PROGRAM TASKER C C ROBERT WATSON C CISCO, INC. C (918)665-2110 C 4135 S. 100TH E. AVE. C TULSA OK 74145 C C THIS PROGRAM HAS BEEN DONATED TO THE PUBLIC DOMAIN C AND IS NOT TO BE COPYRIGHTED. C INTEGER*4 INST, PC, ADR, 1 NN, IBEG, IEND INTEGER*2 BLK(256), OPSUB, PCDUM(2), 1 ADRDUM(2), HIPC, LOPC, 2 HIADR, LOADR, Q EQUIVALENCE (PC,PCDUM(1)), (ADR,ADRDUM(1)), 1 (PCDUM(1),LOPC), (PCDUM(2),HIPC), 2 (ADRDUM(1),LOADR), (ADRDUM(2),HIADR) BYTE LINE(78), MAC(6), LOC(6), 1 WRK(6), FNAM(25), VALID, 2 OPC(4), ANS, MOD, 3 NEXT, Z, FIRST, 4 SET, CLVZ(7), SUBR, 5 BHIS(4), BLO(4), F, 6 NAM(25) DATA FIRST /.TRUE./, SET /.FALSE./, 1 CLVZ /'C','L','V',"41,'C','L','Z'/, 2 BHIS /'B','H','I','S'/, 3 BLO /'B','L','O',' '/, 4 FNAM /25*' '/, 5 ISUB /0/ CALL ERRSET (29, .TRUE., .FALSE., .TRUE., .FALSE.) GO TO 4 2 CLOSE (UNIT=1) ISUB = -2 !CODE TO CLEAR RO PTRS CALL FILL (BLK, IREC, ISUB, PC) ISUB = 0 4 ILINE = 53 IPAGE = 0 SUBR = .FALSE. 7 WRITE (5,5) 5 FORMAT (/,' RUN IN UPDATE, REPORT, SEARCH, OR HEADER MODE', 1 ' (U, R, S, OR H)? ',$) READ (5,6,END=99999) MOD 6 FORMAT (A1) IF (MOD.NE.'U'.AND.MOD.NE.'R'.AND.MOD.NE.'S'.AND. 1 MOD.NE.'H') GO TO 7 IF (MOD.EQ.'U'.OR.MOD.EQ.'S'.OR.MOD.EQ.'H') GO TO 100 IF (SET) GO TO 100 SET = .TRUE. 9 WRITE (5,10) 10 FORMAT (/,' MACRO SOURCE OUTPUT TO TI OR PRINTER', 1 ' (T OR P)? ',$) READ (5,6,END=99999) ANS IF (ANS.NE.'T' .AND. ANS.NE.'P') GO TO 9 IF (ANS .EQ. 'P') GO TO 100 CALL ASNLUN (6, 'TI', 0, I) IF (I .NE. 1) STOP 'ASNLUN ERROR' 100 IF (.NOT. FIRST) GO TO 120 FIRST = .FALSE. WRITE (5,110) 110 FORMAT (/,' ENTER TASK FILENAME: ',$) GO TO 135 120 WRITE (5,130) 130 FORMAT (/,' ENTER TASK FILENAME OR RETURN FOR OLD: ',$) 135 READ (5,140,END=99999) Q, NAM 140 FORMAT (Q,25A1) IF (Q .GT. 0) GO TO 150 IF (FNAM(1) .NE. ' ') GO TO 175 FIRST = .TRUE. GO TO 100 150 DO 160 I=1,25 FNAM(I) = NAM(I) 160 CONTINUE DO 170 I=25,1,-1 IF (FNAM(I) .EQ. ' ') FNAM(I) = 0 170 CONTINUE 175 IF (MOD .NE. 'U') GO TO 180 OPEN (UNIT=1, NAME=FNAM, TYPE='OLD', ACCESS='DIRECT', 1 FORM='UNFORMATTED', RECORDSIZE=128, ERR=176) CALL CHANGE (BLK) GO TO 2 176 CALL ERRTST (29, J) IF (J .NE. 1) GO TO 99998 WRITE (5,177) 7 177 FORMAT (/' NO SUCH FILE',A1) FIRST = .TRUE. GO TO 4 180 OPEN (UNIT=1, NAME=FNAM, TYPE='OLD', ACCESS='DIRECT', 1 READONLY, FORM='UNFORMATTED', RECORDSIZE=128, 2 ERR=176) IF (MOD .NE. 'S') GO TO 600 CALL SRCH (BLK) GO TO 2 600 IF (MOD .NE. 'H') GO TO 605 CALL HDR (BLK, FNAM) GO TO 2 605 WRITE (5,610) 610 FORMAT (/,' REPORT IN MACRO SOURCE FORMAT (Y OR N)? ',$) READ (5,6,END=99998) F IF (F.NE.'Y' .AND. F.NE.'N') GO TO 600 IF (F .EQ. 'Y') GO TO 680 CALL OTHER (BLK) GO TO 2 680 WRITE (5,700) 700 FORMAT (/,' ENTER OCTAL BEGINNING ADDRESS: ',$) READ (5,800,ERR=600,END=99998) IBEG 800 FORMAT (O6) IF ((IBEG.AND.1) .EQ. 0) GO TO 900 WRITE (5,820) 7 820 FORMAT (/,' WORD ADDRESS MUST BE EVEN',A1) GO TO 600 900 WRITE (5,1000) 1000 FORMAT (/,' ENTER OCTAL ENDING ADDRESS : ',$) READ (5,800,ERR=900,END=99998) IEND WRITE (5,1010) 1010 FORMAT (' ') PC = IBEG CALL INIT (BLK, ISUB, IBEG, IREC, PC) 1040 IF (MOD.EQ.'R' .AND. PC.GT.IEND) GO TO 2 1045 DO 1050 I=1,78 LINE(I) = ' ' 1050 CONTINUE IF (ISUB .LE. 256) GO TO 1200 IREC = IREC + 1 CALL FILL (BLK, IREC, ISUB, PC) 1200 Z = .TRUE. CALL OCTL (LOPC, LOC, Z) CALL OCTL (BLK(ISUB), MAC, Z) DO 1300 I=1,6 LINE(I) = LOC(I) 1300 CONTINUE DO 1400 I=1,6 LINE(I+8) = MAC(I) 1400 CONTINUE PC = PC + 2 IF (BLK(ISUB) .NE. "000246) GO TO 1450 !UNDOCUMENTED PSEUDO OP-CODE DO 1410 I=1,7 LINE(I+39) = CLVZ(I) 1410 CONTINUE GO TO 3400 1450 INST = BLK(ISUB) INST = (INST .AND. "177777) CALL BAD (INST, VALID, LINE) IF (.NOT. VALID) GO TO 3400 CALL OP (INST, OPC, OPSUB) IF (OPSUB.LT.65 .OR. OPSUB.GT.66) GO TO 1490 IF (SUBR) GO TO 1490 IF (OPSUB .EQ. 66) GO TO 1460 DO 1455 I=1,4 OPC(I) = BHIS(I) 1455 CONTINUE GO TO 1490 1460 DO 1470 I=1,4 OPC(I) = BLO(I) 1470 CONTINUE 1490 SUBR = .FALSE. DO 1500 I=1,4 1500 LINE(I+39) = OPC(I) IF (OPSUB .EQ. 6) LINE(44) = 'T' IF (OPSUB.LT.8 .OR. OPSUB.EQ.11) GO TO 3400 IF (OPSUB.GT.11 .AND. OPSUB.LT.22) GO TO 3400 IF ((OPSUB.GT.22 .AND. OPSUB.LT.30) .OR. 1 (OPSUB.GT.58 .AND. OPSUB.LT.67)) GO TO 1600 GO TO 1700 1600 CALL BRA (BLK(ISUB), PC, LINE) GO TO 3400 1700 IF (OPSUB .NE. 9) GO TO 1900 LINSUB = 49 CALL REG (MAC(6), LINE, LINSUB) GO TO 3400 1900 IF (OPSUB .NE. 10) GO TO 2000 LINE(49) = MAC(6) GO TO 3400 2000 IF (OPSUB .NE. 43) GO TO 2100 LINE(49) = MAC(5) LINE(50) = MAC(6) GO TO 3400 2100 IF (OPSUB .NE. 58) GO TO 2300 LINSUB = 49 CALL REG (MAC(4), LINE, LINSUB) LINE(LINSUB) = ',' LINSUB = LINSUB + 1 NN = (BLK(ISUB) .AND. "77) ADR = PC - (2 * NN) Z = .FALSE. CALL OCTL (LOADR, WRK, Z) DO 2200 I=1,6 IF (WRK(I) .EQ. ' ') GO TO 2200 LINE(LINSUB) = WRK(I) LINSUB = LINSUB + 1 2200 CONTINUE GO TO 3400 2300 IF (OPSUB.NE.67 .AND. OPSUB.NE.68) GO TO 2800 IWRK = (BLK(ISUB) .AND. "377) Z = .FALSE. CALL OCTL (IWRK, WRK, Z) LINSUB = 49 DO 2700 I=1,6 IF (WRK(I) .EQ. ' ') GO TO 2700 LINE(LINSUB) = WRK(I) LINSUB = LINSUB + 1 2700 CONTINUE GO TO 3400 2800 LINSUB = 49 IF (OPSUB .NE. 30) GO TO 3000 CALL REG (MAC(4), LINE, LINSUB) LINE(LINSUB) = ',' LINSUB = LINSUB + 1 3000 NO = 3 IF (OPSUB.GT.46 .AND. OPSUB.LT.53) GO TO 3100 IF (OPSUB.GT.82) GO TO 3100 GO TO 3200 3100 CALL DOIT (MAC, ISUB, BLK, LINE, LINSUB, NO, PC, IREC) GO TO 3400 3200 IF (OPSUB.NE.57) GO TO 3300 CALL REG (MAC(4), LINE, LINSUB) LINE(LINSUB) = ',' LINSUB = LINSUB + 1 3300 NO = 5 CALL DOIT (MAC, ISUB, BLK, LINE, LINSUB, NO, PC, IREC) IF (OPSUB.LT.53 .OR. OPSUB.GT.56) GO TO 3400 LINE(LINSUB) = ',' LINSUB = LINSUB + 1 CALL REG (MAC(4), LINE, LINSUB) 3400 ISUB = ISUB + 1 IF (OPSUB.EQ.30 .OR. OPSUB.EQ.67 .OR. OPSUB.EQ.68) SUBR = .TRUE. IF (ANS .EQ. 'T') GO TO 3450 ILINE = ILINE + 1 IF (ILINE .LE. 53) GO TO 3450 IPAGE = IPAGE + 1 WRITE (6,3410) FNAM, IPAGE 3410 FORMAT ('1MACRO SOURCE FROM FILE ',25A1,10X,'PAGE ',I3,//) ILINE = 0 3450 WRITE (6,3500) LINE 3500 FORMAT (' ',78A1) GO TO 1040 99998 CLOSE (UNIT=1) 99999 STOP END