XLFCRC ;ISF/RWF - Library Functions to do CRC ;08/04/2000 09:42
;;8.0;KERNEL;**166**;Jul 10, 1995
; The code below was approved in document X11/1998-32
;From the book "M[UMPS] by example" by Ed de Mole.
;
CRC32(string,seed) ;
; Polynomial X**32 + X**26 + X**23 + X**22 +
; + X**16 + X**12 + X**11 + X**10 +
; + X**8 + X**7 + X**5 + X**4 +
; + X**2 + X + 1
N I,J,R
I '$D(seed) S R=4294967295
E I seed'<0,seed'>4294967295 S R=4294967295-seed
E S $ECODE=",M28,"
F I=1:1:$L(string) D
. S R=$$XOR($A(string,I),R,8)
. F J=0:1:7 D
. . I R#2 S R=$$XOR(R\2,3988292384,32)
. . E S R=R\2
. . Q
. Q
Q 4294967295-R
;
XOR(a,b,w) N I,M,R
S R=b,M=1
F I=1:1:w D
. S:a\M#2 R=R+$S(R\M#2:-M,1:M)
. S M=M+M
. Q
Q R
; ===
;
; The code below was approved in document X11/1998-32
;
CRC16(string,seed) ;
; Polynomial x**16 + x**15 + x**2 + x**0
N I,J,R
I '$D(seed) S R=0
E I seed'<0,seed'>65535 S R=seed\1
E S $ECODE=",M28,"
F I=1:1:$L(string) D
. S R=$$XOR($A(string,I),R,8)
. F J=0:1:7 D
. . I R#2 S R=$$XOR(R\2,40961,16)
. . E S R=R\2
. . Q
. Q
Q R
;
ZXOR(a,b,w) NEW I,M,R
SET R=b,M=1
FOR I=1:1:w DO
. SET:a\M#2 R=R+$SELECT(R\M#2:-M,1:M)
. SET M=M+M
. QUIT
QUIT R
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXLFCRC 1298 printed Oct 16, 2024@18:03:25 Page 2
XLFCRC ;ISF/RWF - Library Functions to do CRC ;08/04/2000 09:42
+1 ;;8.0;KERNEL;**166**;Jul 10, 1995
+2 ; The code below was approved in document X11/1998-32
+3 ;From the book "M[UMPS] by example" by Ed de Mole.
+4 ;
CRC32(string,seed) ;
+1 ; Polynomial X**32 + X**26 + X**23 + X**22 +
+2 ; + X**16 + X**12 + X**11 + X**10 +
+3 ; + X**8 + X**7 + X**5 + X**4 +
+4 ; + X**2 + X + 1
+5 NEW I,J,R
+6 IF '$DATA(seed)
SET R=4294967295
+7 IF '$TEST
IF seed'<0
IF seed'>4294967295
SET R=4294967295-seed
+8 IF '$TEST
SET $ECODE=",M28,"
+9 FOR I=1:1:$LENGTH(string)
Begin DoDot:1
+10 SET R=$$XOR($ASCII(string,I),R,8)
+11 FOR J=0:1:7
Begin DoDot:2
+12 IF R#2
SET R=$$XOR(R\2,3988292384,32)
+13 IF '$TEST
SET R=R\2
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 QUIT 4294967295-R
+17 ;
XOR(a,b,w) NEW I,M,R
+1 SET R=b
SET M=1
+2 FOR I=1:1:w
Begin DoDot:1
+3 if a\M#2
SET R=R+$SELECT(R\M#2:-M,1:M)
+4 SET M=M+M
+5 QUIT
End DoDot:1
+6 QUIT R
+7 ; ===
+8 ;
+9 ; The code below was approved in document X11/1998-32
+10 ;
CRC16(string,seed) ;
+1 ; Polynomial x**16 + x**15 + x**2 + x**0
+2 NEW I,J,R
+3 IF '$DATA(seed)
SET R=0
+4 IF '$TEST
IF seed'<0
IF seed'>65535
SET R=seed\1
+5 IF '$TEST
SET $ECODE=",M28,"
+6 FOR I=1:1:$LENGTH(string)
Begin DoDot:1
+7 SET R=$$XOR($ASCII(string,I),R,8)
+8 FOR J=0:1:7
Begin DoDot:2
+9 IF R#2
SET R=$$XOR(R\2,40961,16)
+10 IF '$TEST
SET R=R\2
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 QUIT R
+14 ;
ZXOR(a,b,w) NEW I,M,R
+1 SET R=b
SET M=1
+2 FOR I=1:1:w
Begin DoDot:1
+3 if a\M#2
SET R=R+$SELECT(R\M#2:-M,1:M)
+4 SET M=M+M
+5 QUIT
End DoDot:1
+6 QUIT R
+7 ;
+8
***** ERRORS & WARNINGS IN XLFCRC *****
ZXOR+8 W - Null line (no commands or comment).
