Google
 

Trailing-Edge - PDP-10 Archives - cobol12c - cmngen.mac
There are 20 other files named cmngen.mac in the archive. Click here to see a list.
; UPD ID= 3514 on 5/5/81 at 10:32 AM by NIXON                           
TITLE	CMNGEN FOR COBOL V12C
SUBTTL	COMMON ROUTINES USED BY CODE GENERATORS		AL BLACKINGTON/CAM

	SEARCH COPYRT
	SALL

COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE.

	SEARCH	P
	SEARCH	OPCTAB
	%%P==:%%P

;EDITS
;NAME	DATE		COMMENTS
;V12B****************
;KWS	26-OCT-84	[1550] Clear Elags on literals in SETOPN
;MJC	21-AUG-84	[1543] Fix 1411 to give no warning if ON SIZE ERROR
;				is used.
;JEH	10-OCT-83	[1477] Adjust the correction factor added to floating
;				point numbers (epsilon) to consider nbr of 
;				decimal places in source
;JBB	22-SEP-83	[1476] Bad table link, catastrophe in phase E with
;				subscript assoc with linkage item with no
;				occurs clause. corrects edit 1123.
;DMN	24-Feb-83	[1453] Fix 1411 to point to correct line on truncation error.
;JEH	30-SEP-82	[1411] Test for leading truncation warning in the 
;				rounding routine if converting from floating
;				point to binary before operand sizes adjusted
;JEH	18-MAY-82	[1355] Build COMP-3 zero literal correctly
;JEH	05-MAY-82	[1353] Eliminate HALT if literal too large - give error
;RJD	09-MAR-82	[1344] Bad code generated for literal compare 
;JSM/DN	16-OCT-81	[1300] Fatal Diag for subprogram if REDEFINED item
;			  is referenced in USING clause but original item
;			  is referenced elsewhere.
;JSM	18-SEP-81	[1307] Comp-3 Literal 0 always generated unsigned
;				Make signed if receiving operand signed.
;V12A****************
;JSM	19-Mar-81	[1123] Bad table link, catastrophe in phase E with
;				subscript assoc with linkage item with no boccurs clause.
;DMN	31-Dec-80	[1110] Allow ON SIZE ERROR code to catch divide by zero for COMP-1 result.
;DAW	29-Dec-80	[1107] Prevent "Ill mem ref"
;DAW	15-Dec-80	[1103] Bug in literal pooler caused bad code to
;				be generated in rare cases.
;DAW	18-Nov-80	[1077] Prevent "ILL MEM REF" in PHASE E
;DAW	14-Nov-80	[1073] Bad code gen when depending item is at a level
;				two or more down from the item being looked at
;DMN	 1-APR-80	[1004] MAKE ASCII & EBCDIC COLLATING SEQUENCES WORK.
;DMN	30-JAN-80	[762] ADD SMALL CONSTANT TO COMP-2 COMPUTE CALCULATIONS.
;			      IMPLEMENT AND USE D. P. FLOATING POINT LITERALS.
;DAW	25-OCT-79	[753] MAKE 745 WORK FOR ANS68 TOO
;DAW	15-OCT-79	[745] MULTIPLE SUBSCRIPTS WITH NON-COMP DEPENDING VAR.
;			COBOL-74 ONLY
;V12*****************
;DMN	 6-OCT-79	[743] COBOL-74 MORE OF EDIT 721
;DMN	 7-SEP-79	[730] FIX MULTIPLY A BY B ON SIZE ERROR FOR QUAD WORD.
;DMN	26-JUL-79	[722] COBOL-74 FIX MOVE HIGH/LOW-VALUES WITH PROGRAM COL. SEQ.
;DMN	24-JUL-79	[721] COBOL-74 FIX SUBSCRIPTED IF WITH PROGRAM COL. SEQ.
;DAW	22-JUN-79	[716] FIX BAD CHECK FOR EBCDIC MODE IN SUBSCRIPTING
;DMN	 2-APR-79	[673] FIX QUAD WORD ROUNDING PROBLEM
;DAW	28-MAR-79	[671] FIX PROBLEM WITH LINKAGE SECTION SUBSCRIPTS
;DAW	12-MAR-79	[661] GIVE ERROR MESSAGE AND DISALLOW COMP-1 SUBSCRIPTS
;DAW	12-MAR-79	[660] FIX ERROR MESSAGE POINTS TO WRONG PLACE
;DAW	27-FEB-79	[643] FIX "?SIZTE RETURNED 0" IF PROGRAM ERRORS
;DMN	26-FEB-79	[636] FIX BAD LITERAL GENERATION IF PROGRAM HAS FATAL SUBSCRIPT ERRORS
;DAW	20-FEB-79	[634] FIX SIZE ERROR CHECKING FOR FOUR-WORD RESULTS
;DMN	16-JAN-79	[625] FIX BAD TEST FOR TWO WORD TEMP IN PUTEMP
;DMN	 4-JAN-79	[621] MAKE BADALL A GLOBAL FOR MOVGEN
;DMN	11-DEC-78	[610] FIX INCORRECT CODE GENERATED IN ARRAY WHERE TOP LEVEL IS COMP IS REFERENCED VIA CONSTANT SUBSCRIPT
;DAW	 7-DEC-78	[606] FIX ?INTERNAL COMPILER ERROR IF 01 ITEM OCCURS USAGE IS NON-DISPLAY
;DMN	31-OCT-78	[577] FIX SET DOWN BY 262144 (I.E. <-1,,0>)
;DMN	 6-OCT-78	[570] ADD QUAD-WORD ROUNDING FUNCTION
;EHM	16-SEP-78	[551] FIX CATASTROPHE IN PHASE E
;EHM	14-SEP-78	[543] FIX ACCEPT INTO A DISPLAY-6 ITEM

;V10*****************
;EHM	 6-JAN-78	[525] FIX SUBSCRIPT EXPRESSION AND NON COMP
;EHM	 7-NOV-77	[522] FIX ROUNDING FOR LARGE DIFFERENCES IN NUMBER OF DECIMAL PLACES.
;DPL	23-JUN-76	[431] ADD PUTAYY AS INTERNAL FOR SORT GIVING
;	 6-APR-76	[424] DONT ATTEMPT TO MAKE LITERAL IF NO SIZE
;	17-FEB-76	[406] SET ERROR RETURN FROM SETOPN IF DATA ITEM HAS ERROR BIT (DA.ERR) SET
;	28-JAN-76	[402] ALLOW INDEX REG AND INDIRECT ADDRESSING FOR ARGUMENT TO LIBOL
;JEC	21-JAN-76	[374] FIX CONVERSION FROM ASCII TO SIXBIT LITERALS
;DBT	23-JUN-75	REMOVE LAST OF UUOS - SETUUO:
;ACK	20-APR-75	ADD ABILITY TO MOVE DISPLAY-9 TO/FROM OTHER FLAVORS OF DISPLAY.
;ACK	22-APR-75	SAME AS ABOVE FOR FIGURATIVE CONSTANTS.
;********************

; EDIT 365 FIX MULTIPLE CALLS TO SETOPN FOR TALLY.
; EDIT 333 ALLOW TALLY AS A SUBSCRIPT TO BE ADDED TO SUBTRACTED FROM
; EDIT 330 MAINTAIN FFATAL ERROR BIT ON
; EDIT 306 JEC FIX SUBSCRIPTING OF COMP ITEMS IN AN ASCII RECORD.
; EDIT 274 RECOVER IF LITERAL SUBCRIPT IS TOO LARGE
; EDIT 262 HANDLE DUMMY SUBSCRIPT CORRECTLY [262]
; EDIT 251 RECOVER IF SUBSCRIPT IS SUBSCRIPTED
; EDIT 250 ALLOW TALLY AS A SUBSCRIPT
; EDIT 173 PUT BACK SOME CODE TAKEN OUT BY LITTAB FIX 167
;	   CODE MOVES CURLIT WHICH CONTAINS HEADER WORD LOCATION.
; EDIT 167 FIXES LITTAB OVERFLOW
; EDIT 161 DON'T ASSIGN FATHER'S USAGE TO THE SON IF SON'S IS NOT BINARY

TWOSEG
	.COPYRIGHT		;Put standard copyright statement in REL file
RELOC	400000
SALL
ENTRY CMNGEN
CMNGEN:

EXTERNAL XPNLIT,XPNTAG,XPNEOP,FATAL,WARN,KILL,DEVDED,ERATYP
EXTERNAL LNKSET,GETTAG,PUTAS1,PUTAS2,PUTAS3,ADJDP.,FNDBRO
EXTERNAL MXAC.,MACX.,MXX.,CFPCX.,CC1C2.
EXTERN   CPOPJ1,CPOPJ
EXTERN	 MSERA.		;[1453]

;ROUTINES INCLUDED HERE

INTERNAL SZERO.,SQUOT.,ASRJ.,AZRJ.,AQRJ.,AHRJ.,ALRJ.,FPLOV.
IFN ANS74,<
INTERN	SHVAL.,SLVAL.		;[722]
INTERN	TSTARO,GDEBV,GDEBA,GDEBB,GDEBAB,CDEBA,CDEBB,CDEBAB
>
INTERNAL M.IA,M.IB,GETEMP,SETEMP,PUTEMP,PUTTAG,SETOPA,SETOPB,SETOPN
INTERN   STASHI,STASHL,STASHP,STASHQ,MBYTPA,MBYTPB,PVALIT,PVLIT2
INTERNAL VALLIT,VLIT2,CONVNL,CONVFP,CONVF2,SCANL,MBYTEA,MBYTEB,DPDIV.

INTERNAL PUTASY,PUTASN,FORCX0,BMPEOP,GENFPL,GENF2L,PUSEOP,PUSH12,PUTAYY  ;[431]
INTERNAL NEGATL,CREATL,MAKEL,MAKEL2,ROUND,SIZERA,B1PAR,B2PAR
INTERNAL SWAPAB,ADJSL.,JOUT,SUBSCR,BYTE.A,BYTE.B,BYTE.C
INTERNAL SUBSCA,SUBSCB,SUBSCC,SUBSCD,SUBSCE
INTERNAL PUT.A,PUT.AA,PUT.B,PUT.BA,PUT.L,PUT.LA,PUT.LB,PUT.LC,PUT.LD
INTERNAL PUT.P,PUT.PA,PUT.PC,PUT.XA,PUT.XB,PUT.EX,PUT.16,PUT.SX,PUT.AO,PUT.BO,PUT.PJ
INTERNAL SUBSIZ
INTERNAL SZDPVA,SZDPVB
INTERNAL DEPCKK,DEPTSA,DEPTSB,DPBDEP
IFN BIS,<
INTERNAL EPSLON		;[762]
>

;****************************************************************

;CONSTANTS INCLUDED HERE

INTERNAL BYTE.S,BYTE.W,CHAC,CHOP,W1LN,W1CP,TCLN,TCCP,POWR10,DPWR10
INTERNAL ACMODE,ACSIZE,TESUBC,W2SUBC,TASUBC

;****************************************************************

;ERROR ROUTINES INCLUDED HERE

INTERNAL OPNWRN, OPWRN, OPNFAT, OPFAT
INTERNAL BADEOP, NOTNUM, NOTDAT, NOTDEF
;PUT A WORD ONTO THE CURRENT ASYFIL AND BUMP APPROPRIATE PC

PUTASY:
	TLC	CH,UUOMSK	;COMPLIMENT SO WE CAN CHECK FOR UUO'S
	TLCN	CH,UUOMSK	;POSSIBLE UUO??
	JRST	CNVUUO		;YES

PUTAYY:
	TSWT	FAS3		;ARE WE CURRENTLY IN A NON-RESIDENT SEGMENT?
	AOSA	EAS2PC		;NO--BUMP RESIDENT PC
	AOSA	EAS3PC		;YES--BUMP NON-RESIDENT PC
	JRST	PUTAS2		;WRITE ONTO AS2FIL
	JRST	PUTAS3		;WRITE ONTO AS3FIL


;PUT ALTERNATE CODE SET MARKER INTO ASYFIL

PUTASA::MOVSI	CH,ASMACS

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

PUTASN:
	TSWFZ	FUUOIC		;DO WE HAVE A UUO INCREMENT TO TRAP?
	JRST	CNVUUI		;YES - GO DO IT

	TSWT	FAS3		;CURRENTLY IN NON-RESIDENT SEGMENT?
	JRST	PUTAS2		;NO--USE AS2FIL
	JRST	PUTAS3		;YES--USE AS3FIL

;PUT OUT REFERENCE TO A CONSTANT
;ENTER WITH INST IN CH, AND CONSTANT IN TE
;IF RHS OF CH = AS.CNB
;AND TE .LT. 77777
;GENERATE SMALL CONSTANT, ELSE GENERATE LARGE CONSTANT

PUTASC:	CAILE	TE,77777	;IS IT A SMALL CONSTANT?
	JRST	PTASC2		;NO, SO GIVE UP NOW
	PUSH	PP,CH
	HRRZ	CH,CH		;GET RHS ONLY
	CAIE	CH,AS.CNB+ASINC	;CONSTANT?
	JRST	PTASC1		;NO
	POP	PP,CH
	HRR	CH,TE		;JUST USE CONST
	JRST	PUTASY		;AND OUTPUT IT

PTASC1:	POP	PP,CH
PTASC2:	PUSH	PP,TE		;SAVE CONST.
	PUSHJ	PP,PUTASY
	POP	PP,CH		;GET BACK CONST.
	JRST	PUTASN


;CALL PUTASY OR PUT.EX IF ADDRESS IS AN EXTERNAL SYMBOL
PUTAXY:	LDB	TE,[POINT 3,CH,20]	;LOOK AT ADDRESS
	CAIN	TE,AC.EXT##	;IS IT AN EXTERNAL SYMBOL?
	JRST	PUT.EX		;YES, CALL "PUT AN EXTERNAL"
	JRST	PUTASY		;NO, CALL REGULAR OUTPUT ROUTINE
;THIS ROUTINE IS CALLED FROM PUTASY AND PUTASN WITH JRST'S
; TO CNVUUO AND CNVUUI RESPECTIVELY
;
;THIS ROUTINE IS CALLED WHEN THERE IS A UUO TO BE CONVERTED TO
; A PUSHJ.  WHEN IT RECIEVES A UUO ( IN CH ) FROM PUTASY IT CHECKS
; TO SEE IF THERE IS AN INCREMENT TO FOLLOW AND IF SO IT SETS THE
; SW FLAG FUUOIC AND RETURNS DIRECTLY TO THE PUTASY CALLER.
; FUUOIC WILL THEN CAUSE PUTASN TO JRST TO CNVUUI WITH THE INCREMENT.
; IF THERE IS NO INCREMENT IT WILL GENERATE THE PUSHJ IMMEDIATELY.

; THERE ARE 4 POSSIBLE CASES TO BE HANDLED DEPENDING UPON 1. IF THERE
; IS AN INCREMENT TO FOLLOW AND 2. IF THE UUO ROUTINE NEEDS TO SEE
; THE AC NUMBER IN THE UUO.

;	NO INCREMENT - NO AC
;		MOVEI	16,UUO.ADRESS.FIELD
;		PUSHJ	17,UUO.ROUTINE

;	INCREMENT - NO AC
;		MOVEI	16,UUO.ADRESS.FIELD
;		INCREMENT WORD TO ASY
;		PUSHJ	17,UUO.ROUTINE

;	NO INCREMENT - AC NEEDED
;		MOVE	16,LIT00%
;		LIT00% INCREMENT TO ASY
;		PUSHJ	17,UUO.ROUTINE
;		...
;	LIT00%+N:
;		UUO INSTRUCTION

;	INCREMENT - AC
;		MOVE	16,LIT00%
;		LIT00% INCREMENT TO ASY
;		PUSHJ	17,UUO.ROUTINE
;		...
;	LIT00%+N:
;		UUO
;		UUO ADDRESS INCREMENT

; NOTE THAT IF SOMEONE GENERATES A UUO WHICH MAKES
; USE OF THE INDEX FIELD AND/OR THE INDIRECT BIT IT WILL BE
; IMPROPERLY HANDLED IN THE LATTER 2 CASES SINCE THE ADDRESS WILL
; NOT BE EVALUATED A'LA A UUO CALL.  INTERNAL COMPILER ERRORS
; WILL BE GENERATED FOR THIS CASE AND IF IT OCCURS THE UUO GENERATING
; ROUTINE WILL BE FIXED TO GENERATE THE PUSHJ DIRECTLY

; NOTE ALSO THE RUSSIAN ROUTLETTE WHICH IS BEING PLAYED BY PLACING
; THINGS INTO THE  LIT00% TABLE - WE COULD BE SPLITTING A BLOCK WHICH
; THE CALLER IS GENERATING.  IT IS HOPED THAT THIS WILL NOT OCCUR.
; IT WOULD BE A STRANGE THING TO DO BUT WHO KNOWS.

; FIRST A FEW SYMBOLIC DEFINITIONS OF FIELDS

	ENDIT==177		;END OF ASY FILES CODE

; ASY INSTRUCTION FIELD MASKS

	IM.CD==600000		;CODE FIELD OF INSTRUCTION
	IM.IC==400000		;INSTRUCTION CODE BIT
	IM.OP==177000		;OP CODE CODE FIELD
	IM.AC==000740		;AC FIELD
	IM.ACL==000040		;LOW ORDER AC BIT
	IM.IN==000017		;INDEX FIELD
	IM.IX==000020		;INDIRECT BIT
	IM.ADH==600000		;HIGH ORDER TWO BITS OF ADDRESS CODE

; ASY INSTRUCTION FIELD BYTE POINTERS

	IP.OP==<POINT 7,CH,8>		;ASY OPERATOR FIELD
	IP.AC==<POINT 4,CH,12>		;AC FIELD
	IP.ACH==<POINT 3,CH,11>		;HIGH 3 AC BITS

EXTERNAL	UUOSV%		;SAVE UUO TO BE CONVERTED
EXTERNAL	UUINC%		;SAVE INCREMENT OF UUO TO BE CONVERTED
CNVUUO::			;PUTASY ENTRY POINT
	;IS THERE ANY POINT IN LOOKING AT ALL??
	SKIPE	LITASY##	;IF NOT = 0 THEN
	JRST	PUTAYY		;LITERALS, NOT INSTRUCTIONS ARE BEING
				;SHOVED INTO THE ASY FILES

	; FIRST DO AN INTERNAL CHECK OF THE INCREMENT FLAG
	; IT SHOULD NEVER BE ON AT THIS POINT
	TSWFZ	FUUOIC
	PUSHJ	PP,CNVER	;BAD NEWS

	;NOW DO WE HAVE A VALID UUO???
	PUSH	PP,TE		;SAVE SOME REGS
	PUSH	PP,TD

	TLNE	CH,IM.IC	;IS THIS REALLY AN INSTRUCTION OR
				; JUST A REVERSED ASY ASN CALL???
	JRST	CNVUNO		;BAD CALL - IF A UUO SLIPED THROUGH
				; COBOLG WILL LET US KNOW

	LDB	TE,[IP.OP]	;OPERATOR
	CAIGE	TE,FSTUUO	;IS IT IN THE LOWER BOUND?
				;THIS IS DONE BECAUSE THE CHECK IN PUTASY
				; IS NOT COMPLETELY ACCURATE
	JRST	CNVUNO		;NOT A UUO
	LDB	TD,[IP.AC]	;GET AC FOR LATER
	CAIE	TE,ENDIT	;END OF ASY FILE???
	JRST	CNVU11		;ITS A UUO
				;MAYBE - CHECK AC FOR 17
	CAIN	TD,17
	JRST	CNVUNO		;YES IT IS THE END

CNVU11:
	;HACK HACK IF ADDRESS TYPE 6 OR 7  SET ASINC
	TRC	CH,IM.ADH	
	TRCN	CH,IM.ADH
	TLO	CH,ASINC	;SET IT IF 6 OR 7
	MOVEM	CH,UUOSV%##	;SAVE UUO AWAY
	TLNN	CH,ASINC	;IS INCREMENT TO FOLLOW??
	JRST	CNVUU2		;NO - LETS GET IT OVER WITH NOW
	;YES INDEED LETS GO BACK AND WAIT FOR THE PUTASN CALL
	SWON	FUUOIC		;SET FLAG TO GET BACK
	JRST	CNVUED		;BACK TO CALLER OF PUTASY

CNVUNO:	POP	PP,TD		;RESTORE REGS
	POP	PP,TE
	JRST	PUTAYY		;RETURN PAST UUO TEST AND CONTINUE


CNVUUI::			;PUTASN ENTRY POINT
	PUSH	PP,TE
	PUSH	PP,TD
	MOVEM	CH,UUINC%##	;SAVE INCREMENT
	MOVE	CH,UUOSV%	;GET UUO
	LDB	TE,[IP.OP]	;GET OPERATOR
	LDB	TD,[IP.AC]	; AND AC FIELD

CNVUU2:
	PUSH	PP,TA		;SAVE TA
	JUMPE	TD,CNVU2A	;USE MOVEI IF AC = 0 REGARDLESS
	CAIGE	TE,UUOWAC+1	;DOES AC EXTEND OP CODE?
				; THE 1 IS ADDED BECAUSE FOR OPEN/CLOSE
				;THE AC IS A PARAMETER AND DEFINES OP
	JRST	CNVUU5		;NO

	; YES - SO WE CAN USE THE MOVEI	16,UUO.ADDRESS
CNVU2A:
	TLZ	CH,IM.OP!IM.AC	;CLEAR OPERATOR,AC
	TLO	CH,MOVEI.+AC16		;CHANGE IT TO MOVEI	16,
	PUSHJ	PP,PUTASY		;PUT IT INTO ASY FILE

	MOVE	CH,UUOSV%		;IS THERE AN INCREMENT TO FOLLOW?
	TLNN	CH,ASINC	
	JRST	CNVUU6		;NO INCREMENT
	MOVE	CH,UUINC%	;YES - PUT IT INTO ASY FILE
	PUSHJ	PP,PUTASN
	JRST	CNVUU6		;GO DO PUSHJ

CNVUU5:			;WE NEED A MOVE 16,[UUO]
	; FIRST PUT UUO IN LIT TABLE
	MOVE	TA,[XWDLIT,,2]	;PUT OUT XWD
	PUSHJ	PP,STASHP
	HLRZ	TA,UUOSV%		;GET AC FIELD
	TRZ	TA,IM.CD!IM.OP	;CLEAR CODE AND OP FIELDS
;[402]	TRNE	TA,IM.IX!IM.IN	;ARE INDEX AND INDIRECT BITS 0?
;[402]	PUSHJ	PP,CNVER		;OH OH COMPILER ERROR
	PUSHJ	PP,STASHQ		;STORE AC AWAY AS A COMMENT
	MOVE	TA,UUOSV%		;GET ADDRESS FIELD
	TLNN	TA,ASINC	;IS THERE AN INCREMENT
	SETZM	UUINC%		;NO INCREMENT
	HRL	TA,UUINC%	;YES- GET IT
	PUSHJ	PP,POOLIT

	;NOW THE MOVE	16,[UUO]
	MOVE	CH,[MOV+ASINC+AC16,,AS.MSC]
	PUSHJ	PP,PUTASY
	SKIPN	CH,PLITPC		;GET POOLED LIT
	SKIPA	CH,ELITPC		;NOT POOLED, USE THE INCREMENT TO LIT00%
	CAIA
	AOS	ELITPC
	IORI	CH,AS.LIT
	PUSHJ	PP,PUTASN

	HLRZ	TA,UUOSV%		; [402] PICK UUO
	TRNN	TA,IM.IX!IM.IN		; [402] IF NO INDEX OR INDIRECT
	JRST	CNVUU6			; [402] GO GENERATE NOW , THE PUSHJ
	LDB	TE,[POINT 7,UUOSV%,8]	;GET OPERATOR
	CAIN	TE,UUOWAC		;OPEN AND CLOSE ARE SPECIAL
	JRST	CNVUU6			;NEED THESE BITS FOR VARIOUS FUNCTIONS
	MOVE	CH,[EXP <HRRI.+AC16>B17+<Z @>+<<AC16>_<-5>>]	; [402] GENERATE
	PUSHJ	PP,PUTASY		; [402] "HRRI 16,@16"


CNVUU6:			;NOW FOR THE PUSHJ
	;FIRST GET EXTAB INDEX FROM TABLE
	MOVE	CH,UUOSV%	;GET UUO BACK
	LDB	TE,[IP.OP]	;OPERATOR
	CAIGE	TE,UUOWAC	;NEED AC ??
	JRST	CNVUU9		;NO
	LDB	TD,[IP.ACH]	;YES- GET AC
	CAIG	TE,UUOWAC	;IS OPEN/CLOSE
	SETZI	TD,		;YES- CLEAR HIGH 3 BITS
	TLNE	CH,IM.ACL		;RIGHT OR LEFT HALF OF TABLE?
	SKIPA	CH,@UUOTBB-UUOWAC(TE)	;RIGHT
	HLRZ	CH,@UUOTBB-UUOWAC(TE)	;LEFT
	JRST	CNVU10

CNVUU9:				;AC DOES NOT EXTEND OP CODE
	HRRZ	CH,UUOTB6-FSTUUO(TE)	;GET EXTAB INDEX

CNVU10:				;PUT OUT PUSHJ
	TRNN	CH,77777	;FIRST CHECK FOR LEGAL INDEX
	PUSHJ	PP,CNVER	;NO LEGAL
	PUSHJ	PP,GNPSX.	;GO GENERATE THE PUSHJ.
	POP	PP,TA		;RESTORE TA

CNVUED:
	POP	PP,TD
	POP	PP,TE
	POPJ	PP,

CNVER:	OUTSTR	[ASCIZ	'?Compiler error - UUO conversion
']
	SWON	FFATAL		;SET ERROR FLAG
	POPJ	PP,
; A TABLE OF POINTERS TO DISPATCH TABLES

UUOTBB:	Z	UUO1.(TD)
	Z	UUO2.(TD)
	Z	UUO3.(TD)
	Z	UUO4.(TD)
	Z	UUO5.(TD)

	DEFINE TABLE2,<
UUOTB6.:	TABSEP	<FIX%,0>
	TABSEP	<PERF%,FLOT%1,FLOT%2,PD6%,PD7%,GD6%,GD7%>
	TABSEP	<NEG%,MAG%,ADD%12,ADD%21,ADD%22>
	TABSEP	<SUB%12,SUB%21,SUB%22,MUL%12,MUL%21,MUL%22>
	TABSEP	<DIV%11,DIV%12,DIV%21,DIV%22>
	>

	DEFINE	TABSEP (Y),<
	IRP Y,<IFDIF	<Y><0>,<EXTERNAL	Y>
	EXP	Y
	>>

UUO1.:	XWD	C%OPEN##,C%CLOS##
UUO2.:	XWD	DSPLY%##,ACEPT%##
	XWD	READ%##,WRITE%##
IFN ANS68,<
	XWD	WADV%##,SEEK%##
>
IFN ANS74,<
	XWD	WADV%##,RDNXT%##
>
	XWD	DELET%##,RERIT%##
	XWD	PURGE%##,INIT%##
	XWD	TERM%##,0
	XWD	DSPL%6##,DSPL%7##
	XWD	0,0
UUO3.:	XWD	COMP%##,CMP%76##
	XWD	0,NUM%6##
	XWD	ALF%6##,ZERO%6##
	XWD	POS%6##,NEG%6##
	XWD	0,NUM%7##
	XWD	ALF%7##,ZERO%7##
	XWD	POS%7##,NEG%7##
	XWD	COMP%D##,0
UUO4.:	XWD	MOVE%##,C%D6D7##
	XWD	C%D7D6##,CMP%E##
	XWD	CMP%G##,CMP%GE##
	XWD	CMP%L##,CMP%LE##
	XWD	CMP%N##,0
	REPEAT 3,<	XWD	0,0>
UUO5.:	XWD	EDIT%S##,EDIT%U##
IFN ANS68,<
	XWD	EXAM%##,SUBSC%##
>
IFN ANS74,<
	XWD	INSP%##,SUBSC%##
>
	XWD	SIZE%1##,SIZE%2##
	XWD	SIZE%3##,E%C3C1##
	XWD	E%C3C3##,OVLAY%##
	XWD	C%EXIT##,ARGS%##
	XWD	PUTF%##,RESF%##
	XWD	GETNM%##,ILLC%##	

	TABLE2

;ROUTINE TO GENERATE:

;	HRRZI	16,	<ADR>
;	PUSHJ	17,	<EXTERNAL>

;WHERE:
;	EXTERNAL = RH(CH)
;	ADR = (EACC) IF NON ZERO OR SXR IF (EACC) IS ZERO.

PMOPV.::
	HRLM	CH,	(PP)		;SAVE THE EXTERNAL.
	PUSH	PP,	[EXP	PMOPU7]	;WHERE WE GO NEXT.

	MOVE	CH,	[XWD	HRRZI.+AC16,SXR]	;ASSUME (EACC)=0.

	JUMPE	EACC,	PUTASY		;IF THE PARAMETER IS GOING TO
					; BE IN SXR, GO GENERATE THE
					; INSTRUCTION AND GO ON.
	TLO	CH,	ASINC		;OTHERWISE CHANGE THE ADDRESS
	HRRI	CH,	AS.MSC		; SO THAT IT HAS AN INCREMENT.
	PUSHJ	PP,	PUTASY		; GENERATE THE INSTRUCTION.
	HRRZI	CH,	(EACC)		;GET THE ADDRESS PORTION
	PJRST		PUTASN		;GO WRITE IT OUT AND GO ON.


IFN BIS,<
;ROUTINE TO GENERATE:

;	HRRZI	16,	<EBASEB+EINCRB>
;	PUSHJ	17,	<EXTERNAL>

;WHERE:
;	EXTERNAL = RH(CH)

PMOPB.::
	HRLM	CH,(PP)			;SAVE THE EXTERNAL.
	PUSH	PP,[EXP	PMOPU7]		;WHERE WE GO NEXT.
	MOVSI	CH,HRRZI.+AC16
	JRST	PUT.B			;GET ADDRESS

;ROUTINE TO GENERATE:

;	HRRZI	16,	<POWER OF TEN>
;	PUSHJ	17,	<EXTERNAL>

;WHERE:
;	EXTERNAL = RH(CH)
;	POWER OF TEN = TC

PMOPC.::
	PUSHJ	PP,CREATL		;GET POWER OF TEN IN LIT POOL
	MOVE	EACC,EPWR10(TC)		;GET ADDRESS OF LITERAL
	JRST	PMOPV.			;GENERATE CALL
>
;ROUTINE TO GENERATE:

;		MOVE	16,	%LIT
;		PUSHJ	17,	<EXTERNAL>
;		.
;		.
;		.
;	%LIT:	BYTE	(9)0(4)AC(5)0(18)ADR

;WHERE:
;	EXTERNAL = RH(CH)
;	AC = (EAC)
;	ADR = (EACC) IF NON ZERO OR SXR IF (EACC) IS 0.

PMOPU.::
	SKIPN		EAC		;IF THE AC FIELD IS GOING TO BE
	JRST		PMOPV.		; ZERO GO GENERATE HRRZI INSTEAD.

	HRLM	CH,	(PP)		;SAVE THE EXTERNAL.

	MOVE	TA,	[XWD	XWDLIT,2]	;SET UP XWD HEADER.
	PUSHJ	PP,	STASHP		;GO WRITE IT OUT.

	HRRZ	TA,	EAC		;GET THE AC.
	LSH	TA,	5		;PUT IT IN THE AC FIELD.
	PUSHJ	PP,	STASHQ		;WRITE OUT THE LH OF THE XWD.

	MOVEI	TA,	SXR		;ASSUME THE PARAMETER IS IN SXR.
	JUMPE	EACC,	PMOPU5		;IS IT?
	HRLI	TA,	(EACC)		;NO, GET IT.
	HRRI	TA,	AS.MSC		;IT IS MISCELLANEOUS.
PMOPU5:	PUSHJ	PP,	POOLIT		;WRITE OUT THE RH OF THE XWD.

	MOVE	CH,	[XWD	MOV+AC16,AS.MSC]	;GET THE MOVE INSTR.
	PUSHJ	PP,	PUTASY		;WRITE IT OUT.
	SKIPN	CH,	PLITPC		;GET PC IF POOLED
	SKIPA	CH,	ELITPC		;GET THE LITAB PC.
	CAIA
	AOS		ELITPC		;BUMP IT OVER THE XWD.
	IORI	CH,	AS.LIT		;FORM THE XWD'S ADDRESS.
	PUSHJ	PP,	PUTASN		;WRITE IT OUT.

PMOPU7:	HLRZ	CH,	(PP)		;GET THE EXTERNAL BACK AND
					; FALL INTO THE ROUTINE TO PUT
					; OUT "PUSHJ 17,<EXTERNAL>".
;ROUTINE TO GENERATE "PUSHJ	17,<EXTERNAL>".

;	ENTER WITH THE EXTAB ADDRESS OF THE EXTERNAL IN RH(CH).

GNPSX.::
	HRRZI	TA,	(CH)		;SAVE THE EXTAB LINK.
	HRLI	CH,	EPJPP		;FORM THE INSTRUCTION.
	PUSHJ	PP,	PUTASY		;GO PUT IT IN THE ASY FILE.
	ANDI	TA,	LMASKB##	;GET THE EXTAB OFFSET.
	ADD	TA,	EXTLOC		;FORM THE ADDRESS.
	SETOI	TE,			;GET SOME ONES.
	TSWF	FAS3;			;ARE WE IN A NONRESIDENT SEGMENT?
	DPB	TE,	EX.NRS##	;YES, SET THE FLAG.
	POPJ	PP,			;RETURN.
;CREATE THE LITERAL <SIXBIT "000000">

SZERO.:	SKIPE	ESZERO		;HAS IT ALREADY BEEN GENERATED?
	POPJ	PP,		;YES--RETURN

	MOVE	TB,[SIXBIT "000000"]	;NO
	PUSHJ	PP,SLITX.
	MOVEM	TB,ESZERO	;SET ADDRESS
	POPJ	PP,

;CREATE THE LITERAL <SIXBIT '""""""'>

SQUOT.:	SKIPE	ESQUOT		;HAS IT ALREADY BEEN GENERATED?
	POPJ	PP,		;YES--RETURN

	MOVE	TB,[SIXBIT '""""""']	;NO
	PUSHJ	PP,SLITX.
	MOVEM	TB,ESQUOT
	POPJ	PP,


;NOTE, DON'T POOL THESE LITERAL, THEY ARE POOLED ALREADY
ELITX.:	SKIPA	TA,[XWD	EBCLIT,1]	;PUT ONE EBCDIC LITERAL IN LITAB.
SLITX.:	MOVE	TA,[XWD SIXLIT,1]
	PUSHJ	PP,STASHI
	MOVE	TA,TB
	PUSHJ	PP,STASHL
	MOVE	TB,ELITPC
	AOS	ELITPC
	IORI	TB,AS.LIT
	POPJ	PP,
;[722] CREATE THE LITERAL SIXBIT HIGH-VALUES WITH PROG. COL. SEQ.

IFN ANS74,<
SHVAL.:	SKIPE	ESHIVL##	;[722] HAS IT ALREADY BEEN GENERATED?
	POPJ	PP,		;[722] YES--RETURN

	HRRZ	TB,COHVLV##	;[722] NO, GET HIGH-VALUE CHAR.
	IMULI	TB,10101	;[722] THREE CHARACTERS
	HRL	TB,TB		;[722] SIX CHARACTERS
	PUSHJ	PP,SLITX.	;[722]
	MOVEM	TB,ESHIVL	;[722] SET ADDRESS
	POPJ	PP,		;[722]

;[722] CREATE THE LITERAL SIXBIT LOW-VALUES WITH PROG. COL. SEQ.

SLVAL.:	SKIPE	ESLOVL##	;[722] HAS IT ALREADY BEEN GENERATED?
	POPJ	PP,		;[722] YES--RETURN

	HRRZ	TB,COHVLV+3	;[722] NO, GET LOW-VALUE CHAR.
	IMULI	TB,10101	;[722] THREE CHARACTERS
	HRL	TB,TB		;[722] SIX CHARACTERS
	PUSHJ	PP,SLITX.	;[722]
	MOVEM	TB,ESLOVL	;[722]SET ADDRESS
	POPJ	PP,		;[722]
>
;CREATE THE LITERAL <XWD 360360,360360> (EBCDIC '0000')

EZERO.::
	SKIPE		EEZERO##	;HAS IT ALREADY BEEN GENERATED?
	POPJ	PP,			;YES, RETURN.

	MOVE	TB,	[XWD	360360,360360]	;GET THE LITERAL.
	PUSHJ	PP,	ELITX.		;GO PUT IT IN LITAB.
	MOVEM	TB,	EEZERO##	;REMEMBER ITS ADDRESS.
	POPJ	PP,			;RETURN.


;CREATE THE LITERAL <XWD 377377,377377> (EBCDIC HIGH VALUES)

EHVLS.::
	SKIPE		EEHIGH##	;HAS IT ALREADY BEEN GENERATED?
	POPJ	PP,			;YES, RETURN.
IFN ANS74,<
	SKIPLE	COLSEQ			;[1004] [722] PROGRAM COL. SEQ.?
	JRST	[HRRZ	TB,COHVLV+2		;[722] YES, GET EBCDIC HIGH-VALUE
		IMUL	TB,[1001,,1001]		;[722] 4 CHARS.
		JRST	.+2]			;[722]
>
	MOVE	TB,	[XWD	377377,377377]	;GET THE LITERAL.
	PUSHJ	PP,	ELITX.		;GO PUT IT IN LITAB.
	MOVEM	TB,	EEHIGH##	;REMEMBER ITS ADDRESS.
	POPJ	PP,			;RETURN.

IFN ANS74,<
;[722] CREATE THE LITERAL  (EBCDIC LOW VALUES)

ELVLS.::
	SKIPE	EELOW##			;[722] HAS IT ALREADY BEEN GENERATED?
	POPJ	PP,			;[722] YES, RETURN.
	HRRZ	TB,COHVLV+5		;[722] GET EBCDIC LOW-VALUE
	IMUL	TB,[1001,,1001]		;[722] 4 CHARS.
	PUSHJ	PP,ELITX.		;[722] GO PUT IT IN LITAB.
	MOVEM	TB,EELOW##		;[722] REMEMBER ITS ADDRESS.
	POPJ	PP,			;[722] RETURN.
>

;CREATE THE LITERAL <XWD 100100,100100> (EBCDIC '    ')

ESPAC.::
	SKIPE		EESPCE##	;HAS IT ALREADY BEEN GENERATED?
	POPJ	PP,			;YES, RETURN.

	MOVE	TB,	[XWD	100100,100100]	;GET THE LITERAL.
	PUSHJ	PP,	ELITX.		;GO PUT IT IN LITAB.
	MOVEM	TB,	EESPCE##	;REMEMBER ITS ADDRESS.
	POPJ	PP,			;RETURN.


;CREATE THE LITERAL <XWD 177177,177177> (EBCDIC '""""')

EQUOT.::
	SKIPE		EEQUOT##	;HAS IT ALREADY BEEN GENERATED?
	POPJ	PP,			;YES, RETURN.

	MOVE	TB,	[XWD	177177,177177]	;GET THE LITERAL
	PUSHJ	PP,	ELITX.		;GO PUT IT IN LITAB.
	MOVEM	TB,	EEQUOT##	;REMEMBER ITS ADDRESS.
	POPJ	PP,			;RETURN.
;CREATE THE LITERAL
;	OCT	231231231231
;	OCT	231231231231
;	OCT	231231231237
;(COMP-3 HIGH-VALUES PIC S9(18).)

C3HVL.::
	SKIPE	EACC,	C3HIVL##	;HAS IT ALREADY BEEN GENERATED?
	POPJ	PP,			;YES, RETURN.

	PUSH	PP,	[XWD	231237,C3HIVL##]	;SET UP THE
	PUSH	PP,	[XWD	231231,231231]		; PARAMETERS.

	PJRST		PC3LIT		;GO WRITE OUT THE LITERAL.

;CREATE THE LITERAL
;	OCT	231231231231
;	OCT	231231231231
;	OCT	231231231233
;(COMP-3 LOW-VALUES PIC S9(18).)

C3LVL.::
	SKIPE	EACC,	C3LOVL##	;HAS IT ALREADY BEEN GENERATED?
	POPJ	PP,			;YES, RETURN.

	PUSH	PP,	[XWD	231233,C3LOVL##]	;SET UP THE
	PUSH	PP,	[XWD	231231,231231]		; PARAMETERS.

	PJRST		PC3LIT		;GO WRITE OUT THE LITERAL.

;CREATE THE LITERAL
;	OCT	0
;	OCT	0
;	OCT	17 ;[1307] ASSUMES UNSIGNED, SIGNED SHOULD BE OCT 14
;(COMP-3 ZERO PIC 9(18) OR S9(18).)	;[1307]

C3ZRO.::
;[1307] GENERATE LITERAL SEPARATELY FOR EACH RECEIVING OPERAND, AS THERE
;[1307] MAY BE A MIX OF SIGNED AND UNSIGNED RECEIVING OPERANDS.
;[D1307] SKIPE	EACC,	C3ZERO##	;HAS IT ALREADY BEEN GENERATED?
;[D1307] POPJ	PP,			;YES, RETURN.

	TSWF	FBSIGN	;[1307] If receiving operand is signed
	PUSH	PP,	[XWD	14,C3ZERO##] ;[1307] Make Literal signed
	TSWT	FBSIGN	;[1307] Else make it unsigned
	PUSH	PP,	[XWD	17,C3ZERO##]	;SET UP THE
	SETZ	EACC,				;[1355] ZERO FIRST PART OF LIT.
	PUSH	PP,	EACC			; PARAMETERS.

					;AND FALL INTO THE SUBROUTINE.
;NOTE, DON'T POOL THESE LITERALS
PC3LIT:	MOVE	TA,	[XWD	OCTLIT,3]	;SET UP THE HEADER.
	PUSHJ	PP,	STASHI		;GO WRITE IT OUT.

	POP	PP,	TA		;GET THE FIRST 3 DIGITS.
	PUSHJ	PP,	STASHL		;GO WRITE THEM OUT.
	PUSHJ	PP,	STASHL		;THE NEXT 8 ARE THE SAME.
	HLR	TA,	(PP)		;GET THE LAST 3 AND THE SIGN.
					; THE PRECEEDING 4 DON'T CHANGE.
	PUSHJ	PP,	STASHL		;GO WRITE THEM OUT.

	MOVEI	EACC,	3		;GET THE ADDRESS AND
	EXCH	EACC,	ELITPC		; BUMP THE PC.
	ADDM	EACC,	ELITPC

	IORI	EACC,	AS.LIT		;NOTE THAT IT IS IN LITTAB.
	POP	PP,	TA		;GET THE LOCATION INTO WHICH
					; WE SHOULD PUT THE ADDRESS.
	MOVEM	EACC,	(TA)		;REMEMBER WHERE WE PUT THE LIT.

	POPJ	PP,			;RETURN.
;CREATE THE LITERAL <ASCII "00000">, AND THE SAME LITERAL
;	SHIFTED RIGHT 1 BIT.

AZRJ.:	SKIPE	EAZRJ		;HAVE THEY ALREADY BEEN GENERATED?
	POPJ	PP,		;YES--RETURN

	MOVE	TB,[ASCII "00000"]	;NO
	PUSHJ	PP,AXRJ.
	MOVEM	TB,EAZRJ
	POPJ	PP,


;CREATE THE LITERAL <ASCII "     ">, AND THE SAME LITERAL
;	SHIFTED RIGHT 1 BIT.

ASRJ.:	SKIPE	EASRJ		;HAVE THEY ALREADY BEEN GENERATED?
	POPJ	PP,		;YES--RETURN

	MOVE	TB,[ASCII "     "]	;NO
	PUSHJ	PP,AXRJ.
	MOVEM	TB,EASRJ
	POPJ	PP,


;CREATE THE LITERAL <ASCII '"""""'>, AND THE SAME LITERAL
;	SHIFTED RIGHT 1 BIT.

AQRJ.:	SKIPE	EAQRJ		;HAVE THEY ALREADY BEEN GENERATED?
	POPJ	PP,		;YES--RETURN

	MOVE	TB,[ASCII '"""""']	;NO
	PUSHJ	PP,AXRJ.
	MOVEM	TB,EAQRJ
	POPJ	PP,

;CREATE THE LITERAL ASCII HIGH-VALUES, AND THE SAME LITERAL
;	SHIFTED RIGHT 1 BIT.

AHRJ.:	SKIPE	EAHRJ##		;HAVE THEY ALREADY BEEN GENERATED?
	POPJ	PP,		;YES--RETURN

IFN ANS74,<
	SKIPLE	COLSEQ##	;[1004] [722] PROGRAM COLLATING SEQUENCE
	JRST	[HRRZ	TB,COHVLV+1	;[722] YES, GET ASCII HIGH-VALUE CHAR.
		IMUL	TB,[2010,,40201]	;[722] 5 CHARACTERS
		LSH	TB,1		;[722] LEFT JUSTIFIED (MUST BE SEPARATE TO AVOID OVERFLOW)
		JRST	.+2]		;[722]
>
	MOVE	TB,[BYTE (7) 177,177,177,177,177]	;NO
	PUSHJ	PP,AXRJ.
	MOVEM	TB,EAHRJ
	POPJ	PP,

;CREATE THE LITERAL ASCII LOW-VALUES, AND THE SAME LITERAL
;	SHIFTED RIGHT 1 BIT.

ALRJ.:	SKIPE	EALRJ##		;HAVE THEY ALREADY BEEN GENERATED?
	POPJ	PP,		;YES--RETURN

IFN ANS74,<
	SKIPLE	COLSEQ##	;[1004] [722] PROGRAM COLLATING SEQUENCE
	JRST	[HRRZ	TB,COHVLV+4	;[722] YES, GET ASCII LOW-VALUE CHAR.
		IMUL	TB,[2010,,40201]	;[722] 5 CHARACTERS
		LSH	TB,1		;[722] LEFT JUSTIFIED (MUST BE SEPARATE TO AVOID OVERFLOW)
		JRST	.+2]		;[722]
>
	SETZ	TB,		;[BYTE (7) 0,0,0,0,0]
	PUSHJ	PP,AXRJ.
	MOVEM	TB,EALRJ
	POPJ	PP,

;NOTE, DON'T POOL THESE LITERALS
AXRJ.:	MOVE	TA,[XWD ASCLIT,1]
	PUSHJ	PP,STASHI
	MOVE	TA,TB
	PUSHJ	PP,STASHL
	AOS	ELITPC
	MOVE	TA,[XWD OCTLIT,1]
	PUSHJ	PP,STASHI
	MOVE	TA,TB
	LSH	TA,-1
	PUSHJ	PP,STASHL
	AOS	TB,ELITPC
	SUBI	TB,2		;BACKUP TO START OF LITERAL PAIR
	IORI	TB,AS.LIT

	POPJ	PP,
;CREATE TWO-WORD "HIGH-VALUE" LITERAL

HIVAL::	SKIPE	EHIVAL		;IS THERE ONE ALREADY?
	POPJ	PP,		;YES--QUIT

	HRLOI	TC,377777	;NO
	PUSHJ	PP,HILO.
	MOVEM	TE,EHIVAL
	POPJ	PP,

;CREATE TWO-WORD "LOW-VALUE" LITERAL

LOVAL::	SKIPE	ELOVAL		;IS THERE ONE ALREADY?
	POPJ	PP,		;YES--QUIT

	HRLZI	TC,1B18		;NO
	PUSHJ	PP,HILO.
	MOVEM	TE,ELOVAL
	POPJ	PP,

;CREATE LOW-VALUE FOR FLOATING-POINT

FPLOV.:	SKIPE	EFPLOV		;IS THERE ONE ALREADY?
	POPJ	PP,		;YES--QUIT

	MOVE	TA,[XWD OCTLIT,1]	;NO
	PUSHJ	PP,STASHI
	MOVE	TA,[EXP 1B0!1B35]
	PUSHJ	PP,STASHL
	MOVE	TA,ELITPC
	IORI	TA,AS.LIT
	MOVEM	TA,EFPLOV

	AOS	ELITPC
	POPJ	PP,

;COMMON ROUTINE FOR HIVAL. & LOVAL.

HILO.:	MOVE	TA,[XWD OCTLIT,2]
	PUSHJ	PP,STASHI
	MOVE	TA,TC
	PUSHJ	PP,STASHL
	PUSHJ	PP,STASHL

	MOVEI	TE,2
	EXCH	TE,ELITPC
	ADDM	TE,ELITPC

	IORI	TE,AS.LIT
	POPJ	PP,
;INCREMENT PARAMETERS OF "A" OPERAND BY THE NUMBER OF BYTES
;	WHOSE VALUE IS IN "TE".

M.IA:	MOVE	TC,EMODEA
	CAIN	TC,	C3MODE		;IF IT'S COMP-3, GO CHANGE
	PUSHJ	PP,	M.IA2		; IT TO DISPLAY-9.
	IDIV	TE,BYTE.W(TC)	;ADJUST INCREMENT
	ADDM	TE,EINCRA
	HLRZ	TE,ERESA
	PUSHJ	PP,M.IB5
	JUMPG	TE,M.IA1	;TO BIT 35 OR BEYOND?

	AOS	EINCRA		;YES--INCREMENT THE INCREMENT
	ADDI	TE,^D36		;RESET RESIDUE

M.IA1:	HRLM	TE,ERESA
	POPJ	PP,

M.IA2:	SKIPN	TC,	ESIZEA		;SKIPPING THE WHOLE THING?
	JRST		M.IB7		;YES.
	JRST		M.IB6N		;NO.

;INCREMENT PARAMETERS OF "B" OPERAND BY THE NUMBER OF BYTES
;	WHOSE VALUE IS IN "TE".

M.IB:	HRRZ	TC,EMODEB
	CAIN	TC,	C3MODE		;IF IT'S COMP-3 GO CHANGE
	PUSHJ	PP,	M.IB6		; IT TO DISPLAY-9.
	IDIV	TE,BYTE.W(TC)
	ADDM	TE,EINCRB
	PUSHJ	PP,M.IB4
	JUMPG	TE,M.IB1

	AOS	EINCRB
	ADDI	TE,^D36

M.IB1:	HRLM	TE,ERESB
	POPJ	PP,

M.IB4:	HLRZ	TE,ERESB
M.IB5:	IMUL	TD,BYTE.S(TC)
	SUB	TE,TD
	CAML	TE,BYTE.S(TC)
	POPJ	PP,

	CAIN	TC,D7MODE
	SUBI	TE,1
	POPJ	PP,

M.IB6:	SKIPN	TC,	ESIZEB		;SKIPPING THE WHOLE THING?
	JRST		M.IB7		;YES.
M.IB6N:	ADDI	TC,	(TE)		;FORM THE ORIGIONAL LENGTH.
	TRNN	TC,	1		;IF IT WAS EVEN
	ADDI	TE,	1		; MAKE SURE WE SKIP TO THE
	TRNA				; NEXT BYTE.
M.IB7:	ADDI	TE,	2		;ROUND UP AND SKIP THE SIGN.
M.IB8:	LSH	TE,	-1		;NUMBER OF 9 BIT BYTES TO SKIP.
	MOVEI	TC,	D9MODE		;PRETEND IT'S DISPLAY-9.
	POPJ	PP,			;RETURN.
;GET A BYTE POINTER TO "A", IN ASYFIL XWD FORMAT, INTO TA&TB

BYTE.A:	MOVEI	TE,EBASEA

BYTE.X:	HRRZ	TC,EMODEX(TE)
	HLRZ	TA,ERESX(TE)
	LSH	TA,6
	ADD	TA,BYTE.S(TC)
	ROT	TA,-14

BYTE.Y:	HRRI	TA,AS.CNB
	MOVE	TB,EBASEX(TE)
	HRL	TB,EINCRX(TE)

	POPJ	PP,


;SIMILAR TO BYTE.A, EXCEPT FOR "B"

BYTE.B:	MOVEI	TE,EBASEB
	JRST	BYTE.X

;SIMILAR TO BYTE.B, EXCEPT SIZE PUT INTO BITS 6-17

BYTE.C:	MOVEI	TE,EBASEB
	HLRZ	TA,ERESB
	LSH	TA,14
	ADD	TA,ESIZEZ
	HRLZS	TA

	JRST	BYTE.Y
;PUT A SINGLE WORD INTO EOPTAB.
;ENTER AT PUSEOP WITH WORD IN 'CH'.

PUSEO1:	PUSHJ	PP,XPNEOP	;EXPAND EOPTAB
PUSEOP:	MOVE	EACA,EOPNXT
	CAML	EACA,[XWD -1,0]	;ENOUGH ROOM?
	JRST	PUSEO1		;NO
	PUSH	EACA,CH		;YES--STASH IT
	MOVEM	EACA,EOPNXT	;SAVE EACA
	POPJ	PP,


;STASH W1&W2 IN EOPTAB.
;ENTER AT PUSH12.

PUS12A:	PUSHJ	PP,XPNEOP	;EXPAND EOPTAB
PUSH12:	MOVE	EACA,EOPNXT	;GET END OF TABLE
	CAML	EACA,[XWD -2,0]	;ENOUGH ROOM FOR TWO WORDS?
	JRST	PUS12A		;NO
	PUSH	EACA,W1		;YES--STASH W1
	PUSH	EACA,W2		;  AND W2
	MOVEM	EACA,EOPNXT	;SAVE EACA
	POPJ	PP,
;HERE FOR LITERAL POOLING

;STASHP JUST STORES A LITERAL IN THE TEST POOL
;	IF THE POOL IS FULL DUMP THE CONTENTS INTO STASHL AND SET FLAG
;
;POOLIT	STORES THE CURRENT LITERAL IN POOL
;	THEN TESTS ENTIRE CONTENTS OF POOL AGAINST LITTAB
;	IF A MATCH IS FOUND PLITPC POINT TO START OF LITERAL
;	IF NO MATCH IS FOUND THE LITERAL IS PUT IN LITTAB AND PLITPC SET TO ZERO

;INITIALIZE THE POINTERS
POOLINI::
	MOVEI	TE,1
	MOVEM	TE,PLITOF##	;SET OFFSET TO 1 INITIALL TO ACCOUNT FOR ZERO
PLINI1:	SETZM	PLITPC##	;SET NO POOLED PC
PLINI2:	MOVEI	TE,PLITSZ##	;GET SIZE
	MOVEM	TE,PLITCT##	;INITIALIZE THE COUNT
PLINI3:	MOVE	TE,[POINT 36,PLITBF##]
	MOVEM	TE,PLITPT##	;INITIALIZE THE POINTER
	POPJ	PP,

;STORE THE HEADER OF A LITERAL IN THE POOL BUFFER

STASHP:	SKIPGE	PLITCT		;ANY ROOM?
	JRST	STASHI		;NO
	SOSGE	PLITCT		;ONE MORE WORD?
	JRST	[PUSHJ	PP,POOLFL	;NO, POOL JUST FILLED UP
		JRST	STASHI]
	TRNN	TA,770000	;[1353] VERY LARGE LITERAL?
	JRST	STASHR		;[1353]  NO
	MOVEI	DW,E.653	;[1353]  YES
	JRST	BADLIT		;[1353] GIVE ERROR
;[1353]	HALT			;YES
STASHR:	HRRZ	TE,TA		;[1353] GET SIZE
	HLLZ	TA,TA		;GET TYPE ONLY
	LSH	TA,-6
	IOR	TA,TE		;ADD IN SIZE
	HRL	TA,ELITPC	;AND PUT LIT P.C. IN LHS
	JRST	STSHP0
;STORE REST OF LITERAL IN POOL BUFFER

STASHQ:	SKIPGE	PLITCT		;ANY ROOM?
	JRST	STASHL		;NO
	SOSGE	PLITCT		;ONE MORE WORD?
	JRST	[PUSHJ	PP,POOLFL	;NO, POOL JUST FILLED UP
		JRST	STASHL]
STSHP0:	IDPB	TA,PLITPT	;YES, STORE
	POPJ	PP,

POOLFL:	PUSH	PP,TA		;SAVE CURRENT LITERAL
	PUSHJ	PP,PLINI1	;RESET POINTERS
	ILDB	TA,PLITPT	;GET LITERAL
	PUSHJ	PP,STASHL	;STORE
	SOSLE	PLITCT		;COUNT DOWN
	JRST	.-3		;LOOP
	SETOM	PLITCT		;MAKE SURE WE DON'T COME AGAIN
	POP	PP,TA		;ORIGINAL LIT
	POPJ	PP,

;ACC USAGE
;TA	POINTER INTO LITTAB
;TB	POINTER INTO PLITBF
;TC	END OF LITTAB
;TD	COUNTER OF ITEMS IN THIS LITERAL
;TE	DATUM

POOLIT::
	PUSHJ	PP,STASHQ	;STORE THIS LITERAL
POOL::	SKIPGE	PLITCT		;ANYTHING IN POOL?
	JRST	PLINI1		;NO, RESET POINTERS
	MOVE	TE,[TD,,SAVEAC]
	BLT	TE,SAVEAC+4	;SAVE TD THRU TA
	MOVEI	TB,PLITBF	;BASE OF POOLED LITS
	HRRZ	TC,LITNXT	;END OF LITS
	HRRZ	TA,LITLOC	;BASE OF LITS
	ADD	TA,PLITOF	;BYPASS FIRST WORD (ITS ZERO)
PLIT0:	MOVEI	TB,PLITBF	;BASE OF POOLED LITS
PLIT1:	HRRZ	TE,(TA)		;GET LITERAL FROM LITTAB
	HRRZ	TD,(TB)		;AND FROM POOLING BUFFER
	CAMN	TE,TD		;MATCH?
	AOJA	TB,PLIT2	;YES
	ANDI	TE,7777		;GET SIZE
	ADDI	TA,1(TE)	;BYPASS THIS GROUP
	CAIGE	TA,(TC)		;AT END?
	JRST	PLIT1		;NO
PLIT1A:	MOVS	TE,[TD,,SAVEAC]	;[1103] New label
	BLT	TE,TA		;RESTORE
	PUSHJ	PP,PLINI3	;RESET POINTER
	MOVNI	TE,PLITSZ
	ADDM	TE,PLITCT	;- COUNT OF WORDS TO MOVE
	ILDB	TA,PLITPT	;GET LITERAL
	PUSHJ	PP,STASHL	;STORE IT
	AOSGE	PLITCT		;COUNT DOWN
	JRST	.-3
	JRST	PLINI1		;RETURN WITH PLITPC=0

;POOL ROUTINE (CONT'D)

PLIT2:	MOVE	TD,(TA)		;GET WORD AGAIN
	HLRZM	TD,PLITPC	;ASSUME SUCCESS
PLIT3:	ANDI	TD,7777		;FORM COUNT
	MOVN	TD,TD		;NEGATE TO
	HRL	TB,TD		; FORM AOBJN POINTER
PLIT4:	ADDI	TA,1		;BUMP POINTER
	MOVE	TE,(TA)		;GET LITERAL
	CAME	TE,(TB)		;MATCH?
	JRST	PLIT90		;NO
	AOBJN	TB,PLIT4	;LOOP FOR ALL OF IT
	HRRZ	TE,PLITPT	;GET END OF BUFFER
	CAIGE	TE,(TB)		;FINISHED?
	JRST	PLIT99		;YES, FOUND A MATCH
	CAMN	TA,TC		;[1103] Is the group that just matched
				;[1103] the first literal group at the
				;[1103] logical end of the literals?
	 JRST	PLIT1A		;[1103] Yes, can't pool even if it matches
				;[1103] past the end
	ADDI	TA,1		;BYPASS HEADER
	HRRZ	TD,(TA)		;GET NEXT GROUP HEADER
	HRRZ	TE,(TB)
	CAMN	TD,TE		;MATCH?
	AOJA	TB,PLIT3	;YES
PLIT90:	HLRE	TB,TB		;GET WORDS LEFT
	MOVM	TB,TB
	ADDI	TA,(TB)		;BYPASS REST OF GROUP
	JRST	PLIT0		;AND TRY AGAIN

PLIT99:	SKIPN	PLITPC		;MAKE SURE ITS NOT AT LIT+00
	JRST	PLIT0		;TOO BAD, WE CAN NOT TELL IT FROM FAILURE
	MOVS	TE,[TD,,SAVEAC]	;OK
	BLT	TE,TA		;RESTORE
	JRST	PLINI2		;SUCCESSFUL RETURN
;PUT A WORD INTO AS.LIT

;IF LITAB IS FULL AND < FULLIT WORDS, EXPAND AS.LIT
;IF LITAB 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 (SEE EBURPL IN XFRGEN),
			;YET SMALL ENOUGH SO THAT CURRENT LITERAL GROUP
			;BEING STASHED WILL NOT BE WRITTEN OUT.
			;LARGEST LITERAL GROUP IS ASCII, SIZE 120, OR
			;  A MULTI-DIMENSION SUBSCRIPT CALL.

STASHI:	SETZM	PLITPC		;JUST INCASE STILL SET
	TRNN	TA,770000	;[1353] VERY LARGE LITERAL?
	JRST	STASHK		;[1353]  NO
	MOVEI	DW,E.653	;[1353]  YES
	JRST	BADLIT		;[1353] GIVE ERROR
;[1353]	HALT			;YES
STASHK:	HRRZ	TE,TA		;[1353] GET SIZE
	HLLZ	TA,TA		;GET TYPE ONLY
	LSH	TA,-6
	IOR	TA,TE		;ADD IN SIZE
	HRL	TA,ELITPC	;AND PUT LIT P.C. IN LHS
IFN DEBUG,<
	SKIPN	TE,ELITPC
	JRST	STASHL		;IGNORE FIRST TIME
	EXCH	TE,IMPAT.##
	CAML	TE,IMPAT.	;IT BETTER INCREASE IN SIZE
	JFCL			;PUT BREAK POINT HERE
>

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,

;TABLE IS FULL

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

STSHL1:	SKIPE	ALITSV##	;[1077] NEED TO SAVE A PTR?
	 JRST	STSL1A		;[1077] YES
	PUSHJ	PP,XPNLIT	;NO--EXPAND LITAB
	JRST	STASHL		;TRY AGAIN

;[1077] THE ABSOLUTE POINTER TO LITTAB WILL NOT BE ANY GOOD AFTER
;[1077] THIS, SO WE HAVE TO MAKE IT A RELATIVE POINTER DURING THE
;[1077] TABLE EXPANSION.
STSL1A:	PUSH	PP,TA		;[1077] SAVE A COUPLE ACS
	PUSH	PP,TE		;[1077]
	PUSH	PP,TB		;[1077]
	MOVE	TA,ALITSV	;[1077] GET PTR TO EBASEA OR SOMETHING..
	HRRZ	TE,EBYTEX(TA)	;[1077] GET PRESENT BP
	HRRZ	TB,VALLOC##	;[1077] START OF TABLE
	SUB	TE,TB		;[1077] THIS IS OFFSET
	JUMPL	TE,[	PUSHJ	PP,XPNLIT	;[1344] IF RELATIVE PTR
			JRST	STSL1B]		;[1344] ALREADY SKIP PTR DEVEL. 
	PUSH	PP,TE		;[1077]
	PUSHJ	PP,XPNLIT	;[1077] EXPAND LITTAB
	POP	PP,TE		;[1077] GET BP OFFSET
	ADD	TE,VALLOC	;[1077] GET NEW PTR INTO VALTAB
	MOVE	TA,ALITSV	;[1077] GET BP TO EBASEA OR SOMETHING..
	HRRM	TE,EBYTEX(TA)	;[1077] RESTORE BP
STSL1B:				;[1344]
	POP	PP,TB		;[1077]
	POP	PP,TE		;[1077]
	POP	PP,TA		;[1077] RESTORE ACS
	JRST	STASHL		;[1077] GO CALL STASHL AGAIN

;LITAB IS FULL, AND IS 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--TROUBLE

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

;LITFIL IS NOW OPEN FOR OUTPUT
;NOW COUNT WORDS SO THAT WE LEAVE A COMPLETE BLOCK AS FIRST THING IN LITAB

STSHL3:	HRRZ	TE,LITLOC	;BASE OF LITERALS
	ADD	TE,PLITOF	;PLUS OFFSET
	SOS	TA,PLITOF	;INITIALIZE THE COUNT
STSHL6:	HRRZ	TD,(TE)		;GET TYPE AND COUNT
	ANDI	TD,7777
	ADDI	TA,1(TD)
	ADDI	TE,1(TD)	;NEXT LITERAL GROUP
	CAIGE	TA,FULLIT	;ENOUGH?
	JRST	STSHL6		;NO
	SUBI	TA,FULLIT-1	;GET EXTRA WORDS
	MOVEM	TA,PLITOF	;RESET OFFSET FOR COMPARES
	MOVEI	TE,FULLIT
	ADDM	TE,LITBLK	;BUMP WORD COUNT
	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--KILL
	JRST	DEVDED

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

; AT STSHL4+6 [167]
	MOVNI	TA,FULLIT	;UPDATE
	SKIPE	CURLIT		;  ANY NON-ZERO
	ADDM	TA,CURLIT	;  CURLIT

	MOVE	TA,[XWD SAVEAC+1,TD]
	BLT	TA,TB
	MOVE	TA,SAVEAC

	JRST	STASHL

;ENTER FAILURE

STSHL5:	OUTSTR	[ASCIZ "?Cannot enter "]
	MOVEI	DA,LITDEV
	HRRZ	I2,TD		;GET ERROR CODE
	JRST	ERATYP
;GET SOME TEMPORARY LOCATIONS
;ENTER WITH DESIRED NUMBER OF WORDS IN "TE".

GETEMP:	MOVE	EACC,ETEMPC
	ADDB	TE,ETEMPC
	CAMLE	TE,ETEMAX
	MOVEM	TE,ETEMAX
	IORI	EACC,AS.TMP
	ADD	EACC,TEMBAS
	POPJ	PP,


;SET UP "B" PARAMETERS TO REPRESENT AN ASCII TEMP.
;ENTER WITH SIZE IN "TD", RELATIVE ADDRESS IN "TA".

SETEMP:	IORI	TA,AS.TMP
	MOVEM	TA,EINCRB
	MOVEI	TE,AS.MSC
	MOVEM	TE,EBASEB
	MOVEI	TE,^D36
	HRLM	TE,ERESB
	MOVEM	TD,ESIZEB
	SETZM	EDPLB
	MOVEI	TE,D7MODE
	MOVEM	TE,EMODEB

	SWOFF	FBNUM!FBSIGN
	POPJ	PP,
;MOVE AC'S TO %TEMP.

PUTEMP:	SWON	FANUM!FASIGN;
	SWOFF	FASUB!FAINAC;
	HRRZ	TD,EMODEA
	MOVEI	TE,1
	CAIE	TD,D2MODE
	CAIN	TD,F2MODE
	MOVEI	TE,2
	PUSHJ	PP,GETEMP

	MOVEM	EACC,EINCRA
	MOVEI	TE,AS.MSC
	MOVEM	TE,EBASEA
	MOVSI	CH,MOVEM.
	CAIE	TD,D2MODE	;[625]
	CAIN	TD,F2MODE
	TRNA
	PJRST	PUT.AA
IFN BIS,<
	PUSHJ	PP,PUTASA
	MOVSI	CH,DMOVM.
	PJRST	PUT.AA
>
IFE BIS,<
	PUSHJ	PP,PUT.AA
	MOVSI	CH,MOVEM.
	AOS	EINCRA
	AOS	EAC
	PUSHJ	PP,PUT.AA
	SOS	EAC
	SOS	EINCRA
	POPJ	PP,
>
;PUT A TAG ONTO ASYFIL,  AND RESOLVE ADDRESS

PUTTAG:	ANDI	CH,77777
	IORI	CH,AS.TAG
	HRLI	CH,720000	;WRITE IT OUT
	PUSHJ	PP,PUTASN

	TSWF	FAS3		;ARE WE IN NON-RESIDENT SEGMENT?
	SKIPA	TE,EAS3PC	;YES
	SKIPA	TE,EAS2PC	;NO--RESIDENT
	IORI	TE,1B18

	ANDI	CH,77777	;GET LOW 15 BITS ONLY
	MOVE	TD,TAGLOC
	ADDI	CH,(TD)
	HRRM	TE,0(CH)	;STORE PC OF TAG
	POPJ	PP,
;SET UP "A" PARAMETERS.
;ENTER WITH "TC" POINTING TO AN OPERAND.
;IF ANY ERRORS DETECTED, POP OFF ONE EXIT FROM PUSH-DOWN LIST, SUCH THAT
;	WE EXIT TO THE ROUTINE WHICH CALLED THE CALLING ROTUINE.

SETOPA:	MOVEI	LN,EBASEA

STOPA1:	PUSHJ	PP,SETOPN
	TSWF	FERROR;
	POP	PP,TE
	POPJ	PP,

;SIMILAR FOR "B"

SETOPB:	MOVEI	LN,EBASEB
	JRST	STOPA1
;SET UP OPERAND PARAMETERS.
;ENTER WITH ADDRESS OF 2-WORD OPERAND IN TC, ADDRESS OF
;	EITHER EBASEA OR EBASEB IN LN.

SETOPN:	MOVE	TB,0(TC)
	MOVE	TA,1(TC)
IFN ANS68,<
	CAIN	TA,TALLY.##		; [250] TALLY ADDRESS ?
	JRST	[CAIE	LN,EBASEA	; [365] IF "A" OPERAND
		SWOFFS	FBSUB;		; [365] TURN OFF "A" SUBSCRIPTED
		SWOFF	FASUB;		; [365] ELSE TURN OFF "B" SUBSCRIPTED
		JRST	SETOP7]		; [365] FINISH UP OPERAND SETTING
					; [365] FOR TALLY.
>
	HRRZM	TA,ETABLX(LN)
	LDB	TE,LNKCOD
	CAIE	TE,TB.DAT
	JRST	SETOP1
	ANDI	TA,LMASKB
	IORI	TA,AS.DAT

SETOP1:	HRRZM	TA,EBASEX(LN)	;STASH BASE ADDRESS
	TLNE	TB,GNLIT	;IS THIS A LITERAL?
	JRST	SETOP4		;YES

	TLNE	TA,GNNOTD	;IS OPERAND EITHER TEMP OR AC'S?
	JRST	SETOP9

	MOVEI	DW,E.101	;GET READY FOR "NOT DATA-NAME" ERROR
	LDB	TE,LNKCOD
	CAIE	TE,TB.DAT	;IS IT A DATA-NAME?
	JRST	OPERA		;NO--ERROR

	SETZM	EINCRX(LN)	;YES--CLEAR INCREMENT
	SETZM	EFLAGX(LN)	;CLEAR FLAGS

	MOVE	TA,ETABLX(LN)
	PUSHJ	PP,LNKSET	;SET UP TABLE ADDRESS
	LDB	TE,DA.ERR##	; [406] ERROR BIT ON?
	JUMPN	TE,[SWON FERROR		; [406] CANT USE SET ERROR
		POPJ	PP,]		; [406] RETURN

	LDB	TE,DA.USG
	SUBI	TE,1
	CAIN	TE,IXMODE	;INDEX MODE?
	MOVEI	TE,D1MODE	;YES--PRETEND IT'S 1-WORD COMP
	CAIN	TE,%US.C3-1	;COMP-3?
	MOVEI	TE,C3MODE	;YES, USE INDEX'S SLOT.
	CAIN	TE,%US.C2-1	;COMP-2?
	MOVEI	TE,F2MODE	;YES, USE CORRECT INDEX
	MOVEM	TE,EMODEX(LN)

	LDB	TD,DA.RES	;GET RESIDUE
	HRLM	TD,ERESX(LN)	;	AND STASH
	LDB	TD,DA.NDP	;GET DECIMAL PLACES
	LDB	TE,DA.DPR	;IS DECIMAL POINT
	SKIPE	TE		;  TO RIGHT OF FIELD?
	MOVNS	TD		;YES--NEGATE
	MOVEM	TD,EDPLX(LN)	;NO--STASH DECIMAL PLACES
	LDB	TE,DA.INS	;GET INTERNAL SIZE
	MOVEM	TE,ESIZEX(LN)

	MOVEI	DW,E.104	;GET READY FOR "UNDEFINED" ERROR
	LDB	TD,DA.DEF	;IF DEFINED,
	JUMPN	TD,SETOP0	;  GO ON


	SWON	FERROR		;SET ERROR FLAG
	HRRZ	TD,DATLOC	;CK FOR DUMMY DATAB ENTRY
	SUBI	TD,-1(TA)
	JUMPN	TD,OPERA	;IF NOT, PUT OUT ?NOT DEFINED
	POPJ	PP,		;IF DUMMY, EXIT NOW
;SET UP OPERAND PARAMETERS  (CONT'D).

SETOP0:	MOVE	TE,1(TC)	;ANY
	LDB	TE,TESUBC	;  SUBSCRIPTS?
	JUMPE	TE,SETOP2	;NO IF JUMP
	LDB	TD,DA.SUB	;SHOULD
	JUMPN	TD,SETOP2	;  THERE BE?
	MOVEI	DW,E.275	;YES
	PUSHJ	PP,OPERA	;  ERROR

SETOP2:
IFN ANS74,<
	SKIPN	FLGSW		;FIPS FLAGGER WANTED?
	JRST	SETP2A		;NO
	LDB	TE,DA.LVL	;GET THE LEVEL #
	CAIE	TE,LVL.66	;IS OPERAND A RENAMES?
	JRST	SETP2A		;NO
	PUSH	PP,LN		;YES, WHAT A CROCK
	PUSH	PP,CUREOP	; WE HAVE TO FLAG ALL REFERENCES TO IT
	MOVEM	TC,CUREOP	;SO FAKE UP WHAT WE NEED
	PUSHJ	PP,TST.N2	; FOR GENERAL ERROR ROUTINE
	MOVE	TC,CUREOP
	POP	PP,CUREOP
	POP	PP,LN
SETP2A:>
	CAIN	LN,EBASEA	;"A" OPERAND?
	JRST	SETOP3		;YES

;"B" OPERAND

IFN ANS74,<
	SKIPL	TE,EDEBDB##	;DID USER WANT DEBUGGING?
	JRST	SETOQ2		;NO
	SKIPE	INDCLR##	;ARE WE STILL IN DECLARATIVES?
	TDZA	TD,TD		;YES, SO NO DEBUGGING ALLOWED
	LDB	TD,DA.DEB##	;DEBUGING ON THIS DATA-NAME ALLOWED?
	SKIPE	TD		;NO
	HRRZ	TD,EBASEX(LN)	;YES, GET BASE ADDRESS
	MOVEM	TD,EDEBDB	;SIGNAL DEBUGGING REQUIRED (OR NOT)
	JUMPE	TD,SETOQ2	;DONE IF NOT DEBUGGING
	HRRZM	TE,EDEBGB##	;SAVE AS FLAG FOR "ARO" TEST
	MOVE	TD,EDEBDB	;GET BASE
	PUSHJ	PP,TSTARO	; SEE IF IT IS "ON ALL REFERENCES OF"
SETOQ2:>
	LDB	TD,DA.SGN	;IS 'B'
	SKIPE	TD		;  SIGNED?
	SWONS	FBSIGN;		;YES
	SWOFF	FBSIGN;		;NO
	LDB	TE,DA.EDT
	LDB	TD,DA.CLA
	SKIPN	TE
	CAIE	TD,2
	SWOFFS	FBNUM		;EDITED OR NOT NUMERIC
	SWON	FBNUM		;NUMERIC AND NOT EDITED

	LDB	TD,DA.SUB	;SHOULD ITEM
	SKIPN	TD		;  BE SUBSCRIPTED?
	SWOFFS	FBSUB;		;NO
	SWON	FBSUB		;YES

	LDB	TD,DA.LKS##	;LINKAGE SECTION?
	SKIPE	TD		;NO
	SWON	FBSUB		;YES
IFN ANS74,<
	TSWF	FBNUM		;NUMERIC?
	JRST	SETOPF		;YES, SET SIGN FLAGS
>
	POPJ	PP,

;"A" OPERAND

SETOP3:
IFN ANS74,<
	SKIPL	TE,EDEBDA##	;DID USER WANT DEBUGGING?
	JRST	SETOQ3		;NO
	SKIPE	INDCLR		;ARE WE STILL IN DECLARATIVES?
	TDZA	TD,TD		;YES, SO NO DEBUGGING ALLOWED
	LDB	TD,DA.DEB##	;DEBUGING ON THIS DATA-NAME ALLOWED?
	SKIPE	TD		;NO
	HRRZ	TD,EBASEX(LN)	;YES, GET BASE ADDRESS
	MOVEM	TD,EDEBDA	;SIGNAL DEBUGGING REQUIRED (OR NOT)
	JUMPE	TD,SETOQ3	;DONE IF NOT DEBUGGING
	HRRZM	TE,EDEBGA##	;SAVE AS FLAG FOR "ARO" TEST
	MOVE	TD,EDEBDA##	;GET BASE
	PUSHJ	PP,TSTARO	; SEE IF IT IS "ON ALL REFERENCES OF"
SETOQ3:>
	LDB	TD,DA.SGN	;IS 'A'
	SKIPE	TD		;  SIGNED?
	SWONS	FASIGN;		;YES
	SWOFF	FASIGN		;NO
	LDB	TE,DA.EDT
	LDB	TD,DA.CLA
	SKIPN	TE
	CAIE	TD,2
	SWOFFS	FANUM		;EDITED OR NOT NUMERIC
	SWON	FANUM		;NUMERIC AND NOT EDITED

	LDB	TD,DA.SUB	;IS IT
	SKIPN	TD		;  SUBSCRIPTED?
	SWOFFS	FASUB		;NO
	SWON	FASUB		;YES

	LDB	TD,DA.LKS	;LINKAGE SECTION?
	SKIPE	TD		;NO
	SWON	FASUB		;YES
IFN ANS74,<
	TSWT	FANUM		;NUMERIC?
	POPJ	PP,
SETOPF:	LDB	TE,DA.SCF##	;GET FLAGS
	DPB	TE,[POINT 2,EFLAGX(LN),1]
>
	POPJ	PP,
;SET UP OPERAND PARAMETERS  (CONT'D).

;OPERAND IS A LITERAL.

SETOP4:
	SETZM	EINCRX(LN)	;[1550] Clear increment
	SETZM	EFLAGX(LN)	;[1550] Clear flag
IFN ANS74,<
	CAIE	LN,EBASEA
	JRST	.+3
	SKIPGE	EDEBDA##
	SETZM	EDEBDA		;DON'T DEBUG ON "A" OPERAND
	CAIN	LN,EBASEA
	JRST	.+3
	SKIPGE	EDEBDB##
	SETZM	EDEBDB		;DON'T DEBUG ON "B" OPERAND

>
	CAIE	LN,EBASEA
	SWOFFS	FBSUB;
	SWOFF	FASUB;

	TLNE	TB,GNFIGC
	JRST	SETOP6

	MOVEI	TE,LTMODE
	MOVEM	TE,EMODEX(LN)

	PUSHJ	PP,LNKSET
	HRLI	TA,350700
	MOVEM	TA,EBYTEX(LN)
	LDB	TD,TA
	MOVEM	TD,ESIZEX(LN)
	SETZM	EDPLX(LN)
	CAIE	LN,EBASEA
	JRST	SETOP5

	TLNE	TB,GNNUM	;IS IT NUMERIC?
	SWONS	FANUM!FASIGN;
	SWOFF	FANUM!FASIGN;
	POPJ	PP,

SETOP5:	TLNE	TB,GNNUM	;IS IT NUMERIC?
	SWONS	FBNUM!FBSIGN;
	SWOFF	FBNUM!FBSIGN;
	POPJ	PP,
;SET UP OPERAND PARAMETERS  (CONT'D).

;OPERAND IS A FIGURATIVE CONSTANT

SETOP6:
IFN ANS68,<
	TLNE	TB,GNTALY
	JRST	SETOP7
>
	MOVEI	TE,FCMODE
	MOVEM	TE,EMODEX(LN)

	TLNE	TB,GNTODY
	MOVEI	TE,0
	TLNE	TB,GNFCS
	MOVEI	TE,1
	TLNE	TB,GNFCZ
	MOVEI	TE,2
	TLNE	TB,GNFCQ
	MOVEI	TE,3
	TLNE	TB,GNFCHV
	MOVEI	TE,4
	TLNE	TB,GNFCLV
	MOVEI	TE,5
IFN ANS74,<
	TLNN	TB,GNDATE!GNDAY!GNTIME
	JRST	.+3
	LDB	TE,[POINT 2,TB,7]
	ADDI	TE,5
>
	MOVEM	TE,EFLAGX(LN)

	JRST	SETOP8
;SET UP OPERNAD (CONT'D).

;OPERAND IS "TALLY"

IFN ANS68,<
SETOP7:	MOVEI	TE,D1MODE
	MOVEM	TE,EMODEX(LN)
	HRRI	TA,TALLY.##	; [333] SET TALLY BUT KEEP LEFT HALF INTACT
	HRRZM	TA,EBASEX(LN)	; [333] WE ONLY WANT TALLY ADDRESS.
	SETZM	EINCRX(LN)
	SETZM	EDPLX(LN)
	MOVEI	TE,5
	MOVEM	TE,ESIZEX(LN)
	CAIE	LN,EBASEA
	SWONS	FBSIGN!FBNUM;
	SWON	FASIGN!FANUM;
	TLZ	TB,GNFIGC!GNLIT
	MOVEM	TB,0(TC)
	TSWT	FAS3		;ARE WE IN NON-RESIDENT SEGMENT?
	JRST	SETOP8		;NO

	MOVE	TD,TA		;YES--SET FLAG IN EXTAB ENTRY FOR TALLY
	ANDI	TD,77777
	ADD	TD,EXTLOC
	MOVSI	TE,1B18
	IORM	TE,1(TD)
>
SETOP8:	MOVEM	TA,1(TC)
	POPJ	PP,
;SET UP OPERAND  (CONT'D).
;OPERAND IS A TEMP OR THE AC'S.

SETOP9:	CAIE	LN,EBASEA
	SWOFFS	FBSUB;
	SWOFF	FASUB;

	MOVE	TD,TA
	LDB	TE,ACMODE
	MOVEM	TE,EMODEX(LN)
	LDB	TE,ACSIZE
	MOVEM	TE,ESIZEX(LN)
	HRREM	TD,EDPLX(LN)

	MOVEI TE,(TB)		;IS IT THE AC'S?

	CAIG	TE,17
	JRST	STOP10		;YES

	MOVEI	TE,AS.MSC	;NO--TEMP
	MOVEM	TE,EBASEX(LN)
	HRRZM	TB,EINCRX(LN)
	JRST	STOP11

STOP10:	SETZM	EBASEX(LN)	;YES
	SETZM	EINCRX(LN)

STOP11:	TLNE	TB,GNOPNM	;IS IT NUMERIC?
	JRST	STOP12		;YES

	CAIE	LN,EBASEA	;NO--"A"?
	SWOFFS	FBSIGN!FBNUM	;NO--MUST BE "B"
	SWOFF	FASIGN!FANUM	;YES
	POPJ	PP,

STOP12:	CAIE	LN,EBASEA	;IS THIS "A" OPERAND?
	SWONS	FBNUM!FBSIGN	;NO
	SWON	FANUM!FASIGN;
	POPJ	PP,
;GENERATE CODE TO ROUND THE AC'S

ROUND:	SWON	FROUND		;TURN ON "WE'RE ROUNDING"
	HRRZ	TE,EMODEB
	CAIE	TE,FPMODE
	CAIN	TE,F2MODE
	JRST	ROUND5

	HRRZ	TE,EMODEA
	CAIN	TE,FPMODE
	JRST	ROUND9
	CAIN	TE,F2MODE
	JRST	ROUNDF		;COMP-2

ROUND0:	MOVE	TC,EDPLA	;COMPUTE DIFFERENCE IN DECIMAL PLACES
	SUB	TC,EDPLB
	SKIPE	REMRND##	;SPECIAL IF ROUNDING AND REMAINDER
	JUMPE	TC,SPCRND	;IT IS
	JUMPLE	TC,NOROUN	;IF NOT POSITIVE--NO NEED FOR ROUNDING
IFN BIS,<
	CAIN	TE,D4MODE	;[673] IS "A" 4 WORDS?
	JRST	ROUND7		;[673] YES, NEED TO REDUCE TO 2 FIRST
>
	MOVEM	TC,ESAVAC

	CAIG	TC,^D10		;MORE THAN 10?
	JRST	ROUND1		;NO

	PUSHJ	PP,FORCX0	;YES--INSURE AC'S ARE 0&1
	MOVEI	TC,^D10		;GENERATE <DIV.21 [10**10]>
	MOVSI	CH,DIV.21
	PUSHJ	PP,PUT.PC

	MOVNI	TE,^D10		;RESET SIZE AND DECIMAL PLACES
	ADDM	TE,ESIZEA
	ADDM	TE,EDPLA
	ADDM	TE,ESAVAC	;[522] GENERATE THE CORRECT LITERAL

ROUND1:	MOVSI	CH,SKIPL.	;GENERATE <SKIPL AC>
	HRR	CH,EAC
	PUSHJ	PP,PUTASY

	MOVE	TC,ESAVAC	;IS LITERAL ALREADY CREATED?
	SKIPN	CH,RPWR10-1(TC)
	PUSHJ	PP,ROUND4	;NO--CREATE IT
	MOVEM	CH,ESAVAC
	MOVEM	CH,RPWR10-1(TC)

	MOVE	CH,[XWD SKIPA.+AC4,AS.MSC]	;GENERATE <SKIPA 4,[LIT]>
	PUSHJ	PP,PUTASY
	MOVE	CH,ESAVAC
	PUSHJ	PP,PUTASN

	MOVE	CH,[XWD MOVN.+AC4,AS.MSC]	;GENERATE <MOVN 4,[LIT]>
	PUSHJ	PP,PUTASY
	MOVE	CH,ESAVAC
	PUSHJ	PP,PUTASN

ROUND6:	HRRZ	TE,EMODEA
	CAIN	TE,D2MODE
	JRST	ROUND3
IFN BIS,<
	CAIE	TE,D4MODE	;[570] SPECIAL QUAD-WORD CODE?
	JRST	ROUND2		;[570] NO
	MOVEI	CH,ADD.4R##	;[570] YES
	PJRST	PUT.PJ		;[570] NEED HELP WITH THIS ONE

ROUND7:	AOS	EDPLB		;[673] ACCOUNT FOR ROUNDING
	AOS	ESIZEB		;[673] AND MAKE SIZE BIGGER  ALSO
	MOVN	TC,TC		;[673] GET NO. OF DECIMAL PLACES TO REMOVE
	ADD	TC,ESIZEA	;[673] GET NEW SIZE WHEN DONE
	CAIGE	TC,MAXSIZ	;[673] SKIP IF REDUCING D.P. WON'T DO ANY GOOD
	PUSHJ	PP,ADJ4C.##	;[673] ADJUST DECIMAL PLACES
	MOVE	TE,EMODEA	;[673] MAKE SURE WE DON'T LOOP
	CAIE	TE,D4MODE	;[673] MODE SHOULD HAVE CHANGED BY NOW
	JRST	ROUND8		;[673] OK, SO RETURN
	PUSHJ	PP,CUTC4##	;[673] NO, TRY TO REDUCE INTEGERS INSTEAD
	PUSHJ	PP,FORCX0	;[673] PUT RESULT IN ACC 0 & 1
	MOVE	TE,EMODEA	;[673] MAKE SURE WE DON'T LOOP
	CAIE	TE,D4MODE	;[673] MODE SHOULD HAVE CHANGED BY NOW
	JRST	ROUND8		;[673] OK, SO RETURN
	PUSHJ	PP,ADJ4C.	;[673] ONE LAST TRY
	MOVE	TE,EMODEA	;[673] MAKE SURE WE DON'T LOOP
	CAIN	TE,D4MODE	;[673] MODE SHOULD HAVE CHANGED BY NOW
	JRST	KILL		;[673] SHOULD NEVER HAPPEN
ROUND8:	SOS	EDPLB		;[673] BACK THE WAY IT WAS
	SOS	ESIZEB		;[673] ...
	JRST	ROUND0		;[673] SO TRY AGAIN
>
;GENERATE CODE TO ROUND AC'S  (CONT'D).

;AC'S CONTAIN 1-WORD COMP OR INDEX

ROUND2:	MOVE	CH,[XWD AD,4]
	JRST	PUT.XA
;AC'S CONTAIN A 2-WORD COMP

ROUND3:	PUSHJ	PP,FORCX0
IFE BIS,<
	MOVE	CH,[XWD ADD.21,4]
>
IFN BIS,<
	PUSHJ	PP,PUTASA
	MOVE	CH,[ASHC.+AC4+ASINC,,AS.CNB]
	PUSHJ	PP,PUTASY	;"ASHC 4,-^D35"
	MOVEI	CH,-^D35
	PUSHJ	PP,PUTASN
	PUSHJ	PP,PUTASA
	MOVE	CH,[DADD.,,4]
>;END IFN BIS
	JRST	PUTASY


;GET ROUNDING VALUE INTO LITERAL POOL

ROUND4:	MOVE	TA,[XWD D1LIT,1]
	PUSHJ	PP,STASHI
	MOVE	TA,ROUNDR-1(TC)
	PUSHJ	PP,STASHL
	HRRZ	CH,ELITPC
	IORI	CH,AS.LIT
	AOS	ELITPC
	POPJ	PP,

;ROUNDING NOT ALLOWED WITH COMP-1 OR COMP-2 RECEIVING FIELDS

ROUND5:	MOVEI	DW,E.300
	JRST	OPNWRN

;AC'S ARE FLOATING POINT, "B" IS NOT.
;CONVERT AC'S TO TWO-WORD COMP LEAVING 1 EXTRA DECIMAL PLACE.

ROUND9:	MOVE	TD,EDPLB
	AOSE	TD
	PUSHJ	PP,GENFPL
	MOVSI	CH,FIX.
	PUSHJ	PP,PUT.XA
	JRST	ROUNDG
;AC'S ARE D.P. FLOATING POINT, "B" IS NOT.
;CONVERT AC'S TO TWO-WORD COMP LEAVING 1 EXTRA DECIMAL PLACE.

ROUNDF:	MOVE	TD,EDPLB
	AOSE	TD
	PUSHJ	PP,GENF2L
	HRRZ	CH,EAC
	DPB	CH,CHAC		;GET ACC FIELD
	PUSHJ	PP,PUT.16	;OUTPUT MOVX 16,<Z AC,AC>
	MOVEI	CH,FIX.2##
	PUSHJ	PP,PUT.PJ	;PUSHJ P,FIX.2

ROUNDG:	TLNE	W1,GNSERA	;[1543] ON SIZE ERROR USED?
	JRST	ROUNDH		;[1543] DON'T CHECK FOR TRUNCATION ERROR IF SO
	MOVE	TE,ESIZEB	;[1543] [1411] FIND DIFFERENCE IN DIGITS BEFORE
	SUB	TE,EDPLB	;[1411]  THE DECIMAL POINT BETWEEN RESULT FIELD
	ADD	TE,EDPLA	;[1411]  AND OPERANDS IN EXPRESSION
	SUB	TE,ESIZEA	;[1411] IF B OPERAND HAS SAME OR MORE, NO
	SKIPGE	TE		;[1453] [1411]   LEADING TRUNCATION, SO CONTINUE
	PUSHJ	PP,MSERA.	;[1453]   ELSE GIVE WARNING
ROUNDH:	MOVE	TE,[XWD ESIZEB,ESIZEA]	;[1543]
	BLT	TE,EBASAX
	AOS	ESIZEA
	AOS	EDPLA
	MOVEI	TE,D2MODE
	MOVEM	TE,EMODEA
	JRST	ROUND0
;GENERATE CODE TO ROUND IF REMAINDER ALSO
; THE FOLLOWING IS TRUE:
; THE REMAINDER IS IN AC 2 (2 AND 3 IF 2-WORD).
;  THE QUOTIENT TO ROUND IS IN AC0 AND AC1.
;  THE DIVISOR'S ADDRESS IS POINTED TO BY REMRND AND REMRN1.
;  THE REMAINDER HAS ALSO BEEN SAVED IN %TEMP.
;
; ROUNDING PROCEDURE IS:
;	MULTIPLY REMAINDER IN 2 BY 2. IF THIS IS GREATER OR EQUAL TO DIVISOR,
;	  ROUND UP (ADD 1 TO DIVIDEND), ELSE TRUNCATE (ADD 0 TO DIVIDEND).

SPCRND:	HLRZ	TC,REMRND	;GET "B" SIZE
	SKIPN	SGNREM##	;COULD REMAINDER BE NEGATIVE?
	 JRST	SPCRNA		;NO--DON'T GET MAGNITUDE
	CAIG	TC,^D10
	 JRST	SPCR10		;S.P. MOVM
IFN BIS,<
	MOVE	CH,[SKPGE.,,2]
	PUSHJ	PP,PUTASY
	PUSHJ	PP,PUTASA
	MOVE	CH,[DMOVN.+AC2,,2]
>;END IFN BIS
IFE BIS,<
	MOVE	CH,[MAG.+AC2,,2]
>;END IFN BIS
	PUSHJ	PP,PUTASY
	JRST	SPCRNA		;DONE GETTING POSITIVE REMAINDER IN 2&3

SPCR10:	MOVE	CH,[MOVM.+AC2,,2]
	PUSHJ	PP,PUTASY	;MOVM 2,2

SPCRNA:	PUSHJ	PP,PUTASA	;NOW TO MULTIPLY BY 2
	CAIG	TC,^D10
	SKIPA	CH,[ASH.+AC2,,1]
	MOVE	CH,[ASHC.+AC2,,1]
	PUSHJ	PP,PUTASY
	SKIPN	SGNDIV##	;DID WE HAVE A SIGNED DIVISOR?
	 JRST	SPCRNB		;NO- LEAVE IT WHERE IT IS

;GET MAGNITUDE OF DIVISOR INTO AC4&5, CHANGE REMRND ACCORDINGLY

	CAIG	TC,^D10		;BIG?
	 JRST	SPCR20		;NO
IFN BIS,<
	PUSHJ	PP,PUTASA
	MOVSI	CH,DMOVE.+AC4+ASINC
>;END IFN BIS
IFE BIS,<
	MOVSI	CH,MAG.+AC4+ASINC
>;END IFE BIS
	HRR	CH,REMRND
	MOVE	TE,REMRN1
	PUSHJ	PP,PUTASC	;PUT OUT CORRECT FORM OF CONSTANT
	JRST	SPCR30

SPCR20:	MOVSI	CH,MOVM.+AC4+ASINC
	HRR	CH,REMRND
	MOVE	TE,REMRN1
	PUSHJ	PP,PUTASC

SPCR30:	MOVEI	TE,AS.CNB	;RESET REMRND TO POINT TO ACS
	HRRM	TE,REMRND
	MOVEI	TE,4
	MOVEM	TE,REMRN1
SPCRNB:	MOVE	TD,REMPAR##	;GET REMAINDER PARAMETERS
	LDB	TC,ACSIZE	;GET SIZE
	CAILE	TC,^D10		;D.P.
	JRST	SPCRDP		;YES
	HRLI	CH,CAMGE.+AC2+ASINC
	HRR	CH,REMRND
	MOVE	TE,REMRN1##
	PUSHJ	PP,PUTASC
SPCRNC:	MOVE	CH,[TDCA.+AC4,,4]
	PUSHJ	PP,PUTASY
	MOVE	CH,[MOVEI.+AC4,,1]
	PUSHJ	PP,PUTASY
	MOVSI	CH,SKPGE.
	HRR	CH,EAC
	PUSHJ	PP,PUTASY
	MOVE	CH,[MOVN.+AC4,,4]
	PUSHJ	PP,PUTASY
	SETZM	REMRND
	JRST	ROUND6

SPCRDP:	HRLI	CH,CAMN.+AC2+ASINC
	HRR	CH,REMRND
	MOVE	TE,REMRN1
	PUSHJ	PP,PUTASC
	HRLI	CH,CAML.+AC3+ASINC
	HRR	CH,REMRND
	MOVE	TE,REMRN1
	ADDI	TE,1
	PUSHJ	PP,PUTASC
	MOVSI	CH,CAMGE.+AC2+ASINC
	HRR	CH,REMRND
	MOVE	TE,REMRN1
	PUSHJ	PP,PUTASC
	JRST	SPCRNC
;GENERATE "SIZE ERROR" CODING

SIZERA:	SWON	FSZERA		;SET 'DON'T WORRY ABOUT TOO BIG'
	MOVE	TE,EDPLA
	CAMLE	TE,EDPLB
SIZER0:	PUSHJ	PP,ADJDP.

	HRRZ	TE,EMODEB	;IS RESULT FIELD FLOATING-POINT?
	CAIE	TE,FPMODE
	CAIN	TE,F2MODE
	JRST	SIZER7		;[1110] YES, TEST FOR DIVIDE BY ZERO ONLY

	HRRZ	TD,EMODEA	;NO--IS "A" FLOATING-POINT?
	CAIE	TD,FPMODE
	CAIN	TD,F2MODE
	PUSHJ	PP,CFPCX.	;YES--CONVERT

	MOVE	TC,ESIZEB	;FIND POWER OF 10 REQUIRED
IFN ANS74,<
	SKIPGE	EFLAGB		;SEPARATE SIGN
	SUBI	TC,1		;YES, 1 LESS DIGIT
>
	SUB	TC,EDPLB
	ADD	TC,EDPLA
	JUMPL	TC,SIZER0

	CAILE	TC,^D10		;NEED A 2-WORD LITERAL?
	JRST	SIZER6		;YES

	HRRZ	TD,EMODEA	;NO
	CAIE	TD,D1MODE
	JRST	SIZER4


;AC'S CONTAIN ONE WORD COMP OR INDEX, LITERAL IS ONE WORD.
;GENERATE TEST INLINE


	MOVSI	CH,MOVM.+AC13
	HRR	CH,EAC
	PUSHJ	PP,PUTASY	;GENERATE MOVM 13,ACC

	MOVE	CH,[SKIPN.,,OVFLO.##]
	SKIPGE	OVFLFL##	;SEE IF NEEDED
	PUSHJ	PP,PUT.EX

	PUSHJ	PP,CREATL

	MOVSI	CH,CAML.+AC13
	PUSHJ	PP,PUT.PC	;CAML 13,[POWER OF TEN]

	MOVSI	CH,SKIPA.
	PUSHJ	PP,PUTASY	;SKIP--WE HAVE TO SET SZERA.

	PUSHJ	PP,GETTAG	;GET A TAG FOR JRST AROUND SETOM
	PUSH	PP,CH
	HRLI	CH,JRST.
	HRRZ	TA,CH
	PUSHJ	PP,REFTAG##	;AND REFERENCE IT
	PUSHJ	PP,PUTASY

	MOVE	CH,[SETOM.,,SZERA.##]
	PUSHJ	PP,PUT.EX

	SKIPN	EMULSZ
	SKIPA	CH,ESZERA
	PUSHJ	PP,GETTAG
	MOVEM	CH,ESAVAC
	HRRZ	TA,CH		 ;GET TAG NUMBER
	PUSHJ	PP,REFTAG##	;REFERENCE IT
	HRLI	CH,JRST.	;JRST SIZE-ERROR TAG
	PUSHJ	PP,PUTASY

	POP	PP,CH		;GET TAG
	PUSHJ	PP,PUTTAG	;OUTPUT IT

	SETZM	OVFLFL		;CLEAR OVFLO. FLAG
	SKIPN	EMULSZ		;MORE THAN ONE RESULT?
	JRST	MACX.		;NO--GENERATE STASH AND RETURN

	PUSHJ	PP,MACX.
	MOVE	CH,ESAVAC
	JRST	PUTTAG
;GENERATE "SIZE ERROR" CODING  (CONT'D).

;AC'S CONTAIN TWO WORDS, LITERAL IS ONE WORD

SIZER4:
IFN BIS,<			;[634]
	CAIN	TD,D4MODE	;[634] FOUR WORDS IN ACS?
	 JRST	SZER4A		;[634] YES
>;END IFN BIS			;[634]
	MOVSI	CH,SIZE.2
	JRST	SIZER2
IFN BIS,<			;[634]
SZER4A:	PUSH	PP,[EPJPP,,SIZE.4] ;[634] ONE WORD LIT COMPARE-- CALL TO SIZE.4
	  CAIA			;[634]
SIZE6A:	PUSH	PP,[EPJPP,,SIZE.5] ;[634] TWO WORD LIT COMPARE-- CALL TO SIZE.5
	MOVSI	CH,MOVEI.+AC16	;[634]
	PUSHJ	PP,PUTASY	;[634] AC16 POINTS TO 1ST AC OF FOUR
	POP	PP,CH		;[634]
	PUSHJ	PP,PUTASY	;[634] PUT OUT ROUTINE CALL
	JRST	SIZR2A		;[634] GO PUT OUT 2ND WORD
>;END IFN BIS			;[634]

;LITERAL IS TWO WORDS

;[634] CHECK SIZE ERROR ON QUAD-WORD RESULT
SIZER6:	HRRZ	TE,EMODEA	;IS AC ONE WORD?
IFN BIS,<			;[634]
	CAIN	TE,D4MODE	;[634] FOUR WORDS IN ACS?
	 JRST	SIZE6A		;[634] YES, USE SIZE.5
>;END IFN BIS			;[634]
	CAIE	TE,D2MODE
	PUSHJ	PP,CC1C2.	;YES--CONVERT TO TWO WORDS

	MOVSI	CH,SIZE.3
SIZER2:	SETZM	OVFLFL		;CLEAR OVFLO. FLAG
	HRR	CH,EAC
	PUSHJ	PP,PUTASY

SIZR2A:	PUSHJ	PP,CREATL	;[634] ADD LABEL

	MOVE	CH,[XWD AS.XWD,1]
	PUSHJ	PP,PUTASN

	SKIPN	EMULSZ
	SKIPA	CH,ESZERA
	PUSHJ	PP,GETTAG
	MOVEM	CH,ESAVAC
	LDB	TA,[POINT 15,CH,35] ;GET TAG NUMBER
	PUSHJ	PP,REFTAG##	;REFERENCE IT
	PUSHJ	PP,PUTASY

	HRRZI	CH,AS.MSC
	HRL	CH,EPWR10(TC)
	PUSHJ	PP,PUTASN
IFN BIS,<
	MOVE	TE,EMODEA	;[730] GET MODE OF INTERMEDIATE TEMP
	CAIN	TE,D4MODE	;[730] IS IT QUAD-WORD?
	PUSHJ	PP,CUTC2C##	;[730] YES, CONVERT TO 2 WORDS NOW
	  JFCL			;[730] TAKE CARE OF NON-SKIP RETURN
>
	SKIPN	EMULSZ		;MORE THAN ONE RESULT?
	JRST	MACX.		;NO--GENERATE STASH AND RETURN

	PUSHJ	PP,MACX.
	MOVE	CH,ESAVAC
	JRST	PUTTAG


;[1110] HERE TO GENERATE FLOATING OVERFLOW TEST (DIVIDE BY ZERO)
;[1110] FOR COMP-1 AND COMP-2 RESULTS

SIZER7:	PUSHJ	PP,PUTASA	;[1110]
	MOVSI	CH,JFOV.	;[1110]
	HRR	CH,ESZERA	;[1110] TAG OF "ON SIZE ERROR" CODE
	PUSHJ	PP,PUTASY	;[1110]
	SETZM	OVFLFL		;[1110] CLEAR OVFLO. FLAG
	JRST	MACX.		;[1110] AND FORGET SIZE ERROR
;[762] GENERATE CODE TO ADD A SMALL NUMBER (EPSILON) TO COMP-2 ITEMS
;[762] TO MAKE UP FOR BITS LOST IN DP INSTRUCTIONS
;[762] THE EPSILON IS MORE THAN 2 ORDERS OF MAGNITUDE LESS THAN THE ROUNDING
;[762] VALUE IF ROUNDING HAD BEEN SPECIFIED.

IFN BIS,<
EPSLON:	MOVE	TC,EDPLB	;[1477] If destination can hold more dec pl
	CAMGE	TC,EDPLA	;[1477]  or if source has generated extra
	MOVE	TC,EDPLA	;[1477] use smaller correction factor
	SKIPGE	TC		;[1477] [762] GET NO OF DECIMAL PLACES IN "A"
	POPJ	PP,		;[762] GIVE UP IF "P" SHIFTED
	ADDI	TC,2		;[762] MAKE IT 1000 TIMES SMALLER
	MOVE	TA,[F2LIT,,2]	;[762] TWO WORDS
	PUSHJ	PP,STASHP	;[762] INITIALIZE POOLER
	MOVN	TA,TC		;[762] GET NEGATIVE POWER OF TEN
	PUSHJ	PP,STASHQ	;[762] PUT IN POOL
	MOVSI	TA,(BYTE (4)0,1)	;[762] GET 0.1
	PUSHJ	PP,POOLIT	;[762] POOL LITERAL
	SKIPE	CH,PLITPC	;[762] GET LITERAL IF POOLED
	JRST	.+4		;[762]
	MOVEI	CH,2		;[762] NO, COUNT THE 2 NEW ONES
	EXCH	CH,ELITPC	;[762]
	ADDM	CH,ELITPC	;[762]
	IORI	CH,AS.LIT	;[762]
	PUSH	PP,CH		;[762]
	PUSHJ	PP,PUTASA	;[762] SECOND SET OF OPCODES
	MOVE	CH,[DMOVE.+AC4,,AS.MSC]	;[762]
	PUSHJ	PP,PUTASY	;[762]
	POP	PP,CH		;[762] GET BACK LITERAL
	PUSHJ	PP,PUTASN	;[762]
	MOVSI	CH,SKPGE.	;[762]
	HRR	CH,EAC		;[762]
	PUSHJ	PP,PUTASY	;[762] GENERATE <SKIPGE AC>
	PUSHJ	PP,PUTASA	;[762]
	MOVE	CH,[DMOVN.+AC4,,4]	;[762]
	PUSHJ	PP,PUTASY	;[762] NEGATE CONSTANT ALSO
	PUSHJ	PP,PUTASA	;[762]
	MOVE	CH,[DFAD.,,4]	;[762]
	PJRST	PUT.XA		;[762] ADD IN CONSTANT
>
;MOVE A LITERAL FROM VALTAB TO LITAB (DISPLAY ONLY)
;THE HEADER WORD HAS ALREADY BEEN PUT OUT.

VALLIT:	MOVEI	TE,EBASEA	;[1077] SAVE EBYTEA IF XPAND LITERALS
	MOVEM	TE,ALITSV##	;[1077] REMEMBER INCASE WE EXPAND
	HRRZ	TC,EMODEB
	PUSHJ	PP,VLIT5.
	JUMPE	TD,VLIT3A	;[1077] RETURN IF SIZE IF ZERO

VLIT2:	ILDB	TE,EBYTEA	;GET A CHARACTER
	XCT	VLIT6.(TC)	;CONVERT IT IF NECESSARY.
	IDPB	TE,TB		;STASH IT INTO TA
	SOJLE	TD,VLIT2A	;QUIT IF ALL HAVE BEEN TRANSFERRED

	TLNN	TB,760000	;IS "TA" FULL?
	PUSHJ	PP,VLIT4.	;YES--PUT IT INTO LITAB
	JRST	VLIT2

VLIT2A:	SKIPN	TD,ADCRLF##	;NEED TO ADD CR-LF?
	JRST	VLIT3.		;NO
	SOJE	TD,VLIT2B	;ONLY NEED NULL
	TLNN	TB,760000	;ANY ROOM?
	PUSHJ	PP,VLIT4.	;NO
	MOVEI	TE,15		;CR
	IDPB	TE,TB
	TLNN	TB,760000	;FULL?
	PUSHJ	PP,VLIT4.	;YES
	MOVEI	TE,12		;LF
	IDPB	TE,TB
VLIT2B:	TLNN	TB,760000
	PUSHJ	PP,VLIT4.
	IBP	TB		;ENSURE NULL AT END

VLIT3.::
	TLNN	TB,760000	;[1077] JUST ENOUGH TO FIT WORD?
	 JRST	VLIT4.		;[1077] MORE WORDS
VLIT3A:	SETZM	ALITSV##	;[1077] DON'T WORRY ABOUT THIS ANYMORE
	POPJ	PP,		;[1077] RETURN

VLIT4.::
	PUSHJ	PP,STASHL	;PUT THAT WORD INTO LITAB

VLIT5.::
	MOVEI	TA,0		;CLEAR LITAB WORD
	MOVE	TB,VLIT7.(TC)	;PICK UP THE APPROPRIATE BYTE POINTER.
	SKIPN	IMCONS##	;IMMEDIATE MODE FLAG SET?
	POPJ	PP,		;NO
	MOVEI	TB,1(TC)	;MODE + 1
	IMUL	TB,ESIZEB	;*SIZE
	MOVE	TB,VLIT7I-1(TB)	;GET BYTE POINTER
	POPJ	PP,

;BYTE POINTERS FOR PUTTING THE CONVERTED CHAR INTO TA.

VLIT7I:
	POINT	6,TA,29			;1-SIXBIT.
	POINT	7,TA,28			;1-ASCII.
	POINT	9,TA,26			;1-EBCDIC.
	POINT	6,TA,23			;2-SIXBIT.
	POINT	7,TA,21			;2-ASCII.
	POINT	9,TA,17			;2-EBCDIC.
	POINT	6,TA,23			;3-SIXBIT.
;SAME AS VALLIT EXCEPT THAT LITERAL WILL BE POOLED


PVALIT:	MOVEI	TE,EBASEA	;[1077] GET BASE FOR EBYTEA
	MOVEM	TE,ALITSV##	;[1077] SAVE INCASE WE EXPAND LITTAB
	HRRZ	TC,EMODEB
	PUSHJ	PP,VLIT5.
	JUMPE	TD,PVLT5A	;[1077] IF SIZE IF ZERO QUIT NOW

PVLIT2:	ILDB	TE,EBYTEA	;GET A CHARACTER
	XCT	VLIT6.(TC)	;CONVERT IT IF NECESSARY.
	IDPB	TE,TB		;STASH IT INTO TA
	SOJLE	TD,PVLIT3	;QUIT IF ALL HAVE BEEN TRANSFERRED

	TLNN	TB,760000	;IS "TA" FULL?
	PUSHJ	PP,PVLIT6	;YES--PUT IT INTO LITAB
	JRST	PVLIT2

PVLIT3:	SKIPN	TD,ADCRLF##	;NEED TO ADD CR-LF?
	JRST	PVLIT5		;NO
	SOJE	TD,PVLIT4	;ONLY NEED NULL
	TLNN	TB,760000	;ANY ROOM?
	PUSHJ	PP,PVLIT6	;NO
	MOVEI	TE,15		;CR
	IDPB	TE,TB
	TLNN	TB,760000	;FULL?
	PUSHJ	PP,PVLIT6	;YES
	MOVEI	TE,12		;LF
	IDPB	TE,TB
PVLIT4:	TLNN	TB,760000
	PUSHJ	PP,PVLIT6
	IBP	TB		;ENSURE NULL AT END
PVLIT5::SKIPN	IMCONS		;IMMEDIATE MODE?
	TLNE	TB,760000	;JUST ENOUGH TO FIT WORD?
	 JRST	PVLT5A		;[1077] NO--QUIT
PVLIT6::PUSHJ	PP,STASHQ	;PUT THAT WORD INTO LITAB
	JRST	VLIT5.

PVLT5A:	SETZM	ALITSV##	;[1077] FORGET ABOUT THIS
	POPJ	PP,		;[1077] RETURN
;INSTRUCTIONS XCT'ED TO CONVERT THE CHAR IN TE FROM ASCII TO EBCDIC.

VLIT6.::
	PUSHJ	PP,VLIT10		; [374] SIXBIT.
	JFCL				;ASCII.
	PUSHJ	PP,	VLIT8.		;EBCDIC.

;BYTE POINTERS FOR PUTTING THE CONVERTED CHAR INTO TA.

VLIT7.::
	POINT	6,TA			;SIXBIT.
	POINT	7,TA			;ASCII.
	POINT	9,TA			;EBCDIC.

;ROUTINE TO CONVERT AN ASCII CHAR TO EBCDIC.

VLIT8.::
	ROT	TE,	-2		;FORM THE INDEX INTO THE TABLE.
	JUMPL	TE,	VLIT9		;LEFT OR RIGHT HALF?
	HLR	TE,	ASEBC.##(TE)	;LEFT.
	CAIA
VLIT9:	HRR	TE,	ASEBC.##(TE)	;RIGHT.
	TLNN	TE,	(1B1)		;IS THE CHAR RIGHT JUSTIFIED?
	LSH	TE,	-^D9		;IT IS NOW.
	ANDI	TE,377			;JUST SAVE CHAR VALUE.
	POPJ	PP,			;RETURN.

;ROUTINE TO CONVERT AN ASCII CHAR TO SIXBIT

VLIT10::				; [374]
	CAIL	TE,40			; [374] IS THIS ASCII CHAR CONVERTABLE?
	CAILE	TE,137			; [374] IE TO SIXBIT?
	SETOM	LITERR##		; [374] NO- IFGEN WILL GIVE ERROR
VLIT76:: ROT	TE,	-2		; [374] FORM THE INDEX INTO THE TABLE.
	JUMPL	TE,	VLIT11		; [374] LEFT OR RIGHT HALF?
	HLR	TE,	ASCSX.##(TE)	; [374] LEFT.
	CAIA				; [374]
VLIT11:	HRR	TE,	ASCSX.##(TE)	; [374] RIGHT.
	TLNN	TE,	(1B1)		; [374] IS THE CHAR RIGHT JUSTIFIED?
	LSH	TE,	-^D9		; [374] IT IS NOW.
	TRZ	TE,777700		; [374] GET RID OF STATUS BITS
	POPJ	PP,			; [374] RETURN.
;CONVERT A NUMERIC LITERAL INTO 2-WORD COMP.
;ENTER WITH EITHER "BASEA" OR "EBASEB" IN "LN".
;RETURN WITH RESULT IN TD&TC.

CONVNL:	PUSHJ	PP,FDIGIT	;GET FIRST DIGIT
	TSWF	FERROR		;ANY ERRORS SO FAR?
	POPJ	PP,		;YES--QUIT

	SETZB	TC,TD
	HRRZI	TE,1
	JRST	CNVNL2

CNVNL1:	SOSGE	ESIZEX(LN)
	JRST	CNVNL4

	ILDB	CH,EBYTEX(LN)	;GET NEXT CHARACTER
	CAIN	CH,"."
	JRST	CNVNL3

	CAIG	CH,"9"
	CAIGE	CH,"0"
	JRST	BADLK

	CAILE	TE,^D18
	JRST	TOOBIG

	ADDI	TE,1
CNVNL2:	TSWF	FLITDP		;ANY DECIMAL POINT?
	AOS	EDPLX(LN)	;YES--INCREMENT DECIMAL PLACES

	IMULI	TD,^D10
	MULI	TC,^D10
	ADD	TD,TC
	MOVE	TC,TB

	ADDI	TC,-"0"(CH)
	TLZN	TC,1B18
	JRST	CNVNL1
	AOJA	TD,CNVNL1

CNVNL3:	CAIE	LN,EBASEA
	JRST	CNVNL5
	TSWT	FANUM;
	JRST	BADLK
	JRST	CNVNL6
CNVNL5:	TSWT	FBNUM;
	JRST	BADLK
CNVNL6:	SWON	FLITDP		;YES--SET "DECIMAL POINT SEEN"
	JRST	CNVNL1		;LOOP

CNVNL4:	MOVEM	TE,ESIZEX(LN)
	POPJ	PP,
;CREATE A FLOATING POINT LITERAL.
;EXIT WITH EXPONENT IN TD, MANTISSA IN TC.

CONVFP:	PUSHJ	PP,FDIGIT	;GET FIRST DIGIT
	TSWF	FERROR		;ANY ERRORS?
	POPJ	PP,		;YES

	MOVEI	TC,0
	MOVN	TD,EDPLX(LN)
	HRRZI	TE,1
	MOVE	TB,[POINT 4,TC,3]
	JRST	CNVFP2

CNVFP1:	SOSGE	ESIZEX(LN)
	POPJ	PP,

	ILDB	CH,EBYTEX(LN)
	CAIN	CH,"."
	JRST	CNVFP3

	CAIG	CH,"9"
	CAIGE	CH,"0"
	JRST	BADLK

	CAILE	TE,^D8
	JRST	CNVFP7

	ADDI	TE,1
CNVFP2:	TSWT	FLITDP;
	AOS	TD

	IDPB	CH,TB
	JRST	CNVFP1

CNVFP3:	CAIE	LN,EBASEA
	JRST	CNVFP5
	TSWT	FANUM;
	JRST	BADLK
	JRST	CNVFP6
CNVFP5:	TSWT	FBNUM;
	JRST	BADLK
CNVFP6:	SWON	FLITDP;
	JRST	CNVFP1

CNVFP7:	CAIE	CH,"0"
	JRST	TOOBIG
	TSWT	FLITDP		;IS THIS A DECIMAL PLACE?
	AOJA	TD,CNVFP1	;NO--BUMP INTEGRAL SIZE
	JRST	CNVFP1		;YES--LOOP WITHOUT BUMPING
;CREATE A D. P. FLOATING POINT LITERAL.
;EXIT WITH EXPONENT IN TD, MANTISSA IN C2MANT (3 WORDS).

CONVF2:	PUSHJ	PP,FDIGIT	;GET FIRST DIGIT
	TSWF	FERROR		;ANY ERRORS?
	POPJ	PP,		;YES

	SETZM	C2MANT##	;ZERO THE MANTISSA
	SETZM	C2MANT+1	;...
	SETZM	C2MANT+2	;...
	MOVN	TD,EDPLX(LN)
	HRRZI	TE,1
	MOVE	TB,[POINT 4,C2MANT,3]
	JRST	CNVF22

CNVF21:	SOSGE	ESIZEX(LN)
	POPJ	PP,

	ILDB	CH,EBYTEX(LN)
	CAIN	CH,"."
	JRST	CNVF23

	CAIG	CH,"9"
	CAIGE	CH,"0"
	JRST	BADLK

	CAILE	TE,^D18		;ALLOW UP TO 18 DIGITS
	JRST	CNVF27

	ADDI	TE,1
CNVF22:	TSWT	FLITDP;
	AOS	TD

	IDPB	CH,TB
	JRST	CNVF21

CNVF23:	CAIE	LN,EBASEA
	JRST	CNVF25
	TSWT	FANUM;
	JRST	BADLK
	JRST	CNVF26
CNVF25:	TSWT	FBNUM;
	JRST	BADLK
CNVF26:	SWON	FLITDP;
	JRST	CNVF21

CNVF27:	CAIE	CH,"0"
	JRST	TOOBIG
	TSWT	FLITDP		;IS THIS A DECIMAL PLACE?
	AOJA	TD,CNVF21	;NO--BUMP INTEGRAL SIZE
	JRST	CNVF21		;YES--LOOP WITHOUT BUMPING
;SCAN A LITERAL TO GET SIZE AND DECIMAL PLACES

SCANL:	HLRZ	TE,OPERND	;IS "ALL" FLAG UP?
	MOVE	TE,0(TE)
	TLNE	TE,GNALL
	JRST	BADALL		;YES--ERROR

	MOVEI	LN,EBASEA
	PUSHJ	PP,FDIGIT	;GET FIRST DIGIT
	TSWF	FERROR		;ANY ERROR?
	POPJ	PP,		;YES--QUIT

	MOVE	TD,[POINT 6,LITHLD]
	HRRZI	TC,0		;CLEAR SIZE
	JRST	SCANL3

SCANL2:	SOSGE	ESIZEA		;ANYTHING LEFT?
	JRST	SCANL5		;NO

	ILDB	CH,EBYTEA
	CAIN	CH,"."
	JRST	SCANL4

	CAIG	CH,"9"
	CAIGE	CH,"0"
	JRST	BADLK

SCANL3:	ADDI	TC,1
	TSWF	FLITDP
	AOS	EDPLA
	CAILE	TC,^D120	;[FCCTS NC105] ALLOW UP TO 120 CHARS
	JRST	TOOBIG
	SUBI	CH,40
	IDPB	CH,TD
	JRST	SCANL2

SCANL4:	TSWT	FANUM		;DECIMAL POINT SEEN
	JRST	BADLK
	TSWT	FBNUM
	JRST	BADDP
	SWON	FLITDP
	JRST	SCANL2

SCANL5:	MOVEM	TC,ESIZEA
	POPJ	PP,
;GET FIRST SIGNIFICANT DIGIT OF LITERAL IN VALTAB
;RETURN WITH THAT FIRST DIGIT IN "CH"

FDIGIT:	SWOFF	FLITDP!FLNEG!FERROR;
	SETZM	EDPLX(LN)
	SOSGE	ESIZEX(LN)
	JRST	LNOSIZ
	ILDB	CH,EBYTEX(LN)

	CAIN	CH,"+"
	JRST	FDIG4
	CAIN	CH,"-"
	JRST	FDIG3

FDIG1:	CAILE	CH,"9"
	JRST	BADLK
	CAIL	CH,"1"
	POPJ	PP,

	CAIN	CH,"0"
	JRST	FDIG6
	CAIE	CH,"."
	JRST	BADLK

	SWONS	FLITDP;

FDIG3:	SWON	FLNEG;

FDIG4:	CAIE	LN,EBASEA
	JRST	FDIG5
	TSWT	FANUM;
	JRST	BADLK
	JRST	FDIG7

FDIG5:	TSWT	FBNUM;
	JRST	BADLK
	JRST	FDIG7

FDIG6:	SKIPN	ESIZEX(LN)
	POPJ	PP,
	TSWF	FLITDP;
	AOS	EDPLX(LN)

FDIG7:	SOSGE	ESIZEX(LN)
	JRST	LNOSIZ
	ILDB	CH,EBYTEX(LN)
	JRST	FDIG1
;MULTIPLY A LITERAL BY SOME POWER OF 10.
;ENTER WITH THE POWER IN "TE", A PARAMETER TABLE BASE IN "LN".

ADJSL.:	JUMPLE	TE,CPOPJ	;REFUSE ANY NEGATIVE OR ZERO POWERS

	ADDM	TE,EDPLX(LN)
	MOVE	TA,TE
	ADDB	TA,ESIZEX(LN)
	CAILE	TA,MAXSIZ
	JRST	TOOBIG

	CAILE	TE,^D10
	JRST	ADJSL1

	IMUL	TD,POWR10(TE)
	MUL	TC,POWR10(TE)
	ADD	TD,TC
	MOVE	TC,TB
	POPJ	PP,

ADJSL1:	SUBI	TE,^D11
	LSH	TE,1
	MOVEM	TC,ELITLO

	IMUL	TD,DPWR10+1(TE)
	MUL	TC,DPWR10(TE)
	ADD	TD,TB
	MOVE	TC,ELITLO
	MUL	TC,DPWR10+1(TE)
	ADD	TD,TC
	MOVE	TC,TB

	POPJ	PP,
;SWAP THE TWO OPERANDS.

SWAPAB:	MOVE	TE,[XWD EBASEA,ESAVEB]
	BLT	TE,ESAVBX
	MOVE	TE,[XWD EBASEB,EBASEA]
	BLT	TE,EBASAX
	MOVE	TE,[XWD ESAVEB,EBASEB]
	BLT	TE,EBASBX

	MOVE	TA,SW
	TSWTZ	FBSIGN;
	SWOFFS	FASIGN;
	SWON	FASIGN;
	TSWTZ	FBNUM;
	SWOFFS	FANUM;
	SWON	FANUM;
	TSWTZ	FBSUB;
	SWOFFS	FASUB;
	SWON	FASUB;

	TRNE	TA,FASIGN
	SWON	FBSIGN;
	TRNE	TA,FANUM
	SWON	FBNUM;
	TRNE	TA,FASUB
	SWON	FBSUB;

	MOVSS	OPERND

IFN ANS74,<
	MOVE	TE,EDEBDA	;SWAP THE DEBUG STUFF ALSO
	EXCH	TE,EDEBDB
	MOVEM	TE,EDEBDA
	MOVE	TE,EDEBPA
	EXCH	TE,EDEBPB
	MOVEM	TE,EDEBPA
	MOVE	TE,EDEBGA
	EXCH	TE,EDEBGB
	MOVEM	TE,EDEBGA
>
	POPJ	PP,
;CREATE A BYTE POINTER TO "A" AND PUT IT INTO LITAB

MBYTEA:	MOVEI	TB,EBASEA
	JRST	MBYTEX

;LIKEWISE FOR "B"

MBYTEB:	MOVEI	TB,EBASEB

MBYTEX:	HRRZ	TA,EBASEX(TB)
	PUSHJ	PP,STASHL
	HLRZ	TA,ERESX(TB)
	ROT	TA,-6
	HRRZ	TC,EMODEX(TB)
	MOVE	TC,BYTE.S(TC)
	DPB	TC,[POINT 6,TA,11]
	HRR	TA,EINCRX(TB)
	JRST	STASHL


;SAME BUT FOR POOLED LITERALS

MBYTPA:	MOVEI	TB,EBASEA
	JRST	MBYTPX

;LIKEWISE FOR "B"

MBYTPB:	MOVEI	TB,EBASEB

MBYTPX:	HRRZ	TA,EBASEX(TB)
	PUSHJ	PP,STASHQ
	HLRZ	TA,ERESX(TB)
	ROT	TA,-6
	HRRZ	TC,EMODEX(TB)
	MOVE	TC,BYTE.S(TC)
	SKIPE	USENBT##
	IMUL	TC,NBYTES##	;USE LARGER BYTES
	DPB	TC,[POINT 6,TA,11]
	HRR	TA,EINCRX(TB)
	SKIPE	MAKBPB##	;MAKE AN INCREMENTED BYTE PTR?
	IBP	TA		;YES, INCREMENT BP
	SETZM	MAKBPB##	;CLEAR THE FLAG
	JRST	STASHQ
;WRITE OUT <OP AC,EBASEA+EINCRA>

PUT.AA:	MOVE	TE,EAC
PUT.A0:	DPB	TE,CHAC

;WRITE OUT <OP EBASEA+EINCRA>

PUT.A:	TSWF	FASUB		;IS IT SUBSCRIPTED?
	JRST	PUT.A2		;YES

PUT.A1:	HRR	CH,EBASEA
	SKIPN	EINCRA
	JRST	PUTAXY		;CHECK FOR EXTERNAL REF

	TLO	CH,ASINC
	PUSHJ	PP,PUTAXY	;CHECK FOR EXTERNAL SYMBOL
	HRRZ	CH,EINCRA
	JRST	PUTASN

PUT.A2:	LDB	TE,[POINT 3,EBASEA,20]
	CAIE	TE,TB.DAT
	JRST	PUT.A1

	TLO	CH,SXR
	HRR	CH,EINCRA
	JRST	PUTASY

;WRITE OUT <OP AC+1,EBASEA+EINCRA>

PUT.AO:	MOVE	TE,EAC
	AOJA	TE,PUT.A0
;WRITE OUT <OP AC,EBASEB+EINCRB>

PUT.BA:	MOVE	TE,EAC
PUT.B0:	DPB	TE,CHAC

;WRITE OUT <OP EBASEB+EINCRB>

PUT.B:	TSWF	FBSUB		;IS IT SUBSCRIPTED?
	JRST	PUT.B2		;YES

PUT.B1:	HRR	CH,EBASEB
	SKIPN	EINCRB
	JRST	PUTAXY		;CHECK FOR EXT. SYMBOL AND PUT IT OUT

	TLO	CH,ASINC
	PUSHJ	PP,PUTAXY	;CHECK FOR EXT. SYMBOL
	HRRZ	CH,EINCRB
	JRST	PUTASN

PUT.B2:	LDB	TE,[POINT 3,EBASEB,20]
	CAIE	TE,TB.DAT
	JRST	PUT.B1

	TLO	CH,SXR
	HRR	CH,EINCRB
	JRST	PUTASY

;WRITE OUT <OP AC+1,EBASEB+EINCRB>

PUT.BO:	MOVE	TE,EAC
	AOJA	TE,PUT.B0
;WRITE OUT <OP AC,[LITERAL]>.
;LITERAL VALUE IS IN TC.

PUT.LA:	MOVE	TE,EAC
	DPB	TE,CHAC

	TLNE	TC,-1
	JRST	PUT.L2

	ADD	CH,[1B8]
PUT.L0:	TRNE	TC,7B20
	JRST	PUT.L1
	HRR	CH,TC
	JRST	PUTASY

PUT.L1:	HRRI	CH,AS.CNB
	TLO	CH,ASINC
	PUSHJ	PP,PUTASY
	HRRZ	CH,TC
	JRST	PUTASN

;CHECK TO SEE IF LITERAL IS NEGATIVE SMALL NUMBER

PUT.L2:	TLC	TC,-1
	TLCN	TC,-1		;LEFT HALF ALL ONES
	TLNE	CH,777000	;AND OP WAS MOVE
	JRST	PUT.L		;NO
	TRNN	TC,-1		;[577] CHECK FOR -262144 I.E. <-1,,0>
	JRST	[TLO	CH,MOVSI.	;[577] YES, GENERATE
		MOVEI	TC,-1		;[577] MOVSI AC,-1
		JRST	PUT.L0]		;[577]
	TLO	CH,MOVNI.	;YES
	MOVNS	TC		;MAKE LITERAL POSITIVE
	JRST	PUT.L0		;GENERATE MOVNI AC,<LIT>

;WRITE OUT <OP X,[LITERAL]>.
;PUT LITERAL INTO AS.LIT
;LITERAL VALUE IS IN TC

PUT.L:	MOVE	TA,[XWD D1LIT,1]
	PUSHJ	PP,STASHP
	MOVE	TA,TC
	PUSHJ	PP,POOLIT
	SKIPN	EACC,PLITPC
	SKIPA	EACC,ELITPC
	CAIA
	AOS	ELITPC

;WRITE OUT <OP X,[LITERAL]>
;ADDRESS OF LITERAL IS IN EACC

PUT.LB:	HRRI	CH,AS.MSC
	TLO	CH,ASINC
	PUSHJ	PP,PUTASY
	HRRZ	CH,EACC
	IORI	CH,AS.LIT
	JRST	PUTASN
;GENERATE <OP AC,[POWER OF 10]>,  OR <OPI AC,POWER OF 10>.
;ENTER WITH OP SET UP IN CH, THE POWER IN TC.

PUT.PA:	MOVE	TE,EAC		;SET AC FIELD

	DPB	TE,CHAC

PUT.P:	CAIG	TC,5		;CAN IT BE IMMEDIATE MODE?
	JRST	PUT.P1		;YES

;SIMILAR TO GENOPL, EXCEPT THAT AC-FIELD NOT TOUCHED, AND
;	NO IMMEDIATE MODE.

PUT.PC:	PUSHJ	PP,CREATL	;CREATE THE LITERAL, IF NEEDED

	HRRI	CH,AS.MSC	;CREATE INSTRUCTION
	TLO	CH,ASINC
	PUSHJ	PP,PUTASY	;WRITE OUT FIRST OF TWO WORDS
	HRRZ	CH,EPWR10(TC)
	JRST	PUTASN		;WRITE OUT INCREMENT AND RETURN

PUT.P1:	ADD	CH,[1B8]	;IMMEDIATE MODE USED
	CAILE	TC,4		;IS IT LESS THAN 77777?
	JRST	PUT.P2

	HRR	CH,POWR10(TC)	;YES
	JRST	PUTASY

PUT.P2:	HRRI	CH,AS.CNB	;NO
	TLO	CH,ASINC
	PUSHJ	PP,PUTASY
	HRRZ	CH,POWR10(TC)
	JRST	PUTASN
;GENERATE AN INSTRUCTION REFERENCING CURRENT LITERAL.
;OP-CODE IS IN "CH", AC-FIELD IN EAC.

PUT.LC:	MOVE	TE,EAC
	DPB	TE,CHAC

;SIMILAR TO PUT.LC, EXCEPT THAT AC-FIELD UNALTERED.

PUT.LD:	HRRI	CH,AS.MSC
	TLO	CH,ASINC
	PUSHJ	PP,PUTASY

	SKIPN	CH,PLITPC##
	HRRZ	CH,ELITPC
	IORI	CH,AS.LIT
	JRST	PUTASN


;SET AC-FIELD TO "EAC", AND WRITE OUT INSTRUCTION.

PUT.XA:	MOVE	TE,EAC
PUT.X1:	DPB	TE,CHAC
	JRST	PUTASY

;SET AC-FIELD TO EAC+1, AND WRITE OUT INSTRUCTION.

PUT.XB:	MOVE	TE,EAC
PUT.X2:	AOJA	TE,PUT.X1

IFN BIS,<	INTERN	PUT.XC

;SET AC-FIELD TO EAC+2, AND WRITE OUT INSTRUCTION.

PUT.XC:	MOVE	TE,EAC
	AOJA	TE,PUT.X2
>


;PUT OUT MOVX 16,<Z AC,MEM>
;ON ENTRY CH CONTAINS:
;	LHS	DESTINATION AC
;	RHS	SOURCE ACC OR EBASEA/EBASEB

PUT.16:	TLNN	CH,-1		;LHS 0?
	JRST	PUT16I		;YES
	PUSH	PP,CH		;NO
	MOVE	TA,[XTNLIT,,1]
	TLNE	CH,ASINC	;NEED TWO WORDS?
	ADDI	TA,1		;YES
	PUSHJ	PP,STASHP	;GET LITERAL TO HOLD ACC 
	MOVE	TA,0(PP)	;GET <Z AC,ADDRESS>
	TRNE	TA,-20		;IS SOURCE ACC?
	HRR	TA,(TA)		;NO, GET IT
	TLNE	TA,ASINC	;INCREMENT WANTED?
	JRST	PUT162		;YES
	PUSHJ	PP,POOLIT	;NO, STORE 1 WORD
	POP	PP,TA		;FIXUP STACK
PUT161:	MOVE	CH,[MOV+ASINC+AC16,,AS.MSC]
	PUSHJ	PP,PUTASY
	SKIPN	CH,PLITPC
	SKIPA	CH,ELITPC
	TRNA
	AOS	ELITPC
	IORI	CH,AS.LIT
	JRST	PUTASN


PUT162:	PUSHJ	PP,STASHQ	;STORE FIRST WORD
	MOVE	TA,0(PP)	;GET WORD AGAIN
	HRRZ	TA,EINCRX(TA)	;YES, GET IT
	PUSHJ	PP,POOLIT	;STORE SECOND WORD
	POP	PP,TA
	JRST	PUT161		;GO GENERATE THE MOVE

PUT16I:	TLO	CH,MOVEI.+AC16
	TLNE	CH,ASINC	;INCREMENT TO FOLLOW?
	PUSH	PP,EINCRX(CH)	;SAVE INCREMENT
	TRNE	CH,-20		;IS SOURCE ACC?
	HRR	CH,(CH)		;NO, GET IT
	TLNN	CH,ASINC	;INCREMENT TO FOLLOW?
	JRST	PUTASY		;NO
	PUSHJ	PP,PUTASY
	POP	PP,CH
	JRST	PUTASN


;PUT OUT REFERENCE TO EXTERNAL AND CHECK FOR NON-RESIDENT

PUT.PJ:	HRLI	CH,EPJPP	;COMPLETE INSTRUCTION

PUT.EX:	PUSHJ	PP,PUTASY
	TSWT	FAS3
	POPJ	PP,
	ANDI	CH,77777
	ADD	CH,EXTLOC
	MOVSI	TE,NR.EXT
	IORM	TE,1(CH)
	POPJ	PP,

;SAME AS PUT.EX BUT TURNS ON @ SIGN NEEDED FLAG ALSO

PUT.SX:	PUSHJ	PP,PUTASY
	TSWT	FAS3
	POPJ	PP,
	ANDI	CH,77777
	ADD	CH,EXTLOC
	MOVSI	TE,NR.EXT!NR.IND
	IORM	TE,1(CH)
	POPJ	PP,
;ADJUST DECIMAL PLACES OF FLOATING-POINT ITEM IN AC'S.

GENFPL:	MOVM	TC,TD
	SKIPE	TD
	CAILE	TC,MAXSIZ
	POPJ	PP,

	MOVSI	CH,FMP.
	SKIPG	TD
	MOVSI	CH,FDV.

	SKIPE	TB,EFPCNV(TC)
	JRST	GENFP1

	MOVE	TB,ELITPC
	IORI	TB,AS.LIT
	MOVEM	TB,EFPCNV(TC)

	MOVE	TA,[XWD FLTLIT,2]
	PUSHJ	PP,STASHI
	MOVEI	TA,1(TC)
	PUSHJ	PP,STASHL
	MOVSI	TA,1B<^D18+7>
	PUSHJ	PP,STASHL
	AOS	ELITPC

GENFP1:	HRRI	CH,AS.MSC
	TLO	CH,ASINC
	PUSHJ	PP,PUT.XA
	HRRZ	CH,TB
	JRST	PUTASN
;ADJUST DECIMAL PLACES OF D.P. FLOATING-POINT ITEM IN AC'S.

GENF2L:	MOVM	TC,TD
	SKIPE	TD
	CAILE	TC,MAXSIZ
	POPJ	PP,

	PUSHJ	PP,PUTASA
	MOVSI	CH,DFMP.
	SKIPG	TD
	MOVSI	CH,DFDV.

	SKIPE	TB,EF2CNV(TC)	;ALREADY GENERATED
	JRST	GENFP1		;YES

	MOVE	TB,ELITPC
	IORI	TB,AS.LIT
	MOVEM	TB,EF2CNV(TC)	;STORE LOCATION
	SKIPE	EFPCNV(TC)	;[762] S.P. LOC ALREADY STORED?
	JRST	GENF21		;[762] YES
	MOVN	TD,TC		;[762] NO, SEE IF S.P. VALUE IS SAME
	MOVSI	TA,(1B0)	;[762]  AS HIGH WORD OF D.P. VALUE
	LSH	TA,(TD)		;[762] SHIFT BIT INTO POSITION
	AND	TA,[1B12+1B14+1B15+1B16+1B18+7B23+7777]	;[762] MASK
	JUMPN	TA,GENF21	;[762] ITS NOT THE SAME (S.P. IS ROUNDED UP)
	MOVEM	TB,EFPCNV(TC)	;[762] SAME SO MAY AS WELL STORE IT ALSO

GENF21:	MOVE	TA,[F2LIT,,2]	;[762] D. P. FLOATING POINT
	PUSHJ	PP,STASHI
	MOVEI	TA,1(TC)
	PUSHJ	PP,STASHL
	MOVSI	TA,(BYTE (4)0,1)
	PUSHJ	PP,STASHL
	AOS	ELITPC
	AOS	ELITPC		;SPACE FOR SECOND WORD OF ZERO
	JRST	GENFP1
;PUT A POWER OF 10 IN THE LITERAL POOL, AND PUT ENTRY ADDRESS INTO "EPWR10".
;ENTER WITH POWER IN "TC".

CREATL:	SKIPE	EPWR10(TC)
	POPJ	PP,

	CAILE	TC,^D10		;2 WORDS?
	JRST	CREAT2		;YES

	MOVE	TA,[XWD D1LIT,1];NO--1 WORD
	PUSHJ	PP,STASHI
	MOVE	TA,POWR10(TC)
	PUSHJ	PP,STASHL

	MOVE	TE,ELITPC	;SAVE ADDRESS OF THE LITERAL
	AOS	ELITPC		;BUMP THE ADDRESS

CREAT1:	IORI	TE,AS.LIT	;SET TABLE ENTRY WITH ADDRESS
	MOVEM	TE,EPWR10(TC)

	CAILE	TC,^D20
	SKIPE	EPWR10-^D20(TC)
	POPJ	PP,
	ADDI	TE,1
	MOVEM	TE,EPWR10-^D20(TC)
	POPJ	PP,

CREAT2:	MOVE	TA,[XWD D2LIT,2]	;GENERATE 2-WORD LITERAL
	PUSHJ	PP,STASHI

	CAILE	TC,^D20
	JRST	CREAT4

	MOVE	TE,TC
	SUBI	TE,^D11
	LSH	TE,1
	MOVE	TA,DPWR10(TE)
	MOVE	TD,DPWR10+1(TE)
	PUSHJ	PP,STASHL
	MOVE	TA,TD
CREAT3:	PUSHJ	PP,STASHL

	MOVEI	TE,2		;BUMP UP LITERAL ADDRESS
	EXCH	TE,ELITPC
	ADDM	TE,ELITPC
	JRST	CREAT1

CREAT4:	MOVEI	TA,0
	PUSHJ	PP,STASHL
	MOVE	TA,POWR10-^D20(TC)
	JRST	CREAT3
;INSURE THAT AC'S ARE 0&1.
;IF NOT, GENERATE A MOVE.

FORCX0:	SKIPN	CH,EAC
	POPJ	PP,

	HRLI	CH,MOV
IFE BIS,<
	PUSHJ	PP,PUTASY
	MOVE	CH,EAC
	SETZM	EAC
	HRRZ	TE,EMODEA
	CAIE	TE,D2MODE
	POPJ	PP,

	HRLI	CH,MOV+AC1
	AOJA	CH,PUTASY
>
IFN BIS,<
	SETZM	EAC
	HRRZ	TE,EMODEA
	CAIE	TE,D2MODE
	JRST	PUTASY
	HRLI	CH,DMOVE.
	PUSH	PP,CH
	PUSHJ	PP,PUTASA	;SIGNAL ALTERNATE
	POP	PP,CH
	JRST	PUTASY
>

;PUT OUT A "JRST" TO A MISCELLANEOUS ADDRESS.
;ENTER WITH ADDRESS INCREMENT IN "TC".

JOUT:	MOVE	CH,[XWD JRST.+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY
	MOVEI	CH,(TC)
	JRST	PUTASN
;DOUBLE PRECISION DIVIDE.  "TE" SPECIFIES SOME POWER OF 10.

DPDIV.:	CAILE	TE,^D10
	JRST	DPDIV1

	MOVE	TA,POWR10(TE)
	JRST	DPD21

DPDIV1:	SUBI	TE,^D11
	LSH	TE,1
	MOVE	TB,DPWR10(TE)
	MOVE	TA,DPWR10+1(TE)
	JRST	DPD22
;DIVIDE A DOUBLE PRECISION NUMBER BY A SINGLE PRECISION NUMBER..

;ENTER WITH DIVIDEND IN TD&TC, DIVISOR IN TA.
;EXIT WITH QUOTIENT IN TD&TC, REMAINDER IN TB&TA.

DPD21:	JOV	.+1
	DIV	TD,TA
	JOV	DPD21A

	MOVE	TA,TC
	MOVE	TC,TD
	SETZB	TD,TB
	POPJ	PP,

;QUOTIENT IS DOUBLE PRECISION.

DPD21A:	MOVE	TE,TD
	IDIV	TE,TA
	DIV	TD,TA

	MOVE	TA,TC
	MOVE	TC,TD
	MOVE	TD,TE
	HRRZI	TB,0
	POPJ	PP,
;DIVIDE A DOUBLE PRECISION NUMBER BY A DOUBLE PRECISION NUMBER.
;ENTER WITH DIVIDEND IN TD&TC, DIVISOR IN TB&TA.
;EXIT WITH QUOTIENT IN TD&TC, REMAINDER IN TB&TA.

COMMENT	\

DPD22:	MOVE	LN,TD
	MOVE	CP,TC
	IDIV	TD,TB

	MOVE	CH,TD

DPDIV3:	MUL	TD,TA
	MOVE	TE,TB
	IMUL	TE,CH
	ADD	TD,TE

	SUBM	LN,TD
	SUBM	CP,TC
	TLZE	TC,1B18
	SUBI	TD,1
	TLNE	TD,1B18
	TLO	TC,1B18

	JUMPGE	TD,DPDIV5
	MOVEI	TD,-1(CH)
	SOJA	CH,DPDIV3

DPDIV5:	MOVE	TA,TC
	MOVE	TB,TD
	HRRZI	TD,0
	MOVE	TC,CH

	POPJ	PP,

\

DPD22:	PUSH	PP,	SW		;SAVE SW.
	MOVE	LN,	TD		;SAVE A (THE DIVIDEND.)
	MOVE	CP,	TC

	IDIV	TD,	TB		;FORM S (INITIAL APPROXIMATION
					; TO THE QUOTENT.)

	MOVE	SW,	TD		;SAVE I (THE INCREMENT.)

	SKIPA	CH,	TD		;SAVE S.

DPDIV3:	MOVE	TD,	CH		;GET S.

	LSH	SW,	-1		;FORM I FOR THE NEXT ITERATION.
	SKIPN		SW
	MOVEI	SW,	1

	MUL	TD,	TA		;FORM S * B (B IS THE DIVISOR.)
	MOVE	TE,	TB
	IMUL	TE,	CH
	ADD	TD,	TE

	SUBM	LN,	TD		;FORM S * B - A.
	SUBM	CP,	TC
	TLZE	TC,	(1B0)
	SUBI	TD,	1

	JUMPL	TD,	DPDIV7		;IF S * B - A < 0, S > Q, GO
					; MAKE S SMALLER.

;S * B - A > OR = 0.

	CAMLE	TD,	TB		;SEE IF S * B - A > B.
	JRST		DPDIV5		;IT IS.
	CAMN	TD,	TB
	CAMGE	TC,	TA
	JRST		DPDIV9		;IT ISN'T, S = Q, GO RETURN.

;S * B - A > B ==> S < Q, MAKE S LARGER.

DPDIV5:	ADD	CH,	SW
	JRST		DPDIV3		;ITERATE.

;S * B - A < 0 ==> S > Q, MAKE S SMALLER.

DPDIV7:	SUB	CH,	SW
	JRST		DPDIV3		;ITERATE.

;COME HERE TO RETURN.

DPDIV9:	POP	PP,	SW		;RSTORE SW.

	MOVE	TA,	TC		;GET THE REMAINDER.
	MOVE	TB,	TD

	SETZI	TD,			;GET THE QUOTENT.
	MOVE	TC,	CH

	POPJ	PP,			;RETURN.
;SET CUREOP TO THE NEXT OPERAND IN EOPTAB.

BMPEOP:	MOVE	TE,CUREOP
	MOVE	TD,0(TE)
	MOVE	TE,1(TE)

	TLNN	TE,GNNOTD
	TLNE	TD,GNLIT
	TDCA	TD,TD
	LDB	TD,TESUBC

	LSH	TD,1
	ADDI	TD,2
	ADDB	TD,CUREOP

	HRRZ	TE,EOPNXT
	CAILE	TE,(TD)
	AOS	(PP)
	POPJ	PP,
;NEGATE THE 2-WORD LITERAL TO BE FOUND IN TD&TC.

NEGATL:	SETCA	TD,
	MOVNS	TC
	JUMPN	TC,CPOPJ
	ADDI	TD,1
	TLNN	TD,1B18
	TLZA	TC,1B18
	TLO	TC,1B18
	POPJ	PP,
;PUT A LITERAL INTO %LIT.
;ENTER WITH VALUE OF LITERAL IN TD&TC.

MAKEL:	MOVEI	TA,AS.MSC
	MOVEM	TA,EBASEX(LN)
	MOVE	TE,ESIZEX(LN)		;IS IT TWO WORDS?
	CAILE	TE,^D10
	JRST	MAKL1A		;YES

MAKEL1:	MOVE	TA,[XWD D1LIT,1]	;NO--CREATE A 1-WORD LITERAL
	PUSHJ	PP,STASHP
	TSWT	FLNEG		;LITERAL NEGATIVE?
	SKIPA	TA,TC		;NO--USE POSITIVE VALUE
	MOVN	TA,TC		;YES--USE NEGATIVE VALUE
	PUSHJ	PP,POOLIT

	SKIPN	TA,PLITPC
	SKIPA	TA,ELITPC	;GET %LIT ADDRESS
	CAIA
	AOS	ELITPC
	IORI	TA,AS.LIT
	MOVEM	TA,EINCRX(LN)
	MOVEI	TA,D1MODE
	MOVEM	TA,EMODEX(LN)
	POPJ	PP,

MAKL1A:	JUMPE	TD,MAKEL3

MAKL1B:	MOVE	TA,[XWD D2LIT,2]
	PUSHJ	PP,STASHP
	TSWF	FLNEG;
	PUSHJ	PP,NEGATL
	MOVE	TA,TD
	PUSHJ	PP,STASHQ
	MOVE	TA,TC
	PUSHJ	PP,POOLIT

	SKIPN	TA,PLITPC
	SKIPA	TA,ELITPC
	TDZA	TE,TE		;ZERO
	MOVEI	TE,2
	IORI	TA,AS.LIT
	MOVEM	TA,EINCRX(LN)
	ADDM	TE,ELITPC
	MOVEI	TE,D2MODE
	MOVEM	TE,EMODEX(LN)
	POPJ	PP,

MAKEL3:	MOVEI	TE,^D10
	MOVEM	TE,ESIZEX(LN)
	JRST	MAKEL1

MAKEL2:	MOVEI	TA,AS.MSC
	MOVEM	TA,EBASEX(LN)
	JRST	MAKL1B
;BUILD A SINGLE PARAMETER FROM "A" DATA.
;IF "A" IS SUBSCRIPTED, CALL SUBSCRIPT GENERATOR.
;IF "A" NOT SUBSCRIPTED, LEAVE PARAMETER IN %LIT.
;IF "SUBINP" IS -1, PUT BYTE POINTER IN SOME PLACE IT CAN BE MODIFIED.

B1PAR:	SKIPE	IBPFLG##	;THIS BETTER BE 0
	  JRST	E$IBP
	PUSHJ	PP,SUBSCD
	TSWF	FASUB		;IS "A" SUBSCRIPTED NOW?
	POPJ	PP,		;YES--RETURN

	SKIPN	SUBINP		;SKIP IF WE'RE SUPPOSED TO BE ABLE TO
				; MODIFY IT
	 JRST	B1PARN		;NO, PUT IT IN %LIT
;PUT PARAMETER IN %PARAM (OR %TEMP IF A NON-RESIDENT SECTION)
	TSWF	FAS3		;ARE WE IN A NON-RESIDENT SECTION?
	 JRST	B1PAR7		;YES, CAN'T USE %PARAM.

;PUT BASE PARAMETER IN %PARAM.
	PUSHJ	PP,BYTE.A	;GET BYTE PTR TO "A" IN TA AND TB
	TLZ	TA,7777		;MAKE IT LOOK LIKE A PARAMETER
	MOVE	CH,[XWD AS.XWD,1]
	PUSHJ	PP,PUTAS1
	MOVE	CH,TA
	PUSHJ	PP,PUTAS1
	MOVE	CH,TB
	PUSHJ	PP,PUTAS1

	HRRZ	EACC,EAS1PC
	IORI	EACC,AS.PAR	;RETURN AS.PAR AS ADDRESS
	AOS	EAS1PC
	POPJ	PP,

;HERE IF WE ARE IN A NON-RESIDENT SECTION.. BYTE POINTER MUST BE PUT
; INTO A TEMP.  NOTE WE MUST USE A RUNTIME AC.. AC7 IS ASSUMED TO BE FREE
; AT THIS POINT.
B1PAR7:	MOVE	TA,[BYTLIT,,2]
	PUSHJ	PP,STASHP
	PUSHJ	PP,MBYTPA
	PUSHJ	PP,POOL

	SKIPN	TE,PLITPC	;GET PTR TO LITERAL
	HRRZ	TE,ELITPC
	IORI	TE,AS.LIT
	SKIPN	PLITPC
	AOS	ELITPC		;UPDATE LITERAL PC
	MOVE	CH,[MOV+AC7+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY	;"MOVE AC7,LIT"
	MOVE	CH,TE
	PUSHJ	PP,PUTASN

	MOVEI	TE,1
	PUSHJ	PP,GETEMP
	PUSH	PP,EACC		;REMEMBER AS.TMP+N
	MOVE	CH,[MOVEM.+AC7+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	MOVE	CH,-1(PP)
	PUSHJ	PP,PUTASN
	POP	PP,EACC		;SETUP EACC FOR RETURN
	POPJ	PP,

B1PARN:	MOVE	TA,[XWD XWDLIT,2]	;NO--PUT PARAMETER INTO %LIT
	PUSHJ	PP,STASHP

	HLRZ	TA,ERESA
	LSH	TA,14
	ADD	TA,SUBCON
	HRLZS	TA
	HRRI	TA,AS.CNB
	PUSHJ	PP,STASHQ

	MOVE	TA,EBASEA
	HRL	TA,EINCRA
	PUSHJ	PP,POOLIT

	SKIPN	EACC,PLITPC
	MOVE	EACC,ELITPC
	SKIPN	PLITPC
	AOS	ELITPC
	IORI	EACC,AS.LIT

	POPJ	PP,
;ALTERNATE VERSION OF B1PAR
;SETUP BYTE PTR TO "A" IN AC5.

NB1PAR:: MOVEI	TE,5
	MOVEM	TE,SUSEAC##	;USE AC5 FOR SUBSCRIPTING
	SETOM	IBPFLG##	;USING B.P. FOR ILDB OR EXTEND
	PUSHJ	PP,SUBSCA	;DO SUBSCRIPTING IF NECESSARY
	TSWT	FASUB		;CONSTANT OR NO SUBSCRIPTS?
	 JRST	NB1PR1		;YES
NB1PR2:	SETZM	SUSEAC##	;CLEAR "USE AC" FLAG
	SETZM	IBPFLG##	;CLEAR INCASE SUBSCR NOT CALLED
	POPJ	PP,		;RETURN

NB1PR1:
IFN BIS,<
	SKIPN	USENBT		;USE LARGER BYTE OPT. ON?
	 JRST	NB1PR3		;NO
	MOVE	TA,NBYTES
	CAIE	TA,4		;FULL WORD BYTES?
	CAIN	TA,6
	 JRST	NB1PR2		;YES--DON'T SETUP AC
NB1PR3:
>;END IFN BIS
	MOVE	TA,[BYTLIT,,2]
	PUSHJ	PP,STASHP
	PUSHJ	PP,MBYTPA	;BYTE PTR TO "A"
	PUSHJ	PP,POOL
	MOVSI	CH,MOV+AC5
	PUSHJ	PP,PUT.LD
	SKIPN	PLITPC
	AOS	ELITPC
	JRST	NB1PR2
;LIKE NB1PAR, EXCEPT SETUP BYTE PTR TO "B" IN AC10

NBBPAR:: MOVEI	TE,10
	MOVEM	TE,SUSEAC##
	SETOM	IBPFLG##
	PUSHJ	PP,SUBSCB
	TSWT	FBSUB		;CONSTANT OR 0 SUBSCRIPTS?
	 JRST	NBBPR1		;YES
NBBPR2:	SETZM	SUSEAC##
	SETZM	IBPFLG##
	POPJ	PP,

NBBPR1:
IFN BIS,<
	SKIPN	USENBT
	 JRST	NBBPR3
	MOVE	TE,NBYTES
	CAIE	TE,4
	CAIN	TE,6
	 JRST	NBBPR2		;DON'T SETUP AC
NBBPR3:
>;END IFN BIS

	MOVE	TA,[BYTLIT,,2]
	PUSHJ	PP,STASHP
	PUSHJ	PP,MBYTPB
	PUSHJ	PP,POOL
	MOVSI	CH,MOV+AC10
	PUSHJ	PP,PUT.LD
	SKIPN	PLITPC
	AOS	ELITPC
	JRST	NBBPR2
;SET UP TWO PARAMETERS (FOR MOVE OR IF).
;IF BOTH FIELDS ARE SUBSCRIPTED, PARAMETERS ARE PUT INTO %TEMP.
;IF ONLY ONE FIELD IS SUBSCRIPTED, PARAMETERS ARE PUT INTO %PARAM.
;IF NEITHER FIELD IS SUBSCRIPTED, PARAMETERS ARE PUT INTO %LIT.

B2PAR:	PUSHJ	PP,SUBSCA	;SUBSCRIPT "A" IF NECESSARY
	TSWF	FASUB		;IS IT SUBSCRIPTED NOW?
	JRST	B2PAR3		;YES

	PUSHJ	PP,SUBSCC	;NO--SUBSCRIPT "B" IF NECESSARY
	TSWF	FBSUB		;IS "B" SUBSCRIPTED?
	JRST	B2PAR6		;YES

;NEITHER IS SUBSCRIPTED
	PUSH	PP,ELITPC	;[543] SAVE LITERAL PC NOW
IFN ANS74,<
	SKIPN	COLSCP##	;[1004] SPECIAL
	JRST	B2PAR1		;NO
	MOVE	TA,[XWDLIT,,2]
	PUSHJ	PP,STASHP
	MOVEI	TA,AS.CNB	;LHS = 0
	PUSHJ	PP,STASHQ
	MOVE	TA,EMODEA
	HRLZ	TA,COLSQS##(TA)	;GET COLLATING SEQUENCE
	HRRI	TA,AS.MSC
	PUSHJ	PP,STASHQ
	AOS	ELITPC
B2PAR1:>
	MOVE	TA,[XWD BYTLIT,2]
	PUSHJ	PP,STASHP
	PUSHJ	PP,BYTE.A
	EXCH	TB,TA
	HLR	TB,TA
	HRRZS	TA
	PUSHJ	PP,STASHQ
	MOVE	TA,TB
	PUSHJ	PP,STASHQ
	AOS	ELITPC		;[543]

	MOVE	TA,[XWD XWDLIT,2]
	PUSHJ	PP,STASHP
	PUSHJ	PP,BYTE.C

	TSWF	FBSIGN;
	TLO	TA,SYNBIT
	PUSHJ	PP,STASHQ
	MOVE	TA,TB
	PUSHJ	PP,POOLIT
	POP	PP,ELITPC	;[543] RESTORE INITIAL ELITPC
	SKIPN	EACC,PLITPC
	MOVE	EACC,ELITPC	;GET PC AT START OF THIS BUNCH OF LITS
	IORI	EACC,AS.LIT
;SET UP TWO PARAMETERS (CONT'D).
	MOVEI	TE,2		;NORMAL NUMBER OF WORDS
IFN ANS74,<
	SKIPE	COLSCP		;[1004] SPECIAL COLL. SEQ.?
	ADDI	TE,1		;ONE MORE
>
	SKIPN	PLITPC
	ADDM	TE,ELITPC	;GET LIT PC CORRECT
	POPJ	PP,

;"A" IS SUBSCRIPTED

B2PAR3:	TSWT	FAS3		;ARE WE IN NON-RESIDENT SEGMENT?
	TSWF	FBSUB		;NO--IS "B" ALSO SUBSCRIPTED?
	JRST	B2PAR8		;YES

IFN ANS74,<
	SKIPE	COLSCP		;[1004] [743] SPECIAL COL. SEQ.?
	PUSHJ	PP,B2PR6C	;[743] YES
>
	MOVE	CH,[XWD AS.OCT,1]	;NO--USE IMPPAR
	PUSHJ	PP,PUTAS1
	HRRZI	CH,0
	PUSHJ	PP,PUTAS1

	MOVE	CH,MOVSAC
	PUSHJ	PP,PUTASY
	HRRZ	CH,EAS1PC
	IORI	CH,AS.PAR
	PUSHJ	PP,PUTASN

	PUSHJ	PP,BYTE.C
	TSWF	FBSIGN;
	TLO	TA,SYNBIT
	MOVE	CH,[XWD AS.XWD,1]
	PUSHJ	PP,PUTAS1
	MOVE	CH,TA
	PUSHJ	PP,PUTAS1
	MOVE	CH,TB
	PUSHJ	PP,PUTAS1

B2PAR4:	MOVEI	EACC,2
	EXCH	EACC,EAS1PC
	ADDM	EACC,EAS1PC
IFN ANS74,<
	SKIPE	COLSCP		;[1004] [721] SPECIAL COL. SEQ.?
	SUBI	EACC,1		;[721] YES, ACCOUNT FOR EXTRA PARAM
>
	IORI	EACC,AS.PAR
	POPJ	PP,
;SET UP PARAMETERS (CONT'D).

;"B" IS SUBSCRIPTED, "A" ISN'T

B2PAR6:	TSWF	FAS3		;ARE WE IN NON-RESIDENT SEGMENT?
	JRST	B2PAR7		;YES
IFN ANS74,<
	SKIPE	COLSCP		;[1004] [743] [721] SPECIAL COL. SEQ.?
	PUSHJ	PP,B2PR6C	;[743] [721] YES
>				;[743] [721]
	PUSHJ	PP,BYTE.A
	MOVSI	CH,AS.BYT
	HRR	CH,TB
	PUSHJ	PP,PUTAS1

	MOVS	CH,TB
	HLL	CH,TA
	PUSHJ	PP,PUTAS1

	MOVE	CH,[XWD AS.OCT,1]
	PUSHJ	PP,PUTAS1
	MOVEI	CH,0
	PUSHJ	PP,PUTAS1

	MOVE	CH,MOVSAC
	PUSHJ	PP,PUTASY
	HRRZ	CH,EAS1PC
	ADDI	CH,1
	IORI	CH,AS.PAR
	PUSHJ	PP,PUTASN
	JRST	B2PAR4

IFN ANS74,<
B2PR6C:	MOVE	CH,[AS.XWD,,1]	;[743] [721] NEED EXTRA WORD FOR COL. SEQ.
	PUSHJ	PP,PUTAS1	;[721] PUT IN LOW SEQ DATA
	SETZ	CH,		;[721] LHS = 0
	PUSHJ	PP,PUTAS1	;[721]
	MOVE	CH,EMODEA	;[721]
	HRLZ	CH,COLSQS##(CH)	;[721] GET COLLATING SEQUENCE
	HRRI	CH,AS.MSC	;[721]
	PUSHJ	PP,PUTAS1	;[721]
	AOS	EAS1PC		;[721] ACCOUNT FOR EXTRA WORD
	POPJ	PP,		;[743]
>
B2PAR7:	MOVEI	TE,2
IFN ANS74,<
	SKIPE	COLSCP		;[1004] [721] SPECIAL COL. SEQ.?
	ADDI	TE,1		;[721] YES, NEED EXTRA WORD
>
	PUSHJ	PP,GETEMP
IFN ANS74,<
	SKIPE	COLSCP		;[1004] [721] SPECIAL COL. SEQ. CODE?
	AOS	EACC		;[721] YES, LEAVE FIRST WORD FREE
>
	PUSH	PP,EACC
	MOVE	CH,MOVSAC
	PUSHJ	PP,PUTASY
	HRRZ	CH,0(PP)
	ADDI	CH,1
	PUSHJ	PP,PUTASN

	PUSHJ	PP,B2PR9A
	MOVE	CH,MOVSAC
	PUSHJ	PP,PUTASY
	POP	PP,CH
IFN ANS74,<
	MOVE	EACC,CH		;[721] INCASE COL. SEQ.
	JRST	B2PR9B		;[721] SEE IF SPECIAL COL. SEQ.?
>
IFN ANS68,<
	JRST	PUTASN		;[721]
>
;SET UP TWO PARAMETERS (CONT'D).

;WE ARE GOING TO USE %TEMP TO HOLD PARAMETERS.
;EITHER BOTH ITEMS WERE SUBSCRIPTED, OR WE ARE IN NON-RESIDENT SEGMENT.

B2PARD::			;ENTER HERE TO FORCE PARAMS INTO TEMP FOR DEPENDENT MOVE
	PUSHJ	PP,SUBSCA	;SUBSCRIPT "A" IF NECESSARY
	PUSHJ	PP,SUBSCC	;DITTO "B"

B2PAR8:	MOVEI	TE,2
IFN ANS74,<
	SKIPE	COLSCP		;[1004] [721] SPECIAL COL. SEQ.?
	ADDI	TE,1		;[721] YES, NEED EXTRA WORD
>
	PUSHJ	PP,GETEMP
IFN ANS74,<
	SKIPE	COLSCP		;[1004] [721] SPECIAL COL. SEQ. CODE?
	AOS	EACC		;[721] YES, LEAVE FIRST WORD FREE
>
	PUSH	PP,EACC		;SAVE ADDRESS
	TSWT	FASUB		;IS "A" SUBSCRIPTED?
	PUSHJ	PP,B2PR9A	;NO

	MOVE	CH,MOVSAC
	PUSHJ	PP,PUTASY
	HRRZ	CH,(PP)
	PUSHJ	PP,PUTASN

	PUSHJ	PP,SUBSCC
	TSWF	FBSUB		;"B" SUBSCRIPTED?
	JRST	B2PAR9		;YES
	MOVE	TA,[XWD XWDLIT,2]
	PUSHJ	PP,STASHP
	PUSHJ	PP,BYTE.C
	TSWF	FBSIGN
	TLO	TA,SYNBIT
	PUSHJ	PP,STASHQ
	MOVE	TA,TB
	PUSHJ	PP,POOLIT
	MOVSI	CH,MOV+SAC
	PUSHJ	PP,PUT.LD
	SKIPN	PLITPC
	AOS	ELITPC

B2PAR9:	MOVE	CH,MOVSAC
	PUSHJ	PP,PUTASY
	POP	PP,EACC
	HRRZI	CH,1(EACC)
IFN ANS74,<
B2PR9B:	SKIPN	COLSCP		;[1004] [721] SPECIAL COL. SEQ.?
	JRST	PUTASN		;[721] NO
	SOS	EACC		;[721] BACKUP TO FIRST WORD
	PUSH	PP,EACC		;[721] SAVE AGAIN
	PUSHJ	PP,PUTASN	;[721] SAVE SECOND SUBSCRIPT
	MOVE	CH,[MOVEI.+AC12+ASINC,,AS.MSC]	;[721]
	PUSHJ	PP,PUTASY	;[721]
	MOVE	CH,EMODEA	;[721]
	HRRZ	CH,COLSQS(CH)	;[721] GET COLLATING SEQUENCE
	PUSHJ	PP,PUTASN	;[721]
	MOVE	CH,MOVSAC	;[721]
	PUSHJ	PP,PUTASY	;[721]
	POP	PP,CH		;[721] POINT TO WORD 1
>
	JRST	PUTASN


B2PR9A:	MOVE	TA,[XWD BYTLIT,2]
	PUSHJ	PP,STASHP
	PUSHJ	PP,MBYTPA
	PUSHJ	PP,POOL
	MOVSI	CH,MOV+SAC
	PUSHJ	PP,PUT.LD
	SKIPN	PLITPC
	AOS	ELITPC
	POPJ	PP,
;SET UP TWO PARAMETERS, AND GET REAL BYTE POINTERS TO BOTH.
;THIS GENERATES CODE TO LEAVE AN ILDB BYTE PTR TO "A" IN AC5, BYTE
;POINTER TO "B" IN AC10
; NOTE: IF USING FULL-WORD BYTES (4 OR 6 BYTES/BYTE), ONLY THE
;ADDRESS WILL BE PUT IN THE SUBSCRIPT AC, NOT A BYTE PTR.

NB2PAR:: PUSHJ	PP,EXMAB	;GET SUBSCRIPTS INTO TEMP LOCS IF NECESSARY
	TSWF	FERROR		;ANY ERRORS?
	 POPJ	PP,		;YES, GIVE UP
	PUSHJ	PP,NB1PAR	;GET BYTE PTR TO "A" IN AC5
	PJRST	NBBPAR		;BYTE PTR TO "B" IN AC10
IFN BIS,<
;ROUTINES TO SETUP BYTE PTRS FOR MOVE/COMPARE OF ONLY ONE BYTE.
; RETURNS TA= XWD <PTR TO "A">, <PTR TO "B">
;IF PTR POINTS TO AC, E.G. "5", BYTE PTR SHOULD BE INCREMENTED BEFORE
;USE. IF PTR POINTS TO %LIT00+N, BYTE PTR SHOULD BE ONLY "LDB'D" OR "DPB'D".

PCXBP2:: PUSHJ	PP,EXMAB	;MAKE SURE SUBSCRIPTS ARE IN %TEMP.
	PUSHJ	PP,PCXBPA	;PUT PTR TO "A" IN LH (PCXPTR)
	TSWF	FERROR		;ERRORS?
	 JRST	PCX2B		;YES
	PUSHJ	PP,PCXBPB	;PUT PTR TO "B" IN RH (PCXPTR)
	TSWF	FERROR		;ERRORS?
PCX2B:	SETZM	PCXPTR##	;ERRORS - CLEAR PCXPTR
	POPJ	PP,		;RETURN

;ROUTINE TO DO THE SAME FOR ONLY 1 PARAMETER

PCXBP1:: PUSHJ	PP,PCXBPA	;DO IT FOR "A"
	TSWF	FERROR		;ERRORS?
	SETZM	PCXPTR##	;YES, CLEAR
	POPJ	PP,		;RETURN
;ROUTINE TO SETUP BYTE PTR TO "A", PUT IN LITAB IF NOT SUBSCRIPTED,
;AND RETURN PTR TO WHERE IT WILL BE IN LH (PCXPTR)

PCXBPA:	MOVEI	TE,5		;USE AC 5 FOR SUBSCRIPTING
	MOVEM	TE,SUSEAC##
	SETOM	IBPFLG##	;IGNORE SUBCON
	PUSHJ	PP,SUBSCA
	TSWT	FASUB
	 JRST	PCXC		;CONSTANT OR NO SUBSCRIPTS

;RETURN "5" AS PTR TO "A"
PCXRT5:	MOVEI	TE,5		;SUBSCRIPTING WAS DONE
PCXRTA:	HRLM	TE,PCXPTR##	;RETURN PTR TO "A"
PCXRTT:	SETZM	SUSEAC##
	SETZM	IBPFLG##
	POPJ	PP,

PCXC:	SKIPN	USENBT##	;USING THE BIG BYTE OPTIMIZATION?
	 JRST	PCXC1		;NO
	MOVE	TE,NBYTES##	;YES
	CAIE	TE,6
	CAIN	TE,4		;4 OR 6 (36-BIT BYTES)?
	 JRST	PCXRT5		;YES--DON'T SETUP AC
PCXC1:	MOVE	TA,[XWD BYTLIT,2] ;PUT ANSWER IN LITAB
	PUSHJ	PP,STASHP
	SETOM	MAKBPB##	;TELL MBYTPA TO INCREMENT THE B.P.
	PUSHJ	PP,MBYTPA
	PUSHJ	PP,POOL

	SKIPN	TE,PLITPC	;GET PTR TO LITERAL
	HRRZ	TE,ELITPC
	IORI	TE,AS.LIT
	SKIPN	PLITPC		;DID WE POOL IT?
	AOS	ELITPC		;NO, UPDATE LITERAL PC
	JRST	PCXRTA		;STORE PTR TO "A" & RETURN
;SAME AS PCXBPA, EXCEPT FOR "B". USES AC 10 FOR SUBSCRIPTING

PCXBPB:	MOVEI	TE,10
	MOVEM	TE,SUSEAC##
	SETOM	IBPFLG##
	PUSHJ	PP,SUBSCB
	TSWT	FBSUB
	 JRST	PCXD		;CONSTANT OR NO SUBSCRIPTS

;RETURN "10" AS PTR TO "B"
PCXR10:	MOVEI	TE,10
PCXRTB:	HRRM	TE,PCXPTR##	;RETURN PTR IN RH (PCXPTR)
	JRST	PCXRTT		;RETURN

PCXD:	SKIPN	USENBT##
	 JRST	PCXD1
	MOVE	TE,NBYTES##
	CAIE	TE,6
	CAIN	TE,4
	 JRST	PCXR10		;DON'T SETUP AC10, RETURN
PCXD1:	MOVE	TA,[XWD BYTLIT,2]
	PUSHJ	PP,STASHP
	SETOM	MAKBPB##
	PUSHJ	PP,MBYTPB
	PUSHJ	PP,POOL

	SKIPN	TE,PLITPC
	HRRZ	TE,ELITPC
	IORI	TE,AS.LIT

	SKIPN	PLITPC
	AOS	ELITPC
	JRST	PCXRTB		;RETURN PTR TO "B"
;GETNB -- ROUTINE TO CHECK FOR "LARGER BYTE" OPTIMIZATION.
; CALLED FROM MOVGEN & IFGEN.
;
;INPUTS:
;	"A" & "B" SETUP BY SETOPN.
;	NCHARS/  #CHARS TO MOVE OR COMPARE
;
;RETURNS:
;	NBYTES/  MULTIPLE # OF BYTES TO USE, E.G., IF
;		MODE IS SIXBIT AND NBYTES=2, USE 12 BIT BYTES.
;
;	NOTE: THIS ROUTINE ONLY WORKS WHEN "A" AND "B" ARE
;		DISPLAY ITEMS OF THE SAME MODE

GETNB::	SKIPE	USENBT##	;THIS SHOULD BE 0 AT THIS POINT
	 JRST	E$UNZ		;? INTERNAL COMPILER ERROR
	PUSHJ	PP,DEPCKK	; ANY DEPENDING ITEMS?
	 TRNA			;NO, OK
	  JRST	GOTAN1		;"A" OR "B" HAS A DEPENDING ITEM - RETURN 1
	SETOM	ONLYEX##	;TELL SUBSCRIPT ROUTINE WE JUST WANT INFO,
				;NO REAL SUBSCRIPT CODE GENERATED
	MOVEI	DT,EBASEA	;POINT TO "A"
	MOVE	TD,[FASUB]	;"A" SUBSCRIPT FLAG IN TD
	PUSHJ	PP,GETNB1	;HOW MANY BYTES/BYTE?
	PUSH	PP,TA		;SAVE ANSWER FOR A

	MOVEI	DT,EBASEB	;NOW DO THE SAME FOR B
	MOVE	TD,[FBSUB]
	PUSHJ	PP,GETNB1
	POP	PP,TC		;TC= "A" ANSWER, TA= "B" ANSWER

;USE EUCLID'S ALGORITHM TO FIND GREATEST COMMON DIVISOR

	CAMLE	TA,TC		;GET TC= LARGER NUMBER
	EXCH	TA,TC

E1:	IDIVI	TC,(TA)		;GET TB= REMAINDER
	JUMPE	TB,GOTNB	;IF 0, ANSWER=TA
	MOVE	TC,TA
	MOVE	TA,TB
	JRST	E1

GOTNB:	MOVE	TC,NCHARS##	;GET # CHARS TO MOVE/COMPARE
	CAMLE	TA,TC		;GET GREATEST COMMON DIVISOR AGAIN
	EXCH	TA,TC

E1AGEN:	IDIVI	TC,(TA)
	JUMPE	TB,GOTANS
	MOVE	TC,TA
	MOVE	TA,TB
	JRST	E1AGEN

GOTAN1:	MOVEI	TA,1		;RETURN 1 IF CAN'T DO IT

GOTANS:	MOVEM	TA,NBYTES##	;SAVE # TO USE
	SETZM	ONLYEX##	;CLEAR FLAG FOR SUBSCR
	POPJ	PP,		;RETURN
;ROUTINE TO LOOK AT OPERAND POINTED TO BY DT, WITH CUREOP
;POINTING TO THE ITEM, AND FIGURE OUT HOW MANY BYTES WE CAN
;LDB AT ONCE (INDEPENDENT OF HOW MANY CHARS TO MOVE).
;RETURNS TA= MAX # BYTES.

GETNB1:	TDCN	SW,TD		;IS IT SUBSCRIPTED?
	 JRST	NOTSB		;NO
	PUSH	PP,TD		;SAVE FLAG
	SETOM	IBPFLG##	;GENERATE A BYTE PTR!
	CAIN	DT,EBASEB	;POINTING TO B?
	 SKIPA	TE,OPERND
	HLRZ	TE,OPERND
	HRRZM	TE,CUREOP	;SETUP CUREOP
	PUSH	PP,DT		;SAVE PTR TO A OR B
	CAIN	DT,EBASEA	;SETUP PTR THE WAY SUBSCR LIKES IT
	 SKIPA	DT,[ESAVES]
	MOVEI	DT,ESAVSB	;. .
	PUSHJ	PP,SUBSCR
	 JRST	NOTSBA		;LITERAL SUBSCRIPTS OR ERRORS
	POP	PP,DT
	POP	PP,TD
	TDO	SW,TD		;REMEMBER IT IS SUBSCRIPTED

;RETURN GCD OF NUMBER RETURNED BY GETNBS AND S1SIZ

	PUSHJ	PP,GETNBS	;# BYTES BASED ON BYTE RESIDUE
	MOVE	TC,S1SIZ##	;TC= SIZE OF ELEMENTARY ITEM
	CAMLE	TA,TC
	EXCH	TA,TC		;GET TC=LARGER NUMBER

GETNLP:	IDIVI	TC,(TA)
	JUMPE	TB,CPOPJ	;ANSWER= TA
	MOVE	TC,TA
	MOVE	TA,TB
	JRST	GETNLP		;LOOP


;HERE IF THE ITEM WAS NOT SUBSCRIPTED (OR LITERAL SUBSCRIPTS)

NOTSBA:	POP	PP,DT
	POP	PP,TD
	TSWF	FERROR		;ERRORS?
	 POPJ	PP,		;YES. RETURN IMMEDIATELY
	HRRZM	TE,EINCRX(DT)
	LSH	TE,-14
	HLLM	TE,ERESX(DT)
NOTSB:	TDZ	SW,TD		;CLEAR SUBSCRIPT FLAG

	PJRST	GETNBS		;RETURN TA= # BYTES TO USE
;ROUTINE TO GET # BYTES/BYTE TO USE, DEPENDING ON BYTE RESIDUE ONLY
;RETURNS ANSWER IN TA

GETNBS:	HLRZ	TB,ERESX(DT)	;GET BYTE RESIDUE
	SKIPN	TB		;0? (END-OF-WORD)
	 MOVEI	TB,^D36		;YES, SAME AS 36
	MOVE	TD,EMODEX(DT)	;GET MODE
	IDIV	TB,[	EXP 6
			EXP 7
			EXP 9](TD) ;CONVERT BIT RESIDUE TO # BYTES
	MOVE	TE,[	EXP NB6TBL
			EXP NB7TBL
			EXP NB9TBL](TD) ;GET TABLE TO USE
	HRLI	TE,(POINT 6)	;POINT TO IT
	MOVEI	TC,6
	SUB	TC,TB
	IMULI	TC,6		;GET BYTE RESIDUE IN "TABLE"
	DPB	TC,[POINT 6,TE,5] ;MAKE TE POINT TO ANSWER
	LDB	TA,TE		;PUT IT IN TA
	POPJ	PP,		;AND RETURN

;1-WORD "TABLES" FOR GETNBS

NB6TBL:	BYTE(6) 1,2,3,2,1,6
NB7TBL:	BYTE(6) 1,1,1,1,5,0
NB9TBL:	BYTE(6) 1,2,1,4,0,0
>;END IFN BIS
;GENERATE SUBSCRIPT CALL FOR "A"
SUBSCA:	TSWT	FASUB		;IS IT SUBSCRIPTED?
	POPJ	PP,		;NO--NO ACTION

	HRRZ	TE,EMODEA
	CAIN	TE,C3MODE	;IS IT COMP-3?
	MOVEI	TE,D9MODE	;YES, WE WILL USE 9 BIT BYTES THEN.
	CAILE	TE,DSMODE
	TDCA	TE,TE
	MOVE	TE,BYTE.S(TE)
	LSH	TE,6
	MOVEM	TE,SUBCON
SBSCA1:	MOVEI	DT,ESAVES
	HLRZ	TE,OPERND
	MOVEM	TE,CUREOP
	PUSHJ	PP,SUBSCR
	SWOFFS	FASUB		;LITERAL SUBSCRIPTS
	POPJ	PP,		;NON-LITERAL SUBSCRIPTS

	HRRZM	TE,EINCRA
	LSH	TE,-14
	HLLM	TE,ERESA
	POPJ	PP,

;GENERATE SUBSCRIPT CALL FOR "B"
SUBSCB:	TSWT	FBSUB;
	POPJ	PP,

	HRRZ	TE,EMODEB
	CAIN	TE,C3MODE	;IF IT'S COMP-3,
	MOVEI	TE,D9MODE	;PRETEND IT'S EBCDIC.
	CAILE	TE,DSMODE
	TDCA	TE,TE
	MOVE	TE,BYTE.S(TE)
	LSH	TE,6
SUBSB0:	MOVEM	TE,SUBCON
SUBSB1:	MOVEI	DT,ESAVSB
	HRRZ	TE,OPERND
	MOVEM	TE,CUREOP
	PUSHJ	PP,SUBSCR
	SWOFFS	FBSUB		;LITERAL SUBSCRIPTS
	POPJ	PP,		;NON-LITERAL SUBSCRIPTS

	HRRZM	TE,EINCRB
	LSH	TE,-14
	HLLM	TE,ERESB
	POPJ	PP,

;GENERATE SUBSCRIPT CALL FOR "B", WITH SIZE IN SUBCON
SUBSCC:	TSWT	FBSUB		;IS IT SUBSCRIPTED?
	POPJ	PP,		;NO
	HRRZ	TE,ESIZEB
	TSWF	FBSIGN;
	IORI	TE,SYNBIT
	JRST	SUBSB0
;GENERATE SUBSCRIPT CALL FOR "A", WITH "ESIZEZ" IN SUBCON.

SUBSCD:	HRRZ	TE,ESIZEZ
	TSWF	FASIGN;
	IORI	TE,SYNBIT
	MOVEM	TE,SUBCON
	TSWT	FASUB;
	POPJ	PP,
	JRST	SBSCA1


;GENERATE SUBSCRIPT CALL FOR "B", ASSUMING "SUBCON" IS SET UP

SUBSCE:	TSWT	FBSUB		;IS "B" SUBSCRIPTED?
	POPJ	PP,		;NO

	JRST	SUBSB1		;YES

;ROUTINE TO MAKE SURE THAT SUBSCRIPTS TO "A" AND "B" ARE
;PUT IN TEMP LOCATIONS BEFORE THE ACTUAL SUBSCRIPT CODE IS
;GENERATED. THIS ALLOWS THE LIBOL CONVERSION ROUTINES TO
;USE ALL AC'S WITHOUT FEAR OF SMASHING SOMETHING.

EXMAB::	SETOM	ONLYEX##	;"ONLY EXAMINE" FLAG
	SETOM	IBPFLG##	; BYTE PTR BEING GENERATED
	PUSHJ	PP,SUBSCA	; FOR "A"
	SETOM	IBPFLG##
	PUSHJ	PP,SUBSCB	; FOR "B"
	SETZM	ONLYEX##	;DONE WITH THIS
	SETZM	IBPFLG##
	POPJ	PP,		;RETURN
SUBTTL	SUBSCR - GENERATE CODE FOR SUBSCRIPTING

;ENTER WITH "CUREOP" POINTING TO THE ITEM, A CONSTANT IN "SUBCON",
;	AND "DT" POINTING TO EITHER ESAVES (FOR A), OR ESAVSB (FOR B).
;EXIT TO CALL+1 IF ALL SUBSCRIPTS ARE LITERALS, OR IF ERRORS FOUND
;	WITH "TE" CONTAINING THE BYTE POINTER.
;EXIT TO CALL+2 IF NOT ALL SUBSCRIPTS WERE LITERALS, AFTER GENERATING CODE.
;
;  IF "ONLYEX" IS -1, JUST CALL "EXMSUB" TO GEN CODE TO PUT SUBSCRIPTS
;INTO %TEMP, DON'T GENERATE ANY OTHER SUBSCRIPT CODE, AND RETURN S1SIZ=
;SIZE OF BASE ITEM. ON EXIT, "ONLYEX" WILL STILL BE -1.
;
;  IF "ALSTMP" IS -1, PUT ALL SUBSCRIPTS IN %TEMP, EVEN COMP ONES.
;THIS FLAG SHOULD ONLY BE SET IN CONJUNCTION WITH "ONLYEX". ON
;EXIT, "ALSTMP" WILL STILL BE -1.
;
;  IF "IBPFLG" IS -1, A BYTE PTR WILL BE GENERATED, AND "SUBCON"
;WILL BE IGNORED. THIS FLAG SHOULD ONLY BE SET IF THE BYTE PTR WILL
;BE USED FOR AN "EXTEND", "ILDB", OR "IDPB". ON EXIT, "IBPFLG" IS SET TO 0.
;
;  [ANS74]  IF DEBUGGING ON THIS DATA ITEM, ON ENTRY:
;1) EDEBDA (EDEBDB) WILL BE NON-ZERO (THE BASE DATA ITEM)
;2) EDEBPA (EDEBPB) WILL POINT TO THE %PARAM BLOCK TO STORE
;   THE SUBSCRIPT INDICES.
;
;   IN THIS CASE, CODE WILL BE GENERATED TO STORE THE SUBSCRIPT
; VALUES IN %PARAM THRU %PARAM+2, AND THE BASE ITEM POINTER
; IN %PARAM+3.

SUBSCR:	MOVEM	SW,ESAVSW
	SWOFF	FASUB!FBSUB!FALWY0;
	MOVEM	DT,ESAVDT
	MOVE	TE,[XWD EBASEA,ESAVES]	;SAVE "A" AND "B" PARAMS
	BLT	TE,ESAVSX

	MOVE	TC,CUREOP		;SAVE CUREOP
	MOVEM	TC,ESAVOP

	MOVSI	TE,(LKSFLG)		;GET OPERAND'S L.S. FLAG
	AND	TE,(TC)
	MOVEM	TE,ELNKSF##		;REMEMBER SETTING

	MOVE	TE,1(TC)		;ANY SUBSCRIPTS WAITING?
	LDB	TE,TESUBC
	SKIPN	ELNKSF			;LINKAGE SECTION ARGUMENT?
	JUMPE	TE,BADSB3		;NO -- ERROR
	MOVEM	TE,ENOCC2		;YES -- SAVE COUNT

IFN ANS74,<
; IF DEBUGGING THIS ITEM, PUT ADDR OF %PARAM BLOCK IN "SUBPBL".
; ELSE CLEAR IT.
	CAIN	DT,ESAVES		;IS THIS "A"
	 JRST	SDEBA			;YES

;CHECK FOR DEBUGGING "B" ITEM
	SKIPN	EDEBDB			;ARE WE DEBUGGING ON "B"?
	 JRST	SDEBNO			;NO
	MOVE	TE,EDEBPB##		;GET %PARAM ADDR
	MOVEM	TE,SUBPBL##		;SAVE IT
	JRST	SDEBDN			;DONE

;CHECK FOR DEBUGGING "A" ITEM
SDEBA:	SKIPN	EDEBDA			;ARE WE DEBUGGGING ON "A"?
	 JRST	SDEBNO			;NO
	MOVE	TE,EDEBPA##		;GET %PARAM ADDR
	MOVEM	TE,SUBPBL##		;SAVE IT
	 TRNA				;SKIP
SDEBNO:	SETZM	SUBPBL##		;NO DEBUGGING--CLEAR ITEM
SDEBDN:
>;END IFN ANS74
	PUSHJ	PP,EXMSUB		;LOOK AT THE SUBSCRIPTS
	JRST	SUBS20			;THEY ARE ALL LITERALS

SUBSC0:	TSWF	FERROR			;ANY ERRORS?
	JRST	SUBS10			;YES -- QUIT
	AOS	(PP)			;EXIT WILL BE TO CALL+2
	MOVE	TC,ESAVOP		;RESET CUREOP
	MOVEM	TC,CUREOP
	MOVEM	TC,HLDEOP##		;SAVE PTR FOR SUBS15
	SETZM	ENOCC1			;CLEAR COUNTER
;GENERATE CODING FOR SUBSCRIPT  (CONT'D).

	MOVE	DT,ESAVDT
	JRST	SILGO			; GENERATE INLINE CODE

SUBS10:	MOVE	TA,[XWD ESAVES,EBASEA];RESTORE "A" AND "B"
	BLT	TA,EBASBX
	MOVE	TA,ESAVOP	;RESET CUREOP
	MOVEM	TA,CUREOP
	SETZM	IBPFLG##	;RESET "BP WILL BE INCREMENTED" FLAG

	TSWT	FERROR		; [330]ANY ERRORS?
	JRST	SUBS11		; [330] NO-GO ON
	MOVSI	TE,(FFATAL)	; [330] MAKE SURE THAT FFATAL
	IORM	TE,ESAVSW	; [330] FLAG STAYS ON
	MOVEI	TE,0		;[330] NOW  -- RETURN 0

SUBS11:	MOVE	SW,ESAVSW	; [330] GET BACK SAVED SW-
				;WITH FFATAL FLAG ON IF SET BY SUBSCR. ERROR
	POPJ	PP,
;ALL SUBSCRIPTS WERE NUMERIC LITERALS -- GENERATE INCREMENT

SUBS20:	SETZM	EREMAN
	SETZM	ENOCC1
	MOVE	TC,ESAVOP
	MOVEM	TC,CUREOP

	MOVE	DT,ESAVDT
	HLRZ	TE,ERESX(DT)
	ROT	TE,-6
	HRRZ	TD,EMODEX(DT)
	PUSHJ	PP,SUBSCK	;IF COMP, GET GRANDFATHER'S USAGE
	TSWF	FERROR		;IF ERRORS,
	 POPJ	PP,		;GIVE UP
	CAILE	TD,DSMODE	;[610] IS TOP LEVEL DISPLAY?
	MOVEI	TD,D6MODE	;[610] NO, PRETEND DISPLAY-6
				;[610]  (SO "COMP" WILL WORK RIGHT)
	MOVEM	TD,ESAVMD##	;[306] SAVE MODE OF FATHER FOR LATER CHECKING.
	MOVE	TD,BYTE.S(TD)	;BITS/BYTE
	SKIPE	USENBT##	;USE LARGER BYTES?
	 IMUL	TD,NBYTES##	;YES
	DPB	TD,[POINT 6,TE,11] ;STORE BYTE SIZE IN BYTE PTR
	HRR	TE,EINCRX(DT)
	MOVEM	TE,EWORDB

	MOVE	TC,CUREOP
	MOVE	TA,1(TC)
	PUSHJ	PP,LNKSET

	LDB	TE,DA.OCC	;IS THERE AN OCCURS AT THIS LEVEL?
	JUMPN	TE,SUBS21	;YES, IF JUMP

	LDB	TA,DA.OCH	;NO--BACK UP ONE LEVEL
	PUSHJ	PP,LNKSET	;GET IT'S ADDRESS

SUBS21:	HRRZM	TA,CURDAT	;SAVE ADDRESS OF ITEM

	LDB	TE,DA.DEP	;ANY 'DEPENDING' ITEM?
	JUMPN	TE,SUBSC0	;YES--WE HAVE TO CALL SUBSCRIPT UUO

	LDB	TE,DA.NOC	;GET NUMBER OF OCCURENCES
	MOVEM	TE,ESMAX	;SAVE IT

	MOVEI	TC,2		;KICK UP TO NEXT SUBSCRIPT
	ADDB	TC,CUREOP

	MOVEI	LN,EBASEA	;SET UP "A" TO BE SUBSCRIPT
	PUSHJ	PP,SETOPN
	PUSHJ	PP,CONVNL	;GET VALUE
	JUMPN	TD,BADLSB	;> 10**10?
	SKIPN	EDPLA		;NO -- ANY DECIMAL PLACES?
	TSWF	FLNEG		;NO -- NEGATIVE?
	JRST	BADLSB		;YES -- TOUGH
	CAMLE	TC,ESMAX	;LARGER THAN MAXIMUM?
	JRST	BADSB6		;YES -- ERROR

	SOJL	TC,BADLSB	;NO -- DECREMENT AND IF IT WAS ZERO, ERROR
	PUSH	PP,TC
	MOVE	TA,CURDAT	;GET BACK TO OCCURENCE ITEM
	LDB	TC,DA.USG	;GET SIZE IN BYTES
	XCT	SUBSIZ(TC)

	POP	PP,TC		;GET LITERAL VALUE BACK
	IMUL	TE,TC		;MULTIPLY BY <LITERAL VALUE -1>
	ADDM	TE,EREMAN	;ADD TO SUM
IFN ANS74,<
; IF DEBUGGING ON THIS ITEM, GENERATE CODE TO STORE THE SUBSCRIPT VALUE
; IN THE %PARAM BLOCK.
	SKIPN	SUBPBL		;SKIP IF DEBUGGING
	 JRST	SUBS23		;NO

;GENERATE	MOVEI AC,VALUE
;		MOVEM AC,%PARAM + SUBSCR# - 1
	ADDI	TC,1		;GET REAL VALUE
	SKIPN	TE,SUSEAC	;GET AC TO USE
	MOVEI	TE,SXR		;(DEFAULT)
	CAILE	TC,77777	;SKIP IF VALUE SMALL
	SKIPA	CH,[MOVEI.+ASINC,,AS.CNB]
	MOVSI	CH,MOVEI.
	DPB	TE,CHAC		;STORE AC FIELD
	CAILE	TC,77777	;SKIP IF SMALL
	 JRST	[PUSH	PP,TC		;SAVE CONST.
		PUSHJ	PP,PUTASY	;GEN FIRST PART
		POP	PP,CH		;GET CONST. BACK
		PUSHJ	PP,PUTASN	;GEN LAST PART
		JRST	SUBS2B]		;NOW GEN THE MOVEM
	HRR	CH,TC		;PUT IN INSTRUCTION
	PUSHJ	PP,PUTASY	;GENERATE IT
SUBS2B:	MOVE	CH,[MOVEM.+ASINC,,AS.MSC] ;GET START OF "MOVEM"
	SKIPN	TE,SUSEAC	;PUT AC VALUE IN
	 MOVEI	TE,SXR		;(DEFAULT AC)
	DPB	TE,CHAC
	PUSHJ	PP,PUTASY	;GEN FIRST PART
	MOVE	CH,SUBPBL	;GET %PARAM BASE
	HRRZ	TE,SUBNUM	;GET TOTAL # SUBSCRIPTS
	SUB	TE,ENOCC1	; - THIS ONE
	SUBI	TE,1		; (BECAUSE THEY COUNT FROM 0)
	ADD	CH,TE		;GET %PARAM OFFSET TO USE
	PUSHJ	PP,PUTASN	;GEN THE INSTRUCTION
>;END IFN ANS74

SUBS23:	AOS	TE,ENOCC1	;KICK UP COUNT
	MOVE	TA,CURDAT
	LDB	TA,DA.OCH	;BACK UP TO PREVIOUS LEVEL
	CAML	TE,ENOCC2	;DONE?
	JRST	SUBS24		;YES

	JUMPE	TA,SUBS25	;NO -- ANY LEVELS LEFT?

	PUSHJ	PP,LNKSET	;YES -- GET NEXT LEVEL'S ADDRESS
	JRST	SUBS21		;LOOP

SUBS24:	JUMPE	TA,SUBS26	;NO SUBSCRIPTS LEFT--ANY LEVELS LEFT?
SUBS25:	PUSHJ	PP,NOTNUF	;YES -- ERROR
SUBS26:	MOVE	TD,EREMAN	;GET COMPUTED OFFSET

	LDB	TE,[POINT 6,EWORDB,11];COMPUTE BYTES/WORD
	MOVEI	TB,^D36
	IDIV	TB,TE

	IDIV	TD,TB		;COMPUTE NUMBER OF WORDS
	MOVE	TE,EWORDB	;GET POINTER TO (1,...,1) BACK
	ADD	TE,TD		;PUT #WORDS IN RH
SUBS27:	SOJL	TC,SUBS28	;ANY BYTES LEFT OVER?
	IBP	TE		;YES -- BUMP POINTER
	JRST	SUBS27		;LOOP

SUBS28:	SKIPE	IBPFLG##	;WANT A BYTE PTR TO INCREMENT?
	 JRST	SUBS29		;YES, NO "SUBCON"
	MOVE	TD,SUBCON
	DPB	TD,[POINT 12,TE,17]
IFN ANS68,<SUBS30==SUBS10>
	JRST	SUBS30

SUBS29:	TLNE	TE,760000	;MAKE "POINT 36,BLAH" OR "POINT 35,BLAH"
	 JRST	SUBS30		;IF NECESSARY
	TLZ	TE,770000
	ADD	TE,[440000,,1]
	JRST	SUBS30

IFN ANS74,<
;SUBS30:  CHECK FOR DEBUGGING, IF SO,
; GEN CODE TO STORE BASE POINTER, AND CLEAR LAST SUBSCRIPT
;	JRST'S TO SUBS10 WHEN DONE

SUBS30:	SKIPN	SUBPBL		;SKIP IF DEBUGGING
	 JRST	SUBS10		;NO, JUST GO TO SUBS10
	PUSH	PP,TE		;SAVE TE

;WE WILL GET THE FINAL BYTE PTR IN SUSEAC
	MOVE	TA,[BYTLIT,,2]
	PUSHJ	PP,STASHP
	HRRZ	TA,EBASEX(DT)	;GET BASE ITEM
	PUSHJ	PP,STASHQ
	MOVE	TA,(PP)		;GET REST OF B.P.
	PUSHJ	PP,POOLIT	;FINISH UP
	HRRZ	TE,ELITPC	;LITERAL PC
	SKIPN	PLITPC		;SKIP IF WE POOLED
	AOSA	ELITPC		;NO, BUMP LITERAL PC
	HRRZ	TE,PLITPC	;GET PC TO USE
	MOVE	CH,[MOV+ASINC,,AS.MSC]
	SKIPN	TD,SUSEAC
	 MOVEI	TD,SXR		;DEFAULT AC
	DPB	TD,CHAC		;PUT IN INSTRUCTION
	PUSH	PP,TE		;SAVE LIT PC FOR A SEC..
	PUSHJ	PP,PUTASY	;GEN FIRST PART
	POP	PP,CH		;RESTORE LIT PC
	IORI	CH,AS.LIT
	PUSHJ	PP,PUTASN	;GEN REST OF INSTRUCTION

;GEN "MOVEM AC,%PARAM + MAXSUB"
	MOVE	CH,[MOVEM.+ASINC,,AS.MSC]
	SKIPN	TD,SUSEAC
	 MOVEI	TD,SXR
	DPB	TD,CHAC
	PUSHJ	PP,PUTASY	;FIRST PART OF INSTRUCTION
	HRRZ	CH,SUBPBL	;%PARAM BASE
	ADDI	CH,MAXSUB	;+ MAX # SUBSCRIPTS
	PUSHJ	PP,PUTASN	;LAST PART OF INSTRUCTION

;GEN CODE TO CLEAR LAST SUBSCRIPT VALUE (IF NECESSARY)
	PUSHJ	PP,DBCLRL	;CLEAR LAST SUBSCRIPT IF NECESSARY
	POP	PP,TE		;RESTORE TE
	JRST	SUBS10		;DONE, RETURN

;ROUTINE TO GENERATE THE SETZM TO CLEAR LAST SUBSCRIPT
;CALL:	SUBNUM/ TOTAL # OF SUBSCRIPTS THIS DATA ITEM HAS
;	MAXSUB = MAX NUMBER OF SUBSCRIPTS THIS COMPILER ALLOWS
;	SUBPBL/ %PARAM BASE FOR "DEBUGGING ITEM"
;
;	PUSHJ	PP,DBCLRL
;	<RETURNS HERE, MAY GENERATE "SETZM">
;ALL ACS SMASHED

DBCLRL:	MOVE	TE,SUBNUM	;GET # OF SUBSCRIPTS SEEN
	CAIL	TE,MAXSUB	; LESS THAN MAX?
	 POPJ	PP,		;NO, DON'T GENERATE ANY CODE
	MOVE	CH,[SETZM.+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY	;YES, GENERATE SETZM
	HRRZ	CH,SUBPBL	;GET %PARAM BASE
	ADD	CH,SUBNUM	; LAST SUBSCRIPT+1
	JRST	PUTASN		;FINISH INSTRUCTION AND POPJ
>;END IFN ANS74

NOTNUF:	HRRZ	TC,ESAVOP	;GET BACK EOP PTR TO MAIN ITEM
	MOVEM	TC,CUREOP
	MOVEI	DW,E.250
NOTNF1:	SWON	FERROR
	JRST	OPNFAT

BADLSB:	MOVEI	DW,E.251
	JRST	BADSB7

BADSB4:	SKIPA	DW,[E.264]	;[661] ?MUST REPRESENT AN INTEGER
BADSB1:	MOVEI	DW,E.251
BADSB2:	PUSHJ	PP,NOTNF1
	JRST	EXMS9

;LINKAGE SUBSCRIPT ERROR
BADLS2:	MOVEI	TC,2		;SKIP OVER THE ADDITIVE
	ADDM	TC,CUREOP
	AOS	ENOCC1		; (ACCOUNT FOR THE ADDITIVE)
BADLS1:	MOVEI	DW,E.598	;?MUST BE USAGE COMP, FEWER THAN 11
				; DIGITS, AND NOT HAVE AN ADDITIVE
	JRST	BADSB2		;COMPLAIN, THEN GO ON TO NEXT SUBSCRIPT

;NO SUBSCRIPTS WHEN THERE SHOULD BE

BADSB3:	MOVEI	DW,E.274
	PUSHJ	PP,NOTNF1
	JRST	SUBS10

BADSB6:	MOVEI	DW,E.252
BADSB7:	PUSHJ	PP,NOTNF1
	JRST	SUBS23

BADSB8:	POP	PP,DW		;REMOVE ONE FROM STACK
	MOVEI	DW,E.251
	PUSHJ	PP,NOTNF1
	JRST	EXMS8A

;A TABLE WHICH DETERMINES SIZE OF ITEM (ALWAYS IN BYTES)
SUBSIZ:	PUSHJ	PP,BADBAD	;0
	PUSHJ	PP,SUBSZX	;1 SIXBIT
	PUSHJ	PP,SUBSZX	;2 ASCII
	PUSHJ	PP,SUBSZX	;3 EBCDIC
	PUSHJ	PP,SUBSZ1	; [306] 4 1-WORD COMP
	PUSHJ	PP,SUBSZ2	; [306] 5 2-WORD COMP
	PUSHJ	PP,SUBSZ1	; [306] 6 COMP-1
	PUSHJ	PP,SUBSZ1	; [306] 7 INDEX
	PUSHJ	PP,SUBSZ3	; 10 COMP-3.


BADBAD:	OUTSTR	[ASCIZ "Compiler error--bad usage at SUBSIZ
"]
	JRST	KILL

SUBSZX:	LDB	TE,DA.EXS
SBSZX1:	LDB	TD,DA.SYL
	JUMPN	TD,SUBSZY
	LDB	TD,DA.SYR
	JUMPN	TD,SUBSZY
	LDB	TD,DA.SLL	;SYNC AT LOWER LEVEL?
	JUMPE	TD,CPOPJ	;NO

SUBSZY:	IDIV	TE,BYTE.W-1(TC)
	SKIPE	TD
	ADDI	TE,1
	IMUL	TE,BYTE.W-1(TC)
	POPJ	PP,


;CHECK FATHER OF BINARY ITEMS TO SEE IF ASCII OR SIXBIT
;  LEAVE USAGE IN TD

SUBSCK:	CAIN	TD,C3MODE	;IF IT'S COMP-3, HIS FATHER
	SKIPA	TD,[EXP D9MODE]	; MUST BE EBCDIC, IF HE EXISTS.
	CAIG	TD,DSMODE	;[716] [161] SKIP IF USAGE IS BINARY
	POPJ	PP,		;[161];  ELSE RETURN
	PUSH	PP,TE		;SAVE AC'S
	HRRZ	TA,ERESX(DT)
	PUSHJ	PP,LNKFA##
	LDB	TD,DA.USG
	POP	PP,TE
	SOJA	TD,CPOPJ

;	MAKE SURE OCCURS SIZE WILL BE IN ACCORDANCE WITH MODE OF FATHER
SUBSZ1:	MOVE	TD,ESAVMD	; [306] GET MODE OF FATHER
	MOVEI	TE,6		; [306] SIX CHAR/WORD IF SIXBIT
	CAIN	TD,D7MODE	; [306] IF ASCII
	MOVEI	TE,5		; [306] FIVE CHAR/ WORD
	CAIN	TD,D9MODE	;IF EBCDIC,
	MOVEI	TE,4		; 4 CHARS/WORD.
	POPJ	PP,		; [306]

SUBSZ2:	PUSHJ	PP,SUBSZ1	;GET BYTES PER WORD.
	LSH	TE,1		;DOUBLE IT.
	POPJ	PP,		;RETURN.

SUBSZ3:	LDB	TE,DA.EXS##	;GET THE ITEM'S SIZE.
	ADDI	TE,2		;CONVERT IT TO NINE BIT BYTES.
	LSH	TE,-1
	MOVEI	TC,%US.EB	;PRETEND IT'S EBCDIC.
	JRST	SBSZX1		;GO SEE IF IT'S JUSTIFIED.
;HERE TO DO INLINE SUBSCRIPTING GENERATION
;CALL:
;	SUBNUM/	# OF SUBSCRIPTS (SET BY EXMSUB)
;	JRST	SILGO
;	<RETURN TO CALLER OF SUBSCR>

SILGO:	SKIPE	ONLYEX##	;ONLY EXAMINE?
	 JRST	RETSIZ		;YES, RETURN SIZE OF ITEM
	HRRZ	TD,EMODEX(DT)	;MODE OF ITEM
	CAILE	TD,DSMODE	;DISPLAY?
	 CAIN	TD,C3MODE	;OR COMP-3?
	  CAIA			;YES, NEED BYTE PTR
	JRST	SILGOB		;SKIP

;GET BYTE PTR TO (1,...,1) ELEMENT IF NEEDED

	HRRZ	TD,EMODEX(DT)	;GET USAGE
	CAIN	TD,C3MODE
	MOVEI	TD,D9MODE	;CHANGE COMP-3 TO DISPLAY-9 MODE
	MOVEM	TD,SSMODE##
	PUSHJ	PP,SUBSCK	;CHECK FATHER OF COMP ITEMS
	TSWF	FERROR		;ERRORS?
	  POPJ	PP,		;YES, GO AWAY
	MOVEM	TD,ESAVMD##	;SAVE IT
	MOVE	TD,BYTE.S(TD)	;GET # BITS/BYTE
IFN BIS,< SKIPE	USENBT##	;USE LARGER BYTES?
	IMUL	TD,NBYTES##	;YES -- TD= # BITS IN BYTE
	CAIN	TD,^D36		;36 BITS/BYTE?
	 JRST	SILGOC		;YES, NO BYTE PTR GENERATED THEN
>;END IFN BIS
	PUSH	PP,TD		;SAVE # BITS/BYTE
	MOVE	TA,[XWD BYTLIT,2]
	PUSHJ	PP,STASHP
	HRRZ	TA,EBASEX(DT)	;ADDRESS PORTION
	PUSHJ	PP,STASHQ
	HLRZ	TE,ERESX(DT)
	ROT	TE,-6		;SHIFT BYTE RESIDUE INTO LEFTMOST 6 BITS
	POP	PP,TD		;GET # BITS/BYTE
	DPB	TD,[POINT 6,TE,11] ;STORE IN BYTE PTR.
	HLLZ	TA,TE
	HRR	TA,EINCRX(DT)
	PUSHJ	PP,POOLIT
	JRST	SUBSIL		;CONTINUE

SILGOB:	MOVEM	TD,SSMODE##	;MODE OF BASE ITEM
	PUSHJ	PP,SUBSCK	;FATHER'S MODE
	TSWF	FERROR		;[643] ERRORS?
	  POPJ	PP,		;[643] YES, GIVE UP
	MOVEM	TD,ESAVMD##

; HERE WHEN SSMODE AND ESAVMD  HAVE BEEN STORED, AND NO BYTE POINTER
;WAS GENERATED. STORE THE ADDRESS OF THE (1,...,1) ITEM IN "BASITM".
SILGOC:	HRRZ	TE,EBASEX(DT)
	HRL	TE,EINCRX(DT)
	MOVEM	TE,BASITM##	;SAVE INFO OF BASE ITEM

SUBSIL:	MOVE	TE,SUBNUM##	;TE:= # SUBSCRIPTS LEFT
	SKIPE	ELNKSF##	;LINKAGE SECTION?
	 JRST	SILLNK		;YES, MAY BE 0 SUBSCRIPTS
SUBSLA:	SETZM	ZEROSB##	;NOT 0 SUBSCRIPTS
	CAIL	TE,1		;REASONABLE #?
	CAILE	TE,MAXSUB	; (BETWEEN 1 AND MAXSUB)
	 JRST	E$WNS		;?INTERNAL COMPILER ERROR
	MOVEI	TE,1		;START WITH 1ST SUBSCRIPT
	MOVEM	TE,SUBNM1##
	JRST	SETEAC

SILLNK:	JUMPN	TE,SUBSLA
	SETOM	ZEROSB##	;THERE ARE 0 SUBSCRIPTS
				;...
;SET GENERATED AC TO DESIRED DESTINATION AC FOR BYTE PTR
; CODE GENERATED WILL USE AC THRU AC+2 FOR CALCULATIONS.

SETEAC:	PUSH	PP,EAC
	SKIPN	TE,SUSEAC##	;SHOULD I LEAVE BYTE PTR IN SOME AC?
	MOVEI	TE,SXR		;NO, USE DEFAULT
	MOVEM	TE,EAC
	SKIPE	ZEROSB##	;ZERO SUBSCRIPTS?
	 JRST	SILZRO		;YES

	MOVE	TA,CUREOP
	MOVE	TA,1(TA)
	PUSHJ	PP,LNKSET

	LDB	TE,DA.OCC	;OCCURS AT THIS LEVEL?
	JUMPN	TE,SUBS74	;[745] YES, GO CHECK FOR CONVERSION
	LDB	TA,DA.OCH	;NO, BACK UP ONE LEVEL
	PUSHJ	PP,LNKSET
;[753] MOVED LINE TO SUBSI1+1
IFN ANS74,<			;[745]

;[745] IF ANY SUBSCRIPTS HAVE DEPENDING VARIABLES THAT REQUIRE
;[745] CONVERSION TO COMP, GENERATE THE CODE NOW SO THE SUBSCRIPT
;[745] ACS DON'T GET SMASHED IN THE MIDDLE OF THE COMPUTATION

SUBS74:	HRRZM	TA,CURDAT	;[745] SAVE CURRENT DATA ITEM
SUBS75:	LDB	CH,DA.DCR	;[745] CONVERSION REQUIRED?
	JUMPE	CH,NOCNVT	;[745] NO
	IORI	CH,AS.TAG	;[745] YES, CALL ROUTINE
	HRLI	CH,EPJPP	;[745] "PUSHJ PP,<CONVERSION ROUTINE>"
	MOVE	TE,ESAVDT	;ARE WE SUBSCRIPTING "B"?
	CAIE	TE,ESAVSB	;...
	JRST	SUBS78		;NO, MUST BE "A"
	PUSH	PP,CH		;ITS "B", SAVE CURRENT INST.
	PUSHJ	PP,PUTASA	;WE MUST PRESERVE AC5 FOR "A"
	MOVE	CH,[PUSH.+AC17,,5]
	PUSHJ	PP,PUTASY	; SINCE CONVERSION ROUTINE MIGHT DESTROY IT
	POP	PP,CH
	PUSHJ	PP,PUTASY	;GENERATE CONVERSION INST.
	PUSHJ	PP,PUTASA
	MOVE	CH,[POP.+AC17,,5]	;RESTORE AC5
SUBS78:	PUSHJ	PP,PUTASY	;[745]
	JRST	SUBS76		;[745] DONE NOW

NOCNVT:	LDB	TA,DA.OCH	;[745] CHECK ALL LEVELS
	JUMPE	TA,SUBS76	;[745] NO MORE, DONE
	PUSHJ	PP,LNKSET	;[745]
	JRST	SUBS75		;[745] LOOP FOR ALL SUBSCRIPT LEVELS

SUBS76:	HRRZ	TA,CURDAT	;[745] RESTORE TA
>;[745] END IFN ANS74
; HERE TO GEN CODE FOR NEXT SUBSCRIPT

SUBSI1:	HRRZM	TA,CURDAT	;SAVE ADDRESS OF OCCURS LEVEL
;[753] AT SUBSI1+1 (MOVED LINE DOWN)
IFE ANS74, SUBS74==SUBSI1	;[745] NO CONVERSION REQUIRED IN COBOL-68
	LDB	TE,DA.NOC
	MOVEM	TE,ESMAX	;SAVE # OF OCCURS
	SETZM	SUBFLG##	;CLEAR SUBSCRIPT FLAGS
IFN ANS74,<			;[745]
	LDB	CH,DA.DCR	;[745]
	JUMPE	CH,SUBS77	;[745] NO CONVERSION REQUIRED
	MOVE	TA,[AS.PAR,,AS.MSC] ;[745] DEP. VAR HAS BEEN PUT IN %PARAM+0
	JRST	SUBSI2		;[745] GO STORE IT
SUBS77:				;[745]
>;[745] END IFN ANS74
;STILL IN SUBSIL
;PUT DEPENDING ITEM INFO (OR 0) IN DEPITM

	LDB	TA,DA.DEP
	JUMPE	TA,SUBSI2	;JUMP IF NONE
	PUSH	PP,TA
	PUSHJ	PP,LNKSET
	LDB	TE,DA.LKS
	JUMPE	TE,SUBSI3	;JUMP IF DEP. VARIABLE NOT IN LINKAGE S.
	LDB	TE,DA.RBE	;YES, CHECK TO MAKE SURE IT WAS
				;REFERENCED BY AN ENTRY  OR PD USING
	JUMPE	TE,SUBSIE	;GIVE ERROR, USE DATANAME
	POP	PP,TE		;FIX STACK
	MOVSI	TE,1B20		;REMEMBER DEP. VARIABLE IN LINK. SEC.
	MOVEM	TE,SUBFLG
	LDB	TA,DA.ARG	;GET ARG
	IORI	TA,AS.PAR	;IN %PARAM
	HRLZ	TA,TA
	HRRI	TA,AS.MSC
	JRST	SUBSI2

SUBSIE:	MOVEI	DW,E.401
	PUSHJ	PP,OPNFAT
SUBSI3:	POP	PP,TA
	ANDI	TA,TM.DAT
	IORI	TA,AS.DAT	;CHANGE CODE TO "DATANAME"
SUBSI2:	MOVEM	TA,DEPITM##	;SAVE DEPENDING VARIABLE ITEM
;GET SUBSCRIPT VALUE
	MOVEI	TC,2
	ADDB	TC,CUREOP
	MOVEI	LN,EBASEA	;PUT SUBSCR AS "A" PARAM
	PUSHJ	PP,SETOPN

	HRRZ	TE,EMODEA	;A LITERAL?
	CAIN	TE,LTMODE
	 JRST	SUBILL		;YES, CHECK IT OUT

	SKIPE	EDPLA		;NO - ANY DECIMAL PLACES?
	 JRST	BADSL0		;YES, COMPLAIN

	LDB	TE,[POINT 3,EBASEA,20]
	CAIE	TE,TB.DAT	;SKIP IF A DATANAME
	 JRST	SUBSI4

	LDB	TE,DA.LKS	;IS IT IN LINKAGE SECTION?
	JUMPN	TE,SUBSL1	;YES
SUBSI4:	MOVE	TA,EBASEA
	HRL	TA,EINCRA	;NORMAL INFO
SUBSI5:	MOVEM	TA,SUBITM##	;STORE SUBSCRIPT INFO
	JRST	SUBSI6

;HERE IF SUBSCRIPT WAS A LITERAL
;
SUBILL:	PUSHJ	PP,CONVNL	;GET VALUE IN TD&TC
	SKIPN	EDPLA
	TSWF	FLNEG
	 JRST	BADSL0
	JUMPN	TD,BADSL1
	JUMPE	TC,BADSL0
	CAMLE	TC,ESMAX
	 JRST	BADSL1

	MOVS	TA,TC
	HRRI	TA,AS.CNB
	JRST	SUBSI5

;USER ERRORS
BADSL0:	SKIPA	DW,[E.251]	;?IMPROPER SUBSCRIPT
BADSL1:	MOVEI	DW,E.252	;?SUBSCR. VALUE .GT. OCCURS VALUE
	PUSHJ	PP,NOTNF1
	SETZ	TA,		;PUT ZERO IN SUBITM
	JRST	SUBSI5
;HERE IF SUBSCRIPT IN LINKAGE SECTION

SUBSL1:	MOVSI	TE,1B21
	IORM	TE,SUBFLG	;REMEMBER INDIRECTING NEEDED
SUBSL2:	LDB	TE,DA.VAL##	;GET VALUE
	MOVS	TE,TE
	IOR	TE,[AS.PAR,,AS.MSC]
	MOVEM	TE,SUBITM##	;STORE SUBSCRIPT INFO
	LDB	TE,DA.RBE	;REF. BY ENTRY?
	JUMPN	TE,SUBSI6	;YES, THEN ALL DONE
SUBSL3:	LDB	TE,DA.LVL##	;GET LEVEL
	CAIE	TE,01		;AT LEVEL 01
	CAIN	TE,77		;OR LEVEL 77
	JRST	SUBSI6		;YES, DONE
	PUSHJ	PP,LNKFA1##	;NO, BACKUP TO FATHER
	LDB	TE,DA.RBE	;WAS FATHER REF. BY ENTRY?
	JUMPE	TE,SUBSL3	;NO, KEEP ON TRYING
	JRST	SUBSL2		;YES, STORE VALUE
;NOW WE'RE READY TO CALL GEN. SUBROUTINES

SUBSI6:	MOVSI	TE,1B18
	HRRZ	TD,EMODEA
	CAIE	TD,LTMODE
	IORM	TE,SUBFLG	;SET FLAG IF NOT LITERAL

	PUSHJ	PP,SILG00	;GEN: SKIPLE AC,SUBSC. VALUE
				;	CAILE AC,OCCURS VALUE
				;	  PUSHJ PP,SUBE1##
	SKIPE	DEPITM##	;SKIP IF NO DEPENDING ITEM
	PUSHJ	PP,SILG02	;GEN: SKIPLE AC+1,DEPENDING.VAR
				;	CAILE AC,AC+1
				;	 PUSHJ PP,SUBE2##
	PUSHJ	PP,SILG01	;GEN:	SUBI AC,1
	AOS	TE,SUBNM1##	;INCREMENT COUNTER
	CAILE	TE,2		;SKIP IF FIRST PASS
	 JRST	[PUSHJ	PP,GENIML	;GENERATE THE IMULI AC,SIZE
		SOS	EAC		;AC:=AC-1
		PUSHJ	PP,SILG03	;GEN: ADD AC,AC+1
		MOVE	TE,SUBNM1##	;GET SUBSCR. INDEX AGAIN
		JRST	.+1]
	CAMLE	TE,SUBNUM	;SKIP IF .LE. NUMBER
	 JRST	SUBSI8		;NO MORE, GEN END
	CAIG	TE,2		;ON 1ST SUBSCRIPT?
	PUSHJ	PP,GENIML	;YES, GEN "IMULI AC,SIZE"
	AOS	EAC		;BUMP EAC
	MOVE	TE,CUREOP
	MOVE	TE,1(TE)
	TLNN	TE,BSUBSC	;DID IT HAVE AN ADDITIVE?
	 JRST	SUBSI9		;NO
	MOVEI	TE,2
	ADDM	TE,CUREOP	;YES, BUMP PAST ONE OPERAND
SUBSI9:	MOVE	TA,CURDAT
	LDB	TA,DA.OCH
	JUMPE	TA,[PUSHJ PP,NOTNUF
		 JRST	SUBIDN]
	PUSHJ	PP,LNKSET
	JRST	SUBSI1		;LOOP BACK FOR ALL
;HERE WHEN DONE CALCULATION OF OFFSET
;GEN. CODE TO ADJUST BYTE POINTER

SUBSI8:	MOVE	TE,SSMODE	;GET MODE OF BASE ITEM
	CAILE	TE,DSMODE	;IF NOT DISPLAY..
	  JRST	SUBILC		;DON'T BOTHER WITH BYTE PTR STUFF
	MOVE	TE,SUBNM1
	CAIG	TE,2		;ONLY 1 SUBSCRIPT?
	 PUSHJ	PP,CHKIML	;YES, GEN "IMULI AC,SIZE"
	PUSHJ	PP,SILG04	;GEN CODE TO ADJUST BYTE PTR
	SKIPN	IBPFLG##	;SKIP IF WE ARE MAKING A BYTE PTR
	 PUSHJ	PP,SILG05	;GEN CODE TO DPB "SUBCON" INTO BITS 6-17
	JRST	SUBID1		;AND THEN WE'RE DONE


;HERE IF BASE ITEM IS COMP
;GEN. "ADDI AC,BASE" INSTEAD OF BOTHERING WITH BYTE POINTER

SUBILC:	MOVE	TE,SUBNM1
	CAIG	TE,2		;ONLY 1 SUBSCRIPT?
	PUSHJ	PP,GENIML	;YES, GENERATE "IMULI AC,<SIZE>"
	PUSHJ	PP,SILG06	;"ADDI AC,BASE"
	SKIPE	ELNKSF##	;ITEM IN LINKAGE SECTION?
	 PUSHJ	PP,SILG07	;YES, ADD OFFSET


;HERE WHEN NO MORE CODE GENERATION TO DO - RESULT IS IN AC "SXR".
SUBID1:
IFN ANS74,<
;IF DEBUGGING, STORE AWAY THE BYTE PTR FROM AC,
; AND MAYBE GENERATE "SETZM %PARAM + LAST.SUBSCRIPT - 1"

	SKIPN	SUBPBL		;DEBUGGING?
	 JRST	SUBID3		;NO, SKIP THIS
	MOVE	CH,[MOVEM.+ASINC,,AS.MSC]
	PUSHJ	PP,PUT.XA	;FIRST PART OF INSTRUCTION
	HRRZ	CH,SUBPBL	;GET %PARAM BASE
	ADDI	CH,MAXSUB	; OFFSET SKIPS ALL SUBSCRIPTS
	PUSHJ	PP,PUTASN	;FINISH "MOVEM".

	PUSHJ	PP,DBCLRL	;(MAYBE) GENERATE A "SETZM"
SUBID3:
>;END IFN ANS74

IFN CSTATS,<
	SKIPN	METRSW##	;METER--ING?
	 JRST	SUBID2		;NO
	MOVEI	CH,^D1477	;BASE BUCKET NUMBER
	SKIPE	DEPITM##	;DEPENDING VARIABLE?
	 ADDI	CH,6		;YES, USE 2ND 6 BUCKETS
	SKIPE	NACMP##		;ANY NON-COMP?
	 ADDI	CH,3		;YES
	MOVE	TE,SUBNUM##
	ADDI	CH,-1(TE)	; + SUBNUM - 1
	PUSHJ	PP,MTRAOS	;COUNT IT
SUBID2:	SETZM	NACMP##		;RESET NACMP FLAG
>;END IFN CSTATS

SUBIDN:	POP	PP,EAC		;RESTORE VALUE OF EAC
	PJRST	SUBS10		;RESTORE PARAMS & RETURN TO CALLER
				;OF SUBSCR
;HERE FOR 0 SUBSCRIPTS - MOVE "A" TO "B" WHERE "A" IN LINKAGE.

SILZRO:	MOVE	TE,SSMODE##
	CAILE	TE,DSMODE
	 JRST	SILZRB		;NOT DISPLAY

IFN BIS,<
	SKIPN	USENBT##	;LARGER BYTES?
	 JRST	SILZR1		;NO
	MOVE	TD,NBYTES##	;HOW BIG?
	CAIE	TD,4
	CAIN	TD,6
	 JRST	SILZRB		;FULL WORD-- NO BYTE PTR
SILZR1:
>;END IFN BIS

;DISPLAY - GEN "MOVE AC,BYTE.PTR", "ADD AC,OFFSET"

	MOVSI	CH,MOV
	PUSHJ	PP,PUT.LC	;"MOVE AC,CURRENT.LITERAL"
	SKIPN	PLITPC
	AOS	ELITPC
	PUSHJ	PP,SILG07	;"ADD AC,OFFSET"
	SKIPN	IBPFLG##	;SKIP IF MAKING A BYTE PTR
	 PUSHJ	PP,DPBSUB	;DPB SUBCON
	JRST	SUBIDN

;NOT DISPLAY - GEN "MOVEI AC,BASITM", "ADD AC,OFFSET"

SILZRB:	MOVSI	CH,MOVEI.
	PUSHJ	PP,SILG6A
	PUSHJ	PP,SILG07	;"ADD AC,OFFSET"
	JRST	SUBIDN
;HERE IF ONLYEX FLAG WAS ON, AND SUBSCRIPTS ARE NOT ALL LITERALS
; RETURN SIZE OF ELEMENTARY ITEM IN S1SIZ

RETSIZ:	MOVE	TA,CUREOP	;BASE ITEM
	MOVE	TA,1(TA)
	PUSHJ	PP,LNKSET

	SKIPN	TB,SUBNUM##	;ZERO SUBSCRIPTS?
	 JRST	RETSZ1		;RIGHT, RETURN SIZE OF BASE ITEM

	LDB	TE,DA.OCC	;AN OCCURS AT THIS LEVEL?
	JUMPN	TE,RETSZA
	LDB	TA,DA.OCH	;NO, BACK UP ONE LEVEL
	PUSHJ	PP,LNKSET
RETSZA:	CAIN	TB,1		;JUST ONE SUBSCRIPT?
	 JRST	RETSZ1		;YES, BE FAST

;MORE THAN 1 SUBSCRIPT. WE HAVE TO GET THE GREATEST COMMON DIVISOR
; OF ALL THE SUBSCRIPTS
RETSZL:	LDB	TC,DA.USG
	PUSH	PP,TA		;SAVE TA
	XCT	SUBSIZ(TC)	;GET FIRST SIZE IN TE
	POP	PP,TA		;RESTORE TA
	PUSH	PP,TE		;SAVE SIZE ON STACK
	SOJLE	TB,RETSZB	;JUMP IF ALL DONE NOW
	LDB	TA,DA.OCH	;BACK UP ONE LEVEL
	PUSHJ	PP,LNKSET
	JRST	RETSZL		;LOOP

RETSZB:	POP	PP,TA		;GET 1ST SUBSCRIPT SIZE
	MOVE	TD,SUBNUM	;TD:= # SUBSCRIPTS LEFT
	SOJ	TD,
RETSZE:	POP	PP,TC		;NEXT ONE
	CAMLE	TA,TC
	EXCH	TA,TC
RETSZC:	IDIVI	TC,(TA)
	JUMPE	TB,RETSZD	;ANSWER = TA
	MOVE	TC,TA
	MOVE	TA,TB
	JRST	RETSZC
RETSZD:	SOJG	TD,RETSZE	;LOOP FOR ALL REMAINING SUBSCRIPTS
	MOVEM	TA,S1SIZ##	;RETURN GCD
	JRST	SUBS10		;RESTORE PARAMS & RETURN

RETSZ1:	LDB	TC,DA.USG
	XCT	SUBSIZ(TC)	;GET SIZE IN TE
	MOVEM	TE,S1SIZ##	;RETURN SIZE
	JRST	SUBS10		;RESTORE PARAMS & RETURN
;ROUTINE TO GENERATE:
;	SKIPLE	AC,SUBSCRIPT.VALUE
;	CAILE	AC,OCCURS.VALUE
;	 PUSHJ	PP,SUBE1##
;
;OR;
;	MOVE	AC,SUBSCRIPT.VALUE

SILG00:	SKIPN	TA,SUBITM##	;GET SUBSCRIPT INFO
	  POPJ	PP,		;?ERROR HAPPENED, DON'T DO ANYTHING
	HLRZ	TB,SUBFLG
	TRNE	TB,1B18		;SKIP IF A VALUE
	 JRST	SILGA0		;NO, A VARIABLE

;SUBSCRIPT VALUE IS A LITERAL - SET SIMULATED AC THEN RETURN

	SETOM	SSMACF##	;SIMULATE RUN-TIME AC VALUE
	HLRZM	TA,SSMACV##	;STORE INITIAL VALUE

IFN ANS68,<
	POPJ	PP,		;JUST RETURN
>
IFN ANS74,<
; IF DEBUGGING, STORE SUBSCRIPT VALUE
	SKIPN	SUBPBL		;SKIP IF DEBUGGING..
	 POPJ	PP,		;NO, JUST RETURN
	MOVE	CH,[MOVEI.+ASINC,,AS.CNB] ;ASSUME A LARGE CONSTANT
	PUSHJ	PP,PUT.XA
	MOVE	CH,SSMACF
	PUSHJ	PP,PUTASN	;WRITE VALUE
SILGA7:	MOVE	CH,[MOVEM.+ASINC,,AS.MSC]
	PUSHJ	PP,PUT.XA	;START INSTRUCTION..
	HRRZ	CH,SUBPBL	;GET %PARAM START
	HRRZ	TE,SUBNUM	;TOTAL # SUBSCRIPTS
	SUB	TE,SUBNM1	; - THIS #
	ADD	CH,TE		;GET %PARAM OFFSET TO USE
	PJRST	PUTASN		;FINISH INSTRUCTION, AND RETURN
>;END IFN ANS74

;STILL IN SILG00 ROUTINE
SILGA0:	SETZM	SSMACF##	;NOT SIMULATING AC
	TRNE	TB,1B21		;IF SUBSC. IN LINKAGE SECTION
	  JRST	SILGA2		;INDIRECTING REQUIRED
	SKIPE	QUIKSW##	;/Q TYPED?
	 JRST	SILGA1		;YES, DON'T GENERATE ERROR CHECK
	MOVSI	CH,SKPLE.
	PUSHJ	PP,PUT.AA	;SKIPLE SUBSCRIPT.VALUE
SILGA5:	MOVE	CH,[CAILE.+ASINC,,AS.CNB]
	PUSHJ	PP,PUT.XA
	HRRZ	CH,ESMAX
	PUSHJ	PP,PUTASN	;CAILE AC,OCCURS.VALUE
	MOVEI	CH,SUBE1.##
IFN ANS68,	PJRST	PUT.PJ		; "PUSHJ PP,SUBE1.##"
IFN ANS74,<	PUSHJ	PP,PUT.PJ	;'PUSHJ PP,SUBE1.##"
	JRST	SILGA6>		;GO SEE IF DEBUGGING THE ITEM

;GENERATE "MOVE AC,SUBSCRIPT.VALUE" (NO ERROR CHECK)

SILGA1:	MOVSI	CH,MOV
IFN ANS68, PJRST  PUT.AA	;PUT IT IN ASYFIL AND RETURN
IFN ANS74,<PUSHJ PP,PUT.AA	;GEN THE MOVE
	JRST	SILGA6>		;GO SEE IF DEBUGGING

;STILL IN SILG00 ROUTINE
;STILL IN SILG00 ROUTINE


;HERE TO GENERATE INDIRECTING
;	MOVE AC,SUBSC.ADDR.
;	MOVE AC,(AC) OR SKIPLE AC,(AC)
;EBASEA POINTS TO THE COMP SUBSCRIPT

SILGA2:	MOVE	CH,[MOV+ASINC,,AS.MSC]
	PUSHJ	PP,PUT.XA
	HLRZ	CH,SUBITM	;POINT TO %PARAM+N
	PUSHJ	PP,PUTASN

;CODE GENERATED HAS PUT ADDRESS OF SUBSCRIPT INTO EAC

	SKIPE	QUIKSW##	;/Q?
	 JRST	SILGA3		;YES, GEN "MOVE AC,EBASEA(AC)"

;GENERATE "SKIPLE AC,EBASEA(AC)"

	HRRZ	CH,EAC
	IORI	CH,SKPLE.
	HRLZ	CH,CH
	HRR	CH,EBASEA	;[671] GENERATES OFFSET INTO %PARAM BLOCK
	PUSHJ	PP,PUT.XA
	JRST	SILGA5		;THEN DO ERROR CHECK

;GENERATE "MOVE AC,EBASEA(AC)" THEN RETURN

SILGA3:	HRRZ	CH,EAC
	IORI	CH,MOV
	HRLZ	CH,CH
	HRR	CH,EBASEA	;[671] OFFSET INTO %PARAM BLOCK
IFN ANS68,	PJRST	PUT.XA
IFN ANS74,< PUSHJ PP,PUT.XA

;CHECK FOR DEBUGGING ITEM.. IF SO, GENERATE A STORE OF THE SUBSC. VALUE
SILGA6:	SKIPN	SUBPBL		;SKIP IF DEBUGGING THE ITEM
	 POPJ	PP,		;NO, JUST RETURN
	JRST	SILGA7		;GENERATE THE "MOVEM" FROM AC
>;END IFN ANS74

;ROUTINE TO GENERATE;
;	SUBI	AC,1

SILG01:	SKIPE	SSMACF##	;SIMULATING RUN-TIME AC?
	 JRST	SIMSL1		;YES, DON'T GENERATE INSTRUCTIONS

	MOVSI	CH,SUBI.
	AOJA	CH,PUT.XA	;SUBI AC,1

SIMSL1:	SOS	SSMACV##	;SIMULATE "SUBI AC,1"
	POPJ	PP,		;AND RETURN


;ROUTINE TO GENERATE:
;	ADD	AC,AC+1

SILG03:	MOVE	CH,[AD+ASINC,,AS.CNB]
	PUSHJ	PP,PUT.XA
	HRRZ	CH,EAC
	AOJA	CH,PUTASN	;AC+1
;ROUTINE TO GENERATE "IMULI AC,<SIZE>" OR "LSH"

GENIML:	PUSHJ	PP,SIZTE	;GET SIZE OF ITEM IN TE
GENIM1:	SKIPE	SSMACF##	;SIMULATING AC?
	 JRST	SIMSL2		;YES, PUT OUT MOVEI
	CAIN	TE,1		;IF SIZE IS 1 NO NEED FOR INSTRUCTION
	 POPJ	PP,		; . .
	MOVE	CH,[IMULI.+ASINC,,AS.CNB] ;ASSUME IMULI

;USE LSH IF TE CONTAINS A MULTIPLE OF 2

	JFFO	TE,.+2		;FIND FIRST 1 BIT
	 JRST	E$SIZ		;?TE WAS ZERO???
	HRRZ	TC,TE		;COPY NUMBER TO TC
	LSH	TC,1(TD)	;SHIFT FIRST BIT OUT OF NUMBER
	JUMPN	TC,USEIML	; IF THERE WERE MORE, # WAS NOT AN
				;EVEN MULTIPLE OF 2 - USE "IMULI"

;# IN TE IS AN EVEN MULTIPLE OF 2
;TD CONTAINS THE # OF 0'S TO THE LEFT OF IT

	MOVEI	TE,^D35
	SUB	TE,TD		;TE= # TO LSH
	PUSHJ	PP,PUTASA	;USE "LSH", IN ALTERNATE CODE SET
	MOVE	CH,[LSH.+ASINC,,AS.CNB]

USEIML:	PUSH	PP,TE		;SAVE #
	PUSHJ	PP,PUT.XA
	POP	PP,CH
	PJRST	PUTASN
;
;HERE TO SIMULATE IMULI (AND ACTUALLY PUT OUT "MOVEI")

SIMSL2:	IMUL	TE,SSMACV##
	MOVEM	TE,SSMACV##
	PJRST	GENMVI		;GO GENERATE THE "MOVEI" AND RETURN
;ROUTINE TO GENERATE:
;	SKIPLE	AC+1,DEPENDING.VARIABLE
;	CAILE	AC,(AC+1)
;	 PUSHJ	PP,SUBE3.##
;	CAILE	AC+1,OCCURS.VALUE
;	 PUSHJ	PP,SUBE2.##


SILG02:	SKIPN	TA,DEPITM##	;SKIP IF ANY
	  POPJ	PP,		;NO, RETURN

	SKIPE	SSMACF##	;WERE WE SIMULATING AC?
	PUSHJ	PP,GENMVI	;YES, GET VALUE INTO RUNTIME AC
	HLRZ	TB,SUBFLG
	TRNE	TB,1B20		;IN LINKAGE SECTION?
	  JRST	SILGB2		;YES, INDIRECTING REQUIRED

;GENERATE "SKIPLE AC+1,DEPENDING VARIABLE"

	HRLI	CH,SKPLE.
	HRR	CH,DEPITM
	PUSHJ	PP,PUT.XB	;AC+1
	HLRZ	CH,DEPITM
	SKIPE	CH		;ANY INCREMENT?
	PUSHJ	PP,PUTASN	;YES

;GENERATE "CAILE AC,(AC+1)"
SILGB1:	MOVE	TE,EAC
	ADDI	TE,1		;AC+1
	IORI	TE,CAILE.
	HRLZ	CH,TE		;CAILE (AC+1)
	PUSHJ	PP,PUT.XA

;GENERATE "PUSHJ PP,SUBE3."

	MOVEI	CH,SUBE3.##
	PUSHJ	PP,PUT.PJ

;GENERATE CODE TO MAKE SURE DEPENDING VARIABLE VALUE IS
; .LE. AMOUNT OF OCCURS

	MOVE	CH,[CAILE.+ASINC,,AS.CNB]
	PUSHJ	PP,PUT.XB	;AC+1
	HRRZ	CH,ESMAX
	PUSHJ	PP,PUTASN

;PUT OUT "PUSHJ PP,SUBE2.##"

	MOVEI	CH,SUBE2.##
	PJRST	PUT.PJ		;THEN RETURN

;STILL IN SILG02 ROUTINE
;STILL IN SILG02 ROUTINE

;HERE TO GEN INDIRECTING FOR DEPENDING VARIABLE

;PUT OUT "MOVE AC+1,<PARAM ADDRESS>"
SILGB2:	MOVE	CH,[MOV+ASINC,,AS.MSC]
	PUSHJ	PP,PUT.XB	;"MOVE AC+1,DEP.VAR.ADDR"
	HLRZ	CH,DEPITM
	SKIPE	CH		;PUT OUT INCREMENT IF ANY
	PUSHJ	PP,PUTASN

;"SKIPLE AC+1,(AC+1)"
	HRRZ	CH,EAC
	ADDI	CH,1
	IORI	CH,SKPLE.
	HRLZ	CH,CH
	PUSHJ	PP,PUT.XB

	JRST	SILGB1		;THEN GO BACK TO GEN "CAILE.."
;ROUTINE TO GENERATE:
;	ADJBP	AC,CURRENT LITERAL
;	[ADD	AC,OFFSET]	;FOR ITEM IN LINKAGE SECTION
;	TLNE	AC,760000	;RAN OUT OF BYTES IN WORD?
;	 JRST	.+3		;NO
;	TLZ	AC,770000	;YES, CLEAR BIT 10000 IF SET
;	ADD	AC,[440000,,1]	;POINT TO NEXT WORD
;OR;
;	IDIVI	AC,BYTES/WORD
;	ADD	AC,CURRENT LITERAL
;	[ADD	AC,OFFSET]	;FOR ITEM IN LINKAGE SECTION
;	JUMPE	AC+1,.+3
;	IBP	AC
;	SOJG	AC+1,.-1

SILG04:
IFN BIS,<
	SKIPN	USENBT##	;USING LARGE BYTES?
	 JRST	HAVLTR		;NO, LITERAL WAS GENERATED AT SILGO
	MOVE	TD,NBYTES##	;GET # BYTES/BYTE
	CAIE	TD,4
	CAIN	TD,6		;4 OR 6 MEANS 36-BIT BYTES
	 CAIA
	JRST	HAVLTR		;ELSE WE GENERATED A LITERAL AT SILGO

;HERE WHEN FULL WORD BYTES ARE USED. ROUTINES IN IFGEN OR MOVGEN
;WILL ONLY CARE ABOUT THE ADDRESS, NOT THE WHOLE BYTE POINTER.;
; GENERATE "ADDI AC,BASE.ADDR"

	PUSHJ	PP,SILG06	;GENERATE THE ADDI USING "BASITM"
	 JRST	SILG4C

;HERE WHEN LITERAL WAS GENERATED AT SILGO

HAVLTR:	SKIPN	ELNKSF##	;ITEM IN LINKAGE SECTION?
	 JRST	SILG4B		;NO

;WE MUST GENERATE THE FOLLOWING TWO WORDS IN THIS CASE BECAUSE
; IF THE ITEM IS IN THE LINKAGE SECTION, THE BYTE POINTER MAY BE
; POINT 7,0 OR POINT 6,0, IN WHICH CASE THE ADJBP WILL DO THE
; WRONG THING IF ADJUSTING 0 BYTES.

;GEN "CAIN AC,0"
	MOVSI	CH,CAIN.
	PUSHJ	PP,PUT.XA

;GEN "SKIPA AC,<CURRENT LITERAL>"
	MOVSI	CH,SKIPA.
	PUSHJ	PP,PUT.LC	;FAKE ADJBP OF 0 BYTES

SILG4B:	PUSHJ	PP,PUTASA	;ALTERNATE CODE SET
	MOVSI	CH,ADJBP.
	PUSHJ	PP,PUT.LC	;"ADJBP AC,CURRENT.LITERAL"
	SKIPN	PLITPC		;UNLESS WE POOLED IT..
	AOS	ELITPC		; COUNT THE LITERAL
SILG4C:	SKIPE	ELNKSF##	;LINKAGE SECTION ARG?
	 PUSHJ	PP,SILG07	;YES, ADD OFFSET

	SKIPE	IBPFLG##	;WILL BYTE PTR BE INCREMENTED?
	 POPJ	PP,		;YES, NO NEED FOR THE FOLLOWING

;GEN "TLNE AC,760000"
	MOVE	CH,[TLNE.+ASINC,,AS.CNB]
	PUSHJ	PP,PUT.XA
	MOVEI	CH,760000
	PUSHJ	PP,PUTASN

;GEN "JRST .+3"
	MOVE	CH,[JRST.+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	MOVEI	CH,AS.DOT+3
	PUSHJ	PP,PUTASN

;GEN "TLZ AC,770000"
	MOVE	CH,[TLZ.+ASINC,,AS.CNB]
	PUSHJ	PP,PUT.XA
	MOVEI	CH,770000
	PUSHJ	PP,PUTASN

;GEN "ADD AC,[440000,,1]
	MOVE	TA,[XWDLIT,,2]
	PUSHJ	PP,STASHP
	MOVE	TA,[XWD 440000,AS.CNB]
	PUSHJ	PP,STASHQ	;LEFT HALF
	MOVE	TA,[XWD 1,AS.CNB]
	PUSHJ	PP,POOLIT	;RIGHT HALF
	PJRST	GENADL		;GEN "ADD AC,CURR.LIT" THEN RETURN
>;END OF IFN BIS
IFE BIS,<
	SKIPE	NOIDVF##	;SKIP IF IDIVI NEEDED
	 JRST	SILG4A		;GREAT!
	MOVE	CH,[IDIVI.+ASINC,,AS.CNB]
	PUSHJ	PP,PUT.XA
	MOVE	TE,SSMODE	;GET MODE
	CAILE	TE,DSMODE	;MUST BE DISPLAY IF WE ARE HERE
	 JRST	E$UND		;?USAGE NOT DISPLAY
	MOVE	CH,BYTE.W(TE)	;GET CH=BYTES/WD
PUTBTW:	SKIPE	USENBT##	;USE LARGER BYTES?
	 JRST	[MOVE TC,CH	;YES, COPY SIZE
		IDIV  TC,NBYTES##
		MOVE  CH,TC	;GET ITEM SIZE IN BIG BYTES
		JRST  .+1]
	PUSHJ	PP,PUTASN

;GEN ADD AC,CURRENT LITERAL

	PUSHJ	PP,GENADL	;"ADD AC,CURR. LIT"

;GEN "ADD AC,OFFSET" IF ITEM IN LINKAGE SECTION

	SKIPE	ELNKSF##	;IS IT?
	 PUSHJ	PP,SILG07	;YES, GEN ADD

;GEN JUMPE AC+1,.+3

	MOVE	CH,[JUMPE.+ASINC,,AS.MSC]
	PUSHJ	PP,PUT.XB	;USE AC+1
	MOVEI	CH,AS.DOT+3
	PUSHJ	PP,PUTASN

;GEN IBP AC

	PUSHJ	PP,PUTASA	;"IBP" IS IN ALTERNATE CODE SET
	MOVE	CH,[IBP.+ASINC,,AS.CNB]
	PUSHJ	PP,PUTASY
	HRRZ	CH,EAC
	PUSHJ	PP,PUTASN

;GEN SOJG AC+1,.-1

	MOVE	CH,[SOJG.+ASINC,,AS.MS2]
	PUSHJ	PP,PUT.XB	;USE AC+1
	MOVEI	CH,AS.DOT+1	;AS.MS2 SAYS NEG. INCREMENT
	PJRST	PUTASN

SILG4A:	SETZM	NOIDVF##	;CLEAR FLAG
	SKIPE	ELNKSF##
	 PUSHJ	PP,SILG07	;IN LINKAGE SECTION
	PJRST	GENADL		;"ADD AC,CURR.LIT", RETURN
>;END IFE BIS
;ROUTINE TO GEN "ADD AC,CURRENT.LITERAL"
; THEN BUMP LITERAL PC

GENADL:	MOVSI	CH,AD
	PUSHJ	PP,PUT.LC
	SKIPN	PLITPC
	 AOS	ELITPC
	POPJ	PP,


IFE BIS,<
;ROUTINE TO CHECK FOR IMULI FOLLOWED BY IDIVI
; IF WE CAN DO IT WITH NO PROBLEM, SET NOIDVF TO -1

CHKIML:	PUSHJ	PP,SIZTE	;TE=SIZE
	MOVE	TD,SSMODE
	CAILE	TD,DSMODE	;WE SHOULD ONLY BE HERE IF IT'S DISPLAY
	 JRST	E$UND
	MOVE	TD,BYTE.W(TD)	;TD= BYTES/WD
	SKIPE	USENBT##	;USE LARGER BYTES?
	IDIV	TD,NBYTES##	;YES, GET # OF "BIG" BYTES/WORD
	IDIVI	TE,(TD)		;TE=DIVIDE FACTOR
	JUMPN	TD,GENIML	;NOT EVENLY DIVISIBLE
	SETOM	NOIDVF##	;NO IDIVI NEEDED!
	PJRST	GENIM1		;GEN THE SMALLER IMULI
>;END IFE BIS
IFN BIS,<
	CHKIML==GENIML		;NO IDIVI IF BIS
>;END IFN BIS
;ROUTINE TO GEN CODE TO PUT SUBCON IN BITS 6-17 OF RESULT
;THIS ROUTINE MUST BE CALLED RIGHT AFTER SILG04 IS CALLED

SILG05:	MOVE	TE,SSMODE##	;GET MODE
	MOVE	TD,[EXP 600
		   EXP 700
		   EXP 1100](TE) ; GET DEFAULT SUBCON
	CAMN	TD,SUBCON##	;IS IT ALREADY SETUP RIGHT?
	 POPJ	PP,		;YES, NO NEED FOR DPB

IFE BIS,<
;HERE IS AN OPTIMIZATION FOR THE CASE WHEN SILG04 HAS
;GENERATED NON-BIS CODE. WE KNOW THAT C(AC+1) WILL BE 0
;WHEN CODE GENERATED HERE IS EXECUTED.

	SKIPN	SUBCON		;WILL IT GEN "MOVEI AC+1,0"?
	  JRST	SILG5A		;YES, DON'T NEED INSTRUCTION
>;END OF IFE BIS

DPBSUB:	MOVE	CH,SUBCON
	CAILE	CH,77777	;SMALL CONST.
	SKIPA	CH,[HRRZI.+ASINC,,AS.CNB]
	HRLI	CH,HRRZI.	;YES, PRINT AS OCTAL
	PUSHJ	PP,PUT.XB
	MOVE	CH,SUBCON
	CAILE	CH,77777	;DO WE NEED TO OUTPUT CONST.
	PUSHJ	PP,PUTASN	;YES

;PUT THE BYTE POINTER IN THE LITERAL TABLE

SILG5A:	MOVE	TA,[XWD BYTLIT,2]
	PUSHJ	PP,STASHP
	MOVE	TA,EAC		;ADDRESS PORTION
	PUSHJ	PP,STASHQ
	MOVSI	TA,(POINT 12,,17)
	PUSHJ	PP,POOLIT	;REST OF IT

;NOW DPB AC+1,<CURRENT LITERAL>

	MOVSI	CH,DPB.
	HRRZ	TE,EAC
	ADDI	TE,1
	DPB	TE,CHAC
	PUSHJ	PP,PUT.LD
	SKIPN	PLITPC		;SKIP IF WE POOLED IT
	AOS	ELITPC		;REMEMBER WE MADE A LITERAL
	POPJ	PP,
;ROUTINE TO GEN "ADDI AC,BASITM" (BASE ITEM WAS COMP)

SILG06:	MOVSI	CH,ADDI.
SILG6A:	HRR	CH,BASITM##
	HLRZ	TE,BASITM##	;INCREMENT
	JUMPE	TE,PUT.XA	;NONE
	TLO	CH,ASINC
	PUSHJ	PP,PUT.XA
	HLRZ	CH,BASITM##	;GET INCREMENT
	PJRST	PUTASN

;ROUTINE TO GET THE SIZE OF ITEM IN TE

SIZTE:	HRRZ	TA,CURDAT
	LDB	TC,DA.USG
	XCT	SUBSIZ(TC)
	SKIPE	USENBT##	;USE LARGER BYTES?
	 IDIV	TE,NBYTES##	; YES
	MOVE	TC,SSMODE##	;GET MODE OF LOWEST LEVEL
	CAIG	TC,DSMODE	;DISPLAY?
	 POPJ	PP,		;YES, KEEP BYTES
	MOVE	TB,ESAVMD##	;NO, GET WORDS
	CAILE	TB,DSMODE	;[606] THIS DISPLAY?
	JRST	SIZTE1		;[606] NO, DIVIDE BY 6
	IDIV	TE,BYTE.W(TB)
	POPJ	PP,

SIZTE1:	IDIVI	TE,6		;[606] DEFAULT TO 6 BYTES/WORD, THIS GIVES
	POPJ	PP,		;[606]  US # OF WORDS


;ROUTINE TO GENERATE "MOVEI AC,<SIMULATED AC VALUE>

GENMVI:	SETZM	SSMACF##	;CLEAR FLAG
	HRRZ	CH,SSMACV	;GET CONST
	CAILE	CH,77777	;SMALL?
	SKIPA	CH,[MOVEI.+ASINC,,AS.CNB]
	HRLI	CH,MOVEI.	;YES
	PUSHJ	PP,PUT.XA
	HRRZ	CH,SSMACV##
	CAILE	CH,77777	;DO WE NEED TO OUTPUT IT?
	PJRST	PUTASN		;YES
	POPJ	PP,
;ROUTINE TO GENERATE CODE TO ADD EXTERNAL LINKAGE OFFSET
;
SILG07:	MOVE	TA,HLDEOP##	;DUMMY INDEX LOC.
	MOVE	TA,1(TA)
	PUSHJ	PP,LNKFA##	;GET GRANDFATHER'S TABLE ADDRESS
	LDB	TB,DA.RBE##	;REFERENCED BY AN ENTRY OR PD USING?
;[D1300] JUMPE	TB,SILG7C	;NO
	MOVEM	TA,HLDBRO##	;[1300] INITIALIZE TEMP BROTHER PTR WITH SELF
	JUMPN	TB,SILG7A	;[1300] YES, REF'D BY ENTRY OR PD USING
	PUSH	PP,TA		;[1300] SAVE PTR TO CURRENT ITEM AGAIN
SILG7D:				;[1300]
	LDB	TA,DA.BRO##	;[1300] SEE IF IT HAS A BROTHER
	JUMPE	TA,SILG7E	;[1300] NO, GIVE UP
	PUSHJ	PP,LNKSET	;[1300] GET POINTER TO IT
	LDB	TB,DA.RDF##	;[1300] IS IT A REDEFINES?
	JUMPE	TB,SILG7D	;[1300] NO, TRY TO GET NEXT BROTHER
	LDB	TB,DA.ARG##	;[1300] IS ITS INDEX LOC SET UP?
	JUMPE	TB,SILG7D	;[1300] NO, TRY TO GET NEXT BROTHER
	MOVEM	TA,HLDBRO##	;[1300] YES, PUT IN TEMP BROTHER PTR
	POP	PP,TA		;[1300] RESTORE PTR TO ORIG ITEM
				;[1300] AND CONTINUE ON TO GENERATE INSTR
SILG7A:	MOVE	CH,[AD+ASINC,,AS.MSC]
	PUSHJ	PP,PUT.XA	;"ADD AC,"
;[1300] HERE WE USE THE TEMP BROTHER PTR TO SEE IF INDEX LOC IS SET UP
	PUSH	PP,TA		;[1300] SAVE PTR TO CURRENT ITEM
	MOVE	TA,HLDBRO##	;[1300] GET PTR TO BROTHER (OR MAYBE SELF)
;[1300] THEN WE GET HIS INDEX LOC. IF THIS IS SET UP WE USE IT TO GENERATRATE
;[1300] THE SECOND OPERAND FOR THE INSTRUCTION. IF IT IS NOT SET UP WE
;[1300] FALL THRU THE CODE AND PUT A 0 IN FOR THE SECOND OPERAND.
	LDB	TB,DA.ARG##	;WHERE IS THE ARG?
	POP	PP,TA		;[1300] RESTORE PTR TO CURRENT ITEM
	JUMPN	TB,SILG7B	; THERE IT IS! ;[1300] GENUINE ENTHUSIASM

	MOVE	TB,EAS1PC	;NOT SET UP, HAVE TO GET ONE
	AOS	EAS1PC
	DPB	TB,DA.ARG
	PUSHJ	PP,PUTOC0##	;OCTAL 0 TO AS1FIL

SILG7B:	IORI	TB,AS.PAR	;%PARAM+N
	HRRZ	CH,TB
	PJRST	PUTASN		;"%PARAM+N" , THEN RETURN

SILG7E:	POP	PP,TA		;[1300] NO VALID BRO, SO RESTORE ORIG PTR
				;[1300] AND FALL THRU TO REPORT ERROR.
SILG7C:	HRRZI	DW,E.401	;?NOT DECLARED BY ENTRY OR PD USING
	PUSHJ	PP,OPNFAT
	JRST	SILG7A
;INTERNAL COMPILER ERRORS

DEFINE $ERRF(MSG),<
	JSP	TA,E$$INT
XLIST
	ASCIZ	/MSG/
LIST
>


E$$INT:	OUTSTR	[ASCIZ/?Internal compiler error in CMNGEN - /]
	OUTSTR	(TA)		;TYPE EXPLANATION
	OUTSTR	[ASCIZ/
/]
	JRST	KILL##		;AND GO TAKE A DUMP

E$WNS:	$ERRF	<wrong number of subscripts>
E$UND:	$ERRF	<usage not DISPLAY>
E$UNZ:	$ERRF	<USENBT not zero at GETNB>
E$SIZ:	LDB	TE,DA.EXS	;IF SIZE IS ZERO
	JUMPE	TE,CPOPJ	;THEN ITS AN ERROR IN PHASE C
	$ERRF	<SIZTE returned 0>
E$IBP:	$ERRF	<B1PAR with IBPFLG not zero>
E$BAC:	$ERRF	<DEPVB not positive at DPBDEP>
E$DLT:	$ERRF	<DPBDEP trying to deposit into a literal>
;SCAN THRU SUBSCRIPTS LOOKING FOR OBVIOUS ERRORS.
;IF ALL ARE LITERALS--RETURN TO CALL+1.
;IF ANY NON-LITERALS--RETURN TO CALL+2.

EXMSUB:	SWOFF	FERROR!FSDAT	;CLEAR SOME FLAGS
	SKIPE	ELNKSF		;LINKAGE SECTION REFERENCE
	SWON	FSDAT		;YES, FORCE NON-CONSTANT SUBSCRIPT ACTION
	SETZM	SUBNUM##	;# OF SUBSCRIPTS SEEN
	SETZM	ENOCC1
	SKIPN	ENOCC2
	JRST	EXMS9L		;LINKAGE SECTION ITEM WITH NO SUBSCRIPTS

EXMS1:	MOVEI	TC,2		;LOOK AT NEXT SUBSCRIPT
	ADDB	TC,CUREOP
	MOVEI	LN,EBASEA	;SET UP "A" PARAMETERS
	PUSHJ	PP,SETOPN
	TSWF	FERROR		; [***] ANY ERRORS?
	  JRST	EXMS9		; [***] YES, GIVE UP
	TSWT	FASUB		;[251] IS SUBSCRIPT SUBSCRIPTED?
	JRST	EXMS1A		; [***] NO
	LDB	TE,DA.SUB	; [***] IS IT REALLY SUBSCRIPTED?
	JUMPN	TE,NOTSUB	; [***] YES, ILLEGAL
	LDB	TE,DA.LKS	; [***] IS IT IN LINKAGE SECTION
	JUMPE	TE,NOTSUB	; [***] NO, GIVE UP
	SWOFF	FASUB		; [***] YES, TREAT AS NOT SUBSCRIPTED
	MOVE	TE,CUREOP	; MAKE SURE IT'S A COMP ITEM
	MOVE	TE,1(TE)	;WITH NO ADDITIVE
	TLNE	TE,BSUBSC
	 JRST	BADLS2		;(ADDITIVE)
	HRRZ	TE,EMODEA	; ELSE WE WOULD HAVE TO CALL
	CAIE	TE,D1MODE	; THE SUBSCRIPT ROUTINE AGAIN!
	 JRST	BADLS1

EXMS1A:	TSWT	FANUM		; [***] IS IT NUMERIC?
	JRST	BADSB1		;NO -- ERROR

	HRRZ	TE,EMODEA	;IS IT A LITERAL?
	CAIN	TE,LTMODE
	JRST	EXMS9		;YES -- NO WORK NEEDED NOW

	SWON	FSDAT		;NO -- SET FLAG

	HRRZ	TE,EBASEA	;TALLY?
	CAIN	TE,AS.MSC	; SUBSCRIPT IN TEMP LOCATION?
	JRST	[MOVE	TE,CUREOP	;YES, WE'VE BEEN HERE BEFORE
		MOVE	TE,1(TE)	; SEE IF ADDITIVE FOLLOWS
		TLNN	TE,BSUBSC
		 JRST	EXMS9		;IT DOESN'T, ALL IS OK
		MOVEI	TC,2
		ADDM	TC,CUREOP	;ADDITIVE FOLLOWS, SO SKIP IT
		AOS	ENOCC1		;BUMP OPERAND COUNT
		JRST	EXMS9]		;AND COUNT THE SUBSCRIPT

IFN ANS68,<
	CAIN	TE,TALLY.	; [250] TALLY ?
	JRST	EXMS2		; [250] YES SET UP FOR IT
>
;[661] BETTER ERROR CHECKING FOR ILLEGAL SUBSCRIPTS
	SKIPE	TE,EDPLA	;ANY DECIMAL PLACES?
	JRST	BADSB4		;[661] YES -- ERROR
	HRRZ	TE,EMODEA	;[661] DISALLOW COMP-1
	CAIE	TE,FPMODE	;[661] FLOATING POINT?
	CAIN	TE,F2MODE
	JRST	BADSB4		;[661] YES, COMPLAIN

	MOVE	TE,CUREOP	;DOES THIS
	MOVE	TE,1(TE)	;  SUBSCRIPT HAVE
	TLNE	TE,BSUBSC	;  ADDITIVE?
	JRST	EXMS2		;YES--TEMP NEEDED

	SKIPE	ALSTMP##	;SHOULD WE PUT ALL SUBSCRIPTS IN %TEMP?
	 JRST	EXMS2		;YES, GO DO SO EVEN IF IT IS COMP

	HRRZ	TE,EMODEA	;1-WORD COMP?
	CAIN	TE,D1MODE
	JRST	EXMS9		;YES -- NO WORK NEEDED NOW
;PUT SUBSCRIPT INTO TEMP; EITHER BECAUSE IT IS NOT COMP, OR
;   BECAUSE IT HAS AN ADDITIVE.

EXMS2:	MOVE	TE,EMODEA	;SAVE THE MODE.
	MOVEM	TE,SSU.MD##
	MOVEI	TE,1		;GET A TEMPORARY LOCATION
	PUSHJ	PP,GETEMP
	MOVEI	TE,0(EACC)
	TLO	TE,GNOPNM
	MOVEM	TE,0(TC)
IFN CSTATS,<
	HRRZ	TE,EMODEA	;IS IT NON-COMP?
	CAIE	TE,D1MODE
	 SETOM	NACMP##		;YES, SET FLAG FOR METER--ING
>;END IFN CSTATS

	MOVSI	TD,GNNOTD
	MOVE	TE,ESIZEA
	DPB	TE,ACSIZE
	MOVEI	TE,D1MODE
	DPB	TE,ACMODE
	MOVE	TE,1(TC)
	TLNE	TE,ASUBSC
	TLO	TD,ASUBSC
	TLNE	TE,SSUBSC
	TLO	TD,SSUBSC
	MOVEM	TD,1(TC)


	PUSH	PP,ESIZEZ
	PUSH	PP,SUBCON
	PUSH	PP,EAC		;SAVE CURRENT SETTING OF AC'S
	PUSH	PP,CUREOP	;SAVE CURRENT CUREOP
	MOVEI	TE,4		;SET AC'S
	MOVEM	TE,EAC		;  TO 4&5
	PUSH	PP,IBPFLG##
	SETZM	IBPFLG##
	PUSH	PP,SUSEAC##	;SAVE VALUE OF SUSEAC
	PUSHJ	PP,MXAC.	;GET OPERAND INTO AC'S
	POP	PP,SUSEAC##	;RESTORE SUSEAC
	POP	PP,IBPFLG##	;SET IBPFLG AGAIN IF IT WAS
	HRRZ	TC,CUREOP	;DOES SUBSCRIPT
	MOVE	TE,1(TC)	;  HAVE
	TLNN	TE,BSUBSC	;  ADDITIVE?
	JRST	EXMS8		;NO

	AOS	ENOCC1		;YES--BUMP COUNT ONCE
	ADDI	TC,2		;STEP TO NEXT OPERAND
	MOVEM	TC,CUREOP
	MOVEI	LN,EBASEB	;GET ADDITIVE AS
	PUSHJ	PP,SETOPN	;  'B' OPERAND
	TSWF	FERROR		;IF ERROR,
	JRST	EXMS8		;  FORGET IT

	PUSHJ	PP,CONVNL	;CONVERT LITERAL
	SKIPE	EDPLB		;IF DECIMAL PLACES,
	JRST	BADSB8		;  ERROR

	MOVSI	CH,AD		;ASSUME 'ADD'
	MOVE	TE,CUREOP	;IS
	MOVE	TE,-1(TE)	;  IT
	TLNN	TE,ASUBSC	;  REALLY 'ADD'?
	MOVSI	CH,SUB.		;NO--MUST BE SUBTRACT
	PUSHJ	PP,PUT.LA	;GENERATE <ADD/SUB LITERAL>
;PUT SUBSCRIPT IN TEMP (CONT'D)

EXMS8:	POP	PP,TC		;GET CUREOP BACK
	MOVE	TD,1(TC)
	LDB	TE,ACMODE
	MOVEM	TE,EMODEB
	LDB	TE,ACSIZE
	MOVEM	TE,ESIZEB
	SETZM	EDPLB
	MOVE	TE,[XWD ^D36,AS.MSC]
	MOVEM	TE,EBASEB
	MOVE	TE,0(TC)
	HRRZM	TE,EINCRB
	SWON	FBSIGN
	PUSH	PP,SW		;[525] SAVE SWITCHES
	SWOFF	FALWY0		;[525] TURN OFF AC'S = 0
	PUSHJ	PP,MACX.	;STASH OPERAND INTO TEMP
	POP	PP,SW		;[525] GET SWITCHES BACK

EXMS8A:	POP	PP,EAC		;RESET AC'S
	POP	PP,SUBCON
	POP	PP,ESIZEZ

EXMS9:	AOS	SUBNUM##	;COUNT SUBSCRIPTS
	AOS	TE,ENOCC1	;BUMP COUNT
	CAMGE	TE,ENOCC2	;DONE?
	JRST	EXMS1		;NO--LOOP

;MAKE SURE WE GOT THE CORRECT NUMBER OF SUBSCRIPTS

	TSWF	FERROR		;ANY ERRORS?
	 JRST	EXMS9B		;YES--SKIP RETURN
	MOVE	TA,ESAVOP	;POINT TO BASE ITEM
	MOVEM	TA,CUREOP	;[660] MAKE ERROR MESSAGE POINT TO BASE ITEM
	MOVE	TA,1(TA)
	PUSHJ	PP,LNKSET
	LDB	TE,DA.OCC
	JUMPN	TE,EXMS9C
	LDB	TE,DA.SUB	;[1476] DOES THIS ITEM NEED A SUBSCRIPT?
	JUMPE	TE,NOTSUB	;[1476] NO, THEN THERE'S NO DA.OCH ENTRY
	LDB	TA,DA.OCH	
	JUMPE	TA,NOTSUB	;[1123] IF NO SUBSCR AT ALL IN DATAB WE HAVE
				;[1123] AN ERROR, DON'T TRY TO FIND ITS LINK
	PUSHJ	PP,LNKSET	

EXMS9C:	MOVE	TB,SUBNUM	;NUMBER OF SUBSCRIPTS WE SAW
EXMS9F:	SOJL	TB,EXMS9D	;NO MORE SUBSCRIPTS
	LDB	TA,DA.OCH
	JUMPE	TA,EXMS9E	;NO MORE LEVELS
	PUSHJ	PP,LNKSET
	JRST	EXMS9F

EXMS9E:	SOJL	TB,EXMS9A	;SUBSCRIPTS RAN OUT ALSO--OK
EXMS9D:	MOVEI	DW,E.250	;?WRONG NUMBER OF SUBSCRIPTS
	AOS	(PP)
	JRST	OPNFAT		;FATAL RETURN

;HERE IF WE SAW LINKAGE SECTION ITEM WITH NO SUBSCRIPTS
;  MAKE SURE IT DOESN'T NEED SUBSCRIPTS

EXMS9L:	MOVE	TA,ESAVOP
	MOVE	TA,1(TA)
	PUSHJ	PP,LNKSET
	LDB	TE,DA.SUB	;IT IS SUPPOSED TO BE SUBSCRIPTED?
	JUMPN	TE,EXMS9G	;NEEDS A SUBSCRIPT - COMPLAIN

;DIDN'T NEED ANY SUBSCRIPTS - OK
; FALL INTO EXMS9A

EXMS9A:	TSWT	FERROR		;YES--ANY ERRORS?
	TSWF	FSDAT		;NO--ANY NON-LITERALS?
EXMS9B:	AOS	(PP)		;YES--EXIT TO CALL+2
	POPJ	PP,

EXMS9G:	MOVEI	DW,E.274	;?MUST BE SUBSCRIPTED
	AOS	(PP)
	JRST	OPNFAT		;GIVE ERROR, AND SKIP RETURN

NOTSUB:	SWON	FERROR		;[251] TURN ON ERROR SWITCH
	JRST	EXMS9		;[251] GO ON TO NEXT SUBSCRIPT
; TEST FOR DEPENDENCY AT LOWER LEVEL
;SKIP IF EITHER "A" OR "B" HAS A DEPENDING ITEM
DEPCKK:	PUSHJ	PP,DEPTSA	;DOES "A"?
	 CAIA			;NO
	JRST	CPOPJ1		;YES--SKIP
	PUSHJ	PP,DEPTSB	;DOES "B"?
	 POPJ	PP,		;NO
	JRST	CPOPJ1		;YES--SKIP


;SKIP IF "A" HAS A DEPENDING ITEM
DEPTSA:	HRRZ	TA,ETABLA	;GET "A"
	 TRNA
DEPTSB:	HRRZ	TA,ETABLB	;GET "B"
	LDB	TC,[POINT 3,TA,20]
	CAIE	TC,CD.DAT	;MAKE SURE ITS A DATAB ENTRY
	POPJ	PP,		;NO
	PUSHJ	PP,LNKSET
	LDB	TC,DA.DLL##	;IS THERE A DEPENDING ITEM?
	JUMPN	TC,CPOPJ1	;YES
	POPJ	PP,
;ROUTINE TO SETUP AC = SIZE OF VARIABLE, WHERE VARIABLE HAS A DEPENDING ITEM
;CALLED BY:
;	MOVEI	TE,WHICH AC TO USE (0-16)
;	SAVPR0/ 0 (NORMAL CASE) OR -1 (%PARAM+0 MUST BE PRESERVED)
;	PUSHJ	PP,SZDPVA (OR SZDPVB)
;	<RETURN HERE IF NO DEPENDING VARIABLE OR ERRORS, DEPVB/ -1, FERROR SET>
;	<RETURN HERE IF SIZE SETUP IN AC SPECIFIED, DEPVB / RUNTIME AC USED>
;	ALL RUNTIME AC'S MAY BE SMASHED!!

SZDPVA:	MOVEI	LN,EBASEA	;REMEMBER WE'RE DOING 'A'
	HRRZ	TA,ETABLA
	JRST	GTABDP
SZDPVB:	MOVEI	LN,EBASEB	;REMEMBER WE'RE DOING 'B'
	HRRZ	TA,ETABLB
GTABDP:	MOVEM	TE,DEPVB##	;SAVE RUNTIME AC TO USE
	PUSHJ	PP,LNKSET	;LOOK AT ITEM
	LDB	TB,DA.SON	;FIND THE DEPENDING ITEM
GTSONA:	PUSHJ	PP,FNDBRO	; THIS CODE COPIED FROM OTHER MOVGEN CODE
	 SKIPA	TA,TB		;FOUND LAST BROTHER
	JRST	GTSONA		;NO, LOOP
	PUSHJ	PP,LNKSET
	LDB	TB,DA.NOC	;[1073] IS THERE AN OCCURS CLAUSE?
	JUMPE	TB,GTSNA1	;[1073] NO, THIS ISN'T THE DEPENDING ITEM
	LDB	TB,DA.DEP	;IS THIS THE DEPENDING VARIABLE?
	JUMPN	TB,GTSONB	; YES-- GO DO IT
GTSNA1:	LDB	TB,DA.SON	;[1073] LOOK AT ELEMENTARY ITEM
	JUMPN	TB,GTSONA	;THIS ISN'T IT, GO DOWN DEEPER
	JRST	QITDPV		;?ERROR--SHOULD HAVE FOUND DEPENDING ITEM!

GTSONB:	LDB	CH,DA.DCR	;CONVERSION NECESSARY?
	JUMPE	CH,GTBDP1	;NO, COMP ALREADY

;CONVERSION ROUTINE MAY POTENTIALLY SMASH ALL AC'S. IF WE HAVE ONE
; TO PRESERVE, MUST MOVE IT TO %TEMP AND MOVE IT BACK AFTER CONVERSION!!
	SKIPN	SAVPR0##	;MUST SAVE %PARAM+0?
	 JRST	NOSV0		;NO
	PUSH	PP,TA		;SAVE DA.* POINTER
	PUSHJ	PP,PUTASA
	MOVE	CH,[PUSH.+AC17,,AS.MSC]
	PUSHJ	PP,PUTASY
	MOVEI	CH,AS.PAR
	PUSHJ	PP,PUTASN
	POP	PP,TA

NOSV0:	SKIPN	CONVSV##	;AC TO PRESERVE?
	 JRST	NOPRES		;NO

	PUSH	PP,TA		;SAVE DA.* POINTER

	PUSHJ	PP,PUTASA
	MOVSI	CH,PUSH.+AC17
	HRR	CH,CONVSV	;SAVE THIS AC
	PUSHJ	PP,PUTASY

	POP	PP,TA		;RESTORE ACS SAVED
	LDB	CH,DA.DCR	;CONVERSION TAG
NOPRES:	IORI	CH,AS.TAG
	HRLI	CH,EPJPP
	PUSHJ	PP,PUTASY
	PUSH	PP,TA
	LDB	TA,DA.DCR	;GET CONVERSION TAG
	PUSHJ	PP,REFTAG##	;REFERENCE IT

	SKIPN	CONVSV		;DID WE SAVE AN AC?
	 JRST	NORSTR		;NO, DON'T "POP" ANY THEN
	PUSHJ	PP,PUTASA
	MOVSI	CH,POP.+AC17
	HRR	CH,CONVSV	;GET SAVED AC
	PUSHJ	PP,PUTASY	;"POP 17,AC"

NORSTR:	POP	PP,TA		;GET DA.* BASE
	SKIPA	TB,[ASINC,,AS.MSC] ;NOW IT'S IN %PARAM
GTBDP1:	LDB	TB,DA.DEP##	;MAKE SURE WE ARE LOOKING AT A DEPENDING ITEM
	JUMPE	TB,QITDPV	;? NO, GIVE UP
	LDB	CH,DA.INS	;GET SIZE
	LDB	TE,DA.NOC	; # OF OCCURANCES
	IMUL	CH,TE		;TOTAL SIZE
	MOVEM	CH,DPVAR
	MOVEM	TA,DPLNK
	MOVEM	TB,DPITM

	MOVE	CH,TB		;PUT ITEM IN CH
	TLNN	CH,-1		;IN %PARAM?
	 JRST	GTBDP2		;NO, A REGULAR COMP ITEM
	HRRZ	TE,DEPVB	;GET AC
	LSH	TE,5		; SHIFT TO AC POSITION
	TLO	CH,SKPLE.
	TLO	CH,(TE)		;FINISH INSTRUCTION
	PUSHJ	PP,PUTASY
	MOVEI	CH,AS.PAR
	PUSHJ	PP,PUTASN	;SKIPLE AC,%PARAM

	SKIPN	SAVPR0##	;SAVED %PARAM+0?
	 JRST	GTBDP3		;NO, GO GENERATE "CAILE.."

;RESTORE (POP FROM STACK) %PARAM+0
	PUSHJ	PP,PUTASA
	MOVE	CH,[POP.+AC17,,AS.MSC]
	PUSHJ	PP,PUTASY
	MOVEI	CH,AS.PAR
	PUSHJ	PP,PUTASN
	JRST	GTBDP3		;GO GENERATE "CAILE.."

GTBDP2:	PUSH	PP,CUREOP	;SAVE CUREOP
	SKIPE	TE,CUROPP	;HAVE AN OVER-RIDING POINTER TO AN OPERAND?
	 JRST	GTBDP5		;YES, USE THAT FOR ERRORS
	HRRZ	TE,OPERND	;MAKE "CUREOP" POINT TO "B"
	CAIN	LN,EBASEA
	HLRZ	TE,OPERND	; (NO, "A")..
GTBDP5:	MOVEM	TE,CUREOP	; (INCASE ERRORS)
	PUSHJ	PP,CHKLNK	;LOOK AT ITEM IN "CH" -- IN LINKAGE SECTION?
	  JRST	GTBDP4		;NO, NORMAL CASE
	POP	PP,CUREOP	;RESTORE CUREOP
	PUSH	PP,CH		;SAVE ITEM
	MOVE	CH,[MOV+ASINC,,AS.MSC]
	HRRZ	TE,DEPVB	;GET AC AGAIN
	LSH	TE,5
	TLO	CH,(TE)		;FINISH INSTRUCTION
	PUSHJ	PP,PUTASY
	POP	PP,CH
	PUSHJ	PP,PUTASN	;MOVE AC,ADDRESS.OF.A
	MOVEI	CH,SKPLE.
	TRO	CH,(TE)
	ADD	CH,DEPVB	;SKIPLE AC,(AC)
	HRLZ	CH,CH
	PUSHJ	PP,PUTASY
	JRST	GTBDP3		;GO GENERATE "CAILE.."

GTBDP4:	POP	PP,CUREOP	;RESTORE CUREOP
	HRLI	CH,SKPLE.	;NORMAL COMP ITEM..
	HRRZ	TE,DEPVB	;GET AC AGAIN
	LSH	TE,5
	TLO	CH,(TE)
	PUSHJ	PP,PUTASY	;"SKIPLE AC,DEPENDING VARIABLE"

;HERE TO DO UPPER BOUND TEST
;SKIPLE AC, DEPENDING.VARIABLE   JUST PUT OUT
; NOW GENERATE:
;CAILE AC,UPPER.BOUND.FOR.DEPENDING.VARIABLE

GTBDP3:	SETZM	SAVPR0##	;CLEAR FLAG
	MOVE	TA,DPLNK
	LDB	CH,DA.NOC	;NUMBER OF OCCURANCES
	HRLI	CH,CAILE.
	HRRZ	TE,DEPVB
	LSH	TE,5
	TLO	CH,(TE)
	PUSHJ	PP,PUTASY	;"CAILE AC,NUMBER.OF.OCCURANCES"
	MOVEI	CH,SUBE2.##
	PUSHJ	PP,PUT.PJ	;"PUSHJ PP,SUBE2." - DEPENDING VARIABLE
				;OUT OF RANGE
	LDB	CH,DA.INS	;SIZE OF EACH ITEM
	CAIG	CH,1		;IF 1, DON'T DO IMULI
	 JRST	NOIMLI
	HRLI	CH,IMULI.
	HRRZ	TE,DEPVB
	LSH	TE,5
	TLO	CH,(TE)
	PUSHJ	PP,PUTASY	;"IMULI AC,SIZE"

NOIMLI:	HRRZ	TA,ETABLB
	CAIN	LN,EBASEA
	HRRZ	TA,ETABLA
	PUSHJ	PP,LNKSET
	LDB	CH,DA.INS	;TOTAL SIZE
	MOVE	TB,DPVAR	;DEPENDING SIZE
	SUB	CH,TB		;CH=SIZE OF FIXED PART
	JUMPLE	CH,CPOPJ1	;NO FIXED PART... DONE
	HRLI	CH,ADDI.
	HRRZ	TE,DEPVB
	LSH	TE,5
	TLO	CH,(TE)
	AOS	(PP)		;SKIP RETURN
	PJRST	PUTASY		;"ADDI AC,SIZE.OF.FIXED.PART"

QITDPV:	SETOM	DEPVB		;SET DEPVB TO -1 TO INDICATE ERROR
	SETZM	SAVPR0##	;CLEAR FLAG
	SWON	FERROR		;SET "ERROR" BIT
	POPJ	PP,
;ROUTINE TO SKIP IF ITEM IN CH IS IN LINKAGE SECTION
; IF IT IS, MAKE CH POINT TO %PARAM+N (THE ADDRESS OF THE ARG ADDRESS)

CHKLNK:	HRRZ	TA,CH
	PUSHJ	PP,LNKSET
	LDB	TE,DA.LKS
	JUMPE	TE,CPOPJ	;SKIP IF IN LINKAGE SECTION
	LDB	TE,DA.RBE	;MAKE SURE THERE IS AN ARG FOR IT
	JUMPE	TE,CHKLN1	;? NO, FATAL ERROR
	LDB	CH,DA.ARG
	IORI	CH,AS.PAR
	JRST	CPOPJ1		;RETURN, CH POINTS TO %PARAM+N

CHKLN1:	PUSH	PP,CH		;WE WILL RETURN JUST ADDRESS OF THE GUY
	PUSH	PP,LN		;[1107] Save value of "LN"
	MOVEI	DW,E.597	;? HAS A DEPENDING VARIABLE NOT REFERENCED
				; IN AN ENTRY OR PD USING CLAUSE.
	PUSHJ	PP,OPNFAT	;GIVE ERROR
	POP	PP,LN		;[1107] Restore "LN"
	POP	PP,CH		;THIS WILL ASSEMBLE WITHOUT ERRORS
	POPJ	PP,
;ROUTINE TO GENERATE A "DPB DEPVB,[PARAMETER WORD]"
; CALLED TO PUT THE ACTUAL SIZE OF THE ITEM INTO THE PARAMETER
; WORD FOR A LIBOL ROUTINE.
;CALL:
;	DEPVB/	RUNTIME AC WHICH CONTAINS THE SIZE OF THE ITEM
;	EACC/	WHERE THE PARAMETER IS
;		EITHER C(EACC) = AN AC (0-17), OR
;		LH (EACC) = AS.MSC, RH (EACC) = AS.TMP+N OR AS.PAR+N
;	PUSHJ	PP,DPBDEP
;	<RETURN HERE, ALL ACS CLOBBERED>

DPBDEP:	SKIPG	DEPVB		;BETTER BE A RUNTIME AC AND NOT ZERO!
	 JRST	E$BAC		;? BAD AC SPECIFIED
	TLNN	EACC,-1		;FIRST CHECK TO MAKE SURE
	 JRST	DPBDP1		; WE CAN DPB TO THIS PLACE
	HRRZ	TE,EACC
	TRC	TE,AS.LIT	;NOT INTO A LITERAL!
	TRNN	TE,700000	; SKIP IF NOT A LITERAL
	 JRST	E$DLT		;? DEPOSIT INTO A LITERAL
DPBDP1:	PUSH	PP,EACC		;SAVE LOC TO DPB INTO
	MOVE	TA,[BYTLIT,,2]
	PUSHJ	PP,STASHP	;MAKING A BYTE PTR TO THE PLACE
	HLRZ	TA,(PP)		;ASSUME AS.MSC FOR ADDRESS
	SKIPN	TA		;IS IT?
	HRRZ	TA,(PP)		;NO, JUST AN AC
	PUSHJ	PP,STASHQ
	POP	PP,EACC		;GET EACC BACK INCASE IT WAS SMASHED
	MOVSI	TA,(POINT 12,0,17) ;WHERE THE PARAMETER IS
	TLNE	EACC,-1
	HRR	TA,EACC		;AS.MSC, GET INCREMENT
	PUSHJ	PP,POOLIT

	HRRZ	CH,DEPVB	;RUNTIME AC
	LSH	CH,5		;SHIFT TO AC POSITION
	IORI	CH,DPB.
	HRLZ	CH,CH		;GET LH OF INSTRUCTION
	PUSHJ	PP,PUT.LD	; USE CURRENT LITERAL

	SKIPN	PLITPC
	AOS	ELITPC		;UPDATE LITERAL PC
	POPJ	PP,		;RETURN, ALL DONE
;DEBUG MODULE ROUTINES

IFN ANS74,<

GDEBV:	SKIPN	GDEBSW##	;SEE IF ITS WORTH LOOKING AT DEBTAB
	JRST	GDEBV4		;NO, BUT CLEAN UP
	PUSH	PP,TA		;JUST IN CASE
	HRRZ	TA,DEBLOC	;GET BASE
	HRRZ	TE,DEBNXT	;GET END
	SUB	TE,TA
IFE SZ.DEB-2,<
	LSH	TE,-1		;SAVES WORRYING ABOUT TE+1
>
IFN SZ.DEB-2,<
	PUSH	PP,TE+1
	IDIVI	TE,SZ.DEB
	POP	PP,TE+1
>
	MOVN	TE,TE
	HRL	TA,TE		;FORM AOBJN POINTER
	ADDI	TA,1		;BYPASS FIRST WORD
GDEBV1:	LDB	TE,DB.IDP##	;NEED TO GENERATE CODE FOR THIS ONE?
	JUMPE	TE,GDEBV2	;NO
	SETZ	TE,
	DPB	TE,DB.IDP	;YES, BUT ONLY ONCE
	PUSHJ	PP,GDEBV4	;CLEAN UP JUNK
	MOVEI	CH,DBDA.##	
	PUSHJ	PP,PUT.PJ	;PUSHJ	17,DBDA.
	MOVE	CH,[AS.XWD,,1]
	PUSHJ	PP,PUTASN
	LDB	CH,DB.LN##	;LINE NUMBER
	PUSHJ	PP,PUTASN
	LDB	CH,DB.DAT##	;GET DATAB LINK
	ANDI	CH,077777	;INDEX ONLY
	PUSHJ	PP,PUTASY
	MOVE	CH,[AS.XWD,,1]
	PUSHJ	PP,PUTASN
	LDB	CH,DB.PRM	;GET 0, OR BASE OF SUBSCRIPTS
	HRLZ	CH,CH		;PUT PARAM OFSET IN LHS
	SKIPE	CH
	HRRI	CH,AS.MSC	;MAKE IT %PARAM+N
	PUSHJ	PP,PUTASN
	PUSH	PP,TA		;SAVE DATAB LINK
	LDB	TA,DB.DUP	;GET USER ROUTINE LINK
	ADD	TA,USELOC
	LDB	CH,US.PRO	;GET ACTUAL TAG
	PUSHJ	PP,PUTASY
	POP	PP,TA
GDEBV2:	ADDI	TA,SZ.DEB-1	;NEXT
	AOBJN	TA,GDEBV1	;LOOP OVER ALL OF DEBTAB
GDEBV3:	POP	PP,TA
GDEBV4:	SETZM	EDEBDA		;MAKE SURE NO JUNK LEFT AROUND
	SETZM	EDEBDB
	SETZM	GDEBSW
	POPJ	PP,


GDEBAB:	PUSHJ	PP,GDEBA	;GENERATE CODE FOR "A"

GDEBB:	SKIPG	EDEBDB		;ANYTHING TO DO
	JRST	[SETZM	EDEBDB		;NO, BUT SET TO ZERO
		POPJ	PP,]		;AND RETURN
	PUSHJ	PP,GDEBC	;PUT OUT COMMON CODE
	PUSH	PP,EDEBGB	;SAVE USE PROCEDURE TO GO TO
	HRRZ	CH,EDEBDB	;GET BASE
	SETZM	EDEBDB		;ONLY DO IT ONCE
	JRST	GDEBG		;OUTPUT USE PROCEDURE

GDEBA:	SKIPG	EDEBDA		;ANYTHING TO DO
	JRST	[SETZM	EDEBDA		;NO, BUT SET TO ZERO
		POPJ	PP,]		;AND RETURN
	PUSHJ	PP,GDEBC	;PUT OUT COMMON CODE
	PUSH	PP,EDEBGA	;SAVE USE PROCEDURE TO GO TO
	HRRZ	CH,EDEBDA	;GET BASE
	SETZM	EDEBDA		;ONLY DO IT ONCE
GDEBG:	ANDI	CH,077777	;INDEX ONLY
	PUSHJ	PP,PUTASY
	MOVE	CH,[AS.XWD,,1]
	PUSHJ	PP,PUTASN
	HLLZ	CH,0(PP)	;GET 0, OR BASE OF SUBSCRIPTS
	SKIPE	CH
	HRRI	CH,AS.MSC	;MAKE IT %PARAM+N
	PUSHJ	PP,PUTASN
	POP	PP,CH		;GET ADDRESS BACK
	HRRZS	CH
	JRST	PUTASY

GDEBC:	MOVEI	CH,DBDA.##	
	PUSHJ	PP,PUT.PJ	;PUSHJ	17,DBDA.
	MOVE	CH,[AS.XWD,,1]
	PUSHJ	PP,PUTASN
	LDB	CH,[POINT 13,OPLINE,28]	;LINE #
	JRST	PUTASN

;ROUTINE TO FIND DEBTAB ENTRY
;CALLED WITH TD = DATAB
;RETURNS WITH

;	EDEBDX(LN) = DATAB POINTER OR ZERO
;	EDEBPX(LN) = DEBTAB ,, PARAM BASE
;	EDEBGX(LN) = PARAM BASE OR ZERO ,, USE PROCEDURE

TSTARO:	PUSH	PP,TA
	HRRZ	TA,DEBLOC##	;GET BASE
	HRRZ	TE,DEBNXT##	;GET END
	SUB	TE,TA
IFE SZ.DEB-2,<
	LSH	TE,-1		;SAVES WORRYING ABOUT TE+1
>
IFN SZ.DEB-2,<
	PUSH	PP,TE+1
	IDIVI	TE,SZ.DEB
	POP	PP,TE+1
>
	MOVN	TE,TE
	HRL	TA,TE		;FORM AOBJN POINTER
	ADDI	TA,1		;BYPASS FIRST WORD
TSARO1:	LDB	TE,DB.DAT##	;GET DATAB LINK
	CAMN	TE,TD		;ONE WE WANT?
	JRST	TSARO2		;YES
	ADDI	TA,SZ.DEB-1	;NO
	AOBJN	TA,TSARO1	;LOOP UNTIL WE FIND IT
	HALT			;ERROR

TSARO2:	PUSH	PP,LN
	CAIE	LN,EBASEA	;CHANGE LN TO POINT TO DEBUG DATA
	SKIPA	LN,[EXP EDEBDB]
	MOVEI	LN,EDEBDA
	LDB	TE,DB.IDP##	;ALREADY GENERATED DEBUG INFO?
	SKIPE	TE
	SETZM	EDEBDX(LN)	;YES, DON'T DO IT TWICE
	HRRZ	TE,DEBLOC
	HRRZ	TD,TA
	SUB	TD,TE		;GET OFFSET INTO DEBTAB
	HRLZM	TD,EDEBPX(LN)
	LDB	TE,DB.ARO##
	LDB	TD,DB.PRM##	;GET BASE OF PARAMS OR ZERO (IF NOT SUBSCRIPTED)
	HRRM	TD,EDEBPX##(LN)	
	HRLM	TD,EDEBGX(LN)	;AND FOR CODE GENERATION
	LDB	TA,DB.DUP##	;GET USE ROUTINE
	ADD	TA,USELOC##	;ADD IN BASE
	LDB	TD,US.PRO##
	IOR	TE,EDEBGX##(LN)	;BIT 35 WILL BE ON IF WE EANT TO DEBUG
	HRRM	TD,EDEBGX(LN)	;STORE %PARAM,,<USE-PROCEDURE>
	TRNN	TE,1		;EITHER USER SET -1 OR DA.ARO WAS ON
	SETZM	EDEBDX##(LN)	;NO, SO DON'T WANT IT
	POP	PP,LN
	POP	PP,TA
	POPJ	PP,

CDEBAB:	PUSHJ	PP,CDEBB	;DO IT FOR "B"
CDEBA:	SKIPG	EDEBDA		;ANYTHING TO DO
	JRST	[SETZM	EDEBDA		;NO, BUT SET TO ZERO
		POPJ	PP,]		;AND RETURN
	PUSH	PP,TA
	HLRZ	TA,EDEBPA	;GET DEBTAB OFFSET
	SETZM	EDEBDA
	JRST	CDEBC		;COMMON CODE

CDEBB:	SKIPG	EDEBDB		;ANYTHING TO DO
	JRST	[SETZM	EDEBDB		;NO, BUT SET TO ZERO
		POPJ	PP,]		;AND RETURN
	PUSH	PP,TA
	HLRZ	TA,EDEBPB	;GET DEBTAB OFFSET
	SETZM	EDEBDB
CDEBC:	ADD	TA,DEBLOC	;ADD IN BASE
	LDB	TE,[POINT 13,OPLINE,28]
	DPB	TE,DB.LN##	;SAVE LINE NUMBER IN CASE IT CHANGES
	SETO	TE,
	DPB	TE,DB.IDP	;SIGNAL WE NEED IT
	POP	PP,TA
	AOS	GDEBSW		;SO WE WILL SEARCH DEBTAB AT GDEBV
	POPJ	PP,
>
;IMPROPER "ALL"

BADALL::MOVEI	DW,E.273	;[621] CALLED FROM MOVGEN
	JRST	BADLIT

;LITERAL HAS ZERO SIZE

LNOSIZ:	MOVEI	DW,E.183
	JRST	BADLIT


;BAD CHARACTER FOR NUMERIC LITERAL

BADLK:	MOVEI	DW,E.211
	JRST	BADLIT


;LITERAL IS BEING MOVED TO ALPHANUMERIC FIELD, AND HAS DECIMAL PLACES

BADDP:	MOVEI	DW,E.96
	JRST	BADLIT


;LITERAL IS TOO LARGE TO BE NUMERIC

TOOBIG:	MOVEI	DW,E.56

BADLIT:	SWON	FERROR;
	CAIN	LN,EBASEB
	SKIPA	TC,OPERND
	MOVS	TC,OPERND
	MOVE	TC,0(TC)
	LDB	LN,TCLN
	LDB	CP,TCCP
	JRST	FATAL

;"ROUNDED" CLAUSE SEEN, BUT NO NEED FOR ROUNDING.

NOROUN:	MOVEI	DW,E.218
	JRST	OPNWRN

;"SIZE ERROR" SEEN, BUT A SIZE ERROR CAN'T HAPPEN.

NOSERA:	MOVEI	DW,E.217
	MOVE	W1,OPLINE
	JRST	OPWRN
;COMMON ERROR ROUTINES
;PUT OUT A FATAL DIAG AT OPERAND

OPNFAT:	SWON	FERROR;
	MOVE	TC,CUREOP
	MOVE	TC,0(TC)
	LDB	CP,TCCP
	LDB	LN,TCLN
	JRST	FATAL

;PUT OUT A FATAL DIAG AT OPERATOR

OPFAT:	SWON	FERROR;
	LDB	CP,W1CP
	LDB	LN,W1LN
	JRST	FATAL

;PUT OUT A WARNING DIAG AT OPERAND

OPNWRN:	MOVE	TC,CUREOP
	MOVE	TC,(TC)
	LDB	CP,TCCP
	LDB	LN,TCLN
	JRST	WARN

;PUT OUT A WARNING DIAG AT OPERATOR

OPWRN:	LDB	CP,W1CP
	LDB	LN,W1LN
	JRST	WARN


;OPERAND IS NOT NUMERIC

NOTNUM:	MOVEI	DW,E.211
	JRST	OPNFAT

;WRONG NUMBER OF OPERANDS

BADEOP:	MOVEI	DW,E.214
	JRST	OPFAT

;NOT A DATA-NAME
NOTDAT:	MOVEI	DW,E.101
	JRST	OPNFAT
;COMMON ERROR ROUTINES (CONT'D)

;ERROR DETECTED DURING "SETOPN"

OPERA:	SWON	FERROR;
	PUSH	PP,LN
	LDB	CP,TBCP
	LDB	LN,TBLN
	PUSHJ	PP,FATAL
	POP	PP,LN
	POPJ	PP,

;ITEM NOT DEFINED
NOTDEF:	MOVEI	DW,E.104
	JRST	OPNFAT

;IF FIPS FLAGGER REQUESTED FOR NUCLEUS 2 FEATURES

IFN ANS74,<
	INTERN	TST.N2
TST.N2:	SKIPN	FLGSW##		;ARE WE CHECKING FIPS LEVEL?
	POPJ	PP,		;NO
	MOVE	TC,CUREOP	;POSSIBLE ERROR
	MOVE	TC,0(TC)	;SETUP TO POINT TO "B"
	LDB	CP,TCCP		;LOAD UP LN & CP
	LDB	LN,TCLN
	PUSH	PP,TA		;ACC TO CONTAIN THE LEVEL FLAG
	MOVEI	TA,%LV.HI	;GET FLAG LEVEL OF HIGH-INTERMEDIATE
	ANDCM	TA,FLGSW	;CLEAR THE BITS WE ALLOW
	SKIPE	TA		;IS THIS WITHIN LIMITS?
	PUSHJ	PP,FLG.ES##	;NO
	POP	PP,TA
	POPJ	PP,
>
IFN CSTATS,<
;ROUTINE TO GENERATE AN AOS FOR AN INTERNAL METER COUNTER
;CALLED BY CMNGEN, IPCGEN IF METRSW=-1
;CALL:
;	MOVEI CH,NUMBER
;	PUSHJ PP,MTRAOS
;	<RETURN HERE>
;		USES: CH,TE

MTRAOS::
	PUSH	PP,CH		;SAVE THE NUMBER
	PUSHJ	PP,PUTASA	;HRRZ IN 2ND CODE SET
	MOVE	CH,[HRRZ.+AC16,,METR.##]
	PUSHJ	PP,PUT.EX
	POP	PP,CH
	TLO	CH,AOS.+16
	PJRST	PUTASY		;GEN "AOS N(16)" AND RETURN
>;END IFN CSTATS
;TABLE OF ONE-WORD POWERS OF 10

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 TWO-WORD POWERS OF 10
DPWR10:	OCT	2		;11
	OCT	351035564000
	OCT	35		;12
	OCT	032451210000
	OCT	443		;13
	OCT	011634520000
	OCT	5536		;14
	OCT	142036440000
	OCT	70657		;15
	OCT	324461500000
	OCT	1070336		;16
	OCT	115760200000
	OCT	13064257	;17
	OCT	013542400000
	OCT	157013326	;18
	OCT	164731000000
	OCT	2126162140	;19
	OCT	221172000000
	OCT	25536165705	;20
	OCT	254304000000
	OCT	330656232670	;21
	OCT	273650000000


;TABLE OF ROUNDING VALUES

ROUNDR:	^D5
	^D50
	^D500
	^D5000
	^D50000
	^D500000
	^D5000000
	^D50000000
	^D500000000
	^D5000000000
;SOME CONSTANTS

CHAC:	POINT 4,CH,12	;AC-FIELD IN "CH"
CHOP:	POINT 7,CH,8	;OP-CODE FIELD IN "CH"
TCLN:	POINT 13,TC,28	;LINE NUMBER FIELD
TCCP:	POINT 7,TC,35	;CHARACTER POSITION FIELD
TBLN:	POINT 13,TB,28
TBCP:	POINT 7,TB,35
W1LN:	POINT 13,W1,28	;LINE-NUMBER FIELD
W1CP:	POINT 7,W1,35	;CHARACTER-POSITION FIELD
TASUBC:	POINT 6,TA,17
TESUBC:	POINT 6,TE,17	;SUBSCRIPT COUNT IN OPERAND
W2SUBC:	POINT 6,W2,17	;SUBSCRIPT COUNT IN W2
ACMODE:	POINT 4,TD,3
ACSIZE:	POINT 6,TD,17

BYTE.S:	OCT 6	;SIXBIT BYTE SIZE
	OCT 7	;ASCII BYTE SIZE
	OCT 11	;EBCDIC BYTE SIZE

NBYT.S::
	OCT -6	;SIXBIT (NEGATIVE)
	OCT -7	;ASCII (NEGATIVE)
	OCT -11	;EBCDIC (NEGATIVE)

	OCT 11	;COMP-3 BYTE SIZE.

BYTE.W:	OCT 6	;SIXBIT BYTES PER WORD
	OCT 5	;ASCII BYTES PER WORD
	OCT 4	;EBCDIC BYTES PER WORD


;'ADDITIVE SUBSCRIPT' BITS IN OPERAND

ASUBSC==1B29	;ADD LITERAL TO SUBSCRIPT
SSUBSC==2B29	;SUBTRACT LITERAL FROM SUBSCRIPT
BSUBSC==ASUBSC!SSUBSC
;DEFINITION OF ASYFIL OPERATOR CODES

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

	DEFINE %OPCT%(A,B,C,D,E,F,G,H,I,J,K,L,M,N),<
	SETVAL	C,B	;MAKE AVAILABLE THE INTERNAL OPCODE
	>

	DEFINE %OPCU%(A,B,C,D,E,F,G,H,I,J,K,L,M,N),<
	SETVAL	C,B	;MAKE AVAILABLE THE INTERNAL OPCODE
	>

	;NOW INVOKE THE TABLE EXCERCISER
	OPCTAB;
	OPCTB2;

;DEFINITION OF UUO CALLS

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

	UUOWAC==172		;FIRST UUO WHICH DOES NOT USE AC
				;TO EXTEND THE OP CODE

SETVAL OPCLS.,172,0
SETVAL OPN,172,0
SETVAL OPEN.I,172,4;
SETVAL OPEN.O,172,10;
SETVAL CLOS,172,1;

SETVAL IO.,173,0
SETVAL DSPLY.,173,0;
SETVAL ACEPT.,173,1;
SETVAL READ,173,2;
SETVAL WRITE,173,3;
SETVAL WADV.,173,4;
IFN ANS68,<
SETVAL SEEK,173,5;
>
IFN ANS74,<
SETVAL RDNXT.,173,5;
>
SETVAL DELETE,173,6;
SETVAL RERIT.,173,7;
SETVAL PURGE.,173,10;
SETVAL INITT,173,11;
SETVAL TERM,173,12;
SETVAL DSPL.6,173,14;
SETVAL DSPL.7,173,15;

;SETVAL COMP,174,0
;SETVAL CMP.76,174,1
;SETVAL SPAC.6,174,2
;SETVAL NUM.6,174,3
;SETVAL ALF.6,174,4
;SETVAL ZERO.6,174,5
;SETVAL POS.6,174,6
;SETVAL NEG.6,174,7
;SETVAL SPAC.7,174,10
;SETVAL NUM.7,174,11
;SETVAL ALF.7,174,12
;SETVAL ZERO.7,174,13
;SETVAL POS.7,174,14
;SETVAL NEG.7,174,15
SETVAL COMP.D,174,16
;UUO CALLS  (CONT'D).

SETVAL C.DD,175,0;
SETVAL C.D6D7,175,1;
SETVAL C.D7D6,175,2;
SETVAL CMP.,175,2	;BASE OF CMP.X UUO'S
			; CMP.E=3,CMP.G=4,CMP.GE=5,CMP.L=6,CMP.LE=7,CMP.N=10

SETVAL EDIT.S,176,0
SETVAL EDIT.U,176,1
IFN ANS68,<
SETVAL EXAM.,176,2
>
IFN ANS74,<
SETVAL INSP.,176,2
>

;SETVAL SUBSC.,176,3;
;SETVAL SIZE.1,176,4
SETVAL SIZE.2,176,5
SETVAL SIZE.3,176,6

SETVAL E.C3C1,176,7;
SETVAL E.C3C3,176,10;

SETVAL	OVLAY.,176,11;
SETVAL	XIT,176,12
SETVAL	ARGS.,176,13	;ROUTINE TO PICK UP ARGS AT ENTRY
;SETVAL	PUTF.,176,14	;PUT FIXED ITEMS INTO LIBIMP
;SETVAL	RESF.,176,15	;RESTORE CALLER'S FIXED ITEMS
;176,16 IS USED BY COBDDT
;SETVAL	ILLC.,176,17	;KILL RECURSIVE CALL ERROR

;MORE UUO CALLS

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

		;140 NOT USED
		;141 NOT USED

FSTUUO==142		;FIRST UUO CODE
UUOMSK==140000		;MASK TO CHECK FOR UUO IN PUTASY

SETVAL FIX.,142;
		;143 RESERVED FOR COMP.D
SETVAL PERF.,144;

SETVAL FLOT.1,145;
SETVAL FLOT.2,146;

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

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

IFE BIS,<
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
	>

;DEFINITION OF MODES

SETVAL D6MODE,0		;SIXBIT
SETVAL D7MODE,1		;ASCII
SETVAL D9MODE,2		;EBCDIC
SETVAL DSMODE,2		;HIGHEST MODE FOR DISPLAY

SETVAL D1MODE,3		;1-WORD DECIMAL
SETVAL D2MODE,4		;2-WORD DECIMAL
SETVAL FPMODE,5		;FLOATING POINT
SETVAL IXMODE,6		;INDEX
SETVAL C3MODE,6		;COMP-3 (INDEX GETS CHANGED TO D1MODE)
SETVAL EDMODE,7		;EDITED
SETVAL LTMODE,10	;LITERAL
SETVAL FCMODE,11	;FIG. CONST.
SETVAL D4MODE,12	;4-WORD DECIMAL (TEMP DURING D2 OPERATIONS)
SETVAL F2MODE,13	;D.P. FLOATING POINT (COMP-2)
SETVAL IMMODE,14	;IMMEDIATE (ADDRESS IS VALUE)

SETVAL ZERO,2		;EFLAG VALUE FOR "ZERO"

SETVAL CORR,1B<^D18+^D12>	;"CORRESPONDING" FLAG IN OPERATOR
SETVAL INVKEY,1B29	;"INVALID KEY" FLAG IN SPIF OPERATOR
SETVAL ATEND,1B27	;"AT END" FLAG IN SPIF OPERATOR
SETVAL	OVERFL,1B31	;"ON OVERFLOW" FLAG IN SPIF
SETVAL ATINVK,INVKEY!ATEND!OVERFL
IFN ANS74,<
SETVAL	ATEOP,1B<^D18+^D15>	;"AT END OF PAGE" FLAG IN SPIF OPERATOR
SETVAL	ATPINV,ATINVK!ATEOP
>
SETVAL FLOBIT,1B20	;BIT IN 2ND WORD OF OPERAND TO DENOTE "FLOTAB"
SETVAL SPIF.,23		;OPERATOR CODE FOR SPIF
SETVAL	NOOP.,106	;OPERATOR CODE FOR NOOP (USED IN ANS74 READ)



;MISCELLANEOUS CONSTANTS
SETVAL EPJPP,PUSHJ.+AC17	;"PUSHJ 17,"
SETVAL	JOV.,JFCL.+AC10		;"JOV"
SETVAL	JFOV.,JFCL.+AC1		;[1110] "JFOV"
SETVAL MAXSIZ,^D20	;LARGEST ALLOWED NUMERIC ITEM
SETVAL MXPSZ.,3770	;LARGEST SIZE WE CAN FIT IN A PARAMETER.
			; (AND STILL BE DIVISIBLE BY 4,5,6)
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 CONSTANT
SETVAL FLTLIT,7		;LITAB CODE FOR FLOATING-POINT CONSTANT
SETVAL OCTLIT,10	;LITAB CODE FOR OCTAL CONSTANT
SETVAL EBCLIT,11	;LITAB CODE FOR EBCDIC CONSTANT
SETVAL XTNLIT,12	;LITAB CODE FOR EXTEND [OPCODE]
SETVAL F2LIT,13		;LITAB CODE FOR D.P. FLOATING POINT CONSTANT

SETVAL MAXLIT,13	;MAXIMUM LITAB CODE

;TABLE OF LITAB CODES FOR DISPLAY LITERALS.

D.LTCD::
	EXP	SIXLIT			;SIXBIT.
	EXP	ASCLIT			;ASCII.
	EXP	EBCLIT			;EBCDIC.

	INTERNAL MOVSAC
MOVSAC:	XWD	MOVEM.+SAC+ASINC,AS.MSC	;FIRST HALF OF INSTRUCTION TO STASH AC12

SETVAL SYNBIT,1B<^D18+6>	;SIGN FLAG IN PARAMETERS
EXTERNAL LITBLK,LITNXT,LITLOC,CURLIT,LITDEV,LITHDR
EXTERNAL ESZERO,ESQUOT,EAZRJ,EASRJ,EAQRJ,ELOVAL,EHIVAL,EFPLOV,EFPCNV,EF2CNV
EXTERNAL ELITPC,ELITLO,ESIZEZ,ETEMPC,ETEMAX,TEMBAS,OPERND,LITHLD,EPWR10,RPWR10
EXTERNAL EBASEA,EMODEA,ERESA,EINCRA,ESIZEA,EDPLA,EFLAGA,EBYTEA,ETABLA
EXTERNAL EBASEB,EMODEB,ERESB,EINCRB,ESIZEB,EDPLB,EFLAGB,EBYTEB,ETABLB
EXTERNAL EBASEX,EMODEX,ERESX,EINCRX,ESIZEX,EDPLX,EFLAGX,EBYTEX,ETABLX
EXTERNAL ESAVEA,ESAVAX,ESAVEB,ESAVBX,EBASAX,EBASBX,ESAVES,ESAVSB,ESAVSX
EXTERNAL EXTLOC,DATLOC
EXTERNAL TAGLOC,TAGCNT,EAC,EOPLOC,EOPNXT,CUREOP,EAS1PC,EAS2PC,EAS3PC,OPLINE
EXTERNAL ESAVAC,ESZERA,ESAVOP,ENOCC1,ENOCC2,SUBCON
EXTERNAL ESMAX, EREMAN,EWORDB,EMULSZ,ESAVDT,ESAVSW,SAVEAC
EXTERNAL SUBINP,CUROPP

EXTERNAL DA.USG,DA.NDP,DA.DPR,DA.INS,DA.EXS,DA.RES,DA.CLA,CURDAT
EXTERNAL DA.EDT,DA.SYR,DA.SYL,DA.SLL,DA.SGN,DA.DEF,DA.SUB
EXTERNAL DA.OCC,DA.NOC,DA.OCH,DA.DEP,DA.SON,DA.DCR

EXTERNAL AS.DAT,AS.TAG,AS.CNB,AS.MSC,AS.PAR,AS.LIT,AS.TMP
EXTERNAL AS.BYT,AS.XWD,AS.OCT,AS.DOT,AS.MS2

EXTERNAL TB.DAT,TM.DAT

EXTERNAL LNKCOD,LMASKB,LMASKS
EXTERNAL DPITM,DPLNK,DPVAR,DEPVB
IFN BIS, EXTERNAL SIZE.4,SIZE.5 ;[634] SIZE CHECK ROUTINES IN LIBOL

	END