Google
 

Trailing-Edge - PDP-10 Archives - BB-4157E-BM - fortran-compiler/cnstcm.mac
There are 12 other files named cnstcm.mac in the archive. Click here to see a list.
	TITLE	CNSTCM - CONSTANT COMBINE MODULE
	SUBTTL	S. MURPHY/SRM/HPW/NEA/HPW/SJW/DCE/TFV

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

;COPYRIGHT (C) 1972,1981 BY DIGITAL EQUIPMENT CORPORATION

	INTERN	CNSTCV
	CNSTCV= BYTE (3)0(9)6(6)0(18)^D72	; Version Date:	24-Jul-81


	SUBTTL	Revision History

Comment \

***** Begin Revision History *****

54	-----	-----	FIX CONVERSION OF LITERALS
55	-----	-----	ADD CONVERSION ROUTINE TO
			CMPLX WITH CONSTANT ARGUMENTS
			AT KILFBR+1
56	-----	-----	ADD ROUTINES TO FOLD INTEGER EXPONENTIATION
57	-----	-----	ADD SPECIFIC DISPATCH KDPINT FOR REAL TO INTEGER
			TRUNCATION
58	-----	-----	PATCH CALL TO WARNERR
59	-----	-----	ADD CODE FOR INLINE DABS
60	-----	-----	ADD CODE FOR SQUARE OF DP
61	-----	-----	ADD CODE FOR EXPONEN OF DP
62	-----	-----	REMOVE CODE FOR SQUARE,CUBE,P4 (THEY ARE NOW
				ALL UNDER EXPCIOP)
63	-----	-----	FIX BUG IN "EXPRL" (REAL NUMBER TO INTEGER
			POWER) -WHEN CALL KADPML, C1H-C1L MUST
			CONTAIN THE FIRST ARG TO BE MULTIPLIED
64	-----	-----	IN "EXPINT" AND "EXPRL" MUSTCHECK FOR THE
			POWER EQUAL TO 0 (AND SET RESULT TO 1 IN
			THAT CASE)
65	275	-----	FOR FLOATING UNDEFLOW, CHECK UNDERFLOW AND NOT
			OVERFLOW + DIVIDE CHECK BECAUSE OVERFLOW IS SET, (JNT)

***** Begin Version 5 *****

66	413	-----	DON'T USE FADL IN INTDP IF NOT ON KA10

***** Begin Version 5A *****

67	606	22795	CATCH ALL OVERFLOWS AND UNDERFLOWS IN EXPRL, (DCE)

***** Begin Version 6 *****

68	761	TFV	1-Mar-80	-----
	Remove all KA tables and add /GFLOATING tables.
	Clean up everything

69	1006	TFV	1-Jul-80	------
	Add code for specops (p2mul, p2div, p21mul) for reals and dp

70	1025	TFV	21-Nov-80	------
	Fix conversion of reals to logical under GFLOATING.
	Just taking the high order word losses.

71	1030	TFV	25-Nov-80	------
	Fix GFLOATING DP conversion to INT.  Truncate don't round.

72	1031	TFV	25-Nov-80	------
	Fix ABS of GFLOATING reals. Use DABS routine since low word has some
	mantissa bits for the SP representation

***** End Revision History *****

\

	SUBTTL	COMBIND CONSTANTS

	HISEG
;TO COMBINE CONSTANTS AT RUN TIME
;CALLED WITH THE GLOBALS
;	C1H - HIGH ORDER WD OF 1ST CONSTANT
;	C1L - LOW ORDER WD OF 1ST CONSTANTS
;	C2H - HIGH ORDER WD OF 2ND CONSTNT (HIGH ORDER WD OF RESULT
;		IS LEFT HERE)
;	C2L - LOW ORDER WD OF 2ND CONSTANT (LOW ORDER WD OF RESULT IS 
;		LEFT HERE)
;	COPRIX - TABLE INDEX FOR OPERATION TO BE PERFORMED
;		FOR ARITH OPERATIONS - 2 BITS FOR OP FOLLOWED
;			BY 2 BITS FOR VALUE-TYPE
;		FOR TYPE CONVERSIONS - "KTYPCB" (BASE IN TABLE FOR TYPE
;			CONV) PLUS 2 BITS FOR SOURCE TYPE FOLLOWED
;			BY 2 BITS FOR DESTINATION TYPE
;		FOR BOOLEAN OPERATIONS - "KBOOLB" (BASE IN TABLE FOR
;			BOOLEANS) PLUS 2 BITS  SPECIFYING
;			THE OPERATION
;

	SEARCH GFOPDF	;[761] OPDEFS FOR GFLOAT INSTRUCTIONS

	ENTRY	CNSTCM
	EXTERN	SKERR,C1H,C1L,C2H,C2L,COPRIX

	INTERN	KDPINT	;REAL TO INTEGER TRUNCATION
	INTERN	KGFINT	;[761] REAL TO INTEGER TRUNCATION
	INTERN	KARIIB		;BASE FOR ARITH OPERATIONS FOR KI10
	INTERN	KARIGB		;[761] BASE FOR GFLOATING ARITH OPS
	INTERN	KBOOLB,KDNEGB,KILFBA,KILFBR,KILFBG
	INTERN	KTYPCB,KTYPCG,KSPECB,KSPECG	;[761] type conversions

	INTERN	KDPRL,KGFRL	;[761] TO ROUND A DOUBLE-WD REAL DOWN TO A
				; SINGLE WD OF PRECISION. USED ONLY WITH THE
				; OPTIMIZER
	INTERN KGFSPR		;[761] to round /GFLOATING to SP accuracy
				; keeping /GFLOATING format
	INTERN	KILDAB		;TO FOLD DABS

	SREG=17		;STACK REG
	FLGREG=0	;FLAGS REGISTER
	RH=4		;HIGH ORDER WD OF RESULT DEVELOPED
			; INTO THIS REG
	RL=5		;LOW ORDER WD OF RESULT DEVELOPED
			; INTO THIS REG
	RGDSP=6		;INDEX INTO TABLE OF OPERATIONS
			; INDICATING  OPERATION TO BE PERFORMED
	T=7		;REGISTER USED AS A TEMPORARY

	F1=201400	;FLOATING POINT ONE
	G1=200140	;[761] GFLOATING 1.0


CNSTCM:	JRSTF	@[0,,.+1]	;CLEAR FLAGS FOR OVERFLOW AND UNDERFLOW
	MOVE	RH,C1H		;LOW HIGH ORDER 1ST CONSTANT
	MOVE	RL,C1L		;LOW LOW ORDER 1ST CONSTANT
	HRRZ	RGDSP,COPRIX	;LOAD INDEX
	XCT	0(RGDSP)	;PERFORM DESIRED OPERATION
	JSP	T,.+1		;LOAD FLAGS INTO T
	TLNE	T,440140	;IF OVERFLOW,UNDERFLOW,OR DIVIDE CHECK IS
	PUSHJ	SREG,OVFLW	;SET, GO HANDLE THE OVERFLOW
	MOVEM	RH,C2H		;RETURN RESULTS IN GLOBALS
	MOVEM	RL,C2L		;C2H AND C2L
	POPJ	SREG,		;RETURN
;TABLE OF OPERATIONS TO BE PERFORMED
;CODE FOR EACH OPERATION IS IDENTICAL TO THE CODE THAT WOULD BE
;EXECUTED AT RUN-TIME.
;
;
;ARITH OPERATIONS 
; NOGFLOATING - Clean up table
KARIIB:	ADD	RL,C2L
	DFAD	RH,C2H		;[761]
	DFAD	RH,C2H		;[761]
	PUSHJ	SREG,CMPADD
	SUB	RL,C2L
	DFSB	RH,C2H		;[761]
	DFSB	RH,C2H		;[761]
	PUSHJ	SREG,CMPSUB
	IMUL	RL,C2L
	DFMP	RH,C2H		;[761]
	DFMP	RH,C2H		;[761]
	PUSHJ	SREG,CMPMUL
	IDIV	RL,C2L
	DFDV	RH,C2H		;[761]
	DFDV	RH,C2H		;[761]
	PUSHJ	SREG,CMPDIV
;ARITH OPERATIONS 
; GFLOATING [761]	
KARIGB:	ADD	RL,C2L		;[761]
	GFAD	RH,C2H		;[761]
	GFAD	RH,C2H		;[761]
	PUSHJ	SREG,CMPADD	;[761]
	SUB	RL,C2L		;[761]
	GFSB	RH,C2H		;[761]
	GFSB	RH,C2H		;[761]
	PUSHJ	SREG,CMPSUB	;[761]
	IMUL	RL,C2L		;[761]
	GFMP	RH,C2H		;[761]
	GFMP	RH,C2H		;[761]
	PUSHJ	SREG,CMPMUL	;[761]
	IDIV	RL,C2L		;[761]
	GFDV	RH,C2H		;[761]
	GFDV	RH,C2H		;[761]
	PUSHJ	SREG,CMPDIV	;[761]
;
; FOR TYPE CONVERSIONS
; NOGFLOATING
KTYPCB=.
;	FROM OCTAL/LOGICAL
	JFCL			;TO OCTAL/LOGICAL
	PUSHJ	SREG,SKERR	;TO CONTROL (SHOULD NEVER OCCUR)
	PUSHJ	SREG,OCTRL	;TO DOUBLE-OCTAL - THIS WD BECOMES HIGH WD
	PUSHJ	SREG,OCTRL	;TO LITERAL - THIS WD IS HIGH WD
	JFCL			;TO INTEGER
	PUSHJ	SREG,OCTRL	;TO REAL
	PUSHJ	SREG,OCTRL	;TO DOUBLE-PREC
	PUSHJ	SREG,OCTRL	;TO COMPLEX
;	FROM CONTROL
	JFCL			;TO OCTAL
	JFCL			;TO CONTROL
	PUSHJ	SREG,OCTRL	;TO DOUBLE-OCTAL
	PUSHJ	SREG,OCTRL	;TO LITERAL
	JFCL			;TO INTEGER
	PUSHJ	SREG,OCTRL	;TO REAL - MUST MOVE CONST2 TO CONST1
	PUSHJ	SREG,OCTRL	;TO DOUBLE-PREC
	PUSHJ	SREG,OCTRL	;TO COMPLEX
;	FROM DOUBLE-OCTAL
	PUSHJ	SREG,DOCTIN	;TO LOGICAL - USE HIGH WD ONLY,SET OVFLW
	PUSHJ	SREG,DOCTIN	;TO CONTROL
	JFCL			;TO DOUBLE-OCTAL
	JFCL			;TO LITERAL
	PUSHJ	SREG,DOCTIN	;TO INTEGER
	JFCL			;TO REAL
	JFCL			;TO DOUBLE-PREC
	JFCL			;TO COMPLEX
;	FROM LITERAL
	PUSHJ	SREG,LITINT	;TO LOGICAL - USE HIGH WD ONLY
	PUSHJ	SREG,LITINT	;TO CONTROL
	PUSHJ	SREG,LITTWD	;TO DOUBLE-OCTAL (COMPLEX/DOUBLE PRECISION)
	JFCL			;TO LITERAL
	PUSHJ	SREG,LITINT	;TO INTEGER
	PUSHJ	SREG,LITRL	;TO REAL
	PUSHJ	SREG,LITTWD	;TO DOUBLE PREC
	PUSHJ	SREG,LITTWD	;TO COMPLEX
;	FROM INTEGER
	JFCL			;TO LOGICAL
	JFCL			;TO CONTROL
	PUSHJ	SREG,SKERR	;TO DOUBLE-OCTAL - SHOULD NEVER OCCUR
	PUSHJ	SREG,SKERR	;TO LITERAL - SHOULD NEVER OCCUR
	JFCL
	PUSHJ	SREG,INTDP	;TO REAL
	PUSHJ	SREG,INTDP	;TO DOUBLE PRECISION
	PUSHJ	SREG,INTCM	;TO COMPLEX
;	FROM REAL
	PUSHJ	SREG,RLLOG	;TO LOGICAL
	PUSHJ	SREG,RLLOG	;TO CONTROL
	PUSHJ	SREG,SKERR	;TO DOUBLE-OCTAL (SHOULD NEVER OCCUR)
	PUSHJ	SREG,SKERR	;TO LITERAL (SHOULD NEVER OCCUR)
KDPINT:	PUSHJ	SREG,DPINT	;TO INTEGER (SAME AS FROM DOUBLE-PREC)
	JFCL
	JFCL			;TO DOUBLE PREC (SINCE REAL KEPT 2 WDS OF PREC)
	PUSHJ	SREG,DPCM	;TO COMPLEX - ROUND AND USE HIGH WD
;	FROM DOUBLE PREC
	PUSHJ	SREG,RLLOG	;TO LOGICAL - USE HIGH WD ONLY
	PUSHJ	SREG,RLLOG	;TO CONTROL
	PUSHJ	SREG,SKERR	;TO DOUBLE-OCTAL (SHOULD NEVER OCCUR)
	PUSHJ	SREG,SKERR	;TO LITERAL (SHOULD NEVER OCCUR)
	PUSHJ	SREG,DPINT
	JFCL			;TO REAL - KEEP SAME 2 WDS OF PREC
	JFCL			;DOUBLE-PREC TO DOUBLE-PREC
	PUSHJ	SREG,DPCM	;DOUBLE-PREC TO COMPLEX-USE HIGH ORDER WD
;	FROM COMPLEX
	PUSHJ	SREG,RLLOG	;TO LOGICAL - USE REAL PART ONLY
	PUSHJ	SREG,RLLOG	;TO CONTROL
	PUSHJ	SREG,SKERR	;TO DOUBLE-OCTAL (SHOULD NEVER OCCUR)
	PUSHJ	SREG,SKERR	;TO LITERAL (SHOULD NEVER OCCUR)
	PUSHJ	SREG,CMINT	;TO INTEGER - CONVERT REAL PART
	MOVEI	RL,0		;TO REAL - USE HIGH WD ONLY
	MOVEI	RL,0		;COMPLEX TO DOUBLE-PREC- USE HIGH ORDER WD
	JFCL			;COMPLEX TO COMPLEX

; FOR TYPE CONVERSIONS [761]
; GFLOATING
KTYPCG=.
;	FROM OCTAL/LOGICAL
	JFCL			;[761] TO OCTAL/LOGICAL
	PUSHJ	SREG,SKERR	;[761] TO CONTROL (SHOULD NEVER OCCUR)
	PUSHJ	SREG,OCTRL	;[761] TO DOUBLE-OCTAL - THIS WD BECOMES HIGH WD
	PUSHJ	SREG,OCTRL	;[761] TO LITERAL - THIS WD IS HIGH WD
	JFCL			;[761] TO INTEGER
	PUSHJ	SREG,OCTRL	;[761] TO REAL
	PUSHJ	SREG,OCTRL	;[761] TO DOUBLE-PREC
	PUSHJ	SREG,OCTRL	;[761] TO COMPLEX
;	FROM CONTROL
	JFCL			;[761] TO OCTAL
	JFCL			;[761] TO CONTROL
	PUSHJ	SREG,OCTRL	;[761] TO DOUBLE-OCTAL
	PUSHJ	SREG,OCTRL	;[761] TO LITERAL
	JFCL			;[761] TO INTEGER
	PUSHJ	SREG,OCTRL	;[761] TO REAL - MUST MOVE CONST2 TO CONST1
	PUSHJ	SREG,OCTRL	;[761] TO DOUBLE-PREC
	PUSHJ	SREG,OCTRL	;[761] TO COMPLEX
;	FROM DOUBLE-OCTAL
	PUSHJ	SREG,DOCTIN	;[761] TO LOGICAL - USE HIGH WD ONLY,SET OVFLW
	PUSHJ	SREG,DOCTIN	;[761] TO CONTROL
	JFCL			;[761] TO DOUBLE-OCTAL
	JFCL			;[761] TO LITERAL
	PUSHJ	SREG,DOCTIN	;[761] TO INTEGER
	JFCL			;[761] TO REAL
	JFCL			;[761] TO DOUBLE-PREC
	JFCL			;[761] TO COMPLEX
;	FROM LITERAL
	PUSHJ	SREG,LITINT	;[761] TO LOGICAL - USE HIGH WD ONLY
	PUSHJ	SREG,LITINT	;[761] TO CONTROL
	PUSHJ	SREG,LITTWD	;[761] TO DOUBLE-OCTAL (COMPLEX/DOUBLE PRECISION)
	JFCL			;[761] TO LITERAL
	PUSHJ	SREG,LITINT	;[761] TO INTEGER
	PUSHJ	SREG,LITRL	;[761] TO REAL
	PUSHJ	SREG,LITTWD	;[761] TO DOUBLE PREC
	PUSHJ	SREG,LITTWD	;[761] TO COMPLEX
;	FROM INTEGER
	JFCL			;[761] TO LOGICAL
	JFCL			;[761] TO CONTROL
	PUSHJ	SREG,SKERR	;[761] TO DOUBLE-OCTAL - SHOULD NEVER OCCUR
	PUSHJ	SREG,SKERR	;[761] TO LITERAL - SHOULD NEVER OCCUR
	JFCL
	PUSHJ	SREG,INTGF	;[761] TO REAL
	PUSHJ	SREG,INTGF	;[761] TO DOUBLE PRECISION
	PUSHJ	SREG,INTCM	;[761] TO COMPLEX
;	FROM REAL
	PUSHJ	SREG,GRLLOG	;[1025] TO LOGICAL
	PUSHJ	SREG,GRLLOG	;[1025] TO CONTROL
	PUSHJ	SREG,SKERR	;[761] TO DOUBLE-OCTAL (SHOULD NEVER OCCUR)
	PUSHJ	SREG,SKERR	;[761] TO LITERAL (SHOULD NEVER OCCUR)
KGFINT:	PUSHJ	SREG,GFINT	;[761] TO INTEGER (SAME AS FROM DOUBLE-PREC)
	JFCL			;[761]
	JFCL			;[761] TO DOUBLE PREC (SINCE REAL KEPT 2 WDS OF PREC)
	PUSHJ	SREG,GFCM	;[761] TO COMPLEX - ROUND AND USE HIGH WD
;	FROM DOUBLE PREC
	PUSHJ	SREG,RLLOG	;[761] TO LOGICAL - USE HIGH WD ONLY
	PUSHJ	SREG,RLLOG	;[761] TO CONTROL
	PUSHJ	SREG,SKERR	;[761] TO DOUBLE-OCTAL (SHOULD NEVER OCCUR)
	PUSHJ	SREG,SKERR	;[761] TO LITERAL (SHOULD NEVER OCCUR)
	PUSHJ	SREG,GFINT
	JFCL			;[761] TO REAL - KEEP SAME 2 WDS OF PREC
	JFCL			;[761] DOUBLE-PREC TO DOUBLE-PREC
	PUSHJ	SREG,GFCM	;[761] DOUBLE-PREC TO COMPLEX-USE HIGH ORDER WD
;	FROM COMPLEX
	PUSHJ	SREG,RLLOG	;[761] TO LOGICAL - USE REAL PART ONLY
	PUSHJ	SREG,RLLOG	;[761] TO CONTROL
	PUSHJ	SREG,SKERR	;[761] TO DOUBLE-OCTAL (SHOULD NEVER OCCUR)
	PUSHJ	SREG,SKERR	;[761] TO LITERAL (SHOULD NEVER OCCUR)
	PUSHJ	SREG,CMINT	;[761] TO INTEGER - CONVERT REAL PART
	EXTEND	RH,[GDBLE RH]	;[761] TO REAL - USE HIGH WD ONLY
	EXTEND	RH,[GDBLE RH]	;[761] COMPLEX TO DOUBLE-PREC- USE HIGH ORDER WD
	JFCL			;[761] COMPLEX TO COMPLEX
;
;TO ROUND A DOUBLE-WD REAL TO A SINGLE WORD. USED WITH THE OPTIMIZER
; FOR THE CASE:
;	R=5.4
;	DP=R
; SO THAT WHEN THE CONSTANT 5.4 IS PROPAGATED, ONLY ONE WORD OF
; PRECISION WILL BE PROPAGATED
KDPRL:	PUSHJ	SREG,DPCM		;USE SAME ROUTINE AS IS USED FOR
					; CONVERTING DOUBLE-WD REAL TO COMPLEX
KGFRL:	PUSHJ	SREG,GFCM		;[761]

;[761] Round /GFLOATING DP to SP precision without changing the form
KGFSPR:	PUSHJ	SREG,GFSPR		;[761] 

GFSPR:	EXTEND	RH,[GSNGL RH]		;[761] first convert to SP
	MOVEI	RL,0			;[761] zero second word
	EXTEND	RH,[GDBLE RH]		;[761] convert back to DP format
	POPJ	SREG,			;[761] return
;
;
;

;
;
;FOR BOOLEAN OPS - ALWAYS PERFORMED ON ONE WD ONLY
KBOOLB=.
	AND	RL,C2L
	OR	RL,C2L
	EQV	RL,C2L
	XOR	RL,C2L
;
;
;FOR NEGATION OF DOUBLE-PREC CONSTANTS (NOTE THAT ALL CONSTANTS ARE 
; STORED IN KI10 FORMAT
KDNEGB=.
	DMOVN	RH,RH		;FOR COMPILATION ON KI10
 
;OPERATIONS THAT TAKE MORE THAN 1 INSTR
;
;COMPLEX ARITHMETIC
;
;COMPLEX ADD
CMPADD:	FADR	RH,C2H
	FADR	RL,C2L
	POPJ	SREG,
;
;COMPLEX SUBTRACT
CMPSUB:	FSBR	RH,C2H
	FSBR	RL,C2L
	POPJ	SREG,
;
;COMPLEX MULTIPLY
CMPMUL:	PUSHJ	SREG,SKERR	;DO NOT FOLD COMPLEX MULTIPLICATION
;
;COMPLEX DIVIDE
CMPDIV:	PUSHJ	SREG,SKERR		;DO NOT FOLD COMPLEX DIVISION
;
;FOR FOLDING OF SPECIAL-OPS (P2MUL,P2DIV,PLPL1MUL,EXPCIOP
;NOGFLOATING
KSPECB:	PUSHJ	SREG,P2MI
	PUSHJ	SREG,P2MR	;[1006]
	PUSHJ	SREG,P2MR	;[1006]
	PUSHJ	SREG,P2MC
;
	PUSHJ	SREG,P2DI
	PUSHJ	SREG,P2DR	;[1006]
	PUSHJ	SREG,P2DR	;[1006]
	PUSHJ	SREG,P2DC
;
	PUSHJ	SREG,P21MI
	PUSHJ	SREG,P21MR	;[1006]
	PUSHJ	SREG,P21MR	;[1006]
	PUSHJ	SREG,P21MC
;
;	UNUSED OPERSP (FORMERLY USED FOR SQUARE)
	PUSHJ	SREG,SKERR
	PUSHJ	SREG,SKERR
	PUSHJ	SREG,SKERR
	PUSHJ	SREG,SKERR
;
;	UNUSED OPERSP (FORMERLY USED FOR CUBE)
	PUSHJ	SREG,SKERR
	PUSHJ	SREG,SKERR
	PUSHJ	SREG,SKERR
	PUSHJ	SREG,SKERR
;
;	UNUSED OPERSP (FORMERLY USED FOR POWER OF 4)
	PUSHJ	SREG,SKERR
	PUSHJ	SREG,SKERR
	PUSHJ	SREG,SKERR
	PUSHJ	SREG,SKERR
;
;
;FOR INTEGER EXPONENTIATION
	PUSHJ	SREG,EXPINT
	PUSHJ	SREG,EXPRL
	PUSHJ	SREG,EXPRL
	PUSHJ	SREG,SKERR

;GFLOATING [761]
KSPECG:	PUSHJ	SREG,P2MI	;[761]
	PUSHJ	SREG,P2MG	;[761]
	PUSHJ	SREG,P2MG	;[761]
	PUSHJ	SREG,P2MC	;[761]
;
	PUSHJ	SREG,P2DI	;[761]
	PUSHJ	SREG,P2DG	;[761]
	PUSHJ	SREG,P2DG	;[761]
	PUSHJ	SREG,P2DC	;[761]
;
	PUSHJ	SREG,P21MI	;[761]
	PUSHJ	SREG,P21MG	;[761]
	PUSHJ	SREG,P21MG	;[761]
	PUSHJ	SREG,P21MC	;[761]
;
;	UNUSED OPERSP (FORMERLY USED FOR SQUARE)
	PUSHJ	SREG,SKERR	;[761]
	PUSHJ	SREG,SKERR	;[761]
	PUSHJ	SREG,SKERR	;[761]
	PUSHJ	SREG,SKERR	;[761]
;
;	UNUSED OPERSP (FORMERLY USED FOR CUBE)
	PUSHJ	SREG,SKERR	;[761]
	PUSHJ	SREG,SKERR	;[761]
	PUSHJ	SREG,SKERR	;[761]
	PUSHJ	SREG,SKERR	;[761]
;
;	UNUSED OPERSP (FORMERLY USED FOR POWER OF 4)
	PUSHJ	SREG,SKERR	;[761]
	PUSHJ	SREG,SKERR	;[761]
	PUSHJ	SREG,SKERR	;[761]
	PUSHJ	SREG,SKERR	;[761]
;
;
;FOR INTEGER EXPONENTIATION
	PUSHJ	SREG,EXPINT	;[761]
	PUSHJ	SREG,EXPGF	;[761]
	PUSHJ	SREG,EXPGF	;[761]
	PUSHJ	SREG,SKERR	;[761]

P2MI:	MOVE	T,C2L
	ASH	RL,0(T)
	POPJ	SREG,
;
P2MR:	SKIPA	RH,C2L		;[1006]
P2DR:	MOVN	RH,C2L		;[1006]
	ASH	RH,^D27		;[1006]
	ADD	RH,[201400,,0]	;[1006]
	SETZ	RL,		;[1006]
	DFMP	RH,C1H		;[1006]
	POPJ	SREG,		;[1006]
;
P2MG:	MOVE	T,C2L			;[761]
	EXTEND	RH,[GFSC 0,0(T)]	;[761]
	POPJ	SREG,			;[761]
;
P2MC:	MOVE	T,C2L
	FSC	RH,0(T)
	FSC	RL,0(T)
	POPJ	SREG,
;
P2DI:	JUMPGE	RL,P2DI1	;FOR A DIVIDING A NEGATIVE CONST
				; BY 2**N BY DOING A RIGHT SHIFT
	MOVEI	T,1		; MUST ADD IN 2**N -1. MUST COMPUTE
	ASH	T,@C2L		; 2**N
	SUBI	T,1		; MINUS ONE
	ADD	RL,T		;THEN ADD IT TO THE NEG CONST 
P2DI1:	MOVN	T,C2L		;GET NEG OF THE POWER - TOSHIFT RIGHT
	ASH	RL,0(T)		;SHIFT RIGHT N PLACES
	POPJ	SREG,
;
P2DG:	MOVN	T,C2L			;[761]
	EXTEND	RH,[GFSC 0,0(T)]	;[761]
	POPJ	SREG,			;[761]
;
P2DC:	MOVN	T,C2L
	FSC	RH,0(T)
	FSC	RL,0(T)
	POPJ	SREG,
;
P21MI:	MOVE	T,C2L
	ASH	RL,0(T)
	ADD	RL,C1L
	POPJ	SREG,
;
P21MR:	MOVE	RH,C2L		;[1006]
	ASH	RH,^D27		;[1006]
	ADD	RH,[201400,,0]	;[1006]
	SETZ	RL,		;[1006]
	DFMP	RH,C1H		;[1006]
	DFAD	RH,C1H		;[1006]
	POPJ	SREG,		;[1006]
;
P21MG:	MOVE	T,C2L			;[761]
	EXTEND	RH,[GFSC 0,0(T)]	;[761]
	GFAD	RH,C1H			;[761]
	POPJ	SREG,			;[761]
;
P21MC:	MOVE	T,C2L
	FSC	RH,0(T)
	FADR	RH,C1H
	FSC	RL,0(T)
	FADR	RL,C1L
	POPJ	SREG,
;
;
;
;RAISE TO AN ARBITRARY INTEGER POWER
EXPINT:	SKIPN	T,C2L		;CHECK FOR POWER=0
	JRST	EXPIN0		; IF SO RETURN 1
	MOVEM	T,C2H		;STORE POWER  SOMEWHERE FOR COMPARE
	SETZ	RH,		;NOTHING BACK IN HIGH ORDER
EXPIN1:	TRNN	T,777776	;BITS OTHER THAN 1
	JRST	EXPIN2		;NO
	ROT	T,-1		;CYCLE
	JRST	EXPIN1		;TRY AGAIN
EXPIN2:	CAMN	T,C2H		;ANOTHER POWER
	POPJ	SREG,		;DONE
	ROT	T,1		;CYCLE
	IMUL	RL,RL		;MULTIPLY BY POWER
	TRNE	T,1		;BY NUMBER ITSELF?
	IMUL	RL,C1L		;YES
	JRST	EXPIN2		;ITERATE
;
EXPIN0:	MOVEI	RL,1	;IF POWER=0, RETURN 1
	POPJ	SREG,
;
;RAISE A REAL (OR DOUBLE PREC ) TO AN ARBITRARY INTEGER POWER
EXPRL:	SKIPN	T,C2L		;CHECK FOR POWER=0
	JRST	EXPRL0		;IF SO RETURN 1.0
	PUSH	SREG,C1H	;COPY ORIGINAL NUMBER
	PUSH	SREG,C1L
	PUSH	SREG,T		;SAVE POWER  FOR COMPARE
EXPRL1:	TRNN	T,777776	;ONLY 1 LEFT
	JRST	EXPRL2		;NO
	ROT	T,-1		;SHIFT A BIT
	JRST	EXPRL1		;CONTINUE TIL DONE
EXPRL2:	MOVEM	RH,C2H		;STORE 
	MOVEM	RL,C2L		;STORE
	CAMN	T,0(SREG)	;DONE
	JRST	EXPRL3		;YES
	ROT	T,1		;GET A BIT
	PUSH	SREG,T		;PRESERVE OVER CALL
	MOVEM	RH,C1H		;(WHEN CALL KADPML, C1H-C1L MUST CONTAIN
				; ARG1)
	MOVEM	RL,C1L
	DFMP	RH,C2H	;MULTIPLY RH/RL BY C2H/C2L
				;RESULT COMES BACK IN RH/RL
				;(C1H/C1L IS CLOBBERED)
	;TEST FOR OVERFLOW/UNDERFLOW AND GET OUT IF THERE IS.
	JSP	T,.+1		; USE T AS TEMP FOR FLAGS
	TLNE	T,440140	; TEST FOR TROUBLE!
	JRST	EXPRL4		; TIME TO GET OUT
	POP	SREG,T		;RESTORE
	TRNN	T,1		;ANOTHER MULTIPLY NEEDED
	JRST	EXPRL2		;NO - STORE AND ITERATE
	PUSH	SREG,T		;NEED T FOR COPY
	MOVE	T,-3(SREG)		;GET ORIGINAL NUMBER
	MOVEM	T,C2H		;STORE IT
	MOVE	T,-2(SREG)		;GET ORIGINAL NUMBER
	MOVEM	T,C2L		;STORE IT
	MOVEM	RH,C1H		;NUMBER TO BE MULTIPLIED
	MOVEM	RL,C1L
	DFMP	RH,C2H	;MULTIPLY
	JSP	T,.+1		; USE T AS TEMP FOR FLAGS
	TLNE	T,440140	; TEST FOR TROUBLE!
	JRST	EXPRL4		; TIME TO GET OUT
	POP	SREG,T		;RESTORE T
	JRST	EXPRL2		;REPEAT
EXPRL4:	POP	SREG,T		; RESTORE T
				; THIS IS OVERFLOW/UNDERFLOW EXIT
EXPRL3:	POP	SREG,0(SREG)	;FIX STACK
	POP	SREG,0(SREG)
	POP	SREG,0(SREG)
	POPJ	SREG,		;DONE
;
;IF POWER IS 0
EXPRL0:	MOVSI	RH,F1		;SET HI WD TO FLOATING PT 1
	MOVEI	RL,0		; LO WD TO 0
	POPJ	SREG,		;RETURN

;[761] RAISE A REAL (OR DOUBLE PREC ) TO AN ARBITRARY INTEGER POWER
EXPGF:	SKIPN	T,C2L		;[761] CHECK FOR POWER=0
	JRST	EXPGF0		;[761] IF SO RETURN 1.0
	PUSH	SREG,C1H	;[761] COPY ORIGINAL NUMBER
	PUSH	SREG,C1L	;[761]
	PUSH	SREG,T		;[761] SAVE POWER  FOR COMPARE
EXPGF1:	TRNN	T,777776	;[761] ONLY 1 LEFT
	JRST	EXPGF2		;[761] NO
	ROT	T,-1		;[761] SHIFT A BIT
	JRST	EXPGF1		;[761] CONTINUE TIL DONE
EXPGF2:	MOVEM	RH,C2H		;[761] STORE 
	MOVEM	RL,C2L		;[761] STORE
	CAMN	T,0(SREG)	;[761] DONE
	JRST	EXPGF3		;[761] YES
	ROT	T,1		;[761] GET A BIT
	PUSH	SREG,T		;[761] PRESERVE OVER CALL
	MOVEM	RH,C1H		;[761] (WHEN CALL KADPML, C1H-C1L MUST CONTAIN
				;[761]  ARG1)
	MOVEM	RL,C1L		;[761]
	GFMP	RH,C2H		;[761] MULTIPLY RH/RL BY C2H/C2L
				;[761] RESULT COMES BACK IN RH/RL
				;[761] (C1H/C1L IS CLOBBERED)
;[761] TEST FOR OVERFLOW/UNDERFLOW AND GET OUT IF THERE IS.
	JSP	T,.+1		;[761] USE T AS TEMP FOR FLAGS
	TLNE	T,440140	;[761] TEST FOR TROUBLE!
	JRST	EXPGF4		;[761] TIME TO GET OUT
	POP	SREG,T		;[761] RESTORE
	TRNN	T,1		;[761] ANOTHER MULTIPLY NEEDED
	JRST	EXPGF2		;[761] NO - STORE AND ITERATE
	PUSH	SREG,T		;[761] NEED T FOR COPY
	MOVE	T,-3(SREG)	;[761] GET ORIGINAL NUMBER
	MOVEM	T,C2H		;[761] STORE IT
	MOVE	T,-2(SREG)	;[761] GET ORIGINAL NUMBER
	MOVEM	T,C2L		;[761] STORE IT
	MOVEM	RH,C1H		;[761] NUMBER TO BE MULTIPLIED
	MOVEM	RL,C1L		;[761]
	GFMP	RH,C2H		;[761] MULTIPLY
	JSP	T,.+1		;[761] USE T AS TEMP FOR FLAGS
	TLNE	T,440140	;[761] TEST FOR TROUBLE!
	JRST	EXPGF4		;[761] TIME TO GET OUT
	POP	SREG,T		;[761] RESTORE T
	JRST	EXPGF2		;[761] REPEAT
EXPGF4:	POP	SREG,T		;[761] RESTORE T
				;[761] THIS IS OVERFLOW/UNDERFLOW EXIT
EXPGF3:	POP	SREG,0(SREG)	;[761] FIX STACK
	POP	SREG,0(SREG)	;[761]
	POP	SREG,0(SREG)	;[761]
	POPJ	SREG,		;[761] DONE
;
;IF POWER IS 0
EXPGF0:	MOVSI	RH,G1		;[761]
	MOVEI	RL,0		;[761]
	POPJ	SREG,		;[761]

;FOR THE FOLDING OF IN-LINE-FNS
;
KILFBA:	MOVM	RL,RL
	PUSHJ	SREG,SKERR		;UNUSED OPERSP
	PUSHJ	SREG,ISIGN
	PUSHJ	SREG,DIM
	PUSHJ	SREG,MOD
	PUSHJ	SREG,MAX
	PUSHJ	SREG,MIN
;FOR ARGS REAL NOGFLOATING
KILFBR:	MOVM	RH,RH
	PUSHJ	SREG,CMPLX	;FOR REAL TO CMPLX
	PUSHJ	SREG,SIGN
	PUSHJ	SREG,DIM
	PUSHJ	SREG,SKERR	;PUSHJ	SREG,MOD
	PUSHJ	SREG,AMAX
	PUSHJ	SREG,AMIN
;FOR ARGS REAL GFLOATING [761]
;[1031] Use DABS routine for GFLOATING ABS since low word has some SP mantissa
KILFBG:	PUSHJ	SREG,ILDABS	;[1031] GFLOATING must do both words
	PUSHJ	SREG,GCMPLX	;[761] FOR REAL TO CMPLX
	PUSHJ	SREG,SIGN	;[761]
	PUSHJ	SREG,GDIM	;[761]
	PUSHJ	SREG,SKERR	;[761] PUSHJ	SREG,MOD
	PUSHJ	SREG,AMAX	;[761]
	PUSHJ	SREG,AMIN	;[761]
;
;SPECIAL CODE TO HANDLE DABS

KILDAB:	PUSHJ SREG,ILDABS

ILDABS:	SKIPGE	0,RH
	DMOVN	RH,RH
	POPJ	SREG,

;
;
CMPLX:	PUSHJ	SREG,DPCM	;COMBINE HIGH ORDER WORD
	EXCH	RH,C2H		;STORE HIGH ORDER, GET NEW HIGH ORDER
	MOVEM	RH,C1H		;STORE FOR DPCM
	EXCH	RL,C2L		;STORE LOW ORDER, LOAD NEW LOW ORDER
	MOVEM	RL,C1L		;SET FOR DPCM
	PUSHJ	SREG,DPCM	;COMBINE LOW ORDER
	MOVE	RL,RH		;COPY LOW ORDER
	MOVE	RH,C2H		;COPY HIGH ORDER
	POPJ	SREG,		;DONE
;
GCMPLX:	PUSHJ	SREG,GFCM	;[761] COMBINE HIGH ORDER WORD
	EXCH	RH,C2H		;[761] STORE HIGH ORDER, GET NEW HIGH ORDER
	MOVEM	RH,C1H		;[761] STORE FOR GFCM
	EXCH	RL,C2L		;[761] STORE LOW ORDER, LOAD NEW LOW ORDER
	MOVEM	RL,C1L		;[761] SET FOR GFCM
	PUSHJ	SREG,GFCM	;[761] COMBINE LOW ORDER
	MOVE	RL,RH		;[761] COPY LOW ORDER
	MOVE	RH,C2H		;[761] COPY HIGH ORDER
	POPJ	SREG,		;[761] DONE
;
SIGN:	MOVM	RH,RH
	SKIPGE	C2H
	MOVNS	RH,RH
	POPJ	SREG,
;
DIM:	CAMG	RH,C2H
	TDZA	RH,RH
	FSBR	RH,C2H
	POPJ	SREG,
;
GDIM:	CAMG	RH,C2H	;[761]
	TDZA	RH,RH	;[761]
	GFSB	RH,C2H	;[761]
	POPJ	SREG,	;[761]
;
MOD:	MOVE	RH,RL
	IDIV	RH,C2L
	POPJ	SREG,
;
MAX:	CAMGE	RL,C2L
	MOVE	RL,C2L
	POPJ	SREG,
;
MIN:	CAMLE	RL,C2L
	MOVE	RL,C2L
	POPJ	SREG,

AMAX:	CAMGE	RH,C2H
	MOVE	RH,C2H
	POPJ	SREG,
;
AMIN:	CAMLE	RH,C2H
	MOVE	RH,C2H
	POPJ	SREG,
;
ISIGN:	MOVM	RL,RL
	SKIPGE	C2L
	MOVNS	RL,RL
	POPJ	SREG,



;
;
;
;TYPE CONVERSION
;
;FROM LOGICAL/OCTAL TO REAL,DOUBLE-PREC,COMPLEX
OCTRL:	MOVE	RH,RL
LITRL:	MOVEI	RL,0
	POPJ	SREG,
;FROM DOUBLE-OCTAL TO INTEGER
; OR LITERAL TO OCTAL/LOGICAL/CONTROL/INTEGER
DOCTIN:
LITINT:	MOVE	RL,RH
	MOVEI	RH,0
	POPJ	SREG,
;
;FROM LITERAL TO DOUBLE OCTAL (COMPLEX OR DOUBLE PRECISION)
;
LITTWD:	JUMPN	RL,CPOPJ		;SET LOW ORDER WORD TO
	MOVE	RL,[ASCII /     /]	;BLANKS IF ZERO
	POPJ	SREG,			;AND RETURN
;
;FROM REAL (DOUBLE-PREC OR COMPLEX) TO LOGICAL. USE HIGH ORDER OR
; REAL PART ONLY
RLLOG:	MOVE	RL,RH
	MOVEI	RH,0
	POPJ	SREG,
;
;[1025] FROM REAL TO LOGICAL. Convert to SP then use high order.
GRLLOG:	EXTEND	RL,[GSNGL RH]	;[1025] convert GFLOATING DP to SP
	MOVEI	RH,0		;[1025] logical value is in low order word
	POPJ	SREG,		;[1025] return
;
;FROM INTEGER TO  COMPLEX
INTCM:	MOVE	RH, RL		;MOVE INTEGER INTO WD WHER REAL PART IS TO
				; BE LEFT
	IDIVI	RH,400		;DIVIDE INTEGER INTO 2 PIECES
	SKIPE	RH		;IMPLIES INTEGER LESS THAN 18 BITS
	TLC	RH, 243000	;SET EXP TO 254 (27+17 DECIMAL)
	TLC	RL, 233000	;SET EXP OF 2ND PART TO 233 (27 DECIMAL)
	FADR	RH,RL		;NORMALIZE AND ADD
	MOVEI	RL,0
	POPJ	SREG,
;FROM INTEGER TO DOUBLE-PREC OR REAL (SINCE WE KEEP 2 WDS)
INTDP:	MOVE	RH, RL		;PUT INTEGER INTO REG IN WHICH HIGH ORDER
				; PART WILL BE RETURNED
	SETZ	RL,		; CLEAR LOW ORDER WORD
	ASHC	RH,-8		; MAKE ROOM FOR EXPONENT IN HIGH WORD
	TLC	RH,243000	; SET EXP TO 27+8 DECIMAL
	DFAD	RH,[EXP 0,0]	; NORMALIZE
	POPJ	SREG,		; RETURN
;
INTGF:	MOVE	RH, RL		;[761]
	EXTEND	RH,[GFLTR 0,RH]	;[761]
	POPJ	SREG,		;[761]

;FROM  COMPLEX TO INTEGER
CMINT:	MOVM	RH, RH		;USE  MAGNITUDE ONLY
	MULI	RH,400		;SEPARATE FRACTION AND EXPONENT
				;(EXPONENT IN RH, FRACTION IN RL)
	ASH	RL, -243(RH)	;USE THE EXPONENT AS AN INDEX REGISTER
	SKIPGE	C1H		;SET THE CORRECT SIGN
	MOVNS	RL,RL
	MOVEI	RH,0		;ZERO 1ST WD
	POPJ	SREG,
;FROM DOUBLE PREC OR REAL (SINCE WE KEEP 2 WDS OF ACCURACY) TO INTEGER
DPINT:
	;TAKE THE ABSOLUTE VALUE - IF THE NUMBER IS NEGATIVE, MUST
	; NEGATE A KI10 FORMAT NUMBER (THIS CODE RUNS ON KA OR KI)
	SKIPGE	RH
	DMOVN	RH,RH

	HLRZ	T,RH		;GET EXPONENT INTO RIGHT
	ASH	T,-9		; 8 BITS OF REGISTER "T"
	TLZ	RH,777000	;WIPE OUT EXPONENT IN ARG
	ASHC	RH,-201-^D26(T)	;CHANGE FRACTION BITS TO INTEGER
	SKIPGE	C1H		;IF ORIGINAL VAL WAS NEGATIVE
	MOVNS	RH		; NEGATE THE INTEGER RESULT
;
	MOVE	RL,RH		;ALWAYS LEAVE INTEGER RESULTS IN RL
	MOVEI	RH,0		; WITH RH EQL TO 0
;
	POPJ	SREG,

GFINT:	EXTEND	RL,[GFIX RH]	;[1030] truncate instead of rounding
	MOVEI	RH,0		;[761]
	POPJ	SREG,		;[761]

;
;FROM  DOUBLE PREC TO COMPLEX - ROUND HIGH WD, ZERO IMAGINARY PART
DPCM:	
	JUMPE	RH,CPOPJ	;FOR ZERO - DO NOTHING
	;MUST FIRST TAKE ABSOLUTE VALUE - IF THE NUMBER IS NEG, MUST
	; NEGATE A KI10 FORMAT NUMBER (THIS CODE RUNS ON KA OR KI)
	SKIPGE	RH
	DMOVN	RH,RH
	TLNN	RL,200000	;IS ROUNDING NECESSARY
	JRST	DPRL2
	AOS	RH		;YES, ROUND INTO HIGH WORD
	TLO	RH,400		;TURN ON HI FRAC BIT IN CASE CARRY
				;  ADDED 1 TO EXPONENT
DPCM1:	JUMPGE	RH,DPRL2
	HRLOI	RH,377777	;OVERFLOW, MAKE LARGEST NUMBER AND
	JRSTF	@[XWD 440000,DPRL2]	;  SET AROV AND FOV
DPRL2:	SKIPGE	C1H		;IF ORIGINAL NUMBER WAS NEG
	MOVNS	RH		; THEN NEGATE THE RESULT
	MOVEI	RL,0		;CLEAR LOW WORD
	POPJ	SREG,

GFCM:	EXTEND	RH,[GSNGL RH]	;[761]
	MOVEI	RL,0		;[761]
	POPJ	SREG,		;[761]




;
;WHEN AN OVERFLOW/UNDERFLOW WAS DETECTED
;
;
OVFLW:
	PUSH	SREG,RH		;STORE RESULT OF COMPUTATION HIGH ORDER
	PUSH	SREG,RL		;STORE RESULT OF COMPUTATION LOW ORDER
	PUSH	SREG,T		;STORE FLAGS
				;TYPE OUT MESSAGE
	PUSH	SREG,ISN##	;PASS STATEMENT NUMBER
	PUSH	SREG,[E64##]	;ERROR NUMBER 64(DEC) TO BE PRINTED
	PUSHJ	SREG,WARNERR##	;TYPE WARNING
	POP	SREG,0(SREG)	;RESTORE STACK
	POP	SREG,0(SREG)
	POP	SREG,T		;RESTORE FLAGS
	POP	SREG,RL		;RESTORE RESULT LOW ORDER
	POP	SREG,RH		;RESTORE RESULT HIGH ORDER
	HRRZ	RGDSP,COPRIX	;RESTORE DISPATCH INDEX

	;DETERMINE THE TYPE OF THE RESULT BEING GENERATED
	; LEAVE THE REGISTER "RGDSP" SET TO 0 FOR INTEGER, 1 FOR REAL,
	; 2 FOR DOUBLE-PREC, 3 FOR COMPLEX
	;
	;THE FIRST ENTRIES IN THE DISPATCH TABLE ARE ARITH FOLLOWED BY TYPE
	; CONVERSION. IN BOTH THESE CASES, THE INDEX INTO THE TABLE WAS BUILT
	; BY ADDING THE BASE FOR THE GIVEN OPERATION TO A 2 BIT TYPE CODE.
	CAIL	RGDSP,KBOOLB	
	JRST	OVFLW1
	; IF DISPATCH-INDEX WAS FOR A TYPE-CNV OR ARITH OP, CAN GET TYPE
	; OF RES BY SUBTRACTING BASE OF TABLE AND THEN USING LAST 2 BITS
	SUBI	RGDSP,KARIIB
	ANDI	RGDSP,3
	JRST	HAVTYP
OVFLW1:	

	; IF THE VAL OF COPRIX IS BETWEEN THE BASE FOR BOOLEANS AND THE 
	; THE BASE FOR SPECIAL-OPS, THEN THE OVERFLOW WAS CAUSED IN
	;  DOUBLE-PREC NEGATION. VALUE TYPE IS ALWAYS DOUBLE-PREC
	CAIL	RGDSP,KSPECB
	JRST	OVFLW2
	MOVEI	RGDSP,2
	JRST	HAVTYP
OVFLW2:

	;IF COPRIX IS IN THE RANGE USED FOR SPECIAL-OPS - USE THE LAST 2 BITS
	CAIL	RGDSP,KILFBA
	JRST	OVFLW3
	SUBI	RGDSP,KSPECB
	ANDI	RGDSP,3
	JRST	HAVTYP
OVFLW3:

	;FOR IN-LINE-FNS ARGS ARE INTEGER BETWEEN "KILFBA" AND "KILFBR"
	; REAL IF GREATER THAN "KILFBR"
	CAIL	RGDSP,KILFBR
	JRST	OVFLW4
	MOVEI	RGDSP,0
	JRST	HAVTYP
OVFLW4:	MOVEI	RGDSP,1



;	AFTER HAVE SET THE REGISTER "RGDSP" TO CONTAIN THE VALTYPE OF
;        THE RESULT
HAVTYP:
	JUMPE	RGDSP,CPOPJ	;IF THE TYPE IS INTEGER, DO NOT ALTER THE
				; RESULT

	TLNN	T,000100	; SKIP IF UNDERFLOW
	JRST	OVERFL		; IF EITHER OVERFLOW OR DIVIDE-CHECK,
				; TREAT AS AN OVERFLOW

	;
	; FOR UNDERFLOW - SET THE RESULT TO 0
	SETZB	RH,RL
CPOPJ:	POPJ	SREG,		;GO STORE THE RESULT AND RETURN

	;
	;FOR OVERFLOW (OR DIVIDE CHECK) - SET THE RESULT TO THE HIGHEST
	; NUMBER (NEG OR POS) AND RETURN
OVERFL:	JUMPL	RH,NEGNUM
	HRLOI	RH,377777
	CAIE	RGDSP,1
	HRLOI	RL,377777		;IF THE VALTYPE WAS DOUBLE-PREC
					; OR COMPLEX
	POPJ	SREG,
;
;      IF THE VAL WAS NEG - USE THE LARGEST NEG NUMBER
NEGNUM:
	CAIN	RGDSP,2
	JRST	DPNEGN
	MOVE	RH,[400000000001]
	CAIN	RGDSP,3
	MOVE	RL,[400000000001]	;IF THE TYPE WAS COMPLEX, SET THE IMAGIN
					; PART AS WELL AS THE REAL PART
	POPJ	SREG,
;
;	FOR A DOUBLE-PREC, WHEN WANT THE LARGEST NEGATIVE DP NUMBER
DPNEGN:	HRLZI	RH,400000
	MOVEI	RL,1
	POPJ	SREG,

	END