Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-10 - 43,50517/rpgiie.mac
There is 1 other file named rpgiie.mac in the archive. Click here to see a list.
	TITLE	RPGIIE FOR RPGII 1
	SUBTTL	GENERATE CODE AND TABLES

;
;	RPGIIE	PHASE E FOR RPGII V1
;
;	THIS PHASE BUILDS THE RUNTIME TABLES, WRITES THEM TO THE
;	ASSEMBLY FILE, GENERATES THE CALCULATION CODE, AND CLOSES
;	UP VARIOUS FILES.
;
;	BOB CURRIER	AUGUST 28, 1975	03:06:19
;
;	ALL RIGHTS RESERVED, BOB CURRIER
;


	TWOSEG
	RELOC	400000

	ENTRY	RPGIIE


	FIXNUM==^D9			; NUMBER OF FIXED ITEMS

RPGIIE:	PORTAL	.+1			; YOU MAY NOW ENTER
	SETFAZ	E;			; INITIALIZE THE PHASE

	SWOFF	FLAG!FAS3;		; RESET TIME
	SETOM	@CPYBHO##+1		; FLAG END OF CPYFIL
	CLOSE	CPY,			; CLOSE CPYFIL

	MOVE	TA,AS2BUF##		; SET UP AS2FIL
	MOVEM	TA,.JBFF##		; START AT THE BEGINNING
	OUTBUF	AS2,2			; GRAB 2 BUFFERS


	MOVE	TA,AS3BUF##		; SET UP AS3FIL
	MOVEM	TA,.JBFF##		; START AT FIRST FREE
	OUTBUF	AS3,2			; GET TWO BUFFERS

	SETZM	EINITL##		; ZAP ALL THE JUNK
	MOVE	TE,[XWD EINITL,EINITL+1]; SET UP FOR BLIT
	BLT	TE,EZEROH##		; ZAP!
	SETZM	HILOC##			; ZAP ME TOO DADDY!

	MOVE	TA,LITLOC##		; MAKE SURE LITNXT IS RESET
	MOVEM	TA,LITNXT##		; JUST LIKE THAT
;SET UP RPGLIB ARGUMENTS

SELARG:	TSWF	REENT;			; REENTRANT?
	JRST	BLDRES			; YES - NO RPGLIB CALL

	MOVE	TA,[SIXLIT##,,1]	; A SIXBIT LITERAL!
	PUSHJ	PP,STASHL##		; GO STASH IT
	MOVE	TA,[SIXBIT 'RPGII']	; THAT'S US!
	PUSHJ	PP,STASHL
	AOS	ELITPC##		; BUMP LITERAL PC

	MOVE	TA,[OCTLIT##,,1]	; ARG 2 IS COMPILER VERSION NUMBER
	PUSHJ	PP,STASHL
	MOVE	TA,.JBVER##		; GET VERSION
	PUSHJ	PP,STASHL		; STASH
	AOS	ELITPC

	MOVE	TA,[OCTLIT,,1]		; PUT OUT ARG COUNT PRIOR TO LIST
	PUSHJ	PP,STASHL
	MOVSI	TA,-2
	PUSHJ	PP,STASHL

	AOS	TA,ELITPC		; SAVE ADDR OF FIRST WORD OF LIST
	MOVEM	TA,RPGVER##

	MOVE	TA,[XWDLIT##,,4]	; MAKE ARG LIST ENTRIES
	PUSHJ	PP,STASHL

	MOVEI	TA,0			; ENTRY1 = 0,,ARG1-PTR
	PUSHJ	PP,STASHL
	MOVE	TA,RPGVER
	HRLZI	TA,-3(TA)
	TLO	TA,AS.LIT##
	HRRI	TA,AS.MSC##
	PUSHJ	PP,STASHL
	AOS	ELITPC

	MOVEI	TA,0			; ENTRY2 = 0,,ARG2-PTR
	PUSHJ	PP,STASHL
	MOVE	TA,RPGVER
	HRLZI	TA,-2(TA)
	TLO	TA,AS.LIT
	HRRI	TA,AS.MSC
	PUSHJ	PP,STASHL
	AOS	ELITPC



;BLDRES		BUILD UP RESERVED WORD ENTRIES
;
;
;

BLDRES:	SETZM	NAMWRD+1		; HOUSEKEEPING
	SETZB	DT,LN			; ZAP THE INDEX

RES.0:	MOVE	TC,RESTAB(DT)		; GET A NAME
	JUMPE	TC,BLDCH		; WHEN WE GOT A ZERO, WE'RE DONE
	MOVEM	TC,NAMWRD		; ELSE PUT IT WHERE IT BELONGS
	PUSHJ	PP,TRYNAM		; LOOK IT UP
	  JRST	RES.6			; NOT FOUND. TRY ANOTHER.
	MOVEI	TB,CD.DAT		; LOOK IN DATAB
	MOVSS	TA			; GET RELATIVE LINK
	PUSHJ	PP,FNDLNK		; LOOK ME UP SOMETIME HONEY
	  JRST	RES.6			; NOT FOUND IN DATAB
	MOVE	TA,TB			; GET LINK INTO GOOD AC
	PUSH	PP,TA			; SAVE IT FOR AWHILE

RES.1:	LDB	TC,DA.SIZ		; GET SIZE OF FIELD
	JUMPE	TC,RES.2		; ZERO - NOT DEFINED
	CAME	TC,LN			; IS IT THE SAME AS LAST TIME?
	JRST	RES.3			; NO - COULD BE BAD

RES.2:	LDB	TA,DA.SNM		; GET LINK
	JUMPE	TA,RES.4		; END OF CHAIN
	PUSHJ	PP,LNKSET		; ELSE SET UP LINK
	JRST	RES.1			; AND LOOP

RES.3:	SKIPE	LN			; FIRST TIME?
	JRST	RES.7			; NOPE - ERROR TIME
	MOVE	LN,TC			; YES - GET NEW VALUE
	LDB	CH,DA.DEC		; AND GET DECIMAL POSITS
	JRST	RES.2			; AND LOOP

RES.4:	SKIPE	LN			; ZERO AFTER ALL THAT?
	JRST	RES.5			; NO - GOOD USE VALUE WE FOUND
	MOVE	LN,RESSIZ(DT)		; ELSE WE MUST DEFAULT SIZE
	SETZ	CH,			; AND DECIMAL POSITIONS

RES.5:	POP	PP,TA			; RECOVER POINTER
	DPB	LN,DA.SIZ		; STASH SIZE
	DPB	CH,DA.DEC		; LIKEWISE WITH DEC POS
	MOVEI	TB,3			; UNPACKED NUMERIC
	DPB	TB,DA.FLD		; STORE AS TYPE
	MOVEI	TB,1(DT)		; GET WORD ID
	DPB	TB,DA.RSV		; FLAG AS SUCH
	LDB	TA,DA.SNM		; GET LINK
	JUMPE	TA,RES.6		; DONE THIS LOOP TOO
	PUSHJ	PP,LNKSET		; SET UP LINK
	JRST	RES.5+1			; LOOP

RES.6:	SETZ	LN,			; START ALL OVER
	AOJA	DT,RES.0		; WAY BACK THERE
;BLDRES (CONT'D)
;

RES.7:	LDB	TB,DA.LIN##		; GET DEFINING LINE NUMBER
	MOVEM	TB,SAVELN		; STASH
	WARN	122;			; HE REDEFINED SAME FIELD
	JRST	RES.2			; SO IGNORE THE TRY

;TABLE OF DEFAULT FIELD SIZES

RESSIZ:	OCT	6			; UDATE
	OCT	2			; UDAY
	OCT	2			; UMONTH
	OCT	2			; UYEAR
	OCT	4			; PAGE
	OCT	4			; PAGE1
	OCT	4			; PAGE2


RESTAB:	SIXBIT	/UDATE/
	SIXBIT	/UDAY/
	SIXBIT	/UMONTH/
	SIXBIT	/UYEAR/
	SIXBIT	/PAGE/
	SIXBIT	/PAGE1/
	SIXBIT	/PAGE2/
	SIXBIT	/      /

;BLDCH	BUILD UP INPUT AND OUTPUT CHAINS
;
;THIS ROUTINE WILL RESERVE SPACE IN AS1FIL FOR ALL DATA ITEMS,
;AND BUILD OTFTAB, OCHTAB, ICHTAB.
;

BLDCH:	HRRZ	TA,DATLOC		; GET START OF DATTAB
	MOVEI	TD,^D30			; START AT THE BEGINNING
	SETZM	LDCIND##		; zap the pointer to compile time array table

BLD.00:	SWOFF	FBINRY;			; START FRESH
	MOVEM	TA,CURDAT		; STORE FOR LATER
	SETZM	HISIZ			; ZAP SIZE COUNTER
	SETZM	OP1DEC			; zap decimal counter
	SETZM	OPFLDX##		; and field type register
	SETZM	OP1SIZ			; zappe'

BLD.01:	LDB	TB,DA.DUN		; GET DONE FLAG
	JUMPN	TB,BLD.3A		; IF ALREADY DONE, BYPASS
	LDB	TB,DA.LTF##		; GET LITERAL FLAG
	JUMPN	TB,BLD.3A		; IF A LITERAL, BYPASS
IFN	BINARY,<
	LDB	TC,DA.FLD		; GET FIELD TYPE
	CAIN	TC,2			; GODAMN BINARY?
	  SWON	FBINRY;			; YES - TELL THE GENTRY
	>
	MOVEI	TC,1			; get a flag
	DPB	TC,DA.DUN		; say we've been here
	LDB	TB,DA.OCC		; GET NUMBER OF OCCURS
	JUMPN	TB,BLD.03		; ARRAY OF SOME SORTS
	LDB	TB,DA.SIZ		; GET SIZE OF FIELD
	SKIPE	TB			; [275] did we get a size?
	  MOVEM	TB,OP1SIZ		; [275] yes - store it

BLD.05:	SKIPN	HISIZ			; first time?
	  JUMPN	TB,BLD.5A		; yes - jump if found a size
	JUMPN	TB,BLD.04		; jump if size found this time
	MOVE	TB,OP1SIZ		; get the size
	DPB	TB,DA.SIZ		; store it
	MOVE	TB,OP1DEC		; get decimal count
	DPB	TB,DA.DEC		; store that too
	MOVE	TB,OPFLDX		; get field type
	DPB	TB,DA.FLD		; store it

BLD.04:
IFN	BINARY,<
	TSWT	FBINRY;			; BINARY FIELD?
	  JRST	.+3			; NO - SKIP OVER JUNK
	CAIE	TD,^D30			; YES - ARE WE ON WORD BOUNDARY?
	  AOS	EAS1PC			; NO - BUMP PC
	>
	MOVE	TC,EAS1PC		; GET CURRENT PC
	HRRM	TC,2(TA)		; store core pointer (DA.COR)
	DPB	TD,DA.RES		; store byte residue
	LDB	TB,DA.FLS		; defined in file section?
	JUMPE	TB,BLD.2A		; no - treat special

BLD.4B:	HRRZ	TC,7(TA)		; get array load pointer (DA.LDP)
	SKIPE	TC			; is it set?
	  PUSHJ	PP,BLDARR		; yes - go build an ARRTAB entry for it
	HLRZ	TC,10(TA)		; get array dump pointer (DA.DPP)
	SKIPE	TC			; is that set?
	  PUSHJ	PP,BLDARD		; yes - build ARRTAB entry
;BLDCH	(cont'd)
;

BLD.02:	HRRZ	TA,10(TA)		; get same name link (DA.SNM)
	JUMPN	TA,BLD.1A		; GOT ONE - LOOP
	MOVE	TB,HISIZ		; GET CHARACTER COUNTER
	JUMPE	TB,BLD.E1		; [342] undefined field if zero....
IFN	BINARY,<
	TSWF	FBINRY;			; BINARY?
	  JRST	BLD.B1			; YES - TREAT A TAD SPECIAL
	>
BLD.2D:	ADDB	TB,PCREM		; ADD NEW CHARACTER SIZE
	IDIVI	TB,6			; GET WORD (RELATIVE)
	MOVEM	TB,EAS1PC		; STORE AS NEW ASYFIL PC
	ADDI	TA,1			; BYTES ARE ORGIN 1
	IMULI	TA,6			; CONVERT FROM BYTES TO BITS
	MOVEI	TD,^D36			; ASHES TO ASHES
	SUB	TD,TA			; DUST TO DUST

BLD.3A:	MOVE	TA,CURDAT		; REGET POINTER
	ADDI	TA,SZ.DAT		; INCREMENT
	HRRZ	TE,DATNXT		; [033] GET END OF DATAB
	CAME	TA,TE			; AT END?
	JRST	BLD.00			; NO - LOOP
	JRST	BLD.06			; YES - GO BUILD SOME TABLES

BLD.3D:	LDB	TC,DA.ALT		; alternating table?
	JUMPN	TC,CPOPJ		; exit if yes
	MOVE	TC,TA			; else get link where we can play with it
	SUB	TC,DATLOC		; make relative
	TRO	TC,TC.DAT##		; identify it
	AOS	TE,LDCIND		; get next table index
	MOVEM	TC,LDCTAB##(TE)		; stash in table
	POPJ	PP,			; and exit

BLD.E1:	MOVE	TA,CURDAT		; [342] get first field
BLD.E2:	LDB	TB,DA.LIN		; [342] get defining line number
	MOVEM	TB,SAVELN		; [342] save for error routines
	LDB	TB,DA.FLS		; [342] defined on I or O specs?
	JUMPE	TB,BLD.E3		; [342] (others will catch other errors)
	LDB	TB,DA.INF		; [351] defined on I specs?
	JUMPN	TB,BLD.E3		; [351] yes - we don't want it
	LDB	TB,DA.LTF		; [342] output literal?
	JUMPN	TB,BLD.E3		; [342] yes - no definition necessary
	LDB	TB,DA.NAM		; [342] a real field?
	JUMPE	TB,BLD.E3		; [342] no error if not
	WARN	148;			; [342] [351] yes - error
BLD.E3:	LDB	TA,DA.SNM		; [342] get pointer to next field
	JUMPE	TA,BLD.3A		; [342] exit if none
	PUSHJ	PP,LNKSET		; [342] else set it up
	JRST	BLD.E2			; [342] and loop
;BLDCH (CONT'D)
;

BLD.03:	LDB	TC,DA.ARE		; GET ARRAY ENTRY FLAG
	JUMPN	TC,BLD.3F		; IF IS, DON'T RESERVE SPACE
	SKIPE	HISIZ			; [254] already defined once?
	  JRST	BLD.3F			; [254] yes - go set up linkers
	LDB	TC,DA.SIZ		; IF NOT, IS REGULAR ARRAY, GET SIZE
	IMUL	TB,TC			; MULTIPLY BY NUMBER OF OCCURANCES
	MOVEM	TB,HISIZ		; stash size
	MOVEM	TC,OP1SIZ		; save element size
	LDB	TC,DA.DEC		; get decimal count
	MOVEM	TC,OP1DEC		; stash
	LDB	TC,DA.FLD		; get field type
	MOVEM	TC,OPFLDX		; save
	LDB	TC,DA.LDC##		; load at compile time?
	SKIPE	TC			; well?
	  PUSHJ	PP,BLD.3D		; yes - set up table entry
	MOVE	TD,PCREM		; get PC counter
	IDIVI	TD,6			; get words
	SKIPE	TC			; remainder?
	  ADDI	TD,1			; round to nearest word
	ADDI	TD,1			; allow extra header word
	MOVEM	TD,EAS1PC		; use as new PC
	IMULI	TD,6			; return to characters
	MOVEM	TD,PCREM		; store new value
	MOVEI	TD,^D36			; get new residue
	PUSH	PP,TA			; save a pointer
	MOVE	TA,CURDAT		; get the original DATAB pointer

BLD.3B:	LDB	TC,DA.DUN		; already been here?
	JUMPE	TC,BLD.3C		; no - no need to visit this time either
	MOVE	TC,EAS1PC		; get PC
	HRRM	TC,2(TA)		; replace core pointer (DA.COR)
	DPB	TD,DA.RES		; and byte residue
	MOVE	TC,OP1SIZ		; get size of field
	DPB	TC,DA.SIZ		; store in this item
	MOVE	TC,OP1DEC		; get decimal count
	DPB	TC,DA.DEC		; store that too
	MOVE	TC,OPFLDX		; ge field type
	DPB	TC,DA.FLD		; stash it
	LDB	TC,DA.ICH		; get ICHTAB link
	JUMPE	TC,BLD.3E		; leap if none
	ADD	TC,ICHLOC		; turn into real pointer
	MOVE	TE,EAS1PC		; get core location
	ADDI	TE,1			; don't know why we need this but we do
	HRLI	TE,440600		; make into byte pointer
	MOVEM	TE,(TC)			; store as IC.DES
	MOVE	TE,OP1SIZ		; get size of field
	DPB	TE,[POINT 12,5(TC),32]	; stash as IC.SIZ
	MOVE	TE,OPFLDX		; get field type
	DPB	TE,[POINT 2,4(TC),35]	; save as IC.FLD

BLD.3E:	HRRZ	TA,10(TA)		; get next item with same name (DA.SNM)
	JUMPE	TA,BLD.3C		; exit if no link
	PUSHJ	PP,LNKSET		; set it up
	JRST	BLD.3B			; and loop

BLD.3C:	POP	PP,TA			; restore the pointer
	JRST	BLD.05			; GO RESERVE SPACE

BLD.1A:	PUSHJ	PP,LNKSET		; SET UP LINK
	JRST	BLD.01			; BACK WE GO

BLD.2A:	MOVEI	CH,SAVAC2##		; set up to save the AC's
	BLT	CH,SAVAC2+16		; save 'em
;	LDB	TB,DA.NDF		; GET "NOT DEFINED"
;	JUMPE	TB,BLD.2B		; IS DEFINED - OK
;	LDB	TA,DA.SNM		; GET SAME NAME LINK
;	JUMPE	TA,BLD.2C		; error if none
;	PUSHJ	PP,LNKSET		; SET IT UP
;	JRST	BLD.2A+2		; loop
;BLDCH	(cont'd)
;

BLD.2B:	MOVEM	TA,CURDAT		; STASH
	SWON	FLAG;			; ON GOES THE FLAG
	PUSHJ	PP,BLD11C		; A BIT OF MAGIC, DICK
	MOVSI	CH,SAVAC2		; SAVE A WORD OF CORE
	BLT	CH,16			; RESTORE AC'S
	JRST	BLD.4B			; AND BACK TO MAINLINE TYPE STUFF

BLD.3F:	SKIPN	HISIZ			; size defined yet?
	  JRST	BLD.04			; no - continue
	MOVE	TC,OP1SIZ		; yes - get size
	DPB	TC,DA.SIZ		; yes - stash into DATAB entry
	MOVE	TB,OP1DEC		; get decimal count
	DPB	TB,DA.DEC		; stash that too
	MOVE	TB,OPFLDX		; get field type
	DPB	TB,DA.FLD		; that too may be needed
	LDB	TE,DA.ICH		; get ICHTAB link
	JUMPE	TE,BLD.04		; exit if none
	ADD	TE,ICHLOC		; make into real pointer
	MOVE	TC,OP1SIZ		; get size of field
	DPB	TC,[POINT 12,5(TE),32]	; save as IC.SIZ
	MOVE	TC,OPFLDX		; get field type
	DPB	TC,[POINT 2,4(TE),35]	; save as IC.FLD
	JRST	BLD.04			; continue

BLD.5A:	MOVEM	TB,HISIZ		; store the size
;[275]	MOVEM	TB,OP1SIZ		; store again
	LDB	TB,DA.DEC		; get the decimal count
	MOVEM	TB,OP1DEC		; stash it
	LDB	TB,DA.FLD		; get the field
	MOVEM	TB,OPFLDX		; stash
	PUSH	PP,TA			; stash the current DATAB pointer
	MOVE	TA,CURDAT		; get the original one

BLD.5B:	CAMN	TA,(PP)			; are we back where we started?
	  JRST	BLD.5C			; yes - exit
	MOVE	TB,OP1SIZ		; get the size
	DPB	TB,DA.SIZ		; store
	MOVE	TB,OP1DEC		; get the decimal count
	DPB	TB,DA.DEC		; store
	MOVE	TB,OPFLDX		; get the field type
	DPB	TB,DA.FLD		; store that too
	LDB	TC,DA.ICH		; get ICHTAB link
	JUMPE	TC,BLD.5D		; skip over this code if none
	ADD	TC,ICHLOC		; else turn into real pointer
	MOVE	TB,OP1SIZ		; get size
	DPB	TB,[POINT 12,5(TC),32]	; store as IC.SIZ
	MOVE	TB,OPFLDX		; get field type
	DPB	TB,[POINT 2,4(TC),35]	; store as IC.FLD

BLD.5D:	HRRZ	TA,10(TA)		; get DA.SNM
	JUMPE	TA,BLD.5C		; exit if we hit the end (????)
	PUSHJ	PP,LNKSET		; set those linkers fred
	JRST	BLD.5B			; loop the loop

BLD.5C:	POP	PP,TA			; restore old DATAB pointer
	JRST	BLD.04			; back to the grind
;BLDCH	(cont'd)
;

BLD.2C:	OUTSTR	[ASCIZ /
?Not defined field with no same name link found in BLD.2A
/]
	JRST	KILL			; OOPS! DIDN'T KNOW IT WAS LOADED

BLD.B1:	MOVE	TD,PCREM		; GET THAT PC
	IDIVI	TD,6			; IS MAGIC
	SKIPE	TC			; IF WE HAD REMAINDER
	  ADDI	TD,1			; BUMP UP BY ONE
	IMULI	TD,6			; MAKE REAL
	MOVEM	TD,PCREM		; REPLACE
	MOVEI	TC,6			; TRY SIX TO START WITH
	CAILE	TB,^D10			; DOUBLE PRECISION?
	  MOVEI	TC,^D12			; YES -
	MOVE	TB,TC			; GET INTO PROPER AC
	JRST	BLD.2D			; CONTINUE WITH WHAT WE WERE DOING BEFORE
;
;START BUILDING OTFTAB
;

BLD.06:	MOVE	TB,LDCIND		; get LDCTAB index
	SETZM	LDCTAB+1(TB)		; and stash a zero entry
	HRRZ	TA,FILLOC		; GET START OF FILTAB
	MOVEM	TA,CURFIL		; STORE FOR OTHERS
;[312]	CAIE	TD,0			; [115] [243] even word?
	  AOS	EAS1PC			; NO - ROUND TO IT
	MOVEI	TB,1			; [152] get an initial value
	MOVEM	TB,FTBNUM##		; [152] and use it to initialize FTBNUM
	PUSHJ	PP,BLDLHL		; set up limits literal

BLD.07:	MOVE	TA,[XWD CD.OTF,SZ.OTF]	; SET UP TO GET ENTRY
	PUSHJ	PP,GETENT		; GET IT
	MOVEM	TA,CUROTF		; STASH POINTER
	MOVE	TB,CURFIL		; GET CURFILE POINTER
	MOVEI	TD,TBCNT-1		; get index

BLD.08:	EXCH	TB,TA			; PLAY FOOTSIES WITH POINTERS
	LDB	TC,@FTB(TD)		; GET A BYTE
	EXCH	TB,TA			; ONE MORE TIME
	DPB	TC,@OTB(TD)		; STORE BYTE
	SOJGE	TD,BLD.08		; loop until done
	MOVEI	TC,1			; get output flag
	TSWF	FLAG;			; magic call?
	  DPB	TC,OT.TYP		; yes - say is output file regardless
	EXCH	TB,TA			; YES -
	MOVE	TB,CUROTF		; get OTFTAB pointer
	SUB	TB,OTFLOC		; make into relative pointer
	DPB	TB,FI.OTF##		; stash in FILTAB as pointer to corresponding item
	LDB	TB,FI.BKL##		; GET BLOCK LENGTH
	LDB	TD,FI.RCL##		; GET RECORD LENGTH
	MOVE	TE,TD			; STORE FOR LATER
	LDB	TC,FI.ADF##		; GET LINK TO RAF FILE
	ANDI	TC,77777		; DROP TABLE ID
	MOVE	TA,CUROTF		; GET BACK POINTER
	SUBI	TC,1			; decrement address
	DPB	TC,OT.ADP##		; STASH IN OTFTAB
;[345]	Blocking Factor optimization put under REPEAT 0

REPEAT	0,<				; [345]
	LDB	TC,OT.DEV##		; GET DEVICE
	CAIL	TC,.FIDSK		; DISK?
	CAIG	TC,.FIMTA		; TAPE?
	  JRST	BLD.09			; NO - DON'T FIGURE BLOCKING
	CAME	TB,TD			; WE GOTTA FIGURE BLOCKING?
	  JRST	BLD.09			; NO -
	ADDI	TD,6			; YES - ADD WC WORD
	IDIVI	TD,6			; TAKE TO MOD 6
	SKIPE	TC			; REMAINDER?
	  ADDI	TD,1			; yes - round up
	MOVEI	TB,^D256		; start with standard length
BLD.8A:	CAMLE	TD,TB			; will we fit in this size block?
	  JRST	BLD.8B			; no - try another size
	MOVE	TC,TB			; stash
	IDIV	TB,TD			; get blocking factor
	MOVE	TD,TB			; get into proper AC
	MOVE	TB,TC			; get back number of words
	IMULI	TB,6			; convert to characters
	JRST	BLD.10			; and go finish up

BLD.8B:	ADDI	TB,^D256		; try a bit larger
	JRST	BLD.8A			; like this
	>				; [345]

	JRST	BLD.09			; [345] just get straight blocking factor
;BLD.06 (CONT'D)	CONTINUE BUILDING OTFTAB
;

BLD.10:	MOVE	TA,CUROTF		; GET OTF POINTER
	DPB	TD,OT.BLK		; STORE BLOCKING FACTOR
	MOVE	TC,TB			; TRICKY
	IDIVI	TC,6			; GET WORDS IN REC
	SKIPE	TB			; REMAINDER?
	  AOS	TC			; YES - ROUND UP
	DPB	TC,OT.BSZ		; STORE AS BUFFER SIZE (WORDS)
	DPB	TE,OT.BSC		; STORE BUFFER SIZE (CHARS)
	MOVE	TB,EAS1PC		; GET CURRENT PC
	DPB	TB,OT.BFP		; STORE AS BUFFER POINTER
	CAIGE	TC,^D14			; enough room for labels?
	  MOVEI	TC,^D14			; no - make some
	ADDM	TC,EAS1PC		; UPDATE PC
	JRST	BLD.11			; ON TO BIGER AND BETTER

BLD.09:	EXCH	TB,TD			; get stuff into proper AC
	IDIV	TD,TB			; get blocking factor
	JRST	BLD.10			; go and store


BLDLHL:	MOVE	CH,[XWD OCTLIT,2]	; get LITAB header
	PUSHJ	PP,STASHC		; output it
	SETZ	CH,			; get a zero
	PUSHJ	PP,STASHC		; output it
	MOVE	CH,[EXP .INFIN]		; get the big one
	PUSHJ	PP,STASHC		; output that too
	HRLZ	CH,ELITPC		; get LITtab PC
	AOS	ELITPC			; bump PC
	HRR	CH,ELITPC		; get next half
	AOS	ELITPC			; bump PC once more
	MOVEM	CH,LHLLIT##		; stash as limits literal
	POPJ	PP,			; jump
;BLD.06 (CONT'D)	TABLES USED TO BUILD OTFTAB
;

FTB:	EXP	FI.PHY##
	EXP	FI.TYP##
	EXP	FI.DES##
	EXP	FI.PRO##
	EXP	FI.ORG##
	EXP	FI.RAF##
	EXP	FI.DEV##
	EXP	FI.EOF##
	EXP	FI.KYP##
	EXP	FI.SEQ##
	EXP	FI.BUF##
	EXP	FI.AST##
	EXP	FI.REW##
	EXP	FI.EXT##
	EXP	FI.ADD##
	EXP	FI.OVI##
	EXP	FI.OVL##
	EXP	FI.LPP##
	EXP	FI.EXI##
	EXP	FI.COR##
	EXP	FI.KYL##

TBCNT==.-FTB

OTB:	EXP	OT.NAM##
	EXP	OT.TYP##
	EXP	OT.DES##
	EXP	OT.PRO##
	EXP	OT.ORG##
	EXP	OT.RAF##
	EXP	OT.DEV##
	EXP	OT.EOF##
	EXP	OT.KYP##
	EXP	OT.SEQ##
	EXP	OT.BUF##
	EXP	OT.AST##
	EXP	OT.REW##
	EXP	OT.EXT##
	EXP	OT.ADD##
	EXP	OT.OVI##
	EXP	OT.OVL##
	EXP	OT.LPP##
	EXP	OT.EXI##
	EXP	OT.CRS##
	EXP	OT.KYL##

;BLD.11
;
;BUILD UP ICHTAB & OCHTAB ENTRIES FOR FILE IN CUROTF, CURFIL.
;
;

BLD.11:	PUSHJ	PP,BLDFTB		; GO BUILD FTBTAB FOR THIS FILTAB ENTRY
	TSWF	FLAG;			; MFCU call?
	  POPJ	PP,			; yes - exit
	MOVE	TA,CURFIL		; GET THE FILE
	LDB	TB,FI.TYP		; get file type
	CAIN	TB,3			; combined?
	  PUSHJ	PP,BLDSTK		; yes - output stacker entries
	LDB	TA,FI.DAT		; GET POINTER TO DATAB ITEM
	JUMPE	TA,BLD.18		; NO DATA ITEMS (?)
	PUSHJ	PP,LNKSET		; SET UP LINKERS
	MOVEM	TA,CURDAT		; STASH FOR LATER
	MOVEM	TA,CURMAJ		; STORE AS MAJOR POINTER
	LDB	TB,DA.INF##		; GET INPUT SECTION FLAG
	JUMPE	TB,BLD.19		; OUTPUT RECORD - GO PROCESS

BLD11C:	MOVE	TA,[XWD CD.ICH,SZ.ICH]	; SET UP TO GET ITEM
	PUSHJ	PP,GETENT		; GET AN ICHTAB ENTRY
	HRRZM	TA,CURICH		; STORE
	hrrz	tb,ta			; get pointer into tb
	SUB	TB,ICHLOC		; MAKE A POINTER
	hrrzm	tb,currec		; save current record pointer
	MOVE	TA,CUROTF		; GET OTFTAB POINTER
	TRNN	TB,777777		; [021] TREAT SPECIAL IF RH ZERO
	  MOVEI	TB,777777		; [021] OUR SPECIAL FLAG
	DPB	TB,OT.IPC		; STORE AS INPUT CHAIN POINTER

BLD.14:	MOVE	TA,CURICH		; GET POINTER TO ICHTAB ITEM
	MOVE	TB,CURDAT		; GET POINTER TO DATAB ITEM
	MOVEI	TD,TB2CNT-1		; get index

BLD11B:	EXCH	TA,TB			; ZWAP!
	LDB	TC,@DTB(TD)		; GET A BYTE
	EXCH	TA,TB			; SWAP POINTERS
	DPB	TC,@ITB(TD)		; STASH IN ICHTAB
	SOJGE	TD,BLD11B		; Loop until done
	EXCH	TA,TB			; RESTORE POINTERS
	HRRZ	TC,2(TA)		; get core location (DA.COR)
	LDB	TD,DA.RES		; GET BYTE RESIDUE
	ROT	TD,-6			; AIIIII! THE ROT!
	ADD	TD,TC			; COMBINE
	TLO	TD,(6B11)		; SIX BIT BYTES.
	HRRZ	TC,1(TA)		; get INDTAB chain pointer (DA.IND)
	EXCH	TA,TB			; swap the pointers
	MOVEM	TD,(TA)			; store destination byte pointer (IC.DES)
;[352]	TSWT	FLAG;			; [272] flagged items never have entries
	  JUMPE	TC,BLD11A		; [272] skip over code if no IDTTAB entry
	MOVE	CH,ELITPC		; GET POINTER
	HRLM	CH,1(TA)		; store pointer to IDTTAB chain (IC.RII)
	PUSHJ	PP,INDOUT		; GO DUMP INDTAB ENTRY
BLD11A:	EXCH	TA,TB			; [272] restore pointers
;BLD.11 (CONT'D)	CONTINUE BUILDING ICHTAB & OCHTAB ENTRIES
;

BLD11D:	TSWF	FLAG;			; special flag set?
	  JRST	BLD.12			; yes - skip over array entry stuff
	HRRZ	TA,13(TA)		; get array pointer (DA.ARP)
	JUMPE	TA,BLD.12		; NOT AN ARRAY -
	PUSHJ	PP,LNKSET		; SET UP LINKS
	HLRZ	TC,13(TA)		; get pointer to ICHTAB (DA.ICH)
	MOVE	TA,CURICH		; RESTORE POINTER
	JUMPN	TC,.+2			; [324] special case - flag as
	  HRRZI	TC,777777		; [324]    relocatable zero entry.
	HRRM	TC,2(TA)		; store as array pointer to ICH (IC.ARP)
	MOVE	TA,CURDAT		; GET BACK TO DATAB
	LDB	TD,DA.IMD		; GET IMMEDIATE
	LDB	TA,DA.INP		; GET POINTER TO INDEX
	JUMPE	TA,BLD.12		; NO INDEX (BUT AN ARRAY??)
	MOVE	TC,TA			; GET INTO RIGHT AC IN CASE OF JUMP
	JUMPN	TD,.+3			; IMMEDIATE?
	PUSHJ	PP,LNKSET		; NO - SET LINKS
	HLRZ	TC,13(TA)		; get ICHTAB pointer (DA.ICH)
	MOVE	TA,CURICH		; YES - GET ICHTAB POINTER
	DPB	TC,IC.INP		; STORE INDEX POINTER

BLD.12:	MOVE	TC,CURICH		; GET ICHTAB POINTER
	SUB	TC,ICHLOC		; MAKE A POINT
	MOVE	TA,CURDAT		; GET DATAB POINTER
	HRLM	TC,13(TA)		; store as ICHTAB pointer (DA.ICH)
	MOVE	TA,CURICH		; RESTORE POINTER
	TSWFZ	FLAG;			; MAGIC?
	  POPJ	PP,			; YES - EXIT
	MOVEM	TA,CURFLD		; STORE AS CURRENT FIELD
	MOVE	TA,CURDAT		; GET CURRENT DATAB
	HLRZ	TA,1(TA)		; get brother link (DA.BRO)
	JUMPE	TA,BLD.15		; THIS IS THE END
	PUSHJ	PP,LNKSET		; SET UP LINKS
	MOVEM	TA,CURDAT		; STORE AS NEW DATAB ITEM
	MOVE	TA,[XWD CD.ICH,SZ.ICH]	; SET UP TO GET ICHTAB ENTRY
	PUSHJ	PP,GETENT		; GO FOR IT
	HRRZM	TA,CURICH		; STASH POINTER FOR POSTERIOR
	HRRZ	TB,TA			; BACHINO! BACHINO!
	SUB	TB,ICHLOC		; MAKE A POINTER
	MOVE	TA,CURFLD		; GET CURRENT FIELD
	HRRM	TB,1(TA)		; store as pointer to next field (IC.NXF)
	JRST	BLD.14			; LOOP ON BACK
;BLD.11 (CONT'D)	TABLES USED TO BUILD ICHTAB ENTRIES
;
;
;TABLE OF DATAB ITEMS TO BE TRANSFERRED TO ICHTAB

DTB:	EXP	DA.NPS##
	EXP	DA.FMN##
	EXP	DA.FBZ##
	EXP	DA.FPL##
	EXP	DA.CLI##
	EXP	DA.FRR##
	EXP	DA.MAT##
	EXP	DA.RTR##
	EXP	DA.LHI##
	EXP	DA.STS##
	EXP	DA.FLD##
	EXP	DA.ISZ##		; [317]
	EXP	DA.SEQ##
	EXP	DA.FRP##
	EXP	DA.OCC##
	EXP	DA.IMD##
	EXP	DA.FMT##

TB2CNT==.-DTB

;TABLE OF ITEMS TO BE TRANSFERRED TO ICHTAB


ITB:	EXP	IC.NPS##
	EXP	IC.FMN##
	EXP	IC.FBZ##
	EXP	IC.FPL##
	EXP	IC.CLI##
	EXP	IC.FRR##
	EXP	IC.MAT##
	EXP	IC.RTR##
	EXP	IC.LHI##
	EXP	IC.STS##
	EXP	IC.FLD##
	EXP	IC.SIZ##
	EXP	IC.SEQ##
	EXP	IC.SRC##
	EXP	IC.OCC##
	EXP	IC.IMD##
	EXP	IC.FMT##

;BLD.11 (CONT'D)	CONTINUE BUILDING ICHTAB & OCHTAB ENTRIES
;

BLD.15:	MOVE	TA,CURMAJ		; GET MAJOR POINTER
	LDB	TA,DA.MAJ		; GET MAJOR LINK
	JUMPE	TA,BLD.18		; GET ANOTHER FILE IF LINK IS EMPTY
	PUSHJ	PP,LNKSET		; SET UP LINK
	MOVEM	TA,CURDAT		; STORE
	MOVEM	TA,CURMAJ##		; STORE NEW MAJOR POINTER
	MOVE	TA,CURFLD		; GET PREVIOUS FIELD
	HLLZS	1(TA)			; make sure IC.NXF is zero
	MOVE	TA,CURDAT		; GET BACK DATAB POINTER
	LDB	TB,DA.INF		; INPUT RECORD?
	JUMPE	TB,BLD.19		; NO - OUTPUT RECORD
	MOVE	TA,[XWD CD.ICH,SZ.ICH]	; SET UP TO GET ICHTAB ENTRY
	PUSHJ	PP,GETENT		; GET IT
	HRRZM	TA,CURICH		; STASH IT
	HRRZ	TB,TA			; SET UP TO MAKE A POINTER
	SUB	TB,ICHLOC		; MAKE IT
	MOVE	TA,CURREC		; AND STORE FOR LATER
	add	ta,ichloc		; offset

BLD.16:	HRLM	TB,2(TA)		; store as next record link (IC.NXR)
	HRRZ	TA,1(TA)		; get next field link (IC.NXF)
	JUMPE	TA,BLD.17		; ALL DONE IF ZED
	ADD	TA,ICHLOC		; INDEX
	JRST	BLD.16			; LOOP

BLD.17:	MOVE	TA,CURICH		; GET ICHTAB POINTER BACK
	sub	ta,ichloc		; make table relative
	MOVEM	TA,CURREC		; STORE AS CURRENT RECORD
	JRST	BLD.14			; AND TAKE THE BIG LOOP

BLD.18:	MOVE	TA,CURFIL		; GET FILTAB POINTER
	ADDI	TA,SZ.FIL		; BUMP
	HRRZ	TB,FILNXT		; GET FILNXT 
	MOVEM	TA,CURFIL		; STORE NEW FILTAB POINTER
	CAME	TA,TB			; ALL DONE?
	JRST	BLD.07			; NO - LOOP
	MOVE	TA,CUROTF		; YES - GET OTFTAB POINTER
	MOVEI	TB,1			; SET "LAST"
	DPB	TB,OT.LAS		;    SO WE KNOW WHERE TO STOP
	JRST	OUT.00
;BLD.11 (CONT'D)	ROUTINE BLD.19 PROCESSES OCHTAB ENTRIES
;

BLD.19:	MOVE	TA,[XWD CD.OCH,SZ.OCH]	; SET UP TO GET TABLE ENTRY
	PUSHJ	PP,GETENT		; GET IT
	HRRZM	TA,CUROCH		; STORE
	HRRZM	TA,CURREC		; STORE AS CURRENT RECORD
	HRRZ	TB,TA			; MOVE 'ER
	SUB	TB,OCHLOC		; MAKE A POINTER
	MOVE	TA,CUROTF		; GET A POINTER
	TRNN	TB,777777		; [021] ANYTHING BUT ZERO RH, OK
	MOVEI	TB,777777		; [021] FAKE OUT OTF.02
	DPB	TB,OT.OPC		; STORE A POINTER
	JRST	BLD.20			; BYPASS SOME JUNK

BLD20A:	MOVE	TA,CURDAT		; GET DATAB POINTER
	LDB	TB,DA.SIZ		; GET THIS SIZE
	JUMPN	TB,BLD.20		; ALL OK IF WE FIND ONE
	LDB	TB,DA.LTF##		; CHECK LITERAL FLAG
	JUMPN	TB,BLD.20		; ALL ALSO OK IF WE FIND ONE
	LDB	TA,DA.NAM##		; ELSE GET NAMTAB LINK
	MOVEI	TB,CD.DAT		; GET  PLACE TO LOOK
	PUSHJ	PP,FNDLNK		; AND LOOK
	  JFCL				; ALWAYS FIND IT
	MOVE	TA,TB			; GET LINK INTO PROPER AC
	

BLD19A:	LDB	TB,DA.SIZ		; GET THIS SIZE ENTRY
	JUMPN	TB,BLD19B		; ALL DONE WHEN WE FIND ONE
	HRRZ	TB,10(TA)		; get a same name link (DA.SNM)
	JUMPE	TB,BLD.20		; didn't find one - complain to Him
	MOVE	TA,TB			; GOT ONE SO SWAP LINKS
	PUSHJ	PP,LNKSET		;   SET UP THOSE LINKS
	JRST	BLD19A			;   AND TRY ONE MORE TIME

BLD19B:	LDB	TC,DA.FLD		; GET FIELD TYPE TOO
	LDB	TD,DA.DEC		; AND DECIMAL POSITIONS
	MOVE	TA,CURDAT		; GET OLD TIME DATAB POINTER
	DPB	TB,DA.SIZ		; AND STORE SIZE
	DPB	TC,DA.FLD		;   FIELD TYPE,
	DPB	TD,DA.DEC		;   AND DECIMAL POSITIONS

BLD.20:	MOVE	TA,CUROCH		; GET OCHTAB POINTER
	MOVE	TB,CURDAT		; GET DATAB POINTER
	MOVEI	TD,TB3CNT-1		; get index

;BLD.11 (CONT'D)	CONTINUE PROCESSING ICHTAB & OCHTAB ENTRIES
;BLD.19 (CONT'D)	CONTINUE OUTPUTTING OCHTAB ENTRIES
;

BLD.21:	EXCH	TA,TB			; ZWAP!
	LDB	TC,@DTB2(TD)		; GET A DATAB ITEM
	EXCH	TA,TB			; SWAP POINTERS
	DPB	TC,@OCB(TD)		; STORE AS OCHTAB ITEM
	SOJGE	TD,BLD.21		; Loop until done
	EXCH	TA,TB			; GET EVERYTHING WHERE IT BELONGS
	HRRZ	TC,2(TA)		; get assigned core location (DA.COR)
	LDB	TD,DA.RES		; GET BYTE RESIDUE
	ROT	TD,-6			; MAKE A BYTE POINTER
	ADD	TD,TC			; MIX THE TWO
	TLO	TD,(6B11)		; SIX BIT BYTES
	HRRZ	TC,1(TA)		; get INDTAB pointer (DA.IND)
	MOVEM	TD,2(TB)		; store as source byte pointer (OC.SRC)
	JUMPE	TC,BLD21A		; DON'T GENERATE ANYTHING IF ZERO
	MOVE	CH,ELITPC		; GET POINTER INTO LITAB
	HRRM	CH,1(TB)		; store OC.IND
	MOVE	TA,TB			; get link into proper AC for LNKSET
	PUSHJ	PP,INDOUT		; DUMP INDTAB

BLD21A:	MOVE	TA,CURDAT		; GET DATAB POINTER
	LDB	TC,DA.IMD		; get immediate flag
	HLRZ	TA,14(TA)		; get index pointer (DA.INP)
	JUMPE	TA,BLD.22		; NONE - GO JUMP
	MOVE	TB,TA			; get into proper AC in case of jump
	JUMPN	TC,.+4			; jump if immediate
	PUSHJ	PP,LNKSET		; SET UP LINKS
	HLRZ	TB,13(TA)		; get pointer to ICHTAB item (DA.ICH)
	ANDI	TB,TM.DAT##		; get only the juicy parts
	MOVE	TA,CUROCH		; GET OUR OCHTAB POINTER
	HRLM	TB,(TA)			; store as index pointer (OC.IDX)

BLD.22:	MOVE	TA,CURDAT		; RECOVER POINTER
	HRRZ	TA,13(TA)		; get array pointer (DA.ARP)
	JUMPE	TA,BLD22A		; NONE -
	PUSHJ	PP,LNKSET		; SET UP LINKAGE
	HLRZ	TB,13(TA)		; get ICHTAB pointer (DA.ICH)
	SKIPN	TB			; is it zero?
	  SETO	TB,			; yes - use special flag
	MOVE	TA,CUROCH		; GET CURRENT OCHTAB ITEM
	HRLM	TB,6(TA)		; store as array pointer (OC.ARP)

BLD22A:	MOVE	TA,CUROCH		; make sure we have OCHTAB pointer
	SETZ	TB,			; and a zero
	DPB	TB,OC.LTF		; zap the literal flag
	DPB	TB,OC.LSZ		; likewise the size
	MOVE	TA,CURDAT		; RECOVER POINTER
	HLRZ	TB,2(TA)		; get VALTAB link (DA.VAL)
	JUMPE	TB,BLD.23		; JUST LEAVE IF NO LINK
	PUSHJ	PP,PREDIT##		; ELSE GO SET UP FOR EDIT.
	SWOFF	FLAG;			; turn off flag to be sure
	JUMPE	TE,BLD.23		; MUST BE EDIT WORD
	MOVE	TA,CUROCH		; MUST BE LITERAL
	DPB	TE,OC.LTF##		; FLAG AS SUCH
	SUBI	TD,1			; ADJUST FOR BACK ARROW
	DPB	TD,OC.LSZ##		; AND STORE LITERAL SIZE
;BLD.11 (CONT'D)	CONTINUE PROCESSING ICHTAB & OCHTAB ENTRIES
;BLD.19 (CONT'D)	CONTINUE OUTPUTTING OCHTAB ENTRIES
;

BLD.23:	MOVE	TA,CUROCH		; RECOVER OCHTAB POINTER
	MOVEM	TA,CURFLD		; STORE AS CURRENT FIELD
	MOVE	TA,CURDAT		; RECOVER DATAB POINTER
	HLRZ	TA,1(TA)		; get brother link (DA.BRO)
	JUMPE	TA,BLD.24		; NO MORE BROTHERS, GET MAJOR
	PUSHJ	PP,LNKSET		; SET UP LINK
	MOVEM	TA,CURDAT		; STORE AS CURRENT DATAB ITEM
	MOVE	TA,[XWD CD.OCH,SZ.OCH]	; SET UP TO GET OCHTAB ENTRY	
	PUSHJ	PP,GETENT		; GET IT
	HRRZM	TA,CUROCH		; STASH POINTER
	HRRZ	TB,TA			; MOVE POINTER
	SUB	TB,OCHLOC		; MAKE A POINTER
	MOVE	TA,CURFLD		; GET CURRENT FIELD
	HRLM	TB,1(TA)		; store as next field (OC.NXF)
	JRST	BLD20A			; AND LOOP


BLD23A:	MOVE	TA,CURDAT		; GET ORIGINAL POINTER
	LDB	TB,DA.LIN##		; GET LINE NUMBER
	MOVEM	TB,SAVELN		; SAVE IT FOR WARNW
	WARN	700;			; OUTPUT A WARNING
	JRST	BLD.23			; AND TRY AGAIN

;BLD.11 (CONT'D)	CONTINUE PROCESSING ICHTAB & OCHTAB ENTRIES
;BLD.19 (CONT'D)	TABLES USED FOR PROCESSING OCHTAB ENTRIES
;
;
;ITEMS TO GET FROM DATAB

DTB2:	EXP	DA.FLD##
	EXP	DA.SIZ##
	EXP	DA.DEC##
	EXP	DA.PRI##
	EXP	DA.PRO##
	EXP	DA.STR##
	EXP	DA.STP##
	EXP	DA.ORT##
	EXP	DA.ARC##
	EXP	DA.FOV##
	EXP	DA.SKB##
	EXP	DA.SKA##
	EXP	DA.SPB##
	EXP	DA.SPA##
	EXP	DA.END##
	EXP	DA.EDT##
	EXP	DA.IMD##
	EXP	DA.STS##
	EXP	DA.BLA##
	EXP	DA.RSV##
	EXP	DA.OCC##
	EXP	DA.TAB##

TB3CNT==.-DTB2

;PLACES TO PUT THEM IN OCHTAB

OCB:	EXP	OC.FLD##
	EXP	OC.SIZ##
	EXP	OC.DEC##
	EXP	OC.PRI##
	EXP	OC.PRO##
	EXP	OC.STR##
	EXP	OC.STP##
	EXP	OC.ORT##
	EXP	OC.ADD##
	EXP	OC.FOV##
	EXP	OC.SKB##
	EXP	OC.SKA##
	EXP	OC.SPB##
	EXP	OC.SPA##
	EXP	OC.END##
	EXP	OC.EDT##
	EXP	OC.IMD##
	EXP	OC.STS##
	EXP	OC.BLA##
	EXP	OC.RSV##
	EXP	OC.OCC##
	EXP	OC.TAB##
;BLD.11 (CONT'D)	CONTINUE PROCESSING ICHTAB & OCHTAB ENTRIES
;BLD.19 (CONT'D)	GET NEXT OCHTAB ENTRY, OR LOOP AND GET NEXT FILTAB ENTRY
;

BLD.24:	MOVE	TA,CURMAJ		; GET MAJOR RECORD POINTER
	HRRZ	TA,(TA)			; get major link (DA.MAJ)
	JUMPE	TA,BLD.18		; NO MORE
	PUSHJ	PP,LNKSET		; SET LINKER'S
	MOVEM	TA,CURDAT		; STASH
	MOVEM	TA,CURMAJ		; STORE AS NEW MAJOR RECORD
	MOVE	TA,CURFLD		; GET FIELD POINTER
	HRRZS	1(TA)			; zap OC.NXF
	MOVE	TA,[XWD CD.OCH,SZ.OCH]	; SET UP TO GET TABLE ENTRY
	PUSHJ	PP,GETENT		; AND GET IT
	HRRZM	TA,CUROCH		; STASH
	HRRZ	TB,TA			; IDAHO TRANSFER
	SUB	TB,OCHLOC		; MAKE A LINK
	MOVE	TA,CURREC		; GET RECORD POINTER

BLD.25:	HRRM	TB,(TA)			; stash link to next record (OC.NXR)
	HLRZ	TA,1(TA)		; get link to next field (OC.NXF)
	JUMPE	TA,BLD.26		; OUT -
	ADD	TA,OCHLOC		; CONVERT LINK TO REAL WORLD
	JRST	BLD.25			; AND LOOP -

BLD.26:	MOVE	TA,CUROCH		; GET CURRENT OCHTAB POINTER
	MOVEM	TA,CURREC		; STORE AS NEXT RECORD
	JRST	BLD.20			; and loop on around
;BLDFTB		ROUTINE TO BUILD AN FTBTAB ENTRY FOR THE CURRENT FILTAB ENTRY
;
;
;

BLDFTB:	PUSHJ	PP,GETFTB##		; GET AN FTBTAB ENTRY
	HRRZM	TA,CURFTB##		; STASH FOR LATER
	MOVE	TB,TA			; get pointer to where we can use it
	SUB	TB,FTBLOC		; make into relative pointer
	ANDI	TB,777777		; get only the good parts
	MOVE	TC,FTBNUM		; get number of FTBTAB entries we've made
	IMULI	TC,32			; multiply by size of device table
	ADD	TB,TC			; increase pointer
	MOVE	TA,CUROTF		; GET CURRENT OTFTAB POINTER
	DPB	TB,OT.FTB		; and store pointer to FTBTAB entry
	LDB	TC,OT.BFP		; get the buffer pointer
	LDB	TD,OT.BSC		; GET THE BUFFER SIZE
	LDB	TE,OT.BLK		; GET THE BLOCKING FACTOR
	MOVE	TA,CURFTB		; GET BACK THE FTBTAB POINTER
	DPB	TC,FT.REC##		; STASH BUFFER POINTER
	DPB	TD,FT.MRS##		; STASH BUFFER SIZE (RECORD SIZE)
	DPB	TE,FT.BKF##		; STASH BLOCKING FACTOR
	MOVE	TA,CURFIL		; GET FILTAB POINTER
	LDB	TB,FI.NAM##		; GET NAMTAB POINTER FOR THIS FILE
	MOVE	TA,CURFTB		; GET FTBTAB POINTER BACK
	ADD	TB,NAMLOC##		; MAKE NAMTAB POINTER REAL
	MOVE	TC,1(TB)		; GET FIRST SIX CHARS
	MOVE	TD,2(TB)		; GET THE NEXT SIX (MY KINGDOM FOR DMOVE)
	MOVEM	TC,(TA)			; STASH IN FT.FNM
	MOVEM	TD,1(TA)		; STASH AS NEXT WORD
	MOVEI	TB,1			; GET THE INFAMOUS FLAG
	DPB	TB,FT.NOD##		; SET NUMBER OF DEVICES TO 1
	DPB	TB,FT.NFL##		; ALSO NUMBER OF FILE LIMIT CLAUSES
	DPB	TB,FT.STL##		; LIKEWISE WITH STANDARD LABELS FLAG
	MOVE	CH,ELITPC		; get LITAB PC
	DPB	CH,FT.DNM##		; stash as address of device name literal
	MOVE	TA,CURFIL		; GET FILTAB POINTER
	LDB	TB,FI.DEV		; GET THE DEVICE
	MOVE	CH,[XWD SIXLIT,1]	; GET LITAB HEADER
	PUSHJ	PP,STASHC		; OUTPUT TO LITAB
	MOVE	CH,DVTAB1(TB)		; GET DEVICE NAME
	CAIN	TB,.FIMTA		; is it a mag-tape?
	  JRST	[	LDB	TC,FI.UNT##	; yes - get unit number
			ADDI	TC,'0'		; make into sixbit
			ASH	TC,6		; get into line
			ADD	CH,TC		; add in the unit 
			JRST	.+1 ]		; exit
	PUSHJ	PP,STASHC		; OUTPUT IT TO LITAB
	AOS	ELITPC			; bump that PC
	LDB	TC,FI.ORG		; GET FILE ORGANIZATION
	CAIN	TC,2			; indexed file?
	  PUSHJ	PP,BLDFT2		; yes - output second device name
	LDB	CH,FI.AST##		; get ASCII option
;BLDFTB (cont'd)
;
;
;

	MOVE	TA,CURFTB		; get FTBTAB pointer
	SETZ	TE,			; get a special constant ready
	MOVEI	TD,2			; default to ASCII
	JUMPN	CH,.+3			; all set if this is ASCII option
	CAILE	TB,5			; DISK or TAPE?
	  SETZ	TD,			; yes - use sixbit I/O
	DPB	TD,FT.DDM##		; stash device data mode
	SKIPE	TD			; was that ASCII mode?
	  DPB	TE,FT.BKF		; yes - set to unblocked
	SETZ	TD,			; 0 = SEQUENTIAL
	MOVE	TA,CUROTF		; get OTFTAB pointer back
	LDB	TE,OT.PRO##		; [276] get file description
	MOVE	TA,CURFTB		; restore FTBTAB pointer
	MOVE	TD,MODTAB(TE)		; [276] get I/O mode
	CAIN	TC,2			; [276] was that ISAM?
	  MOVEI	TD,2			; [276] yes - set to ISAM mode
BLDFT3:	DPB	TD,FT.MOD##		; STASH AS I/O MODE
	CAIE	TD,1			; RANDOM?
	  JRST	BLDFT0			; NO -
	MOVE	CH,ELITPC		; YES - GET LITAB PC
	DPB	CH,FT.ACK##		; STASH AS ADDR OF ACTUAL KEY TABLE
	MOVE	CH,[XWD OCTLIT,1]	; GET HEADER
	PUSHJ	PP,STASHC		; OUTPUT
	SETZ	CH,			; START WITH ZERO
	PUSHJ	PP,STASHC		; OUTPUT THAT TOO
	AOS	ELITPC			; [276] bump litab pc
	JRST	BLDFT1			; [276] continue elsewhere

MODTAB:	EXP	0			; consecutive => sequential
	EXP	1			; ADDRout => random
	EXP	1			; seq by key => random
	EXP	0			; not supported
	EXP	1			; random by rec num => random
	EXP	2			; indexed => ISAM
;BLDFTB (CONT'D)	COME HERE ON SEQUENTIAL OR INDEXED FILE
;
;
;

BLDFT0:	CAIE	TD,2			; INDEXED?
	  JRST	BLDFT1			; NO - JUMP OUT
	MOVEI	TB,17			; GET ALL ACCESS PRIVLEDGES
	DPB	TB,FT.OWA##		; STASH AS ISAM ACCESS RIGHTS
	MOVEI	TB,10			; GET READ ONLY PRIVLEDGES
	DPB	TB,FT.OTA##		; STASH AS OTHERS ACCESS RIGHTS
	MOVE	TA,CURFIL		; GET FILTAB POINTER
	LDB	TC,FI.KYP		; GET KEY POINTER
	SUBI	TC,1			; make key position orgin 0
	LDB	TD,FI.KYL		; GET KEY LENGTH
	IDIVI	TC,6			; GET WORD COUNT FROM POINTER
	HRL	TC,BYTAB1(TB)		; GET BYTE RESIDUE
	MOVE	TA,CUROTF		; get OTFTAB pointer
	LDB	TB,OT.BFP		; get pointer to buffer
	ADD	TC,TB			; add in as base address
	MOVE	TA,CURFTB		; GET FTBTAB POINTER
	DPB	TC,FT.BRK##		; STORE AS BPTR TO RECORD KEY
	HRRZ	TC,ELITPC		; GET LITAB PC
	HRL	TC,BYTAB1		; GET STANDARD BYTE POINTER
	DPB	TC,FT.BSK##		; STORE AS BPTR TO SYMBOLIC KEY
	DPB	TD,FT.KLB##		; STASH LENGTH OF ISAM KEY	
	IDIVI	TD,6			; TAKE MODULO 6
	SKIPE	TC			; IF REMAINDER
	  ADDI	TD,1			; THEN ROUND UP
	MOVE	CH,TD			; GET INTO PROPER AC
	HRLI	CH,SIXLIT		; MAKE INTO HEADER WORD
	PUSHJ	PP,STASHC		; OUTPUT
	ADDM	TD,ELITPC		; BUMP ELITPC
	SETZ	CH,			; GET A ZERO
	PUSHJ	PP,STASHC		; OUTPUT IT
	SOJG	TD,.-1			; AND LOOP ON
	JRST	BLDFT1			; continue

BLDFT2:	MOVE	CH,[XWD SIXLIT,1]	; get LITAB header
	PUSHJ	PP,STASHC		; output
	MOVE	CH,DVTAB1(TB)		; get device name for data file
	AOS	ELITPC			; bump the pc
	PJRST	STASHC			; output and exit
;BLDFTB (CONT'D)	OUTPUT REMAINDER OF FTBTAB DATA
;
;
;

BLDFT1:	HRRZ	TC,ELITPC		; GET THAT PC
	HRL	TC,BYTAB1		; GET BYTE POINTER DATA
	DPB	TC,FT.VID##		; STASH AS VALUE OF ID BYTE POINTER
	MOVE	CH,[XWD SIXLIT,2]	; ONE FOR FILENAME, ONE FOR EXTENSION
	PUSHJ	PP,STASHC		; OUTPUT
	MOVE	TA,CUROTF		; GET OTFTAB POINTER
	LDB	CH,OT.NAM		; GET PHYSICAL NAME
	PUSHJ	PP,STASHC		; OUTPUT IT
	HRLZI	CH,'RGD'		; GET DEFAULT EXTENSION
	LDB	TC,OT.DES		; GET DESCRIPTION
	CAIN	TC,3			; RECORD ADDRESS?
	  HRLZI	CH,'RGL'		; YES - LIMITS FILE
	LDB	TC,OT.ORG		; GET ORGANIZATION
	CAIN	TC,3			; ADDRout?
	  HRLZI	CH,'RGA'		; yes -
	CAIN	TC,2			; indexed?
	  HRLZI	CH,'IDX'		; YES
	LDB	TC,OT.DEV		; GET DEVICE
	CAIN	TC,.FIMF1		; MFCU1?
	  HRLZI	CH,'MF1'		; YES -
	CAIN	TC,.FIMF2		; MFCU2?
	  HRLZI	CH,'MF2'		; YES -
	TSWF	FLAG;			; outputing stacker entries?
	  MOVS	CH,.STEXT		; yes - use stacker extension
	PUSHJ	PP,STASHC		; OUTPUT
	AOS	ELITPC			; BUMP
	AOS	ELITPC			; BUMP
	MOVE	TA,CURFTB		; GET THAT POINTER
	MOVE	CH,LHLLIT##		; get limits literal
	DPB	CH,FT.LHL##		; stash in FTBTAB
	MOVE	TB,FTBNXT##		; GET NEXT FTBTAB ADDRESS
	SUB	TB,FTBLOC		; GET RELATIVE LOC
	AOS	TC,FTBNUM		; get number of entries and increment at same time
	IMULI	TC,32			; multiply by number of words in device table
	ADD	TB,TC			; and add in
	DPB	TB,FT.NFT##		; STASH
	POPJ	PP,			; EXIT
;DEVICE TABLE

DVTAB1:	SIXBIT	/DSK/			; MFCU1
	SIXBIT	/DSK/			; MFCU2
	SIXBIT	/CDR/			; READ01
	SIXBIT	/LPT/			; PRINTER
	SIXBIT	/LPT/			; PRINTR2
	SIXBIT	/TTY/			; CONSOLE
	SIXBIT	/DSK/			; DISK
	SIXBIT	/TAPE/			; TAPE

;BYTE POINTER TABLE

BYTAB1:	XWD	0,440600
	XWD	0,360600
	XWD	0,300600
	XWD	0,220600
	XWD	0,140600
	XWD	0,060600
	XWD	0,000600
;BLDARR		Build an ARRTAB entry for array load/dump
;
;
;

BLDARR:	TDCA	LN,LN			; say from whence we came
BLDARD:	MOVEI	LN,1			; likewise I'm sure
	LDB	TB,DA.ALT##		; is it first half of alternating table?
	JUMPN	TB,CPOPJ##		; must be if we jumped
	PUSH	PP,TD			; save some AC's
	PUSH	PP,TA			; and another
	PUSHJ	PP,GETARR		; get an ARRTAB entry
	MOVE	TA,(PP)			; get DATAB pointer back
	LDB	TB,DA.COR		; get core pointer
	LDB	TC,DA.RES		; and byte pointer residue
	DPB	TC,[POINT 6,TB,5]	; each in it's proper place
	LDB	TC,DA.SIZ		; get size of field
	LDB	TD,DA.OCC		; and occurs of array
	MOVE	TA,CURARR##		; get ARRTAB pointer
	TLO	TB,600			; set byte size
	DPB	TB,AR.PNT##		; store as pointer
	DPB	TC,AR.SIZ##		; store size
	DPB	TD,AR.OCC##		; and occurs
	MOVE	TA,(PP)			; get pointer to DATAB item
	LDB	TB,DA.EPR##		; get entries/record
	LDB	TC,DA.LDP##		; get load pointer
	LDB	TD,DA.DPP##		; and dump pointer
	CAIN	TC,777777		; [250] special flag?
	  SETZ	TC,			; [250] yes - reset to zero
	CAIN	TD,777777		; [250] another special flag?
	  SETZ	TD,			; [250] yes - likewise reset
	MOVE	TA,CURARR		; get back ARRTAB pointer
	DPB	TB,AR.EPR##		; stash entries per record
	DPB	LN,AR.LDM##		; stash load/dump flag
	DPB	TC,AR.FIL##		; default to load
	SKIPE	LN			; but was it dump?
	  DPB	TD,AR.FIL		; yes - so stash correct pointer
	MOVE	TA,(PP)			; get back DATAB pointer
	LDB	TA,DA.ALL##		; get alternating link
	JUMPE	TA,BLDAR1		; exit if none
	CAIN	TA,TC.DAT##+77777	; [252] special valid zero?
	  TRZ	TA,77777		; [252] yes - make into real zero
	PUSHJ	PP,LNKSET		; else set up link
	LDB	TB,DA.COR		; get assigned core location
	LDB	TC,DA.RES		; and byte residue
	DPB	TC,[POINT 6,TB,5]	; combine
	TLO	TB,600			; turn into real byte pointer
	LDB	TC,DA.SIZ		; get size of entry
	MOVE	TA,CURARR		; get pointer into ARRtab
	DPB	TB,AR.ALT##		; save alternating table pointer
	DPB	TC,AR.ASZ##		; and field size

BLDAR1:	POP	PP,TA			; restore pointer
	POP	PP,TD			; again
	POPJ	PP,			; and exit
;GETARR		Get an ARRTAB entry
;
;
;

GETARR:	MOVE	TA,ARRNXT##		; get pointer to next item
	MOVE	TB,TA			; get into working AC
	ADD	TB,[XWD SZ.ARR,SZ.ARR]	; increment by size of entry
	JUMPGE	TB,GETAR1		; jump if all out of room
	MOVEM	TB,ARRNXT		; else store new pointer
	MOVEM	TA,CURARR		; save current one for others
	POPJ	PP,			; and leave

GETAR1:	PUSHJ	PP,XPNARR##		; expand the table
	JRST	GETARR			; and try again
;BLDSTK		Output table entries for MFCU stackers
;
;
;

BLDSTK:	SKIPE	.STLST##		; already done it once?
	  POPJ	PP,			; yes - exit
	PUSH	PP,CUROTF		; save pointer
	SWON	FLAG;			; no - turn on magic flag
	MOVEI	TB,'ST1'		; get stacker 1 extension
	MOVEM	TB,.STEXT##		; save it
	PUSHJ	PP,BLD.07		; go output OTFTAB and FTBTAB entries
	MOVE	TB,CUROTF		; get the OTFTAB entry we just output
	SUB	TB,OTFLOC		; make table relative
	HRRM	TB,.STLST		; save
	AOS	.STEXT			; get next extension
	PUSHJ	PP,BLD.07		; output stacker 2 entries
	AOS	.STEXT			; get .ST3
	PUSHJ	PP,BLD.07		; output that entry
	AOS	.STEXT			; get .ST4
	PUSHJ	PP,BLD.07		; output that too
	SWOFF	FLAG;			; turn off the flag
	MOVE	TA,CURFIL		; restore the AC
	POP	PP,CUROTF		; restore pointer
	POPJ	PP,			; exit
;OUT.00		Final setup before outputing tables
;
;
;

OUT.00:	MOVE	CH,[XWD AS.REL+1B35,AS.MSC]	; [356]
	PUSHJ	PP,PUTAS1		; [356] output a RELOC
	MOVEI	CH,AS.DAT		; [356] to start of DATAB so that
	PUSHJ	PP,PUTAS1		; [356] correct value of %DAT is output by G.
	AOS	EAS1PC			; bump the PC one more time
	MOVE	CH,[XWD AS.REL+1B35,AS.MSC]
	PUSHJ	PP,PUTAS1##		; PUT OUT TYPE WORD
	MOVE	CH,EAS1PC		; OUR INCREMENT
	TRO	CH,AS.DOT##		; .+
	PUSHJ	PP,PUTAS1		; OUTPUT IT
	MOVE	TA,CURFTB		; GET THE CURRENT FTBTAB POINTER
	SETZ	TB,			; GET A ZERO
	DPB	TB,FT.NFT		; ZERO OUT POINTER
	MOVE	TA,ARRLOC		; get start of ARRTAB
	CAMN	TA,ARRNXT		; anything in it?
	  JRST	OUT.01			; no -
	MOVE	TA,CURARR		; yes - get last item
	MOVEI	TB,1			; get a flag
	DPB	TB,AR.LAS##		; flag as last item

OUT.01:	PUSHJ	PP,ARR.00		; output ARRTAB
;OTF.00		OTFTAB OUTPUT ROUTINE
;
;THIS ROUTINE OUTPUTS OTFTAB TO AS1FIL.
;

OTF.00:	MOVE	TA,EAS1PC		; GET CURRENT PC
	MOVEM	TA,OTFBAS##		; STORE AS BASE OF OTFTAB
	SETZM	EAS1PC			; ZAPETH THE PC
	HRRZ	TA,OTFLOC		; START AT THE BEGINNING
	MOVEM	TA,CUROTF		; STORE FOR LATER
	HRLZI	CH,AS.REL+1B35
	HRRI	CH,AS.MSC
	PUSHJ	PP,PUTAS1
	HRRZI	CH,AS.OTB##
	PUSHJ	PP,PUTAS1		; RELOC %OTF

OTF.01:	HRRZ	TB,OTFNXT		; GET END O' LINE
	CAML	TA,TB			; ARE WE THERE YET?
	JRST	ICH.00			; YES - GO DUMP ICHTAB

	MOVEI	CH,3			; GONNA PUT OUT 3 XWD'S
	TLO	CH,AS.XWD##		; TELL THE ASSEMBLER
	PUSHJ	PP,PUTAS1		; OUTPUT THE WORD
	MOVSI	TB,-5			; SET UP AOBJ POINTER

OTF.02:	LDB	CH,@PTAB1(TB)		; GET OTFTAB ITEM
	CAIN	CH,777777		; [021] IS SPECIAL??
	AOJA	CH,.+4			; [021] YES - CHANGE TO RELOCATED ZERO
	JUMPN	CH,.+3			; ZERO?
	SKIPGE	PTAB1(TB)		; YES - DO WE WANT NON-RELOCATABLE ZERO?
	SKIPA	CH,[XWD AS.CNB,0]	; YES - GIVE IT TO 'EM
	ADD	CH,ATAB1(TB)		; NO - ADD IN RELOCATION
	MOVSS	CH			; GET EVERYTHING WHERE IT BELONGS
	PUSHJ	PP,PUTAS1		; OUTPUT IT
	AOBJN	TB,OTF.02		; LOOP UNTIL DONE
	LDB	CH,OT.FTB##		; GET FTBTAB POINTER
	ADDI	CH,AS.FTB##		; FLAG IT
	PUSHJ	PP,PUTAS1		; OUTPUT IT
	MOVE	CH,[XWD AS.SIX##,1]	; WRITE OUT SIXBIT CONSTANT
	PUSHJ	PP,PUTAS1		;
	LDB	CH,OT.NAM##		; PHYSICAL NAME OF FILE
	PUSHJ	PP,PUTAS1		; OUTPUT
	MOVE	CH,[XWD AS.OCT,5]	; GONNA WRITE 6 MORE WORDS
	PUSHJ	PP,PUTAS1		; SAY SO
	MOVE	TB,[XWD -5,4]		; ANOTHER AOBJ POINTER

;OTF.00 (CONT'D)	CONTINUE OUTPUTING OTFTAB ENTRIES
;

OTF.03:	MOVE	TD,CUROTF		; GET BASE
	ADD	TD,TB			; INCREMENT
	MOVE	CH,(TD)			; GET THE WORD WE WANT
	PUSHJ	PP,PUTAS1		; OUTPUT IT
	AOBJN	TB,OTF.03		; LOOP 'TIL DONE
	ADDI	TA,SZ.OTF		; BUMP POINTER
	MOVEM	TA,CUROTF		; RESTORE
	MOVEI	TB,SZ.OTF		; GET SIZE OF THAT ENTRY
	ADDM	TB,EAS1PC		; BUMP EAS1PC
	JRST	OTF.01			; LOOP

;TABLE FOR RELOCATABLE ENTRIES IN OTFTAB

ATAB1:	XWD	AS.MSC,AS.DAT
	XWD	AS.MSC,AS.OTB
	XWD	AS.MSC,AS.DAT
	XWD	AS.MSC,AS.OCB
	XWD	AS.MSC,AS.ICB

PTAB1:	EXP	OT.COR##+1B0
	EXP	OT.ADP##
	EXP	OT.BFP##
	EXP	OT.OPC##+1B0
	EXP	OT.IPC##+1B0




EXTERNAL AS.MSC, AS.DAT, AS.OTB, AS.OCB, AS.ICB, AS.CNS

;ICH.00		ICHTAB OUTPUT ROUTINE
;
;THIS ROUTINE OUTPUTS ICHTAB TO AS1FIL.
;

ICH.00:	MOVE	TA,EAS1PC		; GET PC
	MOVEM	TA,ICHBAS##		; STORE AS BASE OF ICHTAB
	SETZM	EAS1PC			; ZAP PC
	HRRZ	TA,ICHLOC		; GET START OF ICHTAB
	HRLZI	CH,AS.REL+1B35
	HRRI	CH,AS.MSC
	PUSHJ	PP,PUTAS1
	HRRZI	CH,AS.ICB##
	PUSHJ	PP,PUTAS1		; RELOC %ICH

ICH.01:	HRRZ	TB,ICHNXT		; GET LAST LOC
	CAML	TA,TB			; ARE WE THERE?
	JRST	OCH.00			; YES - GO DUMP OCHTAB

	MOVE	CH,[XWD AS.BYT,AS.MSC]	; OUTPUT A BYTE POINTER
	PUSHJ	PP,PUTAS1		; TELL G THAT
	MOVE	CH,(TA)			; GET FIRST WORD
	TRO	CH,AS.DAT		; RELATIVE TO %DAT
	PUSHJ	PP,PUTAS1		; OUTPUT THAT TOO
	MOVE	CH,[XWD AS.XWD,3]	; SETUP TO DUMP 3 XWD's
	PUSHJ	PP,PUTAS1		; DUMP
	MOVSI	TB,-4			; MAKE AN AOBJ POINTER

ICH.02:	LDB	CH,@PTAB2(TB)		; GET A WORD
	JUMPN	CH,ICH.2A		; [324] zero?
	MOVE	CH,[XWD AS.CNB##,0]	; [324] yes - put a zero in ASYFIL
	JRST	ICH.2B			; [324]

ICH.2A:	CAIN	CH,777777		; [324] relocatable zero entry?
	  MOVEI	CH,0			; [324] yes - set to zero
	ADD	CH,ATAB2(TB)		; [324] add relocation to increment

ICH.2B:	MOVSS	CH			; [324] swap!
	PUSHJ	PP,PUTAS1		; OUTPUT IT
	AOBJN	TB,ICH.02		; LOOP 'TIL DONE
	HLRZ	CH,3(TA)		; get index pointer (IC.INP)
	ADD	CH,[XWD AS.MSC,AS.DAT]	; RELOCATE WITH RESPECT TO DATAB
	LDB	TC,IC.IMD		; GET IMMEDIATE FLAG
	JUMPE	TC,ICH.04		; IF NOT IMMEDIATE, LEAVE AS IS
	HLRZ	CH,3(TA)		; else make it non-relocatable
	HRLI	CH,AS.CNB		; MARK AS CONSTANT
	CAIA				; NO REASON TO SWAP HALVES

ICH.04:	MOVSS	CH			; OF COURSE
	PUSHJ	PP,PUTAS1		; OUTPUT IT

	MOVE	CH,[XWD AS.CNB,0]	; ROUND OUT ODD HALF
	PUSHJ	PP,PUTAS1
	MOVE	CH,[XWD AS.OCT,3]	; 3 OCTAL CONSTANTS
	PUSHJ	PP,PUTAS1		;
	MOVE	TB,[XWD -3,4]		; AOBJ POINTER
;ICH.00 (CONT'D)	CONTINUE OUTPUTING ICHTAB ENTRIES
;

ICH.03:	MOVE	TC,TA			; GET BASE
	ADD	TC,TB			; GET APPROPRIATE WORD
	MOVE	CH,(TC)			; LOAD IT
	PUSHJ	PP,PUTAS1		; DUMP IT
	AOBJN	TB,ICH.03		; LOOP IT
	ADDI	TA,SZ.ICH		; BUMP IT
	MOVEI	TB,SZ.ICH		; GET SIZE OF ICHTAB ENTRY
	ADDM	TB,EAS1PC		; BUMP PC ACCORDINGLY
	JRST	ICH.01			; LOOP IT



ATAB2:	XWD	AS.MSC,AS.LIT
	XWD	AS.MSC,AS.ICB
	XWD	AS.MSC,AS.ICB
	XWD	AS.MSC,AS.ICB		; [324]

PTAB2:	EXP	IC.RII
	EXP	IC.NXF
	EXP	IC.NXR
	EXP	IC.ARP##
;OCH.00		OUTPUT OCHTAB TO AS1FIL
;
;THIS ROUTINE WILL DUMP OCHTAB TO AS1FIL, DOING APPROPRIATE TRANSLATIONS
;

OCH.00:	MOVE	TA,EAS1PC		; GET PC
	MOVEM	TA,OCHBAS##		; IS START OF OCHTAB
	SETZM	EAS1PC			; START OVER AGAIN
	HRRZ	TA,OCHLOC		; GET START OF TABLE
	HRLZI	CH,AS.REL+1B35
	HRRI	CH,AS.MSC
	PUSHJ	PP,PUTAS1
	HRRZI	CH,AS.OCB##
	PUSHJ	PP,PUTAS1		; RELOC %OCH

OCH.01:	HRRZ	TB,OCHNXT		; GET END
	CAML	TA,TB			; ARE WE THERE?
	JRST	FTB.00			; YES - ALL DONE
	MOVE	CH,[XWD AS.XWD,2]	; TWO XWD's
	PUSHJ	PP,PUTAS1		;
	MOVSI	TB,-4			; AOBJ POINTER
	LDB	TC,OC.IMD		; IMMEDIATE INDEX?
	JUMPE	TC,OCH.02		; NO -
	HLRZ	CH,(TA)			; yes - get index (OC.IDX)
	PUSHJ	PP,PUTAS1		; OUTPUT WORD
	AOBJP	TB,			; BUMP POINTER

OCH.02:	LDB	CH,@PTAB3(TB)		; GET A BYTE
	JUMPN	CH,.+2			; IS IT ZERO?
	SKIPA	CH,[XWD AS.CNB,0]	; YES - STUFF ZERO IN ASYFIL
	ADD	CH,ATAB3(TB)		; ELSE SET UP RELOCATE
	MOVSS	CH			; THE RITUAL
	PUSHJ	PP,PUTAS1		; OUTPUT
	AOBJN	TB,OCH.02		; LOOP IF NOT DONE
	MOVE	CH,[XWD AS.BYT,AS.MSC]	; SET UP FOR A BYTE POINTER
	PUSHJ	PP,PUTAS1		; OUTPUT DESCRIPTOR
	MOVE	CH,2(TA)		; GET BYTE POINTER
	TRO	CH,AS.DAT		; RELOCATE RELATIVE TO DATBAS
	PUSHJ	PP,PUTAS1		; AND OUTPUT
	MOVE	CH,[XWD AS.OCT,3]	; THREE OCTAL CONSTANTS
	PUSHJ	PP,PUTAS1		;
	MOVE	TB,[XWD -3,3]		; A POINTER
;OCH.00 (CONT'D)	CONTINUE OUTPUTING OCHTAB ENTRIES
;

OCH.03:	MOVE	TC,TA			; GET CURRENT TABLE ENTRY
	ADD	TC,TB			; ADD IN INDEX
	MOVE	CH,(TC)			; GET ENTRY
	PUSHJ	PP,PUTAS1		; OUTPUT IT
	AOBJN	TB,OCH.03		; KEEP ON LOOPIN'
	MOVE	CH,[XWD AS.XWD,1]	; ANOTHER XWD
	PUSHJ	PP,PUTAS1		;
	HLRZ	CH,6(TA)		; this one is array pointer (OC.ARP)
	CAIE	CH,777777		; special flag?
	  JRST	.+3			; no - treat normally
	SETZ	CH,			; yes - make a zero
	JRST	.+3			; and relocate against ICHTAB
	JUMPN	CH,.+2			; NOT ZERO SO SKIP
	SKIPA	CH,[XWD AS.CNB,0]	; IS ZERO SO PUT ZERO
	ADD	CH,[XWD AS.MSC,AS.ICB]	; RELOCATE AGAINST %ICH
	MOVSS	CH			;
	PUSHJ	PP,PUTAS1		;
	HRRZ	CH,6(TA)		; get edit word pointer (OC.EDP)
	JUMPN	CH,.+2			; IF IS ZERO
	SKIPA	CH,[XWD AS.CNB,0]	; SUBSTITUTE A NON-RELOCATABLE ZERO
	ADD	CH,[XWD AS.MSC,AS.LIT]	; ELSE ADD IN RELOCATION TO EXISITING POINTER
	MOVSS	CH			; GET EVERYTHING WHERE IT BELONGS
	PUSHJ	PP,PUTAS1		; LIKE THIS
	MOVEI	TB,SZ.OCH		; GET SIZE
	ADDM	TB,EAS1PC		; BUMP PC
	ADDI	TA,SZ.OCH		; GET NEXT ENTRY
	JRST	OCH.01			; LOOP -



ATAB3:	XWD	AS.MSC,AS.ICB
	XWD	AS.MSC,AS.OCB
	XWD 	AS.MSC,AS.OCB
	XWD	AS.MSC,AS.LIT

PTAB3:	EXP	OC.IDX
	EXP	OC.NXR
	EXP	OC.NXF
	EXP	OC.IND
;FTB.00		ROUTINE TO OUTPUT FTBTAB TO AS1FIL
;
;

FTB.00:	MOVE	TA,EAS1PC		; GET PC
	MOVEM	TA,FTBBAS##		; SAVE IT
	SETZM	EAS1PC			; ZAP PC
	MOVE	CH,[XWD AS.REL,AS.FTB]	; GET THE RELOC
	PUSHJ	PP,PUTAS1		; OUTPUT RELOC %FTB
	HRRZ	TA,FTBLOC##		; START AT THE BEGINNING

FTB.01:	HRRZ	TB,FTBNXT		; GET END OF TABLE
	CAML	TA,TB			; ARE WE THERE YET?
	  JRST	LDC.00			; YES - EXIT
	HRRZM	TA,CURFTB		; NO - STASH POINTER
	MOVE	CH,[XWD AS.OCT,SZ.DEV]	; Device table is 32 words long
	PUSHJ	PP,PUTAS1		; Output header
	MOVNI	TB,SZ.DEV		; Get counter
	SETZ	CH,			; Get a constant of zero
	PUSHJ	PP,PUTAS1		; Output a zero
	AOJL	TB,.-1			; Loop until we've put out 32 of 'em
	MOVE	CH,[XWD AS.SIX,5]	; SET UP TO OUTPUT FT.FNM
	PUSHJ	PP,PUTAS1		; OUTPUT HEADER
	MOVNI	TB,5			; GET COUNT

FTB.02:	MOVE	CH,(TA)			; GET A WORD
	PUSHJ	PP,PUTAS1		; OUTPUT IT
	ADDI	TA,1			; BUMP POINTER
	AOJN	TB,FTB.02		; LOOP UNTIL DONE
	MOVE	CH,[XWD AS.XWD,SZ.FTB-5]; get monster header
	PUSHJ	PP,PUTAS1		; OUTPUT
	HLLZ	CH,(TA)			; GET LH OF WORD
	HRRI	CH,AS.CNB		; GET CONTROL INFO
	PUSHJ	PP,PUTAS1		; OUTPUT
	HRLZ	CH,(TA)			; GET RIGHT HALF
	IOR	CH,[XWD AS.LIT,AS.MSC]	; GET CONTROL DATA
	PUSHJ	PP,PUTAS1		; OUTPUT
	ADDI	TA,1			; INCREMENT POINTER
	HLLZ	CH,(TA)			; GET LH
	HRRI	CH,AS.CNB		; THE USUAL
	PUSHJ	PP,PUTAS1		; LIKEWISE
	HRRZ	CH,(TA)			; ALL BECAUSE FT.NFT IS WEIRD
	SKIPN	CH			; ZERO?
	  SKIPA	CH,[XWD 0,AS.CNB]	; YES - USE REAL ZERO
	ADDI	CH,AS.FTB		; NO - RELOCATE
	PUSHJ	PP,PUTAS1		; OUTPUT
	ADDI	TA,1			; BUMP POINTER
	MOVSI	TB,-<SZ.FTB-7>		; make IOWD
;FTB.00 (CONT'D)
;
;

FTB.03:	HLLZ	CH,(TA)			; GET LH OF TABLE WORD
	HLLZ	TC,ASTAB(TB)		; GET RELOCATION CODE
	IOR	CH,TC			; COMBINE
	HRRI	CH,AS.MSC		; GET OTHER ASYFIL DATA
	SKIPN	TC			; RELOCATED?
	  HRRI	CH,AS.CNB		; NO - USE CONSTANT FLAG
	PUSHJ	PP,PUTAS1		; OUTPUT
	HRLZ	CH,(TA)			; GET RH OF TABLE WORD
	HRLZ	TC,ASTAB(TB)		; GET CORRESPONDING RELOCATION
	IOR	CH,TC			; COMBINE
	HRRI	CH,AS.MSC		; GET RH OF DATA WORD
	SKIPN	TC			; RELOCATED?
	  HRRI	CH,AS.CNB		; NO - SET UP AS CONSTANT
	PUSHJ	PP,PUTAS1		; OUTPUT
	ADDI	TA,1			; BUMP POINTER
	AOBJN	TB,FTB.03		; LOOP UNTIL DONE
	MOVEI	TB,SZ.FTB+SZ.DEV	; get total table size
	ADDM	TB,EAS1PC		; AND BUMP PC
	JRST	FTB.01			; AND TAKE THE BIG LOOP

;FTB.00 (CONT'D)	DEFINE RELOCATION TABLES
;
;
;	TABLE IS FORMATTED AS FOLLOWS:
;
;	LH CONTAINS RELOCATION FOR LEFT HALF OF DATA WORD. IF THE RELOCATION
;		IS ZERO, THEN THE DATA IS TREATED AS NON-RELOCATABLE.
;
;	RH CONTAINS RELOCATION FOR RIGHT HALF OF DATA WORD FORMMATTED THE
;		SAME AS THE LH.
;
;

ASTAB:	XWD	0,0
	XWD	0,AS.DAT
	XWD	0,0
	XWD	0,AS.LIT
	XWD	0,AS.LIT
	XWD	0,0
	XWD	0,0
	XWD	0,0
	XWD	0,0
	XWD	0,0
	XWD	0,0
	XWD	0,0
	XWD	0,AS.LIT
	XWD	0,AS.DAT
	XWD	0,0
	XWD	0,0
	XWD	0,0
	XWD	0,0
	XWD	0,0
	XWD	0,0
	XWD	0,0
	XWD	0,0
	XWD	0,0
	XWD	0,0
	XWD	AS.LIT,AS.LIT
	XWD	0,0
	XWD	0,0

ASTBLN==.-ASTAB
IFN <ASTBLN-<SZ.FTB-7>>,<PRINTX ?ASTAB is incorrect length for SZ.FTB>
;LDC.00		Output compile time arrays to AS1FIL
;
;Note special register definition.
;
;

	OPTR==2
	IPTR==3
	EPR==5
	OCC==6
	SIZ==7

LDC.00:	SKIPN	LDCIND			; any compile time arrays?
	  JRST	GENIE			; no -
	MOVE	LN,ARRLIN##		; get saved line number
	MOVEM	LN,SAVELN##		; and restore it
	TSWF	FEOF;			; yes - but are we at end of source?
	  JRST	LDC.06			; yes - minor error
	LDB	TB,[POINT 14,CRDBUF,13]	; get first 2 characters
	CAIE	TB,"**"			; hmmmmm?
	  JRST	LDC.10			; error of sorts

LDC.11:	SETZM	LDCIND			; reset index

LDC.03:	SETZM	TEMCNT##		; [355] and PC counter
	SETZM	TM2CNT##		; Likewise for alternate
	SWOFF	FLALT!FLUALT;		; [346] [355] zap some flags
	PUSHJ	PP,RDCRD		; [340] get a card
	  JRST	LDC.06			; E-O-F
	  JRST	LDC.07			; **
	AOS	TA,LDCIND		; get an index
	SKIPN	TA,LDCTAB(TA)		; anything there?
	  JRST	GENIE			; no -
	PUSHJ	PP,LNKSET		; yes - set up the link
	LDB	TB,DA.ALL		; get alternating link
	SKIPE	TB			; alternating arrays/tables?
	  SWON	FLALT;			; yes -
	MOVE	CH,[XWD AS.REL+1,AS.MSC]; get RELOC
	PUSHJ	PP,PUTAS1		; output it
	LDB	CH,DA.COR		; get core address
	ADDI	CH,AS.DAT		; [340] make DATAB relative
	PUSHJ	PP,PUTAS1		; output
	LDB	EPR,DA.EPR		; get entries/record
	LDB	OCC,DA.OCC		; get number of occurs
	TSWF	FLALT;			; alternating?
	  IMULI	OCC,2			; yes - double occurs
	MOVE	IPTR,[POINT 7,CRDBUF]	; get pointer into buffer
	MOVE	OPTR,[POINT 6,TEMBUF]	; get pointer into storage
	TSWT	FLALT;			; alternating arrays?
	  JRST	LDC.08			; no -
	MOVEM	OPTR,CURARP##		; yes - stash pointer
	MOVE	OPTR,[POINT 6,TM2BUF]	; get new pointer
	EXCH	OPTR,CURARP		; [355] get pointers into correct places
	MOVEM	TA,CURARR		; stash pointer
	LDB	TA,DA.ALL		; get new link
	CAIN	TA,TC.DAT+77777		; [346] is it relocatable zero?
	  ANDI	TA,-TM.DAT-1		; [346] yes - make it so
	PUSHJ	PP,LNKSET		; set it up
	EXCH	TA,CURARR		; [346] get pointers in correct order
	IMULI	EPR,2			; [346] alternating tables get twice
;LDC.00 (cont'd)
;
;
;

LDC.08:	TSWT	FLALT;			; alternating?
	  JRST	LDC.09			; no -
	TSWC	FLUALT;			; switch items
	EXCH	OPTR,CURARP		; swap
	EXCH	TA,CURARR		; pointers

LDC.09:	LDB	SIZ,DA.SIZ		; get size of field
LDC.01:	ILDB	CH,IPTR			; get a character
	SUBI	CH,40			; convert to sixbit
	IDPB	CH,OPTR			; store
	TLNN	OPTR,770000		; word full?
	  PUSHJ	PP,TEMOUT		; yes - output it
	SOJG	SIZ,LDC.01		; loop until whole field is out
	SOJLE	OCC,LDC.02		; exit if whole array is done
	SOJG	EPR,LDC.08		; loop if any record left
	PUSHJ	PP,RDCRD		; else read in a card
	  JRST	LDC.06			; E-O-F
	  JRST	LDC.07			; **
	MOVE	IPTR,[POINT 7,CRDBUF]	; get new pointer
	LDB	EPR,DA.EPR		; and get entries/record again
	TSWF	FLALT;			; [346] using alternating tables?
	  IMULI	EPR,2			; [346] yes - double it
	JRST	LDC.08			; loop

LDC.02:	TLNE	OPTR,770000		; anything left in word?
	  PUSHJ	PP,TEMOUT		; yes - output it
	TSWT	FLALT;			; [355] alternating tables?
	  JRST	LDC.04			; [355] no -
	MOVE	OPTR,CURARP		; [355] yes - get alternate pointer
	MOVE	TA,CURARR		; [355] get array pointer
	TSWC	FLUALT;			; [355] complement user flag
	TLNE	OPTR,770000		; [355] anything left in buffer?
	  PUSHJ	PP,TEMOUT		; [355] yes - output it

LDC.04:	PUSHJ	PP,RDCRD		; read a card
	  JRST	LDC.05			; E-O-F
	  JRST	LDC.03			; **
	WARN	333;			; too much data
	JRST	LDC.04			; try again

LDC.05:	AOS	TA,LDCIND		; get another entry
	SKIPN	LDCTAB(TA)		; anything left?
	  JRST	GENIE			; No  ok

LDC.06:	WARN	334;			; not enough data
	JRST	GENIE			; exit

LDC.07:	WARN	334;			; not enough data
	JRST	GENIE			; loop

LDC.10:	WARN	22;			; bad card
	PUSHJ	PP,RDCRD		; get another
	  JRST	LDC.06			; E-O-F
	  JRST	LDC.07			; **
	JRST	LDC.11			; loop
;TEMOUT		Output a word to AS1FIL
;
;
;

TEMOUT:	TSWF	FLALT;			; alternating?
	  JRST	TEM.00			; yes - handle special
	MOVE	CH,[XWD AS.SIX,1]	; one word of sixbit
	PUSHJ	PP,PUTAS1		; coming up
	MOVE	CH,(OPTR)		; get the word
	PUSHJ	PP,PUTAS1		; output
	MOVE	OPTR,[POINT 6,TEMBUF]	; get new pointer
	TSWF	FLUALT;			; using alternate?
	  MOVE	OPTR,[POINT 6,TM2BUF]	; yes - use pointer to that
	POPJ	PP,			; and exit

TEM.00:	MOVE	CH,[XWD AS.REL+1,AS.MSC]; get a RELOC
	PUSHJ	PP,PUTAS1		; output it
	LDB	CH,DA.COR		; get core address
	ADDI	CH,AS.DAT		; [340] %DAT is base address
	TSWT	FLUALT;			; using alternate?
	  JRST	TEM.01			; no -
	ADD	CH,TM2CNT		; yes - add in how many words we've already put
	AOS	TM2CNT			; bump the count
	PUSHJ	PP,PUTAS1		; output the RELOC address
	JRST	TEMOUT+2		; then output the sixbit word

TEM.01:	ADD	CH,TEMCNT		; increment it
	AOS	TEMCNT			; bump
	PUSHJ	PP,PUTAS1		; output address
	JRST	TEMOUT+2		; loop


;RDCRD		Read in a card image for LDC.00
;
;
;

RDCRD:	PUSHJ	PP,GETSRC##		; get a character
	TSWF	FEOF;			; at E-O-F?
	  POPJ	PP,			; yes -
	SWON	FREGCH;			; no - set to reget the character
	PUSHJ	PP,GETCRD##		; get a cards worth
	LDB	TB,[POINT 14,CRDBUF,13]	; get first 2 chars
	CAIN	TB,"/*"			; [340] eof card?
	  POPJ	PP,			; [340] yes - take eof return
	AOS	(PP)			; [340] no - increment return
	CAIN	TB,"**"			; double star?
	  POPJ	PP,			; yes -
	AOS	(PP)			; No - bump PC once more
	POPJ	PP,			; then return
;ARR.00		Output ARRTAB to AS1FIL
;
;
;

ARR.00:	MOVE	TA,EAS1PC		; get where we left of after data
	MOVEM	TA,ARRBAS##		; save for later
	SETZM	EAS1PC			; and zap count
	HRRZ	TA,ARRLOC##		; get start of table

ARR.01:	HRRZ	TB,ARRNXT		; get end of table
	CAMN	TA,TB			; are we there yet?
	  POPJ	PP,			; yes - exit
	MOVEM	TA,CURARR		; save pointer
	MOVE	CH,[XWD AS.BYT,AS.MSC]	; no - set up to output byte pointer
	PUSHJ	PP,PUTAS1		; output
	MOVE	CH,(TA)			; get AR.PNT
	TRO	CH,AS.DAT		; add in relocation
	PUSHJ	PP,PUTAS1		; output it
	MOVE	CH,[XWD AS.OCT,1]	; set up for octal constant
	PUSHJ	PP,PUTAS1		; output header
	MOVE	CH,1(TA)		; get ARR flags
	PUSHJ	PP,PUTAS1		; output those too
	MOVE	CH,[XWD AS.XWD,1]	; next output an XWD
	PUSHJ	PP,PUTAS1		; output the header word
	HLRZ	TA,2(TA)		; get FILTAB pointer
	PUSHJ	PP,LNKSET		; set it up
	LDB	CH,FI.OTF		; get OTFTAB pointer
	MOVSS	CH			; get into proper half
	IOR	CH,[XWD AS.OTB,AS.MSC]	; get relocation word
	PUSHJ	PP,PUTAS1		; output the LH
	MOVE	TA,CURARR		; [253] restore ARRTAB pointer
	HRLZ	CH,2(TA)		; get RH flags
	HRRI	CH,AS.CNB		; identify as constant
	PUSHJ	PP,PUTAS1		; so output it
	SKIPN	3(TA)			; all zero?
	  JRST	ARR.02			; yes - go output a zero
	MOVE	CH,[XWD AS.BYT,AS.MSC]	; get ready for byte pointer
	PUSHJ	PP,PUTAS1		; output it
	MOVE	CH,3(TA)		; get the pointer
	TRO	CH,AS.DAT		; DATBAS relative otherwise
ARR.03:	PUSHJ	PP,PUTAS1		; output it
	MOVEI	TB,SZ.ARR		; get size of ARRTAB entry
	ADDM	TB,EAS1PC		; bump the ASYfil PC
	HRRZ	TA,CURARR		; get ARRTAB pointer
	ADDI	TA,SZ.ARR		; increment it
	JRST	ARR.01			; and keep on looping

ARR.02:	MOVE	CH,[XWD AS.OCT,1]	; get constant header
	PUSHJ	PP,PUTAS1		; output
	SETZ	CH,			; get zero constant
	JRST	ARR.03			; output
;ROUTINE TO DUMP LITAB ENTRIES WHOSE POINTER IS IN TC
;
;THIS ROUTINE MUST NOT DISTURB AC'S TA OR TB
;
;
;

INDOUT:	EXCH	TA,TC			; GET POINTER AND STORE TA
	PUSHJ	PP,LNKSET		; GET REAL INDTAB LINK
	MOVE	CH,[XWD OCTLIT,1]	; GONNA OUTPUT A WORD
	PUSHJ	PP,STASHC##		; OUTPUT HEADER
	MOVE	CH,(TA)			; GET INDTAB WORD
	PUSHJ	PP,STASHC		; OUTPUT IT
	AOS	ELITPC			; BUMP LITAB PC
	LDB	CH,ID.END##		; GET END FLAG
	JUMPN	CH,.+2			; IS IT END?
	AOJA	TA,INDOUT+2		; NO - LOOP
	EXCH	TA,TC			; YES - RESTORE TA
	POPJ	PP,			; AND EXIT

;
;	GENIE
;
;	THIS IS THE HEART OF THE CODE GENERATOR. IT IS THIS ROUTINE
;	THAT READS THE OP'S OUT OF GENFIL, STASHES THEM IN
;	APPROPRIATE SPOTS, THEN DISPATCHES TO THE CORRECT ROUTINE.
;
;
;

GENIE:	HRLZI	CH,(<ENDOP>B8)		; FLAG END OF GENFIL
	PUSHJ	PP,PUTGEN##		; AND OUTPUT IT
	CLOSE	GEN,			; CLOSE OUT FILE
	MOVE	CH,PRGID##		; OUR VERY FIRST TAG
	MOVEM	CH,NAMWRD##		; STASH
	SETZM	NAMWRD+1		; AND ZAP THE GARBO
	PUSHJ	PP,TRYNAM##		; LOOKUP
	PUSHJ	PP,BLDNAM##		; NOT THERE- PUT IT THERE
	MOVEM	TA,CURNAM##		; STASH
	MOVE	TA,[XWD CD.PRO,SZ.PRO]	; GET PRAMAETERS
	PUSHJ	PP,GETENT##		; GET A PROTAB ENTRY
	HRRZM	TA,CURPRO		; STASH FOR LATER
	MOVS	TB,CURNAM		; REGET NAMTAB LINK
	DPB	TB,PR.NAM##		; STORE IN PROTAB ENTRY
	MOVEI	TB,CD.PRO		; GET OUR SECRET CODE
	DPB	TB,PR.ID##		; STICK IN TABLE
	MOVE	TB,EAS2PC		; GET CURRENT PC
	DPB	TB,PR.LNK##		; STASH AS PC BASE
	MOVE	CH,CURPRO		; GET BACK OUR CURRENT ENTRY
	SUB	CH,PROLOC		; MAKE A TYPE OF POINTER
	HRRZS	CH			; DUMP THE GARBAGE
	ADD	CH,[XWD AS.PN,AS.PRO]	; MAKE AN INSTRUCTION
	PUSHJ	PP,PUTASN		; DEFINE TAG

	PUSHJ	PP,SETGEN##		; OPEN IT UP FOR INPUT
	PUSHJ	PP,GETGEN##		; GET A WORD
	MOVEM	CH,OPHLD##		; STASH IT

	PUSH	PP,[[	OUTSTR	[ASCIZ "?Too many POPJ's
"]
			JRST	KILL
		   ]]			; PROVIDE A SAFETY VALVE
	SWOFF	FINDON;			; TURN OFF "INDCHK GENERATED"


GEN.00:	MOVE	TA,OPHLD		; GET LAST TIMES OP
	TLNE	TA,400000		; IS IT REALLY AN OP?
	JRST	NOTOP			; NO - ERROR
	LDB	TB,[POINT 8,TA,8]	; YES - GET OP-CODE
	CAILE	TB,HIOP			; IS IT < HIOP?
	JRST	BIGOP			; NO - SHOULD BE = HIOP
	SETZM	OPRTR##			; ZAP THE AREA
	MOVE	TC,[XWD OPRTR,OPRTR+1]	; SET UP TO ZAP ALL
	BLT	TC,OPRTR+5		; AND DO IT
	MOVEM	TA,OPRTR		; STASH OP
	PUSHJ	PP,GETGEN		; GET SECOND WORD
	MOVEM	CH,OPRTR+1		; AND STORE
	PUSHJ	PP,GETGEN		; GET ANOTHER
	TLNN	CH,400000		; IS OPERAND?
	JRST	GEN.01			; NO - SHOULD BE OPERATOR
	MOVEM	CH,OPRTR+2		; YES - STASH
	PUSHJ	PP,GETGEN		; AND ANOTHER
	TLNN	CH,400000		; ???
	JRST	GEN.01			; OPERATOR
	MOVEM	CH,OPRTR+3		; STASH
	PUSHJ	PP,GETGEN		; AND STILL ANOTHER
	TLNN	CH,400000		; OP?
	JRST	GEN.01			; OPERATOR
	MOVEM	CH,OPRTR+4		; STORE
	PUSHJ	PP,GETGEN		; [315] get another genfil entry
	TLNN	CH,1B18			; [315] operand?
	  JRST	GEN.01			; [315] no - operator
	MOVEM	CH,OPRTR+5		; [315] yes - store
	PUSHJ	PP,GETGEN		; AND STILL ANOTHER

GEN.01:	MOVEM	CH,OPHLD		; STORE FOR NEXT TIME
	SWOFF	FROUND!FOP1AR!FOP1TB!FOP2AR!FOP2TB!FWHOLE!FOP1WL;
	MOVE	TC,[XWD 377777,777777]	; CAN'T HELP BUT GET SMALLER
	MOVEM	TC,WHOSIZ##		; START SIZE FOR WHOLE ARRAYS
	PUSHJ	PP,@OPTAB(TB)		; OFF TO THE ROUTINE
	JRST	GEN.00			; AND LOOP ON AROUND


BIGOP:	CAIN	TB,ENDOP		; VALID ENDOP?
	JRST	CLSUP			; YEP - GO FINISH

.BADOP:	OUTSTR	[ASCIZ "?Bad GENFIL operator
"]
	JRST	KILL##



NOTOP:	OUTSTR	[ASCIZ "?Operator not found when expected
"]
	JRST	KILL

NOTIMP:	LDB	TB,[POINT 13,OPRTR,28]	; GET LINE NUMBER
	MOVEM	TB,SAVELN##		; STASH
	WARN	706;			; OPERATOR NOT IMPLEMENTED
	POPJ	PP,			; RETURN


;
;DISPATCH TABLE FOR OPERATORS
;
;
;
;


OPTAB:	EXP	.BADOP			; ZERO ALWAYS INVALID
	EXP	.ADD			; ADD
	EXP	.ZADD			; ZADD
	EXP	.SUB			; SUB
	EXP	.ZSUB			; ZSUB
	EXP	.MULT			; MULT
	EXP	.DIV			; DIV
	EXP	.MVR			; MVR
	EXP	.XFOOT			; XFOOT
	EXP	.SQRT			; SQRT
	EXP	.MOVE			; MOVE
	EXP	.MOVEL			; MOVEL
	EXP	.MLLZO			; MLLZO
	EXP	.MHHZO			; MHHZO
	EXP	.MLHZO			; MLHZO
	EXP	.MHLZO			; MHLZO
	EXP	.COMP			; COMP
	EXP	.TESTZ			; TESTZ
	EXP	.BITON			; BITON
	EXP	.BITOF			; BITOF
	EXP	.TESTB			; TESTB
	EXP	.SETON			; SETON
	EXP	.SETOF			; SETOF
	EXP	.GOTO			; GOTO
	EXP	.TAG			; TAG
	EXP	.EXIT			; EXIT
	EXP	.RLABL			; RLABL
	EXP	.LOKUP			; LOKUP (TABLE)
	EXP	.LOKUP			; LOKUP (ARRAY)
	EXP	.BEGSR			; BEGSR
	EXP	.ENDSR			; ENDSR
	EXP	.EXSR			; EXSR
	EXP	.FORCE			; FORCE
	EXP	.EXCPT			; EXCPT
	EXP	.DSPLY			; DSPLY
	EXP	.READ			; READ
	EXP	.CHAIN			; CHAIN
	EXP	.DEBUG			; DEBUG
	EXP	.DET			; DETAIL CALC ESCAPE LINKAGE
	EXP	.CAL			; CONTROL CALC ESCAPE LINKAGE
	EXP	.MOVEA			; MOVEA
	EXP	.TIME			; TIME

HIOP==.-OPTAB
ENDOP==377
;GENERATE CODE FOR ADD
;
;

.ADD:	PUSHJ	PP,CHK3##		; CHECK FOR WHOLE ARRAYS
	PUSHJ	PP,INDCHK##		; GENERATE INDICATOR CHECK CODE
	TSWF	FWHOLE;			; WHOLE ARRAY?
	  PUSHJ	PP,WHLGN1##		; YES - GENERATE SOME CODE
	PUSHJ	PP,GT1AC1##		; GET OP1 INTO AC1
	PUSHJ	PP,GT2AC3##		; GET OP2 INTO AC3
	HRRZ	TA,OPRTR##+4		; GET RESULT LINK
	PUSHJ	PP,LNKSET##		; SET UP DATAB LINK
	LDB	TB,DA.FLD##		; GET FIELD TYPE
	SKIPN	TB			; ALPHA NO GOOD
	PUSHJ	PP,FNDFLD##		; TELL THE TURKEY
	LDB	TC,DA.DEC##		; GET DECIMAL POSITION COUNT
	LDB	TB,DA.RND##		; GET ROUNDING FLAG
	SKIPE	TB			; DO WE NEED TO ROUND?
	SWON	FROUND;			; YEP
	PUSHJ	PP,SH1AC1##		; SHIFT AC1 INTO LINE
	PUSHJ	PP,SH2AC3##		; SHIFT AC3 INTO LINE
	SETZ	LN,			; THE MAGIC INDEX
	PUSHJ	PP,CH.12##		; CHOOSE 1 OR 2
	MOVE	TB,OP1SIZ		; [354] get a size
	CAILE	TB,^D10			; [354] double precision?
	  MOVEM	TB,OP2SIZ		; [354] yes - make sure we store double precision
	PUSHJ	PP,PTRAC3##		; STORE RESULT FROM AC3
	TSWF	FWHOLE;			; WHOLE ARRAYS?
	  PJRST	WHLGN2##		; YES -
	POPJ	PP,			; EXIT

;GENERATE CODE FOR SUBTRACT
;
;

.SUB:	PUSHJ	PP,CHK3			; CHECK FOR WHOLE ARRAYS
	PUSHJ	PP,INDCHK		; CHECK FOR INDICATORS
	TSWF	FWHOLE;			; IF WHOLE ARRAYS
	  PUSHJ	PP,WHLGN1		; GENERATE SOME CODE
	PUSHJ	PP,GT2AC1		; GET OP1
	PUSHJ	PP,GT1AC3		; GET OP2
	HRRZ	TA,OPRTR+4		; GET DATAB LINK
	PUSHJ	PP,LNKSET		; SET IT UP
	LDB	TB,DA.FLD		; GET FIELD TYPE
	SKIPN	TB			; WE ONLY WANT NUMERIC
	PUSHJ	PP,FNDFLD		; SAY SO
	LDB	TC,DA.DEC		; GET DECIMALS
	LDB	TB,DA.RND		; GET HALF ADJUST FLAG
	SKIPE	TB			; ON?
	SWON	FROUND;			; YES - TURN THIS ONE ON TOO
	PUSHJ	PP,SH2AC1##		; SHIFT AC1
	PUSHJ	PP,SH1AC3##		; SHIFT AC3
	MOVEI	LN,1			; SUB=1
	PUSHJ	PP,CH.12		; MAKE A CHOICE
	MOVE	TB,OP1SIZ		; [354] get size
	CAILE	TB,^D10			; [354] double precision?
	  MOVEM	TB,OP2SIZ		; [354] yes - store
	PUSHJ	PP,PTRAC3		; SHIFT RESULT
	TSWF	FWHOLE;			; WHOLE?
	  PJRST	WHLGN2			; YES -
	POPJ	PP,			; EXIT
;GENERATE CODE FOR MULTIPLY
;
;

.MULT:	PUSHJ	PP,CHK3			; CHECK OUT ARRAYS
	PUSHJ	PP,INDCHK##		; GENERATE INDICATOR CHECK CODE
	TSWF	FWHOLE;			; WHOLE ARRAYS?
	  PUSHJ	PP,WHLGN1		; YES -
	PUSHJ	PP,GT1AC1##		; GET OP1 INTO AC1
	PUSHJ	PP,GT2AC3##		; GET OP2 INTO AC3
	HRRZ	TA,OPRTR##+4		; GET RESULT LINK
	PUSHJ	PP,LNKSET##		; SET UP DATAB LINK
	LDB	TB,DA.FLD##		; GET FIELD TYPE
	SKIPN	TB			; ALPHA NO GOOD
	PUSHJ	PP,FNDFLD##		; TELL THE TURKEY
	MOVE	TB,OP1SIZ		; [361] GET SIZE OF OP1
	ADD	TB,OP2SIZ		; [361] PLUS SIZE OF OP2
	CAILE	TB,^D19			; [361] WILL IT FIT AS FIXED POINT?
	  JRST	FLTMUL			; [361] NO - USE FLOATING
	LDB	TB,DA.RND##		; GET ROUNDING FLAG
	SKIPE	TB			; DO WE NEED TO ROUND?
	SWON	FROUND;			; YEP
	MOVEI	LN,2			; THE MAGIC INDEX
	PUSHJ	PP,CH.12##		; CHOOSE 1 OR 2
	MOVE	TB,OP1SIZ##		; GET SIZE OF A
	ADD	TB,OP2SIZ##		; ADD IN SIZE OF B
	MOVEM	TB,OP2SIZ		; FUDGE
	MOVE	TB,OP1DEC##		; GET A'S DEC POSITS	
	ADDM	TB,OP2DEC##		; UPDATE B
	LDB	TC,DA.DEC		; GET RESULT DEC POSITS
	PUSHJ	PP,SH2AC3		; SHIFT RESULT
	PUSHJ	PP,PTRAC3		; STORE RESULT FROM AC3
	TSWF	FWHOLE;			; WHOLE ARRAYS?
	  PJRST	WHLGN2			; YES -
	POPJ	PP,			; EXIT
;FLTMUL		Generate floating multiply code
;
;
;

FLTMUL:	MOVE	TB,OP1SIZ		; GET SIZE OF FIRST OP
	MOVE	CH,[XWD FLOT1.+AC1,AS.CNS+1]
	CAILE	TB,^D10			; DOUBLE PRECISION?
	  MOVE	CH,[XWD FLOT2.+AC1,AS.CNS+1]
	PUSHJ	PP,PUTASY		; OUTPUT ONE OR THE OTHER
	MOVE	TB,OP2SIZ		; DO THE SAME FOR OP 2
	MOVE	CH,[XWD FLOT1.+AC3,AS.CNS+3]
	CAILE	TB,^D10			; DOUBLE?
	  MOVE	CH,[XWD FLOT2.+AC3,AS.CNS+3]
	PUSHJ	PP,PUTASY		; OUTPUT IT
	MOVE	CH,[XWD FMP.+AC3,AS.CNS+1]
	PUSHJ	PP,PUTASY		; OUTPUT THE MULTIPLY
	MOVE	TB,OP1DEC		; GET OP 1 DECIMALS
	ADD	TB,OP2DEC		; PLUS OP 2
	LDB	TD,DA.DEC		; GET RESULT DECIMALS
	SUB	TD,TB			; GET AMOUNT TO SHIFT

FLTML0:	JUMPE	TD,FLTML1		; MAYBE NONE?
	MOVE	CH,[XWD FDV.+ASINC+AC3,AS.MSC]
	SKIPL	TD			; SKIP IF RIGHT SHIFT
	  MOVE	CH,[XWD FMP.+ASINC+AC3,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT IT
	MOVMS	TD			; GET SIZE OF SHIFT
	HRRZ	CH,ELITPC		; GET LITAB PC
	IORI	CH,AS.LIT		; SAY WHAT IT IS
	PUSHJ	PP,PUTASN		; AND OUTPUT IT
	MOVE	CH,[XWD FLTLIT,2]	; SAY WHAT WE'RE GOING TO OUTPUT
	PUSHJ	PP,STASHC		; OUTPUT EADER
	MOVEI	CH,1(TD)		; GET EXPONENT
	PUSHJ	PP,STASHC		; OUTPUT THAT
	MOVSI	CH,(1B7)		; GET MANTISSA OF .1
	PUSHJ	PP,STASHC		; OUTPUT THAT TOO
	AOS	ELITPC			; BUMP PC

FLTML1:	MOVE	CH,[XWD FIX.+AC3,AS.CNS+3]
	PUSHJ	PP,PUTASY		; OUTPUT FIX INSTRUCTION
;[365] The following code is designed to truncate the recently fixed number to
;[365] eight digits. This is not a very intelligent way of doing it, but it
;[365] should work OK, and it needs to be done NOW!
	LDB	TD,DA.SIZ		; [365] get result size
	SUBI	TD,^D8			; [365] floating point only has 8 digit precision
	JUMPLE	TD,FLTML2		; [365] thats all we need...
	PUSH	PP,TA			; [365] save TA
	PUSH	PP,TD			; [365] save shift count
	MOVNS	TD			; [365] negate for right shift
	LDB	TB,DA.SIZ		; [365] get result precision again
	MOVEM	TB,ESIZ			; [365] save for shifter
	PUSH	PP,ESIZ			; [365] save ESIZ for later
	LDB	TB,DA.DEC		; [365] get decimals
	MOVEM	TB,EDEC			; [365] stash
	PUSH	PP,EDEC			; [365] save it
	HRLZI	CH,AC3			; [365] work with AC3
	PUSHJ	PP,SHFTAC##		; [365] right shift -
	POP	PP,EDEC			; [365] get parameters back
	POP	PP,ESIZ			; [365]
	POP	PP,TD			; [365]
	HRLZI	CH,AC3			; [365] use ac3 again
	PUSHJ	PP,SHFTAC		; [365] and shift left again
	POP	PP,TA			; [365] restore TA

FLTML2:	MOVEI	TB,^D15			; SET SIZE UP TO MAX SINCE
	MOVEM	TB,OP2SIZ		; FIX ALWAYS RETURNS DOUBLE
	LDB	TC,DA.DEC		; GET DECIMALS FOR PUTAC
	PUSHJ	PP,PTRAC3		; AND PUT THAT AC
	TSWF	FWHOLE;			; WHOLE ARRAYS?
	  PJRST	WHLGN2			; YES -
	POPJ	PP,			; NO -
;GENERATE CODE FOR DIVIDE
;
;

.DIV:	PUSHJ	PP,CHK3			; CHECK FOR WHOLE ARRAYS
	PUSHJ	PP,INDCHK		; CHECK FOR INDICATORS
	TSWF	FWHOLE;			; IS THERE A WHOLE ARRAY?
	  PUSHJ	PP,WHLGN1		; YES -
	PUSHJ	PP,GT1AC3##		; GET OP1
	PUSHJ	PP,GT2AC1##		; GET OP2
	HRRZ	TA,OPRTR+4		; GET DATAB LINK
	PUSHJ	PP,LNKSET		; SET IT UP
	MOVEM	TA,CURDAT		; SAVE POINTER
	LDB	TB,DA.FLD		; GET FIELD TYPE
	SKIPN	TB			; WE ONLY WANT NUMERIC
	PUSHJ	PP,FNDFLD		; SAY SO
	MOVE	TB,OP1DEC		; GET A DECIMALS
	SUB	TB,OP2DEC		; SUBTRACT B DECIMALS
	LDB	TD,DA.DEC		; GET R DECIMALS
	SUB	TD,TB			; TD_R-(A-B)
	LDB	TB,DA.RND		; [364] get rounding flag
	SKIPE	TB			; [364] is it set?
	  ADDI	TD,1			; [364] yes - allow extra precision for round
	MOVE	TC,TD			; [366] get into working AC
	ADD	TC,OP1SIZ		; [366] plus size of OP
	CAILE	TC,^D15			; [366] must we float it?
	  JRST	FLTDIV			; [366] yes - go do so
	JUMPLE	TD,.+2			; SKIP IF WE DON'T NEED TO SHIFT
	PUSHJ	PP,SH13.1##		; [353] SHIFT A TO MAKE SURE WE HAVE SUFFICIENT
					; PRECISION FOR RESULT
	MOVE	TA,CURDAT		; GET DATAB POINTER
	LDB	TB,DA.RND		; GET HALF ADJUST FLAG
	SKIPE	TB			; ON?
	SWON	FROUND;			; YES - TURN THIS ONE ON TOO
	MOVE	TB,OP2DEC		; GET B DECIMALS
	MOVEM	TB,REMDEC##		; SAVE IN CASE OF MVR
	MOVE	TB,OP2SIZ		; GET B SIZE
	MOVEM	TB,REMSIZ##		; ALSO SAVE FOR SAME REASON
	MOVEI	LN,3			; DIV=3
	PUSHJ	PP,CH.12		; MAKE A CHOICE
	SKIPN	TB,OP1DEC		; [353] get A
	  SKIPA	TB,OP2DEC		; [353] if A=0 then TB_B, else TB_A-B
	SUB	TB,OP2DEC		; [353] -B
	LDB	TD,DA.DEC		; GET R
	SUB	TD,TB			; TD_R-(A-B)
	JUMPE	TD,.+2			; SHIFT IF NECESSARY
	PUSHJ	PP,SH23.1##		; LIKE RIGHT HERE
	MOVE	TB,OP1SIZ		; [353] get size of number in the AC's
	MOVEM	TB,OP2SIZ		; [353] store for PTRAC3
	PUSHJ	PP,PTRAC3		; SHIFT RESULT
	TSWF	FWHOLE;			; WHOLE ARRAY?
	  PJRST	WHLGN2			; YES -
	POPJ	PP,			; NO -
;FLTDIV		Generate code for floating point divide operation
;
;[366]
;

FLTDIV:	MOVE	TB,OP1SIZ		; get size of OP1
	MOVE	CH,[XWD FLOT1.+AC3,AS.CNS+3]
	CAILE	TB,^D10			; double precision in AC3?
	  MOVE	CH,[XWD FLOT2.+AC3,AS.CNS+3]
	PUSHJ	PP,PUTASY		; output one or the other
	MOVE	TB,OP2SIZ		; get size of OP2
	MOVE	CH,[XWD FLOT1.+AC1,AS.CNS+1]
	CAILE	TB,^D10			; double?
	  MOVE	CH,[XWD FLOT2.+AC1,AS.CNS+1]
	PUSHJ	PP,PUTASY		; output it
	MOVE	CH,[XWD FDV.+AC3,AS.CNS+1]
	PUSHJ	PP,PUTASY		; output the divide operation
	MOVE	TB,OP2DEC		; get decimals for remainder operation
	MOVEM	TB,REMDEC		; store them
	MOVE	TB,OP2SIZ		; get size
	MOVEM	TB,REMSIZ		; and store that too
	SKIPN	TB,OP1DEC		; get A
	  SKIPA	TB,OP2DEC		; if A=0 then TB_B, else TB_A-B
	SUB	TB,OP2DEC		; -B
	LDB	TD,DA.DEC		; get R
	SUB	TD,TB			; TD_R-ABS(A-B)
	JRST	FLTML0			; do the rest elsewhere
;GENERATE CODE FOR MVR
;
;
;

.MVR:	PUSHJ	PP,INDCHK		; GENERATE INDICATOR CHECK
	HRRZ	TA,OPRTR+2		; GET LINK
	HRRZM	TA,OPRTR+4		; [113] STASH THERE IN CASE WE DON'T CALL FNDFLD
	PUSHJ	PP,LNKSET		; SET IT UP
	LDB	TB,DA.FLD		; GET FIELD TYPE
	SKIPN	TB			; ONLY NUMERIC IS OK
	PUSHJ	PP,FNDFLD		; FIND A NUMERIC FIELD
	HRLZI	CH,AC0			; DO IT WITH AC0
	MOVE	TB,REMDEC		; GET LEFT OVER DECIMALS	
	MOVEM	TB,EDEC##		; SAVE
	MOVE	TB,REMSIZ		; GET SIZE
	MOVEM	TB,ESIZ##		; SAVE
	MOVEM	TB,OP2SIZ		; STASH SO SHFT3B WORKS RIGHT
	LDB	TD,DA.DEC		; GET RESULT DECIMALS
	SUB	TD,REMDEC		; GET SHIFT 
	PJUMPE	TD,PTRAC5		; MAYBE WE DON'T HAVE TO SHIFT
	PUSHJ	PP,SHFTAC##		; NOPE- WE HAVE TO
	PJRST	PTRAC5##		; GO STASH RESULT
;GENERATE CODE FOR ZADD
;
;

.ZADD:	PUSHJ	PP,WH.OP1##		; CHECK OUT WHOLE ARRAYS
	PUSHJ	PP,INDCHK		; GENERATE INDICATOR CODE
	MOVE	TA,OPRTR+3		; GET FACTOR 2 LINK
	MOVEM	TA,OPRTR+4		; STASH AS RESULT LINK
	PUSHJ	PP,WH.OP3##		; DOES RESULT AGREE?
	  POPJ	PP,			; NOPE - JUST FORGET THIS ONE
	TSWF	FWHOLE;			; YES - IS IT WHOLE ARRAY?
	  PUSHJ	PP,WHLGN1		; YES - OUTPUT SOME CODE
	PUSHJ	PP,GT1AC3		; GET FACTOR 1 INTO AC3
	HRRZ	TA,OPRTR+4		; GET DATAB LINK
	PUSHJ	PP,LNKSET		; SET UP THAT LINK	
	LDB	TB,DA.FLD		; GET FIELD TYPE
	SKIPN	TB			; MUST BE NUMERIC
	PUSHJ	PP,FNDFLD		; IS NOT - GO FIND ONE
	LDB	TC,DA.DEC		; GET DECIMAL POSITIONS
	PUSHJ	PP,SH1AC3		; ALLIGN THE AC'S
	MOVE	TB,OP1SIZ		; GET SIZE OF FIELD
	MOVEM	TB,OP2SIZ		; STASH SO SHFT3B WORKS OK
	PUSHJ	PP,PTRAC3		; GO STORE RESULT
	TSWF	FWHOLE;			; WHOLE ARRAY?
	  PJRST	WHLGN2;			; YES -
	POPJ	PP,			; NO 


;GENERATE CODE FOR ZSUB
;
;

.ZSUB:	PUSHJ	PP,WH.OP1		; CHECK FOR WHOLE ARRAYS
	PUSHJ	PP,INDCHK		; GEN INDICATOR CODE
	MOVE	TA,OPRTR+3		; GET FACTOR 2 LINK
	MOVEM	TA,OPRTR+4		; STASH AS RESULT LINK
	PUSHJ	PP,WH.OP3		; CHECK RESULT
	  POPJ	PP,			; WAS ERROR
	TSWF	FWHOLE;			; WAS IT WHOLE ARRAY?
	  PUSHJ	PP,WHLGN1		; YES
	PUSHJ	PP,GT1AC3		; GET FACTOR 1
	MOVEI	LN,5			; THE MAGIC NUMBER
	SETZM	OP2SIZ			; ZAP ANY LEFTOVERS
	PUSHJ	PP,CH.12		; CHOOSE SOME CODE
	JRST	.ZADD+11		; GO DO THE REST
;Generate code for XFOOT
;
;
;

.XFOOT:	PUSHJ	PP,WH.OP1		; make sure our factor 2 is whole array
	TSWTZ	FWHOLE;			; was it?
	  JRST	.XFOO1			; no - error
	PUSHJ	PP,WH.OP2		; how about result?
	TSWF	FWHOLE;			; [350] we don't want it, but did we get it?
	  JRST	.XFOO2			; yes - error
	MOVE	TB,OPRTR+3		; get result entry
	MOVEM	TB,OPRTR+4		; stick it where it should be
	PUSHJ	PP,INDCHK		; generate indicator code
	MOVE	CH,[XWD SETZB.##+AC3,AS.CNS+4]	; [350]
	PUSHJ	PP,PUTASY		; [350] get some zeroes
	MOVEI	TB,^D12			; [350] say that they are double precision
	MOVEM	TB,OP2SIZ		; [350] store for PTRAC3
	PUSHJ	PP,PTRAC3		; [350] and store that result field full of 0's
	SWON	FWHOLE;			; [350] turn the flag back on
	PUSHJ	PP,WHLGN1		; generate whole array set up code
	PUSHJ	PP,GT1AC1		; get op1 into AC1
	PUSHJ	PP,GT2AC3		; get op2 into AC3
	HRRZ	TA,OPRTR+4		; get result link
	PUSHJ	PP,LNKSET		; set up link
	LDB	TB,DA.FLD		; get field type
	SKIPN	TB			; alpha no good
	  PUSHJ	PP,FNDFLD		; find a good one
	LDB	TC,DA.DEC		; get decimal count
	LDB	TB,DA.RND		; get rounding flag
	SKIPE	TB			; is it set?
	  SWON	FROUND;			; yes - turn on SW flag
	PUSHJ	PP,SH1AC1		; allign op1
	PUSHJ	PP,SH2AC3		; allign op2
	SETZ	LN,			; ADD index
	PUSHJ	PP,CH.12		; choose an operator
	SWOFF	FWHOLE;			; result never whole array
	PUSHJ	PP,PTRAC3		; store result
	SWON	FWHOLE;			; turn whole array flag back on
	PJRST	WHLGN2			; output whole array ending code

.XFOO1:	GETLN;				; get line number
	WARN	716;			; factor 2 must be whole array
	POPJ	PP,			; exit

.XFOO2:	GETLN;				; recover line number
	WARN	646;			; result cannot be whole array
	POPJ	PP,			;
;Generate code for SQRT
;
;
;

.SQRT:	PUSHJ	PP,WH.OP1		; check for whole array
	PUSHJ	PP,INDCHK		; output indicators
	MOVE	TA,OPRTR+3		; get result
	MOVEM	TA,OPRTR+4		; put in it's place
	PUSHJ	PP,WH.OP3		; check result for whole array
	  POPJ	PP,			; some sort of error
	TSWF	FWHOLE;			; whole array?
	  PUSHJ	PP,WHLGN1		; yes - generate some code
	SETZM	FLTCN.##		; zap temp storage
	PUSHJ	PP,GT1AC1		; get argument into AC1
	MOVE	TB,OP1SIZ		; get it's size
	MOVE	CH,[XWD FLOT1.+AC1,AS.CNS+1]
	CAILE	TB,^D10			; double precision?
	  MOVE	CH,[XWD FLOT2.+AC1,AS.CNS+1]
	PUSHJ	PP,PUTASY		; put out call to float routine
	MOVE	TB,OP1DEC		; get the decimal places
	JUMPE	TB,.SQRT1		; none - no need to shift
	MOVE	CH,[XWD FDV.+ASINC+AC1,AS.MSC]
	PUSHJ	PP,PUTASY		; put out floating divide
	MOVE	CH,ELITPC		; get LITAB PC
	IORI	CH,AS.LIT		; identify as such
	MOVEM	CH,FLTCN.##		; save for later
	PUSHJ	PP,PUTASN		; output address
	MOVE	CH,[XWD FLTLIT,2]	; get LITAB header
	PUSHJ	PP,STASHC		; output
	MOVEI	CH,1(TB)		; get exponent
	PUSHJ	PP,STASHC		; output
	MOVSI	CH,(1B7)		; get mantissa
	PUSHJ	PP,STASHC		; output
	AOS	ELITPC			; bump LITAB PC

.SQRT1:	MOVE	CH,[XWD SQRT.,AS.CNS+1]	; get UUO call to square root routine
	PUSHJ	PP,PUTASY		; output it
	HRRZ	TA,OPRTR+4		; get link to result
	PUSHJ	PP,LNKSET		; set it up
	LDB	TB,DA.FLD		; get field
	SKIPN	TB			; numeric?
	  PUSHJ	PP,FNDFLD		; no - find one that is
	LDB	TC,DA.DEC		; get decimal positions
	JUMPE	TC,.SQRT2		; is zero - no need to shift
	MOVEM	TC,OP2DEC		; save for PUTAC
	MOVE	CH,[XWD FLTLIT,2]	; get LITAB header
	PUSHJ	PP,STASHC		; output
	MOVEI	CH,1(TC)		; get exponent
	PUSHJ	PP,STASHC		; output
	MOVSI	CH,(1B7)		; get a .1
	PUSHJ	PP,STASHC		; output it
	MOVE	CH,[XWD FMP.+ASINC+AC1,AS.MSC]
	PUSHJ	PP,PUTASY		; output floating multiply
	HRRZ	CH,ELITPC		; get LITAB PC
	IORI	CH,AS.LIT		; identify as such
	PUSHJ	PP,PUTASN		; output it
	AOS	ELITPC			; bump the PC
;.SQRT (cont'd)
;
;
;

.SQRT2:	MOVE	CH,[XWD FIX.+AC1,AS.CNS+1]
	PUSHJ	PP,PUTASY		; output call to fix routine
	MOVEI	TB,^D15			; get full 15 digit count
	MOVEM	TB,OP1SIZ		; stash as op1 size since FIX returns double precision
	MOVEM	TB,OP2SIZ		; store special for PUTAC
	HRRZ	TA,OPRTR+4		; get result link
	PUSHJ	PP,LNKSET		; set it up
	LDB	TB,DA.FLD		; get field type
	SKIPN	TB			; only numeric valid
	  PUSHJ	PP,FNDFLD		; find one
	LDB	TC,DA.DEC		; get decimal count
	SWON	FROUND;			; square root is always rounded
	PUSHJ	PP,PTRAC1##		; stash result
	TSWF	FWHOLE;			; was all this a whole array?
	  PJRST	WHLGN2			; yes - output rest of code
	POPJ	PP,			; No - exit
;GENERATE CODE FOR COMP
;
;
;

.COMP:	PUSHJ	PP,INDCHK		; GENERATE INDICATOR CHECK
	MOVE	TB,OPRTR+3		; GET F1 ENTRY
	TLNE	TB,1B20			; NUMERIC LITERAL?
	  JRST	.COMP0			; YEP -
	TLNE	TB,1B19			; ALPHA LITERAL?
	  JRST	.COMP3			; YES -
	MOVE	TB,OPRTR+4		; GET F2 ENTRY
	TLNE	TB,1B20			; NUMERIC LIT?
	  JRST	.COMP2			; YES -
	TLNE	TB,1B19			; ALPHA LIT?
	  JRST	.COMP4			; YES -
	MOVEI	TB,3			; GET F1 INDEX
	PUSHJ	PP,GTFLD##		; GET TYPE
	JUMPE	TC,.COMP3		; F1 NOT NUMERIC

.COMP0:	MOVEI	TB,4			; GET F2 INDEX
	PUSHJ	PP,GTFLD		; GET TYPE
	JUMPE	TC,.COMP7		; F2 NOT NUMERIC - ERROR

.COMP1:	MOVE	TB,OPRTR+3		; REARRANGE THE STACK
	EXCH	TB,OPRTR+2
	EXCH	TB,OPRTR+4
	MOVEM	TB,OPRTR+3		; ALL DONE
	PUSHJ	PP,GT1AC1		; GET FACTOR 1
	PUSHJ	PP,GT2AC3		; GET FACTOR 3
	MOVE	TC,OP2DEC		; GET FACTOR 2 DECIMALS
	PUSHJ	PP,SH1AC1		; ALLIGN FACTOR 1
	MOVEI	LN,4			; COMP = 4
	PUSHJ	PP,CH.12		; CHOOSE OP
	HLRZ	TA,OPRTR+4		; GET INDTAB LINK
.CMP1A:	PUSHJ	PP,LNKSET		; SET IT UP
	MOVE	CH,[XWD AS.OCT,1]	; OUTPUT OCTAL CONSTANT
	PUSHJ	PP,PUTASY		; LIKE THIS
	MOVE	CH,(TA)			; GET THE CONSTANT
	JRST	PUTASN			; OUTPUT IT AND EXIT

.COMP2:	MOVEI	TB,3			; FACTOR 1 INDEX
	PUSHJ	PP,GTFLD		; GET TYPE
	JUMPE	TC,.COMP6		; F1 NOT NUMERIC - ERROR
	JRST	.COMP1			; ALL OK

.COMP3:	MOVEI	TB,4			; FACTOR 2 INDEX
	PUSHJ	PP,GTFLD		; GET TYPE
	JUMPN	TC,.COMP9		; F2 NOT ALPHA - ERROR
	JRST	.COMP5

;.COMP (CONT'D)

.COMP4:	MOVEI	TB,3			; F1 INDEX
	PUSHJ	PP,GTFLD		; IS SHE MY TYPE?
	JUMPN	TC,.COMP8		; NO - F1 NOT ALPHA - ERROR
	JRST	.COMP5			; YES - ALLS WELL

.COMP6:	GETLN;				; GET ERROR CAUSING LINE NUMBER
	WARN	700;			; F1 NOT NUMERIC
	POPJ	PP,

.COMP7:	GETLN;
	WARN	701;			; F2 NOT NUMERIC
	POPJ	PP,

.COMP8:	GETLN;
	WARN	702;			; F1 NOT ALPHA
	POPJ	PP,

.COMP9:	GETLN;
	WARN	703;			; F2 NOT ALPHA
	POPJ	PP,

;.COMP (CONT'D)
;
;.COMP5	  HANDLE ALPHA COMPARE
;
;

.COMP5:	PUSHJ	PP,STBYT1##		; SET UP POINTER TO OP1
	PUSHJ	PP,STBYT2##		; SET UP POINTER TO OP2
	MOVE	TB,OP1BSZ##		; GET OP1 BYTE SIZE
	CAMGE	TB,OP2BSZ##		; SHOULD GO HIGH-LOW OR EQUAL
	  PUSHJ	PP,SWPOP##		; NO - HAVE TO SWAP OPERANDS
	MOVE	TB,OP1SIZ		; GET SIZE
	CAMLE	TB,OP2SIZ		; GET SMALLER SIZE
	  MOVE	TB,OP2SIZ		; HAVE TO USE OP2
	PUSHJ	PP,BPTRSZ		; OUTPUT BYTE POINTERS WITH IMBEDDED SIZE
	MOVE	TB,OP1BSZ		; GET BYTE SIZE
	CAMN	TB,OP2BSZ		; ARE THEY EQUAL?
	  JRST	.CMP11			; YES - USE COMP.
	CAIN	TB,7			; NO - IS OP1 ASCII?
	  JRST	.CMP12			; YES - USE CMP.76
	MOVE	TB,OP2BSZ		; MUST BE EBCDIC
	MOVE	CH,[XWD CMP.97+ASINC,AS.MSC]
	CAIE	TB,7			; IS OP2 ASCII?
	  MOVE	CH,[XWD CMP.96+ASINC,AS.MSC]

.CMP10:	PUSHJ	PP,PUTASY		; OUTPUT COMPARE
	MOVE	CH,OP1LIT		; GET INCREMENT
	TRO	CH,AS.LIT		; IDENTIFY IT
	PUSHJ	PP,PUTASN		; OUTPUT INCREMENT
	HLRZ	TA,OPRTR+2		; GET INDICATOR POINTER
	PUSHJ	PP,.CMP1A		; OUTPUT INDICATOR WORD
	MOVE	TB,OP1SIZ		; GET SIZE OF OP1
	CAME	TB,OP2SIZ		; ALL OK IF EQUAL
	  JRST	.CMP14			; NOT EQUAL - DO SPACE CHECK
	POPJ	PP,			; EXIT

.CMP11:	SKIPA	CH,[XWD COMP.+ASINC,AS.MSC]
.CMP12:	MOVE	CH,[XWD CMP.76+ASINC,AS.MSC]
	JRST	.CMP10

EXTERNAL COMP.,CMP.76,CMP.96,CMP.97,AS.BYT,BYTLIT
;.COMP (CONT'D)
;
;.CMP14	   HANDLE COMPARE WHEN FIELD LENGTH UNEQUAL
;
;
;

.CMP14:	CAMG	TB,OP2SIZ		; WHICH IS LONGER?
	  JRST	.CMP15			; OP2 > OP1
	SUB	TB,OP2SIZ		; OP1 > OP2: GET DIFFERANCE
	MOVE	TC,OP2SIZ		; GET AMOUNT TO INCREMENT POINTER
	MOVE	CH,OP1BYT##		; GET POINTER
	PUSHJ	PP,.CMP17		; SET UP BYTE INCREMENT
	MOVE	TC,OP1BSZ		; GET BYTE SIZE

.CMP16:	MOVE	CH,BTB2-6(TC)		; GET INSTRUCTION
	PUSHJ	PP,PUTASY		; OUTPUT
	MOVE	CH,OP1LIT		; GET LITAB PC
	TRO	CH,AS.LIT		; IDENTIFY AS SUCH
	PUSHJ	PP,PUTASN		; OUTPUT INCREMENT
	AOS	ELITPC			; BUMP PC
	HLRZ	TA,OPRTR+2		; GET INDICATOR LINK
	JRST	.CMP1A			; OUTPUT INDICATOR WORD

.CMP15:	PUSHJ	PP,SWPIND##		; SWAP INDICATORS
	MOVE	TB,OP2SIZ		; GET OP2 SIZE
	SUB	TB,OP1SIZ		; GET DIFFERANCE
	MOVE	TC,OP1SIZ		; GET AMOUNT TO INCREMENT
	MOVE	CH,OP2BYT##		; GET POINTER
	PUSHJ	PP,.CMP19		; INCREMENT POINTER
	MOVE	TC,OP2BSZ		; GET BYTE SIZE
	JRST	.CMP16			; GO OUTPUT COMPARE

BTB2:	XWD	SPAC.6##+ASINC,AS.MSC
	XWD	SPAC.7##+ASINC,AS.MSC
	XWD	0,0
	XWD	SPAC.9##+ASINC,AS.MSC

;.COMP (CONT'D)
;
;
;

.CMP17:	TSWF	FOP1AR!FOP1TB;		; TABLE OR ARRAY?
	  JRST	.CMP18			; YES -
	PUSHJ	PP,BINC			; NO - BUMP POINTER
	MOVEM	CH,OP2BYT		; STASH NEW POINTER
	PJRST	BPTRSZ			; OUTPUT POINTERS THEN EXIT

.CMP18:	PUSH	PP,TC			; SAVE SIZE
	PUSHJ	PP,BPTRSZ		; OUTPUT POINTERS
	POP	PP,TC			; GET BACK INCREMENT COUNT
	PJRST	BNCGN3##		; GENERATE INCREMENT CODE

.CMP19:	TSWF	FOP2AR!FOP2TB;		; TABLE/ARRAY?
	  JRST	.CMP20			; YES -
	PUSHJ	PP,BINC##		; NO - BUMP POINTER
	MOVEM	CH,OP2BYT		; STASH
	PJRST	BPTRSZ			; OUTPUT POINTER

.CMP20:	MOVEM	TC,OP2CNT##		; stash count
	SWON	FINC;			; set increment flag for BPTRSZ
	PJRST	BPTRSZ			; go output pointers with increment code
;GENERATE CODE FOR SETOF AND SETON
;
;
;

.SETOF:	SKIPA	CH,[XWD SETOF.##+ASINC,AS.MSC]

.SETON:	MOVE	CH,[XWD SETON.##+ASINC,AS.MSC]
	PUSH	PP,CH			; SAVE CH
	PUSHJ	PP,INDCHK		; CHECK INDICATORS
	POP	PP,CH			; REGET HEADER
	PUSHJ	PP,PUTASY		; PUT OUT HEADER
	MOVE	CH,ELITPC		; GET LITAB ENTRY
	TRO	CH,AS.LIT		; FLAG AS SUCH
	PUSHJ	PP,PUTASN		; OUTPUT INCREMENT
	MOVE	CH,[XWD OCTLIT,1]	; SETUP FOR OCTAL LITERAL
	PUSHJ	PP,STASHC		; TELL LITAB ABOUT IT
	HLRZ	TA,OPRTR+2		; GET VALUE
	PUSHJ	PP,LNKSET		; SET UP LINKS
	MOVE	CH,(TA)			; GET INDICATORS
	PUSHJ	PP,STASHC		; PUT THEM INTO LITAB
	AOS	ELITPC			; BUMP LITAB PC
	POPJ	PP,			; EXIT
;GENERATE CODE FOR GOTO
;
;
;

.GOTO:	PUSHJ	PP,INDCHK		; CHECK OUT SOME INDICATORS
	HRRZ	TA,OPRTR+2		; GET A NAMTAB LINK
	MOVEI	TB,CD.PRO		; LOOK IN PROTAB
	PUSHJ	PP,FNDLNK		; LIKE THIS
	  JRST	.GOTO1			; NOT FOUND - ERROR
	MOVE	TA,TB			; REARRANGE THE LINK
	LDB	TC,PR.BSR##		; GET BEGSR FLAG
	JUMPN	TC,.GOTO2		; CAN'T GOTO A BEGSR TAG
	SUB 	TB,PROLOC##		; MAKE A RELATIVE LINK
	HRRZ	CH,TB			; PUT IN CORRECT AC
	ADD	CH,[XWD JRST.,AS.PRO]	; MAKE INTO AN INSTRUCTION
	PJRST	PUTASY			; OUTPUT IT

.GOTO1:	GETLN;				; GET LINE NUMBER
	WARN	231;			; NOT DEFINED
	POPJ	PP,			; EXIT

.GOTO2:	GETLN;
	WARN	214;			; GOTO TO BEGSR NOT ALLOWED
	POPJ	PP,			; EXIT


;GENERATE CODE FOR TAG
;
;
;

.TAG:	HRRZ	TA,OPRTR+2		; GET A PROTAB LINK
	PUSHJ	PP,LNKSET		; MAKE INTO REAL LINK
	TSWT	FAS3;			; ARE WE IN AS3FIL?
	SKIPA	TC,EAS2PC		; NO - USE EAS2PC
	MOVE	TC,EAS3PC		; YES - USE EAS3PC
	DPB	TC,PR.LNK##		; STASH AS CORE LOC
	MOVEI	TC,1			; GET A FLAG
	TSWF	FAS3;			; ARE WE IN AS3FIL?
	  DPB	TC,PR.SEG##		; YES - SAY SO IN PROTAB ENTRY
	HRRZ	CH,OPRTR+2		; GET BACK PROTAB LINK
	ANDI	CH,TM.PRO##		; DROP OFF THE TABLE ID
	ADD	CH,[XWD AS.PN##,AS.PRO##]
	PJRST	PUTASN			; OUTPUT THE TAG DEFINITION

;GENERATE CODE FOR BEGSR TAG
;
;
;

.BEGSR:	JRST	.TAG			; USE IDENTICAL CODE



;GENERATE CODE FOR ENDSR
;
;
;

.ENDSR:	MOVE	CH,[XWD POPJ.+AC17,AS.CNS+0]
	PJRST	PUTASY			; OUTPUT A POPJ 17,



;GENERATE CODE FOR EXSR
;
;
;

.EXSR:	PUSHJ	PP,INDCHK		; GENERATE INDICATOR CHECK CODE
	HRRZ	TA,OPRTR+2		; GET PROTAB LINK
	MOVEI	TB,CD.PRO		; SAY THAT IS WHAT IT IS
	PUSHJ	PP,FNDLNK		; TRY IT
	  JRST	.GOTO1			; BEGSR TAG NOT DEFINED
	MOVE	TA,TB			; GET INTO PROPER AC
	LDB	TC,PR.BSR		; GET BEGSR FLAG
	JUMPE	TC,.EXSR1		; MUST BE SET TO BE LEGAL
	SUB	TB,PROLOC		; GET RELATIVE LINK
	HRRZ	CH,TB			; GET INTO PROPER AC
	ADD	CH,[XWD PUSHJ.+AC17,AS.PRO]
	PJRST	PUTASY			; OUTPUT THE PUSHJ 17,TAG

.EXSR1:	GETLN;				; recover line number
	WARN	213;			; EXSR OF NON-BEGSR TAG
	POPJ	PP,			; EXIT
;Generate code for the EXIT op
;
;
;

.EXIT:	PUSHJ	PP,INDCHK		; generate indicator check
	HRRZ	CH,OPRTR+2		; get EXTAB link
	ANDI	CH,TM.EXT##		; clear out ID
	ADD	CH,[XWD PUSHJ.+AC17,AS.EXT##]
	PJRST	PUTASY			; output the PUSHJ and exit


;Generate code for the RLABL op
;
;
;

.RLABL:	MOVE	TA,OPRTR+2		; get a factor
	MOVEM	TA,OPRTR+3		; put it where others can get to it
	MOVEM	TA,OPRTR+4		; and again
	SETZM	OP2DEC			; start fresh
	PUSHJ	PP,STBYT2		; make byte pointer to factor
	PUSHJ	PP,.BPTRB		; output that pointer
	MOVE	CH,[XWD ARG.+ASINC+AC10,AS.MSC]
	PUSHJ	PP,PUTASY		; output the ARGument
	MOVE	CH,OP2LIT		; get location of byte pointer
	IORI	CH,AS.LIT		; identify as LITAB item
	PUSHJ	PP,PUTASN		; output as address field
	MOVE	CH,[XWD OCTLIT,1]	; follow pointer with constant
	PUSHJ	PP,STASHC		; output
	SETZ	CH,			; start fresh
	PUSHJ	PP,CHKNUM		; numeric?
	CAIA				; no -
	  TLO	CH,(3B1)		; yes - set some flags
	MOVE	TB,OPRTR+4		; get link
	TLNE	TB,(1B1)		; literal?
	  TLO	CH,(1B3)		; yes - flag it
	MOVE	TB,OP2DEC		; get decimal places
	DPB	TB,[POINT 5,CH,17]	; stash
	HRR	CH,OP2SIZ		; get size of field
	AOS	ELITPC			; bump pointer
	PJRST	STASHC			; output and exit
;		********** NOTE **********
;
;
;	IF FWHOLE IS SET THEN FOP2AR MUST ALSO BE SET SINCE THE RESULT
;	FIELD MUST ALWAYS BE A WHOLE ARRAY, IF ANYTHING IS. THIS IS NOT
;	TRUE OF FOP1AR SINCE OP1 MAY BE ANYTHING EVEN IF THE RESULT
;	IS A WHOLE ARRAY. WE MUST THEREFORE KEEP THREE FLAGS FOR OP1;
;	ONE (FOP1AR) TO FLAG AN ARRAY ENTRY; ANOTHER (FOP1TB) TO FLAG AS
;	TABLE ENTRY; AND A THIRD (FOP1WL) TO FLAG OP1 AS A WHOLE ARRAY.
;	ALL THREE MUST BE CHECKED TO DETERMINE IF OP1 IS SUBSCRIPTED.
;
;GENERATE CODE FOR MOVE
;
;
;

.MOVE:	PUSHJ	PP,INDCHK		; OUTPUT THOSE INDICATORS
	MOVE	TB,OPRTR+2		; GET F2
	MOVEM	TB,OPRTR+4		; STASH FOR OTHERS
IFN	BINARY,<
	TLNE	TB,3B19			; A LITERAL?
	  JRST	.MOVE0			; YES -
	MOVEI	TB,2			; GET FACTOR 2 INDEX
	PUSHJ	PP,GTFLD		; SET IT UP
	CAIN	TC,2			; BINARY?
	  JRST	.ZADD+1			; YES - USE Z-ADD

.MOVE0:	HRRZ	TA,OPRTR+3		; GET RESULT FIELD
	PUSHJ	PP,LNKSET		; SET UP THOSE LINKERS
	LDB	TB,DA.SIZ		; GET SIZE
	SKIPN	TB			; IF FIELD DEFINED?
	  PUSHJ	PP,FNDFLD		; NO - SET IT UP NOW
	LDB	TB,DA.FLD		; GET FIELD TYPE
	CAIN	TC,2			; BINARY?
	  JRST	.ZADD+1			; YES - USE Z-ADD
	>

.MOVE1:	SETZM	OP2CNT			; reset increment count
	MOVE	TB,OPRTR+4		; SWAP SOME POINTERS AROUND
	EXCH	TB,OPRTR+3		; SO THAT F2 IS IN OPRTR+3
	MOVEM	TB,OPRTR+4		; AND RESULT IS IN OPRTR+4
	PUSHJ	PP,WH.OP2		; CHECK OUT OP2
	PUSHJ	PP,WH.OP3		; DOES OP3 AGREE?
	  POPJ	PP,			; NO -
	TSWF	FWHOLE;			; WAS IT WHOLE ARRAY?
	  PUSHJ	PP,WHLGN1		; YES - GENERATE CODE
	PUSHJ	PP,STBYT1		; SO THAT THIS WORKS RIGHT
	PUSHJ	PP,STBYT2		; AND THIS
	MOVE	TB,OP1SIZ		; GET SIZE OF F2
	CAMN	TB,OP2SIZ		; TWO FIELDS EQUAL?
	  JRST	.MOVE2			; YES - 1 = 2
	CAML	TB,OP2SIZ		; WELL?
	  JRST	.MOVE3			; 1 > 2
	MOVE	TC,OP2SIZ		; 1 < 2
	SUB	TC,TB			; GET DIFFERENCE
	MOVEM	TC,OP2CNT		; save for later
	TSWF	FOP2AR!FOP2TB;		; SUBSCRIPTED OP2?
	  JRST	.MOVE2			; YES - SPECIAL CASE
	MOVE	CH,OP2BYT		; GET BYTE POINTER TO RESULT
	PUSHJ	PP,BINC			; INCREMENT IT TC TIMES
	MOVEM	CH,OP2BYT		; RESTORE POINTER

.MOVE2:	TSWF	FOP2AR!FOP2TB;		; op2 subscripted?
	  SWON	FINC;			; yes - set increment flag
	PUSHJ	PP,BPTRSZ##		; OUTPUT POINTERS
	TSWT	FOP1AR!FOP1TB!FOP1WL;	; op1 subscripted?
	  JRST	.MOVE6			; NO SPECIAL CARE NEEDED
	MOVE	TB,OP1SIZ		; GET SIZE OF 1
	CAMN	TB,OP2SIZ		; WELL?
	  JRST	.MOVE6			; TWO FIELDS ARE EQUAL IN SIZE
	CAML	TB,OP2SIZ		;
	  JRST	.MOVE4			; 1 > 2

.MOVE6:	PUSH	PP,ELITPC		; SAVE CURRENT LITAB PC
	MOVE	TB,OP1LIT##		; GET LOC OF OP1 POINTER
	MOVEM	TB,ELITPC		; MOVE INTO CURRENT PC
	PUSHJ	PP,CHCONV##		; CHOOSE A MOVE UUO
	POP	PP,ELITPC		; RESTORE LITAB PC
	TSWF	FWHOLE;			; ARE WE DEALING WITH WHOLE ARRAYS?
	  PJRST	WHLGN2			; YES - GENERATE END CODE
	POPJ	PP,			; AND EXIT
;.MOVE (CONT'D)
;

.MOVE3:	TSWF	FOP1AR!FOP1TB!FOP1WL;	; OP1 SUBSCRIPTED?
	  JRST	.MOVE5			; YES - WILL GENERATE IBP CODE
	SUB	TB,OP2SIZ		; GET DIFFERENCE IN SIZE
	MOVE	TC,TB			; GET INTO PROPER AC
	MOVE	CH,OP1BYT		; GET BYTE POINTER
	PUSHJ	PP,BINC			; INCREMENT
	MOVEM	CH,OP1BYT		; REPLACE POINTER
.MOVE5:	MOVE	TB,OP2SIZ		; GET SIZE
	JRST	.MOVE2			; GO FINISH UP

.MOVE4:	TSWT	FOP1AR!FOP1TB!FOP1WL;	; IS OP1 SUBSCRIPTED?
	  JRST	.MOVE6			; NO - ALREADY MODIFIED
	SUB	TB,OP2SIZ		; GET IBP COUNT
	MOVE	TC,TB			; GET INTO PROPER AC
	PUSHJ	PP,BNCGN1##		; GENERATE IBP CODE
	JRST	.MOVE6			; CONTINUE WITH UUO GENERATION
;GENERATE CODE FOR MOVEL
;
;
;

.MOVEL:	PUSHJ	PP,INDCHK		; GENERATE INDICATOR CHECK
	MOVE	TB,OPRTR+2		; GET FACTOR 2
	MOVEM	TB,OPRTR+4		; STASH FOR LATER SWAP
IFN	BINARY,<
	TLNE	TB,3B19			; LITERAL?
	  JRST	.MOVL0			; YES -
	MOVEI	TB,2			; GET FACTOR 2 INDEX
	PUSHJ	PP,GTFLD		; GET FIELD TYPE
	CAIN	TC,2			; BINARY?
	  JRST	.ZADD+1			; YES - USE Z-ADD

.MOVL0:	HRRZ	TA,OPRTR+3		; GET RESULT FIELD
	PUSHJ	PP,LNKSET		; SET UP LINKS
	LDB	TB,DA.SIZ		; GET SIZE OF FIELD
	SKIPN	TB			; DEFINED?
	  PUSHJ	PP,FNDFLD		; NO - FIND OUT IF IT IS
	LDB	TB,DA.FLD		; GET FIELD TYPE
	CAIN	TC,2			; BINARY?
	  JRST	.ZADD+1			; YES - USE Z-ADD
	>

.MOVL1:	MOVE	TB,OPRTR+4		; REARRANGE DATA
	EXCH	TB,OPRTR+3		; CONTINUE (SEE .MOVE1 FOR DETAILS)
	MOVEM	TB,OPRTR+4		; FINISH
	PUSHJ	PP,WH.OP2##		; CHECK OP2
	PUSHJ	PP,WH.OP3##		; CHECK OP3
	  POPJ	PP,			; SOMETHING DIDN'T WORK
	TSWF	FWHOLE;			; DID WE FIND A WHOLE ARRAY?
	  PUSHJ	PP,WHLGN1		; YES -
	PUSHJ	PP,STBYT1		; GET BYTE POINTER TO FACTOR 2
	PUSHJ	PP,STBYT2		; GET BYTE POINTER TO RESULT
	MOVE	TB,OP1SIZ		; GET F2 SIZE
	CAMN	TB,OP2SIZ		; EQUAL TO RESULT LENGTH?
	  JRST	.MOVL8			; OUTPUT BYTE POINTERS AND EXIT
	CAML	TB,OP2SIZ		; ?
	  JRST	.MOVL2			; 1 > 2
	PUSHJ	PP,.MOVL3		; 1 < 2 - OUTPUT BYTE POINTERS
	PUSHJ	PP,CHKNUM##		; IS RESULT NUMERIC?
	  POPJ	PP,			; NO - JUST EXIT
	TSWF	FOP1AR!FOP1TB!FOP1WL;	; TABLE/ARRAY?
	  JRST	.MOVL4			; YES -
	MOVE	CH,OP2BYT		; NO - GET BYTE POINTER
	MOVE	TC,OP1SIZ		; GET INCREMENT COUNT
	SUBI	TC,1			; WE WANT ILDB NOT LDB POINTER
	PUSHJ	PP,BINC			; INCREMENT
	MOVEM	CH,OP1BYT		; STASH

.MOVL4:	MOVE	CH,OP2BYT		; GET BYTE POINER
	MOVE	TC,OP2SIZ		; GET INCREMENT COUNT
	SUBI	TC,1			; GO FORTH AND BE DIMINISHED
	PUSHJ	PP,.MINC2		; OUPUT INCREMENT AND POINTERS
	TSWF	FOP1AR!FOP1TB!FOP1WL;	; DID WE DEFER OP1 INCREMENT?
	  PUSHJ	PP,.MOVL5		; YES - DO IT NOW THEN
	MOVE	CH,[XWD MVSGNR##+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT
	MOVE	CH,OP1LIT		; GET OP1 BYTE ADDRESS
	TRO	CH,AS.LIT		; IDENTIFY
	PUSHJ	PP,PUTASN		; OUTPUT IT
	TSWF	FWHOLE;			; DO WE HAVE WHOLE ARRAY?
	  PJRST	WHLGN2			; OUTPUT END CODE
	POPJ	PP,			; EXIT

;.MOVEL (CONT'D)
;
;

.MOVL3:	PUSHJ	PP,BPTRSZ		; OUTPUT POINTERS WITH SIZE
	PUSH	PP,ELITPC		; SAVE LITAB PC
	MOVE	CH,OP1LIT		; GET OP1 BYTE ADDRESS
	MOVEM	CH,ELITPC		; TEMPORARY
	PUSHJ	PP,CHCONV		; CHOOSE A CONVERSION
	POP	PP,ELITPC		;  GET BACK REAL PC
	POPJ	PP,			; AND EXIT

.MOVL5:	MOVE	TC,OP1SIZ		; GET INCREMENT COUNT
	SUBI	TC,1			; DECREMENT
	PJRST	BNCGN1			; OUTPUT INCREMENT CODE AND EXIT

.MOVL8:	PUSHJ	PP,.MOVL3		; OUTPUT SOME POINTERS
	TSWF	FWHOLE;			; ARE WE DEALING WITH WHOLES?
	  PJRST	WHLGN2			; YES -
	POPJ	PP,			; NO -
;.MOVEL (CONT'D)
;

.MOVL2:	MOVE	TB,OP2SIZ		; GET THE SMALLER ONE
	PUSHJ	PP,.MOVL3		; OUTPUT SOME BYTE POINTERS
	PUSHJ	PP,CHKNUM		; IS IT NUMERIC (THE RESULT)?
	  POPJ	PP,			; NO - EXIT
	TSWF	FOP1AR!FOP1TB!FOP1WL;	; TABLE OR ARRAY?
	  JRST	.MOVL6			; YES - DEFER OUTPUTING POINTERS
	MOVE	CH,OP1BYT		; GET FIRST BYTE POINTER
	MOVE	TC,OP1SIZ		; GET SIZE OF FIRST FIELD
	SUBI	TC,1			; MAKE IXXB POINTER
	PUSHJ	PP,BINC			; GET POINTER TO SIGN IN F2
	MOVEM	CH,OP1BYT		; STASH AS FIRST BYTE POINTER

.MOVL6:	MOVE	CH,OP2BYT		; GET POINTER TO RESULT
	MOVE	TC,OP2SIZ		; GET SIZE
	SUBI	TC,1			;
	PUSHJ	PP,.MINC2		; MAKE POINTER TO PLACE TO PUT SIGN
	TSWF	FOP1AR!FOP1TB!FOP1WL;	; DID WE DEFER OUTPUT?
	  PUSHJ	PP,.MOVL5		; YES - WELL DO IT NOW THEN
	MOVE	CH,[XWD MVSGN##+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT UUO
	MOVE	CH,OP1LIT		; GET LITAV ADDRESS
	TRO	CH,AS.LIT		; MARK AS SUCH
	PUSHJ	PP,PUTASN		; OUTPUT
	TSWF	FWHOLE;			; DID WE HAVE WHOLE ARRAY?
	  PJRST	WHLGN2			; YES -
	POPJ	PP,			; NO -
;Generate code for MOVEA
;
;
;

.MOVEA:	PUSHJ	PP,INDCHK		; generate indicator check
	MOVE	TB,OPRTR+2		; get factor 2
	MOVEM	TB,OPRTR+4		; save as result
IFN	BINARY,<
	TLNE	TB,3B19			; literal?
	  JRST	.MOVA0			; yes -
	MOVEI	TB,2			; no - get factor 2 index
	PUSHJ	PP,GTFLD		; get the field
	CAIN	TC,2			; binary?
	  JRST	.ZADD+1			; yes -

.MOVA0:	HRRZ	TA,OPRTR+3		; get result field
	PUSHJ	PP,LNKSET		; set up links
	LDB	TB,DA.SIZ		; get size of field
	SKIPN	TB			; defined here?
	  PUSHJ	PP,FNDFLD		; no - go find it
	LDB	TB,DA.FLD		; get field type
	CAIN	TC,2			; binary ?
	  JRST	.ZADD+1			; yes -
	>	; end of IFN BINARY

.MOVA1:	MOVE	TB,OPRTR+4		; do the old swap
	EXCH	TB,OPRTR+3		;
	MOVEM	TB,OPRTR+4		; presto!
	PUSHJ	PP,WH.OP2		; check for whole array
	PUSHJ	PP,WH.OP3		; ok?
	  POPJ	PP,			; obviously not
	TSWF	FWHOLE;			; any whole arrays?
	  PUSHJ	PP,WHLGN1		; yes - go generate some setup code
	PUSHJ	PP,STBYT1		; get byte pointer to factor 2
	PUSHJ	PP,STBYT2		; get byte pointer to result
	TSWT	FOP1AR!FOP2AR;		; at least one of them an array?
	  WARN	559;			; no - error
	MOVE	TB,OP1SIZ		; get size of factor 2
	MOVE	TC,OP2SIZ		; get size of result
	CAMGE	TB,TC			; f2 < result ?
	  MOVEM	TB,OP2SIZ		; yes - use smaller
	CAMGE	TC,TB			; no - result < f2 ?
	  MOVEM	TB,OP1SIZ		; yes - use that
	JRST	.MOVL8			; go generate some code
;GENERATE CODE FOR MHHZO
;
;
;

.MHHZO:	PUSHJ	PP,INDCHK		; GENERATE INDCHK CODE
	PUSHJ	PP,MVITMS		; MOVE SOME THINGS AROUND
	PUSHJ	PP,CHKNM2##		; IS F2 NUMERIC?
	CAIA				; NO 
	  JRST	.MYYZO			; YES - ERROR
	PUSHJ	PP,CHKNUM		; IS RESULT NUMERIC?
	CAIA				; NO -
	  JRST	.MYYZO			; YES - ERROR
	PUSHJ	PP,STBYT1		; SET UP POINTER
	PUSHJ	PP,STBYT2		; AND ANOTHER
	PUSHJ	PP,BPTR##		; OUTPUT BYTE POINTERS
	PJRST	.MXXZO			; OUTPUT THE MOVSGN CODE


;GENERATE CODE FOR MHLZO
;
;
;

.MHLZO:	PUSHJ	PP,INDCHK		; CHECK THOSE INDICATORS
	PUSHJ	PP,MVITMS		; MOVE THOSE ITEMS
	PUSHJ	PP,CHKNM2		; CHECK THAT FACTOR 2
	CAIA				; OK
	  JRST	.MYYZO			; ERROR - IS NUMERIC
	PUSHJ	PP,STBYT1		; SET UP ONE POINTER
	PUSHJ	PP,STBYT2		; AND ANOTHER
	MOVE	CH,OP2BYT		; GET RESULT POINTER
	MOVE	TC,OP2SIZ		; GET LENGTH
	SUBI	TC,1			; WE WANT IDPB POINTER, NOT DPB
	SKIPE	TC			; don't do it 6.871947674*10^10 times
	  PUSHJ	PP,.MINC2		; INCREMENT POINTER
	PJRST	.MXXZO
;GENERATE CODE FOR MLLZO
;
;
;

.MLLZO:	PUSHJ	PP,INDCHK		; OUTPUT INDICATOR CODE
	PUSHJ	PP,MVITMS		; MOVE THAT STUFF AROUND
	PUSHJ	PP,STBYT1		; SET UP FACTOR 2 POINTER
	PUSHJ	PP,STBYT2		; SET UP RESULT POINTER
	TSWF	FOP1AR!FOP1TB!FOP1WL;	; IS IT TABLE/ARRAY?
	  JRST	.MLLZ1			; YES - DEFER POINTER OUTPUT
	MOVE	CH,OP1BYT		; GET BYTE POINTER
	MOVE	TC,OP1SIZ		; GET INCREMENT COUNT
	SUBI	TC,1			; THE USUAL
	SKIPE	TC			; don't try it with zero
	  PUSHJ	PP,BINC			; INCREMENT IT
	MOVEM	CH,OP1BYT		; STASH

.MLLZ1:	MOVE	CH,OP2BYT		; GET THAT POINTER
	MOVE	TC,OP2SIZ		; GET INCREMENT
	SUBI	TC,1			; OH HUM
	SKIPE	TC			; watch out for zero
	  PUSHJ	PP,.MINC2		; USE A COMMON ROUTINE
	TSWT	FOP1AR!FOP1TB!FOP1WL;	; DID WE DEFER?
	  PJRST	.MXXZO			; NO - GO OUTPUT CODE
	MOVE	TC,OP1SIZ		; YES - GET INCREMENT COUNT
	SUBI	TC,1			; DIMINISH BY 1
	SKIPE	TC			; don't use zero
	  PUSHJ	PP,BNCGN1		; OUTPUT INCREMENT CODE
	PJRST	.MXXZO			; OUTPUT MOVSGN CODE AND EXIT


;GENERATE CODE FOR MLHZO
;
;
;

.MLHZO:	PUSHJ	PP,INDCHK		; GENERATE INDICATOR CHECK
	PUSHJ	PP,MVITMS		; SWAP!
	PUSHJ	PP,CHKNUM		; IS RESULT NUMERIC?
	CAIA				; NO - OK
	  JRST	.MYYZO			; APPARENTLY SO
	PUSHJ	PP,STBYT1		; GET ONE POINTER
	PUSHJ	PP,STBYT2		; GET ANOTHER
	MOVE	CH,OP1BYT		; GET FACTOR 2 BYTE POINTER
	MOVE	TC,OP1SIZ		; GET FACTOR 2 SIZE
	SUBI	TC,1			; OF COURSE
	SKIPE	TC			; don't try it with zero
	  PUSHJ	PP,.MINC1		; INCCCCCCCCREMENT
	PJRST	.MXXZO			; GO OUTPUT POINTERS AND EXIT
;SUPPORT ROUTINES FOR THE MOVE ZONE VERBS
;
;
;
;ROUTINE TO OUTPUT MVSGN UUO

.MXXZO:	MOVE	CH,[XWD MVSGN+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT IT
	MOVE	CH,OP1LIT		; GET LITAB PC
	TRO	CH,AS.LIT		; SAY WHAT IT IS
	PUSHJ	PP,PUTASN		; OUTPUT ADDRESS AND EXIT
	TSWF	FWHOLE;			; WAS IT WHOLE ARRAY?
	  PJRST	WHLGN2			; YES -
	POPJ	PP,			; NO -


;ROUTINE TO OUTPUT ERROR MESSAGE FOR ILLEGAL NUMERIC FIELD

.MYYZO:	GETLN;				; get line number for error
	WARN	590;			; "WHEREVER HIGH USED, MUST BE ALPHA"
	POPJ	PP,			; EXIT


;ROUTINE TO SWAP SOME POINTERS AROUND

MVITMS:	MOVE	TB,OPRTR+2		; GET FACTOR 2 POINTER
	EXCH	TB,OPRTR+3		; PUT IN OPRTR+3
	MOVEM	TB,OPRTR+4		; PUT RESULT POINTER INTO OPRTR+4
	PUSHJ	PP,WH.OP2		; CHECK OUT OP2
	PUSHJ	PP,WH.OP3		; CHECK OUT OP3
	  JRST	MVITM1			; OP3 DIDN'T CHECK OUT TOO GOOD
	TSWF	FWHOLE;			; ALL OK - WHOLE ARRAY?
	  PJRST	WHLGN1			; YES - GENERATE CODE
	POPJ	PP,			; EXIT

MVITM1:	POP	PP,TB			; POP OFF EXTRA RETURN ADDRESS
	POPJ	PP,			; EXIT

;ROUTINE TO INCREMENT OP1 IN SOME FASHION

.MINC1:	TSWF	FOP1AR!FOP1TB!FOP1WL;	; TABLE/ARRAY?
	  JRST	.MNC1A			; YES -
	PUSHJ	PP,BINC			; NO - INCREMENT
	MOVEM	CH,OP1BYT		; SAVE POINTER
	PJRST	BPTR			; OUTPUT POINTERS

.MNC1A:	PUSH	PP,TC			; SAVE COUNT
	PUSHJ	PP,BPTR			; OUTPUT POINTERS
	POP	PP,TC			; RESTORE COUNT
	PJRST	BNCGN1			; OUTPUT INCREMENT CODE AND EXIT
;Support routines for move zone (cont'd)
;
;ROUTINE TO INCREMENT OP2 IN SOME FASHION
;

.MINC2:	TSWF	FOP2AR!FOP2TB;		; TABLE/ARRAY?
	  JRST	.MNC2A			; YES -
	PUSHJ	PP,BINC			; INCREMENT
	MOVEM	CH,OP2BYT		; SAVE
	PJRST	BPTR			; OUTPUT POINTERS

.MNC2A:	PUSH	PP,TC			; SAVE COUNT
	PUSHJ	PP,BPTR			; OUTPUT SOME POINTERS
	POP	PP,TC			; RESTORE COUNT
	PJRST	BNCGN2##		; OUTPUT INCREMENT CODE
;Generate code for TESTZ
;
;
;

.TESTZ:	PUSHJ	PP,INDCHK		; generate indicator check
	MOVE	TB,OPRTR+2		; get our only link
	MOVEM	TB,OPRTR+3		; and spread it around a bit
	MOVEM	TB,OPRTR+4		; and a bit more
	PUSHJ	PP,CHKNM2		; is it numeric?
	CAIA				; no - OK
	  JRST	.TSTZ1			; yes - error
	PUSHJ	PP,WH.OP2		; better check out a stupid programmer
	TSWF	FWHOLE;			; was he?
	  JRST	.TSTZ2			; yes -
	PUSHJ	PP,STBYT2		; no - try some more
	TSWF	FOP2AR;			; another attempt at an array?
	  JRST	.TSTZ2			; yes - still wrong
	PUSHJ	PP,.BPTRB		; output a pointer
	MOVE	CH,[XWD OCTLIT,1]	; get litab header for one word
	PUSHJ	PP,STASHC		; output it
	HRRZ	TA,OPRTR+1		; get indicators
	PUSHJ	PP,LNKSET		; set 'em up
	MOVE	CH,(TA)			; get those indicators
	PUSHJ	PP,STASHC		; and output them
	AOS	ELITPC			; bump the LITAB PC
	MOVE	CH,[XWD TESTZ##+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; output the UUO
	MOVE	CH,OP2LIT		; get litab address of op pointer
	IORI	CH,AS.LIT		; mark it
	PJRST	PUTASN			; output and exit

.TSTZ1:	GETLN;				; get line number with error
	WARN	207;			; must be alpha
	POPJ	PP,

.TSTZ2:	GETLN;				; get offending line number
	WARN	205;			; arrays invalid
	POPJ	PP,
;Generate code for BITON
;
;
;

.BITON:	PUSHJ	PP,.BITST		; output common code
	MOVE	CH,[XWD TDO.+AC1,AS.CNS+2]
	PUSHJ	PP,PUTASY		; output code to turn on bits
	PJRST	.BITFN			; generate common finish code and exit


;Generate code for BITOF
;
;
;

.BITOF:	PUSHJ	PP,.BITST		; output common code
	MOVE	CH,[XWD TDZ.+AC1,AS.CNS+2]
	PUSHJ	PP,PUTASY		; output code to clear bits
	PJRST	.BITFN			; generate end code

;Generate code for TESTB
;
;
;

.TESTB:	PUSHJ	PP,.BITST		; output common code
	MOVE	CH,[XWD TESTB.##+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; output TESTB. UUO
	MOVE	CH,ELITPC		; get LITAB PC
	IORI	CH,AS.LIT		; id
	PUSHJ	PP,PUTASN		; Output address
	MOVE	CH,[XWD OCTLIT,1]	; one octal constant to LITAB
	PUSHJ	PP,STASHC		; Output LITAB word
	HRRZ	TA,OPRTR+1		; get link to resulting indicators
	PUSHJ	PP,LNKSET		; set up links
	MOVE	CH,(TA)			; get resulting indicators
	AOS	ELITPC			; bump PC
	PJRST	STASHC			; output as address field
;Support Routines for the Bit Verbs
;
;
;Routine to generate common start code
;

.BITST:	PUSHJ	PP,INDCHK		; generate indicator check
	MOVE	CH,OPRTR+2		; move some links around
	EXCH	CH,OPRTR+3		; stick 2 in 3
	MOVEM	CH,OPRTR+4		; and 3 in 4
	PUSHJ	PP,WH.OP2		; whole array?
	TSWFZ	FWHOLE;			; ?
	  JRST	.BIT5			; yes - error
	PUSHJ	PP,CHKNM2		; factor 2 numeric?
	CAIA				; no - ok
	  JRST	.BIT7			; yes - error
	PUSHJ	PP,CHKNUM		; how about result field
	CAIA				; no - ok
	  JRST	.BIT7			; yes - error
	MOVE	TB,OPRTR+3		; get factor 2 link
	TLNE	TB,(1B1)		; literal?
	  JRST	.BITS1			; yes - convert to binary mask
	PUSHJ	PP,STBYT1		; set up byte pointer for op 1
	MOVE	TB,OP1SIZ		; get size
	CAIE	TB,1			; is one?
	  JRST	.BIT6			; no - error
	PUSHJ	PP,GTBP15##		; yes - get pointer into AC0
	MOVE	CH,[XWD ILDB.+AC1,AS.CNS+5]
	PUSHJ	PP,PUTASY		; generate <ILDB 1,5>

.BITS0:	PUSHJ	PP,STBYT2		; generate pointer to result field
	MOVE	TB,OP2SIZ		; get size
	CAIE	TB,1			; one?
	  JRST	.BIT6			; no - error
	PUSHJ	PP,GTBP25##		; get pointer into AC0
	MOVE	CH,[XWD ILDB.+AC2,AS.CNS+5]
	PJRST	PUTASY			; output <ILDB 2,5>

.BITS1:	HRRZ	TA,OPRTR+3		; get VALTAB link
	PUSHJ	PP,LNKSET		;  set it
	HRLI	TA,440700		; make into byte pointer
	ILDB	TB,TA			; get WC
	SUBI	TB,1			; allow for psuedo back-arrow
	SETZ	TC,			; start with mask of zero

.BITS2:	ILDB	CH,TA			; get character (ASCII)
	CAIL	CH,"0"			; valid character?
	CAILE	CH,"5"			; sorry! only six bits
	  JRST	.BIT4			; No - error
	IOR	TC,BITAB-"0"(CH)	; add in that bit to the mask
	SOJG	TB,.BITS2		; loop until WC = 0

.BITS3:	HRLZI	CH,<MOVEI.+AC1>		; generate <MOVEI 1,bit.mask>
	HRR	CH,TC			; get the mask
	PUSHJ	PP,PUTASY		; output
	JRST	.BITS0			; generate rest of code
;.BITST (cont'd)
;
;
;

.BIT4:	GETLN;				; get line number
	WARN	557;			; mask other than 0-5
	SOJG	TB,.BITS2		; ignore if any left
	JRST	.BITS3			; else just finish up

.BIT5:	GETLN;				; get number
	WARN	588;			; no whole arrays allowed
	POP	PP,TB			; pop off garbage return
	POPJ	PP,			; then return

.BIT6:	GETLN;				; get line number with error
	WARN	589;			; size must be = 1
	POP	PP,TB			;
	POPJ	PP,			;

.BIT7:	GETLN;				; get bad line
	WARN	207;			; must be alpha
	POP	PP,TB			;
	POPJ	PP,			;

BITAB:	EXP	1B30
	EXP	1B31
	EXP	1B32
	EXP	1B33
	EXP	1B34
	EXP	1B35


;.BITFN		Generate final code for the bit verbs
;
;
;

.BITFN:	MOVE	CH,[XWD DPB.+AC1,AS.CNS+5]
	PJRST	PUTASY			; generate <DPB 1,5> and exit
;Generate code for EXCPT
;
;
;

.EXCPT:	PUSHJ	PP,INDCHK		; generate that indicator check
	MOVE	CH,[XWD EXCPT.##,AS.CNS]; get the UUO
	PJRST	PUTASY			; output code, then exit



;Generate code for FORCE
;
;
;

.FORCE:	PUSHJ	PP,INDCHK		; check for indicators
	MOVE	CH,[XWD MOVEI.+AC1+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; output it
	HRRZ	TA,OPRTR+2		; get the FILTAB link
	PUSHJ	PP,LNKSET		; set it up
	LDB	CH,FI.OTF		; get the pointer to the OTFTAB item
	IORI	CH,AS.OTB##		; add in relocation
	PUSHJ	PP,PUTASN		; output OTFTAB address
	MOVE	CH,[XWD MOVEM.+AC1,AS.CNS+146]
	PJRST	PUTASY			; output it then exit
;Generate code for READ
;
;
;

.READ:	PUSHJ	PP,INDCHK		; generate indicator code
	MOVE	CH,[XWD READ.##+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; output the UUO
	MOVE	CH,ELITPC		; get a pointer into LITAB
	IORI	CH,AS.LIT		; mark it as such
	PUSHJ	PP,PUTASN		; output as UUO address
	MOVE	CH,[XWD XWDLIT,2]	; get LITAB header
	PUSHJ	PP,STASHC		; output
	SETZ	CH,			; default to zero
	HRRZ	TA,OPRTR+1		; get resulting indicators pointer
	JUMPE	TA,.+3			; if none - use that zero
	PUSHJ	PP,LNKSET		; set up the link	
	LDB	CH,[POINT 8,(TA),23]	; get indicator from col 58-59
	PUSHJ	PP,STASHC		; output it as LH
	HRRZ	TA,OPRTR+2		; get FILTAB link
	PUSHJ	PP,LNKSET		; set it up
	LDB	CH,FI.OTF		; get OTFTAB link
	MOVSS	CH			; get into proper half
	IOR	CH,[XWD AS.OTB,AS.MSC]	; mark as to what it is
	AOS	ELITPC			; bump the LITAB PC now so
	PJRST	STASHC			; we can PJRST the hell out of here
;.CHAIN		Generate code for CHAIN
;
;
;

.CHAIN:	PUSHJ	PP,INDCHK		; generate indicator code
	HRRZ	TA,OPRTR+2		; get FILTAB link
	PUSHJ	PP,LNKSET		; set it up
	LDB	TB,FI.PRO		; get file processing mode
	CAIN	TB,5			; random by key?
	  JRST	.CHAN2			; yep -
	CAIE	TB,4			; no - random by relative key?
	  JRST	.CHAN3			; no - error
	PUSHJ	PP,CHKNM2		; is key numeric?
	  JRST	.CHAN5			; no - error
	PUSHJ	PP,GT2AC1		; yes - get key into AC1 & AC2
	MOVE	TB,OP2DEC		; get decimal position count
	JUMPN	TB,.CHAN5		; error if any
	TSWF	FWHOLE;			; any whole arrays?
	  JRST	.CHAN4			; yes - error
	MOVE	CH,[XWD CHAIN.##+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; output the UUO
	MOVE	CH,ELITPC		; get a LITAB entry
	IORI	CH,AS.LIT		; mark as such
	PUSHJ	PP,PUTASN		; output that too
	MOVE	CH,[XWD XWDLIT,4]	; get LITAB header word
	PUSHJ	PP,STASHC		; output
	SETZ	CH,			; get a zero
	PUSHJ	PP,STASHC		; output LH
	PUSHJ	PP,STASHC		; and RH
	AOS	ELITPC			; and bump LITAB PC

.CHAN1:	HRRZ	TA,OPRTR+1		; get indicator link	
	SETZ	CH,			; start fresh
	JUMPE	TA,.+3			; do we have any resulting indicators?
	PUSHJ	PP,LNKSET		; yes - set up link
	LDB	CH,[POINT 8,(TA),7]	; and get that indicator
	MOVE	TB,OP2SIZ		; now get size
	DPB	TB,[POINT 10,CH,27]	; stash in LH word too
	MOVSS	CH			; XWD literal is increment,,address
	IORI	CH,AS.CNB		; say it's a constant
	PUSHJ	PP,STASHC		; and output
	HRRZ	TA,OPRTR+2		; get FILTAB link
	PUSHJ	PP,LNKSET		; set it up
	LDB	CH,FI.OTF		; get OTFTAB pointer
	MOVSS	CH			; get into proper half
	IOR	CH,[XWD AS.OTB,AS.MSC]	; add in flags
	AOS	ELITPC			; bump the PC
	PJRST	STASHC			; and output and exit
;.CHAIN (cont'd)
;
;
;

.CHAN2:	MOVE	TB,OPRTR+3		; get the data item link
	MOVEM	TB,OPRTR+4		; put it where STBYT2 can find it
	PUSHJ	PP,STBYT2		; get byte pointer to key
	TSWF	FWHOLE;			; any whole arrays?
	  JRST	.CHAN4			; yes - no good
	HRRZ	TA,OPRTR+2		; get FILTAB link
	PUSHJ	PP,LNKSET		; set it up
	LDB	TB,FI.KYL		; get supposed length of key field
	CAME	TB,OP2SIZ		; same size as key the guy gave us?
	  JRST	.CHAN6			; no - error
	PUSHJ	PP,.BPTRB##		; output byte pointer to LITAB
	MOVE	CH,[XWD CHAIN.+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; output the UUO
	MOVE	CH,OP2LIT##		; get LITAB location of byte pointer
	IORI	CH,AS.LIT		; add in address
	PUSHJ	PP,PUTASN		; output address
	MOVE	CH,[XWD XWDLIT,2]	; get LITAB header
	PUSHJ	PP,STASHC		; output
	JRST	.CHAN1			; and output the rest

.CHAN3:	GETLN;				; get offending line number
	WARN	525;			; file is of incorrect type for CHAIN
	POPJ	PP,			; exit

.CHAN4:	GETLN;				; get bad line number
	WARN	524;			; no whole arrays allowed
	POPJ	PP,

.CHAN5:	GETLN;				; get line number
	WARN	582;			; key must be numeric and no decimals
	POPJ	PP,

.CHAN6:	GETLN;				; get the line
	WARN	591;			; key lengthes must be equal
	POPJ	PP,
;Generate code for DSPLY
;
;
;

.DSPLY:	PUSHJ	PP,INDCHK		; generate indicator check
	HRRZ	TB,OPRTR+3		; [322] factor 1 optional
	SKIPE	TB			; [322]
	  PUSHJ	PP,WH.OP2		; whole arrays?
	TSWFZ	FWHOLE;			; ?
	  JRST	.DSPL1			; yes - error
	SETZM	OP1BYT			; reset to zero in case none
	SETZM	OP2BYT			; likewise
	HRRZ	TB,OPRTR+3		; get factor 1
	SKIPE	TB			; anything there?
	  PUSHJ	PP,STBYT1		; yes - set it up
	HRRZ	TB,OPRTR+4		; get result
	SKIPE	TB			; anything there?
	  PUSHJ	PP,STBYT2		; yes - set that up too
	PUSHJ	PP,BPTR			; output the byte pointers
	MOVE	CH,[XWD XWDLIT,2]	; followed by an XWD
	PUSHJ	PP,STASHC		; tell LITAB
	SETZ	CH,			; start anew
	MOVE	TB,OP1SIZ		; get size of field
	DPB	TB,[POINT 7,CH,10]	; stash
	MOVE	TB,OP2SIZ		; get size of next field
	DPB	TB,[POINT 7,CH,17]	; stash that too
	HRRZ	TB,OPRTR+3		; [322] factor 1 optional
	SKIPE	TB			; [322]
	  PUSHJ	PP,CHKNM2		; factor 1 numeric?
	CAIA				; no -
	  TLO	CH,(1B0)		; yes - flag as such
	HRRZ	TB,OPRTR+4		; [322] result is optional
	SKIPE	TB			; [322]
	  PUSHJ	PP,CHKNUM		; what about result
	CAIA				; not numeric
	  TLO	CH,(1B1)		; numeric - flag it
	HRRI	CH,AS.CNB		; LH is constant
	PUSHJ	PP,STASHC		; output to LITAB
	HRRZ	TA,OPRTR+2		; get FILTAB pointer
	PUSHJ	PP,LNKSET		; set it up
	LDB	CH,FI.OTF		; get pointer to OTFTAB entry
	IORI	CH,AS.OTB		; flag as %OTF relative
	HRLZS	CH			; get into LH
	HRRI	CH,AS.MSC		; get other flag
	PUSHJ	PP,STASHC		; output to LITAB
;.DSPLY (cont'd)
;
;
;

	MOVE	CH,[XWD OCTLIT,1]	; and now an octal constant
	PUSHJ	PP,STASHC		; output header
	SETZ	CH,			; start fresh
	MOVE	TB,OP1DEC		; get decimal places
	DPB	TB,[POINT 4,CH,3]	; stash in output word
	MOVE	TB,OP2DEC		; get decimal places of other field
	DPB	TB,[POINT 4,CH,7]	; and stash those too
	PUSHJ	PP,STASHC		; output word to LITAB
	MOVE	CH,[XWD DSPLY.##+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; output UUO call to ASYfil
	HRRZ	CH,OP1LIT		; get address of first byte pointer
	IORI	CH,AS.LIT		; identify it
	AOS	ELITPC			; bump the LITAB PC once
	AOS	ELITPC			; and twice
	PJRST	PUTASN			; output increment and exit

.DSPL1:	GETLN;				; get line number for error
	WARN	524;			; can't use whole arrays
	POPJ	PP,			; exit
;.TIME		Generate code for TIME verb
;
;
;

.TIME:	PUSHJ	PP,INDCHK		; generate indicator check
	PUSHJ	PP,WH.OP1		; check out the field
	TSWF	FWHOLE;			; whole array?
	  JRST	.TIME4			; yes - no good
	HRRZ	TA,OPRTR+2		; get the link
	MOVEM	TA,OPRTR+4		; and stash in case we don't call FNDFLD
	PUSHJ	PP,LNKSET		; set the links
	LDB	TB,DA.FLD		; get the field type
	SKIPN	TB			; we want numeric
	  PUSHJ	PP,FNDFLD		; see if we can find one
	LDB	TB,DA.DEC		; apparently did - get decimal positions
	JUMPN	TB,.TIME1		; must be zero to be OK
	LDB	TB,DA.SIZ		; now get size of field
	CAIN	TB,6			; just time of day wanted?
	  JRST	.TIME2			; yes -
	CAIN	TB,^D12			; or does he want time of day and date?
	  JRST	.TIME3			; that's it -
	GETLN;				; get line number for error message
	WARN	713;			; doesn't want either - must be error
	POPJ	PP,			; exit

.TIME1:	GETLN;				; get line number
	WARN	714;			; must be 0 decimal positions
	POPJ	PP,			;

.TIME2:	SKIPA	CH,[XWD TIME.##,AS.CNS]	; get the UUO
.TIME3:	MOVE	CH,[XWD TIMED.##,AS.CNS]; likewise
	PUSHJ	PP,PUTASY		; output it
	PJRST	PTRAC3			; and store result

.TIME4:	GETLN;				; get line number
	WARN	715;			; no whole arrays allowed
	POPJ	PP,
;Generate code for the DEBUG op
;
;
;

.DEBUG:	PUSHJ	PP,INDCHK		; generate indicator check
	MOVE	TA,OPRTR+3		; get a link
	EXCH	TA,OPRTR+4		; swap it for another
	MOVEM	TA,OPRTR+3		; and replace
	HRRZ	TB,OPRTR+3		; get the link
	SKIPE	TB			; make sure we have one
	  PUSHJ	PP,WH.OP2		; check for good ol' whole arrays
	SETZM	OP1BYT			; start fresh
	SETZM	OP2BYT			; likewise I'm sure
	HRRZ	TB,OPRTR+3		; get result link
	SKIPE	TB			; is there one?
	  PUSHJ	PP,STBYT1		; yes set it up
	HRRZ	TB,OPRTR+4		; get factor 1 link
	SKIPE	TB			; is there one?
	  PUSHJ	PP,STBYT2		; yes - set it
	PUSHJ	PP,BPTR			; output two byte pointers
	MOVE	CH,[XWD XWDLIT,2]	; get LITAB link
	PUSHJ	PP,STASHC		; output it
	HRRZI	CH,AS.CNB		; get non-relocatable zero
	PUSHJ	PP,STASHC		; output it
	HRRZ	TA,OPRTR+2		; get FILTAB link
	PUSHJ	PP,LNKSET		; set it up
	LDB	CH,FI.OTF		; get OTFTAB link
	MOVSS	CH			; get into correct half
	IOR	CH,[XWD AS.OTB,AS.MSC]	; identify halves
	PUSHJ	PP,STASHC		; output it
	MOVE	CH,[XWD OCTLIT,1]	; now comes an octal constant
	PUSHJ	PP,STASHC		; tell LITAB
	SETZ	CH,			; start with nothing
	MOVE	TB,OP2SIZ		; get size of factor 1
	DPB	TB,[POINT 4,CH,6]	; stash
	MOVE	TB,OP1SIZ		; get result field size
	DPB	TB,[POINT 10,CH,16]	; stash that too
	MOVE	TB,WHOSIZ		; get whole array size
	TSWT	FWHOLE;			; is it set up
	  SETZ	TB,			; no -
	DPB	TB,[POINT 10,CH,26]	; save it
	HRRZ	TB,OPRTR+3		; get result link
	SKIPE	TB			; make sure it exists
	  PUSHJ	PP,CHKNM2		; is result numeric?
	CAIA				; no 
	  TRO	CH,1B27			; yes - say so
	HRRZ	TB,OPRTR+4		; does factor 1 exist?
	SKIPE	TB			; don't do anything if it doesn't
	  PUSHJ	PP,CHKNUM		; factor 1 numeric?
	CAIA				; no -
	  TLO	CH,(1B2)		; yes -
	SETZ	TB,			; default to field
	TSWF	FOP1TB;			; table?
	  MOVEI	TB,1			; yes -
	TSWF	FOP1AR;			; array?
	  MOVEI	TB,2			; yes -
	TSWF	FOP1WL;			; whole array?
	  MOVEI	TB,3			; yes -
	DPB	TB,[POINT 2,CH,1]	; save whatever it is
	PUSHJ	PP,STASHC		; output the flags
	MOVE	CH,[XWD DEBUG.##+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; output UUO call
	HRRZ	CH,OP1LIT		; get address of first pointer
	IORI	CH,AS.LIT		; identify it
	AOS	ELITPC			; bump the PC
	AOS	ELITPC			; again
	PJRST	PUTASN			; and exit
;GENERATE ESCAPE LINKAGE FOR CONTROL CALCULATIONS
;
;GENERATE:	PUSHJ	PP,400012
;		JRST	PRGID
;
;

.CAL:	TSWFZ	FINDON;			; STILL GOT A TAG LEFT?
	PUSHJ	PP,FNDTAG##		; YES - TIE UP LOOSE ENDS
	MOVE	CH,[XWD PUSHJ.+AC17+ASINC,AS.CNB]
	PUSHJ	PP,PUTASY##		; OUTPUT IT
	HRRZI	CH,400012		; ADDRESS OF D.00
	PUSHJ	PP,PUTASN		; OUTPUT INCREMENT
	MOVE	CH,PRGID		; PLACE TO JRST TO
	MOVEM	CH,NAMWRD		; STASH FOR LOOKUP
	SETZM	NAMWRD+1		; CLEAN HOUSE
	PUSHJ	PP,TRYNAM		; LOOKUP
	  JRST	.CAL1			; ERROR -
	MOVEI	TB,CD.PRO		; GET TABLE ID
	MOVSS	TA			; GET RELATIVE LINK INTO RH
	PUSHJ	PP,FNDLNK##		; LOOKUP LINK
	  JRST	.CAL1			; ERROR -
	SUB	TB,PROLOC##		; MAKE A POINTER
	HRRZ	CH,TB			; MOVE AND CLEAR
	ADD	CH,[XWD JRST.,AS.PRO]	; MAKE INTO INSTRUCTION
	PUSHJ	PP,PUTASY		; OUTPUT IT
	POPJ	PP,			; EXIT


.CAL1:	OUTSTR	[ASCIZ /?PROTAB entry not found when expected in phase E
/]
	JRST	KILL##			; GO CROAK, FROGGY


;OUTPUT DETAIL CALCULATION ESCAPE CODE
;
;OUTPUT:	PUSHJ	PP,400011
;	%TOT:
;
;

.DET:	TSWFZ	FINDON;			; CHECK FOR LEFTOVER TAG
	PUSHJ	PP,FNDTAG		; GOT ONE - GO PROCESS
	MOVE	CH,[XWD PUSHJ.+AC17+ASINC,AS.CNB]
	PUSHJ	PP,PUTASY
	HRRZI	CH,400011		; GET ADRESS INCREMENT
	PUSHJ	PP,PUTASN		; OUTPUT IT
	TSWC	FAS3;			; SWITCH SEGMENTS
	MOVE	CH,[SIXBIT /%TOT/]	; GET TAG NAME
	MOVEM	CH,NAMWRD		; STASH FOR LOOKUP/BUILD
	SETZM	NAMWRD+1		; CALL DEWEY'S
	PUSHJ	PP,TRYNAM		; SEE IF IT'S THERE
	PUSHJ	PP,BLDNAM		; IT'S NOT - PUT IT THERE
	MOVEM	TA,CURNAM		; STASH NAMTAB LINK FOR LATER
	MOVE	TA,[XWD CD.PRO,SZ.PRO]	; GET VITAL STATISTICS
	PUSHJ	PP,GETENT##		; GET A PROTAB ENTRY
	HRRZM	TA,CURPRO##		; STASH THIS LINK TOO
	MOVS	TB,CURNAM		; GET BACK NAMTAB LINK
	DPB	TB,PR.NAM		; STORE LINK IN TABLE
	MOVE	TB,CD.PRO		; GET TABLE ID
	DPB	TB,PR.ID		; STORE AS SUCH
	MOVE	TB,EAS3PC##		; GET CURRENT PC (SHOULD BE ZERO)
	DPB	TB,PR.LNK		; STASH AS LOC OF TAG
	MOVEI	TB,1			; GET A FLAG
	DPB	TB,PR.SEG##		; STASH AS SEGMENT FLAG
	MOVE	CH,CURPRO		; GET PROTAB LINK
	SUB	CH,PROLOC		; MAKE INTO POINTER
	HRRZS	CH			; CLEAR OUT THE GARBAGE
	ADD	CH,[XWD AS.PN,AS.PRO]	; MAKE INTO TAG DEF OP
	PUSHJ	PP,PUTASN		; WRITE IT OUT
	POPJ	PP,			; EXIT

CLSUP:	PUSHJ	PP,LITSET##		; GO SET UP LITERALS
	MOVE	TB,EAS3PC		; [260] get AS3 PC
	MOVEM	TB,TEMBAS		; [260] store as start of %TEMP
	HRRZ	CH,ETEMAX##		; [246] get max count of temporaries
	JUMPE	CH,CLS.1		; [246] just continue if none required
	HRLI	CH,AS.OCT		; [246] else get ready to output
	PUSHJ	PP,PUTASN		; [246] output header
	MOVE	TB,ETEMAX		; [246] get count
	SETZ	CH,			; [246] output zeroes
	PUSHJ	PP,PUTASY		; [246] output at least one
	SOJN	TB,.-1			; [246] as many as necessary

CLS.1:	SETOI	DW,			; ALL ONES ON ERA FILE = EOF
	PUSHJ	PP,PUTERA##
	CLOSE	ERA,			; CLOSE OUT ERROR FILE
	MOVEI	CH,0			; EOF FOR AS1 = A HEADER WORD OF ZERO
	PUSHJ	PP,PUTAS1		; OUTPUT IT
	CLOSE	AS1,			; CLOSE FILE
	MOVEI	CH,0			; PUT OUT
	PUSHJ	PP,PUTAS2##		;   END-OF-DATA ON AS2
	MOVEI	CH,0			; PUT OUT
	PUSHJ	PP,PUTAS3##		;   END-OF-DATA ON AS3
	MOVSI	CH,177740		; PUT OUT
	PUSHJ	PP,PUTASN##		;   'END-FILE' ON CURRENT FILE
	CLOSE	AS2,			; AS2 CLOSED OUT.....
	CLOSE	AS3,			; AS3 CLOSED OUT.....

FINE:	MOVEI	TA,FIXNUM		; [246] get number of fixed items
	MOVEM	TA,DATBAS##		; DATBAS = number of fixed items
	ADDB	TA,ARRBAS		; ARRBAS = ARRBAS + DATBAS
	ADDB	TA,OTFBAS		; OTFBAS = OTFBAS + ARRBAS
	ADDB	TA,ICHBAS		; ICHBAS = OTFBAS + ICHBAS
	ADDB	TA,OCHBAS		; OCHBAS = ICHBAS + OCHBAS
	ADDB	TA,FTBBAS		; FTBBAS = OCHBAS + FTBBAS
	ADD	TA,EAS1PC		; RESDNT = FTBBAS + EAS1PC
	MOVEM	TA,RESDNT##
	MOVEM	TA,PROGST##		; STORE AS PROGRAM ENTRY POINT
	ADD	TA,EAS2PC##		; NONRES = RESDNT + EAS2PC
	MOVEM	TA,NONRES##
	ADDB	TA,LITBAS##		; LITBAS = NONRES + LITBAS
	ADDB	TA,TEMBAS##		; [260] TEMBAS = LITBAS + TEMBAS


	ENDFAZ	E;
;DEFINE ALL EXTERNAL CALLS SO WE AVOID SOME ERROR MESSAGES

EXTERNAL DATLOC,DATNXT,CURDAT,FILLOC,FILNXT,CURFIL,OTFLOC,OTFNXT,CUROTF
EXTERNAL ICHLOC,ICHNXT,CURICH,OCHLOC,OCHNXT,CUROCH,OTFBAS

EXTERNAL .FIMF1,.FIMF2,.FICDR,.FILPT,.FILP2,.FITTY,.FIDSK,.FIMTA

EXTERNAL CURFLD,CURREC

EXTERNAL HISIZ,EAS1PC,PCREM,SAVEAC,TEMBUF,TM2BUF,CRDBUF

EXTERNAL LNKSET,GETENT,GENCOM,.LOKUP

EXTERNAL AS.REL,AS.MSC,AS.OCT,AS.DAT,AS.OCB,AS.ICB,AS.CNB
EXTERNAL AS.ABS,AS.BYT,AS.PRO,AS.PN

EXTERNAL DA.DUN,DA.FLS,DA.COR,DA.RES,DA.SNM,DA.VAL,DA.ARE,DA.NDF,DA.IND
EXTERNAL DA.ARP,DA.ICH,DA.BRO,DA.MAJ,DA.INP
EXTERNAL OT.BLK,OT.BSZ,OT.BSC,OT.BFP,OT.IPC,OT.LAS,OT.OPC
EXTERNAL IC.DES,IC.RII,IC.INP,IC.NXF,IC.NXR
EXTERNAL OC.NXR,OC.NXF,OC.IND,OC.IDX,OC.ARP,OC.SRC
EXTERNAL FI.DAT

EXTERNAL AD,SUBM.,MOVEI.,MOVEM.,JRST.,PUSHJ.,POPJ.,ILDB.,TDO.,TDZ.,DPB.
EXTERNAL FDV., FMP., FLTLIT, SQRT., FIX., FLOT1., FLOT2., ARG.

	END	RPGIIE