Ticket #48: ugarit_and_friends.diff

aes/trunk/aes.setup

@@ -1 @@
-(compile -s -O2 -d1 aes.scm)
+(compile -s -O2 -d1 aes.scm -j aes)
+(compile -s -O2 -d1 aes.import.scm -j aes)
 (compile -c -O2 -d1 aes.scm -unit aes)
 ;
 (install-extension
   'aes
-  '("aes.o" "aes.so" "aes.html")
+  '("aes.o" "aes.import.so" "aes.so" "aes.html")
   '((version 1.1)
     (static "aes.o") ;; for static linking
     (documentation "aes.html")))

aes/trunk/aes.scm

@@ +1 @@
+(module aes
+(make-aes128-encryptor make-aes192-encryptor make-aes256-encryptor
+   make-aes128-decryptor make-aes192-decryptor make-aes256-decryptor)
 
-(declare (export
-   make-aes128-encryptor make-aes192-encryptor make-aes256-encryptor
-   make-aes128-decryptor make-aes192-decryptor make-aes256-decryptor))
-
 ;; The contents of the below foreign-declare
 ;; Are public domain code from http://www.efgh.com/software/rijndael.htm
 ;; My modifications extend no further than pasting it together and putting
@@ -13 +12 @@
 ;; * Antoon Bosselaers antoon.bosselaers@esat.kuleuven.ac.be
 ;; * Paulo Barreto paulo.barreto@terra.com.br
 
+(import scheme)
+(import chicken)
+(import foreign)
+
+(use extras)
+
 (foreign-declare "
    static int rijndaelSetupEncrypt(unsigned long *rk, const unsigned char *key,
      int keybits);
@@ -1319 +1324 @@
             (rijndaelDecrypt
                context nrounds
                input result)
-            result))))
-
-                 
- No newline at end of file
+            result)))) )

json/trunk/json.setup

@@ -1 @@
-(compile -R syntax-case json.scm -s -O2 -d1)
+(compile json.scm -s -O2 -d1 -j json)
+(compile json.import.scm -s)
 (install-extension 
  'json 
- '("json.so")
+ '("json.so" "json.import.so")
  '((version "1.2.1") 
    (documentation "json.html")))

json/trunk/json.scm

@@ -28 +28 @@
 ;; JSON Arrays are lists
 ;;
 
-(require-extension packrat srfi-69)
+(module json (json-read json-write)
 
-(import packrat)
+(import scheme)
+(import chicken)
+(use ports)
+(require-library srfi-1) (import (except srfi-1 any))
+(use srfi-69)
+(use packrat)
 
-(declare (export json-read json-write))
-
   (define (hashtable->vector ht)
     (list->vector (hash-table->alist ht)) )
 
@@ -201 +204 @@
                              (parse-error-messages e)))))))
 
       (lambda maybe-port
-        (read-any (if (pair? maybe-port) (car maybe-port) (current-input-port))))))
+        (read-any (if (pair? maybe-port) (car maybe-port) (current-input-port)))))))
 

json/trunk/json.meta

@@ -2 +2 @@
 
 ((egg "json.egg")
  (synopsis "A JSON library")
- (needs syntax-case packrat)
+ (needs "packrat")
  (category parsing)
  (license "MIT")
  (eggdoc "doc.scm")

lzma/trunk/tests/run.scm

@@ -1 @@
-(load "../lzma")
+(use lzma)
 
 (define test-string (with-input-from-file "../lzma.so" (lambda () (read-string))))
 
@@ -6 +6 @@
 
 (printf "Original size: ~A\n" (blob-size test-blob))
 
-(define compressed (lzma:compress test-blob))
+(define compressed (compress test-blob))
 
 (printf "Compressed size: ~A\n" (blob-size compressed))
 
-(define decompressed (lzma:decompress compressed))
+(define decompressed (decompress compressed))
 
 (printf "Decompressed size: ~A\n" (blob-size decompressed))
 

lzma/trunk/lzma.setup

@@ -1 @@
-(compile -s -O2 -d1 lzma.scm -llzma)
+(compile -s -O2 -d1 lzma.scm -llzma -j lzma)
 (compile -c -O2 -d1 lzma.scm -llzma -unit lzma)
+(compile -s -O2 -d1 lzma.import.scm)
 ;
 (install-extension
   'lzma
-  '("lzma.o" "lzma.so" "lzma.html")
+  '("lzma.o" "lzma.so" "lzma.import.so" "lzma.html")
   '((version 1.2)
     (static "lzma.o") ;; for static linking
     (documentation "lzma.html")))

lzma/trunk/lzma.scm

@@ -1 @@
-(declare (export lzma:compress lzma:decompress))
+(module lzma (compress decompress)
 
+(import scheme)
+(import chicken)
+(import foreign)
 (use lolevel)
 
 (foreign-declare "#include <lzmalib.h>")
@@ -13 +16 @@
    "C_return (lzma_compress(inblob, inlen, &lzma_return_buffer_len));"))
 (define _free (foreign-lambda void "lzma_free" c-pointer))
 
-(define (lzma:decompress inblob)
+(define (decompress inblob)
    (let ((ptr (_decompress inblob (blob-size inblob))))
       (if (null-pointer? ptr)
          #f
@@ -23 +26 @@
                (_free ptr)
                outblob)))))
 
-(define (lzma:compress inblob)
+(define (compress inblob)
    (let ((ptr (_compress inblob (blob-size inblob))))
       (if (null-pointer? ptr)
          #f
@@ -31 +34 @@
             (begin
                (move-memory! ptr outblob lzma-return-buffer-len)
                (_free ptr)
-               outblob)))))
+               outblob))))))

tiger-hash/trunk/tiger-hash.setup

@@ -1 @@
-(include "setup-header")
-
-(required-extension-version
-  'mathh                  "1.11"
-  'message-digest         "1.5")
-
-(install-dynld+docu tiger-hash *version*)
-
-(install-test "tiger-hash-test.scm")
+(compile tiger-hash.scm -s -O2 -d1 -j tiger-hash)
+(compile tiger-hash.import.scm -s)
+(install-extension 
+ 'tiger-hash 
+ '("tiger-hash.so" "tiger-hash.import.so")
+ '((version "trunk")
+   (documentation "tiger-hash.html")))

tiger-hash/trunk/tiger-hash.scm

@@ -1 +1 @@
 ;;;; tiger-hash.scm
 ;;;; Kon Lovett, Jan '06
+(module tiger-hash
 
+   (tiger192:binary-digest
+    tiger192:digest
+    tiger192:primitive)
+
+(import scheme)
+(import chicken)
+
 (use message-digest)
 
 (declare
@@ -9 +17 @@
   (fixnum)
   (no-procedure-checks)
   (no-bound-checks)
-  (export
-    tiger192:binary-digest
-    tiger192:digest
-    tiger192:primitive) )
+   )
 
 #>
 /* Chicken.h includes it but be specific */
@@ -833 +838 @@
 (define (tiger192:primitive)
   (make-message-digest-primitive
     context-size192 digest-length192
-    init192 update192 final192))
+    init192 update192 final192)) )

sha2/sha2.setup

@@ -1 @@
-(define has-exports? (string>=? (chicken-version) "2.310"))
-
-(compile -O2 -d0 -s
-  ,@(if has-exports? `(-check-imports -emit-exports sha2.exports) '())
-  sha2.scm)
-(install-extension 'sha2
-        '("sha2.so" "sha2.html")
-        `((version "1.4")
-          ,@(if has-exports? `((exports "sha2.exports")) '())
-                (documentation "sha2.html") ) )
-
+(compile sha2.scm -s -O2 -d1 -j sha2)
+(compile sha2.import.scm -s)
+(install-extension 
+ 'sha2 
+ '("sha2.so" "sha2.import.so")
+ '((version "1.4") 
+   (documentation "sha2.html")))

sha2/sha2.scm

@@ -1 +1 @@
 ;;;; sha2.scm
+(module sha2
+ (sha256:binary-digest sha384:binary-digest sha512:binary-digest
+   sha256:digest sha384:digest sha512:digest
+   sha256:primitive sha384:primitive sha512:primitive)
 
+(import scheme)
+(import chicken)
+
 (declare
  (fixnum)
  (no-bound-checks)
  (no-procedure-checks)
- (export
-   sha256:binary-digest sha384:binary-digest sha512:binary-digest
-   sha256:digest sha384:digest sha512:digest
-   sha256:primitive sha384:primitive sha512:primitive)
 )
 
 (use message-digest)
@@ -92 +95 @@
 (define (sha512:primitive)
   (make-message-digest-primitive
     context-size-512 digest-length-512
-    sha512:init sha512:update sha512:final))
+    sha512:init sha512:update sha512:final)))

ugarit/trunk/ugarit.meta

@@ -4 +4 @@
  (documentation "ugarit.html")
  (license "BSD")
  (category data)
- (needs miscmacros gdbm tiger-hash sha2 aes crypto-tools z3 lzma srfi-37 stty)
+ (needs miscmacros gdbm tiger-hash sha2 aes crypto-tools z3 lzma srfi-37 stty matchable)
  (author "Alaric Snell-Pym")
- (synopsis "A backup/archival system based on content-addressed storage"))
- No newline at end of file
+ (synopsis "A backup/archival system based on content-addressed storage"))

ugarit/trunk/ugarit-core.scm

@@ -1 @@
-(use srfi-2)
-(use srfi-4)
-(use srfi-18)
-(use miscmacros)
-(use posix)
-(use tiger-hash)
-(use sha2)
-(use aes)
-(use crypto-tools)
-(use z3)
-(use lzma)
-(use stty)
-(include "posixextras.scm")
-(include "backend-fs.scm")
-(include "backend-cache.scm")
-(include "backend-devtools.scm")
-
-(declare (export 
-   open-archive
+(module ugarit-core
+ ( open-archive
    archive?
    archive-writable?
    archive-unlinkable?
@@ -60 +43 @@
    snapshot-directory-tree!
    tag-snapshot!
    fold-history
-   fold-archive-node))
+   fold-archive-node)
 
+(import scheme)
+(import chicken)
+
+(require-library lzma)
+(import (prefix lzma lzma:))
+(use srfi-1)
+(use srfi-4)
+(use srfi-13)
+(use srfi-18)
+(use extras)
+(use ports)
+(use files)
+(use lolevel)
+(use data-structures)
+(use miscmacros)
+(use posix)
+(use tiger-hash)
+(use sha2)
+(use aes)
+(use crypto-tools)
+(use z3)
+(use stty)
+(use matchable)
+(use regex)
+
+
 ;;
 ;; STORAGE ENGINES
 ;;
@@ -99 +108 @@
    encrypt ; the encryptor, u8vector -> u8vector
    decrypt) ; the decryptor, inverse of the above
 
+(include "posixextras.scm")
+(include "backend-fs.scm")
+(include "backend-cache.scm")
+(include "backend-devtools.scm")
+
 (define (prepend-type-byte b v)
    (let* ((v-len (u8vector-length v))
           (v2 (make-u8vector (+ 1 v-len))))
@@ -654 +668 @@
                sexprs)))
       knil))
 
-(define (unlink-sexpr-stream-block! key sexpr-unlink!)
+(define (unlink-sexpr-stream-block! archive key sexpr-unlink!)
    (let ((result (archive-unlink! archive key)))
       (if result
          (for-each sexpr-unlink! (deserialise-sexpr-stream result)))))
@@ -667 +681 @@
             (unlink-key-stream! archive key ks-type
                (lambda (archive leaf-key found-leaf-type)
                   (assert (eq? found-leaf-type leaf-type))
-                  (unlink-sexpr-stream-block! leaf-key sexpr-unlink!))))
+                  (unlink-sexpr-stream-block! archive leaf-key sexpr-unlink!))))
          ((eq? type leaf-type)
-            (unlink-sexpr-stream-block! key sexpr-unlink!))
+            (unlink-sexpr-stream-block! archive key sexpr-unlink!))
          (else
             (assert (or (eq? type leaf-type) (eq? type ks-type)))))))
 
@@ -1020 +1034 @@
                            (kons #f dirent acc))
                         (else
                            (kons #f dirent acc)))))
-            knil))))
+            knil)))) )
 

ugarit/trunk/posixextras.scm

@@ +1 @@
+(import foreign)
 
 ;; Things that the posix unit forgot
 (foreign-declare #<<EOF
@@ -13 +14 @@
 #define C_lchown(fn, u, g)   C_fix(lchown(C_data_pointer(fn), C_unfix(u), C_unfix(g)))
 #define C_mknod(fn, m, d) C_fix(mknod(C_data_pointer(fn), C_unfix(m), C_unfix(d)))
 #define C_utime(fn) C_fix((C_utime_buf.actime = C_utime_atime, C_utime_buf.modtime = C_utime_mtime, utime(C_data_pointer(fn), &C_utime_buf)))
+#define C_ftell(p) C_fix(ftell(C_port_file(p)))
+#define C_fseek(p, n, w) C_mk_nbool(fseek(C_port_file(p), C_unfix(n), C_unfix(w)))
+#define C_lseek(fd, o, w) C_fix(lseek(C_unfix(fd), C_unfix(o), C_unfix(w)))
 EOF
 )
 
@@ -79 +83 @@
    (when (fx< (##core#inline "C_utime" (##sys#make-c-string (##sys#expand-home-path fn))) 0)
       (posix-error #:file-error 'change-file-times "cannot change file times" fn atime mtime)))
    
-   
- No newline at end of file
+ 
+(define-foreign-variable _seek_set int "SEEK_SET")
+(define-foreign-variable _seek_cur int "SEEK_CUR")
+(define-foreign-variable _seek_end int "SEEK_END")
+ 
+(define set-file-position!
+   (lambda (port pos . whence)
+     (let ([whence (if (pair? whence) (car whence) _seek_set)])
+       (##sys#check-exact pos 'set-file-position!)
+       (##sys#check-exact whence 'set-file-position!)
+       (when (fx< pos 0) (##sys#signal-hook #:bounds-error 'set-file-position! "invalid negative port position" pos port))
+       (unless (cond [(port? port)
+     (and (eq? (##sys#slot port 7) 'stream)
+       (##core#inline "C_fseek" port pos whence) ) ]
+     [(fixnum? port) (##core#inline "C_lseek" port pos whence)]
+     [else (##sys#signal-hook #:type-error 'set-file-position! "invalid file" port)] )
+   (posix-error #:file-error 'set-file-position! "cannot set file position" port pos) ) ) ) )
+

ugarit/trunk/ugarit.setup

@@ -1 @@
-(compile -s -O2 -d1 ugarit-core.scm)
+(compile -s -O2 -d1 ugarit-core.scm -j ugarit-core)
+(compile -s -O2 -d1 ugarit-core.import.scm)
 (compile -c -O2 -d1 ugarit-core.scm -unit ugarit-core)
-(install-extension 'ugarit-core '("ugarit-core.so" "ugarit-core.o")
+(install-extension 'ugarit-core '("ugarit-core.so" "ugarit-core.o" "ugarit-core.import.so")
   '((version 0.5)
     (static "ugarit-core.o")
     (documentation "ugarit.html")))

ugarit/trunk/ugarit.scm

@@ -2 +2 @@
 
 (use srfi-37)
 (use miscmacros)
+(use matchable)
 (use regex)
 
 (define (bit? i b)
@@ -131 +132 @@
       (let ((result (string-split line)))
   
          (match result
-            (()
+            (("")
                (explore-archive archive directory-key path quit-continuation))
             (("help")
                (printf "cd .. : Go up one level\n")

ugarit/trunk/backend-fs.scm

@@ -330 +330 @@
                (lambda (key value)
                   (file-close value)))))))
       
-   
- No newline at end of file
+   

gdbm/gdbm.setup

@@ -1 @@
-(run (csc -s -O2 -d0 gdbm.scm -lgdbm))
-(install-extension 'gdbm "gdbm.so")
- No newline at end of file
+(compile -s -O2 -d1 gdbm.scm -j gdbm -lgdbm)
+(compile -s -O2 -d1 gdbm.import.scm -j gdbm)
+(compile -c -O2 -d1 gdbm.scm -unit gdbm -lgdbm)
+;
+(install-extension
+  'gdbm
+  '("gdbm.o" "gdbm.import.so" "gdbm.so" "gdbm.html")
+  '((version "trunk")
+    (static "gdbm.o") ;; for static linking
+    (documentation "gdbm.html")))

gdbm/gdbm.scm

@@ -4 +4 @@
 ;; All rights reserved.
 ;;
 ;; BSD-style license: http://www.debian.org/misc/bsd.license
+(module gdbm
 
+( gdbm-open gdbm-close gdbm-store gdbm-fetch gdbm-delete gdbm-exists
+  gdbm-first-key gdbm-next-key gdbm-fold
+  GDBM_READER GDBM_WRITER GDBM_WRCREAT GDBM_NEWDB GDBM_SYNC GDBM_NOLOCK
+  GDBM_INSERT GDBM_REPLACE)
+
+(import scheme)
+(import chicken)
+(import foreign)
+
 (declare
  (fixnum-arithmetic)
  (usual-integrations)
- (export
-  gdbm-open gdbm-close gdbm-store gdbm-fetch gdbm-delete gdbm-exists
-  gdbm-first-key gdbm-next-key gdbm-fold
-  GDBM_READER GDBM_WRITER GDBM_WRCREAT GDBM_NEWDB GDBM_SYNC GDBM_NOLOCK
-  GDBM_INSERT GDBM_REPLACE))
+ )
 
 (declare
   (foreign-declare #<<EOF
@@ -123 +129 @@
        (let ([str (make-string len)])
          (##core#inline "copy_string_result" ptr len str)
          (##core#inline "free_ptr" ptr)
-         str) ) )
+         str) ) ) )

crypto-tools/trunk/crypto-tools.scm

@@ -1 @@
-(use lolevel)
+(module crypto-tools
+(blob->hexstring blob->hexstring/uppercase hexstring->blob
+ blob-xor blob-pad blob-unpad
+ make-cbc-encryptor make-cbc-decryptor
+ make-cbc*-encryptor make-cbc*-decryptor)
 
+(import scheme)
+(import chicken)
+(use extras lolevel)
 
-(declare (export
-   blob->hexstring blob->hexstring/uppercase hexstring->blob
-   blob-xor blob-pad blob-unpad
-   make-cbc-encryptor make-cbc-decryptor
-   make-cbc*-encryptor make-cbc*-decryptor))
-
 (define *the-null-blob* (make-blob 0))
 
 (define (check-blob blob len function)
@@ -254 +255 @@
                (let* ((inputsize (blob-size input))
                       (output (make-blob inputsize))
                       (iv (decryptor (subblob input 0 blocksize))))
-                  (decrypt input blocksize inputsize iv output 0)))))
+                  (decrypt input blocksize inputsize iv output 0))))) )

crypto-tools/trunk/crypto-tools.setup

@@ -1 @@
-(compile -s -O2 -d1 crypto-tools.scm)
+(compile -s -O2 -d1 crypto-tools.scm -j crypto-tools)
+(compile -s -O2 -d1 crypto-tools.import.scm)
 (compile -c -O2 -d1 crypto-tools.scm -unit crypto-tools)
 ;
 (install-extension
   'crypto-tools
-  '("crypto-tools.o" "crypto-tools.so" "crypto-tools.html")
+  '("crypto-tools.o" "crypto-tools.import.so""crypto-tools.so" "crypto-tools.html")
   '((version 1.1)
     (static "crypto-tools.o") ;; for static linking
     (documentation "crypto-tools.html")))

message-digest/trunk/message-digest.setup

@@ -1 @@
-(include "setup-header")
-
-(required-extension-version 'miscmacros "2.4" 'mathh "1.11")
-
-(install-dynld+docu message-digest *version*)
-
-(install-test "message-digest-test.scm")
+(compile message-digest.scm -s -O2 -d1 -j message-digest)
+(compile message-digest.import.scm -s)
+(install-extension 
+ 'message-digest 
+ '("message-digest.so" "message-digest.import.so")
+ '((version "1.7")
+   (documentation "message-digest.html")))

message-digest/trunk/tests/message-digest-test.scm

@@ -1 +1 @@
 ;;;; message-digest-test.scm
 
-(use testbase testbase-output-compact)
 (use message-digest)
 
 ;;

message-digest/trunk/message-digest.scm

@@ -8 +8 @@
 ;; - The ->fixnum/blob/... is approximate at best!
 
 
-(eval-when (compile)
-        (declare
-                (not usual-integrations
-      inexact->exact integer? round number? modulo)
-                (fixnum)
-                (inline)
-                (no-procedure-checks)
-                (constant
-                  int->hex
-                        ->fixnum
-                        ->blob
-                        ->blob/shared
-                        byte-string->hexadecimal)
+(module message-digest
+        (export
+                byte-string->substring-list/shared
+                byte-string->substring-list
+                byte-string->hexadecimal
+                ->blob
+                ->blob/shared
+                message-digest-chunk-size
+                make-binary-message-digest
+                make-message-digest
+                make-message-digest-primitive
+                message-digest-primitive?
+                message-digest-primitive-name
+                message-digest-primitive-context-info
+                message-digest-primitive-digest-length
+                message-digest-primitive-init
+                message-digest-primitive-update
+                message-digest-primitive-final
+                message-digest-primitive-apply)
+
+(import scheme)
+(import chicken)
+
+(declare
+        (not usual-integrations inexact->exact integer? round number? modulo)
+        (fixnum)
+        (inline)
+        (no-procedure-checks)
+        (constant
+          int->hex
+                ->fixnum
+                ->blob
+                ->blob/shared
+                byte-string->hexadecimal)
     (bound-to-procedure
-      message-digest-primitive?)
-                (export
-                        byte-string->substring-list/shared
-                        byte-string->substring-list
-                        byte-string->hexadecimal
-                        ->blob
-                        ->blob/shared
-                        message-digest-chunk-size
-                        make-binary-message-digest
-                        make-message-digest
-                        make-message-digest-primitive
-                        message-digest-primitive?
-                        message-digest-primitive-name
-                        message-digest-primitive-context-info
-                        message-digest-primitive-digest-length
-                        message-digest-primitive-init
-                        message-digest-primitive-update
-                        message-digest-primitive-final
-                        message-digest-primitive-apply) ) )
+      message-digest-primitive?) ) 
+(use ports data-structures srfi-1 srfi-4 srfi-13 srfi-69 lolevel mathh miscmacros)
 
-(require-extension extras srfi-1 srfi-4 srfi-9 srfi-13 srfi-69 lolevel mathh-int miscmacros)
-
 ;;;
 
 (define (check-procedure loc obj')
@@ -56 +58 @@
 
 (define (check-context-info loc obj)
   (unless (or (fixnum? obj) (procedure? obj))
-    (error loc "bad argument type - expected a fixnum or procedure" ctx-info) ) )
+    (error loc "bad argument type - expected a fixnum or procedure" obj) ) )
 
 ;;; Cache
 
@@ -86 +88 @@
 (define (int->hex ch)
   (let* ((int (char->integer ch))
          (str (number->string int 16)))
-    (if (< int 16) (conc #\0 str) str) ) )
+    (if (< int 16) (conc "0" str) str) ) )
 
 (define (byte-string->hexadecimal str #!optional (len (byte-string-length str)))
-  (with-output-to-string (lambda () (byte-string-for-each int->hex str 0 len) ) ) )
+  (with-output-to-string (lambda () (byte-string-for-each (lambda (x) (display (int->hex x))) str 0 len) ) ) )
 
 ;;;
 
@@ -187 +189 @@
       (lambda () (when (fixnum? ctx-info) (free ctx)) ) ) ) )
 
 (define (make-message-digest obj ctx-info digest-len init update final . caller)
-        (string->hexadecimal
+        (byte-string->hexadecimal
    (make-binary-message-digest obj
     ctx-info digest-len
     init update final
@@ -208 +210 @@
          (message-digest-primitive-init md-prim)
          (message-digest-primitive-update md-prim)
          (message-digest-primitive-final md-prim)
-         (optional caller 'message-digest-primitive-apply)) )
+         (optional caller 'message-digest-primitive-apply)) ))

message-digest/trunk/message-digest.meta

@@ -1 @@
-;;;; -*- Hen -*-
-;;;; message-digest.meta
+;;; message-digest.meta -*- Hen -*-
 
-((category crypt)
- (synopsis "Message Digest Support")
- (author "Kon Lovett")
- (egg "message-digest.egg")
- (license "BSD")
+((egg "message-digest.egg")
+ (synopsis "Message Digest provides support for message digest primitives.")
  (needs mathh miscmacros)
+ (category crypt)
+ (license "MIT")
  (doc-from-wiki)
- (files
-  "tests"
-        "setup-header.scm"
-        "message-digest.scm"
-        "message-digest.setup"
-        "message-digest.html"))
+ (author "Kon Lovett")
+ (files "message-digest.setup" "message-digest.scm" "message-digest.html"))

packrat/packrat.setup

@@ -1 @@
-(compile packrat.scm -s -O2 -d1 -R syntax-case)
-(install-extension 'packrat '("packrat.scm" "packrat.html" "packrat.so") '((documentation "packrat.html") (version 1.1)))
+(compile packrat.scm -s -O2 -d1 -j packrat) (compile packrat.import.scm -s)
+(install-extension 'packrat '("packrat.scm" "packrat.html" "packrat.so" "packrat.import.so") '((documentation "packrat.html") (version 1.1)))

packrat/packrat.scm

@@ -26 +26 @@
 ;; Requires: SRFI-1, SRFI-9, SRFI-6. See the documentation for more
 ;; details.
 
-(use srfi-1)
-
 (module packrat (parse-result?
            parse-result-successful?
            parse-result-semantic-value
@@ -84 +82 @@
 
            (packrat-parser object->external-representation) )
 
+(import chicken)
+(import scheme)
+(require-library srfi-1) (import srfi-1)
+
 (define-record-type parse-result
   (make-parse-result successful? semantic-value next error)
   parse-result?

packrat/packrat.meta

@@ -2 +2 @@
 
 ((egg "packrat.egg")
  (synopsis "A packrat parsing library")
- (needs syntax-case)
  (category parsing)
  (license "MIT")
  (author "Tony Garnock-Jones")

syntax-case/trunk/syntax-case.scm

@@ -3 +3 @@
 ; This file is mainly by Felix L. Winkelmann, but contains a good deal of code
 ; from the portable syntax case (psyntax) distribution.
 
+(module
 
 (declare
  (disable-interrupts)
@@ -597 +598 @@
              (newline)
              (pretty-print exp)
              (display "<EXPANDED>\n")
-             exp) ) ) ) ) ) )
+             exp) ) ) ) ) ) ) )
 
 
-(##syncase#install-macro-package)
+;; (##syncase#install-macro-package)

z3/z3.setup

@@ -1 +1 @@
 (compile z3.scm -O2 -d1 -s
-         -emit-exports "z3.exports"
+         -extend easyffi -j z3)
+(compile z3.import.scm -O2 -d1 -s
          -extend easyffi)
 
 (install-extension 
  'z3
- '("z3.so" "z3.html")
+ '("z3.so" "z3.import.so" "z3.html")
  '((exports "z3.exports") 
    (version 1.36)
    (documentation "z3.html")))

z3/z3lib.h

@@ -24 +24 @@
 typedef int32_t __s32;
 #endif
 
-#ifdef _WIN32
+#if defined (_WIN32) || defined (__OpenBSD__)
 # define EMSGSIZE    40
 # define EOVERFLOW   84
 # define EBADMSG     94

z3/z3flib.c

@@ -35 +35 @@
     return -EINVAL;
   }
   if (filedescr < 0) {
-    return -ENOENT;
+    return -ENODATA;
   }
   if (level <= 0) {
     level = 6;
@@ -196 +196 @@
     return -EINVAL;
   }
   if (filedescr < 0) {
-    return -ENOENT;
+    return -ENODATA;
   }
   if (z3d_decode_init(0, 0, &zh->z3dd, sizeof(zh->z3dd)) == NULL) {
     return -EFAULT;

z3/z3.scm

@@ -1 +1 @@
 ;;;; z3.scm
-
-(use posix)
-
-(declare 
-  (fixnum)
-  (export z3:decode-init z3:decode
+(module z3
+        (z3:decode-init z3:decode
           z3:encode-init z3:encode
           z3:handle?
           z3:open-compressed-input-file z3:open-compressed-output-file
           z3:file-handle? z3:file-handle-fileno
           z3:encode-buffer z3:decode-buffer
           z3:encode-file z3:write-encoded
-          z3:decode-file z3:read-decoded) )
+          z3:decode-file z3:read-decoded)
+(import scheme)
+(import chicken)
+(import (except foreign foreign-declare))
+(use data-structures ports posix easyffi)
 
+(declare 
+  (fixnum)
+  )
+
 #>
 #include <unistd.h>
 #include "z3blib.c"
@@ -342 +346 @@
                  (##core#inline "free_dbuffer" ptr)
                  buf)
                (error 'z3:decode-buffer "out of memory - can not allocate decompression buffer")) )
-          (else (z3:error 'z3:decode-buffer err "can not decode data") ) ) ) )
+          (else (z3:error 'z3:decode-buffer err "can not decode data") ) ) ) ) )