diff options
author | Steve Langasek <vorlon@debian.org> | 2005-01-10 08:53:33 +0000 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:30 -0800 |
commit | e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e (patch) | |
tree | abbf06041619e445f9d0b772b0d58132009d8234 /crc.scm | |
parent | f559c149c83da84d0b1c285f0298c84aec564af9 (diff) | |
parent | 8466d8cfa486fb30d1755c4261b781135083787b (diff) | |
download | slib-e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e.tar.gz slib-e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e.zip |
Import Debian changes 3a1-4.2debian/3a1-4.2
slib (3a1-4.2) unstable; urgency=low
* Non-maintainer upload.
* Add guile.init.local for use within the build dir, since otherwise we
have an (earlier unnoticed) circular build-dep due to a difference
between scm and guile.
slib (3a1-4.1) unstable; urgency=low
* Non-maintainer upload.
* Build-depend on guile-1.6 instead of scm, since the new version of
scm is wedged in unstable (closes: #281809).
slib (3a1-4) unstable; urgency=low
* Also check for expected creation on slibcat. (Closes: #240096)
slib (3a1-3) unstable; urgency=low
* Also check for /usr/share/guile/1.6/slib before installing for guile
1.6. (Closes: #239267)
slib (3a1-2) unstable; urgency=low
* Add format.scm back into slib until gnucash stops using it.
* Call guile-1.6 new-catalog (Closes: #238231)
slib (3a1-1) unstable; urgency=low
* New upstream release
* Remove Info section from doc-base file (Closes: #186950)
* Remove period from end of description (linda, lintian)
* html gen fixed upstream (Closes: #111778)
slib (2d4-2) unstable; urgency=low
* Fix url for upstream source (Closes: #144981)
* Fix typo in slib.texi (enquque->enqueue) (Closes: #147475)
* Add build depends.
slib (2d4-1) unstable; urgency=low
* New upstream.
slib (2d3-1) unstable; urgency=low
* New upstream.
* Remove texi2html call in debian/rules. Now done upstream. Add make
html instead.
* Changes to rules and doc-base to conform to upstream html gen
* Clean up upstream makefile to make sure it cleans up after itself.
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))))))) |