       .TITLE DOUBLE PRECISION FLOATING POINT ARITHMETIC PACKAGE
/COPYRIGHT 1970, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
/EDIT 4  10-14-70
       .GLOBL .CB,.AA,.AB,.AC,.CF,.CC,.CH,.BA,.CA,.CI
       .GLOBL .AO,.AP,.AR,.AS,.AV,.AT,.AQ,.AU,
	.GLOBL DOUBLE
DOUBLE=.
	.IFDEF TIME%
	.GLOBL TIMON,TIMOFF
	.ENDC
/CONDITIONAL CODE...WAD...JULY69
/GLOBLS FOR HELD AC
	.GLOBL CE01,CE02,CE03
/
/	    CONTENTS
/
/	    .AO	         LOAD DOUBLE
/	    .AP	         STORE DOUBLE
/	    .AQ	         ADD DOUBLE
/	    .AR	         SUBTRACT DOUBLE
/	    .AS	         MULTIPLY DOUBLE
/	    .AT	         DIVIDE DOUBLE
/	    .AU	         REVERSE SUBTRACT DOUBLE
/	    .AV	         REVERSE DIVIDE DOUBLE
       .EJECT
/		     LOAD DOUBLE (.AO)
/	    CALLING SEQUENCE
/      JMS*   (.AO) 	SUBR CALL
/      CAL/XCT ADDR 	ADDR OF DOUBLE ARG (XCT IF INDIRECT)
/      NEXT   INSTRUCTION	SUBR RETURN (ARG IN FLOATING ACC)
/
.AO    CAL    0	         /ENTRY-EXIT
	.IFDEF TIME%	/WAD...JULY69
	JMS* TIMON
	.DSA 6
	.ENDC
	LAC* .AO		/IN LINE .CB
	ISZ .AO
	DAC AO01
	SPA
	LAC* AO01
	DAC AO01		/WAD...JULY69
       LAC*   AO01	         /GET EXP
       DAC*   .AA
       ISZ    AO01
       LAC*   AO01	         /GET M.S.
       DAC*   .AB
       ISZ    AO01
       LAC*   AO01	         /GET L.S.
       DAC*   .AC
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 6
	.ENDC
       JMP*   .AO	         /EXIT
AO01	CAL	0	/ (ARG ADDR)-
       .EJECT
/		    STORE DOUBLE (.AP)
/	    CALLING SEQUENCE
/      JMS*   (.AP) 	SUBR CALL (VALUE IN FLOATING ACC)
/      CAL/XCT ADDR 	ADDR OF ARG (XCT IF INDIRECT)
/      NEXT   INSTRUCTION	SUBR RETURN (VALUE IN ARG AND FLOAT ACC)
/
.AP    CAL    0	         /ENTRY-EXIT
	.IFDEF TIME%	/WAD...JULY69
	JMS* TIMON
	.DSA 7
	.ENDC
	LAC* .AP		/IN LINE .CB
	ISZ .AP
	DAC AP01
	SPA
	LAC* AP01
	DAC AP01		/WAD...JULY69
       LAC*   .AA	         /STORE EXP
       DAC*   AP01
       ISZ    AP01
       LAC*   .AB	         /STORE M.S.
       DAC*   AP01
       ISZ    AP01
       LAC*   .AC	         /STORE L.S.
       DAC*   AP01
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 7
	.ENDC
       JMP*   .AP	         /EXIT
AP01	0		/ ARG ADDR
       .EJECT
/		    SUBTRACT DOUBLE (.AR)
/	    CALLING SEQUENCE
/      JMS*   (.AR) 	SUBR CALL (MINUEND IN FLOATING ACC)
/      CAL/XCT ADDR 	ADDR OF SUBTRAHEND (XCT IF INDIRECT)
/      NEXT   INSTRUCTION	SUBR RETURN (DIFFERENCE IN FLOATING ACC)
/
.AR    CAL    0	         /ENTRY-EXIT
       JMS*   .CB	         /SHORT GET ARG
AR01   CAL    0	         / (ARG ADDR)
	.IFDEF TIME%
	JMS* TIMON
	.DSA 10
	.ENDC
       JMS*   .BA	         /NEGATE MINUEND
       JMS    .AQ	         /ADD DOUBLE
       .DSA   AR01+400000    / (-MINUEND + SUBRAHEND)
       JMS*   .BA	         /NEGATE RESULT (MINUEND - SUBTRAHEND)
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 10
	.ENDC
       JMP*   .AR	         /EXIT
       .EJECT
/		    MULTIPLY DOUBLE (.AS)
/	    CALLING SEQUENCE
/      JMS*   (.AS) 	SUBR CALL (MULTIPLICAND IN FLOATING ACC)
/      CAL/XCT ADDR 	ADDR OF MULTIPLIER (XCT IF INDIRECT)
/      NEXT   INSTRUCTION	SUBR RETURN (PRODUCT IN FLOATING ACCT)
/
.AS    CAL    0	         /ENTRY-EXIT
	.IFDEF TIME%	/WAD...JULY69
	JMS* TIMON
	.DSA 11
	.ENDC
	LAC* .AS
	DAC AS01
	SPA
	LAC* AS01	/ONE MORE LEVEL
	DAC AS01	/IF INDIRECT
	ISZ .AS		/BUMP EXIT
	LAC* AS01	/MULTIPLIER INTO
	DAC* CE01	/HELD AC
	ISZ AS01
	LAC* AS01
	DAC* CE02
	ISZ AS01
	LAC* AS01
	DAC* CE03
       JMS*   .CA	         /GENERAL FLOATING MULTIPLY
       JMS*   .CH	         /ROUND AND SIGN
	    1	         / L.S. BIT
	    777776         / MASK
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 11
	.ENDC
       JMP*   .AS	         /EXIT
AS01	CAL	0	/ (ARG ADDR)
       .EJECT
/		    REVERSE DIVIDE DOUBLE (.AV)
/	    CALLING SEQUENCE
/      JMS*   (.AV) 	SUBR CALL (DIVISOR IN FLOATING ACC)
/      CAL/XCT ADDR 	ADDR OF DIVIDEND (XCT IF INDIRECT)
/      NEXT   INSTRUCTION	SUBR RETURN (QUOTIENT IN FLOATING ACC)
/
.AV    CAL    0	         /ENTRY-EXIT
       JMS*   .CB	         /SHORT GET ARG
AV01   CAL    0	         / (ARG ADDR)
	.IFDEF TIME%
	JMS* TIMON
	.DSA 12
	.ENDC
       JMS    .AP	         /STORE DOUBLE
       .DSA   AV02	         / (TEMP)
       JMS    .AO	         /LOAD DOUBLE
       .DSA   AV01+400000    / (DIVIDEND)
       JMS    .AT	         /DIVIDE DOUBLE
       .DSA   AV02	         / (ADD9 6F DIVISOR=TEMP)
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 12
	.ENDC
       JMP*   .AV	         /EXIT
AV02   CAL    0	         /TEMP (1)
       CAL    0	         /     (2)
       CAL    0	         /     (3)
       .EJECT
/		    DIVIDE DOUBLE (.AT)
/	    CALLING SEQUENCE
/      JMS*   (.AT) 	SUBR CALL (DIVIDEND IN FLOATING ACC)
/      CAL/XCT ADDR 	ADDR OF DIVISOR
/      NEXT   INSTRUCTION	SUBR RETURN (QUOTIENT IN FLOATING ACC)
/
.AT    CAL    0	         /ENTRY-EXIT
       JMS*   .CB	         /SHORT GET ARG
AT01   CAL    0	         / (ARG ADDR)
	.IFDEF TIME%
	JMS* TIMON
	.DSA 13
	.ENDC
       JMS*   .CF	         /HOLD ACC
       JMS    .AO	         /LOAD DOUBLE
       .DSA   AT01+400000    / (DIVISOR)
       JMS*   .CI	         /GENERAL FLOATING DIVIDE
	    -44	         /(-36) 36 BIT QUOTIENT
	    1	         /L.S. QUOTIENT BIT
       JMS*   .CH	         /ROUND AND SIGN
	    1	         /L.S. BIT
	    777776         / MASK
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 13
	.ENDC
       JMP*   .AT	         /EXIT
       .EJECT
/		     REVERSE SUBTRACT DOUBLE (.AU)
/	    CALLING SEQUENCE
/      JMS*   (.AU) 	SUBR CALL (SUBRRAHEND IN FLOATING ACC)
/      CAL/XCT ADDR 	ADDR OF MINUEND (XCT IF INDIRECT)
/      NEXT   INSTRUCTION	SUBR RETURN (DIFFERENCE IN FLOATING ACC)
/
.AU    CAL    0	         /ENTRY-EXIT
       JMS*   .CB	         /SHORT GET ARG
AU01   CAL    0	         / (ARG ADDR)
	.IFDEF TIME%
	JMS* TIMON
	.DSA 14
	.ENDC
       JMS*   .BA	         /NEGATE SUBTRAHEND
       JMS    .AQ	         /ADD DOUBLE
       .DSA   AU01+400000    / (MINUEND - SUBTRAHEND)
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 14
	.ENDC
       JMP*   .AU	         /EXIT
       .EJECT
/		     ADD DOUBLE (.AQ)
/	    CALLING SEQUENCE
/      JMS*   (.AQ) 	SUBR CALL (AUGEND IN FLOATING ACC)
/      CAL/XCT ADDR 	ADDR OF ADDEND (XCT IF INDIRECT)
/      NEXT   INSTRUCTION	SUBR RETURN (SUM IN FLOATING ACC)
/
.AQ    CAL    0	         /ENTRY-EXIT
	.IFDEF TIME%	/WAD...JULY69
	JMS* TIMON
	.DSA 15
	.ENDC
	LAC* .AQ		/ADDEND TO HELD AC
	DAC AQ01
	SPA
	LAC* AQ01	/ONE MORE LEVEL
	DAC AQ01		/IF INDIRECT
	ISZ .AQ		/BUMP EXIT
	LAC* AQ01	/ADDEND TO HELD AC
	DAC* CE01		/STORE EXP
	ISZ AQ01
	LAC* AQ01	/STORE HIGH AND LOW ORDER
	DAC* CE02		/MANTISSA
	ISZ AQ01
	LAC* AQ01
	DAC* CE03		/WAD...JULY69
       JMS*   .CC	         /GENERAL FLOATING ADD
	    42	         / 34 MAX SHIFT
       JMS*   .CH	         /ROUND AND SIGN
	    1	         / L.S. BIT
	    777776         / MASK
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 15
	.ENDC
       JMP*   .AQ	         /EXIT
AQ01	CAL 0		/(ARG ADDR)
       .END
