TITLE MLOG

	DEFINE DCONST(DX,Y)
<	MOVM AC1,DX
	MOVEI AC0,0
	LSHC AC0,11
	SUBI AC0,200
	ADD AC0,[200000000000]
	SKIPGE DX
	MOVNM AC0,AC0
	MOVEM AC0,Y
	MOVE AC0,DX
	MOVE AC1,DX+1
	SKIPGE AC0
	DFN AC0,AC1
	LSH AC1,11
	LSHC AC0,10
	TLZ AC0,400000
	LSH AC1,-1
	MOVEM AC0,Y+1
	MOVEM AC1,Y+2
	ZAP (Y,3)   >

	DEFINE ZAP(A,B)
<	MOVE AC2,PREC
	MOVEI AC1,B
	AOS AC2
	CAIG AC2,B
	JRST .+4
	SOS AC2
	SETZM A(AC2)
	JRST .-4 >

	DEFINE DPVAL(X,DY,%ODDERR,%ASS)
<	MOVM AC0,X
	SUB AC0,[200000000000]
	ADDI AC0,200
	MOVEM AC0,EXP#
	TDZE AC0,[777777777400]
	JRST ERROR#
	MOVE AC1,X+1
	MOVE AC2,X+2
	TRNE AC2,100000
	AOS AC2
	JUMPL AC2,%ODDERR
%ASS:	LSH AC2,1
	LSHC AC1,1
	LSHC AC0,33
	LSH AC1,-33
	LSHC AC1,^D18
	MOVE AC2,EXP
	SUBI AC2,33
	LSH AC2,^D27
	IOR AC1,AC2
	SKIPGE X
	DFN AC0,AC1
	MOVEM AC0,DY
	MOVEM AC1,DY+1
	JRST .+7
%ODDERR:	AOS AC1
	TLZN AC2,400000
	JRST %ASS
	LSHC AC1,-1
	JRST %ASS  >

	DEFINE SETPREC (N)
<	MOVEI AC0,N
	MOVEM AC0,PREC#>

	DEFINE ICON(I,Y)
<	MOVM AC1,I
	JFFO AC1,.+1
	SOS AC2
	LSH AC1,0(AC2)
	SUBI AC2,^D35
	MOVNM AC2,AC2
	ADD AC2,[200000000000]
	SKIPGE I
	MOVNM AC2,AC2
	MOVEM AC2,Y
	MOVEM AC1,Y+1
	ZAP (Y,2)  >
	DEFINE COPY(X,Y)
<	IRP Y<
	HRLI AC2,X
	HRRI AC2,Y
	MOVE AC1,PREC
	ADDI AC1,Y
	HRRM AC1,.+1
	BLT AC2,.>>

	DEFINE MADD(X,Y,Z)
<	JSA 16,MADD
	EXP X,Y,PREC,Z
	JRST OUTNOW>

	DEFINE MMUL(X,Y,Z)
<	JSA 16,MMULT
	EXP X,Y,PREC,Z
	JRST 2  >

	DEFINE MDIV(X,Y,Z)
<	JSA 16,MDIV
	EXP X,Y,PREC,Z
	JRST 3  >

	EXTERN MADD,MMULT,MDIV

	ENTRY MLOG

MLOG:	0
	MOVE 0,@0(16)
	JUMPN	AC0, ONE
	MOVE	AC0, [400000000001]
	SETZ	AC1,
	JRA	16, 1(16)
ONE:	HRRI	AC1,@0(16)
	AOS AC1
	HRRM AC1,.+1
	MOVE AC1,.
	CAMN	AC0, [201400000000]
	JUMPE	AC1, .+2
	JRST	CONT
	SETZB	AC0, AC1
	JRA	16, 1(16)
CONT:	MOVEM AC0,DX
	MOVEM AC1,DX+1
	DCONST(DX,X)
S0:	SETPREC(2)
	MOVE	AC0, X
	SUB	AC0, [200000000000]
	MOVEM	AC0, T1
	ICON	(T1,XP)
	MMUL	(XP,LOGE2,XP)
	HRLZI	AC0, 200000
	MOVEM	AC0, X
	MADD	(X,MONES,X)
	COPY	(X,<SUM,TERM>)
	COPY	(TWO,N)
ARTHUR:	MMUL	(TERM,X,TERM)
	MOVE	AC0, TERM
	MOVNM	AC0, TERM
	MDIV	(TERM,N,T1)
	MADD	(T1,SUM,SUM)
	MADD	(N,ONES,N)
	MOVM	AC4, SUM
	MOVM	AC5, T1
	SUB	AC4, AC5
	CAIGE	AC4, ^D70
	JRST	ARTHUR
	MADD	(SUM,XP,SUM)
OUTNOW:	DPVAL(SUM,DANS)
	MOVE AC0,DANS
	MOVE AC1,DANS+1
	JRA 16,1(16)
DANS:	BLOCK 2
DX:	BLOCK 2
ONES:	OCT	200000000001,200000000000,0
MONES:	OCT	577777777777,200000000000,0
TWO:	OCT	200000000002,200000000000,0
LOGE2:	OCT	200000000000,261344137676,216367465331,0
TERM:	BLOCK 3
N:	BLOCK 3
SUM:	BLOCK 3
XP:	BLOCK 3
T1:	BLOCK 3
X:	BLOCK 3
	AC5=5
	AC4=4
	AC0=0
	AC1=1
	AC2=2
	AC3=3

	END