pipes

1 files changed, 30 insertions, 2 deletions

diff --git a/modules/language/python/module/binascii.scm b/modules/language/python/module/binascii.scm
index ab3dd69..2fc0e62 100644
--- a/modules/language/python/module/binascii.scm
+++ b/modules/language/python/module/binascii.scm
@@ -7,7 +7,7 @@
   #:use-module (rnrs bytevectors)
   #:use-module (oop pf-objects)
   #:export (Error Incomplete a2b_uu b2a_uu a2b_base64 b2a_base64 a2b_qp b2a_qp
-		  a2b_hex b2a_hex))
+		  a2b_hex b2a_hex crc32 crc_hqx))
 
 (define-python-class Error (Exception))
 (define-python-class Incomplete (Exception))
@@ -385,4 +385,32 @@
 		     (x  (logior a1 (ash a2 4))))
 		(lp (+ i 2) (cons x r)))
 	      (bytes (reverse r)))))))
-	       
+
+(define (id x) x)
+(define-syntax-rule (mkcrc crc_hqx high xor mask)
+  (def (crc_hqx data (= value 0))
+       (let ((n (len data))
+	     (d (bv-scm data)))
+	 (let lp ((i 0) (v value))
+	   (if (< i n)
+	       (let ((b (id (bytevector-u8-ref d i))))
+		 (let lp2 ((j 0) (x 1) (v v))
+		   (if (> j -8)
+		       (let ((bit   (ash (logand x b) j))
+			     (hbit  (logand v high)))
+			 (if (= hbit 0)
+			     (lp2 (- j 1) (ash x 1) (logior bit (ash v 1)))
+			     (lp2 (- j 1) (ash x 1) (logxor
+						     xor
+						     (logand mask
+							     (logior
+							      bit
+							      (ash v 1)))))))
+		       (lp (+ i 1) v))))
+	       v)))))
+						  
+		       
+(mkcrc crc_hqx #x8000     #x1021     #xffff)
+(mkcrc crc32   #x80000000 #x04c11db7 #xffffffff)
+
+