X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fdectapes%2Fdectape2%2Fdlog.ra;fp=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fdectapes%2Fdectape2%2Fdlog.ra;h=00a6fe7f3d3f1a07a9378fc1d8576b7b726b9478;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=0000000000000000000000000000000000000000;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git

diff --git a/sw/os8/v3d/sources/fortran/dectapes/dectape2/dlog.ra b/sw/os8/v3d/sources/fortran/dectapes/dectape2/dlog.ra
new file mode 100644
index 0000000..00a6fe7
--- /dev/null
+++ b/sw/os8/v3d/sources/fortran/dectapes/dectape2/dlog.ra
@@ -0,0 +1,234 @@
+/
+/
+/	D L O G
+/	- - - -
+/
+/ VERSION 5A 4-27-77  PT
+/
+/LOGE(X)
+/
+/X=2^N*F
+/
+/LOGE(X)
+ /= N*LOGE(2)+LOGE(F)
+/
+/
+	SECT	DLOG
+	JA	#DALOG
+	DPCHK
+/
+/IF X<=0 - IT IS AN ERROR
+	EXTERN	#ARGER
+DALERR,	TRAP4	#ARGER
+/
+	TEXT	+DLOG  +
+DALXR,	SETX	XRDAL
+	SETB	BPDAL
+BPDAL,	F 0.0
+XRDAL,	F 0.0
+	F 0.0
+	ORG 10*3+BPDAL
+	FNOP
+	JA	DALXR
+	0
+DALRTN,	JA	.
+N,	F 0.0
+	F 0.0
+F,	F 0.0
+	F 0.0
+DAL1,	F 1.0
+	F 0.0
+/
+DT7,	7776		/1/7
+	2222
+	2222
+	2222
+	2222
+	2221
+DT6,	7776		/-1/6
+	5252
+	5252
+	5252
+	5252
+	5252
+DT5,	7776		/1/5
+	3146
+	3146
+	3146
+	3146
+	3146
+DT4,	7776		/-1/4
+	4000
+	0
+	0
+	0
+	0
+DT3,	7777		/1/3
+	2525
+	2525
+	2525
+	2525
+	2524
+DT2,	7777		/-1/2
+	4000
+	0
+	0
+	0
+	0
+/
+A0,	F 1.84375
+	F 0.0
+A1,	F 1.65625
+	F 0.0
+A2,	F 1.500
+	F 0.0
+A3,	F 1.375
+	F 0.0
+A4,	F 1.250
+	F 0.0
+A5,	F 1.1875
+	F 0.0
+A6,	F 1.09375
+	F 0.0
+A7,	F 1.03125
+	F 0.0
+LA0,	0		/.6118015411059928976
+	2344
+	7603
+	2325
+	4250
+	3144
+LA1,	0		/.5045560107523952859
+	2011
+	2512
+	4551
+	3503
+	7657
+LA2,	7777		/.4054651081081643810
+	3174
+	6217
+	5457
+	7141
+	1370
+LA3,	7777		/.3184537311185346147
+	2430
+	3057
+	0207
+	0573
+	0232
+LA4,	7776		/.2231435513142097553
+	3443
+	7737
+	0746
+	5150
+	4146
+LA5,	7776		/.1718502569266592214
+	2577
+	6301
+	6051
+	7117
+	2356
+LA6,	7775		/.08961215868968712374
+	2674
+	1512
+	1271
+	2655
+	1272
+LA7,	7773		/.030771658666753687
+	3740
+	5154
+	1636
+	0313
+	7764
+D16,	F 16.0
+	F 0.0
+D8,	F 8.0
+	F 0.0
+CUM,	F 0.0
+	F 0.0
+DLOGE2,	0
+	2613
+	4413
+	7676
+	4347
+	5715
+/
+/PICK UP X
+	BASE	0
+#DALOG,	STARTD
+	FLDA	10*3
+	FSTA	DALRTN
+	FLDA	0
+	SETX	XRDAL
+	SETB	BPDAL
+	BASE	BPDAL
+	LDX	1,1
+	FSTA	BPDAL
+	FLDA%	BPDAL,1		/ADDRESS
+	FSTA	BPDAL
+	STARTE
+	FLDA%	BPDAL		/AND X
+	JLE	DALERR		/X <= 0 IS ERROR
+	FSUB	DAL1		/SUB 1.0
+	JNE	DALA
+	FCLA			/LOG(1)=0
+	JA	DALRTN
+/
+DALA,	FADD	DAL1		/ADD BACK
+	FSTA	XRDAL		/STORE AT X
+/EXPONENT STORED IN XR0
+/MANTISSA STORED IN XR1-5
+/PICK UP EXP + MULTIPLY BY LOGE(2)
+/
+	XTA	0
+	FMUL	DLOGE2
+	FSTA	N		/N*LOGE(2)
+/XRDAL IS NOW FRACTION IN RANGE .5<=F<1.0
+/COMPUTE LOG(F) BY
+/LOG(F)=LOG(A(K1)*A(K2)...(F))-(LOG(A(K1))+
+/	LOG(A(K2))...)
+/FIT F IN A 1/16 RANGE
+/I.E. 1/2-9/16,9/16-10/16,ETC.
+/MULTIPLY F BY APPROPRIATE A(K) MULTIPLIER
+/KEEP RUNNING SUM OF LOG(A(K))
+/CONTINUE UNTIL F>1
+
+/
+	LDX	0,0
+	FLDA	XRDAL
+	FSTA	F
+	FCLA
+	FSTA	CUM
+DALB,	FLDA	F
+	FMUL	D16	/16 REAL PARTS
+	FSUB	D8		/NEED JUST 8
+	ATX	1
+	FLDA	A0,1		/GET MULTIPLIER
+	FMULM	F
+	FLDA	LA0,1		/ADD LOG(A(K)) TO SUM
+	FADDM	CUM
+	FLDA	F
+	FSUB	DAL1
+	JLT	DALB
+/NOW F>1. USE TAYLOR SERIES
+/LOG(T)=Z-(Z^2)/2+(Z^3)/3+...  WHERE Z=T-1
+	FLDA	F
+	FSUB	DAL1	/F-1.0
+	FSTA	F
+	FMUL	DT7
+	FADD	DT6
+	FMUL	F
+	FADD	DT5
+	FMUL	F
+	FADD	DT4
+	FMUL	F
+	FADD	DT3
+	FMUL	F
+	FADD	DT2
+	FMUL	F
+	FADD	DAL1
+	FMUL	F
+	FSUB	CUM
+	FADD	N
+	JA	DALRTN
+