C File name: UNMAC2.FOR !Rev 8303.091 C C********************************************************************** C SUBROUTINE PASS 2 !Rev 8302.071 C C On pass 2, finish the disassembly process C IMPLICIT INTEGER (A-Z) C C------------------------------ COMMONS ------------------------------ C COMMON /PSECT2/ N CUR PS, N OLD PS, CUR PS(8), PS LOC(100) BYTE CUR PS COMMON /RLD/ NRLD,NRPTR,NPOFF(50),NBOFF(50),NRBUFF(512) BYTE NRBUFF COMMON /TXT/ N TXT, LOC TXT, TXT(256), INST PS, N TXT OF LOGICAL INST PS C D COMMON /DEBUG/ DEBUG(50) D LOGICAL DEBUG C C------------------------- LOCAL VARIABLES -------------------------- C LOGICAL GOT TXT C C==================================================================== C C BEGIN DEBUG D IF (.NOT.DEBUG(31)) GO TO 1 D CALL CRLF D CALL NEWLIN D CALL OUT TXT (';* * * * * P A S S 2 * * * * *') D CALL CRLF D 1 CONTINUE C END DEBUG C C----------------------- Initialize some stuff ----------------------- C N CUR PS = 0 GOT TXT = .FALSE. N TXT = 0 N RLD = 0 N TXT OF = 0 N OLD PS = 0 DO 2 I=1,100 PS LOC(I) = 0 2 CONTINUE C C----------------------- Find first RLD block ------------------------ C 10 CONTINUE CALL GET BLK CALL RD WORD (TYPE) IF (TYPE.EQ.6) GO TO 600 IF (TYPE.EQ.1) CALL GSD 2 IF (TYPE.NE.4) GO TO 10 CALL RLD 2 C C DEBUG BEGIN D IF (.NOT.DEBUG(31)) GO TO 20 D CALL NEWLIN D CALL OUT TXT (';Found first RLD.') D 20 CONTINUE C DEBUG END C C---------------------- Get the next data block ---------------------- C 40 CALL GET BLK C C Get data block identification code and jump to appropriate C routine to process the data block C CALL RD WORD (CODE) IF (CODE.GE.0 .AND. CODE.LE.6) GO TO 41 CALL NEWLIN CALL OUT TXT (' PASS2: Illegal identification code = ') CALL OUT OCT (CODE) CALL FTL ERR("10,'Data block ident. code out of range') 41 CONTINUE C C BEGIN DEBUG D IF (.NOT.DEBUG(31)) GO TO 50 D IF (CODE.EQ.3 .AND. DEBUG(33)) GO TO 50 D IF (CODE.EQ.4 .AND. DEBUG(34)) GO TO 50 D CALL NEWLIN D IF (CODE.EQ.0) CALL OUT TXT (';Get RSX LIB header') D IF (CODE.EQ.1) CALL OUT TXT (';GSD') D IF (CODE.EQ.2) CALL OUT TXT (';ENDGSD') D IF (CODE.EQ.3) CALL OUT TXT (';TXT') D IF (CODE.EQ.4) CALL OUT TXT (';RLD') D IF (CODE.EQ.5) CALL OUT TXT (';ISD') D IF (CODE.EQ.6) CALL OUT TXT (';ENDMOD') D CALL OUT TXT (' - Pass 2') D 50 CONTINUE C END DEBUG C GO TO (40,100,40,300,400,40,600), CODE+1 C C------------------- GSD - Global symbol directory -------------------- C 100 CALL GSD 2 GO TO 40 C C---------------- TXT - Binary text information block ----------------- C 300 IF (GOT TXT) CALL BUILD CALL TXT 2 GOT TXT = .TRUE. GO TO 40 C C------------------ RLD - Relocation directory block ------------------- C 400 CALL RLD 2 IF (GOT TXT) CALL BUILD GOT TXT = .FALSE. GO TO 40 C C-------------------- ENDMOD - End of object module ------------------ C 600 IF (GOT TXT) CALL BUILD CALL CRLF C RETURN END SUBROUTINE GSD 2 !Rev 8302.031 C C GSD - Get global symbol directory information for pass 2 C (See subroutine GSD 1 in UNMAC1.FOR for more complete comments.) C IMPLICIT INTEGER (A-Z) C C---------------------------- COMMONS --------------------------------- C COMMON /PSECT2/ N CUR PS, N OLD PS, CUR PS(8), PS LOC(100) BYTE CUR PS COMMON /RECORD/ LEN, NXT CHR, RECORD(256) BYTE RECORD C D COMMON /DEBUG/ DEBUG(50) D LOGICAL DEBUG C C--------------------- LOCAL VARIABLES AND DATA ---------------------- C LOGICAL PS OUT INTEGER NRAD50(2) BYTE NAME(7) DATA BIT3,BIT5 /"10,"40/ C C====================================================================== C------------------- Get the next GSD record -------------------------- C 100 CALL RD NAME (NAME,NRAD50) CALL RD BYTE (FLAGS) FLAGS = FLAGS .AND. "377 CALL RD BYTE (TYPE) CALL RD WORD (VALUE) C C BEGIN DEBUG D IF (.NOT.DEBUG(32)) GO TO 101 D CALL NEWLIN D CALL OUT TXT (';GSD 2: ') D CALL OUT TXT ('; Type = ') D CALL OUT OCT (TYPE) D CALL OUT TXT ('; Value = ') D CALL OUT OCT (VALUE) D CALL OUT TXT ('; Flags = ') D CALL OUT BYT (FLAGS) D CALL OUT TXT ('; Name = ') D CALL OUT TXT (NAME) D 101 CONTINUE C END DEBUG C IF (TYPE.GE.0 .AND. TYPE.LE.7) GO TO 102 CALL NEWLIN CALL OUT TXT ('GSD 2: Illegal entry type = ') CALL OUT OCT (TYPE) CALL FTL ERR ("11,'GSD entry type out of range') 102 CONTINUE C IF (TYPE .NE. 5) GO TO 190 C C----------------- TYPE 5: Program section name ----------------------- C 150 CONTINUE DO 152 I=1,7 CUR PS(I) = NAME(I) 152 CONTINUE PS OUT = .FALSE. C C------------------------- All types go here -------------------------- C 190 IF (LEN .GT. 0) GO TO 100 C RETURN END SUBROUTINE TXT 2 !Rev 8302.031 C IMPLICIT INTEGER (A-Z) C C------------------------------ COMMONS ---------------------------- C COMMON /MACRO/ MACRO LOGICAL MACRO COMMON /PSECTS/ NPSECT,PSNAME(2,100),PSFLAG(100),PSVALU(100) BYTE PSFLAG COMMON /PSECT2/ N CUR PS, N OLD PS, CUR PS(8), PS LOC(100) BYTE CUR PS COMMON /RECORD/ LEN, NXT CHR, RECORD (256) BYTE RECORD COMMON /TXT/ N TXT, LOC TXT, TXT(256), INST PS, N TXT OF LOGICAL INST PS C D COMMON /DEBUG/ DEBUG(50) D LOGICAL DEBUG C C==================================================================== C------------------------ LOCAL VARIABLES --------------------------- C BYTE NAME(7) C C-------------------------------------------------------------------- C OLD LOC = PS LOC (N CUR PS) CALL RD WORD (COUNT) IF (N CUR PS .GT. 100) 1 CALL FTL ERR (26,'N CUR PS out of range in TXT 2') PS LOC (N CUR PS) = COUNT LOC TXT = COUNT C C BEGIN DEBUG D IF (.NOT.DEBUG(33)) GO TO 10 D CALL NEWLIN D CALL OUT TXT (';TXT - Binary text information at ') D CALL R50ASC(6,PSNAME(1,NCURPS),NAME) D CALL OUT TXT (NAME) D CALL OUT TXT ('+') D CALL OUT OCT (COUNT) D 10 CONTINUE C END DEBUG C C------------ Find out if it is an instruction psect ---------------- C I = PSFLAG (N CUR PS) INST PS = (I.AND."200) .EQ. 0 C C------------ If it is a new psect, write its name ------------------ C IF (N CUR PS .EQ. N OLD PS) GO TO 20 CALL R50ASC (6,PSNAME(1,NCURPS),NAME) CALL NEWLIN CALL OUT TXT (' .PSECT ') CALL OUT TXT (NAME) N OLD PS = N CUR PS 20 CONTINUE C C----- If the location counter has moved, output the new pointer ----- C IF (COUNT .EQ. OLD LOC) GO TO 30 CALL NEWLIN CALL OUT TXT ('.=.+') I = COUNT - OLD LOC CALL OUT OCT (I) 30 CONTINUE C C----------------------- Get the text ------------------------------- C 40 CALL RD WORD (TEXT) C C BEGIN DEBUG D IF (.NOT.DEBUG(33)) GO TO 50 D CALL NEWLIN D CALL OUT TXT (';') D CALL OUT OCR (PS LOC (N CUR PS)) D CALL OUT TXT (' ') D CALL OUT OCR (TEXT) D 50 CONTINUE C END DEBUG C 60 PS LOC (N CUR PS) = PS LOC (N CUR PS) + 2 N TXT = N TXT + 1 IF (N TXT .GT. 256) CALL FTL ERR("16,'TXT record > 256 bytes') TXT (N TXT) = TEXT IF (LEN .GT. 1) GO TO 40 IF (LEN .LE. 0) RETURN C C---------------- Process last byte in odd length records ------------- C CALL RD BYTE (TEXT) TEXT = TEXT .AND. "377 GO TO 60 C RETURN END SUBROUTINE RLD 2 !Rev 8302.031 C C RLD - Relocation directory block C IMPLICIT INTEGER (A-Z) C C---------------------------- COMMONS ------------------------------ C COMMON /COMPLX/ NBUF, BUF(100) BYTE BUF COMMON /MACRO/ MACRO LOGICAL MACRO COMMON /PSECTS/ NPSECT,PSNAME(2,100),PSFLAG(100),PSVALU(100) BYTE PSFLAG COMMON /PSECT2/ N CUR PS, N OLD PS, CUR PS(8), PS LOC(100) BYTE CUR PS COMMON /RECORD/ LEN, NXT CHR, RECORD(256) BYTE RECORD COMMON /RLD/ NRLD,NRPTR,NPOFF(50),NBOFF(50),NRBUFF(512) BYTE NRBUFF COMMON /TXT/ N TXT, LOC TXT, TXT(256), INST PS, N TXT OF LOGICAL INST PS C D COMMON /DEBUG/ DEBUG(50) D LOGICAL DEBUG C C-------------------- LOCAL VARIABLES AND DATA ---------------------- C INTEGER NRAD50(2) BYTE NAME(7) DATA MAX RLD /50/, MAXBUF /512/, NAME /7*0/ C C=================================================================== C N RLD = 0 N R PTR = 1 4000 CALL RLD BLK (RELOC,B,TYPE) C C BEGIN DEBUG D IF (.NOT.DEBUG(34)) GO TO 10 D CALL NEWLIN D CALL OUT TXT (';RLD: Type = ') D CALL OUT OCT (TYPE) D CALL OUT TXT ('; Reloc = ') D CALL OUT OCT (RELOC) D IF (B.EQ."102) CALL OUT TXT (' B') D 10 CONTINUE C END DEBUG C IF (TYPE.GE.1 .AND. TYPE.LE."17) GO TO 1 CALL NEWLIN CALL OUT TXT ('RLD 2: Illegal RLD type = ') CALL OUT OCT (TYPE) CALL FTL ERR ("15,'RLD entry type out of range') 1 CONTINUE C GO TO (401,402,403,404,405,406,407,410,411,412,413,414, 1 415,416,417), TYPE C C------ TYPE 1: Internal relocation ----------------------------- C 401 CALL RD WORD (CONST) C C BEGIN DEBUG D IF (.NOT.DEBUG(34)) GO TO 4010 D CALL NEWLIN D CALL OUT TXT ('; Type 1: Substitute #') D CALL OUT OCT (CONST) D4010 CONTINUE C END DEBUG C N RLD = N RLD + 1 IF (N RLD .GT. MAX RLD) GO TO 999 N B OFF (N RLD) = N R PTR CALL R50ASC (6,PSNAME(1,NCURPS),NAME) CALL RLD TXT (NAME) CALL RLD TXT ('+') CALL RLD OCT (CONST) GO TO 480 C C------ TYPE 2: Global relocation ------------------------------- C 402 CALL RD NAME (NAME,NRAD50) CALL SHORTN (NAME) C C BEGIN DEBUG D IF (.NOT.DEBUG(34)) GO TO 4020 D CALL NEWLIN D CALL OUT TXT ('; Type 2: Substitute global #') D CALL OUT TXT (NAME) D4020 CONTINUE C END DEBUG C N RLD = N RLD + 1 IF (N RLD .GT. MAX RLD) GO TO 999 N B OFF (N RLD) = N R PTR CALL RLD TXT (NAME) GO TO 480 C C------ TYPE 3: Internal displaced relocation ------------------- C 403 CALL RD WORD (CONST) C C BEGIN DEBUG D IF (.NOT.DEBUG(34)) GO TO 4030 D CALL NEWLIN D CALL OUT TXT ('; Type 3: Substitute ') D CALL OUT OCT (CONST) D4030 CONTINUE C END DEBUG C N RLD = N RLD + 1 IF (N RLD .GT. MAX RLD) GO TO 999 N B OFF (N RLD) = N R PTR CALL RLD OCT (CONST) GO TO 480 C C------ TYPE 4: Global displaced relocation ---------------------- C 404 CALL RD NAME (NAME,NRAD50) CALL SHORTN (NAME) C C BEGIN DEBUG D IF (.NOT.DEBUG(34)) GO TO 4040 D CALL NEWLIN D CALL OUT TXT ('; Type 4: Substitute global ') D CALL OUT TXT (NAME) D4040 CONTINUE C END DEBUG C N RLD = N RLD + 1 IF (N RLD .GT. MAX RLD) GO TO 999 N B OFF (N RLD) = N R PTR CALL RLD TXT (NAME) GO TO 480 C C------ TYPE 5: Global additive relocation ----------------------- C 405 CALL RD NAME (NAME,NRAD50) CALL SHORTN (NAME) CALL RD WORD (CONST) C C BEGIN DEBUG D IF (.NOT.DEBUG(34)) GO TO 4050 D CALL NEWLIN D CALL OUT TXT ('; Type 5: Substitute global #') D CALL OUT TXT (NAME) D CALL OUT TXT ('+') D CALL OUT OCT (CONST) D4050 CONTINUE C END DEBUG C N RLD = N RLD + 1 IF (N RLD .GT. MAX RLD) GO TO 999 N B OFF (N RLD) = N R PTR CALL RLD TXT (NAME) CALL RLD TXT ('+') CALL RLD OCT (CONST) GO TO 480 C C------ TYPE 6: Global additive displaced relocation -------------- C 406 CALL RD NAME (NAME,NRAD50) CALL SHORTN (NAME) CALL RD WORD (CONST) C C BEGIN DEBUG D IF (.NOT.DEBUG(34)) GO TO 4060 D CALL NEWLIN D CALL OUT TXT ('; Type 6: Substitute global ') D CALL OUT TXT (NAME) D CALL OUT TXT ('+') D CALL OUT OCT (CONST) D4060 CONTINUE C END DEBUG C N RLD = N RLD + 1 IF (N RLD .GT. MAX RLD) GO TO 999 N B OFF (N RLD) = N R PTR CALL RLD TXT (NAME) CALL RLD TXT ('+') CALL RLD OCT (CONST) GO TO 480 C C------ TYPE 7: Location counter definition ----------------------- C 407 CALL RD NAME (NAME,NRAD50) CALL SHORTN (NAME) CALL RD WORD (CONST) DO 408 I=1,NPSECT II = I IF (PSNAME(1,II).NE.NRAD50(1)) GO TO 408 IF (PSNAME(2,II).NE.NRAD50(2)) GO TO 408 GO TO 409 408 CONTINUE II = 0 C 409 IF (N CUR PS .NE. II) PS OUT = .FALSE. N CUR PS = II PS LOC (N CUR PS) = CONST C C BEGIN DEBUG D IF (.NOT.DEBUG(34)) GO TO 4090 D CALL NEWLIN D CALL OUT TXT ('; Type 7: Location counter ') D CALL OUT TXT ('definition: .=') D CALL OUT TXT (NAME) D IF (CONST.NE.0) CALL OUT TXT ('+') D IF (CONST.NE.0) CALL OUT OCT (VALUE) D4090 CONTINUE C END DEBUG C GO TO 490 C C------ TYPE 10: Location counter modification -------------------- C 410 CALL RD WORD (CONST) C C BEGIN DEBUG D IF (.NOT.DEBUG(34)) GO TO 4100 D CALL NEWLIN D CALL OUT TXT ('.=') D CALL R50ASC (6,PSNAME(1,NCURPS),NAME) D CALL SHORTN (NAME) D CALL OUT TXT (NAME) D CALL OUT TXT ('+') D CALL OUT OCT (CONST) D CALL OUT TXT (' ;Type 10') D4100 CONTINUE C END DEBUG C GO TO 490 C C------ TYPE 11: Program limits ----------------------------------- C 411 CALL NEWLIN CALL OUT TXT (' .LIMIT') NTXT = NTXT - 2 GO TO 490 C C------ TYPE 12: P-sect relocation -------------------------------- C 412 CALL RD NAME (NAME,NRAD50) CALL SHORTN (NAME) C C BEGIN DEBUG D IF (.NOT.DEBUG(34)) GO TO 4120 D CALL NEWLIN D CALL OUT TXT ('; Type 12: Substitute PSECT #') D CALL OUT TXT (NAME) D4120 CONTINUE C END DEBUG C N RLD = N RLD + 1 IF (N RLD .GT. MAX RLD) GO TO 999 N B OFF (N RLD) = N R PTR CALL RLD TXT (NAME) GO TO 480 C C------ TYPE 13: Not used ----------------------------------------- C 413 CALL FTL ERR ("41,'RLD type 13 (not used)') C C------ TYPE 14: P-sect displaced relocation ---------------------- C 414 CALL RD NAME (NAME,NRAD50) CALL SHORTN (NAME) C C BEGIN DEBUG D IF (.NOT.DEBUG(34)) GO TO 4140 D CALL NEWLIN D CALL OUT TXT ('; Type 14: Substitute PSECT ') D CALL OUT TXT (NAME) D4140 CONTINUE C END DEBUG C N RLD = N RLD + 1 IF (N RLD .GT. MAX RLD) GO TO 999 N B OFF (N RLD) = N R PTR CALL RLD TXT (NAME) GO TO 480 C C------ TYPE 15: P-sect additive relocation ----------------------- C 415 CALL RD NAME (NAME,NRAD50) CALL SHORTN (NAME) CALL RD WORD (CONST) C C BEGIN DEBUG D IF (.NOT.DEBUG(34)) GO TO 4150 D CALL NEWLIN D CALL OUT TXT ('; Type 15: Substitute PSECT #') D CALL OUT TXT (NAME) D CALL OUT TXT ('+') D CALL OUT OCT (CONST) D4150 CONTINUE C END DEBUG C N RLD = N RLD + 1 IF (N RLD .GT. MAX RLD) GO TO 999 N B OFF (N RLD) = N R PTR CALL RLD TXT (NAME) CALL RLD TXT ('+') CALL RLD OCT (CONST) GO TO 480 C C------ TYPE 16: P-sect additive displaced relocation ------------- C 416 CALL RD NAME (NAME,NRAD50) CALL SHORTN (NAME) CALL RD WORD (CONST) C C BEGIN DEBUG D IF (.NOT.DEBUG(34)) GO TO 4160 D CALL NEWLIN D CALL OUT TXT ('; Type 16: Substitute PSECT ') D CALL OUT TXT (NAME) D CALL OUT TXT ('+') D CALL OUT OCT (CONST) D4160 CONTINUE C END DEBUG C N RLD = N RLD + 1 IF (N RLD .GT. MAX RLD) GO TO 999 N B OFF (N RLD) = N R PTR CALL RLD TXT (NAME) CALL RLD TXT ('+') CALL RLD OCT (CONST) GO TO 480 C C------ TYPE 17: Complex relocation expression ---------------------- C 417 CONTINUE C C BEGIN DEBUG D IF (.NOT. DEBUG(34)) GO TO 418 D CALL NEWLIN D CALL OUT TXT ('; Type 17: ') D CALL OUT TXT ('Complex relocation expression:') D CALL NEWLIN D 418 CONTINUE C END DEBUG C N RLD = N RLD + 1 IF (N RLD .GT. MAX RLD) GO TO 999 N B OFF (N RLD) = N R PTR NBUF = 1 4170 CALL RD BYTE (CODE) IF (CODE.GE.0 .AND. CODE.LE."20) GO TO 4171 CALL NEWLIN CALL OUT TXT ('RLD 2: Illegal complex relocation code = ') CALL OUT OCT (CODE) CALL FTL ERR ("17,'Complex relocation code out of range') 4171 CONTINUE C C BEGIN DEBUG D IF (.NOT.DEBUG(34)) GO TO 419 D CALL NEWLIN D CALL OUT TXT ('; CODE ') D CALL OUT OCT (CODE) D 419 CONTINUE C END DEBUG C GO TO (1400,1401,1402,1403,1404,1405,1406,1407, 1 1410,1411,1412,1413,1414,1415,1416,1417,1420), CODE+1 C 1400 GO TO 4170 1401 CALL OPER ('+') GO TO 4170 1402 CALL OPER ('-') GO TO 4170 1403 CALL OPER ('*') GO TO 4170 1404 CALL OPER ('/') GO TO 4170 1405 CALL OPER ('&') GO TO 4170 1406 CALL OPER ('!') GO TO 4170 1407 GO TO 4170 1410 CALL UNOPER ('-') GO TO 4170 1411 CALL UNOPER ('^C') GO TO 4170 1412 CALL STORE GO TO 480 1413 CALL STORE GO TO 480 1414 CONTINUE 1415 CALL FTL ERR("20,'Complex relocation expression code not used') 1416 CALL RD NAME (NAME) CALL SHORTN (NAME) CALL TSTUFF (NAME) GO TO 4170 1417 CALL RD BYTE (SECTOR) CALL RD WORD (OFFSET) CALL R50ASC(6,PSNAME(1,SECTOR+1),NAME) CALL SHORTN (NAME) NAME(7) = 0 CALL TSTUFF (NAME) IF (OFFSET .EQ. 0) GO TO 4170 CALL TSTUFF ('+') CALL OSTUFF (OFFSET) GO TO 4170 1420 CALL RD WORD (CONST) CALL OSTUFF (CONST) GO TO 4170 C C-------------------------------------------------------------------- C 480 CONTINUE LOC = LOC TXT + RELOC - 4 C C BEGIN DEBUG D IF (.NOT.DEBUG(34)) GO TO 481 D CALL OUT TXT (' At ') D CALL OUT OCT (LOC) D CALL OUT TXT (B) D 481 CONTINUE C END DEBUG C N P OFF (N RLD) = LOC IF (NR PTR .GT. MAX BUF) GO TO 998 N R BUFF (N R PTR) = 0 N R PTR = N R PTR + 1 490 IF (LEN .GT. 0) GO TO 4000 C RETURN C C------------------ Out of RLD buffer space ---------------------- C 998 CALL FTL ERR ("21,'RLD NRBUFF buffer overflow (>512 bytes)') 999 CALL FTL ERR ("22,'RLD NBOFF buffer overflow (>50 RLDs)') RETURN END SUBROUTINE BUILD !Rev 8303.091 C C=============> Build output line for an instruction <================ C IMPLICIT INTEGER (A-Z) C COMMON /INSTR/ INST,NARG,ARG1,ARG2,NWRDS COMMON /MACRO/ MACRO LOGICAL MACRO COMMON /TXT/ N TXT, LOC TXT, TXT(256), INST PS, N TXT OF LOGICAL INST PS LOGICAL VALUE D COMMON /DEBUG/ DEBUG(50) D LOGICAL DEBUG C C BEGIN DEBUG D IF (.NOT.DEBUG(35)) GO TO 10 D CALL NEWLIN D CALL OUT TXT (';Enter build with NTXT = ') D CALL OUT OCT (NTXT) D 10 CONTINUE C END DEBUG C IF (N TXT .LE. 0) GO TO 1000 N = LOC TXT - N TXT OF * 2 I = 1 20 NARG = 0 IF (.NOT. INST PS) GO TO 222 CALL CHECK (TXT(I)) IF (I .GT. 256) 1 CALL FTL ERR (27,'TXT buffer overflow in BUILD') IF (I+NWRDS .GT. N TXT) GO TO 100 C C BEGIN DEBUG D IF (.NOT.DEBUG(35)) GO TO 22 D CALL NEWLIN D CALL OUT TXT (';BUILD: INST = ') D CALL OUT OCT (INST) D CALL OUT TXT (', NARG = ') D CALL OUT OCT (NARG) D IF (NARG .EQ. 0) GO TO 21 D CALL OUT TXT (', ARG1 = ') D CALL OUT OCT (ARG1) D IF (NARG .EQ. 1) GO TO 21 D CALL OUT TXT (', ARG2 = ') D CALL OUT OCT (ARG2) D 21 CALL CRLF D 22 CONTINUE C END DEBUG C C-------------------- Output listing stuff ---------------------------- C 222 CALL CRLF IF (MACRO) GO TO 30 CALL OUT OCR (N) CALL OUT TXT (' ') CALL OUT OCR (TXT(I)) CALL OUT TXT (' ') NN = 2 IF (NARG .EQ. 0) GO TO 26 IF (NWORD(ARG1) .EQ. 0) GO TO 24 CALL OUT OCR (TXT(I+1)) CALL OUT TXT (' ') NN = 1 24 IF (NARG .NE. 2) GO TO 26 IF (NWORD(ARG2) .EQ. 0) GO TO 26 CALL OUT OCR (TXT(I+2)) CALL OUT TXT (' ') NN = NN - 1 26 IF (NN .EQ. 0) GO TO 30 DO 28 II=1,NN CALL OUT TXT (' ') 28 CONTINUE 30 CONTINUE C C---------------------- Output label, instruction --------------------- C CALL LABEL (N) IF (.NOT.INST PS .OR. INST.EQ.0) GO TO 40 CALL OUT INS (N,INST) N = N+2 I = I+1 IF (NARG .NE. 0) CALL OUT ARG (ARG1,N,I) IF (NARG .EQ. 2) CALL OUT TXT (',') IF (NARG .EQ. 2) CALL OUT ARG (ARG2,N,I) GO TO 50 C 40 CALL OUT ADR (N,I) C 50 IF (I .LE. NTXT) GO TO 20 N TXT = 0 N TXT OF = 0 GO TO 1000 C 100 CONTINUE K = NTXT - I + 1 IF (K.LT.1 .OR. K.GT.100) 1 CALL FTL ERR (28,'Illegal TXT address in BUILD') DO 200 J=1,K TXT(J) = TXT(I+J-1) 200 CONTINUE NTXT = NTXT-I+1 N TXT OF = N TXT C 1000 N RLD = 0 C RETURN END