diff options
Diffstat (limited to 'crc.scm')
| -rw-r--r-- | crc.scm | 137 |
1 files changed, 137 insertions, 0 deletions
@@ -0,0 +1,137 @@ +;;;; "crc.scm" Compute Cyclic Checksums +;;; Copyright (C) 1995, 1996, 1997, 2001, 2002 Aubrey Jaffer +; +;Permission to copy this software, to modify it, to redistribute it, +;to distribute modified versions, and to use it for any purpose is +;granted, subject to the following restrictions and understandings. +; +;1. Any copy made of this software must include this copyright notice +;in full. +; +;2. I have made no warranty or representation that the operation of +;this software will be error-free, and I am under no obligation to +;provide any services, by way of maintenance, update, or otherwise. +; +;3. In conjunction with products arising from the use of this +;material, there shall be no use of my name in any advertising, +;promotional, or sales literature without prior written consent in +;each case. + +(require 'byte) +(require 'logical) + +;;@ (define CRC-32-polynomial "100000100100000010001110110110111") ; IEEE-802, FDDI +(define CRC-32-polynomial "100000100110000010001110110110111") ; IEEE-802, AAL5 +;@ +(define CRC-CCITT-polynomial "10001000000100001") ; X25 +;@ +(define CRC-16-polynomial "11000000000000101") ; IBM Bisync, HDLC, SDLC, USB-Data + +;;@ (define CRC-12-polynomial "1100000001101") +(define CRC-12-polynomial "1100000001111") + +;;@ (define CRC-10-polynomial "11000110001") +(define CRC-10-polynomial "11000110011") +;@ +(define CRC-08-polynomial "100000111") +;@ +(define ATM-HEC-polynomial "100000111") +;@ +(define DOWCRC-polynomial "100110001") +;@ +(define USB-Token-polynomial "100101") + +;;This procedure is careful not to use more than DEG bits in +;;computing (- (expt 2 DEG) 1). It returns #f if the integer would +;;be larger than the implementation supports. +(define (crc:make-mask deg) + (string->number (make-string deg #\1) 2)) +;@ +(define (crc:make-table str) + (define deg (+ -1 (string-length str))) + (define generator (string->number (substring str 1 (string-length str)) 2)) + (define crctab (make-vector 256)) + (if (not (eqv? #\1 (string-ref str 0))) + (slib:error 'crc:make-table 'first-digit-of-polynomial-must-be-1 str)) + (if (< deg 8) + (slib:error 'crc:make-table 'degree-must-be>7 deg str)) + (and + generator + (do ((i 0 (+ 1 i)) + (deg-1-mask (crc:make-mask (+ -1 deg))) + (gen generator + (if (logbit? (+ -1 deg) gen) + (logxor (ash (logand deg-1-mask gen) 1) generator) + (ash (logand deg-1-mask gen) 1))) + (gens '() (cons gen gens))) + ((>= i 8) (set! gens (reverse gens)) + (do ((crc 0 0) + (m 0 (+ 1 m))) + ((> m 255) crctab) + (for-each (lambda (gen i) + (set! crc (if (logbit? i m) (logxor crc gen) crc))) + gens '(0 1 2 3 4 5 6 7)) + (vector-set! crctab m crc)))))) + +(define crc-32-table (crc:make-table CRC-32-polynomial)) + +;;@ Computes the P1003.2/D11.2 (POSIX.2) 32-bit checksum. +(define (cksum file) + (cond ((not crc-32-table) #f) + ((input-port? file) (cksum-port file)) + (else (call-with-input-file file cksum-port)))) + +(define cksum-port + (let ((mask-24 (crc:make-mask 24)) + (mask-32 (crc:make-mask 32))) + (lambda (port) + (define crc 0) + (define (accumulate-crc byt) + (set! crc + (logxor (ash (logand mask-24 crc) 8) + (vector-ref crc-32-table (logxor (ash crc -24) byt))))) + (do ((byt (read-byte port) (read-byte port)) + (byte-count 0 (+ 1 byte-count))) + ((eof-object? byt) + (do ((byte-count byte-count (ash byte-count -8))) + ((zero? byte-count) (logxor mask-32 crc)) + (accumulate-crc (logand #xff byte-count)))) + (accumulate-crc byt))))) +;@ +(define (crc16 file) + (cond ((not crc-16-table) #f) + ((input-port? file) (crc16-port file)) + (else (call-with-input-file file crc16-port)))) + +(define crc-16-table (crc:make-table CRC-16-polynomial)) + +(define crc16-port + (let ((mask-8 (crc:make-mask 8)) + (mask-16 (crc:make-mask 16))) + (lambda (port) + (define crc mask-16) + (define (accumulate-crc byt) + (set! crc + (logxor (ash (logand mask-8 crc) 8) + (vector-ref crc-16-table (logxor (ash crc -8) byt))))) + (do ((byt (read-byte port) (read-byte port))) + ((eof-object? byt) (logxor mask-16 crc)) + (accumulate-crc byt))))) +;@ +(define (crc5 file) + (cond ((input-port? file) (crc5-port file)) + (else (call-with-input-file file crc5-port)))) + +(define (crc5-port port) + (define generator #b00101) + (define crc #b11111) + (do ((byt (read-byte port) (read-byte port))) + ((eof-object? byt) (logxor #b11111 crc)) + (do ((data byt (ash data 1)) + (len (+ -1 8) (+ -1 len))) + ((negative? len)) + (set! crc + (logand #b11111 + (if (eqv? (logbit? 7 data) (logbit? 4 crc)) + (ash crc 1) + (logxor (ash crc 1) generator))))))) |