'HEAD' EXPLODED LIST ROUTINES C EDIT DATE 10DEC78 21:05 C SOURCE FILE CDIAGAJH.FS C AUTHOR A. J. HOWARD/J.H.PERINE C CLUSTER 27 'OUTFILE' LISTAJH.FR SUBROUTINE LIST (FUNC, ARG1, ARG2) INTEGER FUNC, ARG1, ARG2 'INCLUDE' CTRLAJH.IN, EXTERNAL OLLST 'IF' (LISTF .NE. 0 .AND. PRINTF .NE. 0) CALL OVLOD (OLLST) CALL OLIST (FUNC, ARG1, ARG2) 'ENDIF' RETURN END 'OUTFILE' OLISTAJH.FR N OVERLAY OLLST SUBROUTINE OLIST (FUNC, ARG1, ARG2) INTEGER FUNC, ARG1, ARG2 INTEGER CONST (2), LISTA (2), LISTX (3), LISTY (3) INTEGER FCEND (2), RREF (2) INTEGER CLOCN, NLOPS EXTERNAL CLOCN, NLOPS 'INCLUDE' LOGOSAJH.IN, 'INCLUDE' LISTCMAJH.IN, 'INCLUDE' LSDATAJHP.IN, 'INCLUDE' NLNAMEFTM.IN, 'INCLUDE' NLISTCFTM.IN, 'INCLUDE' PRTCOMFTM.IN, 'INCLUDE' SRCXDFFTM.IN, 'INCLUDE' WFLAGSJHP.IN, 'INCLUDE' CRUCOMJHP.IN, LOGICAL NLTEST DATA CONST / '"X" '/ DATA LISTA / 'AREG' / DATA LISTX / ', XREG' / DATA LISTY / ', YREG' / DATA FCEND / '....' / DATA RREF / '****' / ASSIGN 1 TO LRET C SWITCH ON FUNCTION CODE GO TO (100, 200, 250, 300, 350, 400, 450, 500), FUNC C COMMON EXIT 1 RETURN 'EJECT' C LIST OBJECT WORD (ARG1) AND WORD FLAG (ARG2) 100 'IF' (ARG2 .LE. 0) C BAD WORD FLAG ARG2 = 1 CALL EST (RREF, LINE, 31, 34) LINEX = 35 GO TO 1490 'ENDIF' GO TO (1100, 1200, 1300, 1400, 1400, ^ 1500, 1600, 1400, 1700, 1, ^ 1, 1800, 1900, 1, 1, ^ 1, 1), ARG2 C CONSTANT VALUE, WORD FLAG 1 1100 'IF' (NOTINQ .OR. ARG1 .EQ. 0) CALL EST ('00', LINE, 27, 27) CALL EHX (ARG1, LINE, 28, 29) 'ELSE' CALL PCHAR (CONST, 2, ARG1) CALL EST (CONST, LINE, 27, 29) 'ENDIF' GO TO 1490 C TEST LABEL, WORD FLAG 2 1200 IF (LENTER) GO TO 350 GO TO 1 C FLOWCHART END, WORD FLAG 3 1300 CALL EST (FCEND, LINE, 19, 22) GO TO 900 'EJECT' C ENTER FUNCTION CODE, WORD FLAG 4, 5, 8 1400 CALL EHX (ARG1, LINE, 19, 21) C GET ASCII OP CODE & MISC INFO LX = ARG1 * 2 + 1 TABNR = ISHFT (LINSTR (LX), -8) TABX = IAND (LINSTR (LX), 255) LMODE = LINSTR (LX+1) LTIME = IAND (LMODE, 127) IF ( TABX .LE. 0 ) GO TO 1450 IF ( TABNR .LE. 0 .OR. TABNR .GT. 4 ) GO TO 1450 GO TO (1410, 1420, 1430, 1440), TABNR C IMPLIED 1410 CALL EST (IMPLID (TABX), LINE, 23, 26) GO TO 1460 C RELATIVE 1420 CALL EST (RELTIV (TABX), LINE, 23, 26) GO TO 1460 C GROUP1 1430 CALL EST (GROUP1 (TABX), LINE, 23, 26) GO TO 1450 C OTHERS 1440 CALL EST (OTHERS (TABX), LINE, 23, 26) IF ( IAND (LMODE, 16384) .NE. 0) CALL EST (LISTA,LINE,31,34) C SET FLAGS & MISC 1450 'IF' ( IAND (LMODE, 1024) .NE. 0 ) INDXFL = 1 'ELSE' 'IF' ( IAND (LMODE, 512) .NE. 0 ) INDXFL = 2 'ELSE' INDXFL = 0 'ENDIF' 'ENDIF' 'IF' ( IAND (LMODE, 4096) .NE. 0 ) CALL EST ('ZP', LINE, 65, 66) 'ELSE' 'IF' ( IAND (LMODE, 2048) .NE. 0 ) CALL EST ('AB', LINE, 65, 66) 'ELSE' 'IF' ( IAND (LMODE, 8192) .NE. 0) CALL EST ('IM', LINE, 65, 66) CALL EST (' =', LINE, 29, 30) 'ENDIF' 'ENDIF' 'ENDIF' 'IF' ( IAND (LMODE, 256) .NE. 0 ) CALL EST (' @', LINE, 29, 30) CALL EST ('IN', LINE, 69, 70) 'ENDIF' C CYCLES 1460 CALL ESP (LTIME, LINE, 58, 58) IF ( IAND (LMODE, 128) .NE. 0 ) CALL EST ('* ',LINE,59,60) IF (ARG2 .NE. WF4) GO TO 1 IF ( LINEX .LT. 31 ) LINEX = 31 C FINISH THE LINE FOR MULTI-PART OPCODES 1490 'IF' (OFFSET .LT. 0) CALL ESP (OFFSET, LINE, LINEX, LINEX+5) LINEX = LINEX + 6 'ELSE' 'IF' (OFFSET .GT. 0) CALL EST ('+ ', LINE, LINEX, LINEX) CALL ESP (OFFSET, LINE, LINEX+1, LINEX+5) LINEX = LINEX + 6 'ENDIF' 'ENDIF' 'IF' ( INDXFL .EQ. 1 ) CALL EST (LISTX, LINE, LINEX, LINEX+5) 'ELSE' 'IF' ( INDXFL .EQ. 2 ) CALL EST (LISTY, LINE, LINEX, LINEX+5) 'ENDIF' 'ENDIF' IF ( INDXFL .NE. 0 ) LINEX = LINEX + 2 INDXFL = 0 OFFSET = 0 GO TO 900 'EJECT' C CONSTANT OFFSET, WORD FLAG 6 1500 OFFSET = OFFSET + ARG1 GO TO 1 C NAME LIST REFERENCE, WORD FLAG 7 1600 IF (ARG1 .LT. 0) CALL EST (' @', LINE, 29, 30) LN = IAND (ARG1, 32767) IF (NLTEST (LN, CBIT)) CALL EST (' =', LINE, 29, 30) 1620 LINEX = CLOCN (LN) + 30 CALL EST (NAME, LINE, 31, LINEX) LINEX = LINEX + 1 GO TO 1490 C TRANSFER LIST REFERENCE, WORD FLAG 9 1700 CALL EHX (ARG1, LINE, 31, 33) CALL EST ('TL', LINE, 34, 35) LINEX = 36 GO TO 1490 C WORD FLAG 12 C (' <', LINE, 29, 30) 1800 CALL EST (8252, LINE, 29, 30) LN = ARG1 GO TO 1620 C WORD FLAG 13 1900 CALL EST (' >', LINE, 29, 30) LN = ARG1 GO TO 1620 'EJECT' C TRANSFER LIST LABEL 200 ASSIGN 210 TO LRET IF (LENTER) GO TO 350 210 LENTER = .TRUE. CALL EHX (ARG1, LINE, 1, 3) CALL EST ('TL', LINE, 4, 5) GO TO 1 C LIT POOL START 250 GO TO 1 C LABEL DEFINITION 300 ASSIGN 310 TO LRET IF (LENTER) GO TO 350 310 LENTER = .TRUE. LN = CLOCN (ARG1) CALL EST (NAME, LINE, 1, LN) GO TO 1 C MOVE PRINT 350 CALL EST ('.BLK', LINE, 19, 22) CALL EST ('0 ', LINE, 31, 31) GO TO 900 C LIST BSS 400 CALL EST ('.BLK', LINE, 19, 22) CALL ESP (ARG1, LINE, 31, 35) GO TO 900 'EJECT' C LIST EXTERNAL EQUATE 450 ASSIGN 460 TO LRET IF (LENTER) GO TO 350 460 LN = CLOCN (ARG1) CALL EST (NAME, LINE, 1, LN) IF (ARG2 .NE. 0) LN = CLOCN (ARG2) CALL EST ('= ', LINE, 19, 20) ASSIGN 1 TO LRET GO TO 800 C CONSTANT EQUIVALANCE 500 ASSIGN 510 TO LRET IF (LENTER) GO TO 350 510 LN = CLOCN (ARG1) CALL EST (NAME, LINE, 1, LN) CALL EST ('= ', LINE, 19, 20) LN = NLOPS (CVALUE, ARG2) CALL ESP (LN, LINE, 31, 36) CALL EHX (LN, LINE, 38, 42) ASSIGN 1 TO LRET GO TO 900 C LIST UTILITY 800 CALL EST (NAME, LINE, 31, 46) C MOVE LINE SUBROUTINE 900 CALL EHX (LC, LBUF, 1, 4) CALL EST (',,', LBUF, 5, 5) CALL EHX (LCI, LBUF, 6, 6) CALL EST (LINE, LBUF, 9, 88) CALL SET (' ', LINE, 40) LENTER = .FALSE. LINEX = 31 CALL SGLPRT GO TO LRET END 'HEAD' DUMP STACK FOR BUILD POLISH 'OUTFILE' DUMSTFTM.FR SUBROUTINE DUMST (CALLER) 'INCLUDE' CTRLAJH.IN, INTEGER CALLER (2) EXTERNAL OLDUM IF (DUMFLG .EQ. 0 .OR. CTLUSE .NE. 0) RETURN CALL OVLOD (OLDUM) CALL ODUMS (CALLER) RETURN END 'OUTFILE' ODUMSFTM.FR N OVERLAY OLDUM SUBROUTINE ODUMS (CALLER) 'INCLUDE' LOGOSAJH.IN, 'INCLUDE' REGSJHP.IN, 'INCLUDE' STKDEFA.IN, 'INCLUDE' STKDEFB.IN, 'INCLUDE' STKDEFC.IN, 'INCLUDE' STKDEFD.IN, 'INCLUDE' STKDEFE.IN, 'INCLUDE' STKDEFF.IN, 'INCLUDE' NLNAMEFTM.IN, 'INCLUDE' PRTCOMFTM.IN, INTEGER CALLER (2) INTEGER DSS, DSX, DSM (7), DSO (45) INTEGER II, JJ, NOSTR (6), ACTSTR (4), ASTSTR INTEGER CLOCN DATA NOSTR /' NEXT OP '/ DATA ACTSTR /' ACTIVE'/ DATA ASTSTR /'**'/ DATA DSM /'SPDPSTHX '/ DATA DSO /' , ; . :FODOWH', ^ 'RBLBRE $ ( ) [ ] = # >>=', ^ 8252, ^ // ' <' 15421, ^ // '<=' '-> + - * /MDR!R&ORXO &LSRSLCRCALARNE', ^ 8286, ^ // ' ^' 'DECOLO'/ CALL ESP (OPX, LBUF, 1, 6) CALL ESP (NEXTX, LBUF, 7, 12) CALL ESP (TOPX, LBUF, 13, 18) CALL EST (CALLER, LBUF, 30, 33) CALL SGLPRT II = 1 'DOLOOP' DSX = 1, NRREGS CALL ESP (STATUS (DSX), LBUF, II, II + 5) II = II + 6 'END' CALL SGLPRT CALL EST (NOSTR, LBUF, 1, 11) CALL EST (DSO (NEXTOP + 1), LBUF, 12, 13) CALL EST (ACTSTR, LBUF, 15, 21) CALL ESP (ACTLO, LBUF, 23, 28) CALL ESP (ACTHI, LBUF, 30, 35) CALL SGLPRT 'EJECT' 'DOLOOP' DSX = 1, STKSIZ N = NAMEX (DSX) 'IF' (N .EQ. 0) 'NEXT' 'ENDIF' CALL ESP (DSX, LBUF, 1, 2) IF (DSX .EQ. OPX ) CALL EST ('XX', LBUF, 3, 3) IF (DSX .EQ. NEXTX) CALL EST ('NN', LBUF, 4, 4) IF (DSX .EQ. TOPX ) CALL EST ('TT', LBUF, 5, 5) JJ = CLOCN (N) CALL EST (NAME, LBUF, 7, 21) N = SUBX (DSX) 'IF' (N .NE. 0) JJ = CLOCN (N) CALL EST (NAME, LBUF, 23, 38) 'ENDIF' CALL ESP (BIAS (DSX), LBUF, 40, 44) JJ = MODE (DSX) + 1 CALL EST (DSM (JJ), LBUF, 46, 47) IF (LOCFLG (DSX) .NE. 0) ^ CALL EST ('LL', LBUF, 48, 48) JJ = SUBXM (DSX) + 1 CALL EST (DSM (JJ), LBUF, 50, 51) JJ = IAND (OSTACK (DSX), 63) + 1 CALL EST (DSO (JJ), LBUF, 53, 54) CALL EHX (OPCODE (DSX), LBUF, 56, 58) CALL ESP (WFOP (DSX), LBUF, 60, 62) CALL ESP (WFOPND (DSX), LBUF, 64, 66) CALL EHX (SUBOP (DSX), LBUF, 68, 70) CALL ESP (WFSOP (DSX), LBUF, 71, 73) CALL ESP (SUBXB (DSX), LBUF, 75, 79) CALL SGLPRT 'END' CALL SGLPRT RETURN END 'OUTFILE' REGOUTAPB.FR C EDIT DATE 10DEC78 21:07 C SOURCE FILE REGAPB.FS C AUTHOR A.P. BUCHALTER C CLUSTER C PRINT OUT THE REGISTER CONTENTS SUBROUTINE REGDMP (FLAG) 'INCLUDE' NLNAMEFTM.IN, 'INCLUDE' RMCOMJHP.IN, 'INCLUDE' CTRLAJH.IN, 'INCLUDE' PRTCOMFTM.IN, INTEGER FLAG INTEGER CLOCN INTEGER REG, L IF (DUMFLG .EQ. 0) RETURN CALL EST('REGDMP', LBUF, 1, 6) CALL ESP (FLAG, LBUF, 1, 12) CALL SGLPRT 'DOLOOP' REG = 1, 11 'IF' (ACADDR(REG) .NE. 0) CALL ESP(REG, LBUF, 1, 2) L = CLOCN(ACADDR(REG)) CALL EST(NAME, LBUF, 4, 19) CALL ESP(ACTYPE(REG), LBUF, 21, 23) 'IF' (ACSUBS(REG) .NE. 0) L = CLOCN(ACSUBS(REG)) CALL EST(NAME, LBUF, 26, 41) CALL ESP(ACSBTY(REG), LBUF, 43, 45) 'ENDIF' CALL ESP(ACBIAS(REG), LBUF, 47, 50) CALL SGLPRT 'ENDIF' 'END' END