!Modified 19/April/88 14:00 NDIAG9.2 !---History: ! ! %c NDIAG9.2 incorporates changes to enable diagnostics on NP1. Note %c that the new changes have been implemented primarily for %c soft failures from Fortran and are dependent upon the %c storage allocation of the IMP compiler. !%c also effectively disables "bottomad" check for NP1 and UTX. !%c NDIAG9.1 corrects occasional report of GLA CORRUPT when a FORTRAN %c main program has been compiled without diagnostics. !%c NDIAG9 introduces conditional compilation for UTX, MPX, and NP1 %c also removes first newline output by coredump !%c NDIAG8 corrects, for the 9000, the mask for the bottom of %c stack check !%c NDIAG7 derived from NDIAG5 and no longer outputs text %c associated with no diagnostics for stack frame. %c This message may be re-instated when diagnostics %c are firing on all cylinders (ie: IMP diagnostics %c and hardware traps). !---Conditional Compilation Constants: ! ! %constinteger UTX= 0 %constinteger MPX= 1 %constinteger NP1= 2 %constinteger target= NP1 !---Global Specs: ! ! %externalstring(15) %fnspec itos (%integer n) %externalroutinespec fdiag (%integer lnb,gla,pc,adiags,first, %integername flag) %if target= MPX %thenstart ! %externalintegerfnspec validate (%integer address, bytes) %externalroutinespec fexit %alias "f_exit" (%integer return code) %finish %if target= UTX %or target= NP1 %thenstart ! %externalintegerfnspec getpid %externalroutinespec kill (%integer pid, signal) %externalroutinespec signal (%integer trap, trap rtn) %externalroutinespec UNIX write %alias "write" (%integer chan, text adr, bytes) %externalintegerfnspec sbrk (%integer n) %finish !---Global Constants: ! ! %if target= NP1 %thenstart %constinteger gla displacement= 20 {bytes from lnb} %constinteger adr mask= x'ffffffff' %finishelsestart !if UTX or MPX %constinteger gla displacement= 8 {bytes from lnb} %constinteger adr mask= x'00ffffff' %finish !---Global Variables: ! ! %owninteger ignore %if target= MPX %thenstart ! %owninteger abort code= 0 %finish %if target= UTX %or target= NP1 %thenstart ! %owninteger topad %owninteger bottomad %finish %if target= UTX %or target= NP1 %thenstart %routine COREDUMP ! ! %ownstring(8) abort text= "Fortran " signal ( 6 {SIGIOT}, 0 {SIG_dfl}) UNIX write ( 2 {STDERR}, addr (abort text)+1, length (abort text)) kill ( getpid, 6 {SIGIOT}) %end; !of COREDUMP %finishelsestart !if MPX %routine COREDUMP ! ! %integer return code return code= abort code abort code= 0 fexit (return code) %end; !of COREDUMP ! ! %finish; !if MPX %if target= NP1 %thenstart %integerfn NDIAG STACK SIZE (%integer dummy) ! ! !---a local routine to determine the size of NDIAG's ! stack frame. It is dependent upon the storage ! allocation of the IMP compiler. ! %integer ndiag link {return address to NDIAG} %integer ndiag code base { code address of NDIAG} %integer ndiag stack size { size of NDIAG`s stack} %integer lnb {lnb of this procedure } lnb= addr(dummy) - x'30' ndiag link = integer (lnb+8) ndiag code base = integer (ndiag link) ndiag stack size= integer (ndiag code base) %result= ndiag stack size ! %end; !of NDIAG STACK SIZE ! ! %finish; !if NP1 %routine PHEX (%integer val) %conststring(1) %array hex(0:15) = "0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F" %integer I %cycle I=28,-4,0 printstring(Hex((Val>>I)&15)) %repeat %end; !of Phex %routine DUMP (%string(31) text, %integer start {from}, finish {to}) %INTEGER CNT,INC %INTEGER I, J %UNLESS TEXT="" %THENSTART NEWLINE SPACES (14) PRINT STRING (TEXT); NEWLINE %FINISH I= START %IF I< 0 %THENSTART I= (I+3) & (-4) %IF FINISH>0 %THEN FINISH= I-FINISH %IF FINISH>I %THENRETURN %FINISHELSESTART I= I & (-4) %IF FINISH<0 %THENRETURN %IF FINISH 0 %CYCLE PRINTSYMBOL ('(') PHEX (I) PRINTSTRING (") ") %CYCLE J= 0,1,3 SPACES (2) PHEX (INTEGER(I)) CNT= CNT - 1 %IF CNT= 0 %THENEXIT I= I+INC %REPEAT NEWLINE %REPEAT %END; !of DUMP %externalroutine NDIAG %alias "s_ndiag" (%integer pc, lnb, p3, p4) ! ! ! %owninteger once only %owninteger diagnosing %integer first %integer gla %integer adiags %integer flag %integer i %integer adr of code; !address of address of start of code for current proc %integer base of code; !address of stack of code for current proc %integer stack size ; !size of stack for current proc %if target= NP1 %thenstart ! %integer next stack size; !size of the following (older) stack frame %integer curr lnb ; !used while initialising for scan of stack %finish %integerfn ADR CONTENTS OF (%integer address) ! ! !A procedure to validate the contents of the word ! pointed at by ADDRESS as an address. %integer contents contents= integer (address) & adr mask %result=contents %if (target= UTX %or target= NP1) %andc contents > bottomad %andc contents < topad %andc contents&3= 0 %result=contents %if target= MPX %and validate (contents, 4)= 0 %c %and contents &3 = 0 %result= 0 {invalid} ! %end; !of ADR CONTENTS OF %if p3 #0 %start { soft error } newline %if p3 = 2049 %then printstring("** Unassigned Variable ** ") %elsec %if p3 = 2050 %then printstring("** Switch Bounds Exceeded ** ") %elsec %if p3 = 513 %then printstring("** Top of Stack **") %elsec %if p3 = 1537 %then printstring("** Capacity Exceeded **") %elsec %if p3 = 21 %then printstring("** No %result **") %elsec %if p3 = 1281 %then printstring("** Invalid %FOR loop **") %elsec %if p3 = 1793 %then printstring("** Resolution error **") %elsec %if p3 = 1538 %then printstring("** Array bounds check **") %elsec %if p3 = 1285 %then printstring("** Expontiation out of bounds **") %elsec printstring("** Imp Error") %and write (p3,1) %c %and printstring(" **") newline %finish %if target= UTX %or target= NP1 %thenstart ! ! bottomad = lnb & x'00700000' ! %if bottomad<= 0 %orc ! bottomad>= x'00700000' %then -> STOP bottomad = 0 topad = sbrk (0) {maximum DATA address} %finishelsestart !if MPX %if validate (lnb,4)\= 0 %then -> STOP %finish flag = 1 first= 1 %if target= NP1 %thenstart ! ! Initialise for Scan Down the Stack ! stack size= ndiag stack size (1234) curr lnb = addr (pc) - x'40' %cycle i= 0, 1, 1 ! adr of code= integer (curr lnb+8) {skip over stack frames} base of code= integer (adr of code) { belonging } next stack size= integer (base of code) { to NDIAG } curr lnb = curr lnb + stack size { and %MONITOR } stack size= next stack size %repeat -> stop %if lnb# curr lnb {jump if something went wrong unwinding the} %finish { stack to the frame passed in by %MONITOR} %cycle; !up the stack %if target= UTX %or target= MPX %thenstart adr of code= adr contents of (lnb) %if adr of code= 0 %then -> abandon base of code= adr contents of (adr of code) %if base of code= 0 %then -> abandon stack size = integer (base of code) %if (stack size & 3)> 0 %then -> abandon %if stack size < 0 %thenstart ! i = stack size >> 24 %if i\= x'80' %then -> abandon %exit %finish %finish !if UTX or MPX %if integer(base of code-8)= m'F77 ' %and integer(base of code-4)# m'diag' %thenstart ! ! Analyse a Fortran Stack Frame ! !In case we break in FDIAG avoid looping diagnostics by !ensuring we only call FDIAG once for each stack frame %if onceonly=lnb %then coredump %else onceonly=lnb adiags= integer (base of code-4) %if adiags<= 0 %thenstart %if adiags = 0 %thenstart print string (" Fortran subprogram compiled without diagnostics ") %if diagnosing\= 0 -> next frame %finishelse print string (" Corrupt stack for Fortran subprogram") %c %and -> dump stack %finish gla= adr contents of (lnb+gla displacement) %if gla= 0 %thenstart print string (" Corrupt GLA Address") -> dump stack %finish i= adr contents of (gla+20) %if i= 0 %thenstart { corrupted address of the diagnostic tables} ! print string (" Corrupt Data for Fortran subprogram") -> dump stack %finish diagnosing= 1 adiags = i + adiags FDIAG(lnb,GLA,base of code,adiags,first,flag) first= 0 %finishelsestart ! ! Stack Frame Not Recognised ! ! %if diagnosing\= 0 %then print string (" !No diagnostics for stack frame ! !"); %finish next frame: %exit %if flag= 0 {stop at main program} %if target= NP1 %thenstart adr of code= adr contents of (lnb+8) %if adr of code= 0 %then -> abandon base of code= adr contents of (adr of code) %if base of code= 0 %then -> abandon next stack size= integer (base of code) %if next stack size<= 0 %or (next stack size&3)> 0 %then -> stop lnb= lnb + stack size; stack size= next stack size %finishelse {UTX or MPX} lnb= lnb + stack size %repeat STOP: newline coredump {unless P3=0} ABANDON: -> STOP DUMP STACK: newlines (2) stack size= 256 %if stack size> 256 dump ("Dump Of Stack",lnb,stack size) -> STOP %end; !of NDIAG %if target= UTX %or target= NP1 %thenstart %externalroutine CALL NDIAG (%integer levels {to hide}) ! ! ignore= levels + 1 {for CALL NDIAG} %c + 1 {for %monitor } %monitor %end; !of CALL NDIAG %externalintegerfn VALIDATE (%integer address, length) ! ! ! ! ! An externalroutine, primariliy for FDIAG, to ! ! determine whether a given address is valid. ! ! ! At Exit: Result = 0 => address is valid ! Result\= 0 => address is not valid ! ! ! address= (address & adr mask) + length %if (address> bottomad %and address> addr(address)) %orc address< topad %thenresult= 0 {okay} %result= 1 {invalid address} ! %end; !of validate %finishelsestart !if MPX %externalroutine CALL NDIAG (%integer levels {to hide}, return code) ! ! abort code= return code ignore= levels + 1 {for CALL NDIAG} %c + 1 {for %monitor } %monitor %end; !of CALL NDIAG ! ! %finish; !if MPX %endoffile