Trailing-Edge
-
PDP-10 Archives
-
decuslib10-02
-
43,50250/tblopr.f4
There are no other files named tblopr.f4 in the archive.
SUBROUTINE TBLOPR
C
C TBLTRN ROUTINE TO IDENTIFY AND PERFORM OPERATION
C INDICATED BY SYMBOL 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
C ***********************************
C * SYMBOL IN RANGE OF OPERATOR *
C ***********************************
C
GO TO(153,153,137,153,153,153,153,153,153,153,153,153,
123,33,36,153,153,153,153,153,153,153,153,144,153,153,
22,2,153,2,153,2,153,2,153,153,36,153,111,2,67,2,153,
32,153,2,153,2,153,2,153,2,153,153,153,153,153,2,153,
42,2,2,153,2,153,153,153,75,153,77,76,153,85,2,153,
586,88,90,2,153,32,2,153,2,129,89,87,2,2,2,
62,2,2,2,2,2,99,2,100,2,102,2,104,2,103,2,101,
72,107,2,108,2,109,2,2,2,2,153,2,153,153,2,153,153,
8153,2,153,2,112,2,124,2,143,153,153,153),IOPRTR
C
C *************************************
C * OPERATORS WHICH CAN TAKE PREFIX *
C *************************************
C
1 KNTWRD=KNTWRD-1
IF(KODE.EQ.45)GO TO 155
IF(KODE.EQ.47)GO TO 153
2 IF(KODE.EQ.66)GO TO 13
IF(KODE.GE.1001)GO TO 9
IF(KODE.LE.2)GO TO 15
IF(KODE.EQ.54)GO TO 7
IF(KODE.EQ.55)GO TO 8
IF(KODE.EQ.11)GO TO 155
IF(KODE.EQ.12)GO TO 155
IF(KODE.EQ.47)GO TO 155
IF(KODE.EQ.125)GO TO 3
IF(KODE.EQ.127)GO TO 155
IF(KODE.EQ.10)GO TO 4
IF(KODE.EQ.9)GO TO 5
IF(KODE.EQ.38)GO TO 6
IF(KODE.NE.124)GO TO 153
C
C SIGNS + - IOR
KSIGN=1
GO TO 147
3 KSIGN=2
GO TO 147
4 KSIGN=3
GO TO 147
5 KSIGN=4
GO TO 147
6 KSIGN=5
GO TO 147
C
C PARENTHESIS
7 LSIGN=1+KSIGN
GO TO 147
8 IF(LSIGN.EQ.0)GO TO 153
NUMBER=JVALUE
GO TO 22
C
C SINGLE ENTRY CONSTANT
9 IF(KIND.NE.2)GO TO 11
IF(IOPRTR.EQ.15)GO TO 10
IF(IOPRTR.EQ.37)GO TO 10
IRADIX=KRADIX
GO TO 18
10 IRADIX=JRADIX
GO TO 18
11 IF(IPFX.LT.0)GO TO 12
IF(IPFX.EQ.0)GO TO 18
IF(IPFX.NE.(KODE-1000))GO TO 15
GO TO 18
12 NUMBER=KODE-1000
GO TO 18
C
C MULTIPLE ENTRY CONSTANT
13 NUMBER=-NUMBER-1
IF(IPFX.LT.0)GO TO 16
IF(IPFX.EQ.0)GO TO 17
I=MASTER(NUMBER+2)
14 IF(IPFX.EQ.MASTER(NUMBER))GO TO 17
IF(IPFX.GT.MASTER(NUMBER))GO TO 15
NUMBER=NUMBER-2
IF(NUMBER.GT.I)GO TO 14
15 NUMBER=0
GO TO 18
16 NUMBER=MASTER(NUMBER)
GO TO 18
17 NUMBER=MASTER(NUMBER-1)
C
C PROCESS UNLESS UNBALANCED PARENTHESES
18 IF(LSIGN.EQ.0)GO TO 21
KSIGN=KSIGN-1
IF(KSIGN.GE.0)GO TO 19
KSIGN=2
IF(IBASE.EQ.2)KSIGN=4
19 JVALUE=ITBPUT(JVALUE,NUMBER,KSIGN,0,2)
KSIGN=LSIGN-1
IF(IOPRTR.EQ.15)GO TO 20
IF(IOPRTR.NE.37)GO TO 147
20 IF(KNTWRD.NE.3)GO TO 147
MASTER(IADDRS)=JOPRTR+1
MASTER(IADDRS-1)=JVALUE
GO TO 147
21 IF(KSIGN.EQ.4)NUMBER=-NUMBER
IF(KSIGN.EQ.2)NUMBER=0
22 IF(IOPRTR.EQ.15)GO TO 39
IF(IOPRTR.EQ.37)GO TO 39
IF(IOPRTR.EQ.27)GO TO 79
IF(IOPRTR.EQ.60)GO TO 80
IF(IOPRTR.EQ.28)GO TO 81
IF(IOPRTR.EQ.82)GO TO 82
IF(IOPRTR.EQ.61)GO TO 83
IF(IOPRTR.EQ.84)GO TO 84
IF(IOPRTR.EQ.89)GO TO 93
IF(IOPRTR.EQ.91)GO TO 94
IF(IOPRTR.EQ.115)GO TO 95
IF(IOPRTR.EQ.93)GO TO 96
IF(IOPRTR.EQ.117)GO TO 97
IF(IOPRTR.EQ.95)GO TO 98
KODE=IOPRTR+1
IOPRTR=0
GO TO 155
C
C ************************************
C * ADDRESS FOLLOWING LOC OPERATOR *
C ************************************
C
23 KNT=1
IOPRTR=0
I=MOST+NEXT
IF(IBASE.EQ.2)GO TO 24
IF(ISIGN.LT.0)ISIGN=2
GO TO 25
24 IF(ISIGN.LT.0)ISIGN=4
25 IF(MORE.LE.NEXT)GO TO 26
NEXT=NEXT+1
I=I+1
IF(I.GE.LEAST)GO TO 154
MASTER(I)=0
GO TO 24
26 INSERT=MULT+NEXT
IMOST=MOST
IF(KODE.EQ.16)GO TO 30
IF(KODE.EQ.2)GO TO 29
IF(KODE.EQ.1)GO TO 27
IF(KODE.NE.0)GO TO 153
MASTER(NEW)=1
27 IF(IBASE.GT.17)GO TO 62
C REMOVE FOLLOWING TEST IF UNKNOWN ADDRESS LABEL
C REFERENCE INFORMATION IS NOT TO BE STORED
C WITHIN THE ASSEMBLED TABLE.
IF(LOCK.EQ.0)GO TO 28
C
C UNKNOWN ADDRESS IN ENTRY WITH OTHER CONTENTS
LOCK=2
GO TO 148
C
C INITIAL CONTENT OF TABLE ENTRY IS UNKNOWN ADDRESS
28 IADDRS=NEW
JSIGN=ISIGN
JBASE=IBASE
JSHIFT=ISHIFT
JMORE=MORE
LOCK=1
GO TO 146
C
C LABEL OF KNOWN ADDRESS
29 IF(NUMBER.GE.0)GO TO 31
NUMBER=-NUMBER-1
NUMBER=MASTER(NUMBER)
GO TO 31
30 NUMBER=MOST+MORE
31 I=MOST+MORE
MASTER(I)=ITBPUT(MASTER(I),NUMBER,ISIGN,ISHIFT,
1IBASE)
GO TO 145
C
C ******************************************
C * SYMBOL FOLLOWING XSY OR XAD OPERATOR *
C ******************************************
C
C XAD OPERATOR
32 IF(NEW.EQ.0)GO TO 147
IF(KODE.EQ.1)GO TO 153
IF(KODE.EQ.2)GO TO 34
GO TO 147
C XSY OPERATOR
33 IF(NEW.EQ.0)GO TO 147
IF(KODE.LE.2)GO TO 147
IF(KODE.EQ.29)GO TO 34
IF(KODE.EQ.66)GO TO 34
IF(KODE.NE.8)GO TO 35
34 IF(NUMBER.GE.0)GO TO 35
NUMBER=-NUMBER
IF(IARG.EQ.NUMBER)IARG=0
IF(IIARG.EQ.NUMBER)IIARG=0
IF(IMASK.EQ.NUMBER)IMASK=0
MASTER(NUMBER)=0
IF(NUMBER.GT.KSIGN)KSIGN=NUMBER+1
35 MASTER(NEW)=0
IF(NEW.GT.KSIGN)KSIGN=NEW+1
GO TO 147
C
C ****************************************
C * SYMBOL FOLLOWING = OR == OPERATORS *
C ****************************************
C
36 IF(KODE.GT.2)GO TO 37
IF(KODE.NE.0)GO TO 153
IF(NEW.NE.IKODE)GO TO 153
IF(JOPRTR.NE.0)GO TO 18
KODE=1001
KIND=2
C
C TEST FOR OPERATOR WHICH HAS FOLLOWING CONSTANT
37 IF(JOPRTR.NE.0)GO TO 1
IF(NUMBER.NE.0)GO TO 40
I=0
38 I=I+1
IF(JKODE(I).EQ.0)GO TO 40
IF(JKODE(I).NE.KODE)GO TO 38
JOPRTR=KODE
KSIGN=0
LSIGN=0
JVALUE=0
GO TO 42
C
C SYMBOL RIGHT OF OPERATORS WHICH CAN TAKE INTEGER
C PREFIX IN RANGE OF = OR ==
39 KODE=JOPRTR+1
JOPRTR=0
C
C TEST FOR SYMBOLS THAT CAN BE IN BYTE PATTERN
C DEFINITIONS
C KODE= 9, -
C =10, +
C =11, OCT
C =12, DEC
C =16, . (SINGLE PERIOD)
C =29, ANOTHER BYTE PATTERN
C =31, LFT WITH PREFIX
C =33, RIT WITH PREFIX
C =35, SIZ WITH PREFIX
C =38, IOR
C =45, SRX WITH PREFIX
C =59, WRD WITH PREFIX
C =67, ARG
C =127, PFX WITH PREFIX
C =124, XOR
C =125, AND
40 IF(MASTER(IADDRS).NE.29)GO TO 42
IF(KPAREN.LT.0)GO TO 46
IF(KODE.EQ.9)GO TO 155
IF(KODE.EQ.10)GO TO 155
IF(KODE.EQ.11)GO TO 155
IF(KODE.EQ.12)GO TO 155
IF(KODE.EQ.38)GO TO 155
IF(KODE.EQ.45)GO TO 155
IF(KODE.EQ.127)GO TO 155
IF(KODE.EQ.124)GO TO 155
IF(KODE.EQ.125)GO TO 155
C FOLLOWING CAN'T BE IN PHRASE AFTER ARG
41 IF(KODE.EQ.16)GO TO 58
IF(KODE.EQ.29)GO TO 45
IF(KODE.EQ.31)GO TO 60
IF(KODE.EQ.33)GO TO 59
IF(KODE.EQ.35)GO TO 155
IF(KODE.EQ.59)GO TO 155
IF(KODE.EQ.67)GO TO 64
LSTNEW=IADDRS
LEAST=MASTER(IADDRS+1)
MASTER(LEAST)=0
MASTER(IADDRS)=1001
MASTER(IADDRS-1)=0
C
C DEFINE AS EQUAL FIRST SYMBOL IN DEFINITION
42 IF(KNTWRD.NE.3)GO TO 43
MASTER(IADDRS)=KODE
MASTER(IADDRS-1)=NUMBER
IF(KODE.EQ.29)MASTER(IADDRS-1)=0
IF(KODE.EQ.66)MASTER(IADDRS-1)=0
C
C TEST FOR SYMBOLS THAT CAN BE IN PHRASES
C KODE= 9, -
C =10, +
C =11, OCT
C =12, DEC
C =29, BYTE PATTERN
C =31, LFT WITH PREFIX
C =33, RIT WITH PREFIX
C =35, SIZ WITH PREFIX
C =38, IOR
C =45, SRX WITH PREFIX
C =54, ( OR ((
C =55, )
C =56, ))
C =57, NUL
C =59, WRD WITH PREFIX
C =127, PFX WITH PREFIX
C =124, XOR
C =125, AND
43 IF(KODE.EQ.9)GO TO 155
IF(KODE.EQ.10)GO TO 155
IF(KODE.EQ.11)GO TO 155
IF(KODE.EQ.12)GO TO 155
IF(KODE.EQ.29)GO TO 45
IF(KODE.EQ.31)GO TO 155
IF(KODE.EQ.33)GO TO 155
IF(KODE.EQ.35)GO TO 155
IF(KODE.EQ.38)GO TO 155
IF(KODE.EQ.45)GO TO 155
IF(KODE.EQ.54)GO TO 155
IF(KODE.EQ.55)GO TO 155
IF(KODE.EQ.56)GO TO 155
IF(KODE.EQ.57)GO TO 155
IF(KODE.EQ.59)GO TO 155
IF(KODE.EQ.66)GO TO 155
IF(KODE.EQ.127)GO TO 155
IF(KODE.EQ.124)GO TO 155
IF(KODE.EQ.125)GO TO 155
IF(KODE.GT.1000)GO TO 44
IF(JOPRTR.NE.0)GO TO 147
IF(KNTWRD.NE.3)GO TO 153
IERR=-1
GO TO 147
44 IF(KIND.NE.2)GO TO 155
IF(NEW.EQ.0)GO TO 155
IF(IRADIX.NE.JRADIX)GO TO 153
MORE=1
GO TO 155
45 KODE=16
GO TO 155
C
C TEST FOR SYMBOLS WHICH CAN FOLLOW ARG OPERATOR
C KODE= 9, -
C KODE=10, +
C =11, OCT
C =12, DEC
C =38, IOR
C =45, SRX WITH PREFIX
C =54, ( OR ((
C =55, )
C =56, ))
C =57, NUL SIMULATED AS ZERO
C =66 OR 1001 OR GREATER, CONSTANT
C =127, PFX WITH PREFIX
C =124, XOR
C =125, AND
46 IF(KODE.EQ.9)GO TO 50
IF(KODE.EQ.10)GO TO 49
IF(KODE.EQ.11)GO TO 155
IF(KODE.EQ.12)GO TO 155
IF(KODE.EQ.38)GO TO 51
IF(KODE.EQ.45)GO TO 155
IF(KODE.EQ.54)GO TO 52
IF(KODE.EQ.55)GO TO 55
IF(KODE.EQ.56)GO TO 55
IF(KODE.EQ.57)GO TO 56
IF(KODE.EQ.66)GO TO 53
IF(KODE.EQ.127)GO TO 155
IF(KODE.EQ.124)GO TO 47
IF(KODE.EQ.125)GO TO 48
IF(KODE.GT.1000)GO TO 54
IF(KPAREN.LE.-2)GO TO 153
KPAREN=0
GO TO 41
47 IF(KPAREN.EQ.-1)IPAREN=0
GO TO 155
48 IF(KPAREN.EQ.-1)IPAREN=1
GO TO 155
49 IF(KPAREN.EQ.-1)IPAREN=2
GO TO 155
50 IF(KPAREN.EQ.-1)IPAREN=3
GO TO 155
51 IF(KPAREN.EQ.-1)IPAREN=4
GO TO 155
52 IF(KPAREN.EQ.-1)KPAREN=-2
GO TO 147
53 ISIGN=MASTER(NEW-1)
GO TO 57
54 ISIGN=-NEW
IF(KIND.NE.2)GO TO 57
IF(NEW.EQ.0)IRADIX=JRADIX
GO TO 56
55 IF(KPAREN.EQ.-1)GO TO 153
I=KPAREN
KPAREN=0
IF(I.EQ.-3)GO TO 146
56 ISIGN=-MAX
57 IF(IRADIX.NE.JRADIX)GO TO 153
IF(KPAREN.EQ.-2)KPAREN=-3
GO TO 66
C
C ORIGIN INCREMENT COMMAND IN MASK DEFINITION
58 ISIGN=-1
GO TO 66
C
C SHIFT IN MASK DEFINITION
59 NUMBER=-NUMBER
60 IF(NUMBER.EQ.0)GO TO 61
IF(JBASE.GT.17)GO TO 62
61 ISHIFT=NUMBER*JADJST
KSHIFT=NUMBER
GO TO 147
62 WRITE(ITTY,63)
63 FORMAT(1X,28HBYTE SPECIFICATION TOO LARGE)
GO TO 153
C
C ARGUMENT SPECIFICATION IN MASK DEFINITION
64 KPAREN=-1
IBASE=JBASE
IADJST=JADJST
IF(NSIGN.GE.0)GO TO 65
ISIGN=4
IF(IBASE.NE.2)ISIGN=2
65 IPAREN=ISIGN
JPAREN=NMORE
IF(JPAREN.EQ.0)JPAREN=1
66 NEW=IADDRS
GO TO 148
C
C **************************************
C * ADDRESS IN RANGE OF BIT OPERATOR *
C **************************************
C
67 IOPRTR=0
IF(IRADIX.NE.KRADIX)GO TO 153
IF(KPAREN.GT.0)GO TO 68
IF(MASK.NE.0)MASK=MASK+2
C
C ADJUST ISHIFT AND MORE FOR MULTIPLE PRECISION
C OR REVERSE (LEFT TO RIGHT) BIT NUMBERING
68 MORE=NMORE
IF(MORE.EQ.0)MORE=1
I=IPRCN
IF(IPRCN.GT.0)GO TO 70
IF(IPRCN.EQ.0)GO TO 153
69 I=I-IPRCN
ISHIFT=ISHIFT+IPRCN
IF(ISHIFT.GT.0)GO TO 69
ISHIFT=I-ISHIFT+1
I=-IPRCN
70 IF(ISHIFT.LE.I)GO TO 71
MORE=MORE+1
ISHIFT=ISHIFT-I
GO TO 70
71 ISHIFT=JBYTE*(ISHIFT-1)
IF(KODE.NE.16)GO TO 74
C
C DEPOSIT BIT IN PRESENT ENTRY
I=MOST+NEXT
72 IF(MORE.LE.NEXT)GO TO 73
NEXT=NEXT+1
I=I+1
IF(I.GE.LEAST)GO TO 154
MASTER(I)=0
GO TO 72
73 INSERT=MULT+NEXT
IMOST=MOST
I=MOST+MORE
J=4
IF(IBYTE.NE.2)J=2
IF(JBYTE.NE.1)J=2
MASTER(I)=ITBPUT(MASTER(I),1,J,ISHIFT,IBYTE)
GO TO 145
C
C CALL TBLCEL TO DEPOSIT BIT IN KNOWN ENTRY
74 IF(KODE.EQ.2)GO TO 149
C
C CALL TBLCEL TO DEPOSIT BIT IN UNKNOWN ENTRY
IF(KODE.GT.2)GO TO 153
ISIGN=-1
MASTER(NEW)=1
GO TO 148
C
C **************************************************
C * ADDRESS IN RANGE OF LOA ADR OR HIA OPERATORS *
C **************************************************
C
75 MORE=1
GO TO 78
76 MORE=-MULT+1
GO TO 78
77 MORE=NEXT
IF(MORE.EQ.0)MORE=1
78 IOPRTR=0
MORE=MORE+NMORE-1
IF(NMORE.EQ.0)MORE=MORE+1
IF(KODE.LE.2)GO TO 151
GO TO 153
C
C *******************************************
C * SYMBOL IN RANGE OF IF CLASS OPERATORS *
C *******************************************
C
79 IF(NUMBER.EQ.0)GO TO 92
GO TO 91
80 IF(NUMBER.NE.0)GO TO 92
GO TO 91
81 IF(NUMBER.EQ.0)GO TO 92
82 IF(NUMBER.LT.0)GO TO 92
GO TO 91
83 IF(NUMBER.EQ.0)GO TO 92
84 IF(NUMBER.GT.0)GO TO 92
GO TO 91
85 IF(KODE.NE.0)GO TO 92
GO TO 91
86 IF(KODE.EQ.0)GO TO 92
GO TO 91
87 IF(KODE.EQ.0)GO TO 92
88 IF(KODE.EQ.1)GO TO 92
IF(KODE.EQ.2)GO TO 92
GO TO 91
89 IF(KODE.EQ.0)GO TO 92
90 IF(KODE.GT.2)GO TO 92
91 IFKNT=1
92 JFKNT=JFKNT+1
IOPRTR=0
GO TO 150
C
C **********************************************
C * SYMBOL IN RANGE OF DO-IF CLASS OPERATORS *
C **********************************************
C
93 IF(NUMBER.EQ.0)GO TO 106
GO TO 105
94 IF(NUMBER.NE.0)GO TO 106
GO TO 105
95 IF(NUMBER.EQ.0)GO TO 106
96 IF(NUMBER.LT.0)GO TO 106
GO TO 105
97 IF(NUMBER.EQ.0)GO TO 106
98 IF(NUMBER.GT.0)GO TO 106
GO TO 105
99 IF(KODE.NE.0)GO TO 106
GO TO 105
100 IF(KODE.EQ.0)GO TO 106
GO TO 105
101 IF(KODE.EQ.0)GO TO 106
102 IF(KODE.EQ.1)GO TO 106
IF(KODE.EQ.2)GO TO 106
GO TO 105
103 IF(KODE.EQ.0)GO TO 106
104 IF(KODE.GT.2)GO TO 106
105 ISKIP=IVALUE
106 IOPRTR=0
GO TO 147
C
C ***********************************************
C * SYMBOLS IN RANGE OF RED INC DEF OPERATORS *
C ***********************************************
C
107 IF(KODE.LT.1001)GO TO 153
IF(KIND.EQ.2)GO TO 153
MASTER(NEW-1)=MASTER(NEW-1)-IVALUE
GO TO 119
108 IF(KODE.LT.1001)GO TO 153
IF(KIND.EQ.2)GO TO 153
MASTER(NEW-1)=MASTER(NEW-1)+IVALUE
GO TO 119
109 IF(KODE.LE.2)GO TO 115
IF(KODE.EQ.66)GO TO 110
IF(KODE.LT.1001)GO TO 153
IF(KIND.EQ.2)GO TO 153
GO TO 118
110 MASTER(NEW)=1001
MASTER(NEW-1)=IVALUE
NUMBER=-NUMBER+1
IOPRTR=0
GO TO 152
C
C ****************************************
C * PACKING PATTERN AFTER TON OPERATOR *
C ****************************************
C
111 IF(KODE.NE.29)GO TO 153
IMASK=1
IOPRTR=0
GO TO 155
C
C *************************************
C * SYMBOL IN RANGE OF STK OPERATOR *
C *************************************
C
112 IOPRTR=0
IF(KODE.EQ.66)GO TO 120
IF(KODE.LE.2)GO TO 115
IF(KODE.LT.1001)GO TO 153
C
C SINGLE ENTRY CONSTANT
IF(KIND.EQ.2)GO TO 153
IF(NUMBER.NE.0)GO TO 113
MASTER(NEW)=KODE+1
MASTER(NEW-1)=IVALUE
GO TO 147
113 J=KODE-1000
I=J+1
114 IF(MASTER(LSTNEW).EQ.0)LEAST=LSTNEW+1
LSTNEW=LEAST-1
IF((LEAST-6).LE.(MOST+NEXT))GO TO 154
LEAST=LEAST-6
MASTER(LSTNEW+1)=LEAST
MASTER(LSTNEW)=-NEW+1
MASTER(LSTNEW-1)=I
MASTER(LSTNEW-2)=IVALUE
MASTER(LSTNEW-3)=J
MASTER(LSTNEW-4)=NUMBER
MASTER(LEAST)=0
MASTER(NEW)=66
MASTER(NEW-1)=-LSTNEW
GO TO 147
C
C ADDRESS LABEL OR UNDEFINED
115 IF(KODE.EQ.0)GO TO 117
IF(MASTER(LSTNEW).EQ.0)LEAST=LSTNEW+1
LSTNEW=LEAST-1
I=LSTNEW+MASTER(NEW+1)-NEW
IF(I.LE.(MOST+NEXT))GO TO 154
MASTER(LEAST)=I
MASTER(I)=0
NEW=NEW-2
LEAST=LEAST-3
116 MASTER(LEAST)=MASTER(NEW)
LEAST=LEAST-1
NEW=NEW-1
IF(LEAST.NE.I)GO TO 116
NEW=LSTNEW
117 MASTER(NEW)=1001
118 MASTER(NEW-1)=IVALUE
119 IOPRTR=0
GO TO 147
C
C ALREADY MULTIPLE ENTRY CONSTANT
120 NEW=-NUMBER
IF(MASTER(NEW-2).NE.0)GO TO 121
MASTER(NEW-1)=MASTER(NEW-1)+1
MASTER(NEW-2)=IVALUE
GO TO 147
121 NUMBER=MOST+NEXT+2
IF(NUMBER.GE.LEAST)GO TO 154
I=MASTER(NEW+1)+1
MASTER(NUMBER-1)=MASTER(I)
MASTER(NUMBER)=MASTER(I+1)
122 I=I+2
IF(I.GE.NEW)GO TO 123
MASTER(I-2)=MASTER(I)
MASTER(I-1)=MASTER(I+1)
GO TO 122
123 MASTER(I-2)=IVALUE
MASTER(I-1)=MASTER(I-1)+1
GO TO 152
C
C *************************************
C * SYMBOL IN RANGE OF PSH OPERATOR *
C *************************************
C
124 IOPRTR=0
IF(KODE.EQ.66)GO TO 126
IF(KODE.LE.2)GO TO 115
IF(KODE.LT.1001)GO TO 153
C
C SINGLE ENTRY CONSTANT
IF(KIND.EQ.2)GO TO 153
IF(IVALUE.EQ.0)GO TO 125
I=NUMBER
NUMBER=IVALUE
IVALUE=I
J=1
I=KODE-999
GO TO 114
125 MASTER(NEW)=KODE+1
GO TO 147
C
C ALREADY MULTIPLE ENTRY CONSTANT
126 NEW=-NUMBER
J=NEW+1
I=MASTER(J)
127 J=J-2
IF(J.LE.I)GO TO 128
MASTER(J)=MASTER(J)+1
GO TO 127
128 IF(IVALUE.EQ.0)GO TO 147
NUMBER=MOST+NEXT+2
IF(NUMBER.GE.LEAST)GO TO 154
MASTER(NUMBER)=1
MASTER(NUMBER-1)=IVALUE
GO TO 152
C
C *************************************
C * SYMBOL IN RANGE OF ROT OPERATOR *
C *************************************
C
129 IOPRTR=0
IF(KODE.EQ.66)GO TO 130
IF(KODE.LE.2)GO TO 147
IF(KODE.LT.1001)GO TO 153
C
C SINGLE ENTRY CONSTANT
IF(KIND.EQ.2)GO TO 153
IF(KODE.EQ.1001)GO TO 147
IF(NUMBER.EQ.0)GO TO 147
IVALUE=0
MASTER(NEW)=KODE-1
I=KODE-1000
J=1
GO TO 114
C
C MULTIPLE ENTRY CONSTANT
130 NEW=-NUMBER
NUMBER=MASTER(NEW+1)
I=NEW-3
131 MASTER(I)=MASTER(I)+1
I=I-2
IF(I.GT.NUMBER)GO TO 131
IF(MASTER(NEW-2).NE.0)GO TO 134
IF(MASTER(NEW-1).NE.MASTER(NEW-3))GO TO 147
IF((NEW-5).EQ.NUMBER)GO TO 133
C TOP WORD ZERO, SECOND FROM TOP NON-ZERO
C AND AT LEAST ONE OTHER NON-ZERO WORD
I=NEW-3
132 MASTER(I+2)=MASTER(I)
MASTER(I+1)=MASTER(I-1)
I=I-2
IF(I.GT.NUMBER)GO TO 132
NUMBER=NUMBER+2
MASTER(NEW+1)=NUMBER
MASTER(NUMBER)=NUMBER-2
GO TO 152
C TOP WORD ZERO, SECOND FROM TOP ONLY
C NON-ZERO WORD
133 NUMBER=NEW+1
NEW=-MASTER(NEW)+1
MASTER(NEW)=1000+MASTER(NUMBER-4)
MASTER(NEW-1)=MASTER(NUMBER-5)
GO TO 152
134 IF(MASTER(NEW-1).NE.MASTER(NEW-3))GO TO 136
C ROTATE CONTENTS IF TOP 2 WORDS NON-ZERO
I=NEW-3
J=MASTER(NEW-1)
J=MASTER(NEW-2)
135 MASTER(I+2)=MASTER(I)
MASTER(I+1)=MASTER(I-1)
I=I-2
IF(I.GT.NUMBER)GO TO 135
MASTER(I+2)=1
MASTER(I+1)=J
GO TO 147
C TOP WORD NON-ZERO, SECOND FROM TOP ZERO
136 NUMBER=MOST+NEXT+2
IF(NUMBER.GE.LEAST)GO TO 154
MASTER(NUMBER)=1
MASTER(NUMBER-1)=MASTER(NEW-2)
MASTER(NEW-2)=0
GO TO 152
C
C *************************************
C * SYMBOL IN RANGE OF POP OPERATOR *
C *************************************
C
137 IOPRTR=0
IF(KODE.EQ.66)GO TO 139
IF(KODE.LE.2)GO TO 147
IF(KODE.LT.1001)GO TO 153
C
C SINGLE ENTRY CONSTANT
IF(KIND.EQ.2)GO TO 153
IF(KODE.NE.1001)GO TO 138
NUMBER=NEW+1
GO TO 152
138 MASTER(NEW)=KODE-1
MASTER(NEW-1)=0
GO TO 147
C
C MULTIPLE ENTRY CONSTANT
139 NEW=-NUMBER
NUMBER=MASTER(NEW+1)
I=MASTER(NEW-1)-1
IF(I.EQ.1)GO TO 142
IF(I.EQ.MASTER(NEW-3))GO TO 140
C CHANGE TOP ENTRY TO ZERO TO PRESERVE PRECISION
MASTER(NEW-1)=I
MASTER(NEW-2)=0
GO TO 147
C GET RID OF TOP ENTRY
140 IF((NEW-5).EQ.NUMBER)GO TO 142
I=NEW-3
141 MASTER(I+2)=MASTER(I)
MASTER(I+1)=MASTER(I-1)
I=I-2
IF(I.GT.NUMBER)GO TO 141
NUMBER=NUMBER+2
MASTER(NEW+1)=NUMBER
MASTER(NUMBER)=NUMBER-2
GO TO 152
C CAN BECOME SINGLE ENTRY CONSTANT
142 NUMBER=NEW+1
NEW=-MASTER(NEW)+1
MASTER(NEW)=1000+I
MASTER(NEW-1)=MASTER(NUMBER-5)
GO TO 152
C
C *************************************
C * SYMBOL IN RANGE OF SFT OPERATOR *
C *************************************
C
143 IOPRTR=0
IF(KODE.LT.1001)GO TO 153
IF(KIND.EQ.2)GO TO 153
IVALUE=IVALUE*IADJST
MASTER(NEW-1)=ITBPUT(0,NUMBER,4,IVALUE,IBASE)
GO TO 147
C
C *************************************
C * SYMBOL IN RANGE OF TEL OPERATOR *
C *************************************
C
144 CALL TBLTEL
GO TO 147
C
C *********************************
C * INDICATE DEPOSIT INTO ENTRY *
C *********************************
C
145 LOCK=2
GO TO 146
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 = 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.
146 KODE=-1
GO TO 155
147 KODE=-2
GO TO 155
148 KODE=-5
GO TO 155
149 KODE=-6
GO TO 155
150 KODE=-7
GO TO 155
151 KODE=-8
GO TO 155
152 KODE=-9
GO TO 155
153 KODE=-10
GO TO 155
154 KODE=-11
155 RETURN
END