From:	HENRY::IN%"JMS%arizmis.bitnet%WISCVM.WISC.EDU%SRI-KL.ARPA%relay.cs.net@rca.com"  2-FEB-1987 08:22
To:	info-vax@SRI-KL.ARPA
Subj:	HPWD.MAR continued

And here is a version of HPWD.MAR which is subtly different from Digital's,
and probably doesn't cause copyright problems:
 
+-------------------------------+
| Joel M Snyder                 |             BITNET: jms@arizmis.BITNET
| Univ of Arizona Dep't of MIS  |           ArizoNET: MRSVAX::JMS
| Tucson, Arizona 85721         |    Pseudo-PhoneNET: (602) 621-2748
+-------------------------------+
(std. disclaimer in re: nobody taking anything I say seriously)
 
        .TITLE  HPWD - Hash user password
        .IDENT  /V04-003/
 
;++
; FACILITY: User verification subroutine
;
; ABSTRACT:
;
;
; ENVIRONMENT:
;
; AUTHOR:       , CREATION DATE:
;
; MODIFIED BY:
;
;--
 
 
 
 
 
 
 
 
 
        .SUBTITLE DECLARATIONS
;
; INCLUDE FILES:
;
        $DSCDEF
        $SSDEF
;
; MACROS:
;
        .MACRO  PUSHQ   SRC
                MOVQ    SRC,-(SP)
        .ENDM   PUSHQ
 
        .MACRO  POPQ    DST
                MOVQ    (SP)+,DST
        .ENDM   POPQ
 
;
; EQUATED SYMBOLS:
;
 $OFFSET 4,POSITIVE,< -
        <OUTDSC>, -                     ; addr of encrypted output descriptor
        <PWDDSC>, -                     ; addr of password descriptor
        <ENCRYPT>, -                    ; encryption algorithm index (byte)
        <SALT>, -                       ; random number (word)
        <USRDSC> -                      ; addr of username descriptor
  >
;
; OWN STORAGE:
;
        .PSECT  _LIB$CODE       RD,NOWRT,PIC,SHR,BYTE,EXE
 
;
; AUTODIN-II polynomial table used by CRC algorithm
;
 
AUTODIN:
        .LONG   ^O00000000000,^O03555610144,^O07333420310,^O04666230254
        .LONG   ^O16667040620,^O15332650764,^O11554460530,^O12001270474
        .LONG   ^O35556101440,^O36003711504,^O32665521750,^O31330331614
        .LONG   ^O23331141260,^O20664751324,^O24002561170,^O27557371034
 
; the following table of coefficients is used by the Purdy polynomial
; algorithm.  They are prime, but the algorithm does not require this.
 
C:      .LONG   -83,    -1              ; C1
        .LONG   -179,   -1              ; C2
        .LONG   -257,   -1              ; C3
        .LONG   -323,   -1              ; C4
        .LONG   -363,   -1              ; C5
 
 
 
 
 
 
 
 
 
        .SUBTITLE Dispatch - Select encryption algorithm
;++
; FUNCTIONAL DESCRIPTION:
;
;       Smash up the password into a non-reversible number.
;
; CALLING SEQUENCE:
;
;       CALLS/CALLG
;
; INPUT PARAMETERS:
;
;       PWDDSC - Address of password descriptor
;       ENCRYPT - Encryption algorithm index (byte)
;       SALT - Random number (word)
;       USRDSC - Address of username descriptor
;
; IMPLICIT INPUTS:
;
;       NONE
;
; OUTPUT PARAMETERS:
;
;       OUTDSC - Address of output buffer descriptor
;
; IMPLICIT OUTPUTS:
;
;       NONE
;
; COMPLETION CODES:
;
;       SS$_NORMAL - password is encrypted
;
; SIDE EFFECTS:
;
;       NONE
;
;--
 
 
 
 
 
 
 
 
 
        .ENTRY  LGI$HPWD, ^M<R2,R3,R4, r5, r6>
        TSTB    ENCRYPT(AP)             ; use the CRC algorithm if the index
        beql    20$
        subl2   #20, sp                 ; get temp desc buffer on stack
        movl    sp, r6                  ; put address in r6
        movq    @USRDSC(ap), (r6)       ; put current user desc into stack desc
        cmpb    #1, ENCRYPT(ap)         ; which PURDY algorithm?
        bneq    10$
        movc5   (r6), @4(r6), #32, #12, 8(r6) ; PURDY 12 blank pad username
        movw    #12, (r6)               ; size of desc is now 12
        movab   8(r6), 4(r6)            ; point to desc buffer on stack
        brb     20$
 
10$:    movzwl  (r6), r5                ; PURDY V remove padding from username
        clrw    (r6)
        movl    4(r6), r0               ; get address of username buffer in r0
15$:    cmpb    (r0)+, #32              ; search until we find first blank
        beql    20$
        incw    (r6)                    ; increment byte count until blank found
        cmpw    #31, (r6)               ;  or 31 characters have been seen
        beql    20$                     ;   (31 is max username length)
        cmpw    r5, (r6)                ;  or entire buffer has been parsed
        beql    20$                     ;   (someone not playing by the rules)
        brb     15$
 
20$:    MOVAQ   @PWDDSC(AP), R4         ; get address of password
        tstl    (r4)                    ; if password is 0 length
        bneq    25$
        movaq   @OUTDSC(ap), r4         ; then return null password
        clrw    (r4)
        movc5   #0, (r4), #0, #8, @4(r4) ; quadword of zeroes
        brb     40$
 
25$:    MOVAQ   @OUTDSC(AP), R4         ; get pointer to output buffer
        MOVAQ   @4(R4), R4              ; point to actual buffer
        TSTB    ENCRYPT(ap)
        BGTRU   30$                     ; is zero
        MNEGL   #1, R0                  ; initial CRC
        MOVAQ   @PWDDSC(AP), R1         ; get address of password descriptor
        CRC     AUTODIN, R0, (R1), @4(R1)
                                        ; convert password to 32 bit number
        CLRL    R1                      ; high order longword will be zero
        MOVQ    R0, (R4)                ; copy result to output buffer
        BRB     40$                     ; finished with AUTODIN-II type
 
30$:    CLRQ    (R4)                    ; initialize output buffer
        MOVAQ   @PWDDSC(AP), R3         ; collapse password to quadword
        BSBB    COLLAPSE_R2
        ADDW2   SALT(AP), 3(R4)         ; add random salt to middle
        movl    r6, r3
        BSBB    COLLAPSE_R2
        PUSHAQ  (R4)                    ; push pointer to U
        CALLS   #1, PURDY               ; run U through the polynomial mod P
 
40$:    MOVL    #SS$_NORMAL, R0         ; return success
        RET                             ; return to caller
 
 
 
 
 
 
 
 
 
        .SUBTITLE COLLAPSE_R2 - Collapse bytes
 
;+
; This routine takes a string of bytes (the descriptor for which is pointed
; to by R3) and collapses them into a quadword (pointed to by R4).  It does
; this by cycling around the bytes of the output buffer adding in the bytes
; of the input string.
;-
 
COLLAPSE_R2:
        .ENABLE LSB
        MOVZWL  (R3), R0                ; obtain the number of input bytes
        BEQLU   20$                     ; skip if none
        MOVAL   @4(R3), R2              ; obtain pointer to input string
10$:    BICL3   #-8, R0, R1             ; obtain cyclic index into output buffer
        ADDB2   (R2)+, (R4)[R1]
        SOBGTR  R0, 10$                 ; loop until input string is exhausted
20$:    RSB                             ; all done
        .DISABLE LSB
 
 
 
 
 
 
 
 
 
        .SUBTITLE PURDY - Evaluate PURDY polynomial
 
;+
; This routine computes f(u) = p(u) mod P.  Where P is a prime of the form
; P = 2^64 - a.  The function p is the following polynomial:
;
;       X^n0 + X^n1*C1 + X^3*C2 + X^2*C3 + X*C4 + C5
;
; The input U is an unsigned quadword.
;-
 
        A=59                            ; 2^64 - 59 is the biggest quadword prim
e
 
        N0=1@24 - 3                     ; these exponents are prime but this
        N1=1@24 - 63                    ;  is not required by the algorithm
 
        .ENTRY  PURDY, ^M<R2,R3,R4,R5>
 
        PUSHQ   @4(AP)                  ; push U
        BSBW    PQMOD_R0                ; ensure U less than P
        MOVAQ   (SP), R4                ; maintain a pointer to X
        MOVAQ   C, R5                   ; point to the table of coefficients
        PUSHQ   (R4)
        PUSHL   #N1
        BSBB    PQEXP_R3                ; x^n1
        PUSHQ   (R4)
        PUSHL   #N0-N1
        BSBB    PQEXP_R3
        PUSHQ   (R5)+                   ; C1
        BSBW    PQADD_R0                ; X^(n0 - n1) + C1
        BSBW    PQMUL_R2                ; X^n0 + X^n1*C1
        PUSHQ   (R5)+                   ; C2
        PUSHQ   (R4)
        BSBW    PQMUL_R2                ; X*C2
        PUSHQ   (R5)+                   ; C3
        BSBW    PQADD_R0                ; X*C2 + C3
        PUSHQ   (R4)
        BSBB    PQMUL_R2                ; X^2*C2 + X*C3
        PUSHQ   (R5)+                   ; C4
        BSBW    PQADD_R0                ; X^2*C2 + X*C3 + C4
        PUSHQ   (R4)
        BSBB    PQMUL_R2                ; X^3*C2 + X^2*C3 + C4*X
        PUSHQ   (R5)+                   ; C5
        BSBW    PQADD_R0                ; X^3*C2 + X^2*C3 +C4*X + C5
        BSBW    PQADD_R0                ; add in the high order terms
        POPQ    @4(AP)                  ; replace U with f(X)
        MOVL    #SS$_NORMAL, R0         ; return success
        RET
 
PQEXP_R3:
        .ENABLE LSB
;+
; Replaces the inputs with U^n mod P where P is of the form P = 2^64 - a.
; U is a quadword, n is an unsigned longword.
;-
        POPR    #^M<R3>                 ; record return address
        PUSHQ   #1                      ; initialize
        PUSHQ   8+4(SP)                 ; copy U to top of stack for speed
        TSTL    8+8(SP)                 ; only handle n greater than 0
        BEQLU   30$
10$:    BLBC    8+8(SP), 20$
        PUSHQ   (SP)                    ; copy the current power of U
        PUSHQ   8+8(SP)                 ; multiply with current value
        BSBB    PQMUL_R2
        POPQ    8(SP)                   ; replace current value
        CMPZV   #1, #31, 8+8(SP), #0
        BEQLU   30$
20$:    PUSHQ   (SP)                    ; proceed to next power of U
        BSBB    PQMUL_R2
        EXTZV   #1, #31, 8+8(SP), 8+8(SP)
        BRB     10$
30$:    MOVQ    8(SP), 8+8+4(SP)        ; copy the return value
        MOVAQ   8+8+4(SP), SP           ; discard the exponent
        JMP     (R3)                    ; return
        .DISABLE LSB
 
 
 
 
 
 
 
 
 
        .SUBTITLE PQMOD_R0
 
;+
; Replaces the quadword U on the stack with U mod P where P is of the
; form P = 2^64 - a.
;-
 
        U = 0                           ; low longword of U
        V = U+4                         ; high longword of U
        Y = U+8                         ; low longword of Y
        Z = Y+4                         ; high longword of Y
 
PQMOD_R0:
        .ENABLE LSB
 
        POPR    #^M<R0>                 ; record return address
        CMPL    V(SP), #-1              ; replace U with U mod P
        BLSSU   10$
        CMPL    U(SP), #-A
        BLSSU   10$
        ADDL2   #A, U(SP)
        ADWC    #0, V(SP)
10$:    JMP     (R0)                    ; return
        .DISABLE LSB
 
 
 
 
 
 
 
 
 
        .SUBTITLE PQMUL_R2
 
;+
; Computes the product U*Y mod P where P is of the form 2^64 - a.
; U, Y are quadwords less than P.  The product replaces U and Y on the stack.
;
; The product may be formed as the sum of four longword multiplications
; which are scaled by powers of 2^32 by evaluating:
;
;       2^64*v*z + 2^32*(v*y + u*z) + u*y
;
; the result is computed such that division by the modulus P is avoided.
;-
 
PQMUL_R2:
        POPR    #^M<R1>                 ; record return address
        MOVL    SP, R2                  ; record initial stack value
        PUSHL   Z(R2)
        PUSHL   V(R2)
        BSBB    EMULQ
        BSBB    PQMOD_R0
        BSBB    PQLSH_R0                ; obtain 2^32*v*z
        PUSHL   Y(R2)
        PUSHL   V(R2)
        BSBB    EMULQ
        BSBB    PQMOD_R0
        PUSHL   Z(R2)
        PUSHL   U(R2)
        BSBB    EMULQ
        BSBB    PQMOD_R0
        BSBB    PQADD_R0                ; obtain (v*y + u*z)
        BSBB    PQADD_R0                ; add in the 2^32*v*z
        BSBB    PQLSH_R0                ; obtain the first two terms
        PUSHL   Y(R2)
        PUSHL   U(R2)
        BSBB    EMULQ
        BSBB    PQMOD_R0                ; obtain the third term: u*y
        BSBB    PQADD_R0                ; add it in
        POPQ    Y(R2)                   ; copy the return value
        MOVAQ   Y(R2), SP               ; point the stack to the return value
        JMP     (R1)                    ; return
 
 
 
 
 
 
 
 
 
        .SUBTITLE EMULQ
 
;+
; This routine knows how to multiply two unsigned longwords, replacing them
; with the unsigned quadword product on the stack.
;-
 
EMULQ:
        .ENABLE LSB
        EMUL    4(SP), 8(SP), #0, -(SP)
        CLRL    -(SP)
        TSTL    4+8+4(SP)               ; check both longwords to see if we must
        BGEQ    10$                     ;  compensate for the unsigned bias
        ADDL    4+8+8(SP), (SP)
10$:    TSTL    4+8+8(SP)
        BGEQ    20$
        ADDL    4+8+4(SP), (SP)
20$:    ADDL    (SP)+, 4(SP)            ; add in the compensation
        POPQ    4(SP)                   ; replace the longwords with their produ
ct
        RSB
        .DISABLE LSB
 
 
 
 
 
 
 
 
 
        .SUBTITLE PQLSH_R0
 
;+
; This routine computes the product 2^32*U mod P where P is of the form
; P = 2^64 - a.  U is a quadword less than P.  The product replaces U on the sta
ck.
;
; This routine is used by PQMUL in the formation of quadword products in
; such a way as to avoid division by the modulus P.
; The product 2^64*v + 2^32*u is congruent a*v + 2^32*u mod P (where u, v are
; longwords).
;+
 
PQLSH_R0:
        .ENABLE LSB
 
        POPR    #^M<R0>                 ; record return address
        PUSHL   V(SP)
        PUSHL   #A
        BSBB    EMULQ                   ; push a*v
        ASHQ    #32, Y(SP), Y(SP)       ; form Y = 2^32*u
        BRB     10$                     ; return the sum U + Y mod P.
 
PQADD_R0:
;+
; Computes the sum U + Y mod P where P is of the form P = 2^64 - a.
; U, Y are quadwords less than P.  The sum replaces U and Y on the stack.
;-
 
        POPR    #^M<R0>                 ; record return address
10$:    ADDL2   U(SP), Y(SP)            ; add the low longwords
        ADWC    V(SP), Z(SP)            ; add the high longwords with the carry
        BCS     20$                     ; if the result is greater than a quadwo
rd
        CMPL    Z(SP), #-1
        BLSSU   30$
        CMPL    Y(SP), #-A              ; or simply greater than or equal to P
        BLSSU   30$
20$:    ADDL2   #A, Y(SP)               ; we must subtract P
        ADWC    #0, Z(SP)
30$:    MOVAQ   Y(SP), SP               ; point the stack to the return value
        JMP     (R0)                    ; return
 
        .DISABLE LSB
 
 
 
 
 
 
 
 
 
        .END
 
