Changeset 15242 in project


Ignore:
Timestamp:
07/18/09 14:10:36 (10 years ago)
Author:
Alaric Snell-Pym
Message:

C-Keen's patches

Location:
release/4/ugarit/trunk
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • release/4/ugarit/trunk/posixextras.scm

    r15241 r15242  
     1(import foreign)
    12
    23;; Things that the posix unit forgot
     
    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)
     
    8084      (posix-error #:file-error 'change-file-times "cannot change file times" fn atime mtime)))
    8185   
    82    
     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
  • release/4/ugarit/trunk/ugarit-core.scm

    r15241 r15242  
    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?
     
    6144   tag-snapshot!
    6245   fold-history
    63    fold-archive-node))
     46   fold-archive-node)
     47
     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
    6473
    6574;;
     
    99108   encrypt ; the encryptor, u8vector -> u8vector
    100109   decrypt) ; the decryptor, inverse of the above
     110
     111(include "posixextras.scm")
     112(include "backend-fs.scm")
     113(include "backend-cache.scm")
     114(include "backend-devtools.scm")
    101115
    102116(define (prepend-type-byte b v)
     
    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
     
    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)))))))
     
    10211035                        (else
    10221036                           (kons #f dirent acc)))))
    1023             knil))))
    1024 
     1037            knil)))) )
     1038
  • release/4/ugarit/trunk/ugarit.meta

    r15241 r15242  
    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")
    99 (synopsis "A backup/archival system based on content-addressed storage"))
  • release/4/ugarit/trunk/ugarit.scm

    r15241 r15242  
    33(use srfi-37)
    44(use miscmacros)
     5(use matchable)
    56(use regex)
    67
     
    132133 
    133134         (match result
    134             (()
     135            (("")
    135136               (explore-archive archive directory-key path quit-continuation))
    136137            (("help")
  • release/4/ugarit/trunk/ugarit.setup

    r15241 r15242  
    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")
Note: See TracChangeset for help on using the changeset viewer.