Ticket #48: ugarit_and_friends.diff

File ugarit_and_friends.diff, 28.9 KB (added by felix winkelmann, 13 years ago)
  • aes/trunk/aes.setup

     
    1 (compile -s -O2 -d1 aes.scm)
     1(compile -s -O2 -d1 aes.scm -j aes)
     2(compile -s -O2 -d1 aes.import.scm -j aes)
    23(compile -c -O2 -d1 aes.scm -unit aes)
    34;
    45(install-extension
    56  'aes
    6   '("aes.o" "aes.so" "aes.html")
     7  '("aes.o" "aes.import.so" "aes.so" "aes.html")
    78  '((version 1.1)
    89    (static "aes.o") ;; for static linking
    910    (documentation "aes.html")))
  • aes/trunk/aes.scm

     
     1(module aes
     2(make-aes128-encryptor make-aes192-encryptor make-aes256-encryptor
     3   make-aes128-decryptor make-aes192-decryptor make-aes256-decryptor)
    14
    2 (declare (export
    3    make-aes128-encryptor make-aes192-encryptor make-aes256-encryptor
    4    make-aes128-decryptor make-aes192-decryptor make-aes256-decryptor))
    5 
    65;; The contents of the below foreign-declare
    76;; Are public domain code from http://www.efgh.com/software/rijndael.htm
    87;; My modifications extend no further than pasting it together and putting
     
    1312;; * Antoon Bosselaers antoon.bosselaers@esat.kuleuven.ac.be
    1413;; * Paulo Barreto paulo.barreto@terra.com.br
    1514
     15(import scheme)
     16(import chicken)
     17(import foreign)
     18
     19(use extras)
     20
    1621(foreign-declare "
    1722   static int rijndaelSetupEncrypt(unsigned long *rk, const unsigned char *key,
    1823     int keybits);
     
    13191324            (rijndaelDecrypt
    13201325               context nrounds
    13211326               input result)
    1322             result))))
    1323 
    1324                  
    1325  No newline at end of file
     1327            result)))) )
  • json/trunk/json.setup

     
    1 (compile -R syntax-case json.scm -s -O2 -d1)
     1(compile json.scm -s -O2 -d1 -j json)
     2(compile json.import.scm -s)
    23(install-extension
    34 'json
    4  '("json.so")
     5 '("json.so" "json.import.so")
    56 '((version "1.2.1")
    67   (documentation "json.html")))
  • json/trunk/json.scm

     
    2828;; JSON Arrays are lists
    2929;;
    3030
    31 (require-extension packrat srfi-69)
     31(module json (json-read json-write)
    3232
    33 (import packrat)
     33(import scheme)
     34(import chicken)
     35(use ports)
     36(require-library srfi-1) (import (except srfi-1 any))
     37(use srfi-69)
     38(use packrat)
    3439
    35 (declare (export json-read json-write))
    36 
    3740  (define (hashtable->vector ht)
    3841    (list->vector (hash-table->alist ht)) )
    3942
     
    201204                             (parse-error-messages e)))))))
    202205
    203206      (lambda maybe-port
    204         (read-any (if (pair? maybe-port) (car maybe-port) (current-input-port))))))
     207        (read-any (if (pair? maybe-port) (car maybe-port) (current-input-port)))))))
    205208
  • json/trunk/json.meta

     
    22
    33((egg "json.egg")
    44 (synopsis "A JSON library")
    5  (needs syntax-case packrat)
     5 (needs "packrat")
    66 (category parsing)
    77 (license "MIT")
    88 (eggdoc "doc.scm")
  • lzma/trunk/tests/run.scm

     
    1 (load "../lzma")
     1(use lzma)
    22
    33(define test-string (with-input-from-file "../lzma.so" (lambda () (read-string))))
    44
     
    66
    77(printf "Original size: ~A\n" (blob-size test-blob))
    88
    9 (define compressed (lzma:compress test-blob))
     9(define compressed (compress test-blob))
    1010
    1111(printf "Compressed size: ~A\n" (blob-size compressed))
    1212
    13 (define decompressed (lzma:decompress compressed))
     13(define decompressed (decompress compressed))
    1414
    1515(printf "Decompressed size: ~A\n" (blob-size decompressed))
    1616
  • lzma/trunk/lzma.setup

     
    1 (compile -s -O2 -d1 lzma.scm -llzma)
     1(compile -s -O2 -d1 lzma.scm -llzma -j lzma)
    22(compile -c -O2 -d1 lzma.scm -llzma -unit lzma)
     3(compile -s -O2 -d1 lzma.import.scm)
    34;
    45(install-extension
    56  'lzma
    6   '("lzma.o" "lzma.so" "lzma.html")
     7  '("lzma.o" "lzma.so" "lzma.import.so" "lzma.html")
    78  '((version 1.2)
    89    (static "lzma.o") ;; for static linking
    910    (documentation "lzma.html")))
  • lzma/trunk/lzma.scm

     
    1 (declare (export lzma:compress lzma:decompress))
     1(module lzma (compress decompress)
    22
     3(import scheme)
     4(import chicken)
     5(import foreign)
    36(use lolevel)
    47
    58(foreign-declare "#include <lzmalib.h>")
     
    1316   "C_return (lzma_compress(inblob, inlen, &lzma_return_buffer_len));"))
    1417(define _free (foreign-lambda void "lzma_free" c-pointer))
    1518
    16 (define (lzma:decompress inblob)
     19(define (decompress inblob)
    1720   (let ((ptr (_decompress inblob (blob-size inblob))))
    1821      (if (null-pointer? ptr)
    1922         #f
     
    2326               (_free ptr)
    2427               outblob)))))
    2528
    26 (define (lzma:compress inblob)
     29(define (compress inblob)
    2730   (let ((ptr (_compress inblob (blob-size inblob))))
    2831      (if (null-pointer? ptr)
    2932         #f
     
    3134            (begin
    3235               (move-memory! ptr outblob lzma-return-buffer-len)
    3336               (_free ptr)
    34                outblob)))))
     37               outblob))))))
  • tiger-hash/trunk/tiger-hash.setup

     
    1 (include "setup-header")
    2 
    3 (required-extension-version
    4   'mathh                  "1.11"
    5   'message-digest         "1.5")
    6 
    7 (install-dynld+docu tiger-hash *version*)
    8 
    9 (install-test "tiger-hash-test.scm")
     1(compile tiger-hash.scm -s -O2 -d1 -j tiger-hash)
     2(compile tiger-hash.import.scm -s)
     3(install-extension
     4 'tiger-hash
     5 '("tiger-hash.so" "tiger-hash.import.so")
     6 '((version "trunk")
     7   (documentation "tiger-hash.html")))
  • tiger-hash/trunk/tiger-hash.scm

     
    11;;;; tiger-hash.scm
    22;;;; Kon Lovett, Jan '06
     3(module tiger-hash
    34
     5   (tiger192:binary-digest
     6    tiger192:digest
     7    tiger192:primitive)
     8
     9(import scheme)
     10(import chicken)
     11
    412(use message-digest)
    513
    614(declare
     
    917  (fixnum)
    1018  (no-procedure-checks)
    1119  (no-bound-checks)
    12   (export
    13     tiger192:binary-digest
    14     tiger192:digest
    15     tiger192:primitive) )
     20   )
    1621
    1722#>
    1823/* Chicken.h includes it but be specific */
     
    833838(define (tiger192:primitive)
    834839  (make-message-digest-primitive
    835840    context-size192 digest-length192
    836     init192 update192 final192))
     841    init192 update192 final192)) )
  • sha2/sha2.setup

     
    1 (define has-exports? (string>=? (chicken-version) "2.310"))
    2 
    3 (compile -O2 -d0 -s
    4   ,@(if has-exports? `(-check-imports -emit-exports sha2.exports) '())
    5   sha2.scm)
    6 (install-extension 'sha2
    7         '("sha2.so" "sha2.html")
    8         `((version "1.4")
    9           ,@(if has-exports? `((exports "sha2.exports")) '())
    10                 (documentation "sha2.html") ) )
    11 
     1(compile sha2.scm -s -O2 -d1 -j sha2)
     2(compile sha2.import.scm -s)
     3(install-extension
     4 'sha2
     5 '("sha2.so" "sha2.import.so")
     6 '((version "1.4")
     7   (documentation "sha2.html")))
  • sha2/sha2.scm

     
    11;;;; sha2.scm
     2(module sha2
     3 (sha256:binary-digest sha384:binary-digest sha512:binary-digest
     4   sha256:digest sha384:digest sha512:digest
     5   sha256:primitive sha384:primitive sha512:primitive)
    26
     7(import scheme)
     8(import chicken)
     9
    310(declare
    411 (fixnum)
    512 (no-bound-checks)
    613 (no-procedure-checks)
    7  (export
    8    sha256:binary-digest sha384:binary-digest sha512:binary-digest
    9    sha256:digest sha384:digest sha512:digest
    10    sha256:primitive sha384:primitive sha512:primitive)
    1114)
    1215
    1316(use message-digest)
     
    9295(define (sha512:primitive)
    9396  (make-message-digest-primitive
    9497    context-size-512 digest-length-512
    95     sha512:init sha512:update sha512:final))
     98    sha512:init sha512:update sha512:final)))
  • ugarit/trunk/ugarit.meta

     
    44 (documentation "ugarit.html")
    55 (license "BSD")
    66 (category data)
    7  (needs miscmacros gdbm tiger-hash sha2 aes crypto-tools z3 lzma srfi-37 stty)
     7 (needs miscmacros gdbm tiger-hash sha2 aes crypto-tools z3 lzma srfi-37 stty matchable)
    88 (author "Alaric Snell-Pym")
    9  (synopsis "A backup/archival system based on content-addressed storage"))
    10  No newline at end of file
     9 (synopsis "A backup/archival system based on content-addressed storage"))
  • ugarit/trunk/ugarit-core.scm

     
    1 (use srfi-2)
    2 (use srfi-4)
    3 (use srfi-18)
    4 (use miscmacros)
    5 (use posix)
    6 (use tiger-hash)
    7 (use sha2)
    8 (use aes)
    9 (use crypto-tools)
    10 (use z3)
    11 (use lzma)
    12 (use stty)
    13 (include "posixextras.scm")
    14 (include "backend-fs.scm")
    15 (include "backend-cache.scm")
    16 (include "backend-devtools.scm")
    17 
    18 (declare (export
    19    open-archive
     1(module ugarit-core
     2 ( open-archive
    203   archive?
    214   archive-writable?
    225   archive-unlinkable?
     
    6043   snapshot-directory-tree!
    6144   tag-snapshot!
    6245   fold-history
    63    fold-archive-node))
     46   fold-archive-node)
    6447
     48(import scheme)
     49(import chicken)
     50
     51(require-library lzma)
     52(import (prefix lzma lzma:))
     53(use srfi-1)
     54(use srfi-4)
     55(use srfi-13)
     56(use srfi-18)
     57(use extras)
     58(use ports)
     59(use files)
     60(use lolevel)
     61(use data-structures)
     62(use miscmacros)
     63(use posix)
     64(use tiger-hash)
     65(use sha2)
     66(use aes)
     67(use crypto-tools)
     68(use z3)
     69(use stty)
     70(use matchable)
     71(use regex)
     72
     73
    6574;;
    6675;; STORAGE ENGINES
    6776;;
     
    99108   encrypt ; the encryptor, u8vector -> u8vector
    100109   decrypt) ; the decryptor, inverse of the above
    101110
     111(include "posixextras.scm")
     112(include "backend-fs.scm")
     113(include "backend-cache.scm")
     114(include "backend-devtools.scm")
     115
    102116(define (prepend-type-byte b v)
    103117   (let* ((v-len (u8vector-length v))
    104118          (v2 (make-u8vector (+ 1 v-len))))
     
    654668               sexprs)))
    655669      knil))
    656670
    657 (define (unlink-sexpr-stream-block! key sexpr-unlink!)
     671(define (unlink-sexpr-stream-block! archive key sexpr-unlink!)
    658672   (let ((result (archive-unlink! archive key)))
    659673      (if result
    660674         (for-each sexpr-unlink! (deserialise-sexpr-stream result)))))
     
    667681            (unlink-key-stream! archive key ks-type
    668682               (lambda (archive leaf-key found-leaf-type)
    669683                  (assert (eq? found-leaf-type leaf-type))
    670                   (unlink-sexpr-stream-block! leaf-key sexpr-unlink!))))
     684                  (unlink-sexpr-stream-block! archive leaf-key sexpr-unlink!))))
    671685         ((eq? type leaf-type)
    672             (unlink-sexpr-stream-block! key sexpr-unlink!))
     686            (unlink-sexpr-stream-block! archive key sexpr-unlink!))
    673687         (else
    674688            (assert (or (eq? type leaf-type) (eq? type ks-type)))))))
    675689
     
    10201034                           (kons #f dirent acc))
    10211035                        (else
    10221036                           (kons #f dirent acc)))))
    1023             knil))))
     1037            knil)))) )
    10241038
  • ugarit/trunk/posixextras.scm

     
     1(import foreign)
    12
    23;; Things that the posix unit forgot
    34(foreign-declare #<<EOF
     
    1314#define C_lchown(fn, u, g)   C_fix(lchown(C_data_pointer(fn), C_unfix(u), C_unfix(g)))
    1415#define C_mknod(fn, m, d) C_fix(mknod(C_data_pointer(fn), C_unfix(m), C_unfix(d)))
    1516#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)))
     17#define C_ftell(p) C_fix(ftell(C_port_file(p)))
     18#define C_fseek(p, n, w) C_mk_nbool(fseek(C_port_file(p), C_unfix(n), C_unfix(w)))
     19#define C_lseek(fd, o, w) C_fix(lseek(C_unfix(fd), C_unfix(o), C_unfix(w)))
    1620EOF
    1721)
    1822
     
    7983   (when (fx< (##core#inline "C_utime" (##sys#make-c-string (##sys#expand-home-path fn))) 0)
    8084      (posix-error #:file-error 'change-file-times "cannot change file times" fn atime mtime)))
    8185   
    82    
    83  No newline at end of file
     86 
     87(define-foreign-variable _seek_set int "SEEK_SET")
     88(define-foreign-variable _seek_cur int "SEEK_CUR")
     89(define-foreign-variable _seek_end int "SEEK_END")
     90 
     91(define set-file-position!
     92   (lambda (port pos . whence)
     93     (let ([whence (if (pair? whence) (car whence) _seek_set)])
     94       (##sys#check-exact pos 'set-file-position!)
     95       (##sys#check-exact whence 'set-file-position!)
     96       (when (fx< pos 0) (##sys#signal-hook #:bounds-error 'set-file-position! "invalid negative port position" pos port))
     97       (unless (cond [(port? port)
     98     (and (eq? (##sys#slot port 7) 'stream)
     99       (##core#inline "C_fseek" port pos whence) ) ]
     100     [(fixnum? port) (##core#inline "C_lseek" port pos whence)]
     101     [else (##sys#signal-hook #:type-error 'set-file-position! "invalid file" port)] )
     102   (posix-error #:file-error 'set-file-position! "cannot set file position" port pos) ) ) ) )
     103
  • ugarit/trunk/ugarit.setup

     
    1 (compile -s -O2 -d1 ugarit-core.scm)
     1(compile -s -O2 -d1 ugarit-core.scm -j ugarit-core)
     2(compile -s -O2 -d1 ugarit-core.import.scm)
    23(compile -c -O2 -d1 ugarit-core.scm -unit ugarit-core)
    3 (install-extension 'ugarit-core '("ugarit-core.so" "ugarit-core.o")
     4(install-extension 'ugarit-core '("ugarit-core.so" "ugarit-core.o" "ugarit-core.import.so")
    45  '((version 0.5)
    56    (static "ugarit-core.o")
    67    (documentation "ugarit.html")))
  • ugarit/trunk/ugarit.scm

     
    22
    33(use srfi-37)
    44(use miscmacros)
     5(use matchable)
    56(use regex)
    67
    78(define (bit? i b)
     
    131132      (let ((result (string-split line)))
    132133 
    133134         (match result
    134             (()
     135            (("")
    135136               (explore-archive archive directory-key path quit-continuation))
    136137            (("help")
    137138               (printf "cd .. : Go up one level\n")
  • ugarit/trunk/backend-fs.scm

     
    330330               (lambda (key value)
    331331                  (file-close value)))))))
    332332     
    333    
    334  No newline at end of file
     333   
  • gdbm/gdbm.setup

     
    1 (run (csc -s -O2 -d0 gdbm.scm -lgdbm))
    2 (install-extension 'gdbm "gdbm.so")
    3  No newline at end of file
     1(compile -s -O2 -d1 gdbm.scm -j gdbm -lgdbm)
     2(compile -s -O2 -d1 gdbm.import.scm -j gdbm)
     3(compile -c -O2 -d1 gdbm.scm -unit gdbm -lgdbm)
     4;
     5(install-extension
     6  'gdbm
     7  '("gdbm.o" "gdbm.import.so" "gdbm.so" "gdbm.html")
     8  '((version "trunk")
     9    (static "gdbm.o") ;; for static linking
     10    (documentation "gdbm.html")))
  • gdbm/gdbm.scm

     
    44;; All rights reserved.
    55;;
    66;; BSD-style license: http://www.debian.org/misc/bsd.license
     7(module gdbm
    78
     9( gdbm-open gdbm-close gdbm-store gdbm-fetch gdbm-delete gdbm-exists
     10  gdbm-first-key gdbm-next-key gdbm-fold
     11  GDBM_READER GDBM_WRITER GDBM_WRCREAT GDBM_NEWDB GDBM_SYNC GDBM_NOLOCK
     12  GDBM_INSERT GDBM_REPLACE)
     13
     14(import scheme)
     15(import chicken)
     16(import foreign)
     17
    818(declare
    919 (fixnum-arithmetic)
    1020 (usual-integrations)
    11  (export
    12   gdbm-open gdbm-close gdbm-store gdbm-fetch gdbm-delete gdbm-exists
    13   gdbm-first-key gdbm-next-key gdbm-fold
    14   GDBM_READER GDBM_WRITER GDBM_WRCREAT GDBM_NEWDB GDBM_SYNC GDBM_NOLOCK
    15   GDBM_INSERT GDBM_REPLACE))
     21 )
    1622
    1723(declare
    1824  (foreign-declare #<<EOF
     
    123129       (let ([str (make-string len)])
    124130         (##core#inline "copy_string_result" ptr len str)
    125131         (##core#inline "free_ptr" ptr)
    126          str) ) )
     132         str) ) ) )
  • crypto-tools/trunk/crypto-tools.scm

     
    1 (use lolevel)
     1(module crypto-tools
     2(blob->hexstring blob->hexstring/uppercase hexstring->blob
     3 blob-xor blob-pad blob-unpad
     4 make-cbc-encryptor make-cbc-decryptor
     5 make-cbc*-encryptor make-cbc*-decryptor)
    26
     7(import scheme)
     8(import chicken)
     9(use extras lolevel)
    310
    4 (declare (export
    5    blob->hexstring blob->hexstring/uppercase hexstring->blob
    6    blob-xor blob-pad blob-unpad
    7    make-cbc-encryptor make-cbc-decryptor
    8    make-cbc*-encryptor make-cbc*-decryptor))
    9 
    1011(define *the-null-blob* (make-blob 0))
    1112
    1213(define (check-blob blob len function)
     
    254255               (let* ((inputsize (blob-size input))
    255256                      (output (make-blob inputsize))
    256257                      (iv (decryptor (subblob input 0 blocksize))))
    257                   (decrypt input blocksize inputsize iv output 0)))))
     258                  (decrypt input blocksize inputsize iv output 0))))) )
  • crypto-tools/trunk/crypto-tools.setup

     
    1 (compile -s -O2 -d1 crypto-tools.scm)
     1(compile -s -O2 -d1 crypto-tools.scm -j crypto-tools)
     2(compile -s -O2 -d1 crypto-tools.import.scm)
    23(compile -c -O2 -d1 crypto-tools.scm -unit crypto-tools)
    34;
    45(install-extension
    56  'crypto-tools
    6   '("crypto-tools.o" "crypto-tools.so" "crypto-tools.html")
     7  '("crypto-tools.o" "crypto-tools.import.so""crypto-tools.so" "crypto-tools.html")
    78  '((version 1.1)
    89    (static "crypto-tools.o") ;; for static linking
    910    (documentation "crypto-tools.html")))
  • message-digest/trunk/message-digest.setup

     
    1 (include "setup-header")
    2 
    3 (required-extension-version 'miscmacros "2.4" 'mathh "1.11")
    4 
    5 (install-dynld+docu message-digest *version*)
    6 
    7 (install-test "message-digest-test.scm")
     1(compile message-digest.scm -s -O2 -d1 -j message-digest)
     2(compile message-digest.import.scm -s)
     3(install-extension
     4 'message-digest
     5 '("message-digest.so" "message-digest.import.so")
     6 '((version "1.7")
     7   (documentation "message-digest.html")))
  • message-digest/trunk/tests/message-digest-test.scm

     
    11;;;; message-digest-test.scm
    22
    3 (use testbase testbase-output-compact)
    43(use message-digest)
    54
    65;;
  • message-digest/trunk/message-digest.scm

     
    88;; - The ->fixnum/blob/... is approximate at best!
    99
    1010
    11 (eval-when (compile)
    12         (declare
    13                 (not usual-integrations
    14       inexact->exact integer? round number? modulo)
    15                 (fixnum)
    16                 (inline)
    17                 (no-procedure-checks)
    18                 (constant
    19                   int->hex
    20                         ->fixnum
    21                         ->blob
    22                         ->blob/shared
    23                         byte-string->hexadecimal)
     11(module message-digest
     12        (export
     13                byte-string->substring-list/shared
     14                byte-string->substring-list
     15                byte-string->hexadecimal
     16                ->blob
     17                ->blob/shared
     18                message-digest-chunk-size
     19                make-binary-message-digest
     20                make-message-digest
     21                make-message-digest-primitive
     22                message-digest-primitive?
     23                message-digest-primitive-name
     24                message-digest-primitive-context-info
     25                message-digest-primitive-digest-length
     26                message-digest-primitive-init
     27                message-digest-primitive-update
     28                message-digest-primitive-final
     29                message-digest-primitive-apply)
     30
     31(import scheme)
     32(import chicken)
     33
     34(declare
     35        (not usual-integrations inexact->exact integer? round number? modulo)
     36        (fixnum)
     37        (inline)
     38        (no-procedure-checks)
     39        (constant
     40          int->hex
     41                ->fixnum
     42                ->blob
     43                ->blob/shared
     44                byte-string->hexadecimal)
    2445    (bound-to-procedure
    25       message-digest-primitive?)
    26                 (export
    27                         byte-string->substring-list/shared
    28                         byte-string->substring-list
    29                         byte-string->hexadecimal
    30                         ->blob
    31                         ->blob/shared
    32                         message-digest-chunk-size
    33                         make-binary-message-digest
    34                         make-message-digest
    35                         make-message-digest-primitive
    36                         message-digest-primitive?
    37                         message-digest-primitive-name
    38                         message-digest-primitive-context-info
    39                         message-digest-primitive-digest-length
    40                         message-digest-primitive-init
    41                         message-digest-primitive-update
    42                         message-digest-primitive-final
    43                         message-digest-primitive-apply) ) )
     46      message-digest-primitive?) )
     47(use ports data-structures srfi-1 srfi-4 srfi-13 srfi-69 lolevel mathh miscmacros)
    4448
    45 (require-extension extras srfi-1 srfi-4 srfi-9 srfi-13 srfi-69 lolevel mathh-int miscmacros)
    46 
    4749;;;
    4850
    4951(define (check-procedure loc obj')
     
    5658
    5759(define (check-context-info loc obj)
    5860  (unless (or (fixnum? obj) (procedure? obj))
    59     (error loc "bad argument type - expected a fixnum or procedure" ctx-info) ) )
     61    (error loc "bad argument type - expected a fixnum or procedure" obj) ) )
    6062
    6163;;; Cache
    6264
     
    8688(define (int->hex ch)
    8789  (let* ((int (char->integer ch))
    8890         (str (number->string int 16)))
    89     (if (< int 16) (conc #\0 str) str) ) )
     91    (if (< int 16) (conc "0" str) str) ) )
    9092
    9193(define (byte-string->hexadecimal str #!optional (len (byte-string-length str)))
    92   (with-output-to-string (lambda () (byte-string-for-each int->hex str 0 len) ) ) )
     94  (with-output-to-string (lambda () (byte-string-for-each (lambda (x) (display (int->hex x))) str 0 len) ) ) )
    9395
    9496;;;
    9597
     
    187189      (lambda () (when (fixnum? ctx-info) (free ctx)) ) ) ) )
    188190
    189191(define (make-message-digest obj ctx-info digest-len init update final . caller)
    190         (string->hexadecimal
     192        (byte-string->hexadecimal
    191193   (make-binary-message-digest obj
    192194    ctx-info digest-len
    193195    init update final
     
    208210         (message-digest-primitive-init md-prim)
    209211         (message-digest-primitive-update md-prim)
    210212         (message-digest-primitive-final md-prim)
    211          (optional caller 'message-digest-primitive-apply)) )
     213         (optional caller 'message-digest-primitive-apply)) ))
  • message-digest/trunk/message-digest.meta

     
    1 ;;;; -*- Hen -*-
    2 ;;;; message-digest.meta
     1;;; message-digest.meta -*- Hen -*-
    32
    4 ((category crypt)
    5  (synopsis "Message Digest Support")
    6  (author "Kon Lovett")
    7  (egg "message-digest.egg")
    8  (license "BSD")
     3((egg "message-digest.egg")
     4 (synopsis "Message Digest provides support for message digest primitives.")
    95 (needs mathh miscmacros)
     6 (category crypt)
     7 (license "MIT")
    108 (doc-from-wiki)
    11  (files
    12   "tests"
    13         "setup-header.scm"
    14         "message-digest.scm"
    15         "message-digest.setup"
    16         "message-digest.html"))
     9 (author "Kon Lovett")
     10 (files "message-digest.setup" "message-digest.scm" "message-digest.html"))
  • packrat/packrat.setup

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

     
    2626;; Requires: SRFI-1, SRFI-9, SRFI-6. See the documentation for more
    2727;; details.
    2828
    29 (use srfi-1)
    30 
    3129(module packrat (parse-result?
    3230           parse-result-successful?
    3331           parse-result-semantic-value
     
    8482
    8583           (packrat-parser object->external-representation) )
    8684
     85(import chicken)
     86(import scheme)
     87(require-library srfi-1) (import srfi-1)
     88
    8789(define-record-type parse-result
    8890  (make-parse-result successful? semantic-value next error)
    8991  parse-result?
  • packrat/packrat.meta

     
    22
    33((egg "packrat.egg")
    44 (synopsis "A packrat parsing library")
    5  (needs syntax-case)
    65 (category parsing)
    76 (license "MIT")
    87 (author "Tony Garnock-Jones")
  • syntax-case/trunk/syntax-case.scm

     
    33; This file is mainly by Felix L. Winkelmann, but contains a good deal of code
    44; from the portable syntax case (psyntax) distribution.
    55
     6(module
    67
    78(declare
    89 (disable-interrupts)
     
    597598             (newline)
    598599             (pretty-print exp)
    599600             (display "<EXPANDED>\n")
    600              exp) ) ) ) ) ) )
     601             exp) ) ) ) ) ) ) )
    601602
    602603
    603 (##syncase#install-macro-package)
     604;; (##syncase#install-macro-package)
  • z3/z3.setup

     
    11(compile z3.scm -O2 -d1 -s
    2          -emit-exports "z3.exports"
     2         -extend easyffi -j z3)
     3(compile z3.import.scm -O2 -d1 -s
    34         -extend easyffi)
    45
    56(install-extension
    67 'z3
    7  '("z3.so" "z3.html")
     8 '("z3.so" "z3.import.so" "z3.html")
    89 '((exports "z3.exports")
    910   (version 1.36)
    1011   (documentation "z3.html")))
  • z3/z3lib.h

     
    2424typedef int32_t __s32;
    2525#endif
    2626
    27 #ifdef _WIN32
     27#if defined (_WIN32) || defined (__OpenBSD__)
    2828# define EMSGSIZE    40
    2929# define EOVERFLOW   84
    3030# define EBADMSG     94
  • z3/z3flib.c

     
    3535    return -EINVAL;
    3636  }
    3737  if (filedescr < 0) {
    38     return -ENOENT;
     38    return -ENODATA;
    3939  }
    4040  if (level <= 0) {
    4141    level = 6;
     
    196196    return -EINVAL;
    197197  }
    198198  if (filedescr < 0) {
    199     return -ENOENT;
     199    return -ENODATA;
    200200  }
    201201  if (z3d_decode_init(0, 0, &zh->z3dd, sizeof(zh->z3dd)) == NULL) {
    202202    return -EFAULT;
  • z3/z3.scm

     
    11;;;; z3.scm
    2 
    3 (use posix)
    4 
    5 (declare
    6   (fixnum)
    7   (export z3:decode-init z3:decode
     2(module z3
     3        (z3:decode-init z3:decode
    84          z3:encode-init z3:encode
    95          z3:handle?
    106          z3:open-compressed-input-file z3:open-compressed-output-file
    117          z3:file-handle? z3:file-handle-fileno
    128          z3:encode-buffer z3:decode-buffer
    139          z3:encode-file z3:write-encoded
    14           z3:decode-file z3:read-decoded) )
     10          z3:decode-file z3:read-decoded)
     11(import scheme)
     12(import chicken)
     13(import (except foreign foreign-declare))
     14(use data-structures ports posix easyffi)
    1515
     16(declare
     17  (fixnum)
     18  )
     19
    1620#>
    1721#include <unistd.h>
    1822#include "z3blib.c"
     
    342346                 (##core#inline "free_dbuffer" ptr)
    343347                 buf)
    344348               (error 'z3:decode-buffer "out of memory - can not allocate decompression buffer")) )
    345           (else (z3:error 'z3:decode-buffer err "can not decode data") ) ) ) )
     349          (else (z3:error 'z3:decode-buffer err "can not decode data") ) ) ) ) )