Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

;<KSTEVENS.BUFFER>EXPGEN.MAC.2, 21-Mar-88 22:01:45, Edit by KSTEVENS
; UPD ID= 1520 on 2/2/84 at 6:04 PM by HOFFMAN
TITLE	EXPGEN FOR COBOL V13
SUBTTL	CODE GENERATORS FOR ARITHMETIC EXPRESSIONS	AL BLACKINGTON/CAM

	SEARCH COPYRT
	SALL

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

COPYRIGHT (C) 1974, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION

	SEARCH	P
IFN TOPS20,<SEARCH MACSYM>
	%%P==:%%P

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

;EDITS

;NAME	DATE		COMMENTS
;JEH	26-APR-84	[1522] Clean up EOP stack if error w/ ref. modifiers
;JEH	19-DEC-83	[1511] Test for need of float. point correction factor
;				before generating rounding statements
;JEH	20-APR-83	[1461] Test for DP floating point before GETEMP calls
;JEH	25-MAR-83	[1456] Fix COMPUTE using 'ZERO' in first term
;JEH	 5-Nov-82	[1430] Store intermediate results in 2 words if DP floating point mode.
;JEH	30-Sep-82	[1402] Force floating point divide, but convert
;				back to integer arithmetic when done.
;RLF	14-Apr-82	[1352] Fix DP floating point subtract.

;V12B RELEASED
;DMN	26-SEP-80	[1056] FIX COMP-2 TO COMP-1 CONVERSION IN COMPUTE STATEMENT.
;DMN	 8-MAY-80	;[1017] FIX EDIT 443, MAKE COMPUTE A = - (SOMETHING) WORK.
;DAW	27-MAR-80	;[777] FIX ?ASSEMBLY ERROR WHEN LITERALS USED IN
;			;COMPUTE AND EDIT 637 IS INSTALLED
;DMN	 7-FEB-80	;[767] CHECK OVERFLOW FLAGS FOR "ON SIZE ERROR".
;DMN	30-JAN-80	;[762] ADD SMALL CONSTANT TO COMP-2 COMPUTE CALCULATIONS.

;V12A RELEASED
;DMN	27-FEB-79	;[641] FIX INCORRECT TEST FOR OPERAND IS ACC AT LASTOP
;DAW	23-FEB-79	;[637] FIX COMPUTE WITH COMP-1 RESULT
;EHM	14-APR-78	;[534] FIX COMPUTE GETS ANSWER FROM WRONG AC

;V12 RELEASE
;EHM	28-DEC-76	;[456] WARN IF ROUNDING IN WRONG PLACE

;V11 RELEASE
;JC	16-SEP-76	;[443] FIX 'COMPUTE A = - (25)'
;ACK	28-MAY-75	COMP-3/EBCDIC CODE.

;V10 RELEASE
; EDIT 370 FIX RETURN FATAL ERROR IN EXPRESSION
; EDIT 360 FIX EDIT 320 FOR SIMPLE COMPUTE X = -A OR (-A)
; EDIT 350 TURN OFF ZERO BIT AFTER COMPUTE
; EDIT 321 FIX RECOVERY IN A COMPUTE STATEMENT IF DATA IS NOT QUALIFIED.
; EIDT 320 FIX COMPUTE X = - (EXP) (MINUS SIGN)
;EDIT 314 FIX RECOVERY IF COMPUTE STATEMENT HAS UNDEFINED VARIBLE

EXPGEN:	INTERNAL EXPGEN

ENTRY	EXPRGN	;START OF AN EXPRESSION
ENTRY	COMPGN	;"COMPUTE" GENERATOR
ENTRY	CENDGN	;"CEND" GENERATOR

EXTERNAL PUTASY,PUTASN,FATAL,WARN,GETEMP,GETGEN,SETOPN,LNKSET
EXTERNAL BMPEOP,GETTAG,PUTTAG,ADJDP.,COMEBK,PUSEOP,PUSH12
EXTERNAL ADDX.,SUBX.,MULX.,DIVX.,EXPX.,MACX.,MXAC.,MNXAC.,SWAPAB
EXTERNAL PUT.XA,PUT.XB,PUT.EX
EXTERNAL ROUND,SIZERA,NOTNUM,BADEOP
EXTERNAL NEGCMP		; [360]
EXTERNAL OPNWRN		;[456]


	DEFINE SUBGEN (X),<
	XLIST
	IRP X,<
	ENTRY X'GN
	X'GN=NOTOPR
	>
	LIST>


NOTOPR:	MOVEM	PP,SAVEPP
	MOVEI	DW,E.215

W1ERA:	LDB	LN,W1LN
	LDB	CP,W1CP

;PUT OUT A DIAGNOSTIC, THEN SCAN GENFIL FOR ENDEXP OR ENDIT OPERATOR.

GOBACK:	SKIPN	RMFLAG##	;Error already given if RMFLAG
	PUSHJ	PP,FATAL
	JRST	GOBAK3

GOBAK1:	MOVE	PP,SAVEPP
GOBAK2:	PUSHJ	PP,GETGEN
GOBAK3:	JUMPL	W1,GOBAK2
	HRRZ	TE,W2
	CAIL	TE,OPCADD	; [321] GO PAST  PARTS OF COMPUTE
	CAILE	TE,OPCEXP	; [321] STMNT ADD,SUB,MULPY,DIV,EXPEN
	SKIPA			; [321] OKAY SO FAR
	JRST	GOBAK2		; [321] ONE OF THE ABOVE- GO ON
	CAIL	TE,OPLPAR	; [321] ALSO GO PAST LEFT AND RIGHT
	CAILE	TE,OPEXP	; [321] PARENS AND EXPRESSIONS
	CAIN	TE,OPYECC	; [V10] SKIP OVER THE YECCH ALSO.
	JRST	GOBAK2		; [321] ONE OF THE ABOVE- GO ON
	SETZM	NEGCMP		; [V10]
	POPJ	PP,		; [V10]


;THE FOLLOWING ROUTINES SHOULD NEVER BE ENTERED FROM THE OUTSIDE
	SUBGEN <CADD,CSUB,CMUL,CDIV,CEXP,LPAR,RPAR,ENDX>

;"COMPUTE" GENERATOR

COMPGN:	SETZM	NEGCMP		; [360] TURN OFF NEGATE SWITCH
	SETZM	ECARRY##	;[534] RESET ECARRY
	SETZM	FLTDIV##	;[637] CLEAR "RESULT IS FLOATING POINT"
	SWOFF	FEOFF1		;TURN OFF MOST FLAGS
	MOVEM	W1,OPLINE	;SAVE LN&CP OF OPERATOR
	SWON	FBIGCV		;TURN ON "CONVERT TO FL.PT. IF TOO BIG"

	HRRZ	TC,EOPLOC	;GET FIRST OPERAND
	MOVE	CH,CMPLVL
	IMULI	CH,4		;4 WORDS EACH
	ADDI	TC,1(CH)
	MOVE	EACA,EOPNXT
	CAIL	TC,(EACA)
	JRST	BADEOP		;THERE ISN'T ONE--ERROR

	MOVE	W2,1(TC)	;GET OPERAND'S SECOND WORD
	LDB	CH,W2SUBC	;GET SUBSCRIPT COUNT
	ADDI	CH,1
	LSH	CH,1
	HRLS	CH
	PUSHJ	PP,PUSEOP	;STASH IT IN EOPTAB
	MOVEI	CH,0		;  FOLLOWED BY
	PUSHJ	PP,PUSEOP	;  ZERO

	MOVE	TA,W2		;IF ITEM IS
	LDB	TE,LNKCOD	;  NOT
	CAIN	TE,TB.DAT	;  DATA-NAME,
	JRST	COMPG1		;  USE
	MOVEI	TA,0		;  ZERO
	JRST	COMPG2		;  DECIMAL PLACES

COMPG1:	PUSHJ	PP,LNKSET	;IT'S DATA-NAME--GET DATAB ENTRY ADDRESS

	LDB	TE,DA.NDP	;GET DECIMAL PLACES
	LDB	TD,DA.DPR	;IF DECIMAL POINT IS TO
	SKIPE	TD		;  THE RIGHT OF THE WORD BOUNDARY,
	MOVNS	TE		;  NEGATE
;[1402]	LDB	TD,DA.USG##	;[637] GET USAGE OF TARGET
;[1402]	CAIN	TD,%US.C1	;[637] IF IT IS COMP-1
;[1402]	SETOM	FLTDIV		;[637] SET FLAG

COMPG2:	TLNE	W2,GNROUN	;IS RESULT TO BE ROUNDED?
	ADDI	TE,1		;YES--ADD 1 TO DECIMAL PLACES
	SKIPN	CMPLVL##	;NOT FIRST?
	JRST	.+3		;IT IS
	CAMGE	TE,ERESDP	;FIND LARGEST IN SERIES
	MOVE	TE,ERESDP	;USE PREVIOUS
	MOVEM	TE,ERESDP
	MOVE	EACA,EOPNXT

	AOS	CH,CMPLVL	;BUMP COUNT
	SOJN	CH,COMEBK	;ONLY OUTPUT FIRST TIME
	MOVE	CH,[XWD SETZM.,OVFLO.]
	PUSHJ	PP,PUT.EX
	PUSHJ	PP,PUTASA##	;[767] OTHER SET
	MOVE	CH,[JFCL.##+ASINC+AC17,,AS.MSC]	;[767]
	PUSHJ	PP,PUTASY	;[767] CLEAR THE OVERFLOW FLAGS
	MOVEI	CH,AS.DOT+1	;[767]
	PUSHJ	PP,PUTASN	;[767]
	SETOM	OVFLFL##	;SIGNAL WE MIGHT NEED OVERFLOW CHECKING
	JRST	COMEBK

;"CEND" GENERATOR

CENDGN:	SETZM	ERESDP
	SETZM	FLTDIV##	;[637] CLEAR "FLOATING POINT RESULT"
	SWOFF	<FBIGCV!FEOFF1>-FALWY0;	TURN OFF SOME FLAGS
	MOVE	EACA,EOPNXT
	HRRZ	TC,EOPLOC

	ADDI	TC,1
	CAIL	TC,(EACA)	;ANY OPERANDS?
	POPJ	PP,		;NO--MUST HAVE HAD A YECCH
	MOVEM	TC,OPERND
	MOVEM	TC,CUREOP
	SETZM	CMPTMP##	;
	SOSG	CMPLVL		;MORE THAN 1 IN SERIES?
	JRST	CEND00		;NO
	MOVE	TC,CMPLVL	;GET COUNT
	PUSHJ	PP,BMPEOP	;BYPASS OPERAND
	  POPJ	PP,		;ERROR
	PUSHJ	PP,BMPEOP	;BYPASS "PSEUDO = OP"
	  POPJ	PP,
	SOJGE	TC,.-4		;LOOP
	MOVE	TC,CUREOP	;POINT TO VALUE OF COMP
	HRRZM	TC,CMPEOP##	;STORE FOR LATER
	HRRZ	TC,EOPLOC
	ADDI	TC,1
	MOVEM	TC,OPERND	;RESET
	MOVEM	TC,CUREOP
	HRROS	CMPLVL		;SIGNAL FIRST TIME
CEND0L:	PUSHJ	PP,CEND00	;YES, LOOP BACK
	SKIPN	CMPTMP		;NEED TO RESTORE VALUE?
	JRST	CEND0N		;NO
	SETZM	EAC		;[1647]MAKE SURE AC IS SET CORRECTLY TO 0
	HLRZ	CH,CMPTMP
	SOJE	CH,.+3		;1 WORD ONLY
	PUSHJ	PP,PUTASA
	SKIPA	CH,[DMOVE.##+ASINC,,AS.MSC]
	MOVE	CH,[MOV##+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	HRRZ	CH,CMPTMP
	PUSHJ	PP,PUTASN
CEND0N:	HRRZ	TC,EOPLOC
	MOVEI	TC,1(TC)
	MOVEM	TC,OPERND
	MOVEM	TC,CUREOP
	PUSHJ	PP,BMPEOP	;BYPASS THIS
	  POPJ	PP,		;CAN'T HAPPEN
	AOS	TC,CUREOP	;BYPASS "PSEUDO = OP"
	HRRM	TC,EOPLOC	;SET TO TOP OF NEW OPERAND
	MOVEI	TC,1(TC)
	MOVEM	TC,OPERND
	MOVEM	TC,CUREOP
	SOSE	CMPLVL		;COUNT DOWN
	JRST	CEND0L		;NOT DONE YET
CEND00:

	MOVEI	LN,EBASEB
	PUSHJ	PP,SETOPN

	TSWT	FBNUM;
	JRST	CEND2

CEND0:	PUSHJ	PP,BMPEOP
	  POPJ	PP,		;ONLY 1 OP--MUST HAVE BEEN A YECCH.

	HRRZ	TC,EOPLOC	;GET
	ADDI	TC,1		;	CUREOP, AND RESET IT TO
	EXCH	TC,CUREOP	;	TOP OF EOPTAB
	ADDI	TC,2		;SKIP PAST COUNT WORD AND "PSEUDO =" OPERATOR
	SKIPE	CMPLVL		;LAST ONE (OR ONLY ONE)?
	MOVE	TC,CMPEOP	;YES, POINT TO IT
	HRLM	TC,OPERND

	MOVE	TA,1(TC)	; [314] GET DATA NAME ADDRESS
	CAIN	TA,100001	; [314] IF DUMMY VARIABLE
	POPJ	PP,		; [314] WHICH REPLACED UNDEFINED ONE-QUIT
	MOVEI	LN,EBASEA
	PUSHJ	PP,SETOPN
	SKIPE	CMPTMP		;VALUE IN TEMP?
	SETZM	EBASEA		;ACTUALLY IN ACC 0 & 1
	SKIPL	CMPLVL		;FIRST TIME?
	JRST	CEND0B		;NO
	HRRZS	CMPLVL		;ONLY ONCE
	HRRZ	TE,EBASEA	;IS IT IN THE ACCS
	CAILE	TE,17
	JRST	CEND0B		;NO?
	MOVEI	TE,1		;[1461] ASSUME 1 WORD ONLY
	MOVE	TD,EMODEA
	CAIE	TD,D2MODE
	CAIN	TD,F2MODE	;[1461]
	MOVEI	TE,2		;[1461] 2 WORDS
	HRLZM	TE,CMPTMP	;LHS = NO. OF WORDS
	PUSHJ	PP,GETEMP
	CAIE	TD,D2MODE
	CAIN	TD,F2MODE
	PUSHJ	PP,PUTASA	;NEED DMOVE
	MOVE	CH,EBASEA	;GET ACC
	LSH	CH,^D18+5
	ADD	CH,[ASINC,,AS.MSC]
	CAIE	TD,D2MODE	;NEED DMOVEM
	CAIN	TD,F2MODE
	TLOA	CH,DMOVM.##
	TLO	CH,MOVEM.
	PUSHJ	PP,PUTASY
	HRRZ	CH,EACC
	HRRM	CH,CMPTMP	;RHS = TEMP ADDRESS
	PUSHJ	PP,PUTASN

CEND0B:	TSWT	FANUM		;IS "A" NUMERIC?
	PUSHJ	PP,CEND3

	HRRZ	TE,EMODEA	;IS "A" A LITERAL?
	CAIN	TE,LTMODE
	JRST	CEND0A

	HRRZ	TE,EBASEA	;NO--IS IT THE AC'S?
	CAIG	TE,17
	JRST	CEND1		;YES
CEND0A:	SETZM	EAC		;NO--GET IT INTO AC'S 0&1
	PUSHJ	PP,INTOAC	;GET "A" INTO THE AC'S
	MOVS	TC,OPERND	;[1017] GET "A" OPERANDS ADDRESS
	MOVSI	TE,NEGEOP	;[1017] CLEAR NEGATE OPERAND FLAG
	ANDCAM	TE,1(TC)	;[1017] SINCE INTOAC HAS ALREADY GOT NEGATIVE

CEND1:	HLRZ	TC,OPERND	; [320] GET AC OPERND ADDRESS
	MOVE	TC,1(TC)	; [320] GET 2ND WORD OF OPERND
	TLNE	TC,NEGEOP	; [320] NEGATE THE RESULT IN THE AC?
	PUSHJ	PP,CENDN	; [320] YES
	SETZM	NEGCMP		; [360] TURN OFF NEGATE SWITCH
	HRRZ	TE,EMODEA	;[762] GET MODE OF "A"
	HRRZ	TC,EMODEB	;[762] AND "B"
	CAIN	TE,F2MODE##	;[762] IS "A" COMP-2
	CAIN	TC,F2MODE	;[762] AND "B" SOMETHING ELSE?
	JRST	CEND1C		;[762] NO, LEAVE AS IS
	CAIN	TC,FPMODE	;[1056] IF COMP-1
	JRST	[PUSHJ	PP,CF2FP.##	;[1056] JUST ROUND AND TRUNCATE
		JRST	CEND1C]	;[1056]
	PUSHJ	PP,EPSLON##	;[762] YES, ADD EPSILON TO "A"
CEND1C:	HRRZ	TC,OPERND	;[1511] Destination operand address
	MOVE	TC,1(TC)	;[1511] second word of operand pair
	TLNE	TC,GNROUN	;[1511] test on rounding bit
	PUSHJ	PP,ROUND##	;[1511] generate rounding code
	SETZM	EMULSZ		;SET "SINGLE RESULT" INDICATOR
	TLNE	W1,GNSERA	;[350] ON SIZE SPECIFIED?
	JRST	CEND1A		;[350] YES
	PUSHJ	PP,MACX.	;[350] GENERATE MOVE
	JRST	CEND1B		;[350] FINISH UP AND RETURN.

CEND1A:	PUSHJ	PP,GETTAG	;[350] GET A TAG NUMBER.
	MOVEM	CH,ESZERA	;[350] SAVE IT FOR "SPIF"
	PUSHJ	PP,SIZERA	;[350] GENERATE "SIZE ERROR" CODE
CEND1B:	SWOFF	FALWY0		;[350] TURN OFF ZERO INDICATOR
	POPJ	PP,		;[350] RETURN

;	NEGATE THE RESULT IN THE AC'S
;	ONLY NEGATE FINAL RESULT IF COMPUTE STATEMENT HAS
;	LEADING MINUS SIGN AND LEFT PAREN
CENDN:	MOVE	TC,NEGCMP	; [360] SEE IF WE SHOULD NEGATE THE FINAL OUTPUT.
	CAIGE	TC,2		; [360] YES IF CORRECT COUNT
	POPJ	PP,		; [360] DO DON'T DO IT.
	HRRZ	TC,EMODEA	; [320] GET MODE OF AC
	MOVSI	CH,MOVN.	; [320] ASSUME 1-WORD RESULT
	CAIE	TC,D2MODE	; [320] IS IT 2-WORD RESULT?
	CAIN	TC,F2MODE
	TRNA			;YES
	JRST	PUTASY		; [320] NO, PUT IN CODE AND RETURN
	PUSHJ	PP,PUTASA##
	MOVSI	CH,DMOVN.##
	JRST	PUTASY		; [320] PUT IN CODE AND RETURN

;"B" ISN'T NUMERIC. SEE IF IT IS NUMERIC EDITED.

CEND2:	TLNN	TB,GNOPNM
	JRST	NOTNUM		;IT ISN'T--TOUGH
	MOVE	TA,ETABLB	;IT IS--
	PUSHJ	PP,LNKSET	;  GET
	LDB	TE,DA.INS	;  INTERNAL SIZE
	MOVEM	TE,ESIZEB
	MOVEI	TE,EDMODE	;RESET MODE
	MOVEM	TE,EMODEB
	SWON	FBNUM;
	JRST	CEND0


;"A" ISN'T NUMERIC.  SEE IF IT IS "ZERO".

CEND3:	HRRZ	TE,EMODEA
	MOVE	TD,EFLAGA
	CAIN	TE,FCMODE
	CAIE	TD,ZERO
	JRST	NOTNUM

	JRST	INTOAC		;IT IS "ZERO"--SET AC'S TO ZERO

;GENERATE CODE FOR EXPRESSION

EXPRGN:	MOVEM	W1,OPLINE
	MOVEM	PP,SAVEPP	;SAVE PP IN CASE OF ERROR
	MOVE	EACA,EOPNXT
	MOVE	TE,EACA
	SUB	TE,EOPLOC
	MOVEM	TE,EXPBEG
	AOS	CURXSQ##	;INCREMENT THE NUMBER SEEN FOR FIPS FLAGGER
	PUSHJ	PP,EXPRGA	; [360] CHECK SEQUENCE OF TERMS AND EVALUATE EXPRESSION.

EXPRA:	MOVEI	TA,COMEBK
	SKIPN	RMFLAG##	;If handling Ref Mod, want to return to READEM
	PUSH	PP,TA
	MOVE	TA,EOPLOC
	ADD	TA,EXPBEG
	CAMN	TA,EOPNXT
	JRST	EXPR0

	HRRZ	TD,W2
	SKIPN	RMFLAG##
	CAIE	TD,OPYECC
	POPJ	PP,

	PUSHJ	PP,GOBAK2

;TROUBLE--PUT DUMMY DATAB OPERAND ON EOPTAB

EXPR0:	MOVE	EACA,TA
	MOVEM	EACA,EOPNXT
	MOVE	CH,OPLINE
	TLZ	CH,777774
	TLO	CH,(1B0)
	PUSHJ	PP,PUSEOP
	MOVE	CH,EOPNXT	;[1522]
	MOVEM	CH,CUREOP	;[1522]
	HRRZI	CH,100001
	PUSHJ	PP,PUSEOP
	MOVE	CH,[XWD 2,2]
	JRST	PUSEOP

; [360] CHECK TERM SEQUENCE IN AN EXPRESSION.

EXPRGA:	PUSHJ	PP,GETGEN	; [360] GET NEXT GENFIL INPUT
	SETZM	NEGCMP		; [360] RESET NEGATE SWITCH
	JUMPL	W1,EXPR1A	; [360] IT IS AN OPERAND, NO NEGATION
	CAIN	W2,OPCSUB	; [360] LEADING MINUS SIGN
	AOS	NEGCMP		; [360] YES, FINAL NEGATION POSSIBLE
	JRST	EXPR11		; [360] GO ON TO EVALUATE EXPRESSION
EXPR1:	PUSHJ	PP,GETGEN
	JUMPL	W1,EXPR1A
EXPR11:	HRRZ	TE,W2		; [360] GET OPERATOR CODE
	CAIN	TE,OPENDE
	POPJ	PP,

	PUSHJ	PP,NXTOPR
	JRST	EXPR1B

EXPR1A:	PUSHJ	PP,GTOPN1

EXPR1B:	PUSHJ	PP,GETOPR

EXPR2:	SWOFF	FEOFF1-FBIGCV-FALWY0;
	HRRZ	TE,W2
	CAIG	TE,OPCEXP	;IS IT ONE OF THE ALGEBRAIC OPERATORS?
	CAIGE	TE,OPCADD
	JRST	EXPR3		;NO

	PUSHJ	PP,@EXPR5-OPCADD(TE)	;YES--DISPATCH TO A ROUTINE
	JRST	EXPR2		;LOOP

EXPR3:	CAIN	TE,OPRPAR
	POPJ	PP,
	CAIN	TE,OPENDE
	JRST	EXPR4
	CAIN	TE,OPYECC
	JRST	EXPR4
	CAIE	TE,OPREFM
	JRST	CONFUZ
	MOVE	TA,RMFLAG##	;Has EXPRGN been called from READEM?
	TLZN	TA,400000	;Yes
	SETO	TA,		;No
	MOVEM	TA,RMFLAG	;Save flag
	PUSHJ	PP,REFMOD##	;
	MOVE	TA,RMFLAG	;Has EXPGRN been called from READEM?
	TLOE	TA,400000	;Yes
	SETZ	TA,		;No
	MOVEM	TA,RMFLAG	;Save flag
	JRST	EXPR1B

EXPR4:	SETZM	ERESDP
	POPJ	PP,

EXPR5:	EXP	CADD
	EXP	CSUB
	EXP	CMUL
	EXP	CDIV
	EXP	CEXP

;GENERATE CODE FOR A+B
CADD:	PUSHJ	PP,ADDSUB	;INSURE THAT WE CAN ADD NOW

	PUSHJ	PP,BOPRND	;GET "B" OPERAND
	  JRST	CADD4		;IT IS IN AC'S

	PUSHJ	PP,AOPRND	;GET "A" OPERAND
	  JRST	CADD3		;IT IS IN AC'S

	HRRZ	TE,EMODEA	;IS "A" A LITERAL?
	CAIE	TE,LTMODE
	JRST	CADD2		;NO
	HRRZ	TE,EMODEB	;IS "B" A LITERAL?
	CAIN	TE,LTMODE
	JRST	CADD2		;YES--NO SENSE IN SWAPPING
	PUSHJ	PP,SWAPAB	;NO--SWAP SO LITERAL IS "B"

CADD2:	PUSHJ	PP,INTOAC	;GET "A" INTO THE AC'S

CADD3:	MOVE	TE,OPERND
	MOVE	TE,1(TE)
	TLNE	TE,NEGEOP
	JRST	CSUB3A

CADD3A:	PUSHJ	PP,ADDX.	;GENERATE THE ADD
	JRST	SETAC		;SET OPERAND TO BE AC'S, AND RETURN

CADD4:	PUSHJ	PP,SWAPAB
CADD5:	PUSHJ	PP,BOPRN1	;GET OTHER OPERAND
	  JRST	CONFUZ		;IT CAN'T BE IN AC'S
	JRST 	CADD3

;GENERATE CODE FOR A-B
CSUB:	PUSHJ	PP,ADDSUB	;INSURE THAT WE CAN SUBTRACT NOW

	PUSHJ	PP,BOPRND	;GET "B" OPERAND
	  JRST	CSUB4		;IT IS IN AC'S

	PUSHJ	PP,AOPRND	;GET "A" OPERAND
	  JRST	CSUB3		;IT IS IN AC'S

	PUSHJ	PP,INTOAC	;GET "A" INTO AC'S

CSUB3:	MOVE	TE,OPERND
	MOVE	TE,1(TE)
	TLNE	TE,NEGEOP
	JRST	CADD3A

CSUB3A:	PUSHJ	PP,SUBX.
	JRST	SETAC

CSUB4:	PUSHJ	PP,SWAPAB

	HRRZ	TE,EMODEA	;NEGATE THE AC'S
	CAIE	TE,F2MODE	;[1352] CHECK FOR FLOATING POINT
	CAIN	TE,D2MODE
	JRST	CSUB5

	MOVSI	CH,MOVN.	;GENERATE <MOVN AC,AC>
	JRST	CSUB6

CSUB5:	PUSHJ	PP,PUTASA
	MOVSI	CH,DMOVN.

CSUB6:	HRR	CH,EAC
	DPB	CH,CHAC
	PUSHJ	PP,PUTASY
	JRST	CADD5

;GENERATE CODE FOR A*B

CMUL:	PUSHJ	PP,MULDIV	;INSURE THAT WE CAN MULTIPLY NOW

	PUSHJ	PP,BOPRND	;GET "B" OPERAND
	  JRST	CMUL5		;IT IS AC'S

	PUSHJ	PP,AOPRND	;GET "A" OPERAND
	  JRST	CMUL3		;IT IS AC'S

	HRRZ	TE,EMODEA
	CAIE	TE,FCMODE
	CAIN	TE,LTMODE
	PUSHJ	PP,SWAPAB

CMUL2:	PUSHJ	PP,INTOAC	;GET OPERAND INTO AC'S

CMUL3:	PUSHJ	PP,MULX.	;GENERATE THE MULTIPLY

CMUL4:	PUSHJ	PP,SETAC	;SET OPERAND TO BE AC'S
	HRRZ	TE,W2		;IS NEXT OPERATOR ANOTHER "*"?
	CAIN	TE,OPCMUL
	JRST	CMUL		;YES--LOOP
	CAIN	TE,OPCDIV	;NO--IS IT "/"?
	JRST	CDIV		;YES

	POPJ	PP,		;NO--RETURN

CMUL5:	MOVE	TE,[XWD EBASEB,EBASEA] ;MOVE "B" TO "A"
	BLT	TE,EBASAX
	MOVSS	OPERND
	PUSHJ	PP,BOPRN1	;GET OTHER OPERAND
	 JRST	CONFUZ		;IT CAN'T BE IN AC'S

	JRST	CMUL3

;GENERATE CODE FOR A/B

CDIV:	PUSHJ	PP,MULDIV

	PUSHJ	PP,BOPRND	;GET "B" OPERAND
	  JRST	CDIV5		;IT'S IN AC'S

	PUSHJ	PP,AOPRND	;GET "A" OPERAND
	  JRST	CDIV4		;[1402] SEE IF "A" IS FLOATING POINT

CDIV2:	SETOM	FLTDIV		;FORCE FLOATING POINT ON DIVIDE
	PUSHJ	PP,INTOAC	;GET "A" INTO AC'S
REPEAT 0,<
	MOVE	TE,ESIZEA
	CAIL	TE,^D18		;MAX. SIZE
	JRST	CDIV3		;YES, CAN NOT DO ANY BETTER
	MOVE	TE,[EBASEB,,ESAVEB##]
	BLT	TE,ESAVBX##	;SAVE CURRENT "B"
	MOVE	TE,[EBASEA,,EBASEB]
	BLT	TE,EBASBX	;COPY  "A" TO "B"
	MOVEI	TE,D2MODE
	MOVEM	TE,EMODEB	;SET MODE TO 2-WORDS
	MOVEI	TE,^D18
	MOVEM	TE,ESIZEB	;MAKE "B" MAX. SIZE
	SUB	TE,ESIZEA
	ADDM	TE,EDPLB	;ADD EXTRA AS DECIMAL PLACES
	PUSHJ	PP,ADJDP.##	;ADJUST ACCS
	MOVE	TE,[EBASEB,,EBASEA]
	BLT	TE,EBASAX	;NEW "A"
	MOVE	TE,[ESAVEB,,EBASEB]
	BLT	TE,EBASBX	;RESTORE "B"
>
CDIV3:	PUSHJ	PP,DIVX.
	SETZM	FLTDIV		;[1402]
	JRST	CMUL4

CDIV4:	MOVE	TE,EMODEA	;[1402] GET MODE OF OPERAND IN AC'S
	CAIN	TE,F2MODE	;[1402] IF FIELD IN AC'S IS ALREADY FLOATING POINT,
	JRST	CDIV3		;[1402] GENERATE THE DIVIDE
	HRRZ	TA,EBYTEB	;[1402] ELSE, FIRST MAKE B OP'S
	HRRZ	TB,VALLOC	;[1402]  BYTE POINTER RELATIVE
	SUB	TA,TB		;[1402]  (IF IT IS A BYTE POINTER)
	SKIPL	TA		;[1402] IN CASE OF TABLE
	HRRM	TA,EBYTEB	;[1402]  EXPANSION
	PUSHJ	PP,CCXF2.	;[1402] CONVERT FIELD IN AC'S TO FP
	HRRZ	TA,VALLOC	;[1402] MAKE B OP'S POINTER
	HRRZ	TB,EBYTEB	;[1402]  ABSOLUTE AGAIN
	SKIPE	TB		;[1402]
	ADDM	TA,EBYTEB	;[1402]
	JRST	CDIV3		;[1402] GENERATE DIVIDE CODE

CDIV5:	HRRZ	TE,EMODEB	;ARE AC'S 2-WORD COMP
	CAIE	TE,D2MODE
	CAIN	TE,F2MODE	;[1461]
	JRST	CDIV7		;YES

	MOVEI	TE,1		;NO--GET A 1-WORD TEMP
	PUSHJ	PP,GETEMP
CDIV6:	MOVE	CH,[XWD MOVEM.+ASINC,AS.MSC]
CDIV8:	PUSHJ	PP,PUT.XA
	IORI	EACC,AS.TMP
	HRRZ	CH,EACC
	PUSHJ	PP,PUTASN

	MOVEM	EACC,EINCRB
	MOVEI	TE,AS.MSC
	MOVEM	TE,EBASEB
	PUSHJ	PP,AOPRND
	  JRST	CONFUZ

	MOVEI	TE,1(EACA)
	HRLM	TE,OPERND
	JRST	CDIV2

CDIV7:	MOVEI	TE,2
	PUSHJ	PP,GETEMP
	PUSHJ	PP,PUTASA
	MOVE	CH,[DMOVM.##+ASINC,,AS.MSC]
	JRST	CDIV8

;EXPONENTIATE.

CEXP:	MOVE	CH,W1		;SAVE
	PUSHJ	PP,PUSEOP	;  OPERATOR
	PUSHJ	PP,GETOPN	;GET NEXT OPERAND

	PUSHJ	PP,BOPRND	;GET "B" OPERAND
	  JRST	CEXP5

CEXP1A:	PUSHJ	PP,AOPRND	;GET "A" OPERAND
	  JRST	CEXP2

	PUSHJ	PP,INTOAC	;PUT IT INTO AC'S

CEXP2:	PUSHJ	PP,EXPX.
	PUSHJ	PP,SETAC

	PUSHJ	PP,GETOPR

	HRRZ	TE,W2
	CAIN	TE,OPCEXP
	JRST	CEXP
	POPJ	PP,

CEXP5:	HRRZ	TE,EMODEA
	CAIN	TE,D4MODE	;IF "A" IS 4-WORDS
	PUSHJ	PP,CNVAF2##	;CONVERT TO COMP-2

	MOVEI	TE,1
	HRRZ	TD,EMODEA
	CAIE	TD,D2MODE
	CAIN	TD,F2MODE
	MOVEI	TE,2
	PUSHJ	PP,GETEMP

	HRRZM	EACC,EINCRA
	MOVEI	TD,AS.MSC
	MOVEM	TD,EBASEA
	MOVE	TE,[XWD EBASEA,EBASEB]
	BLT	TE,EBASBX
	PUSHJ	PP,MACX.
	MOVE	TE,[XWD EBASEA,EBASEB]
	BLT	TE,EBASBX
	JRST	CEXP1A

;LOOK AHEAD TO SEE IF WE CAN ADD OR SUBTRACT.
;IF WE CANNOT, FIX IT SUCH THAT WE CAN.

ADDSUB:	PUSHJ	PP,ADSB6	;GET OPERAND & OPERATOR
	CAIN	TE,OPCEXP	;EXPONENTIATION?
	JRST	ADSB3		;YES
ADSB2:	CAIN	TE,OPCMUL	;MULTIPLICATION?
	JRST	ADSB4		;YES
	CAIN	TE,OPCDIV	;DIVISION?
	JRST	ADSB5		;YES

	POPJ	PP,		;NO--RETURN

;NEXT OPERATOR IS "**"
ADSB3:	PUSHJ	PP,STASH	;STASH CURRENT AC'S
	PUSHJ	PP,CEXP		;GENERATE EXPONENTIATION CALLS
	HRRZ	TE,W2		;GO BACK TO CHECK FOR
	JRST	ADSB2		;	MULTIPLY AND DIVIDE

;NEXT OPERATOR IS "*"
ADSB4:	PUSHJ	PP,STASH	;STASH CURRENT AC'S
	JRST	CMUL		;GENERATE MULTIPLY AND RETURN

;NEXT OPERATOR IS "/"
ADSB5:	PUSHJ	PP,STASH	;STASH CURRENT AC'S
	JRST	CDIV		;GENERATE DIVIDE AND RETURN


;GET NEXT OPERAND AND OPERATOR

ADSB6:	MOVE	CH,W1		;SAVE
	PUSHJ	PP,PUSEOP	;  THIS OPERATOR
	PUSHJ	PP,GETOPN	;GET OPERAND
	PUSHJ	PP,GETOPR	;GET OPERATOR
	HRRZ	TE,W2		;EXTRACT OPERATOR CODE
	POPJ	PP,

;LOOK AHEAD TO SEE IF WE CAN MULTIPLY OR DIVIDE NOW.
;IF WE CANNOT, FIX IT SO THAT WE CAN.

MULDIV:	PUSHJ	PP,ADSB6	;GET OPERAND AND OPERATOR
	CAIE	TE,OPCEXP	;IS IT EXPONENTIATION?
	POPJ	PP,		;NO--RETURN

	PUSHJ	PP,STASH	;YES--SAVE CURRENT AC'S
	JRST	CEXP		;EXPONENTIATE, THEN RETURN

;GENERATE CODE TO GET "A" INTO THE AC'S

INTOAC:	CAMN	EACA,EOPLOC	;ANYTHING IN EOPTAB?
	JRST	INTOA0		;NO
	MOVE	TD,[XWD EBASEB,ESAVER]	;YES--IF AC'S, STASH
	BLT	TD,ESAVRX
	MOVEI	TD,-2(EACA)
	PUSHJ	PP,STASHA
	MOVE	TD,[XWD ESAVER,EBASEB]
	BLT	TD,EBASBX

;"A" IS GOING INTO THE ACS. "B" OPERAND IS SETUP IN EBASEB, ETC.
; PROTECT "B" AGAINST EXPANDING TABLES BY ADJUSTING "EBYTEB" TO
; BE A RELATIVE ITEM.
INTOA0:	HRRZ	TA,EBYTEB
	HRRZ	TB,VALLOC##	;GET RELATIVE VALTAB OFFSET
	SUB	TA,TB
	HRRM	TA,EBYTEB	;INCASE TABLES EXPAND
	PUSH	PP,[INTOA4]	;RETURN HERE WHEN MOVGEN POPJ'S
	SETZM	EAC		;CLEAR RESULT AC
	HRRZ	TE,EMODEA
	CAIN	TE,FCMODE
	JRST	INTOA2

INTOA1:	MOVS	TA,OPERND
	MOVE	TA,1(TA)
	SKIPE	FLTDIV##	;[637] IS RESULT FLOATING?
	 JRST	INTOF1		;[637] YES, FLOAT "A"
	TLNE	TA,NEGEOP
	JRST	MNXAC.
	JRST	MXAC.

;[637] "FLTDIV" HAS BEEN SET TO -1 BY "COMPGN". THIS HAPPENS WHEN
;[637] THE COBOL STATEMENT IS "COMPUTE COMP-1 = EXPRESSION"
;[637] OR A DIVIDE OPARAND HAS BEEN SEEN IN EXPRESSION.
;[637] THE FIRST OPERAND IS BROUGHT INTO THE ACS AS COMP-1 OR COMP-2,
;[637] THUS FORCING COBOL TO EVALUATE THE EXPRESSION
;[637] ENTIRELY WITH FLOATING-POINT OPERATIONS

INTOF1:	HRRZ	TE,EMODEA	;[777] IS "A" A LITERAL?
	CAIN	TE,LTMODE	;[777]
	 JRST	INTOF2		;[777] YES, THESE MOVGEN ROUTINES
				;[777] ARE NOT SMART ENOUGH TO HANDLE
				;[777] LITERALS CORRECTLY -- (FIXED IN V13)
	TLNN	TA,NEGEOP	;[637] NEGATE "A" ALSO?
	JRST	MXF2A.##	;[637] NO, JUST FLOAT IT
	PUSHJ	PP,MNXAC.	;[637] YES, GET -A IN ACS
	JRST	CCXF2.##	;[637] AND FLOAT IT

;[777] LITERAL SPECIAL CASE
;[777] THIS STUFF IS NECESSARY BECAUSE THE MOVGEN ROUTINES
;[777] DO NOT ALWAYS KEEP TRACK OF WHERE THE DATA ITEM IS!
INTOF2:	PUSH	PP,EMODEB	;[777] SAVE CURRENT MODE OF B
	MOVEI	TE,F2MODE##	;[777] WANT 2 WORD F.P. ANSWER IN AC
	MOVEM	TE,EMODEB	;[777] FAKE OUT MOVGEN
	TLNE	TA,NEGEOP	;[777] SKIP IF NOT A NEGATIVE OPERAND
	 JRST	INTOF4		;[777] TELL MOVGEN TO NEGATE IT
	PUSHJ	PP,MXAC.	;[777] MOVE LITERAL TO AC, CONVERTING TO FP
INTOF3:	POP	PP,EMODEB	;[777] PUT BACK ORIGINAL "EMODEB"
	POPJ	PP,		;[777] RETURN
INTOF4:	PUSHJ	PP,MNXAC.	;[777] MOVE NEG. LITERAL TO AC, CONVERTING TO FP
	JRST	INTOF3		;[777]

INTOA2:	HRRZ	TD,EMODEB
	CAIE	TD,FCMODE
	CAIN	TD,LTMODE
	MOVEI	TD,D1MODE

	CAILE	TE,DSMODE	;IS IT DISPLAY OR
	CAIN	TD,C3MODE##	; OR COMP-3.
	SKIPA	TE,ESIZEB	;YES, CHANGE THE MODE.
	JRST	INTOA3
	MOVEI	TD,D1MODE
	CAILE	TE,^D10
	MOVEI	TD,D2MODE

INTOA3:	SWON	FALWY0		;SET "AC'S CONTAIN ZERO"
	POPJ	PP,

;RETURN HERE TO FIX EBYTEB
INTOA4:	HRRZ	TA,VALLOC
	ADDM	TA,EBYTEB	;NOW IT'S AN ABSOLUTE BP AGAIN
	POPJ	PP,		;RETURN FROM "INTOAC"

;GET "B" OPERAND FROM EOPTAB

BOPRND:	MOVEI	LN,EBASEB
	PUSHJ	PP,LASTOP
	  AOS	(PP)

	POP	EACA,EOPHLD
	MOVEM	EACA,EOPNXT

	MOVEI	TE,EOPHLD
	MOVEM	TE,CUREOP

BOPA:	HRRM	TC,OPERND

	TSWF	FBNUM		;IS "B" NUMERIC?
	POPJ	PP,		;YES

	HRRZ	TE,EMODEB	;NO--IT BEST BE "ZERO"
	MOVE	TD,EFLAGB

BOPB:	CAIN	TE,FCMODE	;IS IT A FIG. CONST.?
	CAIE	TD,ZERO		;YES--ZERO?
	JRST	NOTNMA		;NO--YOU LOSE
	POPJ	PP,



;GET "B" OPERAND AS SECOND OPERAND

BOPRN1:	MOVEI	LN,EBASEB
	PUSHJ	PP,LASTOP
	  AOS	(PP)
	JRST	BOPA


;GET "A" OPERAND FROM EOPTAB

AOPRND:	MOVEI	LN,EBASEA
AOPRN1:	PUSHJ	PP,LASTOP
	  AOS	(PP)

	HRLM	TC,OPERND
	TSWF	FANUM		;IS "A" NUMERIC?

	POPJ	PP,

	HRRZ	TE,EMODEA
	MOVE	TD,EFLAGA
	JRST	BOPB

;GET THE LAST OPERAND FROM EOPTAB

LASTOP:	MOVE	EACA,EOPNXT
	POP	EACA,TC		;GET DECREMENT COUNT
	SUB	EACA,TC		;BACK UP EOPTAB POINTER

	MOVS	TE,1(EACA)	;[641] IS IT THE AC'S?
	CAIN	TE,GNOPNM	;[641] TEST FOR OPERAND SET AT SETAC
	AOS	(PP)		;YES--RETURN TO CALL+2

	MOVEI	TC,1(EACA)
	MOVEM	EACA,EOPNXT
	PUSHJ	PP,SETOPN
	MOVE	EACA,EOPNXT
	MOVE	TB,EBASEX(LN)	; [321] GETOPERAND LOCATION
	CAIE	TB,<CD.DAT>B20+1	; [321] IF DUMMY QUIT NOW
	POPJ	PP,		; [321] OKAY- RETURN
	JRST	GOHOME		; [321] ABANDON EXPRESSION CODE GENERATION

;SET "LAST OPERAND IS AC".

SETAC:	MOVSI	CH,GNOPNM	;STASH FIRST PART OF
	PUSHJ	PP,PUSEOP	;  OPERAND
	MOVSI	TD,GNOPNM
	MOVE	TE,EMODEA
	DPB	TE,ACMODE
	MOVE	TE,ESIZEA
	DPB	TE,ACSIZE
	HRR	TD,EDPLA
	TLO	TD,GNNOTD
	MOVE	CH,TD		;STASH SECOND PART OF
	PUSHJ	PP,PUSEOP	;  OPERAND
	MOVE	CH,[XWD 2,2]	;STASH
	JRST	PUSEOP		;  COUNT WORD AND RETURN

;IF ANYTHING IN AC'S--SAVE IT IN A TEMP

;LAST THING IN EOPTAB IS AN OPERAND.

STASH:	MOVE	TD,EOPNXT
	SUB	TD,(TD)
	MOVEI	TD,-4(TD)

STASHA:	MOVE	TE,1(TD)
	HRRZ	TC,0(TD)
	TLNE	TE,GNNOTD
	CAILE	TC,17
	POPJ	PP,

	MOVE	TE,[XWD EBASEA,ESAVEA]	;SAVE CURRENT "A"
	BLT	TE,ESAVAX
	MOVE	TC,TD
	MOVE	TD,1(TD)
	HRRE	TE,TD
	MOVEM	TE,EDPLA
	LDB	TE,ACMODE
	MOVEM	TE,EMODEA
	LDB	TE,ACSIZE
	MOVEM	TE,ESIZEA

	PUSH	PP,SW		;SAVE CURRENT SWITCHES
	SWON	FASIGN!FANUM!FBSIGN!FBNUM;
	SWOFF	FASUB!FBSUB;

	MOVEI	TE,1
	HRRZ	TD,EMODEA
	CAIE	TD,D2MODE
	CAIN	TD,F2MODE	;[1430] IS IT DP FLOATING POINT?
	MOVEI	TE,2		;[1430] YES
	CAIN	TD,D4MODE
	MOVEI	TE,4
	PUSHJ	PP,GETEMP
	HRRM	EACC,0(TC)

	MOVE	TE,[XWD EBASEA+1,EBASEB+1]
	BLT	TE,EBASBX
	HRRZM	EACC,EINCRB
	HRRZI	TE,AS.MSC
	MOVEM	TE,EBASEB

	PUSHJ	PP,MACX.

	MOVE	TE,[XWD ESAVEA,EBASEA]	;RESTORE "A"
	BLT	TE,EBASAX
	POP	PP,SW		;RESTORE SWITCHES
	TRZ	FALWY0		;[1456] 'ZERO' NO LONGER IN ACCUMULATOR
	SETZM	EAC
	POPJ	PP,

;SAVE ANYTHING IN AC'S (CONT'D).

;LAST THING IN EOPTAB IS OPERATOR, COUNT WORD, OR NOTHING

STASHB:	MOVE	EACA,EOPNXT
	CAMN	EACA,EOPLOC	;ANYTHING IN EOPTAB?
	POPJ	PP,		;NO--NOTHING TO STASH

	MOVE	TD,(EACA)	;IS LAST THING AN OPERATOR?
	TLNN	TD,777000
	POPJ	PP,		;NO--FORGET IT

	MOVEI	TD,-1(EACA)
	SUB	TD,0(TD)
	JRST	STASHA

;GET NEXT OPERAND.

GETOPN:	PUSHJ	PP,GETGEN
	JUMPGE	W1,NXTOPR	;IT IS AN OPERATOR

GTOPN1:	PUSHJ	PP,PUSH12	;STASH W1&W2 IN EOPTAB
	MOVEI	TE,-1(EACA)	;SAVE
	MOVEM	TE,CUREOP	;  THAT ENTRY LOCATION

	TLNE	W2,GNROUN	;[456] IS IT ROUNDED?
	PUSHJ	PP,ROUNER	;[456] YES, ERROR
	TLNE	W1,GNLIT
	TDCA	TE,TE
	LDB	TE,W2SUBC
	MOVE	TD,TE
	JUMPE	TE,GTOPN3

GTOPN2:	PUSHJ	PP,GETGEN
	PUSHJ	PP,PUSH12	;STASH W1&W2
	SOJG	TE,GTOPN2

	MOVE	TA,CUREOP
	MOVE	W1,0(TA)
	MOVE	W2,1(TA)

GTOPN3:	TXNN	W1,GNREFM	;Is operand ref. modded?
	JRST	GTOPN4		;No
	TLNN	W1,GNFIGC	;[1522] Make sure it's not FC of low-values
	JRST	GTOPN5		;[1522] It's not

GTOPN4:	LSH	TD,1
	ADDI	TD,2
	HRLS	TD
	MOVE	CH,TD		;STASH COUNT WORD
	JRST	PUSEOP		;  AND RETURN

GTOPN5:	PUSHJ	PP,GETGEN	;read next opcode
	HRRZ	TA,W2		;
	CAIE	TA,OPEXP	;should be expression start
	JRST	CONFUZ		;no, error
GTOPN6:	SETOM	RMFLAG##	;turn on ref mod flag
	PUSH	PP,EXPBEG	;save counter
	PUSHJ	PP,EXPRGN	;evaluate offset/length expression
	POP	PP,EXPBEG	;restore counter
	PUSHJ	PP,GETGEN	;get next opcode
	HRRZ	TA,W2		;
	CAIE	TA,OPREFM	;should be ref mod
	JRST	GTOPN7		;error - try to clean up EOP stack
	PUSHJ	PP,REFMOD##	;build operand words for offset, length
	TSWF	FERROR		;[1522] Error set in REFMOD?
	JRST	GTOPN7		;[1522] Yes, get rid of modifiers
	SETZM	RMFLAG##	;
	TXNE	W1,RFMLEN	;[1522] have we done the length?
	POPJ	PP,		;yes, exit
	MOVE	TA,CUREOP	;get start of operand
	MOVE	TE,1(TA)	;
	LDB	TD,TESUBC	;restore subscript count in TD
	JRST	GTOPN4		;do length now

GTOPN7:	MOVE	TA,EOPNXT	;
	TXNE	W1,RFMLEN	;[1522] Was error on length?
	POPJ	PP,		;[1522] Yes, default to rest of field
GTOPN8:	POP	TA,TB		;[1522] continue through rest of EOP stack
	JUMPGE	TB,GTOPN8	; searching for operands until finding the one
	TXNN	TB,GNREFM	; that has been reference modified
	JRST	GTOPN8		;
	TLNE	TB,GNFIGC	;is it FC of low-values?
	JRST	GTOPN8		;yes
	TXZ	TB,GNREFM	;no
	PUSH	TA,TB		;[1522] put it back w/ ref mod flag off
	MOVE	TE,1(TA)	;get second word of the operand
	LDB	TB,TESUBC	;
	MOVE	TD,TB		;
	AOBJP	TA,KILL##	;[1522]
	LSH	TB,1		;[1522]
	HRLS	TB		;[1522]
	ADD	TA,TB		;
	MOVEM	TA,EOPNXT	;
	TSWTZ	FERROR		;[1522] If on, error reported
	PUSHJ	PP,CONFUZ	;
	SETZM	RMFLAG		;zero flag
	JRST	GTOPN4		;build [size,,size word


;GET NEXT OPERATOR

GETOPR:	PUSHJ	PP,GETGEN
	JUMPL	W1,CONFUZ
	HRRZ	TE,W2
	CAIN	TE,OPYECC
	JRST	GOHOME		;
	CAIE	TE,OPEXP	;if found EXPRGN op code,
	POPJ	PP,
	PUSHJ	PP,GTOPN6	; field is reference modified, do that first
	JRST	GETOPR		;

;NEXT OPERATOR WAS YECCH--GO AWAY

GOHOME:	MOVE	PP,SAVEPP
	PUSHJ	PP,GOBAK3	; [370] GET READY TO RETURN
	MOVE	TA,EXPBEG
	ADD	TA,EOPLOC
	MOVEM	TA,EOPNXT
	JRST	EXPRA

;WE WENT LOOKING FOR AN OPERAND, BUT FOUND AN OPERATOR.

NXTOPR:	HRRZ	TE,W2		;LEFT PAREN?
	CAIE	TE,OPLPAR
	JRST	NXTOP1		;NO

	PUSHJ	PP,STASHB	;YES--STASH AC'S
	SKIPLE	NEGCMP		; [360] IF > 0 MEANS WE HAD A LEADING SIGN.
	AOS	NEGCMP		; [360] LEADING MINUS SIGN - COUNT LEFT PAREN
	JRST	EXPR1		;EVALUATE EXPRESSION AND RETURN

NXTOP1:	CAIE	TE,OPCSUB	;WAS IT A UNARY MINUS?
	JRST	NXTOP3		;NO--WE'RE CONFUSED

	PUSH	PP,EACA
	PUSHJ	PP,GETOPN	;YES--GET NEXT OPERAND
	POP	PP,TD

	MOVSI	TE,NEGEOP	;SET "NEGATE OPERAND"
	XORM	TE,2(TD)
	POPJ	PP,


NXTOP3:	CAIE	TE,OPYECC
	JRST	CONFUZ
	JRST	GOHOME

;ERROR ROUTINES

;OPERAND WAS NOT NUMERIC  (INSIDE EXPRESSION)

NOTNMA:	MOVEI	DW,E.211
	SWON	FERROR;
	MOVE	TC,(TC)
	LDB	CP,TCCP
	LDB	LN,TCLN
	JRST	FATAL

;WRONG NUMBER OF OPERANDS  (INSIDE EXPRESSION)

BADOPA:	MOVEI	DW,E.214
	JRST	W1ERA



CONFUZ:	MOVE	TC,CUREOP
	MOVE	TC,(TC)
	LDB	LN,TCLN
	LDB	CP,TCCP
	MOVEI	DW,E.216
	JRST	GOBACK

;[456] USER HAS TRIED TO ROUND IN WRONG PLACE, WARN HIM
ROUNER:	MOVEI	DW,E.591		;[456] GET DIAGNOSTIC
	PUSH	PP,TE			;[456] SAVE
	PUSH	PP,LN			;[456]   SOME
	PUSH	PP,TC			;[456]     REGISTERS
	PUSHJ	PP,OPNWRN		;[456] GIVE WARNING
	POP	PP,TC			;[456]     GET
	POP	PP,LN			;[456]   REGISTERS
	POP	PP,TE			;[456] BACK
	POPJ	PP,			;[456] AND CONTINUE

NEGEOP==1B<^D18+6>

EXTERNAL TCLN,TCCP,W1LN,W1CP,W2SUBC,EAC,SAVEPP
EXTERNAL EBASEA,EINCRA,ERESA,EDPLA,ESIZEA,EMODEA,EFLAGA,EBYTEA
EXTERNAL EBASEB,EINCRB,ERESB,EDPLB,ESIZEB,EMODEB,EFLAGB,EBYTEB,ETABLB
EXTERNAL EBASEX,EINCRX,ERESX,EDPLX,ESIZEX,EMODEX,EFLAGX,EBYTEX
EXTERNAL ESAVEA,ESAVEB,EBASAX,EBASBX,ESAVAX,ESAVBX
EXTERNAL ESAVER,ESAVRX

EXTERNAL EOPLOC,EOPNXT,CUREOP,OPLINE,OPERND,EXPBEG

EXTERNAL DA.NDP,DA.DPR,DA.INS
EXTERNAL LNKCOD,TB.DAT



EXTERNAL D1MODE,D2MODE,D4MODE,D6MODE,D7MODE,EDMODE,LTMODE,FCMODE,DSMODE,ZERO
EXTERN	FPMODE,F2MODE
EXTERNAL ACMODE,ACSIZE,TESUBC
EXTERNAL OVFLO.
EXTERNAL MOVN.,MOVEM.,JRST.,CAML.
EXTERNAL SKIPL.,SKIPA.,SETZM.,SETZB.,HRRZI.

EXTERNAL CHAC,ESAVAC,ESZERA,POWR10,ELITPC,EOPHLD,ERESDP
EXTERNAL AS.MSC,AS.TMP,D1LIT,D2LIT,AS.DOT,AS.%X,EMULSZ
EXTERNAL EBASEX	; [321]


	END