Changeset 14379


Ignore:
Timestamp:
Oct 28, 2010, 9:46:51 PM (9 years ago)
Author:
rme
Message:

Remove some 68K-specific code (long commented-out).

If we re-port to the 68K, make-hash-table now takes a :weak keyword
argument anyway.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lib/hash.lisp

    r13067 r14379  
    313313        (unlock-rwlock lock)))))
    314314
    315 
    316 
    317              
    318 
    319 #+not-yet
    320 (progn
    321 ;;;;;;;;;;;;;
    322 ;;
    323 ;; Replacement for population
    324 ;;
    325 (def-accessors (weak-table) %svref
    326   nil                                   ; 'weak-table
    327   weak-table.vector                     ; a $v_nhash vector
    328   weak-table.index                      ; index for next entry
    329   weak-table.grow-threshold             ; number of entries left in vector
    330   )
    331 
    332 (defun make-weak-table (&optional (size 20))
    333   (%istruct 'weak-table
    334             (%cons-nhash-vector
    335              size (+ (ash 1 $nhash_weak_bit)))
    336             0
    337             size))
    338 
    339 (defun weak-table-p (weak-table)
    340   (istruct-typep weak-table 'weak-table))
    341 
    342 (setf (type-predicate 'weak-table) 'weak-table-p)
    343 
    344 (defun weak-table-count (weak-table)
    345   (setq weak-table (require-type weak-table 'weak-table))
    346   (- (weak-table.index weak-table)
    347      (nhash.vector.weak-deletions-count (weak-table.vector weak-table))))
    348 
    349 (defun weak-table-push (key weak-table &optional value)
    350   (setq weak-table (require-type weak-table 'weak-table))
    351   (let ((thresh (weak-table.grow-threshold weak-table))
    352         (vector (weak-table.vector weak-table))
    353         (index (weak-table.index weak-table)))
    354     (declare (fixnum thresh index))
    355     (if (> thresh 0)
    356       (progn
    357         (lap-inline (index)
    358           (:variable vector key value)
    359           (move.l (varg vector) atemp0)
    360           (lea (atemp0 arg_z.l $nhash_data) atemp0)
    361           (move.l (varg key) atemp0@+)
    362           (move.l (varg value) @atemp0))
    363         (setf (weak-table.index weak-table) (the fixnum (1+ index))
    364               (weak-table.grow-threshold weak-table) (the fixnum (1- thresh)))
    365         value)
    366       (let ((deletions (nhash.vector.weak-deletions-count vector)))
    367         (declare (fixnum deletions))
    368         (if (> deletions 0)
    369           ; GC deleted some entries, we can compact the table
    370           (progn
    371             (lap-inline (index)
    372               (:variable vector)
    373               (getint arg_z)            ; length
    374               (move.l (varg vector) atemp0)
    375               (lea (atemp0 $nhash_data) atemp0)
    376               (move.l atemp0 atemp1)
    377               (move.l ($ $undefined) da)
    378               ; Find the first deleted entry
    379               (dbfloop.l arg_z
    380                 (if# (ne (cmp.l @atemp0 da))
    381                   (add.l ($ 1) arg_z)
    382                   (bra @move))
    383                 (add.w ($ 8) atemp0))
    384               ; copy the rest of the table up
    385               @move
    386               (dbfloop.l arg_z
    387                 (move.l atemp0@+ db)
    388                 (if# (eq (cmp.l db da))
    389                   (add.w ($ 4) atemp0)
    390                  else#
    391                   (move.l db atemp1@+)
    392                   (move.l atemp0@+ atemp1@+)))
    393               ; Write over the newly emptied part of the table
    394               (while# (ne (cmp.l atemp0 atemp1))
    395                 (move.l da @atemp1)
    396                 (add.l ($ 8) atemp1)))
    397             (setf (nhash.vector.weak-deletions-count vector) 0
    398                   (weak-table.index weak-table) (the fixnum (- index deletions))
    399                   (weak-table.grow-threshold weak-table) (the fixnum (+ thresh deletions)))
    400             (weak-table-push key weak-table value))
    401           ; table is full.  Grow it by a factor of 1.5
    402           (let* ((new-size (+ index (the fixnum (ash (the fixnum (1+ index)) -1))))
    403                  (new-vector (%cons-nhash-vector new-size (ash 1 $nhash_weak_bit))))
    404             (declare (fixnum new-size))
    405             (lap-inline (index)
    406               (:variable vector new-vector count)
    407               (move.l (varg vector) atemp0)
    408               (move.l (varg new-vector) atemp1)
    409               (lea (atemp0 $nhash_data) atemp0)
    410               (lea (atemp1 $nhash_data) atemp1)
    411               (getint arg_z)            ; table length
    412               (dbfloop.l arg_z
    413                 (move.l atemp0@+ atemp1@+)
    414                 (move.l atemp0@+ atemp1@+)))
    415             (setf (weak-table.vector weak-table) new-vector
    416                   (weak-table.grow-threshold weak-table) (the fixnum (- new-size index)))
    417             ; It's possible that GC deleted some entries while consing the new vector
    418             (setf (nhash.vector.weak-deletions-count new-vector)
    419                   (nhash.vector.weak-deletions-count vector))
    420             (weak-table-push key weak-table value)))))))
    421 
    422 ; function gets two args: key & value
    423 (defun map-weak-table (function weak-table)
    424   (setq weak-table (require-type weak-table 'weak-table))
    425   (let* ((vector (weak-table.vector weak-table))
    426          (index (weak-table.index weak-table))
    427          (flags (nhash.vector.flags vector)))
    428     (unwind-protect
    429       (progn
    430         (setf (nhash.vector.flags vector) 0)    ; disable deletion by GC
    431         (lap-inline ()
    432           (:variable function vector index)
    433           (while# (gt (move.l (varg index) da))
    434             (sub.l '1 da)
    435             (move.l da (varg index))
    436             (move.l (varg vector) atemp0)
    437             (move.l (atemp0 da.l $nhash_data) arg_y)
    438             (if# (ne (cmp.w ($ $undefined) arg_y))
    439               (move.l (atemp0 da.l (+ $nhash_data 4)) arg_z)
    440               (set_nargs 2)
    441               (move.l (varg function) atemp0)
    442               (jsr_subprim $sp-funcall))))
    443         nil)
    444       (setf (nhash.vector.flags vector) flags))))
    445 
    446 ; function gets one arg, the key
    447 (defun map-weak-table-keys (function weak-table)
    448   (flet ((f (key value)
    449            (declare (ignore value))
    450            (funcall function key)))
    451     (declare (dynamic-extent #'f))
    452     (map-weak-table #'f weak-table)))
    453    
    454 ) ; #+not-yet
    455 
    456315; end
Note: See TracChangeset for help on using the changeset viewer.