perm filename SAITRG[GEO,BGB] blob
sn#001328 filedate 1973-03-07 generic text, type T, neo UTF8
00100 TITLE SAITRG
00200
00250 ;ALTERNATE PDP-10 MNEMONICS.
00300 OPDEF LAC[MOVE]↔OPDEF DAC[MOVEM]↔OPDEF GO[JRST]
00400 OPDEF LACM[MOVM]↔OPDEF LACN[MOVN]↔OPDEF DAP[HRRM]
00450 ;SAIL CONVENTIONS.
00500 DEFINE SUBR(NAME){INTERN NAME↔NAME:}
00600 DEFINE ARG1<-1(17)>
00610 DEFINE ARG2<-2(17)>
00700 DEFINE POP1J<GO POP1J.>
00750 DEFINE POP2J<GO POP2J.>
00775
00800 HALFPI: 201622077325 ;PI/2
00850 PI: 202622077325
00900
01000 INTERN SIN,COS
01100 BEGIN SINCOS
01200 A←1 ↔ B←2 ↔ C←3
01300 ↑COS: SKIPA A,ARG1
01400 ↑SIN: SKIPA A,ARG1
01500 FADR A,HALFPI ;COS(X) = SIN(X+π/2).
01600 MOVM B,A↔CAMG B,[17B5]↔POP1J ;FOR SMALL X, SIN(X)=X.
01700
01800 ;B ← (ABS(X)MODULO 2π)/HALFPI
01900 ;C ← QUADRANT 0, 1, 2 OR 3.
02000 FDVR B,HALFPI
02100 LAC C,B↔FIX C,233000
02200 CAILE C,3↔GO[
02300 TRZ C,3↔FSC C,233
02400 FSBR B,C↔GO .-3] ;MODULO 2π.
02500 GO .+1(C)↔GO .+4↔JFCL↔GO[
02650 FSBRI B,(2.0)↔MOVNS B↔GO .+2] ;SIN(X+π)=SIN(-X)
02700 FSBRI B,(4.0) ;SIN(X+2π)=SIN(X)
02800 SKIPGE A↔MOVNS B ;SIN(-X) = -SIN(X).
02900
03000 ;FOR -1 ≤ B ≤ +1 REPRESENTING -π/2 ≤ X ≤ +π/2,
03100 ;COMPUTE SINE(X) APPROXIMATION BY TAYLOR SERIES.
03200 DAC B,C↔FMPR B,B
03300 LAC A,[164475536722]↔FMP A,B
03400 FAD A,[606315546346]↔FMP A,B
03500 FAD A,[175506321276]↔FMP A,B
03600 FAD A,[577265210372]↔FMP A,B
03700 FAD A,HALFPI↔FMPR A,C↔POP1J
03800 LIT
03900 BEND
00100 ;ACOS(X)= π/2 - ASIN(X).
00200 ;GIVEN -1 ≤ X ≤ +1 RETURN 0 ≤ ACOS(X) ≤ +π.
00300 SUBR(ACOS)
00400 BEGIN ACOS
00500 PUSH 17,ARG1↔PUSHJ 17,ASIN
00600 MOVNS 1↔FADR 1,HALFPI↔POP1J
00700 BEND
00800
00900 ;ASIN(X)=ATAN(X/SQRT(1-X↑2)).
01000 ;GIVEN -1 ≤ X ≤ +1 RETURN -π/2 ≤ ASIN(X) ≤ +π/2.
01100 SUBR(ASIN)
01200 BEGIN ASIN
01300 A←1 ↔ B←2
01400 LACN A,ARG1↔FMPR A,ARG1↔FADRI A,(1.0)
01500 JUMPE A,[ ;WAS X EITHER -1.0 OR 1.0?
01600 LAC A,HALFPI
01700 SKIPGE ARG1
01800 MOVNS A↔POP1J]
01900 PUSH 17,A↔PUSHJ 17,SQRT
02000 LAC B,ARG1↔FDVR B,1↔DAC B,ARG1 ;CALCULATE X/SQRT(1-X↑2)
02100 GO ATAN ;CALCULATE ATAN(SQRT(1-X↑2))
02200 BEND
02300
02400 SUBR(LOG)
02500 BEGIN LOG
02600 MOVM ARG1↔SKIPE 1,0↔CAMN 0,[1.0]↔POP1J
02700 ASHC 0,-33↔ADDI 0,211000↔MOVSM 0,TMP1#
02800 MOVSI 0,(-128.5)↔FADM 0,TMP1
02900 ASH 1,-10↔TLC 1,200000↔FAD 1,[-0.70710678]
03000 LAC 0,1↔FAD 0,[1.4142135]↔FDV 1,0
03100 DAC 1,TMP2#↔FMP 1,1
03200 LAC 0,[0.59897864]↔FMP 0,1
03300 FAD 0,[0.96147063]↔FMP 0,1
03400 FAD 0,[2.88539120]↔FMP 0,TMP2↔FAD 0,TMP1
03500 FMP 0,[0.69314718]↔LAC 1,0↔POP1J
03550 LIT↔VAR
03600 BEND
00100 SUBR(SQRT)
00200 BEGIN SQRT
00300 A←1 ↔ B←2 ↔ C←3
00400 LACM B,ARG1↔JUMPE B,POP1J.
00500
00600 ;LET X=F*(2↑2B) WHERE 0.25<F<1.00 THEN SQRT(X)=SQRT(F)*(2↑B).
00700 ASHC B,-=27↔SUBI B,201 ;GET EXPONENT IN B, FRACTION IN C.
00800 ROT B,-1 ;CUT EXP IN HALF, SAVE ODD BIT
00900 DAP B,L↔LSH B,-=35 ;USE THAT ODD BIT.
01000 ASH C,-10↔FSC C,177(B) ;0.25 < FRACTION < 1.00
01100
01200 ;LINEAR APPROXIMATION TO SQRT(F).
01300 DAC C,A
01400 FMP C,[0.8125↔0.578125](B)
01500 FAD C,[0.302734↔0.421875](B)
01600
01700 ;TWO ITERATIONS OF NEWTON'S METHOD.
01800 LAC B,A
01900 FDV B,C↔FAD C,B↔FSC C,-1
02000 FDV A,C↔FADR A,C↔L: FSC A,0
02100 ↑POP1J.: SUB 17,[XWD 2,2]
02200 GO @2(17)
02300 LIT
02400 BEND
00001 ;ATAN(X) = X*(B0+A1 / (Z+B1-A2 / (Z+B2-A3 / (Z+B3))) )
00020 ;WHERE Z=X↑2, IF 0<X<=1
00039 ;IF X>1, THEN ATAN(X) = PI/2 - ATAN(1/X)
00058 ;IF X>1, THEN RH(D) =-1, AND LH(D) = -SGN(X)
00077 ;IF X<1, THEN RH(D) = 0, AND LH(D) = SGN(X)
00100 SUBR(ATAN)
00200 BEGIN ATAN
00300 A←1 ↔ B←2 ↔ C←3 ↔ D←4 ↔ E←5 ↔ P←17
01000 LAC A,ARG1 ;PICK UP THE ARGUMENT IN A
01100 ATAN1: LACM B, A ;GET ABSF OF ARGUMENT
01200 CAMG B, A1 ;IF X<2↑-33, THEN RETURN WITH...
01300 POP1J ;ATAN(X) = X
01400 HLLO D, A ;SAVE SIGN, SET RH(D) = -1
01500 CAML B, A2 ;IF A>2↑33, THEN RETURN WITH
01600 GO[LAC A,HALFPI ↔POP1J]; ATAN(X) = PI/2
01700 MOVSI C, 201400 ;FORM 1.0 IN C
01800 CAMG B, C ;IS ABSF(X)>1.0?
01900 TRZA D, -1 ;IF B ≤ 1.0, THEN RH(D) = 0
02000 FDVM C, B ;B IS REPLACED BY 1.0/B
02100 TLC D, (D) ;XOR SIGN WITH > 1.0 INDICATOR
02200
02300 DAC B,E↔FMP B,B
02400 LAC C,B↔FAD C,KB3↔LAC A,KA3↔FDVM A,C
02500 FAD C,B↔FAD C,KB2↔LAC A,KA2↔FDVM A,C
02600 FAD C,B↔FAD C,KB1↔LAC A,KA1↔FDV A,C
02700 FAD A,KB0↔FMP A,E
02800
02900 TRNE D, -1 ;CHECK > 1.0 INDICATOR
03000 FSB A, HALFPI ;ATAN(A) = -(ATAN(1/A)-PI/2)
03100 SKIPGE D ;LH(D) = -SGN(B) IF B>1.0
03200 MOVNS A ;NEGATE ANSWER
03300 POP1J ;EXIT
03400 A1: 145000000000 ;2↑-33
03500 A2: 233000000000 ;2↑33
03600
03700 KB0: 176545543401 ;0.1746554388
03800 KB1: 203660615617 ;6.762139240
03900 KB2: 202650373270 ;3.316335425
04000 KB3: 201562663021 ;1.448631538
04100
04200 KA1: 202732621643 ;3.709256262
04300 KA2: 574071125540 ;-7.106760045
04400 KA3: 600360700773 ;-0.2647686202
04500 BEND
00100 ; OMEGA ← ATAN2(Y,X).
00200 SUBR(ATAN2)
00300 BEGIN ATAN2
00400 Y←1 ↔ X←2
00500 LACM Y,ARG2↔LACM X,ARG1
00600 CAML Y,X↔GO L1
00700
00800 ;HORIZONTAL TO π/2; ABS(Y) < ABS(X).
00900 LAC Y,ARG2↔FDVR Y,ARG1
01000 PUSH 17,Y↔PUSHJ 17,ATAN ; ARCTAN(Y/X)
01100 SKIPL ARG1↔POP2J ;1ST & 2ND QUADRANTS.
01200 JUMPGE Y,[
01300 FSBR Y,PI.↔POP2J] ;3RD QUADRANT.
01400 FADR Y,PI.↔POP2J ;2ND QUADRANT.
01500
01600 ;VERTICAL TO π/2; ABS(X) < ABS(Y).
01700 L1: LACN X,ARG1↔FDVR X,ARG2
01800 PUSH 17,X↔PUSHJ 17,ATAN ;ARCTAN(X/Y)
01900 SKIPG ARG2↔GO[
02000 FSB Y,PI2↔POP2J]
02100 FADR Y,PI2
02200 POP2J.: SUB 17,[XWD 3,3]↔GO @3(17)
02300
02400 PI.: 202622077325
02500 PI2: 201622077325
02600 BEND
02700
02800 END
02900 SAITRG.FAI - EOF.