Recent

Author Topic: HASH: CRC-16  (Read 17271 times)

joho

  • Jr. Member
  • **
  • Posts: 69
  • Joaquim Homrighausen
    • ~/JoHo
HASH: CRC-16
« on: September 15, 2017, 01:30:08 am »
Any chance this could make it into the HASH package, or someone show me how to do it inline ASM FPC style so I don't run into the silly COFF-format error? :)

Pascal declaration:

Code: Pascal  [Select][+][-]
  1. FUNCTION CRC16 (Old :LONGINT; VAR Buff; Len :LONGINT) :WORD; EXTERNAL;
  2.  

ASM code:

Code: ASM  [Select][+][-]
  1. CODE32  SEGMENT DWORD PUBLIC USE32 'CODE'
  2.         ASSUME CS:CODE32
  3.         EVEN
  4.         PUBLIC CRC16
  5.  
  6. ctab:   dw  00000h, 01021h, 02042h, 03063h, 04084h, 050a5h, 060C6h, 070e7h
  7.         dw  08108h, 09129h, 0a14ah, 0B16bh, 0C18ch, 0D1aDh, 0e1Ceh, 0F1eFh
  8.         dw  01231h, 00210h, 03273h, 02252h, 052B5h, 04294h, 072F7h, 062D6h
  9.         dw  09339h, 08318h, 0B37bh, 0a35ah, 0D3BDh, 0C39ch, 0F3FFh, 0e3Deh
  10.         dw  02462h, 03443h, 00420h, 01401h, 064e6h, 074C7h, 044a4h, 05485h
  11.         dw  0a56ah, 0B54bh, 08528h, 09509h, 0e5eeh, 0F5CFh, 0C5ach, 0D58Dh
  12.         dw  03653h, 02672h, 01611h, 00630h, 076D7h, 066F6h, 05695h, 046B4h
  13.         dw  0B75bh, 0a77ah, 09719h, 08738h, 0F7DFh, 0e7Feh, 0D79Dh, 0C7Bch
  14.         dw  048C4h, 058e5h, 06886h, 078a7h, 00840h, 01861h, 02802h, 03823h
  15.         dw  0C9Cch, 0D9edh, 0e98eh, 0F9aFh, 08948h, 09969h, 0a90ah, 0B92bh
  16.         dw  05aF5h, 04aD4h, 07aB7h, 06a96h, 01a71h, 00a50h, 03a33h, 02a12h
  17.         dw  0DBFDh, 0CBDch, 0FBBFh, 0eB9eh, 09B79h, 08B58h, 0BB3bh, 0aB1ah
  18.         dw  06Ca6h, 07C87h, 04Ce4h, 05CC5h, 02C22h, 03C03h, 00C60h, 01C41h
  19.         dw  0edaeh, 0FD8Fh, 0CDech, 0DDCDh, 0aD2ah, 0BD0bh, 08D68h, 09D49h
  20.         dw  07e97h, 06eB6h, 05ed5h, 04eF4h, 03e13h, 02e32h, 01e51h, 00e70h
  21.         dw  0FF9Fh, 0eFBeh, 0DFDDh, 0CFFch, 0BF1bh, 0aF3ah, 09F59h, 08F78h
  22.         dw  09188h, 081a9h, 0B1Cah, 0a1ebh, 0D10ch, 0C12Dh, 0F14eh, 0e16Fh
  23.         dw  01080h, 000a1h, 030C2h, 020e3h, 05004h, 04025h, 07046h, 06067h
  24.         dw  083B9h, 09398h, 0a3Fbh, 0B3Dah, 0C33Dh, 0D31ch, 0e37Fh, 0F35eh
  25.         dw  002B1h, 01290h, 022F3h, 032D2h, 04235h, 05214h, 06277h, 07256h
  26.         dw  0B5eah, 0a5Cbh, 095a8h, 08589h, 0F56eh, 0e54Fh, 0D52ch, 0C50Dh
  27.         dw  034e2h, 024C3h, 014a0h, 00481h, 07466h, 06447h, 05424h, 04405h
  28.         dw  0a7Dbh, 0B7Fah, 08799h, 097B8h, 0e75Fh, 0F77eh, 0C71Dh, 0D73ch
  29.         dw  026D3h, 036F2h, 00691h, 016B0h, 06657h, 07676h, 04615h, 05634h
  30.         dw  0D94ch, 0C96Dh, 0F90eh, 0e92Fh, 099C8h, 089e9h, 0B98ah, 0a9abh
  31.         dw  05844h, 04865h, 07806h, 06827h, 018C0h, 008e1h, 03882h, 028a3h
  32.         dw  0CB7Dh, 0DB5ch, 0eB3Fh, 0FB1eh, 08BF9h, 09BD8h, 0aBBbh, 0BB9ah
  33.         dw  04a75h, 05a54h, 06a37h, 07a16h, 00aF1h, 01aD0h, 02aB3h, 03a92h
  34.         dw  0FD2eh, 0ed0Fh, 0DD6ch, 0CD4Dh, 0BDaah, 0aD8bh, 09De8h, 08DC9h
  35.         dw  07C26h, 06C07h, 05C64h, 04C45h, 03Ca2h, 02C83h, 01Ce0h, 00CC1h
  36.         dw  0eF1Fh, 0FF3eh, 0CF5Dh, 0DF7ch, 0aF9bh, 0BFBah, 08FD9h, 09FF8h
  37.         dw  06e17h, 07e36h, 04e55h, 05e74h, 02e93h, 03eB2h, 00ed1h, 01eF0h
  38.  
  39. OldCRC  EQU     DWORD PTR [EBP+16]
  40. Buffer  EQU     DWORD PTR [EBP+12]
  41. BufLen  EQU     DWORD PTR [EBP+8]
  42.  
  43. CRC16   PROC
  44.         push    EBP
  45.         mov     EBP, ESP
  46.         push    EBX
  47.         push    ECX
  48.         push    ESI
  49.         mov     EAX, OldCRC             ;Set-up EAX before zero check
  50.         and     EAX, 0000ffffh          ;Make sure it's a "word"
  51.         mov     ECX, BufLen
  52.         and     ECX, 0000ffffh          ;Make sure it's a "word"        
  53.         or      ECX, ECX
  54.         jz      short return
  55.         mov     ESI, Buffer
  56.         xor     EBX, EBX
  57. loop2:
  58.         xor     BH, BH
  59.         mov     BL, [ESI]               ;bx := Current
  60.         xor     BL, AH                  ;bx := (old >> 8) xor Current
  61.         mov     AH, AL
  62.         xor     AL, AL                  ;ax := old << 8
  63.         shl     EBX, 1
  64.         xor     AX, word ptr ctab [EBX] ;ax := (old << 8) ^ table [(old >> 8) ^ Curr]
  65.         inc     ESI                     ;Increase character pointer
  66.         loop    short loop2
  67. return:
  68.         pop     ESI
  69.         pop     ECX
  70.         pop     EBX
  71.         pop     EBP
  72.         ret     12
  73. CRC16   ENDP
  74. CODE32  ENDS
  75.         END
  76.  

-joho

Thaddy

  • Hero Member
  • *****
  • Posts: 14197
  • Probably until I exterminate Putin.
Re: HASH: CRC-16
« Reply #1 on: September 15, 2017, 08:06:54 am »
No, I don't think so because it is:

a) not portable
b) even old fashioned assembler
c) there are many crc16's in pure pascal that are probably *much* faster than your code because it will use more modern instructions.
d) a crc calculation based on lookups (as here) is *very* easy for the compiler. Even proper modern assembler will likely not have much if any speed gain.

Example:
Code: Pascal  [Select][+][-]
  1. program crc16test;
  2. {$mode objfpc}{$I-}
  3. uses sysutils;
  4. // based on synacode.pas from synapse
  5. const
  6.  Crc16Tab: array[0..255] of Word = (
  7.     $0000, $1189, $2312, $329B, $4624, $57AD, $6536, $74BF,
  8.     $8C48, $9DC1, $AF5A, $BED3, $CA6C, $DBE5, $E97E, $F8F7,
  9.     $1081, $0108, $3393, $221A, $56A5, $472C, $75B7, $643E,
  10.     $9CC9, $8D40, $BFDB, $AE52, $DAED, $CB64, $F9FF, $E876,
  11.     $2102, $308B, $0210, $1399, $6726, $76AF, $4434, $55BD,
  12.     $AD4A, $BCC3, $8E58, $9FD1, $EB6E, $FAE7, $C87C, $D9F5,
  13.     $3183, $200A, $1291, $0318, $77A7, $662E, $54B5, $453C,
  14.     $BDCB, $AC42, $9ED9, $8F50, $FBEF, $EA66, $D8FD, $C974,
  15.     $4204, $538D, $6116, $709F, $0420, $15A9, $2732, $36BB,
  16.     $CE4C, $DFC5, $ED5E, $FCD7, $8868, $99E1, $AB7A, $BAF3,
  17.     $5285, $430C, $7197, $601E, $14A1, $0528, $37B3, $263A,
  18.     $DECD, $CF44, $FDDF, $EC56, $98E9, $8960, $BBFB, $AA72,
  19.     $6306, $728F, $4014, $519D, $2522, $34AB, $0630, $17B9,
  20.     $EF4E, $FEC7, $CC5C, $DDD5, $A96A, $B8E3, $8A78, $9BF1,
  21.     $7387, $620E, $5095, $411C, $35A3, $242A, $16B1, $0738,
  22.     $FFCF, $EE46, $DCDD, $CD54, $B9EB, $A862, $9AF9, $8B70,
  23.     $8408, $9581, $A71A, $B693, $C22C, $D3A5, $E13E, $F0B7,
  24.     $0840, $19C9, $2B52, $3ADB, $4E64, $5FED, $6D76, $7CFF,
  25.     $9489, $8500, $B79B, $A612, $D2AD, $C324, $F1BF, $E036,
  26.     $18C1, $0948, $3BD3, $2A5A, $5EE5, $4F6C, $7DF7, $6C7E,
  27.     $A50A, $B483, $8618, $9791, $E32E, $F2A7, $C03C, $D1B5,
  28.     $2942, $38CB, $0A50, $1BD9, $6F66, $7EEF, $4C74, $5DFD,
  29.     $B58B, $A402, $9699, $8710, $F3AF, $E226, $D0BD, $C134,
  30.     $39C3, $284A, $1AD1, $0B58, $7FE7, $6E6E, $5CF5, $4D7C,
  31.     $C60C, $D785, $E51E, $F497, $8028, $91A1, $A33A, $B2B3,
  32.     $4A44, $5BCD, $6956, $78DF, $0C60, $1DE9, $2F72, $3EFB,
  33.     $D68D, $C704, $F59F, $E416, $90A9, $8120, $B3BB, $A232,
  34.     $5AC5, $4B4C, $79D7, $685E, $1CE1, $0D68, $3FF3, $2E7A,
  35.     $E70E, $F687, $C41C, $D595, $A12A, $B0A3, $8238, $93B1,
  36.     $6B46, $7ACF, $4854, $59DD, $2D62, $3CEB, $0E70, $1FF9,
  37.     $F78F, $E606, $D49D, $C514, $B1AB, $A022, $92B9, $8330,
  38.     $7BC7, $6A4E, $58D5, $495C, $3DE3, $2C6A, $1EF1, $0F78
  39.     );
  40.  
  41.  
  42. function UpdateCrc16(Value: Byte; Crc16: Word): Word;inline;
  43. begin
  44.   Result := ((Crc16 shr 8) and $00FF) xor
  45.     crc16tab[Byte(Crc16 xor (Word(Value)) and $00FF)];
  46. end;
  47.  
  48.  
  49. function Crc16(const Value: AnsiString): Word;inline;
  50. var
  51.   n: Integer;
  52. begin
  53.   Result := $FFFF;
  54.   for n := 1 to Length(Value) do
  55.     Result := UpdateCrc16(Ord(Value[n]), Result);
  56. end;
  57.  
  58. begin
  59.   writeln(inttohex(crc16('testme'),4));
  60. end.

This is usually almost just as fast and fully cross-platform. It is faster when using the proper optimisations for modern processors.

« Last Edit: September 15, 2017, 08:57:04 am by Thaddy »
Specialize a type, not a var.

joho

  • Jr. Member
  • **
  • Posts: 69
  • Joaquim Homrighausen
    • ~/JoHo
Re: HASH: CRC-16
« Reply #2 on: September 15, 2017, 08:53:17 am »
So ... since there's 32, 64, and 128-bit CRC code in there already, could we have a 16-bit CRC function as well then? (Of course, written by you guys since your code efficiency level is way beyond mine.)

Thaddy

  • Hero Member
  • *****
  • Posts: 14197
  • Probably until I exterminate Putin.
Re: HASH: CRC-16
« Reply #3 on: September 15, 2017, 10:22:22 am »
Which crc16 do you suggest? ccitt? (your table is CCITT) There are many...
[edit]
By now I have a compendium of different CRC16's, but - apart from legacy - do you have a use-case?
See this https://en.wikipedia.org/wiki/Cyclic_redundancy_check

BTW:
Here's your  CCITT table, also works with my code, just exchange tables:
Code: Pascal  [Select][+][-]
  1. const
  2.  crc_tab_CCITT:array[0..255] of word = (
  3.     $0000, $1021, $2042, $3063, $4084, $50a5, $60c6, $70e7,
  4.     $8108, $9129, $a14a, $b16b, $c18c, $d1ad, $e1ce, $f1ef,
  5.     $1231, $0210, $3273, $2252, $52b5, $4294, $72f7, $62d6,
  6.     $9339, $8318, $b37b, $a35a, $d3bd, $c39c, $f3ff, $e3de,
  7.     $2462, $3443, $0420, $1401, $64e6, $74c7, $44a4, $5485,
  8.     $a56a, $b54b, $8528, $9509, $e5ee, $f5cf, $c5ac, $d58d,
  9.     $3653, $2672, $1611, $0630, $76d7, $66f6, $5695, $46b4,
  10.     $b75b, $a77a, $9719, $8738, $f7df, $e7fe, $d79d, $c7bc,
  11.     $48c4, $58e5, $6886, $78a7, $0840, $1861, $2802, $3823,
  12.     $c9cc, $d9ed, $e98e, $f9af, $8948, $9969, $a90a, $b92b,
  13.     $5af5, $4ad4, $7ab7, $6a96, $1a71, $0a50, $3a33, $2a12,
  14.     $dbfd, $cbdc, $fbbf, $eb9e, $9b79, $8b58, $bb3b, $ab1a,
  15.     $6ca6, $7c87, $4ce4, $5cc5, $2c22, $3c03, $0c60, $1c41,
  16.     $edae, $fd8f, $cdec, $ddcd, $ad2a, $bd0b, $8d68, $9d49,
  17.     $7e97, $6eb6, $5ed5, $4ef4, $3e13, $2e32, $1e51, $0e70,
  18.     $ff9f, $efbe, $dfdd, $cffc, $bf1b, $af3a, $9f59, $8f78,
  19.     $9188, $81a9, $b1ca, $a1eb, $d10c, $c12d, $f14e, $e16f,
  20.     $1080, $00a1, $30c2, $20e3, $5004, $4025, $7046, $6067,
  21.     $83b9, $9398, $a3fb, $b3da, $c33d, $d31c, $e37f, $f35e,
  22.     $02b1, $1290, $22f3, $32d2, $4235, $5214, $6277, $7256,
  23.     $b5ea, $a5cb, $95a8, $8589, $f56e, $e54f, $d52c, $c50d,
  24.     $34e2, $24c3, $14a0, $0481, $7466, $6447, $5424, $4405,
  25.     $a7db, $b7fa, $8799, $97b8, $e75f, $f77e, $c71d, $d73c,
  26.     $26d3, $36f2, $0691, $16b0, $6657, $7676, $4615, $5634,
  27.     $d94c, $c96d, $f90e, $e92f, $99c8, $89e9, $b98a, $a9ab,
  28.     $5844, $4865, $7806, $6827, $18c0, $08e1, $3882, $28a3,
  29.     $cb7d, $db5c, $eb3f, $fb1e, $8bf9, $9bd8, $abbb, $bb9a,
  30.     $4a75, $5a54, $6a37, $7a16, $0af1, $1ad0, $2ab3, $3a92,
  31.     $fd2e, $ed0f, $dd6c, $cd4d, $bdaa, $ad8b, $9de8, $8dc9,
  32.     $7c26, $6c07, $5c64, $4c45, $3ca2, $2c83, $1ce0, $0cc1,
  33.     $ef1f, $ff3e, $cf5d, $df7c, $af9b, $bfba, $8fd9, $9ff8,
  34.     $6e17, $7e36, $4e55, $5e74, $2e93, $3eb2, $0ed1, $1ef0);

Same output as yours and faster. Compare your assembler to what the compiler does.... Useless use of assembler...
I respect that you are interested in optimizing code, but plz always examine what the compiler does.... >:D
Took me 25 years to get my bad habits corrected...  ;D :( %) :-[(there is still a use for plain assembler optimisation, if you really know what you are doing, and always more complex than this)

Frankly (I hope you wrote that yourself!) it is a good exercise.. That's it. 8-)
Proof: the compiler generates only one loop....., not two...
« Last Edit: September 15, 2017, 12:05:53 pm by Thaddy »
Specialize a type, not a var.

joho

  • Jr. Member
  • **
  • Posts: 69
  • Joaquim Homrighausen
    • ~/JoHo
Re: HASH: CRC-16
« Reply #4 on: September 15, 2017, 12:04:38 pm »
Yes, CCITT. A use case would be some (old) file-transfer protocols, "lesser CPU" platforms where perhaps CRC-32 or similar cannot or is not used. Thanks for the table, etc. The original code was written over 20 years ago. No Pascal compiler for DOS, that I know of, generated faster code than that at the time. Of course I agree with your sentiments, modern compilers are (mostly) good at optimizing the resulting code.

Thaddy

  • Hero Member
  • *****
  • Posts: 14197
  • Probably until I exterminate Putin.
Re: HASH: CRC-16
« Reply #5 on: September 15, 2017, 12:08:16 pm »
So CRC16-Kermit, Y-Modem etc is the same as CRC16-CCITT?  ::)  (It s NOT!) First show WHERE you need it...
I will include CCITT, but that is hardly used albeit the official standard.

Let me explain: this is legacy, I will submit a patch with CRC16 hashes. It does not belong in the hash apart from being crc16.pas.
I am willing to propose that.
« Last Edit: September 15, 2017, 12:18:00 pm by Thaddy »
Specialize a type, not a var.

joho

  • Jr. Member
  • **
  • Posts: 69
  • Joaquim Homrighausen
    • ~/JoHo
Re: HASH: CRC-16
« Reply #6 on: September 15, 2017, 12:22:37 pm »
Nice pages:

http://reveng.sourceforge.net/crc-catalogue/16.htm
http://reveng.sourceforge.net/crc-catalogue/17plus.htm#crc.cat-bits.32
http://reveng.sourceforge.net/crc-catalogue/

Regardless, I'll just stick to using my own code then and update it using FPC since it clearly outdoes my "optimization" and the case is closed :)

marcov

  • Administrator
  • Hero Member
  • *
  • Posts: 11383
  • FPC developer.
Re: HASH: CRC-16
« Reply #7 on: September 15, 2017, 02:36:35 pm »
So CRC16-Kermit, Y-Modem etc is the same as CRC16-CCITT?  ::)  (It s NOT!) First show WHERE you need it...
I will include CCITT, but that is hardly used albeit the official standard.

Afaik the hardware crc16 unit of Microchip dspic and pic32 uses CCITT. So a cleaned (non asm) unit would be welcome.

Moreover if the only difference is the tables, maybe solve this with one CRC implementation, but multiple table generators?

joho

  • Jr. Member
  • **
  • Posts: 69
  • Joaquim Homrighausen
    • ~/JoHo
Re: HASH: CRC-16
« Reply #8 on: September 15, 2017, 02:39:13 pm »
Afaik the hardware crc16 unit of Microchip dspic and pic32 uses CCITT. So a cleaned (non asm) unit would be welcome.
Moreover if the only difference is the tables, maybe solve this with one CRC implementation, but multiple table generators?

That sounds like a pretty good way of doing it, and catering to multiple needs.

Thaddy

  • Hero Member
  • *****
  • Posts: 14197
  • Probably until I exterminate Putin.
Re: HASH: CRC-16
« Reply #9 on: September 15, 2017, 02:48:46 pm »
So CRC16-Kermit, Y-Modem etc is the same as CRC16-CCITT?  ::)  (It s NOT!) First show WHERE you need it...
I will include CCITT, but that is hardly used albeit the official standard.

Afaik the hardware crc16 unit of Microchip dspic and pic32 uses CCITT. So a cleaned (non asm) unit would be welcome.

Moreover if the only difference is the tables, maybe solve this with one CRC implementation, but multiple table generators?
Well, there's a little more to it, but not much more than xor'ing the end result for some implementations.
Basically I already took the approach of collecting tables. Because the polynomials are essentially the same principle.
E.g.:The second table I gave renders CCITT compliant results (as does OP's assembler code) with the same Pascal code.
Currently I am making them compliant with buffers instead of strings and follow the format as presented in crc.pas.

I already did some tests: there's no reason to use assembler, as I suspected. E.g. for win64 with all optimizations:
Code: Pascal  [Select][+][-]
  1. .Lj10:
  2.         addl    $1,%r9d
  3.         movslq  %r9d,%r8
  4.         leaq    -1(%rcx,%r8,1),%r8
  5.         movzbw  (%r8),%r8w
  6.         movw    %ax,%r10w
  7.         xorw    %r8w,%r10w
  8.         andl    $255,%r10d
  9.         leaq    TC_$P$CRC16TEST$_$CRC16$ANSISTRING$$WORD_$$_CRC16TAB(%rip),%r8
  10.         movzwl  (%r8,%r10,2),%r10d
  11.         movzwl  %ax,%r8d
  12.         shrl    $8,%r8d
  13.         andl    $255,%r8d
  14.         xorl    %r10d,%r8d
  15.         movw    %r8w,%ax
  16.         cmpl    %edx,%r9d
  17.         jnge    .Lj10
The long construct is just the lookup table, which I put on the stack. 1 cycle.
There's just one loop. i386 code looks almost the same.
Arm is even better. It skips the double load. I expect even better code with byte buffers.
« Last Edit: September 15, 2017, 04:54:20 pm by Thaddy »
Specialize a type, not a var.

Thaddy

  • Hero Member
  • *****
  • Posts: 14197
  • Probably until I exterminate Putin.
Re: HASH: CRC-16
« Reply #10 on: September 17, 2017, 12:46:08 pm »
Ok,
The compendium is ready for crc16. I will publish it later today and provide a patch for hash package to add crc16.pas:
crc_16
crc_16_modbus
crc_16_kermit
crc_16_xmodem
crc_16_dnp
crc_16_ccitt
crc_16_generic  // for which the Polynomial is the same but the start value differs.
 - crc_16_1d0f
 - crc_16_ffff

and crc_16_sick

That should cover it about all... :D

Initial tests are like this and all pass:
Code: Pascal  [Select][+][-]
  1. program program1;
  2. {$ifdef fpc}{$mode delphi}{$H+}{$J+}{$endif}
  3. uses sysutils;
  4. const
  5.   CRC_POLY_16 = $A001;    
  6.   CRC_POLY_CCITT = $1021;    
  7.   CRC_POLY_DNP = $A6BC;    
  8.   CRC_POLY_KERMIT = $8408;    
  9.   CRC_POLY_SICK = $8005;    
  10.  
  11.   CRC_START_16 = $0000;    
  12.   CRC_START_MODBUS = $FFFF;    
  13.   CRC_START_XMODEM = $0000;    
  14.   CRC_START_CCITT_1D0F = $1D0F;    
  15.   CRC_START_CCITT_FFFF = $FFFF;    
  16.   CRC_START_KERMIT = $0000;    
  17.   CRC_START_SICK = $0000;    
  18.   CRC_START_DNP = $0000;    
  19.  
  20.   crc_tab16_init:Boolean = false;
  21.   crc_tab16: array[0..255] of word =(
  22.   $0000, $C0C1, $C181, $0140, $C301, $03C0, $0280, $C241,
  23.   $C601, $06C0, $0780, $C741, $0500, $C5C1, $C481, $0440,
  24.   $CC01, $0CC0, $0D80, $CD41, $0F00, $CFC1, $CE81, $0E40,
  25.   $0A00, $CAC1, $CB81, $0B40, $C901, $09C0, $0880, $C841,
  26.   $D801, $18C0, $1980, $D941, $1B00, $DBC1, $DA81, $1A40,
  27.   $1E00, $DEC1, $DF81, $1F40, $DD01, $1DC0, $1C80, $DC41,
  28.   $1400, $D4C1, $D581, $1540, $D701, $17C0, $1680, $D641,
  29.   $D201, $12C0, $1380, $D341, $1100, $D1C1, $D081, $1040,
  30.   $F001, $30C0, $3180, $F141, $3300, $F3C1, $F281, $3240,
  31.   $3600, $F6C1, $F781, $3740, $F501, $35C0, $3480, $F441,
  32.   $3C00, $FCC1, $FD81, $3D40, $FF01, $3FC0, $3E80, $FE41,
  33.   $FA01, $3AC0, $3B80, $FB41, $3900, $F9C1, $F881, $3840,
  34.   $2800, $E8C1, $E981, $2940, $EB01, $2BC0, $2A80, $EA41,
  35.   $EE01, $2EC0, $2F80, $EF41, $2D00, $EDC1, $EC81, $2C40,
  36.   $E401, $24C0, $2580, $E541, $2700, $E7C1, $E681, $2640,
  37.   $2200, $E2C1, $E381, $2340, $E101, $21C0, $2080, $E041,
  38.   $A001, $60C0, $6180, $A141, $6300, $A3C1, $A281, $6240,
  39.   $6600, $A6C1, $A781, $6740, $A501, $65C0, $6480, $A441,
  40.   $6C00, $ACC1, $AD81, $6D40, $AF01, $6FC0, $6E80, $AE41,
  41.   $AA01, $6AC0, $6B80, $AB41, $6900, $A9C1, $A881, $6840,
  42.   $7800, $B8C1, $B981, $7940, $BB01, $7BC0, $7A80, $BA41,
  43.   $BE01, $7EC0, $7F80, $BF41, $7D00, $BDC1, $BC81, $7C40,
  44.   $B401, $74C0, $7580, $B541, $7700, $B7C1, $B681, $7640,
  45.   $7200, $B2C1, $B381, $7340, $B101, $71C0, $7080, $B041,
  46.   $5000, $90C1, $9181, $5140, $9301, $53C0, $5280, $9241,
  47.   $9601, $56C0, $5780, $9741, $5500, $95C1, $9481, $5440,
  48.   $9C01, $5CC0, $5D80, $9D41, $5F00, $9FC1, $9E81, $5E40,
  49.   $5A00, $9AC1, $9B81, $5B40, $9901, $59C0, $5880, $9841,
  50.   $8801, $48C0, $4980, $8941, $4B00, $8BC1, $8A81, $4A40,
  51.   $4E00, $8EC1, $8F81, $4F40, $8D01, $4DC0, $4C80, $8C41,
  52.   $4400, $84C1, $8581, $4540, $8701, $47C0, $4680, $8641,
  53.   $8201, $42C0, $4380, $8341, $4100, $81C1, $8081, $4040 );
  54.  
  55.   crc_tabccitt_init:boolean = false;
  56.   crc_tabccitt:array[0..255] of word = (
  57.   $0000, $1021, $2042, $3063, $4084, $50A5, $60C6, $70E7,
  58.   $8108, $9129, $A14A, $B16B, $C18C, $D1AD, $E1CE, $F1EF,
  59.   $1231, $0210, $3273, $2252, $52B5, $4294, $72F7, $62D6,
  60.   $9339, $8318, $B37B, $A35A, $D3BD, $C39C, $F3FF, $E3DE,
  61.   $2462, $3443, $0420, $1401, $64E6, $74C7, $44A4, $5485,
  62.   $A56A, $B54B, $8528, $9509, $E5EE, $F5CF, $C5AC, $D58D,
  63.   $3653, $2672, $1611, $0630, $76D7, $66F6, $5695, $46B4,
  64.   $B75B, $A77A, $9719, $8738, $F7DF, $E7FE, $D79D, $C7BC,
  65.   $48C4, $58E5, $6886, $78A7, $0840, $1861, $2802, $3823,
  66.   $C9CC, $D9ED, $E98E, $F9AF, $8948, $9969, $A90A, $B92B,
  67.   $5AF5, $4AD4, $7AB7, $6A96, $1A71, $0A50, $3A33, $2A12,
  68.   $DBFD, $CBDC, $FBBF, $EB9E, $9B79, $8B58, $BB3B, $AB1A,
  69.   $6CA6, $7C87, $4CE4, $5CC5, $2C22, $3C03, $0C60, $1C41,
  70.   $EDAE, $FD8F, $CDEC, $DDCD, $AD2A, $BD0B, $8D68, $9D49,
  71.   $7E97, $6EB6, $5ED5, $4EF4, $3E13, $2E32, $1E51, $0E70,
  72.   $FF9F, $EFBE, $DFDD, $CFFC, $BF1B, $AF3A, $9F59, $8F78,
  73.   $9188, $81A9, $B1CA, $A1EB, $D10C, $C12D, $F14E, $E16F,
  74.   $1080, $00A1, $30C2, $20E3, $5004, $4025, $7046, $6067,
  75.   $83B9, $9398, $A3FB, $B3DA, $C33D, $D31C, $E37F, $F35E,
  76.   $02B1, $1290, $22F3, $32D2, $4235, $5214, $6277, $7256,
  77.   $B5EA, $A5CB, $95A8, $8589, $F56E, $E54F, $D52C, $C50D,
  78.   $34E2, $24C3, $14A0, $0481, $7466, $6447, $5424, $4405,
  79.   $A7DB, $B7FA, $8799, $97B8, $E75F, $F77E, $C71D, $D73C,
  80.   $26D3, $36F2, $0691, $16B0, $6657, $7676, $4615, $5634,
  81.   $D94C, $C96D, $F90E, $E92F, $99C8, $89E9, $B98A, $A9AB,
  82.   $5844, $4865, $7806, $6827, $18C0, $08E1, $3882, $28A3,
  83.   $CB7D, $DB5C, $EB3F, $FB1E, $8BF9, $9BD8, $ABBB, $BB9A,
  84.   $4A75, $5A54, $6A37, $7A16, $0AF1, $1AD0, $2AB3, $3A92,
  85.   $FD2E, $ED0F, $DD6C, $CD4D, $BDAA, $AD8B, $9DE8, $8DC9,
  86.   $7C26, $6C07, $5C64, $4C45, $3CA2, $2C83, $1CE0, $0CC1,
  87.   $EF1F, $FF3E, $CF5D, $DF7C, $AF9B, $BFBA, $8FD9, $9FF8,
  88.   $6E17, $7E36, $4E55, $5E74, $2E93, $3EB2, $0ED1, $1EF0);
  89.  
  90. crc_tabkermit_init:boolean = false;
  91. var
  92. crc_tabkermit:array[0..255] of word = (
  93.   $0000, $1189, $2312, $329B, $4624, $57AD, $6536, $74BF,
  94.   $8C48, $9DC1, $AF5A, $BED3, $CA6C, $DBE5, $E97E, $F8F7,
  95.   $1081, $0108, $3393, $221A, $56A5, $472C, $75B7, $643E,
  96.   $9CC9, $8D40, $BFDB, $AE52, $DAED, $CB64, $F9FF, $E876,
  97.   $2102, $308B, $0210, $1399, $6726, $76AF, $4434, $55BD,
  98.   $AD4A, $BCC3, $8E58, $9FD1, $EB6E, $FAE7, $C87C, $D9F5,
  99.   $3183, $200A, $1291, $0318, $77A7, $662E, $54B5, $453C,
  100.   $BDCB, $AC42, $9ED9, $8F50, $FBEF, $EA66, $D8FD, $C974,
  101.   $4204, $538D, $6116, $709F, $0420, $15A9, $2732, $36BB,
  102.   $CE4C, $DFC5, $ED5E, $FCD7, $8868, $99E1, $AB7A, $BAF3,
  103.   $5285, $430C, $7197, $601E, $14A1, $0528, $37B3, $263A,
  104.   $DECD, $CF44, $FDDF, $EC56, $98E9, $8960, $BBFB, $AA72,
  105.   $6306, $728F, $4014, $519D, $2522, $34AB, $0630, $17B9,
  106.   $EF4E, $FEC7, $CC5C, $DDD5, $A96A, $B8E3, $8A78, $9BF1,
  107.   $7387, $620E, $5095, $411C, $35A3, $242A, $16B1, $0738,
  108.   $FFCF, $EE46, $DCDD, $CD54, $B9EB, $A862, $9AF9, $8B70,
  109.   $8408, $9581, $A71A, $B693, $C22C, $D3A5, $E13E, $F0B7,
  110.   $0840, $19C9, $2B52, $3ADB, $4E64, $5FED, $6D76, $7CFF,
  111.   $9489, $8500, $B79B, $A612, $D2AD, $C324, $F1BF, $E036,
  112.   $18C1, $0948, $3BD3, $2A5A, $5EE5, $4F6C, $7DF7, $6C7E,
  113.   $A50A, $B483, $8618, $9791, $E32E, $F2A7, $C03C, $D1B5,
  114.   $2942, $38CB, $0A50, $1BD9, $6F66, $7EEF, $4C74, $5DFD,
  115.   $B58B, $A402, $9699, $8710, $F3AF, $E226, $D0BD, $C134,
  116.   $39C3, $284A, $1AD1, $0B58, $7FE7, $6E6E, $5CF5, $4D7C,
  117.   $C60C, $D785, $E51E, $F497, $8028, $91A1, $A33A, $B2B3,
  118.   $4A44, $5BCD, $6956, $78DF, $0C60, $1DE9, $2F72, $3EFB,
  119.   $D68D, $C704, $F59F, $E416, $90A9, $8120, $B3BB, $A232,
  120.   $5AC5, $4B4C, $79D7, $685E, $1CE1, $0D68, $3FF3, $2E7A,
  121.   $E70E, $F687, $C41C, $D595, $A12A, $B0A3, $8238, $93B1,
  122.   $6B46, $7ACF, $4854, $59DD, $2D62, $3CEB, $0E70, $1FF9,
  123.   $F78F, $E606, $D49D, $C514, $B1AB, $A022, $92B9, $8330,
  124.   $7BC7, $6A4E, $58D5, $495C, $3DE3, $2C6A, $1EF1, $0F78);
  125.  
  126. crc_tabdnp_init:Boolean = false;
  127. crc_tabdnp:array[0..255] of word =(
  128.   $0000, $365E, $6CBC, $5AE2, $D978, $EF26, $B5C4, $839A,
  129.   $FF89, $C9D7, $9335, $A56B, $26F1, $10AF, $4A4D, $7C13,
  130.   $B26B, $8435, $DED7, $E889, $6B13, $5D4D, $07AF, $31F1,
  131.   $4DE2, $7BBC, $215E, $1700, $949A, $A2C4, $F826, $CE78,
  132.   $29AF, $1FF1, $4513, $734D, $F0D7, $C689, $9C6B, $AA35,
  133.   $D626, $E078, $BA9A, $8CC4, $0F5E, $3900, $63E2, $55BC,
  134.   $9BC4, $AD9A, $F778, $C126, $42BC, $74E2, $2E00, $185E,
  135.   $644D, $5213, $08F1, $3EAF, $BD35, $8B6B, $D189, $E7D7,
  136.   $535E, $6500, $3FE2, $09BC, $8A26, $BC78, $E69A, $D0C4,
  137.   $ACD7, $9A89, $C06B, $F635, $75AF, $43F1, $1913, $2F4D,
  138.   $E135, $D76B, $8D89, $BBD7, $384D, $0E13, $54F1, $62AF,
  139.   $1EBC, $28E2, $7200, $445E, $C7C4, $F19A, $AB78, $9D26,
  140.   $7AF1, $4CAF, $164D, $2013, $A389, $95D7, $CF35, $F96B,
  141.   $8578, $B326, $E9C4, $DF9A, $5C00, $6A5E, $30BC, $06E2,
  142.   $C89A, $FEC4, $A426, $9278, $11E2, $27BC, $7D5E, $4B00,
  143.   $3713, $014D, $5BAF, $6DF1, $EE6B, $D835, $82D7, $B489,
  144.   $A6BC, $90E2, $CA00, $FC5E, $7FC4, $499A, $1378, $2526,
  145.   $5935, $6F6B, $3589, $03D7, $804D, $B613, $ECF1, $DAAF,
  146.   $14D7, $2289, $786B, $4E35, $CDAF, $FBF1, $A113, $974D,
  147.   $EB5E, $DD00, $87E2, $B1BC, $3226, $0478, $5E9A, $68C4,
  148.   $8F13, $B94D, $E3AF, $D5F1, $566B, $6035, $3AD7, $0C89,
  149.   $709A, $46C4, $1C26, $2A78, $A9E2, $9FBC, $C55E, $F300,
  150.   $3D78, $0B26, $51C4, $679A, $E400, $D25E, $88BC, $BEE2,
  151.   $C2F1, $F4AF, $AE4D, $9813, $1B89, $2DD7, $7735, $416B,
  152.   $F5E2, $C3BC, $995E, $AF00, $2C9A, $1AC4, $4026, $7678,
  153.   $0A6B, $3C35, $66D7, $5089, $D313, $E54D, $BFAF, $89F1,
  154.   $4789, $71D7, $2B35, $1D6B, $9EF1, $A8AF, $F24D, $C413,
  155.   $B800, $8E5E, $D4BC, $E2E2, $6178, $5726, $0DC4, $3B9A,
  156.   $DC4D, $EA13, $B0F1, $86AF, $0535, $336B, $6989, $5FD7,
  157.   $23C4, $159A, $4F78, $7926, $FABC, $CCE2, $9600, $A05E,
  158.   $6E26, $5878, $029A, $34C4, $B75E, $8100, $DBE2, $EDBC,
  159.   $91AF, $A7F1, $FD13, $CB4D, $48D7, $7E89, $246B, $1235);
  160.  
  161.  
  162. procedure init_crc16_tab;
  163. var
  164.  i,j,crc,c:word;
  165. begin
  166.   for i := 0 to 255 do
  167.   begin
  168.         crc := 0;
  169.         c   := i;
  170.         for j := 0 to 7 do
  171.         begin
  172.           if  (crc xor c) and $0001  > 0 then
  173.         crc := ( crc >> 1 ) xor CRC_POLY_16
  174.           else                      
  175.             crc :=   crc >> 1;
  176.           c := c >> 1;
  177.     end;
  178.         crc_tab16[i] := crc;
  179.   end;
  180.   crc_tab16_init := true;
  181. end;
  182.  
  183. procedure init_crcccitt_tab;
  184. var
  185.  i,j,crc,c:word;
  186. begin
  187.   for i := 0 to 255 do
  188.   begin
  189.         crc := 0;
  190.         c   := i << 8;
  191.         for j :=0 to 7 do
  192.         begin
  193.           if (crc xor c) and $8000 <> 0 then
  194.             crc := ( crc << 1 ) xor CRC_POLY_CCITT
  195.           else                      
  196.             crc := crc << 1;
  197.       c := c << 1;
  198.         end;
  199.         crc_tabccitt[i] := crc;
  200.   end;
  201.   crc_tabccitt_init := true;
  202. end;
  203.  
  204. procedure init_crc_tabkermit;
  205. var
  206.   i,j,crc,c:word;
  207. begin
  208.   for i:=0 to 255 do
  209.   begin
  210.     crc := 0;
  211.         c   := i;
  212.         for j := 0 to 7 do
  213.         begin
  214.           if ( (crc xor c) and $0001 ) <> 0 then
  215.             crc := ( crc >> 1 ) xor CRC_POLY_KERMIT
  216.           else                      
  217.             crc := crc >> 1;
  218.           c := c >> 1;
  219.         end;
  220.     crc_tabkermit[i] := crc;
  221.   end;
  222.   crc_tabkermit_init := true;
  223. end;
  224.  
  225. procedure init_crcdnp_tab;
  226. var
  227.   i,j,crc,c:word;
  228. begin
  229.   for i := 0 to 255 do
  230.   begin
  231.     crc := 0;
  232.         c := i;
  233.         for j :=0 to 7 do
  234.         begin
  235.       if ( (crc xor c) and $0001 ) <> 0 then
  236.         crc := ( crc >> 1 ) xor CRC_POLY_DNP
  237.           else                      
  238.             crc := crc >> 1;
  239.           c := c >> 1;
  240.         end;
  241.     crc_tabdnp[i] := crc;
  242.   end;
  243.   crc_tabdnp_init := true;
  244. end;
  245.  
  246. function crc_16( const input_str:Pbyte;num_bytes:integer ):word;
  247. var
  248.   ptr:PByte;
  249.   a:integer;
  250. begin
  251.         if not crc_tab16_init then init_crc16_tab;
  252.         result := CRC_START_16;
  253.         ptr := input_str;
  254.         if ptr <> nil then for a :=0 to pred(num_bytes) do
  255.     begin      
  256.           Result := (Result >> 8) xor crc_tab16[ (Result xor ptr^) and $00FF ];
  257.           inc(ptr);
  258.         end;
  259. end;
  260.  
  261. function crc_modbus( const input_str:Pbyte; num_bytes:integer):word;
  262. var
  263.   ptr:PByte;
  264.   a:integer;
  265. begin
  266.   if not crc_tab16_init then init_crc16_tab;
  267.   result := CRC_START_MODBUS;
  268.   ptr := input_str;
  269.   if ptr <> nil then for a := 0 to pred(num_bytes) do
  270.   begin
  271.         result := (result >> 8) xor crc_tab16[ (result xor ptr^) and $00FF ];
  272.         inc(ptr);
  273.   end;
  274. end;
  275.  
  276. function crc_ccitt_generic( const input_str:PByte; num_bytes:integer;start_value:word ):word;
  277. var
  278.  ptr:PByte;
  279.  a:integer;
  280. begin
  281.   if not crc_tabccitt_init then init_crcccitt_tab;
  282.   Result := start_value;
  283.   ptr := input_str;
  284.   if ptr <> nil then for  a := 0 to pred(num_bytes) do
  285.   begin
  286.     Result := (Result << 8) xor crc_tabccitt[ ((Result >> 8) xor ptr^) and $00FF ];
  287.         inc(ptr);
  288.   end;
  289. end;
  290.  
  291. function update_crc_ccitt( crc:word;c:byte ):word; inline;
  292. begin
  293.   if not crc_tabccitt_init then init_crcccitt_tab;
  294.   result := (crc << 8) xor crc_tabccitt[ ((crc >> 8) xor word(c)) and $00FF ];
  295. end;
  296.  
  297. function crc_xmodem( const input_str:PByte;num_bytes:integer):word;inline;
  298. begin
  299.  result:= crc_ccitt_generic( input_str, num_bytes, CRC_START_XMODEM );
  300. end;
  301.  
  302. function crc_ccitt_1d0f( const input_str:PByte;num_bytes:integer):word;inline;
  303. begin
  304.  result:= crc_ccitt_generic( input_str, num_bytes, CRC_START_CCITT_1D0F );
  305. end;
  306.  
  307. function crc_ccitt_ffff( const input_str:PByte;num_bytes:integer):word;inline;
  308. begin
  309.  result:= crc_ccitt_generic( input_str, num_bytes, CRC_START_CCITT_FFFF );
  310. end;
  311.  
  312. function crc_kermit( const input_str:PByte; num_bytes:integer ):word;
  313. var
  314.   crc,low_byte,high_byte:word;
  315.   ptr:PByte;
  316.   a:integer;
  317. begin
  318.   if not crc_tabkermit_init then init_crc_tabkermit;
  319.   crc := CRC_START_KERMIT;
  320.   ptr := input_str;
  321.   if ptr <> nil then for a := 0 to pred(num_bytes) do
  322.   begin
  323.     crc := (crc >> 8) xor crc_tabkermit[ (crc xor word(ptr^)) and $00FF ];
  324.     inc(ptr);
  325.   end;
  326.   low_byte  := (crc and $ff00) >> 8;
  327.   high_byte := (crc and $00ff) << 8;
  328.   crc := low_byte or high_byte;
  329.   Result := crc;
  330. end;
  331.  
  332. function update_crc_kermit( crc:word; c:byte ):word;
  333. begin
  334.   if not crc_tabkermit_init then  init_crc_tabkermit;
  335.   Result := (crc >> 8) xor crc_tabkermit[ (crc xor dword(c)) and $00FF ];
  336. end;
  337.  
  338. function crc_dnp( const input_str:PByte; num_bytes:Integer):word;
  339. var
  340.   crc,low_byte,high_byte:word;
  341.   ptr:PByte;
  342.   a:integer;
  343. begin
  344.   if not crc_tabdnp_init then init_crcdnp_tab;
  345.   crc := CRC_START_DNP;
  346.   ptr := input_str;
  347.   if ptr <> nil then for a :=0 to pred(num_bytes) do
  348.   begin
  349.     crc := (crc >> 8) xor crc_tabdnp[ (crc xor ptr^) and $00FF ];
  350.     inc(ptr);
  351.   end;
  352.   crc := not crc;
  353.   low_byte := (crc and $ff00) >> 8;
  354.   high_byte := (crc and $00ff) << 8;
  355.   crc := low_byte or high_byte;
  356.   result := crc;
  357. end;
  358.  
  359. function update_crc_dnp(crc:word; c:byte ):word;inline;
  360. begin
  361.   if not crc_tabdnp_init then init_crcdnp_tab;
  362.   result := (crc >> 8) xor crc_tabdnp[ (crc xor dword(c)) and $00FF ];
  363. end;
  364.  
  365. function crc_sick( const input_str:PByte; num_bytes:integer ):word;
  366. var
  367.   crc,low_byte,high_byte,short_c,short_p:word;
  368.   ptr:PByte;
  369.   a:integer;
  370. begin
  371.   crc:= CRC_START_SICK;
  372.   ptr:= input_str;
  373.   short_p := 0;
  374.   if ptr <> nil then for a := 0 to pred(num_bytes) do
  375.   begin
  376.     short_c := $00FF and word(ptr^);
  377.     if ( crc and $8000 ) <> 0 then
  378.       crc := ( crc << 1 ) xor CRC_POLY_SICK      
  379.         else                
  380.           crc := crc << 1;
  381.         crc := crc xor ( short_c or short_p );
  382.         short_p := short_c << 8;
  383.     inc(ptr);
  384.   end;
  385.  
  386.   low_byte  := (crc and $FF00) >> 8;
  387.         high_byte := (crc and $00FF) << 8;
  388.         crc := low_byte or high_byte;
  389.  
  390.         result := crc;
  391. end;
  392.  
  393. function update_crc_sick(crc:word; c,prev_byte:Byte ):word;inline;
  394. var
  395.   short_c,short_p:word;
  396. begin
  397.   short_c := $00FF and dword(c);
  398.   short_p := ( $00FF and dword(prev_byte) ) << 8;
  399.   if ( crc and $8000 ) <> 0 then
  400.     crc := ( crc << 1 ) xor CRC_POLY_SICK
  401.   else                
  402.     crc :=   crc << 1;
  403.   crc := crc xor ( short_c or short_p );
  404.   result := crc;
  405. end;
  406.  
  407.  
  408. var
  409.   i:integer;
  410. begin
  411.   init_crcdnp_tab;
  412.   for i := 1 to 256 do
  413.   begin
  414.     write('$',IntToHex(crc_tabdnp[i-1],4),', ');
  415.     if i mod 8 = 0 then writeln;
  416.   end;
  417.   writeln('crc16: ':20,'$',inttohex(crc_16(PByte(PChar('123456789')),9),4));
  418.   writeln('crc_modbus: ':20,'$',inttohex(crc_modbus(PByte(PChar('123456789')),9),4));
  419.   writeln('crc_xmodem: ':20,'$',inttohex(crc_xmodem(PByte(PChar('123456789')),9),4));
  420.   writeln('crc_10df: ':20,'$',inttohex(crc_ccitt_1d0f(PByte(PChar('123456789')),9),4));
  421.   writeln('crc_ffff: ':20,'$',inttohex(crc_ccitt_ffff(PByte(PChar('123456789')),9),4));
  422.   writeln('crc_kermit: ':20,'$',inttohex(crc_kermit(PByte(PChar('123456789')),9),4));
  423.   writeln( 'crc_dnp: ':20,'$',inttohex(crc_dnp(PByte(PChar('123456789')),9),4));
  424.   writeln( 'crc_sick: ':20,'$',inttohex(crc_sick(PByte(PChar('123456789')),9),4));
  425. end.

For the Sicko's: of course it will be in a neat separate unit. >:D O:-)

 
 
« Last Edit: September 17, 2017, 01:45:16 pm by Thaddy »
Specialize a type, not a var.

marcov

  • Administrator
  • Hero Member
  • *
  • Posts: 11383
  • FPC developer.
Re: HASH: CRC-16
« Reply #11 on: September 17, 2017, 01:44:25 pm »
I delved in my sources, and it seems that microchip uses a different algo, I added a CCIT implementation in the same vein for reference.

Code: Pascal  [Select][+][-]
  1. // bitwise crc16 routines. Slower than tabledriven, but easier to mod, and we only use short sequences <15 bytes
  2. function CRC16CCITT(p:pbyte;len:integer;initial:word=$1D0F): Word;
  3. const
  4.   polynomial = $1021;   // 0001 0000 0010 0001  (0, 5, 12)
  5. var
  6.   crc: Word;
  7.   I, J: Integer;
  8.   b: Byte;
  9.   bit, c15: Boolean;
  10. begin
  11.   crc := initial; // initial value
  12.   for I := 0 to len-1 do
  13.   begin
  14.     b := p[I];
  15.     for J := 0 to 7 do
  16.     begin
  17.       bit := (((b shr (7-J)) and 1) = 1);
  18.       c15 := (((crc shr 15) and 1) = 1);
  19.       crc := crc shl 1;
  20.       if ((c15 xor bit)) then crc := crc xor polynomial;
  21.     end;
  22.   end;
  23.   Result := crc and $ffff;
  24. end;
  25.  
  26. function CRC16Microchip(p:pbyte;len:integer;initial:word=0): Word;
  27. const
  28.   polynomial = $1021;   // 0001 0000 0010 0001  (0, 5, 12)
  29. var
  30.   crc: Word;
  31.   I, J: Integer;
  32.   b: Byte;
  33.   bit:word;
  34.   c15: Boolean;
  35. begin
  36.   crc := initial; // initial value
  37.   for I := 0 to len-1 do
  38.   begin
  39.     b := p[I];
  40.     for J := 0 to 7 do
  41.     begin
  42.       c15 := (((crc shr 15) and 1) = 1);  // test hoogste bit accu
  43.       crc := crc shl 1;               // shift accu
  44.       bit := (b shr (7-J)) and 1;     // or met hoogste bit data
  45.       crc:=crc or bit;
  46.       if c15 then                     // indien test dan polyxor.
  47.         begin
  48.           crc := crc xor polynomial;
  49.         end;
  50.     end;
  51.   end;
  52.   Result := crc and $ffff;
  53. end;
  54.  

Thaddy

  • Hero Member
  • *****
  • Posts: 14197
  • Probably until I exterminate Putin.
Re: HASH: CRC-16
« Reply #12 on: September 17, 2017, 01:53:32 pm »
@Marco:
If you looked good enough you see that it is already implemented. and tested against the standards. what you do is not ccitt if the result difer. i checked all.
During my research I found some implementations to be wrong. But I can implement microchip in the same way if the generic function does not do what you want.
It is the same polynomial $1021 that is used for true ccitt.
« Last Edit: September 17, 2017, 02:14:44 pm by Thaddy »
Specialize a type, not a var.

joho

  • Jr. Member
  • **
  • Posts: 69
  • Joaquim Homrighausen
    • ~/JoHo
Re: HASH: CRC-16
« Reply #13 on: September 17, 2017, 06:25:32 pm »
So maybe posting my initial query did some good .... :)

Thaddy

  • Hero Member
  • *****
  • Posts: 14197
  • Probably until I exterminate Putin.
Re: HASH: CRC-16
« Reply #14 on: September 17, 2017, 06:38:05 pm »
So maybe posting my initial query did some good .... :)

Yes, here's the complete unit crc16.pas attached (but without the comments) if you want to test here example and test code:
Code: Pascal  [Select][+][-]
  1. program democrc16;
  2. {$mode objfpc}
  3. uses sysutils,crc16;
  4. begin
  5.   writeln('crc16: ':20,'$',inttohex(crc_16(Pbyte(PChar('123456789')),9),4));
  6.   writeln('crc_modbus: ':20,'$',inttohex(crc_modbus(PByte(PChar('123456789')),9),4));
  7.   writeln('crc_xmodem: ':20,'$',inttohex(crc_xmodem(PByte(PChar('123456789')),9),4));
  8.   writeln('crc_10df: ':20,'$',inttohex(crc_ccitt_1d0f(PByte(PChar('123456789')),9),4));
  9.   writeln('crc_ffff: ':20,'$',inttohex(crc_ccitt_ffff(PByte(PChar('123456789')),9),4));
  10.   writeln('crc_kermit: ':20,'$',inttohex(crc_kermit(PByte(PChar('123456789')),9),4));
  11.   writeln('crc_dnp: ':20,'$',inttohex(crc_dnp(PByte(PChar('123456789')),9),4));
  12.   writeln('crc_sick: ':20,'$',inttohex(crc_sick(PByte(PChar('123456789')),9),4));  
  13. end.

Compare to e.g.: https://www.lammertbies.nl/comm/info/crc-calculation.html which I took most of the code from and translated to pure portable pascal.

[edit]
submitted as patch.


« Last Edit: September 17, 2017, 09:02:45 pm by Thaddy »
Specialize a type, not a var.

 

TinyPortal © 2005-2018