Changeset 36735 in project


Ignore:
Timestamp:
10/28/18 19:38:17 (2 weeks ago)
Author:
kon
Message:

reflow, add non-mmap chunked reading

Location:
release/5/message-digest-utils/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/5/message-digest-utils/trunk/message-digest-chunk.scm

    r36078 r36735  
    3939(: fxzero? (fixnum --> boolean))
    4040;
    41 (define (fxzero? n)
    42   (fx= 0 n) )
     41(define (fxzero? n) (fx= 0 n))
    4342
    4443(: fxpositive? (fixnum --> boolean))
    4544;
    46 (define (fxpositive? n)
    47   (fx< 0 n) )
     45(define (fxpositive? n) (fx< 0 n))
    4846
    4947;;
    5048
    5149(include "message-digest-types")
     50
     51;;
     52
     53(define-constant DEFAULT-CHUNK-SIZE 1024)
    5254
    5355;;; Update Phase Helpers
     
    7274
    7375;(define-type message-digest-raw-chunk (struct message-digest-raw-chunk))
    74 ;assignment of value of type `(procedure message-digest-chunk#make-message-digest-raw-chunk (* * *) (struct message-digest-chunk#message-digest-raw-chunk))' to toplevel variable `message-digest-chunk#make-message-digest-raw-chunk' does not match declared type `(procedure message-digest-chunk#make-message-digest-raw-chunk (* fixnum fixnum) (struct message-digest-raw-chunk))'
     76;assignment of value of type `(procedure
     77;message-digest-chunk#make-message-digest-raw-chunk (* * *) (struct
     78;message-digest-chunk#message-digest-raw-chunk))' to toplevel variable
     79;`message-digest-chunk#make-message-digest-raw-chunk' does not match declared
     80;type `(procedure message-digest-chunk#make-message-digest-raw-chunk (* fixnum
     81;fixnum) (struct message-digest-raw-chunk))'
    7582(: make-message-digest-raw-chunk (* fixnum fixnum --> message-digest-raw-chunk))
    7683(: message-digest-raw-chunk? (* -> boolean : message-digest-raw-chunk))
     
    9299    (siz (file-size fd))
    93100    (chk (message-digest-chunk-size)) )
     101    ;anything to read?
    94102    (if (fxzero? siz)
    95103      (lambda () #f)
     104      ;returns chunk, after reading, or #f
     105      ;errors when lolevel problem
    96106      (let-values (
    97         ((buffer cleanup updater) (mapped-buffer 'default-chunk-fileno-read-maker fd siz chk)) )
     107        ;buffer used as flag
     108        ((buffer cleanup updater)
     109          (mapped-buffer 'default-chunk-fileno-read-maker fd siz chk)) )
    98110        (let (
    99111          (chunk (and buffer (make-message-digest-raw-chunk buffer chk 0))) )
     112          ;no updater means 1) chunk already filled, & 2) last read done
    100113          (if (not updater)
    101             ;returns ptr to file-chunk until #floor
    102114            (lambda ()
    103               ;memory-map means only 1 file-chunk
    104115              (if buffer
    105116                (begin
     
    110121                  (cleanup)
    111122                  #f ) ) )
    112             ;
    113123            (lambda ()
    114124              (and
     
    155165    (define (mapped-buffer loc fd siz chk)
    156166      (let* (
    157         (ptr (allocate siz))
    158         (finalize (cut free ptr)) )
    159         (unless (read-into-buffer fd ptr siz)
    160           (finalize)
    161           (error loc "cannot read file") )
    162         (values ptr finalize #f) ) ) ) )
    163 
    164 #; ;
    165 (cond-expand
    166 
    167   ((and windows (not cygwin))
    168 
    169     ;tested w/ macosx (replaced mmap version)
    170 
    171     (import (only (chicken memory) allocate free))
    172 
    173     (: read-into-buffer (fixnum pointer fixnum -> boolean))
    174     ;
    175     (define read-into-buffer
    176       (foreign-lambda* bool ((int fd) (c-pointer buffer) (integer size))
    177         "C_return( read( fd, buffer, size ) == size );") )
    178 
    179     (: mapped-buffer (symbol fixnum fixnum -> pointer procedure))
    180     ;
    181     (define (mapped-buffer loc fd siz)
    182       (let* (
    183         (ptr (allocate siz))
    184         (finalize (cut free ptr)) )
    185         (unless (read-into-buffer fd ptr siz)
    186           (finalize)
    187           (error loc "cannot read file") )
    188         (values ptr finalize) ) ) )
    189 
    190   (else ;assume unix
    191 
    192     (import
    193       (only memory-mapped-files
    194         map-file-to-memory unmap-file-from-memory
    195         memory-mapped-file-pointer map/shared prot/read))
    196 
    197     (: mapped-buffer (symbol fixnum fixnum -> pointer procedure))
    198     ;
    199     (define (mapped-buffer loc fd siz)
    200       (let* (
    201         (mmap (map-file-to-memory #f siz prot/read map/shared fd))
    202         (ptr (memory-mapped-file-pointer mmap))
    203         (finalize (cut unmap-file-from-memory mmap)) )
    204         (values ptr finalize) ) ) ) )
    205 
    206 ;;
    207 
    208 (define-constant DEFAULT-CHUNK-SIZE 1024)
     167        (ptr
     168          (allocate chk) )
     169        (finalize
     170          (cut free ptr) )
     171        ;FIXME assumes offset is 0
     172        ;FIXME pass fd in message-digest-raw-chunk?
     173        (updater
     174          (let ((rem siz))
     175            (lambda (chunk)
     176              ;
     177              (define (reader amt)
     178                (let ((ptr (message-digest-raw-chunk-object chunk)))
     179                  (unless (read-into-buffer fd ptr amt)
     180                    (finalize)
     181                    (message-digest-raw-chunk-size-set! chunk 0)
     182                    (error loc "problem reading fileno" fd) ) )
     183                (message-digest-raw-chunk-size-set! chunk amt)
     184                (set! rem (- rem amt))
     185                #t )
     186              ;
     187              (cond
     188                ((zero? rem)
     189                  #f )
     190                ((< (message-digest-raw-chunk-size chunk) rem)
     191                  (reader (message-digest-raw-chunk-size chunk)) )
     192                (else
     193                  (reader rem) ) ) ) ) ) )
     194        (values ptr finalize updater) ) ) ) )
    209195
    210196;;; Message Digest "chunk"
  • release/5/message-digest-utils/trunk/message-digest-update-item.scm

    r36734 r36735  
    5858;
    5959(define (get-port-chunk-reader port)
    60         ((message-digest-chunk-port-read-maker) port) )
     60  ((message-digest-chunk-port-read-maker) port) )
    6161
    6262(: get-fileno-chunk-reader (fixnum -> procedure))
    6363;
    6464(define (get-fileno-chunk-reader fd)
    65         ((message-digest-chunk-fileno-read-maker) fd) )
     65  ((message-digest-chunk-fileno-read-maker) fd) )
    6666
    6767(: get-update (message-digest --> source-update))
     
    9797    (raw-updt (get-raw-update md))
    9898    (ctx (message-digest-context md)) )
    99     ;note the 'src' object (return of proc) may or may not be unique
     99    ;note the 'src' object (return of proc) may or may not be unique!
    100100    (let loop ()
    101101      (and-let* ((dat (proc)))
     
    124124      (let (
    125125        (blb (blob/slice src start end)))
    126           (src-updt ctx blb (blob-size blb))) )
     126        (src-updt ctx blb (blob-size blb))) )
    127127    ((string? src)
    128128      (let (
    129129        (str (string/slice src start end)))
    130           (src-updt ctx str (string-length str))) )
     130        (src-updt ctx str (string-length str))) )
    131131    ((message-digest-raw-chunk? src)
    132132      (let* (
     
    152152    (chunk-convert obj)) )
    153153
     154;;
     155
     156(: *message-digest-update-file/fileno (symbol message-digest pathname -> void))
     157;
     158(define (*message-digest-update-file/fileno loc md flnm)
     159  (let ((fd #f))
     160    (dynamic-wind
     161      (lambda () (set! fd (file-open flnm open/rdonly)) )
     162      (lambda () (do-procedure-update loc md (get-fileno-chunk-reader fd) 0 #f) )
     163      (lambda () (file-close fd) ) ) )
     164  #; ;porta-potty
     165  (let (
     166    (fd (file-open flnm open/rdonly)) )
     167    (handle-exceptions exn
     168        (begin
     169          (file-close fd)
     170          (abort exn) )
     171      (do-procedure-update loc md (get-fileno-chunk-reader fd) 0 #f) )
     172    (file-close fd) ) )
     173
     174(: *message-digest-update-file/port (symbol message-digest pathname -> void))
     175;
     176(define (*message-digest-update-file/port loc md flnm)
     177  (let ((in #f))
     178    (dynamic-wind
     179      (lambda () (set! in (open-input-file flnm)) )
     180      (lambda () (do-port-update loc md in 0 #f) )
     181      (lambda () (close-input-port in) ) ) )
     182  #; ;porta-potty
     183  (let (
     184    (in (open-input-file flnm)) )
     185    (handle-exceptions exn
     186        (begin
     187          (close-input-port in)
     188          (abort exn) )
     189      (do-port-update loc md in 0 #f) )
     190    (close-input-port in) ) )
     191
    154192;;; Update Operation
    155193
     
    207245    (*message-digest-update-file/port 'message-digest-update-file md flnm) ) )
    208246
    209 ;;
    210 
    211 (: *message-digest-update-file/fileno (symbol message-digest pathname -> void))
    212 ;
    213 (define (*message-digest-update-file/fileno loc md flnm)
    214   (let ((fd #f))
    215         (dynamic-wind
    216                 (lambda () (set! fd (file-open flnm open/rdonly)) )
    217                 (lambda () (do-procedure-update loc md (get-fileno-chunk-reader fd) 0 #f) )
    218         (lambda () (file-close fd) ) ) )
    219   #; ;porta-potty
    220   (let (
    221     (fd (file-open flnm open/rdonly)) )
    222     (handle-exceptions exn
    223         (begin
    224           (file-close fd)
    225           (abort exn) )
    226       (do-procedure-update loc md (get-fileno-chunk-reader fd) 0 #f) )
    227     (file-close fd) ) )
    228 
    229 (: *message-digest-update-file/port (symbol message-digest pathname -> void))
    230 ;
    231 (define (*message-digest-update-file/port loc md flnm)
    232   (let ((in #f))
    233         (dynamic-wind
    234                 (lambda () (set! in (open-input-file flnm)) )
    235                 (lambda () (do-port-update loc md in 0 #f) )
    236         (lambda () (close-input-port in) ) ) )
    237   #; ;porta-potty
    238   (let (
    239     (in (open-input-file flnm)) )
    240     (handle-exceptions exn
    241         (begin
    242           (close-input-port in)
    243           (abort exn) )
    244       (do-port-update loc md in 0 #f) )
    245     (close-input-port in) ) )
    246 
    247247) ;module message-digest-update-item
  • release/5/message-digest-utils/trunk/message-digest-utils.egg

    r36150 r36735  
    33
    44((synopsis "Message Digest Support")
    5  (version "4.1.1")
     5 (version "4.1.2")
    66 (category crypt)
    77 (author "[[kon lovett]]")
Note: See TracChangeset for help on using the changeset viewer.