TITLE MSQRT

	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 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 Q,MADD
	EXP X,Y,PREC,Z
	JFCL	0  >


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


	EXTERN MADD,MDIV
	ENTRY MSQRT


MSQRT:	0
	MOVM 0,@0(Q)
	JUMPN	AC0, CONT
	SETZB	AC0, AC1
	JRA	Q, 1(Q)
CONT:	HRRI AC1,@0(Q)
	AOS AC1
	HRRM AC1,.+1
	MOVM AC1,.
	MOVEM AC0,DX
	MOVEM AC1,DX+1
S0:	SETPREC(2)
	DCONST	(DX,N)
	COPY	(N,X1)
AGNES:	MDIV	(N,X1,X2)
	MADD	(X2,X1,X2)
	MOVE	AC0,X2
	SOJ	AC0,
	MOVEM	AC0,X2
	MOVN	AC0, X1
	MOVN	AC1, X2
	SUB	AC0, AC1
	JUMPN	AC0, AGAIN
	MOVE	AC0, X1+1
	MOVE	AC1, X2+1
	SUB	AC0, AC1
	JUMPN	AC0, AGAIN
	MOVE	AC0, X1+2
	MOVE	AC1, X2+2
	SUB	AC0, AC1
	MOVM	AC0, AC0
	CAIG	AC0, 1
	JRST	OUTNOW
AGAIN:	COPY	(X2,X1)
	JRST	AGNES
OUTNOW:	DPVAL	(X2,DANS)
	MOVE AC0,DANS
	MOVE AC1,DANS+1
	JRA Q,1(Q)

DANS:	BLOCK 2
DX:	BLOCK 2
ONES:	OCT 200000000001,200000000000,0,0
N:	BLOCK	4
X1:	BLOCK	4
X2:	BLOCK	4
	AC0=0
	AC1=1
	AC2=2
	Q=	16

	END