

Task

Demonstrate a method of deriving the Cyclic Redundancy Check from within the language.



The result should be in accordance with ISO 3309, ITU-T V.42, Gzip and PNG.

Algorithms are described on Computation of CRC in Wikipedia.
This variant of CRC-32 uses LSB-first order, sets the initial CRC to FFFFFFFF16, and complements the final CRC.

For the purpose of this task, generate a CRC-32 checksum for the ASCII encoded string:

 The quick brown fox jumps over the lazy dog


*process source attributes xref or(!) nest;
 crct: Proc Options(main);
 /*********************************************************************
 * 19.08.2013 Walter Pachl  derived from REXX
 *********************************************************************/
 Dcl (LEFT,LENGTH,RIGHT,SUBSTR,UNSPEC) Builtin;
 Dcl SYSPRINT Print;
 dcl tab(0:255) Bit(32);
 Call mk_tab;
 Call crc_32('The quick brown fox jumps over the lazy dog');
 Call crc_32('Generate CRC32 Checksum For Byte Array Example');
 
 crc_32: Proc(s);
 /*********************************************************************
 * compute checksum for s
 *********************************************************************/
 Dcl s Char(*);
 Dcl d   Bit(32);
 Dcl d1  Bit( 8);
 Dcl d2  Bit(24);
 Dcl cc  Char(1);
 Dcl ccb Bit(8);
 Dcl tib Bit(8);
 Dcl ti  Bin Fixed(16) Unsigned;
 Dcl k   Bin Fixed(16) Unsigned;
 d=(32)'1'b;
 Do k=1 To length(s);
    d1=right(d,8);
    d2=left(d,24);
    cc=substr(s,k,1);
    ccb=unspec(cc);
    tib=d1^ccb;
    Unspec(ti)=tib;
    d='00000000'b!!d2^tab(ti);
    End;
  d=d^(32)'1'b;
  Put Edit(s,'CRC_32=',b2x(d))(Skip,a(50),a,a);
  Put Edit('decimal ',b2d(d))(skip,x(49),a,f(10));
 End;
 
 b2x: proc(b) Returns(char(8));
 dcl b bit(32);
 dcl b4 bit(4);
 dcl i Bin Fixed(31);
 dcl r Char(8) Var init('');
 Do i=1 To 29 By 4;
   b4=substr(b,i,4);
   Select(b4);
     When('0000'b) r=r!!'0';
     When('0001'b) r=r!!'1';
     When('0010'b) r=r!!'2';
     When('0011'b) r=r!!'3';
     When('0100'b) r=r!!'4';
     When('0101'b) r=r!!'5';
     When('0110'b) r=r!!'6';
     When('0111'b) r=r!!'7';
     When('1000'b) r=r!!'8';
     When('1001'b) r=r!!'9';
     When('1010'b) r=r!!'A';
     When('1011'b) r=r!!'B';
     When('1100'b) r=r!!'C';
     When('1101'b) r=r!!'D';
     When('1110'b) r=r!!'E';
     When('1111'b) r=r!!'F';
     End;
   End;
 Return(r);
 End;
 
 b2d: Proc(b) Returns(Dec Fixed(15));
 Dcl b Bit(32);
 Dcl r Dec Fixed(15) Init(0);
 Dcl i Bin Fixed(16);
 Do i=1 To 32;
   r=r*2
   If substr(b,i,1) Then
     r=r+1;
   End;
 Return(r);
 End;
 
 mk_tab: Proc;
 dcl b32 bit(32);
 dcl lb  bit( 1);
 dcl ccc bit(32) Init('edb88320'bx);
 dcl (i,j) Bin Fixed(15);
 Do i=0 To 255;
   b32=(24)'0'b!!unspec(i);
   Do j=0 To 7;
     lb=right(b32,1);
     b32='0'b!!left(b32,31);
     If lb='1'b Then
       b32=b32^ccc;
     End;
   tab(i)=b32;
   End;
 End;
 End;