Menu
▾
▴
clisp-cvs digest, Vol 1 #559 - 9 msgs
|
From: <cli...@li...> - 2004-06-11 12:08:14
|
Send clisp-cvs mailing list submissions to cli...@li... To subscribe or unsubscribe via the World Wide Web, visit https://lists.sourceforge.net/lists/listinfo/clisp-cvs or, via email, send a message with subject or body 'help' to cli...@li... You can reach the person managing the list at cli...@li... When replying, please edit your Subject line so it is more specific than "Re: Contents of clisp-cvs digest..." CLISP CVS commits for today Today's Topics: 1. clisp/src io.d,1.234,1.235 ChangeLog,1.3163,1.3164 (Bruno Haible) 2. clisp/src lispbibl.d,1.519,1.520 hashtabl.d,1.95,1.96 clos-class2.lisp,1.31,1.32 clos-class5.lisp,1.19,1.20 clos-genfun2.lisp,1.4,1.5 ChangeLog,1.3164,1.3165 (Bruno Haible) 3. clisp/src hashtabl.d,1.96,1.97 loop.lisp,1.26,1.27 clos-class5.lisp,1.20,1.21 clos-genfun2.lisp,1.5,1.6 ChangeLog,1.3165,1.3166 (Bruno Haible) 4. clisp/src sequence.d,1.78,1.79 compiler.lisp,1.196,1.197 room.lisp,1.4,1.5 ChangeLog,1.3166,1.3167 (Bruno Haible) 5. clisp/src clos-class2.lisp,1.32,1.33 ChangeLog,1.3167,1.3168 (Bruno Haible) 6. clisp/src trace.lisp,1.25,1.26 ChangeLog,1.3168,1.3169 (Bruno Haible) 7. clisp/doc impbody.xml,1.245,1.246 (Bruno Haible) 8. clisp/src NEWS,1.151,1.152 (Bruno Haible) 9. clisp/src clos.lisp,1.82,1.83 ChangeLog,1.3169,1.3170 (Bruno Haible) --__--__-- Message: 1 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src io.d,1.234,1.235 ChangeLog,1.3163,1.3164 Date: Fri, 11 Jun 2004 10:34:14 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28951/src Modified Files: io.d ChangeLog Log Message: Use FASTHASH-EQ as test for hash tables indexed by characters. Index: io.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/io.d,v retrieving revision 1.234 retrieving revision 1.235 diff -u -d -r1.234 -r1.235 --- io.d 9 Jun 2004 11:10:26 -0000 1.234 +++ io.d 11 Jun 2004 10:34:08 -0000 1.235 @@ -36,16 +36,18 @@ # A simple-vector of small_char_code_limit+1 elements, the last entry being # a hash table for the non-base characters. local object allocate_perchar_table (void) { - # Allocate the hash table. - # (MAKE-HASH-TABLE :KEY-TYPE 'CHARACTER - # :VALUE-TYPE '(OR FUNCTION SIMPLE-VECTOR) - # :TEST 'EQ) - pushSTACK(S(Ktest)); pushSTACK(S(eq)); funcall(L(make_hash_table),2); - pushSTACK(value1); - # Allocate the simple-vector. - var object table = allocate_vector(small_char_code_limit+1); - TheSvector(table)->data[small_char_code_limit] = popSTACK(); - return table; + # Allocate the hash table. + # (MAKE-HASH-TABLE :KEY-TYPE 'CHARACTER + # :VALUE-TYPE '(OR FUNCTION SIMPLE-VECTOR) + # :TEST 'FASTHASH-EQ :WARN-IF-NEEDS-REHASH-AFTER-GC T) + pushSTACK(S(Ktest)); pushSTACK(S(fasthash_eq)); + pushSTACK(S(Kwarn_if_needs_rehash_after_gc)); pushSTACK(T); + funcall(L(make_hash_table),4); + pushSTACK(value1); + # Allocate the simple-vector. + var object table = allocate_vector(small_char_code_limit+1); + TheSvector(table)->data[small_char_code_limit] = popSTACK(); + return table; } local object perchar_table_get (object table, chart c) { if (as_cint(c) < small_char_code_limit) { @@ -69,8 +71,10 @@ # Allocate a new hash table. # (MAKE-HASH-TABLE :KEY-TYPE 'CHARACTER # :VALUE-TYPE '(OR FUNCTION SIMPLE-VECTOR) - # :TEST 'EQ) - pushSTACK(S(Ktest)); pushSTACK(S(eq)); funcall(L(make_hash_table),2); + # :TEST 'FASTHASH-EQ :WARN-IF-NEEDS-REHASH-AFTER-GC T) + pushSTACK(S(Ktest)); pushSTACK(S(fasthash_eq)); + pushSTACK(S(Kwarn_if_needs_rehash_after_gc)); pushSTACK(T); + funcall(L(make_hash_table),4); pushSTACK(value1); # stack layout: table, newht. map_hashtable(TheSvector(STACK_1)->data[small_char_code_limit], @@ -137,8 +141,10 @@ # Allocate the hash table. # (MAKE-HASH-TABLE :KEY-TYPE 'CHARACTER # :VALUE-TYPE 'FIXNUM - # :TEST 'EQ) - pushSTACK(S(Ktest)); pushSTACK(S(eq)); funcall(L(make_hash_table),2); + # :TEST 'FASTHASH-EQ :WARN-IF-NEEDS-REHASH-AFTER-GC T) + pushSTACK(S(Ktest)); pushSTACK(S(fasthash_eq)); + pushSTACK(S(Kwarn_if_needs_rehash_after_gc)); pushSTACK(T); + funcall(L(make_hash_table),4); pushSTACK(value1); # Allocate the simple-bit-vector. pushSTACK(allocate_bit_vector(Atype_8Bit,small_char_code_limit)); @@ -370,8 +376,10 @@ # Allocate a new hash table. # (MAKE-HASH-TABLE :KEY-TYPE 'CHARACTER # :VALUE-TYPE 'FIXNUM - # :TEST 'EQ) - pushSTACK(S(Ktest)); pushSTACK(S(eq)); funcall(L(make_hash_table),2); + # :TEST 'FASTHASH-EQ :WARN-IF-NEEDS-REHASH-AFTER-GC T) + pushSTACK(S(Ktest)); pushSTACK(S(fasthash_eq)); + pushSTACK(S(Kwarn_if_needs_rehash_after_gc)); pushSTACK(T); + funcall(L(make_hash_table),4); pushSTACK(value1); # stack layout: to-readtable, from-readtable, newht. map_hashtable(Cdr(TheReadtable(STACK_1)->readtable_syntax_table),ch,entry, @@ -417,8 +425,10 @@ # Allocate a new hash table. # (MAKE-HASH-TABLE :KEY-TYPE 'CHARACTER # :VALUE-TYPE '(OR FUNCTION SIMPLE-VECTOR) - # :TEST 'EQ) - pushSTACK(S(Ktest)); pushSTACK(S(eq)); funcall(L(make_hash_table),2); + # :TEST 'FASTHASH-EQ :WARN-IF-NEEDS-REHASH-AFTER-GC T) + pushSTACK(S(Ktest)); pushSTACK(S(fasthash_eq)); + pushSTACK(S(Kwarn_if_needs_rehash_after_gc)); pushSTACK(T); + funcall(L(make_hash_table),4); mtable1 = STACK_0; STACK_0 = value1; # stack layout: mtable2, newht. Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3163 retrieving revision 1.3164 diff -u -d -r1.3163 -r1.3164 --- ChangeLog 9 Jun 2004 13:39:34 -0000 1.3163 +++ ChangeLog 11 Jun 2004 10:34:10 -0000 1.3164 @@ -1,3 +1,10 @@ +2004-05-13 Bruno Haible <br...@cl...> + + Use FASTHASH-EQ as test for hash tables indexed by characters. + * io.d (allocate_perchar_table, copy_perchar_table, + allocate_syntax_table, copy_readtable_contents): Use FASTHASH-EQ as + test for MAKE-HASH-TABLE. + 2004-05-14 Bruno Haible <br...@cl...> New hash-table tests FASTHASH-EQL/EQUAL and STABLEHASH-EQL/EQUAL. --__--__-- Message: 2 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src lispbibl.d,1.519,1.520 hashtabl.d,1.95,1.96 clos-class2.lisp,1.31,1.32 clos-class5.lisp,1.19,1.20 clos-genfun2.lisp,1.4,1.5 ChangeLog,1.3164,1.3165 Date: Fri, 11 Jun 2004 10:39:53 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1294/src Modified Files: lispbibl.d hashtabl.d clos-class2.lisp clos-class5.lisp clos-genfun2.lisp ChangeLog Log Message: Make the hashcode of classes GC-invariant. Index: clos-genfun2.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-genfun2.lisp,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- clos-genfun2.lisp 8 Jun 2004 11:18:23 -0000 1.4 +++ clos-genfun2.lisp 11 Jun 2004 10:39:50 -0000 1.5 @@ -343,7 +343,7 @@ (setq ht-init `(MAKE-HASH-TABLE ; :KEY-TYPE '(CONS ... CLASS ...) :VALUE-TYPE 'FUNCTION - :TEST (FUNCTION ,(if (eql n 1) 'EQ 'EQUAL))) + :TEST (FUNCTION ,(if (eql n 1) 'EXT:STABLEHASH-EQ 'EQUAL))) ht-key-binding `((,tuple-var ,(let ((tuple-fun (hash-tuple-function n))) @@ -381,7 +381,7 @@ ht-init `(MAKE-HASH-TABLE ; :KEY-TYPE '(CONS ... CLASS ...) :VALUE-TYPE 'FUNCTION - :TEST (FUNCTION ,(if (eql n 1) 'EQ 'EQUAL))) + :TEST (FUNCTION ,(if (eql n 1) 'EXT:STABLEHASH-EQ 'EQUAL))) em-expr (if (eql n 1) ; whatever is faster ;; `(GETHASH ,@class-of-exprs ,ht-var) == Index: clos-class5.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-class5.lisp,v retrieving revision 1.19 retrieving revision 1.20 diff -u -d -r1.19 -r1.20 --- clos-class5.lisp 9 Jun 2004 11:10:26 -0000 1.19 +++ clos-class5.lisp 11 Jun 2004 10:39:50 -0000 1.20 @@ -22,7 +22,7 @@ (defparameter *make-instance-table* (make-hash-table :key-type 'class :value-type '(simple-vector 4) - :test #'eq)) + :test 'ext:stablehash-eq :warn-if-needs-rehash-after-gc t)) ;; Hash table, mapping a class to a simple-vector containing ;; - a list of valid keyword arguments, ;; - the effective method of allocate-instance, @@ -31,14 +31,14 @@ (defparameter *reinitialize-instance-table* (make-hash-table :key-type 'class :value-type 'cons - :test #'eq)) + :test 'ext:stablehash-eq :warn-if-needs-rehash-after-gc t)) ;; Hash table, mapping a class to a cons containing ;; - a list of valid keyword arguments, ;; - the effective method of shared-initialize. (defparameter *update-instance-for-redefined-class-table* (make-hash-table :key-type 'class :value-type 'list - :test #'eq)) + :test 'ext:stablehash-eq :warn-if-needs-rehash-after-gc t)) ;; Hash table, mapping a class to ;; - a list of valid keyword arguments. Index: clos-class2.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-class2.lisp,v retrieving revision 1.31 retrieving revision 1.32 diff -u -d -r1.31 -r1.32 --- clos-class2.lisp 9 Jun 2004 11:10:26 -0000 1.31 +++ clos-class2.lisp 11 Jun 2004 10:39:50 -0000 1.32 @@ -26,7 +26,7 @@ ;; Definition of <class> and its subclasses. -(defstruct (class (:predicate nil)) +(defstruct (class (:inherit structure-stablehash) (:predicate nil)) metaclass ; (class-of class) = (class-metaclass class), a class classname ; (class-name class) = (class-classname class), a symbol direct-superclasses ; list of all direct superclasses (or their names, @@ -793,7 +793,7 @@ ;; Stuff all superclasses (from the precedence-list) into a hash-table. (defun std-compute-superclasses (precedence-list) (let ((ht (make-hash-table :key-type 'class :value-type '(eql t) - :test #'eq))) + :test 'ext:stablehash-eq :warn-if-needs-rehash-after-gc t))) (mapc #'(lambda (superclass) (setf (gethash superclass ht) t)) precedence-list) ht)) @@ -1156,7 +1156,8 @@ (setf (ext:weak-list-list direct-subclasses) list) (setf (class-direct-subclasses class) (let ((ht (make-hash-table :key-type 'class :value-type '(eql t) - :test #'eq :weak :key))) + :test 'ext:stablehash-eq :warn-if-needs-rehash-after-gc t + :weak :key))) (dolist (x list) (setf (gethash x ht) t)) ht)))))) (t (setf (gethash subclass direct-subclasses) t))))) @@ -1189,7 +1190,8 @@ ; Use a breadth-first search which removes duplicates. (let ((as-list '()) (as-set (make-hash-table :key-type 'class :value-type '(eql t) - :test #'eq :rehash-size 2s0)) + :test 'ext:stablehash-eq :warn-if-needs-rehash-after-gc t + :rehash-size 2s0)) (pending (list class))) (loop (unless pending (return)) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3164 retrieving revision 1.3165 diff -u -d -r1.3164 -r1.3165 --- ChangeLog 11 Jun 2004 10:34:10 -0000 1.3164 +++ ChangeLog 11 Jun 2004 10:39:50 -0000 1.3165 @@ -1,5 +1,20 @@ 2004-05-13 Bruno Haible <br...@cl...> + Make the hashcode of classes GC-invariant. + * lispbibl.d (Class): New field 'hashcode'. + * hashtabl.d (CLOS::CLASS-GETHASH): Inline hash_lookup and + hashcode1stable. Use the class' hashcode directly. + * clos-class2.lisp (class): Inherit from structure-stablehash. + (std-compute-superclasses, add-direct-subclass, list-all-subclasses): + Use a hash table with test STABLEHASH-EQ. + * clos-class5.lisp (*make-instance-table*, + *reinitialize-instance-table*, + *update-instance-for-redefined-class-table*): Likewise. + * clos-genfun2.lisp (compute-dispatch): When the number of dispatching + arguments is 1, use a hash table with test STABLEHASH-EQ. + +2004-05-13 Bruno Haible <br...@cl...> + Use FASTHASH-EQ as test for hash tables indexed by characters. * io.d (allocate_perchar_table, copy_perchar_table, allocate_syntax_table, copy_readtable_contents): Use FASTHASH-EQ as Index: hashtabl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/hashtabl.d,v retrieving revision 1.95 retrieving revision 1.96 diff -u -d -r1.95 -r1.96 --- hashtabl.d 9 Jun 2004 11:17:20 -0000 1.95 +++ hashtabl.d 11 Jun 2004 10:39:50 -0000 1.96 @@ -2632,14 +2632,33 @@ {/* (CLOS::CLASS-GETHASH ht object) is like (GETHASH (CLASS-OF object) ht). */ var object ht = check_hashtable(STACK_1); /* hashtable argument */ C_class_of(); /* value1 := (CLASS-OF object) */ - var gcv_object_t* KVptr; - var gcv_object_t* Iptr; - /* search key value1 in the hash-table: */ - if (hash_lookup(ht,value1,&KVptr,&Iptr)) { /* -> Value as value: */ - VALUES2(KVptr[1], T); /* and T as the 2nd value */ - } else { /* not found -> NIL as value */ + var object clas = value1; + if (!ht_validp(TheHashtable(ht))) /* hash-table must still be reorganized */ + ht = rehash(ht); + { + var uint32 code = /* calculate hashcode of the class */ + posfixnum_to_L(TheClass(clas)->hashcode); + var uintL hashindex; + divu_3232_3232(code,TheHashtable(ht)->ht_size, (void),hashindex = ); + var object kvtable = TheHashtable(ht)->ht_kvtable; + var gcv_object_t* Nptr = /* pointer to the current entry */ + &TheSvector(TheHashedAlist(kvtable)->hal_itable)->data[hashindex]; + var gcv_object_t* kvt_data = TheHashedAlist(kvtable)->hal_data; + while (!eq(*Nptr,nix)) { /* track "list" : "list" finished -> not found */ + var uintL index = posfixnum_to_L(*Nptr); /* next index */ + var gcv_object_t* KVptr = /* pointer to entries in key-value-vector */ + kvt_data + 3*index; + /* compare key */ + if (eq(KVptr[0],clas)) { + /* found */ + VALUES2(KVptr[1], T); goto done; + } + Nptr = &KVptr[2]; /* pointer to index of next entry */ + } + /* not found */ VALUES2(NIL, NIL); /* NIL as the 2nd value */ } + done: skipSTACK(1); } Index: lispbibl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/lispbibl.d,v retrieving revision 1.519 retrieving revision 1.520 diff -u -d -r1.519 -r1.520 --- lispbibl.d 9 Jun 2004 11:17:20 -0000 1.519 +++ lispbibl.d 11 Jun 2004 10:39:49 -0000 1.520 @@ -5513,6 +5513,7 @@ typedef struct { SRECORD_HEADER gcv_object_t structure_types_2 _attribute_aligned_object_; # list (metaclass <class>) + gcv_object_t hashcode _attribute_aligned_object_; # GC invariant hash code gcv_object_t metaclass _attribute_aligned_object_; # a subclass of <class> gcv_object_t classname _attribute_aligned_object_; # a symbol gcv_object_t direct_superclasses _attribute_aligned_object_; # direct superclasses --__--__-- Message: 3 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src hashtabl.d,1.96,1.97 loop.lisp,1.26,1.27 clos-class5.lisp,1.20,1.21 clos-genfun2.lisp,1.5,1.6 ChangeLog,1.3165,1.3166 Date: Fri, 11 Jun 2004 10:47:10 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8186/src Modified Files: hashtabl.d loop.lisp clos-class5.lisp clos-genfun2.lisp ChangeLog Log Message: Use hash table test FASTHASH-EQUAL. Index: clos-genfun2.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-genfun2.lisp,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- clos-genfun2.lisp 11 Jun 2004 10:39:50 -0000 1.5 +++ clos-genfun2.lisp 11 Jun 2004 10:47:07 -0000 1.6 @@ -216,7 +216,7 @@ (let ((prototype-table (make-hash-table :key-type '(cons fixnum boolean) :value-type '(simple-array (unsigned-byte 8) (*)) - :test #'equal))) + :test #'equal :warn-if-needs-rehash-after-gc t))) (defun finalize-fast-gf (gf) (let* ((signature (gf-signature gf)) (reqanz (sig-req-num signature)) @@ -343,7 +343,8 @@ (setq ht-init `(MAKE-HASH-TABLE ; :KEY-TYPE '(CONS ... CLASS ...) :VALUE-TYPE 'FUNCTION - :TEST (FUNCTION ,(if (eql n 1) 'EXT:STABLEHASH-EQ 'EQUAL))) + :TEST ',(if (eql n 1) 'EXT:STABLEHASH-EQ 'EXT:STABLEHASH-EQUAL) + :WARN-IF-NEEDS-REHASH-AFTER-GC 'T) ht-key-binding `((,tuple-var ,(let ((tuple-fun (hash-tuple-function n))) @@ -381,7 +382,8 @@ ht-init `(MAKE-HASH-TABLE ; :KEY-TYPE '(CONS ... CLASS ...) :VALUE-TYPE 'FUNCTION - :TEST (FUNCTION ,(if (eql n 1) 'EXT:STABLEHASH-EQ 'EQUAL))) + :TEST ',(if (eql n 1) 'EXT:STABLEHASH-EQ 'EXT:STABLEHASH-EQUAL) + :WARN-IF-NEEDS-REHASH-AFTER-GC 'T) em-expr (if (eql n 1) ; whatever is faster ;; `(GETHASH ,@class-of-exprs ,ht-var) == Index: clos-class5.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-class5.lisp,v retrieving revision 1.20 retrieving revision 1.21 diff -u -d -r1.20 -r1.21 --- clos-class5.lisp 11 Jun 2004 10:39:50 -0000 1.20 +++ clos-class5.lisp 11 Jun 2004 10:47:07 -0000 1.21 @@ -44,7 +44,7 @@ (defparameter *update-instance-for-different-class-table* (make-hash-table :key-type '(cons class class) :value-type 'list - :test #'equal)) + :test 'ext:stablehash-equal :warn-if-needs-rehash-after-gc t)) ;; Hash table, mapping a cons (old-class . new-class) to ;; - a list of valid keyword arguments. Index: hashtabl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/hashtabl.d,v retrieving revision 1.96 retrieving revision 1.97 diff -u -d -r1.96 -r1.97 --- hashtabl.d 11 Jun 2004 10:39:50 -0000 1.96 +++ hashtabl.d 11 Jun 2004 10:47:07 -0000 1.97 @@ -2636,7 +2636,7 @@ if (!ht_validp(TheHashtable(ht))) /* hash-table must still be reorganized */ ht = rehash(ht); { - var uint32 code = /* calculate hashcode of the class */ + var uint32 code = /* calculate hashcode1stable of the class */ posfixnum_to_L(TheClass(clas)->hashcode); var uintL hashindex; divu_3232_3232(code,TheHashtable(ht)->ht_size, (void),hashindex = ); @@ -2665,8 +2665,8 @@ /* (CLOS::CLASS-TUPLE-GETHASH ht object1 ... objectn) is like (GETHASH (funcall (hash-tuple-function n) class1 ... classn) ht) with classi = (CLASS-OF objecti). - Definition: n>0, ht is an EQUAL-hashtable and (hash-tuple-function n) is - defined in clos.lisp . + Definition: n>0, ht is a STABLEHASH-EQUAL-hashtable and + (hash-tuple-function n) is defined in clos.lisp . This function is the core of the dispatch for generic functions. It has to be fast and must not cons. @@ -2681,7 +2681,8 @@ local uint32 hashcode_tuple (uintC n, const gcv_object_t* args_pointer, uintC depth) { if (n==1) { - return hashcode1(Next(args_pointer)); /* hashcode3_atom for classes */ + var object clas = Next(args_pointer); + return posfixnum_to_L(TheClass(clas)->hashcode); /* hashcode3stable_atom for classes */ } else if (n<=16) { var uintC n1 = tuple_half_1[n]; var uintC n2 = tuple_half_2[n]; /* n1 + n2 = n */ Index: loop.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/loop.lisp,v retrieving revision 1.26 retrieving revision 1.27 diff -u -d -r1.26 -r1.27 --- loop.lisp 8 Jun 2004 11:18:22 -0000 1.26 +++ loop.lisp 11 Jun 2004 10:47:07 -0000 1.27 @@ -21,7 +21,7 @@ (load-time-value (make-hash-table :key-type 'string :value-type 'symbol - :test #'equal + :test 'fasthash-equal :warn-if-needs-rehash-after-gc t :initial-contents (mapcar #'(lambda (s) (cons (symbol-name s) s)) '(named Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3165 retrieving revision 1.3166 diff -u -d -r1.3165 -r1.3166 --- ChangeLog 11 Jun 2004 10:39:50 -0000 1.3165 +++ ChangeLog 11 Jun 2004 10:47:07 -0000 1.3166 @@ -1,3 +1,13 @@ +2004-05-14 Bruno Haible <br...@cl...> + + * hashtabl.d (hashcode_tuple): Use inlined hashcode3stable_atom. + * clos-genfun2.lisp (compute-dispatch): When the number of dispatching + arguments is > 1, use a hash table with test STABLEHASH-EQUAL. + * clos-class5.lisp (*update-instance-for-different-class-table*): + Use hash table test FASTHASH-EQUAL. + + * loop.lisp (loop-keywordp): Use hash table test FASTHASH-EQUAL. + 2004-05-13 Bruno Haible <br...@cl...> Make the hashcode of classes GC-invariant. --__--__-- Message: 4 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src sequence.d,1.78,1.79 compiler.lisp,1.196,1.197 room.lisp,1.4,1.5 ChangeLog,1.3166,1.3167 Date: Fri, 11 Jun 2004 10:49:55 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9780/src Modified Files: sequence.d compiler.lisp room.lisp ChangeLog Log Message: Use hash table test FASTHASH-EQ/EQL/EQUAL. Index: room.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/room.lisp,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- room.lisp 8 Jun 2004 11:18:21 -0000 1.4 +++ room.lisp 11 Jun 2004 10:49:36 -0000 1.5 @@ -117,7 +117,7 @@ ;; Now we have all the statistics, and are free to do any kind ;; of allocations. (let ((ht (make-hash-table :key-type 't :value-type '(cons cons cons) - :test #'eq))) + :test 'fasthash-eq))) ;; For each type, (gethash type ht) contains a cons ;; (heap-stat-record . gc-stat-record), ;; where both records are conses (n-instances . n-bytes). Index: sequence.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/sequence.d,v retrieving revision 1.78 retrieving revision 1.79 diff -u -d -r1.78 -r1.79 --- sequence.d 2 Jun 2004 21:32:33 -0000 1.78 +++ sequence.d 11 Jun 2004 10:49:35 -0000 1.79 @@ -3250,7 +3250,17 @@ # Neuen Bitvektor allozieren: pushSTACK(allocate_bit_vector_0(bvl)); # mit (MAKE-HASH-TABLE :test test) eine leere Hash-Tabelle bauen: - pushSTACK(S(Ktest)); pushSTACK(STACK_(1+3+1)); funcall(L(make_hash_table),2); + { + var object test = STACK_(1+3); + if (eq(test,S(eq)) || eq(test,L(eq))) + test = S(fasthash_eq); + else if (eq(test,S(eql)) || eq(test,L(eql))) + test = S(fasthash_eql); + else if (eq(test,S(equal)) || eq(test,L(equal))) + test = S(fasthash_equal); + pushSTACK(S(Ktest)); pushSTACK(test); + } + funcall(L(make_hash_table),2); pushSTACK(value1); # ht retten { pushSTACK(STACK_(6+3+1)); # sequence Index: compiler.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/compiler.lisp,v retrieving revision 1.196 retrieving revision 1.197 diff -u -d -r1.196 -r1.197 --- compiler.lisp 8 Jun 2004 11:18:23 -0000 1.196 +++ compiler.lisp 11 Jun 2004 10:49:36 -0000 1.197 @@ -5773,6 +5773,11 @@ (return (third case))))) (let ((default-label (make-label 'NIL)) (end-label (make-label *for-value*))) + (when (and (eq test 'EQL) (every #'EQL=EQ allkeys)) + (setq test 'EQ)) + (cond ((eq test 'EQ) (setq test 'FASTHASH-EQ)) + ((eq test 'EQL) (setq test 'FASTHASH-EQL)) + ((eq test 'EQUAL) (setq test 'FASTHASH-EQUAL))) (make-anode :type 'CASE :sub-anodes `(,keyform-anode ,@(mapcar #'third cases) @@ -5783,8 +5788,7 @@ :code `(,keyform-anode (JMPHASH - ,(if (and (eq test 'eql) (every #'EQL=EQ allkeys)) - 'EQ test) + ,test ,(mapcap ; alist (obji -> labeli) #'(lambda (case) (let ((label (second case))) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3166 retrieving revision 1.3167 diff -u -d -r1.3166 -r1.3167 --- ChangeLog 11 Jun 2004 10:47:07 -0000 1.3166 +++ ChangeLog 11 Jun 2004 10:49:36 -0000 1.3167 @@ -1,3 +1,11 @@ +2004-05-13 Bruno Haible <br...@cl...> + + * sequence.d (seq_duplicates): Use a hash table test FASTHASH-EQ + instead of EQ, FASTHASH-EQL instead of EQL, FASTHASH-EQUAL instead of + EQUAL. + * compiler.lisp (c-CASE): Likewise. + * room.lisp (%space): Likewise. + 2004-05-14 Bruno Haible <br...@cl...> * hashtabl.d (hashcode_tuple): Use inlined hashcode3stable_atom. --__--__-- Message: 5 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src clos-class2.lisp,1.32,1.33 ChangeLog,1.3167,1.3168 Date: Fri, 11 Jun 2004 10:51:28 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11085/src Modified Files: clos-class2.lisp ChangeLog Log Message: Use :warn-if-needs-rehash-after-gc. Index: clos-class2.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-class2.lisp,v retrieving revision 1.32 retrieving revision 1.33 diff -u -d -r1.32 -r1.33 --- clos-class2.lisp 11 Jun 2004 10:39:50 -0000 1.32 +++ clos-class2.lisp 11 Jun 2004 10:51:25 -0000 1.33 @@ -17,7 +17,8 @@ ;; An empty hash table. (defconstant empty-ht (make-hash-table :key-type 'symbol :value-type 't - :test #'eq :size 0)) + :test 'eq :warn-if-needs-rehash-after-gc t + :size 0)) ;; Definition of <structure-stablehash>. ;; Used for (make-hash-table :test 'stablehash-eq). Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3167 retrieving revision 1.3168 diff -u -d -r1.3167 -r1.3168 --- ChangeLog 11 Jun 2004 10:49:36 -0000 1.3167 +++ ChangeLog 11 Jun 2004 10:51:25 -0000 1.3168 @@ -1,5 +1,10 @@ 2004-05-13 Bruno Haible <br...@cl...> + * clos-class2.lisp (empty-ht): Warn if this hash table ever gets used + nontrivially. + +2004-05-13 Bruno Haible <br...@cl...> + * sequence.d (seq_duplicates): Use a hash table test FASTHASH-EQ instead of EQ, FASTHASH-EQL instead of EQL, FASTHASH-EQUAL instead of EQUAL. --__--__-- Message: 6 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src trace.lisp,1.25,1.26 ChangeLog,1.3168,1.3169 Date: Fri, 11 Jun 2004 10:53:31 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13298/src Modified Files: trace.lisp ChangeLog Log Message: New TRACE option :MAX-DEPTH. Index: trace.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/trace.lisp,v retrieving revision 1.25 retrieving revision 1.26 diff -u -d -r1.25 -r1.26 --- trace.lisp 30 Apr 2004 10:16:16 -0000 1.25 +++ trace.lisp 11 Jun 2004 10:53:28 -0000 1.26 @@ -11,6 +11,7 @@ ;; or a List made of a Symbol and a few Keyword-Arguments (pair-wise!) ;; (symbol ;; [:suppress-if form] ; no Trace-Output, as long as form is true +;; [:max-depth form] ; no trace output, as long as (> *trace-level* form) ;; [:step-if form] ; Trace moves into the Stepper, if form is true ;; [:pre form] ; executes form before function call ;; [:post form] ; executes form after function call @@ -127,7 +128,7 @@ (defstruct (tracer (:type vector)) name symb cur-def local-p - suppress-if step-if pre post pre-break-if post-break-if + suppress-if max-depth step-if pre post pre-break-if post-break-if pre-print post-print print) ;; install the new function definition @@ -195,7 +196,9 @@ `((declare (inline car cdr cons apply values-list)) (let ((*trace-level* (1+ *trace-level*))) (block nil - (unless ,(tracer-suppress-if trr) (trace-pre-output)) + (unless (or ,(tracer-suppress-if trr) + ,(if (tracer-max-depth trr) `(> *trace-level* ,(tracer-max-depth trr)) 'nil)) + (trace-pre-output)) ,@(when (tracer-pre-print trr) `((trace-print (multiple-value-list ,(tracer-pre-print trr))))) @@ -223,7 +226,8 @@ ,@(when (tracer-post-print trr) `((trace-print (multiple-value-list ,(tracer-post-print trr))))) - (unless ,(tracer-suppress-if trr) + (unless (or ,(tracer-suppress-if trr) + ,(if (tracer-max-depth trr) `(> *trace-level* ,(tracer-max-depth trr)) 'nil)) (trace-post-output)) (values-list *trace-values*))))))) (setf (get newname 'sys::untraced-name) (tracer-symb trr)) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3168 retrieving revision 1.3169 diff -u -d -r1.3168 -r1.3169 --- ChangeLog 11 Jun 2004 10:51:25 -0000 1.3168 +++ ChangeLog 11 Jun 2004 10:53:28 -0000 1.3169 @@ -1,3 +1,8 @@ +2004-06-10 Bruno Haible <br...@cl...> + + * trace.lisp (tracer): Add max-depth slot. + (trace1): Implement :max-depth option. + 2004-05-13 Bruno Haible <br...@cl...> * clos-class2.lisp (empty-ht): Warn if this hash table ever gets used --__--__-- Message: 7 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/doc impbody.xml,1.245,1.246 Date: Fri, 11 Jun 2004 10:58:44 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/doc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17599 Modified Files: impbody.xml Log Message: New TRACE option :MAX-DEPTH. Index: impbody.xml =================================================================== RCS file: /cvsroot/clisp/clisp/doc/impbody.xml,v retrieving revision 1.245 retrieving revision 1.246 diff -u -d -r1.245 -r1.246 --- impbody.xml 9 Jun 2004 14:59:58 -0000 1.245 +++ impbody.xml 11 Jun 2004 10:58:41 -0000 1.246 @@ -4630,7 +4630,8 @@ <para><literal role="sexp">(&trace; &func-r; ...)</literal> makes the functions &func-r;, ... traced. &func-r; should be either a symbol or a list <literal role="sexp">(&symbol-r; &key-amp; - <constant>:suppress-if</constant> <constant>:step-if</constant> + <constant>:suppress-if</constant> <constant>:max-depth</constant> + <constant>:step-if</constant> <constant>:pre</constant> <constant>:post</constant> <constant>:pre-break-if</constant> <constant>:post-break-if</constant> <constant>:pre-print</constant> <constant>:post-print</constant> @@ -4640,6 +4641,12 @@ <varlistentry><term><constant>:suppress-if</constant> &form-r;</term> <listitem><simpara>no trace output as long as &form-r; is true </simpara></listitem></varlistentry> + <varlistentry><term><constant>:max-depth</constant> &form-r;</term> + <listitem><simpara>no trace output as long as <literal role="sexp">(> + *trace-level* &form-r;)</literal>. This is useful for tracing functions that + are use by the tracer itself, such as &print-object;, or otherwise when + tracing would lead to an infinite recursion. + </simpara></listitem></varlistentry> <varlistentry><term><constant>:step-if</constant> &form-r;</term> <listitem><simpara>invokes the stepper as soon as &form-r; is true </simpara></listitem></varlistentry> --__--__-- Message: 8 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src NEWS,1.151,1.152 Date: Fri, 11 Jun 2004 12:01:26 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4842 Modified Files: NEWS Log Message: New TRACE option :MAX-DEPTH. Index: NEWS =================================================================== RCS file: /cvsroot/clisp/clisp/src/NEWS,v retrieving revision 1.151 retrieving revision 1.152 diff -u -d -r1.151 -r1.152 --- NEWS 6 Jun 2004 23:19:57 -0000 1.151 +++ NEWS 11 Jun 2004 12:01:22 -0000 1.152 @@ -107,6 +107,9 @@ + LAST, BUTLAST and NBUTLAST check their list argument for circularity. + NAMESTRING no longer accepts an optional second argument. +* TRACE has a new option :MAX-DEPTH, that is useful to avoid infinite + recursions in the tracer. + * TRANSLATE-PATHNAME and TRANSLATE-LOGICAL-PATHNAME accept a new keyword argument :ABSOLUTE which makes them convert their return values to absolute pathnames. --__--__-- Message: 9 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src clos.lisp,1.82,1.83 ChangeLog,1.3169,1.3170 Date: Fri, 11 Jun 2004 12:06:41 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7846/src Modified Files: clos.lisp ChangeLog Log Message: Reorder includes. Index: clos.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos.lisp,v retrieving revision 1.82 retrieving revision 1.83 diff -u -d -r1.82 -r1.83 --- clos.lisp 10 May 2004 09:45:04 -0000 1.82 +++ clos.lisp 11 Jun 2004 12:06:38 -0000 1.83 @@ -15,26 +15,29 @@ ;; em = effective method (load "clos-class1") +; Now DEFCLASS works (except for accessor methods). (load "clos-slots1") (load "clos-class2") (load "clos-method1") (load "clos-methcomb1") -(load "clos-method2") (load "clos-genfun1") (load "clos-methcomb2") (load "clos-genfun2") (load "clos-methcomb3") -(load "clos-genfun3") (load "clos-methcomb4") +(load "clos-methcomb5") +(load "clos-method2") +(load "clos-genfun3") (load "clos-genfun4") +; Now DEFGENERIC, DEFMETHOD work. DEFCLASS works fully. (load "clos-class3") (load "clos-genfun5") (load "clos-method3") (load "clos-slots2") (load "clos-class5") (load "clos-slotdef2") +; Now instance creation works. Instances can be passed to generic functions. (setq *classes-finished* t) (load "clos-slotdef3") (load "clos-print") (load "documentation") -(load "clos-methcomb5") Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3169 retrieving revision 1.3170 diff -u -d -r1.3169 -r1.3170 --- ChangeLog 11 Jun 2004 10:53:28 -0000 1.3169 +++ ChangeLog 11 Jun 2004 12:06:38 -0000 1.3170 @@ -1,3 +1,7 @@ +2004-05-31 Bruno Haible <br...@cl...> + + * clos.lisp: Reorder method and method combination includes. + 2004-06-10 Bruno Haible <br...@cl...> * trace.lisp (tracer): Add max-depth slot. --__--__-- _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest |