Ignore:
Timestamp:
08/26/17 22:31:52 (3 years ago)
Author:
Kon Lovett
Message:

add raw-update to prim, use raw-update for mmapped/in-mem file md

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/message-digest/trunk/message-digest-primitive.scm

    r34300 r34373  
    1919  message-digest-primitive-init
    2020  message-digest-primitive-update
    21   message-digest-primitive-final)
     21  message-digest-primitive-final
     22  message-digest-primitive-raw-update)
    2223
    2324(import scheme)
     
    4344  (and (fixnum? obj) (positive? obj)) )
    4445
     46(define (primitive-ctx-info? obj)
     47  (or (procedure? obj) (positive-fixnum? obj)) )
     48
     49(define (primitive-name? obj)
     50  (or (symbol? obj) (string? obj)) )
     51
    4552;;; Message Digest Algorithm API
    4653
    4754;;
    4855
    49 (define (check-message-digest-arguments loc ctx-info digest-len init update final block-len name)
    50   (unless (or (procedure? ctx-info) (positive-fixnum? ctx-info))
     56(define (check-message-digest-arguments loc ctx-info digest-len init update final block-len name raw-update)
     57  (unless (primitive-ctx-info? ctx-info)
    5158    (error-argument-type loc ctx-info "positive-fixnum or procedure" 'context-info) )
    5259  (check-positive-fixnum loc digest-len 'digest-length)
     
    5562  (check-procedure loc final 'digest-finalizer)
    5663  (check-positive-fixnum loc block-len 'block-length)
    57   (unless (or (symbol? name) (string? name))
    58     (error-argument-type loc name "symbol or string" 'name) ) )
     64  (unless (primitive-name? name)
     65    (error-argument-type loc name "symbol or string" 'name) )
     66  (when raw-update
     67    (check-procedure loc raw-update 'digest-raw-updater) ) )
    5968
    6069;;
    6170
    6271(define-record-type message-digest-primitive
    63   (*make-message-digest-primitive ctxi digest-len init update final block-len name)
     72  (*make-message-digest-primitive ctxi digest-len init update final block-len name raw-update)
    6473  message-digest-primitive?
    6574  (ctxi message-digest-primitive-context-info)
     
    6978  (final message-digest-primitive-final)
    7079  (block-len message-digest-primitive-block-length)
    71   (name message-digest-primitive-name) )
     80  (name message-digest-primitive-name)
     81  (raw-update message-digest-primitive-raw-update) )
    7282
    7383(define-check+error-type message-digest-primitive)
     
    7888                  (values (car rest) (cdr rest))
    7989                  (values 4 rest) ) ) )
    80     (let ((name (if (null? rest) (gensym "mdp") (car rest) ) ) )
    81       (check-message-digest-arguments 'make-message-digest-primitive
    82         ctx-info digest-len init update final block-len name)
    83       (*make-message-digest-primitive
    84         ctx-info
    85         digest-len
    86         init update final
    87         block-len
    88         name) ) ) )
     90    (let-values (((name rest)
     91                  (if (and (not (null? rest)) (primitive-name? (car rest)))
     92                    (values (car rest) (cdr rest))
     93                    (values (gensym 'mdp) rest) ) ) )
     94      (let-values (((raw-update rest)
     95                    (if (and (not (null? rest)) (procedure? (car rest)))
     96                      (values (car rest) (cdr rest))
     97                      (values #f rest) ) ) )
     98        (check-message-digest-arguments 'make-message-digest-primitive
     99          ctx-info digest-len init update final block-len name raw-update)
     100        (*make-message-digest-primitive
     101          ctx-info
     102          digest-len
     103          init update final
     104          block-len
     105          name
     106          raw-update) ) ) ) )
     107
     108;;
     109
     110(define do-raw-update
     111
    89112
    90113) ;module message-digest-primitive
Note: See TracChangeset for help on using the changeset viewer.