.TITLE	FPE
	.SBTTL	1.	INTRODUCTION TO FPE
;+
;
; F P E . . .
;
; PURPOSE:	EMULATE FLOATING POINT HARDWARE ON PDP-11'S WITHOUT IT
;
; INTERFACE:	DURING INITIALIZATION, THIS PROGRAM CONNECTS TO THE
;		ILLEGAL INSTRUCTION TRAP. ALL SUBSEQUENT ENTRIES TO
;		THIS EMULATOR ARE MADE VIA THAT TRAP.
;
; LANGUAGE:	MACRO-11
;
; RESTRICTIONS:	THIS VERSION RUNS UNDER RSX-11D ONLY
;
; REFERENCES:	PDP11/45 PROCESSOR HANDBOOK, FP11 FLOATING-POINT 
;		PROCESSOR MAINTENANCE MANUAL, RSX11-SIG
;		NEWSLETTER, VOL. 5, NO. 5, PAGE 74.
;
;-
; REVISIONS:
; 17-AUG-77	MARSHALL LONG	WRITTEN
;+
;	1.0.1	ABOUT FPE 
;
;	FPE CONSISTS OF THREE FAIRLY DISTINCT PARTS:
;	
;	(1) CODE TO STEAL/RETURN THE ILLEGAL INSTRUCTION TRAP
;	    FROM THE SYSTEM.(SECTIONS 2. AND 4.)
;		THIS PART OF THE PROGRAM IS RESPONSIBLE FOR ROUTING THE
;		ILLEGAL INSTRUCTION TRAP TO FPE.IT IS NORMALLY EXECUTED
;		ONLY ONCE WHEN THE EMULATOR IS INSTALLED INTO THE 
;		SYSTEM. WHEN FPE IS RUN, THIS CODE IS EXECUTED AND
;		THE EMULATOR SUSPENDS. ALL SUBSEQUENT ENTRIES TO
;		FPE ARE MADE VIA THE ILLEGAL INSTRUCTION TRAP
;		(VECTOR LOACTION 10). THE  TRAP IS STOLEN FROM THE
;		SYSTEM BY FIRST MAKING IT SEEM LIKE THE VECTOR IS NOT 
;		IN USE, THEN CONNECTING TO THE INTERRUPT.THE PROCEDURE 
;		IS DESCRIBED IN DETAIL IN RSX11-SIG NEWSLETTER,
;		 VOL. 5, NO. 5, PAGE 74.
;		IF FPE IS RESUMED, THE ILLEGAL INSTRUCTION TRAP IS
;		RETURNED TO THE SYSTEM AND FPE EXITS. TO REMOVE
;		THE EMULATOR FROM THE SYSTEM:
;		MCR>HEL [10,10]
;		MCR>RES FPE...
;		MCR>UNF FPE...
;		MCR>REM FPE...

;	(2) CODE TO CRACK THE FLOATING POINT INSTRUCTIONS AND
;	    FETCH THE NECESSARY OPERANDS.(SECTIONS 6. AND 8.)
;		AFTER FPE HAS BEEN RUN ONCE, AN ILLEGAL INSTRUCTION
;		CAUSES CONTROL TO BE TRANSFERRED TO FPE'S INTERRUPT
;		SERVICE ROUTINE (ISR). THE FAULTING INSTRUCTION AND
;		PROCESSOR MODE ARE EXAMINED. IF THE INSTRUCTION IS
;		NOT FLOATING POINT OR THE MODE IS NOT USER, THE TRAP
;		IS FORWORDED TO THE SYSTEM FOR USUAL PROCESSING. *
;		IF THE INSTRUCTION IS FLOATING POINT IN USER MODE,
;		THE EMULATOR DECIDES WHICH INSTRUCTION IT IS AND
;		JUMPS TO THE APPROPRIATE FLOATING POINT INSTRUCTION
;		ROUTINE. AFTER SOME INITIALIZATION, THE "GET" 
;		SUBROUTINE IS CALLED WHICH FETCHES THE NECESSARY
;		OPERANDS.
;	     *  AN EXCEPTION TO THIS IS THE "STST" INSTRUCTION
;		WHICH MAY BE EXECUTED IN KERNEL MODE.
;
;	(3) THE FLOATING POINT INSTRUCTION SUBROUTINES.
;		(SECTIONS 6. AND 7.)
;		THESE ROUTINES DO THE ACTUAL FLOATING POINT OPERATIONS.
;		EACH F.P. TASK HAS 25. WORDS IN ITS HEADER THAT ARE
;		NORMALLY USED AS A SAVE AREA FOR THE HARDWARE F.P.
;		REGISTERS AND STATUS WORD. (1 1-WORD F.P. STATUS AND
;		6 4-WORD F.P. ACCUMULATORS). WHEN FLOATING POINT
;		HARDWARE IS PRESENT, THE REGISTERS AND STATUS ARE
;		SAVED UPON CONTEXT SWITCHING. THE EMULATOR HOWEVER,
;		USES EACH TASK'S F.P. SAVE AREA AS THAT TASK'S F.P.
;		ACCUMULATORS SO AT ALL TIMES, EACH F.P. TASK HAS ITS
;		OWN COMPLETE SET OF FLOATING POINT REGISTERS.
;
;	1.0.2	CONDITIONAL ASSEMBLY PARAMETERS
;	
;	THERE ARE THREE CONDITIONAL ASSEMBLY PARAMETERS IN SECTION
;	1.2 OF FPE.MAC. THEY ARE AS FOLLOWS:
;
;	(1) CHECKH -- DEFINING THIS SYMBOL ALLOWS THE EMULATOR TO
;	    BE TESTED ON A MACHINE THAT HAS FLOATING POINT HARDWARE.
;	    THIS IS DONE AT THE ASSEMBLY LANGUAGE LEVEL BY WRITING
;	    TEST PROGRAMS THAT HAVE ACTUAL ILLEGAL INSTRUCTIONS
;	    FOLLOWED BY FLOATING POINT INSTRUCTIONS. FOR EXAMPLE,
;		FPI=100			; ILLEGAL INSTRUCTION
;		GO:	FPI		; CAUSE TRAP TO FPE...
;			LDF	NUM,F1	; TEST LDF INSTRUCTION
;			FPI		; ANOTHER TRAP TO FPE...
;			STF	F1,NUM	; TEST STF
;			BR	GO	; PUT IN ODT BREAKPOINT HERE
;		NUM:	40200,177777
;		.END	GO
;	    TO PERFORM THE SAME OPERATIONS USING THE ACTUAL
;	    HARDWARE,SIMPLY DEFINE FPI AS A NOP (FPI=240).
;	    THIS FEATURE IS FOR CHECKOUT ONLY AND THEREFORE, CHECKH
;	    IS NOT DEFINED IN THE WORKING VERSION.
;

;	(2) STAT -- DEFINING THIS SYMBOL WILL CAUSE FPE TO RECORD THE
;	    NUMBER AND KIND OF FLOATING POINT INSTRUCTIONS EXECUTED
;	    AS WELL AS INFORMATION ABOUT ADDRESSING MODES AND
;	    FLOATING POINT EXCEPTION CONDITIONS. THIS IS DONE BY
;	    SIMPLY INCREMENTING THE APPROPRIATE TWO WORD COUNTERS
;	    FOR EACH INSTRUCTION EXECUTED.(THE FIRST WORD IS HIGH
;	    ORDER). WHEN THIS OPTION IS INCLUDED, THE TWO-WORD 
;	    COUNTERS ARE LOCATED NEAR THE BEGINNING OF FPE.
;	    TO EXAMINE THE STATISTICS GATHERED, THE OPEN COMMAND
;	    IS USED:
;		MCR>HEL [10,10]
;		MCR>OPE 334/TASK=FPE...
;		000334/XXXXXX (CARRIAGE RETURN)
;		000336/YYYYYY (CARRIAGE RETURN)
;		   .
;		   .
;		   .
;		   .
;		000650/ZZZZZZ (ALTMODE)
;	    FOR THE MEANING OF EACH OF THE STATISTICS WORDS, REFER TO
;	    SECTION 3. OF FPE.MAC. NOTICE THAT THE TASK ADDRESSES 
;	    DIFFER FROM THE LISTING ADDRESSES BY 100 OCTAL. (THIS
;	    IS BECUASE OF FPE'S STACK AREA).
;	    INCLUSION OF THIS FEATURE MAKES FPE OCCUPY MORE CORE AND
;	    RUN SOMEWHAT SLOWER. THEREFORE, STAT IS NOT DEFINED IN
;	    THE WORKING VERSION (NO STATISTICS GATHERED).
;
;	(3) MODFHW -- DURING THE DEVELOPMENT OF FPE IT WAS
;	    DISCOVERED THAT THE FLOATING POINT HARDWARE WOULD
;	    NOT INTERRUPT FOR AN OVERFLOW IN THE MODF/MODD
;	    INSTRUCTIONS. (SEE PDP11/45 PROCESSOR HANDBOOK
;	    FOR A DESCRIPTION OF THESE INSTRUCTIONS). IN
;	    SOME CASES, THIS FEATURE COULD BE UNDESIRABLE.
;	    FOR THIS REASON, THE FOLLOWING CHOICE IS MADE AVAILABLE:
;
;		DEFINE MODFHW -- THE EMULATOR WILL BEHAVE LIKE
;		THE HARDWARE. AN OVERFLOW WILL NOT CAUSE A FLOATING
;		POINT EXCEPTION.
;
;		UNDEFINE MODFHW -- AN OVERFLOW IN MODF/MODD WILL
;		CAUSE A FLOATING POINT EXCEPTION AST IF THE
;		INTERRUPT ON OVERFLOW BIT IS SET IN THE F.P.
;		STATUS WORD.
;
;	    NOTE: THIS ONLY AFFECTS THE MODD/MODF INSTRUCTIONS
;
;	    IN THE WORKING VERSION OF FPE, MODFHW IS DEFINED.

;	1.0.3	INSTALLING FPE
;	    SUPPOSE FPE.MAC IS LOACTED ON "DEV:[UIC]". THE FOLLOWING 
;	PROCEDURE IS USED TO INSTALL FPE.
;
;	(1) IN ORDER TO RUN FPE PROPERLY, THE SYSTEM MUST HAVE
;	    BEEN BUILT AS A FLOATING POINT SYSTEM. I.E., "FP"
;	    MUST BE PRESENT IN THE "PDP11" LINE OF THE SYSGEN
;	    PHASE ONE COMMAND LINE.
;
;	(2) LOGON UNDER A PRIVILEGED UIC. 
;	    (E.G., MCR>HEL [10,10])
;
;	(3) IF YOU WISH TO CHANGE ANY OF THE ASSEMBLY OPTIONS
;	    (E.G., IF THE STATISTICS OPTION IS DESIRED), EDIT
;	    FPE.MAC ON DEV:[UIC] AND DEFINE/UNDEFINE THE APPROPRIATE
;	    SYMBOLS.
;
;	(4) ASSEMBLE THE PROGRAM:
;	MCR>MAC DEV:[UIC]FPE=DEV:[UIC]FPE
;
;	(5) TASK BUILD FPE:
;	MCR>TKB
;	TKB>DEV:[UIC]FPE/PR/-AB/-FP/-CP/FX=DEV:[UIC]FPE,SY:[1,1]EXEC.STB
;	TKB>/
;	ENTER OPTIONS:
;	TKB>UNITS=0
;	TKB>STACK=32
;	TKB>TASK=FPE...
;	TKB>//
;	MCR>
;
;	(6) REBOOT THE SYSTEM AND MAKE SURE NO OTHER TASKS ARE
;	    INITIATED DURING THE REMAINDER OF THE INSTALATION PROCESS.
;
;	(7) INSTALL,FIX AND RUN FPE:
;	MCR>INS DEV:[UIC]FPE/PRI=70/TASK=FPE...
;	MCR>FIX FPE...
;	MCR>RUN FPE...
;	MCR>
;
;	(8) DISABLE THE FLOATING POINT CONTEXT SWITCHING:
;	MCR>OPE NNNNNN/KNL
;	NNNNNN/001010 240$
;	MCR>OPE MMMMMM/KNL
;	MMMMMM/001025 240$
;	MCR>
;
;	"$" ABOVE REPRESENTS THE ALT MODE OR ESCAPE KEY
;
;	THE VALUES OF NNNNNN AND MMMMMM DEPEND ON THE OPERATING SYSTEM
;	FOR RSX-11D V6A:
;		NNNNNN=007232
;		MMMMMM=007342
;	FOR RSX11-D V6.2:
;		NNNNNN=011766
;		MMMMMM=012076

;
;	(9) SAVE THE SYSTEM
;	    THE PROCEDURE DEPENDS UPON THE OPERATING SYSTEM AS WELL
;	    AS SYSTEM CONFIGURATION. 
;
;	    FOR RSX-11D V6A:
;
;	MCR>DMO SY:
;	MCR>(CARRIAGE RETURN)
;	SAV
;	;(DATE AND INITIALS)
;	MOU SY:/OVR
;	(MOUNT ANY OTHER DEVICES DESIRED)
;	TIM
;	(TYPE CONTROL C)
;
;	    FOR RSX-11D V6.2
;
;	MCR>DMO SY:
;	MCR>TER /NOCCF
;	MCR>(CARRIAGE RETURN)
;	SAV
;	;(DATE AND INITIALS)
;	MOU SY:/OVR
;	@STARTUP
;	(TYPE CONTROL C)
;
;	    NOTE THAT THE COMMANDS BETWEEN "MCR>(CARRIAGE RETURN)"
;	    AND "(TYPE CONTROL C)" ARE NOT ECHOED ON THE TERMINAL.
;	    THEY ARE NOT ACTUALLY INITIATED UNTIL THE CONTROL C IS
;	    TYPED.
;
;
;	THE SYSTEM SHOULD NOW RESTART
;-

	.SBTTL		1.1	MACRO CALLS AND DEFINITIONS
;
;	MACRO CALLS AND DEFINITIONS
;
	.MCALL PUSH,POP,CALL,EXIT$S,SPND$S
;
	.MACRO	IFERR	ARG
	BR	.+4		; CONTINUE IF NO ERROR
	.WORD	ARG+ASF3	; ADDRESS OF ERROR ROUTINE
	.ENDM
;
	.MACRO	MOVTU	ARG1,ARG2
	PUSH	ARG1
	MTPI	ARG2
	IFERR	ODAD1		; CHECK FOR LEGAL ADDRESSES
	.ENDM
;
	.MACRO CLRWRD	NUM,REG	; CLEAR NUM WORDS
				; REG = (RN)
	.REPT	NUM-1		; AUTO INC. NUM-1 TIMES
	CLR	REG+
	.ENDR
	CLR	REG
	.ENDM
;
	.MACRO	SINC	ARG	; INCREMENT STATISTICS IF STAT DEFINED
	.IF	DF	STAT
	ADD	#1,ARG'C+2
	ADC	ARG'C
	.ENDC
	.ENDM
;
	.MACRO	TSTOVF	?A,?B
	BVS	A		; TEST FOR OVERFLOW ON ROUND
	BCC	B
A:	CALL	TOVER
B:
	.ENDM
;
 .MACRO	TRKTST	ARG1,ARG2	; TEST TO SEE IF TRUNCATE BIT SET
	BIT	#40,ARG1	; IS THE TRUNCATE BIT SET?
	BNE	ARG2		; IF SO, SKIP PAST ROUNDING
	.ENDM
;

	.SBTTL		1.2	SYMBOL DEFINITIONS
;
PRIOR=40
PCOFF=6		; PCOFFSET=2*N+2 (N=#OF REGISTERS SAVED)
PCOFF2=2*7+2
PAR3K=172346
PAR2K=172344
PDR2K=172304
ASF2=40000
ASF3=60000
PSW=177776
;CHECKH=0		; DEFINE THIS TO CHECK EMULATOR ON 
			; AN 11 WITH FP HARDWARE 
			; (FOLLOW RESERVED INSTR. W/ FP INSTR.)
;STAT=0			; DEFINE THIS TO GENERATE STATISTICS
MODFHW=0		; DEFINE THIS TO EMULATE QUESTIONABLE HARDWARE
;
;	NOTE:	THE FLOATING POINT HARDWARE WILL NOT INTERRUPT FOR
;		AN OVERFLOW ENCOUNTERED IN THE MODF/MODD INSTRUCTIONS.
;		IF AN OVERFLOW HAS OCCURED, THE INTEGER WILL BE < 1
;		SINCE THE EXPONENT IS OFF BY 400 OCTAL. DEFINING MODFHW
;		EMULATES THIS STRANGE BEHAVIOR. IF IT IS NOT DEFINED,
;		AN OVERFLOW WILL CAUSE AN AST AS IN OTHER INSTRUCTIONS
;		(ASSUMING THE INTERRUPT ON OVERFLOW BIT IS SET).
;

	.SBTTL	2.	INITIALIZATION CODE
;
INIT:	MOV	.CRTSK,R0	;
	MOV	A.TD(R0),R1	; OUR STD ADR
	CALL	..PENP		; GET A NODE FROM THE POOL
	BCS	NONODE		; (ASSUMING THERE IS ONE)
	MOV	#10,R0		; ADDR OF RESERVED INSTR. TRAP
	PUSH	@#PSW		; SAVE CURRENT STATUS	
	MOV	#144140,@#PSW	;; PREVIOUS MODE=KERNEL
	MFPI	(R0)+		;; PUT SYSTEM TRAP PC ON STACK
	MFPI	(R0)		;; PUT SYSTEM TRAP PS ON STACK
	POP	SYSPS		;; SAVE SYSTEM PS
	MOV	R1,NODADR	;; SAVE NODE ADDRESS
	ADD	#6,R1		;; CODE WILL START @ BYTE 6
	MOV	R1,SYSTP	;; REMEMBER WHERE TO PICKUP SYSTEM TRAP
	MOV	#CODE,R4	;; PREPARE TO PUT IN CODE
	MOV	(R4)+,(R1)+	;; 
	MOV	(R4)+,(R1)+	;; PUT CODE IN THE NODE
	MOV	(R4)+,(R1)+	;;
	POP	(R1)+		;; PUT IN PC OF SYSTEM TRAP
	PUSH	#.EMINT		;; ..CINT NEEDS THIS
	MTPI	-(R0)		;; TEMP PC SAVED
	MOV	#FPISR,R1	;; FP INTERRUPT SERVICE ADR
	CLR	R2		;; BASE
	MOV	#PRIOR,R3	;; ESTABLISH PRIORITY
	CALL	..CINT		;; CONNECT TO INTERRUPT
	BCS	POPDUN		;; NO GOOD
	CALL	..ENB0		;; ENABLE TASK SWITCHING
	SPND$S			; SUSPEND EXECUTION
	PUSH	@#PSW		; PUT THINGS BACK
	MOV	#144140,@#PSW	;; NO TASK SWITCHING
	MOV	#10,R0		;; TRAP VECTOR ADR
	CALL	..DINT		;; DISCONNECT INTERRUPT
	MOV	NODADR,R1	;; GIVE BACK THE NODE
	PUSH	14(R1)		;; GET SYSTEM PC
	MTPI	(R0)+		;;
	PUSH	SYSPS		;;
	MTPI	(R0)		;; OLD PS BACK
	CALL	..ENB0		;; ENABLE TASK SWITCHING
	CALL	..RNTP		; RETURN NODE TO POOL
	EXIT$S
POPDUN:	CALL	..ENB0		;;
NONODE:	EXIT$S			; GIVE UP IF GOING GETS ROUGH
CODE:	POP	@#PAR3K
	JMP	@(PC)+

	.SBTTL	3.	STATISTICS GATHERED
	.IF DF STAT
INSTR:	0	; LAST INSTRUCTION PROCESSED
TOTALC:	0,0	; TOTAL NUMBER OF TIMES ISR WAS ENTERED
LDFPSC:	0,0	; # LDFPS
STFPSC:	0,0	; # STFPS
CLRFC:	0,0	; # CLRF + # CLRD
STSTC:	0,0	; # STST
TSTFC:	0,0	; # TSTF + #TSTD
ABSFC:	0,0	; # ABSF + # ABSD
NEGFC:	0,0	; # NEGF + # NEGD
MULFC:	0,0	; # MULF + # MULD
MULDC:	0,0	; # MULD
MODFC:	0,0	; # MODF + # MODD
ADDFC:	0,0	; # ADDF + # ADDD
ADDDC:	0,0	; # ADDD
LDFC:	0,0	; # LDF + # LDD
SUBFC:	0,0	; # SUBF + # SUBD
CMPFC:	0,0	; # CMPF + # CMPD
STFC:	0,0	; # STF + # STD
DIVFC:	0,0	; # DIVF + # DIVD
DIVDC:	0,0	; # DIVD
STEXPC:	0,0	; # STEXP
STCFIC:	0,0	; # STCFI + # STCFL + # STCDI + # STCDL
STCFDC:	0,0	; # STCFD + # STCDF
LDEXPC:	0,0	; # LDEXP
LDCIFC:	0,0	; # LDCIF + # LDCLF + # LDCID + # LDCLD
LDCDFC:	0,0	; # LDCDF + # LDCFD
SETIC:	0,0	; # SETI
SETLC:	0,0	; # SETL
SETFC:	0,0	; # SETF
SETDC:	0,0	; # SETD
CFCCC:	0,0	; # CFCC
Z0OPC:	0,0	; # NO OPERAND INSTRUCTIONS
Z1OPC:	0,0	; # ONE OPERAND INSTRUCTIONS
Z2OPC:	0,0	; # TWO OPERAND INSTRUCTIONS
MODE0C:	0,0	; ADDRESSING MODES USED IN ONE AND TWO OPERAND INSTR.
MODE1C:	0,0
MODE2C:	0,0
MODE3C:	0,0
MODE4C:	0,0
MODE5C:	0,0
MODE6C:	0,0
MODE7C:	0,0
LONGC:	0,0	; LONG MODE ( DOUBLE )
SHORTC:	0,0	; SHORT MODE ( FLOATING )
		; THE FLOATING/DOUBLE BIT IS TESTED ONLY ON ONE AND
		; TWO OPERAND INSTRUCTIONS
FPEC:	0,0	; FP EXCEPTIONS THAT CAUSED AN AST -- INTERRUPT ENABLED
TFPEC:	0,0	; TOTAL # OF FPE'S FOUND
UNDERC:	0,0	; # OF UNDERFLOW CONDITIONS
OVERC:	0,0	; # OF OVERFLOW CONDITIONS
FDZC:	0,0	; # OF DIVIDE BY ZERO CONDITIONS
ICEC:	0,0	; # OF INTEGER CONVERSION ERRORS
UNDVC:	0,0	; # OF UNDEFINED VARIABLES (MINUS ZERO)
FOPCEC:	0,0	; # OF OP CODE ERRORS
	.ENDC

	.SBTTL	4.	SYSTEM RETURN CODE
SPCASE:	MOV	PCOFF(SP),R1	; GET THE PC 
	MFPI	-(R1)		; PUT INSTR. THAT CALLED ON STACK
	POP	R1		; R1 HAS THE INSTRUCTION
	.IF NDF CHECKH
	MOV	R1,R0		; COPY INSTR
	.IIF	DF STAT		MOV	R1,INSTR
	BIC	#77,R0		; CLEAR OUT ADDRESSING
	CMP	#170300,R0	; SEE IF STST WAS EXCICUTED IN KERNEL
	BNE	POPOUT		; IF IT WASN'T QUIT
	.ENDC
	.IF DF CHECKH
	BIT	#^C075077,R1	; USE AN 11/40 FP INSTR. TO FAULT
	BNE	POPOUT		; IF NOT THAT, GIVE UP
	BIC	#177700,R1	; MAKE IT AN STST
	BIS	#170300,R1	; LEAVE DEST ALONE
	.ENDC
	MOV	#FAKFPS+ASF3,R0	; SETUP A FAKE FPSW ADDRESS
	JMP	NOTNO		; GO PROCESS
POPOUT:	POP	R1		; RETURN REGISTERS BEFORE QUITING
	POP	R0
SYSRTN:	MOVB	(PC)+,@(PC)+	; GIVE SYSTEM THE EXPECTED STATUS
SYSPS:	0
	PSW
	JMP	@(PC)+		; GO TO SYSTEM RETURN NODE
SYSTP:	0
NODADR:	0

	.SBTTL	5.	ISR TABLES
FPXCOD:	0			; FLOATING POINT EXCEPTION CODE
FXM:	0
FAKFPS:	100000			; FAKE FLOATING POINT STATUS
;
OPERA:	LDFPSX+ASF3,STFPSX+ASF3,STSTX+ASF3,CLRFX+ASF3,TSTFX+ASF3
	ABSFX+ASF3,NEGFX+ASF3
	MULFX+ASF3,MULFX1+ASF3,MULFX2+ASF3,MULFX3+ASF3
	MODFX+ASF3,MODFX1+ASF3,MODFX2+ASF3,MODFX3+ASF3
	ADDFX+ASF3,ADDFX1+ASF3,ADDFX2+ASF3,ADDFX3+ASF3
	LDFX+ASF3,LDFX1+ASF3,LDFX2+ASF3,LDFX3+ASF3
	SUBFX+ASF3,SUBFX1+ASF3,SUBFX2+ASF3,SUBFX3+ASF3
	CMPFX+ASF3,CMPFX1+ASF3,CMPFX2+ASF3,CMPFX3+ASF3
	STFX+ASF3,STFX1+ASF3,STFX2+ASF3,STFX3+ASF3
	DIVFX+ASF3,DIVFX1+ASF3,DIVFX2+ASF3,DIVFX3+ASF3
	STEXPX+ASF3,STEXP1+ASF3,STEXP2+ASF3,STEXP3+ASF3
	STCFIX+ASF3,STCFI1+ASF3,STCFI2+ASF3,STCFI3+ASF3
	STCFDX+ASF3,STCFD1+ASF3,STCFD2+ASF3,STCFD3+ASF3
	LDEXPX+ASF3,LDEXP1+ASF3,LDEXP2+ASF3,LDEXP3+ASF3
	LDCIFX+ASF3,LDCIF1+ASF3,LDCIF2+ASF3,LDCIF3+ASF3
	LDCDFX+ASF3,LDCDF1+ASF3,LDCDF2+ASF3,LDCDF3+ASF3

	.SBTTL	6.	START OF ISR ROUTINE
FPISR:	SINC	TOTAL		; STATISTICS
	PUSH	R0		; SAVE REGISTERS
	PUSH	R1
	BIT	#30000,@#PSW	; CHECK MODE
	BEQ	SPCASE		; GENERALLY THIS ISN'T ACCEPTABLE - GO CHECK
	MOV	@#.CRTSK,R0	; POINTER TO ATL NODE OF CURRENT TASK
	MOV	A.HA(R0),@#PAR2K	; SET RELOCATION
	MOV	#2006,@#PDR2K	; READ/WRITE IN 5 BLOCKS
	MOV	@#H.CR1+ASF2,R0	; R0 HAS POINTER TO FP SAVE AREA
	BEQ	POPOUT		; GIVE IT TO THE SYSTEM IF NO FP AREA
	ADD	#ASF2-ASF3,R0	; CORRECT R0 EXPLICITLY FOR ASF2 MAP
	MOV	PCOFF(SP),R1	; R1 HAS CURRENT PC
	.IF NDF CHECKH
	MFPI	-(R1)		; GET FAULTING INSTRUCTION
	MOV	R1,(PC)+	; SAVE PC OF INSTRUCTION
PCSAVE:	0			; NEXT INSTRUCTION LOCATION
	.ENDC
	.IF DF CHECKH		; FOLLOW  RESERVED INSTR. WITH A FP INSTR.
	MOV	R1,(PC)+	; SAVE PC OF INSTRUCTION
PCSAVE:	0			; NEXT INSTRUCTION LOCATION
	MFPI	(R1)+		; GET FP INSTR.
	MOV	R1,PCOFF+2(SP)	; FUDGE UP PC
	.ENDC
	POP	R1		; R1 HAS THE INSTR. THAT CALLED
	.IIF DF	STAT	MOV	R1,INSTR	; SAVE INSTRUCTION
	BGE	POPOUT		; FP INSTR.S ARE AT LEAST NEGATIVE
	CMP	#170000,R1	; ALSO LESS THAN THIS
	BGT	POPOUT		; GIVE BACK TO SYSTEM
	BIT	#7700,R1	; IS THIS A NO OPERAND INSTR.?
	BEQ	NO		; NO IT'S GOT NO OPERAND
NOTNO:
	PUSH	R2		; SAVE ANOTHER REGISTER
	PUSH	R3
	PUSH	R4
	PUSH	R5
	MFPI	SP
	MOV	R1,R2		; COPY INSTR.
	CLR	NMB		; FOR USE IN GET SUBROUTINE
	MOV	#200,R3		; MOST COMMON FPSR MASK
	MOV	#10,R5
	MOV	R0,R4		; POINT TO FP SAVE AREA
	BIC	#170077,R1	; PICK DISTINGUISHING PART OF INSTR.
	ASH	#-5,R1		; SHIFT IT SO IT BECOMES AN OFFSET
	ADD	#OPERA+ASF3,R1	; NOW A REAL ADDRESS
	JMP	@-(R1)		; GO TO THE PROPER ROUTINE
NO:	SINC	Z0OP		; STATS
	DECB	R1		; DECODE NO OPERAND INSTRUCTIONS
	BGE	NO1		; BRANCH IF NOT CFCC
CFCCX:	MOV	(R0),R1		; GET CONTENTS OF FPSR
	SINC	CFCC		; STATS
	BIC	#177760,R1	; MASK ALL BUT LOW 4 BITS
	BIC	#17,PCOFF+2(SP)	; CLEAR OUT PRESENT STATUS
	BIS	R1,PCOFF+2(SP)	; SET THE BITS IN TASKS PSW
FPEXIT:	POP	R1		; RETURN REGISTERS
	POP	R0
	JMP	@#..INTX
NO1:	BNE	NO2		; BRANCH IF NOT SETF
SETFX:	BIC	#200,(R0)	; CLEAR FD BIT IN FPSR
	SINC	SETF		; STATS
	BR	FPEXIT
NO2:	CMPB	#10,R1		;
	BLE	NO3		; IT IS NOT SETI
	DECB	R1		; MAKE SURE THIS IS SETI
	BNE	ILLIN		; BRANCH IF ILLEGAL INSTRUCTION
SETIX:	BIC	#100,(R0)	; CLEAR FL BIT IN FPSR
	SINC	SETI		; STATISTICS
	BR	FPEXIT		; DONE
NO3:	BLT	SETLX		; BRANCH IF SETL
SETDX:	BIS	#200,(R0)	; SET FD BIT IN FPSR
	SINC	SETD		; STATS
	POP	R1		; RETURN REGISTERS
	POP	R0
	JMP	@#..INTX
SETLX:	CMPB	R1,#11		; MAKE SURE THIS IS SETL
	BNE	ILLIN		; BRANCH IF ILLEGAL INSTRUCTION
	BIS	#100,(R0)	; SET FL BIT IN FPSR
	SINC	SETL		; STATS
	BR	FPEXIT		; DONE
ILLIN:	SINC	UNDV		; STATS
	SINC	TFPE
	BIS	#100000,(R0)	; SET ERROR BIT
	MOV	#2,FPXCOD	; SET EXCEPTION CODE
	BIT	#40000,(R0)	; IS INHIBIT INTERRUPT SET?
	BNE	FPEXIT		; IF SO JUST EXIT QUIETLY
	SINC	FPE		; STATS
	MOV	@#244,4(SP)	; SETUP TO GO AST
	POP	R1
	POP	R0
	MOV	#34340,@#PSW
	JMP	@(SP)+		; GO

	.SBTTL	7.	SINGLE AND DOUBLE OPERAND ROUTINES
	.SBTTL	  	7.1	ABSF,NEGF,LDFPS,TSTF,LDF,STFPS,STST,CLRF
;----------------------------------------------------------------
ABSFX:
	SINC	Z1OP
	SINC	ABSF		; STATS
	INC	NMB		; WANT AN ADDRESS
	CALL	GET		; GET IT
	BCS	ABSFY		; MODE 0
	MFPI	(R1)		; GET FIRST NUMBER
	IFERR	ODAD1		; CHECK FOR LEGAL ADDRESSES
	BIC	#100000,(SP)	; MAKE SURE IT IS POSITIVE
	MOV	(SP),NUMB	; WILL WANT TO SET CONDITION CODES
	MTPI	(R1)		; PUT ABS VALUE BACK
	BR	TSTFY		; SET CONDITION CODES
ABSFY:	BIC	#100000,(R1)	; MAKE POSITIVE
	MOV	(R1),NUMB	; SAVE ABS VALUE
	BR	TSTFY
;----------------------------------------------------------------
NEGFX:
	SINC	Z1OP
	SINC	NEGF		; STATS
	INC	NMB		; WANT AN ADDRESS
	CALL	GET		;
	BCS	NEGFZ		; GO DO MODE 0
	MFPI	(R1)		; GET NUMBER
	IFERR	ODAD1		; CHECK FOR LEGAL ADDRESSES
	ADD	#100000,(SP)	; DO NEGATE
	MOV	(SP),NUMB	; SAVE RESULT
	MTPI	(R1)		; PUT BACK IN USER TASK
	BR	TSTFY		; SET CONDITION CODES
NEGFZ:
	ADD	#100000,(R1)	; DO NEGATE
	MOV	(R1),NUMB	;
	BR	TSTFY		; GO SET CODES
;----------------------------------------------------------------
LDFPSX:
	SINC	Z1OP
	SINC	LDFPS		; STATS
	MOV	#2,R5		; MAX AUTOINCREMENT IS 2
	CALL	GETX		; GET IT
	MOV	NUMB,(R0)	; SAVE STATUS
	BCC	FPEX2		; DONE IF NOT MODE 0
	MOV	(R4),(R0)	; GET NUMBER FROM A RESISTER ON THE STACK
	BR	FPEX2
;----------------------------------------------------------------
TSTFX:
	SINC	Z1OP
	SINC	TSTF		; STATS
	CALL	GET
	BR	TSTFY
;----------------------------------------------------------------
LDFX3:	ADD	R5,R4
LDFX2:	ADD	R5,R4
LDFX1:	ADD	R5,R4
LDFX:	TST	(R4)+		; AC0
	SINC	Z2OP
	SINC	LDF		; STATS
	MOV	R4,TMP3		; SAVE POINTER TO AC
	CALL	GET
	MOV	TMP3,R2		; GET AC ADDRESS
	BIT	#200,(R0)	; SINGLE OR DOUBLE
	BNE	LDDX		; BRANCH ON DOUBLE
	CLR	2(R2)		; CLEAR OUT REGISTER
	MOV	#NUMB+ASF3,R3	; GET ADDRESS OF NUMBERS
LDFY:	MOV	(R3)+,(R2)+	; LOAD THE NUMBERS
	DEC	TMP1
	BGT	LDFY		;
TSTFY:	BIC	#17,(R0)	; CLEAR OUT CURRENT CONDITION CODES
TSTFY2:	BIT	#77600,NUMB	; CHECK FOR ZERO IN EXPONENT --> 0 FRAC
	BNE	10$		; NOT ZERO
	BIS	#4,(R0)		; SET ZERO INDICATOR
10$:	TST	NUMB		; NOW IS IT NEGATIVE?
	BGE	FPEX2		; NO
	BIS	#10,(R0)	; SET NEGATIVE BIT
FPEX2:
	MTPI	SP		;
	POP	R5
	POP	R4
	POP	R3
	POP	R2
	POP	R1		; RETURN REGISTERS
	POP	R0
	JMP	@#..INTX	; RETURN TO USER
LDDX:	CLRWRD	4,(R2)		; CLEAR OUT THE FAC
	MOV	TMP3,R2		; GET THE TOP OF FAC AGAIN
	MOV	#NUMB+ASF3,R3	; POINT TO NUMBER
	BR	LDFY		; GO LOAD
;----------------------------------------------------------------
STFPSX:
	SINC	Z1OP
	SINC	STFPS		; STATS
	MOV	#2,R5		; WANT ONLY AN ADDRESS
	INC	NMB		; WANT AN ADDRESS
	CALL	GETX		; GET THE ADDRESS
	BCS	STFPSY		; MODE 0 IS DIFFERENT
	MOVTU	(R0),(R1)	; STORE STATUS IN USER AREA
	BR	FPEX2		; DONE
STFPSY:	MOV	(R0),(R4)	; PUT IT IN A REGISTER
	BR	FPEX2		; DONE
;----------------------------------------------------------------
STSTX:
	SINC	Z1OP
	SINC	STST		; STATS
	MOV	#-1,R3		; NO PARTICULAR BIT TO TEST
	ASR	R5		; AUTO INC. BY 4 ALWAYS
	INC	NMB		; WANT AN ADDRESS
	CALL	GET		; GET ADDRESS
	BCS	STSTY		; BRANCH IF MODE 0
	MOVTU	FPXCOD,(R1)+	; PUT FEC IN USER AREA
	DEC	TMP1		; WANT FEA ALSO?
	BEQ	FPEX2		; EVIDENTLY NOT
	MOVTU	PCSAVE,(R1)	; YES - PUT IT IN USER AREA +2
	BR	FPEX2		; LEAVE
STSTY:	MOV	FPXCOD,(R4)	; PUT FEC IN A REGISTER
	BR	FPEX2		; AND LEAVE
;----------------------------------------------------------------
CLRFX:
	SINC	Z1OP
	SINC	CLRF		; STATS
	BIC	#17,(R0)	; CLEAR OUT CONDITION CODES
	BIS	#4,(R0)		; SET ZERO CONDITION CODE
	INC	NMB		; WANT AN ADDRESS
	CALL	GET
	BCS	CLRFZ		; MODE 0 PROCESSING
CLRFY:	CLR	-(SP)		; ALL OTHER MODES PROCESSED
	MTPI	(R1)+		; PUT THE ZERO IN
	IFERR	ODAD1		; CHECK FOR LEGAL ADDRESSES
	DEC	TMP1		; DECREMENT THE WORD COUNT
	BGT	CLRFY		; CONTINUE TILL FINISHED
	BR	FPEX2		; DONE
CLRFZ:	CLR	(R1)+		; PUT THE ZERO IN THE HEADER
	DEC	TMP1
	BGT	CLRFZ		; CONTINUE TILL DONE
	BR	FPEX2		; FINISHED
;----------------------------------------------------------------

	.SBTTL	  	7.2	MULF
;----------------------------------------------------------------
MULGET:	MOV	R4,TMP3		; SAVE POINTER TO AC
	CALL	GET		; GET THE NUMBER
	PUSH	R0		; SAVE FPSW POINTER
	MOV	TMP3,R0		; SETUP POINTER TO FAC
	MOV	#NUMB+ASF3,R1	; SETUP POINTER TO FSRC
	BIT	#200,@(SP)	; CHECK MODE
	BEQ	MULF		; BRANCH IF SINGLE PRECISION
	CLR	MODFLG		; THIS IS MULD NOT MODF OR MODD
	JMP	MULDX		; GO DO DOUBLE
MULDM0:	SINC	LONG		; STATS
	MOV	#NUMB+ASF3,R1	; MUST COPY THE FSRC TO SCRATCH AREA
	MOV	(R2)+,(R1)+	; MOVE IT
	MOV	(R2)+,(R1)+
	MOV	(R2)+,(R1)+
	MOV	(R2),(R1)	; DONE
	PUSH	R0		; SAVE POINTER
	MOV	R4,R0		; POINT TO FAC WITH R0
	MOV	R4,TMP3		; SAVE POINTER TO AC
	MOV	#NUMB+ASF3,R1	; R1 POINTS TO BEGINNING OF FSRC
	CLR	MODFLG
	JMP	MULDX		; GO DO DOUBLE MULTIPLY
MULFX3:	ADD	R5,R4		; PROPER AC
MULFX2:	ADD	R5,R4		; PROPER AC
MULFX1:	ADD	R5,R4		; PROPER AC
MULFX:	TST	(R4)+		; AC0
	SINC	Z2OP
	SINC	MULF		; STATS
	CLR	FXM		; CLEAR FPE FLAG
	BIT	#70,R2		; CHECK FOR MODE0
	BNE	MULGET		; IF NOT MODE 0 ,DO REGULAR THINGS
	SINC	MODE0		; STATS
	BIC	#77770,R2	; CLEAR ALL BUT REGISTER AND MSB
	ASL	R2		; SHIFT TO MAKE AN OFFSET
	ROL	R2		; PUT IN CARRY TO ADD 2
	ASL	R2		; SHIFT IS DONE
	ADD	R0,R2		; R2 HAS THE POINTER TO FSRC
	BIT	#200,(R0)	; FLOATING OR DOUBLE?
	BNE	MULDM0		; BRANCH IF DOUBLE
	SINC	SHORT		; STATS
	MOV	R2,R1		; R1 POINTS TO FSRC
	PUSH	R0		; SAVE POINTER
	MOV	R4,R0		; POINT TO FAC WITH R0
	MOV	R4,TMP3		; SAVE POINTER TO AC
MULF:	MOV	(R0)+,R4	; HIGH ORDER FAC
	MOV	(R0),R5		; LOW ORDER FAC
	ASHC	#1,R4		; GET THE SIGN OUT
	ROL	-(SP)		; SAVE IT ON THE STACK
	PUSH	R4		; WANT EXPONENT ON THE STACK
	CLRB	(SP)		; CLEAR OUT FRACTION
	SWAB	(SP)		; PUT IT IN THE LOW ORDER BYTE
	BEQ	MULZRO		; ANSWER IS ZERO
	ASHC	#7,R4		; LEFT JUSTIFY THE FAC
	PUSH	R5		; SAVE LOW ORDER FAC ON STACK
	BIS	#100000,R4	; PUT IN HIDDEN BIT
	PUSH	R4		; SAVE HIGH ORDER FAC ON STACK
	MOV	(R1)+,R2	; GET HI ORDER FSRC
	MOV	(R1),R3		; LOW ORDER FSRC
	ASHC	#1,R2		; SHIFT OUT SIGN
	ADC	6(SP)		; STORE FINAL SIGN
	MOV	R2,R1		; GET THE EXP OF FSRC
	CLRB	R1		; GET RID OF FRACTION
	SWAB	R1		; RIGHT JUSTIFY
	BEQ	MULZR2		; ANSWER IS ZERO
	ADD	R1,4(SP)	; STORE THE SUM OF THE EXPONENTS
	ASHC	#7,R2		; LEFT JUSTIFY THE FSRC
	BIS	#100000,R2	; PUT IN HIDDEN BIT
	CLR	(R0)		; CLEAR PLACE IN FAC FOR ANSWER
	CLR	-(R0)		;
	TST	R3		; TEST LOW ORDER FSRC
	BEQ	MULA2Z		; BRANCH IF ZERO
	MUL	R3,R4		; GET HI(FAC)*LO(FSRC)
	ADD	R3,R4		; ADD LO(FSRC) TO HI WORD OF RESULT
				; THIS MUST BE DONE SINCE HI(FAC)
				; IS REALLY POSITIVE EVEN THOUGH IT
				; APPEARS NEGATIVE TO THE MUL INSTR.
	TST	R3		; WAS LO(FSRC) INTERPRETED AS MINUS?
	BPL	MULA2P		; IF NOT O.K.
	ADD	(SP),R4		; IF SO, CORRECT FOR IT BY ADDING
				; HI(FAC) TO HIGH WORD OF MULTIPLICATION
MULA2P:	MOV	R4,2(R0)	; PUT IN HI(FAC)*LO(FSRC)
MULA2Z:	MOV	2(SP),R4	; PUT LO(FAC) IN R4
	BEQ	MULB2Z		; BRANCH IF ZERO
	MUL	R2,R4		; GET HI(FSRC)*LO(FAC)
	ADD	2(SP),R4	; ADD LO(FAC)  SINCE HI(FSRC)REALLY +
	TST	2(SP)		; SEE IF LO(FSRC) WAS MISTAKEN FOR NEGATIVE
	BPL	MULB2P		; NO -- NO PROBLEM
	ADD	R2,R4		; PUT IN CORRECTION
MULB2P:	ADD	R4,2(R0)	; ADD IN HI(FSRC)*LO(FAC)
	ADC	(R0)		; THERE MAY BE A CARRY
MULB2Z:	MOV	R2,R4		; NOW GET HI(FAC)*HI(FSRC)
	ADD	R2,(R0)		; ADD HI(FSRC) TO RESULT
	MUL	(SP),R4		; MULT. HI(FAC)*HI(FSRC)
	ADD	(SP)+,(R0)+	; ADD HI(FAC) TO RESULT
	ADD	R5,(R0)		; PUT IN LOW ORDER
	ADC	-(R0)		; INCLUDE CARRY
	ADD	R4,(R0)		; PUT IN HIGH ORDER
	TST	(SP)+		; POP LO (FAC)
	POP	R4		; GET EXPONENT
	ROL	2(R0)		; GET RID OF NORMAL BIT
	ROL	(R0)+		;
	BCS	MULNRM		; BRANCH IF IT WAS FOUND
	ROL	(R0)		; SHIFT AGAIN
	ROL	-2(R0)		; MUST HAVE IT NOW
	DEC	R4		; ADJUST EXPONENT
MULNRM:	SUB	#200,R4		; GET RID OF EXTRA EXCESS 128.
	BGT	MULNU		; BRANCH ON NO UNDERFLOW
	CALL	UNDER		; HANDLE UNDERFLOW
MULNU:	CMP	#377,R4		; CHECK FOR OVERFLOW
	BGE	MULOK		; BRANCH IF NO OVERFLOW
	CALL	OVER		; PROCESS OVERFLOW
MULOK:	CLRB	(R0)		; SHIFT THE THING RIGHT
	BISB	-2(R0),(R0)	; MOVE  BYTES
	SWAB	(R0)		; PROPER ORDER
	TST	-(R0)		; POINT TO FIRST WORD
	CLRB	(R0)		; ROOM FOR EXPONENT
	BISB	R4,(R0)		; EXPONENT IN
	SWAB	(R0)		; EXPONENT ON THE LEFT
	ROR	(SP)+		; PUT SIGN IN CARRY
	ROR	(R0)+		; PUT THE SIGN IN
	ROR	(R0)		;
	TRKTST	@(SP),10$	; CHECK TRUNCATE BIT
	ADC	(R0)		; ROUND
	ADC	-(R0)		;
	TSTOVF			; CHECK FOR OVERFLOW
10$:	JMP	ADDOUT		; GO FINISH
MULZR2:	CMP	(SP)+,(SP)+	; SET STACK PROPERLY
MULZRO:	CMP	(SP)+,(SP)+	; DONE
	CLR	(R0)		; SET TO ZERO
	CLR	-(R0)		; FAC = 0 NOW
	JMP	ADDOUT
OVER:	MOV	#10,FPXCOD	; PUT IN FEC
	BIC	#17,@4(SP)	; CLEAR OUT CC'S
	BIS	#2,@4(SP)	; SET V BIT
	MOV	#1000,FXM	; SET FPSW MASK
	SINC	OVER		; STATS
	RETURN			; CONTINUE WITH REGULAR PROCESSING
TOVER:	MOV	#10,FPXCOD	; PUT IN FEC
	BIC	#17,@2(SP)	; THIS ROUTINE HAS DIFFERENT STACK FROM
	BIS	#2,@2(SP)	; THE OVER SUBROUTINE
	MOV	#1000,FXM	; SET FPSW MASK
	SINC	OVER		; STATS
	RETURN			; CONTINUE WITH REGULAR PROCESSING
;----------------------------------------------------------------

	.SBTTL		7.3	MULD
;----------------------------------------------------------------
MULDX:
	SINC	MULD		; STATS
MULDX1:	ASL	(R0)		; SHIFT LEFT FAC
	ROL	-(SP)		; SAVE SIGN ON STACK
	CLR	-(SP)		; MAKE ROOM FOR THE EXPONENT
	MOVB	1(R0),(SP)	; SAVE EXPONENT
	BEQ	MULDZR		; BRANCH IF ANSWER IS ZERO
	SWAB	(R0)		; WISH TO LEFT JUSTIFY THE FAC
	SEC			;
	ROR	(R0)+		; PUT IN HIDDEN BIT
	MOVB	1(R0),-2(R0)	; SHIFT LEFT 1 BYTE  TO JUSTIFY
	SWAB	(R0)+		; PROPER ORDER
	MOVB	1(R0),-2(R0)	;
	SWAB	(R0)+		;
	MOVB	1(R0),-2(R0)	;
	SWAB	(R0)		; DONE
	CLRB	(R0)		; CLEAR OUT LOWEST BYTE
	ASL	(R1)		; SHIFT LEFT FSRC
	ADC	2(SP)		; GET SIGN OF RESULT
	TSTB	1(R1)		; IS THE FSRC = 0?
	BNE	MULDNZ		; BRANCH IF NOT
MULDZR:	CMP	(SP)+,(SP)+	; CLEAR STACK OF UNWANTED ITEMS
	MOV	TMP3,R0		; GET ADDRESS OF FAC
	CLR	(R0)+		; CLEAR FAC
	CLR	(R0)+
	CLR	(R0)+
	CLR	(R0)+		; DONE
	TST	MODFLG		; THIS COULD BE A MOD INSTR.
	BNE	10$		; BRANCH IF IT IS
	JMP	ADDOUT		; ELSE GO FINISH
10$:	MOV	TMP3,R1		; FAC ADDRESS
	SUB	(SP),R1		; MUST CHECK FOR EVEN FAC
	BIT	#10,R1		; IS IT ODD?
	BNE	20$		; IF IT IS ODD, WE ARE DONE
	CLRWRD	4,(R0)		; IF EVEN, CLEAR THE INTEGER REGISTER
20$:	JMP	ADDOUT		; GO FINISH
MULDNZ:	CLR	R2		; R2!R3!R4!R5 WILL ACCUMULATE ANSWER
	CLR	R3		; GET THE HIGH ORDER READY
	CLR	R4		; USE R4 FOR SOME TEMP STUFF
	BISB	1(R1),R4	; GET EXPONENT
	ADD	R4,(SP)		; GET THE SUM OF THE EXPONENTS
	MOVB	#1,1(R1)	; PUT IN NORMALIZE BIT
	ROR	(R1)		; THERE
	SWAB	(R1)+		; LEFT JUSTIFY THE FSRC
	MOVB	1(R1),-2(R1)	; SHIFT LEFT ONE BYTE
	SWAB	(R1)+		; PROPER ORDER
	MOVB	1(R1),-2(R1)	;
	SWAB	(R1)+		;
	MOVB	1(R1),-2(R1)	;
	SWAB	(R1)		; DONE
	CLRB	(R1)		; CLEAR OUT LOW BYTE
	SUB	#6,R0		; POINT BACK TO THE TOP OF FAC
	PUSH	(R0)+		; FAC1
	PUSH	(R1)		; FSRC4
	CALL	MULT		; GO  MULTIPLY -- RETURN RESULT TO STACK
	POP	R4		; RESULT TO LOW HALF OF 4 WORD ACCUMULATOR
	POP	R5		;
	PUSH	(R0)+		; FAC2
	PUSH	-(R1)		; FSRC3
	CALL	MULT		; FAC2*FSRC3
	ADD	(SP)+,R4	; ADD TO LOW HALF
	ADC	R3
	ADD	(SP)+,R5
	ADC	R4		; MAY HAVE CARRY
	ADC	R3		;
	PUSH	(R0)+		; FAC3
	PUSH	-(R1)		; FSRC2
	CALL	MULT		; FAC3*FSRC2
	ADD	(SP)+,R4	; ADD IN
	ADC	R3
	ADD	(SP)+,R5
	ADC	R4
	ADC	R3
	PUSH	(R0)		; FAC4
	PUSH	-(R1)		; FSRC1
	CALL	MULT		; FAC4*FSRC1
	ADD	(SP)+,R4	; ADD IN
	ADC	R3
	ADD	(SP)+,R5
	ADC	R4
	ADC	R3
	MOV	R4,R5		; DIVIDE BY 2**16
	MOV	R3,R4
	CLR	R3		; DONE
	PUSH	-(R0)		; FAC3
	PUSH	(R1)+		; FSRC1
	CALL	MULT		; FAC3*FSRC1
	ADD	(SP)+,R4
	ADC	R3
	ADD	(SP)+,R5
	ADC	R4
	ADC	R3
	PUSH	-(R0)		; FAC2
	PUSH	(R1)+		; FSRC2
	CALL	MULT		; FAC2*FSRC2
	ADD	(SP)+,R4
	ADC	R3
	ADD	(SP)+,R5
	ADC	R4
	ADC	R3
	PUSH	-(R0)		; FAC1
	PUSH	(R1)		; FSRC3
	CALL	MULT		; FAC1*FSRC3
	ADD	(SP)+,R4
	ADC	R3
	ADD	(SP)+,R5
	ADC	R4
	ADC	R3
	PUSH	(R0)+		; FAC1
	PUSH	-(R1)		; FSRC2
	CALL	MULT		; FAC1*FSRC2
	ADD	(SP)+,R3
	ADC	R2
	ADD	(SP)+,R4
	ADC	R3
	ADC	R2		; ADDING TO MIDDLE 2 WORDS NOW
	PUSH	(R0)		; FAC2
	PUSH	-(R1)		; FSRC1
	CALL	MULT		; FAC2*FSRC1
	ADD	(SP)+,R3
	ADC	R2
	ADD	(SP)+,R4
	ADC	R3
	ADC	R2
	PUSH	-(R0)		; FAC1
	PUSH	(R1)		; FSRC1
	CALL	MULT		; FAC1*FSRC1
	ADD	(SP)+,R2	; HIGHEST WORD
	ADD	(SP)+,R3
	ADC	R2		; FRACTION MULTIPLICATION DONE
	POP	R1		; PUT SUM OF EXPONENTS IN R1
	ASL	R5		; SHIFT OUT NORMAL BIT
	ROL	R4
	ROL	R3
	ROL	R2		; DONE
	BCS	MULDNM		; BRANCH IF FOUND
	ASL	R5
	ROL	R4
	ROL	R3
	ROL	R2		; DONE
	DEC	R1		; ADJUST EXPONENT
MULDNM:	TST	MODFLG		; IS THIS MULD OR MODF/MODD?
	BEQ	MULD		; BRANCH IF MULD INSTRUCTION
	JMP	MODFY		; GO DO MOD INSTRUCTION
MULD:	SUB	#200,R1		; GET RID OF EXTRA EXCESS 128.
	BGT	MULDNU		; BRANCH ON NO UNDERFLOW
	CALL	UNDER		; SET UNDERFLOW FLAGS
MULDNU:	CMP	#377,R1
	BGE	MULDOK		; BRANCH ON NO OVERFLOW
	CALL	OVER		; SET OVERFLOW
MULDOK:	CALL	MULDMD		; GO SHIFT RIGHT AND INSERT EXPONENT
	TSTOVF			; CHECK FOR OVERFLOW
MULDOT:	MOV	R2,(R0)+	; SAVE THE ANSWER IN THE FAC
	MOV	R3,(R0)+
	MOV	R4,(R0)+
	MOV	R5,(R0)
	JMP	ADDOUT
MULT:	PUSH	R4		; SAVE REGISTERS
	PUSH	R5
	CLR	-(SP)		; CLEAR HIGH PRODUCT
	MOV	10(SP),R4	; MULTIPLICAND
	BEQ	MZ		; BRANCH IF 0
	BGT	MPLUS		; BRANCH IF PLUS
	TST	12(SP)		; TEST MULTIPLIER
	BEQ	MZ		; 0
	BGT	MNEG1		; +
	BR	MNEG
MPLUS:	TST	12(SP)		; TEST MULTIPLIER
	BEQ	MZ
	BGT	MLTQ
	ADD	R4,(SP)		; CORRECTION
	BR	MLTQ
MNEG:	ADD	R4,(SP)		; 
MNEG1:	ADD	12(SP),(SP)	;
MLTQ:	MUL	12(SP),R4	; GET PRODUCT
MDONE:	ADD	(SP)+,R4	; ADD HIGH ORDER PARTS
	MOV	R4,6(SP)	; RETURN ANSWER ON STACK
	MOV	R5,10(SP)	;
	POP	R5		; RETURN REGISTERS
	POP	R4
	RETURN
MZ:	CLR	R4		; ZERO
	CLR	R5
	BR	MDONE
MULDMD:
	CLRB	R5		; SHIFT EVERYTHING RIGHT
	BISB	R4,R5		;
	SWAB	R5
	CLRB	R4
	BISB	R3,R4
	SWAB	R4
	CLRB	R3
	BISB	R2,R3
	SWAB	R3
	CLRB	R2
	BISB	R1,R2		; PUT THE EXPONENT IN
	SWAB	R2		; PROPER ORDER
	ROR	2(SP)		; GET THE SIGN
	MOV	(SP)+,(SP)	; SET RETURN
	ROR	R2		; PUT IT IN
	ROR	R3
	ROR	R4
	ROR	R5
	TRKTST	@2(SP),10$	; CHECK TRUNCATE -- BRANCH IF SET
	ADC	R5		; ROUND IT
	ADC	R4
	ADC	R3
	ADC	R2		; DONE
	RETURN
10$:	CLC
	RETURN			; RETURN
;----------------------------------------------------------------

	.SBTTL		7.4	MODF,MODD
;----------------------------------------------------------------
MODFX3:	ADD	R5,R4		; PROPER AC
MODFX2:	ADD	R5,R4		; PROPER AC
MODFX1:	ADD	R5,R4		; PROPER AC
MODFX:	TST	(R4)+		; AC0
	SINC	Z2OP
	SINC	MODF		; STATS
	MOV	#1,MODFLG	; SET MOD INSTRUCTION FLAG
	CLR	FXM		; INITIALIZE FPSW MASK
	MOV	R4,TMP3		; SAVE POINTER TO AC
	CALL	GET
	PUSH	R0		; SAVE FPSW POINTER
	MOV	TMP3,R0		; POINT TO  FAC
	MOV	#NUMB+ASF3,R1	; POINT TO FSRC
	JMP	MULDX1		; GO MULTIPLY
;
MODFY:
	MOV	#59.,TMP2	; SET THE NUMBER OF PRODUCT BITS
	BIC	#37,R5		; GET RID OF EXTRA PRECISION LIKE HARD.
	BIT	#200,@2(SP)	; CHECK FLOATING OR DOUBLE
	BNE	MODD		; BRANCH IF DOUBLE
	CLR	R5		; SINGLE PRECISION KEEPS 48. BITS
	MOV	#48.,TMP2	; SET THE NUMBER OF PRODUCT BITS TO 48.
MODD:	SUB	#200,R1		; GET RID OF EXTRA EXCESS 128.
	BGT	MODNU		; BRANCH ON NO UNDERFLOW
	CALL	UNDER		; SET UNDERFLOW
MODNU:
	.IF NDF	MODFHW
	CMP	#377,R1		; CHECK FOR OVERFLOW
	BGE	MODNO		; BRANCH ON NO OVERFLOW
	CALL	OVER		; SET OVERFLOW
	.ENDC
MODNO:	SUB	#200,R1		; GET THE MINIMUM SHIFT COUNT
	BGT	MODFZ		; BRANCH IF THERE IS SHIFTING TO DO
	ADD	#200,R1		; RESTORE EXPONENT
	CALL	MULDMD		; NO SHIFT NEEDED
	SUB	(SP),R0		; CHECK FOR EVEN/ODD FAC
	BIT	#10,R0		;
	BNE	MODDUN		; BRANCH IF ODD REGISTER
	MOV	TMP3,R0		; GET ADDRESS OF FAC BACK
	ADD	#10,R0		; GET ADDRESS OF FAC+1 (FAC IS EVEN HERE)
	CLRWRD	4,(R0)		; CLEAR THE INTEGER REGISTER
MODDUN:	MOV	TMP3,R0		; R0 HAS ADDRESS OF FAC
	CALL	MODSAV		; SAVE THE FRACTION
	JMP	ADDOUT		; GO FONISH
MODFZ:	CMP	R1,TMP2		; HOW BIG IS THE INTEGER?
	BLE	MODSHF		; SHIFT IF NOT TOO BIG
	CLRWRD	4,(R0)		; OTHERWISE ZERO THE FRACTION REGISTER
	ADD	#200,R1		; RESET EXPONENT
	MOV	TMP3,R0		; CHECK FOR EVEN/ODD FAC
	SUB	2(SP),R0
	BIT	#10,R0
	BEQ	MODINT		; BRANCH IF EVEN FAC
	JMP	ADOUT		; FINISHED IF ODD FAC
MODINT:	CALL	MULDMD		; ASSEMBLE THE INTEGER
	.IIF NDF MODFHW TSTOVF	; THERE MAY BE OVERFLOW ON ROUND
	MOV	TMP3,R0		; FAC
	ADD	#10,R0		; FAC+1
	CALL	MODSAV		; SAVE INTEGER
	JMP	ADDOUT		; GO FINISH
MODSHF:	PUSH	R1		; SAVE SHIFT COUNT
	SUB	4(SP),R0	; IS THE FAC EVEN OR ODD?
	BIT	#10,R0
	BNE	MODSH		; GO SHIFT IF ODD
	MOV	TMP3,R0		; MUST SAVE THE FRACTION
	ADD	#10,R0		; POINT TO FAC+1
	MOV	R2,(R0)+	; SAVE THE FRACTION IN FAC+1
	MOV	R3,(R0)+
	MOV	R4,(R0)+
	MOV	R5,(R0)	; DONE
	MOV	R1,EFAC		; SAVE THE SHIFT COUNT
	MOV	2(SP),EFSRC	; SAVE A COPY OF THE SIGN
	MOV	TMP3,R0		; POINT TO FAC AGAIN
	DEC	MODFLG		; FLAG EVEN FAC PROCESSING
MODSH:	CMP	R1,#16.		; CAN WORDS BE SHIFTED?
	BLE	MODSS		; NO
	MOV	R3,R2		; SHIFT WORDS
	MOV	R4,R3
	MOV	R5,R4
	CLR	R5		; CLEAR OUT BOTTOM WORD
	SUB	#16.,R1		; ADJUST SHIFT COUNT
	BR	MODSH
MODSS:	CMP	R1,#8.		; SHIFT BY BYTE?
	BLE	MODSS1		; NO
	SWAB	R2		; SHIFT LEFT ONE BYTE
	CLRB	R2
	SWAB	R3
	BISB	R3,R2
	CLRB	R3
	SWAB	R4
	BISB	R4,R3
	CLRB	R4
	SWAB	R5
	BISB	R5,R4
	CLRB	R5		; CLEAR OUT BOTTOM BYTE
	SUB	#8.,R1		; ADJUST SHIFT COUNT
MODSS1:	ASL	R5		; SHIFT LEFT
	ROL	R4
	ROL	R3
	ROL	R2		; DONE
	DEC	R1		; CHANGE COUNT
	BGT	MODSH		; SHIFT TILL PAST THE INTEGER
	BCS	MODSHD		; DONE SHIFTING IF NORMAL BIT FOUND
MODSH1:	INC	(SP)		; BUMP SHIFT COUNT
	CMP	(SP),TMP2	; ANY NEED TO LOOK FURTHER FOR NORMAL BIT?
	BGT	MODZEX		; NO, THERE IS NO FRACTION
	DEC	R1
	ASL	R5
	ROL	R4
	ROL	R3
	ROL	R2
	BCC	MODSH1		; KEEP LOOKING FOR NORMAL
MODSHD:	TST	(SP)+		; RESET STACK
	ADD	#200,R1		; PUT IN EXCESS 128.
MODCF:	CALL	MULDMD		; GO PUT EXPONENT AND FRACTION TOGETHER
	TST	MODFLG		; EVEN OR ODD FAC?
	BNE	MODDUN		; BRANCH ON ODD -- JUST SAVE FRACTION
	CALL	MODSAV		; FIRST, SAVE THE FRACTION
	MOV	TMP3,R0		; GET ADDRES OF FAC
	ADD	#10,R0		; FAC+1
	MOV	EFAC,R1		; SHIFT COUNT
	MOV	#4,R4		; SETUP WORD COUNTER
	SUB	#2,R1		; ADJUST SHIFT COUNT
	BLT	MODZIF		; BRANCH IF THE INTEGER IS 1
	MOV	#77777,R5	; SETUP THE SHIFT MASK
MODIC:	CMP	R1,#14.		; DETERMINE WHICH WORD NEEDS BITS MASKED
	BLE	MODSHM		; R1 LESS MEANS MASK IN THIS WORD
	TST	(R0)+		; BYPASS THIS WORD
	DEC	R4		; DECREMENT WORD COUNT
	SUB	#16.,R1		; ADJUST SHIFT COUNT
	BLT	MODZIF		; BRANCH IF ENTIRE WORD TO BE ZEROED
	BR	MODIC		; NEXT WORD
MODSHM:	NEG	R1		; SHIFT RIGHT
	ASH	R1,R5		; SHIFT THE MASK RIGHT
	BIC	R5,(R0)+	; CLEAR OUT FRACTION BITS
	DEC	R4		; REDUCE WORD COUNT
	BEQ	MODZD		; BRANCH DONE
MODZIF:	CLR	(R0)+		; CLEAR REMAINING FRACTION BITS
	DEC	R4		; DECREMENT WORD COUNT
	BNE	MODZIF		; ZERO UNTIL DONE
MODZD:	MOV	EFAC,R1		; GET THE EXPONENT
	ADD	#200,R1		; EXCESS 128. BACK
	MOV	-(R0),R5	; PUT THE INTEGER FRACTION IN REGISTERS
	MOV	-(R0),R4
	MOV	-(R0),R3
	MOV	-(R0),R2	; DONE
	PUSH	EFSRC		; SIGN TO STACK
	CALL	MULDMD		; ASSEMBLE THE INTEGER
	CALL	MODSAV		; SAVE THE INTEGER
	JMP	ADDOUT		; GO FINISH
MODZEX:	TST	(SP)+		; RESET STACK
	CLR	R1
	CLR	(SP)		; SET THE SIGN TO ZERO
	BR	MODCF		; GO ASSEMBLE FRACTION
MODSAV:	MOV	R2,(R0)+	; SAVE THE FRACTION OR INTEGER
	MOV	R3,(R0)+
	BIT	#200,@2(SP)		; **** RIGHT IN SPIRIT ONLY
	BEQ	10$			; ****
	MOV	R4,(R0)+
	MOV	R5,(R0)		;  SAVED
	RETURN
10$:	TRKTST	@2(SP),20$
	ROL	R4
	ADC	-(R0)
	ADC	-(R0)
20$:	RETURN			; GO FINISH UP
MODFLG:	0
;----------------------------------------------------------------

	.SBTTL		7.5	SUBF,ADDF
;----------------------------------------------------------------
SUBFX3:	ADD	R5,R4		; PROPER AC
SUBFX2:	ADD	R5,R4		; PROPER AC
SUBFX1:	ADD	R5,R4		; PROPER AC
SUBFX:	TST	(R4)+		; AC0
	SINC	Z2OP
	SINC	SUBF		; STATS
	CLR	FXM		; CLEAR FPE FLAG
	MOV	R4,TMP3		; SAVE POINTER TO AC
	CALL	GET		;
	ADD	#100000,NUMB	; CHANGE SIGN OF FSRC
	BR	ADSUBE		; GO ADD
;------------------------------------------------------------------
ADDGET:	MOV	R4,TMP3		; SAVE POINTER TO AC
	CALL	GET		; GET IT
ADSUBE:	MOV	TMP3,R5		; ADDRESS OF FAC
	PUSH	R0		; SAVE FPSW POINTER
	CLR	-(SP)		; SAVE SIGNS ON STACK
	MOV	#NUMB+ASF3+2,R4	; POINT TO SECOND WORD OF FSRC
	BIT	#200,(R0)	; CHECK FOR DOUBLE
	BEQ	ADDF		; BRANCH IF FLOATING
	CMP	(R4)+,(R4)+	; POINT TO BOTTOM OF DOUBLE FSRC
	JMP	ADDDX		; GO DO DOUBLE ADD
ADDDM0:	SINC	LONG		; STATS
	MOV	(R2)+,(R4)+	; SAVE THE FSRC IN SCRATCH AREA
	MOV	(R2)+,(R4)+
	MOV	(R2)+,(R4)+
	MOV	(R2),(R4)
	JMP	ADDDX		; GO ADD
ADDFX3:	ADD	R5,R4		; PROPER AC
ADDFX2:	ADD	R5,R4		; PROPER AC
ADDFX1:	ADD	R5,R4		; PROPER AC
ADDFX:	TST	(R4)+		; AC0
	SINC	Z2OP
	SINC	ADDF		; STATS
	CLR	FXM		; FPE FLAG CLEARED
	BIT	#70,R2		; CHECK FOR MODE 0
	BNE	ADDGET		; BRANCH IF NOT MODE0
	SINC	MODE0		; STATS
	BIC	#77770,R2	; CLEAR ALL BIT REGISTER AND MSB
	ASL	R2		; SHIFT TO GET AN OFFSET
	ROL	R2		; PUT IN ACRRY TO ADD 2
	ASL	R2
	ADD	R0,R2		; NOW HAVE THE FSRC POINTER
	MOV	R4,R5		; NEW POINTER TO FAC
	MOV	R4,TMP3		; SAVE POINTER TO AC
	MOV	#NUMB+ASF3,R4	; SAVE THE FSRC IN  SCRATCH
	PUSH	R0		; SAVE FPSW POINTER
	CLR	-(SP)		; SAVE SIGNS ON STACK
	BIT	#200,(R0)	; CHECK FOR FLOATING OR DOUBLE
	BNE	ADDDM0		; BRANCH ON DOUBLE
	SINC	SHORT		; STATS
	MOV	(R2)+,(R4)+	
	MOV	(R2),(R4)
ADDF:	CLR	R2		; CLEAR PLACE FOR EXPONENTS
	CLR	R3		;
	ASL	(R4)		; SHIFT FSRC
	ROL	-(R4)		;
	BISB	1(R4),R3	; R3 HAS EXP. OF FSRC
	BEQ	ADOUT		; FSRC=0 MEANS WE'RE FINISHED
	ROLB	(SP)		; NO SUCH LUCK -- SAVE THE SIGN
	ASL	2(R5)		; SHIFT FAC
	ROL	(R5)		;
	BISB	1(R5),R2	; R2 HAS EXP. OF FAC
	BNE	ADA2NZ		; IF NOT ZERO GO CONTINUE
	RORB	(SP)		; RECREATE FSRC
	ROR	(R4)		;
	ROR	2(R4)		; HAVE IT AGAIN
	MOV	(R4)+,(R5)+	; MOVE FSRC TO FAC SINCE THAT IS ANSWER
	MOV	(R4),(R5)	;
	BR	ADOUT		; ALL DONE
ADA2NZ:	ROLB	1(SP)		; SAVE SIGN OF FAC IN HIGH BYTE OF STACK
	MOVB	#1,1(R4)	; PUT IN HIDDEN BIT AND CLEAR OUT EXP.
	MOVB	#1,1(R5)	; IN BOTH FSRC AND FAC
	SUB	R3,R2		; SUBTRACT EXP.S -- R2/EFAC-EFSRC
	BGT	ADEXPA		; BRANCH IF FAC HAS BIG EXPONENT
	MOV	(R5),R0		; FAC HAS LITTLE EXP. -- MOV FRAC TO REGS.
	MOV	2(R5),R1	; R0!R1 HAS THE FRAC OF THE
				; NUMBER WITH THE SMALLEST MAGNITUDE
	MOV	(R4)+,(R5)	; MOVE LARGE MAGNITUDE NUMBER TO FAC
	MOV	(R4),2(R5)	; DONE
	BR	ADECHK		; GO CHECK SIGNS
ADEXPA:	ADD	R2,R3		; R3 CONTAINS LARGEST EXP.
	MOV	(R4)+,R0
	MOV	(R4),R1		; R0!R1 HAS FRAC OF SMALLEST NUMBER (ABS)
	NEG	R2		; R2 IS TO BE RIGHT SHIFT AMOUNT
	SWAB	(SP)		; SIGN OF BIG NUMBER ON THE RIGHT
ADECHK:	CMPB	1(SP),(SP)	; SIGNS EQUAL?
	BEQ	10$		; BRANCH IF SO
	NEG	R1		; NEGATE
	ADC	R0
	NEG	R0
	CLR	TMP2		; CARRY SAVER
10$:	TST	R2		; SHIFT AMOUNT
	BEQ	ADSHTD		; NONE NEEDED ---> BRANCH
	CMP	#-25.,R2	; IS IT WORTH IT TO SHIFT?
	BGT	ADNRMD		; NO -- ANSWER IS THE BIG NUMBER
	ASHC	R2,R0		; DO THE SHIFT
	ROR	TMP2		; SAVE THE CARRY
ADSHTD:	ADD	R0,(R5)+	; ADD THINGS UP
	ADD	R1,(R5)
	ADC	-(R5)		; DONE
	CMPB	1(SP),(SP)	; COMPARE SIGNS
	BNE	ADSUB		; IF NOT SAME GO CLEAN UP
	BIT	(R5),#1000	; WAS THERE A CARRY PAST NORMAL BIT?
	BEQ	ADNRMD		; BRANCH IF NOT
	ASR	(R5)		; SHIFT RIGHT
	ROR	2(R5)		;
	INC	R3		; BUMP EXPONENT
ADNRMD:	BIT	#177400,R3	; TEST FOR OVERFLOW
	BEQ	ADOK		; BRANCH ON NO OVERFLOW
	CALL	OVER		; HANDLE OVERFLOW
ADOK:	MOVB	R3,1(R5)	; PUT EXP IN FAC
	ROR	(SP)		; PUT IN SIGN OF BIG NUMBER
	ROR	(R5)+		; PUT SIGN IN FAC
	ROR	(R5)		;
	TRKTST	@2(SP),ADOUT	; CHECK TRUNCATE -- BRANCH IF SET
	ADC	(R5)		;
	ADC	-(R5)		;
	BVC	ADNOV		; CHECK FOR OVERFLOW
	CALL	OVER		;
ADNOV:	BCC	ADOUT
	CALL	OVER		;
ADOUT:	TST	(SP)+		; RESET STACK
ADDOUT:	POP	R0		; RETURN FPSW POINTER
	MOV	@TMP3,NUMB	; GET READY FOR C.C. TEST
	TST	FXM		; WAS THERE AN FPE?
	BNE	10$		; INVESTIGATE FURTHER IF THERE WAS
	JMP	TSTFY		; IF NOT, LEAVE
10$:	SINC	TFPE		; STATS
	BIT	FXM,(R0)	; WAS THE INTERRUPT ENABLED?
	BEQ	ADOUT2		; BRANCH IF NOT
	BIS	#100000,(R0)	; INTERRUPT BIT WAS SET
ADDDIV:	BIT	#40000,(R0)	; WAS THE INHIBIT INTERRUPT BIT SET?
	BNE	ADOUT3		; YES -- LEAVE
	TST	NUMB		; SET N AND Z BITS AS APPROPRIATE
	BGE	10$		; NOT NEGATIVE
	BIS	#10,(R0)	; SET N
10$:	BNE	20$		; NOT ZERO
	BIS	#4,(R0)		; SET Z
20$:	MOV	@#244,16(SP)	; PUT ADDRESS ON TOP OF KPAR3
	SINC	FPE		; STATS
	JMP	FPEOUT		; GO INTERRUPT
ADOUT2:	CMP	#12,FPXCOD	; WAS THERE AN UNDERFLOW?
	BNE	ADOUT3		; BRANCH IF NOT
	MOV	TMP3,R1		; GET FAC ADDRESS
	CLRWRD	4,(R1)		; CLEAR THE FAC
	BIC	#17,(R0)	; CLEAR CC'S
	CLR	NUMB
ADOUT3:	JMP	TSTFY2		; GO SET C.CS WITHOUT CLEARING
ADSUB:	TST	(R5)		; TEST SIGN OF RESULT
	BGT	ADBIT9		; IF POSITIVE SIGN IS OK
	BEQ	ADZTST		; CHECK FOR ZERO RESULT
	NEG	2(R5)		; GET ABSOLUTE VALUE
	ADC	(R5)		;
	NEG	(R5)		;
	SWAB	(SP)		; SWITCH SIGNS
ADBIT9:	BIT	(R5)+,#400	; CHECK FOR NORMAL BIT
	BNE	ADUTST		; BRANCH IF FOUND
	DEC	R3		; DECREASE EXPONENT
	ASL	TMP2		; GET CARRY
	ROL	(R5)		; DOUBLE FRACTION
	ROL	-(R5)		;
	BR	ADBIT9		; CHECK FOR NORM BIT AGAIN
ADZTST:	TST	(R5)+		; POINT TO SECOND WORD
	TST	(R5)		; CHECK FOR ZERO HERE
	BEQ	ADZERO		; IT'S ZERO ALRIGHT
	SWAB	(R5)		; SAVE NORMALIZE SOME TIME
	BISB	(R5),-2(R5)	; MOVE BITS TO THE LEFT
	CLRB	(R5)		;
	TST	-(R5)		; POINT TO TOP OF FAC
	SUB	#10,R3		; ADJUST THE EXPONENT
	BR	ADBIT9		;
ADUTST:	TST	-(R5)		; BUMP POINTER
	TST	R3		; UNDERFLOW OCCUR?
	BGT	ADNRMD		; NO -- GO FINISH UP
	CALL	UNDER		; UNDERFLOW FLAGS SET
	BR	ADOK		; CONTINUE PROCESSING
ADZERO:	CLR	(R5)+		; PUT IN ZERO
	CLR	(R5)		;
	BR	ADOUT		; DONE
;----------------------------------------------------------------

	.SBTTL		7.6	ADDD
;----------------------------------------------------------------
ADDDX:
	SINC	ADDD		; STATS
	CLR	EFSRC		; CLEAR OUT EXPONENTS
	CLR	EFAC		;
	ASL	(R4)		; SHIFT FSRC
	ROL	-(R4)		;
	ROL	-(R4)		;
	ROL	-(R4)		;
	BISB	1(R4),EFSRC	; GET EXPONENT OF FSRC
	BEQ	ADDA1Z		; IF 0 ARE ESSENTIALLY DONE
	ROLB	(SP)		; SAVE SIGN
	ADD	#6,R5		; POINT TO BOTTOM OF FAC
	ASL	(R5)		; SHIFT FAC
	ROL	-(R5)		;
	ROL	-(R5)		;
	ROL	-(R5)		;
	BISB	1(R5),EFAC	; SAVE EXPONENT OF FAC
	BNE	ADD2NZ		; BRANCH IF NOT 0
	RORB	(SP)		; RECONSTRUCT THE FSRC
	ROR	(R4)+		;
	ROR	(R4)+		;
	ROR	(R4)+		;
	ROR	(R4)		;
	ADD	#6,R5		; POINT TO BOTTOM OF FAC
	MOV	(R4),(R5)	; MOVE FSRC TO FAC
	MOV	-(R4),-(R5)	;
	MOV	-(R4),-(R5)	;
	MOV	-(R4),-(R5)	;
ADDA1Z:	TST	(SP)+		; GET RID OF SIGNS
	.IIF NDF STAT	BR	ADDOUT		; GO FINISH
	.IIF DF STAT	JMP	ADDOUT
ADD2NZ:	ROLB	1(SP)		; SAVE SIGN OF FAC
	MOVB	#1,1(R4)	; PUT IN HIDDEN BIT AND CLEAR OUT EXP.
	MOVB	#1,1(R5)	;
	SUB	EFSRC,EFAC	; SUBTRACT EXPONENTS
	BGT	ADDEXA		; BRANCH IF EFAC IS LARGEST
	MOV	(R5)+,R0	; MOVE SMALLER # INTO REGISTERS
	MOV	(R5)+,R1	; (IT IS FAC IN THIS CASE)
	MOV	(R5)+,R2	; BY SMALLER, I MEAN SMALLER ABSOLUTE VALUE
	MOV	(R5),R3		;
	ADD	#6,R4		; POINT TO BOTTOM OF FSRC
	MOV	(R4),(R5)	; MOVE FSRC TO FAC
	MOV	-(R4),-(R5)	;
	MOV	-(R4),-(R5)	;
	MOV	-(R4),-(R5)	;
	MOV	EFSRC,R4	; R4 HAS THE LARGEST EXPONENT
	BR	ADDSCK		; GO CHECK SIGN
ADDEXA:	MOV	(R4)+,R0	; MOV FSRC TO REGISTERS
	MOV	(R4)+,R1	; NOTE THAT IT IS THE SMALLER NUMBER
	MOV	(R4)+,R2	;
	MOV	(R4),R3		;
	MOV	EFAC,R4		; R4 HAS THE LARGEST EXPONENT
	ADD	EFSRC,R4	; ADD WHAT WAS TAKEN AWAY
	SWAB	(SP)		; SWITCH SIGNS
	NEG	EFAC		; MAKE ROTATE COUNT NEGATIVE
ADDSCK:	CMPB	1(SP),(SP)	; CHECK FOR SAME SIGNS
	BEQ	ADDECK		; 
	NEG	R3		; NEGATE SMALL NUMBER
	ADC	R2		;
	ADC	R1
	ADC	R0
	NEG	R2
	ADC	R1
	ADC	R0
	NEG	R1
	ADC	R0
	NEG	R0		; DONE
	CLR	TMP2		; CARRY HOLDER
ADDECK:	TST	EFAC		; TEST SHIFT COUNT
	BEQ	ADDSHD		; IF 0 SKIP ALL THE SHIFT BUSINESS
	CMP	#-57.,EFAC	; IS THE SMALL NUMBER JUST TOO SMALL?
	BLE	ADDSHT		; NO -- GO SHIFT
	MOVB	R4,1(R5)	; RECONSTRUCT LARGE NUMBER
	ROR	(SP)+		; GET SIGN
	ROR	(R5)+		;
	ROR	(R5)+	
	ROR	(R5)+
	ROR	(R5)		; DONE
	JMP	ADDOUT		; GO FINISH UP
ADDSHT:	CMP	#-8.,EFAC	; SEE HOW MANY BITS ARE TO BE SHIFTED
	BLE	ADDSR8		; BRANCH IF NOT MORE THAN 1/2 WORD
	TST	R0		; CONTINUE HERE IF MORE THAN THAT
	SXT	-(SP)		; PUT THE SIGN EXTENSION ON THE STACK
ADDSH1:	CMP	#-16.,EFAC	; ONE WORD?
	BLT	ADDS16		; BRANCH IF NOT MORE THAN 1 WORD TO SHIFT
	MOV	R3,TMP2		; SAVE THE LOW ORDER WORD (CARRY INFO)
	MOV	R2,R3		; SHIFT ONE WORD AT A TIME
	MOV	R1,R2
	MOV	R0,R1
	MOV	(SP),R0		; INSERT SIGN EXTEND
	ADD	#16.,EFAC	; UPDATE THE EXPONENT
	BNE	ADDSH1		; GO TRY TO DO IT AGAIN
	TST	(SP)+		; IF 0, SHIFTING IS ALL DONE
	ASL	TMP2		; SET CARRY BIT RIGHT
	BR	ADDSHD		; HENCE BEHAVE THAT WAY
ADDS16:	CMP	#-3,EFAC	; HOW MANY TO SHIFT NOW?
	BLE	ADDS8A		; BRANCH IF NOT MORE THAN 3
	MOV	R5,(SP)		; SAVE R5 OVER TOP OF SIGN EXTEND
	PUSH	R4		; SAVE EXPONENT
	PUSH	EFAC		; PUT SHIFT AMOUNT ON STACK
	MOV	R1,R4		; SAVE R1
	ASHC	(SP),R0		; SHIFT HIGH ORDER
	MOV	R2,R5		; SAVE R2
	ASHC	(SP),R4		; SHIFT DOUBLE REG.
	MOV	R2,R4		; 
	MOV	R5,R2		; R2 DONE
	MOV	R3,R5		; SET UP LOW ORDER
	ASHC	(SP)+,R4	; DO LOW ORDER
	MOV	R5,R3		;
	POP	R4		; RETURN EXPONENT
	POP	R5		; RETURN POINTER TO FAC
	BR	ADDSHD		; DONE WITH SHIFT
ADDS8A:	TST	(SP)+		; GET STACK RIGHT
ADDSR8:	ASR	R0		; SHIFT RIGHT UNTIL FINISHED
	ROR	R1		;
	ROR	R2
	ROR	R3		;
	INC	EFAC		; SHIFT COUNTER INCEMENTED
	BLT	ADDSR8		;
ADDSHD:	ROR	TMP2		; SAVE THE CARRY BIT
	ADD	#6,R5		; POINT TO BOTTOM OF FAC
	ADD	(R5),R3		; DO THE ADDITION
	ADC	R2
	ADC	R1
	ADC	R0
	ADD	-(R5),R2
	ADC	R1
	ADC	R0
	ADD	-(R5),R1
	ADC	R0
	ADD	-(R5),R0	; ADDITION IS DONE
	CMPB	1(SP),(SP)	; CHECK FOR SAME SIGNS
	BNE	ADDSUB		; GO FIXUP SUBTRACT
	BIT	#1000,R0	; WAS THERE CARRY INTO EXP PART
	BEQ	ADDNRD		; BRANCH IF NOT
	ASR	R0		; SHIFT RIGHT 
	ROR	R1
	ROR	R2
	ROR	R3
	INC	R4		; ADJUST THE EXPONENT
ADDNRD:	SWAB	R4		; MOVE EXPONENT TO HIGH BYTE
	BEQ	ADDNFL		; BRANCH IF NO OVERFLOWN EXPONENT
	CALL	OVER
ADDNFL:	BISB	R0,R4		; R4 NOW HAS FIRST WORD
	ROR	(SP)+		; GET THE SIGN
	ROR	R4		; PUT THE SIGN IN
	ROR	R1
	ROR	R2
	ROR	R3
	TRKTST	@(SP),ADDPUT	; CHECK TRUNCATE -- BRANCH IF SET
	ADC	R3		; ROUND IT
	ADC	R2
	ADC	R1
	ADC	R4		; ROUNDING DONE
	TSTOVF			; CHECK FOR OVERFLOW
ADDPUT:	MOV	R4,(R5)+	; PUT THE ANSWER IN THE FAC
	MOV	R1,(R5)+	;
	MOV	R2,(R5)+
	MOV	R3,(R5)
	JMP	ADDOUT		; GO CHECK FOR ERRORS,INTERRUPTS,C.C'S
ADDSUB:	TST	R0		; CHECK SIGN OF RESULT
	BGT	ADDBT9		; POSITIVE IS O.K.
	BEQ	ADDZT		; CHECK FOR ZERO
	NEG	R3		; IT IS NEGATIVE -- TAKE ABS. VALUE
	ADC	R2
	ADC	R1
	ADC	R0
	NEG	R2
	ADC	R1
	ADC	R0
	NEG	R1
	ADC	R0
	SWAB	(SP)		; SWITCH SIGN
	NEG	R0
	BEQ	ADDZT		; CHECK FOR ZERO
ADDBT9:	BIT	R0,#400		; CHECK FOR NORMAL BIT
	BNE	ADDUT		; GO CHECK FOR UNDERFLOW WHEN FOUND
	DEC	R4		; REDUCE EXPONENT
	ASL	TMP2		; ROLL BACK CARRY INFO
	ROL	R3		; DOUBLE FRACTION
	ROL	R2
	ROL	R1
	ROL	R0
	BR	ADDBT9		; GO LOOK FOR NORMAL BIT AGAIN
ADDZT:	SUB	#8.,R4		; REDUCE EXPONENT
	TST	R1		; 
	BNE	ADDZT1		;BRANCH IF ONLY R0=0
	SUB	#16.,R4		; REDUCE EXPONENT AGAIN
	MOV	R2,R1		;
	BNE	ADDZT2		; BRANCH IF R2 NOT 0
	SUB	#16.,R4		;
	TST	R3		; TEST LAST WORD
	BEQ	ADDZRO		; IT IS ZERO
	BISB	R3,R1		; MOVE BYTES TO R0,R1
	SWAB	R1
	SWAB	R3		;
	BISB	R3,R0		;
	CLR	R3		; MAKE ALL OTHERS 0
	BR	ADDBT9		;
ADDZT2:	MOV	R3,R2		;
	CLR	R3		;
ADDZT1:	SWAB	R1		;
	BISB	R1,R0		; MOVE ALL BYTES LEFT
	CLRB	R1		;
	SWAB	R2
	BISB	R2,R1		;
	CLRB	R2
	SWAB	R3
	BISB	R3,R2
	CLRB	R3
	BR	ADDBT9		;
ADDUT:	TST	R4		; WAS THERE UNDERFLOW?
	BGT	ADDNRD		; BRANCH IF NOT
	CALL	UNDER		; UNDERFLOW
	BR	ADDNFL		; CONTINUE
ADDZRO:	CLR	(SP)		; SET SIGN PLUS
	CLR	R4		; CLEAR EXPONENT
	BR	ADDNFL
EFSRC:	0
EFAC:	0
;----------------------------------------------------------------

	.SBTTL		7.7	CMPF,STF,DIVF
;----------------------------------------------------------------
CMPFX3:	ADD	R5,R4		; PROPER AC
CMPFX2:	ADD	R5,R4		; PROPER AC
CMPFX1:	ADD	R5,R4		; PROPER AC
CMPFX:	TST	(R4)+		; AC0
	SINC	Z2OP
	SINC	CMPF		; STATS
	MOV	R4,TMP3		; SAVE POINTER TO AC
	CALL	GET		; GET THE NUMBER
	MOV	TMP3,R4		; ADDRES OF FAC
	MOV	#NUMB+ASF3,R5	; ADDRESS OF (FDEST)
	MOV	(PC),R3		; 00XXXX...XXXX01
	MOV	(R5)+,R1	; GET HIGH ORDER OF FIRST
	BGE	CMPPOS		; BRANCH IF FIRST NUMBER +
	ASL	R3		; REMEMBER FIRST NUMBER -
	MOV	(R4)+,R2	; GET HIGH ORDEROF SECOND
	BLT	CMPSAM		; BRANCH IF BOTH ARE SAME
	BR	CMPNEG		; RESULT IS NEGATIVE
CMPPOS:	MOV	(R4)+,R2	; GET HIGH ORDER OF SECOND
	BLT	CMPPLS		; RESULT IS +
CMPSAM:	CMP	R1,R2		; COMPARE HIGH ORDERS
	BNE	CMPOUT		; NOT EQUAL
	CMP	(R5)+,(R4)+	; NEXT WORD
	BNE	CMPOUT		;
	BIT	#200,(R0)	; CONTINUE COMPARING?
	BEQ	CMPCLR		; NO -- THE FLOATING NUMBERS ARE EQUAL
	CMP	(R5)+,(R4)+	; THIRD WORD
	BNE	CMPOUT
	CMP	(R5),(R4)	; LAST
	BNE	CMPOUT
CMPCLR:	CLR	R3		; FLAG AS EQUAL
CMPOUT:	ROR	R3		; SAVE C AND TEST SECOND ARG -
	BCS	CMPPLS		; SET +
CMPNEG:	NEG	R3		; REVERSE C BIT
CMPPLS:	TST	R3		; SET CONDITION CODES
	MOV	@#PSW,R2	; COPY THEM
	BIC	#^C17,R2	; CLEAR ALL BUT CONDITION CODES
	BIC	#17,(R0)	; CLEAR CURRENT C.C'S OUT
	BIS	R2,(R0)		; SET NEW ONES
	JMP	FPEX2		; ALL DONE
;----------------------------------------------------------------
STFX3:	ADD	R5,R4		; PROPER AC
STFX2:	ADD	R5,R4		; PROPER AC
STFX1:	ADD	R5,R4		; PROPER AC
STFX:	TST	(R4)+		; AC0
	SINC	Z2OP
	SINC	STF		; STATS
	INC	NMB		; WANT AN ADDRESS
	MOV	R4,TMP3		; SAVE POINTER TO AC
	CALL	GET		;
	MOV	TMP3,R2		; AC ADDRESS
	BCS	STFZ		; BRANCH IF MODE 0
STFY:	MOVTU	(R2)+,(R1)+	; PUT NUMBER IN TASK AREA
	DEC	TMP1		; CHECK DONE
	BGT	STFY
	JMP	FPEX2		; ALL DONE
STFZ:	MOV	(R2)+,(R1)+	; MOVE WITHIN HEADER
	DEC	TMP1
	BGT	STFZ		; DONE?
	JMP	FPEX2		; YES
;----------------------------------------------------------------
DIVFX3:	ADD	R5,R4		; PROPER AC
DIVFX2:	ADD	R5,R4		; PROPER AC
DIVFX1:	ADD	R5,R4		; PROPER AC
DIVFX:	TST	(R4)+		; AC0
	SINC	Z2OP
	SINC	DIVF		; STATS
	CLR	FXM		; CLEAR FPSW MASK
	MOV	R4,TMP3		; SAVE POINTER TO AC
	CALL	GET		; GET IT
	PUSH	R0		; SAVE THE FPSW POINTER
	BIT	#200,(R0)	; TEST MODE
	BEQ	DIVF		; BRANCH IF SINGLE
	JMP	DIVDX		; GO DO DOUBLE DIVIDE
DIVF:	MOV	#NUMB+ASF3,R3	; POINT TO FSRC (DENOMINATOR)
	MOV	TMP3,R2		; POINT TO NUMERATOR (FAC)
	CLR	-(SP)		; MAKE ROOM FOR THE SIGN
	ASL	(R3)		; GET SIGN OF DENOMINATOR
	ROL	(SP)		; SAVE IT
	CLR	-(SP)		; ROOM FOR THE EXPONENT
	BISB	1(R3),(SP)	; PUT EXPONENT ON STACK
	BEQ	DIVCHK		; BRANCH ON DIVIDE BY 0
	NEG	(SP)		; NEGATE THE EXPONENT
	SWAB	(R3)		; LEFT JUSTIFY THE DENOMINATOR
	SEC			; PUT IN THE NORMAL BIT
	ROR	(R3)+		;
	MOVB	1(R3),-2(R3)	; MOVE LEFT
	SWAB	(R3)		;
	CLRB	(R3)		; CLEAR OUT BOTTOM BYTE
	CLR	R0		; R0!R1 WILL HOLD NUMERATOR FRACTION
	CLR	R1		;
	ASL	(R2)		; SHIFT NUMERATOR LEFT
	ADC	2(SP)		; GET FINAL SIGN
	BISB	1(R2),R1	; GET EXPONENT OF NUMERATOR
	BEQ	DIVZRO		; BRANCH IF ANSWER IS ZERO
	ADD	R1,(SP)		; GET SUM OF EXPONENTS
	CLR	R1		; RESET R1
	BISB	(R2),R0		; MOVE NUMERATOR FRACTION TO REGS.
	SWAB	R0		; (LEFT JUSTIFIED)
	SEC			; NORMAL BIT
	ROR	R0		; IN
	BISB	3(R2),R0	; SECOND BYTE IN
	BISB	2(R2),R1	; THIRD AND LAST BYTE IN
	SWAB	R1		; PROPER ORDER
	ROR	R0		; MAKE SURE NUMERATOR AND DENOM. PLUS
	ROR	R1		;
	ROR	-(R3)		;
	ROR	2(R3)		; DONE
	CMP	R0,(R3)+	; COMPARE HI NUMER. AND DENOM.
	BCS	DIVDHI		; BRANCH IF DENOM. BIGGER
	ROR	R0		; DIVIDE NUMERATOR BY 2
	ROR	R1		; SO THAT IT IS LESS THAN DENOM.
	INC	(SP)		; ADJUST EXPONENT
DIVDHI:	CLC			; CLEAR FOR ROTATES
	ROR	(R3)		; MAKE LOW HALF OF DENOM PLUS
	TST	-(R3)		; POINT TO FIRST WORD
	ROR	R0		; SCALE THE NUMERATOR FOR DIVIDE
	ROR	R1
	MOV	R0,R4		; NUMERATOR TO DIVIDEND
	MOV	R1,R5		;
	DIV	(R3)+,R4	; DIVIDE
	MOV	R5,R1		; SAVE REMAINDER
	MOV	R4,R0		; SAVE QUOTIENT
	MUL	(R3),R4		; GET Q*LO(DENOM)
	ASR	R1		; SCALE REMAINDER
	SUB	R1,R4		; Q*D-R
	ASHC	#-1,R4		; SCALE
	DIV	-(R3),R4	; (Q*D-R)/C
	NEG	R4		;
	ASHC	#-14.,R4	; UNSCALE
	ADD	R0,R4		;
DIVNBT:	ASHC	#1,R4		; 
	BMI	DIVNB		; BRANCH FOR NORMAL BIT
	DEC	(SP)		; ADJUST EXPONENT
	BR	DIVNBT		; KEEP LOOKING
DIVNB:	ASHC	#-7,R4		; ALIGN FRACTION
	MOV	R4,(R2)		; SAVE HI ORDER ANSWER
	MOV	(SP)+,R4	; GET EXPONENT
	ADD	#200,R4		; PUT IN EXCESS 128.
	BGT	DIVNU		; BRANCH ON NO UNDERFLOW
	CALL	UNDER		; HANDLE UNDERFLOW
DIVNU:	CMP	#377,R4		; HOW ABOUT OVERFLOW?
	BGE	DIVOK		; BRANCH IF NO OVERFLOW
	CALL	OVER		; HANDLE OVERFLOW
DIVOK:	MOVB	R4,1(R2)	; PUT EXPONENT IN
	ROR	(SP)+		; GET SIGN
	ROR	(R2)+		; SAVE IT
	ROR	R5		;
	MOV	R5,(R2)		; SAVE THE SECOND WORD
	TRKTST	@(SP),10$	; CHECK TRUNCATE - BRANCH IF SET
	ADC	(R2)		; ROUND
	ADC	-(R2)		;
	TSTOVF			; TEST FOR OVERFLOW
10$:	JMP	ADDOUT
DIVZRO:	CMP	(SP)+,(SP)+	; GET RID OF SIGN AND EXPONENT
	CLRWRD	2,(R2)		; FORCE TO EXACTLY ZERO
	JMP	ADDOUT		; GO FINISH AND EXIT
DIVCHK:	MOV	#4,FPXCOD	; SET FEC
	SINC	FDZ		; STATS
	SINC	TFPE		;
	CMP	(SP)+,(SP)+	; GET RID OF EXPONENT AND SIGN
	BIC	#17,@(SP)	; CLEAR OUT CC'S
	BIS	#100004,@(SP)	; SET Z BIT
	POP	R0		; RESTORE R0
	MOV	@TMP3,NUMB	; PLACE THIS FOR STATUS CHECK
	JMP	ADDDIV		; LEAVE
UNDER:	MOV	#12,FPXCOD	; SET FEC
	MOV	#2000,FXM	; SET MASK
	BIC	#17,@4(SP)	; CLEAR OUT OLD CC'S
	SINC	UNDER		; STATS
	RETURN
DIVDZR:	CMP	(SP)+,(SP)+	; GET RID OF SIGN AND EXPONENT
	CLRWRD	4,(R4)		; SET TO ZERO
	JMP	ADDOUT		; DONE
;---------------------------------------------------------------

	.SBTTL		7.8	DIVD
;----------------------------------------------------------------
DIVDX:
	SINC	DIVD		; STATS
	MOV	TMP3,R4		; POINTER TO FAC (NUMERATOR)
	MOV	#NUMB+ASF3,R5	; POINTER OT FSRC (DENOMINATOR
	CLR	R0		; R0!R1!R2!R3 TO CONTAIN NUM. FRACTION
	CLR	R1
	CLR	R2
	CLR	R3
	ASL	(R5)		; SHIFT LEFT DENOMINATOR
	ROL	-(SP)		; SAVE SIGN
	CLR	-(SP)		; MAKE ROOM FOR EXPONENT
	BISB	1(R5),(SP)	; SAVE EXPONENT
	BEQ	DIVCHK		; BRANCH ON DIVIDE BY ZERO
	NEG	(SP)		; NEGATE EXPONENT
	SWAB	(R5)		; LEFT JUSTIFY DENOMINATOR
	SEC			; PUT IN HIDDEN BIT
	ROR	(R5)+		; IN
	MOVB	1(R5),-2(R5)	; SHIFT LEFT
	SWAB	(R5)+		;
	MOVB	1(R5),-2(R5)
	SWAB	(R5)+
	MOVB	1(R5),-2(R5)
	SWAB	(R5)		; DONE
	CLRB	(R5)		; CLEAR LOW BYTE
	SUB	#6,R5		; POINT TO TOP OF FSRC
	ASL	(R4)		; SHIFT NUMERATOR
	ADC	2(SP)		; GET FINAL SIGN
	BISB	1(R4),R3	; GET EXPONENT OF NUMERATOR
	BEQ	DIVDZR		; BRANCH IF ANSWER IS ZERO
	ADD	R3,(SP)		; ADD EXPONENTS
	CLR	R3		;
	BISB	(R4),R0		; LEFT JUSTIFY NUMERATOR TO REGISTERS
	SWAB	R0		;
	SEC			; PUT IN NORMAL BIT
	ROR	R0
	BISB	3(R4),R0
	BISB	2(R4),R1
	SWAB	R1
	BISB	5(R4),R1
	BISB	4(R4),R2
	SWAB	R2
	BISB	7(R4),R2
	BISB	6(R4),R3
	SWAB	R3		; DONE
	CLRWRD	3,(R4)		; CLEAR FAC TO PREPARE FOR ANSWER
	CMP	-(R4),-(R4)	; POINT BACK TO TOP OF FAC
	CMP	R0,(R5)+	; COMPARE NUMERATOR AND DENOMINATOR
	BHI	DIVDDL		; BRANCH IF DENOM IS SMALLER
	BLO	DIVDDH		; BRANCH IF DENOM IS LARGER
	CMP	R1,(R5)+	; TEST NEXT WORD
	BHI	DIVDDL		; BRANCH DEN LO
	BLO	DIVDDH		; BRANCH DEN HI
	CMP	R2,(R5)+	; COMPARE NEXT
	BHI	DIVDDL		; BRANCH DEN LO
	BLO	DIVDDH		; BRANCH DEN HI
	CMP	R3,(R5)		; LAST WORD
	BHI	DIVDDL		; BRANCH DEN LO
	BNE	DIVDDH		; BRANCH DEN HI
	INC	(SP)		; INCREMENT EXPONENT
	BR	DIVDF1		; SAME
DIVDDL:	ROR	R0		; DIVIDE NUMERATOR BY 2
	ROR	R1		; WANT NUMER < DENOM
	ROR	R2
	ROR	R3
	INC	(SP)		; ADD TO EXPONENT
DIVDDH:	PUSH	#9.		; DO FIRST 9 QUOTIENT BITS
	CALL	DIV		; GET  PARTIAL QUOTIENT
	MOVB	(SP),(R4)	; SAVE ALL BUT NORMAL BIT IN FAC
	TST	(SP)+		; MOVE PAST QUOTIENT
	TST	(SP)+		; DONE YET?
	BNE	DIVDF1		; BRANCH IF SO
	PUSH	#16.		; GET NEXT WORD OF QUOTIENT
	CALL	DIV
	TST	(R4)+		; POINT TO SECOND WORD OF FAC
	POP	(R4)+		; STORE SECOND WORD OF QUOTIENT
	TST	(SP)+		; DONE YET?
	BNE	DIVDF1		; BRANCH IF SO
	PUSH	#16.		; GET NEXT WORD
	CALL	DIV
	POP	(R4)+		; SAVE IN FAC
	TST	(SP)+		; DONE YET?
	BNE	DIVDF1		; YES
	PUSH	#16.		; LAST WORD
	CALL	DIV
	POP	R3		; LAST WORD TO R3
	TST	(SP)+		; POP THE STACK
	BR	DIVDFL
DIVDF1:	CLR	R3		; EMPTY LAST WORD
DIVDFL:	POP	R2		; GET EXPONENT
	MOV	TMP3,R4		; POINT TO TOP OF FAC
	ADD	#200,R2		; PUT EXCESS 128. INTO EXPONENT
	BGT	DIVDNU		; BRANCH IF NO UNDERFLOW
	CALL	UNDER		; SET UNDERFLOW
DIVDNU:	CMP	#377,R2		; CHECK FOR OVERFLOW
	BGE	DIVDOK		; BRANCH IF NO OVERFLOW
	CALL	OVER		; SET OVERFLOW FLAGS
DIVDOK:	MOVB	R2,1(R4)	; PUT EXPONENT IN
	ROR	(SP)+		; GET SIGN
	ROR	(R4)+		; SAVE IT
	ROR	(R4)+
	ROR	(R4)+
	MOV	R3,(R4)		; R3 HAS BOTTOM WORD OF ANSWER
	ROR	(R4)
	TRKTST	@(SP),10$	; CHECK TRUNCATE - BRANCH IF SET
	ADC	(R4)		; ROUND
	ADC	-(R4)
	ADC	-(R4)
	ADC	-(R4)
	TSTOVF			; CHECK FOR OVERFLOW
10$:	JMP	ADDOUT		; GO FINISH
DIV:	MOV	(SP),-(SP)	; COPY RETURN ADDRESS
	PUSH	R4		; SAVE FAC POINTER
DIV1:	MOV	#NUMB+ASF3,R5	; SET POINTER TO DENOMINATOR
	ASL	R4		; SHIFT LEFT QUOTIENT
	ASL	R3		; SHIFT LEFT NUMERATOR
	ROL	R2
	ROL	R1
	ROL	R0		; DONE
	BCS	GO		; ALWAYS GOES FIRST TIME
	CMP	(R5)+,R0	; COMPARE DENOM AND NUMER
	BHI	NOGO		; BRANCH IF DIVISOR LARGER
	BLO	GO		; BRANCH IF DIVISOR SMALLER
	CMP	(R5)+,R1	; COMPARE LOW ORDERS SIMILARLY
	BHI	NOGO
	BLO	GO
	CMP	(R5)+,R2
	BHI	NOGO
	BLO	GO
	CMP	(R5),R3
	BHI	NOGO
	BEQ	NEQD		; BRANCH IF NUMER=DENOM
GO:	MOV	#NUMB+ASF3+6,R5	; POINT TO BOTTOM OF FAC
	SUB	(R5),R3		; NUMER=NUMER-DENOM
	SBC	R2
	SBC	R1
	SBC	R0
	SUB	-(R5),R2
	SBC	R1
	SBC	R0
	SUB	-(R5),R1
	SBC	R0
	SUB	-(R5),R0	; DONE WITH SUBTRACTION
	INC	R4		; SET A BIT IN THE QUOTIENT
NOGO:	DEC	6(SP)		; DECREMENT COUNT
	BGT	DIV1		; REPEAT PROCESS TILL DONE
ALLDUN:	MOV	R4,4(SP)	; PUT QUOTIENT ON STACK
	POP	R4		; RETURN ORIGINAL R4
	RETURN			; 
NEQD:	INC	R4		; INSERT LAST 1 BIT IN QUOTIENT
	BR	EQ1
EQ2:	ASL	R4		; FINISH OUT QUOTIENT WITH 0'S
EQ1:	DEC	6(SP)		; DECREMENT COUNTER
	BGT	EQ2		; FINISHED?
	INC	6(SP)		; SET NO MORE NUMERATOR FLAG
	BR	ALLDUN		; GO BACK
;---------------------------------------------------------------

	.SBTTL		7.9	STEXP,STCFI
;----------------------------------------------------------------
STEXP3:	ADD	R5,R4		; PROPER AC
STEXP2:	ADD	R5,R4		; PROPER AC
STEXP1:	ADD	R5,R4		; PROPER AC
STEXPX:	TST	(R4)+		; AC0
	SINC	Z2OP
	SINC	STEXP		; STATS
	MOV	(R4),R3		; GET THE FIRST WORD OF THE # IN THE AC
	ASH	#-7,R3		; RIGHT JUSTIFY THE EXPONENT
	BIC	#177400,R3	; MAKE SURE THERE IS JUST THE EXPONENT
	SUB	#200,R3		; NOT EXCESS 200 ANYMORE
	MOV	R3,TMP3		; SAVE THE EXPONENT
	MOV	#2,R5		; SET FLAG FOR GETADDRESS ROUTINE
	INC	NMB		; WANT AN ADDRESS
	CALL	GETX		; GET THE ADDRESS
	BCS	STEXPY		; MODE 0 BRANCH
	MOVTU	TMP3,(R1)	; PUT EXPONENT IN TASK
	BR	.+6
STEXPY:	MOV	TMP3,(R4)	; SAVE EXPONENT IN A GENERAL REGISTER
	TST	TMP3		; SET CONDTION CODES
	MOV	@#PSW,R2	; GET PSW
STETST:	BIC	#177760,R2	; CLEAR ALL BUT CONDITION CODES
	BIC	#17,(R0)	; CLEAR ONLY CONDITION CODES IN FPSW
	BIS	R2,(R0)		; PUT THE CODES IN FPSW
	BIC	#17,PCOFF2+2(SP)	;
	BIS	R2,PCOFF2+2(SP)	; SAVE THE CONDITON CODES IN USER PSW
	JMP	FPEX2		; DONE
;---------------------------------------------------------------
STCFI3:	ADD	R5,R4		; PROPER AC
STCFI2:	ADD	R5,R4		; PROPER AC
STCFI1:	ADD	R5,R4		; PROPER AC
STCFIX:	TST	(R4)+		; AC0
	SINC	Z2OP
	SINC	STCFI		; STATS
	CLR	FXM		; CLEAR FE FLAG
	PUSH	R2		; SAVE THE DESTINATION FIELD
	MOV	R4,R5		; GET ADDRESS OF FAC
	MOV	(R5)+,R1	; FIRST WORD FROM FAC
	MOV	(R5)+,R2	; SECOND
	MOV	(R5)+,R3	; THIRD
	CLRB	R3		; DON'T NEED THIS LEAST SIGNIFICANT BYTE
	BISB	R2,R3		; MOVE BYTE 3 DOWN
	CLRB	R2		; CLEAR WHERE BYTE 3 WAS
	BISB	R1,R2		; MOVE BYTE 1 DOWN
	BIS	#200,R2		; MAKE SURE HIDDEN BIT IS THERE
	SWAB	R2		; R1/ BYTE1:BYTE2
	SWAB	R3		; R2/BYTE3:BYTE4
	ROL	R1		; ROLL SIGN OUT
	ROL	R4		; SAVE IT IN R4
	CLRB	R1		; GET RID OF FRACTION
	SWAB	R1		; R1/ EXPONENT
	SUB	#237,R1		; MAKE EXP A SHIFT COUNT
	BGT	STCK		; PROBABLE OVERFLOW -- GO CHECK
	CLC			; CLEAR CARRY
	ROR	R2		; MAKE POSITIVE
	ROR	R3		; (SINCE MOST SIG. BIT IS ROLLED RIGHT)
	CMP	#-37,R1		; IS THIS A NUMBER LESS THAN ONE?
	BGE	STZERO		; YES -- GO SET IT TO 0
	ASHC	R1,R2		; GET THE NUMBER IN R2 & R3
	BIT	#100,(R0)	; IS THIS INTEGER OR LONG MODE?
	BNE	STLONG		; BRANCH ON LONG
	TST	R2		; THIS MUST BE ZERO FOR INTEGER
	BNE	STOVER		; HANDEL OVERFLOW
	NEG	R3		; THIS SHOULD BE NEGATIVE
	BPL	STOVER		; IF NOT, OVERFLOW
	BVC	STISGN		; IF NOT 100000, BRANCH
	ROR	R4		; 100000 IS LEAGL OR NOT DEPENDING ON SGN
	BCC	STOVER		; IF IT WAS POSITIVE IT IS AN OVERFLOW
	BR	STIPUT		; GO PUT IT IN
STISGN:	ROR	R4		; GET APPROPRIATE SIGN FOR OTHER CASES
	BCS	.+4		; LEAVE IT NEGATIVE
	NEG	R3		; MAKE IT POSITIVE
STIPUT:	MOV	R3,NUMB		; SAVE THE INTEGER
	POP	R2		; RESTORE THE DESTINATION
	MOV	#4,R5		; SET MAX. AUTO INC.
	INC	NMB		; WANT AN ADDRESS
	MOV	#100,R3		; TEST LONG OR INTEGER
	CALL	GET		; GET THE ADDRESS
	BCS	STMZ		; GO DO MODE 0
	MOV	#NUMB+ASF3,R2	; ADDRESS OF NUMBER(S)
	MOV	TMP1,R5		; SAVE THE WORD COUNT FOR LATER
STP:	MOVTU	(R2)+,(R1)+	; PUT NUMBER IN USER AREA
	SOB	R5,STP		; DONE YET?
STCTS:	TST	NUMB		; SET CONDITION CODES FOR RETURN
	MOV	@#PSW,R2	; SAVE THEM IN R2
	DEC	TMP1		; ONE WORD O OR TWO?
	BEQ	STCEC		; BRANCH IF ONE
	TST	NUMB+2		; IF TWO, MAKE SURE ENTIRE THING IS 0
	BEQ	STCEC		; BEFORE SETTING THE Z BIT
	BIC	#4,R2		; -- HERE CLEAR THE Z BIT SINCE WORD 2
				; IS NOT ZERO
STCEC:	TST	FXM		; WAS A CONVERSION ERROR ENCOUNTERED?
	BEQ	STETST		; NO -- GO SET CONDITION CODES & QUIT
	INC	R2		; SET CARRY
	BIT	#400,(R0)	; DO WE INTERRUPT ON THIS CONDITION?
	BEQ	STETST		; NO -- JUST HAVE THE CARRY SET
	BIT	#40000,(R0)	; IS INHIBIT INTERRUPT BIT SET?
	BNE	STETST		; YES -- LEAVE
	BIC	#177760,R2	; CLEAR ALL BUT CC'S
	BIC	#17,PCOFF2+2(SP)
	BIS	R2,PCOFF2+2(SP)	; SET CC'S IN PSW
FPE:	BIS	#100000,(R0)	; FLAG ERROR IN FPSW
	BIC	#177760,R2	; PUT CONDITION CODES IN FPSW
	BIC	#17,(R0)	; CLEAR OUT OLD ONES
	BIS	R2,(R0)		; THERE NOW
	MOV	@#244,16(SP)	; COVER KPAR3 WITH ADDRESS
	SINC	FPE		; STATS
	JMP	FPEOUT		; GO SET UP SO SYSTEM CAN MAKE AN AST
STMZ:	MOV	NUMB,(R4)	; PUT NUMBER IN USER REGISTER
	BR	STCTS		; *
STLONG:	ROR	R4		; GET THE SIGN
	BCC	STLPUT		; BRANCH IF POSITIVE
	NEG	R3		; MAKE THE DOUBLE WORD NEGATIVE
	ADC	R2		;
	NEG	R2		; DONE
STLPUT:	MOV	R2,NUMB		; SAVE THE LONG INTEGER
	MOV	R3,NUMB+2	; LOW ORDER IS SECOND
	BR	STIPUT+4	; GO GET ADDRESS
;
STCK:	DEC	R1		; IS THIS THE DOUBLE WORD MAX. NEGATIVE?
	BNE	STOVER		; NO WAY
	NEG	R2		; IF SO, THIS MUST BE 100000
	BVC	STOVER		; BRANCH IF NOT
	TST	R3		; THIS WOULD NEED TO BE 0
	BNE	STOVER		; BRANCH IF NOT
	ROR	R4		; LAST REQUIREMENT IS SIGN BE NEGATIVE
	BCS	STLPUT		; HOORAY -- IT IS -- GO PUT IT IN
;
STOVER:	
	MOV	#6,FPXCOD	; PUT IN THE FEC
	SINC	ICE		; STATS
	SINC	TFPE		;
	INC	FXM		; SET OVERFLOW FLAG
STZERO:	CLR	NUMB		; PUT ZEROS IN
	CLR	NUMB+2		; BOTH WORDS
	BR	STIPUT+4	; GO GET ADDRESS AND STUFF
;---------------------------------------------------------------

	.SBTTL		7.10	STCFD,LDCDF,LDEXP,LDCIF
;----------------------------------------------------------------
STCFD3:	ADD	R5,R4		; PROPER AC
STCFD2:	ADD	R5,R4		; PROPER AC
STCFD1:	ADD	R5,R4		; PROPER AC
STCFDX:	TST	(R4)+		; AC0
	MOV	R4,TMP3		; SAVE POINTER TO AC
	SINC	Z2OP
	SINC	STCFD		; STATS
	BIT	R3,(R0)		; IS CURRENT MODE DOUBLE OR FLOAT
	BNE	STCDFX		; CONVERT FROM DOUBLE TO FLOATING
	ASL	R5		; A.I. BY 10
	INC	NMB		; WANT AN ADDRESS
	CALL	GET		; GET THE ADDRESS
	MOV	TMP3,R2		; GET ADDRESS OF FAC
	BCS	STCFDY		; BRANCH ON MODE 0
	MOVTU	(R2)+,(R1)+	; PUT THE NUMBER IN USER AREA
	MOVTU	(R2)+,(R1)+	; SECOND WORD
	CLR	-(SP)		; FILL WITH ZEROES
	MTPI	(R1)+		;
	IFERR	ODAD1		; CHECK FOR LEGAL ADDRESSES
	CLR	-(SP)		; LAST WORD
	MTPI	(R1)		; DONE
	IFERR	ODAD1		; CHECK FOR LEGAL ADDRESSES
	JMP	TSTFY		; GO SET CONDITION CODES
STCFDY:	MOV	(R2)+,(R1)+	; MOVE FAC TO FAC IN MODE 0
	MOV	(R2)+,(R1)+	;
	CLRWRD	2,(R1)		; FILL WITH ZEROES
STCFDZ:	JMP	TSTFY
;
STCDFX:
	CLR	FXM		; CLEAR FPE FLAG
	MOV	R4,R5		; GET FAC ADDRESS
	TRKTST	(R0),STCDFY	; TEST TRUNCATE - BRANCH IF SET
	ROL	4(R5)		; ROUND
	ADC	2(R5)		;
	ADC	(R5)		; ROUNDING COMPLETE
	BCS	STCDFV		; BRANCH ON OVERFLOW
	BVS	STCDFV		;
STCDFY:	MOV	#4,R5		; GET THE ADDRESS
	INC	NMB		; WANT AN ADDRESS
	CALL	GET
	MOV	TMP3,R2		; GET FAC ADDRESS AGAIN
	BCS	STCDFZ		; BRANCH IF MODE IS 0
	MOVTU	(R2)+,(R1)+	; MOVE NUMBER TO USER
	MOVTU	(R2),(R1)	;
STCDFB:	TST	FXM		; WAS THERE AN EXCEPTION?
	BNE	.+6		; BRACHH IF SO
	JMP	TSTFY		; GO SET CONDITION CODES -- 
	BIT	#1000,(R0)	; INTERRUPT?
	BEQ	STCDFO		; IF NOT LEAVE
	BIT	#40000,(R0)	; INHIBIT ALL INTERRUPTS SET?
	BNE	STCDFO		; IF SO, DON'T INTERRUPT
	MOV	#6,R2		; SET ZERO CONDITION CODE
	TST	@TMP3		; SEE ABOUT SETTING NEGATIVE
	BGE	10$
	MOV	#16,R2
10$:	JMP	FPE
STCDFO:	JMP	TSTFY2		; LEAVE V BIT SET
STCDFV:	INC	FXM		; SET FEC FLAG
	ADD	#100000,(R5)	; PUT SIGN RIGHT
	BIC	#17,(R0)	; CLEAR CONDITION CODES
	BIS	#2,(R0)		; AND SET V
	MOV	#10,FPXCOD	; SET UP THE RIGHT FEC
	BR	STCDFY		; CONTINUE NORMAL PROCESS
STCDFZ:	MOV	(R2)+,(R1)+	; MOVE FAC TO FAC
	MOV	(R2),(R1)+	; DONE
	CLRWRD	2,(R1)		; CLEAR OUT REMAINDER OF FAC
	BR	STCDFB
;---------------------------------------------------------------
LDCDF3:	ADD	R5,R4		; PROPER AC
LDCDF2:	ADD	R5,R4		; PROPER AC
LDCDF1:	ADD	R5,R4		; PROPER AC
LDCDFX:	TST	(R4)+		; AC0
	MOV	R4,TMP3		; SAVE POINTER TO AC
	SINC	Z2OP
	SINC	LDCDF		; STATS
	BIT	R3,(R0)		; TEST MODE
	BNE	LDCFDX		; BRANCH IF MODE IS DOUBLE
	ASL	R5		; INCREMENT REGISTERS BY 20/2
	CALL	GET		; GO GET NUMBER
	MOV	#NUMB+ASF3,R5	; R5 HAS ADDRESS OF NUMBER
	CLR	FXM		; CLEAR FPE FLAG
	TRKTST	(R0),LDCDFY	; IF TRNK SET, DON'T ROUND
	ROL	4(R5)		; ROUND
	ADC	2(R5)		;
	ADC	(R5)		;
	BCS	LDCDFV		; BRANCH ON OVERFLOW
	BVS	LDCDFV		;
LDCDFY:	MOV	TMP3,R2		; R2 HAS ADDRESS OF FAC
	MOV	(R5)+,(R2)+	; MOV THE WORD IN
	MOV	(R5),(R2)+	; SECOND ONE
	CLRWRD	2,(R2)		; CLEAR OUT THE REST OF THE REGISTER
	BR	STCDFB		; GO FINISH
LDCDFV:	INC	FXM		; SET THE FPE FLAG
	MOV	#10,FPXCOD	; PUT IN FEC
	BIC	#17,(R0)	; CLEAR OUT CONDITION CODES
	BIS	#2,(R0)		; SET THE V BIT
	ADD	#100000,(R5)	; GET THE SIGN RIGHT
	BR	LDCDFY		; CONTINUE WITH REGULAR PROCESSING
LDCFDX:	ASR	R5		; INCREMENT BY 4
	CALL	GET		; GET THE NUMBER
	MOV	#NUMB+ASF3,R2	; GET ADDRESS OF NUMBER
	MOV	TMP3,R1		; ADDRESS OF FAC
	.IIF NDF STAT BR	STCFDY		; GO FINISH
	.IIF DF STAT JMP	STCFDY
;---------------------------------------------------------------
LDEXP3:	ADD	R5,R4		; PROPER AC
LDEXP2:	ADD	R5,R4		; PROPER AC
LDEXP1:	ADD	R5,R4		; PROPER AC
LDEXPX:	TST	(R4)+		; AC0
	SINC	Z2OP
	SINC	LDEXP		; STATS
	MOV	#2,R5		; NEED ONE NUMBER
	MOV	R4,TMP3		; SAVE POINTER TO AC
	CALL	GETX		; GET IT
	MOV	NUMB,R3		; R3 HAS THE NUMBER
	BCC	.+4		; ASSUMING IT WAS NOT MODE 0
	MOV	(R4),R3		; IF MODE 0, R3 GETS THE NUMBER HERE
	ADD	#200,R3		; CHANGE TO EXCESS 200 NOTATION
	ASH	#7,R3		; SHIFT IT TO PROPER POSITION
	BIC	#100177,R3	; CLEAR OUT ANY EXTRAS
	MOV	TMP3,R5		; R5 HAS ADDRESS OF AC
	BIC	#077600,(R5)	; CLEAR OUT ANY EXISTING EXPONENT
	BIS	R3,(R5)		; PUT THE NUW ONE IN
	MOV	(R5),NUMB	; PREPARE TO SET CONDITION CODES
	JMP	TSTFY		; GO DO IT
;---------------------------------------------------------------
LDCIF3:	ADD	R5,R4		; PROPER AC
LDCIF2:	ADD	R5,R4		; PROPER AC
LDCIF1:	ADD	R5,R4		; PROPER AC
LDCIFX:	TST	(R4)+		; AC0
	SINC	Z2OP
	SINC	LDCIF		; STATS
	ASR	R3		; CHECK INTEGER OR LONG BIT IN FPSW
	ASR	R5		; MAX AUTO INCREMENT IS 4
	MOV	R4,TMP3		; SAVE POINTER TO AC
	CALL	GET		;
	MOV	TMP3,R5		; R5 HAS FAC ADDRESS
	MOV	(R4),R2		; PUT NUMBER IN R2 (MODE 0)
	BCS	10$		; WAS IT RIGHT -- IF SO BRANCH
	MOV	NUMB,R2		; PUT NON MODE 0 NUMBER IN
10$:	BIT	#100,(R0)	; INTEGER OR LONG MODE?
	BNE	LDCLF		; BRANCH IF LONG
	TST	R2		; CLEAR CARRY BIT
	BGT	LDPOS		; BRANCH IF NUMBER IS POSITIVE
	BEQ	LDZERO		; BRANCH IF NUMBER IS 0
	NEG	R2		; NUMBER IS NEGATIVE -- MAKE IT POSITIVE
LDPOS:	ROL	R4		; SAVE THE SIGN IN R4
	MOV	#221,R3		; R3 HAS MAX EXPONENT
LDNORM:	ASL	R2		; NORMALIZE THE INTEGER
	DEC	R3		; SUBTRACT ONE FROM EXP. FOR EACH SHIFT
	BCC	LDNORM		; KEEP SHIFTING UNTIL FINISHED
	CLR	2(R5)		; CLEAR OUT SECOND WORD
	MOVB	R2,3(R5)	; SAVE THE LOW ORDER FRACTION
	CLRB	R2		; CLEAR OUT LOW ORDER FRACTION
	BISB	R3,R2		; PUT IN EXPONENT
	SWAB	R2		; PUT EXPONENT ON RIGHT SIDE OF R2
	ROR	R4		; LOAD SIGN INTO CARRY BIT
	ROR	R2		; PUT THE SIGN IN
	MOV	R2,(R5)+	; STORE FIRST WORD
	ROR	(R5)		; SHIFT CARRY TO SECOND WORD
	TST	(R5)+		; POINT TO NEXT WORD
	BR	.+6		; CLEAR OUT REMAINING
LDZERO:	CLRWRD	4,(R5)		; CLEAR IT
	MOV	R2,NUMB		; WANT TO SET CONDITION CODES
	JMP	TSTFY		; GO DO IT
LDCLF:
	BCS	LD027		; CLEAR SECOND WORD IF MODE 0
	DEC	TMP1		; TMP1 IS WORD COUNT
	BEQ	LD027		; CLEAR SECOND WORD IF IMMEDIATE MODE
	MOV	NUMB+2,R3	; SECOND WORD IS FROM USER FOR ALL OTHERS
	BR	.+4		; CONTINUE
LD027:	CLR	R3		; SECOND WORD IS CLEARED
	TST	R2		; DECIDE THE SIGN
	BGT	LDCPOS		; POSITIVE
	BEQ	LDC0		; UPPER HALF IS ZERO -- GO TEST LOWER
	NEG	R3		; MAKE A NEGATIVE NUMBER POSITIVE
	ADC	R2		;
	NEG	R2		;
	SEC			; SET FOR SIGN
LDCPOS:	ROL	-(SP)		; SAVE SIGN ON THE STACK
	MOV	#241,R4		; SET MAX EXPONENT
LDCNRM:	DEC	R4		; DECREMENT EXPONENT FOR EACH SHIFT
	ASL	R3		; LOW ORDER
	ROL	R2		; HIGH ORDER
	BCC	LDCNRM		; SHIFT UNTIL NORMALIZED
	CLR	4(R5)		; MAKE ROOM FOR RESULTS
	MOVB	R3,5(R5)	; PUT IN LEAST SIGNIFICANT PART
	CLRB	R3		; MAKE ROOM
	BISB	R2,R3		; SECOND MOST SIGNIFICANT PART
	CLRB	R2		; MAKE ROOM
	BISB	R4,R2		; PUT IN EXPONENT
	SWAB	R2		; NOW PUT THINGS IN PROPER ORDER
	SWAB	R3		; SAME HERE
	ROR	(SP)+		; PUT SIGN IN CARRY BIT
	ROR	R2		; SHIFT EVERYTHING ONE TO PUT IN SIGN
	ROR	R3		;
	ROR	4(R5)		; ALL DONE
	MOV	R2,(R5)+	; PUT IN FIRST WORD
	MOV	R3,(R5)+	; PUT IN SECOND WORD
	BIT	#200,(R0)	; WANT DOUBLE OR FLOATING?
	BEQ	LDZERO+4	; FOR FIX, ERASE THE LEAST SIGNIFICANT
	TST	(R5)+		; POINT TO LAST WORD OF FAC
	BR	LDZERO+6	; CLEAR LAST WORD OF FAC FOR DOUBLE
LDC0:	TST	R3		; IS THE WHOLE THING ZERO?
	BEQ	LDZERO		; YES -- GO ZERO THE FAC
	BR	LDCPOS		; NO -- IT'S JUST A SMALL NUMBER
;
NUMB:	.BLKW	4
TMP1:	0
TMP2:	0
TMP3:	0
NMB:	0

	.SBTTL	8.	GET ADDRESS OR NUMBERS FROM TASK
;	THE UNIVERSAL SOURCE/DESTINATION GETTER
;
;	IT'S PORPOSE IS TO GET THE NUMBER OR ADDRESS THAT IS NEEDED
;	BY THE FLOATING POINT ROUTINES.
;
;	R2 HAS A COPY OF THE INSTRUCTION
;	R3 HAS THE FPSW MASK (SHORT OR LONG MODE REAL OR INTEGER)
;	R5 IS THE MAXIMUM POSSIBLE AUTOINCREMENT COUNT
;
GET:
	BIT	R3,(R0)		; TEST APPROPRIATE BIT IN FPSR
	BNE	GETX		; IT SHOULD BE MAX
	ASR	R5		; TOO BIG -- DIVIDE BY 2
GETX:
	.IF DF STAT		; STATISTICS
	BIT	#200,(R0)
	BNE	LSL	
	SINC	SHORT
	BR	GETT
LSL:	SINC	LONG
GETT:
	.ENDC
	MOV	R5,TMP1		; SAVE COUNT
	ASR	TMP1		; MAKE IT A WORD COUNT
	MOV	R2,R3		; BREAK SRC/DST APART
	BIC	#177770,R2		; R2 HAS THE REGISTER
	MOV	SP,R4		; COPY THE STACK POINTER FOR LATER USE
	TST	(R4)+		; ADD TWO SINCE WITHIN A SUBROUTINE
	MOV	R2,TMP2		; SAVE A COPY OF REG. #
	CMP	#7,R2		; PC ADDRESSING TAKES SPECIAL CARE
	BEQ	PCADRM		;
	NEG	R2		; ALL REGS ARE ON THE STACK
	ADD	#6,R2		; COMPUTE THE OFFSET TO THEM
	ASL	R2		; 
	ADD	R2,R4		; NOW R4 POINTS TO THE SELECTED REG.
HAVREG:	BIC	#177707,R3		; R3 HAS THE MODE
	BEQ	MODE0		; BRANCH IF MODE0
	MOV	(R4),R1		; NOW FOR ALL CASES, R1 HAS THE REGISTER
				; CONTENTS AND R4 HAS THE POINTER TO
				; THAT REGISTER (STORED ON CURRENT STACK)
;
;	NOW MODE CONSIDERATIONS
	ASR	R3		; MAKE THE MODE AN OFFSET
	ASR	R3		;
	ADD	#MODAD+ASF3+2,R3	; GET ADDRESS TO JMP TO
	JMP	@-(R3)		; GO TO PROPER MODE HANDLING ROUTINE
MODAD:	MODE0+ASF3,MODE1+ASF3,MODE2+ASF3,MODE3+ASF3
	MODE4+ASF3,MODE5+ASF3,MODE6+ASF3,MODE7+ASF3
;
PCADRM:	MOV	#2,R5		; SET MAX INCREMENT AT 2
	NEG	R2		; SET REGISTER=PC FLAG
	ADD	#PCOFF2,R4	; R4 POINTS TO PC
	BR	HAVREG
;
MODE0:	SINC	MODE0		; STATS
	MOV	TMP2,R1		; GET REGISTER NUMBER
	ASL	R1		; NEED AN OFFSET
	ASL	R1
	ASL	R1
	ADD	R0,R1		; NOW HAVE THE ADDRESS
	TST	(R1)+		; SKIP PAST STATUS
	TST	NMB		; ADDRESS OR NUMBER
	BNE	M0
	MOV	#NUMB+ASF3,R3	; PUT IN NUMB 
	ADD	R5,PC		; BRANCH TO PROPER PLACE
	NOP
	BR	10$
	BR	20$
	NOP
	MOV	(R1)+,(R3)+
	MOV	(R1)+,(R3)+
	MOV	(R1)+,(R3)+
	MOV	(R1),(R3)
	SEC
	RETURN
10$:	MOV	(R1),(R3)+
	CLR	(R3)+
	CLR	(R3)+
	CLR	(R3)
	SEC
	RETURN
20$:	MOV	(R1)+,(R3)+
	MOV	(R1),(R3)+
	CLR	(R3)+
	CLR	(R3)
M0:	SEC			; LET THE CALLER KNOW THIS IS MODE 0
	RETURN
MODE7:	SINC	MODE7		; STATS
	MFPI	@PCOFF2+2(SP)	; GET OFFSET
	ADD	(SP)+,R1	; POP STACK TO GET FINAL ADDRESS
	ADD	#2,PCOFF2+2(SP)	; INCREMENT PC
	TST	R2		; IF REGISTER IS PC -- TAKE CARE
	BGE	M7C
	ADD	#2,R1		; THIS WAS CHANGED IN INSTR DECODING
M7C:	MFPI	(R1)		; MODE 7 -- GET OTHER ADDRESS
	IFERR	ODAD1		; ODD ADDRESS OR SEGMENT ERROR CATCHER
	POP	R1		; GOT IT
	BR	NORA
MODE6:	SINC	MODE6		; STATS
	MFPI	@PCOFF2+2(SP)	; GET OFFSET
	ADD	(SP)+,R1	; POP STACK TO GET FINAL ADDRESS
	ADD	#2,PCOFF2+2(SP)	; INCREMENT PC
	TST	R2		; IF REGISTER IS PC -- TAKE CARE
	BGE	NORA
	ADD	#2,R1		; THIS WAS CHANGED IN INSTR DECODING
	.IIF	DF	STAT	BR	NORA
MODE1:	SINC	MODE1		; STATS
NORA:	TST	NMB		; WANT A NUMBER OR ADDRESS?
	BNE	NONUM		; GO GET NUMBER
GETNUM:	MOV	#NUMB+2+ASF3,R3	; CLEAR OUT NUMB
	CLRWRD	3,(R3)
	MOV	#NUMB+ASF3,R3	; STORE THE NUMBERS
	MOV	TMP1,R5		; WORD COUNT
PUTNUM:	MFPI	(R1)+		; GET THE NUMBERS
	IFERR	ODAD1		; CHECK FOR LEGAL ADDRESS
	POP	(R3)+		;
	SOB	R5,PUTNUM	; STORE AS MANY AS NEEDED ON THE STACK
NONUM:	RETURN			; YES
MODE3:	SINC	MODE3		; STATS
	MFPI	(R1)		; GET OTHER ADDRESS
	IFERR	ODAD1		; RECOVER FROM ODD ADR OR SEGMENT FAULT
	POP	R1		; THIS IS SECOND ONE
	ADD	#2,(R4)		; UPDATE REGISTER
	BR	NORA		;
MODE2:	SINC	MODE2		; STATS
	ADD	R5,(R4)		; UPDATE REGISTER
	MOV	R5,TMP1		; UPDATE WORD COUNT IN CASE IT IS MODE7
	ASR	TMP1		; BYTES TO WORDS
	BR	NORA		;
MODE5:	SINC	MODE5		; STATS
	SUB	#2,(R4)		; UPDATE REGISTER
	SUB	#2,R1		; UPDATE ADDRESS
	MFPI	(R1)		; GET FIRST ADDRESS
	IFERR	ODAD1		; IN CASE OF ERROR
	POP	R1		; GET SECOND ADDRESS
	BR	NORA		;
MODE4:	SINC	MODE4		; STATS
	SUB	R5,(R4)		; UPDATE THE REGISTER
	SUB	R5,R1		; ADDRESS CHANGES TOO
	BR	NORA		; GO FINISH
ODDADR:
ODAD1:
	MOV	@#4,20(SP)	; SET UP ADDRESS (WIPE OUT KPAR3)
	TST	(SP)+		; FORGET ABOUT EVER RETURNING
FPEOUT:	MTPI	SP		; GIVE THE USER HIS REGISTERS BACK
	POP	R5
	POP	R4
	POP	R3
	POP	R2
	POP	R1
	POP	R0
	MOV	#34340,@#PSW	;
	JMP	@(SP)+
	.END INIT