From 8466d8cfa486fb30d1755c4261b781135083787b Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:29 -0800
Subject: Import Upstream version 3a1

---
 makcrc.scm | 96 --------------------------------------------------------------
 1 file changed, 96 deletions(-)
 delete mode 100644 makcrc.scm

(limited to 'makcrc.scm')

diff --git a/makcrc.scm b/makcrc.scm
deleted file mode 100644
index debd5c9..0000000
--- a/makcrc.scm
+++ /dev/null
@@ -1,96 +0,0 @@
-;;;; "makcrc.scm" Compute Cyclic Checksums
-;;; Copyright (C) 1995, 1996, 1997, 2001 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 warrantee 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 (make-port-crc . margs)
-  (define (make-mask hibit)
-    (+ (ash (+ -1 (ash 1 (+ 1 (- hibit 2)))) 1) 1))
-  (define chunk-bits (integer-length (+ -1 char-code-limit)))
-  (define accum-bits #f)
-  (define generator #f)
-  (case (length margs)
-    ((0) #t)
-    ((1) (if (< (car margs) 128)
-	     (set! accum-bits (car margs))
-	     (set! generator (car margs))))
-    ((2)
-     (set! accum-bits (car margs))
-     (set! generator (cadr margs)))
-    (else  (slib:error 'make-port-crc 'args margs)))
-  (cond ((not generator)
-	 (case accum-bits
-	   ((#f 32) (set! accum-bits 32)
-	    (set! generator #b00000100110000010001110110110111)) ; CRC-32
-	   ((16) (set! generator #b0001000000001011)) ; CRC-16
-	   ;;((16) (set! generator #b0001000000100001)) ; CRC-CCIT
-	   ;;((08) (set! generator #b101011))
-	   (else (slib:error 'make-port-crc "no default polynomial for"
-			     accum-bits "bits"))))
-	((not accum-bits)
-	 (set! accum-bits (+ -1 (integer-length generator)))))
-  (set! generator (logand generator (lognot (ash 1 accum-bits))))
-  (cond ((>= (integer-length generator) accum-bits)
-	 (slib:error 'make-port-crc
-		     "generator longer than" accum-bits "bits")))
-  (let* ((chunk-mask (make-mask chunk-bits))
-	 (crctab (make-vector (+ 1 chunk-mask))))
-    (define (accum src)
-      `(set!
-	crc
-	(logxor (ash (logand ,(make-mask (- accum-bits chunk-bits)) crc)
-		     ,chunk-bits)
-		(vector-ref crctab
-			    (logand ,chunk-mask
-				    (logxor
-				     (ash crc ,(- chunk-bits accum-bits))
-				     ,src))))))
-    (define (make-crc-table)
-      (letrec ((r (make-vector chunk-bits))
-	       (remd (lambda (m)
-		       (define rem 0)
-		       (do ((i 0 (+ 1 i)))
-			   ((>= i chunk-bits) rem)
-			 (if (logbit? i m)
-			     (set! rem (logxor rem (vector-ref r i))))))))
-	(vector-set! r 0 generator)
-	(do ((i 1 (+ 1 i)))
-	    ((>= i chunk-bits))
-	  (let ((r-1 (vector-ref r (+ -1 i)))
-		(m-1 (make-mask (+ -1 accum-bits))))
-	    (vector-set! r i (if (logbit? (+ -1 accum-bits) r-1)
-				 (logxor (ash (logand m-1 r-1) 1) generator)
-				 (ash (logand m-1 r-1) 1)))))
-	(do ((i 0 (+ 1 i)))
-	    ((> i chunk-mask))
-	  (vector-set! crctab i (remd i)))))
-    (make-crc-table)
-    `(lambda (port)
-       (define crc 0)
-       (define byte-count 0)
-       (define crctab ',crctab)
-       (do ((ci (read-byte port) (read-byte port)))
-	   ((eof-object? ci))
-	 ,(accum 'ci)
-	 (set! byte-count (+ 1 byte-count)))
-       (do ((byte-count byte-count (ash byte-count ,(- chunk-bits))))
-	   ((zero? byte-count))
-	 ,(accum 'byte-count))
-       (logxor ,(make-mask accum-bits) crc))))
-- 
cgit v1.2.3