*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;