File DIAG.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

/DIAG.PA : ERROR DIAGNOSER

/
/	GEORGE GONZALEZ
/	H.R.L.
/	JULY 20, 1977
/
/	DOCUMENTATION UPDATE: AUG 1, 1978
/
/
/
/	'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-4777 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. IF THE ERROR WAS NON-FATAL, THEN
/	THE CONTENTS OF 3000-4777 ARE RESTORED AND THE FORTRAN
/	PROGRAM IS CONTINUED.
/
//	TO ASSEMBLE:
/
/	.PAL DIAG,ERRS/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.
/
/
/////////////////////////////////////////////////////////////////////////////

	EJECT	ASSEMBLY CONSTANTS

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
END=	BASE+2200	/END OF PROG
SCRAT=	27		/OUR SCRATCH BLOCK

	EJECT	MAIN PROGRAM
*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,	JMS	PRINT
	MS0
	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

/ / DO ERROR TRACEBACK / TRCBAK, SUBR 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 (-4) /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?) SZA CLA JMP I TRCBAK /RETURN RIGHT NOW 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
STXT, ZBLOCK 3 ETXT, 0;0 / / GET ONE WORD, BACK UP POINTER / GETW, SUBR 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 (-END) 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 / / MOVE MEMORY BLOCK / NUMB, MOVDN, SUBR MOVMM, TAD I HI DCA I LO INC HI INC LO ISZ MOVL JMP MOVMM JMP I MOVDN HI, 7 LO, 0 / / PRINT DECIMAL NUMBER / 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
/ / RETURN TO FORTRAN CODE / HCODE, JMS I SYSH /READIN 1200 /12 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 / / PRINT A ? <BELL> / QMARK, SUBR TAD ("?) JMS TYPE TAD (207) JMS TYPE JMP I QMARK / / START A NEW LINE / CRLF, SUBR TAD (212) JMS TYPE TAD (215) JMS TYPE JMP I CRLF / / PRINT 6-BIT STRING / PRINT, SUBR 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 / / PRINT A 6-BIT CHARACTER / SIX, SUBR AND (77) SNA JMP I PRINT /RETURN TAD (-40) SPA TAD (100) TAD (240) JMS TYPE JMP I SIX / / TYPE ONE CHAR / 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



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search