XUMF5AU ;ISS/PAVEL - XUMF5 MD5 Hash API ;06/17/05
;;8.0;KERNEL;**383**;July 10, 1995
;
;MD5 based on info from 4.005 SORT BY VUID;;original name was 'VESOUHSH' ; Secure hash functions
;;(c) Copyright 1994 - 2004, ESI Technology Corp, Natick MA
;; This source code contains the intellectual property of its copyright holder(s),
;; and is made available under a license. If you are not familiar with the terms
;; of the license, please refer to the license.txt file that is a part of the
;; distribution kit.
;; This is a routine version where Variables and Commands set to be Upercase. Pavel
;
Q
;;**************************************************
;;MD5 'R'egular portion of the code. This will handle
;; one string at a time.
;;**************************************************
MD5R(STR) ; Construct a 128-bit MD5 hash of the input.
N TWOTO
N A,B,C,D
N AA,BB,CC,DD
D INITR
PAD1R ; Pad str out to 56 bytes mod 64
; Padding is a 1 bit followed by all zero bits
N LEN,MOD,NPAD,PAD
S LEN=$L(STR),MOD=LEN#64
S NPAD=$S(MOD<56:56-MOD,1:120-MOD)
S PAD=$C(128)
S:NPAD>1 $P(PAD,$C(0),NPAD)=""
S STR=STR_PAD
PAD2R ; Append length in bits as 64-bit integer, little endian
S LEN=LEN*8
S STR=STR_$$UI64BIT(LEN)
PROCESSR ; Main processing and transformation loop
N J,POS,N,I
N X ; X(J) is a 4-byte word from a 64-byte block
S N=$L(STR)/64 ; Number of 64-byte blocks
F I=0:1:N-1 D
. F J=0:1:15 S POS=(64*I)+(4*J),X(J)=$E(STR,POS+1,POS+4)
. D SAVE
. D ROUND1
. D ROUND2
. D ROUND3
. D ROUND4
. D INCR
K X
Q A_B_C_D
;
INITR ; Initialization
; Set up array of powers of two for rotation
N I,N
S N=1
F I=0:1:31 S TWOTO(I)=N,N=N+N
; Initialize 4-byte buffers A,B,C,D
S A=$C(1,35,69,103)
S B=$C(137,171,205,239)
S C=$C(254,220,186,152)
S D=$C(118,84,50,16)
Q
;
;;**************************************************
;;MD5 'E'nhanced portion of the code. This will handle
;; multiple strings and produce a value for them all
;; as if they were submitted as one long string.
;;**************************************************
MD5E(ABCD,STR,PP,LL) ; Construct a 128-bit MD5 hash of the input.
N TWOTO
N A,B,C,D
N AA,BB,CC,DD
D INITE(ABCD)
PAD1E ; Pad str out to 56 bytes mod 64
; Padding is a 1 bit followed by all zero bits
; PP = 1 Don't pad with $C(128) !!! Pavel Set to 1 if this is not last string !!
; Set to 0 if this is last string !!
; LL = Lenght passed form outside for pading of little endian Pavel !!! -
; Seting lenght if this is last value othervise computed lenght used...
N LEN,MOD,NPAD,PAD
S LEN=$L(STR),MOD=LEN#64
S:$G(LL) LEN=LL ;Pavel
S NPAD=$S(MOD<56:56-MOD,1:120-MOD)
S PAD=$C(128)
S:NPAD>1 $P(PAD,$C(0),NPAD)=""
S:'$G(PP) STR=STR_PAD ;Pavel
;S STR=STR_PAD
PAD2E ; Append length in bits as 64-bit integer, little endian
S LEN=LEN*8
S STR=STR_$$UI64BIT(LEN)
PROCESSE ; Main processing and transformation loop
N J,POS,N,I
N X ; X(J) is a 4-byte word from a 64-byte block
;S N=$L(STR)/64 ; Number of 64-byte blocks
S N=$L(STR)\64 ; Number of 64-byte blocks
F I=0:1:N-1 D
. F J=0:1:15 S POS=(64*I)+(4*J),X(J)=$E(STR,POS+1,POS+4)
. D SAVE
. D ROUND1
. D ROUND2
. D ROUND3
. D ROUND4
. D INCR
. ;W !,I," ABCD=",$$MAIN^XUMF5BYT($$HEX(A_B_C_D)),!
K X
Q A_B_C_D
;
INITE(LASTABCD) ; Initialization
; Set up array of powers of two for rotation
N I,N,L
S N=1
F I=0:1:31 S TWOTO(I)=N,N=N+N
; Initialize 4-byte buffers A,B,C,D
S A=$E(LASTABCD,1,4)
S B=$E(LASTABCD,5,8)
S C=$E(LASTABCD,9,12)
S D=$E(LASTABCD,13,16)
Q
;
;;**************************************************
;;This is where common code starts, used by both
;; Regular and Enhanced portions of this routine.
;;**************************************************
SAVE ; Save buffers
S AA=A,BB=B,CC=C,DD=D
Q
;
ROUND1 ; First round of transformation
D SUB(.A,B,C,D,X(0),7,3614090360,1)
D SUB(.D,A,B,C,X(1),12,3905402710,1)
D SUB(.C,D,A,B,X(2),17,606105819,1)
D SUB(.B,C,D,A,X(3),22,3250441966,1)
D SUB(.A,B,C,D,X(4),7,4118548399,1)
D SUB(.D,A,B,C,X(5),12,1200080426,1)
D SUB(.C,D,A,B,X(6),17,2821735955,1)
D SUB(.B,C,D,A,X(7),22,4249261313,1)
D SUB(.A,B,C,D,X(8),7,1770035416,1)
D SUB(.D,A,B,C,X(9),12,2336552879,1)
D SUB(.C,D,A,B,X(10),17,4294925233,1)
D SUB(.B,C,D,A,X(11),22,2304563134,1)
D SUB(.A,B,C,D,X(12),7,1804603682,1)
D SUB(.D,A,B,C,X(13),12,4254626195,1)
D SUB(.C,D,A,B,X(14),17,2792965006,1)
D SUB(.B,C,D,A,X(15),22,1236535329,1)
Q
;
ROUND2 ; Second round of transformation
D SUB(.A,B,C,D,X(1),5,4129170786,2)
D SUB(.D,A,B,C,X(6),9,3225465664,2)
D SUB(.C,D,A,B,X(11),14,643717713,2)
D SUB(.B,C,D,A,X(0),20,3921069994,2)
D SUB(.A,B,C,D,X(5),5,3593408605,2)
D SUB(.D,A,B,C,X(10),9,38016083,2)
D SUB(.C,D,A,B,X(15),14,3634488961,2)
D SUB(.B,C,D,A,X(4),20,3889429448,2)
D SUB(.A,B,C,D,X(9),5,568446438,2)
D SUB(.D,A,B,C,X(14),9,3275163606,2)
D SUB(.C,D,A,B,X(3),14,4107603335,2)
D SUB(.B,C,D,A,X(8),20,1163531501,2)
D SUB(.A,B,C,D,X(13),5,2850285829,2)
D SUB(.D,A,B,C,X(2),9,4243563512,2)
D SUB(.C,D,A,B,X(7),14,1735328473,2)
D SUB(.B,C,D,A,X(12),20,2368359562,2)
Q
;
ROUND3 ; Third round of transformation
D SUB(.A,B,C,D,X(5),4,4294588738,3)
D SUB(.D,A,B,C,X(8),11,2272392833,3)
D SUB(.C,D,A,B,X(11),16,1839030562,3)
D SUB(.B,C,D,A,X(14),23,4259657740,3)
D SUB(.A,B,C,D,X(1),4,2763975236,3)
D SUB(.D,A,B,C,X(4),11,1272893353,3)
D SUB(.C,D,A,B,X(7),16,4139469664,3)
D SUB(.B,C,D,A,X(10),23,3200236656,3)
D SUB(.A,B,C,D,X(13),4,681279174,3)
D SUB(.D,A,B,C,X(0),11,3936430074,3)
D SUB(.C,D,A,B,X(3),16,3572445317,3)
D SUB(.B,C,D,A,X(6),23,76029189,3)
D SUB(.A,B,C,D,X(9),4,3654602809,3)
D SUB(.D,A,B,C,X(12),11,3873151461,3)
D SUB(.C,D,A,B,X(15),16,530742520,3)
D SUB(.B,C,D,A,X(2),23,3299628645,3)
Q
;
ROUND4 ; Fourth round of transformation
D SUB(.A,B,C,D,X(0),6,4096336452,4)
D SUB(.D,A,B,C,X(7),10,1126891415,4)
D SUB(.C,D,A,B,X(14),15,2878612391,4)
D SUB(.B,C,D,A,X(5),21,4237533241,4)
D SUB(.A,B,C,D,X(12),6,1700485571,4)
D SUB(.D,A,B,C,X(3),10,2399980690,4)
D SUB(.C,D,A,B,X(10),15,4293915773,4)
D SUB(.B,C,D,A,X(1),21,2240044497,4)
D SUB(.A,B,C,D,X(8),6,1873313359,4)
D SUB(.D,A,B,C,X(15),10,4264355552,4)
D SUB(.C,D,A,B,X(6),15,2734768916,4)
D SUB(.B,C,D,A,X(13),21,1309151649,4)
D SUB(.A,B,C,D,X(4),6,4149444226,4)
D SUB(.D,A,B,C,X(11),10,3174756917,4)
D SUB(.C,D,A,B,X(2),15,718787259,4)
D SUB(.B,C,D,A,X(9),21,3951481745,4)
Q
INCR ;
S A=$$ADD(A,AA)
S B=$$ADD(B,BB)
S C=$$ADD(C,CC)
S D=$$ADD(D,DD)
Q
;
; Auxiliary functions
;
SUB(A,B,C,D,X,S,AC,FN) ; FN is 1 (F), 2 (G), 3 (H) or 4 (I)
N INT,COMB,CMD,DO
S INT=$$UINT32(A)
S DO="COMB"_FN
D @DO
S INT=$$ADDIW(INT,COMB)
S INT=$$ADDIW(INT,X)
S INT=$$ADDII(INT,AC)
S INT=$$ROTLI(INT,S)
S INT=$$ADDIW(INT,B)
S A=$$UI32BIT(INT)
Q
COMB ; Choose F, G, H or I
COMB1 S COMB=$$OR($$AND(B,C),$$AND($$NOT(B),D)) Q ; F
COMB2 S COMB=$$OR($$AND(B,D),$$AND(C,$$NOT(D))) Q ; G
COMB3 S COMB=$$XOR($$XOR(B,C),D) Q ; H
COMB4 S COMB=$$XOR(C,$$OR(B,$$NOT(D))) Q ; I
Q
;
; Boolean functions assume args are 4-character strings
;
AND(X,Y) ;
Q $ZBOOLEAN(X,Y,1) ;;EOCONDCD;CACHE
Q X ; Placeholder for other M implementations
;
OR(X,Y) ;
Q $ZBOOLEAN(X,Y,7) ;;EOCONDCD;CACHE
Q X ; Placeholder for other M implementations
;
XOR(X,Y) ;
Q $ZBOOLEAN(X,Y,6) ;;EOCONDCD;CACHE
Q X ; Placeholder for other M implementations
;
NOT(X) ;
Q $ZBOOLEAN(X,X,12) ;;EOCONDCD;CACHE
Q X ; Placeholder for other M implementations
;
; Functions to add and rotate 32-bit words
; X and Y are 4-character strings
; m, n and s are integers
; ADD and ROTL return 4-character strings
; ADDIW, ADDII and ROTLI return integers
;
ADD(X,Y) ; modulo 2**32
Q $$UI32BIT($$UINT32(X)+$$UINT32(Y)#4294967296)
;
ADDIW(M,Y) ; modulo 2**32
Q M+$$UINT32(Y)#4294967296
;
ADDII(M,N) ; modulo 2**32
Q M+N#4294967296
;
ROTL(X,S) ; rotate left by s bits
N INT,RIGHT,SWAP
S INT=$$UINT32(X)
S RIGHT=INT#TWOTO(32-S)
S SWAP=RIGHT*TWOTO(S)+(INT\TWOTO(32-S))
Q $$UI32BIT(SWAP)
;
ROTLI(N,S) ; rotate left by s bits
N RIGHT,SWAP
S RIGHT=N#TWOTO(32-S)
S SWAP=RIGHT*TWOTO(S)+(N\TWOTO(32-S))
Q SWAP
;
; Utility functions
;
UI64BIT(N) ; Convert unsigned integer to 64-bit form, little endian
; code from CORBA ULONGLONG marshaling
N D,X,I
S D=""
F I=7:-1:1 D
. S X=0
. F Q:(N<(256**I)) S X=X+1,N=N-(256**I)
. S X(I)=X
S D=D_$C(N)
F I=1:1:7 S D=D_$C(X(I))
Q D
;
UI32BIT(N) ; Convert unsigned integer to 32-bit form, little endian
; code from CORBA ULONG marshaling
Q $C(N#256,(N\256#256),(N\(65536)#256),(N\(16777216)#256))
;
UINT32(STR) ; Get integer value from bits of 4-character string
; code from CORBA ULONG unmarshaling
Q $A(STR,1)+(256*$A(STR,2))+(65536*$A(STR,3))+(16777216*$A(STR,4))
;
HEX(STR) ; Printable hex representation of characters in string
N DIGITS,RET,I,J,BYTE,OFFSET
S DIGITS="0123456789abcdef"
S RET=""
S OFFSET=$L(STR)#4
S:OFFSET STR=STR_$E($C(0,0,0),1,4-OFFSET) ; PAD
F I=0:4:$L(STR)-4 F J=4:-1:1 D ; Reverse byte order in each word
. S BYTE=$A(STR,I+J)
. S RET=RET_$E(DIGITS,1+(BYTE\16)) ; High nibble
. S RET=RET_$E(DIGITS,1+(BYTE#16)) ; Low nibble
Q RET
;
CHR2OCT(STR) ; convert hex string to decimal byte values
N RET,I,BYTE,HIGH,LOW
S RET=""
F I=1:2:$L(STR) D
. S BYTE=$E(STR,I,I+1)
. Q:BYTE'?2NL
. S HIGH=$$CHAR1($E(BYTE,1))
. S LOW=$$CHAR1($E(BYTE,2))
. S RET=RET_(16*HIGH+LOW)_" "
Q RET
;
CHAR1(DIGIT) ; convert one char to its hex value
N X
S X=$F("0123456789abcdef",DIGIT)
Q:X=0 0
Q X-2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUMF5AU 9877 printed Sep 23, 2025@19:46:44 Page 2
XUMF5AU ;ISS/PAVEL - XUMF5 MD5 Hash API ;06/17/05
+1 ;;8.0;KERNEL;**383**;July 10, 1995
+2 ;
+3 ;MD5 based on info from 4.005 SORT BY VUID;;original name was 'VESOUHSH' ; Secure hash functions
+4 ;;(c) Copyright 1994 - 2004, ESI Technology Corp, Natick MA
+5 ;; This source code contains the intellectual property of its copyright holder(s),
+6 ;; and is made available under a license. If you are not familiar with the terms
+7 ;; of the license, please refer to the license.txt file that is a part of the
+8 ;; distribution kit.
+9 ;; This is a routine version where Variables and Commands set to be Upercase. Pavel
+10 ;
+11 QUIT
+12 ;;**************************************************
+13 ;;MD5 'R'egular portion of the code. This will handle
+14 ;; one string at a time.
+15 ;;**************************************************
MD5R(STR) ; Construct a 128-bit MD5 hash of the input.
+1 NEW TWOTO
+2 NEW A,B,C,D
+3 NEW AA,BB,CC,DD
+4 DO INITR
PAD1R ; Pad str out to 56 bytes mod 64
+1 ; Padding is a 1 bit followed by all zero bits
+2 NEW LEN,MOD,NPAD,PAD
+3 SET LEN=$LENGTH(STR)
SET MOD=LEN#64
+4 SET NPAD=$SELECT(MOD<56:56-MOD,1:120-MOD)
+5 SET PAD=$CHAR(128)
+6 if NPAD>1
SET $PIECE(PAD,$CHAR(0),NPAD)=""
+7 SET STR=STR_PAD
PAD2R ; Append length in bits as 64-bit integer, little endian
+1 SET LEN=LEN*8
+2 SET STR=STR_$$UI64BIT(LEN)
PROCESSR ; Main processing and transformation loop
+1 NEW J,POS,N,I
+2 ; X(J) is a 4-byte word from a 64-byte block
NEW X
+3 ; Number of 64-byte blocks
SET N=$LENGTH(STR)/64
+4 FOR I=0:1:N-1
Begin DoDot:1
+5 FOR J=0:1:15
SET POS=(64*I)+(4*J)
SET X(J)=$EXTRACT(STR,POS+1,POS+4)
+6 DO SAVE
+7 DO ROUND1
+8 DO ROUND2
+9 DO ROUND3
+10 DO ROUND4
+11 DO INCR
End DoDot:1
+12 KILL X
+13 QUIT A_B_C_D
+14 ;
INITR ; Initialization
+1 ; Set up array of powers of two for rotation
+2 NEW I,N
+3 SET N=1
+4 FOR I=0:1:31
SET TWOTO(I)=N
SET N=N+N
+5 ; Initialize 4-byte buffers A,B,C,D
+6 SET A=$CHAR(1,35,69,103)
+7 SET B=$CHAR(137,171,205,239)
+8 SET C=$CHAR(254,220,186,152)
+9 SET D=$CHAR(118,84,50,16)
+10 QUIT
+11 ;
+12 ;;**************************************************
+13 ;;MD5 'E'nhanced portion of the code. This will handle
+14 ;; multiple strings and produce a value for them all
+15 ;; as if they were submitted as one long string.
+16 ;;**************************************************
MD5E(ABCD,STR,PP,LL) ; Construct a 128-bit MD5 hash of the input.
+1 NEW TWOTO
+2 NEW A,B,C,D
+3 NEW AA,BB,CC,DD
+4 DO INITE(ABCD)
PAD1E ; Pad str out to 56 bytes mod 64
+1 ; Padding is a 1 bit followed by all zero bits
+2 ; PP = 1 Don't pad with $C(128) !!! Pavel Set to 1 if this is not last string !!
+3 ; Set to 0 if this is last string !!
+4 ; LL = Lenght passed form outside for pading of little endian Pavel !!! -
+5 ; Seting lenght if this is last value othervise computed lenght used...
+6 NEW LEN,MOD,NPAD,PAD
+7 SET LEN=$LENGTH(STR)
SET MOD=LEN#64
+8 ;Pavel
if $GET(LL)
SET LEN=LL
+9 SET NPAD=$SELECT(MOD<56:56-MOD,1:120-MOD)
+10 SET PAD=$CHAR(128)
+11 if NPAD>1
SET $PIECE(PAD,$CHAR(0),NPAD)=""
+12 ;Pavel
if '$GET(PP)
SET STR=STR_PAD
+13 ;S STR=STR_PAD
PAD2E ; Append length in bits as 64-bit integer, little endian
+1 SET LEN=LEN*8
+2 SET STR=STR_$$UI64BIT(LEN)
PROCESSE ; Main processing and transformation loop
+1 NEW J,POS,N,I
+2 ; X(J) is a 4-byte word from a 64-byte block
NEW X
+3 ;S N=$L(STR)/64 ; Number of 64-byte blocks
+4 ; Number of 64-byte blocks
SET N=$LENGTH(STR)\64
+5 FOR I=0:1:N-1
Begin DoDot:1
+6 FOR J=0:1:15
SET POS=(64*I)+(4*J)
SET X(J)=$EXTRACT(STR,POS+1,POS+4)
+7 DO SAVE
+8 DO ROUND1
+9 DO ROUND2
+10 DO ROUND3
+11 DO ROUND4
+12 DO INCR
+13 ;W !,I," ABCD=",$$MAIN^XUMF5BYT($$HEX(A_B_C_D)),!
End DoDot:1
+14 KILL X
+15 QUIT A_B_C_D
+16 ;
INITE(LASTABCD) ; Initialization
+1 ; Set up array of powers of two for rotation
+2 NEW I,N,L
+3 SET N=1
+4 FOR I=0:1:31
SET TWOTO(I)=N
SET N=N+N
+5 ; Initialize 4-byte buffers A,B,C,D
+6 SET A=$EXTRACT(LASTABCD,1,4)
+7 SET B=$EXTRACT(LASTABCD,5,8)
+8 SET C=$EXTRACT(LASTABCD,9,12)
+9 SET D=$EXTRACT(LASTABCD,13,16)
+10 QUIT
+11 ;
+12 ;;**************************************************
+13 ;;This is where common code starts, used by both
+14 ;; Regular and Enhanced portions of this routine.
+15 ;;**************************************************
SAVE ; Save buffers
+1 SET AA=A
SET BB=B
SET CC=C
SET DD=D
+2 QUIT
+3 ;
ROUND1 ; First round of transformation
+1 DO SUB(.A,B,C,D,X(0),7,3614090360,1)
+2 DO SUB(.D,A,B,C,X(1),12,3905402710,1)
+3 DO SUB(.C,D,A,B,X(2),17,606105819,1)
+4 DO SUB(.B,C,D,A,X(3),22,3250441966,1)
+5 DO SUB(.A,B,C,D,X(4),7,4118548399,1)
+6 DO SUB(.D,A,B,C,X(5),12,1200080426,1)
+7 DO SUB(.C,D,A,B,X(6),17,2821735955,1)
+8 DO SUB(.B,C,D,A,X(7),22,4249261313,1)
+9 DO SUB(.A,B,C,D,X(8),7,1770035416,1)
+10 DO SUB(.D,A,B,C,X(9),12,2336552879,1)
+11 DO SUB(.C,D,A,B,X(10),17,4294925233,1)
+12 DO SUB(.B,C,D,A,X(11),22,2304563134,1)
+13 DO SUB(.A,B,C,D,X(12),7,1804603682,1)
+14 DO SUB(.D,A,B,C,X(13),12,4254626195,1)
+15 DO SUB(.C,D,A,B,X(14),17,2792965006,1)
+16 DO SUB(.B,C,D,A,X(15),22,1236535329,1)
+17 QUIT
+18 ;
ROUND2 ; Second round of transformation
+1 DO SUB(.A,B,C,D,X(1),5,4129170786,2)
+2 DO SUB(.D,A,B,C,X(6),9,3225465664,2)
+3 DO SUB(.C,D,A,B,X(11),14,643717713,2)
+4 DO SUB(.B,C,D,A,X(0),20,3921069994,2)
+5 DO SUB(.A,B,C,D,X(5),5,3593408605,2)
+6 DO SUB(.D,A,B,C,X(10),9,38016083,2)
+7 DO SUB(.C,D,A,B,X(15),14,3634488961,2)
+8 DO SUB(.B,C,D,A,X(4),20,3889429448,2)
+9 DO SUB(.A,B,C,D,X(9),5,568446438,2)
+10 DO SUB(.D,A,B,C,X(14),9,3275163606,2)
+11 DO SUB(.C,D,A,B,X(3),14,4107603335,2)
+12 DO SUB(.B,C,D,A,X(8),20,1163531501,2)
+13 DO SUB(.A,B,C,D,X(13),5,2850285829,2)
+14 DO SUB(.D,A,B,C,X(2),9,4243563512,2)
+15 DO SUB(.C,D,A,B,X(7),14,1735328473,2)
+16 DO SUB(.B,C,D,A,X(12),20,2368359562,2)
+17 QUIT
+18 ;
ROUND3 ; Third round of transformation
+1 DO SUB(.A,B,C,D,X(5),4,4294588738,3)
+2 DO SUB(.D,A,B,C,X(8),11,2272392833,3)
+3 DO SUB(.C,D,A,B,X(11),16,1839030562,3)
+4 DO SUB(.B,C,D,A,X(14),23,4259657740,3)
+5 DO SUB(.A,B,C,D,X(1),4,2763975236,3)
+6 DO SUB(.D,A,B,C,X(4),11,1272893353,3)
+7 DO SUB(.C,D,A,B,X(7),16,4139469664,3)
+8 DO SUB(.B,C,D,A,X(10),23,3200236656,3)
+9 DO SUB(.A,B,C,D,X(13),4,681279174,3)
+10 DO SUB(.D,A,B,C,X(0),11,3936430074,3)
+11 DO SUB(.C,D,A,B,X(3),16,3572445317,3)
+12 DO SUB(.B,C,D,A,X(6),23,76029189,3)
+13 DO SUB(.A,B,C,D,X(9),4,3654602809,3)
+14 DO SUB(.D,A,B,C,X(12),11,3873151461,3)
+15 DO SUB(.C,D,A,B,X(15),16,530742520,3)
+16 DO SUB(.B,C,D,A,X(2),23,3299628645,3)
+17 QUIT
+18 ;
ROUND4 ; Fourth round of transformation
+1 DO SUB(.A,B,C,D,X(0),6,4096336452,4)
+2 DO SUB(.D,A,B,C,X(7),10,1126891415,4)
+3 DO SUB(.C,D,A,B,X(14),15,2878612391,4)
+4 DO SUB(.B,C,D,A,X(5),21,4237533241,4)
+5 DO SUB(.A,B,C,D,X(12),6,1700485571,4)
+6 DO SUB(.D,A,B,C,X(3),10,2399980690,4)
+7 DO SUB(.C,D,A,B,X(10),15,4293915773,4)
+8 DO SUB(.B,C,D,A,X(1),21,2240044497,4)
+9 DO SUB(.A,B,C,D,X(8),6,1873313359,4)
+10 DO SUB(.D,A,B,C,X(15),10,4264355552,4)
+11 DO SUB(.C,D,A,B,X(6),15,2734768916,4)
+12 DO SUB(.B,C,D,A,X(13),21,1309151649,4)
+13 DO SUB(.A,B,C,D,X(4),6,4149444226,4)
+14 DO SUB(.D,A,B,C,X(11),10,3174756917,4)
+15 DO SUB(.C,D,A,B,X(2),15,718787259,4)
+16 DO SUB(.B,C,D,A,X(9),21,3951481745,4)
+17 QUIT
INCR ;
+1 SET A=$$ADD(A,AA)
+2 SET B=$$ADD(B,BB)
+3 SET C=$$ADD(C,CC)
+4 SET D=$$ADD(D,DD)
+5 QUIT
+6 ;
+7 ; Auxiliary functions
+8 ;
SUB(A,B,C,D,X,S,AC,FN) ; FN is 1 (F), 2 (G), 3 (H) or 4 (I)
+1 NEW INT,COMB,CMD,DO
+2 SET INT=$$UINT32(A)
+3 SET DO="COMB"_FN
+4 DO @DO
+5 SET INT=$$ADDIW(INT,COMB)
+6 SET INT=$$ADDIW(INT,X)
+7 SET INT=$$ADDII(INT,AC)
+8 SET INT=$$ROTLI(INT,S)
+9 SET INT=$$ADDIW(INT,B)
+10 SET A=$$UI32BIT(INT)
+11 QUIT
COMB ; Choose F, G, H or I
COMB1 ; F
SET COMB=$$OR($$AND(B,C),$$AND($$NOT(B),D))
QUIT
COMB2 ; G
SET COMB=$$OR($$AND(B,D),$$AND(C,$$NOT(D)))
QUIT
COMB3 ; H
SET COMB=$$XOR($$XOR(B,C),D)
QUIT
COMB4 ; I
SET COMB=$$XOR(C,$$OR(B,$$NOT(D)))
QUIT
+1 QUIT
+2 ;
+3 ; Boolean functions assume args are 4-character strings
+4 ;
AND(X,Y) ;
+1 ;;EOCONDCD;CACHE
QUIT $ZBOOLEAN(X,Y,1)
+2 ; Placeholder for other M implementations
QUIT X
+3 ;
OR(X,Y) ;
+1 ;;EOCONDCD;CACHE
QUIT $ZBOOLEAN(X,Y,7)
+2 ; Placeholder for other M implementations
QUIT X
+3 ;
XOR(X,Y) ;
+1 ;;EOCONDCD;CACHE
QUIT $ZBOOLEAN(X,Y,6)
+2 ; Placeholder for other M implementations
QUIT X
+3 ;
NOT(X) ;
+1 ;;EOCONDCD;CACHE
QUIT $ZBOOLEAN(X,X,12)
+2 ; Placeholder for other M implementations
QUIT X
+3 ;
+4 ; Functions to add and rotate 32-bit words
+5 ; X and Y are 4-character strings
+6 ; m, n and s are integers
+7 ; ADD and ROTL return 4-character strings
+8 ; ADDIW, ADDII and ROTLI return integers
+9 ;
ADD(X,Y) ; modulo 2**32
+1 QUIT $$UI32BIT($$UINT32(X)+$$UINT32(Y)#4294967296)
+2 ;
ADDIW(M,Y) ; modulo 2**32
+1 QUIT M+$$UINT32(Y)#4294967296
+2 ;
ADDII(M,N) ; modulo 2**32
+1 QUIT M+N#4294967296
+2 ;
ROTL(X,S) ; rotate left by s bits
+1 NEW INT,RIGHT,SWAP
+2 SET INT=$$UINT32(X)
+3 SET RIGHT=INT#TWOTO(32-S)
+4 SET SWAP=RIGHT*TWOTO(S)+(INT\TWOTO(32-S))
+5 QUIT $$UI32BIT(SWAP)
+6 ;
ROTLI(N,S) ; rotate left by s bits
+1 NEW RIGHT,SWAP
+2 SET RIGHT=N#TWOTO(32-S)
+3 SET SWAP=RIGHT*TWOTO(S)+(N\TWOTO(32-S))
+4 QUIT SWAP
+5 ;
+6 ; Utility functions
+7 ;
UI64BIT(N) ; Convert unsigned integer to 64-bit form, little endian
+1 ; code from CORBA ULONGLONG marshaling
+2 NEW D,X,I
+3 SET D=""
+4 FOR I=7:-1:1
Begin DoDot:1
+5 SET X=0
+6 FOR
if (N<(256**I))
QUIT
SET X=X+1
SET N=N-(256**I)
+7 SET X(I)=X
End DoDot:1
+8 SET D=D_$CHAR(N)
+9 FOR I=1:1:7
SET D=D_$CHAR(X(I))
+10 QUIT D
+11 ;
UI32BIT(N) ; Convert unsigned integer to 32-bit form, little endian
+1 ; code from CORBA ULONG marshaling
+2 QUIT $CHAR(N#256,(N\256#256),(N\(65536)#256),(N\(16777216)#256))
+3 ;
UINT32(STR) ; Get integer value from bits of 4-character string
+1 ; code from CORBA ULONG unmarshaling
+2 QUIT $ASCII(STR,1)+(256*$ASCII(STR,2))+(65536*$ASCII(STR,3))+(16777216*$ASCII(STR,4))
+3 ;
HEX(STR) ; Printable hex representation of characters in string
+1 NEW DIGITS,RET,I,J,BYTE,OFFSET
+2 SET DIGITS="0123456789abcdef"
+3 SET RET=""
+4 SET OFFSET=$LENGTH(STR)#4
+5 ; PAD
if OFFSET
SET STR=STR_$EXTRACT($CHAR(0,0,0),1,4-OFFSET)
+6 ; Reverse byte order in each word
FOR I=0:4:$LENGTH(STR)-4
FOR J=4:-1:1
Begin DoDot:1
+7 SET BYTE=$ASCII(STR,I+J)
+8 ; High nibble
SET RET=RET_$EXTRACT(DIGITS,1+(BYTE\16))
+9 ; Low nibble
SET RET=RET_$EXTRACT(DIGITS,1+(BYTE#16))
End DoDot:1
+10 QUIT RET
+11 ;
CHR2OCT(STR) ; convert hex string to decimal byte values
+1 NEW RET,I,BYTE,HIGH,LOW
+2 SET RET=""
+3 FOR I=1:2:$LENGTH(STR)
Begin DoDot:1
+4 SET BYTE=$EXTRACT(STR,I,I+1)
+5 if BYTE'?2NL
QUIT
+6 SET HIGH=$$CHAR1($EXTRACT(BYTE,1))
+7 SET LOW=$$CHAR1($EXTRACT(BYTE,2))
+8 SET RET=RET_(16*HIGH+LOW)_" "
End DoDot:1
+9 QUIT RET
+10 ;
CHAR1(DIGIT) ; convert one char to its hex value
+1 NEW X
+2 SET X=$FIND("0123456789abcdef",DIGIT)
+3 if X=0
QUIT 0
+4 QUIT X-2
