Google
 

Trailing-Edge - PDP-10 Archives - BB-H506E-SM - cobol/source/matgen.mac
There are 14 other files named matgen.mac in the archive. Click here to see a list.
; UPD ID= 3447 on 3/10/81 at 10:47 AM by NIXON                          
TITLE	MATGEN FOR COBOL V12C
SUBTTL	MATHEMATICAL 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
	%%P==:%%P

;EDITS
;NAME	DATE		COMMENTS

;JEH	09-JUN-83	[1472] fix DIVIDE literal INTO DN1, DN2, etc.
;DMN	 9-Jan-81	[1113] COMP-1 to COMP-2 conversion not done correctly.
;JEH	22-AUG-80	[1047] CORRECT DIVIDE INTO CODE
;DMN	 7-FEB-80	[767] CHECK OVERFLOW FLAGS FOR "ON SIZE ERROR".
;DAW	13-SEP-79	[732] FIX "SET" GENERATING BAD CODE SOMETIMES IN COBOL-74

;V12 RELEASED
;CLRH	 5-JUN-79	[715] CORRECT EDIT 566
;DAW	29-MAR-79	[672] FIX ILL MEM REF FOR REFERENCES TO TALLY
;MFY	 8-NOV-78	[601] CORRECT EDIT 546
;DMN	 5-OCT-78	[566] FLOAT OPERANDS WHEN TARGET IS COMP-1
;EHM	16-SEP-78	[546] FIX MULTIPLY -1 BY X GENERATES A SETZM
;EHM	15-SEP-78	[545] FIX STATEMENT AFTER SUBTRACT 1 IS COMPILED WRONG
;EHM	14-APR-78	[534] FIX COMPUTE GETS ANSWER FROM WRONG AC

;V12 RELEASE
; VR	 1-JUN-77	[500] FIX "SET X(1)  X(2) UP" TO STOP LOOPING
; EHM	11-APR-77	[466] FIX COMPUTE FLOATING DIVIDES WHEN ANSWER ROUNDED.

;V11 RELEASE
;	 6-APR-76	[417] MAKE SURE THAT RESTYP IS DEFINED
;	26-JAN-76	[377] FIX MULTIPLE ITEMS IN A GIVING CLAUSE
;ACK	28-MAY-75	COMP-3/EBCDIC CODE.

;VERSION 10 RELEASE
; EDIT 350 TURN OFF ZERO INDICATOR AFTER "SET TO"
; EDIT 325 RECOVER IF GIVING ITEM IN A DIVIDE STATEMENT UNDEFINED
; EDIT 317 FIX GIVING X,Y... FOR ANY X,Y BEING EDITED FIELD
; EDIT 250 ALLOW TALLY TO BE RESULTING OPERAND FOR ARITH AND SET.
; EDIT 112 FIXES SET ITEM<SUBCRIPTED> UP BY N.
TWOSEG
	.COPYRIGHT		;Put COPYRIGHT statement in .REL file.

SALL
RELOC	400000

ENTRY ADDGEN		;ADD OPERATOR
ENTRY ADDTGN		;ADDTO OPERATOR
ENTRY SUBGEN		;SUB OPERATOR
ENTRY SUBFGN		;SUBFRM OPERATOR
ENTRY MULGEN		;MUL OPERATOR
ENTRY MULBGN		;MULBY OPERATOR
ENTRY DIVGEN		;DIV OPERATOR
ENTRY DIVBGN		;DIVBY OPERATOR
ENTRY REMGEN		;REMAIN OPERATOR
ENTRY RESGEN		;RESULT OPERATOR
ENTRY SETTGN		;SETTO OPERATOR
ENTRY SETDGN		;SETDN OPERATOR
ENTRY SETUGN		;SETUP OPERATOR

INTERNAL ADDX.		;ADD SOMETHING TO THE AC'S
INTERNAL SUBX.		;SUBTRACT SOMETHING FROM THE AC'S
INTERNAL MULX.		;MULTIPLY AC'S BY SOMETHING
INTERNAL DIVX.		;DIVIDE AC'S BY SOMETHING
INTERNAL EXPX.		;EXPONENTIATE AC'S BY SOMETHING
INTERNAL SWAPEM		;SWAP OPERANDS AND CURRENT "EAC"

EXTERNAL READEM,PUTASY,PUTASN,PUTASA,OPFAT,OPNFAT,NOTNUM,NOTDAT,SWAPAB,ADJSL.
EXTERNAL CC1C2.,MXAC.,MACX.,MNXAC.,FORCX0,ADJDP.,CONVNL,NEGATL
EXTERNAL BMPEOP,BADEOP,GETTAG,ROUND,SIZERA,KILL,XPNRES,XPNEOP,LNKSET,GETEMP
EXTERNAL SUBSCB,SETOPA,SETOPB,SETOPN,MSFP%L,MSF2%L,MXFPA.,MXF2A.,CCXFP.,CCXF2.
EXTERNAL PUT.A,PUT.AA,PUT.B,PUT.BA,PUT.L,PUT.LA,PUT.LB,PUT.P,PUT.PA
EXTERNAL PUT.PC,PUT.LC,PUT.LD,PUT.XA,PUT.XB,PUT.EX,PUT.PJ
EXTERN   STASHP,STASHQ,POOLIT,PLITPC,CPOPJ1,CPOPJ
;"ADD" GENERATOR

ADDGEN:	PUSHJ	PP,GRABOP	;GET FIRST OPERAND INTO AC'S
IFN ANS74,<
	PUSHJ	PP,CDEBA##	;COPY ANY DEBUGGING INFO
>
	PUSHJ	PP,INIT9	;GET INITIAL MAX INTO ADDTMP
	SKIPGE	TE,RESTYP	;ANY ERRORS?
	POPJ	PP,		;YES
	CAIL	TE,3		;[546] TEST FOR AOS OR SOS
	PUSHJ	PP,SETA21	;YES, CHANGE TO MOVEI 0,1
ADDG0:	PUSHJ	PP,BMPEOP	;NO--BUMP UP TO NEXT OPERAND
	  POPJ	PP,		;NO MORE OPERANDS

ADDG1:	MOVE	TC,CUREOP	;SET UP "B" OPERAND
	HRRM	TC,OPERND
IFN ANS74,<
	SETOM	EDEBDB##	;MIGHT WANT TO DEBUG IN RESULT
	SOS	EDEBDB		;BUT ONLY IF "ARO" ON
>
	PUSHJ	PP,SETOPB

	PUSHJ	PP,OPBCHK	;CK 2ND OPERAND FOR ELEMENTARY NUMERIC

	PUSHJ	PP,NEXT9	;SEE IF WE NEED TO GO TO D.P.
	PUSHJ	PP,ADDX.	;ADD IT TO AC'S
IFN ANS74,<
	PUSHJ	PP,CDEBB##	;COPY ANY DEBUGGING INFO
>
	JRST	ADDG0		;LOOK FOR ANOTHER OPERAND

;"ADDTO" GENERATOR

ADDTGN:	PUSHJ	PP,GRABOP	;GET FIRST OPERAND INTO AC'S
IFN ANS74,<
	PUSHJ	PP,CDEBA##	;COPY ANY DEBUGGING INFO
>
	PUSHJ	PP,INIT9	;GET INITIAL MAX INTO ADDTMP
	SKIPGE	TE,RESTYP	;ANY GOOD OPERANDS FOUND?
	POPJ	PP,		;NO--FORGET IT

	JUMPN	TE,ADDG2	;IF AOS OR SOS, MUST CHECK FOR MORE FIRST
	MOVEI	TE,1		;YES--SET RESULT TYPE TO 1
	MOVEM	TE,RESTYP
	JRST	ADDG0

ADDG2:	PUSHJ	PP,BMPEOP	;SEE  IF MORE
	  POPJ	PP,		;NO
	PUSHJ	PP,SETA21	;YES, SET A TO 1
	AOS	RESTYP		;[546] RESET TO 1
	JRST	ADDG1		;AND ADD NEW OPERAND TO IT

SETA21:	SWOFF	FALWY0		;WILL NOT BE ZERO SOON
	MOVE	CH,RESTYP
	MOVEI	TC,1
	CAIE	CH,3
	MOVN	TC,TC
	MOVSI	CH,MOV
	SETZM	RESTYP		;[546] RESET TO MOVEM
	JRST	PUT.LA
;"SUB" GENERATOR

SUBGEN:	SETZM	OVFLFL		;CANNOT CAUSE OVERFLOW
	SETOM	RESTYP
	SETZM	FLTDIV		;[566] CLEAR INCASE LEFT ON BY PREV. DIVIDE
	MOVEM	W1,OPLINE
	SWOFF	FEOFF1		;TURN OFF MOST FLAGS
	HRRZ	TC,EOPLOC	;SET "TC" TO FIRST OPERAND
	ADDI	TC,1
	MOVE	EACA,EOPNXT
	CAIL	TC,(EACA)	;IS IT AFTER END?
	JRST	BADEOP		;YES--OOPS

	SETZM	ECARRY

	MOVEM	TC,ESAVAC	;NO--SAVE THE LOCATION
	MOVEM	TC,CUREOP

	PUSHJ	PP,BMPEOP	;LOOP FOR NEXT OPERAND
	  JRST	BADEOP		;NOT THERE--ERROR

;SKIP THRU EOPTAB UNTIL LAST OPERAND SEEN
SUBGN1:	MOVE	TC,CUREOP	;SAVE LOCATION OF LAST ONE SEEN
	PUSHJ	PP,BMPEOP	;LOOK FOR ANOTHER
	  SKIPA			;NO MORE
	JRST	SUBGN1		;LOOP

	MOVEI	TE,-1(TC)	;RESET EOPNXT TO POINT TO NEXT TO LAST OPERAND
	HRRM	TE,EOPNXT

	HRLZM	TC,OPERND
	SETZM	EAC		;SET AC'S TO 0 & 1
	MOVEI	LN,EBASEA	;SET UP THAT LAST OPERAND'S PARAMETERS
IFN ANS74,<
	SETOM	EDEBDA##	;MIGHT NEED TO DEBUG ON DATA-ITEM
	SOS	EDEBDA		; BUT ONLY IF "ARO" ON
>
	PUSHJ	PP,SETOPN
	TSWF	FERROR		;ANY TROUBLE?
	JRST	SUBGN4		;YES

	PUSHJ	PP,GRBOP2	;GET OPERAND INTO AC'S
IFN ANS74,<
	PUSHJ	PP,CDEBA##	;COPY ANY DEBUGGING INFO
>

	MOVE	TE,RESTYP
	CAIE	TE,3		;TEST FOR AOS
	CAIN	TE,4		;OR SOS
	PUSHJ	PP,SETA21	;NOT ALLOWED HERE
	MOVE	TC,ESAVAC	;GET BACK TO FIRST OPERAND
	MOVEM	TC,CUREOP
	SETZM	RESTYP		;[601]

SUBGN4:	HRRM	TC,OPERND
	PUSHJ	PP,SETOPB	;SET UP "B" PARAMETERS
	PUSHJ	PP,OPBCHK	;CK 2ND OPERAND FOR ELEMENTARY NUMERIC CLASS

	PUSHJ	PP,SUBX.	;YES--GENERATE THE SUBTRACT

SUBGN5:	PUSHJ	PP,BMPEOP	;GO TO NEXT OPERAND
	  POPJ	PP,		;NO MORE--QUIT
	MOVE	TC,CUREOP	;LOOP
	JRST	SUBGN4
;"SUBFRM" GENERATOR

SUBFGN:	SETZM	OVFLFL		;CANNOT CAUSE OVERFLOW
	SETOM	RESTYP
	SETZM	FLTDIV		;[566] CLEAR INCASE LEFT ON BY PREV. DIVIDE
	MOVEM	W1,OPLINE
	SWOFF	FEOFF1		;CLEAR MOST FLAGS

	HRRZ	TC,EOPLOC
	ADDI	TC,1
	MOVE	EACA,EOPNXT
	CAIL	TC,(EACA)
	JRST	BADEOP

	SETZM	ECARRY

SUBFG2:	MOVEM	TC,CUREOP
	MOVSM	TC,OPERND
IFN ANS74,<
	SETOM	EDEBDA##	;MIGHT NEED TO DEBUG ON DATA-ITEM
	SOS	EDEBDA		; BUT ONLY IF "ARO" ON
>
	PUSHJ	PP,SETOPA

	SETZM	EAC		;SET AC'S TO BE 0&1

	TSWT	FANUM		;IS "A" NUMERIC?
	JRST	SUBFG4		;NO--DROP IT

	HRRZ	TE,EMODEA	;IS "A" A LITERAL?
	CAIN	TE,FCMODE
	JRST	SUBFG7
	CAIN	TE,LTMODE
	JRST	SUBFG6		;YES

	PUSHJ	PP,MNXAC.	;NO--GET NEGATIVE INTO AC'S
IFN ANS74,<
	PUSHJ	PP,CDEBA##	;COPY ANY DEBUGGING INFO
>

SUBFG3:	MOVEI	TE,1		;SET RESULT TYPE TO 1
	MOVEM	TE,RESTYP

	PUSHJ	PP,BMPEOP
	  POPJ	PP,

	MOVE	TC,CUREOP
	JRST	SUBGN4

SUBFG4:	PUSHJ	PP,NOTNUM	;PUT OUT "IMPROPER CLASS" DIAG

SUBFG5:	PUSHJ	PP,BMPEOP
	  POPJ	PP,

	HRRZ	TC,CUREOP
	JRST	SUBFG2
;"SUBFRM" GENERATOR (CONT'D).

;"A" IS A LITERAL

SUBFG6:	PUSHJ	PP,CONVNL
	TSWF	FERROR		;ANY ERRORS?
	JRST	SUBFG5		;YES

	TSWTZ	FLNEG		;IS LITERAL NEGATIVE?
	PUSHJ	PP,NEGATL	;NO--MAKE IT NEGATIVE

	PUSHJ	PP,GRBOP4
	MOVE	TE,RESTYP
	CAIE	TE,3
	CAIN	TE,4		;AOS OR SOS?
	CAIA			;YES
	JRST	SUBFG3		;NO
	PUSHJ	PP,BMPEOP	;ANY MORE?
	  POPJ	PP,		;NO, ALL IS WELL
	PUSHJ	PP,SETA21	;YES, LOAD 1 IN ACCS
	AOS	RESTYP		;[546]BACK TO ADDM
	MOVE	TC,CUREOP
	JRST	SUBGN4		;GET NEXT OPERAND

;"A" IS A FIGURATIVE CONSTANT

SUBFG7:	HRRZ	TE,EFLAGA
	CAIE	TE,2
	JRST	SUBFG4
	SWON	FALWY0
	JRST	SUBFG3
;"MUL" GENERATOR

MULGEN:	PUSHJ	PP,GRABOP	;GET FIRST OPERAND INTO AC'S
IFN ANS74,<
	PUSHJ	PP,CDEBA##	;COPY ANY DEBUGGING INFO
>
	MOVE	TE,RESTYP	;[546] CHECK FOR MULTIPLY BY 1 OR -1
	CAIE	TE,3		;[546] +1
	CAIN	TE,4		;[546] -1
	PUSHJ	PP,SETA21	;[546] YES LOAD AC WITH CORRECT VALUE
	SKIPL	RESTYP		;ANY ERRORS?
	PUSHJ	PP,BMPEOP	;NO--GET SECOND OPERAND
	  POPJ	PP,		;SOME KIND OF ERROR

	MOVE	TC,CUREOP
	HRRM	TC,OPERND
	PUSHJ	PP,SETOPB	;SET UP "B" PARAMETERS

	PUSHJ	PP,OPBCHK	;CK 2ND OPERAND FOR ELEM. NUM. CLASS

	JRST	MULX.		;YES--GENERATE MULTIPLY

;"MULBY" GENERATOR

MULBGN:	PUSHJ	PP,GRABOP	;GET OPERAND INTO AC'S
IFN ANS74,<
	PUSHJ	PP,CDEBA##	;COPY ANY DEBUGGING INFO
>
	MOVE	TE,RESTYP	;[546] CHECK FOR MULTIPLY BY 1 OR -1
	CAIE	TE,3		;[546] +1
	CAIN	TE,4		;[546] -1
	PUSHJ	PP,SETA21	;[546] YES LOAD AC WITH CORRECT VALUE
	MOVEI	TE,2
	SKIPL	RESTYP		;ERRORS FOUND?
	MOVEM	TE,RESTYP	;NO--SET RESULT TYPE TO 2

	POPJ	PP,
;"DIVIDE ... GIVING" GENERATOR

DIVGEN:
IFN ANS74,<
	SETOM	DIVSRS##	;SIGNAL NOT TO CONSIDER DIVIDE INTO SERIES
>
	PUSHJ	PP,SETDIV	;SET UP RESULT
	TSWF	FERROR		;ANY TROUBLE?
	JRST	DIVG2C		;YES--DON'T GENERATE CODE
IFN ANS74,<
	SETZM	DIVSRS		;ITS NOT DIVIDE INTO SERIES FOR SURE
>

DIVG1:	TLNE	W1,DINTO	;"INTO" OPTION?
	JRST	DIVG3		;YES

;"DIVIDE BY"

IFN ANS74,<
	SETZM	DIVSRS		;ITS NOT DIVIDE INTO SERIES FOR SURE
>
	PUSHJ	PP,GRBDIV	;GET FIRST OPERAND INTO AC'S
	MOVE	TE,RESTYP	;[546] CHECK FOR MULTIPLY BY 1 OR -1
	CAIE	TE,3		;[546] +1
	CAIN	TE,4		;[546] -1
	PUSHJ	PP,SETA21	;[546] YES LOAD AC WITH CORRECT VALUE
	SKIPL	RESTYP		;ANY GOOD OPERANDS FOUND?
	PUSHJ	PP,BMPEOP	;YES--SKIP UP TO NEXT OPERAND
	  JRST	DIVG2B		;SOME KIND OF ERROR

	MOVE	TC,CUREOP	;SET UP "B" PARAMETERS

DIVG2:	HRRM	TC,OPERND
	PUSHJ	PP,SETOPB

	TSWT	FBNUM		;IS "B" NUMERIC?
	PUSHJ	PP,NOTNUM	;NO--ERROR

	MOVE	TE,EREM4	;GET NEXT OP
	TLNN	TE,GNSERA	;[767] SKIP IF SIZE ERROR WANTED
	JRST	DIVG2N		;[767]
	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]

DIVG2N:	SWON	FADJDV		;[767] SET "ADJUST DIVISOR" FLAG
	PUSHJ	PP,DIVX.	;GENERATE THE DIVIDE
	SWOFF	FADJDV		;CLEAR "ADJUST DIVISOR" FLAG

	SETZM	EMULSZ
	LDB	TE,[POINT 8,EREM4,8];IS THERE
	CAIE	TE,REMOP	;  A REMAINDER?
	JRST	DIVG2B		;NO
	HRRZ	TE,EMODEA
	CAIE	TE,FPMODE	;IF COMP-1,
	CAIN	TE,F2MODE	;OR COMP-2
	JRST	DIVG2B		;  NO NEED FOR REMAINDER
;"DIVIDE ... GIVING" (CONT'D)

	MOVE	TE,EREM4	;ANY
	TLNN	TE,GNSERA	;  SIZE ERROR?
	JRST	DIVG2A		;NO
	MOVE	CH,[XWD SETZM.,SZERA.];YES
	PUSHJ	PP,PUT.EX
	SETOM	EMULSZ

DIVG2A:	SETZM	ETEMPC		;STASH REMAINDER INTO %TEMP
	MOVEI	TE,2
	MOVE	TD,REMPAR
	LDB	TC,ACMODE
	CAIE	TC,D2MODE
	MOVEI	TE,1
	PUSHJ	PP,GETEMP
	HLRZ	TE,REMRND	;SPECIAL ROUNDING?
	JUMPE	TE,DIVG2E	;NO
	CAIG	TE,^D10		;2 WORDS
	SKIPA	TE,[3]		;NO
	MOVEI	TE,4		;YES
	MOVEM	TE,ETEMPC	;SAVE "B" OPERAND IN TEMP
DIVG2E:
IFN BIS,<
	CAIE	TC,D2MODE	;D.P.
	JRST	.+3		;NO
	PUSHJ	PP,PUTASA##	;YES, ENABLE FOR NEW INST.
	SKIPA	CH,[DMOVM.+AC2+ASINC,,AS.MSC]
>
	MOVE	CH,[XWD MOVEM.+AC2+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY
	HRRZ	CH,EACC
	PUSHJ	PP,PUTASN
IFE BIS,<
	CAIE	TC,D2MODE
	JRST	DIVG2B
	MOVE	CH,[XWD MOVEM.+AC3+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY
	MOVEI	CH,1(EACC)
	PUSHJ	PP,PUTASN
>
;"DIVIDE ... GIVING" (CONT'D)

DIVG2B:	MOVE	W1,OPLINE	;SET UP FOR "RESGEN"
	MOVE	EACA,EREM1
	MOVEM	EACA,EOPNXT
	MOVE	W1,EREM2
	MOVE	TC,EREM0
	MOVEI	TC,1(TC)
	PUSHJ	PP,STRES0
	PUSHJ	PP,RESG0D	;GENERATE 'GIVING'

DIVG2C:	SKIPN	W1,EREM4	;ANY OPERATOR READY?
	POPJ	PP,		;NO--WE'RE DONE

	HRRZ	TE,EREM1	;YES--THIS IS START OF OPERAND LESS 1
	HRRZ	TD,EOPLOC	;BUILD
	ADDI	TD,1		;  XWD FOR
	HRLI	TD,1(TE)	;  BLT TO MOVE OPERAND UP

	HRRZ	EACA,EREM3	;THIS IS LAST ADDRESS OF OPERAND
	SUBI	EACA,(TE)	;SO THIS IS SIZE OF OPERAND
	ADDI	TE,1(EACA)	;SO THIS IS LAST ADDRESS TO BLT
	BLT	TD,(TE)		;MOVE OPERAND TO TOP OF EOPTAB

	HRLS	EACA		;COMPUTE NEW
	ADD	EACA,EOPLOC	;  EOPNXT
	MOVEM	EACA,EOPNXT	;  AND STASH IT

	LDB	TE,[POINT 8,W1,8];GET OPERATOR CODE
	JRST	@EOPCOD(TE)	;DISPATCH TO SOME GENERATOR
;"DIVIDE ... GIVING GENERATOR (CONT'D)

;"DIVIDE INTO"

DIVG3:	HRRZ	TC,EOPLOC	;GET TO SECOND OPERAND
	ADDI	TC,1
	MOVEM	TC,CUREOP
	PUSHJ	PP,BMPEOP
	  JRST	BADEOP		;THERE ISN'T ONE--ERROR

	MOVE	TC,CUREOP	;GET THAT OPERAND INTO AC'S
	PUSHJ	PP,GRBOP0

	SKIPGE	RESTYP		;ERRORS?
	JRST	DIVG2B		;YES--FORGET IT

	HRRZ	TC,EOPLOC	;NO--RESET TO TOP OF EOPTAB
	ADDI	TC,1
	MOVEM	TC,CUREOP

	PUSH	PP,TC		;[1047] SAVE AC
	MOVE	TE,RESTYP	;[1047] CHECK FOR MULTIPLY -1 OR +1
	CAIE	TE,3		;[1047] +1
	CAIN	TE,4		;[1047] -1
	PUSHJ	PP,SETA21	;[1047] LOAD AC WITH CORRECT VALUE
	POP	PP,TC		;[1047] RESTORE AC
	JRST	DIVG2		;NOW PRETEND IT'S "DIVIDE BY"
;"DIVIDE ... BY" GENERATOR

DIVBGN:
IFN ANS74,<
	SETZM	DIVSRS##	;ZERO COUNT OF OPERANDS IN SERIES
>
	PUSHJ	PP,SETDIV	;SET UP THE RESULT
	TSWF	FERROR		;ANY TROUBLE?
	JRST	DIVG2C		;YES--QUIT

;WE HAVE TO CREATE A RESULT EQUAL TO THE SECOND DIVIDE OPERAND.
;BE SURE THERE IS ROOM IN EOPTAB.

DIVBG1:	HRRZ	TE,EREM0
	MOVE	EACA,EREM1
	SUBI	TE,(EACA)
	HLRE	TD,EREM3
	CAMLE	TE,TD
	JRST	DIVBG2
	HLRE	TE,EOPLOC	;SAVE OLD EOPLOC
	PUSH	PP,TE
	PUSHJ	PP,XPNEOP
	HLRE	TE,EOPLOC	;GET NEW
	POP	PP,TD		;GET BACK OLD
	SUB	TE,TD		;COMPARE
	HLRE	TD,EREM3
	ADD	TE,TD
	HRLM	TE,EREM3
	JRST	DIVBG1

;OK, THERE IS ROOM IN EOPTAB. NOW WE HAVE TO MOVE DOWN THE RESULT
;  OPERAND (SECOND DIVIDE OPERAND), PLUS OPERANDS FOR REMAINDER OR
;  WHATEVER CAME AFTER DIVIDE.
;NOTE THAT RESULT OPERAND WILL BE DUPLICATED.

DIVBG2:	MOVMS	TE
	HRLS	TE
	HRRZ	TB,EREM0
	HRRZ	TA,EREM3
	ADDM	TE,EREM0
	ADDM	TE,EREM1
	ADDB	TE,EREM3

DIVBG3:	MOVE	CH,(TA)
	MOVEM	CH,(TE)
	SUBI	TA,1
	CAIE	TA,(TB)
	SOJA	TE,DIVBG3

	MOVE	EACA,EREM0
	MOVEM	EACA,EOPNXT
	JRST	DIVG1
;"SETTO" GENERATOR

SETTGN:	PUSHJ	PP,SETSET	;SET UP LAST OPERAND

	SKIPGE	RESTYP		;IS IT ALL RIGHT?
	POPJ	PP,		;NO--FORGET IT

	HRRZ	TE,EMODEA	;YES--IS IT A LITERAL?
	CAIN	TE,LTMODE
	JRST	SETT2		;YES

	CAIN	TE,FCMODE	;NO--IS IT ZERO?
	JRST	SETT3		;YES

	PUSHJ	PP,MXAC.	;NO--GET IT INTO THE AC'S

	JRST	SETT4		;GO TO "RESULT" GENERATOR

SETT2:	PUSH	PP,RESTYP	;SAVE WHICH TYPE
	PUSHJ	PP,GRBOP4	;GET VALUE OF LITERAL INTO AC'S
	MOVE	TE,RESTYP	;MUST CHECK INCASE LIT = 1
	CAIE	TE,3		;+1
	CAIN	TE,4		;-1
	PUSHJ	PP,SETA21	;UNDO AOS OR SOS CODE
	POP	PP,RESTYP	;RESTORE WHAT IT WAS

	JRST	SETT4		;GO TO "RESULT" GENERATOR

SETT3:	SWON	FALWY0;

SETT4:
IFN ANS74,<
	PUSHJ	PP,CDEBAB##	;STORE DEBUGGING DATA
>
	MOVE	EACA,EOPNXT
	PUSHJ	PP,RESGEN	;[350] SET RESULT
	SWOFF	FALWY0		;[350] TURN OFF ZERO INDICATOR
	POPJ	PP,		;[350] RETURN
;"SETDN" GENERATOR

SETDGN:	PUSHJ	PP,SETSET	;SET UP LAST OPERAND

	SKIPGE	RESTYP		;IS IT ALL RIGHT?
	POPJ	PP,		;NO--FORGET IT

	MOVEI	TE,1		;SET RESULT TYPE TO 1
	MOVEM	TE,RESTYP

	HRRZ	TE,EMODEA	;IS IT A LITERAL?
	CAIN	TE,LTMODE
	JRST	SETD2		;YES

	CAIN	TE,FCMODE
	POPJ	PP,

	PUSHJ	PP,MNXAC.	;NO--GET NEGATIVE INTO AC'S
	JRST	SETT4		;GO TO "RESULT" GENERATOR

SETD2:	JUMPN	TD,SETD3	;IS IT A 2-WORD LITERAL?
	TSWT	FLNEG		;NO--NEGATIVE?
	CAIE	TC,1		;NO--IS IT 1?
	JRST	SETD3		;NEGATIVE OR NOT 1

	MOVSI	CH,SOS.		;IT IS 1--USE "SOS"
	JRST	SETU3

SETD3:	TSWTZ	FLNEG		;IS IT NEGATIVE?
	PUSHJ	PP,NEGATL	;NO--MAKE IT NEGATIVE
	JRST	SETT2		;GO TO "RESULT" GENERATOR
;"SETUP" GENERATOR

SETUGN:	PUSHJ	PP,SETSET	;SET UP LAST OPERAND
	SKIPGE	RESTYP		;IS IT ALL RIGHT?
	POPJ	PP,		;NO--FORGET IT

	MOVEI	TE,1		;SET RESULT TYPE TO 1
	MOVEM	TE,RESTYP

	HRRZ	TE,EMODEA	;IS IT A LITERAL?
	CAIN	TE,LTMODE
	JRST	SETU2		;YES
	CAIN	TE,FCMODE	;NO--FIG. CONST.?
	POPJ	PP,		;YES--MUST BE 'ZEROES'

	PUSHJ	PP,MXAC.	;NO--GET IT INTO AC'S
	JRST	SETT4		;GO TO "RESULT" GENERATOR

SETU2:	JUMPN	TD,SETT2	;IS IT A 2-WORD LITERAL?
	TSWT	FLNEG		;NO--IS IT NEGATIVE?
	CAIE	TC,1		;NO--IS IT 1?
	JRST	SETT2		;NOT 1, OR NEGATIVE--GO TO "RESULT"

	MOVSI	CH,AOS.		;IT IS 1--USE "AOS"

SETU3:	MOVEM	CH,RESTYP	;SAVE "AOS" OR "SOS"

	HRRZ	TC,EOPLOC
	ADDI	TC,1
	MOVEM	TC,CUREOP
	MOVEM	TC,OPERND	;IN CASE OF SUBSCRIPTING

	SETZM	ERCNT
	MOVE	TE,RESLOC
	MOVEM	TE,RESNXT

SETU5:	SWOFF	FERROR;
	MOVE	TC,CUREOP	;SET UP PARAMETERS FOR OPERAND
	MOVEM	TC,OPERND	;[500] IN CASE OF SUBSCRIPTING
IFN ANS74,<
	SETOM	EDEBDB		;IN CASE DEBUGGING
>
	MOVEI	LN,EBASEB
	PUSHJ	PP,SETOPN
	TSWF	FERROR;
	JRST	SETU6

	HRRZ	TE,EMODEB	;IS IT 1-WORD COMP?
	CAIE	TE,D1MODE
	JRST	SETU10		;NO

	PUSHJ	PP,SUBSCB	;YES--SUBSCRIPT IF NECESSARY
	MOVE	CH,RESTYP	;GENERATE "AOS" OR "SOS"

	CAMN	CH,[SOS.,,0]	;GENERATING A "SOS"?
	TSWF	FBSIGN		;YES--IS IT UNSIGNED?
	 JRST	SETU5A		;NO, GEN IT

;GENERATE
;	SOSGE	AC,FOO		;SUBTRACT ONE, SKIP IF STILL .GE. 0
;	MOVMS	AC,FOO		;MAKE IT POSITIVE IN MEMORY

	MOVSI	CH,SOSGE.
	PUSHJ	PP,PUT.B	;"SOSGE AC,B"
	PUSHJ	PP,PUTASA
	MOVSI	CH,MOVMS.

SETU5A:	PUSHJ	PP,PUT.B

SETU6:
IFN ANS74,<
	PUSHJ	PP,CDEBB		;STORE DEBUGGING DATA
>
	PUSHJ	PP,BMPEOP	;GO TO NEXT OPERAND
	  SKIPA			;NO MORE
	JRST	SETU5		;LOOP
IFN ANS74,<
	PUSHJ	PP,GDEBV	;GENERATE DEBUGGING CALLS
>
;"SETUP" OPERATOR  (CONT'D).

;ALL RESULTS HAVE BEEN LOOKED AT ONCE.

	SKIPN	ERCNT		;ANY NOT DONE?
	POPJ	PP,		;NO--QUIT

	MOVEI	TE,D1MODE	;SET MODE OF "A" TO 1-WORD COMP
	MOVEM	TE,EMODEA

	HLRZ	CH,RESTYP	;IS THIS "SETUP"?
	CAIE	CH,AOS.
	SKIPA	CH,[XWD MOVNI.,1];NO
	MOVE	CH,[XWD MOVEI.,1];YES

	PUSHJ	PP,PUT.XA

	MOVEI	TE,1		;SET RESULT TYPE TO 1
	MOVEM	TE,RESTYP

	JRST	RESGN0

;A RESULT IS NOT 1-WORD COMP--PUT ENTRY INTO RESTAB

SETU10:	MOVE	TC,CUREOP
	PUSHJ	PP,STRES8

	JRST	SETU6
;"RESULT" GENERATOR

RESGEN:	SWOFF	FEOFF1-FALWY0-FERROR	;CLEAR MOST FLAGS
	MOVEM	W1,OPLINE	;SAVE LN&CP OF OPERATOR

	PUSHJ	PP,SETRES	;SET UP RESTAB
	TLNN	W1,CORR		;IF 'CORRESPONDING', DON'T CLEAR EMULSZ

RESGN0:	SETZM	EMULSZ		;ASSUME ONLY ONE OPERAND
RESG0D:	SETZM	ERESDP
	TSWT	FERROR		;ANY ERRORS?
	SKIPN	TE,ERCNT	;NO--ANYTHING TO DO?
	POPJ	PP,		;NO--QUIT

	SWON	FASIGN		;SET "AC'S ARE SIGNED"
	HRRZ	TE,EMODEA	;IF 'A' IS
	CAIE	TE,FPMODE	;  COMP-1
	TSWF	FALWY0		;  OR IF AC'S ARE ZERO,
	JRST	RESG0C		;  SKIP SIZE TEST
	CAIN	TE,F2MODE	;ALSO COMP-2
	JRST	RESG0C

	MOVE	CH,ESIZEA	;IF SIZE OF 'A' IS TOO BIG,
	CAILE	CH,MAXSIZ+<BIS*^D20>	;  FORGET IT
	POPJ	PP,

RESG0C:	TLNN	W1,GNSERA	;ANY SIZE ERROR?
	JRST	RESGN1		;NO

	PUSHJ	PP,GETTAG	;GET A TAG NUMBER
	MOVEM	CH,ESZERA
	SWON	FSZERA		;SET 'SIZE ERROR REQUIRED'

	LDB	TE,[POINT 8,W1,8];IF OPERATOR
	CAIN	TE,REMOP	;  IS 'REMAINDER'
	JRST	RESGN1		;  GO TO GENERATION

	MOVE	TE,ERCNT
	TLNN	W1,CORR		;ANY CORRESPONDING?
	SOJE	TE,RESGN1	;NO, JUMP IF ONLY ONE OPERAND

RESG0B:	SKIPE	EMULSZ		;IS THIS THE FIRST?
	JRST	RESGN1		;NO
	MOVE	CH,[XWD SETZM.,SZERA.]
	PUSHJ	PP,PUT.EX
	SETOM	EMULSZ
	JRST	RESGN1
;"RESULT" GENERATOR (CONT'D).

RESGN1:	HRRZ	TE,RESLOC
	ADDI	TE,1
	MOVEM	TE,CURRES
IFN ANS74,<
	SKIPN	DIVSRS		;IF DIVIDE SERIES WE DON'T NEED A TEMP
>
	PUSHJ	PP,SCNRES	;SCAN THRU RESTAB TO SEE IF %TEMP NEEDED
RESGN2:
IFN ANS74,<
	SETOM	EDEBDB##	;MIGHT WANT TO DEBUG ON RESULT
>
	PUSHJ	PP,RESETB
	TSWF	FERROR;
	JRST	RESGN6

RESGN5:	PUSHJ	PP,RESG10

RESGN6:
IFN ANS74,<
	PUSHJ	PP,CDEBB##	;COPY RESULT DEBUGGING CODE
>
	PUSHJ	PP,LUKRES
IFN ANS68,<
	  POPJ	PP,
>
IFN ANS74,<
	  JRST	RESGN8		;ALL DONE
	SKIPN	DIVSRS		;DIVIDE SERIES IS SPECIAL
>
	JRST	RESGN2		;LOOP THRU ALL RESULTS
IFN ANS74,<
	PUSHJ	PP,RESETB	;SET "B" WITH NEXT RESULT
	PUSHJ	PP,SWAPEM	;MAKE IT "A"
	MOVE	TE,DIVTMP	;WE SET UP "A" TO POINT TO %TEMP
	MOVEM	TE,ESAVDV+1	;SAVE %TEMP 
	MOVE	TE,[44,,AS.MSC]
	MOVEM	TE,ESAVDV	;POINT TO IT
	MOVE	TE,[ESAVDV,,EBASEB]
	BLT	TE,EBASBX	;RESTORE THE DIVISOR
	MOVE	TA,1(TC)	;GET
	PUSHJ	PP,LNKSET	;  NUMBER
	LDB	TE,DA.NDP	;  OF DECIMAL PLACES
	LDB	TD,DA.DPR	;IS DECIMAL POINT
	SKIPE	TD		; TO RIGHT OF FIELD?
	MOVNS	TE		;YES--NEGATE
	MOVEM	TE,ERESDP
	MOVE	TE,1(TC)	;IS RESULT TO BE
	TLNE	TE,GNROUN	;  ROUNDED?
	AOS	ERESDP		;YES--GET ANOTHER DECIMAL PLACE
	PUSHJ	PP,GRBP1A	;GET "A" INTO THE ACCS
	SWON	FADJDV		;SET "ADJUST DIVISOR" FLAG
	PUSHJ	PP,DIVX.	;DO THE DIVIDE
	SWOFF	FADJDV		;CLEAR "ADJUST DIVISOR" FLAG
	JRST	RESGN2		;NOW DO THE STORE

RESGN8:	SETZM	DIVSRS		;CLEAN UP
	SETZM	DIVTMP
	PJRST	GDEBV##		;PUT OUT DEBUGGING CODE IF REQUIRED
>

RESGN7:	PUSHJ	PP,NOTNUM	;PUT OUT "NOT NUMERIC" DIAG
	JRST	RESGN6		;LOOP
;"RESULT" GENERATOR  (CONT'D).

;GENERATE CODE TO TAKE SOMETHING OUT OF AC'S, DEPENDING ON RESTYP.
;IF RESTYP IS NEGATIVE, THERE HAVE BEEN ERRORS, SO FORGET IT.
;IF RESTYP IS 0, GENERATE A "MOVEM" TYPE OF INSTRUCTION.
;IF RESTYP IS 1, GENERATE "ADDM"
;IF RESTYP IS 2, GENERATE MULTIPLY AND STORE.
;IF RESTYP IS 3, GENERATE "AOS"
;IF RESTYP IS 4, GENERATE "SOS"

RESG10:	SKIPGE	TE,RESTYP	;NEGATIVE?
	POPJ	PP,		;YES--QUIT

	MOVE	TA,1(TC)	;PICK UP SECOND WORD OF OPERAND

	CAIG	TE,4		;IS RESTYP IN BOUNDS?
	JRST	@RES.T(TE)	;YES--GO TO APPROPRIATE ROUTINE

	OUTSTR	[ASCIZ /Bad "RESTYP"
/]
	JRST	KILL

RES.T:	EXP	RESG11		;"MOVEM"
	EXP	RESG14		;"ADDM"
	EXP	RESG12		;MULTIPLY
	EXP	RESG17		;"AOS"
	EXP	RESG17		;"SOS"

;"MOVEM"

RESG11:	TLNE	TA,GNROUN	;ANY ROUNDING?
	PUSHJ	PP,ROUND	;YES--ROUND AC'S

	MOVE	TE,[XWD EBASEB,ESAVER]	; [377] SAVE RESULT PARAMS
	BLT	TE,ESAVRX	; [317] WHICH MAY BE CLOBBERED BY MOVGEN
	TSWF	FSZERA		;ANY SIZE ERROR?
	JRST	[PUSHJ PP,SIZERA	; [317] YES--GENERATE "SIZE ERROR" CODING
		JRST RESG1A]		; [317] FINSISH
	PUSHJ	PP,MACX.	; [317]GENERATE "MOVEM"
RESG1A:	MOVE	TE,[XWD ESAVER,EBASEB]	; [377] RESTORE RESULT PARMS
	BLT	TE,EBASAX		; [317]
	POPJ	PP,		; [317] RETURN

;MULTIPLY

RESG12:	PUSHJ	PP,RESCHK	;IS RECEIVING FIELD ELEMENTARY NUMERIC?
	JRST	NOTNUM		;NO
	PUSHJ	PP,MULX.
	JRST	RESG16
;CK RESULT OPERAND FOR ELEMENTARY NUMERIC CLASS

RESCHK:	TSWT	FBNUM		;NUMERIC?
	POPJ	PP,		;NO, TAKE ERROR RETURN
IFN ANS68,<
	CAIN	TA,TALLY.##	;[V10] TALLY IS NUMERIC AND
	JRST	CPOPJ1		;[V10] ISN'T EDITED.
>
	PUSH	PP,TA
	PUSHJ	PP,LNKSET	;GET PTR TO OPERAND'S DATAB ENTRY
	LDB	TA,DA.EDT	;EDITED?
	JUMPN	TA,.+2		;NO, ERROR
	AOS	-1(PP)		;NORMAL RETURN
	POP	PP,TA
	POPJ	PP,

;SPECIAL CK ON 2ND OPERAND - MUST BE ELEMENTARY NUMERIC CLASS

OPBCHK:	MOVE	TB,EMODEB	;LITERAL?
	CAIL	TB,LTMODE
	POPJ	PP,		;YES, LET IT PASS
IFN ANS68,<
	MOVE	TB,EBASEB	;TALLY?
	CAIN	TB,TALLY.##
	POPJ	PP,		;YES, LET IT PASS
>
	LDB	TB,DA.EDT	;EDITED?
	JUMPN	TB,OPBCH2	;YES, ERROR
	LDB	TB,DA.CLA	;NUMERIC?
	CAIN	TB,%CL.NU
	POPJ	PP,		;OK, RETURN

OPBCH2:	POP	PP,TB		;SET FOR RETURN TO CALLER'S CALLER
	JRST	NOTNUM		;?IMPROPER CLASS
;"RESULT" GENERATOR  (CONT'D).

;"ADDM"

RESG14:	PUSHJ	PP,RESCHK	;IS RECEIVING FIELD ELEMENTARY NUMERIC?
	JRST	NOTNUM		;NO
	TSWT	FSZERA		;ANY SIZE ERROR?
	TLNE	TA,GNROUN	;NO--ANY ROUNDING?
	JRST	RESG15		;YES

	TSWF	FALWY0		;IF AC'S ARE ZERO,
	POPJ	PP,		;  FORGET IT

IFN ANS74,<RESG13::		;ADD ACC 0 TO TALLY COUNTER IN INSPECT>
	HRRZ	TD,EMODEB
	HRRZ	TE,EMODEA
	CAIN	TE,FPMODE	;IS "A" COMP-1?
	JRST	RSG14B		;YES
	CAIN	TD,FPMODE	;NO--IS "B" COMP-1?
	JRST	RSG14A		;YES

	MOVE	TE,EDPLA	;IF A HAS MORE DECIMAL PLACES
	CAMLE	TE,EDPLB	; THAN B GET B INTO THE AC'S
	JRST	RESG15		; SO THAT SUBTRACT 1.9 FROM
				; 2 WILL GIVE A RESULT OF 0
				; RATHER THAN 1.

	PUSHJ	PP,ADJDP.	;ADJUST DECIMAL PLACES OF AC'S

	MOVE	TE,ESIZEA
	CAILE	TE,MAXSIZ	;ARE AC'S TOO BIG?
	POPJ	PP,		;YES--QUIT

	CAMG	TE,ESIZEB	;NO--IS "A" LARGER THAN RESULT?
	TSWT	FBSIGN		;NO--IS "B" SIGNED?
	JRST	RESG15		;CAN'T USE ADDM

	HRRZ	TD,EMODEB
	HRRZ	TE,EMODEA

	CAIE	TE,D1MODE	;ARE AC'S 1-WORD COMP?
	JRST	RESG15		;NO
	CAIE	TD,D1MODE	;YES--ALSO "B"?
	JRST	RESG15		;NO
	PUSHJ	PP,SUBSCB	;YES--SUBSCRIPT IF NECCESSARY
	MOVSI	CH,ADDM.	;GENERATE <ADDM AC,B> AND
	JRST	PUT.BA		;	RETURN

RSG14A:	PUSHJ	PP,CCXFP.##	;CONVERT "A" TO COMP-1
	MOVE	TD,EMODEB
RSG14B:	CAIE	TD,FPMODE	;"A" IS COMP-1, IS "B"?
	JRST	RESG15		;NO

	PUSHJ	PP,SUBSCB	;YES--SUBSCRIPT IF NECESSARY
	MOVSI	CH,FADM.	;GENERATE <FADM AC,B> AND
	JRST	PUT.BA		;	RETURN

RESG15:	PUSHJ	PP,ADDX.	;CAN'T USE "ADDM"--GENERATE ADD TO AC'S

RESG16:	PUSHJ	PP,RESETB
	MOVE	TA,1(TC)
	JRST	RESG11		;GO GENERATE STASH


;"AOS" OR "SOS"

RESG17:	PUSHJ	PP,RESCHK	;IS RECEIVING FIELD ELEMENTARY NUMERIC?
	JRST	NOTNUM		;NO
	TSWT	FSZERA		;ANY SIZE ERROR?
	TLNE	TA,GNROUN	;NO--ANY ROUNDING?
	JRST	RSG15A		;YES
	HRRZ	TD,EMODEB	;GET MODE
	CAIN	TD,D1MODE	;1-WORD COMP
	SKIPE	EDPLB		;AND NO DECIMAL PLACES
	JRST	RSG15A		;NO
	PUSHJ	PP,SUBSCB	;OK, SUBSCRIPT IF REQUIRED
	TSWF	FBSIGN		;IS IT UNSIGNED
	JRST	RSG17A		;NO, WHAT LUCK!
	PUSHJ	PP,PUTASA
	MOVSI	CH,MOVMS.	;MUST MAKE SURE ITS NOT NEGATIVE
	PUSHJ	PP,PUT.B
RSG17A:	MOVE	CH,RESTYP
	CAIE	CH,3		;AOS?
	 JRST	RSG17B		;GENERATE SOS, MOVSS IF NECESSARY
	MOVSI	CH,AOS.		;GENERATE <AOS B>
	JRST	PUT.B

RSG17B:	MOVSI	CH,SOS.		;ASSUME IT IS SIGNED
	TSWF	FBSIGN		;IS IT?
	 JRST	PUT.B		;YES-- JUST GENERATE "SOS"
	MOVSI	CH,SOSGE.
	PUSHJ	PP,PUT.B	;GEN "SOSGE DATANAME"
	PUSHJ	PP,PUTASA	; GENERATE "MOVMS DATANAME"
	MOVSI	CH,MOVMS.	;TO BE EXECUTED IF DATANAME BECAME NEGATIVE
	JRST	PUT.B		;BY THE "SOS"

RSG15A:	MOVE	CH,RESTYP
	CAIE	CH,3
	SKIPA	CH,[MOVNI.,,1]
	MOVE	CH,[MOVEI.,,1]
	PUSHJ	PP,PUT.XA	;GET 1 INTO ACCS
	SWOFF	FALWY0		;ACCS NOT ZERO NOW
	MOVEI	TE,D1MODE	;
	MOVEM	TE,EMODEA	;SET MODE OF A
	MOVEI	TE,1
	MOVEM	TE,ESIZEA	;AND SIZE
	JRST	RESG14		;DO AS ADDM
;"REMAINDER" GENERATOR

REMGEN:	SWOFF	FEOFF1-FALWY0-FERROR
	MOVEM	W1,OPLINE	;SAVE OPERATOR

	SETZM	EAC		;SET AC'S TO BE 0&1
	MOVE	TD,REMPAR	;PICK UP REMAINDER PARAMETERS

	LDB	TC,ACMODE	;GET MODE
	CAIE	TC,FPMODE	;IS IT COMP-1?
	CAIN	TC,F2MODE	;OR COMP-2?
	JRST	REMGN4		;YES

	LDB	TE,ACSIZE	;NO--GET SIZE
	MOVEM	TE,ESIZEA
	MOVEM	TC,EMODEA	;SET MODE
	HRREM	TD,EDPLA	;SET DECIMAL PLACES
IFN BIS,<
	CAIN	TC,D2MODE	;2-WORDS?
	PUSHJ	PP,PUTASA##	;YES
	CAIN	TC,D2MODE
	SKIPA	CH,[DMOVE.##+ASINC,,AS.MSC]
>
	MOVE	CH,[XWD MOV+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY
	MOVEI	CH,AS.TMP
	ADD	CH,TEMBAS
	PUSHJ	PP,PUTASN
IFE BIS,<
	CAIE	TC,D2MODE
	JRST	REMGN5
	MOVE	CH,[XWD MOV+AC1+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY
	MOVEI	CH,AS.TMP+1
	ADD	CH,TEMBAS
	PUSHJ	PP,PUTASN
>
	JRST	REMGN5

REMGN4:	MOVEM	TC,EMODEA	;SET MODE TO COMP-1 OR COMP-2
	MOVE	CH,[XWD SETZB.,1] ;GENERATE <SETZB 0,1>
	PUSHJ	PP,PUTASY
	SWON	FALWY0;

REMGN5:	PUSHJ	PP,SETRES
	JRST	RESG0D
;GENERATE CODE TO ADD SOMETHING TO THE AC'S

ADDX.:	TSWF	FALWY0		;ARE AC'S ZERO?
	JRST	ADDX.7		;YES
	PUSHJ	PP,SETB		;NO--SET UP "B"
	  JRST	ADDX.4		;IT IS A LITERAL, OR ERRORS FOUND

ADDX.1:	PUSHJ	PP,SETDP
	TSWF	FERROR;
	POPJ	PP,

	SWOFF	FALWY0		;TURN OFF "AC'S ARE ZERO"

ADDX.2:	HRRZ	TE,EMODEA
IFN BIS,<
	HRRZ	TD,EMODEB	;DON'T ALLOW ADD IF EITHER "A" OR "B"
	CAIE	TD,D4MODE##	; IS A LARGE INTERMEDIATE RESULT
	CAIN	TE,D4MODE##	;(ARE THEY?)
	 PJRST	TOOBIG		;YES, COMPLAIN
>;END IFN BIS
	JRST	@ADDT.1(TE)


;"B" IS A HALF-WORD LITERAL, OR ERRORS FOUND

ADDX.4:	MOVSI	CH,AD##
	TSWFZ	FLNEG		;IF NEGATIVE LITERAL,
	MOVSI	CH,SUB.		;  USE SUBTRACT

ADDX.5:	TSWT	FERROR		;IF ANY ERRORS DETECTED
	SKIPN	TC		;  OR IF LITERAL IS ZERO,
	POPJ	PP,		;  FORGET IT

	PUSH	PP,CH		;SAVE OP-CODE
	MOVE	TE,EDPLA	;IF
	SUB	TE,EDPLB	;  NECESSARY,
	JUMPLE	TE,ADDX.6	;  ADJUST
	PUSHJ	PP,ADJSL.	;  DECIMAL PLACES OF LITERAL
	PUSHJ	PP,SETB2A	;SEE IF STILL HALF-WORD
	  JFCL			;[534] SETB2A SOMETIMES GIVES SKIP RET
	TSWF	FERROR		;[534] EVEN IF NO ERROR  SO TEST FOR
	POPJ	PP,		;[534] ERROR AND GET OUT IF BAD
	HRRZ	TE,EMODEB	;IS IT
	CAIE	TE,LTMODE	;  STILL A LITERAL?
	JRST	ADDX.8		;NO

ADDX.6:	PUSH	PP,TC		;SAVE LITERAL VALUE
	PUSHJ	PP,SETDP	;ADJUST AC'S
	POP	PP,TC		;RESTORE LITERAL VALUE
	HRRZ	CH,EMODEA##	;IF SETDP CHANGED THE A OPERAND
	CAIE	CH,D1MODE##	; INTO A 2 WORD COMP ITEM, GO
	JRST	ADDX.9		; STASH THE LITERA.
	POP	PP,CH		;RESTORE OP-CODE
	PUSHJ	PP,PUT.LA	;GENERATE ADD OR SUBTRACT
	JRST	CHKSIZ		;CHECK SIZE OF RESULT AND RETURN

;AC'S ARE ZERO

ADDX.7:	PUSHJ	PP,SWAPAB	;SWAP OPERANDS
	SWOFF	FALWY0		;TURN OFF  "AC'S ARE ZERO"
	JRST	MXAC.		;GET OLD 'B' INTO AC'S
;IT IS NO LONGER LITERAL

ADDX.8:	POP	PP,CH		;GET OP-CODE
	CAME	CH,[XWD AD,0]	;IF NOT ADD,
	JRST	SUBX.1		;  DO SUBTRACT,
	JRST	ADDX.1		;  ELSE DO ADD

;COME HERE IF WE HAD A HALF WORD LITERAL AND SETDP CHANGED THE A
; OPERAND FROM A 1 WORD COMP ITEM TO A 2 WORD COMP ITEM.
;	(TC) = THE VALUE OF THE LITERAL.

ADDX.9:	PUSHJ	PP,SETB5	;GO STASH THE LITERAL.
	  JFCL			;CAN'T GET AN ERROR NOW.
	POP	PP,CH		;RESTORE THE OP CODE.
	CAME	CH,[XWD	AD,0]	;IF NOT ADD DO
	JRST	SUBX.4		; SUBTRACT ELSE
	JRST	ADDX.2		; DO ADD.
;ADD NON-LITERAL TO 1-WORD COMP IN AC'S

ADD1D:	HRRZ	TE,EMODEB
	CAIE	TE,D1MODE
	JRST	ADD1DD

	MOVSI	CH,AD
	PUSHJ	PP,PUT.BA
	JRST	CHKSIZ

;"B" IS MORE THAN 10 DIGITS LONG

ADD1DD:	PUSHJ	PP,FORCX0
IFE BIS,<
	MOVSI	CH,ADD.12
>;USE LIBOL ROUTINE FOR NON-BIS
IFN BIS,<
;ADD 2-WD TO 1-WD
	PUSHJ	PP,PUTASA##
	MOVE	CH,[ASHC.+ASINC,,AS.CNB]
	PUSHJ	PP,PUTASY##	;"ASHC 0,-^D35"
	MOVEI	CH,-^D35
	PUSHJ	PP,PUTASN##
	PUSHJ	PP,PUTASA##
	MOVSI	CH,DADD.
	PUSHJ	PP,PUT.B##	;"DADD 0,B"
>;END IFN BIS

ADD1DF:	MOVEI	TE,D2MODE
	MOVEM	TE,EMODEA
IFE BIS,JRST	ADD2DC
IFN BIS,JRST	CHKSIZ


;ADD NON-LITERAL TO 2-WORD COMP IN AC'S

ADD2D:	PUSHJ	PP,FORCX0
IFE BIS,<
	MOVSI	CH,ADD.21
	HRRZ	TE,EMODEB
	CAIE	TE,D1MODE
	MOVSI	CH,ADD.22
>;END IFE BIS
IFN BIS,<
	HRRZ	TE,EMODEB
	CAIE	TE,D1MODE
	 JRST	ADD22D		;ADD 2-WD TO 2-WD

;ADD 1-WD TO 2-WD

ADD21D:	HRRZ	TE,EBASEB	;IF "B" IS IN AN AC, SKIP THE REDUNDANT MOVE
	CAILE	TE,15		;MAKE SURE ASHC WON'T MANGLE AC0
	 JRST	ADD2DA		;TOO BAD
	LSH	TE,^D18+5	;SHIFT TO AC POSITION
	PUSHJ	PP,PUTASA
	MOVE	CH,[ASHC.+ASINC,,AS.CNB]
	IOR	CH,TE
	PUSHJ	PP,PUTASY##	;"ASHC AC,-^D35"
	MOVEI	CH,-^D35
	PUSHJ	PP,PUTASN##

	PUSHJ	PP,PUTASA	;READY FOR "DADD"
	HRLI	CH,DADD.
	HRR	CH,EBASEB	;"DADD 0,B"
	PUSHJ	PP,PUTASY
	JRST	CHKSIZ

ADD2DA:	MOVSI	CH,MOV+AC2
	PUSHJ	PP,PUT.B##	;"MOVE AC2,B"
ADD2DB:	PUSHJ	PP,PUTASA##
	MOVE	CH,[ASHC.+AC2+ASINC,,AS.CNB]
	PUSHJ	PP,PUTASY##	;"ASHC AC2,-^D35"
	MOVEI	CH,-^D35
	PUSHJ	PP,PUTASN##	; TO EXTEND THE SIGN

;GENERATE "DADD 0,2"

	PUSHJ	PP,PUTASA##
	MOVE	CH,[DADD.,,2]
	PUSHJ	PP,PUTASY##

	JRST	CHKSIZ

;ADD 2-WD TO 2-WD

ADD22D:	PUSHJ	PP,PUTASA##	;"DADD 0,B"
	MOVSI	CH,DADD.
	PUSHJ	PP,PUT.B##
	JRST	CHKSIZ
>;END IFN BIS

IFE BIS,<
ADD2DC:	PUSHJ	PP,PUT.BA
	JRST	CHKSIZ
>

;ADD NON-LITERAL TO FLOATING-POINT
;"ADSUB2" CONVERTED "B" TO COMP-1, IF NECESSARY

ADDFP:	MOVSI	CH,FAD.
	JRST	PUT.BA

;ADD NON-LITERAL TO D.P. FLOATING-POINT
;"ADSUB2" CONVERTED "B" TO COMP-2, IF NECESSARY

ADDF2:	PUSHJ	PP,PUTASA
	MOVSI	CH,DFAD.
	JRST	PUT.BA
;GENERATE CODE TO SUBTRACT FROM AC'S

SUBX.:	TSWF	FALWY0		;IF AC'S ARE ZERO,
	JRST	SUBX.6		;  TAKE SPECIAL ROUTE
	PUSHJ	PP,SETB		;SET UP "B"
	  JRST	SUBX.5		;IT IS A LITERAL, OR ERRORS FOUND

SUBX.1:	PUSHJ	PP,SETDP
	TSWF	FERROR;
	POPJ	PP,

	SWOFF	FALWY0		;TURN OFF "AC'S CONTAIN ZERO"

SUBX.4:	HRRZ	TE,EMODEA
IFN BIS,<
	HRRZ	TD,EMODEB	;IF EITHER "B" OR "A"
	CAIE	TD,D4MODE##	;IS A 4-WORD INTERMEDIATE RESULT,
	CAIN	TE,D4MODE##	; GIVE UP
	 PJRST	TOOBIG
>;END IFN BIS
	JRST	@SUBT.1(TE)


;"B" IS A HALF-WORD LITERAL, OR ERRORS FOUND

SUBX.5:	MOVSI	CH,SUB.		;GENERATE SUBTRACT UNLESS
	TSWFZ	FLNEG		;  LITERAL IS NEGATIVE,
	MOVSI	CH,AD		;  IN WHICH CASE GENERATE AN ADD
	JRST	ADDX.5

;AC'S ARE ZERO

SUBX.6:	PUSHJ	PP,SWAPAB	;SWAP OPERANDS
	SWOFF	FALWY0		; RESET "AC'S ARE ZERO"
	JRST	MNXAC.		;GET NEGATIVE OF OLD 'B' INTO AC'S
;SUBTRACT NON-LITERAL FROM 1-WORD COMP IN AC'S

SUB1D:	HRRZ	TE,EMODEB
	CAIE	TE,D1MODE
	JRST	SUB1DD

	MOVSI	CH,SUB.
	PUSHJ	PP,PUT.BA
	JRST	CHKSIZ
SUB1DD:	PUSHJ	PP,FORCX0
IFE BIS,<
	MOVSI	CH,SUB.12
	JRST	ADD1DF
>;END IFE BIS
IFN BIS,<
;
;SUBTRACT 2-WD FROM 1-WD
	PUSHJ	PP,PUTASA##
	MOVE	CH,[ASHC.+ASINC,,AS.CNB]
	PUSHJ	PP,PUTASY##	;"ASHC 0,-^D35"
	MOVEI	CH,-^D35
	PUSHJ	PP,PUTASN##

	PUSHJ	PP,PUTASA##
	MOVSI	CH,DSUB.
	PUSHJ	PP,PUT.B##	;"DSUB 0,B"
	JRST	ADD1DF
>;END IFN BIS


;SUBTRACT NON-LITERAL FROM 2-WORD COMP IN AC'S

SUB2D:	PUSHJ	PP,FORCX0
IFE BIS,<
	MOVSI	CH,SUB.21
	HRRZ	TE,EMODEB
	CAIE	TE,D1MODE
	MOVSI	CH,SUB.22
	JRST	ADD2DC
>;END IFE BIS
IFN BIS,<
	HRRZ	TE,EMODEB
	CAIE	TE,D1MODE
	 JRST	SUB22D		;2-WD MINUS 2-WD

;SUBTRACT 1-WD FROM 2-WD
SUB21D:	MOVSI	CH,MOV+AC2
	PUSHJ	PP,PUT.B##	;"MOVE AC2,B"
	PUSHJ	PP,PUTASA##
	MOVE	CH,[ASHC.+AC2+ASINC,,AS.CNB]
	PUSHJ	PP,PUTASY##	;"ASHC AC2,-^D35"
	MOVEI	CH,-^D35
	PUSHJ	PP,PUTASN##

;GENERATE "DSUB 0,2"
	PUSHJ	PP,PUTASA##
	MOVE	CH,[DSUB.,,2]
	PUSHJ	PP,PUTASY##
	JRST	CHKSIZ

;SUBTRACT 2-WD FROM 2-WD
SUB22D:	PUSHJ	PP,PUTASA##	;"DSUB 0,B"
	MOVSI	CH,DSUB.
	PUSHJ	PP,PUT.B##
	JRST	CHKSIZ
>;END IFN BIS

;SUBTRACT NON-LITERAL FROM COMP-1.
;"ADSUB2" CONVERTED "B" TO COMP-1, IF NECESSARY.

SUBFP:	MOVSI	CH,FSB.
	JRST	PUT.BA

;SUBTRACT NON-LITERAL FROM COMP-2.
;"ADSUB2" CONVERTED "B" TO COMP-2, IF NECESSARY.

SUBF2:	PUSHJ	PP,PUTASA
	MOVSI	CH,DFSB.
	JRST	PUT.BA
;MULTIPLY AC'S BY SOMETHING

MULX.:	TSWF	FALWY0		;IF AC'S ARE ZERO,
	POPJ	PP,		;  NO CODE NECESSARY
	PUSHJ	PP,SETB		;SET UP "B"
	  JRST	MULX20		;"B" IS LITERAL, OR ERRORS


;"B" IS NOT A LITERAL

	HRRZ	TE,EMODEA
	CAIE	TE,FPMODE
	CAIN	TE,F2MODE
	JRST	MUL10B

	MOVE	TA,ESIZEA
	CAILE	TA,MAXSIZ	;IS IT TOO BIG ALREADY?
	POPJ	PP,		;YES--FORGET IT

	HRRZ	TE,EMODEB
	CAIE	TE,FPMODE
	CAIN	TE,F2MODE
	JRST	MUL10B

	ADD	TA,ESIZEB
IFN BIS,<
	TSWT	FBIGCV		;ARE WE ALLOWED TO GO TO FLOATING?
	 JRST	MUL100		;NO
	CAILE	TA,MAXSIZ	;YES, DON'T ALLOW RESULT TO GO TO 4 WORDS
	JRST	MULX32
>
MUL100:	CAILE	TA,MAXSIZ+<BIS*^D24>
	JRST	MULX32

MUL10B:	PUSHJ	PP,SUBSCB
	PUSHJ	PP,NEGIF
	HRRZ	TE,EMODEA
	HRRZ	TD,EMODEB
IFN BIS,<
;DON'T ALLOW MULTIPLY OF 4-WORD INTERMEDIATE RESULTS
	CAIE	TD,D4MODE##	;IS "B" COMP-4?
	CAIN	TE,D4MODE##	;4-WORD INTERMEDIATE ALREADY?
	 PJRST	TOOBIG		;YES, COMPLAIN
>;END IFN BIS
	HRRZ	TD,EMODEB
	JRST	@MULT.1(TE)

;MULTIPLY A 1-WORD COMP BY SOMETHING
ML1CX:
	JRST	@MULT.2(TD)

;MULTIPLY A 2-WORD COMP BY SOMETHING

ML2CX:	JRST	@MULT.3(TD)
;"B" IS A HALF-WORD LITERAL, OR ERRORS FOUND

MULX20:	TSWF	FERROR		;ANY ERRORS?
	POPJ	PP,		;YES--FORGET IT

	SKIPN	TC		;IS LITERAL ZERO?
	SWON	FALWY0		;YES--SET 'AC'S ARE ZERO'

	TSWF	FALWY0		;ARE AC'S ZERO?
	POPJ	PP,		;YES--FORGET IT

	TSWFZ	FLNEG		;IS LITERAL NEGATIVE?
	MOVNS	TC		;YES

	MOVE	TA,ESIZEB
	ADDB	TA,ESIZEA
	CAILE	TA,^D10
	JRST	MULX23

;RESULT WILL BE ONE WORD

	MOVSI	CH,IMUL.

MULX22:	PUSHJ	PP,PUT.LA
	MOVE	TE,EDPLB
	ADDM	TE,EDPLA
	POPJ	PP,

;RESULT WILL BE TWO WORDS

MULX23:	MOVEI	TE,D2MODE
	MOVEM	TE,EMODEA
	MOVSI	CH,MUL.
	JRST	MULX22
;MULTIPLY A 1-WORD COMP BY A 1-WORD COMP
ML1C1C:	MOVE	TE,ESIZEA
	ADD	TE,ESIZEB
	CAILE	TE,^D10
	JRST	MULX12
	MOVSI	CH,IMUL.
	PUSHJ	PP,PUT.BA

MULEND:	MOVE	TE,ESIZEB
	ADDM	TE,ESIZEA
	MOVE	TE,EDPLB
	ADDM	TE,EDPLA
	POPJ	PP,

MULX12:	MOVSI	CH,MUL.
	PUSHJ	PP,PUT.BA
	JRST	MULX14


;MULTIPLY A 1-WORD COMP BY A 2-WORD COMP

ML1C2C:
IFN BIS,<
	MOVE	TA,ESIZEA
	ADD	TA,ESIZEB
	CAILE	TA,MAXSIZ
	JRST	ML1C4C
	PUSHJ	PP,GMUL12
	JRST	MULX14
>;END IFN BIS
IFE BIS,<
	MOVSI	CH,MUL.12
MULX13:	PUSHJ	PP,PUT.BA
>;END IFE BIS

MULX14:	MOVEI	TE,D2MODE
	MOVEM	TE,EMODEA
	JRST	MULEND
;MULTIPLY A 2-WORD COMP BY A 1-WORD COMP

ML2C1C:
IFN BIS,<
	MOVE	TA,ESIZEA
	ADD	TA,ESIZEB
	CAILE	TA,MAXSIZ
	JRST	ML4C1C
	PUSHJ	PP,GMUL21
	JRST	MULX14
>;END IFN BIS
IFE BIS,<
	MOVSI	CH,MUL.21
	JRST	MULX13
>;END IFE BIS

;MULTIPLY A 2-WORD COMP BY A 2-WORD COMP

ML2C2C:
IFN BIS,<
	MOVE	TA,ESIZEA
	ADD	TA,ESIZEB
	CAILE	TA,MAXSIZ
	JRST	ML4C2C
	PUSHJ	PP,GMUL22
	JRST	MULX14
>
IFE BIS,<
	MOVSI	CH,MUL.22
	JRST	MULX13
>;END IFE BIS

;MULTIPLY COMP-1 BY COMP-1

MLFPFP:	MOVSI	CH,FMP.
	JRST	PUT.BA

;MULTIPLY COMP-2 BY COMP-2

MLF2F2:	PUSHJ	PP,PUTASA
	MOVSI	CH,DFMP.
	JRST	PUT.BA
IFN BIS,<
;MULTIPLY A 1-WORD COMP BY A 2-WORD COMP GIVING 4-WORD COMP

ML1C4C:	PUSHJ	PP,MLASHC		;CONVERT TO 2-WORDS
	JRST	ML4C2C

;MULTIPLY A 2-WORD COMP BY A 1-WORD COMP GIVING 4-WORD COMP

ML4C1C:	MOVEI	CH,2
	ADDB	CH,EAC			;USE NEXT PAIR OF ACCS
	CAMN	CH,EBASEB		;IF THERE ALREADY
	JRST	ML4C1D			;SKIP THE LOAD
	MOVSI	CH,MOV
	PUSHJ	PP,PUT.BA
ML4C1D:	PUSHJ	PP,MLASHC
	MOVE	CH,EAC
	MOVEM	CH,EBASEB
	SUBI	CH,2
	MOVEM	CH,EAC
	JRST	ML4C2C

;MULTIPLY A 2-WORD COMP BY A 2-WORD COMP GIVING 4-WORD COMP

ML4C2C:	PUSHJ	PP,PUTASA##		;ALTERNATE CODE SET
	MOVSI	CH,DMUL.##
	PUSHJ	PP,PUT.BA
	MOVEI	TE,D4MODE##
	MOVEM	TE,EMODEA
	JRST	MULEND

MLASHC:	PUSHJ	PP,PUTASA
	HRLZ	CH,EAC
	LSH	CH,5
	ADD	CH,[ASHC.##+ASINC,,AS.CNB]
	PUSHJ	PP,PUTASY
	MOVEI	CH,-^D35
	JRST	PUTASN

>
IFN BIS,<
;GENERATE INLINE CODE FOR MUL.12
GMUL12:	PUSHJ	PP,PUTASA##
	MOVE	CH,[ASHC.+ASINC,,AS.CNB]
	PUSHJ	PP,PUTASY##
	MOVEI	CH,-^D35
	PUSHJ	PP,PUTASN##

	PUSHJ	PP,PUTASA##
	MOVSI	CH,DMUL.
	PUSHJ	PP,PUT.BA##

	PJRST	GMULP0		;GET LOW ORDER RESULT & RETURN

;GENERATE INLINE CODE FOR MUL.21
GMUL21:	PUSHJ	PP,GMULB1	;GET "B" AS 2 WDS, DO DMUL
	PJRST	GMULP0		;GET LOW ORDER RESULT & RETURN

;GENERATE INLINE CODE FOR MUL.22
GMUL22:	PUSHJ	PP,PUTASA##
	MOVSI	CH,DMUL.
	PUSHJ	PP,PUT.BA##	;"DMUL AC,B"

;	PJRST	GMULP0		;GET LOW ORDER RESULT

;ROUTINE TO GENERATE CODE TO PUT LOW ORDER DMUL RESULT INTO 1ST 2 AC'S
;GEN:	DMOVE	AC,AC+2

GMULP0:	PUSHJ	PP,PUTASA##
	MOVSI	CH,DMOVE.
	HRR	CH,EAC
	ADDI	CH,2
	PJRST	PUT.XA##
;ROUTINE TO GET "B" INTO AC+4 & AC+5 AS 2-WDS
;GENERATE:
;	MOVE	AC+4,B
;	ASHC	AC+4,-^D35
;	DMUL	AC,AC+4

;UNLESS B = A +2
;IN WHICH CASE GENERATE
;	ASHC	AC+2,-^D35
;	DMUL	AC,AC+2

GMULB1:	HRRZ	CH,EBASEB	;GET "B"
	ADD	CH,EINCRA	;ANY INCREMENT
	SUBI	CH,2		;"B" -2
	CAMN	CH,EAC		;= "A"
	JRST	GMULB2		;YES
	HRRZ	CH,EAC
	ADDI	CH,4		;AC+4
	LSH	CH,5
	IORI	CH,MOV
	HRLZ	CH,CH		;"MOVE AC+4,"
	PUSHJ	PP,PUT.B##
	PUSHJ	PP,PUTASA##
	HRRZ	CH,EAC
	ADDI	CH,4
	LSH	CH,5		;AC+4
	HRLZ	CH,CH
	IOR	CH,[ASHC.+ASINC,,AS.CNB]
	PUSHJ	PP,PUTASY##
	MOVEI	CH,-^D35
	PUSHJ	PP,PUTASN##
	PUSHJ	PP,PUTASA##
	MOVSI	CH,DMUL.
	HRR	CH,EAC
	ADDI	CH,4		;"DMUL Z, AC+4"
	PJRST	PUT.XA##	;PUT IN AC

GMULB2:	PUSHJ	PP,PUTASA##
	HRRZ	CH,EAC
	ADDI	CH,2
	LSH	CH,5		;AC+2
	HRLZ	CH,CH
	IOR	CH,[ASHC.+ASINC,,AS.CNB]
	PUSHJ	PP,PUTASY##
	MOVEI	CH,-^D35
	PUSHJ	PP,PUTASN##
	PUSHJ	PP,PUTASA##
	MOVSI	CH,DMUL.
	HRR	CH,EAC
	ADDI	CH,2		;"DMUL Z, AC+2"
	PJRST	PUT.XA##	;PUT IN AC

>;END IFN BIS
;NEW SIZE IS > 19 DIGITS

;"B" IS NOT A LITERAL

MULX32:	TSWT	FBIGCV;
	JRST	MULX33
IFE BIS,<
	PUSHJ	PP,CCXFP.
	PUSHJ	PP,SWAPEM
	PUSHJ	PP,MXFPA.
	PUSHJ	PP,SWAPEM
	JRST	MLFPFP
>
IFN BIS,<
	PUSHJ	PP,CCXF2.
	PUSHJ	PP,SWAPEM
	PUSHJ	PP,MXF2A.
	PUSHJ	PP,SWAPEM
	JRST	MLF2F2
>

MULX33:	MOVEI	DW,E.88
	JRST	OPNFAT
;GENERATE CODE TO DIVIDE AC'S BY SOMETHING
DIVX.:	TSWF	FALWY0		;IF AC'S ARE ZERO,
	POPJ	PP,		;  NO CODE NEEDED

	PUSHJ	PP,FORCX0	;INSURE THAT AC'S ARE 0&1
IFN BIS,<
	HRRZ	TE,EMODEA	;DON'T ALLOW DIVIDE WHEN "A"
	CAIN	TE,D4MODE##	; IS A LARGE INTERMEDIATE RESULT
	 PJRST	TOOBIG
>;END IFN BIS

	PUSHJ	PP,SETB		;SET UP "B"
	  JRST	DIVX50		;"B" IS LITERAL OR ERROR

;GENERATE CODE TO DIVIDE AC'S BY SOMETHING.
;"B" IS NOT A LITERAL.

IFN BIS,<
	HRRZ	TE,EMODEB	;DON'T ALLOW DIVIDE BY 4-WORD COMP
	CAIN	TE,D4MODE##
	 PJRST	TOOBIG
>;END IFN BIS
	PUSHJ	PP,SUBSCB
IFN ANS74,<
	SKIPE	DIVSRS		;IS IT A DIVIDE SERIES
	SKIPE	DIVTMP		;AND "B" NOT YET SAVED IN %TEMP?
	JRST	DIVX5C		;NO
DIVX5S:	MOVE	TE,[EBASEB,,ESAVDV##]	;[1472]
	BLT	TE,ESVDVX##	;SAVE DIVISOR
	MOVEI	TE,1		;ASSUME 1 WORD
	MOVE	TD,ESIZEB
	CAILE	TD,^D10
	MOVEI	TE,2		;NEEDS 2 WORDS
	PUSHJ	PP,GETEMP
	MOVEM	EACC,DIVTMP##	;SAVE LOCATION
	PUSHJ	PP,SWAPEM	;PUT DIVISOR IN "A"
	HRRZ	TE,EBASEA	;IS IT ALREADY IN THE ACCS?
	CAILE	TE,17
	JRST	[MOVEI TE,2		;NOT YET
		MOVEM	TE,EAC		;USE 2 & 3
		PUSHJ	PP,MXAC.	;GET INTO ACCS
		MOVE	TE,EAC
		MOVEM	TE,EBASEA	;SET UP BASE
		JRST	.+1]
IFN BIS,<
	MOVE	TC,EMODEA
	CAIE	TC,D2MODE	;D.P.
	CAIN	TC,F2MODE
	TRNA			;YES
	JRST	.+3		;NO
	PUSHJ	PP,PUTASA##	;YES, ENABLE FOR NEW INST.
	SKIPA	CH,[DMOVM.+ASINC,,AS.MSC]
>
	MOVE	CH,[XWD MOVEM.+ASINC,AS.MSC]
	HRRZ	TE,EBASEA	;PUT AC FIELD IN INSTRUCTION
	DPB	TE,CHAC
	PUSHJ	PP,PUTASY
	HRRZI	CH,AS.MSC
	HRRZ	CH,DIVTMP
	PUSHJ	PP,PUTASN
IFE BIS,<
	CAIE	TC,D2MODE
	CAIN	TC,F2MODE
	SKIPA	CH,[XWD MOVEM.+ASINC,AS.MSC]
	JRST	DIVX5F		;NOT D.P.
	HRRZ	TE,EBASEA	;PUT AC FIELD IN INSTRUCTION
	ADDI	TE,1
	DPB	TE,CHAC
	PUSHJ	PP,PUTASY
	MOVEI	CH,1(EACC)
	PUSHJ	PP,PUTASN
DIVX5F:>
	PUSHJ	PP,SWAPEM	;PUT DIVISOR BACK IN "B"
DIVX5C:>

	PUSHJ	PP,NEGIF	;NEGATE AC'S IF 'B' HAS UNARY MINUS
	HRRZ	TE,EMODEB
	CAIN	TE,FPMODE
	JRST	DIVX40
	CAIN	TE,F2MODE
	JRST	DIVXF2

DIVX5B:	MOVE	TE,EDPLA	;WILL THERE BE ENOUGH DECIMAL PLACES?
	SUB	TE,EDPLB
	MOVE	TD,ERESDP
	CAML	TE,TD
	JRST	DIVX5A		;YES

	MOVE	TE,[XWD EBASEB,ESAVEB];NO--ADJUST DP OF "A"
	BLT	TE,ESAVBX
	ADDM	TD,EDPLB
	PUSHJ	PP,ADJDPA##	;[466] SAVE ADJUSTMENT AMNT MIGHT NEED

	MOVE	TE,[XWD ESAVEB,EBASEB]
	BLT	TE,EBASBX
	JRST	DIVX5D

DIVX5A:	TSWF	FADJDV		;SHOULD WE TRY TO ADJUST DIVISOR?
	CAMG	TE,TD		;YES--SHOULD WE ADJUST IT?
	JRST	DIVX5D		;NO

	PUSHJ	PP,SWAPEM	;YES--SWAP OPERANDS
	HRRZ	TE,EBASEA	;IS NEW "A" IN AC'S?
	CAILE	TE,17
	PUSHJ	PP,MXAC.	;NO--PUT IT THERE
	MOVE	TE,[XWD EBASEB,ESAVEB]	;SAVE "B" PARAMETERS
	BLT	TE,ESAVBX
	MOVN	TD,ERESDP
	ADDM	TD,EDPLB
	PUSHJ	PP,ADJDPA##	;[466]ADJUST DECIMAL PLACES  BUT SAVE AMT
	MOVE	TE,[XWD ESAVEB,EBASEB]	;RESTORE "B"
	BLT	TE,EBASBX
	PUSHJ	PP,SWAPEM	;RE-SWAP OPERANDS

DIVX5D:	TSWF	FERROR;
	POPJ	PP,

	SKIPL	REMRND		;SPECIAL ROUNDING REQUIRED?
	JRST	DIVX5E		;NO

; STORE THE DIVISOR IN %TEMP IF IT'S NOW IN AC'S. THIS WILL ALLOW THE
; ROUNDING CODE IN CMNGEN TO WORK. STORE LOCATION OF DIVISOR IN RH(REMRND)
; AND REMRN1. NOTE: IF DIVISOR IS A ONE-WORD COMP, NO %TEMP IS NEEDED.

	MOVE	TD,ESIZEB
	HRLM	TD,REMRND	;RH (REMRND) = SIZE OF DIVISOR
	SETZM	SGNREM##	;CLEAR FLAGS
	SETZM	SGNDIV##
	TSWF	FASIGN		;IS DIVIDEND SIGNED?
	SETOM	SGNREM##	;YES--REMAINDER MAY BE NEGATIVE
	TSWT	FBSIGN		;IS DIVISOR SIGNED?
	 JRST	.+3		;NO
	SETOM	SGNREM##	;YES-- BOTH REMAINDER AND
	SETOM	SGNDIV##	; DIVISOR MAY BE NEGATIVE
	HRRZ	TE,EBASEB	;WHERE IS THE DIVISOR?
	CAILE	TE,17		; DID WE MOVE IT TO AC'S?
	 JRST	[HRRM	TE,REMRND	;NO--REMEMBER WHERE IT IS
		MOVE	TE,EINCRB
		MOVEM	TE,REMRN1##
		JRST	DIVX5E]
	MOVEI	TE,2		;NEED TO ALLOCATE SPACE FOR REMAINDER
	MOVEM	TE,ETEMPC	; SINCE REST OF COMPILER KNOWS
				; REMAINDER IS AT %TEMP+0
				; AND POSSIBLY %TEMP+1
	MOVE	TC,EMODEB	;GET MODE
	CAIE	TC,D2MODE
	CAIN	TC,F2MODE
	SKIPA	TE,[2]		;NEED 2 WORDS
	MOVEI	TE,1		;ONLY 1 WORD
	PUSHJ	PP,GETEMP	;THIS FOR "B"
IFN BIS,<
	CAIE	TC,D2MODE	;D.P.
	CAIN	TC,F2MODE
	TRNA			;YES
	JRST	.+3		;NO
	PUSHJ	PP,PUTASA##	;YES, ENABLE FOR NEW INST.
	SKIPA	CH,[DMOVM.+ASINC,,AS.MSC]
>
	MOVE	CH,[XWD MOVEM.+ASINC,AS.MSC]
	HRRZ	TE,EBASEB	;PUT AC FIELD IN INSTRUCTION
	DPB	TE,CHAC
	PUSHJ	PP,PUTASY
	HRRZI	CH,AS.MSC	;BASE IN RH (REMRND)
	HRRM	CH,REMRND
	HRRZ	CH,EACC
	HRRZM	CH,REMRN1	;INCREMENT IN REMRN1
	PUSHJ	PP,PUTASN
IFE BIS,<
	CAIE	TC,D2MODE
	CAIN	TC,F2MODE
	SKIPA	CH,[XWD MOVEM.+ASINC,AS.MSC]
	JRST	DIVX5E		;NOT D.P.
	HRRZ	TE,EBASEB	;PUT AC FIELD IN INSTRUCTION
	ADDI	TE,1
	DPB	TE,CHAC
	PUSHJ	PP,PUTASY
	MOVEI	CH,1(EACC)
	PUSHJ	PP,PUTASN
>

DIVX5E:	HRRZ	TE,EMODEA
	JRST	@DIVT.1(TE)
;"A" IS A 1-WORD COMP OR INDEX
DIVX.6:	HRRZ	TC,EMODEB
	CAIE	TC,D1MODE
	JRST	DIVX.7
	MOVSI	CH,DIV.11
	MOVE	TE,EBASEB	
	CAIE	TE,AS.MSC	;WAS IT RESET TO MISC?
	JRST	DIVX.8		;NO
	LDB	TE,[POINT 3,EINCRB,20]
	CAIE	TE,AC.LIT##	;I.E. A LITERAL
	JUMPN	TE,DIVX.8	;OR ABS VALUE
	MOVE	TE,EREM4
	TLNE	TE,GNSERA	;DO WE NEED SIZE ERROR CODE?
	SKIPL	OVFLFL		;OR NO CHANCE OF OVERFLOW?
	JRST	DIVX60		;NO, SO NO NEED FOR OVERFLOW CHECK
	PUSHJ	PP,PUTASA
	MOVE	CH,[JOV.##+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	MOVEI	CH,AS.DOT##+1
	PUSHJ	PP,PUTASN	;JOV .+1
DIVX60:	MOVE	TE,EINCRB	;GET VALUE
	TRNN	TE,AS.LIT	;LITERAL?
	JRST	[MOVE	CH,[IDIVI.##+ASINC,,AS.CNB]
		PUSHJ	PP,PUT.XA
		MOVE	CH,EINCRB
		PUSHJ	PP,PUTASN
		JRST	DIVX61]
	MOVSI	CH,IDIV.##
	PUSHJ	PP,PUT.BA	;IDIV EAC,[LITERAL]
DIVX61:	LDB	TE,[POINT 8,EREM4,8]
	CAIE	TE,REMOP	;REMAINDER?
	JRST	DIVX62		;NO, SO NO NEED FOR REMAINDER STORE
	MOVE	CH,EAC
	DPB	CH,CHAC##	;PUT IN AC FIELD
	ADD	CH,[MOVEM.+AC1,,2]
	PUSHJ	PP,PUTASY	;MOVEM EAC+1,EAC+2 - STORE REMAINDER
DIVX62:	MOVE	TE,EREM4
	TLNE	TE,GNSERA	;SIZE ERROR CHECK WANTED?
	SKIPL	OVFLFL		;OR NO CHANCE OF OVERFLOW?
	JRST	DIVX63		;NO SIZE ERROR CODE
	PUSHJ	PP,PUTASA
	MOVE	CH,[JOV.+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	MOVEI	CH,AS.DOT+2
	PUSHJ	PP,PUTASN	;JOV .+2
	PUSHJ	PP,PUTASA
	MOVE	CH,[XJRST.##+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	MOVEI	CH,AS.DOT+2
	PUSHJ	PP,PUTASN	;JRST .+2
	MOVE	CH,[SETOM.##,,OVFLO.##]
	PUSHJ	PP,PUT.EX	;SETOM. OVFLO.
DIVX63:	HRRES	OVFLFL		;RESET FLAG
	JRST	DIVX.9		;CONTINUE
DIVX.7:	MOVEM	TC,EMODEA
	MOVSI	CH,DIV.12

DIVX.8:	PUSHJ	PP,PUT.BA	;WRITE OUT THE INSTRUCTION
DIVX.9:	MOVN	TE,EDPLB	;ADJUST DECIMAL PLACES IN "A"
	MOVE	TD,EDPLA
	ADDM	TE,EDPLA

	MOVE	TE,ESIZEB
	DPB	TE,ACSIZE
	DPB	TC,ACMODE
	MOVEM	TD,REMPAR
	POPJ	PP,

;"A" IS A 2-WORD COMP.
DIVX10:	HRRZ	TC,EMODEB
	MOVSI	CH,DIV.21
	CAIE	TC,D1MODE
	MOVSI	CH,DIV.22
	JRST	DIVX.8

;"A" IS COMP-1

DIVX40:	HRRZ	TE,EMODEB
	CAIE	TE,FPMODE
	PUSHJ	PP,GTBFP
	MOVSI	CH,FDV.
	PUSHJ	PP,PUT.BA
	MOVEI	TD,0		;SET UP REMAINDER PARAMETER
	MOVEI	TE,FPMODE
	DPB	TE,ACMODE
	MOVEM	TD,REMPAR
	POPJ	PP,

;"A" IS COMP-2

DIVXF2:	HRRZ	TE,EMODEB
	CAIE	TE,F2MODE
	PUSHJ	PP,GTBF2
	PUSHJ	PP,PUTASA
	MOVSI	CH,DFDV.
	PUSHJ	PP,PUT.BA
	MOVEI	TD,0		;SET UP REMAINDER PARAMETER
	MOVEI	TE,F2MODE
	DPB	TE,ACMODE
	MOVEM	TD,REMPAR
	POPJ	PP,
IFN BIS,<
DIVX11:	HRRZ	TC,EMODEB
	MOVEI	CH,DIV%41##
	CAIE	TC,D1MODE
	MOVEI	CH,DIV%42##
	PUSHJ	PP,PMOPB.##
	MOVEI	TC,D2MODE
	MOVEM	TC,EMODEA		;WILL BE 2-WORDS SOON
	MOVEI	TC,MAXSIZ		;MOST THAT WILL FIT IN 2 WORDS
	MOVEM	TC,ESIZEA
	PUSHJ	PP,CREATL##
	MOVE	EACC,EPWR10##(TC)	;GET 10*MAXSIZ
	MOVEI	CH,DIV%42		;SO ADJUST TO FIT
	PUSHJ	PP,PMOPV.##
	PUSHJ	PP,PUTASA##
	MOVE	CH,[DMOVE.##,,4]
	PUSHJ	PP,PUTASY		;PUT LOW ORDER WORDS IN 0 & 1
	HRRZ	TC,EMODEB
	JRST	DIVX.9
>
;DIVIDE ONE-WORD COMP BY HALF-WORD LITERAL

DIVX50:	TSWF	FERROR		;ANY ERRORS?
	POPJ	PP,		;YES--QUIT

	JUMPE	TC,CANT0	;CANNOT DIVIDE BY ZERO
	TSWF	FALWY0		;AC'S ALREADY ZERO?
	POPJ	PP,		;YES--NO CODE

	CAIE	TC,1		;IS DIVISIOR +1
	CAMN	TC,[-1]		; OR -1
	CAIA			;YES, THIS IS THE ONLY CASE THAT CAN CAUSE OVERFLOW
	HRRZS	OVFLFL		;NO, SO SET FLAG TO SKIP OVERFLOW GENERATION

	MOVE	TE,OPERND	;UNARY MINUS?
	MOVE	TE,1(TE)
	TLNE	TE,NEGEOP
	TSWC	FLNEG		;YES--NEGATE LITERAL

REPEAT 0,<			;NOT YET WORKING, COMPUTE FAILS
	TSWT	FLNEG		;NEGATIVE?
	SKIPA	TA,TC		;NO
	MOVN	TA,TC		;YES
	TLNN	TA,-1		;18 BITS ONLY?
	JRST	DIVX51		;YES, USE IDIVI
>

	MOVE	TA,[XWD D1LIT,1];CREATE LITERAL
	PUSHJ	PP,STASHP
	TSWT	FLNEG		;NEGATIVE?
	SKIPA	TA,TC		;NO
	MOVN	TA,TC		;YES
	PUSHJ	PP,POOLIT

	MOVEI	TE,D1MODE
	MOVEM	TE,EMODEB
	SKIPN	TE,PLITPC
	MOVE	TE,ELITPC
	IORI	TE,AS.LIT
	MOVEM	TE,EINCRB

	MOVEI	TE,AS.MSC
	MOVEM	TE,EBASEB
	SKIPN	PLITPC
	AOS	ELITPC
	SWON	FBSIGN
IFN ANS74,<
	SKIPE	DIVSRS		;[1472] IS IT DIVIDE SERIES?
	SKIPE	DIVTMP		;[1472]  AND "B" NOT SAVED YET?
	SKIPA			;[1472] NO
	JRST	DIVX5S		;[1472] YES
> ;[1472]
	JRST	DIVX5B

DIVX51:	MOVEM	TA,EINCRB	;STORE NUMBER
	MOVEI	TE,D1MODE
	MOVEM	TE,EMODEB	;SET NEW MODE
	MOVEI	TE,AS.MSC
	MOVEM	TE,EBASEB
	SWON	FBSIGN
	JRST	DIVX5B
;GENERATE CODE FOR EXPONENTIATION

EXPX.:	HRRZ	TE,EMODEA	;IS "A" FLOATING-POINT?
IFN BIS,<
	CAIN	TE,D4MODE##	;DISPLAY-4?
	 PJRST	TOOBIG		;YES, ?INTERMEDIATE TOO LARGE
>;END IFN BIS
IFE BIS,<
	CAIE	TE,FPMODE	;COMP-1?
	PUSHJ	PP,CCXFP.	;NO--CONVERT IT TO FLOATING-POINT
>
IFN BIS,<
	CAIE	TE,F2MODE	;COMP-2?
	PUSHJ	PP,CCXF2.	;NO--CONVERT IT TO FLOATING-POINT
>
	PUSHJ	PP,FORCX0	;BE SURE IT IS IN AC 1

	HRRZ	TE,EMODEB	;GET MODE OF "B"
IFN BIS,<
	CAIN	TE,D4MODE##	;IS "B" A LARGE INTERMEDIATE VALUE?	
	 PJRST	TOOBIG		;YES, WON'T WORK!
>;END IFN BIS
	CAIN	TE,FCMODE	;IS "B" A FIG. CONST.?
	JRST	EXPX15		;YES

	CAIE	TE,LTMODE	;IS "B" A LITERAL?
	JRST	EXPX4		;NO

;"B" IS A LITERAL

	MOVE	TE,EBYTEB	;SAVE
	MOVEM	TE,ESAVER	;	BYTE POINTER TO LITERAL
	MOVE	TE,ESIZEB	;	AND
	MOVEM	TE,ESAVER+1	;	IT'S SIZE

	MOVEI	LN,EBASEB	;GET IT'S VALUE
	PUSHJ	PP,CONVNL
	TSWF	FERROR;
	POPJ	PP,

	JUMPN	TD,EXPX2
	JUMPE	TC,EXPX16
	SKIPN	EDPLB
	JRST	EXPX3
;GENERATE CODE FOR EXPONENTIATION  (CONT'D).

;LITERAL HAS TO BE FLOATING POINT

EXPX2:	MOVE	TE,ESAVER
	MOVEM	TE,EBYTEB
	MOVE	TE,ESAVER+1
	MOVEM	TE,ESIZEB
	SETZM	EDPLB
	PUSHJ	PP,MSFP%L	;CREATE A FLOATING-POINT LITERAL
	HRRZ	TE,EMODEA
	CAIN	TE,F2MODE	;COMP-2?
	JRST	EXPX22		;YES
	MOVE	CH,[XWD E.C3C3,AS.MSC]
	PUSHJ	PP,PUTASY
	HRRZ	CH,TC
	JRST	PUTASN

EXPX22:	MOVE	CH,[MOVEI.+AC16,,AS.MSC]
	PUSHJ	PP,PUTASY
	HRRZ	CH,TC
	PUSHJ	PP,PUTASN
	MOVEI	CH,E.F2FP
	JRST	PUT.PJ

EXPX3:	MOVSI	CH,E.C3C1
	MOVE	TE,OPERND	;IS LITERAL TO BE NEGATED?
	MOVE	TE,1(TE)
	TLNE	TE,NEGEOP
	TSWC	FLNEG		;YES--COMPLEMENT SIGN INDICATOR
	TSWFZ	FLNEG;
	MOVNS	TC
	JRST	PUT.L
;GENERATE EXPONENTIATION  (CONT'D)

;"B" IS NOT A LITERAL

EXPX4:	SETOM	NOFLOT##	;DON'T FLOAT IF INTEGER
	PUSHJ	PP,SETBX	;SET UP "B"
	  POPJ	PP,		;ERROR--QUIT

	MOVE	TE,OPERND	;IS "B" TO BE NEGATED?
	MOVE	TE,1(TE)
	TLNN	TE,NEGEOP
	JRST	EXPX5		;NO

	PUSHJ	PP,SWAPEM	;YES--SWAP OPERANDS
	PUSHJ	PP,MNXAC.	;GET NEGATIVE OF "B" INTO AC'S
	PUSHJ	PP,SWAPEM	;SWAP OPERANDS BACK

EXPX5:	HRRZ	TE,EMODEA
	CAIN	TE,F2MODE	;IS "A" COMP-2?
	JRST	EXPX25		;YES
	HRRZ	TE,EMODEB
	CAIN	TE,FPMODE
	JRST	EXPX8
	CAIN	TE,F2MODE	;IS "B" COMP-2?
	JRST	EXPX20		;YES, MAKE "A" COMP-2 ALSO

;GENERATE EXPONENTIATION (CONT'D)

;"B" IS COMP

	SKIPN	EDPLB
	CAIE	TE,D1MODE
	JRST	EXPX7
	PUSHJ	PP,SUBSCB
	MOVSI	CH,E.C3C1
	JRST	PUT.B

EXPX7:	PUSHJ	PP,GTBFP
	JRST	EXPX9

;"B" IS COMP-1

EXPX8:	PUSHJ	PP,SUBSCB
EXPX9:	MOVSI	CH,E.C3C3
	JRST	PUT.B

;"B" IS A FIG. CONST.

EXPX15:	MOVE	TE,OPERND
	MOVE	TE,(TE)
	TLNN	TE,GNFCZ
	JRST	BADFIG

EXPX16:	MOVE	CH,[XWD HRLZI.+AC1,AS.CNB]
	PUSHJ	PP,PUTASY
	MOVEI	CH,(1.0)
	SETZM	EAC
	PUSHJ	PP,PUTASN
	PUSHJ	PP,PUTASA
	MOVSI	CH,SETZ.+AC1	;JUST INCASE 2 WORDS
	JRST	PUTASY

;"A" IS COMP-2

EXPX25:	HRRZ	TE,EMODEB
	CAIE	TE,FPMODE
	CAIN	TE,F2MODE
	JRST	EXPX28

;GENERATE EXPONENTIATION (CONT'D)

;"B" IS COMP

	SKIPE	EDPLB
	JRST	EXPX27		;CONVERT TO COMP-2
	PUSHJ	PP,SUBSCB
	MOVSI	CH,MOVEI.+AC16
	PUSHJ	PP,PUT.B
	HRRZ	TE,EMODEB
	MOVEI	CH,E.F2D1
	CAIE	TE,D1MODE
	MOVEI	CH,E.F2D2
	JRST	PUT.PJ

EXPX27:	PUSHJ	PP,GTBF2
	JRST	EXPX29

;"B" IS COMP-1 OR COMP-2

EXPX28:	PUSHJ	PP,SUBSCB
EXPX29:	MOVSI	CH,MOVEI.+AC16
	PUSHJ	PP,PUT.B
	HRRZ	TE,EMODEB
	MOVEI	CH,E.F2FP
	CAIE	TE,FPMODE
	MOVEI	CH,E.F2F2
	JRST	PUT.PJ

EXPX20:	PUSHJ	PP,PUTASA
	MOVSI	CH,SETZ.+AC1
	PUSHJ	PP,PUTASY	;CONVERT TO "A" TO COMP-2
	MOVEI	TE,F2MODE
	MOVEM	TE,EMODEA
	JRST	EXPX25		;AND CONTINUE
;SET UP B-OPERAND FOR ARITHMETIC VERBS

;IF "B" IS A LITERAL, AND "A" IS COMP-1, CREATE A COMP-1 LITERAL AND
;	RETURN TO CALL+2.
;IF "B" IS A LITERAL, AND "A" IS COMP-2, CREATE A COMP-2 LITERAL AND
;	RETURN TO CALL+2.
;IF "B" IS A LITERAL, AND "A" IS NOT COMP-1 OR COMP-2, CREATE A LITERAL AND
;	RETURN TO CALL+2 UNLESS VALUE OF LITERAL FITS A HALF-WORD,
;	IN WHICH CASE RETURN TO CALL+1 WITH VALUE OF LITERAL
;	IN ACCUMULATOR TC.
;IF "A" IS COMP-1, CONVERT "B" TO COMP-1 (IF NECESSARY) AND RETURN
;	TO CALL+2.
;IF "B" IS COMP-1, CONVERT "A" TO COMP-1 (IF NECESSARY) AND RETURN
;	TO CALL+2.
;IF "A" IS COMP-2, CONVERT "B" TO COMP-2 (IF NECESSARY) AND RETURN
;	TO CALL+2.
;IF "B" IS COMP-2 CONVERT "A" TO COMP-2 (IF NECESSARY) AND RETURN
;	TO CALL+2.
;IF "B" IS DISPLAY, CONVERT IT TO COMP.

;ON ANY OF THE ABOVE, IF ERRORS FOUND RETURN TO CALL+1.

SETB:	SETZM	NOFLOT		;CLEAR FLAG SINCE IT MIGHT HAVE BEEN LEFT ON
SETBX:	HRRZ	TE,EMODEA	;IF MODE IS
	CAIE	TE,FPMODE	;  FLOATING-POINT,
	CAIN	TE,FCMODE	;  OR FIG. CONST.,
	JRST	SETB0		;  DON'T DO SIZE TEST
	CAIN	TE,F2MODE	;SAME FOR COMP-2
	JRST	SETB0
	MOVE	TE,ESIZEA	;IF SIZE IS
	CAIG	TE,MAXSIZ+<BIS*^D20>	;  REASONABLE,
	JRST	SETB0		;  WE'RE HAPPY
	SWON	FERROR		;FORCE NO CODE
	POPJ	PP,

SETB0:	HRRZ	TE,EMODEB	;GET TYPE OF B-OPERAND
	CAIE	TE,LTMODE	;IS IT A LITERAL?
	JRST	SETB8		;NO

	TSWT	FBNUM		;YES--NUMERIC?
	JRST	NOTNUM		;NO
	SWON	FBSIGN		;YES--MUST BE SIGNED

	MOVEI	LN,EBASEB	;GET READY TO GET LITERAL VALUE

	HRRZ	TE,EMODEA
	CAIN	TE,F2MODE	;IS "A" COMP-2?
	JRST	SETB1F		;YES

	CAIE	TE,FPMODE	;IS "A" COMP-1?
	JRST	SETB2		;NO

	PUSHJ	PP,MSFP%L	;YES--CREATE A COMP-1 LITERAL
	MOVEI	TE,FPMODE	;FORCE MODE TO BE COMP-1

SETB1:	MOVEM	TE,EMODEB
	MOVEI	TE,AS.MSC	;GET ADDRESS
	MOVEM	TE,EBASEB
	MOVEM	TC,EINCRB

SETB1A:	TSWT	FERROR		;ANY ERRORS?
	AOS	(PP)		;NO--RETURN TO CALL+2
	POPJ	PP,

SETB1F:	PUSHJ	PP,MSF2%L	;YES--CREATE A COMP-2 LITERAL
	MOVEI	TE,F2MODE	;FORCE MODE TO BE COMP-2
	JRST	SETB1
;SET UP 'B' OPERAND (CONT'D)

;"B" IS NON-FLOATING-POINT LITERAL

SETB2:	PUSHJ	PP,CONVNL	;GET VALUE
	MOVE	TE,OPERND
	MOVE	CH,1(TE)
	TLZE	CH,NEGEOP
	TSWC	FLNEG;
	MOVEM	CH,1(TE)

SETB2A:	JUMPE	TD,SETB4	;TWO-WORD LITERAL?

;"B" IS TWO-WORD LITERAL

	TSWFZ	FLNEG		;NEGATIVE?
	PUSHJ	PP,NEGATL	;YES--NEGATE VALUE
	MOVE	TA,[XWD D2LIT,2];CREATE LITERAL
	PUSHJ	PP,STASHP
	MOVE	TA,TD
	PUSHJ	PP,STASHQ
	MOVE	TA,TC
	PUSHJ	PP,POOLIT

	MOVEI	TE,D2MODE
	MOVEI	TC,2

SETB3:	SKIPE	PLITPC
	JRST	[MOVE	TC,PLITPC
		JRST	SETB3A]
	EXCH	TC,ELITPC
	ADDM	TC,ELITPC
SETB3A:	IORI	TC,AS.LIT
	JRST	SETB1

;"B" IS ONE-WORD LITERAL

SETB4:	JUMPE	TC,CPOPJ	;RETURN IF ZERO VALUE
	HRRZ	TE,EMODEA	;IS MODE
	CAIN	TE,D1MODE	;  ONE-WORD COMP?
	TLNE	TC,-1		;YES--IS VALUE ONLY HALF-WORD?
	JRST	SETB5		;NO--NEED LITERAL
	POPJ	PP,		;YES--RETURN WITH VALUE

SETB5:	MOVE	TA,[XWD D1LIT,1];CREATE LITERAL
	PUSHJ	PP,STASHP
	TSWTZ	FLNEG		;IS IT NEGATIVE?
	SKIPA	TA,TC		;NO
	MOVN	TA,TC		;YES
	PUSHJ	PP,POOLIT

	MOVEI	TE,D1MODE
	MOVEI	TC,1
	JRST	SETB3
;SET UP "B" OPERAND (CONT'D).

;"B" IS NOT A LITERAL

SETB8:	CAIE	TE,FCMODE	;IS "B" FIG. CONST.?
	JRST	SETB10		;NO

	SETZB	TC,TD		;YES--
	MOVE	TE,OPERND	;  IT
	MOVE	TD,(TE)		;  MUST BE
	TLNE	TD,GNFCZ	;  "ZERO"
	JRST	SETB4		;IT IS -- OK

	HRRZM	TE,CUREOP	;IT ISN'T --
	JRST	BADFIG		;ERROR


;"B" IS A DATA-ITEM

SETB10:	HRRZ	TD,EMODEA
	CAIE	TE,F2MODE	;IS "B" COMP-2?
	JRST	SETB16		;NO
	CAIE	TD,F2MODE	;YES--IS "A" ALSO COMP-2?
	PUSHJ	PP,CCXF2.	;NO--CONVERT "A" TO COMP-2
	JRST	SETB1A		;RETURN

SETB16:	CAIE	TE,FPMODE	;IS "B" COMP-1?
	JRST	SETB11		;NO
	CAIN	TD,F2MODE	;[1113] IS "A" COMP-2?
	JRST	SETB20		;[1113] YES, CONVERT "B" TO COMP-2
	CAIE	TD,FPMODE	;YES--IS "A" ALSO COMP-1?
	PUSHJ	PP,CCXFP.	;NO--CONVERT "A" TO COMP-1
	JRST	SETB1A		;RETURN

;"B" IS COMP-1, GET IT INTO THE ACCS AS COMP-2

SETB20:	HRRZ	TE,EBASEB	;[1113] IS "B" IN
	SKIPN	TE		;[1113]  AC'S 0&1?
	PUSHJ	PP,EXCHAC	;[1113] YES--EXCHANGE AC'S
	PUSHJ	PP,SWAPEM	;[1113] EXCHANGE OPERANDS
	PUSHJ	PP,MXF2A.	;[1113] GET "B" INTO AC'S AS COMP-2
	PUSHJ	PP,SWAPEM	;[1113] RE-EXCHANGE OPERANDS
	JRST	SETB1A		;[1113] RETURN

;"B" IS NOT COMP-1 OR COMP-2

SETB11:	CAIE	TD,F2MODE	;IS "A" COMP-2?
	JRST	SETB17		;NO
	SKIPE	NOFLOT		;DO WE HAVE TO CHECK FIRST?
	SKIPE	EDPLB		;YES, ANY DECIMAL PLACES?
	JRST	SETB18		;FLOAT IT
	CAIN	TE,D1MODE	;IS "B" 1 WORD COMP?
	JRST	SETB1A		;YES, LEAVE AS IS
	MOVE	TD,ESIZEB	;GET SIZE
	CAIG	TE,DSMODE	;DISPLAY MODE?
	CAILE	TE,^D10		;CONVERT TO 1-WORD COMP?
	JRST	SETB18		;NO, JUST FLOAT IT
	JRST	SETB19		;YES, GET INTO ACCS AS 1-WORD COMP

SETB18:	HRRZ	TE,EBASEB	;YES--IS "B" IN
	SKIPN	TE		;  AC'S 0&1?
	PUSHJ	PP,EXCHAC	;YES--EXCHANGE AC'S
	PUSHJ	PP,SWAPEM	;EXCHANGE OPERANDS
	PUSHJ	PP,MXF2A.	;GET "B" INTO AC'S AS COMP-2
	PUSHJ	PP,SWAPEM	;RE-EXCHANGE OPERANDS
	JRST	SETB1A		;RETURN

SETB17:	CAIE	TD,FPMODE	;IS "A" COMP-1?
	JRST	SETB12		;NO

	SKIPE	NOFLOT		;DO WE HAVE TO CHECK FIRST?
	SKIPE	EDPLB		;YES, ANY DECIMAL PLACES?
	JRST	SETB15		;FLOAT IT
	CAIN	TE,D1MODE	;IS "B" 1 WORD COMP?
	JRST	SETB1A		;YES, LEAVE AS IS
	MOVE	TD,ESIZEB	;GET SIZE
	CAIG	TE,DSMODE	;DISPLAY MODE?
	CAILE	TE,^D10		;CONVERT TO 1-WORD COMP?
	JRST	SETB15		;NO, JUST FLOAT IT

SETB19:	HRRZ	TE,EBASEB	;YES--IS "B" IN
	SKIPN	TE		;  AC'S 0&1?
	PUSHJ	PP,EXCHAC	;YES--EXCHANGE AC'S
	PUSHJ	PP,SWAPEM	;EXCHANGE OPERANDS
	PUSHJ	PP,MXAC.	;GET "B" INTO AC'S AS 1-WORD COMP
	PUSHJ	PP,SWAPEM	;RE-EXCHANGE OPERANDS
	JRST	SETB1A		;RETURN

SETB15:	HRRZ	TE,EBASEB	;YES--IS "B" IN
	SKIPN	TE		;  AC'S 0&1?
	PUSHJ	PP,EXCHAC	;YES--EXCHANGE AC'S
	PUSHJ	PP,SWAPEM	;EXCHANGE OPERANDS
	PUSHJ	PP,MXFPA.	;GET "B" INTO AC'S AS COMP-1
	PUSHJ	PP,SWAPEM	;RE-EXCHANGE OPERANDS
	JRST	SETB1A		;RETURN
;SET UP "B" OPERAND (CONT'D)

;"B" IS DATA-ITEM, AND NEITHER "A" NOR "B" IS COMP-1 OR COMP-2

SETB12:	CAILE	TE,DSMODE	;IS "B" DISPLAY?
	JRST	SETB14		;NO

SETB13:	PUSHJ	PP,SWAPEM	;EXCHANGE OPERANDS
	PUSHJ	PP,MXAC.	;GET "B" INTO AC'S
	PUSHJ	PP,SWAPEM	;RE-EXCHANGE AC'S
	JRST	SETB1A		;RETURN

SETB14:	TSWF	FBSIGN		;IF "B" IS NOT SIGNED OR
	CAIN	TE,C3MODE##	; IS COMP-3
	JRST	SETB13		;MOVE IT TO THE AC'S.
	JRST	SETB1A		;OTHERWISE, LEAVE IT IN MEMORY.
;SET UP DECIMAL PLACES FOR ADD OR SUBTRACT

;IF "A" IS COMP-1, SIMPLY RETURN ("SETB" HAS INSURED THAT "B" IS ALSO COMP-1).
;IF "A" IS COMP-2, SIMPLY RETURN ("SETB" HAS INSURED THAT "B" IS ALSO COMP-2).
;IF "A" HAS FEWER DECIMAL PLACES, ADJUST "A".
;IF "B" HAS FEWER DECIMAL PLACES, ADJUST "B".

SETDP:	HRRZ	TE,EMODEA
	CAIE	TE,FPMODE
	CAIN	TE,F2MODE
	JRST	SUBSCB

	MOVE	TE,EDPLA
	CAMN	TE,EDPLB
	JRST	SUBSCB

	CAML	TE,EDPLB
	JRST	SETDP1

;"A" HAS FEWER PLACES

	PUSHJ	PP,ADJDP.
	HRRZ	TE,EMODEA	;HAS "A" BECOME
	CAIE	TE,FPMODE	;  COMP-1?
	JRST	SETDP0		;NO
	PUSHJ	PP,SWAPEM	;YES--
	PUSHJ	PP,MXFPA.	;  CONVERT "B" TO
	JRST	SWAPEM		;  COMP-1

SETDP0:	CAIE	TE,F2MODE	;  COMP-2?
	JRST	SUBSCB		;NO
	PUSHJ	PP,SWAPEM	;YES--
	PUSHJ	PP,MXF2A.	;  CONVERT "B" TO
	JRST	SWAPEM		;  COMP-2

;"B" HAS FEWER PLACES

SETDP1:	PUSHJ	PP,SWAPEM	;EXCHANGE OPERANDS
	PUSHJ	PP,MXAC.	;GET "B" INTO AC'S
	PUSHJ	PP,ADJDP.	;ADJUST DECIMAL PLACES
	PUSHJ	PP,SWAPEM	;RE-EXCHANGE OPERANDS

	HRRZ	TE,EMODEB	;HAS "B" BECOME
	CAIN	TE,FPMODE	;  COMP-1?
	JRST	CCXFP.		;YES--CONVERT "A"
	CAIN	TE,F2MODE	;OR COMP-2?
	JRST	CCXF2.		;CONVERT "A" TO COMP-2
	POPJ	PP,		;NO--RETURN
;LOOK AT NEXT ENTRY IN RESTAB.
;IF NO MORE ENTRIES, EXIT TO CALL+1; OTHERWISE EXIT WILL BE TO CALL+2.
;IF IT HAS MORE INTEGRAL PLACES, OR MORE DECIMAL PLACES, THAN AC'S,
;OR NEXT ENTRY IS S.P. AND PREVIOUS WAS D.P.
;AND CONTENTS OF AC'S WERE PREVIOUSLY STASHED IN A TEMPORARY, GENERATE
;CODE TO PICK UP THAT TEMPORARY.

LUKRES:	SOSG	ERCNT		;ANY MORE?
	POPJ	PP,		;NO--EXIT TO CALL+1

	AOS	(PP)		;EXIT WILL BE TO CALL+2

	MOVEI	TA,2		;BUMP UP TO NEXT ENTRY
	ADDB	TA,CURRES
	HRRZ	TC,0(TA)	;SET POINTER TO RESULT'S EOPTAB ENTRY
	SKIPN	ETEMPR		;ANY TEMP STASHED?
	POPJ	PP,		;NO

	SKIPN	RESTYP		;DOING ANYTHING BUT "MOVEM"?
	SKIPGE	TD,-2(TA)	;WAS LAST RESULT ROUNDED?
	JRST	LUKR5		;YES--TEMP REQUIRED
	TLNE	TD,(1B1)	;WAS LAST RESULT EDITED?
	JRST	LUKR5		;YES, TEMP REQUIRED.

	HRRZ	TD,EMODEA	;ARE AC'S FLOATING POINT?
	CAIN	TD,FPMODE
	JRST	LUKR7		;YES

	HLRZ	TD,1(TA)	;COMPARE INTEGRAL SIZES
	MOVE	TE,ESIZEA
	SUB	TE,EDPLA
	CAMLE	TD,TE
	JRST	LUKR4		;RESULT > AC'S--GET TEMP

	HRRE	TD,1(TA)	;COMPARE DECIMAL PLACES
	CAMLE	TD,EDPLA
	JRST	LUKR4		;GET TEMP

	HLRZ	TE,1(TA)
	ADD	TD,TE		;GET INTERNAL SIZE
	CAILE	TD,^D10		;POSSIBLE PROBLEM IF S.P.
	POPJ	PP,		;NO NEED FOR TEMP
	HLRZ	TE,-1(TA)	;GET PREVIOUS
	HRRE	TD,-1(TA)
	ADD	TD,TE
	CAIG	TD,^D10		;WAS THIS D.P.?
	POPJ	PP,		;NO TEMP NECESSARY

LUKR4:	MOVE	TD,ETEMPR+1	;PICK UP DATA ON TEMP
	LDB	TE,ACMODE
	CAIN	TE,FPMODE
	JRST	LUKR5
	LDB	TE,ACSIZE
	HRRE	TB,TD
	SUB	TE,TB
	MOVE	TD,ESIZEA
	SUB	TD,EDPLA
	CAMLE	TE,TD
	JRST	LUKR5

	CAMG	TB,EDPLA
	POPJ	PP,
;LOOK AT NEXT ENTRY IN RESTAB (CONT'D).

;%TEMP MUST BE PICKED UP
LUKR5:	SETZM	EAC
	MOVE	TD,ETEMPR+1
	LDB	TE,ACSIZE
	MOVEM	TE,ESIZEA

	HRRE	TE,TD
	MOVEM	TE,EDPLA

	LDB	TE,ACMODE
	MOVEM	TE,EMODEA

IFN BIS,<
	CAIE	TE,D2MODE
	CAIN	TE,D4MODE
	JRST	[PUSHJ	PP,PUTASA##
		MOVE	CH,[DMOVE.##+ASINC,,AS.MSC]
		JRST	.+2]
>
	MOVE	CH,[XWD MOV+ASINC,AS.MSC]
	PUSHJ	PP,PUT.XA
	HRRZ	CH,ETEMPR
IFN BIS,<
	HRRZ	TE,EMODEA
	CAIE	TE,D4MODE	;NEED TO RESTORE 4 ACCS?
	JRST	PUTASN
	PUSHJ	PP,PUTASN
	PUSHJ	PP,PUTASA
	MOVE	CH,[DMOVE.+ASINC,,AS.MSC]
	PUSHJ	PP,PUT.XC	;RESTORE ACC+2 AND ACC+3
	MOVE	CH,ETEMPR
	ADDI	CH,2
	JRST	PUTASN
>
IFE BIS,<
	PUSHJ	PP,PUTASN
	MOVE	TE,EMODEA
	CAIE	TE,D2MODE
	POPJ	PP,

	MOVE	CH,[XWD MOV+ASINC,AS.MSC]
	PUSHJ	PP,PUT.XB
	HRRZ	CH,ETEMPR
	AOJA	CH,PUTASN
>

LUKR7:	HLRZ	TE,0(TA)
	ANDCMI	TE,1B18
	CAIE	TE,FPMODE
	JRST	LUKR4
	POPJ	PP,
;SET UP RESTAB
SETRES:	MOVE	TC,EOPLOC
	ADDI	TC,1

STRES0:	MOVEM	TC,CUREOP
	SETZM	ERCNT
	MOVE	EACA,EOPNXT
	CAMN	EACA,EOPLOC
	POPJ	PP,

	MOVE	TB,RESLOC
	MOVEM	TB,RESNXT

STRES1:	PUSHJ	PP,STRES8

	PUSHJ	PP,BMPEOP
	  POPJ	PP,
	HRRZ	TC,CUREOP
	JRST	STRES1
;SET UP RESTAB  (CONT'D)

STRES8:	HLRE	TE,RESNXT
	CAMLE	TE,[-2]
	PUSHJ	PP,XPNRES
	MOVE	TB,RESNXT
	MOVE	TD,TC
	SUB	TD,EOPLOC	;GET A RELATIVE ADDRESS
	HRRZM	TD,1(TB)
	MOVE	TA,1(TC)
IFN ANS68,<
	MOVE	TD,(TC)		;[250] GET 1ST OPERAND WORD
	TLC	TD,GNLIT!GNTALY	;[250] CHECK FOR TALLY
	TLCN	TD,GNLIT!GNTALY	;[250]
	JRST	STRESA		;[250] IT IS TALLY
>
	LDB	TD,LNKCOD
	CAIE	TD,TB.DAT
	JRST	NOTDAT

	PUSHJ	PP,LNKSET
	LDB	TE,DA.CLA
	CAIE	TE,%CL.NU
	JRST	NOTNUM

	LDB	TE,DA.NDP
	LDB	TD,DA.DPR
	SKIPE	TD
	MOVNS	TE
	MOVEM	TE,2(TB)
	LDB	TE,DA.INS
	SUB	TE,2(TB)
	HRLM	TE,2(TB)
	LDB	TE,DA.USG
	SUBI	TE,1
	CAIN	TE,IXMODE
STRESB:			; [250]
	MOVEI	TE,D1MODE
	MOVE	TD,1(TC)
	TLNN	TD,GNROUN
	JRST	STRES9

	IORI	TE,1B18
	AOS	2(TB)
STRES9:	LDB	TD,DA.EDT##
	TRNE	TD,-1
	TRO	TE,(1B1)
STRESC:	HRLM	TE,1(TB)	;[672] ADD LABEL
	AOS	ERCNT
	ADD	TB,[XWD 2,2]
	MOVEM	TB,RESNXT
	POPJ	PP,

IFN ANS68,<			;[672] FIXED TALLY CODE, ANS68 ONLY
STRESA:	MOVEI	TE,5		;[250] GET TALLY SIZE
	HRLZM	TE,2(TB)	;[250] PUT IN 2ND WORD OF RESTAB
	MOVEI	TE,D1MODE	;[672] COMP MODE
	JRST	STRESC		;[672] FINISH UP
>;END IFN ANS68
;SCAN THRU RESTAB.
;IF ANY ENTRY HAS MORE INTEGRAL PLACES, OR MORE DECIMAL PLACES, THAN
;PRECEDING ONES, OR IF ANY NON-FLOATING POINT FOLLOWS A FLOATING POINT,
;OR NEXT ENTRY IS S.P. AND PREVIOUS WAS D.P.
;GET A TEMP LOCATION AND GENERATE CODE TO STASH AC'S THERE.

SCNRES:	TSWF	FALWY0		;IF AC'S ARE ZERO,
	JRST	SCNR3A		;  NO TEMP NEEDED

	MOVE	TE,ERCNT
	SOJLE	TE,CPOPJ

	SKIPN	RESTYP		;RESULT OTHER THAN "MOVEM"?
	TSWF	FSZERA		;ANY SIZE ERROR CLAUSE?
	JRST	SCNRS4		;YES--TEMP NEEDED

	MOVE	TA,RESLOC
	ADDI	TA,1

SCNRS1:	HLRZ	TB,0(TA)	;IS OPERAND ROUNDED?
	TRZN	TB,(1B1)	;OR EDITED?
	TRNE	TB,1B18
	JRST	SCNRS4		;YES--TEMP NEEDED

	CAIE	TB,FPMODE
	JRST	SCNRS2

	HLRZ	TB,2(TA)
	ANDCMI	TB,1B18+1B19
	CAIE	TB,FPMODE
	JRST	SCNRS4
	JRST	SCNRS3

SCNRS2:	HLRZ	TB,1(TA)
	HLRZ	TC,3(TA)
	CAMGE	TB,TC
	JRST	SCNRS4

	CAILE	TB,^D10		;IS THIS D.P.?
	CAILE	TC,^D10		;AND NEXT S.P.?
	CAIA			;NO
	JRST	SCNRS4		;YES, NEED TEMP

	HRRE	TB,1(TA)
	HRRE	TC,3(TA)
	CAMGE	TB,TC
	JRST	SCNRS4

SCNRS3:	ADDI	TA,2
	SOJG	TE,SCNRS1

SCNR3A:	SETZM	ETEMPR
	POPJ	PP,

SCNRS4:	MOVEI	TE,1
	HRRZ	TA,EMODEA
	CAIN	TA,D2MODE
	MOVEI	TE,2
IFN BIS,<
	CAIN	TA,D4MODE
	MOVEI	TE,4
>
	PUSHJ	PP,GETEMP
	HRRZM	EACC,ETEMPR
	HRRZ	TD,EDPLA
	MOVE	TE,ESIZEA
	DPB	TE,ACSIZE
	DPB	TA,ACMODE
	MOVEM	TD,ETEMPR+1
IFN BIS,<
	CAIE	TA,D2MODE
	CAIN	TA,D4MODE
	JRST	[PUSHJ	PP,PUTASA##
		MOVE	CH,[DMOVM.##+ASINC,,AS.MSC]
		JRST	.+2]
>
	MOVE	CH,[XWD MOVEM.+ASINC,AS.MSC]
	PUSHJ	PP,PUT.XA
	HRRZ	CH,ETEMPR
IFN BIS,<
	CAIE	TA,D4MODE	;NEED TO SAVE 4 ACCS?
	JRST	PUTASN
	PUSHJ	PP,PUTASN
	PUSHJ	PP,PUTASA
	MOVE	CH,[DMOVM.+ASINC,,AS.MSC]
	PUSHJ	PP,PUT.XC##	;SAVE ACC+2 AND ACC+3
	MOVE	CH,ETEMPR
	ADDI	CH,2
	JRST	PUTASN
>
IFE BIS,<
	PUSHJ	PP,PUTASN
	CAIE	TA,D2MODE
	POPJ	PP,

	MOVE	CH,[XWD MOVEM.+ASINC,AS.MSC]
	PUSHJ	PP,PUT.XB
	MOVE	CH,ETEMPR
	AOJA	CH,PUTASN
>
;SET UP "B" OPERAND AS A RESULT

RESETB:
IFN ANS74,<			;IF HERE FROM INSPECT, LOCATION "TEMADP"
				; WILL HAVE THE RELATIVE ADDRESS IN TEMTAB
				; WHERE WE HAVE THE OPERAND SAVED... ELSE
				;"TEMADP" WILL BE ZERO
	SKIPN	TC,TEMADP##	;SKIP IF OPERAND IS IN TEMTAB
	 JRST	RSETB0		;NO--TAKE NORMAL ROUTE
;[732] REMOVE CLEARING OF TEMADP - IT WILL BE HANDLED BY THE CALLER
;[732]	SETZM	TEMADP##	;CLEAR FLAG
	ADD	TC,TEMLOC##	;GET ACTUAL LOCATION
	JRST	RSTB0A		; SKIP "HRRZ TC,@CURRES" AND ADD TC,EOPLOC
RSETB0:
>;END IFN ANS74
	HRRZ	TC,@CURRES
	ADD	TC,EOPLOC	;CHANGE RELATIVE ADDRESS TO OPERAND ADDRESS
RSTB0A:	TLZ	TC,-1		;CLEAR LH
	MOVEM	TC,OPERND
	MOVEM	TC,CUREOP

	PUSHJ	PP,SETOPB	;GET PARAMETERS
	MOVE	TC,OPERND	;GET LINK TO
	MOVE	TA,1(TC)	;  OPERAND
IFN ANS68,<
	CAIN	TA,TALLY.	;[250] IS IT TALLY ?
	POPJ	PP,		;[250] YES ALL DONE HERE
>
	PUSHJ	PP,LNKSET	;CONVERT TO ADDRESS
	LDB	TE,DA.CLA	;IF CLASS IS
	CAIE	TE,%CL.NU	;  NOT NUMERIC,
	JRST	RSETB2		;  ERROR
	SWON	FBNUM		;IT IS NUMERIC

	LDB	TE,DA.EDT	;IF IT IS
	JUMPE	TE,RSETB1	;  NOT EDITED, USE EXTERNAL SIZE

	LDB	TE,DA.INS	;IT IS EDITED--GET INTERNAL SIZE
	MOVEM	TE,ESIZEB
	MOVEI	TE,EDMODE	;SET MODE TO NUMERIC-EDITED
	MOVEM	TE,EMODEB
RSETB1:	POPJ	PP,

RSETB2:	SWON	FERROR;
	JRST	NOTNUM
;GET IN RESULT FIELD FOR DIVIDE

SETDIV:	SETOM	OVFLFL##	;SIGNAL DIVIDE DONE, WE NEED OVFLO. TEST
	SETZM	FLTDIV##	;[566] CLEAR COMP-1 RESULT FLAG
	SWOFF	FEOFF1;
	MOVE	EACA,EOPNXT
	MOVEM	EACA,EREM1	; [325]  KEEP EOPTAB LOCATION IN CASE OF ERROR
	MOVEM	W1,OPLINE
	CAMN	EACA,EOPLOC
	JRST	STDIV9
	MOVEM	EACA,EREM0

	PUSHJ	PP,READEM
	HRRZ	TE,W2
	CAIE	TE,RESLT.
	JRST	STDIV9

	MOVEM	EACA,EREM1
	MOVEM	W1,EREM2
	HRRZ	TC,EREM0
	PUSHJ	PP,STDIV7
	TSWF	FERROR		;IF TROUBLE,
	JRST	STDIV4		;  DON'T CHECK ROUNDING
IFN ANS68,<
	SETZM	ERESDP		; [250] SET IN CASE OF TALLY
	MOVE	TD,1(TC)	; [250] GET 1ST OPERAND WORD
	TLC	TD,GNLIT!GNTALY	; [250] CHECK FOR TALLY
	TLCN	TD,GNLIT!GNTALY	; [250]
	JRST	SETDVA		; [250] YES
>
	MOVE	TA,2(TC)	;GET
	PUSHJ	PP,LNKSET	;  NUMBER
	LDB	TE,DA.NDP	;  OF DECIMAL PLACES
	LDB	TD,DA.DPR	;IS DECIMAL POINT
	SKIPE	TD		; TO RIGHT OF FIELD?
	MOVNS	TE		;YES--NEGATE
	MOVEM	TE,ERESDP
	LDB	TE,DA.USG	;[566] GET USAGE OF TARGET
	CAIN	TE,%US.C1	;[566] IF IT IS COMP-1
	SETOM	FLTDIV		;[566] SET FLAG 
SETDVA:				; [250]
	MOVE	TE,2(TC)	;IS RESULT TO BE
	TLNN	TE,GNROUN	;  ROUNDED?
	JRST	STDIV1		;NO
	AOS	ERESDP		;YES--GET ANOTHER DECIMAL PLACE
	SETOM	REMRND##	;IN CASE REMAINDER ALSO
STDIV1:
IFN ANS74,<
	MOVEI	TC,1(TC)
	MOVEM	TC,CUREOP	;SET FOR SERIES TEST
	PUSHJ	PP,BMPEOP	;SEE IF IT IS
	  JRST	STDIV4		;ALL DONE
	SETZM	REMRND		;CAN'T HAVE REM IF SERIES
	SKIPL	DIVSRS		;IS IT DIVIDE INTO SERIES?
	JRST	STDIV5		;YES, COUNT OPERANDS, BUT DON'T FIND MAX.
	MOVE	TC,CUREOP
	SUBI	TC,1		;RESET TC
	MOVE	TA,2(TC)
	PUSHJ	PP,LNKSET
	LDB	TE,DA.NDP	;GET DECIMAL PLACES
	CAMGE	TE,ERESDP	;IS IT SMALLER?
	JRST	STDIV1		;YES, TRY NEXT
	MOVEM	TE,ERESDP	;NO, SET MAX.
	MOVE	TE,2(TC)
	TLNE	TE,GNROUN	;IS THIS ONE ROUNDED?
	AOS	ERESDP		;YES
	JRST	STDIV1		;TRY AGAIN

STDIV5:	AOS	DIVSRS		;COUNT NO. OF OPERANDS
	MOVE	TC,CUREOP
	SOJA	TC,STDIV1	;RESET TC AND TRY AGAIN
>

STDIV4:	PUSHJ	PP,READEM	;GET OPERANDS&OPERATOR AFTER 'RESULT'
	MOVEM	W1,EREM4
	MOVEM	EACA,EREM3
	HRRZ	TE,W2
	CAIE	TE,REMOP
	JRST	STDIV6
	HRRZ	TC,EREM1
	PUSHJ	PP,STDIV7

	MOVSI	TE,GNSERA
	TLNE	W1,GNSERA
	IORM	TE,EREM2
	SKIPGE	REMRND		;ROUNDED ALSO
	SOSA	ERESDP		;YES, REMOVE EXTRA DECIMAL PLACE

STDIV6:	SETZM	REMRND		;NOT BOTH REMAINDER & ROUNDED
	MOVE	W1,OPLINE
	MOVE	TC,EOPLOC
	MOVEI	TC,1(TC)
	MOVEM	TC,CUREOP
	MOVE	EACA,EREM0
	MOVEM	EACA,EOPNXT

	POPJ	PP,
;GET DIVIDE RESULT FIELDS (CONT'D)

;CHECK OPERAND FOR VALIDITY

STDIV7:	CAIN	TC,(EACA)	;WAS AN OPERAND READ?
	JRST	STDIV9		;NO--ERROR
IFN ANS68,<
	MOVE	TD,1(TC)	;[250] GET 1ST OPERAND WORD
	TLC	TD,GNLIT!GNTALY	;[250] CHECK FOR TALLY
	TLCN	TD,GNLIT!GNTALY	;[250]
	POPJ	PP,		;[250] TALLY-OK
>
	MOVE	TA,2(TC)	;IS IT
	LDB	TE,LNKCOD	;  A
	CAIN	TE,TB.DAT	;  DATA-NAME?
	POPJ	PP,		;YES--OK

	MOVEI	TC,1(TC)	;NO, SET UP FOR  OPNFAT
	MOVEM	TC,CUREOP
	JRST	NOTDAT		;PUT OUT DIAG

STDIV9:	CAIN	TE,REMOP
	TDCA	TE,TE
	MOVEM	W1,EREM4	; [325] SAVE W1, FIRST OPERATOR WORD.

	MOVEM	EACA,EREM3
	SWON	FERROR
	POPJ	PP,
;EXCHANGE CONTENTS OF AC'S SUCH THAT "A" IS NOW IN AC'S 0&1.
;CURRENTLY "B" IS THERE.

EXCHAC:	MOVE	TE,EBASEB
	CAILE	TE,1
	POPJ	PP,

	MOVE	TE,EAC
	MOVEM	TE,EBASEB

	MOVSI	CH,EXCH.
	HRR	CH,EAC
	PUSHJ	PP,PUTASY

	HRRZ	TE,EMODEB
	CAIN	TE,D2MODE
	JRST	EXCAC1

	HRRZ	TE,EMODEA
	CAIE	TE,D2MODE
	JRST	EXCAC3

	MOVSI	CH,MOV+AC1
	JRST	EXCAC2

EXCAC1:	MOVSI	CH,MOVEM.+AC1
	HRRZ	TE,EMODEA
	CAIN	TE,D2MODE
	MOVSI	CH,EXCH.

EXCAC2:	HRR	CH,EAC
	ADDI	CH,1
	PUSHJ	PP,PUTASY

EXCAC3:	SETZM	EAC
	POPJ	PP,
;GET "B" INTO AC'S AS COMP-1 NUMBER

GTBFP:	HRRZ	TE,EBASEB	;IS "B" NOW IN AC'S 0&1?
	SKIPN	TE
	PUSHJ	PP,EXCHAC	;YES--EXCHANGE AC'S
	PUSHJ	PP,FORCX0	;BE SURE "A" IS NOW IN 0&1

	PUSHJ	PP,SWAPEM	;SWAP OPERANDS

	PUSHJ	PP,MXFPA.	;GET "B" INTO AC'S AS COMP-1

	JRST	SWAPEM		;RE-SWAP OPERANDS AND LEAVE

;GET "B" INTO AC'S AS COMP-2 NUMBER

GTBF2:	HRRZ	TE,EBASEB	;IS "B" NOW IN AC'S 0&1?
	SKIPN	TE
	PUSHJ	PP,EXCHAC	;YES--EXCHANGE AC'S
	PUSHJ	PP,FORCX0	;BE SURE "A" IS NOW IN 0&1

	PUSHJ	PP,SWAPEM	;SWAP OPERANDS

	PUSHJ	PP,MXF2A.	;GET "B" INTO AC'S AS COMP-2

	JRST	SWAPEM		;RE-SWAP OPERANDS AND LEAVE
;RESET NEW SIZE OF AC'S

CHKSIZ:	MOVE	TE,ESIZEB
	CAMLE	TE,ESIZEA
	JRST	CHKSZ2

CHKSZ1:	AOS	TE,ECARRY
	CAIG	TE,^D9
	POPJ	PP,

	SETZM	ECARRY
	AOS	ESIZEA
	POPJ	PP,

CHKSZ2:	MOVEM	TE,ESIZEA
	MOVEI	TE,1
	MOVEM	TE,ECARRY
	POPJ	PP,


;IF "A" IS 1-WORD COMP, "B" IS 10 DIGITS OR LESS,
;	AND SIZEA OF "A" IS 10, AND ECARRY IS 3, CONVERT "A" TO A 2-WORD COMP.

CHKS10:	HRRZ	TE,EMODEA
	CAIE	TE,D1MODE
	POPJ	PP,

	MOVE	TE,ESIZEB
	CAIL	TE,^D11
	POPJ	PP,

	MOVE	TE,ESIZEA
	CAIE	TE,^D10
	POPJ	PP,

	MOVE	TE,ECARRY
	CAIGE	TE,3
	POPJ	PP,
	JRST	CC1C2.
;SWAP "A" AND "B" PARAMETERS

SWAPEM:	PUSHJ	PP,SWAPAB

	MOVE	TE,EAC
	MOVEM	TE,EBASEB
	SETZM	EINCRB

	SKIPE	EAC
IFE BIS,<
	TDCA	TE,TE
>
IFN BIS,<
	JRST	[SETZB	TE,EAC		;USE 0 & 1
		POPJ	PP,]
	MOVE	TE,EMODEB	;GET MODE OF OLD "A"
	CAIN	TE,D4MODE	;QUADRUPLE PRECISSION?
	SKIPA	TE,[4]		;YES, NEED 0 - 3
>
	MOVEI	TE,2
	MOVEM	TE,EAC

	POPJ	PP,
;NEGATE AC'S IF "B" HAS UNARY MINUS

NEGIF:	MOVE	TE,OPERND
	MOVE	TE,1(TE)
	TLNN	TE,NEGEOP
	POPJ	PP,

	MOVSI	CH,MOVN.
	HRRZ	TE,EMODEA
	CAIE	TE,D2MODE
	JRST	NEGIF2

IFE BIS,<
	MOVSI	CH,NEG.##
>
IFN BIS,<
	PUSHJ	PP,PUTASA
	MOVSI	CH,DMOVN.##
>

NEGIF2:	HRR	CH,EAC
	DPB	CH,CHAC
	JRST	PUTASY
;PUT FIRST OPERAND INTO AC'S
;USED BY ADD,ADDTO,MUL,MULBY,DIV,DIVBY

GRABOP:	SETZM	OVFLFL		;THESE OPERATIONS CANNOT CAUSE OVERFLOW
	SETZM	RESTYP		; [417] SET DEFAULT RESTYP
	SETZM	FLTDIV		;[715] IN CASE LEFT ON BY A DIVIDE
	MOVEM	W1,OPLINE

GRBDIV:	HRRZ	TC,EOPLOC
	ADDI	TC,1

GRBOP0:	MOVE	EACA,EOPNXT
	CAIL	TC,(EACA)	;STILL INSIDE EOPTAB?
	JRST	BADEOP		;NO--TROUBLE

	SWOFF	FEOFF1		;TURN OFF MOST FLAGS

	MOVEM	TC,CUREOP	;SAVE THAT LOCATION
	MOVSM	TC,OPERND

GRBOP1:
IFN ANS74,<
	SETOM	EDEBDA##	;MIGHT NEED TO DEBUG ON DATA-ITEM
	SOS	EDEBDA		; BUT ONLY IF "ARO" ON
>
	PUSHJ	PP,SETOPA	;SET UP "A" PARAMETERS

GRBP1A:	SETZM	EAC		;USE AC'S 0 & 1
	SETZM	ECARRY

GRBOP2:	HRRZ	TE,EMODEA
	CAIN	TE,FCMODE
	JRST	GRBOP9

	TSWF	FANUM		;NUMERIC FIELD?
	JRST	GRBOP5		;YES
	MOVEM	TC,CUREOP	;NO, RESET PTR TO THAT OPERAND
	SETOM	RESTYP		;SET ERROR FLAG
	JRST	NOTNUM		;GIVE "?IMPROPER CLASS" MSG

GRBOP5:	CAIN	TE,LTMODE
	JRST	GRBOP3

	SETZM	RESTYP		;SET RESULT TYPE TO ZERO
	SKIPL	FLTDIV		;[566] DO WE NEED TO FLOAT IT?
	JRST	MXAC.		;GET DATA INTO AC'S AND RETURN
	JRST	MXFPA.		;[566] YES
;PUT FIRST OPERAND INTO AC'S  (CONT'D).

;IT IS A LITERAL.

GRBOP3:	PUSHJ	PP,CONVNL	;GET VALUE INTO TC&TD
	TSWF	FERROR		;ANY ERRORS?
	JRST	GRBOP8		;YES

	SETZM	RESTYP		;NO--CLEAR RESULT TYPE

GRBOP4:	SKIPN	TD		;TREAT ZERO LITERAL IN
	JUMPE	TC,GRBO10	;  SPECIAL WAY
	MOVE	TE,ESIZEA	;ONE WORD LITERAL?
	CAILE	TE,^D10
	JRST	GRBOP6		;NO

	MOVEI	TE,D1MODE	;YES--SET MODE
	MOVEM	TE,EMODEA
	CAIN	TC,1		;1 IS SPECIAL
	JRST	GRBO1A		;AS WE CAN USE AOS OR SOS
	CAMN	TC,[-1]		;OR -1
	JRST	GRBO1B		;SINCE THIS IS SOS OR AOS
	TSWF	FLNEG		;NEGATIVE LITERAL?
	MOVNS	TC		;YES--NEGATE VALUE
	MOVSI	CH,MOV##	;GENERATE <MOVE AC,[LITERAL]>
	JRST	PUT.LA		;	AND RETURN

GRBOP6:	MOVEI	TE,D2MODE
	MOVEM	TE,EMODEA
	TSWF	FLNEG;
	PUSHJ	PP,NEGATL

	MOVE	TA,[XWD D2LIT,2]
	PUSHJ	PP,STASHP
	MOVE	TA,TD
	PUSHJ	PP,STASHQ
	MOVE	TA,TC
	PUSHJ	PP,POOLIT

	MOVEI	TE,AS.MSC
	MOVEM	TE,EBASEA
	SKIPN	TE,PLITPC
	MOVE	TE,ELITPC
	IORI	TE,AS.LIT
	HRRZM	TE,EINCRA
	MOVEI	TE,2
	SKIPN	PLITPC
	ADDM	TE,ELITPC
	JRST	MXAC.

GRBOP7:	PUSHJ	PP,NOTNUM	;PUT OUT "IMPROPER CLASS" DIAG

GRBOP8:	PUSHJ	PP,BMPEOP	;ANY MORE OPERANDS?
	  POPJ	PP,		;NO

	HRRZ	TC,CUREOP	;YES--TRY NEXT ONE
	JRST	GRBOP1
;PUT FIRST OPERAND INTO AC'S (CONT'D)

;IT IS A FIGURATIVE CONSTANT

GRBOP9:	HRRZ	TE,EFLAGA
	CAIE	TE,2
	JRST	GRBOP7
	SETZM	RESTYP		;FIG. CONST ZERO - SET RESTYP TO 0

;LITERAL IS ZERO

GRBO10:	SWON	FALWY0		;SET "AC'S ARE ZERO"
	POPJ	PP,

;LITERAL IS 1

GRBO1A:	MOVEI	TE,3		;AOS
	TSWF	FLNEG		;-1
	MOVEI	TE,4		;SET TO SOS
	MOVEM	TE,RESTYP
	POPJ	PP,		;[545] RETURN

;LITERAL IS -1

GRBO1B:	MOVEI	TE,4		;SAOS
	TSWF	FLNEG		;+1
	MOVEI	TE,3		;SET TO AOS
	MOVEM	TE,RESTYP
	POPJ	PP,		;[545]  RETURN
;CHECK OPERANDS FOR LEGALITY FOR "SET" VERB.
;SET UP LAST OPERAND.

SETSET:	SWOFF	FEOFF1		;TURN OFF MOST FLAGS
	SETZM	FLTDIV		;[566] CLEAR INCASE LEFT ON BY PREV. DIVIDE
	MOVEM	W1,OPLINE	;SAVE LN&CP OF OPERATOR
	SETZM	ERCNT
	SETZM	RESTYP
	SETZM	EAC

	HRRZ	TC,EOPLOC
	ADDI	TC,1
	MOVE	EACA,EOPNXT
	CAIL	TC,(EACA)	;ANY OPERANDS AT ALL?
	JRST	SETST4		;NO--ERROR

SETST1:	MOVEM	TC,CUREOP
IFN ANS68,<
	MOVE	TD,(TC)		;[250] GET 1ST OPERAND WORD
	TLC	TD,GNLIT!GNTALY	;[250] CHECK FOR TALLY
	TLCN	TD,GNLIT!GNTALY	;[250]
	JRST	SETSTA		;[250] YES IT IS TALLY
>
	MOVE	TA,1(TC)
	LDB	TE,LNKCOD
	CAIE	TE,TB.DAT
	JRST	SETST5		;NO--ERROR

	MOVE	TE,0(TC)	;YES--IS IT NUMERIC?
	TLNN	TE,GNOPNM
	JRST	SETST3		;NO--ERROR

	MOVE	TA,1(TC)	;YES--GET POINTER TO DATAB
	PUSHJ	PP,LNKSET

	LDB	TE,DA.NDP	;ANY DECIMAL PLACES?
	JUMPN	TE,SETST3
SETSTA:	AOS	ERCNT		;[250] NO

SETST2:	PUSHJ	PP,BMPEOP	;STEP UP TO NEXT ONE
	  JRST	SETST4		;NO MORE--ERROR

	MOVE	TC,CUREOP	;SAVE LOCATION OF THIS ONE
	PUSHJ	PP,BMPEOP	;WAS THAT THE LAST?
	  JRST	SETST7		;YES
	JRST	SETST1		;NO--GO PROCESS IT


SETST3:	SETOM	RESTYP		;SET ERROR INDICATION
	MOVEI	DW,E.264	;WRITE OUT DIAG
	PUSHJ	PP,OPNFAT
	JRST	SETST2

SETST4:	SETOM	RESTYP		;SET ERROR INDICATION
	JRST	BADEOP		;PUT OUT DIAG

SETST5:	PUSHJ	PP,NOTDAT
	SETOM	RESTYP
	JRST	SETST2
;SET UP LAST OPERAND FOR "SET" VERB  (CONT'D).

;LAST OPERAND IS IN HAND.

SETST7:	MOVEM	TC,CUREOP
	HRLM	TC,OPERND
	MOVEI	TE,-1(TC)	;RESET RESNXT TO DROP THIS ONE
	HRRM	TE,EOPNXT

IFN ANS74,<
	SETOM	EDEBDA		;INCASE DEBUGGING
	SOS	EDEBDA		;ONLY FOR "ARO"
>
	MOVEI	LN,EBASEA	;SET UP PARAMETERS
	PUSHJ	PP,SETOPN
	TSWF	FERROR;
	JRST	STST10

	HRRZ	TE,EMODEA
	CAIN	TE,FCMODE
	JRST	STST12

	TSWT	FANUM		;NUMERIC?
	JRST	SETST8		;NO

	CAIE	TE,LTMODE	;YES--IS IT A LITERAL?
	JRST	STST11		;NO

SETST9:	PUSHJ	PP,CONVNL	;GET VALUE OF LITERAL INTO AC'S
	TSWF	FERROR		;ANY ERRORS?
	JRST	STST10		;YES--QUIT

STST11:	SKIPN	EDPLA		;NO--ANY DECIMAL PLACES?
	POPJ	PP,		;NO--ALL OK

SETST8:	MOVEI	DW,E.264	;WRITE OUT DIAG
	PUSHJ	PP,OPNFAT

STST10:	SETOM	RESTYP		;SET ERROR INDICATION
	POPJ	PP,

STST12:	MOVE	TD,EOPNXT
	MOVE	TD,1(TD)
	TLNN	TD,GNFCZ
	JRST	SETST8
	POPJ	PP,
;ERROR ROUTINES

TOOBIG:	MOVEI	DW,E.88
	JRST	OPERA

BADFIG:	MOVEI	DW,E.211

OPERA:	SWON	FERROR;
	JRST	OPNFAT

CANT0:	MOVE	W1,OPLINE
	MOVEI	DW,E.239
	JRST	OPFAT
ADDT.1=.-3
	EXP ADD1D		;"A" + 1C
	EXP ADD2D		;"A" + 2C
	EXP ADDFP		;"A" + FP
	BLOCK 4
	EXP TOOBIG		;"A" + 4C
	EXP ADDF2		;"A" + F2

SUBT.1=.-3
	EXP SUB1D		;"A" - 1C
	EXP SUB2D		;"A" - 2C
	EXP SUBFP		;"A" - FP
	BLOCK 4
	EXP TOOBIG		;"A" - 4C
	EXP SUBF2		;"A" - F2

MULT.1=.-3
	EXP ML1CX		;"A" * 1C
	EXP ML2CX		;"A" * 2C
	EXP MLFPFP		;"A" * FP
	BLOCK 4
	EXP TOOBIG		;"A" * 4C
	EXP MLF2F2		;"A" * F2

MULT.2=.-3
	EXP ML1C1C		;1C * 1C
	EXP ML1C2C		;1C * 2C

MULT.3=.-3
	EXP ML2C1C		;2C * 1C
	EXP ML2C2C		;2C * 2C

DIVT.1=.-3
	EXP	DIVX.6
	EXP	DIVX10
	EXP	DIVX40
	BLOCK	4
IFN BIS,EXP	DIVX11		;"A" / 4C
IFE BIS,EXP	TOOBIG
	EXP	DIVXF2		;"A" / F2
;CODE TO KEEP TRACK OF MAX. POSSIBLE SIZE OF INTERMEDIATE TEMP IN ADD AND SUBTRACT SERIES.

INIT9:	MOVE	TE,ESIZEA	;GET SIZE
	CAILE	TE,^D12		;IF ITS ALREADY D.P.
	POPJ	PP,		;DON'T CARE
	MOVE	TE,TABLE9(TE)	;GET NO. OF 9'S
	MOVEM	TE,ADDTMP##	;INTO COUNTER
	POPJ	PP,

;ADD NEXT MAX. SIZE TO SEE IF WE NEED D.P. BEFORE CODE IS GENERATED

NEXT9:	TSWF	FERROR		;GIVE UP IF ALREADY SEEN ERROR
	POPJ	PP,
	HRRZ	TE,EMODEA	;IF MODE IS NOT
	CAIE	TE,D1MODE	;  1-WORD COMP
	POPJ	PP,		;  DON'T WORRY
	HRRZ	TE,EMODEB	;SAME FOR "B" OPERAND
	CAIE	TE,FPMODE	;  IF FLOATING-POINT,
	CAIN	TE,F2MODE	;  OR COMP-2,
	POPJ	PP,		;  DON'T WORRY SETB WILL TAKE CARE OF IT
	MOVE	TE,ESIZEB	;IF SIZE IS
	CAILE	TE,^D12		; GREATER THAN 10 DIGITS
	POPJ	PP,		; ITS ALREADY D.P.
	MOVE	TE,EDPLA	;WORRY ABOUT DECIMAL PLACES
	SUB	TE,EDPLB	; IF THEY ARE DIFFERENT
	JUMPE	TE,NEXT9B	;DON'T BOTHER IF ZERO
	JUMPL	TE,NEXT9A	;"B" HAS MORE PLACES SHIFT "A"
	ADD	TE,ESIZEB	;MUST SHIFT "B"
	CAILE	TE,^D12		;SEE IF WE GOT TOO BIG
	POPJ	PP,		;YES, WE WILL USE D.P. ANYWAY
	JRST	NEXT9C		;NUMBER IS SLIGHTLY TOO BIG

NEXT9A:	MOVM	TE,TE		; WE MUST SHIFT CURRENT MAX.
	MOVE	TE,POWR10##(TE)	;GET POWER OF TEN
	JFCL	17,.+1		;CLEAR FLAGS
	IMUL	TE,ADDTMP	;SEE IF IT OVERFLOWS
	JOV	MAKDP		;MAKE "A" D.P. IF IT OVERFLOWS
	MOVEM	TE,ADDTMP	;STORE NEW RESULT BACK
NEXT9B:	MOVE	TE,ESIZEB	;GET SIZE AGAIN
NEXT9C:	MOVE	TE,TABLE9(TE)	;GET 9'S
	JFCL	17,.+1		;CLEAR FLAGS
	ADDM	TE,ADDTMP	;GET NEW TOTAL
	JOV	MAKDP		;MAKE "A" D.P. IF THIS OVERFLOWED
	POPJ	PP,

MAKDP:	JRST	CC1C2.		;CONVERT "A" TO 2-WORD COMP
;TABLE OF 9'S, USED TO COMPUTE MAX. POSSIBLE SIZE OF INTERMEDIATE TEMP
;IN ADD AND SUBTRACT SERIES.

RADIX 10

TABLE9:	0
	9
	99
	999
	9999
	99999
	999999
	9999999
	99999999
	999999999
	9999999999

RADIX	8
DINTO==1B<^D18+^D9>	;"INTO" FLAG IN DIVIDE OPERATOR

RESLT.==11	;"RESULT" OPERATOR CODE
YECCH.==105	;"YECCH" OPERATOR CODE
NEGEOP==1B<^D18+6>	;"UNARY MINUS" FLAG IN OPERAND
REMOP==12	;'REMAINDER' OPERATOR CODE

EXTERNAL CORR

EXTERNAL EOPLOC,EOPNXT,CUREOP,RESLOC,RESNXT,CURRES,EWORDB,EREMAN,TEMBAS,ETEMPC

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

EXTERNAL D1MODE,D2MODE,DSMODE,D6MODE,D7MODE,FPMODE,F2MODE,EDMODE,FCMODE,LTMODE,IXMODE,ZERO
EXTERNAL AS.MSC,AS.CNB,AS.TMP,AS.LIT,D1LIT,D2LIT

EXTERNAL LNKCOD,TB.DAT
EXTERNAL DA.CLA,DA.NDP,DA.DPR,DA.INS,DA.EXS,DA.USG,DA.EDT

EXTERNAL AOS.,FAD.,ADDM.,FADM.,DADD.,DSUB.,DMUL.,DDIV.
EXTERNAL SOS.,SUB.,FSB.,MUL.,FMP.,IMUL.,DFAD.,DFSB.,DFMP.,DFDV.
EXTERNAL DIV.,FDV.,DIV.11,DIV.12,DIV.21,DIV.22
EXTERNAL MOVM.,MOVN.,MOVEM.,MOVEI.,MOVNI.,MOVSI.,HRLZI.
EXTERNAL BLT.,EXCH.,SETZB.,HRRZI.,SETZM.,SETZ.,SZERA.,OVFLO.
EXTERNAL E.C3C1,E.C3C3,E.F2D1,E.F2D2,E.F2FP,E.F2F2,EPJPP
EXTERNAL MOVMS.,SOSGE.

EXTERNAL EAC,ELITPC,CUREOP,OPERND,CHAC,ESAVAC,OPLINE
EXTERNAL ELITLO,ELITHI,ECARRY,MAXSIZ,ESZERA,ERESDP,EMULSZ,EOPCOD
EXTERNAL ERCNT,ETEMPR,RESTYP,ACSIZE,ACMODE,REMPAR
EXTERNAL EREM0,EREM1,EREM2,EREM3,EREM4
IFE BIS,<
EXTERN	ADD.12,ADD.21,ADD.22,SUB.12,SUB.21,SUB.22,MUL.12,MUL.21,MUL.22
>

	END