Trailing-Edge
-
PDP-10 Archives
-
BB-4157D-BM
-
sources/fordbl.mac
There are 3 other files named fordbl.mac in the archive. Click here to see a list.
TITLE DABS %4.(235) DOUBLE PRECISION ABSOLUTE VALUE
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY DABS
EXTERN DABS.
DABS=DABS.
PRGEND
TITLE DABS. %4.(235) DOUBLE PRECISION ABSOLUTE VALUE
SUBTTL D. TODD /KK/DMN/DRT/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;DOUBLE PRECISION ABSOLUTE VALUE FUNCTION
;THIS ROUTINE RETURNS THE ABSOLUTE VALUE OF A DOUBLE PRECISION
;ARGUMENT
;THE CALLING SEQUENCE FOR THE ROUTINE IS
; JSA Q, DABS
; EXP ARG
;WHERE ARG IS THE ADDRESS OF THE HIGH ORDER PART OF A DOUBLE
;PRECISION ARGUMENT, THE LOW ORDER PART BEING IN ARG+1. THE
;DOUBLE PRECISION ANSWER IS RETURNED IN ACCUMULATORS A AND B.
SEARCH FORPRM
A= 0
B= 1
Q= 16
P= 17
HELLO (DABS,.) ;[235] ENTRY TO DABS ROUTINE
DMOVE A,@(Q) ;GET ARGUMENT
SKIPGE A ;IS ARGUMENT POSITIVE?
DFN A, B ;NO, NEGATE IT
GOODBY (1) ;EXIT
PRGEND
TITLE DMOD %4.(235) DOUBLE PRECISION MOD FUNCTION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY DMOD
EXTERN DMOD.
DMOD=DMOD.
PRGEND
TITLE DMOD. %4.(235) DOUBLE PRECISION MOD FUNCTION
SUBTTL D. TODD /DRT/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;THIS ROUTINE CALCULATES
; MOD(A,B) = A-[A/B]*B
;FOR DOUBLE PRECISION ARGUMENTS A AND B, WHERE [A/B] IS THE
;GREATEST INTEGER IN THE MAGNITUDE OF A/B.
;THE CALLING SEQUENCE FOR THE ROUTINE IS AS FOLLOWS:
; JSA Q, DMOD
; EXP ARG1
; EXP ARG2
;ARG1 AND ARG2 ARE THE ADDRESSES OF THE HIGH ORDER PORTIONS OF
;THE DOUBLE PRECISION ARGUMENTS. THE DOUBLE PRECISION ANSWER IS
;RETURNED IN ACCUMULATORS A AND B.
SEARCH FORPRM
P=17 ;PUSH DOWN POINTER
Q=16 ;JSA-JRA ACCUMULATOR
HELLO (DMOD,.) ;[235] ENTRY TO DMOD ROUTINE.
DMOVE 0,@1(Q) ;GET ARG B
SKIPGE 0 ;GET
DFN 0,1 ;/ARG B/.
DMOVEM 0,ARGB ;SAVE ARG B IN ARGB.
DMOVE 0,@(Q) ;GET ARG A
SKIPGE 0 ;GET
DFN 0,1 ;/ARG A/.
DMOVEM 0,ARGA ;SAVE ARG A IN ARGA.
MOVEM 2,SAV2 ;SAVE AC 2.
IFE CPU-KA10,<FDVL 0,ARGB ;DIVIDE A BY B
JFCL OVUNFL ;IF
MOVN 2,0 ;OVER
FMPR 2,ARGB+1 ;OR
JFCL ;UNDER
UFA 1,2 ;FLOW
FDVR 2,ARGB ;OCCURS,
JFCL ;GO
FADL 0,2 ;TO
JFCL OVUNFL > ;OVUNFL.
IFE CPU-KI10,<DFDV 0,ARGB
JFCL OVUNFL >
DMOVEM 0,SAVNUM ;SAVE NUMBER
LDB 2,[POINT 8,0,8] ;GET EXPONENT
TRC 2,777777 ;GET 1'S COMPLEMENT OF EXPONENT
MOVSI 0,777000 ;INITIALIZE MASK
MOVEI 1,0 ;IN 0 AND 1.
CAIL 2,777577 ;IS THE NUMBER ALL FRACTION BITS?
TDZA 0,0 ;YES, A FRACTION WILL TRUNCATE TO 0
ASHC 0,201(2) ;CREATE MASK(SHIFT TO RIGHT ONLY)
;REMEMBER- EXPONENT IS 1'S COMP NEGATIVE
IFE CPU-KA10,<ASH 1,-8 > ;PROTECT LOW ORDER EXPONENT
AND 0,SAVNUM ;MASK HI WORD
AND 1,SAVNUM+1 ;AND LOW WORD
IFE CPU-KA10,<FADL 0,1 > ;AND STRAIGHTEN 0'S OUT.
FLMUL 0,ARGB ;CALCULATE [A/B]*B.
DFN 0,1 ;GET -[A/B]*B
FLADD 0,ARGA ;CALC. A-[A/B]*B.
MOVE 2,SAV2 ;RESTORE AC 2.
SKIPGE @(Q) ;GIVE THE ANSWER
DFN 0,1 ;THE CORRECT SIGN.
GOODBY (2) ;EXIT.
OVUNFL: MOVE 2,SAV2 ;RESTORE AC 2.
JUMPE 0,ANSISA ;IF UNDERFLOW, GO TO ANSISA.
ERROR (APR,5,1,.+1) ;OVERFLOW. RETURN AN
SETZB 0,1 ;AN ANSWER OF ZERO AND
GOODBY (2) ;EXIT.
ANSISA: DMOVE 0,@(Q) ;UNDERFLOW. ANS = A
GOODBY (2)
ARGA: BLOCK 2
ARGB: BLOCK 2
SAVNUM: BLOCK 2
SAV2: BLOCK 1
PRGEND
TITLE DMAX1 %4.(235) DOUBLE PRECISION MAXIMUM OF A SERIES OF ARGUMENTS
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY DMAX1
EXTERN DMAX1.
DMAX1=DMAX1.
PRGEND
TITLE DMAX1. %4.(235) DOUBLE PRECISION MAXIMUM OF A SERIES OF ARGUMENTS
SUBTTL D. TODD /DRT/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;THIS ROUTINE IS CALLED IN THE FOLLOWING MANNER
; JSA Q, DMAX1
; EXP ARG1
; EXP ARG2
; .
; .
; .
;WHERE ARG1,ARG2,...ARE THE ADDRESSES OF THE HIGH ORDER
;PORTIONS OF DOUBLE PRECISION ARGUMENTS. THE MAXIMUM OF THE
;ENTIRE SET IS RETURNED AS A DOUBLE PRECISION NUMBER IN
;ACCUMULATOR A AND B.
SEARCH FORPRM
A= 0
B= 1
C= 14
Q= 16
HELLO (DMAX1,.) ;[235] ENTRY TO DMAX1 ROUTINE
PUSH P,C ;SAVE AC C
IFN F40LIB,<
PUSH P,L ;SAVE THE LINK FOR F40
TLZN L,-1 ;F40 CALL
>
HLL L,-1(L) ;GET THE F10 ARG COUNT
DMOVE A,@(Q) ;GET FIRST ARGUMENT
JRST DMAX.2 ;ADDRESS OF NEXT, START CHECKING
DMAX.1: MOVEI C,@0(Q) ;GET ADDRESS OF NEXT ARGUMENT
CAMLE A,(C) ;IS HIGH ORDER > THAN THIS ONE?
JRST DMAX.2 ;YES, GET ADDRESS OF NEXT IN LIST
CAME A,(C) ;ARE HIGH ORDER WORDS EQUAL?
JRST DMAX.3 ;NO, REPLACEMENT NECESSARY
IFN CPU-KI10,<CAML B, 1(C) ;YES, CHECK LOW ORDER WORDS
JRST DMAX.2 > ;OK, GET ADDRESS OF NEXT ONE
IFE CPU-KI10,<CAMGE B,1(C) > ;SKIP IF PRESENT ARG IS LARGER
DMAX.3: DMOVE A,(C) ;PICK UP NEW ARG
DMAX.2: AOBJN L,DMAX.1 ;END OF ARG LIST
IFN F40LIB,<
TLNN L,-1 ;F40 CALL
JRST DMAX.4 ;NO, F10 CALL EXIT
MOVE C,(L) ;GET THE NEXT ARGUMENT
TLC C,(<JUMP>) ;COMPLEMENT OP-CODE "JUMP" BITS
TLNN C,777000 ;IS THE ARG "JUMP" ?
JRST DMAX.1 ;YES,INCREMENT AND CHECK FURTHER
DMAX.4:
POP P,L ;RESTORE LINK
>
POP P,C ;NO, RESTORE C
GOODBY (2)
PRGEND
TITLE DMIN1 %4.(235) DOUBLE PRECISION MINIMUM OF A SERIES OF ARGUMENTS
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY DMIN1
EXTERN DMIN1.
DMIN1=DMIN1.
PRGEND
TITLE DMIN1. %4.(235) DOUBLE PRECISION MINIMUM OF A SERIES OF ARGUMENTS
SUBTTL D. TODD /DRT/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;THIS ROUTINE IS CALLED IN THE FOLLOWING MANNER:
; JSA Q, DMIN1
; EXP ARG1
; EXP ARG2
; .
; .
; .
;WHERE ARG1,ARG2,... ARE THE ADDRESSES OF THE HIGH ORDER
;PORTIONS OF DOUBLE PRECISION ARGUMENTS. THE MINIMUM OF
;THE ENTIRE SET IS RETURNED AS A DOUBLE PRECISION NUMBER
;IN ACCUMULATOR A AND B
SEARCH FORPRM
LIBSEG ;GET THE SEGMENT CONTROL
A= 0
B= 1
C= 14
Q= 16
HELLO (DMIN1,.) ;[235] ENTRY TO DMIN1 ROUTINE
PUSH P,C ;SAVE AC C
IFN F40LIB,<
PUSH P,L ;SAVE THE LINK
TLZN L,-1 ;F40 CALL
>
HLL L,-1(L) ;NO F10 GET THE ARG COUNT
DMOVE A,@(Q) ;GET FIRST ARGUMENT
JRST DMIN.2 ;ADDRESS OF NEXT,START CHECKING
DMIN.1: MOVEI C,@0(Q) ;GET ADDRESS OF NEXT ARG
CAMGE A, (C) ;IS HIGH ORDER LESS THAN NEXT ARG?
JRST DMIN.2 ;YES, GET ADDRESS OF NEXT
CAME A, (C) ;NO, ARE HIGH ORDER WORDS EQUAL?
JRST DMIN.3 ;NO, REPLACEMENT IS NECESSARY
IFN CPU-KI10,<CAMG B, 1(C) ;YES, CHECK LOW ORDER WORDS
JRST DMIN.2 > ;PRESENT ARGUMENT IS SMALLER
IFE CPU-KI10,<CAMLE B,1(C) > ;SKIP IF PRESENT ARG IS SMALLER
DMIN.3: DMOVE A,(C) ;PICK UP NEW ARG
DMIN.2: AOBJN L,DMIN.1 ;CONTINUE THRU THE LIST
IFN F40LIB,<
TLNN L,-1 ;F40 CALL
JRST DMIN.4 ;NO, F10 CALL EXIT
MOVE C,(L) ;GET THE NEXT ARGUMENT
TLC C,(<JUMP>) ;COMPLEMENT OP CODE "JUMP" BITS
TLNN C,777000 ;IS THE ARG "JUMP"?
JRST DMIN.1 ;YES , INCREMENT AND CHECK FURTHER
DMIN.4:
POP P,L ;RESTORE THE LINK
>
POP P,C ;NO, RESTORE AC C AND EXIT
GOODBY (2)
PRGEND
TITLE DSIGN %4.(235) DOUBLE PRECISION SIGN ROUTINE
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY DSIGN
EXTERN DSIGN.
DSIGN=DSIGN.
PRGEND
TITLE DSIGN. %4.(235) DOUBLE PRECISION SIGN ROUTINE
SUBTTL D. TODD /DRT/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM V.006.
;DOUBLE PRECISION TRANSFER OF SIGN
;THIS ROUTINE RETURNS ABSF(ARG1)*SIGN(ARG2)
;THE ROUTINE MAKES USE OF THE FOLLOWING TABLE:
;ARG1 ARG2 RESULT CHANGE OF SIGN?
;+ + + NO
;+ - - YES
;- + + YES
;- - - NO
;THE CALLING SEQUENCE FOR THIS ROUTINE IS AS FOLLOWS
; JSA Q,DSIGN
; EXP ARG1
; EXP ARG2
;ARG1 AND ARG2 ARE THE ADDRESSES OF THE HIGH ORDER WORDS OF
;THE DOUBLE PRECISION ARGUMENTS, THE DOUBLE PRECISION
;ANSWER IS RETURNED IN ACCUMULATORS A AND B.
SEARCH FORPRM
A=0
B=1
Q=16
HELLO (DSIGN,.) ;[235] ENTRY TO DSIGN ROUTINE
DMOVE A,@(Q) ;GET FIRST ARGUMENT
SKIPGE @1(Q) ;THEN
JUMPL A,OUT ;CHOOSE
SKIPL @1(Q) ;THE
JUMPGE A,OUT ;CORRECT
DFN A,B ;SIGN.
OUT: GOODBY (2) ;EXIT
PRGEND
TITLE DEXP.3 %5A(643) PDP-10/10I DOUBLE PRECISION EXP.3 FUNCTION
SUBTTL D. TODD /DRT/SWG 24-FEB-1977
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;THIS PROGRAM CALCULATES A**B, WHERE A AND B ARE DOUBLE
;PRECISION FLOATING POINT NUMBERS. THE ALGORITHM USED IS
;A**B = DEXP(B*DLOG(/A/)). THE ABSOLUTE VALUE OF A IS USED
;IN THIS CALCULATION BECAUSE A NEGATIVE NUMBER TO A
;NON-INTEGER POWER PRODUCES A COMPLEX ANSWER, AND B IS
;PRESUMED TO BE NON-INTEGER.
;[624]CHECKS TO SEE IF B IS AN INTEGER AND TREATS IT
;[624] ACCORDINGLY BY CALLING DEXP.2. GIVES LIBRARY ERROR FOR
;[624]NEG NUM TO NON-INTEGER POWER.
;THE CALLING SEQUENCE FOR THE ROUTINE IS AS FOLLOWS:
; MOVEI Q, ARG2
; PUSHJ P, DEXP3
;ARG2 IS THE ADDRESS OF THE HIGH ORDER PART OF THE DOUBLE
;PRECISION POWER, AND THE BASE, ARG1, IS IN ACCUMULATORS
;A AND B WHEN THE ROUTINE IS CALLED. THE DOUBLE PRECISION
;ANSWER IS LEFT IN ACCUMULATORS A AND B.
;** ; [624] INSERT BEFORE SEARCH - SWG 29 NOV 1976
EXTERN DEX2.. ;[624]STANDARD DP TO INTEGER POWER
SEARCH FORPRM
IFN F40LIB,<ENTRY DEXP.3>
IFN F10LIB,<ENTRY DEXP3.>
E= 4 ;[624]
D= 3 ;[624]
C= 2
B= 1
A= 0
Q= 16
P= 17
;**; [643] DEXP3.-2 INSERT DEF OF ARGAX SWG 24-FEB-77
ARGAX: BLOCK 2 ;[643]
IFN F10LIB,<
SIXBIT /DEXP3./
DEXP3.: DMOVE T0,@(L) ;GET THE BASE
MOVEI L,@1(L)
IFN F40LIB,<
JRST DEXP.3 ;COMMON ROUTINE
>>
IFN F40LIB,<
SIXBIT /DEXP.3/
DEXP.3:>
;**;[665] INSERT @ DEXP.3+1L FROM BELOW SWG 28-JUL-77
PUSH P,C ;[665] SAVE TEMPORARY REGISTERS
PUSH P,D ;[665] AT ENTRY BEFORE DOING
PUSH P,E ;[665] ANYTHING FOR CLEAN EXIT
SKIPN (Q) ;IS EXPONENT ZERO?
JRST DEXPZ ;YES, RETURN ANSWER OF 1.0
JUMPE A,[SKIPL (Q) ;IS BASE 0 WITH POS EXPONENT?
;**; [665] CHANGE @ DEXP.3+4L SWG 28-JUL-77
JRST DRET ;[665]YES, RETURN 0
JRST OV4] ;NO, BASE 0 AND NEG EXP- OVERFLOW
;**; [665] MOVE @ DEXP.3+6L 3 LINES ABOVE SWG 28-JUL 77
;**; [624] DEXP.3+6L DELETE 2 LINES AND INSERT SWG 29-NOV-76
DMOVEM A,ARGAX ;[624]SAVE BASE
DMOVE A,(Q) ;[624]PULL IN EXPONENT
MOVM D,A ;[624]MAGNITUDE OF WORD 1 OF EXP
MOVEI C,0 ;[624]CLEAR AC C
LSHC C,11 ;[624]SHIFT 9 BITS
CAILE C,233 ;[624]INTEGER MUST FIT IN 27 BITS
JRST DEXPD ;[624]NOT AN INTEGER
SUBI C,200 ;[624]200 COMPLEMENT ON EXP
MOVM E,B ;[624]WORD 2 OF EXP
IFE CPU-KA10,< ;[624]
HRLZI B,777000 ;[624]WANT TO LOOK AT FRACTION
ANDCAM B,E ;[624]CLEAR FIRST 9 BITS
> ;[624]
JUMPN E,DEXPD ;[624]IS WORD 2 ZERO?
LSH D,-1 ;[624]COULD STILL BE INTEGER
HRRZ E,C ;[624]SET E AS INDEX REG
MOVEI C,0 ;[624]CLEAR C
ASHC C,(E) ;[624]SHIFT LEFT BY CONTENT S OF E
JFCL DEXPD ;[624]OVERFLOW
JUMPN D,DEXPD ;[624]IS IT INTEGER??
MOVE B,(Q) ;[624]YES-NEED SIGN OF EX
SKIPGE ,B ;[624]NEGATIVE??
MOVNS C ;[624]YES-NEGATE INTEGER
PUSH P,(Q) ;[624]SAVE WHAT'S POINTED TO BY Q
MOVEM C,(Q) ;[624]SET ARG FOR DEXP.2
DMOVE A,ARGAX ;[624]RESTORE BASE
PUSHJ P,DEX2.. ;[624]
POP P,(Q) ;[624]RESTORE ARG
JRST DRET ;[624]RESTORE REGS AND RETURN
DEXPD: DMOVE A,ARGAX ;[624]CHECK SIGN
JUMPGE A,DEXPD2 ;[624]NEGATIVE??
DFN A,B ;[624]YES-GET ABS VALUE
ERROR (LIB,2,2,[ASCIZ/Attempt to raise negative double precision number to non-integer power/]) ;[624]
DEXPD2: DMOVEM A,ARGAX ;[624-INSERT LABEL]SAVE BASE
FUNCT DLOG.,<ARGAX> ;CALC.
;LOG(/A/).
DMOVEM A,ARGAX ;STORE IT IN ARGAX.
DMOVE A,(Q) ;ARG B TO AC'S 0 AND 1.
MOVEM C,CSAVE ;SAVE AC 2.
IFE CPU-KA10,<MOVEM A,C ;CALCULATE
FMPR C,ARGAX+1 ;B*
JFCL ;LOG(/A/)
FMPR B,ARGAX ;AND
JFCL ;GO
UFA B,C ;TO
JFCL ;OVUNFL
FMPL A,ARGAX ;IF
JFCL OVUNFL ;OVER-
UFA B,C ;OR
FADL A,C ;UNDERFLOW
JFCL OVUNFL > ;OCCUR.
IFE CPU-KI10,<DFMP A,ARGAX
JFCL OVUNFL >
DMOVEM A,ARGAX ;STORE B*LOG(/A/) IN ARGAX.
FUNCT DEXP.,<ARGAX> ;CALC. EXP[B*LOG(/A/)] AND
;LEAVE IT IN AC'S 0 AND 1.
MOVE C,CSAVE ;RESTORE AC 2.
DRET: POP P,E ;[624]RESTORE REGS
POP P,D ;[624]
POP P,C ;[624]
POPJ P, ;EXIT.
DEXPZ: MOVSI A, (1.0) ;ANS = 1.0
MOVEI B, 0 ;AND
;**; [665] CHANGE @ DEXPZ+2 SWG 28-JUL-77
JRST DRET ;[665]EXIT.
OVUNFL: MOVE C,CSAVE ;RESTORE AC 2.
JUMPE A,DEXPZ ;IF EXP= 0, ANS = 1.0.
JUMPL A,OV6 ;GO TO UNDERFLOW.
OV4: ERROR (APR,5,1,.+1) ;OVERFLOW. OUTPUT
HRLOI A,377777 ;ANS =
IFE CPU-KA10,<HRLOI B,344777 > ;INFINITY.
IFN CPU-KA10,<HRLOI B,377777 >
;**; [665] CHANGE @ OV6-1 SWG 28-JUL-77
JRST DRET ;[665]EXIT.
OV6: ERROR (APR,7,1,.+1) ;UNDERFLOW. OUTPUT
SETZB A,B ;ANS = 0, AND
;**; [665] CHANGE @ OV6+2 SWG 28-JUL-77
JRST DRET ;[665]EXIT.
;**;[643] CSAVE-1 MOVE DEF OF ARGAX ABOVE SWG 24-FEB-77
CSAVE: BLOCK 1
PRGEND
TITLE DEXP.2 %5A(624) PDP-10/10I DOUBLE PRECISION EXP2 FUNCTION
SUBTTL D. TODD /DRT/SWG 29-NOV-1976
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;THIS ROUTINE CALCULATES A DOUBLE PRECISION NUMBER RAISED
;TO A FIXED POINT POWER. THE CALCULATION IS A**N, WHERE N
;IS AN INTEGER OF THE FORM
; N= Q(0) + Q(1)*2 + Q(2)*4 + ... WHERE Q(I) = 0 OR 1
;THE ONLY RESTRICTION ON THE BASE OR EXPONENT IS THAT
;AN EXPONENT OF 400000000000 IS NOT HANDLED CORRECTLY.
;THE ROUTINE IS CALLED BY
; MOVEI Q, POWER
; PUSHJ P, DEXP2
;WHERE POWER IS THE ADDRESS OF THE FIXED POINT POWER, AND
;THE DOUBLE PRECISION BASE IS IN ACCUMULATORS A AND B. THE
;RESULT IS RETURNED IN ACCUMULATORS A AND B.
;**;[624] INSERT BEFORE SEARCH SWG 29-NOV-1976
ENTRY DEX2.. ;[624]ENTRY FROM DEXP.3
SEARCH FORPRM
IFN F40LIB,<ENTRY DEXP.2>
IFN F10LIB,<ENTRY DEXP2.>
A= 0
B= 1
C= 2
D= 3
E= 4
G= 6
Q= 16
P= 17
X= G ;HIGHEST AC TO SAVE
IFN F10LIB,<
SIXBIT /DEXP2./
DEXP2.: DMOVE T0,@(L) ;GET THE BASE
MOVEI L,@1(L) ;POINT TO THE POWER
IFN F40LIB,<
JRST DEXP.2 ;GO TO COMMON ROUTINE
>>
IFN F40LIB,<
SIXBIT /DEXP.2/
DEXP.2:>
;**; [624] INSERT LABEL AT DEXP.2+1 SWG 29-NOV-1976
DEX2..: SKIPN (Q) ;[624]IS EXPONENT 0?
JRST [MOVSI A,(1.0) ;YES, A**0 GIVES 1
MOVEI B,0
POPJ P,]
JUMPE A,[SKIPL (Q) ;IS BASE 0 WITH POSITIVE EXPONENT?
POPJ P, ;YES, RETURN 0
ERROR (APR,5,1,.+1) ;BASE IS 0 WITH NEG. EXP- OVERFLOW
HRLOI A,377777 ;RETURN LARGEST POSITIVE NUMBER
IFE CPU-KA10,<HRLOI B,344777 >
IFN CPU-KA10,<HRLOI B,377777 >
POPJ P,]
MOVEM X,XSAVE ;SAVE AC TO DO BLT
MOVE X,XBLT ;SAVE OTHER AC'S
BLT X,XSAVE-1 ;...
SKIPL G,(Q) ;GET EXPONENT. IS IT NEGATIVE?
JRST [DMOVE D,A ;NO, PUT ARG IN D,D+1
JRST DEX2] ;START MAIN LOOP
MOVMS G ;GET POSITIVE VALUE
MOVSI D,(1.0) ;GET DOUB. PRECISION 1.0
MOVEI E,0 ;...
;CALCULATE (1/X)**N, SINCE N .L. 0
IFE CPU-KA10,<FDVL 3,0
JFCL 1,OVER
MOVN 5,3
FMPR 5,1
JFCL
UFA 4,5
FDVR 5,0
JFCL
FADL 3,5 >
IFE CPU-KI10,<DFDV D,0
JFCL 1,OVER >
DEX2: MOVSI A,(1.0) ;GET DOUB. PREC. 1.0
MOVEI B,0 ;...
JRST DEX4 ;START CALCULATING POWERS OF X (OR 1/X)
DEX3: ;SQUARE X (OR 1/X) AGAIN
IFE CPU-KA10,<DMOVEM D,TEMP
MOVEM D,D+2
FMPR D+2,TEMP+1
JFCL
FMPR D+1,TEMP
JFCL
UFA D+1,D+2
JFCL
FMPL D,TEMP
JOV OVR
UFA D+1,D+2
FADL D,D+2
JOV OVR >
IFE CPU-KI10,<DFMP D,D
JOV OVR >
LSH G,-1 ;LOOK AT NEXT BIT IN N
DEX4: TRZN G,1 ;IS LO BIT IN N A 1?
JRST DEX5 ;NO, DON'T MULTIPLY INTO ANSWER
;MULTIPLY POWER OF X INTO ANSWER
IFE CPU-KA10,<MOVEM A,A+2
FMPR A+2,D+1
JFCL
FMPR A+1,D
JFCL
UFA A+1,A+2
JFCL
FMPL A,D
JOV DEX6
UFA A+1,A+2
FADL A,A+2
JOV DEX6 >
IFE CPU-KI10,<DFMP A,D
JOV DEX6 >
DEX5: JUMPN G,DEX3 ;IF G .N. 0, GET MORE POWERS OF X (OR 1/X)
DEX6: MOVS X,XBLT ;RESTORE AC'S
BLT X,X ;...
CPOPJ: POPJ P,
OVR: ;ARITHMETIC FAULT, MOVE FIX UP TO A,B
SKIPGE A ;SHOULD RESULT BE NEGATIVE?
DFN D,E ;YES
OVR2:
DMOVE A,D
JRST DEX6 ;AND EXIT
OVER: JUMPGE D,OVR2 ;IF THE ARG IS <0 AND THE EXPONENT
TRNN G,1 ;IS ODD, THEN
DFN D,E ;THE ANSWER
JRST OVR2 ;IS < 0.
XBLT: XWD C,ACSAVE ;BLT POINTER TO RESTORE AC'S
ACSAVE: BLOCK X-C
XSAVE: BLOCK 1 ;FOR AC X
TEMP: BLOCK 2
PRGEND
TITLE DEXP %4.(235) PDP-10/10I DOUBLE PRECISION EXPONENTIAL FUNCTION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY DEXP
EXTERN DEXP.
DEXP=DEXP.
PRGEND
TITLE DEXP. %5A(700) PDP-10/10I DOUBLE PRECISION EXPONENTIAL FUNCTION
SUBTTL D. TODD /DRT/HPW/MD 12-AUG-74
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;ARGUMENT. AN ARGUMENT OF ZERO CAUSES AN IMMEDIATE EXIT WITH AN
;ANSWER OF 1.0 . AN ARGUMENT WHOSE MAGNITUDE EXCEEDS 88.028
;CAUSES THE ROUTINE TO EXIT WITH 0 IF THE ARGUMENT WAS NEGATIVE.
;AND 377777777777 IF THE ARGUMENT WAS POSITIVE. THIS IS
;BECAUSE DIRECT CALCULATION OF EXP(X) FOR ABSF(X)>88.028 WOULD
;CAUSE EXPONENT OVERFLOW OR UNDERFLOW.
;THE ROUTINE USES THE FOLLOWING ALGORITHM:
;EXP(X) = 2**(X*LOG2(E))
; = 2**(M+F) WHERE M IS AN INTEGER AND 0<F<1
; = 2**(M+N+R) WHERE 0<R<1/8 AND M+N+R=X*LOG2(E)
; = 2**(M+N) * EXP(R*LOG(2))
;2**M IS CALCULATED EASILY WITH THE FLOATING SCALE INSTRUCTION.
;2**N IS CALCULATED BY DETERMINING THE CORRECT INTERVAL OF N AND
;USING A TABLE OF POWERS OF TWO FROM 2**1/8 TO 2**7/8.
;FINALLY, EXP(R*LOG(2)) IS CALCULATED BY A CONTINUED FRACTION
;TAKEN FROM RALSTON AND WILF, "METHODS FOR DIGITAL COMPUTERS" :
;EXP(R*LOG(2)) = 1+A4/((B4/R) -C4 + D4*R + H4/(R + B4/R))
;THE FOLLOWING ERRORS HAVE BEEN OBSERVED WITH DEXP:
; 1. WITH -10.0<X<10.0, ERRORS RANGED FROM 0 TO 48
; UNITS IN THE 19TH SIGNIFICANT DIGIT. THE MEAN ERROR
; FOR 20 READINGS WAS 5.4 UNITS IN THE 19TH DIGIT.
; 2. WITH 10.0<X<40.0, ERRORS RANGED FROM 0 TO 41 UNITS
; IN THE 19TH SIGNIFICANT DIGIT. THE MEAN ERROR FOR
; 7 READINGS WAS 16 UNITS IN THE 19TH SIGNIFICANT DIGIT.
; 3. WITH 40.0<X<88.0, ERRORS RANGED FROM 5 TO 57 UNITS IN
; THE 19TH SIGNIFICANT DIGIT. THE MEAN ERROR FOR 12
; READINGS WAS 44.4 UNITS IN THE 19TH SIGNIFICANT DIGIT.
;THE ERRORS REFERRED TO ABOVE ARE ABSOLUTE ERRORS. IT SHOULD
;BE NOTED THAT ADDITIONAL ERRORS ARE INTRODUCED BY ERRORS IN
;THE DOUBLE PRECISION INPUT AND OUTPUT ROUTINES.
;700 23542 FIX FLOATING DIVIDE CHECK WHEN LEFT WORD
; OF MANTISSA IS <377 (OCTAL)
;****** END OF REVISION HISTORY
A= 0
B= 1
C= 2
D= 3
E= 4
F= 5
G= 6
Q= 16
P= 17
X= G ;HIGHEST AC TO SAVE
SEARCH FORPRM
;CONSTANTS AND TEMPORARY LOCATIONS AND STUFF
XBLT: XWD C,ACSAVE
DCON1: 88.028
DLOG2E: DOUBLE 201561250731,112701376057 ;LOG2(E) = 1.44269 50408 88963 40740
TABLE: 0 ;0
040000000000 ;1/8
100000000000 ;2/8
140000000000 ;3/8
200000000000 ;4/8
240000000000 ;5/8
300000000000 ;6/8
340000000000 ;7/8
ONE: ;DOUBLE PRECISION 1.0
POWERS: DOUBLE 1.0,0 ;2**0 = 1.0
DOUBLE 201427127017,037250572672 ;2**1/8 = 1.09050 77326 65257 65919
DOUBLE 201460337602,214333425134 ;2**2/8 = 1.18920 71150 02721 06671
DOUBLE 201513773265,115425047073 ;2**3/8 = 1.29683 95546 51009 66590
DOUBLE 201552023631,237635714441 ;2**4/8 = 1.41421 35623 73095 04878
DOUBLE 201612634520,212520333270 ;2**5/8 = 1.54221 08254 07940 824
DOUBLE 201656423746,126551655275 ;2**6/8 = 1.68179 28305 07429 086
DOUBLE 201725403067,076722207113 ;2**7/8 = 1.83400 80864 09342 463
A4: DOUBLE 206744575555,062215755376 ;A4 = 60.59319 17173 36463 11080
B4: DOUBLE 207535527021,213670572221 ;B4 = 87.41749 72022 35527 474
MC4: DOUBLE 572033202222,715562022402 ;MC4=-C4 = -30.29659 58586 68231 555
D4: DOUBLE 201414631463,063146314632 ;D4 = 1.05
H4: DOUBLE 210654261010,261565402456 ;H4 = 214.17286 81454 77042 3113
ACSAVE: BLOCK X-C+1
B4F: BLOCK 2 ;TEMP FOR B4*F
FB4F: BLOCK 2 ;TEMP FOR F+B4*F
HELLO (DEXP,.) ;[235] ENTRY TO DEXP ROUTINE
MOVE 0,XBLT ;SAVE ACCUMULATORS
BLT 0,ACSAVE+X-C ;...
DMOVE A,@(Q) ;PICK UP ARGUMENT
JUMPE A,[MOVSI A,(1.0) ;RETURN 1.0 FOR ARG OF ZERO
JRST DEXEND] ;EXIT
MOVM C,A ;GET POS VALUE OF EXPONENT
CAML C,DCON1 ;TOO BIG TO COMPUTE?
JRST [HRLOI A,377777 ;YES, GET LARGEST POS NUM
MOVE C,ACSAVE ;RESTORE AC C.
SKIPGE @(Q) ;SUPPOSED TO BE SMALL ?
MOVEI A,1 ;YES, MAKE IT VERY SMALL
FADL A,A ;CAUSE OVER/UNDERFLOW, RETURN FIX UPS
JRST DEXEND] ;RETURN
FLMUL A,DLOG2E
HLRE E,A ;EXTRACT EXPONENT
ASH E,-9 ;...
TSC E,E ;TAKE 1'S COMPLEMENT IF NUM .L. 0
IFE CPU-KA10,<LSH B, 8 > ;REMOVE LOW ORDER EXP.
SKIPGE A ;CHANGE EXPONENT BITS TO SIGN BITS
TLOA A,377000 ;NUMBER NEGATIVE, SET BITS
TLZ A,377000 ;NUMBER POSITIVE, CLEAR BITS
ASHC A, 8 ;LEFT JUSTIFY ARG FRACTION BITS
;GET ANOTHER COPY OF FRACTION
DMOVE C,A
ASHC A, -243(E) ;SIMULATE THREE-WORD SHIFT WITH...
;TWO LONG SHIFTS. THIS LEAVES INTEGER
;IN A, FRAC IN B AND C.
LSH D,1 ;SQUEEZE OUT SIGN BIT
LSHC C,43-200(E) ;THEN DO 2ND LONG SHIFT, (THE LSHC HERE
;PREVENTS OVERFLOW GOING LEFT)
TLZ B, (1B0) ;CLEAR SIGN BIT. IF FRAC WAS <0,
;THIS GIVES 1-FRAC AND PROPER EXP.
HRRM A, SCALE ;SAVE EXPONENT FOR FUTURE SCALING
MOVEI G, 7 ;GET INDEX REGISTER POINTER TO TABLE
;**; [700] CHANGE & INSERT @ REDUCE SWG 30-AUG-77
REDUCE: CAME B, TABLE(G) ;[700]DOES ARGUMENT MATCH TABLE ENTRY?
JRST REDUC2 ;[700] NO - KEEP LOOKING
JFFO C,.+2 ;[700] HOW MANY LEADING 0'S
JRST REDUC1 ;[700] NONE - C CONTAINS 0
CAIL D,^D28 ;[700] ARE ANY LEFT OF BIT 28 ON?
REDUC1: JRST [LSH G,1 ;[700] NO, IFF LO HALF=0!<377(OCT). CHANGE INDEX TO POINTER
;PICK UP DOUBLE WORD ANSWER
DMOVE A,POWERS(G)
JRST SCALE] ;SCALE RESULTS AND EXIT
;**; [700] ADD LABEL @ REDUCE+4L SWG 30-AUG-77
REDUC2: CAMGE B, TABLE(G) ;[700]IS ARGUMENT GREATER THAN ENTRY?
SOJA G, REDUCE ;NO, TRY NEXT LOWER ENTRY
SUB B, TABLE(G) ;YES, ALL DONE -REDUCE ARGUMENT
LSH G, 1 ;SAVE INDEX AS A POINTER
ASHC B, -8 ;MAKE ROOM FOR EXPONENT
IFE CPU-KA10,<MOVE A, B ;SET UP ARG. FOR NORMALIZING
ASH C, -8 ;MAKE ROOM FOR LOW ORDER EXP.
FSC A,200 ;SET EXP TO 200
FSC C,200-^D27 ;SET EXP 27 LOWER
FADL A,C > ;MAKE STANDARD NUMBER
IFE CPU-KI10,<TLO B,200000 ;INSERT EXPONENT
DFAD B,[EXP 0,0] ;NORMALIZE RESULT
DMOVE A,B > ;PUT RESULT AN A,B
;GET B4/F
DMOVE D,B4
FLDIV D,A
;SAVE B4/F
DMOVEM D,B4F
;GET F+B4/F
FLADD D,A
;GET H4/(F+B4/F)
DMOVEM D,FB4F
DMOVE D,H4
FLDIV D,FB4F
;GET D4*F
FLMUL A,D4
;GET (B4/F)-C4+D4*F+(H4/(F+B4/F))
FLADD D,A
FLADD D,MC4
FLADD D,B4F
;GET 1.0+A4/REST
DMOVE A,A4
FLDIV A,D
FLADD A,ONE
JUMPE G,SCALE ;MULTIPLY BY POWER OF TWO?
FLMUL A,POWERS(G)
SCAL