Changeset 13779 in project


Ignore:
Timestamp:
03/16/09 03:18:22 (11 years ago)
Author:
Kon Lovett
Message:

Fix for intemperate use of ##sys#hash-table routines. Reported by Jim Ursetto.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • chicken/branches/chicken-3/lolevel.scm

    r13320 r13779  
    2828(declare
    2929  (unit lolevel)
     30  (uses srfi-69)
    3031  (usual-integrations)
    3132  (disable-warning var redef)
     
    5960     ##sys#error ##sys#signal-hook
    6061     ##sys#error-not-a-proper-list
    61      ##sys#hash-table-ref ##sys#hash-table-set!
     62     make-hash-table hash-table-ref/default hash-table-set!
    6263     ##sys#make-pointer ##sys#make-tagged-pointer ##sys#make-locative ##sys#locative?
    6364     ##sys#become!
     
    646647  (let ([allocator
    647648         (if (pair? allocator) (car allocator) (foreign-lambda c-pointer "C_malloc" int) ) ]
    648         [tab (##sys#make-vector evict-table-size '())] )
     649        [tab (make-hash-table eq?)] )
    649650    (##sys#check-closure allocator 'object-evict)
    650651    (let evict ([x x])
    651652      (cond [(not (##core#inline "C_blockp" x)) x ]
    652             [(##sys#hash-table-ref tab x) ]
     653            [(hash-table-ref/default tab x #f) ]
    653654            [else
    654655             (let* ([n (##sys#size x)]
     
    656657                    [y (##core#inline "C_evict_block" x (allocator (fx+ bytes (##core#inline "C_bytes" 1))))] )
    657658               (when (symbol? x) (##sys#setislot y 0 (void)))
    658                (##sys#hash-table-set! tab x y)
     659               (hash-table-set! tab x y)
    659660               (unless (##core#inline "C_byteblockp" x)
    660661                 (do ([i (if (or (##core#inline "C_specialp" x) (symbol? x)) 1 0) (fx+ i 1)])
     
    671672                       limit)) ]
    672673         [ptr2 (##sys#address->pointer (##sys#pointer->address ptr))]
    673          [tab (##sys#make-vector evict-table-size '())]
     674         [tab (make-hash-table eq?)]
    674675         [x2
    675676          (let evict ([x x])
    676677            (cond [(not (##core#inline "C_blockp" x)) x ]
    677                   [(##sys#hash-table-ref tab x) ]
     678                  [(hash-table-ref/default tab x #f) ]
    678679                  [else
    679680                   (let* ([n (##sys#size x)]
     
    695696                     (when (symbol? x) (##sys#setislot y 0 (void)))
    696697                     (##sys#set-pointer-address! ptr2 (+ (##sys#pointer->address ptr2) bytes))
    697                      (##sys#hash-table-set! tab x y)
     698                     (hash-table-set! tab x y)
    698699                     (unless (##core#inline "C_byteblockp" x)
    699700                       (do ([i (if (or (##core#inline "C_specialp" x) (symbol? x)) 1 0) (fx+ i 1)] )
     
    722723
    723724(define (object-size x)
    724   (let ([tab (##sys#make-vector evict-table-size '())])
     725  (let ([tab (make-hash-table eq?)])
    725726    (let evict ([x x])
    726727      (cond [(not (##core#inline "C_blockp" x)) 0 ]
    727             [(##sys#hash-table-ref tab x) 0 ]
     728            [(hash-table-ref/default tab x #f) 0 ]
    728729            [else
    729730             (let* ([n (##sys#size x)]
     
    731732                     (fx+ (if (##core#inline "C_byteblockp" x) (align-to-word n) (##core#inline "C_bytes" n))
    732733                          (##core#inline "C_bytes" 1) ) ] )
    733                (##sys#hash-table-set! tab x #t)
     734               (hash-table-set! tab x #t)
    734735               (unless (##core#inline "C_byteblockp" x)
    735736                 (do ([i (if (or (##core#inline "C_specialp" x) (symbol? x)) 1 0) (fx+ i 1)])
     
    739740
    740741(define (object-unevict x #!optional full)
    741   (let ([tab (##sys#make-vector evict-table-size '())])
     742  (let ([tab (make-hash-table eq?)])
    742743    (let copy ([x x])
    743744    (cond [(not (##core#inline "C_blockp" x)) x ]
    744745          [(not (##core#inline "C_permanentp" x)) x ]
    745           [(##sys#hash-table-ref tab x) ]
     746          [(hash-table-ref/default tab x #f) ]
    746747          [(##core#inline "C_byteblockp" x)
    747748           (if full
    748749               (let ([y (##core#inline "C_copy_block" x (##sys#make-string (##sys#size x)))])
    749                  (##sys#hash-table-set! tab x y)
     750                 (hash-table-set! tab x y)
    750751                 y)
    751752               x) ]
    752753          [(symbol? x)
    753754           (let ([y (##sys#intern-symbol (##sys#slot x 1))])
    754              (##sys#hash-table-set! tab x y)
     755             (hash-table-set! tab x y)
    755756             y) ]
    756757          [else
    757758           (let* ([words (##sys#size x)]
    758759                  [y (##core#inline "C_copy_block" x (##sys#make-vector words))] )
    759              (##sys#hash-table-set! tab x y)
     760             (hash-table-set! tab x y)
    760761             (do ([i (if (##core#inline "C_specialp" x) 1 0) (fx+ i 1)])
    761762                 ((fx>= i words))
Note: See TracChangeset for help on using the changeset viewer.