(*
CRC.PAS - Many routines to calculate CRCs.
Written: 05-31-90
Copyright (c)1990, Eric J. Givler, All Rights Reserved.
PROCEDURE blockCRC - Calculate CRC-16 for variable block size.
PROCEDURE ccitt_crc16_calc - Calculate 16bit CRC on CCITT polynomial (asm)
PROCEDURE ccitt_crc32_calc - Calculate 32bit CRC on CCITT polynomial (asm)
PROCEDURE calc_crc16 - Calculate CRC-16 for Xmodem BLOCK. (128)
PROCEDURE calc_crc32 - Calculate CRC-32 for 512 byte block.
PROCEDURE calcCRC - Calculate 16bit CRC OR ChkSum on BYTE.
PROCEDURE c_crc - Calculate CRC-16 for variable block size.
PROCEDURE updcrc - Calculate CRC-16 based on TABLE.
PROCEDURE updcrc2 - Calculate CRC-16 on a byte, updating crc.
PROCEDURE crca - Calculate CRC-16 via external ASM module
PROCEDURE crcasm - Calculate CRC-16 via external ASM module
*)
UNIT CRCS;
interface
type ARRAY512 = RECORD
len : integer;
longstring : array[1..512] of char;
END;
blocktype = array[0..127] of byte;
var crc_input : integer;
crc_reg_lo : integer;
crc_reg_hi : integer;
crc : integer;
chksum : byte;
procedure updcrc( var crc : word; c : integer);
procedure ccitt_crc16_calc;
procedure ccitt_crc32_calc;
procedure calc_crc32(cs : ARRAY512);
procedure calc_crc16(cs : blocktype);
procedure calcCRC(data : byte);
procedure blockCRC( segment,offset : word; count : integer);
procedure c_crc(segment,offset:word; count:integer;var crc:integer);
procedure crcasm(b : byte; VAR c : integer);
procedure crca(VAR a {untyped}; l : word; VAR c : integer);
procedure updcrc2(var crc : word; c : integer);
implementation
CONST
Crctttab : array[0..255] of word =
($0000, $1021, $2042, $3063, $4084, $50A5, $60C6, $70E7,
$8108, $9129, $A14A, $B16B, $C18C, $D1AD, $E1CE, $F1EF,
$1231, $0210, $3273, $2252, $52B5, $4294, $72F7, $62D6,
$9339, $8318, $B37B, $A35A, $D3BD, $C39C, $F3FF, $E3DE,
$2462, $3443, $0420, $1401, $64E6, $74C7, $44A4, $5485,
$A56A, $B54B, $8528, $9509, $E5EE, $F5CF, $C5AC, $D58D,
$3653, $2672, $1611, $0630, $76D7, $66F6, $5695, $46B4,
$B75B, $A77A, $9719, $8738, $F7DF, $E7FE, $D79D, $C7BC,
$48C4, $58E5, $6886, $78A7, $0840, $1861, $2802, $3823,
$C9CC, $D9ED, $E98E, $F9AF, $8948, $9969, $A90A, $B92B,
$5AF5, $4AD4, $7AB7, $6A96, $1A71, $0A50, $3A33, $2A12,
$DBFD, $CBDC, $FBBF, $EB9E, $9B79, $8B58, $BB3B, $AB1A,
$6CA6, $7C87, $4CE4, $5CC5, $2C22, $3C03, $0C60, $1C41,
$EDAE, $FD8F, $CDEC, $DDCD, $AD2A, $BD0B, $8D68, $9D49,
$7E97, $6EB6, $5ED5, $4EF4, $3E13, $2E32, $1E51, $0E70,
$FF9F, $EFBE, $DFDD, $CFFC, $BF1B, $AF3A, $9F59, $8F78,
$9188, $81A9, $B1CA, $A1EB, $D10C, $C12D, $F14E, $E16F,
$1080, $00A1, $30C2, $20E3, $5004, $4025, $7046, $6067,
$83B9, $9398, $A3FB, $B3DA, $C33D, $D31C, $E37F, $F35E,
$02B1, $1290, $22F3, $32D2, $4235, $5214, $6277, $7256,
$B5EA, $A5CB, $95A8, $8589, $F56E, $E54F, $D52C, $C50D,
$34E2, $24C3, $14A0, $0481, $7466, $6447, $5424, $4405,
$A7DB, $B7FA, $8799, $97B8, $E75F, $F77E, $C71D, $D73C,
$26D3, $36F2, $0691, $16B0, $6657, $7676, $4615, $5634,
$D94C, $C96D, $F90E, $E92F, $99C8, $89E9, $B98A, $A9AB,
$5844, $4865, $7806, $6827, $18C0, $08E1, $3882, $28A3,
$CB7D, $DB5C, $EB3F, $FB1E, $8BF9, $9BD8, $ABBB, $BB9A,
$4A75, $5A54, $6A37, $7A16, $0AF1, $1AD0, $2AB3, $3A92,
$FD2E, $ED0F, $DD6C, $CD4D, $BDAA, $AD8B, $9DE8, $8DC9,
$7C26, $6C07, $5C64, $4C45, $3CA2, $2C83, $1CE0, $0CC1,
$EF1F, $FF3E, $CF5D, $DF7C, $AF9B, $BFBA, $8FD9, $9FF8,
$6E17, $7E36, $4E55, $5E74, $2E93, $3EB2, $0ED1, $1EF0
);
{$l xcrc}
procedure crcasm(b : byte; VAR c : integer); external;
procedure crca(VAR a {untyped}; l : word; VAR c : integer); external;
procedure updcrc(var crc : word; c : integer);
var tmp : integer;
begin
tmp := (crc SHR 8) XOR c;
crc := (crc SHL 8) XOR crctttab[tmp];
end;
procedure ccitt_crc16_calc; { CRC-16 }
begin
inLine( $8B/$1E/crc_reg_hi ); { mov bx,crc_reg_hi }
inLine( $B9/>$08 ); { mov cx, 8 }
inLine( $A1/crc_input ); { mov ax,crc_input }
inLine( $D0/$D0 ); { u1: rcl al,1 }
inLine( $D1/$D3 ); { rcl bx,1 }
inLine( $73/$04 ); { jnc u2 }
inLine( $81/$F3/$1021 ); { xor bx, 1021h }
inLine( $E2/$F4 ); { u2: loop u1 }
inLine( $89/$1E/crc_reg_hi); { mov crc_reg_hi,bx }
end;
procedure ccitt_crc32_calc; { CRC-32 }
begin
inLine( $8B/$1E/crc_reg_lo ); { mov bx,crc_reg_lo }
inLine( $8B/$16/crc_reg_hi ); { mov dx,crc_reg_hi }
inLine( $89/>$08 ); { mov cx,8 }
inLine( $A1/crc_input ); { mov ax,crc_input }
inLine( $D0/$D8 ); { u1: rcr al,1 }
inLine( $D1/$DA ); { rcr dx,1 }
inLine( $D1/$DB ); { rcr bx,1 }
inLine( $73/$08 ); { jnc u2 }
inLine( $81/$F3/$8320 ); { xor bx,8320h }
inLine( $81/$F2/$ED88 ); { xor dx,ED88h }
inLine( $E2/$EE ); { u2: loop u1 }
inLine( $89/$1E/crc_reg_lo ); { mov crc_reg_lo, bx }
inLine( $89/$16/crc_reg_hi ); { mov crc_reg_hi, dx }
end;
procedure calc_crc32( cs : ARRAY512);
var i : integer;
begin
{ This routine calculates a 32 bit CRC based on the CCITT polynomial.
The result is stored in the CRC register, variables crc_reg_hi &
crc_reg_lo. }
crc_reg_hi := 0;
crc_reg_lo := 0;
WITH cs DO BEGIN
FOR i := 1 TO Len DO BEGIN
crc_input := ORD(LongString[i]);
ccitt_crc32_calc;
END;
END;
crc_input := 0;
ccitt_crc32_calc;
ccitt_crc32_calc;
ccitt_crc32_calc;
ccitt_crc32_calc;
end;
procedure calc_crc16( cs : blocktype);
var i : integer;
begin
{ This routine calculates a 16 bit CRC based on the CCITT polynomial.
The result is stored in the CRC register, variable crc_reg_hi. }
crc_reg_hi := 0;
crc_reg_lo := 0;
for I := 0 to 127 do begin
crc_input := cs[i];
ccitt_crc16_calc;
end;
crc_input := 0;
ccitt_crc16_calc;
ccitt_crc16_calc;
end;
procedure calcCRC(data:byte);
var carry : boolean;
i : byte;
begin
chksum := Lo(chksum + data);
FOR i := 0 TO 7 do begin
carry := (crc and $8000) <> 0;
crc := crc SHL 1;
if (data and $80) <> 0 then crc := crc or $0001;
if carry then crc := crc xor $1021;
data := lo(data shl 1);
end;
end;
procedure updcrc2( var crc : word; c : integer);
var i : integer;
begin
crc := crc XOR c SHL 8;
for i := 0 to 7 do begin
if ((crc XOR c) AND $8000)<>0
then crc := (crc SHL 1) XOR $1021 else crc := crc SHL 1;
end;
crc := crc SHL 1;
end;
procedure blockCRC( segment,offset : word; count : integer);
VAR i : integer;
begin
crc_reg_hi := 0;
crc_reg_lo := 0;
for i := 0 TO count do begin
crc_input := Mem[segment:offset];
inc(offset);
ccitt_crc16_calc;
end;
crc_input := 0;
ccitt_crc16_calc;
ccitt_crc16_calc;
end;
procedure c_crc(segment,offset:word; count:integer;var crc:integer);
{ usage: c_crc( Seg(sector[0]), Ofs(sector[0]), 127, crc); }
type BytePtr = ^Byte;
VAR i,
j : integer;
b : BytePtr;
begin
j := 0;
crc := 0;
b := New(BytePtr);
while (count >= 0) do begin
b := Ptr(segment,offset);
crc := crc xor b^ shl 8;
for i := 0 to 7 do begin
if (crc and $8000)<>0 then crc := crc SHL 1 xor $1021
else crc := crc SHL 1;
end;
inc(offset);
dec(count);
end;
b := Nil;
crc := crc AND $FFFF;
end;
end.
