Trailing-Edge
-
PDP-10 Archives
-
decuslib10-08
-
43,50503/trad8.for
There are no other files named trad8.for in the archive.
LOGICAL INDEX
DIMENSION INS(6),IOT(200),IOTS(200)
COMMON KD,LD,MD,ND
COMMON /OPR/ K,L,K0,L0,M0,LINE(20)
DATA INS/'AND','TAD','ISZ','DCA','JMS','JMP'/
CALL INITT
M0=0
I=1
20 READ(2,300,END=21)IOT(I),IOTS(I)
300 FORMAT(O4,2X,A4)
I=I+1
GO TO 20
21 IF (I.GT.200) CALL EXIT
NI=I
INDEX=.TRUE.
2 CALL READT(J,K,L)
IF(J.NE.2) GO TO 1
IF(INDEX) GO TO 2
WRITE(3,600)
600 FORMAT(1X,14X,'$')
CALL EXIT
1 CALL READT(J0,K0,L0)
INDEX=.FALSE.
IF(J.NE.1) GO TO 3
KD=K
LD=L
MD=K0
ND=L0
WRITE(3,400) KD,LD,MD,ND
400 FORMAT(/1H ,13X,'*'4O1)
GO TO 2
3 IF(K.GE.6) GO TO 1000
KI=K+1
INDIRE=' '
IF(L.GE.4) INDIRE=' I '
K1=0
L1=1
IF(L.EQ.2.OR.L.EQ.3.OR.L.EQ.6.OR.L.EQ.7) GO TO 1001
IF(L.EQ.0.OR.L.EQ.2.OR.L.EQ.4.OR.L.EQ.6) L1=0
5 WRITE(3,100)KD,LD,MD,ND,K,L,K0,L0,INS(KI),INDIRE,K1,L1,K0,L0
100 FORMAT(1X,2(3X,4O1),3X,2A3,4O1)
8 CALL INCR
GO TO 2
1001 L1=LD-1
K1=KD
IF(LD.EQ.0.OR.LD.EQ.2.OR.LD.EQ.4.OR.LD.EQ.6) L1=LD
IF(L.EQ.1.OR.L.EQ.3.OR.L.EQ.5.OR.L.EQ.7) L1=L1+1
GO TO 5
1000 IF(K.EQ.7) GO TO 1002
CONT=K*"1000+L*"100+K0*"10+L0
DO 6 I=1,NI
IF(CONT.EQ.IOT(I)) GO TO 7
6 CONTINUE
WRITE(3,100) KD,LD,MD,ND,K,L,K0,L0
GO TO 8
7 WRITE(3,200) KD,LD,MD,ND,K,L,K0,L0,IOTS(I)
200 FORMAT(1X,2(3X,4O1),3X,A4)
GO TO 8
1002 IF(L.GE.4.AND.(L0.EQ.0.OR.L0.EQ.2.OR.L0.EQ.4.OR.L0.EQ.6))GO TO 9
IF(L.GE.4) GO TO 10
CALL GPO1
WRITE(3,500) KD,LD,MD,ND,K,L,K0,L0, (LINE(I),I=1,M0)
M0=0
GO TO 8
9 CALL GPO2
WRITE(3,500) KD,LD,MD,ND,K,L,K0,L0, (LINE(I),I=1,M0)
M0=0
500 FORMAT(1X,2(3X,4O1),3X,20A4)
GO TO 8
10 WRITE (3,100) KD,LD,MD,ND,K,L,K0,L0
GO TO 8
END
SUBROUTINE INCR
COMMON KD,LD,MD,ND
ND=ND+1
IF(ND.LT."10) RETURN
ND=0
MD=MD+1
IF(MD.LT."10) RETURN
MD=0
LD=LD+1
IF(LD.LT."10) RETURN
LD=0
KD=KD+1
IF(KD.LT."10) RETURN
KD=0
RETURN
END
SUBROUTINE GPO1
LOGICAL IND
COMMON /OPR/ K,L,N,M
IF(L.EQ.0.AND.N.EQ.0.AND.M.EQ.0) GO TO 14
IF(L.GE.2) CALL NEMON(1)
IF(L.EQ.1.OR.L.EQ.3) CALL NEMON(2)
IF(N.GE.4) CALL NEMON(3)
IF(N.EQ.2.OR.N.EQ.3.OR.N.EQ.6.OR.N.EQ.7) CALL NEMON(4)
IF(M.EQ.1.OR.M.EQ.3.OR.M.EQ.5.OR.M.EQ.7) CALL NEMON(5)
IND=.FALSE.
IF(M.EQ.2.OR.M.EQ.3.OR.M.EQ.6.OR.M.EQ.7) IND=.TRUE.
IF(N.EQ.1.OR.N.EQ.3.OR.N.EQ.5.OR.N.EQ.7) GO TO 11
IF(M.LT.4) RETURN
IF(IND) GO TO 12
CALL NEMON(8)
RETURN
12 CALL NEMON(9)
RETURN
11 IF(IND) GO TO 13
CALL NEMON(6)
RETURN
13 CALL NEMON(7)
RETURN
14 CALL NEMON(10)
RETURN
END
SUBROUTINE GPO2
COMMON /OPR/ K,L,M,N
IF((L.NE.4.OR.L.NE.6).AND.M.NE.1) GO TO 110
CALL NEMON(20)
GO TO 120
110 IF(M.EQ.0.OR.M.EQ.2.OR.M.EQ.4.OR.M.EQ.6) GO TO 130
IF(L.EQ.5.OR.L.EQ.7) CALL NEMON(11)
IF(M.EQ.5.OR.M.EQ.7) CALL NEMON(12)
IF(M.EQ.3.OR.M.EQ.7) CALL NEMON(13)
GO TO 120
130 IF(L.EQ.5.OR.L.EQ.7) CALL NEMON(14)
IF(M.GE.4) CALL NEMON(15)
IF(M.EQ.2.OR.M.EQ.6) CALL NEMON(16)
120 IF(L.GE.6) CALL NEMON(17)
IF(N.GE.4) CALL NEMON(18)
IF(N.EQ.2.OR.N.EQ.6) CALL NEMON(19)
RETURN
END
SUBROUTINE NEMON(N)
COMMON /OPR/I,J,M,L,K,LINE(20)
K=K+1
GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20),N
1 LINE(K)='CLA '
RETURN
2 LINE(K)='CLL '
RETURN
3 LINE(K)='CMA '
RETURN
4 LINE(K)='CML '
RETURN
5 LINE(K)='IAC '
RETURN
6 LINE(K)='RAR '
RETURN
7 LINE(K)='RTR '
RETURN
8 LINE(K)='RAL '
RETURN
9 LINE(K)='RTL '
RETURN
10 LINE(K)='NOP '
RETURN
11 LINE(K)='SPA '
RETURN
12 LINE(K)='SNA '
RETURN
13 LINE(K)='SZL '
RETURN
14 LINE(K)='SMA '
RETURN
15 LINE(K)='SZA '
RETURN
16 LINE(K)='SNL '
RETURN
17 LINE(K)='CLA '
RETURN
18 LINE(K)='OSR '
RETURN
19 LINE(K)='HLT '
RETURN
20 LINE(K)='SKP '
RETRRN
END