Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_1_19910112 - 7/ft3/monitor/stanford/crypt.mac
There are 24 other files named crypt.mac in the archive. Click here to see a list.
;[MACBETH]SRC:<7.FT2.MONITOR.STANFORD>CRYPT.MAC.3,  4-Apr-88 22:55:49, Edit by A.APPLEHACKS
; FT7.2 merge
; UPD ID= 8495, RIP:<7.MONITOR>CRYPT.MAC.2,   9-Feb-88 12:18:37 by GSCOTT
;TCO 7.1218 - Update copyright notice.
;[MACBETH]SRC:<7.FT1.MONITOR.STANFORD>CRYPT.MAC.2, 22-Jan-88 15:31:28, Edit by A.APPLEHACKS
; FT7 merge
;
;------------------------- Autopatch Tape # 13 -------------------------
;------------------------- Autopatch Tape # 12 -------------------------
;<6-1-MONITOR.FT6>CRYPT.MAC.2, 12-Aug-85 17:01:15, Edit by WHP4
; FT6 merge
;Stanford changes:
; Code for Stanford password encryption algorithm
;
; UPD ID= 2058, SNARK:<6.1.MONITOR>CRYPT.MAC.9,   3-Jun-85 14:22:56 by MCCOLLUM
;TCO 6.1.1406  - Update copyright notice.
; UPD ID= 1391, SNARK:<6.1.MONITOR>CRYPT.MAC.8,  22-Jan-85 14:59:05 by LEACHE
;TCO 6.1.1149 Simplify CHKPEV
; UPD ID= 4515, SNARK:<6.MONITOR>CRYPT.MAC.7,  13-Jul-84 19:29:14 by PURRETTA
;Update copyright notice
; UPD ID= 2221, SNARK:<6.MONITOR>CRYPT.MAC.6,   8-Apr-83 14:49:14 by LEACHE
;Suppress MN%DPV and MX%DPV
; UPD ID= 2128, SNARK:<6.MONITOR>CRYPT.MAC.5,   2-Apr-83 22:46:23 by LEACHE
;Move customer dispatch tables to STG

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 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 THAT IS NOT SUPPLIED BY DIGITAL.

	SEARCH PROLOG,MONSYM
	TTITLE CRYPT
	SWAPCD

;Encryption routines
; Routine to encrypt a password


; Accepts in T1/ Password encryption version number to use
;	     T2/ Lookup pointer to JSB block containing password
; Returns:
;	 +1 Invalid password encryption version number
;	 +2 with T1 containing lookup pointer to encrypted block
;		-(LEN-1),,TEXT-1
;		Suitable for use by SETMSK and CPYDIR
;
; Called and returns NOINT because of the JSB block

	;Dispatch table for DEC password encryption version
DECDIS:	[RETSKP]		;Version 0 (Unencrypted)
	  MN%DPV==:.-DECDIS-1	  ;Current Minimum DEC password encryption version
	HSHPWD			;Version 1
	  MX%DPV==:.-DECDIS-1	  ;Current Maximum DEC password encryption version
	[RET]			;Version 2
	[RET]			;Version 3
	[RET]			;Version 4
	[RET]			;Version 5
	[RET]			;Version 6
	[RET]			;Version 7
	[RET]			;Version 10

	;Customer encryption routines, customer dispatch table, customer
	;version interval, and current encryption version for this monitor
	;are defined in STG.  See label PSENVR:


ENCPAS::CALL CHKPEV		;Check validity of password encryption
				; version number
	  RET			;Bad version
	TRZN T1,1B18		;Customer version number?
	SKIPA T3,DECDIS(T1)	;No, get DEC dispatch address
	MOVE T3,CUSDIS(T1)	;Yes, get customer dispatch address
	JRST (T3)		;Go to it
	;Routine to range-check password encryption version number
	;T1/  DEC/customer version number
	;RETURNS:	+1	Bad version number
	;		+2	Good version number

CHKPEV::CAIL T1,MN%DPV		;Within DEC interval?
	CAILE T1,MX%DPV		;...
	SKIPA			;No
	RETSKP			;Yes, return success
	
	CAML T1,MINCPV		;Within customer interval?
	CAMLE T1,MAXCPV		;...
	RET			;Neither DEC nor customer, return failure
	RETSKP			;Yes, return success
	;Routine for polynomial password encryption
	;This computes  P^(2^30+36) +A1*P^(2^30) +A2*P^3 +A3*P^2 +A4*P +A5

HSHPWD:	SAVEP			;Make use of all P's
	STKVAR <HSHVER,HSHPTR>	;Two locals
	MOVEM T1,HSHVER		;Save version number
	MOVEM T2,HSHPTR		;Save lookup pointer
	SKIPN 1(T2)		;Is there anything?
	RETSKP			;No, leave it like that
	SKIPN HSHVER		;Version 0 password?
	RETSKP			;Yes, leave it unencrypted
	MOVE T1,T2		;Copy block address
	MOVEI P5,4		;Number of double word groups to encode
;	SETZB P3,P4		;Start with real first word
	dmove p3,3(a)		;push different hash to up to 20 chars
HSHPW1: TDC P3,1(A)		;First half
	TDC P4,2(A)		;Second half
	DMOVE P1,P3		;Double word to encode
	LSHC P1,-1		;Put significant bits where they belong
	DDIV P1,HSHMOD		;Take mod
	DMOVE C,P3		;Save original number
	MOVEI B,5		;Loop count
HSHPW2: DMOVE P1,P3		;Copy number for square
	DMUL P1,P3		;Square it
	DDIV P1,HSHMOD		;Take mod
	SOJG B,HSHPW2		;Loop to raise it to the 32 power
	DMOVEM P3,1(A)		;Save Pwd^32
	DMOVE P1,P3		;Move for multiply
	DMUL P1,C		;Make Pwd^33
	DDIV P1,HSHMOD		;Take mod
	DADD P3,HSHA1		;Add in first coefficient
	SETZB P1,P2		;Make quad-word
	DDIV P1,HSHMOD		;Take mod
	DMOVE P1,1(A)		;Get Pwd^32 back
	DMOVEM P3,1(A)		;Save A1+Pwd^33
	DMOVE P3,P1		;Copy for square
	MOVEI B,^D25		;Loop count
HSHPW3: DMUL P1,P3		;Square it
	DDIV P1,HSHMOD		;Take mod
	DMOVE P1,P3		;Copy for square
	SOJG B,HSHPW3		;Loop to produce (Pwd^(2^30))
	DMUL P1,1(A)		;Multiply by A1+Pwd^33
	DDIV P1,HSHMOD		;Take mod
	SKIPE HSHVER		;Add second coefficient?
	DADD P3,HSHA2		;Yes
	SETZB P1,P2		;Make a quad-word
	DDIV P1,HSHMOD		;Take mod
	SETZ B,			;Offset for coefficients
HSHPW4: DMOVE P1,P3		;Move for multiply
	DMUL P1,C		;Multiply by Pwd
	DDIV P1,HSHMOD		;Take mod
	DMOVE P1,P3		;Move for multiply
	SKIPN HSHVER		;Multiply by next coefficient?
	DMUL P1,HSHA3(B)	;Yes
	SKIPE HSHVER		;Add next coefficient?
	DADD P1,HSHA3(B)	;Yes
	DDIV P1,HSHMOD		;Take mod
	ADDI B,2		;Next coefficient
	CAIGE B,6		;Only 3 more coefficients
	JRST HSHPW4		;Keep going
	LSHC P3,1		;Make it Ascii again
	MOVE P1,[BYTE(7) 040,040,040,040,040]
	MOVE P2,P1
	TDZ P3,[BYTE(7) 100,100,100,100,100(1)1]
	TDZ P4,[BYTE(7) 100,100,100,100,100(1)1]
	ANDCM P1,P3		;Do necessary
	ANDCM P2,P4		;   work to
	LSHC P1,1		;   make
	TDO P3,P1		;   printable
	TDO P4,P2		;   Ascii
	DMOVEM P3,1(A)		;Store encoded Ascii password doubleword
	ADDI A,2		;Point to next doubleword
	SOJG P5,HSHPW1		;Do all 4 doublewords
	SETZ B,			;Append a zero
	SUBI A,8
	DPB B,[POINT 8,8(A),35]	;To make string Asciz
	MOVE A,HSHPTR		;Restore block pointer
	RETSKP			;Return Noint

HSHMOD: OCT 377777777777,377777777735	;(2^70-35) prime modulus
HSHA1:	OCT 305301317120,157221260120	;The randomly chosen coefficients
HSHA2:	OCT 147300565442,275156661305
HSHA3:	OCT 276504256001,246721554756
	OCT 226461502774,377222042231
	OCT 040267005300,343010077117
IFN STANSW,<
;HASHPW - JACKET FOR OLD TENEX PASSWORD HASH ROUTINE
;TAKES	T2/ -(LEN-1),,TEXT-1, I.E. POINTER TO PLAIN TEXT STRING
;RETURNS +1 FAILURE
;	 +2 SUCCESS, T1/ -(LEN-1),,TEXT-1, I.E. POINTER TO ENCRYPTED STRING

HASHPW::STKVAR <<HSHCOD,2>,HSHPTR,HSHBLK> ;DECLARE LOCAL STORAGE
	MOVEM T2,HSHBLK		;SAVE ORIGINAL BLOCK POINTER
	MOVEI T2,1(T2)		;TEXT BEGINS HERE
	HRLI T2,(POINT 7,)	;SET UP BYTE POINTER
	MOVEM T2,HSHPTR		;SAVE POINTER TO PLAINTEXT BLOCK
	CALL HASHPM		;COMPUTE HASH CODE
	 RET			;NO FREE STORAGE FOR CALCULATIONS  
	DMOVEM T3,HSHCOD	;SAVE HASH CODE
	MOVE T2,HSHPTR		;SET UP BYTE POINTER
	MOVE T4,0+HSHCOD	;TURN FIRST HASH WORD INTO ASCII
	CALL HSHCPY		; ...
	MOVE T4,1+HSHCOD	;TURN SECOND HASH WORD INTO ASCII
	CALL HSHCPY		; ...
	MOVEI T1,.CHNUL		;TIE OFF STRING WITH A NUL
	IDPB T1,T2		; ...
	MOVE T1,HSHBLK		;RETURN THE EXPECTED BLOCK POINTER
	RETSKP			;SUCCESS RETURN TO CALLER

;HSHCPY - HELP ROUTINE.  CONVERTS BINARY NUMBER TO ASCII STRING.
;TAKES	T2/ BYTE POINTER
;	T4/ 36 BITS OF BINARY HASH CODE

HSHCPY:	MOVEI T1,^D12		;COUNT TWELVE BYTES
HSHCP0: SETZ T3,		;CLEAR ACCUMULATION AC
	LSHC T3,3		;GET ONE OCTAL DIGIT
	MOVEI T3,"0"(T3)	;CONVERT TO ASCII
	IDPB T3,T2		;ADD TO THE STRING
	SOJG T1,HSHCP0		;LOOP OVER STRING
	RET			;RETURN TO CALLER
;HASHPM - converts an ASCIZ password string into a 72-bit code
;Takes  T2/ byte pointer to non-null password
;Returns +1 failure, no free storage
;	 +2 success, T3,T4/ 72-bit hash code
;
;This code is from TENEX 1.34 (BBN), which is a modification of the system
;  used by Johnson and Thomas in RSEXEC
;For mathematical technique and credits, see:  Purdy, CACM Aug 74;
;  and Knuth Volume 2 Section 4.6.3
;Routine has been modified to assume a TOPS-20 Release 6 environment.
;
;The following ACs are used as shown:
; Q1/ first arg to arithmetic routines
; Q2/ second arg
; P2/ result (all three of these point to a 2-word datum)
; P3/ pointer to scratch area in JSB storage
; Q1 and Q3 are also used for string copying.

HASHPM:	SAVEPQ			;PRESERVE REGISTERS
	MOVE Q1,T2		;COPY BYTE POINTER
	MOVEI T2,31		;LENGTH OF FREE AREA NEEDED
	CALL ASGJFR		;GET IT FROM JSB AREA
	 RETBAD()		;NO FREE JSB SPACE
	MOVE P3,T1		;P3 GETS JSB POINTER
	MOVEI Q3,0		;NO CHAR'S SEEN YET
	PUSH P,BHC+0		;TWO WORDS OF ZERO ON THE STACK
	PUSH P,BHC+0		;INTO WHICH WILL BE XOR'ED THE TEXT.
HPWL1:	ILDB T2,Q1		;GET NEXT CHARACTER
	JUMPE T2,HSHPM1		;JUMP IF END OF STRING
	MOVEI T3,(Q3)		;CHARACTER NUMBER
	IDIVI T3,^D10		;GET INDEX INTO SHIFT/XOR TABLES
	XCT HPWTB1(T4)		;NOW SHIFT CHARACTER
	XCT HPWTB2(T4)		;AND XOR IT ONTO STACK
	CAIGE Q3,MAXLC-1	;QUIT AT MAXIMUM CHARACTERS
	 AOJA Q3,HPWL1		;MORE TO GO.
HSHPM1:	POP P,T4		;NOW HAVE FIRST LEVEL MESS ON STACK
	POP P,T3		;GET IT BACK TO AC'S, PUT IT IN JSB FREE
	DMOVEM T3,25(P3)	;STORAGE AREA, AT CINPUT AND
	DMOVEM T3,13(P3)	;AT FF ALSO.
	MOVEI Q1,25(P3)		;MULMPD(CINPUT,CINPUT) TO T3
	MOVEI Q2,(Q1)		;..
	MOVEI P2,7(P3)
	CALL MULMPD
	MOVEI Q1,7(P3)		;MULMPD(T3,CINPUT) TO T2
	MOVEI Q2,25(P3)
	MOVEI P2,5(P3)
	CALL MULMPD
	PUSH P,BITS+^D12	;SLIDE A BIT ALONG TO COMPUTE SUM
HSHPM2:	MOVEI Q1,13(P3)		;MULMPD(FF,FF) TO FF
	MOVEI Q2,(Q1)
	MOVEI P2,(Q1)
	CALL MULMPD
	MOVE T1,HASHN1		;CHECK BIT IN MAGIC CONSTANT
	TDNN T1,0(P)		;..
	 JRST HSHPX1		;NOT ON, DON'T ADD IN THIS TERM
	MOVEI P2,13(P3)		;MULMPD(FF,CINPUT) TO FF
	MOVEI Q1,(P2)
	MOVEI Q2,25(P3)
	CALL MULMPD
HSHPX1:	MOVE T1,0(P)
	LSH T1,-1		;SLIDE BIT TO RIGHT
	MOVEM T1,0(P)
	JUMPN T1,HSHPM2		;LOOP UNTIL 24 BITS DONE
	ADJSP P,-1		;DONE. DISCARD FLOATING BIT
	MOVE T1,13(P3)		;FF TO T1
	MOVE T2,14(P3)
	MOVEM T1,3(P3)
	MOVEM T2,4(P3)
	MOVEI Q1,5(P3)		;MULMPD(T2,T2) TO FF
	MOVEI Q2,(Q1)		;P**6
	MOVEI P2,13(P3)
	CALL MULMPD
	MOVEI Q1,13(P3)		;MULMPD(FF,FF) TO FF
	MOVEI Q2,(Q1)		;P**12
	MOVEI P2,(Q1)
	CALL MULMPD
	MOVEI Q1,13(P3)		;MULMPD(FF,T3) TO FF
	MOVEI Q2,7(P3)		;P**14
	MOVEI P2,13(P3)
	CALL MULMPD
	MOVEI Q1,3(P3)		;MULMPD(T1,FF) TO T0
	MOVEI Q2,13(P3)		;P**N0
	MOVEI P2,1(P3)
	CALL MULMPD
HSHPM3:	MOVEI Q1,1(P3)		;NOW COMPUTE TERMS OF FINAL SERIES
	MOVEI Q2,HASHA0		;T0=T0*A0
	MOVEI P2,1(P3)
	CALL MULMPD
	MOVEI Q1,3(P3)		;T1=T1*A1
	MOVEI Q2,HASHA1
	MOVEI P2,3(P3)
	CALL MULMPD
	MOVEI Q1,5(P3)		;T2=T2*A2
	MOVEI Q2,HASHA2
	MOVEI P2,5(P3)
	CALL MULMPD
	MOVEI Q1,7(P3)		;T3=T3*A3
	MOVEI Q2,HASHA3
	MOVEI P2,7(P3)
	CALL MULMPD
	MOVE T1,HASHA4		;T4=A4
	MOVE T2,HASHA4+1
	MOVEM T1,11(P3)
	MOVEM T2,12(P3)

;NOW ADD UP THE TERMS OF THE SERIES
	DMOVE T1,1(P3)		;FF=T0
	DMOVEM T1,13(P3)
	MOVEI Q1,3(P3)		;FF=FF+T1
	CALL ADDMPD
	MOVEI Q1,5(P3)		;FF=FF+T2
	CALL ADDMPD
	MOVEI Q1,7(P3)		;FF=FF+T3
	CALL ADDMPD
	MOVEI Q1,11(P3)		;FF=FF+T4
	CALL ADDMPD
	DMOVE T1,13(P3)		;XFRM=FF
	DMOVEM T1,27(P3)
	MOVEI Q1,27(P3)		;XFRM=MODP(XFRM)
	MOVEI P2,27(P3)
	CALL MODP
	PUSH P,27(P3)		;SAVE ANSWER ON STACK
	PUSH P,30(P3)
	MOVEI T1,JSBFRE		;PREPARE TO RETURN SCRATCH AREA
	MOVEI T2,(P3)		;..
	CALL RELFRE		;RETURN THE BLOCK
	POP P,T4		;HERE'S THE ANSWER
	POP P,T3		;..
	RETSKP			;AND RETURN HASH IN T3,T4
;CONSTANTS

HPWTB1:	REPEAT 2,<	JFCL
	LSH T2,7
	LSH T2,^D14
	LSH T2,^D21
	LSH T2,^D28
>
HPWTB2:	REPEAT 5,<	XORM T2,0(P)>
	REPEAT 5,<	XORM T2,-1(P)>

HASHN1:	100,,13			;2**24+11.
PA==^D59
PRIME:	3777,,-1
	377777,,-PA
K270P:	0
	^D64*PA
HASHA0:	127,,533602
	240563,,422132
HASHA1:	053,,542132
	020301,,633454
HASHA2:	311,,555236
	347001,,45671
HASHA3:	123,,106405
	245330,,106744
HASHA4:	155,,226337
	124357,,220100
;THE DOUBLE WORD MULTIPLY ROUTINE
MULMPD:	MOVE T1,1(Q1)
	MUL T1,1(Q2)
	DMOVEM T1,15(P3)
	MOVE T1,0(Q1)
	MUL T1,1(Q2)
	DMOVEM T1,21(P3)
	MOVE T1,1(Q1)
	MUL T1,0(Q2)
	DMOVEM T1,17(P3)
	MOVE T1,0(Q1)
	MUL T1,0(Q2)
	DMOVEM T1,23(P3)
MLM00:	MOVEI T3,0
	MOVE T1,20(P3)
	ADD T1,22(P3)
	TXZE T1,1B0
	 ADDI T3,1
	ADD T1,15(P3)
	TXZE T1,1B0
	 ADDI T3,1
	MOVEM T1,15(P3)
	MOVE T1,T3
	ADD T1,17(P3)
	MOVEI T3,0
	TXZE T1,1B0
	 ADDI T3,1
	ADD T1,21(P3)
	TXZE T1,1B0
	 ADDI T3,1
	ADD T1,24(P3)
	TXZE T1,1B0
	 ADDI T3,1
	MOVEM T1,24(P3)
	ADDB T3,23(P3)
MLM01:	IOR T3,T1
	JUMPE T3,MULMPX

;FIRST RECURSION NEEDED IF GET HERE. USE "LH" CELLS OVER
;FOR "LL". ON THIS PASS, LH AND HH WOULD BE 0, BECAUSE K270P IS SMALL.

MLM02:	MOVE T1,24(P3)
	MUL T1,K270P+1
	DMOVEM T1,17(P3)
	MOVE T1,23(P3)
	MUL T1,K270P+1
	DMOVEM T1,21(P3)
	ADD T2,17(P3)
	TXZN T2,1B0
	 TDZA T3,T3
	  MOVEI T3,1
	MOVEM T2,17(P3)
	ADD T3,21(P3)
	MOVEM T3,24(P3)
	SETZM 23(P3)
	JUMPE T3,MLMRDG		;JUMP UNLESS NEED TO RECURSE AGAIN
;HERE ON SECOND RECURSION. NOW WILL GET JUST A SINGLE WORD ANSWER.
MLMRC2:	MOVE T1,24(P3)
	MUL T1,K270P+1
	DMOVEM T1,21(P3)
	MOVEI T3,0
	ADD T2,20(P3)
	TLZE T2,(1B0)
	 ADDI T3,1
	MOVEM T2,20(P3)
	ADDM T3,17(P3)

;NOW HAVE ANSWER TO FIRST RECURSION IN 17(P3), 20(P3)
MLMRDG:	MOVEI T2,0
	MOVE T3,20(P3)
	ADD T3,16(P3)
	TXZE T3,1B0
	 ADDI T2,1
	MOVEM T3,16(P3)
	ADD T2,17(P3)
	TXZN T2,1B0
	 TDZA T3,T3
	  MOVEI T3,1
	ADD T2,15(P3)
	TXZE T2,1B0
	 ADDI T3,1
	MOVEM T2,15(P3)
MLMOVL:	JUMPLE T3,MULMPX
	MOVE T1,K270P+1
	ADD T1,16(P3)
	TXZN T1,1B0
	 TDZA T2,T2
	  MOVEI T2,1
	MOVEM T1,16(P3)
	ADD T2,15(P3)
	TLZE T2,(1B0)
	 ADDI T3,1
	MOVEM T2,15(P3)
	SOJA T3,MLMOVL

MULMPX:	DMOVE T1,15(P3)
	DMOVEM T1,0(P2)
	RET			;EXIT FROM MULMPD
;DOUBLE WORD ADD MOD P ROUTINE FOR HASHED PASSWORDS

ADDMPD:	MOVE T1,1(Q1)
	MOVEI T3,0
	ADD T1,14(P3)
	TXZE T1,1B0
	 ADDI T3,1
	MOVEM T1,14(P3)
	MOVE T1,0(Q1)
	ADD T1,T3
	ADD T1,13(P3)
	TXZN T1,1B0
	 TDZA T3,T3
	  MOVEI T3,1
	MOVEM T1,13(P3)
	JUMPE T3,ADDMPN
ADDMPR:	MOVE T1,K270P+1
	ADD T1,14(P3)
	TXZN T1,1B0
	 TDZA T3,T3
	  MOVEI T3,1
	MOVEM T1,14(P3)
	MOVE T1,T3
	ADD T1,13(P3)
	TXZN T1,1B0
	 TDZA T3,T3
	  MOVEI T3,1
	MOVEM T1,13(P3)
	JUMPN T3,ADDMPR
ADDMPN:	RET
;MODULO P ROUTINE FOR HASHED PASSWORDS

MODP:	MOVE T1,0(P2)
	CAMGE T1,PRIME
	 RET
	PUSH P,Q3
	MOVE Q3,0(P2)
	LSH Q3,-^D<36-7>
	JUMPN Q3,MODPOV
MODPNO:	MOVE T1,0(P2)
	CAMLE T1,PRIME
	 JRST MODPN1
	CAME T1,PRIME
	 JRST MODPRT
	MOVE T1,1(P2)
	CAML T1,PRIME+1
	 JRST MODPN1
	JRST MODPRT
MODPRA:	DMOVEM T1,0(P2)
MODPRT:	POP P,Q3
	RET

MODPN1:	MOVE T1,1(P2)
	SUB T1,PRIME+1
	MOVEI T3,0
	TXZE T1,1B0
	 ADDI T3,1
	MOVEM T1,1(P2)
	MOVE T1,0(P2)
	SUB T1,PRIME
	SUB T1,T3
	MOVEM T1,0(P2)
	JRST MODPRT
;MORE MOD P ROUTINE

MODPOV:	PUSH P,P1
	MOVEI P1,1(P)
	PUSH P,0
	PUSH P,0
	MOVEI T1,PA
	MUL T1,Q3
	DMOVEM T1,0(P1)
	PUSH P,P2
	MOVEI P2,0(P1)
	CALL MODP		;NEED TO RECURSE.
	POP P,P2
	MOVE T1,0(P2)
	TLZ T1,774000
	ADD T1,0(P1)
	MOVEI T3,0
	TXZE T1,1B0
	 ADDI T3,1
	MOVE T2,1(P1)
	ADD T2,1(P2)
	TXZE T2,1B0
	 ADDI T1,1
	DMOVEM T1,0(P2)
	CAMGE T1,PRIME
	 JRST MODPO1
	PUSH P,P2
	CALL MODP
	POP P,P2
MODPO1:	ADJSP P,-2
	POP P,P1
	JRST MODPRT
>;IFN STANSW
	TNXEND
	END