C File name: UNMAC4.FOR !Rev 8303.091 C C******************** Support routines for UNMAC2 ********************* C SUBROUTINE LABEL (I) !Rev 8303.091 C C=======================> Fill the label field <======================= C IMPLICIT INTEGER (A-Z) C C------------------------------- COMMONS ----------------------------- C COMMON /GLOBLS/ NGLBLS,GNAME(2,400),GFLAGS(400),GVALUE(400), 1 GPSECT(400) BYTE GFLAGS,GPSECT COMMON /LABELS/ NLABEL,LABL PS(2,1000),LABL OF(1000), 1 PL NAME(2),L OFF 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 /XFR/ XFR ADR, XFR NAM(2), STARTF LOGICAL STARTF C C--------------------------LOCAL VARIABLES --------------------------- C BYTE STRING(9) DATA STRING /9*0/ DATA BIT3, BIT5 /"10,"40/ C C===================================================================== C-------------------------- Check for start -------------------------- C IF (STARTF) GO TO 100 IF (XFRNAM(1) .NE. PS NAME(1,N OLD PS)) GO TO 100 IF (XFRNAM(2) .NE. PS NAME(2,N OLD PS)) GO TO 100 IF (I .NE. XFR ADR) GO TO 100 CALL OUT TXT ('START') STARTF = .TRUE. GO TO 1000 100 CONTINUE C C------------------- Look for subroutine name table ------------------- C IF (NGLBLS .EQ. 0) GO TO 300 IF (NGLBLS .GT. 400) CALL FTL ERR (29,'NGLBLS > 400 in LABEL') DO 200 II=1,NGLBLS NP = GPSECT (II) IF (NP .NE. N OLD PS) GO TO 200 VALUE = GVALUE(II) IF (I .NE. VALUE) GO TO 200 FLAGS = G FLAGS (II) IF ((FLAGS.AND.BIT3).EQ.0) GO TO 200 IF ((FLAGS.AND.BIT5).EQ.0) GO TO 200 CALL R50ASC (6,GNAME(1,II),STRING) DO 110 III = 6,2,-1 N = III IF (STRING(N).NE."40) GO TO 120 110 CONTINUE 120 STRING(N+1) = ':' STRING(N+2) = ':' N = N+2 130 CONTINUE STRING(N+1) = 0 CALL OUT TXT (STRING) IF (N.LT.8) CALL OUT TXT (' ') RETURN 200 CONTINUE 300 CONTINUE C C---------------------- Look for branch label ----------------------- C IF (NLABEL .EQ. 0) GO TO 500 DO 400 II=1,NLABEL IF (LABLPS(1,II).NE.PSNAME(1,NOLDPS)) GOTO 400 IF (LABLPS(2,II).NE.PSNAME(2,NOLDPS)) GOTO 400 IF (LABL OF(II).NE.I) GO TO 400 CALL OUT OCT (I) CALL OUT TXT ('$') GO TO 1000 400 CONTINUE 500 CONTINUE C C-------------------------- No label found --------------------------- C CALL OUT TXT (' ') RETURN C C---------------- Do extra processing for real labels ---------------- C 1000 CALL OUT TXT (': ') RETURN END SUBROUTINE CHECK (NEXT) !Rev 8301.245 C C=====> Examine the next instruction to determine the arguments <===== C C NOTE: If you want to understand what is going on in this C subroutine, take a look at a PDP11 numerical op C code list. C IMPLICIT INTEGER (A-Z) C COMMON /INSTR/ INST, NARG, ARG1, ARG2, NWRDS C C===================================================================== C NARG = 0 ARG1 = 0 ARG2 = 0 INST = NEXT IF (INST .LT. 0) GO TO 10 C C-------Instructions with bit 15=0 C IF (INST.GE."10000 .AND. INST.LT."70000) GO TO 200 IF (INST.LT."100) GO TO 1000 I = INST/"100 IF (I.EQ.2) GO TO 1000 IF (I.GE.4 .AND. I.LT."40) GO TO 1000 IF (I.EQ."64) GO TO 1000 IF (I.GE."700 .AND. I.LT."750) GO TO 300 IF (I.GE."750) GO TO 1000 GO TO 100 C C------Instructions with bit 15=1 C 10 IN = INST.AND."77777 IF (IN.GE."10000 .AND. IN.LT."70000) GO TO 200 IF (IN.LT."5000) GO TO 1000 IF (IN.LT."10000) GO TO 100 C C------Floating point instructions C IF (IN.LT."70100) GO TO 1000 IF (IN.LT."71000) GO TO 100 NARG = 2 ARG2 = (INST.AND."300)/"100 + "100 ARG1 = INST .AND. "77 IF (IN.LT."74000) GO TO 1000 IF (IN.GE."74400 .AND. IN.LT."75000) GO TO 1000 IF (IN.GE."76400) GO TO 1000 TEMP = ARG1 ARG1 = ARG2 ARG2 = TEMP GO TO 1000 C C------Process one-argument instructions C 100 NARG = 1 ARG1 = INST.AND."77 GO TO 1000 C C------Process two-argument instructions C 200 NARG = 2 ARG2 = INST.AND."77 ARG1 = (INST.AND."7777)/"100 GO TO 1000 C C------Process arithmetic operations C 300 NARG = 2 ARG1 = INST.AND."77 ARG2 = (INST.AND."777)/"100 C C------Compute the number of extra words included with instuction C 1000 CONTINUE NWRDS = NWORD(ARG1)+NWORD(ARG2) C RETURN END FUNCTION NWORD (N) !Rev 8301.243 C C=======> Compute the number of words required by an argument <========= C NWORD = 0 IF (N .GE. "60 .AND. N .LT. "100) NWORD = 1 IF (N .EQ. "27) NWORD = 1 IF (N .EQ. "37) NWORD = 1 IF (N .EQ. "67) NWORD = 1 IF (N .EQ. "77) NWORD = 1 C RETURN END SUBROUTINE OUT ARG (ARG,N,I) !Rev 8301.246 C C==================> Output an instruction argument <================== C IMPLICIT INTEGER (A-Z) C MODE = ARG/"10 R = ARG.AND.7 IF (ARG.EQ."27) GO TO 20 IF (ARG.EQ."37) GO TO 30 IF (ARG.EQ."67) GO TO 60 IF (ARG.EQ."77) GO TO 70 GO TO (10,11,12,13,14,15,16,17,100),MODE+1 10 CALL OUT REG (R) RETURN 11 CALL OUT TXT ('(') CALL OUT REG (R) CALL OUT TXT (')') RETURN 12 CALL OUT TXT ('(') CALL OUT REG (R) CALL OUT TXT (')+') RETURN 13 CALL OUT TXT ('@') GO TO 12 14 CALL OUT TXT ('-(') CALL OUT REG (R) CALL OUT TXT (')') RETURN 15 CALL OUT TXT ('@') GO TO 14 16 CALL OUT ADR (N,I) CALL OUT TXT ('(') CALL OUT REG (R) CALL OUT TXT (')') RETURN 17 CALL OUT TXT ('@') GO TO 16 C 20 CALL OUT TXT ('#') CALL OUT ADR (N,I) RETURN 30 CALL OUT TXT ('@#') CALL OUT ADR (N,I) RETURN 60 CALL OUT ADR (N,I) RETURN 70 CALL OUT TXT ('@') CALL OUT ADR (N,I) RETURN C 100 R = ARG .AND. 3 CALL OUT TXT ('AC') CALL OUT OCT (R) RETURN C END SUBROUTINE OUT REG (R) !Rev 8301.053 C C==================> Output a register expression <=================== C IMPLICIT INTEGER (A-Z) C NREG = R.AND.7 IF (NREG.EQ.6) GO TO 60 IF (NREG.EQ.7) GO TO 70 CALL OUT TXT ('R') CALL OUT OCT (NREG) RETURN 60 CALL OUT TXT ('SP') RETURN 70 CALL OUT TXT ('PC') RETURN C END SUBROUTINE OUT ADR (N,I) !Rev 8302.011 C C===========> Output next argument from TXT or RLD buffer <=========== C IMPLICIT INTEGER (A-Z) C 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 BYTE CHAR(4) EQUIVALENCE (CHAR(1),CHARS) C IF (NRLD .EQ. 0) GO TO 200 C DO 100 J=1,NRLD NN = N P OFF(J) IF (NN .NE. N) GO TO 100 M = NBOFF(J) 10 LCHAR = NRBUFF(M) M = M+1 IF (LCHAR .EQ. 0) GO TO 300 CALL OUT TXT (LCHAR) GO TO 10 100 CONTINUE C 200 IF (N .NE. (N/2)*2) GO TO 210 CALL OUT OCT (TXT(I)) GO TO 230 210 CHARS = TXT(I) CALL OUT TXT ('.BYTE ') LCHAR = CHAR(1) LCHAR = LCHAR.AND."377 CALL OUT BYT (LCHAR) CALL OUT TXT (',') LCHAR = CHAR(2) LCHAR = LCHAR.AND."377 CALL OUT BYT (LCHAR) C 230 IF (INST PS) GO TO 300 CALL OUT TXT (' ;') NOUT = 0 CHARS = TXT(I) DO 250 II=1,2 LCHAR = CHAR(II) LCHAR = LCHAR .AND. "377 IF (LCHAR .GE."177) GO TO 240 IF (LCHAR .LT. "40) GO TO 240 CALL OUT TXT (LCHAR) NOUT = NOUT + 1 GO TO 250 240 CALL OUT TXT ('<') CALL OUT OCT (LCHAR) CALL OUT TXT ('>') NOUT = NOUT + 3 IF (LCHAR .GE. "10) NOUT = NOUT + 1 IF (LCHAR .GE. "100) NOUT = NOUT + 1 250 CONTINUE C DO 260 II=NOUT,15 CALL OUT TXT (' ') 260 CONTINUE C LCHAR = TXT(I) K = R50ASC (3,LCHAR,CHAR) CHAR(4) = 0 CALL OUT TXT (CHAR) C 300 I = I+1 N = N+2 RETURN C END SUBROUTINE OUT INS (NADR,INSTR) !Rev 8303.091 C C===================> Output an instruction code <==================== C IMPLICIT INTEGER (A-Z) C COMMON /FPI/ RFLAG,IFLAG LOGICAL RFLAG,IFLAG C INST = INSTR IF (INST.LT. 0) GO TO 500 IF (INST.GE."10000) GO TO 100 IF (INST.GE. "5000) GO TO 45 IF (INST.GE. "400) GO TO 30 IF (INST.GE. "100) GO TO 20 IF (INST.GT. 6) RETURN C C Misc. instructions C GO TO (10,11,12,13,14,15,16),INST+1 10 CALL OUT TXT ('HALT') RETURN 11 CALL OUT TXT ('WAIT') RETURN 12 CALL OUT TXT ('RTI') RETURN 13 CALL OUT TXT ('BPT') RETURN 14 CALL OUT TXT ('IOT') RETURN 15 CALL OUT TXT ('RESET') RETURN 16 CALL OUT TXT ('RTT') RETURN C 20 IN = INST/"100 GO TO (21,22,23),IN 21 CALL OUT TXT ('JMP') GO TO 1005 22 IF (INST.GT."240) GO TO 24 IF (INST.EQ."240) CALL OUT TXT ('NOP') IF (INST.GE."210) RETURN CALL OUT TXT ('RTS ') CALL OUT REG (INST) RETURN 23 CALL OUT TXT ('SWAB') GO TO 1004 24 I = INST.AND."17 IF (I.EQ."17) GO TO 28 N = 0 I = INST.AND.1 IF (I.EQ.0) GO TO 25 IF (INST.LT."260) CALL OUT TXT ('CLC') IF (INST.GE."260) CALL OUT TXT ('SEC') N = 1 25 I = INST.AND.2 IF (I.EQ.0) GO TO 26 IF (N.EQ.1) CALL OUT TXT (',') IF (INST.LT."260) CALL OUT TXT ('CLV') IF (INST.GE."260) CALL OUT TXT ('SEV') N = 1 26 I = INST.AND.4 IF (I.EQ.0) GO TO 27 IF (N.EQ.1) CALL OUT TXT (',') IF (INST.LT."260) CALL OUT TXT ('CLZ') IF (INST.GE."260) CALL OUT TXT ('SEZ') N = 1 27 I = INST.AND."10 IF (I.EQ.0) RETURN IF (N.EQ.1) CALL OUT TXT (',') IF (INST.LT."260) CALL OUT TXT ('CLN') IF (INST.GE."260) CALL OUT TXT ('SEN') RETURN 28 IF (INST.EQ."257) CALL OUT TXT ('CCC') IF (INST.EQ."277) CALL OUT TXT ('SCC') RETURN C C Branch instructions C 30 IF (INST.GE."4000) GO TO 40 IN = INST/"400 GO TO (31,32,33,34,35,36,37),IN 31 CALL OUT TXT ('BR ') GO TO 38 32 CALL OUT TXT ('BNE ') GO TO 38 33 CALL OUT TXT ('BEQ ') GO TO 38 34 CALL OUT TXT ('BGE ') GO TO 38 35 CALL OUT TXT ('BLT ') GO TO 38 36 CALL OUT TXT ('BGT ') GO TO 38 37 CALL OUT TXT ('BLE ') GO TO 38 38 OFFSET = INST .AND. "377 IF (OFFSET .GE. "200) OFFSET = OFFSET - "400 OFFSET = 2*(OFFSET+1) + NADR CALL OUT TXT (' ') CALL OUT OCT (OFFSET) CALL OUT TXT ('$') RETURN C C JSR C 40 CALL OUT TXT ('JSR ') REG = (INST.AND."777)/"100 CALL OUT REG (REG) CALL OUT TXT (',') RETURN C C Single argument instructions C 45 IF (INST.GE."7000) RETURN IN = INST/"100 - "47 GO TO (50,51,52,53,54,55,56,57,60,61,62,63,64,49,49,67),IN 49 RETURN 50 CALL OUT TXT ('CLR') GO TO 68 51 CALL OUT TXT ('COM') GO TO 68 52 CALL OUT TXT ('INC') GO TO 68 53 CALL OUT TXT ('DEC') GO TO 68 54 CALL OUT TXT ('NEG') GO TO 68 55 CALL OUT TXT ('ADC') GO TO 68 56 CALL OUT TXT ('SBC') GO TO 68 57 CALL OUT TXT ('TST') GO TO 68 60 CALL OUT TXT ('ROR') GO TO 68 61 CALL OUT TXT ('ROL') GO TO 68 62 CALL OUT TXT ('ASR') GO TO 68 63 CALL OUT TXT ('ASL') GO TO 68 64 CALL OUT TXT ('MARK ') NN = INST - (INST/"100)*"100 CALL OUT OCT (NN) RETURN 67 CALL OUT TXT ('SXT') 68 IF (INSTR.GT.0) GO TO 1005 CALL OUT TXT ('B') GO TO 1004 C 100 IF (INST.LT."75040) GO TO 110 IF (INST.LT."77000) RETURN NN = INST.AND."77 REG = (INST.AND."777)/"100 CALL OUT TXT ('SOB ') CALL OUT REG (REG) CALL OUT TXT (',.-') CALL OUT OCT (2*NN-2) RETURN 110 IF (INST.LT."75000) GO TO 140 REG = INST.AND.7 IN = (INST.AND."77)/"10 + 1 GO TO (120,121,122,123),IN 120 CALL OUT TXT ('FADD') GO TO 130 121 CALL OUT TXT ('FSUB') GO TO 130 122 CALL OUT TXT ('FMUL') GO TO 130 123 CALL OUT TXT ('FDIV') 130 CALL OUT TXT (' ') CALL OUT REG (REG) RETURN 140 IF (INST.LT."70000) GO TO 170 REG = (INST.AND."777)/"100 IN = (INST.AND."7777)/"1000 + 1 GO TO (150,151,152,153,154),IN 150 CALL OUT TXT ('MUL ') GO TO 160 151 CALL OUT TXT ('DIV ') GO TO 160 152 CALL OUT TXT ('ASH ') GO TO 160 153 CALL OUT TXT ('ASHC') GO TO 160 154 CALL OUT TXT ('XOR ') 160 CALL OUT TXT (' ') RETURN C C Two argument instructions C 170 IN = INST/"10000 GO TO (171,172,173,174,175,176),IN 171 CALL OUT TXT ('MOV') GO TO 177 172 CALL OUT TXT ('CMP') GO TO 177 173 CALL OUT TXT ('BIT') GO TO 177 174 CALL OUT TXT ('BIC') GO TO 177 175 CALL OUT TXT ('BIS') GO TO 177 176 CALL OUT TXT ('ADD') 177 IF (INSTR.GE.0) GO TO 1005 CALL OUT TXT ('B') GO TO 1004 C C Instructions with bit 15=1 C 500 INST = INSTR.AND."77777 IF (INST.GE."70000) GO TO 900 IF (INST.GE."10000) GO TO 800 IF (INST.GE. "5000) GO TO 700 IF (INST.GE. "4000) GO TO 640 I = (INST.AND."3777)/"400 + 1 GO TO (600,604,610,614,620,624,630,634),I 600 CALL OUT TXT ('BPL ') GO TO 38 604 CALL OUT TXT ('BMI ') GO TO 38 610 CALL OUT TXT ('BHI ') GO TO 38 614 CALL OUT TXT ('BLOS') GO TO 38 620 CALL OUT TXT ('BVC ') GO TO 38 624 CALL OUT TXT ('BVS ') GO TO 38 630 CALL OUT TXT ('BCC ') GO TO 38 634 CALL OUT TXT ('BCS ') GO TO 38 C 640 IF (INST.LT."4400) CALL OUT TXT ('EMT ') IF (INST.GE."4400) CALL OUT TXT ('TRAP ') I = INST.AND."377 CALL OUT OCT (I) RETURN C 700 IF (INST.LT."6400) GO TO 45 IF (INST.LT."6700) CALL OUT TXT ('MTPS') IF (INST.GE."6700) CALL OUT TXT ('MFPS') RETURN C 800 IF (INST.LT."60000) GO TO 170 CALL OUT TXT ('SUB') GO TO 1005 C C Floating point instructions C 900 IF (INST .GE. "70100) GO TO 930 I = INST.AND."17 IF (I .GT. 2) GO TO 920 GO TO (910,911,912),I+1 910 CALL OUT TXT ('CFCC') GO TO 1004 911 CALL OUT TXT ('SETF') RFLAG = .TRUE. GO TO 1004 912 CALL OUT TXT ('SETI') IFLAG = .TRUE. GO TO 1004 C 920 GO TO (921,922),I-"10 921 CALL OUT TXT ('SETD') RFLAG = .FALSE. GO TO 1004 922 CALL OUT TXT ('SETL') RFLAG = .FALSE. GO TO 1004 C 930 IF (INST .GE. "71000) GO TO 940 I = (INST .AND. "700)/"100 GO TO (931,932,933,934,935,936,937),I 931 CALL OUT TXT ('LDFPS') GO TO 1003 932 CALL OUT TXT ('STFPS') GO TO 1003 933 CALL OUT TXT ('STST') GO TO 1004 934 IF ( RFLAG) CALL OUT TXT ('CLRF') IF (.NOT.RFLAG) CALL OUT TXT ('CLRD') GO TO 1004 935 IF ( RFLAG) CALL OUT TXT ('TSTF') IF (.NOT.RFLAG) CALL OUT TXT ('TSTD') GO TO 1004 936 IF ( RFLAG) CALL OUT TXT ('ABSF') IF (.NOT.RFLAG) CALL OUT TXT ('ABSD') GO TO 1004 937 IF ( RFLAG) CALL OUT TXT ('NEGF') IF (.NOT.RFLAG) CALL OUT TXT ('NEGD') GO TO 1004 C 940 I = (INST.AND."7400)/"400 GO TO (941,942,943,944,945,946,947,948,949,950,951,952, 1 953,954),I-1 941 CALL OUT TXT ('MUL') GO TO 2004 942 CALL OUT TXT ('MOD') GO TO 2004 943 CALL OUT TXT ('ADD') GO TO 2004 944 CALL OUT TXT ('LD') GO TO 2005 945 CALL OUT TXT ('SUB') GO TO 2004 946 CALL OUT TXT ('CMP') GO TO 2004 947 CALL OUT TXT ('ST') GO TO 2005 948 CALL OUT TXT ('DIV') GO TO 2004 949 CALL OUT TXT ('STEXP') GO TO 1003 950 CALL OUT TXT ('STC') GO TO 2100 951 CALL OUT TXT ('STC') GO TO 2200 952 CALL OUT TXT ('LDEXP') GO TO 1003 953 CALL OUT TXT ('LDC') GO TO 2100 954 CALL OUT TXT ('LDC') GO TO 2200 C 2004 IF ( RFLAG) CALL OUT TXT ('F') IF (.NOT.RFLAG) CALL OUT TXT ('D') GO TO 1004 2005 IF ( RFLAG) CALL OUT TXT ('F') IF (.NOT.RFLAG) CALL OUT TXT ('D') GO TO 1005 2100 IF ( IFLAG) CALL OUT TXT ('I') IF (.NOT.IFLAG) CALL OUT TXT ('L') IF ( RFLAG) CALL OUT TXT ('F') IF (.NOT.RFLAG) CALL OUT TXT ('D') GO TO 1003 2200 IF ( RFLAG) CALL OUT TXT ('FD') IF (.NOT.RFLAG) CALL OUT TXT ('DF') GO TO 1003 C C------------------------------------------------------------------- C 1008 CALL OUT TXT (' ') RETURN 1005 CALL OUT TXT (' ') RETURN 1004 CALL OUT TXT (' ') RETURN 1003 CALL OUT TXT (' ') RETURN C END