/[cmucl]/src/code/extensions.lisp
ViewVC logotype

Diff of /src/code/extensions.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.14 by ram, Thu Dec 31 13:36:23 1992 UTC revision 1.15 by ram, Fri Feb 26 08:25:25 1993 UTC
# Line 396  Line 396 
396    
397  ;;; DEFINE-HASH-CACHE  --  Public  ;;; DEFINE-HASH-CACHE  --  Public
398  ;;;  ;;;
399    ;;;    :INIT-FORM passed as COLD-LOAD-INIT in type system definitions so that
400    ;;; caches can be created before top-level forms run.
401    ;;;
402  (defmacro define-hash-cache (name args &key hash-function hash-bits default  (defmacro define-hash-cache (name args &key hash-function hash-bits default
403                                      (init-form 'progn)
404                                    (values 1))                                    (values 1))
405    "DEFINE-HASH-CACHE Name ({(Arg-Name Test-Function)}*) {Key Value}*    "DEFINE-HASH-CACHE Name ({(Arg-Name Test-Function)}*) {Key Value}*
406    Define a hash cache that associates some number of argument values to a    Define a hash cache that associates some number of argument values to a
# Line 433  Line 437 
437        between 0 and (1- (expt 2 <hash-bits>)).        between 0 and (1- (expt 2 <hash-bits>)).
438    
439    :VALUES <n>    :VALUES <n>
440        The number of values cached."        The number of values cached.
441    
442       :INIT-FORM <name>
443          The DEFVAR for creating the cache is enclosed in a form with the
444          specified name.  Default PROGN."
445    
446    (let* ((var-name (symbolicate "*" name "-CACHE-VECTOR*"))    (let* ((var-name (symbolicate "*" name "-CACHE-VECTOR*"))
447           (nargs (length args))           (nargs (length args))
# Line 533  Line 541 
541          (forms `(,fun-name)))          (forms `(,fun-name)))
542    
543        `(progn        `(progn
544           (defvar ,var-name (make-array ,total-size))           (defvar ,var-name)
545             (,init-form
546              (unless (boundp ',var-name)
547                (setq ,var-name (make-array ,total-size))))
548           (proclaim '(type (simple-vector ,total-size) ,var-name))           (proclaim '(type (simple-vector ,total-size) ,var-name))
549           (proclaim '(inline ,@(inlines)))           (proclaim '(inline ,@(inlines)))
550           ,@(forms)           ,@(forms)

Legend:
Removed from v.1.14  
changed lines
  Added in v.1.15

  ViewVC Help
Powered by ViewVC 1.1.5