Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-06 - decus/20-153/gencom.mac
There is 1 other file named gencom.mac in the archive. Click here to see a list.
	TITLE	GENCOM FOR RPGII %1
	SUBTTL	COMMON ROUTINES TO BE USED BY CODE GENERATORS		BOB CURRIER

;
;	GENCOM %1
;
;	HEREIN FIND VARIOUS ROUTINES USED BY THE CODE GENERATORS.
;	THESE ROUTINES ARE COLLECTED HERE FOR SAKE OF EASIER
;	EDITING.
;
;	BOB CURRIER	SEPTEMBER 6, 1975	16:02:53
;
;	Copyright (C) 1975, 1976 by Cerritos College and Robert Currier
;	All rights reserved
;

	TWOSEG
	RELOC	400000


	ENTRY	GENCOM

GENCOM:

;ROUTINES FOUND HEREIN:

INTERNAL PUTASY, PUTASN, STASHL, LITSET, SH1AC1, SH2AC3, PTRAC3, GT1AC1, GT2AC3
INTERNAL SHFTAC, ROUND, STASHC, INDCHK, MAKTAG, FNDTAG, BLDTAG, NOTNUM, FNDFLD
INTERNAL CH.12, SH11.2, SH23.1, PTRAC5, GTFLD, GT1AC3, GT2AC1, SH1AC3, SH2AC1
INTERNAL SWPOP, SWPIND, BINC, STBYT1, STBYT2, PUTPTR, CHCONV, CHKNUM, CHKNM2
INTERNAL BPTRSZ, BPTR, GTBYTA, BNCGN1, BNCGN2, BNCGN3, WH.OP1, WH.OP2, WH.OP3
INTERNAL CHK3, WHLGN1, WHLGN2, .BPTRB, PUTPT2, GTBP15, GTBP25, PTRAC1

INTERNAL SH13.1, SH23.1		; [353]



	SALL
;PUTASY
;
;PUT A WORD ONTO THE CURRENT ASYFIL AND BUMP APPROPRIATE PC
;
;

PUTASY:	TSWT	FAS3;			; ARE WE CURRENTLY IN SECOND SEGMENT
	AOSA	EAS2PC##		; NO - BUMP PRIMARY PC
	AOSA	EAS3PC##		; YES - BUMP SECONDARY PC
	JRST	PUTAS2			; WRITE ONTO AS2FIL
	JRST	PUTAS3			; WRITE ONTO AS3FIL


;PUTASN
;
;PUT A WORD ONTO THE CURRENT ASYFIL, DON'T BUMP PC
;
;

PUTASN:	TSWT	FAS3;			; CURRENTLY IN SECONDAY SECTION?
	JRST	PUTAS2##		; NO - USE AS2FIL
	JRST	PUTAS3##		; YES - USE AS3FIL
;
;PUT A WORD INTO AS.LIT
;
;IF LITAB IS FULL AND < FULLIT WORDS, EXPAND AS.LIT
;IF LITAB IS FULL AND > FULLIT WORDS, WRITE OUT SOME WORDS
;  ONTO LITFIL, AND MOVE REMAINDER TO TOP OF AS.LIT

	FULLIT==10*200	;NUMBER OF WORDS WRITTEN OUT EACH TIME.
			;THIS MUST BE > ^D768 YET SMALL ENOUGH SO
			;THAT CURRENT LITERAL GROUP BEING STASHED
			;WILL NOT BE WRITTEN OUT.
			;LARGEST LITERAL GROUP IS ASCII, SIZE 120.

STASHC:	EXCH	TA,CH			; SAVE TA AND GET CH
	PUSHJ	PP,STASHL		; GO STASH
	EXCH	TA,CH			; RESTORE
	POPJ	PP,			; EXIT



STASHL:	MOVE	TE,LITNXT##		; GET NEXT HOLE ADDRESS
	AOBJP	TE,STSHL0		; IF NO ROOM, JUMP
	MOVEM	TA,(TE)			; STORE WORD
	MOVEM	TE,LITNXT		; RESTORE LITNXT
	POPJ	PP,			; AND EXIT

;TABLE IS FULL

STSHL0:	HLRE	TE,LITLOC##		; IS
	MOVMS	TE			;   LITAB
	CAILE	TE,FULLIT		;   AS BIG AS IT GETS?
	JRST	STSHL2			; YES -

STSHL1:	PUSHJ	PP,XPNLIT##		; NO - EXPAND LITAB
	JRST	STASHL			; AND TRY AGAIN

;LITAB IS FULL, AND AS BIG AS IT SHOULD GET

STSHL2:	MOVEM	TA,SAVEAC##		; SAVE
	MOVE	TA,[XWD TD,SAVEAC+1]	;   AC'S
	BLT	TA,SAVEAC+3		;   TD THRU TA

	SKIPLE	LITBLK##		; IS LITFIL ALREADY OPEN?
	JRST	STSHL3			; YES -
	SKIPL	LITBLK			; WAS ANYTHING EVER WRITTEN?
	CLOSE	LIT,			; YES - CLOSE INPUT

	MOVE	TE,LITHDR##		; GET FILE NAME
	HLLZ	TD,LITHDR+1		;   AND EXTENSION
	SETZB	TC,TB			; CLEAR PROTECTION, PROJ-PROG
	ENTER	LIT,TE			; OPEN FILE FOR OUTPUT
	JRST	STSHL5			; CANNOT - ERROR

	SETZM	LITBLK			; CLEAR WORD COUNT
;PUT WORD INTO LITAB (CONT'D)

;LITFIL IS NOW OPEN FOR OUTPUT

STSHL3:	MOVEI	TE,FULLIT		; BUMP WORD COUNT
	ADDM	TE,LITBLK		; LIKE THIS

	MOVSI	TE,-FULLIT		; CREATE
	HRR	TE,LITLOC		;   IOWD LIST FOR
	SETZ	TD,			;   OUTPUT

	OUT	LIT,TE			; WRITE IT
	JRST	STSHL4			; OK -
	MOVEI	CH,LITDEV##		; ERROR - DIE
	JRST	DEVDED##		; AGGGGGHH!


STSHL4:	MOVE	TD,LITLOC		; MOVE
	MOVSI	TE,FULLIT+1(TD)		;   WORDS
	HRRI	TE,1(TD)		;   UP
	MOVN	TD,[XWD FULLIT,FULLIT]	;   FROM
	ADDB	TD,LITNXT		;   BOTTOM
	BLT	TE,(TD)			;   OF TABLE

	MOVNI	TE,FULLIT		; UPDATE
	SKIPE	CURLIT			;   ANY NON-ZERO
	ADDM	TE,CURLIT##		;   CURLIT

	MOVE	TA,[SAVEAC+1,,TD]	; RESTORE
	BLT	TA,TB			;   THE AC'S
	MOVE	TA,SAVEAC		;   WE SAVED

	JRST	STASHL			; AND TRY AGAIN

;ENTER FAILURE

STSHL5:	OUTSTR	[ASCIZ "?Cannot ENTER "]
	MOVEI	DA,LITDEV		; GET DEVICE
	HRRZ	I2,TD			; GET ERROR CODE
	JRST	ERATYP##		; GO CROAK
;LITSET		OUTPUT LITAB TO AS3FIL (LITS-O-MANIA)
;
;CALLED VIA THE INFAMOUS PUSHJ
;
;

LITSET:	TSWT	FAS3;			; ARE WE USING AS3FIL ALREADY?
	SWON	FAS3;			; NO - START NOW
	MOVE	TE,EAS3PC		; GET CURRENT ASY PC
	MOVEM	TE,LITBAS##		; STASH
	SETZM	EAS3PC##		; RESET
	HRRZ	TC,LITLOC		; WE MUST SET UP AC TE
	HRRZ	TE,LITNXT		; IN CASE WE DON'T READ ANYTHING
	SUB	TE,TC			; OFF DISK, AND IT DOESN'T GET SET UP THAT WAY
	SKIPLE	LITBLK			; LITFIL OPEN?
	PUSHJ	PP,LITS03		; YES -
	HRRZ	TA,LITLOC		; NO - GET BASE ADDRESS
	AOS	TA			; BUMP BY ONE
	HRLZI	CH,AS.REL##+1B35	; RELOC
	HRRI	CH,AS.MSC##		; MISC ADDRESS
	PUSHJ	PP,PUTASN		; PUT ON ASYFIL
	HRRZI	CH,AS.LIT##		; RELOC %LIT+0
	PUSHJ	PP,PUTASN

LITS00:	MOVS	TB,(TA)			; GET A LITAB WORD
	MOVS	CH,LITSTB(TB)		; GET ASY OP-CODE
	MOVE	TC,TB			; SAVE FOR LATER
	HLRZS	TB			; GET WORD COUNT (LITTAB STYLE)
	MOVE	TD,TB			; GET INTO AC WE CAN PLAY WITH
	IDIV	TD,LITST2(TC)		; CONVERT TO NUMBER OF GENERATED WORDS
	ADDM	TD,EAS3PC		; BUMP ASYFIL PC
	CAMN	CH,[XWD AS.BYT,0]	; IS BYTE POINTER?
	  JRST	.+3			; YES - TREAT A BIT SPECIAL
	HRRM	TD,CH			; STICK WC IN ASYFIL WORD
	PUSHJ	PP,PUTASN		; OUTPUT THE WORD
	AOS	TA			; INCREMENT INDEX
	SOJG	TE,.+2			; ANY LEFT?
	PUSHJ	PP,LITS10		; NO - GO GET ANOTHER HELPING

LITS01:	MOVE	CH,(TA)			; GET ANOTHER WORD
	PUSHJ	PP,PUTASN		; OUTPUT IT
	SOJE	TB,LITS02		; JUMP OUT IF DONE
	AOS	TA			; ELSE BUMP INDEX
	SOJG	TE,.+2			; NO MORE ROOM?
	PUSHJ	PP,LITS10		; YES - GET SOME MORE
	JRST	LITS01			; LOOP

LITS02:	AOS	TA			; BUMP INDEX
	SOJG	TE,.+2			; ANY ROOM LEFT?
	PUSHJ	PP,LITS12		; NO 
	JRST	LITS00			; LOOP
;LITSET (CONT'D)
;

LITS03:	HRRZ	TA,LITLOC		; GET BASE OF LITTAB
	HRRZ	TE,LITNXT		; GET TOP
	CAMN	TA,TE			; IS TABLE ZERO SIZE?
	JRST	LITS04			; YES - NOTHING TO WRITE
	SUB	TE,TA			; TE NOW HAS WORD COUNT
	ADDM	TE,LITBLK		; UPDATE WORD COUNT
	MOVNS	TE			; CREATE IOWD
	HRLZS	TE			;    LIST FOR
	HRR	TE,LITLOC		;    WRITING LITFIL
	SETZ	TD,			; MARK END OF LIST
	OUT	LIT,TE			; OUTPUT
	JRST	LITS04			; ALL OK

	MOVEI	CH,LITDEV		; BAD
	JRST	DEVDED			; GO TO THE DEVICES GRAVEYARD


LITS04:	CLOSE	LIT,			; CLOSE OUTPUT
	MOVE	TE,LITHDR		; GET FILE NAME
	HLLZ	TD,LITHDR+1		;   AND EXTENSION
	SETZB	TC,TB			; ZERO PROT AND PPN
	LOOKUP	LIT,TE			; OPEN FOR INPUT
	JRST	STSHL5			; BUMMER - GO ELSEWHERE TO DIE

LITS05:	MOVE	TB,LITBLK		; GET WORD COUNT
	CAIGE	TB,FULLIT		; COMPARE TO MAX BUFFER
	JRST	LITS09			; NOT FULL BUFFER LEFT

LITS06:	HLRE	TE,LITLOC		;
	MOVMS	TE
	CAILE	TE,FULLIT		; ?
	JRST	LITS07			; YES - OK
	PUSHJ	PP,XPNLIT		; NO - EXPAND IT
	JRST	LITS06			; LOOP AND CHECK AGAIN

LITS07:	MOVNI	TE,FULLIT		; GET WORD COUNT
	ADDM	TE,LITBLK		; SUBTRACT FROM MASTER WORD COUNT
	MOVSI	TE,-FULLIT		; CREATE IOWD
	PUSH	PP,[FULLIT]		; STASH WORD COUNT

LITS08:	HRR	TE,LITLOC		; GET ADDR HALF OF IOWD
	SETZ	TD,			; MARK END
	IN	LIT,TE			; GRAB SOME WORDS
	JRST	LITS8A			; ALL OK

	MOVEI	CH,LITDEV		; SAY WHO DIED
	JRST	DEVDED			; AND PLACE TO DO IT
;LITSET (CONT'D)
;

LITS8A:	POP	PP,TE			; RECOVER WORD COUNT
	POPJ	PP,			; EXIT

LITS09:	SETZM	LITBLK			; ZAP WORD COUNT
	PUSH	PP,TB			; SAVE WORD COUNT
	MOVNS	TB			; GET READY FOR IOWD
	HRLZ	TE,TB			; TRANSFER
	JRST	LITS08			; GO DO REST

LITS10:	SKIPG	LITBLK			; ANY LEFT?
	JRST	LITS14			; NO - ERROR

LITS11:	PUSH	PP,TB			; SAVE AC
	PUSHJ	PP,LITS05		; GO GET SOME
	POP	PP,TB			; RESTORE AC
	HRRZ	TA,LITLOC		; GET NEW LITLOC
	AOS	TA			; AND BUMP LITLOC
	POPJ	PP,			; AND TRY AGAIN

LITS12:	SKIPLE	LITBLK			; ANY LEFT?
	JRST	LITS11			; YES -
	POP	PP,TB			; POP OFF A ADDRESS SO WE RETURN TO RIGHT PLACE
	POPJ	PP,			; NO - EXIT

LITS14:	OUTSTR	[ASCIZ "?Short LITTAB in phase E
"]
	JRST	KILLF##			; GO DIE AND DUMP
;LITSET (CONT'D)	TABLES USED BY LITSET
;

LITSTB:	EXP	0			; DUMMY WORD
	EXP	AS.XWD##		; XWD
	EXP	AS.BYT##		; BYTE POINTER
	EXP	AS.ASC##		; ASCII CONSTANT
	EXP	AS.SIX##		; SIXBIT CONSTANT
	EXP	AS.D1##			; 1-WORD DECIMAL CONSTANT
	EXP	AS.D2##			; 2-WORD DECIMAL CONSTANT
	EXP	AS.FLT##		; FLOATING POINT CONSTANT
	EXP	AS.OCT##		; OCTAL CONSTANT


LITST2:	OCT	0			; DUMMY WORD
	OCT	2			; XWD
	OCT	2			; BYTE POINTER
	OCT	1			; ASCII
	OCT	1			; SIXBIT
	OCT	1			; 1-WORD DECIMAL
	OCT	1			; 2-WORD DECIMAL
	OCT	2			; FLOATING POINT
	OCT	1			; OCTAL
;
;SH1AC1		ROUTINE TO ALLIGN AC1 WITH RESULT FIELD
;
;
;

SH1AC1:	MOVE	TD,TC			; GET RESULT FIELD DECIMAL COUNT
	SUB	TD,OP1DEC##		; TD = R - F1
	JUMPE	TD,SH11.1		; NO NEED TO SHIFT IF THEY'RE THE SAME
SH11.2:	HRLZI	CH,AC1			; GET AC1 CODE
	MOVE	TB,OP1DEC		; GET DECIMAL PLACES
	MOVEM	TB,EDEC##		; STORE FOR UPDATE
	MOVE	TB,OP1SIZ##		; GET SIZE
	MOVEM	TB,ESIZ##		; STASH THAT TOO
	PUSHJ	PP,SHFTAC		; SHIFT THAT AC
	MOVE	TB,EDEC			; GET BACK NEW DEC POSITS
	MOVEM	TB,OP1DEC		; STASH
	MOVE	TB,ESIZ			; GET BACK SIZE
	MOVEM	TB,OP1SIZ		; STORE

SH11.1:	POPJ	PP,			; EXIT


;
;SH2AC3		ROUTINE TO ALLIGN AC3 WITH RESULT FIELD
;
;
;

SH2AC3:	MOVE	TD,TC			; GET RESULT FIELD COUNT
	SUB	TD,OP2DEC##		; TD = R - F2
	JUMPE	TD,SH11.1		; DON'T SHIFT IF EQUAL
SH23.1:	HRLZI	CH,AC3			; PUT IT IN AC3
	MOVE	TB,OP2DEC		; GET DECIMAL PLACES
	MOVEM	TB,EDEC			; STASH
	MOVE	TB,OP2SIZ##		; GET SIZE
	MOVEM	TB,ESIZ			; STASH THAT TOO
	PUSHJ	PP,SHFTAC		; <<<<<<<<SHIFT<<<<<<<
	MOVE	TB,EDEC			; GET BACK DEC PLACES
	MOVEM	TB,OP2DEC		; STORE
	MOVE	TB,ESIZ			; GET
	MOVEM	TB,OP2SIZ		; STORE
	POPJ	PP,			; EXIT
;
;SH2AC1		ROUTINE TO ALLIGN AC1 WITH RESULT FIELD
;
;
;

SH2AC1:	MOVE	TD,TC			; GET R DECIMAL COUNT
	SUB	TD,OP2DEC		; GET AMOUNT TO SHIFT
	JUMPE	TD,SH11.1		; DON'T SHIFT IF WE DON'T NEED TOO
SH21.1:	HRLZI	CH,AC1			; [353] SHIFT AC1 DUMMY
	JRST	SH23.1+1		; GO DO THE REST


;
;SH1AC3		ROUTINE TO ALLIGN AC3 WITH RESULT FIELD
;
;
;

SH1AC3:	MOVE	TD,TC			; GET RESULT DECIMAL COUNT
	SUB	TD,OP1DEC		; GET SHIFT COUNT
	JUMPE	TD,SH11.1		; NO NEED TO SHIFT
SH13.1:	HRLZI	CH,AC3			; [353] AC3 TURKEY!
	JRST	SH11.2+1		; GO DO IT TO IT
;SHFTAC		ROUTINE TO SHIFT AC
;
;
;

SHFTAC:	JUMPL	TD,SHFT4		; MUST DIVIDE (RIGHTWARD SHIFT)
	ADDM	TD,EDEC			; UPDATE
	ADDM	TD,ESIZ			; LIKEWISE
	MOVE	TB,ESIZ			; GET SIZE
	CAILE	TB,^D10			; > 10?
	  JRST	SHFT2			; YES -
	ADD	CH,[XWD IMUL.+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY
	SKIPN	CH,PWR10-1(TD)		; POWER DEFINED?
	  PUSHJ	PP,SHFT1		; NO - STASH IN LITERAL POOL
	PUSHJ	PP,PUTASN		; OUTPUT AS OPERAND
	POPJ	PP,			; EXIT

;GET POWER OF TEN AND STASH IN LITERAL POOL

SHFT1:	MOVE	CH,ELITPC		; GET LITAB PC
	TRO	CH,AS.LIT		; FLAG AS LINK
	MOVEM	CH,PWR10-1(TD)		; STORE ADDRESS FOR LATER
	MOVE	TA,[XWD D1LIT,1]	; GET HEADER
	PUSHJ	PP,STASHL		; OUTPUT IT
	MOVE	TA,POWR10(TD)		; GET VALUE
	PUSHJ	PP,STASHL		; OUTPUT IT
	AOS	ELITPC			; BUMP PC
	POPJ	PP,			; EXIT

;MUST WORK WITH DOUBLE PRECISION

SHFT2:	CAIG	TD,^D10			; A BIGGY?
	  JRST	SHFT3B			; NO -
	PUSH	PP,CH			; YES - SAVE SOME STUFF
	PUSH	PP,TD			; ON THE STACK
	ADD	CH,[XWD MUL.+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; PUT OUT THE MUL
	MOVEI	TD,^D10			; MULTIPLY BY 10**10
	SKIPN	CH,PWR10-1(TD)		; DEFINED YET?
	  PUSHJ	PP,SHFT1		; NO - GO DEFINE IT
	PUSHJ	PP,PUTASN		; OUTPUT THE ADDRESS
	POP	PP,TD			; DO SOME RESTORATION
	POP	PP,CH			;
	SUBI	TD,^D10			; DECREMENT SHIFT COUNT

SHFT3:	ADD	CH,[XWD MUL.21+ASINC,AS.MSC]

SHFTX:	MOVMS	TD			; [360] take magnitude
	PUSHJ	PP,PUTASY		; OUTPUT THE INSTR.
	SKIPN	CH,PWR10-1(TD)		; DEFINED?
	  PUSHJ	PP,SHFT1		; NO -
	PUSHJ	PP,PUTASN		; OUTPUT ADDRESS
	POPJ	PP,			; EXIT -
;SHFTAC (CONT'D)		SEE IF WE MUST CONVERT TO DOUBLE PRECISION
;

SHFT3B:	SUB	TB,TD			; GET THE ORIGINAL SIZE
	CAILE	TB,^D10			; WAS IT SINGLE PRECISION
	  JRST	SHFT3			; NO - IS ALREADY DOUBLE
	PUSH	PP,CH			; YES - CONVERT TO DOUBLE
	ADD	CH,[XWD MULI.,AS.CNS+1]	; GENERATE A <MULI AC,1>
	PUSHJ	PP,PUTASY		; OUTPUT IT
	POP	PP,CH			; RESTORE THE AC
	JRST	SHFT3			; CONTINUE
;SHFTAC (CONT'D)	MUST DO A RIGHT SHIFT. USE DIVIDE
;
;
;

SHFT4:	ADDM	TD,EDEC			; [360] update decimal coount
	MOVE	TC,ESIZ			; GET SIZE OF FIELD
	CAILE	TC,^D10			; > 10?
	  JRST	SHFT5			; YES -
	TSWF	FROUND;			; DO WE NEED TO HALF-ADJUST?
	  PUSHJ	PP,ROUND		; YES -
	ADD	CH,[XWD IDIV.+ASINC,AS.MSC]
	ADDM	TD,ESIZ			; [360] DECREMENT SIZE
	JRST	SHFTX			; GO OUTPUT POWER OF TEN

SHFT5:	TSWF	FROUND;			; must we round?
	  PUSHJ	PP,ROUND		; yes - do so then
	MOVE	TC,ESIZ			; GET SIZE
	ADDM	TD,ESIZ			; [360] decrement size
	CAIG	TC,^D10			; > 10 ?
	  JRST	SHFT6			; NO -
	ADD	CH,[XWD DIV.21+ASINC,AS.MSC]
	JRST	SHFTX			; GET OUTPUT 10**TD

SHFT6:	MOVMS	TD			; [360] take magnitude
	CAILE	TD,^D10			; TD > 10?
	  JRST	SHFT7			; YES -
	ADD	CH,[XWD DIV.+ASINC,AS.MSC]
	JRST	SHFTX			; GO FINISH IN LAPLAND OF COURSE

SHFT7:	PUSH	PP,CH
	PUSH	PP,TD			; SAVE SOME TIDBITS
	ADD	CH,[XWD DIV.+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT DIVIDE
	MOVEI	TD,^D10			; DIVIDE BY 10**10
	SKIPN	CH,PWR10##-1		; DEFINED?
	  PUSHJ	PP,SHFT1		; NO - GO DO IT
	PUSHJ	PP,PUTASN		; MUST BE BY NOW
	POP	PP,TD			; POP TIDBITS OFF STACK
	POP	PP,CH			;
	SUBI	TD,^D10			; DECREMENT SHIFT COUNT
	TSWF	FROUND;			; DO WE NEED TO ROUND ALSO?
	  PUSHJ	PP,ROUND		; YES -
	ADD	CH,[XWD IDIV.+ASINC,AS.MSC]
	JRST	SHFTX			; GO OFF INTO THE SUNSET
;
;ROUND		GENERATE CODE TO ROUND THE AC'S
;
;	ENTER WITH AC IN CH, SHIFT COUNT IN TD; THESE AC'S ARE
;	PRESERVED THRUOUT THE ROUTINE.
;
;
;

ROUND:	PUSH	PP,CH			; STASH THESE
	PUSH	PP,TD			; ON THE STACK
	MOVMS	TD			; [360] take magnitude of dec pos
	MOVEM	CH,EAC##		; STORE AC
	LSH	CH,-5			; GET AC INTO FAR RIGHT HALF
	HRRI	CH,SKIPL.		; GENERATE <SKIPL AC>
	MOVSS	CH			; GET DATA INTO PROPER HALVES
	PUSHJ	PP,PUTASY		; OUTPUT IT
	SKIPN	CH,RPWR10##-1(TD)	; IS FACTOR DEFINED?
	  PUSHJ	PP,ROUND4		; NO - GO PUT IN LITERAL POOL
	MOVEM	CH,ESAVAC##		; STORE FOR LATER USE
	MOVEM	CH,RPWR10-1(TD)		; STORE ADDRESS

	MOVE	CH,[XWD SKIPA.+AC5,AS.MSC]
	PUSHJ	PP,PUTASY		; GENERATE <SKIPA 5,[LIT]>
	MOVE	CH,ESAVAC		; GET LITERAL
	PUSHJ	PP,PUTASN		; OUTPUT IT

	MOVE	CH,[XWD MOVN.+AC5,AS.MSC]
	PUSHJ	PP,PUTASY		; GENERATE <MOVN 5,[LIT]>
	MOVE	CH,ESAVAC		; GET LITERAL
	PUSHJ	PP,PUTASN		; OUTPUT IT
	MOVE	TB,ESIZ			; GET SIZE
	CAILE	TB,^D10			; DOUBLE PRECISION?
	JRST	ROUND3			; NO -

;AC'S CONTAIN SINGLE PRECISION

ROUND1:	MOVE	CH,EAC			; GET AC
	ADD	CH,[XWD AD,5]		; GENERATE <ADD AC,5>
	PUSHJ	PP,PUTASY		; OUTPUT IT

ROUND2:	POP	PP,TD			; RESTORE DATA
	POP	PP,CH			;
	POPJ	PP,			; EXIT

;AC'S CONTAIN DOUBLE PRECISION

ROUND3:	MOVE	CH,EAC			; GET AC
	ADD	CH,[XWD ADD.21,5]	; GENERATE <ADD.21 AC,5>
	PUSHJ	PP,PUTASY		; OUTPUT IT
	JRST	ROUND2			; OGO POP OFF
;ROUND (CONT'D)	ADD A ROUNDING FACTOR TO THE LITERAL POOL
;


ROUND4:	MOVE	TA,[XWD D1LIT,1]	; GET HEADER
	PUSHJ	PP,STASHL		; OUTPUT IT
	MOVE	TA,ROUNDR-1(TD)		; GET ROUNDING FACTOR
	PUSHJ	PP,STASHL		; OUTPUT IT AS DATA
	HRRZ	CH,ELITPC		; GET ADDRESS (LITAB RELATIVE)
	TRO	CH,AS.LIT		; FLAG IT
	AOS	ELITPC			; BUMP PC
	POPJ	PP,			; EXIT
;GT1AC1		GET OPERAND 1 INTO AC1
;
;

GT1AC1:	HRLZI	TB,AC1			; STICK IT IN AC1
	MOVEM	TB,EAC			; TEMP STASH
	MOVEI	TB,2			; OP1 IS OPRTR+2
	PUSHJ	PP,GTFACX		; GO FOR IT
	MOVEM	TC,OP1DEC		; STORE DECIMAL POSITIONS
	MOVEM	TD,OP1SIZ		; STASH SIZE
	POPJ	PP,			; EXIT




;GT2AC3		GET OPERAND 2 INTO AC3
;
;

GT2AC3:	HRLZI	TB,AC3			; STICK IT IN AC3
	MOVEM	TB,EAC			; PUT HERE FOR NOW
	MOVEI	TB,3			; OP2 IS OPRTR+3
	PUSHJ	PP,GTFACX		; GO GET IT
	MOVEM	TC,OP2DEC		; STASH DEC POSITIONS
	MOVEM	TD,OP2SIZ		; STORE FIELD SIZE
	POPJ	PP,			; EXIT





;GT1AC3		GET OPERAND 1 INTO AC3
;
;

GT1AC3:	HRLZI	TB,AC3			; PUT IT IN AC3
	JRST	GT1AC1+1		; GO DO THE REST



;GT2AC1		GET OPERAND 2 INTO AC1
;
;

GT2AC1:	HRLZI	TB,AC1			; AC1 IS THE ONE FOR ME
	JRST	GT2AC3+1		; ME TOO
;GTFACX		GET AN OPERAND INTO AN AC
;
;
;

GTFACX:	SWOFF	FPUT;			; TURN ME OFF
	HRRZ	TA,OPRTR(TB)		; GET LINK TO ITEM
	PUSHJ	PP,LNKSET##		; SET THOSE LINKERS!
	LDB	TC,[POINT 1,OPRTR(TB),1]; GET LITERAL FLAG
	JUMPN	TC,GTF.03		; ONE O' THOSE LITTLE BASTARDS
	LDB	TC,DA.ARE##		; GET ARRAY ENTRY FLAG
	JUMPN	TC,GTF.09		; LEAP IF ARRAY ENTRY
	LDB	TC,DA.SIZ		; GET SIZE
	JUMPE	TC,GTF.1B		; NOT DEFINED -
GTF.00:	LDB	TC,DA.OCC##		; GET NUMBER OF OCCURS
	JUMPN	TC,GTF.10		; LEAP IF WHOLE ARRAY OR TABLE
	LDB	TC,DA.RSV##		; get reserved word flag
	JUMPN	TC,GTF.12		; it is if we jump
	LDB	TC,DA.FLD##		; GET FIELD TYPE (MUST BE DATAB ITEM)
	JUMPE	TC,GTF.1A		; CAN'T BE ALPHA
	CAIE	TC,2			; BINARY?
	  JRST	GTF.02			; NO - TREAT AS GODDAMN SIXBIT
GTF.0A:	MOVE	CH,[XWD MOV+ASINC,AS.MSC##]
	ADD	CH,EAC			; AND IN THE AC OF OUR CHOICE
	PUSHJ	PP,PUTASY		; OUTPUT IT
	LDB	CH,DA.COR##		; GET CORE ADDRESS
	TRO	CH,AS.DAT##		; FLAG AS DATAB RELATIVE
	PUSHJ	PP,PUTASN		; OUTPUT THAT TOO

GTF.01:	LDB	TC,DA.DEC##		; GET DECIMAL POSITIONS TO PLEASE OTHERS
	LDB	TD,DA.SIZ##		; GET FIELD SIZE TOO
	POPJ	PP,			; EXIT

GTF.1A:	PUSHJ	PP,NOTNUM		; ITEM NOT NUMERIC
	JRST	GTF.02			; FAKE IT LIKE IT WAS

GTF.1B:	PUSH	PP,TB			; STASH OPRTR INDEX
	LDB	TA,DA.NAM		; GET NAMTAB LINK
	MOVEI	TB,CD.DAT		; GET DATAB ID
	PUSHJ	PP,FNDLNK		; LOOK FOR LINK
	  JRST	GTF.1D			; NOT FOUND (??)
	MOVE	TA,TB			; GET LINK INTO PROPER AC
	POP	PP,TB			; RESTORE OPRTR INDEX

GTF.1C:	LDB	TC,DA.SIZ		; GET SIZE
	JUMPN	TC,GTF.00		; IF WE GOT IT, JUMP OUT AND CONTINUE
	LDB	TA,DA.SNM##		; GET SAME NAME LINK
	JUMPE	TA,GTF.1D		; ERROR IF NOT ONE
	PUSHJ	PP,LNKSET		; SET IT UP
	JRST	GTF.1C			; LOOP
;GTFACX (cont'd)
;

GTF.1D:	LDB	TC,[POINT 13,OPRTR,28]	; ELSE GET LINE NUMBER
	MOVEM	TC,SAVELN		; STASH
	CAIE	TB,2			; FACTOR 1?
	  JRST	.+3			; NO - MUST BE TWO
	WARN	704;			; FACTOR 1 NOT DEFINED
	JRST	GTF.02			; LET'S PRETEND
	WARN	705;			; FACTOR 2 NOT DEFINED
	JRST	GTF.02

;Get a sixbit operand into an AC

GTF.02:	LDB	CH,DA.FMT		; GET FORMAT
	MOVE	CH,GTAB2(CH)		; GET PROPER INSTRUCTION
	ADD	CH,EAC			; SET UP THE AC
	PUSHJ	PP,PUTASY		; PUT OUT ONE OR THE OTHER
	MOVE	CH,ELITPC##		; GET LITTAB PC
	TRO	CH,AS.LIT##		; FLAG AS LITAB RELATIVE
	PUSHJ	PP,PUTASN		; PUT OUT INCREMENT WORD
	PUSHJ	PP,PUTPTR		; OUTPUT PROPER POINTER
	JRST	GTF.01			; AND GO FINISH UP
;GTFACX (CONT'D)	MOVE A LITERAL TO AN AC
;

GTF.03:	SWOFF	FMINUS!FDECPT;		; TURN OFF SOME FLAGS
	SETZB	TC,TD			; CLEAR SUMMER AND DEC COUNTER
	SETZ	TE,			; AND POSITION COUNTER
	HRRZS	TA			; CLEAR UP POINTER
	ADD	TA,[POINT 7,0,6]	; MAKE INTO A BYTE POINTER
	ILDB	CH,TA			; GET A CHARACTER
	CAIN	CH,"+"			; [304] unary plus?
	  JRST	GTF.04			; [304] yes - ignore
	CAIE	CH,"-"			; IS IT A UNARY MINUS?
	JRST	GTF.04+1		; NO -
	SWON	FMINUS;			; YES - TURN ON NEGATE FLAG

GTF.04:	ILDB	CH,TA			; GET ANOTHER CHARACTER
	CAIN	CH,"."			; A DECIMAL?
	JRST	GTF.4B			; YES - GO TURN ON FLAG
	CAIN	CH,"_"			; NO - A EOL?
	JRST	GTF.05			; YES - ALL DONE HERE
	IMULI	TC,12			; NO - SHIFT SUM
	ADDI	TC,-"0"(CH)		; ADD IN NEW DIGIT
	TSWF	FDECPT;			; IS DECIMAL COUNTER ON?
	ADDI	TD,1			; YES - BUMP COUNTER
	ADDI	TE,1			; BUMP ALL COUNTER
	JRST	GTF.04			; NO - LOOP

GTF.4B:	SWON	FDECPT;			; TURN ON COUNTER FLAG
	JRST	GTF.04			; AND GET ANOTHER CHARACTER

GTF.05:	TSWF	FMINUS;			; UNARY MINUS SEEN?
	MOVNS	TC			; YES - NEGATE

GTF.06:	TLNE	TC,777777		; ARE WE ONLY USING LOW ORDER 18 BITS?
	JRST	GTF.07			; YES - CANNOT USE MOVEI
	MOVE 	CH,[XWD MOVEI.+ASINC,AS.CNB]
	ADD	CH,EAC			; SETUP AC
	PUSHJ	PP,PUTASY		; OUTPUT THE MOVEI
	HRRZ	CH,TC			; GET CONSTANT
	PUSHJ	PP,PUTASN		; PUT IT IN ADDRESS FIELD
	JRST	GTF.08			; GO FINISH UP
;GTFACX (CONT'D)	COME HERE WHEN WE MUST USE A MOVE OF A LITAB CONSTANT
;
;
;

GTF.07:	MOVE	CH,[XWD MOV+ASINC,AS.MSC]
	ADD	CH,EAC			; SET UP AC ENTRY
	PUSHJ	PP,PUTASY		; OUTPUT IT
	MOVE	CH,ELITPC		; GET A LITAB ENTRY
	TRO	CH,AS.LIT		; MARK AS LITAB RELATIVE
	PUSHJ	PP,PUTASN		; OUTPUT AS ADDRESS
	PUSH	PP,TE			; [353] save counter
	MOVE	CH,[XWD D1LIT,1]	; ONE DECIMAL CONSTANT
	PUSHJ	PP,STASHC		; STICK IT IN LITAB
	MOVE	CH,TC			; GET CONSTANT
	PUSHJ	PP,STASHC		; OUTPUT IT
	AOS	ELITPC			; BUMP LITAB PC
	POP	PP,TE			; [353] restore digit count

GTF.08:	MOVE	TC,TD			; TO EACH HIS OWN
	MOVE	TD,TE			; PLACE IN FOURSPACE
	POPJ	PP,			; OFF WE GO, INTO THE WILD BLUE YONDER.....
;GTFACX (CONT'D)	HANDLE ARRAY ENTRY
;

GTF.09:	PUSH	PP,TA			; SAVE DATAB POINTER
	LDB	TA,DA.ARP##		; GET ARRAY POINTER
	PUSHJ	PP,LNKSET		; SET IT UP
	LDB	TC,DA.FLD		; GET FIELD TYPE
	JUMPE	TC,NOTNUM		; ERROR IF NOT NUMERIC
GTF.9E:	LDB	TD,DA.OCC		; GET NUMBER OF OCCURS
	MOVEM	TA,CURDAT##		; STASH POINTER
	POP	PP,TA			; RESTORE DATAB POINTER
	LDB	TC,DA.IMD##		; GET IMMEDIATE FLAG
	JUMPE	TC,GTF.9B		; IS NOT IMMEDIATE
	LDB	TC,DA.INP##		; IS IMMEDIATE - GET INDEX
	CAMLE	TC,TD			; IS INDEX IN BOUNDS?
	  JRST	GTF.9D			; NO - ERROR
	HRRZ	CH,TC			; GET INDEX INTO PROPER AC
	HRLI	CH,<MOVEI.+AC0>		; GENERATE <MOVEI 0,INDEX>
	PUSHJ	PP,PUTASY		; OUTPUT IT

GTF.9A:	EXCH	TA,CURDAT		; GET ARRAY POINTER
	MOVE	CH,[XWD SUBSCR+AC0+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; GENERATE SUBSCRIPT CALL
	MOVE	CH,ELITPC		; GET LITAB PC
	TRO	CH,AS.LIT		; MARK AS LITAB ITEM
	PUSHJ	PP,PUTASN		; OUTPUT IT
	PUSHJ	PP,PUTPT2		; OUTPUT BYTE POINTER TO LITAB
	MOVE	CH,[XWD XWDLIT,2]	; GET READY TO OUTPUT 2 BYTES
	PUSHJ	PP,STASHC		; OUTPUT HEADER TO SAY ITS COMING
	LDB	CH,DA.OCC		; GET NUMBER OF OCCURS
	TSWF	FWHOLE;			; whole array?
	  MOVE	CH,WHOSIZ		; yes - use preset size
	PUSHJ	PP,STASHC		; OUTPUT AS RH
	LDB	CH,DA.SIZ		; GET SIZE OF ENTRY
	PUSHJ	PP,STASHC		; OUTPUT AS LH
	AOS	ELITPC			; BUMP THE PC
	TSWF	FWZARD;			; IS IT SORCEROUS?
	  POPJ	PP,			; YES - GET THEE HENCE FOUL THAUMATURGIST
	MOVE	CH,[XWD TLZ.+AC0,AS.CNS+3777]
	PUSHJ	PP,PUTASY		; OUTPUT CODE TO CLEAR PART OF POINTER
	LDB	CH,DA.SIZ		; GET SIZE OF FIELD
	HRLI	CH,<TLO.+AC0>		; GENERATE <TLO 0,SIZE-OF-FIELD>
	PUSHJ	PP,PUTASY		; OUTPUT INSTRUCTION
	LDB	CH,DA.FMT		; GET FORMAT OF FIELD
	TSWF	FPUT;			; ARE WE PUTTING OR GETTING
	  SKIPA	CH,PTAB1(CH)		; PUTTING
	MOVE	CH,GTAB1(CH)		; GETTING
	ADD	CH,EAC			; ADD IN AC WE ARE USING
	PUSHJ	PP,PUTASY		; OUTPUT IT
	LDB	TD,DA.SIZ		; get the size for others
	LDB	TC,DA.DEC		; likewise with decimals
	POPJ	PP,			; EXIT
;GTFACX (CONT'D)	CONTINUE HANDLEING OF ARRAY ENTRY
;

GTF.9B:	PUSH	PP,TA			; SAVE AC
	PUSH	PP,EAC			; SAVE THE AC WE'RE USING
	MOVSI	TC,AC0			; USE AC0 FOR NOW
	MOVEM	TC,EAC			;
	LDB	TA,DA.INP		; GET POINTER TO INDEX
	PUSHJ	PP,GTFLD+1		; GET THAT FIELD
	JUMPE	TC,GTF.9D		; IS BAD
	CAIN	TC,2			; BINARY?
	  JRST	GTF.9C			; YES -
	PUSHJ	PP,GTF.02		; NO - BORROW A ROUTINE
	POP	PP,EAC			; RESTORE
	POP	PP,TA			; RESTORE
	JRST	GTF.9A			; GO FINISH UP

GTF.9C:	PUSHJ	PP,GTF.0A		; STEAL ANOTHER ROUTINE
	POP	PP,EAC			; RESTORE
	POP	PP,TA			; RESTORE
	JRST	GTF.9A			; CONTINUE

GTF.9D:	WARN	228;			; INVALID INDEX
	POPJ	PP,

GTAB1:	XWD	GD6.,AS.CNS+0
	XWD	GD7.,AS.CNS+0
	XWD	0,0

GTAB2:	XWD	GD6.+ASINC,AS.MSC
	XWD	GD7.+ASINC,AS.MSC
	XWD	0,0
;GTFACX (CONT'D)	HANDLE WHOLE ARRAY OR TABLE
;

GTF.10:	LDB	TC,DA.FLD		; GET FIELD TYPE
	JUMPE	TC,NOTNUM		; MUST BE NUMERIC
	LDB	TC,DA.NAM		; GET NAMTAB LINK
	ADD	TC,NAMLOC##		; MAKE INTO REAL POINTER
	HLRZ	TC,1(TC)		; GET FIRST 3 CHARACTERS
	CAIE	TC,'TAB'		; IS IT A TABLE?	
	  JRST	GTF.11			; NO - IS WHOLE ARRAY
	MOVE	CH,[XWD MOV+AC0+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT <MOVE 0,143>
	LDB	CH,DA.COR##		; get assigned core location
	MOVEI	CH,AS.DAT-1(CH)		; identify and decrement
	PUSHJ	PP,PUTASN		; output address field
	JRST	GTF.9A+1		; GO FINISH

;HANDLE WHOLE ARRAY

GTF.11:	MOVE	CH,[XWD MOV+AC0+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; GENERATE <MOVE 0,INDEX>
	MOVE	CH,WHOLOC##		; GET LITAB ADDRESS OF INDEX
	TRO	CH,AS.LIT		; SAY WHERE IT CAME FROM
	PUSHJ	PP,PUTASN		; OUTPUT IT
	JRST	GTF.9A+1		; GO OUTPUT REST OF CODE

;Handle reserved word

GTF.12:	MOVE	CH,[XWD RSVWD.+ASINC,AS.CNB]
	PUSHJ	PP,PUTASY		; output the UUO call
	SETZ	CH,			; zap our ASYFIL word
	LDB	TD,DA.SIZ		; get size of field
	DPB	TD,[POINT 4,CH,25]	; stash
	SUBI	TC,1			; decrement the reserved word id
	DPB	TC,[POINT 4,CH,29]	; stash that too
	LDB	TC,[POINT 4,EAC,12]	; get the AC
	DPB	TC,[POINT 4,CH,21]	; stash in output word
	PUSHJ	PP,PUTASN		; output
	JRST	GTF.01			; and exit
;PTRAC3		ROUTINE TO MOVE RESULT FROM AC3 TO CORE
;
;
;

PTRAC3:	HRLZI	TB,AC3			; GET AC3

PUTAC:	MOVEM	TB,EAC##		; STASH AS AC TO USE
	HRRZ	TA,OPRTR##+4		; GET RESULT LINK
	PUSHJ	PP,LNKSET		; SET UP LINK
	LDB	TC,DA.RSV		; get reserved word flag
	JUMPN	TC,PUTAC2		; is reserved word - check it out
	LDB	TC,DA.LHI##		; get look-ahead flag
	JUMPN	TC,PUTAC1		; thats a no-no too
	HRRZ	TC,OPRTR+1		; GET RESULTING INDICATORS
	JUMPE	TC,PTR2.2		; SKIP OVER CODE IF NONE
	LDB	TD,DA.SIZ		; GET SIZE OF FIELD
	MOVE	CH,[XWD SETZM.,1]	; GENERATE <SETZM 1>
	PUSHJ	PP,PUTASY		; THUSLY
	ADDI	CH,1			; MAKE IT INTO A <SETZM 2>
	CAIG	TD,^D10			; IS IT DOUBLE PRECISION?
	  PUSHJ	PP,PUTASY		; YES - PUT OUT SECOND SETZM
	CAIG	TD,^D10			; DOUBLE AGAIN?
	  SKIPA	CH,[XWD CMP.11,0]	; NO - GENERATE <CMP.11>
	MOVE	CH,[XWD CMP.22,0]	; YES - GENERATE <CMP.22>
	MOVE	TD,EAC			; GET AC FIELD
	LSH	TD,-5			; SHIFT IT AROUND
	HLR	CH,TD			; STICK IN OUTPUT WORD
	PUSHJ	PP,PUTASY		; OUTPUT APPROPRIATE INSTRUCTION
	PUSH	PP,TA			; SAVE DATAB POINTER
	MOVE	TA,TC			; GET INDTAB POINTER
	PUSHJ	PP,LNKSET		; SET IT UP
	MOVE	CH,[XWD AS.OCT,1]	; SET UP FOR OCTAL CONSTANT
	PUSHJ	PP,PUTASY		; OUTPUT HEADER
	LDB	TC,[POINT 8,(TA),7]	; SWAP > AND < BECAUSE WE MUST
	LDB	TD,[POINT 8,(TA),15]	;   DO THE COMPARISON IN REVERSE
	DPB	TC,[POINT 8,(TA),15]	;   ORDER DUE TO THE FACT THAT
	DPB	TD,[POINT 8,(TA),7]	;   CMP DOES NOT ACCEPT AN AC FIELD
	MOVE	CH,(TA)			; GET INDTAB WORD
	PUSHJ	PP,PUTASN		; OUTPUT TO ASYFIL
	POP	PP,TA			; RESTORE DATAB POINTER
	JRST	PTR2.2			; continue further on

PUTAC1:	GETLN;				; get the line number
	WARN	227;			; reserved word is literal or look-ahead
	POPJ	PP,			; exit

PUTAC2:	CAILE	TC,4			; is it one of the PAGE's?
	  JRST	PUTAC3			; no - error
	MOVE	CH,[XWD RSVWD.+ASINC,AS.CNB]
	PUSHJ	PP,PUTASY		; output it
	SETZ	CH,			; zap an AC
	TRO	CH,1B30			; say we are storing
	JRST	GTF.12+3		; finish up

PUTAC3:	GETLN;				; get the line number
	WARN	226;			; reserved word other than PAGE invalid
	POPJ	PP,			; exit
;PTRAC3 (CONT'D)
;DECIDE WHICH TYPE OF MOVE WE MUST DO

PTR2.2:	LDB	TC,DA.ARE		; IS IT AN ARRAY ENTRY?
	JUMPN	TC,PTR2.3		; MUST BE IF WE JUMPED
	PUSHJ	PP,GTFPT		; GET RESULT FIELD
	LDB	TD,DA.OCC		; GET NUMBER OF OCCURS
	JUMPN	TD,PTR2.4		; MUST BE WHOLE ARRAY OR TABLE
	TSWF	FWHOLE;			; whole array?
	  JRST	PTR2.4			; yes -
	CAIE	TC,2			; BINARY?
	JRST	PTR2.1			; NO -
	MOVE	CH,[XWD MOVEM.+ASINC,AS.MSC]
	ADD	CH,EAC			; GET AC
	PUSHJ	PP,PUTASY		; YES - CAN USE STRAIGHT MOVE
	LDB	CH,DA.COR		; GET CORE POINTER
	TRO	CH,AS.DAT		; FLAG AS DATAB RELATIVE
	PUSHJ	PP,PUTASN		; PUT OUT ADDRESS FIELD
	LDB	TC,DA.SIZ		; GET SIZE OF FIELD
	CAIGE	TC,^D10			; SINGLE PRECISION?
	  POPJ	PP,			; YES - EXIT
	PUSH	PP,CH			; NO - SAVE ADDRESS FIELD
	MOVE	CH,[XWD MOVEM.+ASINC,AS.MSC]
	ADD	CH,EAC			; ADD IN THE AC
	ADDI	CH,1			; BUT WE WANT AC+1
	PUSHJ	PP,PUTASY		; WE MUST DO DOUBLE MOVE
	POP	PP,CH			; GET BACK ADDRESS
	ADDI	CH,1			; INCREMENT ADDRESS BY 1
	PUSHJ	PP,PUTASN		; OUTPUT THE ADDRESS
	POPJ	PP,			; EXIT

GTFPT:	HRRZ	TA,OPRTR+4		; GET DATAB LINK
	PUSHJ	PP,LNKSET		; SET IT UP
	LDB	TC,DA.FLD		; GET FIELD TYPE
	LDB	TD,DA.SIZ		; GET SIZE
	JUMPN	TD,CPOPJ##		; EXIT IF FOUND
	PUSH	PP,TB			; SAVE TB
	LDB	TA,DA.NAM		; GET NAMTAB LINK
	MOVEI	TB,CD.DAT		; GET PLACE TO LOOK
	PUSHJ	PP,FNDLNK		; LOOK
	  JRST	GTFPT2			; NOT FOUND
	MOVE	TA,TB			; GET PROPER LINK
	POP	PP,TB			; RESTORE TB

GTFPT1:	LDB	TD,DA.SIZ		; GET SIZE
	LDB	TC,DA.FLD		; GET FIELD TYPE
	PJUMPN	TD,CPOPJ		; EXIT IF FOUND
	LDB	TA,DA.SNM		; GET LINK
	PJUMPE	TA,FNDFL1		; ERROR IF NONE
	PUSHJ	PP,LNKSET		; ELSE SET UP LINK
	JRST	GTFPT1			; AND LOOP

GTFPT2:	POP	PP,TB			; RESTORE TB
	PJRST	FNDFL1			; GO TYPE ERROR
;PTRAC3 (CONT'D)
;COME HERE IF WE MUST CONVERT FROM SIXBIT TO COMP
;

PTR2.1:	LDB	CH,DA.FMT		; GET FORMAT
	MOVE	CH,PTAB2(CH)		; GET THAT INSTRUCTION
	ADD	CH,EAC			; ADD IN PROPER AC
	MOVE	TA,OPRTR+4		; GET RESULT FIELD POINTER
	PUSHJ	PP,LNKSET		; SET IT UP
	LDB	TB,DA.SIZ		; GET SIZE OF RESULT
	CAILE	TB,^D10			; DOUBLE PRECISION?
	  JRST	PTR2.6			; [353] yes - make sure value in AC is
	MOVE	TB,OP2SIZ		; NO - IS NUMBER IN AC'S DOUBLE?
	CAILE	TB,^D10			; ?
	  ADD	CH,[XWD AC1,0]		; YES - USE LOW ORDER AC ONLY

PTR2.7:	PUSHJ	PP,PUTASY		; [353] output a PD6.
	MOVE	CH,ELITPC		; GET A LITAB POINTER
	TRO	CH,AS.LIT		; LITAB RELATIVE
	PUSHJ	PP,PUTASN		; OUTPUT
	PJRST	PUTPTR			; OUTPUT BYTE POINTER

PTR2.3:	SWON	FPUT;			; SAY WE'RE PUTTING
	PUSHJ	PP,PTR2.5		; CHECK FOR GODAMN AC0
	JRST	GTF.09			; GO DO IT

PTR2.4:	SWON	FPUT;			; PUT-PUT
	PUSHJ	PP,PTR2.5		; UGH
	JRST	GTF.10			; GO

PTR2.5:	MOVE	TC,EAC			; GET OUR AC
	CAIE	TC,AC5			; IS IT GODAMN AC5?
	  POPJ	PP,			; NO - HURRAH
	MOVE	CH,[XWD MOV+AC3,5]	; MOVE AC3_AC5
	PUSHJ	PP,PUTASY
	MOVE	CH,[XWD MOV+AC4,6]	; MOVE AC4_AC6
	PUSHJ	PP,PUTASY		; OUTPUT IT
	MOVE	TC,AC3			; GET AC3
	MOVEM	TC,EAC			; USE AAS NEW AC
	POPJ	PP,			; EXIT

PTR2.6:	MOVE	TB,OP2SIZ		; [353] get size of value in AC
	CAILE	TB,^D10			; [353] double precision?
	  JRST	PTR2.7			; [353] yes - 
	PUSH	PP,CH			; [353] no - must make it so: stash old value
	MOVE	CH,[XWD MULI.,AS.CNS+1]	; [353] get a <MULI AC,1>
	ADD	CH,EAC			; [353] load proper AC
	PUSHJ	PP,PUTASY		; [353] output instruction
	POP	PP,CH			; [353] restore current partial instruction
	JRST	PTR2.7			; [353] and continue...

PTAB1:	XWD	PD6.,AS.CNS+0
	XWD	PD7.,AS.CNS+0
	XWD	0,0

PTAB2:	XWD	PD6.+ASINC,AS.MSC
	XWD	PD7.+ASINC,AS.MSC
	XWD	0,0
;PTRAC5		ROUTINE TO MOVE RESULT FROM AC5 TO CORE
;
;
;

PTRAC5:	HRLZI	TB,AC5			; GET THAT AC
	MOVEM	TB,EAC			; STASH
	HRRZ	TA,OPRTR+2		; GET THIS
	JRST	PUTAC+2



;PTRAC1		Routine to move result from AC1 to core
;
;
;

PTRAC1:	HRLZI	TB,AC1			; get the AC
	JRST	PUTAC			; go do the rest elsewhere
;PUTPTR		OUTPUT BYTE POINTER TO ITEM IN TA
;		   (With size imbedded in ptr)
;
;

PUTPTR:	MOVE	CH,[XWDLIT,,2]		; JUST 1 XWD
	PUSHJ	PP,STASHC		; AND PUT IT IN LITAB
	SETZ	CH,			; START ANEW
	LDB	TC,DA.RES##		; GET BYTE RESIDUE
	DPB	TC,[POINT 6,CH,5]	; STASH IN WORD
	LDB	TC,DA.SIZ		; GET SIZE
	DPB	TC,[POINT 11,CH,17]	; STASH THAT TOO

PUTP:	HRRI	CH,AS.CNB		; MARK IT
	PUSHJ	PP,STASHC		; OUTPUT IT
	LDB	TC,DA.COR		; GET CORE ADDRESS
	HRLZ	CH,TC			; GET INTO PROPER AC
	TLO	CH,AS.DAT		; MARK AS DATAB RELATIVE
	HRRI	CH,AS.MSC		; GOOD OLD MARKER
	PUSHJ	PP,STASHC		; OUTPUT
	AOS	ELITPC			; BUMP COUNTER
	POPJ	PP,			; EXIT


;PUTPT2		Output byte pointer to item in TA with no size imbedded
;
;
;

PUTPT2:	MOVE	CH,[XWD XWDLIT,2]	; get LITAB header word
	PUSHJ	PP,STASHC		; output it
	SETZ	CH,			; zap word
	LDB	TC,DA.RES		; get byte residue
	DPB	TC,[POINT 6,CH,5]	; stash in pointer word
	LDB	TC,DA.FMT		; get format of field
	MOVE	TC,BYTAB(TC)		; get byte size
	DPB	TC,[POINT 6,CH,11]	; stash in pointer word
	JRST	PUTP			; and go finish up
;INDCHK		GENERATE CODE TO CHECK FOR PROPER INDICATORS
;
;
;

INDCHK:	TSWFZ	FINDON;			; DO WE NEED TO PUT OUT A TAG?
	PUSHJ	PP,FNDTAG		; YES - WELL DO SO TURKEY
	HLRZ	TA,OPRTR+1		; GET INDTAB LINK
	SKIPN	TA			; GOT ONE?
	POPJ	PP,			; NO - NO NEED FOR CHECK OR TAG NEXT TIME

	PUSHJ	PP,LNKSET##		; YES - SET UP LINK
	MOVE	CH,[XWD MOVEI.+AC16+ASINC,AS.MSC##]
	PUSHJ	PP,PUTASY		; OUTPUT THE UUO
	MOVE	CH,ELITPC##		; GET LITAB PC
	TRO	CH,AS.LIT##		; FLAG AS LITAB RELATIVE
	PUSHJ	PP,PUTASN		; OUTPUT THE ADDRESS FIELD

INDCK1:	MOVE	CH,[XWD OCTLIT,1]	; INDTAB WORDS ARE OCTAL CONSTANTS
	PUSHJ	PP,STASHC		; OUTPUT HEADER WORD
	MOVE	CH,(TA)			; GET INDTAB ENTRY	
	PUSHJ	PP,STASHC		; OUTPUT THAT TOO
	AOS	ELITPC			; BUMP LITAB PC	
	LDB	TB,ID.END##		; GET END FLAG
	ADDI	TA,1			; ALWAYS BUMP TA
	JUMPE	TB,INDCK1		; LOOP UNTIL WE FIND FLAG
	MOVE	CH,[XWD PUSHJ.+AC17+ASINC,AS.CNB]
	PUSHJ	PP,PUTASY		; OUTPUT PUSHJ
	MOVEI	CH,400013		; GET ADDRESS OF INDC. DISPATCH
	PUSHJ	PP,PUTASN		; OUTPUT THAT TOO
	PUSHJ	PP,BLDTAG		; GET A TAG
	MOVE	CH,CURPRO		; GET TABLE ADDRESS
	SUB	CH,PROLOC		; GET RELATIVE ADDRESS
	HRRZS	CH			; GET ONLY THE GOOD PARTS
	ADD	CH,[XWD JRST.,AS.PRO##]
	PUSHJ	PP,PUTASY		; JRST TO NEXT TAG IF CHECK FAILS
	SWON	FINDON;			; SWITCH ON TO REMEMBER
	POPJ	PP,			; EXIT
;CH.12		CHOOSE WHICH OPERAND TO USE FOR ARITHMETIC OP
;
;
;

CH.12:	MOVE	TB,OP1SIZ		; GET SIZE OF OPERAND 1
	MOVE	TC,OP2SIZ		; GET SIZE OF OPERAND 2
	CAILE	TB,^D10			; TEN DIGITS/WORD
	JRST	CH.12B			; IS A .2X
	CAILE	TC,^D10			; ANOTHER CHECK
	JRST	CH.12C			; IS A .12
	XCT	TAB.11(LN)		; IS A .11

CH.12A:	PUSHJ	PP,PUTASY		; OUTPUT IT
	POPJ	PP,			; AND EXIT

CH.12B:	CAILE	TC,^D10			; CHECK OP2
	JRST	CH.12D			; IS A .22
	XCT	TAB.21(LN)		; IS A .21
	JRST	CH.12A

CH.12C:	XCT	TAB.12(LN)		; GET INSTRUCTION
	JRST	CH.12A			; GO STASH IT

CH.12D:	XCT	TAB.22(LN)		; GET A .22
	JRST	CH.12A			; GO HUNTING

TAB.11:	MOVE	CH,[XWD AD+AC3,1]
	MOVE	CH,[XWD SUB.+AC3,1]
	PUSHJ	PP,MLC1C1
	MOVE	CH,[XWD DIV.11+AC3,1]
	MOVE	CH,[XWD CMP.11,3]
	MOVE	CH,[XWD MOVN.+AC3,3]
	MOVE	CH,[XWD CMP%11,3]

TAB.12:	MOVE	CH,[XWD ADD.21+AC3,1]
	MOVE	CH,[XWD SUB.21+AC3,1]
	MOVE	CH,[XWD MUL.21+AC3,1]
	MOVE	CH,[XWD DIV.12+AC3,1]	; [353]
	MOVE	CH,[XWD CMP.12,3]
	POPJ	PP,
	MOVE	CH,[XWD CMP%12,3]

TAB.21:	MOVE	CH,[XWD ADD.12+AC3,1]
	MOVE	CH,[XWD SUB.12+AC3,1]
	MOVE	CH,[XWD MUL.12+AC3,1]
	MOVE	CH,[XWD DIV.21+AC3,1]	; [353]
	MOVE	CH,[XWD CMP.21,3]
	PUSHJ	PP,ZSC2
	MOVE	CH,[XWD CMP%21,3]

TAB.22:	MOVE	CH,[XWD ADD.22+AC3,1]
	MOVE	CH,[XWD SUB.22+AC3,1]
	MOVE	CH,[XWD MUL.22+AC3,1]
	MOVE	CH,[XWD DIV.22+AC3,1]
	MOVE	CH,[XWD CMP.22,3]
	POPJ	PP,
	MOVE	CH,[XWD CMP%22,3]
;HANDLE MULTIPLICATION OF 1-WORD BY 1-WORD

MLC1C1:	ADD	TB,TC			; GET RESULT SIZE
	CAILE	TB,^D10			; FIT IN ONE WORD?
	SKIPA	CH,[XWD MUL.+AC3,1]	; NO - PUT IT IN TWO
	MOVE	CH,[XWD IMUL.+AC3,1]	; YES - LEAVE IT AS ONE
	POPJ	PP,			; POP BACK TO CA.12A


;HANDLE ZSUB OF DOUBLE PRECISION
;
;GENERATES THE FOLLOWING CODE:
;
;	SETCM	3,3			; TAKE ONES COMPLEMENT OF HIGH WORD
;	MOVN	4,4			; TAKE TWOS COMPLEMENT OF LOW WORD
;	HRLOI	5,377777		; GET TEST MASK
;	TDNN	4,5			; IF LOW PART IS ZERO.....
;	ADDI	3,1			; CHANGE HIGH PART TO TWO'S COMPLEMENT
;

ZSC2:	MOVE	CH,[XWD SETCM.+AC3,3]
	PUSHJ	PP,PUTASY		; OUT TO ASYFIL
	MOVE	CH,[XWD MOVN.+AC4,4]
	PUSHJ	PP,PUTASY		; ME TOO
	MOVE	CH,[XWD HRLOI.+AC0+ASINC,AS.CNB]
	PUSHJ	PP,PUTASY
	MOVEI	CH,377777		; MAGIC CONSTANT
	PUSHJ	PP,PUTASN		; STUFF IT
	MOVE	CH,[XWD TDNN.+AC4,5]
	PUSHJ	PP,PUTASY
	MOVE	CH,[XWD ADDI.+AC3,1]
	POPJ	PP,			; EXIT AND THEN STASH
;CHCONV		ROUTINE TO CHOOSE WHAT CONVERSION ROUTINE TO UTILIZE FOR MOVE
;
;
;

CHCONV:	MOVE	TB,OP1BSZ		; GET BYTE SIZE OF F1
	CAMN	TB,OP2BSZ		; SAME AS F2?
	  JRST	CHCNV1			; YES - USE REGULAR MOVE
	MOVE	TC,OP2BSZ		; GET BYTE SIZE OF F2
	XCT	CONTB1-6(TB)		; GET AN INSTRUCTION

CHCNV0:	PUSHJ	PP,PUTASY		; OUTPUT IT
	MOVE	CH,ELITPC		; GET LITAB PC
	TRO	CH,AS.LIT		; MARK WHO IT CAME FROM
	PJRST	PUTASN			; OUTPUT THAT TOO

CHCNV1:	MOVE	CH,[XWD MOVE.+ASINC,AS.MSC]
	JRST	CHCNV0			; OUTPUT STANDARD MOVE UUO

;DEFINE TABLES

CONTB1:	MOVE	CH,CONTB6-6(TC)		; F1 SIXBIT
	MOVE	CH,CONTB7-6(TC)		; F1 ASCII
	Z
	MOVE	CH,CONTB9-6(TC)		; F1 EBCDIC

CONTB6:	XWD	0,0
	XWD	CD6D7.+ASINC,AS.MSC	; F2 ASCII
	XWD	0,0
	XWD	CD6D9.+ASINC,AS.MSC	; F2 EBCDIC

CONTB7:	XWD	CD7D6.+ASINC,AS.MSC	; F2 SIXBIT
	XWD	0,0
	XWD	0,0
	XWD	CD7D9.+ASINC,AS.MSC	; F2 EBCDIC

CONTB9:	XWD	CD9D6.+ASINC,AS.MSC	; F2 EBCDIC
	XWD	CD9D7.+ASINC,AS.MSC	; F2 EBCDIC
	XWD	0,0
	XWD	0,0
;CHKNUM		ROUTINE TO SEE IF FACTOR IN OPRTR+4 IS NUMERIC
;
;CALL:	PUSHJ	PP,CHKNUM
;	  RET+1 IF NOT NUMERIC
;	  RET+2	IF NUMERIC
;
;

CHKNUM:	MOVE	TB,OPRTR+4		; GET POINTER
	TLNE	TB,1B20			; NUMERIC LITERAL?
	  AOSA	(PP)			; YES - TAKE SKIP RETURN
	TLNE	TB,1B19			; NO - IS IT ALPHA LIT?
	  POPJ	PP,			; YES - TAKE NON-SKIP RETURN
	MOVEI	TB,4			; GET INDEX
	PUSHJ	PP,GTFLD		; GET FIELD TYPE
	SKIPE	TC			; NUMERIC?
	  AOS	(PP)			; YES -
	POPJ	PP,			; NO - EXIT


;CHKNM2		ROUTINE TO SEE IF FACTOR IN OPRTR+3 IS NUMERIC
;
;CALL:	PUSHJ	PP,CHKNM2
;	  RET+1 IF NOT NUMERIC
;	  RET+2 IF NUMERIC
;
;

CHKNM2:	MOVE	TB,OPRTR+3		; GET INDEX
	TLNE	TB,1B20			; NUMERIC LITERAL?
	  AOSA	(PP)			; YES -
	TLNE	TB,1B19			; NO - IS IT ALPHA LIT?
	  POPJ	PP,			; YES - TAKE NON-SKIP RETURN
	MOVEI	TB,3			; GET INDEX
	PUSHJ	PP,GTFLD		; GET FIELD
	SKIPE	TC			; NUMERIC
	  AOS	(PP)			; YES -
	POPJ	PP,			; NO - EXIT
;GTFLD		GET FIELD TYPE
;
;
;

GTFLD:	HRRZ	TA,OPRTR(TB)		; GET LINK
	PUSHJ	PP,LNKSET		; SET IT
	LDB	TC,DA.SIZ		; GET SIZE
	JUMPE	TC,GTFLD1		; NOT DEFINED
	LDB	TC,DA.FLD		; GET FIELD TYPE
	POPJ	PP,			; EXIT

GTFLD1:	PUSH	PP,TB			; [064] STASH OPRTR INDEX IN CASE OF ERROR
	LDB	TA,DA.NAM##		; GET NAMTAB LINK
	MOVEI	TB,CD.DAT		; GET TABLE ID
	PUSHJ	PP,FNDLNK		; LOOK UP LINK
	  JRST	GTFLD4			; NOT FOUND - HUH?????
	MOVE	TA,TB			; [064] GET LINK INTO PROPER AC
	POP	PP,TB			; [064] RESTORE OPRTR INDEX

GTFLD2:	LDB	TC,DA.SIZ		; GET SIZE OF FIELD
	JUMPE	TC,GTFLD3		; NOT DEFINED
	LDB	TC,DA.FLD		; GET FIELD TYPE
	POPJ	PP,			; EXIT

GTFLD3:	HRRZ	TA,10(TA)		; get same name link (DA.SNM)
	JUMPE	TA,GTFLD4		; ERROR IF NOT ONE
	PUSHJ	PP,LNKSET		; SET LINK
	JRST	GTFLD2			; LOOP

GTFLD4:	GETLN;				; GET LINE NUMBER
	CAIN	TB,3			; WHICH ONE?
	  JRST	.+3			; F2
	WARN	704;			; FACTOR 1 NOT DEFINED
	  CAIA				; FAST SKIP
	WARN	705;			; FACTOR 2 NOT DEFINED
	POP	PP,TA			; POP OFF ONE ADDRESS
	POPJ	PP,			; THE LONG EXIT
;MAKTAG	SET UP A TAG NAME IN NAMWRD
;
;

MAKTAG:	MOVE	TB,[POINT 3,TAGNUM##,26]; POINTER TO TAG NUMBER
	SETZ	TC,			; ZAP SUMMER
	ILDB	CH,TB			; GET A DIGIT
	LSH	TC,6			; MAKE ROOM FOR DADDY
	ADDI	TC,'0'(CH)		; ADD IN NEW DIGIT
	TLNE	TB,770000		; ALL DONE?
	JRST	MAKTAG+2		; NOPE - LOOP

MAKTG1:	HRLI	TC,'%'			; YES - GIVE HIM A PERCENTAGE
	LSH	TC,^D12			; LEFT JUSTIFY
	MOVEM	TC,NAMWRD##		; STASH
	SETZM	NAMWRD+1		; ZAP
	POPJ	PP,			; EXIT
;FNDTAG		LOOKUP AND GENERATE TAG
;
;
;

FNDTAG:	PUSHJ	PP,MAKTAG		; MAKE A TAG
	PUSHJ	PP,TRYNAM##		; LOOK IT UP
	  JRST	TAGX			; WHAT THE HELL???
	MOVEI	TB,CD.PRO		; FOR FEW KNOW THEIR TRUE NAME
	MOVSS	TA			; GET RELATIVE POINTER INTO RH
	PUSHJ	PP,FNDLNK##		; GET THAT LINK
	  JRST	TAGX			; BOMBO AGAIN....
	MOVE	TA,TB			; GET INTO USUAL AC
	TSWT	FAS3;			; ARE WE USING AS3FIL YET?
	SKIPA	TC,EAS2PC		; NO - USE EAS2PC
	MOVE	TC,EAS3PC		; YES - USE IT THEN
	DPB	TC,PR.LNK##		; STASH AS CORE LINK
	HRRZ	CH,PROLOC##		; GET THE GOOD STUFF
	SUB	TB,CH			; MAKE INTO RELATIVE POINTER
	MOVE	CH,TB			; AND BACK TO CORRECT AC
	ADD	CH,[XWD AS.PN##,AS.PRO]	; MAKE INTO TAG DEFINITION
	PUSHJ	PP,PUTASN		; OUTPUT IT
	MOVEI	TB,1			; GET A BUMPER
	ADDB	TB,TAGNUM		; AND BUMP WITH IT
	CAIG	TB,777			; ALL OK??
	  POPJ	PP,			; YEP ---

	MSG	<?RPGTMT Too many tags generated internally, max. of 1024 exceeded.
>
	JRST	KILL##			; GO DIE GRACEFULLY

TAGX:	OUTSTR	[ASCIZ "?Tag created then lost, God doesn't like us
"]
	JRST	KILL			; MOST DECIDEDLY FATAL I'M AFRAID
;BLDTAG		BUILD A PROTAB ENTRY FOR A TAG
;
;
;

BLDTAG:	PUSHJ	PP,MAKTAG		; MAKE A TAG
	PUSHJ	PP,TRYNAM		; IS IT IN NAMTAB?
	  PUSHJ	PP,BLDNAM##		; NO - WELL PUT IT THERE
	MOVEM	TA,CURNAM##		; STASH NAMTAB POINTER
	MOVE	TA,[XWD CD.PRO,SZ.PRO]	; SHOW HIM THE PRETTY MARKS, BROTHERS
	PUSHJ	PP,GETENT##		; OL' CHARLTON WILL NEVER LEARN
	HRRZM	TA,CURPRO##		; STASH PROTAB LINK TOO
	MOVS	TB,CURNAM		; GET BACK NAMTAB LINK
	DPB	TB,PR.NAM##		; STASH IN PROTAB
	MOVEI	TB,CD.PRO		; GET THE MARK
	DPB	TB,PR.ID##		; AND MARK HIM FOR LIFE
	SETZ	TB,			; ASSUME EAS2PC RELATIVE
	TSWF	FAS3;			; CORRECT ASSUMPTION?
	MOVEI	TB,1			; NOPE - EAS3PC RELATIVE
	DPB	TB,PR.SEG##		; FLAG SEGMENT TYPE
	POPJ	PP,			; AND GET THE HELL OUT OF HERE
;NOTNUM		OUTPUT "ITEM NOT NUMERIC" ERROR MESSAGE
;
;
;

NOTNUM:	LDB	TC,[POINT 13,OPRTR,28]	; GET LINE NUMBER
	MOVEM	TC,SAVELN##		; STASH IT FOR WARN
	WARN	207;			; AND WARN 'EM
	POPJ	PP,			; THE CARRY ON AS USUAL



;FNDFLD		LOOKUP FIELD
;
;
;

FNDFLD:	LDB	TB,DA.SIZ		; GET SIZE
	JUMPN	TB,NOTNUM		; IF WE HAVE ONE, FIELD IS WRONG TYPE
	HRRZ	TA,10(TA)		; else get same name link (DA.SNM)
	JUMPE	TA,FNDFL1		; RESULT NOT DEFINED
	PUSHJ	PP,LNKSET		; SET UP LINKS
	LDB	TB,DA.FLD		; GET FIELD TYPE
	JUMPE	TB,FNDFLD		; IF ZERO, KEEP ON TRYING
	MOVE	TB,TA			; GET LINK
	SUB	TB,DATLOC##		; MAKE INTO REAL
	IORI	TB,<CD.DAT>B20		; IN CASE OTHERS NEED
	HRRZM	TB,OPRTR+4		; THE SAME LINK
	POPJ	PP,			; AND EXIT

FNDFL1:	GETLN;				; get the line number
	WARN	707;			; RESULT FIELD NOT DEFINED
	HRRZ	TA,OPRTR+4		; GET BACK ORIGINAL LINK
	PUSHJ	PP,LNKSET		; SET IT UP
	POPJ	PP,			; AND EXIT

;BINC		INCREMENT BYTE POINTER IN CH, TC TIMES
;
;
;

BINC:	IBP	CH			; BUMP POINTER
	SOJN	TC,.-1			; LOOP UNTIL DONE
	POPJ	PP,			; EXIT WHEN WE ARE DONE
;SWPOP		SWAP OPERAND INFORMATION
;SWPIND		SWAP HIGH AND LOW INDICATORS
;
;
;

SWPOP:	SETZ	TB,			; START AT THE END
	MOVE	TC,@SWP1(TB)		; GET A OP1 ITEM
	MOVE	TD,@SWP2(TB)		; GET A OP2 ITEM
	MOVEM	TC,@SWP2(TB)		; STASH OP1 ITEM AS OP2 ITEM
	MOVEM	TD,@SWP1(TB)		; DO THE SAME FOR OP2 ITEM
	ADDI	TB,1			; BUMP POINTER
	SKIPE	(TB)			; END OF TABLE?
	JRST	SWPOP+1			; NO - LOOP

SWPIND:	HLRZ	TA,OPRTR+2		; GET INDICATORS LINK
	PUSHJ	PP,LNKSET		; SET UP LINK
	LDB	TB,[POINT 8,(TA),7]	; GET HIGH INDICATOR
	LDB	TC,[POINT 8,(TA),15]	; GET LOW INDICATOR
	DPB	TC,[POINT 8,(TA),7]	; STASH LOW AS HIGH
	DPB	TB,[POINT 8,(TA),15]	; STASH HIGH AS LOW
	POPJ	PP,			; EXIT

SWP1:	EXP	OPRTR+3
	EXP	OP1SIZ
	EXP	OP1BYT
	EXP	OP1BSZ
	EXP	0

SWP2:	EXP	OPRTR+4
	EXP	OP2SIZ
	EXP	OP2BYT
	EXP	OP2BSZ
;STBYT1		SET UP BYTE POINTER TO OPERAND 1
;
;NOTE SPECIAL REGISTER DEFINITION
;
;

	TF==TE-1
	TG==TF-1

STBYT1:	MOVE	TF,OPRTR+3		; GET OP1 INFO
	MOVE	TG,OPRTR+4		; LIKEWISE
	TLNE	TF,1B19			; IS OP1 A LITERAL?
	  JRST	SBYT1A			; YEP -
	HRRZ	TA,OPRTR+3		; GET DATAB LINK
	PUSHJ	PP,LNKSET		; SET UP THAT LINK
	LDB	TB,DA.ARE		; GET ARRAY ENTRY FLAG
	JUMPN	TB,SBYT1G		; IS ARRAY IF WE JUMP
	PUSHJ	PP,FNDRES		; find real field
	LDB	TB,DA.RSV		; get reserved word flag
	JUMPN	TB,SBYTRS		; it is reserved word - error
	LDB	TB,DA.OCC		; GET NUMBER OF OCCURANCES
	JUMPN	TB,SBYT1F		; IF WE JUMP MUST BE TABLE OR WHOLE ARRAY
SBYT1:	LDB	TB,DA.FMT##		; GET FORMAT
	MOVE	TC,BYTAB(TB)		; GET BYTE SIZE
	MOVEM	TC,OP1BSZ##		; STASH
	LDB	CH,DA.COR		; GET CORE POINTER
	TRO	CH,AS.DAT		; DATAB RELATIVE
	LDB	TD,DA.RES		; GET BYTE RESIDUE
	DPB	TD,[POINT 6,CH,5]	; STASH RESIDUE
	DPB	TC,[POINT 5,CH,11]	; STASH BYTE SIZE
	MOVEM	CH,OP1BYT##		; STASH BYTE POINTER
	LDB	TC,DA.SIZ		; GET SIZE OF FIELD
	MOVEM	TC,OP1SIZ		; STASH
	LDB	TC,DA.DEC		; get decimal positions
	MOVEM	TC,OP1DEC		; save
	POPJ	PP,			; EXIT

BYTAB:	DEC	6			; SIXBIT
	DEC	7			; ASCII
	DEC	9			; EBCDIC


SBYT1F:	LDB	TC,DA.NAM		; GET NAMTAB LINK
	ADD	TC,NAMLOC		; MAKE INTO REAL POINTER
	HLRZ	TC,1(TC)		; GET FIRST THREE CHARACTERS
	CAIE	TC,'TAB'		; IS IT A TABLE?
	  SWONS	FOP1WL;			; NO FLAG AS WHOLE ARRAY
	SWON	FOP1TB;			; YES - FLAG AS SUCH
	JRST	SBYT1			; CONTINUE

SBYT1G:	SWON	FOP1AR;			; FLAG AS ARRAY
	MOVEI	TB,3			; GET INDEX
	PUSHJ	PP,GTFLD		; GET FIELD INFORMATION
	JRST	SBYT1			; CONTINUE
;STBYT1 (CONT'D)	HANDLE LITERAL BYTE POINTER

SBYT1A:	TLNE	TG,1B19			; OP2 A LITERAL TOO?
	  JRST	SBYT1B			; YES - USE SIXBIT
;	MOVEI	TB,4			; NO - GET OP2 INDEX
;	PUSHJ	PP,GTFLD		; GET FIELD POINTER
;	LDB	TB,DA.FMT		; GET FORMAT
;	MOVE	TC,BYTAB(TB)		; GET BYTE SIZE
;	CAIN	TC,^D9			; IS EBCDIC?

SBYT1B:	  MOVEI	TC,6			; YES - USE SIXBIT
	MOVEM	TC,OP1BSZ		; NO - STASH BYTE SIZE
	MOVE	CH,ELITPC		; GET LITAB PC
	TRO	CH,AS.LIT		; LITAB RELATIVE
	MOVEI	TD,^D42			; THE MAGIC NUMBER
	SUB	 TD,TC			; GET BYTE OFFSET
	DPB	TD,[POINT 6,CH,5]	; STASH OFFSET
	DPB	TC,[POINT 5,CH,11]	; STASH SIZE
	MOVEM	CH,OP1BYT		; STASH BYTE POINTER
	HRRZ	TA,TF			; GET POINTER TO OP1
	PUSHJ	PP,LNKSET		; SET UP VALTAB LINK
	HRRZ	TB,TA			; GET ADDRESS
	ADD	TB,[POINT 7,0]		; MAKE INTO BYTE POINTER
	ILDB	CH,TB			; GET CHARACTER COUNT
	SUBI	CH,1			; account for the back-arrow terminator
	MOVEM	CH,OP1SIZ		; STASH
	HLLO	LN,OPRTR+3		; get flags
	PUSHJ	PP,SBYT1E		; output literal
	TLNN	LN,1B20			; was that numeric literal?
	  POPJ	PP,			; no -exit
	HRRZS	LN			; yes - get count
	SETZM	OP1DEC			; clear it
	CAIN	LN,777777		; did we see a point?
	  POPJ	PP,			; no -
	SOS	TB,OP1SIZ		; decrement to allow for decimal point
	SUB	TB,LN			; get decimal count
	MOVEM	TB,OP1DEC		; save
	POPJ	PP,			; and exit
;STBYT1 (CONT'D)	COMMON PORTION OF LITERAL SETUP

SBYT1E:	MOVE	TD,CH			; GET COUNT INTO TD
	IDIV	CH,TC			; GET NUMBER OF WORDS
	JUMPE	CH+1,.+2		; REMAINDER?
	  ADDI	CH,1			; YES - ROUND UP
	HRLZI	TA,SIXLIT		; DEFAULT TO SIXBIT
	CAIE	TC,6			; DO WE WANT ASCII?
	  HRLZI	TA,ASCLIT		; YES - GET IT
	HRR	TA,CH			; STASH WORD COUNT
	PUSHJ	PP,STASHL		; STASH WHOLE THING IN LITAB
	ADDM	CH,ELITPC		; BUMP LITAB PC
	MOVE	TE,[POINT 6,TA]		; GET A POINTER
	CAIE	TC,6			; IS SIXBIT?
	  MOVE	TE,[POINT 7,TA]		; NO - GET ASCII POINTER
	SETZ	TA,			; START FRESH

SBYT1C:	ILDB	CH,TB			; GET A CHAR
	TLNN	LN,1B20			; numeric literal?
	  JRST	SBYT1H			; no 
	CAIE	CH,"."			; yes - is this a decimal point?
	  JRST	SBYT1H			; no -
	HRRM	TD,LN			; yes save the count
	SOJE	TD,SBYT1D		; see if any left
	JRST	SBYT1C			; ignore the decimal point

SBYT1H:	CAIN	TC,6			; IS ASCII OK?
	  SUBI	CH,40			; NO - CONVERT TO SIXBIT
	IDPB	CH,TE			; STASH
	SOJE	TD,SBYT1D		; EXIT IF ALL DONE
	TLNE	TE,760000		; HAVE WE FILLED TA YET?
	  JRST	SBYT1C			; NO - LOOP
	PUSHJ	PP,STASHL		; YES - OUTPUT TO LITAB
	JRST	SBYT1C-4		; TAKE THE BIG LOOP

SBYT1D:	PUSHJ	PP,STASHL		; DON'T FORGET THE LAST WORD
	POPJ	PP,			; EXIT

SBYTRS:	GETLN;				; get the line number
	WARN	207;			; all reserved words are numeric
	POPJ	PP,			; exit
;STBYT2		ROUTINE TO SET UP BYTE POINTER FOR OPERAND 2
;
;
;

STBYT2:	MOVE	TF,OPRTR+4		; GET OP2 LINKS
	MOVE	TG,OPRTR+3		; GET OP1 LINKS
	TLNE	TF,1B19			; OP2 A LITERAL?
	  JRST	SBYT2A			; YES - GO PROCESS
	HRRZ	TA,OPRTR+4		; GET DATAB LINK
	PUSHJ	PP,LNKSET		; SET IT UP
	LDB	TB,DA.ARE		; GET ARRAY ENTRY FLAG
	JUMPN	TB,SBYT2C		; IS ARRAY ENTRY
	PUSHJ	PP,FNDRES		; find real data item
	LDB	TB,DA.RSV		; get reserved word flag
	JUMPN	TB,SBYTRS		; error if it is
	LDB	TB,DA.OCC		; GET NUMBER OF OCCURANCES
	JUMPN	TB,SBYT2D		; IS EITHER TABLE OR WHOLE ARRAY
SBYT2:	LDB	TB,DA.FMT		; GET FORMAT
	MOVE	TC,BYTAB(TB)		; GET BYTE SIZE
	MOVEM	TC,OP2BSZ		; STASH
	LDB	CH,DA.COR		; GET CORE POINTER
	TRO	CH,AS.DAT		; RELATIVE TO DATAB
	LDB	TD,DA.RES		; GET BYTE RESIDUE
	DPB	TD,[POINT 6,CH,5]	; STASH IN POINTER
	DPB	TC,[POINT 5,CH,11]	; STASH SIZE TOO
	MOVEM	CH,OP2BYT##		; STASH POINTER
	LDB	TC,DA.SIZ		; GET SIZE
	MOVEM	TC,OP2SIZ		; STORE
	LDB	TC,DA.DEC		; get decimal positions
	MOVEM	TC,OP2DEC		; save it
	POPJ	PP,			; EXIT


SBYT2C:	SWON	FOP2AR;			; SET ARRAY FLAG
	MOVEI	TB,4			; GET ENTRY INDEX
	PUSHJ	PP,GTFLD		; GET THAT FIELD
	JRST	SBYT2			; CONTINUE

SBYT2D:	LDB	TC,DA.NAM		; GET NAMTAB LINK
	ADD	TC,NAMLOC		; MAKE REAL
	HLRZ	TC,1(TC)		; GET FIRST 3
	CAIE	TC,'TAB'		; IS IT A TABLE?
	  SWONS	FOP2AR;			; FLAG WHOLE ARRAY AS ARRAY
	SWON	FOP2TB;			; YES - SET FLAG
	JRST	SBYT2
;STBYT2 (CONT'D)	SET UP LITERAL BYTE POINTER

SBYT2A:	TLNE	TG,1B19			; IS OP1 A LITERAL ALSO?
	  JRST	SBYT2B			; YES - ASSUME 6IXBIT
;	MOVEI	TB,3			; GET OP1 INDEX
;	PUSHJ	PP,GTFLD		; GET FIELD POINTER
;	LDB	TB,DA.FMT		; GET FORMAT
;	MOVE	TC,BYTAB(TB)		; GET BYTE SIZE
;	CAIN	TC,^D9			; EBCDIC?
SBYT2B:	  MOVEI	TC,6			; YES - ASSUME SIXBIT
	MOVEM	TC,OP2BSZ##		; STASH AS BYTE SIZE
	MOVE	CH,ELITPC		; GET LITAB PC
	TRO	CH,AS.LIT		; MEN CALL ME LITAB
	MOVEI	TD,^D42			; LET'S HEAR IT FOR 36 BIT MACHINES
	SUB	TD,TC			; GET BYTE OFFSET
	DPB	TD,[POINT 6,CH,5]	; STASH OFFSET IN POINTER
	DPB	TC,[POINT 5,CH,11]	; STASH BYTE SIZE
	MOVEM	CH,OP2BYT##		; STASH POINTER WHERE WE CAN FIND IT LATER
	MOVE	TA,TF			; GET OP2 LINK
	PUSHJ	PP,LNKSET		; SET UP LINK
	HRRZ	TB,TA			; GET ADDRESS FIELD
	ADD	TB,[POINT 7,0]		; MAKE INTO BYTE POINTER
	ILDB	CH,TB			; GET SIZE
	SUBI	CH,1			; remember the back-arrow
	MOVEM	CH,OP2SIZ		; STASH SIZE
	HLLO	LN,OPRTR+3		; get flags
	PUSHJ	PP,SBYT1E		; use common routine
	TLNN	LN,1B20			; numeric?
	  POPJ	PP,			; No - exit
	HRRZS	LN			; yes - get count
	SETZM	OP2DEC			; zap
	CAIN	LN,777777		; did we see a decimal point?
	  POPJ	PP,			; no
	SOS	TB,OP2SIZ		; decrement size to account for decimal point
	SUB	TB,LN			; get decimal positions
	MOVEM	TB,OP2DEC		; save
	POPJ	PP,			; and exit
;BPTRSZ		ROUTINE TO OUTPUT DUAL BYTE POINTERS WITH SIZE IN SECOND
;
;ENTER WITH SIZE IN TB
;
;

BPTRSZ:	TSWT	FOP1WL;			; IF OP1 A WHOLE ARRAY?
	TSWF	FOP1AR;			; IS OP1 AN ARRAY?
	  JRST	.BPTG			; LOOKS THAT WAY
	TSWF	FOP1TB;			; A TABLE?
	  JRST	.BPTH			; YEP
	SKIPN	OP1BYT			; do we have one?
	  PUSHJ	PP,BYTZ			; no - returns +4
	MOVE	CH,[XWD BYTLIT,2]	; NO - OUTPUT REGULAR POINTER TO LITAB
	PUSHJ	PP,STASHC		; OUTPUT
	MOVE	CH,[XWD AS.BYT,AS.MSC]	; GET ASYFIL HEADER
	PUSHJ	PP,STASHC		; OUTPUT
	MOVE	CH,OP1BYT		; GET POINTER
	PUSHJ	PP,STASHC		; OUTPUT
	MOVE	CH,ELITPC		; GET LITAB PC
	MOVEM	CH,OP1LIT		; SAVE FOR OTHERS
	AOS	ELITPC			; UPDATE LITAB PC

.BPTA:	TSWT	FWHOLE;			; IS OP2 WHOLE ARRAY?
	TSWF	FOP2AR;			; OP2 AN ARRAY?
	  PJRST	.BPTE			; YES -
	TSWF	FOP2TB;			; NO - TABLE?
	  PJRST	.BPTF			; YES -
	SKIPN	OP2BYT			; got one?
	  PUSHJ	PP,BYTZ			; no -
	MOVE	CH,[XWD BYTLIT,2]	; GET LITAB HEADER
	PUSHJ	PP,STASHC		; OUTPUT
	MOVE	CH,[XWD AS.BYT,AS.MSC]	; GET ASYFIL HEADER
	PUSHJ	PP,STASHC		; OUTPUT
	MOVE	CH,OP2BYT		; GET BYTE POINTER
	DPB	TB,[POINT 11,CH,17]	; STASH SIZE IN POINTER
	PUSHJ	PP,STASHC		; OUTPUT IT
	MOVE	CH,ELITPC		; GET PC
	MOVEM	CH,OP2LIT		; SAVE
	AOS	ELITPC			; BUMP PC
	POPJ	PP,			; EXIT

.BPTG:	PUSHJ	PP,.BPTB		; SET UP OP1 POINTER
	JRST	.BPTA			; CONTINUE WITH OP2

.BPTH:	PUSHJ	PP,.BPTD		; SET UP OP1 POINTER TO TABLE
	JRST	.BPTA			; CONTINUE
;BPTRSZ (CONT'D)
;
;.BPTB		OUTPUT ARRAY POINTER TO OP1
;
;

.BPTB:	HRRZ	TA,OPRTR+3		; GET DATAB LINK
	PUSHJ	PP,LNKSET		; SET UP THE LINKS
	PUSH	PP,TB			; SAVE SIZE FIELD
	TSWF	FOP1WL;			; OP1 WHOLE ARRAY?
	  PUSHJ	PP,GTBYTB		; YES  - THIS CALL RETURNS +2
	PUSHJ	PP,GTBYTA		; GENERATE CODE TO GET POINTER INTO AC0
	MOVE	TB,ELITPC		; GET LITAB PC
	MOVEM	TB,OP1LIT##		; SAVE FOR OTHERS

.BPTC:	SWOFF	FWZARD;			; MAKE SURE
	MOVE	CH,[XWD MOVEM.+AC0+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; GENERATE <MOVEM 0,%LIT>
	MOVE	CH,TB			; GET PC
	TRO	CH,AS.LIT		; MARK MY WORDS WELL
	PUSHJ	PP,PUTASN		; OUTPUT ADDRESS
	MOVE	CH,[XWD OCTLIT,1]	; GET LITAB HEADER
	PUSHJ	PP,STASHC		; OUTPUT
	SETZ	CH,			; CONSTANT OF ZERO
	PUSHJ	PP,STASHC		; OUTPUT
	AOS	ELITPC			; BUMP PC
	POP	PP,TB			; RESTORE COUNT
	POPJ	PP,			; EXIT


;.BPTD		ROUTINE TO OUTPUT TABLE POINTER TO OP1
;

.BPTD:	HRRZ	TA,OPRTR+3		; GET DATAB LINK
	PUSHJ	PP,LNKSET		; SET IT UP
	PUSH	PP,TB			; SAVE TB
	SWON	FWZARD;			; REASONS FOR THIS MAY BE FOUND IN
					; "OF EVILL SORCERIES DONE IN NEW-ENGLAND OF
;					; DAEMONS IN NO HUMANE SHAPE"
	PUSHJ	PP,GTF.10+2		; CHEAT!
	MOVE	TB,ELITPC		; GET LITAB PC
	MOVEM	TB,OP1LIT		; STORE FOR OTHERS
	PJRST	.BPTC			; CONTINUE
;BPTRSZ (CONT'D)
;
;.BPTE		ROUTINE TO OUTPUT ARRAY POINTER TO OP2
;
;

.BPTE:	PUSHJ	PP,.BPTJ		; SET UP LOCATION
	HRRZ	TA,OPRTR+4		; GET POINTER
	PUSHJ	PP,LNKSET		; SET IT
	PUSH	PP,TB			; STASH SIZE
	PUSHJ	PP,GTBYTA		; OUTPUT POINTER

.BPTI:	TSWFZ	FINC;			; must we generate increment code?
	  PUSHJ	PP,BNCGN4		; yes - go do it
	MOVE	CH,[XWD TLZ.+AC0,AS.CNS+3777]
	PUSHJ	PP,PUTASY		; GENERATE <TLZ 0,3777> TO CLEAR SIZE AREA
	POP	PP,CH			; GET SIZE OFF STACK
	HRLI	CH,<TLO.+AC0>		; MAKE A <TLO 0,SIZE>
	PUSHJ	PP,PUTASY		; OUTPUT IT

.BPTK:	SWOFF	FWZARD;			; OFF
	MOVE	CH,[XWD MOVEM.+AC0+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT IT
	MOVE	CH,OP2LIT		; GET OP2 BYTE POINTER LOC
	TRO	CH,AS.LIT		; IS IN LITAB
	PJRST	PUTASN			; OUTPUT AND EXIT

.BPTJ:	MOVE	TC,ELITPC		; GET LITAB PC
	MOVEM	TC,OP2LIT##		; STORE FOR OTHERS
	MOVE	CH,[XWD OCTLIT,1]	; ONE OCTAL LITERAL COMING UP
	PUSHJ	PP,STASHC		; OUTPUT
	SETZ	CH,			; LITERAL IS ZERO
	AOS	ELITPC			; BUMP PC
	PJRST	STASHC			; OUTPUT AND EXIT


;.BPTF		OUTPUT TABLE POINTER TO OP2
;
;

.BPTF:	PUSHJ	PP,.BPTJ		; SET UP POINTER IN LITAB
	HRRZ	TA,OPRTR+4		; GET DATAB POINTER
	PUSHJ	PP,LNKSET		; SET IT UP
	PUSH	PP,TB			; SAVE COUNT
	SWON	FWZARD;			; ABRACADABRA
	PUSHJ	PP,GTF.10+2		; GO CHEAT A BIT
	PJRST	.BPTI			; GO FINISH UP CODE
;BPTR		ROUTINE TO OUTPUT TWO BYTE POINTERS
;
;
;

BPTR:	TSWT	FOP1WL;			; OP1 WHOLE ARRAY?
	TSWF	FOP1AR;			; OP1 ARRAY?
	  JRST	.BPTRA			; YES -
	TSWF	FOP1TB;			; NO - TABLE?
	  JRST	.BPTRC			; YES -
	SKIPN	OP1BYT			; got one?
	  PUSHJ	PP,BYTZ			; no -
	MOVE	CH,[XWD BYTLIT,2]	; NO - GET LITAB HEADER
	PUSHJ	PP,STASHC		; OUTPUT
	MOVE	CH,[XWD AS.BYT,AS.MSC]	; GET ASYFIL HEADER
	PUSHJ	PP,STASHC		; OUTPUT
	MOVE	CH,OP1BYT		; GET BYTE POINTER
	PUSHJ	PP,STASHC		; OUTPUT
	MOVE	CH,ELITPC		; GET PC
	MOVEM	CH,OP1LIT		; SAVE FOR OTHER ROUTINES
	AOSA	ELITPC			; BUMP LITAB PC
.BPTRA:	  PUSHJ	PP,.BPTB		; GO OUTPUT ARRAY POINTER

.BPTRB:	TSWT	FWHOLE;			; OP2 WHOLE ARRAY?
	TSWF	FOP2AR;			; OP2 ARRAY?
	  PJRST	.BPTRD			; YES -
	TSWF	FOP2TB;			; NO - TABLE?
	  PJRST	.BPTRE			; YES -
	SKIPN	OP2BYT			; got one?
	  PUSHJ	PP,BYTZ			; no -
	MOVE	CH,[XWD BYTLIT,2]	; NO - GET STANDARD LITAB HEADER
	PUSHJ	PP,STASHC		; OUTPUT IT
	MOVE	CH,[XWD	AS.BYT,AS.MSC]	; GET ASYFIL HEADER
	PUSHJ	PP,STASHC		; OUTPUT IT
	MOVE	CH,OP2BYT		; GET BYTE POINTER
	PUSHJ	PP,STASHC		; OUTPUT IT
	MOVE	CH,ELITPC		; GET PC
	MOVEM	CH,OP2LIT		; SAVE
	AOS	ELITPC			; BUMP PC
	POPJ	PP,			; EXIT

.BPTRC:	PUSHJ	PP,.BPTD		; GO OUTPUT TABLE POINTER
	JRST	.BPTRB			; CONTINUE WITH OP2

.BPTRD:	PUSHJ	PP,.BPTJ		; output LITAB header
	HRRZ	TA,OPRTR+4		; get link
	PUSHJ	PP,LNKSET		; set the links
	PUSHJ	PP,GTBYTA		; get pointer in AC0
	PJRST	.BPTK			; and move to byte pointer

.BPTRE:	PUSHJ	PP,.BPTJ		; setup LITAB location
	HRRZ	TA,OPRTR+4		; get link
	PUSHJ	PP,LNKSET		; set up those linkers
	SWON	FWZARD;			; invoke
	PUSHJ	PP,GTF.10+2		; cheat and steal a routine
	PJRST	.BPTK			; output pointer and exit
;GTBP15		Routine to get byte pointer to OP1 into AC0
;
;
;

GTBP15:	TSWT	FOP1WL;			; whole array?
	TSWF	FOP1AR;			; array?
	  PJRST	GT15.1			; yes - one or the other
	TSWF	FOP1TB;			; table?
	  PJRST	GT15.2			; yes -
	SKIPN	OP1BYT			; have one?
	  PUSHJ	PP,BYTZ			; no -
	MOVE	CH,[XWD BYTLIT,2]	; get LITAB header
	PUSHJ	PP,STASHC		; output it
	MOVE	CH,[XWD AS.BYT,AS.MSC]	; get secondary header
	PUSHJ	PP,STASHC		; output
	MOVE	CH,OP1BYT		; get that byte pointer
	PUSHJ	PP,STASHC		; output it to litab
	MOVE	CH,ELITPC		; get tha PC
	MOVEM	CH,OP1LIT		; save for others
	AOS	ELITPC			; bump the PC
	MOVE	CH,[XWD MOV+AC0+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; generate code to move it to AC0
	MOVE	CH,OP1LIT		; get that litab loc
	IORI	CH,AS.LIT		; identify
	PJRST	PUTASN			; output and exit

GT15.1:	HRRZ	OPRTR+3			; get link
	PUSHJ	PP,LNKSET		; set it up
	TSWF	FOP1WL;			; whole array?
	  PUSHJ	PP,GTBYTB		; yes - this returns +2
	PJRST	GTBYTA			; no -
	POPJ	PP,			; needed for GTBYTB return

GT15.2:	HRRZ	TA,OPRTR+3		; get that link
	PUSHJ	PP,LNKSET		; set it up
	SWON	FWZARD;			; invoke
	PUSHJ	PP,GTF.10+2		; steal the routine
	SWOFF	FWZARD;			; de-invoke
	POPJ	PP,			; and exit
;GTBP25		Routine to get byte pointer to OP2 into AC0
;
;
;

GTBP25:	TSWT	FWHOLE;			; whole array?
	TSWF	FOP2AR;			; array?
	  PJRST	GT25.1			; yes -
	TSWF	FOP2TB;			; table?
	  PJRST	GT25.2			; yes -
	SKIPN	OP2BYT			; got one
	  PUSHJ	PP,BYTZ			; no -
	MOVE	CH,[XWD BYTLIT,2]	; get LITAB header
	PUSHJ	PP,STASHC		; output
	MOVE	CH,[XWD AS.BYT,AS.MSC]	; get secondary header
	PUSHJ	PP,STASHC		; output
	MOVE	CH,OP2BYT		; and get the byte pointer
	PUSHJ	PP,STASHC		; output it
	MOVE	CH,[XWD MOV+AC0+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; output MOVE
	MOVE	CH,ELITPC		; get literal location
	MOVEM	CH,OP2BYT		; save for other
	IORI	CH,AS.LIT		; identify
	AOS	ELITPC			; must do this
	PJRST	PUTASN			; output it

GT25.1:	HRRZ	TA,OPRTR+3		; get the link
	PUSHJ	PP,LNKSET		; set it up
	PJRST	GTBYTA			; get the pointer and exit

GT25.2:	HRRZ	TA,OPRTR+3		; get the link
	PJRST	GT15.2+1		; go do rest elsewhere
;GTBYTA		ROUTINE TO GENERATE CODE TO GET POINTER INTO AC0
;
;
;

GTBYTA:	SWON	FWZARD;			; INVOKE THE ISHTARI
	TSWF	FWHOLE;			; WHOLE ARRAY?
	  JRST	GTBYTB+2		; SET UP AND DISPATCH
	PUSH	PP,TA			; SAVE DATAB POINTER
	LDB	TA,DA.ARP		; GET ARRAY POINTER
	PUSHJ	PP,LNKSET		; SET UP LINKS
	PJRST	GTF.9E			; GO CHEAT AND STEAL A ROUTINE


GTBYTB:	SWON	FWZARD;			; INVOKE
	AOS	(PP)			; TAKE SKIP RETURN
	LDB	TA,DA.ARP		; GET ARRAY POINTER
	PUSHJ	PP,LNKSET		; SET IT UP
	PJRST	GTF.11			; DO IT


BYTZ:	MOVE	CH,[XWD OCTLIT,1]	; non-relocatable header
	MOVEI	TC,3			; return increment
	ADDM	TC,(PP)			; bump return
	POPJ	PP,			; and exit
;BNCGN1		GENERATE INCREMENT CODE FOR OP1
;
;ENTER WITH INCREMENT COUNT IN TC
;
;

BNCGN1:	CAIG	TC,1			; is it worth generating a loop for?
	  JRST	.+4			; no - just generate the IBP
	HRRZ	CH,TC			; GET COUNT INTO PROPER AC
	HRLI	CH,<MOVEI.+AC0>		; MAKE A <MOVEI 0,COUNT>
	PUSHJ	PP,PUTASY		; OUTPUT IT
	MOVE	CH,[XWD IBP.+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT <IBP POINTER>
	MOVE	CH,OP1LIT		; GET OP1 POINTER ADDRESS
	TRO	CH,AS.LIT		; IS IN LITAB
	PUSHJ	PP,PUTASN		; OUTPUT ADDRESS
	CAIG	TC,1			; are we generating a loop?
	  POPJ	PP,			; no - exit
	MOVE	CH,[XWD	SOJG.+AC0+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; GENERATE <SOJG 0,.-1>
	MOVEI	CH,AS.DOT+77777		; = .-1
	PJRST	PUTASN			; OUTPUT IT


;BNCGN2		GENERATE INCREMENT CODE FOR OP2
;
;
;

BNCGN2:	CAIG	TC,1			; must we generate a loop
	  JRST	.+4			; no
	HRRZ	CH,TC			; GET COUNT
	HRLI	CH,<MOVEI.+AC0>		; MAKE AN INSTRUCTION
	PUSHJ	PP,PUTASY		; OUTPUT ONE TOO
	MOVE	CH,[XWD IBP.+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT IBP
	MOVE	CH,OP2LIT		; GET POINTER ADDRESS
	TRO	CH,AS.LIT		; I COME FROM LITAB
	PUSHJ	PP,PUTASN		; OUTPUT ADDRESS

BNCG2A:	CAIG	TC,1			; are we generating a loop?
	  POPJ	PP,			; nope -
	MOVE	CH,[XWD SOJG.+AC0+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT <SOJG 0,.-1>
	MOVEI	CH,AS.DOT+77777		; GET A .-1
	PJRST	PUTASN			; OUTPUT IT AND EXIT
;BNCGN3		GENERATE INCREMENT CODE FOR OP1
;
;THIS ROUTINE GENERATES CODE TO INCREMENT OP1 BYTE POINTER TC TIMES
;AND STASH THE RESULTING POINTER INTO OP2.
;
;
;

BNCGN3:	HRRZ	CH,TC			; GET INTO PROPER AC
	HRLI	CH,<MOVEI.+AC0>		; MAKE INTO INSTRUCTION
	PUSHJ	PP,PUTASY		; OUTPUT
	MOVE	CH,[XWD MOV+AC6+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; GENERATE <MOVE 6,OP1>
	MOVE	CH,OP1LIT		; GET OP1 LITAB LOC
	TRO	CH,AS.LIT		; IDENTIFY
	PUSHJ	PP,PUTASN		; OUTPUT
	MOVE	CH,[XWD IBP.,6]		; GET <IBP 6>
	PUSHJ	PP,PUTASY		; OUTPUT
	MOVE	CH,[XWD SOJG.+AC0+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; GENERATE <SOJG 0,.-1>
	MOVEI	CH,AS.DOT+77777		; = .-1
	PUSHJ	PP,PUTASN		; OUTPUT AS ADDRESS
	MOVE	CH,[XWD MOVEM.+AC6+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; GENERATE <MOVEM 6,OP2>
	MOVE	CH,OP2LIT		; GET OP2 LITAB ADDRESS
	TRO	CH,AS.LIT		; SAY "I'M FROM LITAB"
	PJRST	PUTASN			; OUTPUT ADDRESS AND EXIT
;BNCGN4		This routine generates special code to increment AC0
;
;Increments the byte pointer in AC0, OP2CNT times. Uses AC6 for count rather
;then the customary AC0.
;
;
;

BNCGN4:	SKIPN	TC,OP2CNT##		; get count - is it non-zero?
	  POPJ	PP,			; nope - no code needed
	CAIG	TC,1			; must we loop?
	  JRST	.+4			; no -
	HRRZ	CH,TC			; get into proper AC
	HRLI	CH,<MOVEI.+AC6>		; get the count into AC6
	PUSHJ	PP,PUTASY		; output it
	MOVE	CH,[XWD IBP.,AS.CNS+0]	; get IBP
	PUSHJ	PP,PUTASY		; output it
	CAIG	TC,1			; are we looping?
	  POPJ	PP,			; no - exit
	MOVE	CH,[XWD SOJG.+AC6+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; yes - output loop instruction
	MOVEI	CH,AS.DOT+77777		; address = .-1
	PJRST	PUTASN			; output the address and exit
;WH.OP1		ROUTINE TO CHECK IF OP1 IS A WHOLE ARRAY
;
;
;

WH.OP1:	LDB	TC,[POINT 1,OPRTR+2,1]	; GET LITERAL FLAG
	JUMPN	TC,CPOPJ		; IF LITERAL, OBVIOUSLY NOT ARRAY
	HRRZ	TA,OPRTR+2		; GET DATAB POINTER
	PUSHJ	PP,LNKSET		; SET IT UP
	LDB	TB,DA.ARE		; IS IT ARRAY ENTRY?
	JUMPN	TB,CPOPJ		; MUST BE IF WE JUMPED
	MOVEI	TB,2			; GET INDEX
	PUSHJ	PP,GTFLD		; GET FIELD TYPE
	LDB	TD,DA.OCC		; GET OCCURENCES
	JUMPE	TD,CPOPJ		; IF ZERO, EXIT
	LDB	TC,DA.NAM		; GET NAMTAB LINK
	ADD	TC,NAMLOC		; ADD IN BASE ADDRESS
	HLRZ	TC,1(TC)		; GET FIRST THREE CHARACTERS
	CAIN	TC,'TAB'		; IS IT A TABLE?
	  POPJ	PP,			; YES -
	SWON	FWHOLE;			; NO - MUST BE WHOLE ARRAY, SAY SO
	CAMGE	TD,WHOSIZ		; IS THIS NEW SIZE SMALLER?
	  MOVEM	TD,WHOSIZ		; YES - REPLACE
	POPJ	PP,			; EXIT

	AOS	(PP)			; INCREMENT RETURN ADDRESS
	POPJ	PP,			; EXIT+1

;WH.OP2		ROUTINE TO CHECK IF OP2 IS WHOLE ARRAY
;
;
;

WH.OP2:	LDB	TC,[POINT 1,OPRTR+3,1]	; GET LITERAL FLAG
	JUMPN	TC,CPOPJ		; IS LITERAL IF JUMP
	HRRZ	TA,OPRTR+3		; GET DATAB LINK
	PUSHJ	PP,LNKSET		; SET IT UP
	LDB	TB,DA.ARE		; IS IT ARRAY ENTRY
	JUMPN	TB,CPOPJ		; IGNORE IF IT IS
	MOVEI	TB,3			; GET INDEX FOR OP2
	PUSHJ	PP,GTFLD		; GET FIELD TYPE
	LDB	TD,DA.OCC		; GET NUMBER OF OCCURENCES
	JUMPE	TD,CPOPJ		; IF 0 EXIT
	LDB	TC,DA.NAM		; GET NAMTAB LINK
	ADD	TC,NAMLOC		; ADD IN BASE
	HLRZ	TC,1(TC)		; GET FIRST 3 CHARS
	CAIN	TC,'TAB'		; IS IT A TABLE?
	  POPJ	PP,			; YES - EXIT
	SWON	FWHOLE;			; NO - TURN ON FLAG
	CAMGE	TD,WHOSIZ##		; IS NEW SIZE SMALLER?
	  MOVEM	TD,WHOSIZ		; YES - RESET IT
	POPJ	PP,			; EXIT
;WH.OP3		ROUTINE TO SEE IF OP3 IS A WHOLE ARRAY
;
;IF OP3 IS WHOLE ARRAY, EITHER OP1 OR OP2 MUST BE WHOLE ARRAY.
;IF OP3 IS NOT WHOLE ARRAY, NEITHER OP1 NOR OP2 CAN BE WHOLE ARRAY.
;
;CALL:	PUSHJ	PP,WH.OP3		; NO ARGUMENTS
;	  RETURN+1			; ERROR RETURN
;	  RETURN+2			; OK RETURN
;
;
;

WH.OP3:	HRRZ	TA,OPRTR+4		; GET DATAB LINK
	PUSHJ	PP,LNKSET		; SET UP LINK
	LDB	TB,DA.ARE		; GET ARRAY ENTRY FLAG
	JUMPN	TB,WHOP3N		; JUMP IF ARRAY ENTRY
	PUSHJ	PP,FNDRES		; GET REAL DATAB ENTRY
	LDB	TD,DA.OCC		; GET NUMBER OF OCCURS
	JUMPE	TD,WHOP3N		; JUMP IF ZERO
	LDB	TC,DA.NAM		; GET NAMTAB LINK
	ADD	TC,NAMLOC		; ADD IN BASE
	HLRZ	TC,1(TC)		; GET FIRTS 3 CHARS
	CAIN	TC,'TAB'		; IS IT A TABLE?
	  JRST	WHOP3N			; YES -
	CAMGE	TD,WHOSIZ		; NEW SIZE SMALLER?
	  MOVEM	TD,WHOSIZ		; YES - REPLACE
	SWON	FWHOLE;			; MAKE SURE THIS IS ON
	AOS	(PP)			; SKIP
	POPJ	PP,			; TAKE ERROR RETURN

WHOP3N:	TSWT	FWHOLE;			; WE'RE NOT WHOLE ARRAY, WAS ANYONE ELSE?
	  JRST	CPOPJ1##		; NO - OK
	GETLN;				; GET ERRONEOUS LINE NUMBER
	WARN	587;			; YES - ERROR
	POPJ	PP,			; TAKE ERROR RETURN

FNDRES:	LDB	TA,DA.NAM		; GET NAMTAB LINK
	MOVEI	TB,CD.DAT		; GET THAT ID
	PUSHJ	PP,FNDLNK		; FIND FIRST DATAB ITEM
	  JRST	FNDFL1			; EROR!
	MOVE	TA,TB			; GET PROPER AC

FNDRS1:	LDB	TB,DA.SIZ		; GET SIZE FIELD
	JUMPN	TB,CPOPJ		; EXIT WHEN FOUND
	HRRZ	TA,10(TA)		; else get same name link (DA.SNM)
	JUMPE	TA,FNDFL1		; IF NONE THEN ERROR
	PUSHJ	PP,LNKSET		; SET IT UP
	JRST	FNDRS1			; AND TRY AGAIN
;CHK3		COMMON ROUTINE TO CHECK FOR OP1,2,3 BEING WHOLE ARRAYS
;
;
;

CHK3:	PUSHJ	PP,WH.OP1		; CHECK OUT OP1
	PUSHJ	PP,WH.OP2		; CHECK OUT OP2
	PUSHJ	PP,WH.OP3		; IS OP3 COMPATIBLE?
	  POP	PP,TB			; NO - POP OFF EXTRA RETURN ADDRESS
	POPJ	PP,			; YES - EXIT
;WHLGN1		ROUTINE TO OUTPUT START CODE FOR HANDLING WHOLE ARRAY
;
;GENERATES THE FOLLOWING CODE:
;
; %TAG:	SETZM	%LIT
;	MOVEI	0,1
;	ADDB	0,%LIT
;	CAILE	0,ARRAY-SIZE
;	JRST	%TAG2
;
;SEE WHLGN2 FOR END CODE
;
;

WHLGN1:	HLRZ	TB,OPRTR+1		; GET INDICATORS
	SKIPN	TB			; DID WE GENERATE INDC. CODE?
	  PUSHJ	PP,BLDTAG		; NO - OUTPUT TAG OURSELVES
	MOVE	TB,TAGNUM		; GET THAT NUMBER
	MOVEM	TB,WL%AE##		; STASH AS %TAG2
	AOS	TB,TAGNUM		; GET ANOTHER TAG
	MOVEM	TB,WL%L##		; STORE AS %TAG
	PUSHJ	PP,BLDTAG		; BUILD A TAG
	PUSHJ	PP,FNDTAG		; OUTPUT IT TO ASYFIL
	MOVE	CH,[XWD SETZM.+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT A SETZM
	SKIPN	CH,WHOLOC##		; DO WE HAVE A %LIT DEFINED YET?
	  PUSHJ	PP,WLGN1A		; NO - DEFINE IT NOW
	TRO	CH,AS.LIT		; IDENTIFY AS LITAB ITEM	
	PUSHJ	PP,PUTASN		; OUTPUT AS ADDRESS FOR SETZM
	MOVE	CH,[XWD MOVEI.+AC0,AS.CNS+1]
	PUSHJ	PP,PUTASY		; output a <MOVEI 0,1>
	MOVE	CH,[XWD ADDB.+AC0+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT <AOS 0,%LIT>
	MOVE	CH,WHOLOC		; GET %LIT
	TRO	CH,AS.LIT		; IS LITAB ITEM	
	PUSHJ	PP,PUTASN		; OUTPUT ADDRESS
	HRLZI	CH,<CAILE.+AC0>		; GET <CAILE 0,ARRAY-SIZE>
	HRR	CH,WHOSIZ		; ADD IN SIZE 
	PUSHJ	PP,PUTASY		; OUTPUT INSTRUCTION
	MOVE	CH,WL%AE		; GET %TAG2
	PUSHJ	PP,LKTAG##		; LOOK UP IN PROTAB
	ADD	CH,[XWD JRST.,AS.PRO]	; MAKE INTO INSTRUCTION
	PJRST	PUTASY			; OUTPUT AND EXIT

WLGN1A:	MOVE	TB,ELITPC		; GET LITAB PC
	MOVEM	TB,WHOLOC		; SAVE FOR OTHERS
	AOS	ELITPC			; BUMP
	MOVE	CH,[XWD OCTLIT,1]	; GET LITAB HEADER
	PUSHJ	PP,STASHC		; OUTPUT
	SETZ	CH,			; MAKE <OCT 0>
	PUSHJ	PP,STASHC		; OUTPUT
	MOVE	CH,WHOLOC		; GET LOC
	POPJ	PP,			; RETURN
;WHLGN2		ROUTINE TO OUTPUT END CODE FOR HANDLING WHOLE ARRAYS
;
;GENERATES THE FOLLOWING CODE:
;
;	JRST	%TAG+1
; %TAG2:
;
;
;

WHLGN2:	MOVE	CH,WL%L			; GET %TAG
	PUSHJ	PP,LKTAG		; LOOK UP IN PROTAB
	ADD	CH,[XWD JRST.+ASINC,AS.PRO]
	PUSHJ	PP,PUTASY		; OUTPUT JRST+
	MOVEI	CH,AS.ABS+1		; GET INCREMENT
	PUSHJ	PP,PUTASN		; OUTPUT
	PUSH	PP,TAGNUM		; SAVE TAGNUM
	MOVE	TB,WL%AE		; GET %TAG2
	MOVEM	TB,TAGNUM		; STICK INTO TAGNUM
	PUSHJ	PP,FNDTAG		; OUTPUT TO ASYFIL
	POP	PP,TAGNUM		; RESTORE TAGNUM
	SWOFF	FINDON;			; MAKE SURE IT'S OFF
	POPJ	PP,			; AND EXIT
;TABLE OF ONE-WORD POWERS OF TEN

POWR10:	DEC	1			; 0
	DEC	10			; 1
	DEC	100			; 2
	DEC	1000			; 3
	DEC	10000			; 4
	DEC	100000			; 5
	DEC	1000000			; 6
	DEC	10000000		; 7
	DEC	100000000		; 8
	DEC	1000000000		; 9
	DEC	10000000000		; 10


;TABLE OF ROUNDING FACTORS

ROUNDR:	DEC	5			; 1
	DEC	50			; 2
	DEC	500			; 3
	DEC	5000			; 4
	DEC	50000			; 5
	DEC	500000			; 6
	DEC	5000000			; 7
	DEC	50000000		; 8
	DEC	500000000		; 9
	DEC	5000000000		; 10
;DEFINITION OF ASYFIL CODES

	DEFINE	SETVAL (X,Y),<
	X=Y'B26
	INTERNAL X
	>

SETVAL	MOV,000
SETVAL	MOVEI.,001
SETVAL	MOVEM.,002
SETVAL	MOVM.,003
SETVAL	MOVMM.,004
SETVAL	MOVN.,005
SETVAL	MOVNI.,006
SETVAL	MOVSI.,011
SETVAL	AD,012
SETVAL	ADDI.,013
SETVAL	ADDM.,014
SETVAL	ADDB.,015
SETVAL	SUB.,016
SETVAL	SUBI.,017
SETVAL	SUBM.,020
SETVAL	MUL.,021
SETVAL	MULI.,022
SETVAL	IMUL.,023
SETVAL	ASH.,025
SETVAL	DIV.,026
SETVAL	TDO.,027
SETVAL	TDZ.,030
SETVAL	IDIV.,031
SETVAL	IDIVI.,032
SETVAL	FAD.,034
SETVAL	FADM.,035
SETVAL	FSB.,036
SETVAL	FSBM.,037
SETVAL	FMP.,040
SETVAL	FMPM.,041
SETVAL	FDV.,042
SETVAL	FDVM.,043

SETVAL	DPB.,044
SETVAL	LDB.,045
SETVAL	IDPB.,046
SETVAL	ILDB.,047

SETVAL	AOS.,050
SETVAL	SOS.,051
SETVAL	SOSGE.,052
SETVAL	SOSLE.,053
SETVAL	CAM.,052
SETVAL	CAI.,053
SETVAL	CAME.,054
SETVAL	CAIE.,055
SETVAL	CAMG.,056
SETVAL	CAIG.,057
SETVAL	CAMGE.,060
SETVAL	CAIGE.,061
SETVAL	CAML.,062
SETVAL	CAIL.,063
SETVAL	CAMLE.,064
SETVAL	CAILE.,065
SETVAL	CAMN.,066
SETVAL	CAIN.,067

SETVAL	JUMP.,067
SETVAL	JUMPE.,070
SETVAL	JUMPG.,071
SETVAL	JMPGE.,072
SETVAL	JUMPL.,073
SETVAL	JMPLE.,074
SETVAL	JUMPN.,075
SETVAL	JRST.,076

SETVAL	SKIP.,076
SETVAL	SKIPE.,077
SETVAL	SKIPG.,100
SETVAL	SKPGE.,101
SETVAL	SKIPL.,102
SETVAL	SKPLE.,103
SETVAL	SKIPN.,104
SETVAL	SKIPA.,105

SETVAL	TRNE.,106
SETVAL	TRNN.,107
SETVAL	TLNE.,110
SETVAL	TLNN.,111
SETVAL	IBP.,112
SETVAL	PUSHJ.,113
SETVAL	BLT.,114
SETVAL	SETZM.,115
SETVAL	SETOM.,116
SETVAL	TDCA.,117
SETVAL	ANDM.,120
SETVAL	TDNN.,121
SETVAL	HRLOI.,122
SETVAL	HRROI.,123
SETVAL	HRLZI.,124
SETVAL	HRRZI.,125
SETVAL	SETZB.,126
SETVAL	ARG.,127
SETVAL	SOJG.,130
SETVAL	EXCH.,131
SETVAL	CALLI.,132
SETVAL	TLZ.,133
SETVAL	TLO.,134
SETVAL	SETCA.,135
SETVAL	SETCM.,136
SETVAL	POPJ.,137
;DEFINITION OF UUO CALLS

	DEFINE	SETVAL (X,Y,Z),<
	X=Y'B26+Z'B30
	INTERNAL X
	>

SETVAL	COMP.,174,0
SETVAL	CMP.11,174,1
SETVAL	CMP.12,174,2
SETVAL	CMP.21,174,3
SETVAL	CMP.22,174,4
SETVAL	CMP.76,174,5
SETVAL	CMP.96,174,6
SETVAL	CMP.97,174,7
SETVAL	SPAC.6,174,10
SETVAL	SPAC.7,174,11
SETVAL	SPAC.9,174,12
SETVAL	COMP%,174,13
SETVAL	CMP%11,174,14
SETVAL	CMP%12,174,15
SETVAL	CMP%21,174,16
SETVAL	CMP%22,174,17

SETVAL	MOVE.,175,0
SETVAL	CD6D7.,175,1
SETVAL	CD6D9.,175,2
SETVAL	CD7D6.,175,3
SETVAL	CD7D9.,175,4
SETVAL	CD9D6.,175,5
SETVAL	CD9D7.,175,6
SETVAL	MVSGNR,175,7
SETVAL	MVSGN,175,10
SETVAL	TESTZ,175,11
SETVAL	TIME.,175,12
SETVAL	TIMED.,175,13
SETVAL	RSVWD.,175,14
SETVAL	TESTB.,175,15
SETVAL	SQRT.,175,16
SETVAL	DEBUG.,175,17

SETVAL	SETOF.,176,0
SETVAL	SETON.,176,1
SETVAL	INDC.,176,2
SETVAL	FORCE.,176,3
SETVAL	EXCPT.,176,4
SETVAL	READ.,176,5
SETVAL	CHAIN.,176,6
SETVAL	DSPLY.,176,7
;DEFINE UUO CALLS

	DEFINE	SETVAL (X,Y),<
	X=Y'B26
	INTERNAL X
	>

SETVAL	SUBSCR,140;

SETVAL	FIX.,142

SETVAL	FLOT1.,145
SETVAL	FLOT2.,146

SETVAL	PD6.,147;
SETVAL	PD7.,150;

SETVAL	GD6.,151;
SETVAL	GD7.,152;

SETVAL	NEG.,153;
SETVAL	MAG.,154;

SETVAL	ADD.12,155;
SETVAL	ADD.21,156;
SETVAL	ADD.22,157;

SETVAL	SUB.12,160;
SETVAL	SUB.21,161;
SETVAL	SUB.22,162;

SETVAL	MUL.12,163;
SETVAL	MUL.21,164;
SETVAL	MUL.22,165;

SETVAL	DIV.11,166;
SETVAL	DIV.12,167;
SETVAL	DIV.21,170;
SETVAL	DIV.22,171;
DEFINE	SETVAL (X,Y),<
	X=Y
	INTERNAL X
	>

;DEFINE LITFIL ITEMS

SETVAL	XWDLIT,1			; LITAB CODE FOR XWD GROUP
SETVAL	BYTLIT,2			; LITAB CODE FOR BYTE POINTER GROUP
SETVAL	ASCLIT,3			; LITAB CODE FOR ASCII CONSTANT
SETVAL	SIXLIT,4			; LITAB CODE FOR SIXBIT CONSTANT
SETVAL	D1LIT,5				; LITAB CODE FOR 1-WORD DECIMAL CONSTANT
SETVAL	D2LIT,6				; LITAB CODE FOR 2-WORD DECIMAL CONATANT
SETVAL	FLTLIT,7			; LITAB CODE FOR FLOATING-POINT CONSTANT
SETVAL	OCTLIT,10			; LITAB CODE FOR OCTAL CONSTANT
;DEFINE EXTERNALS AND SUCH ROT


EXTERNAL AS.CNB, AS.CNS, AS.ABS, AS.DOT


	END