Trailing-Edge
-
PDP-10 Archives
-
decuslib10-02
-
43,50250/tblnot.f4
There are no other files named tblnot.f4 in the archive.
SUBROUTINE TBLNOT
C
C TBLTRN ROUTINE TO IDENTIFY AND PERFORM OPERATION
C INDICATED BY SYMBOL NOT IN RANGE OF OPERATOR.
C
C DONALD BARTH, CHEMISTRY DEPT., HARVARD UNIVERSITY
C
COMMON/TBLTRN/I,IADDRS,IADJST,IBASE,IBLANK,IDGT(16),
1IERR,IFILL,IFKNT,IKODE,ILEFT,ILINE,ILPT,ILTR,IBYTE,
2IMASK,LMAX,NMORE,IMOST,INSERT,IOCT(13),IOPRTR,IOUT,
3IPAREN,IPNCTN(11),IPRCN,IRADIX,IREAD,IREPT,IRIGHT,
4ISHIFT,ISIGN,ISTAR,ISTORE(478),ITEN,ITEST,ITITLE(6),
5ITTY,IWIDE,IWRITE,J,JADJST,JBASE,JBLANK,JERR,KPAREN,
6JFKNT,JKODE(37),JLEFT,JMASK,JMORE,JPAREN,JRADIX,LOOP,
7JRIGHT,JSHIFT,JSIGN,K,KADJST,KBASE,KERR,KIND,KLINE,
8KLM,KLTR,KMASK,KNT,KNTLTR,KNTWRD,KODE,KRADIX,IDBG,
9KREAD,KSHIFT,L,LEAST,LETTER(160),LMASK,LOCK,LSTNEW,
1LTTR(160),M,MASK,MASTER(5000),MAX,MLEFT,MORE,MOST,
2MRIGHT,MULT,N,NEW,NEXT,NSIGN,NTITLE(6),NUMBER,LRADIX,
3KMAX,INLINE,JPNCTN(50),KPNCTN(50),LPNCTN,JOPRTR,NLTR,
4JBYTE,ILOOP,ISKIP,IVALUE,INSN(6),JNSN,IMAX,JMAX,
5KNSN,MLTR,JLTR,JLOOP,IPFX,JPFX,LSIGN,IIARG,JJARG,
6KKARG,LLARG,JVALUE,MIN,IAC,IARG,JARG,KARG,LARG,JSTFY,
7LENGTH(20),LNGMIN,IORDER,IRMV,KSIGN
C
IF(KODE.EQ.0)GO TO 1
IF(KODE.GT.1000)GO TO 4
GO TO(1,1,102,113,113,113,113,113,13,14,15,16,102,103,17,
147,45,45,45,103,104,103,102,103,103,113,103,103,46,101,
258,101,57,101,59,113,17,66,102,101,67,101,68,101,69,
3101,69,101,72,101,73,101,74,75,76,77,80,101,82,103,
4103,101,83,101,84,2,113,102,113,102,102,102,103,101,85,
5103,103,103,101,89,103,103,90,103,102,103,103,101,99,101,
699,101,99,101,99,101,99,101,99,101,99,101,99,101,99,
7101,99,101,100,101,100,101,100,101,99,101,99,102,101,91,
8113,101,92,93,94,101,95,101,100,101,100,101,100,96,97,
998),KODE
C
C SYMBOL IS ADDRESS LABEL
1 IF(KNT.NE.0)GO TO 113
MORE=NMORE
IF(MORE.EQ.0)MORE=1
GO TO 112
C
C SYMBOL IS A CONSTANT
2 IF(NUMBER.GT.0)GO TO 3
NEW=-NUMBER-1
NUMBER=MASTER(NEW+2)
NMORE=MORE-1
MORE=NMORE+MASTER(NEW)
GO TO 5
3 NEW=NUMBER-1
NUMBER=MASK-1
NMORE=0
MORE=MASTER(NEW)
IF(IMASK.EQ.0)GO TO 5
IF(INSERT.EQ.0)KODE=0
GO TO 5
4 MORE=MORE+KODE-1001
5 KNT=1
I=MOST+NEXT
6 IF(MORE.LE.NEXT)GO TO 7
NEXT=NEXT+1
I=I+1
IF(I.GE.LEAST)GO TO 114
MASTER(I)=0
GO TO 6
7 IF(KODE.NE.0)INSERT=MULT+NEXT
IMOST=MOST
IF(IOPRTR.EQ.0)GO TO 8
IF(KIND.EQ.2)IRADIX=JRADIX
IF(IRADIX.NE.JRADIX)GO TO 113
GO TO 9
8 IF(KIND.EQ.2)IRADIX=KRADIX
IF(IRADIX.NE.KRADIX)GO TO 113
9 IF(IBASE.EQ.2)GO TO 10
IF(ISIGN.LT.0)ISIGN=2
GO TO 11
10 IF(ISIGN.LT.0)ISIGN=4
11 IF(KODE.LT.1001)GO TO 12
I=MOST+MORE
MASTER(I)=ITBPUT(MASTER(I),NUMBER,
1ISIGN,ISHIFT,IBASE)
GO TO 105
12 I=MOST+NMORE+MASTER(NEW)
MASTER(I)=ITBPUT(MASTER(I),MASTER(NEW-1),
1ISIGN,ISHIFT,IBASE)
NEW=NEW-2
IF(NEW.GT.NUMBER)GO TO 12
GO TO 105
C
C KODE=9 (-), SUBTRACT FOLLOWING CONSTANT
13 ISIGN=3
NSIGN=3
GO TO 109
C
C KODE=10 (+), ADD FOLLOWING CONSTANT
14 ISIGN=2
NSIGN=2
GO TO 109
C
C KODE=11 (OCT), FOLLOWING INTEGER IS OCTAL
15 IRADIX=8
GO TO 109
C
C KODE=12 (DEC), FOLLOWING INTEGER IS DECIMAL
16 IRADIX=10
GO TO 109
C
C KODE=15 (=), DEFINE SYMBOL
C KODE=37 (==), ASK FOR SYMBOL DEFINITION
17 IF(KNTWRD.NE.2)GO TO 113
IF(IADDRS.EQ.0)GO TO 113
IF(IKODE.LE.2)GO TO 18
IF(IKODE.EQ.29)GO TO 18
IF(IKODE.EQ.66)GO TO 18
IF(IKODE.LT.1001)GO TO 113
18 MOST=MOST-MULT
IMOST=MOST
IRMV=0
MULT=0
NEXT=0
INSERT=0
LOCK=0
IRADIX=JRADIX
IMASK=0
IOPRTR=15
JOPRTR=0
MASK=0
IBASE=KBASE
IADJST=KADJST
JBASE=KBASE
JADJST=KADJST
IF(KODE.EQ.15)GO TO 21
IF(ITEST.NE.0)GO TO 20
IF(IREAD.EQ.ITTY)GO TO 21
J=MASTER(IADDRS+1)+1
K=IADDRS-2
WRITE(ITTY,19)(MASTER(I),I=J,K)
19 FORMAT(35H PLEASE TYPE DEFINITION FOR SYMBOL ,40A1)
JBLANK=1
20 IOPRTR=37
C
C DUPLICATE SYMBOL IN DICTIONARY FOR = DEFINITION
21 M=0
IF(MASTER(LSTNEW).EQ.0)LEAST=LSTNEW+1
IF(IKODE.GT.2)GO TO 23
IF(IKODE.EQ.0)GO TO 22
M=1
GO TO 23
22 MASTER(IADDRS)=0
MASTER(IADDRS-1)=0
23 IKODE=IADDRS
LSTNEW=LEAST-1
IADDRS=LSTNEW
I=MASTER(IKODE+1)+1
J=IKODE-2
L=LEAST-J+I-4
IF(L.LE.MOST)GO TO 114
MASTER(LEAST)=L
MASTER(LEAST-1)=8
MASTER(LEAST-2)=0
LEAST=L
DO 24 K=I,J
L=L+1
24 MASTER(L)=MASTER(K)
IF(M.EQ.0)GO TO 25
MASTER(LSTNEW)=0
M=0
GO TO 23
25 MASTER(LEAST)=0
C
C PLACE SYMBOL CELL INTO ORDERRED PORTION OF DICTIONARY
IF(IORDER.EQ.0)GO TO 110
IF(IKODE.GT.LNGMIN)GO TO 110
M=IKODE-MASTER(IKODE+1)-2
L=M+3
IF(M.GT.20)M=20
K=LNGMIN
N=M
26 N=N+1
IF(N.GT.20)GO TO 28
IF(LENGTH(N).EQ.0)GO TO 26
K=LENGTH(N)
27 IF(LENGTH(N).NE.0)LENGTH(N)=LENGTH(N)-L
N=N+1
IF(N.LE.20)GO TO 27
28 LNGMIN=LNGMIN-L
IF(LENGTH(M).EQ.0)LENGTH(M)=K
IF(K.EQ.(IKODE+1))GO TO 110
C PATCH POINTERS TO REGION TO BE MOVED
IF(IARG.EQ.0)GO TO 29
IF(IARG.GT.K)GO TO 29
IF(IARG.GT.IKODE)IARG=IARG-L
29 IF(IIARG.EQ.0)GO TO 30
IF(IIARG.GT.K)GO TO 30
IF(IIARG.GT.IKODE)IIARG=IIARG-L
30 IF(JMASK.EQ.0)GO TO 31
IF(JMASK.GT.K)GO TO 31
IF(JMASK.GT.IKODE)JMASK=JMASK-L
31 IF(KMASK.EQ.0)GO TO 32
IF(KMASK.GE.K)GO TO 32
IF(KMASK.GT.IKODE)KMASK=KMASK-L
C PATCH POINTERS IN REGION TO BE MOVED
32 M=K
33 N=M
M=MASTER(M)
IF(M.LT.IKODE)GO TO 38
MASTER(N)=M-L
J=MASTER(N-1)
IF(J.GE.0)GO TO 35
J=-J
IF(J.GT.K)GO TO 34
IF(J.LT.IKODE)GO TO 34
MASTER(N-1)=-J+L
GO TO 33
34 MASTER(J)=L+1-N
GO TO 33
35 IF(J.EQ.1)GO TO 36
IF(J.EQ.2)GO TO 36
IF(J.EQ.8)GO TO 36
IF(J.EQ.29)GO TO 36
IF(J.NE.66)GO TO 33
36 J=-MASTER(N-2)
IF(J.LE.0)GO TO 33
IF(J.GT.K)GO TO 37
IF(J.LT.IKODE)GO TO 37
MASTER(N-2)=-J+L
GO TO 33
37 MASTER(J)=L+2-N
GO TO 33
C PATCH POINTERS TO CELL TO MOVE
38 M=MASTER(IKODE)
IF(M.EQ.1)GO TO 39
IF(M.EQ.2)GO TO 39
IF(M.EQ.8)GO TO 39
IF(M.EQ.29)GO TO 39
IF(M.NE.66)GO TO 40
39 M=-MASTER(IKODE-1)
IF(M.GT.0)MASTER(M)=2-K
IF(M.GT.K)GO TO 40
IF(M.LT.IKODE)GO TO 40
MASTER(IKODE-1)=-M+L
C PERFORM THE SWAP OF CELL AND REGION
40 LIMIT=K
NUMBER=K-IKODE-1
NEW=IKODE+1
I=MASTER(NEW)+1
J=I
MASTER(NEW)=K-L
IKODE=K-1
41 INDEX=LIMIT-L
M=MASTER(LIMIT)
42 J=J+1
N=MASTER(INDEX)
MASTER(INDEX)=M
M=N
IF(INDEX.GT.NEW)GO TO 43
INDEX=INDEX+NUMBER
GO TO 42
43 IF(INDEX.EQ.LIMIT)GO TO 44
INDEX=INDEX-L
GO TO 42
44 IF(J.GT.K)GO TO 110
LIMIT=LIMIT-1
GO TO 41
C
C KODE=17 (DMP), LIST SYMBOL DICTIONARY
C KODE=18 (DBG), LIST DICTIONARY AND ENTRIES
C KODE=19 (LST), LIST ASSEMBLED TABLE ENTRIES
45 IDBG=ILPT
CALL TBLDBG
GO TO 109
C
C KODE=29 (MSK OR PATTERN NAME), SELECT PATTERN
46 IF(MASK.EQ.0)GO TO 47
IF(NMORE.NE.0)GO TO 113
47 MASK=-NUMBER
IF(IMASK.NE.0)IMASK=MASK
KPAREN=0
MULT=MULT-MOST+IMOST
NEXT=INSERT-MULT
JMORE=JMORE+MOST-IMOST
MOST=IMOST
IF(MASK.NE.0)GO TO 49
IF(IOPRTR.NE.0)GO TO 48
IBASE=KBASE
IADJST=KADJST
GO TO 108
48 IBASE=JBASE
IADJST=JADJST
GO TO 50
49 LMASK=MASTER(MASK+1)
IF(IOPRTR.EQ.0)GO TO 108
50 IF(MASTER(IADDRS).NE.29)GO TO 108
C
C COPY POINTER CELL OF BYTE PATTERN
J=MASTER(IADDRS)
MASTER(IADDRS)=29
IF(NEW.EQ.0)GO TO 108
NEW=-MASTER(NEW-1)
IF(NEW.EQ.0)GO TO 108
I=MASTER(NEW+1)
NEW=NEW-1
IF(J.NE.29)GO TO 51
IF(MASTER(IADDRS-1).EQ.0)GO TO 51
IF(MASTER(LSTNEW).NE.0)GO TO 54
LEAST=LSTNEW+1
LSTNEW=-MASTER(IADDRS-1)
GO TO 54
51 IF(MASTER(LSTNEW).EQ.0)GO TO 52
LSTNEW=LEAST-1
LEAST=LEAST-2
GO TO 53
52 LEAST=LSTNEW-1
53 MASTER(IADDRS-1)=-LSTNEW
MASTER(LSTNEW)=-IADDRS+1
54 IF((LEAST-NEW+I).LE.MOST)GO TO 56
55 MASTER(LEAST)=MASTER(NEW)
NEW=NEW-1
LEAST=LEAST-1
IF(NEW.NE.I)GO TO 55
MASTER(LSTNEW+1)=LEAST
MASTER(LEAST)=0
GO TO 108
56 MASTER(LEAST)=0
GO TO 114
C
C KODE=31 (LFT), LEFT SHIFT
C KODE=33 (RIT), RIGHT SHIFT
57 NUMBER=-NUMBER
58 ISHIFT=NUMBER*IADJST
KSHIFT=NUMBER
GO TO 65
C
C KODE=35 (SIZ), SELECT BYTE SIZE
59 IF(NUMBER.LT.2)GO TO 113
IBASE=2
60 I=NUMBER
IADJST=0
GO TO 62
61 I=J
IADJST=IADJST+1
IF(I.EQ.1)GO TO 63
62 J=I/IBASE
IF(I.EQ.(IBASE*J))GO TO 61
IBASE=IBASE+1
IF(IBASE.LT.18)GO TO 60
IADJST=1
IBASE=NUMBER
63 ISHIFT=KSHIFT*IADJST
IF(IOPRTR.NE.0)GO TO 64
IF(MASK.NE.0)GO TO 106
IF(KPAREN.GT.0)GO TO 106
KBASE=IBASE
KADJST=IADJST
GO TO 109
64 JBASE=IBASE
JADJST=IADJST
IF(MASTER(IADDRS).EQ.29)MASK=0
65 IF(KPAREN.GT.0)GO TO 106
IF(IOPRTR.NE.0)GO TO 109
IF(MASK.NE.0)GO TO 106
GO TO 109
C
C KODE=38 (IOR), INCLUSIVE OR FOLLOWING CONSTANT
66 ISIGN=4
NSIGN=4
GO TO 109
C
C KODE=41 (BIT), TURN ON BIT IN FOLLOWING ADDRESS
67 IF(NUMBER.LE.0)GO TO 113
ISHIFT=NUMBER
IOPRTR=KODE
GO TO 109
C
C KODE=43 (DUP), DUPLICATE ENTRIES FROM STATEMENT
68 IF(NUMBER.LE.0)GO TO 113
IF((LEAST-MOST-NUMBER).LT.0)GO TO 114
IREPT=NUMBER-1
GO TO 109
C
C KODE=45 (SRX), SET RADIX FOR RANGE OF =
C KODE=47 (TRX), SET RADIX FOR TABLE ENTRIES
69 IF(NUMBER.LT.2)GO TO 113
IF(NUMBER.GT.16)GO TO 113
IF(KODE.EQ.45)GO TO 70
KRADIX=NUMBER
GO TO 71
70 JRADIX=NUMBER
IF(IOPRTR.EQ.0)GO TO 109
71 IRADIX=NUMBER
GO TO 109
C
C KODE=49 (WID), SET DATA STATEMENT FIELD WIDTH
72 IF(NUMBER.LT.0)GO TO 113
IF(NUMBER.GT.66)GO TO 113
KLM=NUMBER
GO TO 109
C
C KODE=51 (CLM), SET DATA STATEMENT COLUMN WIDTH
73 IF(NUMBER.LT.0)GO TO 113
IF(NUMBER.GT.(KLM-13))GO TO 113
IWIDE=NUMBER
GO TO 109
C
C KODE=53 (TST), SET TEST SWITCH
74 IF(NUMBER.LT.0)GO TO 113
ITEST=NUMBER
GO TO 109
C
C KODE=54 ( OR ((, START CONSTANT SHIFT PHRASE
75 IF(KPAREN.GT.0)GO TO 109
KPAREN=1
IPAREN=ISIGN
JPAREN=MORE
GO TO 80
C
C KODE=55 ), END CONSTANT SHIFT PHRASE
76 IF(KPAREN.LE.0)GO TO 77
KPAREN=0
GO TO 108
C
C KODE=56 ) OR )), END BYTE MASK ARGUMENT LIST
77 KPAREN=0
IF(MASK.EQ.0)GO TO 108
78 MASK=MASK-2
IF(MASK.LT.LMASK)GO TO 79
IF(MASTER(MASK+1).NE.0)GO TO 78
79 MASK=MASK+2
GO TO 108
C
C KODE=57 (NUL), NULL ARGUMENT OF BYTE PATTERN
80 KNT=1
I=MOST+NEXT
81 INSERT=MULT+NEXT
IMOST=MOST
IF(MORE.LE.NEXT)GO TO 108
I=I+1
IF(I.GE.LEAST)GO TO 114
NEXT=NEXT+1
MASTER(I)=0
GO TO 81
C
C KODE=59 (WRD), DEPOSIT CONSTANT IN FOLLOWING ENTRY
82 IF(NUMBER.LE.0)GO TO 113
MORE=NUMBER
NMORE=MORE
GO TO 109
C
C KODE=63 (FIL), SET LENGTH TO WHICH FILL TABLE
83 IFILL=NUMBER
GO TO 109
C
C KODE=65 (PRC), CHANGE PRECISION FOR BIT OPERATOR
84 IF(NUMBER.EQ.0)GO TO 113
IPRCN=NUMBER
GO TO 109
C
C KODE=75 (BSZ), SELECT BYTE SIZE FOR BIT OPERATOR
85 IF(NUMBER.LT.2)GO TO 113
IBYTE=2
86 I=NUMBER
JBYTE=0
GO TO 88
87 I=J
JBYTE=JBYTE+1
IF(I.EQ.1)GO TO 109
88 J=I/IBYTE
IF(I.EQ.(IBYTE*J))GO TO 87
IBYTE=IBYTE+1
IF(IBYTE.LT.18)GO TO 86
JBYTE=1
IBYTE=NUMBER
GO TO 109
C
C KODE=80 (LMT), SET MAXIMUM NUMBER OF TEXT REPLACEMENTS
89 ILOOP=NUMBER
GO TO 109
C
C KODE=83 (EAC)
90 IAC=0
GO TO 109
C
C KODE=120 (NSV)
91 KNSN=NUMBER
GO TO 109
C
C KODE=123 (JST)
92 IF(NUMBER.LT.0)GO TO 113
JSTFY=NUMBER
GO TO 109
C
C KODE=124 (XOR)
93 ISIGN=0
NSIGN=0
GO TO 109
C
C KODE=125 (AND)
94 ISIGN=1
NSIGN=1
GO TO 109
C
C KODE=127 (PFX)
95 IPFX=NUMBER
IF(IPFX.LT.0)GO TO 109
IF(IOPRTR.EQ.15)GO TO 109
IF(IOPRTR.NE.37)JPFX=IPFX
GO TO 109
C
C KODE=134 (BAC)
96 IAC=1
GO TO 109
C
C KODE=135 (BOD)
97 IORDER=1
GO TO 109
C
C KODE=136 (EOD)
98 IORDER=0
GO TO 109
C
C OPERATORS, SUCH AS DO-IF CLASS, WHICH HAVE HAD A
C VALUE SUPPLIED, AND STILL NEED ANOTHER ARGUMENT.
99 IF(NUMBER.LT.0)GO TO 113
C
C OPERATORS, SUCH AS INC RED AND DEF, WHICH HAVE
C HAD A POSSIBLY NEGATIVE VALUE SUPPLIED, AND WHICH
C STILL NEED ANOTHER ARGUMENT
100 IVALUE=NUMBER
C
C OPERATORS, SUCH AS LFT AND RIT, WHICH COULD HAVE BEEN
C USED WITH PREFIX, BUT INSTEAD STILL NEED AN ARGUMENT
101 KSIGN=0
LSIGN=0
JVALUE=0
C
C OPERATORS, SUCH AS LOC AND TON, WHICH STILL NEED AN
C ARGUMENT BUT DO NOT TERMINATE STATEMENT
102 IOPRTR=KODE
GO TO 109
C
C OPERATORS WHICH TERMINATE PREVIOUS STATEMENT
C 14=XSY,20=BLK,21=FIN,22=SAV,24=TEL,25=TTY,27=IFE,
C 28=IFN
103 IOPRTR=KODE
KSIGN=0
LSIGN=0
JVALUE=0
GO TO 111
104 JOPRTR=KODE
GO TO 111
C
C INDICATE THAT SOMETHING HAS BEEN DEPOSITED INTO ENTRY
105 LOCK=2
GO TO 108
C
C ERROR MESSAGES (MOST ERRORS DON'T NEED THESE)
106 WRITE(ITTY,107)
107 FORMAT(1X,39HSHIFT OR BYTE SPECIFICATION NOT ALLOWED)
GO TO 113
C
C SET SWITCH TO DETERMINE POINT TRANSFERRED TO IN
C MAIN PROGRAM. ONLY VALUES 3, 5, 6, 8 AND 9 HAVE
C SIGNIFICANCE AFTER THE TRANSFER.
C
C KODE = 1, SET DEFAULT SHIFT AND SIGN, THEN SEARCH
C FOR NEXT SYMBOL.
C = 2, SEARCH FOR NEXT SYMBOL RETAINING SHIFT
C AND SIGN.
C = 4, SWAP SELECTED AND DESELECTED BUFFERS.
C FOR DEFINITION BY = OR ==
C = 5, CALL TBLCEL TO STORE INFORMATION
C CONCERNING ADDRESS OF LABEL WHICH DOES
C NOT APPEAR FIRST IN STATEMENT.
C = 6, CALL TBLCEL TO TURN BIT ON IN KNOWN
C ENTRY AND TO REPAIR LOC LIST FOR
C STATEMENTS LIKE B LOC A,10BIT B
C = 7, FORCE END OF STATEMENT WITHOUT DESTROYING
C VALUE OF IOPRTR.
C = 8, CALL TBLCEL TO ASSIGN LOCATION TO LABEL
C AND INSERT VALUE WHERE PREVIOUSLY
C REQUESTED.
C = 9, INSERT NEW DATA INTO CELL WITH ID AT NEW
C = 10, A NON-FATAL ERROR HAS BEEN DETECTED.
C = 11, A FATAL (ARRAY SPACE FULL) ERROR
C HAS BEEN DETECTED.
108 KODE=1
GO TO 115
109 KODE=2
GO TO 115
110 KODE=4
GO TO 115
111 KODE=7
GO TO 115
112 KODE=8
GO TO 115
113 KODE=10
GO TO 115
114 KODE=11
115 RETURN
END