.TITLE .DE    COMPUTE LOG BASE 2 FOR DOUBLE ARGUMENT
/ 
/ 
/                   FIRST PRINTING, FEBRUARY 1974
/ 
/ THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO 
/ CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
/ AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
/ DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPON-
/ SIBILITY FOR ANY ERRORS THAT MAY APPEAR IN THIS
/ DOCUMENT.
/ 
/ THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FUR-
/ NISHED TO THE PURCHASER UNDER A LICENSE FOR USE ON
/ A SINGLE COMPUTER SYSTEM AND CAN BE COPIED (WITH
/ INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR 
/ USE IN SUCH SYSTEM, EXCEPT AS MAY OTHERWISE BE PRO-
/ VIDED IN WRITING BY DIGITAL.
/ 
/ DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/ FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIP-
/ MENT THAT IS NOT SUPPLIED BY DIGITAL.
/ 
/ COPYRIGHT (C) 1974, BY DIGITAL EQUIPMENT CORPORATION
/ 
/ 
        .EJECT
/COPYRIGHT 1970,1971, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. 01754
/EDIT 3  2-26-71
/FOR HARDWARE FLOATING POINT PROCESSOR (FPP), DEFINE %FPP,
       .GLOBL .DE,.DC,.AW,.ER
	.IFUND %FPP
	.GLOBL .AA,.AB,.AQ,
	.GLOBL .AP,.AR,.AT
	.ENDC
	.IFUND %FPP
	.DEFIN DAD%,A		/DOUBLE ADD (.AQ)
	JMS* A
	.ENDM
	.ENDC
	.IFDEF %FPP
DAD=716140
	.DEFIN DAD%
	DAD
	.ENDM
	.ENDC
	.IFUND %FPP
	.DEFIN DDV%,A		/DOUBLE DIVIDE (.AT)
	JMS* A
	.ENDM
	.ENDC
	.IFDEF %FPP
DDV=712140
	.DEFIN DDV%
	DDV
	.ENDM
	.ENDC
	.IFUND %FPP
	.DEFIN UNDST%,A		/UNNORMALIZED
	JMS* A			/DOUBLE STORE (.AP)
	.ENDM
	.ENDC
	.IFDEF %FPP
UNDST=713770
	.DEFIN UNDST%
	UNDST
	.ENDM
	.ENDC
	.IFUND %FPP
	.DEFIN DSB%,A		/DOUBLE SUBTRACT (.AR)
	JMS* A
	.ENDM
	.ENDC
	.IFDEF %FPP
DSB=710540
	.DEFIN DSB%
	DSB
	.ENDM
	.ENDC
	.IFUND %FPP
	.DEFIN GETHOM
	LAC* .AB
	.ENDM
	.ENDC
	.IFDEF %FPP
	.GLOBL .ZA
	.DEFIN GETHOM
	JMS* .ZA
	.ENDM
	.ENDC
/             CALLING SEQUENCE
/      JMS*   (.DE)           SUBR CALL (ARG IN FLOATING ACC)
/      NEXT   INSTRUCTION    SUBR RETURN (RESULT IN FLOATING ACC)
/FPP INSTR. ASS.
	.IFDEF %FPP
UNDST=713770		/UNN. DOUBLE STORE
DLD=713150		/DOUBLE LOAD
FDV=712040		/FLOATING DIV.
	.ENDC
/
.DE    CAL    0              /ENTRY-EXIT
       GETHOM   .AB            /GET SIGN WORD
       SNA!SPA               /IF .LE. ZERO
       JMP    DE01           / ERROR
       LAW    -1             /GET EXP - 1
	.IFDEF %FPP
	UNDST
	DE10
	TAD DE10	/TMP. .AA
	DAC DE02
	LAC DE06
	DAC DE10
	DAC DE04
	DLD
	DE10
	.ENDC
	.IFUND %FPP
       TAD*   .AA
       DAC    DE02           /STORE FOR INTEGER DETERMINATION
       LAC    DE06           /(1)
       DAC*   .AA            /SET ARG EXP = 1 (1 .LE. F .LT. 2)
       DAC    DE04           /SET EXP OF SQRT(2) TO 1
	.ENDC
       DAD%   .AQ            /ADD DOUBLE
       .DSA   DE04           / (F + SQRT(2)
       ISZ    DE04           /BUMP EXP FOR 2 + SQRT(2)
       UNDST%   .AP            /STORE DOUBLE
       .DSA   DE05           / (F+SQRT(2))
       DSB%   .AR            /SUBTRACT DOUBLE
       .DSA   DE04           / (F+SQRT(2)-2*SQRT(2)=F-SQRT(2))
       DDV%   .AT            /DIVIDE DOUBLE
       .DSA   DE05           / (F-SQRT(2) / F+SQRT(2))
       JMS*   .DC            /POLYNOMIAL EVALUATE ABOVE
       .DSA   DE07           /ADDR OF CALLING SEQUENCE
       UNDST%   .AP            /STORE DOUBLE
       .DSA   DE05           / (RESULT TO TEMP)
       LAC    DE02           /GET INTEGER
       STL                   /ADD 0.5
       RAL                   / (INTEGER * 2)
       JMS*   .AW            /FLOAT
	.IFDEF %FPP
	FDV		/DIV BY 2
	DE11
	.ENDC
	.IFUND %FPP
       LAW    -1             /EXP = EXP -1 (INTEGER/2)
       TAD*   .AA
       DAC*   .AA
	.ENDC
       DAD%   .AQ            /ADD DOUBLE
       .DSA   DE05           / (RESULT+(INTEGER + 0.5)
       JMP*   .DE            /EXIT
DE01   JMS*   .ER            /ERROR ROUTINE
       CAL    14             /ERROR NO.
DE02   CAL    0              /INTEGER STORAGE
DE06          1           /CONSTANT 1                                LA
DE05   CAL    0              /TEMP STORAGE (1)
       CAL    0              /             (2)
       CAL    0              /             (3)
DE07          777775         /NO OF COEFF (4)
       777777; 336256; 455134	/0.4342597513D0
       000000; 223466; 040146	/0.5765843421D0
       000000; 366161; 114432	/0.9618007623D0
       000002; 270524; 354400	/2.885390073D0
DE04          1              / (X * SQRT(2)) (1) / (X = 1 OR 2
              265011         /               (2) / AND SET BY
              714640         /               (3) / PROGRAM)
	.IFDEF %FPP
DE10	0		/TMP FOR FPP AC
	0
	0
DE11	000002		/FP 2
	200000
	.ENDC
       .END