C	ASSEMBLER FOR RANDOM MACHINES (LIKE SIZDAT)
C	FOR PDP11 F4P COMPILER
	IMPLICIT INTEGER (A-Z)
C
C	THIS ROUTINE WAS INITIALLY CONCEIVED AS A ONE-PASS ASSEMBLER.
C	HOWEVER, IT NOW GOES THROUGH 3 PASSES (!) TO RESOLVE FORWARD
C	REFERENCES. OUTPUT IS ON THE LAST PASS. AS A RESULT, THE SYMBOL
C	TABLE INSERT FUNCTION IS CALLED ONLY AFTER A SYMBOL TABLE
C	SEARCH FUNCTION IN THE MAIN ROUTINE TO ENSURE THAT SYMBOLS ARE
C	INSERTED AT MOST ONCE INTO THE SYMBOL TABLE "STRING".
C
	COMMON OUT(132),IN(80),GAP,SHIFTS(10,10),NUMS(10),VALS(200),PCT
	COMMON FORMS(15,80),EXPV,CLASS,MEM,ADRS,ANS(5),MASKS(20),EOC,COL
	COMMON CHPT,NUM,SMPL,FNDX,DOOF,MACS(20),MACX,MACF,RELOC,BYTES
	COMMON FORMC,SCHAR,CC(20),HOL(64),CCN,P,LANK,TPF(10)
	COMMON PTIN,PT,CHAR,CCNT,PTOUT,T,TYPE,QUME,SAP,CQ
	COMMON TERM,BYTE,BYTEM,SLOT,COLUM,H,SIZDAT
	COMMON LINX,LINK,PASS,AA,AB,STRING(10100),QH(2048,2)
	INTEGER * 2 STRING
	INTEGER *2 QH
	EXTERNAL BITS,AND,OR,XOR,COMB,RL
	EXTERNAL LLC
	INTEGER*4 LLC,ANS,MASKS,SHIFTS,MASK,DEFAL,TPF
	EXTERNAL I4AND,I4RL
	INTEGER*4 EXPV,I4AND,I4RL,LASTV,ISTART,BASE
	INTEGER*2 AND,OR,XOR,RL,COMB
	INTEGER*4 BITS
	BYTE IN,HOL,FORMS
	INTEGER * 2 QUME,LC,AA,AB
C	END UP WHEN HIT EOF 2ND TIME.
	DO 5209 I555=1,10100
5209	STRING(I555)=0
	DO 5208 I555=1,2048
	QH(I555,1)=0
5208	QH(I555,2)=0
	KLOSD=0
	BYTE=8
	BYTEM=255
	SIZDAT=1
	LINK=80
	FNDX=0
	ATMAK=0
	CCN=1
	PASSMX=2
C	PCT IS PASS COUNT+1... COUNTS PASSES OVER PGM.
C	NOTE: END CARD MUST BE LAST CARD OF INPUT FILE!
C	PCT=1
C	******* HERE ZERO PASS COUNT TO FORCE 3 PASSES! SEE IF IT WORKS BETTER
	PCT=3-PASSMX
C	*******
	ISTOP=0
	LANK=80
C
C	EXPECTED DATA IS:
C	0: THE CHARACTER SET
C	1: 22 PSEUDO OPS
C
C	2: ALL VARIABLE INST FORMAT STUFF
C
C	3: # OF EQUS
C	4: ALL EQUS
C
C	5: USER PROG (PASS 1)
C	6: USER PROG (PASS 2)  (SAME SOURCE IS PASSED TWICE)
C
C
	CALL FDBSET(1,'READONLY')
	CALL FDBSET(2,'READONLY')
	READ (1,8)HOL
8	FORMAT(64A1)
	DO 16 I=1,22
	LINX=1
	READ (1,3)NUM,(IN(K),K=1,20)
	CHPT=1
	CCNT=20
	CALL INSERT(1,NUM,SAP)
16	CALL INSERT (SAP,-2,SAP)
	MASKS(1)=1
	DO 17 I=2,20
17	MASKS(I)=2*MASKS(I-1)+1
C CLASS IS NUMBER OF CLASSES OF INSTRUCTIONS
C MEM IS NUMBER OF BITS IN A MEMORY WORD
C ADRS IS NUMBER OF BITS IN AN ADDRESS. SHOULD BE SO CHOSEN
C THAT MEM IS A MULTIPLE OF IT SINCE IT CONTROLS ALLOCATION
C OF SPACE WHERE ADDRESS CONSTANTS ARE DEFINED IN DATA PSEUDO-OPS.
C ATMAK IS 0 IF OCTAL INSTRUCTIONS ARE DESIRED, 1 FOR ATMAC MICRO
C INSTRUCTION DECOMPOSITION BY FIELD.
	READ (1,1)CLASS,MEM,ADRS,ATMAK
1	FORMAT(I1,2I2,I2)
	FORMC=1
	N=1
6	READ (1,7)(SHIFTS(FORMC,I),I=1,10)
7	FORMAT(10I3)
2	READ (1,3)NUM,(FORMS(FORMC,I),I=1,70)
3	FORMAT(I2,70A1)
	NUMS(FORMC)=N
	DO 5 I=1,NUM
	READ (1,4)(IN(K),K=1,5),VALS(N)
4	FORMAT(5A1,O12)
	CHPT=1
	CCNT=5
	LINX=1
	CALL GNC
	CALL INSERT(0,0,INDX)
	CALL INSERT(INDX,-1,INDX)
5	N=N+1
	CLASS=CLASS-1
	FORMC=FORMC+1
	IF(CLASS.GT.0)GOTO 6
	CLASS=FORMC-1
	READ (1,3)NUM
	DO 19 I=1,NUM
	READ (1,4)(IN(K),K=1,5),VAL
	LINX=1
	CHPT=1
	CCNT=5
	CALL GNC
	CALL INSERT(0,0,INDX)
	CALL SEARCH(-INDX,6,INDX,IERRT)
C	CALL SEARCH(-INDX,6,INDX,$14)
14	STRING(INDX)=STRING(INDX)+1
	STRING(LANK)=VAL
	LANK=LANK+1
19	STRING(LANK)=0
9876	IF(PCT.EQ.2)PRINT 98
	IF(PCT.EQ.2)PRINT 99
98	FORMAT(1H1)
99	FORMAT(2X,' HEXP OCTAL  HEXCONTNT  OCTALCONTNT'
	1   ,3X,'LINE',15X,'STATEMENT',/)
	DO 18 I=1,132
18	OUT(I)=HOL(32)
	P=0
	LINE=0
	LIST=1
	DO 25 I=1,20
25	CC(I)=0
	CCN=1
	SKIPC=0
	LPPG=57
	DAY=0
	SUE=0
	FWD=0
	DOOF=0
	MAC=0
	SOB=0
	MACF=0
	MACX=1
	DATAF=0
	ANS(1)=0
	SPACE=0
	LINES=3
	CALL CLOSE(1)
100	IF(DOOF.EQ.0)GOTO 117
	ISTART=ISTART+ICNR
	IF(ISTART.LE.IEND)GOTO 102
	DOOF=0
117	IF(MACF.NE.0)GOTO 174
4002	READ (2,101,END=4000,ERR=4000)IN
	GO TO 4001
4000	CONTINUE
C	HANDLE ENDFILE BY CLOSING THE FILE FOR PROGRAM
	REWIND 2
C	REWIND IS NOT REALLY CLEAN BUT SHOULD DO THE JOB...
	KLOSED=KLOSED+1
C	****** NEXT LINE IS
C	****** MODIFIED (WAS TEST ON KLOSED.EQ.1) FOR 3 PASSES!!!!!
	IF(KLOSED.LE.PASSMX-1) GO TO 4002
C	******
	CALL EXIT
4001	CONTINUE
C	READ 101,IN
101	FORMAT(80A1)
C WAIT FOR SIG EVENT TO SLOW THIS UP AND GIVE OTHERS MORE OF THE CPU
C	CALL WFSNE
D	CALL MARK(2,15,1)
D	CALL WAITFR(2)
C MARKTIME 1/4 SECOND AND WAIT FOR IT...
	LINE=LINE+1
102	CHPT=1
	RELOC=0
	EOC=0
	SUE=0
	CCNT=80
	LINX=1
104	IF(LIST.EQ.0)GOTO 95
	IF(PCT.EQ.2)PRINT 103,OUT
103	FORMAT(132A1)
95	IF(ISTOP.EQ.0)GOTO 96
C	DUMP SYMBOL TABLE
	SPEND=0
	PCT=PCT+1
	PRINT 98
	LINK=80
68	DO 60 I=1,132
60	OUT(I)=HOL(32)
	DO 69 I=1,4
	HEXC=(I-1)*25+5
	OCTC=HEXC+5
	LABC=OCTC+6
65	LOOP=STRING(LINK)
	IF(LOOP.NE.0)GOTO 66
	SPEND=1
	GOTO 70
66	AA=AND(LOOP,BYTEM)
	BB=RL(LOOP,BYTE)
	POOP=LINK
	LINK=LINK+AA
	IF(BB.NE.6)GOTO 65
	P=STRING(LINK-1)
	CALL DMP(P,HEXC,4,16)
	CALL DMP(P,OCTC,5,8)
	AA=AA-2
	DO 63 J=1,AA
	IT=STRING(POOP+J)
	LEFTC=RL(IT,BYTE)
	RITEC=AND(IT,BYTEM)
	IF(LEFTC.NE.0)GOTO 62
	LEFTC=RITEC
	RITEC=HOL(32)
62	OUT(LABC)=LEFTC
	OUT(LABC+1)=RITEC
63	LABC=LABC+2
69	CONTINUE
70	PRINT 103,OUT
	IF(SPEND.EQ.0)GOTO 68
	ISTOP=0
	IF(PCT.NE.3)GOTO 9876
	STOP
2096	CONTINUE
96	IF(SPACE.EQ.0)GOTO 107
	DO 108 I=1,SPACE
	IF(PCT.EQ.2)PRINT 97
97	FORMAT(1H )
	LINES=LINES+1
	IF(LINES.LT.LPPG)GOTO 108
	IF(PCT.EQ.2)PRINT 99
	LINES=2
108	CONTINUE
	SPACE=0
107	LINES=LINES+1
	IF(LINES.LT.LPPG)GOTO 109
	IF(PCT.EQ.2)PRINT 99
	LINES=2
C	DATAF NONZERO MEANS WE SAW A MULTI-
C	WORD DATA ITEM AND MUST PRODUCE THE REST
C	OF IT FOR OUTPUT.
109	IF(DATAF.NE.0)GOTO 253
	IF(PCT.EQ.2)GOTO 1091
	IF(MAC.EQ.0)GOTO 1092
1091	DO 105 I=1,80
105	OUT(I+51)=IN(I)
	DO 106 I=1,51
106	OUT(I)=HOL(32)
	CALL DMP(LINE,41,4,10)
	OUT(45)=HOL(46)
1092	IF(SKIPC)80,110,90
C	ENDIF,ASM,SKIP
80	CALL BLANK(0)
	CALL INSERT(0,0,INDX)
	CALL SEARCH(INDX,-2,POT,IERRT)
	IF (IERRT.EQ.0)GOTO 81
C	CALL SEARCH(INDX,-2,POT,$81)
	GOTO 100

C	HIT LOOK FOR END OR ENDIF
81	IF(POT.EQ.22)GOTO 195
	IF(POT.EQ.21)SKIPC=0
	GOTO 100
C	SKIP IT
90	SKIPC=SKIPC-1
	GOTO 100
C	BEGIN PROCESSING NEXT LINE
110	IF(MAC.EQ.0)GOTO 119
	CALL BLANK(0)
C	HOL(36) IS DOLLAR SIGN
	IF(CHAR.EQ.HOL(36))CALL BLANK(0)
	CALL INSERT(0,0,INDX)
C	CALL SEARCH(INDX,-2,POT,$118)
	CALL SEARCH(INDX,-2,POT,IERRT)
	IF (IERRT.EQ.0)GOTO 118
	GOTO 241
118	IF(POT.EQ.22)GOTO 195
	IF(POT.EQ.10)GOTO 245
	GOTO 241
119	IF(IN(1).EQ.HOL(32))GOTO 150
C	MAY BE COMMENT
	IF(IN(1).EQ.HOL(42))GOTO 100
	IF(IN(1).EQ.HOL(46))GOTO 100
C	NO
C	LABEL PRESENT
125	CALL GNC
	CALL INSERT(0,0,INDX)
	CALL SEARCH(-INDX,6,POT,IERRT)
	IF (IERRT.EQ.0) GOTO 20
C	CALL SEARCH(-INDX,6,POT,$20)
	STRING(POT)=STRING(POT)+1
	STRING(LANK)=CC(CCN)
	SLINK=LANK
	LANK=LANK+1
	STRING(LANK)=0
21	IF(CHAR.EQ.HOL(32))GOTO 150
C	IGNORE FUNNY CHARACTERS AFTER LABEL
	CALL GNC
	GOTO 21
20	SLINK=POT+AB
26	STRING(SLINK)=CC(CCN)
	GOTO 150
C	DUMB=80
C75    LOOP=STRING(DUMB)
C	IF(LOOP.EQ.0)GOTO 150
C	INK=AND(LOOP,BYTEM)
C	TRIPE=RL(LOOP,BYTE)
C	IF(TRIPE.EQ.10)GOTO 76
C77    DUMB=DUMB+INK
C	PUP=0
C	GOTO 75
C76    SEAR=STRING(DUMB+1)
C	IF(SEAR.NE.POT)GOTO 77
CC     GOT IT
CC     +0   10(FWD REF) , 4=LENGTH
CC     +1    INDEX OF SYMBOL
CC     +2    VALUE OF EXPRESSION
CC     +3    ADDRESS OF REFERENCE
CC
C	STRING(DUMB)=4
C	RELOC=0
C	EXPV=STRING(DUMB+2)+CC(CCN)
C	P=STRING(DUMB+3)
C	B2=AND(EXPV,255)
C	B1=RL(EXPV,8)
C	PUP=2
C	GOTO 1602
C22   OUT(2)=HOL(4)
C	GOTO 152
C	NO LABEL  GET NEXT FIELD
150	CALL BLANK(0)
C	THE NEXT CARD CAUSES $ TO BE IGNORED AS 1ST CHAR OF MNEUMONIC
	IF(CHAR.NE.HOL(36))GOTO 350
	CHAR=HOL(32)
	CALL BLANK(0)
350	SAVEC=CHAR
	POTTED=POT
	CALL INSERT(0,0,INDX)
	CALL SEARCH(INDX,-1,POT,IERRT)
	IF (IERRT.EQ.0) GOTO 155
C	CALL SEARCH(INDX,-1,POT,$155)
C	NOT A MNEMONIC
C	CALL SEARCH(INDX,-2,POT,$160)
	CALL SEARCH(INDX,-2,POT,IERRT)
	IF (IERRT.EQ.0) GOTO 160
C	NOT A PSEUDO OP
C	CALL SEARCH(-INDX,-6,POT,$170)
	CALL SEARCH(-INDX,-6,POT,IERRT)
	IF (IERRT.EQ.0) GOTO 170
C	NOT A MACRO
	SLINK=0
	CALL TC(SAVEC)
	IF(TYPE.EQ.2)GOTO 153
C	**** P ERROR ****
	OUT(2)=HOL(16)
	OUT(48)=HOL(16)
	GOTO 152
153	BYTES=2
	CALL EXP
	ANS(1)=EXPV
	SOB=1
	GOTO 152
C
C
C	FOUND A MNEMONIC
155	FORMC=1
	SLINK=0
	DO 156 I=2,CLASS
	IF(NUMS(I).GT.POT)GOTO 157
156	FORMC=FORMC+1
157	EXPV=VALS(POT)
	SMPL=1
	PARAC=0
	DO 158 I=1,4
158	ANS(I)=0
	DEFAL=0
	CALL GSC
112	LL=SCHAR-HOL(1)+1
	USE=4
	GOTO 133
111	WIDTH=DEFAL
114	DEFAL=EXPV
	OUTF=-1
	GOTO 135
113	CALL GNC
	IF(EOC.NE.0)GOTO 154
140	CALL GSC
159	OUTF=0
	DEFAL=0
	IF(SCHAR.EQ.HOL(47))GOTO 128
	IF(SCHAR.EQ.HOL(41))GOTO 140
	IF(SCHAR.NE.HOL(26))GOTO 141
C	FOUND END
	CALL GNC
	IF(CHAR.NE.HOL(32))GOTO 154
C	DATA,COL,DIGS,BASE
152	P=CC(CCN)
1522	IF(PCT.EQ.2)CALL DMP(P,4,4,16)
	IF(PCT.EQ.2)CALL DMP(P,9,5,8)
	IF(SOB.EQ.0)GOTO 1523
	SOB=0
	ND=H
	GOTO 1525
1523	ND=SHIFTS(FORMC,10)
1525	PINK=ND/MEM
	IF(SUE.NE.0)GOTO 1526
C *** FOLLOWING LINE COMMENTED OUT -- CAUSES ASSEMBLER TO PRODUCE
C *** OUTPUT EVEN IN CASE OF ERRORS
C	IF(OUT(2).NE.HOL(32))GOTO 1607
	B1=I4AND(ANS(1),255)
	B3=I4RL(ANS,8)
	B2=I4AND(B3,255)
	B3=I4RL(B3,8)
C MASK OUTPUT IF 24 BITS
	IF (MEM.LE.24)ANS(1)=I4AND(ANS(1),16777215)
	GOTO(1601,1602,1603),PINK
1603	IF(PCT.EQ.5)PRINT 4604,P,B3
4604	FORMAT(5X,'OBJAPROG',1X,O7,2X,O10)
3604	FORMAT(5X,'OBJBPROG',1X,O7,2X,O10)
	P=P+1
1605	RELOC=0
	B4=B1
	B1=B2
	B2=B4
1602	IF(RELOC.NE.0)GOTO 1605
	IF(PCT.EQ.5)PRINT 3604,P,B2
	P=P+1
C CCN IS BLOCK NUMBER FOR THIS PARTICULAR OUTPUT...
1604	FORMAT(5X,'OBJ',I1,'PROG',1X,O7,2X,O10)
1601	IF(PCT.EQ.2)WRITE(7,1604)CCN,P,ANS(1)
C	WRITE(7,1604) USED TO BE A "PUNCH" STMT
C
C
C	THE NEXT 4 LINES MUST BE COMMENTS IF THE
C	PREVIOUS STATEMENTS (USING 1604) ARE 'PUNCHES'
C	LINES=LINES+1
C	IF(LINES.LT.LPPG)GOTO 1607
C	IF(PCT.EQ.2)PRINT 99
C	LINES=2
C1607  IF(PUP.EQ.2)GOTO 77
1607	CC(CCN)=CC(CCN)+PINK
C1526  SUE=0
1526	SIP=(ND+3)/4
	IF(PCT.EQ.2)CALL DMP(ANS,16,SIP,16)
	SIP=(ND+2)/3
	IF(DATAF.NE.0)GOTO 281
	IF(SIZDAT.EQ.0)GOTO 281
	IF(SUE.NE.0)GOTO 281
	IF(DAY.NE.0)GOTO 281
	IF(ATMAK.EQ.0.AND.PCT.EQ.2)GOTO 281
	IF(PCT.EQ.2)CALL SPLIT(ANS)
	GOTO 282
281	IF(PCT.EQ.2)CALL DMP(ANS,27,SIP,8)
282	ANS(1)=0
	DAY=0
	SUE=0
	IF(DATAF.NE.0)GOTO 104
	GOTO 100
141	IF(SCHAR.NE.HOL(40))GOTO 142
	CALL GSC
	IF(CHAR.EQ.SCHAR)GOTO 113
	PARAC=PARAC+1
	CALL TC(SCHAR)
	IF(TYPE.EQ.2)GOTO 144
	CALL TC(CHAR)
	IF(TYPE.EQ.2)GOTO 144
	IF(SCHAR.EQ.HOL(24))GOTO 1471
144	CALL GSC
145	DEFAL=0
	OUTF=0
	IF(SCHAR.NE.HOL(47))GOTO 1451
	USE=1
	CALL GSC
	CALL TC(SCHAR)
	TYPE=TYPE+1
	GOTO(129,134,135,135),TYPE
129	LM=SCHAR-HOL(1)+1
	DEFAL=TPF(LM)
	CALL GSC
	GOTO 135
1451	IF(SCHAR.NE.HOL(40))GOTO 130
	PARAC=PARAC+1
	GOTO 144
130	IF(SCHAR.NE.HOL(41))GOTO 132
1301	PARAC=PARAC-1
	IF(PARAC)154,140,144
128	CALL GSC
	CALL TC(SCHAR)
	IF(TYPE.EQ.1)GOTO 128
	GOTO 114

C	ASSEMBLE AN OCTAL VALUE FROM THE SAMPLE
133	CALL GSC
	CALL TC(SCHAR)
	IF(TYPE.EQ.1)GOTO 134
	GOTO(135,139,111,111,164),USE
134	DEFAL=8*DEFAL+SCHAR-HOL(48)
	GOTO 133
C	COMBINE CURRENT FIELD WITH RESULT SO FAR - ANS(1)
135	IF(DEFAL.EQ.0)GOTO 137
	SFT=SHIFTS(FORMC,LL)
	MASK=MASKS(WIDTH)
	DEFAL=I4AND(DEFAL,MASK)
	TPF(LL)=DEFAL
C
C	ITMP=ISHFT(DEFAL,SFT)
C	ANS=ANS.OR.ITMP
	CALL FIXIT(DEFAL,SFT,ANS)
C	ANS=ANS.OR.(DEFAL.LC.SFT)
C	L      A0,*0,X11
C	L   A1,*1,X11
C	LSSC   A0,0,A1
C	OR      A0,*2,X11
C	S      A1,*2,X11
C	J      4,X11
137	IF(OUTF)159,145,140
132	IF(SCHAR.EQ.HOL(24))GOTO 144
	IF(SCHAR.EQ.HOL(18))GOTO 144
	IF(SCHAR.LT.HOL(1))GOTO 144
	IF(SCHAR.GT.HOL(26))GOTO 144
	LL=SCHAR-HOL(1)+1
	USE=2
	GOTO 133
139	WIDTH=DEFAL
	GOTO 145
C	OUTSIDE OF (
142	IF(SCHAR.NE.HOL(32))GOTO 147
	CALL BLANK(0)
	IF(EOC.NE.0)GOTO 154
	GOTO 140
147	IF(SCHAR.NE.HOL(24))GOTO 148
1471	CALL EXP
	GOTO 140
148	IF(SCHAR.NE.HOL(18))GOTO 146
	RELOC=1
	IF(CQ.EQ.0)GOTO 140
	IF(PCT.NE.2)GOTO 140
	OUT(2)=HOL(21)
C	**** UNDEFINED NAME ERROR **** (U ERROR)
	OUT(48)=HOL(21)
	GOTO 140
146	IF(SCHAR.LT.HOL(1))GOTO 151
	IF(SCHAR.GT.HOL(26))GOTO 151
	GOTO 112
151	IF(SCHAR.LT.HOL(48))GOTO 163
	IF(SCHAR.GT.HOL(57))GOTO 163
	USE=5
	GOTO 134
164	EXPV=DEFAL
	GOTO 159
163	IF(CHAR.EQ.SCHAR)GOTO 113
	IF(SCHAR.EQ.HOL(41))GOTO 1301
C	**** F ERROR ****
154	OUT(2)=HOL(6)
	OUT(48)=HOL(6)
	GOTO 152
C
C
C	PSEUDO OPS
160	SUE=1
	IF(POT.GT.6)SLINK=0
	IF(POT.GT.10)GOTO 161
	GOTO(200,205,210,215,220,225,230,235,240,245),POT
C
C9    MACRO
240	MAC=1
	GOTO 100
241	INC=52
	OUTC=1
503	CHAR=OUT(INC)
	INC=INC+1
506	IN(OUTC)=CHAR
	OUTC=OUTC+1
	IF(CHAR.NE.HOL(32))GOTO 503
	CNT=1
504	CHAR=OUT(INC)
	INC=INC+1
	IF(CHAR.NE.HOL(32))GOTO 505
	CNT=CNT+1
	IF(INC.LE.131)GOTO 504
505	TEN=CNT/10+HOL(48)
	ONE=MOD(CNT,10)+HOL(48)
	IN(OUTC)=TEN
	IN(OUTC+1)=ONE
	OUTC=OUTC+2
	IF(INC.LT.132)GOTO 506
	OUTC=OUTC-1
	LINX=1
C	HERE SAVING MACROS (IF 1ST PASS). OTHERWISE NO INSERT.
	IF (PCT.NE.(3-PASSMX)) GO TO 100
	CALL INSERT(1,OUTC,INDX)
	CALL INSERT(INDX,-5,INDX)
	GOTO 100
C10   ENDM
245	MAC=0
	GOTO 100

C
161	POTS=POT-10
C	TYPE 22=END
	IF(POTS.EQ.12)GOTO 195
C	TYPE 21= ENDIF
	IF(POTS.EQ.11)GOTO 315
C	OTHERS ARE ALL CONDITIONAL ASSEMBLY CONDITIONS
	IF(POTS.GT.3)GOTO 300
C	DATA,EJECT,SKIP
	GOTO(250,255,260),POTS
C11	DATA
252	DATAF=0
	DAY=1
	GOTO 152
C	DATAF IS A FLAG THAT IS INCREMENTED IF MORE THAN 1 DATA
C	WORD IS TO BE GENERATED. THE MAINLINE RECALLS THIS AREA
C	IF SO AND THE CODE AT 252 RESETS DATAF AT THE END. THE
C	FLAG "SIZDAT" IS USED TO ALLOW EXP TO TELL US THAT MORE THAN
C	1 WORD IS NEEDED (I.E., FOR FLOATING POINT NUMBERS, FLAGGED
C	BY PERIOD IN THE DATA VALUE AND THE EXPONENT "E" OR "D" FOR
C	SINGLE OR DOUBLE PRECISION VALUES.
250	SUE=0
251	BYTES=2
	CALL EXP
	IF (SIZDAT.LT.1)SIZDAT=1
	ANS(1)=EXPV
	SOB=1
	IF(SIZDAT.GT.1)GOTO 450
454	IF(CHAR.EQ.HOL(32))GOTO 252
	DATAF=DATAF+1
	CALL GNC
	DAY=1
	GOTO 152
253	CONTINUE
	IF(DATAF.NE.1)GOTO 451
	DO 257 I=41,132
257	OUT(I)=HOL(32)
451	IF(SIZDAT.LT.2)GOTO 251
452	NEXT=NEXT+1
	ANS(1)=ANS(NEXT)
C *** NEW NEXT LINE ***
	SOB=1
	IF(NEXT.GE.SIZDAT)GOTO 455
	DATAF=DATAF+1
	DAY=1
	GOTO 152
450	NEXT=1
	GOTO 452
455	SIZDAT=1
	GOTO 454
C12	PAGE
255	SPACE=LPPG-LINES
	GOTO 100
C13	SPACE       X
260	CALL EXP
	SPACE=EXPV
	SPACE=IABS(SPACE)
	IF(SPACE.GT.LPPG)SPACE=LPPG
	GOTO 100
C21	END IF
315	SKIPC=0
	GOTO 100

C14-20	IFS
300	CALL EXP
	VAL1=EXPV
	CALL GNC
	CALL EXP
	VAL2=EXPV
	VAL3=-1
	IF(CHAR.EQ.HOL(32))GOTO 301
	CALL GNC
	CALL EXP
	VAL3=EXPV
301	POTS=POTS-3
	GOTO(305,305,306,307,308,309,310),POTS
305	IF(VAL1.EQ.VAL2)GOTO 302
303	VAL3=0
302	SKIPC=VAL3
	GOTO 100
306	IF(VAL1.NE.VAL2)GOTO 302
	GOTO 303
307	IF(VAL1.GT.VAL2)GOTO 302
	GOTO 303
308	IF(VAL1.GE.VAL2)GOTO 302
	GOTO 303
309	IF(VAL1.LT.VAL2)GOTO 302
	GOTO 303
310	IF(VAL1.LE.VAL2)GOTO 302
	GOTO 303
C22	END
195	ISTOP=1
	GOTO 102
C1	BES X
200	BEE=1
201	CALL EXP
	P=CC(CCN)
	STRING(SLINK)=P+BEE*(EXPV-1)
	SLINK=0
	CC(CCN)=P+EXPV
	FORMC=1
	GOTO 1522
C2	BSS X
205	BEE=0
	GOTO 201
C3	BLOCK  X
210	CALL EXP
	CCN=EXPV
	IF(SLINK.NE.0)STRING(SLINK)=CC(CCN)
	GOTO 100
C4	EQU X
215	CALL EXP
	STRING(SLINK)=EXPV
	SLINK=0
	ANS(1)=EXPV
	ND=36
	GOTO 1525
C5	DO   I=K1,K2,K3
220	IF(CHAR.EQ.HOL(61))GOTO 221
	CALL GNC
	GOTO 220
221	CALL GNC
	CALL EXP
	CALL GNC
	ISTART=EXPV
	CALL EXP
	CALL GNC
	IEND=EXPV
	ICNR=1
	SLINK=0
	DOOF=1
	IF(CHAR.EQ.HOL(32))GOTO 117
	CALL EXP
	ICNR=EXPV
	GOTO 117
C6	ORG X
225	CALL EXP
	CC(CCN)=EXPV
	IF(SLINK.NE.0)STRING(SLINK)=CC(CCN)
	SLINK=0
	GOTO 100
C7	LIST
230	LIST=1
	GOTO 100
C8	NOLIST
235	LIST=0
	GOTO 100
C
C
C	MACROS
170	MACF=MACF+1
C	SAVE CALL LINE
	SLOT=16-MACF
	DO 185 LM=1,80
185	FORMS(SLOT,LM)=IN(LM)
	DO 169 LM=1,80
	KLM=81-LM
	IF(IN(KLM).EQ.HOL(32))GOTO 169
	FORMS(SLOT,1)=KLM+2
	GOTO 168
169	CONTINUE
168	CONTINUE
	MACS(MACX)=GOODZ
	MACX=MACX+1
	GOODZ=POT
C	INCR TO NEXT
174	CNT=STRING(GOODZ)
	CNT=AND(CNT,BYTEM)
	GOODZ=GOODZ+CNT
	CNT=STRING(GOODZ)
	TY=RL(CNT,BYTE)
	CNT=AND(CNT,BYTEM)-1
	IF(TY.EQ.5)GOTO 171
C	END OF CURRENT MACRO EXPANSION
	MACX=MACX-1
	GOODZ=MACS(MACX)
C	RESTORE NEXT POINTER
	MACF=MACF-1
	SLOT=SLOT+1
	IF(MACF.NE.0)GOTO 174
	GOTO 100
C	FOUND A LINE TO UNPACK
171	OUTC=1
	DO 179 ICK=1,CNT
	GUNK=STRING(GOODZ+ICK)
	LEFTC=RL(GUNK,BYTE)
	RITEC=AND(GUNK,BYTEM)
	IF(LEFTC.NE.0)GOTO 178
	LEFTC=RITEC
	RITEC=0
178	IN(OUTC)=LEFTC
	IN(OUTC+1)=RITEC
179	OUTC=OUTC+2
	GET=OUTC-1
	OUTC=80
	IN(81)=HOL(32)
	IF(IN(GET).EQ.0)GET=GET-1
175	CHAR=IN(GET)
	GET=GET-1
	IF(CHAR.EQ.HOL(32))GOTO 177
	IN(OUTC)=CHAR
	OUTC=OUTC-1
176	IF(GET.GT.0)GOTO 175
C
C
C	SUBSTITUTE PARAMETERS
182	DO 181 LN=1,80
C	HOL(35) IS # SIGN; HOL(40) IS "("; HOL(41) IS ")"
C	HOL(48) IS ASCII ZERO (0)
	IF(IN(LN).EQ.HOL(35))GOTO 280
	IF(IN(LN).NE.HOL(40))GOTO 181
	IF(IN(LN+2).NE.HOL(41))GOTO 181
	PAM=IN(LN+1)-HOL(48)
	RITEC=LN+2
	LP=LN
183	LP=LP-1
	CHAR=IN(LP)
	CALL TC(CHAR)
	IF(TYPE.LT.2)GOTO 183
	LEFTC=LP+1
284	OLDWN=RITEC-LEFTC+1
C	GET 1ST BLANK
184	CALL BLANK(3)
C	NON-BLANK
	CALL BLANK(4)
C	BLANK
	CALL BLANK(5)
C	NON-BLANK
188	CALL BLANK(4)
	LFC=COLUM
C	GET BLANK OR COMMA
	CALL BLANK(6)
	RTC=COLUM-1
	PAM=PAM-1
	IF(PAM.GT.0)GOTO 188
	NUWUN=RTC-LFC+1
	MOV=NUWUN-OLDWN
C
	IF(MOV)190,191,192
192	NUMX=80-RITEC-MOV
	BEGIN=80-MOV
1921	IN(BEGIN+MOV)=IN(BEGIN)
	BEGIN=BEGIN-1
	NUMX=NUMX-1
	IF(NUMX.GT.0)GOTO 1921
	GOTO 191
190	DO 199 LMN=RITEC,80
199	IN(LMN+MOV)=IN(LMN)
191	NUWUN=NUWUN-1
	DO 197 LMN=0,NUWUN
197	IN(LEFTC+LMN)=FORMS(SLOT,LFC+LMN)
	GOTO 182
181	CONTINUE
	GOTO 102
177	BKC=(IN(OUTC+1)-HOL(48))*10+IN(OUTC+2)-HOL(48)
	OUTC=OUTC+2
	DO 180 ICK2=1,BKC
	IN(OUTC)=HOL(32)
180	OUTC=OUTC-1
	GOTO 176
C	ALLOW #1,#2, ETC AS PARAMETER REFERENCES FOR MACROS
280	LEFTC=LN
	PAM=IN(LN+1)-HOL(48)
	RITEC=LN+1
	GOTO 284
C

C
C THE FOLLOWING IS THE DATA FOR GENASM
C  (SIZDAT INSTRUCTION CODES...)
C ABCDEFGHIJKLMNOPQRSTUVWXYZ      ]"#$%&'()*+,-./0123456789:;<=>?@
C 03BES
C 03BSS
C 05BLOCK
C 03EQU
C 02DO
C 03ORG
C 04LIST
C 06NOLIST
C 05MACRO
C 04MEND
C 04DATA
C 05EJECT
C 04SKIP
C 02IF
C 04IFEQ
C 04IFNE
C 04IFGT
C 04IFGE
C 04IFLT
C 04IFLE
C 05ENDIF
C 03END
C 72416
C 019016013004007004000000000024
C 16A5 XB3(,XC3/0);((*0F3/0)XD11/0(,XE3/0));(XG4/0);Z
C ADD           000
C ADDL          001
C SUB           002
C SUBL          003
C AND           004
C OR            005
C XOR           006
C CPGR          007
C COMP1         010
C COMP2         011
C ZR            012
C LP1           013
C DECR          014
C LN1           015
C INCR          016
C CPGRT         017
C 019016013004007004000000000024
C 15A5 (XB3/0(,XC3/0));((*2F3/2)XD11/0(,XE3/0));(XG4/0);Z
C SHRL          000
C SHRA          001
C SHLL          002
C SHRC          003
C SHLC          004
C DSHL          005
C INCL          006
C COMPL         007
C SUBN          010
C COMPN         011
C MPYS          012
C MPYL          013
C DSET          014
C STAT          015
C NOP           016
C 019016013010007000000000000024
C 08A5 XB3(,XC3/0(,XD3/0(,XE3/0)));(;100F7/100);Z
C CFCCO         010
C CTCCO         011
C CFCCA         012
C CTCCA         013
C CFCC          014
C CTCC          015
C DIVC          016
C DIVT          017
C 019016013010007000000000000024
C 16A5 XB3(,XC3/0(,XD3/B(,XE3/0)));(;140F7/140);Z
C CPGI          000
C CPGIM         001
C CPGIL         002
C CPIR          003
C IADDM         004
C ISUBM         005
C IDECM         006
C IINCM         007
C IDECL         010
C IADDL         011
C ISUBL         012
C IINCL         013
C ISUB          014
C IINC          015
C IADD          016
C IDEC          017
C 019016013010007000000000000024
C 16A5 XB3(,XC3/0(,XD3/0(,XE3/0)));(;160F7/160);Z
C PSHG          000
C PSHGM         001
C PSHGL         002
C PSHM          003
C PSHMM         004
C PSHML         005
C POPM          006
C POPMM         007
C POPML         010
C CPIG          011
C CPIGM         012
C CPIGL         013
C STIR          014
C STIRM         015
C STIRL         016
C IRADD         017
C 019016013004007004000000000024
C 08A5 (XB3/0(,XC3/0));((*4F3/4)XD11/0(,XE3/0));(XG4/0);Z
C ACABS         000
C ABS           001
C LSTAT         002
C RSTAT         003
C CMP           004
C CSTAT         005
C RMIM          006
C SMIM          007
C 016000000000000000000000024
C 16A5 XB3;XRC20;Z
C BOT           020
C BOF           021
C BRAN          022
C LOAD          023
C ADDI          024
C ANDI          025
C ORI           026
C XORI          027
C CMPI          030
C SUBI          031
C STORE         032
C LDI           033
C ILDI          034
C ILDIM         035
C ILDIL         036
C INDX          037
C 32
C MNOP          000
C RTN           001
C MINDX         002
C AUTP3         003
C AUTP1         004
C AUTM1         005
C AUTP2         006
C AUTM2         007
C RNAP2         010
C RNAP3         011
C RNAP1         012
C RNAM1         013
C RNBP1         014
C RNBM1         015
C RTNA          016
C RTNB          017
C LD0           000
C LD1           100
C LD2           200
C LD3           300
C LD4           400
C LD5           500
C LD6           600
C LD7           700
C ST0           001
C ST1           101
C ST2           201
C ST3           301
C ST4           401
C ST5           501
C ST6           601
C ST7           701
C
	END
C

C
	SUBROUTINE DMP (D,C,DIGS,BOSS)
	IMPLICIT INTEGER (A-Z)
	COMMON OUT(132),IN(80),GAP,SHIFTS(10,10),NUMS(10),VALS(200),PCT
	COMMON FORMS(15,80),EXPV,CLASS,MEM,ADRS,ANS(5),MASKS(20),EOC,COL
	COMMON CHPT,NUM,SMPL,FNDX,DOOF,MACS(20),MACX,MACF,RELOC,BYTES
	COMMON FORMC,SCHAR,CC(20),HOL(64),CCN,P,LANK,TPF(10)
	COMMON PTIN,PT,CHAR,CCNT,PTOUT,T,TYPE,QUME,SAP,CQ
	COMMON TERM,BYTE,BYTEM,SLOT,COLUM,H,SIZDAT
	COMMON LINX,LINK,PASS,AA,AB,STRING(10100),QH(2048,2)
	INTEGER * 2 STRING
	INTEGER *2 QH
	EXTERNAL BITS,AND,OR,XOR,COMB,RL
	EXTERNAL LLC
	INTEGER*4 LLC,ANS,MASKS,SHIFTS,MASK,DEFAL,TPF
	EXTERNAL I4AND,I4RL
	INTEGER*4 EXPV,I4AND,I4RL,LASTV,ISTART,BASE
	INTEGER*2 AND,OR,XOR,RL,COMB
	INTEGER*4 BITS,DD
	BYTE IN,HOL,FORMS
	INTEGER * 2 QUME,LC,AA,AB
	DIMENSION DIME(15)
C	DATA,COL,DIGITS,BASE
	DD=D
	NEG=0
	IF(DD.GE.0)GOTO 3
	NEG=4
	CALL SNIP(DD)
3	DO 1 LM=1,DIGS
	LEFT=DD/BOSS
	HAHA=DD-LEFT*BOSS+HOL(48)
	IF(LM.NE.DIGS)GOTO 5
	IF(NEG.EQ.0)GOTO 5
	IF(BOSS.EQ.16)NEG=8
	HAHA=HAHA+NEG
	NEG=0
5	IF(HAHA.GT.HOL(57))HAHA=HAHA-HOL(57)+HOL(1)-1
	DIME(LM)=HAHA
1	DD=LEFT
	DO 2 LM=1,DIGS
	KLM=DIGS+1-LM
2	OUT(C+LM-1)=DIME(KLM)
	RETURN
	END

	SUBROUTINE GSC
	IMPLICIT INTEGER (A-Z)
	COMMON OUT(132),IN(80),GAP,SHIFTS(10,10),NUMS(10),VALS(200),PCT
	COMMON FORMS(15,80),EXPV,CLASS,MEM,ADRS,ANS(5),MASKS(20),EOC,COL
	COMMON CHPT,NUM,SMPL,FNDX,DOOF,MACS(20),MACX,MACF,RELOC,BYTES
	COMMON FORMC,SCHAR,CC(20),HOL(64),CCN,P,LANK,TPF(10)
	COMMON PTIN,PT,CHAR,CCNT,PTOUT,T,TYPE,QUME,SAP,CQ
	COMMON TERM,BYTE,BYTEM,SLOT,COLUM,H,SIZDAT
	COMMON LINX,LINK,PASS,AA,AB,STRING(10100),QH(2048,2)
	INTEGER * 2 STRING
	INTEGER *2 QH
	EXTERNAL BITS,AND,OR,XOR,COMB,RL
	EXTERNAL LLC
	INTEGER*4 LLC,ANS,MASKS,SHIFTS,MASK,DEFAL,TPF
	EXTERNAL I4AND,I4RL
	INTEGER*4 EXPV,I4AND,I4RL,LASTV,ISTART,BASE
	INTEGER*2 AND,OR,XOR,RL,COMB
	INTEGER*4 BITS
	BYTE IN,HOL,FORMS
	INTEGER * 2 QUME,LC,AA,AB
	SCHAR=FORMS(FORMC,SMPL)
C	IF(PCT.EQ.2)PRINT 2,SCHAR
C2	FORMAT(1X,'SCHAR ',1R1)
	SMPL=SMPL+1
	RETURN
	END

C	EVALUATE EXPRESSION
	SUBROUTINE EXP
	IMPLICIT INTEGER (A-Z)
	DOUBLE PRECISION DP,DE
	COMMON OUT(132),IN(80),GAP,SHIFTS(10,10),NUMS(10),VALS(200),PCT
	COMMON FORMS(15,80),EXPV,CLASS,MEM,ADRS,ANS(5),MASKS(20),EOC,COL
	COMMON CHPT,NUM,SMPL,FNDX,DOOF,MACS(20),MACX,MACF,RELOC,BYTES
	COMMON FORMC,SCHAR,CC(20),HOL(64),CCN,P,LANK,TPF(10)
	COMMON PTIN,PT,CHAR,CCNT,PTOUT,T,TYPE,QUME,SAP,CQ
	COMMON TERM,BYTE,BYTEM,SLOT,COLUM,H,SIZDAT
	COMMON LINX,LINK,PASS,AA,AB,STRING(10100),QH(2048,2)
	INTEGER * 2 STRING
	INTEGER *2 QH
	EXTERNAL BITS,AND,OR,XOR,COMB,RL
	EXTERNAL LLC
	INTEGER*4 LLC,ANS,MASKS,SHIFTS,MASK,DEFAL,TPF
	EXTERNAL I4AND,I4RL
	INTEGER*4 EXPV,I4AND,I4RL,LASTV,ISTART,BASE
	INTEGER*2 AND,OR,XOR,RL,COMB
	INTEGER*4 BITS
	BYTE IN,HOL,FORMS
	INTEGER * 2 QUME,LC,AA,AB
	LASTV=0
	CQ=0
	LASTP=HOL(43)
10	EXPV=0
	IF(CHPT.GT.80)GOTO 25
	H=MEM
	BASE=10
	IF(CHAR.EQ.HOL(32))CALL BLANK(0)
	IF(CHAR.EQ.HOL(48))BASE=8
5	CALL TC(CHAR)
	T=TYPE+1
	GOTO(1,2,3,3),T
1	IF(DOOF.EQ.0)GOTO 9
	IF(CHAR.NE.HOL(9))GOTO 11
	JOE=IN(CHPT)
	CALL TC(JOE)
	IF(TYPE.LT.2)GOTO 11
	EXPV=ISTART
	GOTO 7
C	X'0000' HEX CONST
9	IF(CHAR.NE.HOL(24))GOTO 11
	IF(IN(CHPT).NE.HOL(39))GOTO 11
	GOTO 30
11	CALL INSERT(0,0,INDX)
	H=ADRS
C	CALL SEARCH(-INDX,6,POT,$22)
	CALL SEARCH(-INDX,6,POT,IERRT)
	IF (IERRT.EQ.0) GO TO 22
	STRING(POT)=STRING(POT)+1
	LANK=LANK+1
	STRING(LANK)=0
22	EXPV=STRING(POT+AB)
	IF(EXPV.EQ.0)FWD=POT
	GOTO 3
2	EXPV=BASE*EXPV+CHAR-HOL(48)
7	CALL GNC
	GOTO 5
40	CALL GNC
	IF(CHAR.EQ.HOL(39))GOTO 75
	EXPV=CHAR
	P=CC(CCN)
C	IF(PCT.EQ.2)PRINT 1603,P,EXPV
C1603	FORMAT(5X,'OBJ EXPV',2X,O6,4X,O8)
	CC(CCN)=P+1
	GOTO 40
75	CC(CCN)=CC(CCN)-1
	GOTO 7
30	CALL GNC
	IF(CHAR.EQ.HOL(39))GOTO 30
	CALL TC(CHAR)
	IF(TYPE.GT.1)GOTO 13
	IF(TYPE.EQ.0)CHAR=CHAR-HOL(1)+1+HOL(57)
	EXPV=LLC(EXPV,4)+CHAR-HOL(48)
	GOTO 30
3	CONTINUE
	IF(CHAR.EQ.HOL(58))GOTO 30
	IF(CHAR.EQ.HOL(46))GOTO 39
	IF(CHAR.EQ.HOL(39))GOTO 40
	IF(CHAR.EQ.HOL(64))GOTO 18
	IF(CHAR.NE.HOL(36))GOTO 13
	CALL GNC
	EXPV=CC(CCN)
13	IF(LASTP.EQ.HOL(43))LASTV=LASTV+EXPV
	IF(LASTP.EQ.HOL(45))LASTV=LASTV-EXPV
	IF(LASTP.EQ.HOL(42))LASTV=LASTV*EXPV
	IF(LASTP.EQ.HOL(47))LASTV=LASTV/EXPV
	LASTP=CHAR
	IF(LASTP.EQ.HOL(44))GOTO 15
	IF(LASTP.EQ.HOL(32))GOTO 15
	IF(LASTP.EQ.HOL(59))GOTO 15
	CALL GNC
	GOTO 10
18	CALL GNC
	IF(CHAR.EQ.HOL(4))GOTO 19
	EXPV=CC(1)
	IF(CHAR.NE.HOL(16))GOTO 13
C	HANDLE @P
C	@=@P
	GOTO 20
C	HANDLE @D
19	EXPV=CC(2)
20	CALL GNC
	GOTO 13
25	OUT(2)=HOL(5)
C	**** E ERROR ****
	OUT(48)=HOL(5)
15	EXPV=LASTV
	IF(FWD.EQ.0)GOTO 17
C	STRING(LINX)=4
C	STRING(LINX+1)=FWD
C	STRING(LINX+2)=EXPV
C	P=CC(CCN)
C	IF(BYTES.EQ.2)GOTO 16
C	P=P+1
C16	STRING(LINX+3)=P
C	CALL INSERT(LINX,-10,POT)
C	LINX=LINX+4
C	STRING(LINX)=0
	FWD=0
	CQ=1
17	BYTES=0
	RETURN
C	COMPUTE FLOATING POINT VALUE
39	DP=EXPV
	SIZDAT=3
	CUNT=0
37	CALL GNC
	CALL TC(CHAR)
	IF(TYPE.GT.1)GOTO 25
	IF(TYPE.EQ.0)GOTO 38
C	HAVE A DIGIT
	DE=CHAR-HOL(48)
	DP=DP*10.0+DE
	CUNT=CUNT+1
	GOTO 37
38	IF(CHAR.NE.HOL(4))GOTO 36
	SIZDAT=5
	GOTO 35
36	CONTINUE
C  COMMENT OUT NEXT LINE TO ALLOW EXPRESSIONS WITHOUT
C  D OR E FIELDS TO ASSEMBLE
	IF(CHAR.NE.HOL(5))GOTO 25
35	DP=DP/10.0**CUNT
	CALL GNC
	SINN=CHAR
	CALL GNC
	TEN=CHAR-HOL(48)
	CALL TC(CHAR)
	IF(TYPE.NE.1)GOTO 25
	CALL GNC
	ONE=CHAR-HOL(48)
	CALL TC(CHAR)
	IF(TYPE.EQ.1)GOTO 34
	XP=TEN
	GOTO 33
34	XP=TEN*10+ONE
	CALL GNC
33	IF(SINN.EQ.HOL(45))XP=-XP
	DP=DP*(10.0**XP)
	IF(CHAR.EQ.HOL(32))GOTO 32
	IF(CHAR.NE.HOL(44))GOTO 25
32	CALL SAMBO(ANS,DP)
	RETURN
	END

C	GET NEXT CHARACTER
C	CHARACTER OBTAINED FROM "IN" ARRAY POINTED BY CHPT
	SUBROUTINE GNC
	IMPLICIT INTEGER (A-Z)
	COMMON OUT(132),IN(80),GAP,SHIFTS(10,10),NUMS(10),VALS(200),PCT
	COMMON FORMS(15,80),EXPV,CLASS,MEM,ADRS,ANS(5),MASKS(20),EOC,COL
	COMMON CHPT,NUM,SMPL,FNDX,DOOF,MACS(20),MACX,MACF,RELOC,BYTES
	COMMON FORMC,SCHAR,CC(20),HOL(64),CCN,P,LANK,TPF(10)
	COMMON PTIN,PT,CHAR,CCNT,PTOUT,T,TYPE,QUME,SAP,CQ
	COMMON TERM,BYTE,BYTEM,SLOT,COLUM,H,SIZDAT
	COMMON LINX,LINK,PASS,AA,AB,STRING(10100),QH(2048,2)
	INTEGER * 2 STRING
	INTEGER *2 QH
	EXTERNAL BITS,AND,OR,XOR,COMB,RL
	EXTERNAL LLC
	INTEGER*4 LLC,ANS,MASKS,SHIFTS,MASK,DEFAL,TPF
	EXTERNAL I4AND,I4RL
	INTEGER*4 EXPV,I4AND,I4RL,LASTV,ISTART,BASE
	INTEGER*2 AND,OR,XOR,RL,COMB
	INTEGER*4 BITS
	BYTE IN,HOL,FORMS
	INTEGER * 2 QUME,LC,AA,AB
	CHAR=IN(CHPT)
C	IF(PCT.EQ.2)PRINT 2,CHAR
C2	FORMAT(1X,'GNC ',1A1)
3	CHPT=CHPT+1
	CCNT=CCNT-1
	IF(CCNT.GT.-1)GOTO 1
	CHAR=63
	EOC=1
	CHPT=81
1	RETURN
	END

C	FIND CHARACTER TYPE
	SUBROUTINE TC(EEK)
	IMPLICIT INTEGER (A-Z)
	COMMON OUT(132),IN(80),GAP,SHIFTS(10,10),NUMS(10),VALS(200),PCT
	COMMON FORMS(15,80),EXPV,CLASS,MEM,ADRS,ANS(5),MASKS(20),EOC,COL
	COMMON CHPT,NUM,SMPL,FNDX,DOOF,MACS(20),MACX,MACF,RELOC,BYTES
	COMMON FORMC,SCHAR,CC(20),HOL(64),CCN,P,LANK,TPF(10)
	COMMON PTIN,PT,CHAR,CCNT,PTOUT,T,TYPE,QUME,SAP,CQ
	COMMON TERM,BYTE,BYTEM,SLOT,COLUM,H,SIZDAT
	COMMON LINX,LINK,PASS,AA,AB,STRING(10100),QH(2048,2)
	INTEGER * 2 STRING
	INTEGER *2 QH
	EXTERNAL BITS,AND,OR,XOR,COMB,RL
	EXTERNAL LLC
	INTEGER*4 LLC,ANS,MASKS,SHIFTS,MASK,DEFAL,TPF
	EXTERNAL I4AND,I4RL
	INTEGER*4 EXPV,I4AND,I4RL,LASTV,ISTART,BASE
	INTEGER*2 AND,OR,XOR,RL,COMB
	INTEGER*4 BITS
	BYTE IN,HOL,FORMS
	INTEGER * 2 QUME,LC,AA,AB
	TYPE=3
	IF(EEK.EQ.HOL(32))RETURN
	IF(EEK.LT.HOL(1))GOTO 21
	TYPE=0
	IF(EEK.LE.HOL(26))RETURN
21	IF(EEK.LT.HOL(48))GOTO 2
	TYPE=1
	IF(EEK.LE.HOL(57))RETURN
2	TYPE=2
	RETURN
	END

C	FIND BLANKS OR FILL THEM IN
	SUBROUTINE BLANK(KID)
	IMPLICIT INTEGER (A-Z)
	COMMON OUT(132),IN(80),GAP,SHIFTS(10,10),NUMS(10),VALS(200),PCT
	COMMON FORMS(15,80),EXPV,CLASS,MEM,ADRS,ANS(5),MASKS(20),EOC,COL
	COMMON CHPT,NUM,SMPL,FNDX,DOOF,MACS(20),MACX,MACF,RELOC,BYTES
	COMMON FORMC,SCHAR,CC(20),HOL(64),CCN,P,LANK,TPF(10)
	COMMON PTIN,PT,CHAR,CCNT,PTOUT,T,TYPE,QUME,SAP,CQ
	COMMON TERM,BYTE,BYTEM,SLOT,COLUM,H,SIZDAT
	COMMON LINX,LINK,PASS,AA,AB,STRING(10100),QH(2048,2)
	INTEGER * 2 STRING
	INTEGER *2 QH
	EXTERNAL BITS,AND,OR,XOR,COMB,RL
	EXTERNAL LLC
	INTEGER*4 LLC,ANS,MASKS,SHIFTS,MASK,DEFAL,TPF
	EXTERNAL I4AND,I4RL
	INTEGER*4 EXPV,I4AND,I4RL,LASTV,ISTART,BASE
	INTEGER*2 AND,OR,XOR,RL,COMB
	INTEGER*4 BITS
	BYTE IN,HOL,FORMS
	INTEGER * 2 QUME,LC,AA,AB
	IF(KID.GT.2)GOTO 10
	EOC=0
1	CALL GNC
	IF(CCNT.LE.0)GOTO 3
	IF(KID.EQ.0)GOTO 2
C	LOOK FOR BLANK
	IF(CHAR.NE.HOL(32))GOTO 1
3	IF(CCNT.LE.0)EOC=1
	RETURN
C	LOOK FOR NON-BLANK
2	IF(CHAR.EQ.HOL(32))GOTO 1
	GOTO 3
10	IF(KID.NE.3)GOTO 11
	BLAST=FORMS(SLOT,1)
	COLUM=2
	GOTO 15
11	IF(KID.NE.4)GOTO 12
14	COLUM=COLUM+1
	CARE=FORMS(SLOT,COLUM)
	IF(CARE.NE.HOL(32))RETURN
	IF(COLUM.LT.BLAST)GOTO 14
	CARE=HOL(64)
	RETURN
12	IF(KID.NE.5)GOTO 13
15	COLUM=COLUM+1
	CARE=FORMS(SLOT,COLUM)
	IF(CARE.EQ.HOL(32))RETURN
	IF(COLUM.LT.BLAST)GOTO 15
	CARE=HOL(32)
	RETURN
13	COLUM=COLUM+1
	CARE=FORMS(SLOT,COLUM)
	IF(CARE.EQ.HOL(32))RETURN
	IF(CARE.EQ.HOL(44))RETURN
	IF(COLUM.LT.BLAST)GOTO 13
	CARE=HOL(32)
	RETURN
	END

C	INSERT DATA IN SYMBOL TABLE.
	SUBROUTINE INSERT(A,B,C)
	IMPLICIT INTEGER (A-Z)
	COMMON OUT(132),IN(80),GAP,SHIFTS(10,10),NUMS(10),VALS(200),PCT
	COMMON FORMS(15,80),EXPV,CLASS,MEM,ADRS,ANS(5),MASKS(20),EOC,COL
	COMMON CHPT,NUM,SMPL,FNDX,DOOF,MACS(20),MACX,MACF,RELOC,BYTES
	COMMON FORMC,SCHAR,CC(20),HOL(64),CCN,P,LANK,TPF(10)
	COMMON PTIN,PT,CHAR,CCNT,PTOUT,T,TYPE,QUME,SAP,CQ
	COMMON TERM,BYTE,BYTEM,SLOT,COLUM,H,SIZDAT
	COMMON LINX,LINK,PASS,AA,AB,STRING(10100),QH(2048,2)
	INTEGER * 2 STRING
	INTEGER *2 QH
	EXTERNAL BITS,AND,OR,XOR,COMB,RL
	EXTERNAL LLC
	INTEGER*4 LLC,ANS,MASKS,SHIFTS,MASK,DEFAL,TPF
	EXTERNAL I4AND,I4RL
	INTEGER*4 EXPV,I4AND,I4RL,LASTV,ISTART,BASE
	INTEGER*2 AND,OR,XOR,RL,COMB
	INTEGER*4 BITS
	BYTE IN,HOL,FORMS
	INTEGER * 2 QUME,LC,AA,AB
C	B.GT.0   B CHARS FROM IN ARRAY (B COUNTER VALID)
C	B=0      INDEFINITE NO. OF CHARS FROM IN ARRAY
C	B.LT.0   ENTRY FROM A (STILL IN IN ARRAY BUT A=SUBSCRIPT OF START)
	IF(B)1,2,3
C	CASE 1 -- ARG B CONTAINS NO. CHARS IN DATA TO INSERT
1	TIPE=-B
	LIX=IABS(A)
	IF(A.GT.0)GOTO 10
	QUME=LANK
	LANK=LINX
10	ZAP=STRING(LIX)
	AB=AND(ZAP,BYTEM)-1
C	FILL IN SYMBOL TBL WITH DATA
	DO 5 INK=1,AB
5	STRING(LANK+INK)=STRING(LIX+INK)
	STRING(LANK)=LC(TIPE,BYTE)+AB+1
	C=LANK
	LANK=LANK+AB+1
C	FILL IN STRING END MARKER
	STRING(LANK)=0
	IF(A.GT.0)RETURN
	LINX=LANK
	LANK=QUME
	RETURN
C	CASE 2 -- INDEFINITE NUMBER INPUT CHARACTERS
C	IN(CHPT-1) HAS 1ST CHARACTER
C	LINX IS FREE AREA START IN STRING (IF NEEDED)
2	INK=1
C	SAVE LINX POINTER
	LINXSV=LINX
C
C	ROUTINE SYMLKP WILL SEARCH FOR THE SYMBOL IN
C	STRING STARTING AT 1 AND ON...
C	RETURNS IGOTIT=0 IF NOT THERE, IGOTIT=NEW LINX IF THERE
C
	IGOTIT=0
C	CALL SYMLKP(IGOTIT)
	IF (IGOTIT.NE.0)LINX=IGOTIT
	QUME=CHAR
8	CALL GNC
C	FIND CHARACTER TYPE
	CALL TC(CHAR)
	IF(SAP.EQ.1)GOTO 9
	IF(CHAR.EQ.HOL(36))TYPE=0
9	IF(TYPE.GT.1)GOTO 20
	QUME=LC(QUME,BYTE)+CHAR
	IF(BYTEM.GE.QUME)GOTO 8
	STRING(LINX+INK)=QUME
	QUME=0
	INK=INK+1
	GOTO 8
20	IF(QUME.EQ.0)GOTO 21
C	FILL IN ODD BYTE IF LEFT OVER
	STRING(LINX+INK)=QUME
	INK=INK+1
C	FILL IN CHARACTER COUNT
21	STRING(LINX)=INK
	C=LINX
	LINX=LINX+INK
C	FILL IN END MARKER
	STRING(LINX)=0
	IF (IGOTIT.NE.0)LINX=LINXSV
	RETURN
3	START=A
	LOOP=B
	INK=1
7	QUME=IN(START)
	LOOP=LOOP-1
	IF(LOOP.LE.0)GOTO 6
	QUME=LC(QUME,BYTE)+IN(START+1)
	START=START+2
	LOOP=LOOP-1
6	STRING(LINX+INK)=QUME
	INK=INK+1
	IF(LOOP.GT.0)GOTO 7
	GOTO 21
	END
C

CC	SEEK SYMBOL IN TABLE TO SEE IF NEW INSERT IS OK
C	SUBROUTINE SYMLKP(IGOTIT)
C	IMPLICIT INTEGER (A-Z)
C	COMMON OUT(132),IN(80),GAP,SHIFTS(10,10),NUMS(10),VALS(200),PCT
C	COMMON FORMS(15,80),EXPV,CLASS,MEM,ADRS,ANS(5),MASKS(20),EOC,COL
C	COMMON CHPT,NUM,SMPL,FNDX,DOOF,MACS(20),MACX,MACF,RELOC,BYTES
C	COMMON FORMC,SCHAR,CC(20),HOL(64),CCN,P,LANK,TPF(10)
C	COMMON PTIN,PT,CHAR,CCNT,PTOUT,T,TYPE,QUME,SAP,CQ
C	COMMON TERM,BYTE,BYTEM,SLOT,COLUM,H,SIZDAT
C	COMMON LINX,LINK,PASS,AA,AB,STRING(10100),QH(2048,2)
C	INTEGER * 2 STRING
C	INTEGER *2 QH
C	EXTERNAL BITS,AND,OR,XOR,COMB,RL
C	EXTERNAL LLC
C	INTEGER*4 LLC,ANS,MASKS,SHIFTS,MASK,DEFAL,TPF
C	EXTERNAL I4AND,I4RL
C	INTEGER*4 EXPV,I4AND,I4RL,LASTV,ISTART,BASE
C	INTEGER*2 AND,OR,XOR,RL,COMB
C	INTEGER*4 BITS
C	BYTE IN,HOL,FORMS
C	INTEGER * 2 QUME,LC,AA,AB
CC	SEEK SYMBOL AT IN(CHPT-1) ON IN SYMBOL TABLE
C	IGOTIT=0
C	JT1=STRING(1)
C	JT1=AND(JT1,BYTEM)
C	RETURN
C	END

	SUBROUTINE SEARCH(A,B,C,IRTNFG)
	IMPLICIT INTEGER (A-Z)
	COMMON OUT(132),IN(80),GAP,SHIFTS(10,10),NUMS(10),VALS(200),PCT
	COMMON FORMS(15,80),EXPV,CLASS,MEM,ADRS,ANS(5),MASKS(20),EOC,COL
	COMMON CHPT,NUM,SMPL,FNDX,DOOF,MACS(20),MACX,MACF,RELOC,BYTES
	COMMON FORMC,SCHAR,CC(20),HOL(64),CCN,P,LANK,TPF(10)
	COMMON PTIN,PT,CHAR,CCNT,PTOUT,T,TYPE,QUME,SAP,CQ
	COMMON TERM,BYTE,BYTEM,SLOT,COLUM,H,SIZDAT
	COMMON LINX,LINK,PASS,AA,AB,STRING(10100),QH(2048,2)
	INTEGER * 2 STRING
	INTEGER *2 QH
	REAL *8 XHAH,RAND,C2048
	EXTERNAL BITS,AND,OR,XOR,COMB,RL
	EXTERNAL LLC
	INTEGER*4 LLC,ANS,MASKS,SHIFTS,MASK,DEFAL,TPF
	EXTERNAL I4AND,I4RL
	INTEGER*4 EXPV,I4AND,I4RL,LASTV,ISTART,BASE
	INTEGER*2 AND,OR,XOR,RL,COMB
	INTEGER*4 BITS
	BYTE IN,HOL,FORMS
	INTEGER * 2 QUME,LC,AA,AB
	IRTNFG=1
	LIX=IABS(A)
	ZAP=STRING(LIX)
	AB=AND(ZAP,BYTEM)
	BA=AB-1
	TIPE=IABS(B)
	IF(TIPE.EQ.0)TIPE=C
	GG=0
	IF(TIPE.NE.6)GOTO 4
	GG=1
	RAND=6HRANDOM
	XHAH=RAND
	DO 6 INK=1,BA
	XHAH=DFLOAT(STRING(LIX+INK))*XHAH
6	XHAH=XHAH*128.
C	HAH=RL(HAH,BYTE)
	C2048=2048.
	XHAH=DMOD(XHAH,C2048)
	HAH=INT(XHAH)
	HAH=AND(HAH,2047)
	KNTHAH=0
C	MUST COUNT USE  OF TBL SO IF IT FILLS WE CAN EXIT
C	THE FOLLOWING LINE FORCES LINEAR  TABLE SEARCH
C	HAH=0
	IF (HAH.LT.0)HAH=1
9	HAH=HAH+1
	IF(HAH.GT.2048)HAH=1
	DX=QH(HAH,1)
	IF (DX.LT.0) GO TO 30
	KNTHAH=KNTHAH+1
	IF (KNTHAH.GT.2048)WRITE(5,4554)
4554	FORMAT('  SYM TBL OVFLOW')
C	IF (KNTHAH.GT.2048) GO TO 30
	IF (KNTHAH.GT.2048) CALL EXIT
	IF(DX.EQ.0)GOTO 30
	IF (DX.GE.10100) GO TO 9
	DO 8 INK=1,BA
	IF(STRING(LIX+INK).NE.STRING(DX+INK))GOTO 9
8	CONTINUE
	LINK=QH(HAH,1)
	C=QH(HAH,2)
	GOTO 11
30	CANT=CANT+1
	C=CANT
	LINK=LANK
	IF(B.LE.0)GOTO 12
	QH(HAH,1)=LINK
	QH(HAH,2)=CANT
	GOTO 12
4	PUNT=0
	LINK=80
1	LOOP=STRING(LINK)
	IF(LOOP.EQ.0)GOTO 10
	AA=AND(LOOP,BYTEM)-GG
	BB=RL(LOOP,BYTE)
	BB=AND(BB,BYTEM)
	IF(BB.EQ.TIPE)GOTO 2
3	LINK=LINK+AA+GG
	GOTO 1
2	PUNT=PUNT+1
	IF(B.NE.0)GOTO 7
	STRING(LINK)=AA
	IF (LANK.EQ.0)IRTNFG=0
	IF (LANK.EQ.0)RETURN
C	IF(LANK.EQ.0)RETURN 1
	GOTO 3
7	IF(AB.NE.AA)GOTO 3
	DO 5 INK=1,BA
	IF(STRING(LIX+INK).NE.STRING(LINK+INK))GOTO 3
5	CONTINUE
	C=PUNT
11	IF(A.LT.0)C=LINK
	IRTNFG=0
	RETURN
C	RETURN 1
10	C=PUNT+1
12	IF(A.LT.0)C=LINK
	IF(B.LE.0)RETURN
	DO 15 INK=1,BA
15	STRING(LINK+INK)=STRING(LIX+INK)
	STRING(LINK)=LC(TIPE,BYTE)+AB
	LANK=LINK+AB
	STRING(LANK)=0
	RETURN
	END

	SUBROUTINE SPLIT(BUG)
	IMPLICIT INTEGER (A-Z)
	COMMON OUT(132),IN(80),GAP,SHIFTS(10,10),NUMS(10),VALS(200),PCT
	COMMON FORMS(15,80),EXPV,CLASS,MEM,ADRS,ANS(5),MASKS(20),EOC,COL
	COMMON CHPT,NUM,SMPL,FNDX,DOOF,MACS(20),MACX,MACF,RELOC,BYTES
	COMMON FORMC,SCHAR,CC(20),HOL(64),CCN,P,LANK,TPF(10)
	COMMON PTIN,PT,CHAR,CCNT,PTOUT,T,TYPE,QUME,SAP,CQ
	COMMON TERM,BYTE,BYTEM,SLOT,COLUM,H,SIZDAT
	COMMON LINX,LINK,PASS,AA,AB,STRING(10100),QH(2048,2)
	INTEGER * 2 STRING
	INTEGER *2 QH
	EXTERNAL BITS,AND,OR,XOR,COMB,RL
	EXTERNAL LLC
	INTEGER*4 LLC,ANS,MASKS,SHIFTS,MASK,DEFAL,TPF
	EXTERNAL I4AND,I4RL
	INTEGER*4 EXPV,I4AND,I4RL,LASTV,ISTART,BASE
	INTEGER*2 AND,OR,XOR,RL,COMB
	INTEGER*4 BITS
	BYTE IN,HOL,FORMS
	INTEGER * 2 QUME,LC,AA,AB
	OUT(8)=HOL(61)
	OUT(22)=HOL(61)
	F0=BITS(BUG,13,5)
	F1=BITS(BUG,18,3)
	CALL DMP(F0,23,2,8)
	CALL DMP(F1,26,1,8)
	IF(F0.GT.15)GOTO 1
	F2=BITS(BUG,21,3)
	F3=BITS(BUG,24,3)
	F4=BITS(BUG,27,3)
	F5=BITS(BUG,30,3)
	F6=BITS(BUG,33,4)
	CALL DMP(F2,28,1,8)
	CALL DMP(F3,30,1,8)
	CALL DMP(F4,32,1,8)
	CALL DMP(F5,34,1,8)
	CALL DMP(F6,36,2,8)
	RETURN
1	IMOP=BITS(BUG,21,16)
	CALL DMP(IMOP,28,6,8)
	RETURN
	END