Directory of image this file is from
This file as a plain text file
/DIAG.PA : ERROR DIAGNOSER / / 20-JUL-77 GRG CREATED. / 10-FEB-82 JVE IF FATAL FLAG = -1, RETURN TO PROGRAM ANYWAY / BECAUSE THE ERROR ROUTINE CAN HANDLE IT. / 26-FEB-82 JVE GOOFED UP SHORT MESSAGES... / 12-MAR-82 JVE ADDED EPSON MESSAGE / / / 'DIAG' IS INVOKED BY THE FORTRAN II ERROR ROUTINES TO / PRINT AN EXPLANATORY ERROR MESSAGE AND TRACEBACK THE / CALLING SEQUENCE FROM THE POINT OF ERROR BACK TO THE / MAIN PROGRAM. / THE FORTRAN II ERROR ROUTINE FIRST WRITES THE CONTENTS / OF 3000-5377 TO THE USR SCRATCH BLOCKS, PLACES THE ERROR / INFORMATION INTO 7-15, AND THEN LOADS 'DIAG' INTO 3000-UP / AND ENTERS IT AT 3000. / / 'DIAG' THEN USES THE ERROR INFORMATION TO PRINT THE / MESSAGE AND TRACEBACK. AFTER THE TRACEBACK IS FINISHED, / THE CONTENTS OF 3000-5377 ARE RESTORED. / ERROR FLAG = -1, ERROR IS FATAL, RETURN TO PROG. / ERROR FLAG = 0, ERROR IS FATAL, EXIT TO OS/8. / ERROR FLAG = +1, ERROR IS NON-FATAL, RETURN TO PROG. / // TO ASSEMBLE: / / .PAL DIAG/L / .SAVE SYS:DIAG;3000 / / 'DIAG' MUST BE PRESENT ON THE SYSTEM DEVICE UNDER THE / NAME 'DIAG.SV' TO BE CALLED UP BY THE FORTRAN ERROR ROUTINE. / ///////////////////////////////////////////////////////////// T= 7 X0= 10 X1= 11 X2= 12 X6= 16 X7= 17 / / INFO PACKET LEFT BY ERROR ROUTINE / MS0= 0 /ERROR MESSAGE CHARS 1,2 MS1= 1 /3,4 FATFLG= 2 /FATAL ERROR FLAG ERCDF= 3 /ERROR FIELD ERADR= 4 /ERROR ADDRESS RETF= 5 /RETURN FIELD (CDF) RETA= 6 /RETURN ADDRESS SUBR= HLT FIXMRI INC=ISZ BASE= 3000 /PROGRAM BASE WORDS= 2400 /# WORDS OCCUPIED BY THIS PROGRAM SCRAT= 27 /OUR SCRATCH BLOCK
*BASE START, JMP I (7600) /IF .R DIAG, QUIT TLS JMS MOVDN /MOVE MESSAGE DOWN SOME JMS CRLF JMS QMARK JMS LOOKUP /FIND IN TABLE JMP SHORT /IF NOT FOUND JMS PRINT /PRINT LONG MESSAGE 0 JMP TRCB /NOW TRACE BACK SHORT, TAD MS0 DCA ERRTXT TAD MS1 DCA ERRTXT+1 JMS PRINT ERRTXT TRCB, JMS QMARK JMS TRCBAK /TRACE BACK RETURN, TAD FATFLG SZA CLA JMP RETPRG /RETURN TO PROGRAM TAD (CDF CIF 0) DCA RETCIF /SET RETURN TO OS8 TAD (7600) DCA RETAD JMP RETG RETPRG, CLA STL RTL /AC=2 TAD RETF /SET FIELD DCA RETCIF TAD RETA DCA RETAD /SET RETURN ADDRESS RETG, STA /NON-FATAL, RESTORE MEMORY DCA X7 /BUILD HANDLER CALL AT 00000 TAD (-CODLEN) DCA W1 /WORD COUNT TAD (HCODE-1) DCA X6 HCM, TAD I X6 /MOVE HANDLER CALL DCA I X7 /TO LOW CORE ISZ W1 JMP HCM /MOVE MORE CODE JMP 0 /GO READ IN FORTRAN CODE LOOKUP, SUBR /FIND MS0,2 IN ERROR TABLE TAD (SHMSG-1) DCA X0 /--> SHORT MESSAGES GMSG, TAD I X0 /GET SHORT WORD SNA JMP I LOOKUP /NOT FOUND CIA DCA W1 TAD I X0 CIA DCA W2 INC X0 TAD I X0 /GET TEXT POINTER DCA TXTP TAD W1 TAD MS0 /MATCHED? SZA CLA JMP GMSG /NO, TRY ANOTHER TAD W2 TAD MS1 /MATCHED? SZA CLA JMP GMSG /NO, TRY ANOTHER INC LOOKUP /FOUND IT TAD TXTP JMP I LOOKUP W1, 0 W2, 0 TXTP, 0 FINDLO, SUBR /FIND NEXT SMALLEST E.P. DCA LOWEPT /CLEAR LOWEST E.P. TAD (177) DCA X0 /--> CDF TABLES NEP, TAD I X0 /GET A CDF SNA JMP I FINDLO /ALL OF TABLE SCANNED CIA TAD ERCDF /COMPARE WITH ERROR FIELD SZA CLA JMP NEP /WRONG FIELD TAD X0 /NOW GET THE ADDRESS TAD I (507) /TABLE DISPLACEMENT DCA T TAD I T /GET ADDR DCA T TAD T CIA STL TAD ERADR /IS IT BELOW ERROR ADDRESS? SZL CLA JMP NEP /NO, IGNORE IT TAD T CIA STL TAD LOWEPT /AND ABOVE CURRENT CANDIDATE? SNL CLA JMP NEP /NO, IGNORE IT TAD T /YES, SET NEW MAXIMUM DCA LOWEPT JMP NEP PAGE
TRCBAK, SUBR /DO ERROR TRACEBACK TRCTOP, JMS FINDLO /FIND NEXT LOWEST E.P. DCA OFFST /CLEAR BACK OFFSET TAD ERADR DCA GETA /SET GET PTR. NXBW, TAD WRD DCA PAST JMS GETW /GET A WORD (BACKING UP) DCA WRD TAD GETA /ARE WE BEFORE E.P.? CIA STL TAD LOWEPT SNL CLA JMP BELOW /YES, WE WENT TOO FAR!! TAD WRD CIA TAD STMDEL /IS IT A STATEMENT DELIMITER? SNA CLA INC OFFST /YES, BUMP OFFSET COUNTER TAD WRD CIA TAD MSKCLA /IS IT A LABELED STATEMENT? SZA CLA JMP NXBW /NO, LOOK BACK AGAIN TAD PAST /IS THE LABEL A LEGAL ONE? SPA CLA JMP NXBW /NO, IGNORE IT PSTN, JMS PRINT CFM, ATTXT /' AT ' OR 'CALLED FROM' TAD PAST JMS DECIM / STMT # TAD OFFST /ANY OFFSET? SNA CLA JMP NOOFF /NO, DONT PRINT 0 JMS PRINT PLSTXT /' + ' TAD OFFST JMS DECIM / OFFSET NOOFF, CLA STL RTL /AC=2 TAD LOWEPT /GET ENTRY POINT WORD INTO ERROR ADDR DCA GETA JMS GETW /GET CALL ADDR. DCA ERADR JMS GETW /GET CALL FIELD DCA EFCDF /SAVE FOR NEXT LOOP TAD EFCDF /VALIDATE CDF AND (7707) TAD (-CDF) /REALLY A CDF? SNA CLA JMP TRCM /YES, TRACE BACK AS SUBROUTINE JMS PRINT MAINTXT /'MAIN' JMS CRLF JMP I TRCBAK /RETURN FROM TRACING TRCM, JMS PRINT ROUTXT TAD (CFMTXT) /SET 'CALLED FROM' MESSAGE DCA CFM TAD (-7) /SET BACKUP COUNT DCA WC TAD (ETXT) /SET TEXT PTR DCA TXP BNAM, JMS GETW /GET A TEXT WORD DCA T TAD T DCA I TXP /PLACE IN NAME BUFFER STA /BACK UP NAME PTR. TAD TXP DCA TXP TAD T AND (7700) TAD (-7700) /'g SNA CLA JMP ENAME /YES, END OF NAME ISZ WC /NO, GONE TOO FAR BACK? JMP BNAM /NO, LOOK BACK SOME MORE JMS QMARK JMP CREXT ENAME, INC TXP /--> REAL WORD TAD I TXP /ELIMINATE THE '?' AND (0077) TAD (4200) /ADD IN A '"' DCA I TXP JMS PRINT TXP, 0 /PRINT ENTRY POINT NAME TAD ("") JMS TYPE CREXT, JMS CRLF /NEW LINE TAD FATFLG /FATAL ERROR? (FULL TRACEBACK?) SMA SZA CLA JMP I TRCBAK /RETURN RIGHT NOW IF NON-FATAL TAD EFCDF /SET NEW ERR FIELD DCA ERCDF ISZ TRCLIM /OVER TRACEBACK LIMIT? JMP TRCTOP /TRACE BACK CALLER ROUTINE JMP I TRCBAK /YES, QUIT NOW BELOW, DCA PAST /CLEAR LAST LINE # JMP PSTN MSKCLA, SKP CLA STMDEL, CLA CLL RTL OFFST, 0 PAST, 0 LOWEPT, 0 EFCDF, 0 WC, 0 WRD, 0 TRCLIM, -10 /8 TRACEBACKS IS ENOUGH PAGE
ZBLOCK 6 ETXT, 0;0 GETW, SUBR /GET ONE WORD, AND BACK UP STA TAD GETA DCA GETA TAD ERCDF /FIELD 0 TAD (-CDF) SZA CLA JMP MEMGET /NO, NO NEED TO LOOK IN SCRATCH CLL TAD GETA TAD (-BASE) /BELOW BASE? SNL CLA JMP MEMGET /YES, DON'T TAD GETA TAD (-BASE-WORDS) SNL CLA JMP MEMGET /ABOVE US TAD GETA /IN US, COMPUTE BLOCK # TAD (-BASE) RTL RTL RAL AND (7) TAD (SCRAT) /ADD IN BASE BLOCK DCA T TAD T /IS THIS BLOCK IN MEM? CIA TAD RESBLK SNA CLA JMP NOREF /YES, DON'T BOTHER REFRESHING TAD T DCA RESBLK /NO, READ IT IN JMS I (7607) 0200 /READ IN ONE BLOCK BUF, SCRBUF /TO OUR BUFFER RESBLK, 0 HLT /WHAT ELSE CAN WE DO?? NOREF, TAD GETA /FIND WORD AND (377) TAD BUF /IN BUFFER DCA T TAD I T /FINALLY GET THE WORD JMP GETEXT /RETURN MEMGET, TAD ERCDF DCA .+1 /GO TO ERROR FIELD HLT TAD I GETA GETEXT, CDF 00 JMP I GETW MOVL, GETA, -7 NUMB, MOVDN, SUBR /MOVE 7-15 TO 0-6 MOVMM, TAD I HI DCA I LO INC HI INC LO ISZ MOVL JMP MOVMM JMP I MOVDN HI, 7 LO, 0 DECIM, SUBR /ENTRY-EXIT DCA NUMB TAD (-3) DCA X0 DCA X1 TAD TADTBL DCA TPNTR TRY0, DCA X2 TRY1, CLA CLL TAD NUMB TPNTR, TAD TBL SNL JMP NOVL INC X2 DCA NUMB JMP TRY1 NOVL, CLA TAD X2 SZA JMP NOZR TAD X1 SNA CLA JMP IGNOR NOZR, TAD ("0) JMS TYPE INC X1 IGNOR, INC TPNTR ISZ X0 JMP TRY0 TAD NUMB TAD ("0) JMS TYPE JMP I DECIM TADTBL, TAD TBL TBL, -1750 -144 -12 PAGE
HCODE, JMS I SYSH /READIN WORDS%2 /X PAGES BASE /TO OUR BASE SCRAT /FROM USR SCRATCH AREA SYSH, 7607 /ALSO A HALT (I THINK) RETCIF, HLT /CHANGED TO CDF CIF RETURN JMP I RETAD /RETURN THRU GIVEN VALUE RETAD, 0 /FILLED IN WITH RETURN ADDRESS CODLEN=.-HCODE QMARK, SUBR /PRINT A ? TAD ("?) JMS TYPE TAD (207) JMS TYPE JMP I QMARK CRLF, SUBR TAD (212) JMS TYPE TAD (215) JMS TYPE JMP I CRLF PRINT, SUBR /PRINT 6-BIT STRING TAD I PRINT INC PRINT DCA SPTR PLP, TAD I SPTR RTR RTR RTR JMS SIX TAD I SPTR JMS SIX INC SPTR JMP PLP SPTR, 0 SIX, SUBR /PRINT 6-BIT CHARACTER AND (77) SNA JMP I PRINT /RETURN TAD (-40) SPA TAD (100) TAD (240) JMS TYPE JMP I SIX TYPE, SUBR TSF JMP .-1 TLS C7600, 7600 /FUNNY CLA KSF /CHECK KEYBOARD JMP I TYPE TAD C7600 KRS /ANYTHING THERE? TAD (-7603) /^C? SZA CLA JMP I TYPE /NO, RETURN JMP I (7600) /YES, EXIT / PERMANENT TEXT STRINGS (NOT CLOBBERED BY SCR BUFFER) ERRTXT, TEXT '???? ERROR' ATTXT, TEXT ' AT STATEMENT ' PLSTXT, TEXT '.' ROUTXT, TEXT ' OF ROUTINE ' MAINTXT, TEXT ' OF MAIN PROGRAM.' CFMTXT, TEXT 'CALLED FROM STATEMENT ' PAGE
SCRBUF, /ALSO VIRTUAL MEM BUFFER /AS THIS TEXT ISN'T NEEDED AFTER FIRST PRINTING SHMSG, TEXT 'ALOG';ALOGTX TEXT 'DIVZ';DIVZTX TEXT 'EXP ';EXPTX TEXT 'FIPW';FIPWTX TEXT 'FMT1';FMT1TX TEXT 'FMT2';FMT2TX TEXT 'FMT3';FMT3TX TEXT 'FLPW';FLPWTX TEXT 'OVFL';FPNTTX TEXT 'SQRT';SQRTTX TEXT 'FIX ';FIXTX TEXT 'CHNA';CHNATX TEXT 'CHER';CHNATX TEXT 'IOER';IOERTX TEXT 'IPER';IPERTX TEXT 'IQER';IQERTX TEXT 'IUER';IUERTX TEXT 'OOER';OOERTX TEXT 'OPER';OPERTX TEXT 'OQER';OQERTX TEXT 'OUER';OUERTX TEXT 'RUER';RUERTX TEXT 'TAPE';TAPETX TEXT 'IHNA';IHNATX TEXT 'IFNA';IFNATX TEXT 'OHNA';OHNATX TEXT 'OFNA';OFNATX TEXT 'SUB@';SUBTX TEXT 'SUB ';SUBTX TEXT 'UNKE';UNKETX / TEXT 'NOF0';NOF0TX / TEXT 'HNDR';HNDRTX / TEXT 'PGIO';PGIOTX / TEXT 'NOFL';NOFLTX / TEXT 'OUTF';OUTFTX / TEXT 'NOSU';NOSUTX TEXT 'DYBN';DYBNTX TEXT 'DYCS';DYCSTX TEXT 'DYLD';DYLDTX TEXT 'PAT#';PATTX TEXT 'POSC';POSTX TEXT 'FSYN';FSYNTX TEXT 'FSYL';FSYLTX TEXT 'EPSN';EPSNTX 0 ALOGTX, TEXT 'LOGARITHM OF NUMBER <= 0.0' DIVZTX, TEXT 'DIVISION BY ZERO' EXPTX, TEXT 'EXP(X) RESULT OVERFLOW' FIPWTX, TEXT 'X**X RESULT OVERFLOW' FMT1TX, TEXT 'INVALID FORMAT STATEMENT' FMT2TX, TEXT 'INVALID CHARACTER IN INTEGER INPUT' FMT3TX, TEXT 'INVALID CHARACTER IN REAL INPUT' FLPWTX, TEXT 'NEGATIVE NUMBER RAISED TO A REAL POWER' FPNTTX, TEXT 'FLOATING-POINT OVERFLOW' FIXTX, TEXT 'REAL-TO-INTEGER CONVERSION OVERFLOW' SQRTTX, TEXT 'SQUARE ROOT OF A NUMBER < 0.0' CHNATX, TEXT 'CHAIN FILE NOT AVAILABLE ON SYS:' IOERTX, TEXT 'TRIED TO READ WITH NO INPUT FILE OPENED' IPERTX, TEXT 'HARDWARE READ ERROR' OOERTX, TEXT 'TRIED TO WRITE WITH NO OUTPUT FILE OPENED' OPERTX, TEXT 'HARDWARE WRITE ERROR' OQERTX, TEXT 'OUTPUT FILE SPACE FULL' IQERTX, TEXT 'ATTEMPT TO READ PAST END-OF-FILE' TAPETX, TEXT 'HARDWARE DECTAPE ERROR' IUERTX, TEXT 'TRIED TO ACCESS UNDEFINED INPUT UNIT' IHNATX, TEXT 'INPUT HANDLER NOT ALLOCATED' IFNATX, TEXT 'INPUT FILE NOT AVAILABLE' OUERTX, TEXT 'TRIED TO ACCESS UNDEFINED OUTPUT UNIT' RUERTX, TEXT 'RESET ON UNDEFINED UNIT' OHNATX, TEXT 'OUTPUT HANDLER NOT ALLOCATED' OFNATX, TEXT 'OUTPUT FILE NOT AVAILABLE' SUBTX, TEXT 'SUBSCRIPT OUT OF BOUNDS' UNKETX, TEXT 'UNKNOWN EXTERNAL CALLED' /NOF0TX, TEXT 'PAGEIO: NOT LOADED INTO FIELD 0' /HNDRTX, TEXT 'PAGEIO: HANDLER NOT LOADED' /PGIOTX, TEXT 'PAGEIO: HARDWARE I/O ERROR' /NOFLTX, TEXT 'PAGEIO: NO FILE LOOKED UP OR OPENED' /OUTFTX, TEXT 'PAGEIO: TRIED I/O OUTSIDE OF FILE' /NOSUTX, TEXT 'PAGEIO: HANDLER NOT LOADED' DYBNTX, TEXT 'INVALID DYNAMIC MEMORY POINTER' DYCSTX, TEXT 'NO SYSTEM MEMORY SIZE SET' DYLDTX, TEXT 'LOADER DID NOT ALLOCATE ANY FREE MEMORY' POSTX, TEXT 'INVALID OSCILLATOR NUMBER' PATTX, TEXT 'INVALID ATTENUATOR NUMBER' FSYNTX, TEXT 'INVALID FSYN INDEX OR ATTENUATION' FSYLTX, TEXT "CAN'T LOAD FREQ SYNTH" EPSNTX, TEXT "CAN'T USE EPSON-80" PAGE IFNZRO BASE+WORDS-. <*BOMB /ADJUST SOMETHING!> $$$$