github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-02-28 17:09:15 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/link/pltmth.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

931 lines
22 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
UNIVERSAL FORMSC %2.(120)
SUBTTL UNIVERSAL FILE TO ASSEMBLE THE FIX/FLOAT FUNCTIONS
SUBTTL D. TODD/DRT/DZN/PAH/HD/RJF 5-Feb-88
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
; ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH PLTPRM
SALL
CUSTVR==0 ;CUSTOMER VERSION
DECVER==5 ;DEC VERSION
DECMVR==1 ;DEC MINOR VERSION
DECEVR==2417 ;DEC EDIT VERSION
SUBTTL REVISION HISTORY
;START OF VERSION 4A
;1217 Clean up the listings for release.
;1220 Release on both TOPS-10 and TOPS-20 as version 4A(1220).
;Start of Version 5.1
;2026 Update copyright notice.
;Start of Version 6.0
;2403 New corporate copywrite statement.
;2417 Update copywrite statement to 1988.
IF1,< ;PASS 1 ASSEMBLY ONLY
DEFINE FLT(X)<
ENTRY FLT.'X
SIXBIT /FLT.'X/
FLT.'X:
IFE CPU-KA10,<
HLRE X+1,X ;COPY THE HI HALT OF X TO LOW X+1
HLL X,X+1 ;FILL UPPER PART OF X WITH THE SIGH
FSC X,233 ;FLOAT THE LOW HALT OF THE INTEGER
SKIPGE X ;FOR NEGATIVE NUMBERS
AOJE X+1,FLT.XT ;CHANGE HIGH PART TO 2'S COMPLEMENT
FSC X+1,255 ;FLOAT THE HIGH PART
FADR X,X+1 ;COMBINE THE TWO PARTS
>
IFE CPU-KI10,<
FLTR X,X ;USE THE HARDWARE
>
FLT.XT: POPJ P, ;RETURN X=THE FLOATING POINT NUMBER
>
DEFINE IFX(X)<
ENTRY IFX.'X
SIXBIT /IFX.'X/
IFX.'X:
IFE CPU-KA10,<
MULI X,400 ;SEPERATE THE FRACTION AND EXPONENT
EXCH X,X+1 ;PUT PARTICAL RESULT IN X
JUMPGE X+1,IFX.XT ;JUMP IF POSITIVE
TRC X+1,-1 ;NEGATE THE EXPONENT
MOVNS X ;POSITIVE FRACTION
IFX.XT: ASH X,-243(X+1) ;USE EXPONENT AS INDEX
SKIPGE X+1 ;SKIP IF POSITIVE
MOVNS X ;NEGATE THE RESULT
>
IFE CPU-KI10,<
FIX X,X
>
POPJ P, ;RETRURN X=FIXED NUMBER
>
> ;END OF IF1,
PRGEND
TITLE FLOAT %2.(235) INTEGER TO REAL CONVERSION
SUBTTL H. P. WEISS/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
ENTRY FLOAT
EXTERN FLOAT.
FLOAT=FLOAT.
PRGEND
TITLE FLOAT. %2.(235) INTEGER TO REAL CONVERSION
SUBTTL D. TODD/DRT/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
;FROM LIB40 V32.(415)
;36 BIT FLOAT FUNCTION
;CONVERTS A SIGNED FIXED POINT INTEGER TO FLOATING POINT
;BY BREAKING THE INTEGER INTO HIGH ORDER AND LOW ORDER
;FRACTIONS, CALCULATING AN EXPONENT, THEN ADDING THE TWO
;TOGETHER. SINGLE CONVERSION.
;THE ROUTINE IS CALLED AS FOLLOWS:
; JSA Q, FLOAT
; EXP ARG
;THE ANSWER IS RETURNED IN ACCUMULATOR A
IFE HILOW,<
TWOSEG
RELOC 400000>
A=0
B=1
C=2
D=3
E=4
F=5
G=6
Q=16
P=17
HELLO (FLOAT,.) ;[235] ENTRY TO FLOAT ROUTINE
MOVE T0,@(L) ;GET THE ARGUMENT
PJRST FLT.0## ;USE FLT.0 ROUTINE
PRGEND
TITLE IFIX %2.(235) REAL TO INTEGER CONVERSION
SUBTTL H. P. WEISS/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
ENTRY IFIX
EXTERN IFIX.
IFIX=IFIX.
PRGEND
TITLE INT %2.(235) REAL TO INTEGER CONVERSION
SUBTTL H. P. WEISS/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
ENTRY INT
EXTERN INT.
INT=INT.
PRGEND
TITLE IFIX. %2.(235) REAL TO INTEGER CONVERSION
SUBTTL D. TODD/DRT/EY/KK/TWE/DMN/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
;FROM LIB40 V.32(415)
;36 BIT FIX FUNCTION
;AN INTEGER RESULT IS OBTAINED BY SEPARATING FRACTION AND
;EXPONENT. THE FRACTION IS SHIFTED N PLACES RIGHT, WHERE
;N = 43 - (EXPONENT-200) (OCTAL)
;THE CALLING SEQUENCE FOR THE ROUTINE IS AS FOLLOWS:
; JSA Q, IFIX
; EXP ARG
;OR
; JSA Q,INT
; EXP ARG
;THE ANSWER IS RETURNED IN ACCUMULATOR A
IFE HILOW,<
TWOSEG
RELOC 400000>
A=0
B=1
C=2
D=3
E=4
F=5
G=6
Q=16
P=17
HELLO (INT,.) ;[235] ENTRY TO INT ROUTINE.
JRST IFIX1 ;GO TO MAIN ROUTINE.
HELLO (IFIX,.) ;[235] ENTRY TO IFIX ROUTINE
IFIX1:
MOVE T0,@(L) ;GET THE ARGUMENT
PJRST IFX.0## ;USE IFX.0
PRGEND
TITLE FLT.0
SUBTTL /DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH FORMSC,PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
FLT 0
PRGEND
TITLE FLT.14
SUBTTL /DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH FORMSC,PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
FLT 14
PRGEND
TITLE IFX.0
SUBTTL /DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH FORMSC,PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
IFX 0
PRGEND
TITLE EXP2 %2.(216)
SUBTTL D. TODD/DMN/DRT/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
;FROM V.32(415) LIB40
;SINGLE PRECISION EXP.2 FUNCTIONS
;THESE ROUTINES CALCULATE A FLOATING POINT NUMBER TO A FIXED
;POINT POWER. THE CALCULATION IS A**B, WHERE B IS OF THE FORM
; B=Q(0) + Q(1)*2 + Q(2)*4 + ...WHERE Q(I)=0 OR 1
;THERE ARE NO RESTRICTIONS ON THE BASE OR EXPONENT
;THE CALLING SEQUENCES FOR THE ROUTINES ARE AS FOLLOWS:
; PUSHJ P, EXP2.'N'
;WHERE N IS EITHER 0,2,4, OR 6. THE BASE IS IN ACCUMULATOR N
;AND THE EXPONENT IS IN ACCUMULATOR (N+1) WHEN THE ROUTINE IS
;CALLED. THE ANSWER IS RETURNED IN ACCUMULATOR N.
IFE HILOW,<
TWOSEG
RELOC 400000>
ENTRY EXP2.. ;%216% ENTRY FROM EXP3.
ENTRY EXP2.0,EXP2.2,EXP2.4,EXP2.6
ENTRY EXP2.
;ACCUMULATOR DEFINITIONS
A= 0
B= 1
C= 2
D= 3
E= 4
F= 5
G= 6
H= 7
SAVEA=10
SAVEB=11
P= 17
IFN F10LIB,<
SIXBIT /EXP2./
EXP2.: MOVE T0,@(L) ;GET THE BASE
MOVE T1,@1(L) ;GET THE EXPONENT
JRST EXP2.0 ;COMMON ROUNTINE
>
SIXBIT/EXP2.6/
EXP2.6: MOVE A, G ;SET UP ACCUMULATOR A
MOVE B, H ;SET UP ACCUMULATOR B
PUSHJ P, EXP2.0 ;GO TO MAIN ROUTINE.
MOVEM A, G ;MOVE ANSWER TO CORRECT AC.
POPJ P, ;RETURN
SIXBIT/EXP2.4/
EXP2.4: MOVE A, E ;SET UP ACCUMULATOR A
MOVE B, F ;SET UP ACCUMULATOR B
PUSHJ P, EXP2.0 ;GO TO MAIN ROUTINE.
MOVEM A, E ;MOVE ANSWER TO CORRECT AC.
POPJ P, ;RETURN
SIXBIT/EXP2.2/
EXP2.2: MOVE A, C ;SET UP ACCUMULATOR A
MOVE B, D ;SET UP ACCUMULATOR B
PUSHJ P, EXP2.0 ;GO TO MAIN ROUTINE.
MOVEM A, C ;MOVE ANSWER TO CORRECT AC.
POPJ P, ;RETURN
SIXBIT/EXP2.0/
EXP2.0:
EXP2..: JUMPE B,[MOVSI A,(1.0) ;BASE**0, RETURNS 1
POPJ P,]
JUMPN A,EXP2A ;GO AHEAD IF BASE NE 0.
JUMPGE B,FEXP4 ;EXIT IF BASE =0, EXP >= 0,
ERROR (APR,5,1,.+1) ;O'E, SET UP
HRLOI 0,377777 ;AN ANSWER OF INFINITY.
POPJ 17, ;RETURN.
EXP2A: SAVE <C,SAVEA,SAVEB>
MOVSI C, 201400 ;GET 1.0 IN ACCUMULATOR C.
MOVEM A,SAVEA ;STORE BASE IN SAVEA.
MOVEM B,SAVEB ;STORE EXP. IN SAVEB.
JUMPGE B, FEXP2 ;IS EXPONENT POSITIVE?
MOVMS B ;NO, MAKE IT POSITIVE
JFCL MININF ;IF EXP WAS 400000,,0 GO TO MININF.
PUSHJ P, FEXP2 ;CALL MAIN PART OF PROGRAM.
INV: MOVSI B, 201400 ;GET 1.0 IN B.
FDVM B, A ;FORM 1/(A**B) FOR NEG. EXPONENT.
POPJ P, ;RETURN.
FEXP1: FMP A, A ;FORM A**N, FLOATING POINT.
JFCL OVER ;IF OVER/UNDERFLOW, GO TO OVER.
LSH B, -1 ;SHIFT EXPONENT FOR NEXT BIT.
FEXP2: TRZE B, 1 ;IS THE BIT ON?
FMP C, A ;YES, MULTIPLY ANSWER BY A**N.
JFCL OVER ;IF OVER/UNDERFLOW, GO TO OVER.
JUMPN B, FEXP1 ;UPDATE A**N UNLESS ALL THROUGH.
FEXP3: MOVE A, C ;PICK UP RESULT FROM C.
FEXP3A: RESTOR <SAVEB,SAVEA,C>
FEXP4: POPJ P, ;RETURN.
OVER: MOVE C,.JBTPC ;PICK UP FLAGS.
SKIPG SAVEB ;JUMP TO INVERT IF
JRST INVERT ;EXP. WAS NEGATIVE.
TLNE C,(1B11) ;UNDERFLOW, IN WHICH CASE,
ERROR (APR,7,1,OUT) ;UNDER FLOW
ERROR (APR,5,1,OUT) ;OVER FLOW
OUT: HRLOI A,377777 ;ANS. IS SET TO + INFINITY.
TLNE C,(1B11) ;SKIP IF OVERFLOW FLAG SET.
SETZ A, ;O'E, SET ANSWER TO 0.
OUT2: SKIPL SAVEA ;ANS. IS >= 0, IF
JRST FEXP3A ;A WAS >= 0.
MOVE B,SAVEB ;PICK UP THE EXP.
TRNE B,1 ;ANS. IS < 0, IF A < 0 AND
MOVNS A ;THE EXP. WAS ODD.
JRST FEXP3A ;GO TO RETURN.
INVERT: SUB P,[XWD 1,1] ;ADJUST PDP.
TLCN C,(1B11) ;IF TRUE UNDERFLOW, GO
JRST ALOGRT ;TO ALOGRT.
ERROR (APR,1,1,OUT) ;TYPE AN ERROR MESSAGE
ALOGRT: MOVM C,SAVEA ;PICK UP ABS(BASE).
FUNCT ALOG.,<C> ;CALC. LOG(ABS(A)).
MOVEM A,C ;RESULTS TO C.
IFE CPU-KI10,<FLTR 0,SAVEB>
IFE CPU-KA10,<FUNCT FLOAT.,<SAVEB> ;MAKE EXP. A FLOATING
>
FMPRM A,C ;CALC. B*ALOG(ABS(A)).
FUNCT EXP.,<C> ;FIND EXP. OF THIS.
JRST OUT2 ;GO AND TYPE ERROR MESSAGE.
MININF: HRLOI B,377777 ;SET EXP = +INFINITY.
PUSHJ P,FEXP2 ;GO TO MAIN ROUTINE.
FMPR A,SAVEA ;ANS. = ANS. TIMES A.
JFCL OVER ;GO TO OVER IF OVERFLOW.
JRST INV ;OTHERWISE, GO TO INV.
LIT
PRGEND
TITLE EXP %2.(235) FLOATING POINT SINGLE PRECISION EXPONENTIAL
SUBTTL H. P. WEISS/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
ENTRY EXP
EXTERN EXP.
EXP=EXP.
PRGEND
TITLE EXP. %2.(235) FLOATING POINT SINGLE PRECISION EXPONENTIAL
SUBTTL D. TODD/DRT/HPW/EY/KK/DMN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
;FROM V.021 8-AUG-69
;FLOATING POINT SINGLE PRECISION EXPONENTIAL FUNCTION
;IF X<=-89.415..., THE PROGRAM RETURNS ZERO AS THE ANSWER
;IF X>=88.029..., THE PROGRAM RETURNS 377777777777 AS THE ANSWER
;THE RANGE OF THE ARGUMENT IS REDUCED AS FOLLOWS:
;EXP(X) = 2**(X*LOG(E)BASE2) = 2**(M+F)
;WHERE M IS AN INTEGER AND F IS A FRACTION
;2**M IS CALCULATED BY ALGEBRAICALLY ADDING M TO THE EXPONENT
;OF THE RESULT OF 2**F. 2**F IS CALCULATED AS
;2**F = 2(0.5+F(A+B*F^2 - F-C(F^2 + D)**-1)**-1
;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:
; JSA Q, EXP
; EXP ARG
;THE ANSWER IS RETURNED IN ACCUMULATOR A
A= 0
B= 1
C= 2
D= 3
ES2=5
Q= 16
IFE HILOW,<
TWOSEG
RELOC 400000>
HELLO (EXP,.) ;[235] ENTRY TO EXPONENTIAL ROUTINE
MOVE B,@(Q) ;PICK UP THE ARGUMENT IN B
CAMGE B,E77 ;IS EXP. < -89.41...?
JRST OUT2 ;YES, GO TO EXIT.
CAMG B,E7 ;IS EXP. > +88.029...?
JRST EXP1 ;GO TO STANDARD ALGORITHM.
ERROR (APR,5,1,.+1) ;TYPE AN ERROR MESSAGE
HRLOI A, 377777 ;GET LARGEST FLOATING NUMBER
GOODBY (1) ;RETURN
OUT2: ERROR (APR,7,1,.+1) ;ERROR MESSAGE
MOVEI A,0 ;ANSWER IS 0.
GOODBY (1) ;RETURN
EXP1: SAVE <C>
SAVE <D>
SETZ ES2 ;INITIALIZE ES2
MULI B, 400 ;SEPARATE FRACTION AND EXPONENT
TSC B, B ;GET A POSITIVE EXPONENT
MUL C, E5 ;FIXED POINT MULTIPLY BY LOG2(E)
ASHC C, -242(B) ;SEPARATE FRACTION AND INTEGER
AOSG C ;ALGORITHM CALLS FOR MULT. BY 2
AOS C ;ADJUST IF FRACTION WAS NEGATIVE
HRRM C, EX1 ;SAVE FOR FUTURE SCALING
JUMPG D,ASHH ;GO AHEAD IF ARG > 0.
TRNN D,377 ;ARE ALL THESE BITS 0?
JRST ASHH ;YES, GO AHEAD.
ADDI D,200 ;NO, FIX UP.
ASHH: ASH D, -10 ;MAKE ROOM FOR EXPONENT
TLC D, 200000 ;PUT 200 IN EXPONENT BITS
FADB D, ES2 ;NORMALIZE, RESULTS TO D AND ES2
FMP D, D ;FORM X^2
MOVE A, E2 ;GET FIRST CONSTANT
FMP A, D ;E2*X^2 IN A
FAD D, E4 ;ADD E4 TO RESULTS IN D
MOVE B, E3 ;PICK UP E3
FDV B, D ;CALCULATE E3/(F^2 + E4)
FSB A, B ;E2*F^2-E3(F^2 + E4)**-1
MOVE C, ES2 ;GET F AGAIN
FSB A, C ;SUBTRACT FROM PARTIAL SUM
FAD A, E1 ;ADD IN E1
FDVM C, A ;DIVIDE BY F
FAD A, E6 ;ADD 0.5
EX1: FSC A, 0 ;SCALE THE RESULTS
RESTOR <C>
RESTOR <D>
GOODBY (1) ;RETURN
E1: 204476430062 ;9.95459578
E2: 174433723400 ;0.03465735903
E3: 212464770715 ;617.97226953
E4: 207535527022 ;87.417497202
E5: 270524354513 ;LOG(E), BASE 2
E6: 0.5
E7: 207540074636 ;88.029...
E77: 570232254037 ;-89.415986
LIT
PRGEND
TITLE ALOG %2.(235) LOG ROUTINES
SUBTTL H. P. WEISS/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
ENTRY ALOG
EXTERN ALOG.
ALOG=ALOG.
PRGEND
TITLE ALOG10 %2.(235) LOG ROUTINES
SUBTTL H. P. WEISS/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
TWOSEG
RELOC 400000
ENTRY ALOG10
EXTERN ALG10.
ALOG10=ALG10.
PRGEND
TITLE ALOG. %2.(235) LOG ROUTINES
SUBTTL D. TODD/KK/DMN/DRT/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
;FROM V.022 18-DEC-69
;FROM V.020.
;FLOATING POINT SINGLE PRECISION LOGARITHM FUNCTION
;LOG(ABSF(X)) IS CALCULATED BY THE SUBROUTINE, AND AN
;ARGUMENT OF ZERO IS RETURNED AS MINUS INFINITY.
;ALOG IS THE ENTRY POINT FOR LOGE(X), AND
;ALOG10 IS THE ENTRY POINT FOR LOG10(X).
;FOR LOGE(X), THE ALGORITHM IS:
; LOGE(X) = (I + LOG2(F))*LOGE(2)
; WHERE X = (F/2)*2^(I+1), AND LOG2(F) IS GIVEN BY
; LOG2(F) = C1*Z + C3*Z^3 + C5*Z^5 - 1/2
; AND Z = (F-SQRT(2))/(F+SQRT(2))
;FOR LOG10(X), THE ALGORITHM IS:
; LOG10(X) = LOGE(X)*LOG10(E)
;THE CALLING SEQUENCE FOR THE ROUTINE IS AS FOLLOWS:
; JSA Q, ALOG OR ALOG10
; EXP ARG
;THE ANSWER IS RETURNED IN ACCUMULATOR A
A= 0
B= 1
TEMP=10
LS=11
LZ=12
Q= 16
IFE HILOW,<
TWOSEG
RELOC 400000>
HELLO (ALG10.,ALOG10) ;[235] ENTRY TO LOG TO THE BASE 10 ROUTINE.
SAVE TEMP
MOVE TEMP,@(16) ;GET /X/ IN AC 0.
JUMPE TEMP,LZERO ;CHECK FOR ZERO ARG.
FUNCT ALOG.,<TEMP> ;CALC THE LOG TO THE
FMPR 0,LOG10A ;MULTIPLY IT BY LOG10(E).
RESTOR <TEMP>
GOODBY (1) ;RETURN
LOG10A: 177674557305
HELLO (ALOG,.) ;[235] ENTRY TO LOG TO THE BASE E ROUTINE.
SAVE <LS,LZ>
MOVE A, @(Q) ;GET ABSF(X)
JUMPG A,ALOGOK ;ARG IS GREATER THAN 0
JUMPE A, LZERO ;CHECK FOR ZERO ARGUMENT
ERROR (LIB,11,2,[ASCIZ /ATTEMPT TO TAKE LOG OF NEGATIVE ARG/])
MOVM A,@(Q) ;GET ABSF(X)
ALOGOK: CAMN A, ONE ;CHECK FOR 1.0 ARGUMENT
JRST ZERANS ;IT IS 1.0 RETURN ZERO ANS.
ASHC A, -33 ;SEPARATE FRACTION FROM EXPONENT
ADDI A, 211000 ;FLOAT THE EXPONENT AND MULT. BY 2
MOVSM A, LS ;NUMBER NOW IN CORRECT FL. FORMAT
MOVSI A, 567377 ;SET UP -401.0 IN A
FADM A, LS ;SUBTRACT 401 FROM EXP.*2
ASH B, -10 ;SHIFT FRACTION FOR FLOATING
TLC B, 200000 ;FLOAT THE FRACTION PART
FAD B, L1 ;B = B-SQRT(2.0)/2.0
MOVE A, B ;PUT RESULTS IN A
FAD A, L2 ;A = A+SQRT(2.0)
FDV B, A ;B = B/A
MOVEM B, LZ ;STORE NEW VARIABLE IN LZ
FMP B, B ;CALCULATE Z^2
MOVE A, L3 ;PICK UP FIRST CONSTANT
FMP A, B ;MULTIPLY BY Z^2
FAD A, L4 ;ADD IN NEXT CONSTANT
FMP A, B ;MULTIPLY BY Z^2
FAD A, L5 ;ADD IN NEXT CONSTANT
FMP A, LZ ;MULTIPLY BY Z
FAD A, LS ;ADD IN EXPONENT TO FORM LOG2(X)
FMP A, L7 ;MULTIPLY TO FORM LOGE(X)
RESTOR <LZ,LS>
GOODBY (1) ;RETURN
LZERO: ERROR (APR,5,1,.+1) ;ERROR MESSAGE
MOVE A,MIFI ;PICK UP MINUS INFINITY
RESTOR <LZ,LS>
GOODBY (1) ;RETURN
ZERANS: MOVEI A, 0 ;MAKE ANSWER ZERO
RESTOR <LZ,LS>
GOODBY (1) ;RETURN
;CONSTANTS
ONE: 201400000000
L1: 577225754146 ;-0.707106781187
L2: 201552023632 ;1.414213562374
L3: 200462532521 ;0.5989786496
L4: 200754213604 ;0.9614706323
L5: 202561251002 ;2.8853912903
L7: 200542710300 ;0.69314718056
MIFI: 400000000001 ;LARGEST NEGATIVE FLOATING NUMBER
PRGEND
TITLE SIND %2.(235) SIN AND COSINE ROUTINES
SUBTTL H. P. WEISS/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
ENTRY SIND
EXTERN SIND.
SIND=SIND.
PRGEND
TITLE COSD %2.(235) SIN AND COSINE ROUTINES
SUBTTL H. P. WEISS/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
ENTRY COSD
EXTERN COSD.
COSD=COSD.
PRGEND
TITLE SIN %2.(235) SIN AND COSINE ROUTINES
SUBTTL H. P. WEISS/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
ENTRY SIN
EXTERN SIN.
SIN=SIN.
PRGEND
TITLE COS %2.(235) SIN AND COSINE ROUTINES
SUBTTL H. P. WEISS/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
ENTRY COS
EXTERN COS.
COS=COS.
PRGEND
TITLE SIN. %2.(235) SIN AND COSINE ROUTINES
SUBTTL D. TODD/DRT/HPW/EY/KK/DMN/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
;FROM V.020
;FLOATING POINT SINGLE PRECISION SINE AND COSINE FUNCTION
;IF THE ARGUMENT IS IN DEGREES, THE PROPER ENTRY POINTS ARE
;SIND AND COSD, WHILE IF THE ARGUMENT IS IN RADIANS, THE
;PROPER ENTRY POINTS ARE SIN AND COS.
;COSD CALLS SIND TO CALCULATE SIND(PI/2+X)
;COS CALLS SIN TO CALCULATE SIN (PI/2+X)
;SIND CALLS SIN AFTER A CONVERSION FROM DEGREES TO RADIANS.
;THIS ROUTINE CALCULATES SINES AFTER REDUCING THE ARGUMENT TO
;THE FIRST QUADRANT AND CHECKING THE OVERFLOW BITS TO DETERMINE
;THE QUADRANT OF THE ORIGINAL ARGUMENT.
;000 - 1ST QUADRANT
;001 - 2ND QUADRANT
;010 - 3RD QUADRANT
;011 - 4TH QUADRANT
;THE ALGORITHM USES A MODIFIED TAYLOR SERIES TO CALCULATE
;THE SINE OF THE NORMALIZED ARGUMENT.
;THE ROUTINES ARE CALLED IN THE FOLLOWING MANNER:
; JSA Q,SIN (OR COS,SIND, OR COSD)
; EXP ARG
;THE ANSWER IS RETURNED IN ACCUMULATOR A
IFE HILOW,<
TWOSEG
RELOC 400000>
A=0
B=1
C=2
SX=3
Q=16
HELLO (COSD,.) ;[235] ENTRY TO COSINE DEGREES ROUTINE.
MOVE B,@(Q) ;PICK UP THE ARG.
FADR B,CD1 ;ADD 90 DEGREES.
FDVR B,SCD1 ;CONVERT TO RADIANS.
JFCL ;SUPPRESS ERROR MESSAGE FROM OVTRAP.
JRST S1 ;ENTER SINE ROUTINE.
HELLO (SIND,.) ;[235] ENTRY TO SINE DEGREES ROUTINE.
MOVE B,@(Q) ;PICK UP THE ARG.
FDVR B,SCD1 ;CONVERT TO RADIANS
JFCL ;SUPPRESS ERROR MESSAGE ON UNDERFLOW.
JRST S1 ;ENTER SINE ROUTINE.
HELLO (COS,.) ;[235] ENTRY TO COSINE RADIANS ROUTINE.
MOVE B,@(Q) ;PICK UP THE ARG.
FADR B,PIOT ;ADD PI/2.
JRST S1 ;ENTER SINE ROUTINE.
HELLO (SIN,.) ;[235] ENTRY TO SINE RADIANS ROUTINE.
MOVE B,@(Q) ;PICK UP THE ARG.
S1: SAVE SX
MOVEM B,SX ;SAVE THE ARG.
MOVMS B ;GET ABS OF ARG.
CAMG B,SP2 ;SIN(X)=X IF X<2^-9.
JRST S3A ;EXIT WITH ARG. IN A.
SAVE C
FDV B,PIOT ;DIVIDE X BY PI/2.
CAMG B,ONE ;IS X/(PI/2) < 1.0 ?
JRST S2 ;YES,ARG IN 1ST QUADRANT ALREADY.
MULI B,400 ;NO,SEPARATE FRACTION AND EXP.
LSH C,-202(B) ;GET X MODULO 2PI.
TLZ C,(1B0) ;SUPRESS ERROR MESSAGE FROM OVTRAP.
MOVEI B,200 ;PREPARE FLOATING FRACTION.
ROT C,3 ;SAVE THREE BITS TO DETERMINE QUADRANT.
LSHC B,33 ;ARGUMENT NOW IN THE RANGE (-1,1).
FAD B,SP3 ;NORMALIZE THE ARGUMENT.
JUMPE C,S2 ;REDUCED TO 1ST QUAD IF BITS 000.
TLCE C,1000 ;SUBTRACT 1.0 FROM ARG IF BITS ARE
FSB B,ONE ;001 OR 011.
TLCE C,3000 ;CHECK FOR FIRST QUADRANT, 001.
TLNN C,3000 ;CHECK FOR THIRD QUADRANT, 010.
MOVNS B ;001,010.
S2: SKIPGE SX ;CHECK SIGN OF ORIGINAL ARG.
MOVNS B ;SIN(-X)=-SIN(X).
MOVEM B,SX ;STORE REDUCED ARG.
FMPR B,B ;CALCULATE X^X
MOVE A,SC9 ;GET 1ST CONSTANT.
FMP A,B ;MULTIPLY BY X^2
FAD A,SC7 ;ADD IN NEXT CONSTANT.
FMP A,B ;MULTIPLY BY X^2.
FAD A,SC5 ;ADD IN NEXT CONSTANT.
FMP A,B ;MULTIPLY BY X^2.
FAD A,SC3 ;ADD IN NEXT CONSTANT.
FMP A,B ;MULTIPLY BY X^2.
FAD A,PIOT ;ADD IN LAST CONSTANT.
S2B: FMPR A,SX ;MULTIPLY BY X.
RESTOR C
SKIPA 0
S3A: MOVE A,SX ;ANSWER IN X.
RESTOR SX
GOODBY (1) ;EXIT
SC3: 577265210372
SC5: 175506321276
SC7: 606315546346
SC9: 164475536722
SP2: 170000000000
SP3: 0
CD1: 90.0
SCD1: 206712273406
PIOT: 201622077325
ONE: 1.0
END
Reference in New Issue View Git Blame Copy Permalink