File DBGPRT.MA (MACREL macro assembler source file)

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

	TITLE DBGPRT- DEBUGGING PACKAGE FOR PPL
	SUBTTL	TAS/EAT/WDM    15-JUN-74      FOR VERSION 40 AND LATER


	HISEG
	SEARCH PPL

	PNT=: PUSHJ P,DBGPRT	;INSTRUCTION FOR CALLING DBGPRT
	ENUMERATE=:PUSHJ P,ENUM	;INSTRUCTION TO ENUMERATE DZ
	ENUMALL=:PUSHJ P,ENUMA  ;ENUMERATE ALL DZ INCLUDING GARBAGE
	PLEX=: PUSHJ P,LEXPR	;INSTRUCTION FOR PRINTING LEXEMES IN AC1
	PTOK=: PUSHJ P,TOKPR	;INSTRUCTION FOR PRINT TOKEN ADDR
				;IS IN AC1
	PCHN=: PUSHJ P,CHNPR	;PRINT CHAIN FOR WHICH SYNTAX TOKEN ADDR IN AC1
	PFCB=:	PUSHJ P,FCBPR	;PRINT FCB WHOSE ADR IS IN AC1


	DEFINE NXTLIN;			TO SEQUENCE TO NEXT LINE
	<TTOA [BYTE(7)CR,LF,TAB]>


	OPDEF GOTO [JRST]
	
	DEFINE MSG(A)		;TO EXECUTE  TTOS [SIXBIT/A!/]
	<TTOS	[SIXBIT/A!/]>

	DEFINE	AMSG(A)	<	;; SAME AS MSG FOR NON-SIXBIT CHARACTERS
	TTOA	[ASCIZ/A/]
>

	DEFINE	FWPR(A) <	;;PRINT FULL WORD AT A AS LH,,RH
	HLRZ	AC1,A
	CALL	ADRPR
	MSG	<,,>
	HRRZ	AC1,A
	CALL	ADRPR
>

;GENERATE SYSTEM BLOCK TYPE PRINT NAME TABLE DEFINE B.DEF(A) < SIXBIT /A/ > PRTBL: B.DEFS ;GENERATE SYSTEM BLOCK TYPE DISPATCH TABLE DEFINE B.DEF(A) < EXP P'A > SYSDIS: B.DEFS ;GENERATE USER BLOCK TYPE PRINT TABLE DEFINE U.DEF(A,B) < IFIDN <B><ATOM>,< EXP P'A >> USRDIS: U.DEFS ;GENERATE PRINTNAME TABLE FOR ID TYPES DEFINE I.DEF(A) < <SIXBIT/A/> & <-100>!'!' > CPRTBL: SIXBIT /UNDEF!/ I.DEFS
REMARK BYTE POINTERS FOR SELECTION AND ASSIGNMENT REMARK OF PARTS OF SYSTEM OBJECTS ;FIELDS OF ALL DATA BLOCKS PWLF: POINT 18,0(AC1),17 ;WLENGTH FIELD PBPF: POINT 18,0(AC1),35 ;BACK POINTER FIELD PBLTF: POINT 16,0(AC1),17 ;BLOCK TYPE FIELD PCBF: POINT 1,0(AC1), 1 ;COPY BIT FIELD PGCBF: POINT 1,0(AC1), 0 ;GARBAGE COLLECTION BIT FIELD PSYSBF: POINT 1,0(AC1), 2 ;SYSTEM BIT FIELD PTYF: POINT 15,0(AC1),17 ;TYPE FIELD IN PZWORD ;FIELDS IN BOOLEAN AND CHARACTER DATA BLOCKS PCHARF: POINT 7,1(AC1),35 ;CHARACTER FIELD PBOOLF: POINT 1,1(AC1),35 ;COOLEAN FIELD
;FIGLDS IN SEQ AND VSEQ DDEF BLOCKS PLBF: POINT 18,1(AC1),17 ;LOWER BOUND FIELD PUBF: POINT 18,2(AC1),35 ;UPPER BOUND FIELD PTYPF: POINT 18,1(AC1),35 ;TYPE FIELD FIELD (SEQ AND VSEQ) ;FIELDS OF ACTIVATION RECORDS PFNF: POINT 18,1(AC1),17 ;FUNCTION POINTER FIELD PLNF: POINT 18,1(AC1),35 ;LINE NUMBER FIELD PTOPF: POINT 18,2(AC1),17 ;TOP FIELD PLPF: POINT 18,2(AC1),35 ;LINE POINTER FIELD PATRF: POINT 18,3(AC1),17 ;ATTRIBUTE FIELD PPMF: POINT 18,3(AC1),35 ;POSITION MARKER FIELD PCRF: POINT 18,4(AC1),17 ;CALLER FIELD PCDF: POINT 18,4(AC1),35 ;CALLED FIELD PLRF: POINT 18,5(AC1),17 ;LEFT RING FIELD PRRF: POINT 18,5(AC1),35 ;RIGHT RING FIELD ;FIELDS OF REFS AND LVALUES PELTF: POINT 18,1(AC1),17 ;ELEMENT TYPE FIELD PPZAF: POINT 18,1(AC1),35 ;PZADR FIELD PDISPF: POINT 18,2(AC1),17 ;DISP FIELD PLENF: POINT 12,2(AC1),35 ;LENGTH FIELD PBEGF: POINT 6,2(AC1),23 ;LENGTH FIELD ;FIELD IN INSTANCES OF USER DEFINED VARIADIC SEQUENCES PUDUBF: POINT 18,1(AC1),35 ;USER DEFINED UPPER BOUND FIELD
;FIELDS OF TRANSLATED FUNCTIONS PLCLSF: POINT 18,1(AC1),17 ;NUMBER OF LOCALS FIELD PMSTKF: POINT 18,1(AC1),35 ;MAX STACK REQURED FIELD PLINESF: POINT 18,2(AC1),17 ;NUMBER OF LINES FIELD PTEXTF: POINT 18,2(AC1),35 ;POINTER TO TEXT FIELD ;FIELDS OF TRANSLATED LINES PTBITF: POINT 1,1(AC1), 0 ;TRACE BIT FIELD PSBITF: POINT 1,1(AC1), 1 ;STOP BIT FIELD PINHF: POINT 16,1(AC1),17 ;INHERITED LINE NUMBR FIELD PNF: POINT 18,1(AC1),35 ;LINE NUMBER FIELD ;FIELDS OF LINE0 PFRMLF: POINT 12,2(AC1),11 ;NUMBER OF FORMALS FIELD PLCLF: POINT 12,2(AC1),23 ;NUMBER OF LOCALS FIELD PASGNSF: POINT 12,2(AC1),35 ;NUMBER OF ASSIGNMENTS FIELD PATRSF: POINT 18,3(AC1),17 ;FUNCTION ATTRIBUTES FIELD ;FIELDS OF I/O BUFFER BLOCKS PBFSF: POINT 18,1(AC1),17 ;BUFFER SIZE FIELD PFCBF: POINT 18,1(AC1),35 ;POINTER TO FILE CONTROL BLOCK ;FIELDS OF LEXEMES (CONTAINED IN AC1 RATHER THAN IN A BLOCK) PFWDCHN: POINT 9,AC6,8 PACTION: POINT 5,AC6,13 PLXTYP: POINT 4,AC6,17 PVALUE: POINT 18,AC6,35
DEFINE L.DEF(A) < SIXBIT /A/> LXPNS: L.DEFS CALL EHPD LX: CALL OPPR CALL INTPD CALL INTPD CALL INTPD CALL IDPR CALL ADRPR CALL INTPD CALL ADRPR CALL ADRPR CALL IDPR CALL ADRPR DEFINE A.DEF(A) < SIXBIT/A/ > IACTS: A.DEFS
REMARK MACROS FOR ASSIGNING AND SELECTING BYTES REMARK IN FIELDS OF SYSTEM BLOCKS ;CONVENTIONS: ;SELECTION: ;AC1= PZADR OF BLOCK ;AC1= SELECTED BYTE [SELECTION DESTROYS AC1] ;ASSIGNMENT: ;AC1= PZADR OF BLOCK ;R= BYTE TO BE ASSIGNED,RIGHT JUSTIFIED ;THE ARGUMENT TO THE SEL OR ASGN MACRO ;IS THE SYMBOLIC NAME OF THE FIELD TO BE OPERATED ON. ;FOR EXAMPLE: SEL WLF -TO SELECT THE WORD LENGTH FIELD. DEFINE SEL(F) < HRRZ AC1,(AC1) ;GET POINTER TO DATA BLOCK IN DZ LDB AC1,P'F > ;FETCH BYTE INTO AC1 > DEFINE ASGN(F) < HRRZ AC1,(AC1) ;GET POINTER TO DATA BLOCK IN DZ DPB R,P'F > ;PUT BYTE IN R INTO DESIGNATED FIELD>
;BLOCK PRINT ROUTINE: ;THE FOLLOWING IS THE INITIAL PORTION OF THE SYSTEM BLOCK PRINT ;ROUTINE,DBGPRT. IT CHECKS FOR WELL-FORMEDNESS OF THE BACK-POINTER ;CYCLE,THEN PRINTS THE GCBIT,COPYBIT AND SYSBIT ONLY IF ;THEY ARE ON, AND PRINTS THE BLOCK TYPE, PZADRESS AND WLENGTH. ;IT THEN SWITCHES VIA A DISPATCH SWITCH TO THE INDIVIDUAL ROUTINES ;FOR PRINTING THE SEVERAL SPECIES OF BLOCK BODIES. ;AC1= PZADR OF BLOCK TO BE PRINTED DBGPRT::SAVE <OFILE,R,R2,AC1,AC2> ;DBGPRT MADE INTERNAL BY :: SETZM OFILE ;ENSURE OUTPUT TO TTY HLLI AC1, ;CLEAR AC1 LEFT HALF FOR SAFETY CALL ADRPR ;PRINT PZADR FIRST (IN OCTAL) TTOI TAB ;PRINT TAB CAML AC1,PZBEG ;EXIT IF NOT A PZ POINTER CAMLE AC1,PZEND JRST NODAT MOVE AC2,(AC1) ;AC2_HEADER WORD IN PZ TLZE AC2,400000 ;SKIP IF GCBIT IS OFF TTOS [SIXBIT /GCBIT=1,!/];PRINT "GCBIT=1," TLZE AC2,200000 ;SKIP IF COPYBIT IS OFF,ELSE ZERO IT AND PRINT TTOS [SIXBIT /COPYBIT=1,!/];"COPYBIT=1," TLZE AC2,100000 ;TEST IF SYSBIT IS ON ,SKIP IF NO,PRINT AND JRST L1 ;GO TO ROUTINE TO DISPATCH ON SYSTEM BLOCK TYPES TTOS [SIXBIT /USERTYPE=!/];PREPARE TO PRINT USER TYPE IDENTIFIER SAVE <AC1> HLRZ AC1,AC2 ;AC1 _ USER TYPE ID RELADR IN IDT CALL IDPR ;PRINT IDENTIFIER FROM IDT RESTOR <AC1> TTOI COMMA CALL R1 ;CHECK BACK-PTR CYCLE OK AND SEQ. TO NEXT LINE HLRZ R,AC2 ;R _ GET RELADR FOR DISPATCH PURPOSES RESTOR <AC2,AC1> CAILE R,LSTATM ;IF WASN'T TYPE ALREADY IN SYSTEM JRST PUDT ;GO TO PRINT USER DEFINED TYPE LSH R,-1 ;ELSE GO TO PREDEFINED BLOCK PRINT ROUTINE CALL @USRDIS(R) JRST PX ;RESTORE R,R2 AND EXIT R1: HRRZ R,(AC2) ;CHECK IF POINTER CYCLE IS WELL FORMED CAME R,AC1 ;PRINT ERROR MESSAGE IF MAL-FORMED TTOS [SIXBIT /MALFORMED POINTER CYCLE,!/] HLRZ AC1,(AC2) ;PRINT WLENGTH (IN DECIMAL) CALL INTPD NXTLIN ;SEQUENCE TO NEXT LINE RETURN L1: TTOS [SIXBIT /SYSBIT=1,!/];PRINT SYSBIT=1 MOVS AC2,AC2 MOVSI R2,(SIXBIT /!/) MOVE R,PRTBL-1(AC2) ;LOAD BLOCK PRINT NAME INTO R TTOS R ;PRINT IDENTIFIER TTOI COMMA MOVS AC2,AC2 CALL R1 ;CALL R1 TO CHECK PTR CYCLE AND SEQ TO NXT LINE HLRZ R,AC2 ;GET DISPATCH ADDRESS IN R RESTOR <AC2,AC1> CALL @SYSDIS-1(R); ;GO THROUGH SYSTEM BLOCK DISPATCH TABLE PX: RESTORE <R2,R,OFILE> RETURN PUDT: CALL PLOGIC ;COP OUT,PRINT AS LOGIC BLOCK FOR NOW JRST PX
REMARK THE FOLLOWING MACRO IS USED TO COMPRESS REMARK THE EXIT CODING FOLLOWING BLOCK PRINTING. DEFINE EXIT < TTOA [BYTE(7)CR,LF,LF] RETURN > ;IN THE FOLLOWING ROUTINES WE ENTER WITH AC1 CONTAINING ;THE PZ ADDRESS OF THE DATUM WHOSE BLOCK BODY IS TO ;BE PRINTED. AS USUAL, ACCUMULATORS MUST BE SAFE ACROSS THESE ROUTINES ;EXCEPT FOR R,R2. UPON ENTRY, R CONTAINS THE BLOCK TYPE. PINT: SAVE <AC1> ;SAVE AC1 HRRZ R,(AC1) ;AC1_INTEGER MOVE AC1,1(R) ;IN DATA BLOCK CALL INTPD ;GO PRINT THE INTEGER (IN DECIMAL) RESTOR <AC1> ;RESTORE ACCUMULATOR EXIT ;AND EXIT PREAL: SAVE <AC1> ;SAVE AC1 HRRZ R,(AC1) ;MOVE SINGLE PRECISION REAL MOVE AC1,1(R) ;INTO AC1 CALL REALPR ;AND PRINT IT RESTOR <AC1> ;RESTORE ACCUMULATOR EXIT ;AND EXIT PDBL: SAVE <AC1,AC2> ;SAVE TWO ACCUMULATORS HRRZ R,(AC1) ;MOVE DOUBLE PRECISION REAL MOVE AC1,1(R) ;INTO AC1 AND AC2 MOVE AC2,2(R) ;AND CALL DBLPR ;PRINT IT. RESTOR <AC2,AC1> ;RESTORE ACCUMULATORS EXIT ;AND EXIT. NODAT: TTOS [SIXBIT/NOT A PZ WORD#/] RESTORE <AC2,AC1> ;RESTORE AND EXIT JRST PX
PBOOL: SAVE <AC1> ;SAVE ACCUMULATOR SEL BOOLF ;MOVE BOOLEAN TO AC1 AND CALL BOOLPR ;PRINT IT RESTOR <AC1> ;RESTORE ACCUMULATOR EXIT ;AND EXIT PCHAR: SAVE <AC1> ;SAVE ACCUMULATOR SEL CHARF ;PUT CHARACTER IN AC1 CALL CHARPR ;AND PRINT IT. RESTOR <AC1> ;RESTORE ACCUMULATOR EXIT ;AND EXIT. PNONE: TTOS [SIXBIT/NULL!/] EXIT PSTRUC: SAVE <AC1,AC2> ;SAVE TWO ACCUMULATORS HRRZ R,(AC1) ;R_BASE OF BLOCK BODY IN DZ HLLO AC2,(R) ;AC2_[WLENGTH,777777] SETCA AC2, ;COMPLEMENT AC2 ADD AC2,TWOONE ;AC2_AC2+[XWD 2,1] ADDI AC2,(R) ;(AC2)=[-(WL-1),BASE+1] LOOP1: HLRZ AC1,(AC2) ;AC1_SELECTOR RELADR CALL IDPR ;PRINT SELECTOR IDENTIFIER TTOI COLON ;PRIINT COLON HRRZ AC1,(AC2) ;AC1_TYPE RELADR CALL IDPR ;PRINT TYPE IDENTIFIER NXTLIN ;SEQUENCE TO NEXT LINE AOBJN AC2,LOOP1 ;LOOP THROUGH BLOCK BODY RESTOR <AC2,AC1> ;WHEN DONE RESTORE ACCUMULATORS EXIT ;AND EXIT. PALT== PSTRUC ;SAME ROUTINE TO PRINT BLOCK BODY
PSEQ: SAVE <AC1> ;SAVE ACCUMULATOR MSG LB= SEL LBF ;GET LOWER BOUND FIELD CALL EHPD ;PRINT IT AS DECIMAL INTEGER TTOI COMMA ;PRINT A COMMA REFRSH AC1 ;GET ORIGINAL CONTENTS OF AC1 BACK MSG TYPE= SEL TYPF ;SELECT TYPE FIELD CALL IDPR ;PRINT AS IDENTIFIER NXTLIN ;SEQUENCE TO NEXT LINE SETZ AC1, ;PRINT ZEROES CALL ADRPR ;USING ADDRESS PRINT ROUTINE TTOI COMMA ;PRINT COMMA REFRSH AC1 ;RESTORE ORIGINAL CONTENTS OF AC1 MSG UB= SEL UBF ;SELECT THE UPPER BOUND FIELD CALL EHPD ;PRINT AS DECIMAL INTEGER RESTOR <AC1> ;RESTORE ACCUMULATOR AND EXIT ;EXIT PVSEQ: SAVE <AC1> MSG LB= SEL LBF ;GET LOWER BOUND FIELD CALL EHPD ;AND PRINT IN DECIMAL TTOI COMMA ;PRINT COMMA REFRSH AC1 ;REFRESH AC1 MSG TYPE= SEL TYPF ;GET TYPE FIELD CALL IDPR ;PRINT AS IDENTIFIER RESTOR <AC1> ;RESTORE ACCUMULATOR EXIT ;AND EXIT.
PAR: SAVE <AC3,AC1> ;SAVE ACCUMULATOR MSG FN= SEL FNF ;SELECT FUNCTION FIELD CALL ADRPR ;PRINT AS OCTAL ADDRESS TTOI COMMA ;PRINT COMMA REFRSH AC1 ;REFRESH ACCUMULATOR MSG LN= SEL LNF ;SELECT LINE NUMBER FIELD CALL EHPD ;PRINT AS DECIMAL INTEGER NXTLIN ;SEQUENCE TO NEXT LINE REFRSH AC1 ;REFRESH ACCUMULATOR MSG TOP= SEL TOPF ;SELECT TOP FIELD CALL INTPD ;PRINT AS DECIMAL INTEGER TTOI COMMA ;PRINT COMMA REFRSH AC1 ;REFRESH ACCUMULATOR MSG LP= SEL LPF ;SELECT LINE POINTER CALL ADRPR ;AND PRINT AS OCTAL ADDRESS NXTLIN ;SEQUENCE TO NEXT LINE REFRSH AC1 ;REFRESH ACCUMULATOR MSG ATTR= SEL ATRF ;SELECT ATTRIBUTE FIELD CALL ADRPR ;AD PRINT IN OCTAL TTOI COMMA ;PRINT COMMA REFRSH AC1 ;REFRESH ACCUMULATOR MSG PMKR= SEL PMF ;PRINT POSITION MARKER CALL INTPD ;IN DECIMAL NXTLIN ;SEQUENCE TO NEXT LINE REFRSH AC1 ;REFRESH ACCUMULATOR MSG CALLER= SEL CRF ;SELECT CALLER FELD CALL ADRPR ;PRINT IN OCTAL TTOI COMMA ;PRINT COMMA REFRSH AC1 ;REFRESH ACCUMULATOR MSG OLD LN= SEL CDF ;SELECT CALLED FIELD CALL EHPD ;PRINT 18-BIT 2'S COMPLEMENT DECIMAL NXTLIN ;SEQUENCE TO NEXT LINE REFRSH AC1 ;REFRESH ACCUMULATOR MSG LRNG= SEL LRF ;SELECT LEFT RING FIELD CALL ADRPR ;PRINT IN OCTAL TTOI COMMA ;PRINT COMMA
REFRSH AC1 ;REFRESH ACCUMULATOR MSG RRNG= SEL RRF ;SELECT RIGHT RING FIELD CALL ADRPR ;PRINT IN OCTAL NXTLIN REFRSH AC1 ;REFRESH ACCUMULATOR SAVE <AC2> ;SAVE AN ADDITIONAL ACCUMULATOR HRRZ R,(AC1) ;PRINT THE REMAINDER OF THE HLLO AC2,(R) ;ACTIVATION RECORD AS LEXEMES SETCA AC2, ;MAKE AOBJN POINTER ADD AC2,[XWD 7,6] ADDI AC2,(R) SETZM AC3 ;CLEAR NULL LEXEME COUNT LOOP2: SKIPN AC1,(AC2) ;GET LEXEME IN AC1 AOJA AC3,LOOP2A ;ADD TO NULL LXM COUNT AND JUMP IF ZERO JUMPE AC3,LOOP2B ;NUMP IF THIS NOT NULL AND NO NULLS SEEN LOOP2C: EXCH AC1,AC3 ;WERE NULLS BEFORE, GO PRINT CALL INTPD ;NUMBER OF NULLS TTOS [SIXBIT/ NULL LXMS!/] NXTLIN MOVE AC1,AC3 ;RESTORE AC1 SETZM AC3 ;CLEAR NULL COUNT JUMPE AC1,LOOP2A LOOP2B: CALL LEXPR ;PRINT IT NXTLIN LOOP2A: AOBJN AC2,LOOP2 ;SEE IF MORE LEXEMES LEFT JUMPN AC3,LOOP2C ;GO PRINT NULL LXM COUNT IF NONZERO RESTOR <AC2,AC1,AC3> ;RECOVER ACCUMULATORS IF NONE LEFT EXIT ;AND EXIT PLVAL: SAVE <AC1> ;SAVE ACCUMULATOR SEL ELTF ;GET ELEMENT TYPE FIELD CALL IDPR ;PRINT IDENTIFIER FOR ELEMENT TYPE TTOI COMMA REFRSH AC1 SEL PZAF ;GET PZADR CALL ADRPR ;PRINT IN OCTAL NXTLIN REFRSH AC1 MSG <DISP,BEG,LEN=> SEL DISPF ;SELECT DISPLACEMENT FIELD CALL INTPD ;PRINT IN DECIMAL TTOI COMMA REFRSH AC1 SEL BEGF ;SELECT BEGINNING FIELD CALL INTPD ;PRINT IN DECIMAL TTOI COMMA REFRSH AC1 SEL LENF ;SELECT LENGTH FIELD CALL INTPD ;PRINT AS INTEGER RESTOR <AC1> ;RESTORE ACCUMULATOR AND EXIT ;EXIT
;OF LVALS AS FOR REFERENCES. PIDT: SAVE <AC1,AC2,AC3> ;SAVE THREE ACCUMULATORS MOVE AC1,IDTP ;GET ADDRESS OF IDT IN AC1 HRRZ AC2,(AC1) ;AC2_BLOCK BASE ADDRESS OF IDT HLRZ AC3,(AC2) ;AC3_WLENGTH OF IDT ADD AC3,AC2 ;AC3_ADDRESS ONE BEYOND END OF IDT ADDI AC2,1 ;GET ADDRESS OF FIRST SYMBOL TABLE ENTRY LOOP3: HLRZ AC1,(AC2) ;PRINT STE AT ADDRESS=(AC2) TTOS CPRTBL(AC1) ;PRINT CLASS AS CHARACTER STRING TTOI COMMA ;PRINT COMMA HRRZ AC1,(AC2) ;PRINT VALUE AS OCTAL ADDRESS CALL ADRPR NXTLIN ADDI AC2,1 ;PICK UP LENGTH OF ID IN WORDS IN AC1 LDB AC1,[POINT 6,(AC2),5]; JUMPE AC1,FRESPC ;ZERO LENGTH MEANS NO MORE ID'S CALL INTPD TTOI COMMA LDB R,[POINT 30,(AC2),35] MOVSI R2,(SIXBIT/#/) TTOS R SUBI AC1,1 LOOP4: SOJE AC1,NEXT1 ADDI AC2,1 MOVE R,(AC2) TTOI TAB TTOS R GOTO LOOP4 NEXT1: TTOI TAB ADDI AC2,1 CAMGE AC2,AC3 ;SKIP TO CLEAN UP IF GOTO LOOP3 ;ADDRESS IN AC2 IS PAST END OF IDT PIDTX: RESTOR <AC3,AC2,AC1> ;RESTORE ACCUMULATORS EXIT ;AND EXIT FRESPC: SUB AC3,AC2 ;COMPUTE NUMBER OF FREE CELLS AT END OF IDT MOVE AC1,AC3 ;SET UP TO PRINT CALL INTPD TTOS [SIXBIT/ FREE CELLS AT END OF IDT#/] JRST PIDTX
POPT: SAVE <AC1> ;SAVE TWO ACCUMULATORS MOVE AC1,OPTP ;GET ADDRESS OF OPT IN AC1 HRRZ R,(AC1) ;R_BASE OF BLOCK BODY OF OPT IN DZ HLLO AC1,(R) ;AC1_[WLENGTH,777777] SETCA AC1, ADD AC1,TWOONE ;SET UP AOBJN POINTER LOOP5: CALL OPPR ;PRINT CURRENT RELATIVELY ADDRESSED OP NXTLIN AOBJN AC1,.+1 ;PREPARE TO GET OP DISPATCH ADDRESS SAVE AC1 ADD AC1,@OPTP ;TURN INTO ABS ADDR. MOVS AC1,(AC1) ;GET IDT POINTERS TRNE AC1,-1 ;PRINT LH IF NONZERO CALL IDPR TTOA [BYTE(7)TAB,COMMA] MOVS AC1,AC1 ;PRINT RH IF NONZERO TRNE AC1,-1 CALL IDPR NXTLIN REFRSH AC1 ;DO UNARY PRECEDECNE ADD AC1,@OPTP HLRZ AC1,1(AC1) CALL INTPD TTOA [BYTE(7)TAB,COMMA] REFRSH AC1 ;DO ASSOCIATIVITY AND BINARY PRECEDENCE ADD AC1,@OPTP HRRZ AC1,1(AC1) TRNN AC1,400000 MSG <L > TRZE AC1,400000 MSG <R > CALL INTPD RESTORE AC1 NXTLIN AOBJN AC1,.+1 AOBJN AC1,LOOP5 RESTOR <AC1> EXIT PFN: SAVE <AC1> MSG LCLS= SEL LCLSF ;SELECT LOCALS FIELD CALL INTPD ;PRINT NUMBER OF LOCALS IN DECIMAL TTOI COMMA REFRSH AC1 MSG MSTK= SEL MSTKF ;SELECT MAX STACK FIELD CALL INTPD ;PRINT IN DECIMAL NXTLIN REFRSH AC1 MSG LINES= SEL LINESF ;SELECT LINES FIELD CALL INTPD ;PRINT IN DECIMAL TTOI COMMA REFRSH AC1 MSG TEXT= SEL TEXTF ;SELECT TEXT FIELD CALL ADRPR ;PRINT ADDRESS OFTEXT BLOCK IN OCTAL NXTLIN REFRSH AC1 SAVE <AC2> ;SAVE AN ADDITONAL ACCUMULATOR
HRRZ R,(AC1) ;R_BASE OF BLOCK BODY HLLO AC2,(R) ;AC2_[WLENGTH,777777] SETCA AC2,AC2 ;COMPLEMENT AC2 ADD AC2,[XWD 3,2] ;(AC2)=[-(WL-2),BASE+2] ADDI AC2,(R) ;THIS ADDS IN BASE ADDR. AOBJP AC2,NEXT2 ;GO OUT AFTER LAST LINE LOOP6: HLRZ AC1,(AC2) CALL ADRPR TTOI COMMA ;LOOP TO PRINT ADDRESSES OF HRRZ AC1,(AC2) ;LINES IN TEXT BLOCK CALL ADRPR ;IN OCTAL NXTLIN AOBJN AC2,LOOP6 ;LOOP BACK FOR NEXT LINE NEXT2: RESTOR <AC2,AC1> ;RESTORE ACCUMULATORS EXIT ;AND EXIT HEAD0: SAVE <AC1> ;ROUTINE TO PRINT STANDARD TTOS [SIXBIT/T=!/] ;HEADER INFORMATION AT HEADS SEL TBITF ;OF TRANSLATED LINES TTOI 60(AC1) ;PRINT VALUE OF TRACE BIT TTOS [SIXBIT/,S=!/] ;PRINT STOP BIT AFTER TRACE BIT REFRSH AC1 SEL SBITF TTOI 60(AC1) ;PRINT VALUE OF STOP BIT TTOS [SIXBIT /,INH=!/] ;PRINT INHERITED LINE NUMBER REFRSH AC1 SEL INHF TRNE AC1,100000 ;16-BIT NEGATIVE NUMBER? HRROI AC1,600000(AC1) ;YES, EXTEND SIGN CALL INTPD TTOS [SIXBIT /,N=!/] ;PRINT LINE NUMBER REFRSH AC1 SEL NF ;SELECT NUMBER FIELD CALL EHPD ;AND PRINT IN DECIMAL NXTLIN RESTOR <AC1> RETURN
PLIN0: SAVE <AC1> CALL HEAD0 ;PRINT HEADER INFORMATION TTOS [SIXBIT /FORMLS=!/] SEL FRMLF ;PRINT NUMBER OF FORMALS CALL INTPD ;IN DECIMAL REFRSH AC1 TTOS [SIXBIT /,LCLS=!/] SEL LCLF ;PRINT NUMBER OF LOCALS CALL INTPD ;IN DECIMAL REFRSH AC1 TTOS [SIXBIT /,ASGNS=!/];PRINT NUMBER OF ASSIGNMENTS IN SEL ASGNSF ;DECIMAL CALL INTPD NXTLIN TTOS [SIXBIT /ATTRIBUTES=!/] REFRSH AC1 SEL ATRSF ;PRINT ATTRIBUTES AS OCTAL WORD CALL ADRPR NXTLIN REFRSH AC1 SEL FRMLF MOVE R,AC1 REFRSH AC1 SEL LCLF ADDI R,1(AC1) ;R_NO. OF LCLS+FORMLS+PROCID REFRSH AC1 MOVE AC1,(AC1) ;GET BASE ADR OF BLOCK IN AC1 ADDI AC1,4 ;AC1_ADR OF PROCID MOVN R,R ;NEGATE R HRL AC1,R SAVE <AC2> ;SAVE ANOTHER ACCUMULATOR LOOP7: MOVE AC2,(AC1) ;GET A PROCID,FORML,OR LCL SAVE <AC1> HLRZ AC1,AC2 ;PUT RELADR OF ID IN AC1 AND PRINT CALL IDPR TTOI COMMA ;AFTER SAVING AOBJN POINTER ON STCK HRRZ AC1,AC2 ;PRINT FORMAL PARAMETER TRZE AC1,400000 ;NOTICE WHETHER CALL-BY-REF BIT IS ON MSG <CALL-BY-REF,> CALL INTPD ;IN DECIMAL NXTLIN RESTOR <AC1> ;RESTORE AOBJN POINTER TO AC1 AOBJN AC1,LOOP7 ;GO AROUND IF MORE LEFT MOVE R,AC1 ;SAVE POINTER IN R RESTOR <AC2,AC1> ;RESTORE ACCUMULATORS SAVE <AC1,AC2> ;REGENERATE ORIGINAL AC1 AND AC2
SEL ASGNSF ;GET NUMBER OF ASSIGMENTS JUMPE AC1,LOOP8X ;EXIT IF NO ASSIGNMENTS MOVN AC1,AC1 ;NEGATE AC1 HRL R,AC1 ;CREATE AOBJN POINTER IN R MOVE AC1,R LOOP8: MOVE AC2,(AC1) ;AC1_ASGN WORD SAVE <AC1> ;SAVE AOBJN POINTER HLRZ AC1,AC2 CALL INTPD TTOI COMMA ;PRINT ASSIGNMENTS HRRZ AC1,AC2 CALL INTPD NXTLIN RESTOR <AC1> ;RESTORE AOBJN POINTER TO AC1 AOBJN AC1,LOOP8 ;GO AROUND IF MORE LOOP8X: RESTOR <AC2,AC1> ;RESTORE ACCUMULATORS EXIT ;AND EXIT
PLINE: SAVE <AC1> CALL HEAD0 ;PRINT HEADER INFORMATION SEL WLF ;SELECT WORD LENGTH FIELD MOVN R,AC1 ;R_ -WLENGTH REFRSH AC1 MOVE AC1,(AC1) ;GET BASE ADR OF BLOCK BODY I DZ HRL AC1,R ;PUT IN WLENGTH AOBJN AC1,.+1 ;SET UP AOBJN POINTER AOBJP AC1,LOOP9X ;TO START ENUMERATING AT THIRD WORD LOOP9: SAVE <AC1> ;SAVE AOBJN POINTER MOVE AC1,(AC1) ;GET LEXEME I AC1 CALL LEXPR ;PRINT LEXEME NXTLIN RESTOR <AC1> ;GET AOBJN POINTER BACK AOBJN AC1,LOOP9 LOOP9X: RESTOR <AC1> ;GO AROUND IF MORE ELSE EXIT ;RESTORE ACC AND EXIT PLSB: SAVE <AC1> SEL WLF ;SELECT WLENGTH FIELD MOVN R,AC1 ;R _ -WLENGTH REFRSH AC1 MOVE AC1,(AC1) HRL AC1,R ;SET UP AOBJN POINTER FOR AOBJN AC1,.+1 ;ENUMERATING LSB SAVE <AC2> LOOP10: SAVE <AC1> ;SAVE AOBJN POINTER MOVE AC2,(AC1) ;GET ITH ENTRYIN LSB HLRZ AC1,AC2 ;PRINT LEFT HALF (LINE NO) IN STANDARD FORM CALL TYPLNO ;CALL PPL ROUTINE TTOI COMMA HRRZ AC1,AC2 ;PRINT RIGHT HALF CALL ADRPR ;AS OCTAL INTEGER (ADDRESS OF LINE) NXTLIN RESTOR <AC1> ;GET BACK AOBJN POINTER AOBJN AC1,LOOP10 ;GO AROUND IF MORE LINES RESTOR <AC2,AC1> ;ELSE RESTORE ACCUMULATORS EXIT ;AND EXIT
PTLINE: SAVE <AC1> SEL WLF ;SELECT WLENGTH FIELD MOVN R,AC1 ;SET UP AOBJN POINTER FOR ENUMERATION REFRSH AC1 ;IN AC1 MOVE AC1,(AC1) HRL AC1,R AOBJN AC1,.+1 ;PRINT EACH WORD BOTH IN BYTE FORMAT AND IN ASCII FOR CLARITY LOOP11: SAVE <AC1,AC2,AC3> MOVE AC2,(AC1) ;GET A LINE (WORD) TO BE PRINTED MOVE AC3,[POINT 7,AC2] ;PREPARE TO UNPACK 5 ASCII BYTES LP11A: ILDB AC1,AC3 ;GET A BYTE CALL OCTPRT ;CONVERT TO SIXBIT DIGIT STRING MOVS R,R ;PUT IN LH AND APPEND ,! HRRI R,(SIXBIT/,!/) TTOS R ;PRINT THIS BYTE IN OCTAL TLNE AC3,760000 ;SKIP IF OUT OF BYTES JRST LP11A ;NO, GO BACK FOR AOTHER RESTORE <AC3,AC2,AC1> TTOS [SIXBIT/ = !/] ;NOW PRINT IN ASCII MOVE R,(AC1) SETZ R2, ;APPEND ZERO FOR TERMINATOR TTOA R NXTLIN ;ADVANCE TO NEW LINE AOBJN AC1,LOOP11 ;LOOP BACK IF ANY MORE LINES RESTORE <AC1> EXIT PLOGIC: SAVE <AC1> SEL WLF ;GET WLENGTH MOVN R,AC1 REFRSH AC1 ;SET UP AOBJN POITER TO MOVE AC1,(AC1) ;ENUMERATE LOGIC WORDS IN LOGIC BLCOK HRL AC1,R AOBJP AC1,LP12X LOOP12: SAVE <AC1> ;SAVE AOBJN POINTER HLRZ AC1,(AC1) ;PRINT LEFT HALF WORD IN OCTAL CALL ADRPR TTOI COMMA REFRSH AC1 HRRZ AC1,(AC1) ;PRINT RIGHT HALF WORD IN OCTAL CALL ADRPR NXTLIN RESTOR <AC1> ;GET BACK AOBJN POINTER AOBJN AC1,LOOP12 ;GO AROUND IF MORE TO PRINT LP12X: RESTOR <AC1> ;ELSE RESTORE AND EXIT EXIT
PIOB: SAVE <AC2,AC1> SEL BFSF ;SELECT BUFFER SIZE FIELD MSG BUF SIZ= CALL INTPD ;PRINT IN DECIMAL REFRSH AC1 SEL FCBF ;SELECT FILE CHANNEL BLOCK FIELD MSG <,FCB=> CALL ADRPR ;PRINT IN OCTAL NXTLIN ;ADVANCE TO NEXT LINE REFRSH AC1 HRRZ AC1,(AC1) ;GET DZADR OF IOB MOVEI AC2,3(AC1) ;GET PTR TO FIRST RING BUFFER CALL BUFPNT ;PRINT INFORMATION HRRZ AC2,(AC2) ;GET OTHER BUFFER CALL BUFPNT ;PRINT INFORMATION RESTOR <AC1,AC2> EXIT BUFPNT: MSG BFR STAT= HLRZ AC1,-1(AC2) ;GET LH OF IOS WORD CALL ADRPR ;PRINT IN OCTAL MSG <,> HRRZ AC1,-1(AC2) ;GET RH OF IOS WORD CALL ADRPR ;PRINT IN OCTAL NXTLIN ;ADVANCE TO NEXT LINE MSG USE= LDB AC1,[POINT 1,(AC2),0] ;GET USE BIT CALL INTPR ;PRINT IT MSG <,SIZE=> LDB AC1,[POINT 17,(AC2),17] ;GET BUFFER SIZE FIELD CALL INTPD ;PRINT IT IN DECIMAL MSG <,OTHER BFR=> HRRZ AC1,(AC2) ;GET ADR OF OTHER BUFFER CALL ADRPR ;PRINT IN OCTAL NXTLIN ;ADVANCE TO NEXT LINE MSG MISC= HLRZ AC1,1(AC2) ;GET MISC BOOKKEEPING BITS CALL ADRPR ;PRINT IN OCTAL MSG <,WRDS=> HRRZ AC1,1(AC2) ;GET BUFFER WORD COUNT CALL INTPD ;PRINT IN DECIMAL TTOA [ASCIZ/ *DATA WORDS* /] RETURN
;PRINT FILE CHANNEL BLOCK WHOSE ADDRESS IS IN AC1 (VIA PFCB) FCBPR: SAVE <OFILE,R,R2,AC2,AC1> SETZM OFILE ;ENSURE OUTPUT TO TTY CALL ADRPR ;PRINT FCB ADDRESS AMSG < FILPZA > MOVE AC2,AC1 ;PROTECT FCB ADR HLRZ AC1,FILPZA(AC2) ;GET TYPE FIELD ASH AC1,1 ;CONVERT TO NORMAL INTERNAL NAME ADDI AC1,1 CALL IDPR ;PRINT AS ID MSG <,,> HRRZ AC1,FILPZA(AC2) ;FETCH PZADR OF I/O BUFFER BLOCK CALL ADRPR ;PRINT IN OCTAL NXTLIN ;ADVANCE TO NEXT LINE AMSG <FILDEV > MOVE AC1,FILDEV(AC2) ;FETCH DEVICE NAME CALL SIXBP ;PRINT IT NXTLIN AMSG <FILNAM > MOVE AC1,FILNAM(AC2) ;FETCH FILE NAME CALL SIXBP ;PRINT IT NXTLIN HLLZ AC1,FILEXT(AC2) ;FETCH EXTENSION AMSG <FILEXT > CALL SIXBP MSG <,,> HRRZ AC1,FILEXT(AC2) ;FETCH STATUS BITS CALL ADRPR ;PRINT IN OCTAL TTOI "=" TRNE AC1,FS.EOF ;NOW INDIVIDUAL BITS IN SYMBOLIC MSG <EOF,> TRNE AC1,FS.TTY MSG <TTY,> TRNE AC1,FS.OUT MSG <OUT,> TRNE AC1,FS.DSK MSG <DSK,> ANDI AC1,17 ;MASK CHANNEL NUMBER MSG <CH=> CALL OCTPR9 ;PRINT IN OCTAL NXTLIN AMSG <FILPPN > FWPR FILPPN(AC2) ;PRINT PROJ,,PROG NXTLIN AMSG <FILHDP > FWPR FILHDP(AC2) ;PRINT BUFFER POINTER NXTLIN AMSG <FILPTR > FWPR FILPTR(AC2) ;PRINT BYTE POINTER NXTLIN AMSG <FILCTR > MOVE AC1,FILCTR(AC2) CALL INTPD ;PRINT BYTE COUNT IN DECIMAL NXTLIN AMSG <FILPOS > MOVE AC1,FILPOS(AC2) CALL INTPD ;PRINT FILE POSITION IN DECIMAL NXTLIN RESTOR <AC1,AC2,R2,R,OFILE> EXIT
PCVAL== PLOGIC ;BODY IS SAME AS THAT FOR PLOGIC ;THE FOLLOWING ROUTINES PRINT THE ATOMIC VALUES FOR INTEGERS, ;ADDRESSES,REALS,DOUBLES,CHARACTERS AND BOOLEANS. ;AC1 OR AC1 AND AC2 (IN THE CASE OF DOUBLES) CONTAINS THE ARGUMENT ;TO BE PRINTED SIXBP: SKIPA R,AC1 ;HERE TO PRINT SIXBIT STRING IN AC1 ;NOTE - ;WE CALL ROUTINES IN PRINT.MAC FOR MOST ATOMS ADRPR: CALL OCTPRT ;CONVERTS NUMBER IN AC1[RH] MOVSI R2,(SIXBIT /!/) ;TO RIGHT JUSTIFIED SIXBIT IN R TTOS R ;OUTPUT IN SIXBIT RETURN ;PRINT 3-DIGIT (9 BIT) OCTAL NUMBER OCTPR9: CALL OCTPRT ;CONVERT TO SIXBIT DIGIT STRING MOVSI R,(R) ;PUT 3 DIGITS IN LH HRRI R,(SIXBIT/!/) ;TERMINATE TTOS R ;PRINT RETURN
DEFINE GET(S) ;MACRO TO GET BYTE OUT FOR USE <LDB AC1,P'S> ;PUT THE BYTE IN AC1 ;ROUTINE TO PRINT LEXEMES PASSED IN AC1 LEXPR:: SAVE <AC1,AC2,AC6,R,R2> MOVE AC6,AC1 JUMPE AC6,LXNUL ;PRINT 'NULL' IF LEXEME BLANK MSG FWDCHN= GET FWDCHN ;BYTE POINTER INTO LEXEME CALL OCTPR9 ;PRINT IN OCTAL MSG <,ACTION=> GET ACTION ;BYTE POINTER INTO ACT FIELD MOVE R,IACTS(AC1) ;INDEX FOR NAME OF ACTION MOVSI R2,(SIXBIT/!/) ;PRINT ROUTINE FROM BEFORE TTOS R MSG <,LXTYP=> MOVE AC2,AC1 ;REMEMBER ACTION FIELD GET LXTYP ;FETCH LEXEME TYPE FIELD CALL OCTPRT ;CONV TO OCTAL SIXBIT STRING IN R CAILE AC2,UNOP ;STAK,UNOP,OR BINOP? SKIPA AC1,MINUS1 ;NO, SET LEXEME TYPE TO -1 MOVE R,LXPNS(AC1) ;YES, FETCH PRINTNAME MOVSI R2,(SIXBIT/,!/) ;ADD COMMA AND TERMINATE TTOS R ;PRINT MOVE R,AC1 ;REMEMBER LX TYPE HRRZ AC1,AC6 ;FETCH VALUE FIELD XCT LX(R) ;OUTPUT VALUE IN APPROPRIATE FORMAT LXPRX: RESTOR <R2,R,AC6,AC2,AC1> RETURN LXNUL: TTOS [SIXBIT/NULL LXM!/] JRST LXPRX
;ROUTINE TO PRINT A SYNTAX TOKEN ;TAKES ADDRESS OF TOKEN IN AC1 AS ARGUMENT TOKPR: SAVE <AC1,AC2,AC3> ;SAW IT DONE BEFORE MOVE AC2,AC1 ;MOVE ADDR TO AC2 FOR BPTR MOVSI AC3,(POINT 9,(AC2)) MSG BEGPT= ILDB AC1,AC3 ;GETS FIRST BYTE OF TOKEN IN AC2 CALL OCTPR9 ;PRINT IN OCTAL MSG <,ENDPT=> ILDB AC1,AC3 ;GET ENDPTR CALL OCTPR9 MSG <,CNTR=> ILDB AC1,AC3 ;GET COUNTER FIELD CALL INTPD MSG <,STATE=> ILDB AC1,AC3 ;GET STATE FIELD CALL INTPD RESTOR <AC3,AC2,AC1> RETURN ;ROUTINE TO PRINT POSTFIX CHAIN ;TAKES ADDRESS OF SYNTAX TOKEN IN AC1 AS ARG CHNPR: SAVE <AC1,AC2,AC3,AC4,AC5,AC6> MOVSI AC5,(POINT 9,(AC1)) ;BUILD POINTER FROM ADDRESS ILDB AC3,AC5 ;GET BEGPT IN AC3 ILDB AC4,AC5 ;GET ENDPT IN AC4 MOVE AC1,LXMBUF(AC3) ;GET NEXT LEXEME IN AC1 FOR CALL MSG SYNTAX CHAIN= TTOS [SIXBIT/#/] PUSHJ P,LEXPR ;GO PRINT LEXEME LUUP: CAMN AC3,AC4 ;COMPARE FOR LAST IN CHAIN JRST REST MOVE AC6,LXMBUF(AC3) ;GET CURRENT LEXEME IN AC6 GET FWDCHN ;GET REL PTR TO NEXT LEX IN AC1 MOVE AC3,AC1 ;SAVE ADDR OF THIS LEXEME MOVE AC1,LXMBUF(AC3) ;NEXT LEXEME IN AC3 FOR CALL TTOS [SIXBIT/#/] PUSHJ P,LEXPR ;PRINT NEXT LEXEME JRST LUUP REST: RESTOR <AC6,AC5,AC4,AC3,AC2,AC1> POPJ P,
;PRINT EXTENDED HALFWORD DECIMAL INTEGER EHPD: HRRE AC1,AC1 ;EXTEND SIGN ;PRINT A FULL-WORD SIGNED DECIMAL INTEGER INTPD: CALL INTPR ;CALL DECIMAL INTEGER PRINT ROUTINE TTOI "." ;PRINT PERIOD TO SIGNAL DECIMAL RETURN
ENUMA: PUSH P,ZERO ;ENUMERATE ALL DATA IN DZ JRST .+2 ;INCLUDING GARBAGE ENUM: PUSH P,MINUS1 ;SIGNAL TO ENUMERATE ONLY NON-GARBAGE SAVE <AC1,AC2> ;ROUTINE TO ENUMERATE DATA IN DZ TTOI 014 MOVE AC2,PZBEG SUB AC2,PZEND ;AC2_NEG LENGTH OF PZ+1 HRLZI AC1,-1(AC2) ;AOBJN POINTER IN AC1=[-LENGTH,PZADR] HRR AC1,PZBEG ENUM1: MOVE AC2,(AC1) ;AC2_RH OF PZWORD TLNN AC2,-1 ;SEE IF POINTER TO DZ OR NOT JRST ENUM2 CALL DBGPRT ;PRINT DATUM IF WAS PTR TO DZ ENUM4: AOBJN AC1,ENUM1 ;GO AROUND IF MORE RESTOR <AC2,AC1> POP P,(P) ;THROW FLAG AWAY RETURN ENUM2: SKIPN -2(P) CAMGE AC2,DZBEG ;DOES IT ADDRESS DZ? JRST ENUM4 CALL ADRPR ;PRINT ADDRESS IN PZ TTOI TAB TTOS [SIXBIT /GARBAGE !/] HLRZ AC2,(AC2) ;GET ITS LENGTH AND PRINT IT EXCH AC1,AC2 CALL INTPD EXCH AC1,AC2 TTOA [BYTE(7)CR,LF,LF] JRST ENUM4
; TABLE OF CONSTANTS COMMA=="," TAB==011 CR==015 LF==012 COLON==072 TWOONE: XWD 2,1 ;CONSTANT FOR FORMING AOBJN POINTER PATCH:: BLOCK 300 ;REGION FOR PLAYING AROUND END



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