ANEW --crc32.PMF--  DECIMAL                   \  Wil Baden  2001-10-22

\  *******************************************************************
\  *                                                                 *
\  *  Wil Baden  2002-08-07                                          *
\  *                                                                 *
\  *     CRC-32 International Standard 32-Bit CRC                    *
\  *                                                                 *
\  *******************************************************************

\  The subject of this article is calculation of the International 
\  Standard 32-bit CRC, cyclical redundancy check.  It uses 
\  nonce-words as throw-away definitions to build a table to speed it 
\  up. 

\  `CRC-32-Table`, `Calculate-CRC-32`, and `CRC-32` are permanent 
\  definitions. The words between `CRC-32-Table` and 
\  `Calculate-CRC-32` are compiled, executed, and forgotten. 

\  For testing, `Little-Endian-!` and `CRC-TEST` are also permanent 
\  definitions. 

\  With `CRC-32` the user should precondition the check-sum to `TRUE` 
\  (all bits on). For every byte read, `CRC-32` uses 
\  `Calculate-CRC-32` to update the check-sum. 

\  When `CRC-32` has finished reading, it postconditions the 
\  check-sum with `INVERT` to get the CRC. 

\  If the CRC is inverted again and added to the end of the file or 
\  string in little-endian order, the CRC of the result will be all 
\  bits on. 

\  The International Standard 32-bit CRC. 

CREATE CRC-32-Table   256 CELLS ALLOT

MARKER CRC-32-TABLE-INITIALIZATION

\  Define CRC-POLYNOMIAL from its coefficient terms.

    : POLY
        32 26 23 22 16 12 11 10 8 7 5 4 2 1 0   ( ...)
          0 BEGIN                               ( ... poly)
              SWAP                              ( ... poly bit)
              DUP 32 <>
          WHILE
              31 XOR  1 SWAP LSHIFT  OR         ( ... poly)
          REPEAT                                ( ... poly bit)
          DROP                                  ( poly)
    ; POLY CONSTANT CRC-POLYNOMIAL  ( )

CR .( \ CRC-POLYNOMIAL is ) CRC-POLYNOMIAL  HEX U. DECIMAL  CR

\  `CRC-POLYNOMIAL` represents a polynomial with binary coefficients, 
\  0 or 1, of the 32nd degree. In the literature it is usually 
\  written as a sum of powers of _x_ in algebraic notation. But the 
\  coefficient of the highest exponent is always 1, not 0 - otherwise 
\  it wouldn't be of the 32nd degree. So it can be represented by 32 
\  bits. A file or string to be checked is treated like a polynomial 
\  of degree 8 times the number of bytes all minus 1. That is, a 
\  100,000 byte file or string is a 799,999 degree polynomial. 

\  If you examine the code for `Calculate-CRC-for-a-Byte` you can see 
\  that it's doing long division the way you learned in third or 
\  fourth grade but with binary polynomials as dividend and divisor. 
\  `XOR` is subtraction - and addition. `CRC-POLYNOMIAL` is the 
\  divisor. When you're through with the file the check-sum is the 
\  remainder. The quotient is ignored throughout.  `CRC-32-Table` 
\  contains the remainders when dividing by `CRC-POLYNOMIAL`. 

\  The coefficients of `CRC-POLYNOMIAL` are in reverse order from the 
\  arithmetic value. This is the order in which they occur when the 
\  file is transmitted. In the polynomial the sign bit represents `1` 
\  and `1 AND` represents _x_^31. `1 RSHIFT` would shift the dividend 
\  to the _left_ if you were doing it by hand. 

\  After `CRC-32-Table` is built, `CRC-POLYNOMIAL` is no longer 
\  needed and is discarded together with the functions that were used 
\  to build `CRC-32-Table`. 

    : Calculate-CRC-for-a-Byte     ( i -- crc )
        8 0 DO
            dup  1 AND  IF
                1 RSHIFT  CRC-POLYNOMIAL XOR
            ELSE
                1 RSHIFT
            THEN
        LOOP ;

    : Build-CRC-Table              ( -- )
        256 0 DO
            I Calculate-CRC-for-a-Byte  I CELLS CRC-32-Table + !
        LOOP ;

Build-CRC-Table

CRC-32-TABLE-INITIALIZATION   \  Discard everything after CRC-32-Table.

\          Display CRC-32-Table to see whether it looks OK.

\  The print-out has the form it does so you can copy and paste it as 
\  the definition of `CRC-32-Table` rather than re-constructing it in 
\  the future. You will still need the definitions of 
\  `Calculate-CRC-32` and `CRC-32` of course. 

    MARKER ONCE
    : Print-CRC-Table
        CR ." CREATE CRC-32-Table "   CR ." HEX "
        256 0 DO
            I 4 MOD 0= IF
                CR  ." ( "  I 3 .R  ."  )  "
            THEN
            I CELLS CRC-32-Table + @
                HEX 0 <# # # # # # # # # #> TYPE ."  , " DECIMAL
        LOOP
        CR ." DECIMAL "
    ; Print-CRC-Table ONCE

\  Calculate-CRC-32               ( crc byte -- crc' )
\     Update CRC by a byte.

\  CRC-32                         ( crc addr u -- crc' )
\     Compute CRC for a file or string.

: Calculate-CRC-32             ( crc byte -- crc' )
    OVER XOR  255 AND  CELLS CRC-32-Table +  @  SWAP  8 RSHIFT  XOR
    ;

: CRC-32                       ( crc addr u -- crc' )
    BOUNDS ?DO ( crc) I C@ Calculate-CRC-32  LOOP  INVERT ;

\  Little-Endian-!                ( n addr -- )
\     Store _n_ at _addr_ in little-endian order.  If the environment 
\     arithmetic is already little-endian, this is equivalent to `!` 
\     overriding alignment requirements. 

\  CRC-TEST                       ( str len -- )
\     Test the CRC-32 of a string.

: Little-Endian-!              ( n addr -- )
    4 BOUNDS DO ( n) dup  255 AND  I C!  8 RSHIFT  LOOP
    DROP ;

: CRC-TEST                     ( str len -- )
    dup >R
        \  Move string to PAD.
        PAD SWAP MOVE              ( )
        \  Calculate CRC.
        TRUE PAD R@                ( crc str len)
        CRC-32                     ( crc')
        \  Show it.
        CR ." \ "
        dup HEX U. DECIMAL
        \  Invert CRC and add to end of string.
        INVERT
        PAD R@ + Little-Endian-!   ( )
        \  Check CRC of the result.
        TRUE PAD R@ 4 +            ( crc str len)
        CRC-32                     ( crc')
        HEX U. DECIMAL             ( )  \  Should be all bits on.
    R> DROP ;

S" An Arbitrary String" CRC-TEST         \  Should be 6FBEAAE7 FFFFFFFF
S" ZYXWVUTSRQPONMLKJIHGFEDBCA" CRC-TEST  \  Should be 99CDFDB2 FFFFFFFF
S" 123456789" CRC-TEST                   \  Should be CBF43926 FFFFFFFF
 
\  Thanks to Petrus Prawirodidjojo.

\\  End of CRC

\ CRC-POLYNOMIAL is EDB88320

CREATE CRC-32-Table
HEX
(   0 )  00000000 , 77073096 , EE0E612C , 990951BA ,
(   4 )  076DC419 , 706AF48F , E963A535 , 9E6495A3 ,
(   8 )  0EDB8832 , 79DCB8A4 , E0D5E91E , 97D2D988 ,
(  12 )  09B64C2B , 7EB17CBD , E7B82D07 , 90BF1D91 ,
(  16 )  1DB71064 , 6AB020F2 , F3B97148 , 84BE41DE ,
(  20 )  1ADAD47D , 6DDDE4EB , F4D4B551 , 83D385C7 ,
(  24 )  136C9856 , 646BA8C0 , FD62F97A , 8A65C9EC ,
(  28 )  14015C4F , 63066CD9 , FA0F3D63 , 8D080DF5 ,
(  32 )  3B6E20C8 , 4C69105E , D56041E4 , A2677172 ,
(  36 )  3C03E4D1 , 4B04D447 , D20D85FD , A50AB56B ,
(  40 )  35B5A8FA , 42B2986C , DBBBC9D6 , ACBCF940 ,
(  44 )  32D86CE3 , 45DF5C75 , DCD60DCF , ABD13D59 ,
(  48 )  26D930AC , 51DE003A , C8D75180 , BFD06116 ,
(  52 )  21B4F4B5 , 56B3C423 , CFBA9599 , B8BDA50F ,
(  56 )  2802B89E , 5F058808 , C60CD9B2 , B10BE924 ,
(  60 )  2F6F7C87 , 58684C11 , C1611DAB , B6662D3D ,
(  64 )  76DC4190 , 01DB7106 , 98D220BC , EFD5102A ,
(  68 )  71B18589 , 06B6B51F , 9FBFE4A5 , E8B8D433 ,
(  72 )  7807C9A2 , 0F00F934 , 9609A88E , E10E9818 ,
(  76 )  7F6A0DBB , 086D3D2D , 91646C97 , E6635C01 ,
(  80 )  6B6B51F4 , 1C6C6162 , 856530D8 , F262004E ,
(  84 )  6C0695ED , 1B01A57B , 8208F4C1 , F50FC457 ,
(  88 )  65B0D9C6 , 12B7E950 , 8BBEB8EA , FCB9887C ,
(  92 )  62DD1DDF , 15DA2D49 , 8CD37CF3 , FBD44C65 ,
(  96 )  4DB26158 , 3AB551CE , A3BC0074 , D4BB30E2 ,
( 100 )  4ADFA541 , 3DD895D7 , A4D1C46D , D3D6F4FB ,
( 104 )  4369E96A , 346ED9FC , AD678846 , DA60B8D0 ,
( 108 )  44042D73 , 33031DE5 , AA0A4C5F , DD0D7CC9 ,
( 112 )  5005713C , 270241AA , BE0B1010 , C90C2086 ,
( 116 )  5768B525 , 206F85B3 , B966D409 , CE61E49F ,
( 120 )  5EDEF90E , 29D9C998 , B0D09822 , C7D7A8B4 ,
( 124 )  59B33D17 , 2EB40D81 , B7BD5C3B , C0BA6CAD ,
( 128 )  EDB88320 , 9ABFB3B6 , 03B6E20C , 74B1D29A ,
( 132 )  EAD54739 , 9DD277AF , 04DB2615 , 73DC1683 ,
( 136 )  E3630B12 , 94643B84 , 0D6D6A3E , 7A6A5AA8 ,
( 140 )  E40ECF0B , 9309FF9D , 0A00AE27 , 7D079EB1 ,
( 144 )  F00F9344 , 8708A3D2 , 1E01F268 , 6906C2FE ,
( 148 )  F762575D , 806567CB , 196C3671 , 6E6B06E7 ,
( 152 )  FED41B76 , 89D32BE0 , 10DA7A5A , 67DD4ACC ,
( 156 )  F9B9DF6F , 8EBEEFF9 , 17B7BE43 , 60B08ED5 ,
( 160 )  D6D6A3E8 , A1D1937E , 38D8C2C4 , 4FDFF252 ,
( 164 )  D1BB67F1 , A6BC5767 , 3FB506DD , 48B2364B ,
( 168 )  D80D2BDA , AF0A1B4C , 36034AF6 , 41047A60 ,
( 172 )  DF60EFC3 , A867DF55 , 316E8EEF , 4669BE79 ,
( 176 )  CB61B38C , BC66831A , 256FD2A0 , 5268E236 ,
( 180 )  CC0C7795 , BB0B4703 , 220216B9 , 5505262F ,
( 184 )  C5BA3BBE , B2BD0B28 , 2BB45A92 , 5CB36A04 ,
( 188 )  C2D7FFA7 , B5D0CF31 , 2CD99E8B , 5BDEAE1D ,
( 192 )  9B64C2B0 , EC63F226 , 756AA39C , 026D930A ,
( 196 )  9C0906A9 , EB0E363F , 72076785 , 05005713 ,
( 200 )  95BF4A82 , E2B87A14 , 7BB12BAE , 0CB61B38 ,
( 204 )  92D28E9B , E5D5BE0D , 7CDCEFB7 , 0BDBDF21 ,
( 208 )  86D3D2D4 , F1D4E242 , 68DDB3F8 , 1FDA836E ,
( 212 )  81BE16CD , F6B9265B , 6FB077E1 , 18B74777 ,
( 216 )  88085AE6 , FF0F6A70 , 66063BCA , 11010B5C ,
( 220 )  8F659EFF , F862AE69 , 616BFFD3 , 166CCF45 ,
( 224 )  A00AE278 , D70DD2EE , 4E048354 , 3903B3C2 ,
( 228 )  A7672661 , D06016F7 , 4969474D , 3E6E77DB ,
( 232 )  AED16A4A , D9D65ADC , 40DF0B66 , 37D83BF0 ,
( 236 )  A9BCAE53 , DEBB9EC5 , 47B2CF7F , 30B5FFE9 ,
( 240 )  BDBDF21C , CABAC28A , 53B39330 , 24B4A3A6 ,
( 244 )  BAD03605 , CDD70693 , 54DE5729 , 23D967BF ,
( 248 )  B3667A2E , C4614AB8 , 5D681B02 , 2A6F2B94 ,
( 252 )  B40BBE37 , C30C8EA1 , 5A05DF1B , 2D02EF8D ,
DECIMAL