*20
/DBLFLT1
/DOUBLE PRECISION FLOATING POINT PROGRAM
/ (A SLIGHTLY ALTERED VERSION OF DBLFLT)
/BY MICHAEL MCDONALD
/  BIOMEDICAL COMPUTOR LABORATORY
/  WASHINGTON UNIVERSITY
/  ST. LOUIS, MO.
/REVISED FOR PDP-12
/  BY D.A.OVERTON
/FOR PREVIOUS VERSIONS AND DOCUMENTS
/ SEE DEC-L8-SFAA-D ? DEC-L8-FLAA-D
/PLACE IN THE CURRENT INSTRUCTION FIELD
/USES IR.1-5
/
	*1000	/MAY BE RELOCATED
/
/ADDITION ENTRANCE POINT
ADDT,	CLR
	ADD 0	/GET RTN ADDRESS
	JMP SETUP/STANDARD SETUP ROUTINE
	LDA 1	/SUBTRACT EXPONENTS
	COM	/	"
	ADA 2	/	"
	FLO	/WAS THERE OVERFLOW?
	JMP .+4 /NO
	SCR 14	/YES
	BCO I	/SET AC. TO A 40 OF SIGN
	7737	/ OPPOSITE SIGN OF DIFFERENCE
	SCR I 1 /SIGN TO LINK
	ROL I 1 /RESTORE AC.
	LZE I	/SKIP IF NEGATIVE
	COM	/MAKE DIFFERENCE NEGATIVE
	STC DM7+1/AS COUNTER FOR SCALING RIGHT
	JMP DI6	/SET IR.1?2 IN REVERSE ORDER
	LZE	/IS SIGN OF DIFFERENCE +
	JMP DH6	/NO:SET IR.1?2 IN NORMAL ORDER
	LDA 1	/LARGER EXPONENT BECOMES
	STA 3	/ EXPONENT OF RESULT
	LDA I 2 /MANTISSA OF NO.WITH SMALLER
	STA I 3 / EXPONENT BECOMES MANTISSA
	LDA I 2	/ OF RESULT	
	STA I 3	/	"
	JMP DM7	/SCALE RESULT RIGHT N PLACES
		/ N = DIFFERENCE OF EXPONENTS
	JMP DH7	/ADD RESULT TO ARGUMENT
		/ WITH LARGER EXP.
	JMP DI7-2 /CHECK FOR ADD OVERFLOW
	JMP DG6	/SET IR.3 TO ADDRESS OF RESULT
	LDA I 3 /SETUP TO RESTORE SIGN
	JMP DC6+2/ OF RESULT
	SET 1	/SET IR.1 TO RESULT
	DG6+1	/	"
	JMP ABS1/TAKE ABSOLUTE VALUE OF RESULT
	JMP EXIT /TERMINATE
/
/SUBTRACTION ENTRANCE POINT
SUBT,	CLR
	ADD 0	/GET RTN ADDRESS
	JMP SETUP /TO SETUP ROUTINE
	JMP DI6+2 /SET IR.1 TO 2ND ARGUMENT
	JMP COM1  /COMPLEMENT 2ND ARG.
	JMP DH6	/SET IR.1 ? 2 IN NORMAL ORDER
	JMP ADDT+3/TRANSFER CONTROL TO 
		  /ADDITION SUBROUTINE.
/
/MULTIPLY ENTRANCE POINT
MULT,	CLR
	ADD 0	/GET RTN ADDRESS
	JMP SETUP /TO SETUP ROUTINE
	LDA 1	/ADD EXPONENTS
	ADA 2	/ "	"
	JMP DE6+1/STORE AS EXPONENT OF RESULT
		/ ? CHECK FOR OVERFLOW
	STC DE5	/SAVE SUM OF EXPONENTS
	JMP DC6 /DETERMINE SIGN OF RESULT
		/ ? SET UP TO RESTORE IT
	JMP DI6+2 /SET IR.1 TO 2ND ARG.
	JMP ABS1 /TAKE ABS.VALUE OF 2ND ARG.
	JMP DH6	/SET IR.1?2 IN NORMAL ORDER
	JMP DD6 /TAKE ABS. VALUE OF 1ST ARG.
		/ (SINCE IR.2 UNEQUAL TO -0)
	LDA I 2 /PUT SIGN OF LEAST SIGNIFICANT
	LDA I 2 / PART OF FRACTION OF 2ND ARG.
	ROR 1	/ INTO BIT 11 OF 2ND ARG
	STA 2	/	"
	JMP DH6	/RESET IR.1?2 IN NORMAL ORDER
		/ (BIT 0=1 FOR 2ND ARGUMENT)
	LDA I 1	/MULT. MOST SIGNIF PARTS
	MUL I 2	/ OF MANTISSA
	STA 3	/SAVE MOST SIG.PART OF PRODUCT
		/ IN EXPONENT OF RESULT
	QAC	/SAVE LEAST SIG.PART OF PROD.
	STA I 3 / IN 2ND WORD OF RESULT
		/ (PRODUCT IS ALWAYS +)
	LDA I 1 /LOAD LEAST SIG.PART OF
		/ FIRST ARGUMENT
	ROR 1	/ ? PUT SIGN IN BIT 11
	MUL I 2 /MULT BY LEAST SIGNIF.
		/ PART OF 2ND ARG.
	ROL 1	/PUT SIGNIF.BITS AT LEFT END
	STA I 3 /SAVE IN 3RD WORD OF RESULT
	JMP DH6+2 /SET 1 TO NORMAL VALUE(ARG1)
	LDA I 1 /MULT.MOST SIG.PART OF ARG.1
	MUL 2	/ BY LEAST SIG.PART OF ARG.2
	JMP DF5	/SUM INTO RESULT LOCATIONS 2?3
DD5,	JMP DH6	/SET 1 ? 2 IN NORMAL ORDER
	LDA I 1 /MULT.LEAST SIGNIF.PART OF
	LDA I 1 / ARG.1 (WITH SIGN IN BIT 11)
	ROR 1	/ BY MOST SIG.PART OF ARG. 2
	MUL I 2 /	"
	JMP DF5	/SUM INTO RESULT LOCATIONS 2?3
	JMP DG6	/SET 3 TO LOCATION OF RESULT
	LDA I 3 /INCREMENT IR.3
	LDA I 3 /LOAD 3RD WORD OF RESULT
	ROL I 1 /SAVE 1ST BIT IN LINK
	ROL 1	/SAVE 2ND BIT AS BIT 0
	BCL I	/ IN LOCATION DP7
	7776	/	"
	STC DP7	/	"
	JMP DG6	/SET 3 TO LOCATION OF RESULT
	LDA I 3 /SAVE 2ND WORD OF RESULT WITH
	ROL I 1 / PRECISION SHIFTED LEFT AND
	STA I 3	/ LINK BIT (1ST BIT OF WORD 3)
		/ AS BIT 0 IN THE 3RD WORD
	JMP DG6	/RESET 3
	LDA 3	/SAVE 1ST WORD IN 2ND WORD
	STA I 3 /	"
	JMP DG6	/RESET 3
	LDA I	/STORE EXPONENT SUM
DE5,	0	/ AS EXPONENT OF RESULT
	STA 3	/	"
	JMP EXIT/TERMINATE
DF5,	STC ARG1/SAVE MOST SIG.PART OF PRODUCT
	JMP QAC12 /TRANSFER MQ TO AC, 12 BITS
	STC ARG1+1/SAVE LEAST SIG.PART OF PROD
	SET I 1
	ARG1-1
	JMP DG6	/SET IR.3 TO RESULT
	JMP DH7	/ADD PRODUCT INTO 2ND ?
		/ 3RD WORDS OF RESULT
	SET I 2 /SET 2 TO SKIP PART OF
	-0	/ THE ADD OVERFLOW SUBROUTINE
	JMP DI7	/CHECK FOR ADD OVERFLOW
	SRO I	/HAVE WE PASSED HERE BEFORE?
	2525	/ 010 101 010 101
	JMP DD5	/NO: CONTINUE
	JMP DD5+6/YES
/
/DIVIDE ENTRANCE POINT
DIVIDE,	CLR
	ADD 0	/GET RTN JMP
	JMP SETUP /SETUP ROUTINE
	ADD DK7  /SET MASK COUNTER TO 0001
	STC DJ5+1/	"
	LDA I 2 /GET MOST SIG.PART OF 2ND ARG
	AZE I	/IS 2ND ARGUMENT ZERO?
	HLT	/HALT ON ATTEMPTED DIVIDE BY 0
	JMP DH6	/NO:SET IR.1?2 IN NORMAL ORDER
	LDA 2	/SUBTRACT EXPONENT OF DIVISOR
	COM	/ FROM EXPON. OF DIVIDEND
	ADA 1	/	"
	JMP DE6+1 /STORE DIFFERENCE AS EXPON.
	      / OF RESULT ? CHECK FOR OVERFLOW
	JMP DC6	/DETERMINE SIGN OF RESULT
		/ ? SETUP TO RESTORE IT
	JMP DH6+2 /SET IR.1 TO 1ST ARG.
	JMP ABS1  /TAKE ABS. VALUE OF 1ST ARG
	JMP DI6+2 /SET IR.1 TO 2ND ARG.
	JMP ABS1  /TAKE ABS.VALUE OF 2ND ARG.
	JMP DH6	/RESET IR.1?2 IN NORMAL ORDER
	LDA I 1 /STORE MANTISSA OF DIVIDEND
	STA I 3 / IN MANTISSA OF RESULT
	LDA I 1 /	"
	STA I 3 /	"
	LDA I 2 /STORE NEGATIVE OF DIVISOR
	COM	/ IN WORDS 2 ? 3 OF ARG1
	STC ARG1+1 /	"
	LDA I 2 / (POSITIVE DIVISOR IS LEFT
	COM	/ IN ARG.2 LOCATIONS)
	STC ARG1+2/	"
	STC ARG1 /CLEAR ARG1 ? ARG2 WHERE
	STC ARG2 / QUOTIENT WILL BE MAINTAINED
	SET I 2 /DUMMY INITIAL SETUP
	ARG1-3	/ SINCE 1ST ADD IS IGNORED
		/ WILL POINT TO ARG1,THEN ARG2
DH5,	JMP DH6+2/SET 1 TO LOCATION
		 / OF NEGATIVE DIVISOR
	JMP .+2
DI5,	JMP DI6+2/SET 1 TO LOCATION
		 / OF POSITIVE DIVISOR
	JMP DH7	/ADD TO RESULT (I.E. DIVIDEND)
		/ THE NUMBER POINTED TO BY 1
DJ5,	SRO I	/COUNTER AND MARK FOR 12
	1	/ BITS OF QUOTIENT
		/ (WILL SKIP OUT THE 1ST TIME)
	JMP DM5	/GO TO SEE IF FINISHED OR
		/ TO SET UP FOR NEXT 12 BITS
	SET I 5 /SET 5 TO INDICATE
	-0	/ ADD DIVISOR NEXT TIME
	JMP DG6	/SET 3 TO LOCATION OF
		/ RESULT (SUM)
	LDA I 3 /GET MOST SIGNIF.PART OF SUM
	AZE	/IS IT ZERO?
	JMP DK5-3 /NO: SUM IS NOT ALL ZERO
	LDA I 3 /YES:GET LEAST SIG.PART OF SUM
	AZE I	/IS IT ZERO?
	JMP DK5+2/YES:ENTIRE SUM IS ZERO
		 / GO TO POSITIVE SUM
	CLR	/NO
	JMP DG6	/RESET 3 TO LOCATION
		/ OF RESULT (SUM)
	LDA I 3 /MOST SIG. PART OF SUM
DK5,	APO	/WAS SUM POSITIVE?
	JMP DL5	/NO: SKIP 5 INSTRUCTIONS
	LDA 2	/YES:SET BIT CORRESPONDING TO
	BSE	/ MARK IN DJ5+1 IN QUOTIENT
	DJ5+1	/ WORD (POINTED TO BY 2)
	STA 2	/ TO A 1
	XSK I 5 /CHANGE 5 TO INDICATE SUBTRACT
		/ DIVISOR NEXT TIME
DL5,	SET 1	/SET 1 ? 3 TO LOCATION 
	DG6+1	/ OF RESULT (SUM)
	JMP DG6	/	"
	JMP DH7	/ADD PREVIOUS SUM TO ITSELF
	XSK 5	/ARE WE TO ADD OR
		/ SUBTRACT DIVISOR NOW ?
	JMP DH5	/SUBTRACT
	JMP DI5	/ADD
DM5,	XSK I 2 /BUMP 2 BY 3
	XSK I 2 /	"
	XSK I 2 /	"
	SRO I	/HAVE WE BEEN THROUGH HERE
	3333	/ TWICE BEFORE ?
	JMP DJ5+3 /NO: CONTINUE
	JMP DG6	/YES, SET 3 TO LOCATION
		/ OF RESULT
	CLR	/STORE MOST SIGNIF. PART OF
	ADD ARG1 / QUOTIENT IN 2ND WORD
	STA I 3  / OF RESULT
	CLR	 /STORE LEAST SIGNIF. PART OF
	ADD ARG2 / QUOTIENT IN 3RD WORD
	STA I 3 / OF RESULT
	JMP EXIT /TERMINATE
/
/MOVE 1 TO 2 SUBROUTINE
MOVE12,	LDA 1	/MOVE 3 CONSECUTIVE WORDS
	STA 2	/ POINTED TO BY IR.1 ? IR.2
	LDA I 1
	STA I 2
	LDA I 1
	STA I 2
	LDA I 1	/INCREMENT IR.1?2
	LDA I 2	/ A 3RD TIME
	CLR
	JMP 0	/RTN
/
/MQ TO ACCUMULATOR
QAC12,	QAC	/FULL 12-BIT TRANSFER
	ROL 1	/FROM MQ TO AC
	QLZ
	ADD DK7
	JMP 0
/
/COMPLEMENT SETUP
DC6,	LDA I 1 /COMPARE SIGNS OF
	BCO I 2 / MANTISSA AND STORE A
	ROL I 1 / NOP IN DS7 IF THE SIGNS
	LDA I	/ ARE THE SAME, OR A
	NOP	/ JMP COM1 (I.E., COMPLEMENT)
	LZE	/ IF THE SIGNS ARE DIFFERENT
	ADD .+3
	STC DS7
	JMP 0
	JMP COM1-NOP /(USED BY DC6+6)
/
/ENTER HERE TO COMPLEMENT MANTISSA
/ WITH IR.1 SET TO EXPONENT OF DBLFLT NO.
COM1,	SET I 2
	-0
	SKP
/
/ENTER HERE TO TAKE ABSOLUTE VALUE
/ WITH IR.1 SET TO EXPONENT OF NUMBER
ABS1,	SET I 2
	NOP
/COMPLEMENT (IF IR.1 = -0) OR TAKE THE
/ ABSOLUTE VALUE OF THE MANTISSA
DD6,	LDA I 1	/GET MOST SIG.HALF OF MANTISSA
	SCR I 1
	ROL I 1	/SIGN TO LINK
	XSK 2	/SKIP TO COMPLEMENT
	LZE	/SKIP IF POSITIVE FOR ABS1
	COM
	STA 1
	LDA I 1	/GET LEAST SIG.HALF
	XSK 2
	LZE
	COM
	STA 1
	LDA I 1	/INCREMENT IR.1 A 3RD TIME
	CLR
	JMP 0	/RTN
/
/OVERFLOW CHECK
DE6,	ADA 3	/ADD TO EXPONENT
	AZE I
	CLR
	STA 3
	FLO	/TEST OVERFLOW
	JMP 0	/NO OVERFLOW, RETURN
	APO	/WAS IT ACTUALLY OVERFLOW
		/ OR UNDERFLOW ?
	HLT	/OVERFLOW, HALT
/
/RESULT=0
DF6,	JMP DG6	/UNDERFLOW: SET RESULT TO 0.0
	LDA I	/AND EXIT
	-3777
	STA 3
	CLR
	STA I 3
	STA I 3
	JMP DT7
/
/SET IR.3 TO RESULT
DG6,	SET I 3
	0	/BECOMES LOCATION OF RESULT
	JMP 0
/
/SET IR.1 ? 2 IN NORMAL ORDER
/ IR.1 TO EXPONENT OF 1ST ARGUMENT
/ IR.2 TO 2ND ARGUMENT
DH6,	SET I 2
	4\ARG2	
	SET I 1
	ARG1	
	JMP 0
/
/SET IR.1 ? 2 IN REVERSE ORDER
/ IR.1 TO 2ND ARGUMENT
/ IR.2 TO 1ST ARGUMENT
DI6,	SET I 2
	ARG1	
	SET I 1
	ARG2	
	JMP 0
/
/STANDARD SETUP ROUTINE FOR DBLFLT ENTRIES
/ WHICH ARE FOLLOWED BY A 1-3 ITEM LIST
/ OF ARGUMENT LOCATIONS
SETUP,	BCL I	/SET IR.4 TO ADDRESS OF
	6000	/ 1ST ITEM AFTER JMP
	STC 4	/ FROM USER PGM.
	ADD 0	/SAVE RTN JMP FROM SETUP
	STC DE7	/	"
	LDA 4	/PICK UP FIRST ITEM
	JMP DG7	/TEST IT, IS IT NEGATIVE
	JMP DF7	/ONLY 1 ITEM
	STC DC7	/MORE THEN 1, STORE
		/ LOCATION OF 1ST ARG.
	LDA I 4	/PICK UP 2ND ITEM
	JMP DG7	/TEST IT
	JMP DE7+1 /ONLY 2 ITEMS
	STC DD7	/MORE THEN 2, STORE
		/ LOCATION OF 2ND ARG.
	LDA I 4 /PICK UP 3RD ITEM
	JMP DG7	/TEST IT
	NOP	/THERE CAN BE NO MORE THAN 3
	STC DG6+1/ STORE LOCATION OF 3RD ITEM
DB7,	JMP DI6	/SET IR.2 TO ARG1
	SET I 1 /SET IR.1 TO
DC7,	0	/ LOCATION OF 1ST ARG.
	JMP MOVE12/MOVE 1ST ARGUMENT INTO ARG1
	SET I 1 /SET IR.1 TO
DD7,	0	/ LOCATION OF 2ND ARG.
		/(IR.2 ALREADY POINTS TO ARG2)
	JMP MOVE12 /MOVE 2ND ARG.INTO ARG2
	XSK I 4 /CALCULATE THE RETURN
	ADD 4	/  JUMP FROM DBLFLT
	ADD SETUP+1 /	"
	STC DT7	/STORE IT IN DT7
	STC DP7	/PUT 0 IN EXTRA BIT KEEPER
	JMP DG6	/SETUP IR.3 POINTING T0 RESULT
	JMP DH6	/SET UP IR.1 ? 2
DE7,	JMP	/RETURN TO MAIN SUBROUTINES 
	STC DD7	/SET UP ARGUMENTS FOR
	ADD DF7+2 / 2 ITEM LIST
	JMP DB7-1 /	"
DF7,	STC DD7	/SET UP ARGUMENTS FOR
	LDA I	/ 1 ITEM LIST
	FAC	/	"
	STC DC7	/	"
	JMP DE7+2 /	"
/
/TEST A USER PGM ARGUMENT
/  IS THE ARGUMENT NEGATIVE?
/  IS AN INDEX REGISTER USED AS AN ARGUMENT?
DG7,	APO I	/IS ITEM NEGATIVE?
	XSK I 0 /NO: SET .+2 RETURN
	APO	/GET ABSOLUTE VALUE OF ITEM
	COM	/	"
	ADA I	/MAKE ACC. NEGATIVE IF
	-17	/ ITEM IS AN INDEX REGISTER
	SCR I 1	/SET LINK=1 IF ITEM
	ROL I 1 / IS AN INDEX REGISTER
	ADD DG7+3 /ADD 17 TO RESTORE ITEM
	LZE I	/IS ITEM AN INDEX REGISTER?
	JMP 0 /NO,RTN WITH ITEM IN ACCUMULATOR
	STC 1	/YES, PICK UP ARGUMENT
	LDA 1	/ LOCATION INDIRECTLY
	ADD DS7-1 /INDEX INDEX REGISTER BY 3
	STA 1	/	"
	ADA I	/RESTORE ORIGINAL VALUE
	-3	/ OF ITEM IN ACC.
	JMP 0	/AND RETURN
/
/ADD 1 TO 3
/SUBROUTINE TO DO DOUBLE PRECISION ADDITION
/OF MANTISSAS POINTED TO BY IR.1 ? 3
DH7,	SET 4	/SAVE RTN JMP
	0
	CLR
	JMP DG6 /SET IR.3 TO RESULT
	LDA I 1 /PICK UP MOST SIGNIFICANT
		/ PORTION OF 1
	STC DJ7 /SAVE IN OVERFLOW CHECK PGM
	LDA I 3	/PICK UP MOST SIGNIFICANT
		/ PORTION OF 3
	STC DJ7+2 /SAVE IN OVL CHECK ROUTINE
	LDA 1	/ADD MOST SIGNIF. HALVES
	LAM 3	/	"
	LDA I 1	/ADD LEAST SIGNIF.HALVES
	LAM I 3	/	"
	JMP DG6	/RESET IR.3
	STC 0	/CLEAR AC BUT NOT LINK BIT
	LAM I 3 /PROPAGATE CARRY TO MOST
		/ SIGNIF. HALF OF SUM
	STC 0	/CLEAR AC. BUT NOT LINK
	LAM I 3 /PROPAGATE CARRY TO LEAST
		/ SIGNIF. HALF OF SUM
	JMP 4	/RETURN
/
/ENTER HERE IN ORDER NOT TO SKIP PARTS
/OF THE ADD OVERFLOW ROUTINE
	SET I 2
	0
/CHECK FOR ADD OVERFLOW ROUTINE
DI7,	SET 1	/SAVE RTN JMP
	0
	JMP DG6	/SET IR.3
	LDA I	/IF SIGNS OF THE TWO NUMBERS
DJ7,	0	/ ADDED WERE OPPOSITE, NO
	BCO I	/ OVERFLOW WAS POSSIBLE,
	0	/ THEREFORE RETURN
	APO	/	"
	JMP 1	/	"
	LDA I 3 /SIGNS WERE THE SAME, SO
	BCO	/ COMPARE SIGN OF RESULT WITH
	DJ7	/ SIGN OF ONE OF THE ADDENDS
	APO I	/ARE THEY THE SAME?
	JMP 1	/YES, NO OVERFLOW, RETURN
	JMP DG6	/NO,OVERFLOW OCCURRED,SET IR.3
	LDA I
DK7,	1
	JMP DE6	/ADD 1 TO EXPONENT OF RESULT
	LDA I	/LOAD ACCUMULATOR FOR SCALING
DL7,	-1	/	"
	XSK 2	/SET TO -0 IF BYPASS SCALING
	JMP DM7+2 /SCALE RESULT RIGHT 1 PLACE
	ADD DP7	/ADD IN EXTRA BIT KEEPER
	XSK 2  /SET TO -0 IF BYPASS COMPLEMENT
	COM	/COMPLEMENT AND STORE IN
	STC DP7	/ EXTRA BIT KEEPER
	JMP DG6	/CHANGE SIGN OF OVERFLOW SUM
	LDA I 3 /	"
	BCO I	/	"
	4000	/	"
	STA 3	/	"
	JMP 1	/RETURN
/
/SCR N
/SUBROUTINE TO SCALE RESULT RIGHT A NUMBER
/OF PLACES GIVEN BY NEGATIVE NUMBER EITHER
/IN ACCUMULATOR OR IN DM7+1,DEPENDING ON ENTRY
DM7,	LDA I	/LOAD N
	0
	SET 2	/ENTER HERE WITH N IN AC
	0
	AZE I	/IF NUMBER IS ZERO,
	JMP 2	/ RETURN
	STC 5	/OTHERWISE, SET UP COUNTER
	SET I 4 /SET COUNTER FOR MAXIMUM
	-30	/ ALLOWABLE SHIFTS
DO7,	CLR	/SCALE RESULT RIGHT 1 PLACE,
	JMP DG6	/ KEEPING BIT SCALED OFF
	LDA I 3 / RIGHT END IN LINK BIT
	SCR I 1 /	"
	STA 3	/	"
	LDA I 3 /	"
	ROR I 1 /	"
	STA 3	/	"
	XSK I 4 /MAXIMUM NUMBER ?
	JMP .+2 /NO
	JMP .+3 /YES, TERMINATE
	XSK I 5 /NUMBER REQUIRED ?
	JMP DO7	/NO, SCALE ANOTHER
	JMP DG6	/YES, TERMINATE
	LDA I 3 /SAVE ABSOLUTE VALUE OF
	ROL I 1 / LAST BIT SCALED OFF IN
	LZE	/ BIT 0 OF LOCATION DP7
	COM	/	"
	STC DP7	/	"
	JMP 2	/RETURN
DP7,	0	/EXTRA BIT KEEPER
/
/NORMALIZE, ROUND, AND EXIT FROM DBLFLT
EXIT,	CLR
	STC 1	/PUT 0 INTO COUNTER
	ADD DP7	/PUT EXTRA BIT INTO LINK BIT
	ROR I 1 /	"
	JMP DG6
	LDA I 3
	SAE I 3 /ARE BOTH HALVES OF MANTISSA
		/ OF RESULT THE SAME ?
	JMP .+5 /NO
	AZE	/YES, ARE THEY 0 ?
	JMP .+3 /NO
	LZE I	/YES, 0 IN EXTRA BIT
	JMP DF6	/YES, SET RESULT TO 0
	JMP DG6	/NO
	LDA I 3	/GET MOST SIG.HALF OF MANTISSA
		/ OF RESULT (WHICH IS NOT AN 
		/ ABSOLUTE VALUE)
	APO	/IS IT POSITIVE? IF NOT,
		/ IT MUST BE SCALED RIGHT.
	JMP DU7	/NO, SCALE RIGHT 1 ? GO TO DR7
	ROL 1	/YES, TEST TO SEE IF NEXT BIT
		/ IS A 1 (I.E., IS THE NUMBER
	APO I	/ ALREADY NORMALIZED?)
	JMP DT7+1 /NO, ROTATE RESULT LEFT 1
		 / ? RETURN TO DR7-3
DR7,	JMP DG6	/YES, NUMBER IS NORMALIZED
	LDA I 3 /SAVE 23RD BIT IN LINK BIT
	LDA I 3 /	"
	ROR I 1 /	"
	STC 0	/CLEAR AC BUT NOT LINK
	LAM 3	/ADD 23RD BIT TO ITSELF
		/ I.E., ROUND ON IT
	JMP DG6
	STC 0
	LAM I 3 /PROPAGATE ANY CARRY
	APO	/DID IT CARRY INTO SIGN
	JMP DV7	/YES, SCALE RIGHT ONE
	JMP DG6	/ADJUST EXPONENT
	CLR	/ ACCORDING TO SHIFTS
	ADD 1	/	"
	COM	/	"
	JMP DE6	/	"
	SET 1
	3
DS7,	NOP	/BECOMES NOP OR JMP COM1
	CLR
DT7,	JMP	/EXIT FROM DBLFLT 
	LDA I 3 /ROTATE RESULT LEFT 1 PLACE
	ROL I 1 /	"
	STA 3	/	"
	JMP DG6	/	"
	LDA I 3	/	"
	ROL I 1	/	"
	STA 3	/	"
	XSK I 1 /ADD 1 TO COUNTER TO
		/ INDICATE LEFT SHIFT
	JMP DR7-3
DU7,	JMP DV7	/SCALE RIGHT 1
	JMP DR7	/ AND RETURN TO DR7
DV7,	CLR	/SAVE RETURN JMP
	ADD 0	/	"
	STC DW7	/	"
	ADD DL7	/SCALE RESULT RIGHT 1
	JMP DM7+2 /	"
	ADD DL7	/SUBTRACT ONE FROM COUNTER
	ADD 1	/ TO INDICATE RIGHT SHIFT
	STC 1	/	"
	LDA 3	/SET SIGN POSITIVE
	BCL I	/	"
	4000	/	"
	STA 3	/	"
DW7,	0	/RETURN 
/
/TRANSFER ENTRY POINT
TRANS,	CLR 
	ADD 0	/GET RTN JMP
	JMP SETUP/ RETURNS WITH NUMBER IN ARG1
	SET 2
	DD7	/WHERE NUMBER IS TO GO
	JMP MOVE12 /MOVE NUMBER
	JMP DT7-1 /EXIT
/
/FLOAT ENTRY POINT
FLOAT,	CLR
	ADD 0	/GET RTN JMP
	JMP SETUP
	ADD DD7	/SET 2ND ARGUMENT AS RESULT
	STC DG6+1 /	"
	JMP DG6	/SET IR.3 TO RESULT
	LDA I	/SET UP DUMMY EXPONENT
	27	/	"
	STA 3	/	"
	JMP ADDT+35 /EXIT THROUGH LATTER PART
		    / OF ADD SUBROUTINE
/
/FIX SUBROUTINE ENTRY POINT
FIX,	CLR
	ADD 0	/GET RTN JMP
	JMP SETUP
	ADD DD7	/SET 2ND ARGUMENT AS RESULT
	STC DG6+1 /	"
	JMP DG6
	LDA I	/SUBTRACT 27 (=23 DECIMAL)
	-27	/ FROM EXPONENT
	JMP DE6	/	"
	APO I	/IS RESULT POSITIVE?
	JMP DT7	/YES,NUMBER CANNOT BE FIXED.
	 /EXIT WITH AC = NO.OF PLACES TOO MANY
	JMP DM7+2 /NO, SCALE RESULT RIGHT
	JMP DT7-1 /AND EXIT
/
/STORAGE LOCATIONS USED BY DBLFLT1:
/DBLFLT NUMBER REFERENCED BY THE FIRST
/ ARGUMENT IS STORED HERE BY THE SETUP ROUTINE
ARG1,	0
	0
	0
/NUMBER REFERENCED BY 2ND ARGUMENT STORED HERE
ARG2,	0
	0
	0
/FLOATING POINT ACCUMULATOR (FAC)
FAC,	0
	0
	0
/
	/END DBLFLT1
/
/