- XLFCRC ;ISF/RWF - Library Functions to do CRC ;08/04/2000 09:42 [ 04/02/2003 8:29 AM ]
- ;;8.0;KERNEL;**1007**;APR 1, 2003
- ;;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
- ;
-
- XLFCRC ;ISF/RWF - Library Functions to do CRC ;08/04/2000 09:42 [ 04/02/2003 8:29 AM ]
- +1 ;;8.0;KERNEL;**1007**;APR 1, 2003
- +2 ;;8.0;KERNEL;**166**;Jul 10, 1995
- +3 ; The code below was approved in document X11/1998-32
- +4 ;From the book "M[UMPS] by example" by Ed de Mole.
- +5 ;
- 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).
- a S - Lower/Mixed case Variable name used.
- b S - Lower/Mixed case Variable name used.
- seed S - Lower/Mixed case Variable name used.
- string S - Lower/Mixed case Variable name used.
- w S - Lower/Mixed case Variable name used.
