Menu
▾
▴
clisp-cvs digest, Vol 1 #562 - 8 msgs
|
From: <cli...@li...> - 2004-06-14 10:47:02
|
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/doc impbody.xml,1.247,1.248 (Bruno Haible) 2. clisp/src spvw.d,1.299,1.300 hashtabl.d,1.97,1.98 lispbibl.d,1.520,1.521 spvw_typealloc.d,1.37,1.38 constsym.d,1.250,1.251 genclisph.d,1.124,1.125 spvw_garcol.d,1.84,1.85 spvw_update.d,1.27,1.28 ChangeLog,1.3174,1.3175 (Bruno Haible) 3. clisp/src io.d,1.235,1.236 ChangeLog,1.3175,1.3176 (Bruno Haible) 4. clisp/src hashtabl.d,1.98,1.99 ChangeLog,1.3176,1.3177 (Bruno Haible) 5. clisp/tests hashtable.tst,NONE,1.1 (Bruno Haible) 6. clisp/doc impbody.xml,1.248,1.249 (Bruno Haible) 7. clisp/tests tests.lisp,1.35,1.36 ChangeLog,1.180,1.181 (Bruno Haible) 8. clisp/src spvw.d,1.300,1.301 hashtabl.d,1.99,1.100 constsym.d,1.251,1.252 ChangeLog,1.3177,1.3178 (Bruno Haible) --__--__-- Message: 1 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/doc impbody.xml,1.247,1.248 Date: Mon, 14 Jun 2004 10:38:27 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/doc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7622/doc Modified Files: impbody.xml Log Message: Add a hash code to symbols. Index: impbody.xml =================================================================== RCS file: /cvsroot/clisp/clisp/doc/impbody.xml,v retrieving revision 1.247 retrieving revision 1.248 diff -u -d -r1.247 -r1.248 --- impbody.xml 11 Jun 2004 13:42:20 -0000 1.247 +++ impbody.xml 14 Jun 2004 10:38:22 -0000 1.248 @@ -2460,12 +2460,12 @@ can lead to scalability problems.</simpara></listitem></varlistentry> <varlistentry><term>&stablehash-eq;</term> <listitem><simpara>This uses a slower hash function that has the - property that its hash codes for instances of the classes + property that its hash codes for instances of the classes &symbol-t;, &standard-stablehash; (subclass of &standard-object-t;) and &structure-stablehash; (subclass of &structure-object-t;) are stable across GCs. This test can thus avoid the scalability problems if all keys, - other than &immediate-o;s, are &standard-stablehash; or + other than &immediate-o;s, are &symbol-t;, &standard-stablehash; or &structure-stablehash; instances.</simpara></listitem></varlistentry> </variablelist> One can recommend to use &fasthash-eq; for short-lived hash tables. --__--__-- Message: 2 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src spvw.d,1.299,1.300 hashtabl.d,1.97,1.98 lispbibl.d,1.520,1.521 spvw_typealloc.d,1.37,1.38 constsym.d,1.250,1.251 genclisph.d,1.124,1.125 spvw_garcol.d,1.84,1.85 spvw_update.d,1.27,1.28 ChangeLog,1.3174,1.3175 Date: Mon, 14 Jun 2004 10:38:24 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7622/src Modified Files: spvw.d hashtabl.d lispbibl.d spvw_typealloc.d constsym.d genclisph.d spvw_garcol.d spvw_update.d ChangeLog Log Message: Add a hash code to symbols. Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3174 retrieving revision 1.3175 diff -u -d -r1.3174 -r1.3175 --- ChangeLog 11 Jun 2004 12:19:31 -0000 1.3174 +++ ChangeLog 14 Jun 2004 10:38:20 -0000 1.3175 @@ -1,3 +1,20 @@ +2004-05-15 Bruno Haible <br...@cl...> + + Add a hash code to symbols. + * lispbibl.d (symbol_): Add hashcode field. Disable filler for + LINUX_NOEXEC_HEAPCODES. + * spvw.d (init_symbol_tab_1): Pre-initialize the symbol's hash code. + * spvw_update.d (update_symbol_tab): Update the hashcode as well. + * spvw_garcol.d (gc_markphase): Mark the hashcode as well. + * spvw_typealloc.d (make_symbol): Pre-initialize the hash code. + * constsym.d (LISPSYM_B): Pre-initialize the symbol's hash code. + Disable filler for LINUX_NOEXEC_HEAPCODES. + * hashtabl.d (hashcode1stable): Handle symbols specially. + (gcinvariant_hashcode1stable_p): Return true also for symbols. + (gcinvariant_hashcode2stable_p): Likewise. + (gcinvariant_hashcode3stable_atom_p): Likewise. + * genclisph.d (main): Update symbol_ definition. + 2004-05-31 Bruno Haible <br...@cl...> * clos-method1.lisp (lambda-list-keyword-p): Move to clos-method2.lisp. Index: spvw.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/spvw.d,v retrieving revision 1.299 retrieving revision 1.300 diff -u -d -r1.299 -r1.300 --- spvw.d 9 Jun 2004 11:17:20 -0000 1.299 +++ spvw.d 14 Jun 2004 10:38:13 -0000 1.300 @@ -931,6 +931,7 @@ #endif ptr->symvalue = unbound; ptr->symfunction = unbound; + ptr->hashcode = unbound; ptr->proplist = NIL; ptr->pname = NIL; ptr->homepackage = NIL; Index: spvw_garcol.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/spvw_garcol.d,v retrieving revision 1.84 retrieving revision 1.85 diff -u -d -r1.84 -r1.85 --- spvw_garcol.d 9 Jun 2004 11:10:31 -0000 1.84 +++ spvw_garcol.d 14 Jun 2004 10:38:19 -0000 1.85 @@ -133,6 +133,7 @@ for_all_constsyms({ /* peruse symbol_tab */ gc_mark(ptr->symvalue); gc_mark(ptr->symfunction); + gc_mark(ptr->hashcode); gc_mark(ptr->proplist); gc_mark(ptr->pname); gc_mark(ptr->homepackage); Index: constsym.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/constsym.d,v retrieving revision 1.250 retrieving revision 1.251 diff -u -d -r1.250 -r1.251 --- constsym.d 9 Jun 2004 11:17:21 -0000 1.250 +++ constsym.d 14 Jun 2004 10:38:19 -0000 1.251 @@ -20,16 +20,16 @@ /* expander for the initialization of the symbol table: */ #ifdef TYPECODES #define LISPSYM_B(name,printname,package) \ - { {S(name)}, unbound, unbound, NIL, NIL, NIL, }, + { {S(name)}, unbound, unbound, unbound, NIL, NIL, NIL, }, #else - #ifdef LINUX_NOEXEC_HEAPCODES + #if defined(LINUX_NOEXEC_HEAPCODES) && 0 #define LISPSYM_B(name,printname,package) \ { S(name), xrecord_tfl(Rectype_Symbol,0,5,0), \ - unbound, unbound, NIL, NIL, NIL, unbound, }, + unbound, unbound, unbound, NIL, NIL, NIL, unbound, }, #else #define LISPSYM_B(name,printname,package) \ { S(name), xrecord_tfl(Rectype_Symbol,0,5,0), \ - unbound, unbound, NIL, NIL, NIL, }, + unbound, unbound, unbound, NIL, NIL, NIL, }, #endif #endif #define LISPSYM_C(name,printname,package) printname, Index: hashtabl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/hashtabl.d,v retrieving revision 1.97 retrieving revision 1.98 diff -u -d -r1.97 -r1.98 --- hashtabl.d 11 Jun 2004 10:47:07 -0000 1.97 +++ hashtabl.d 14 Jun 2004 10:38:17 -0000 1.98 @@ -156,6 +156,14 @@ slots are inherited in DEFSTRUCT. */ return posfixnum_to_L(TheStructure(obj)->recdata[1]); } + } else if (symbolp(obj)) { + var object hashcode = TheSymbol(obj)->hashcode; + if (eq(hashcode,unbound)) { + /* The first access to a symbol's hash code computes it. */ + pushSTACK(unbound); C_random_posfixnum(); hashcode = value1; + TheSymbol(obj)->hashcode = hashcode; + } + return posfixnum_to_L(hashcode); } return hashcode1(obj); } @@ -178,7 +186,8 @@ /* Tests whether hashcode1stable of an object is guaranteed to be GC-invariant. */ global bool gcinvariant_hashcode1stable_p (object obj) { - return gcinvariant_object_p(obj) || instance_of_stablehash_p(obj); + return gcinvariant_object_p(obj) + || instance_of_stablehash_p(obj) || symbolp(obj); } /* ----------------------------- FASTHASH EQL ----------------------------- */ @@ -391,7 +400,8 @@ GC-invariant. */ global bool gcinvariant_hashcode2stable_p (object obj) { return numberp(obj) - || gcinvariant_object_p(obj) || instance_of_stablehash_p(obj); + || gcinvariant_object_p(obj) + || instance_of_stablehash_p(obj) || symbolp(obj); } /* ---------------------------- FASTHASH EQUAL ---------------------------- */ @@ -876,7 +886,7 @@ break; } #endif - return instance_of_stablehash_p(obj); + return instance_of_stablehash_p(obj) || symbolp(obj); } local inline bool gcinvariant_hashcode3stable_cons0_p (object obj) { if (atomp(obj)) Index: spvw_typealloc.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/spvw_typealloc.d,v retrieving revision 1.37 retrieving revision 1.38 diff -u -d -r1.37 -r1.38 --- spvw_typealloc.d 26 May 2004 11:17:07 -0000 1.37 +++ spvw_typealloc.d 14 Jun 2004 10:38:19 -0000 1.38 @@ -59,6 +59,7 @@ #define FILL \ do { ptr->symvalue = unbound; # empty value cell \ ptr->symfunction = unbound; # empty function cell \ + ptr->hashcode = unbound; # not yet computed \ ptr->proplist = NIL; # empty property list \ ptr->pname = popSTACK(); # store name \ ptr->homepackage = NIL; # no home-package \ @@ -67,8 +68,8 @@ allocate(symbol_type,true,size_symbol(),Symbol,ptr, { FILL; }); #else - allocate(symbol_type,true,size_xrecord(5,0),Symbol,ptr, - { ptr->tfl = xrecord_tfl(Rectype_Symbol,0,5,0); FILL; }); + allocate(symbol_type,true,size_xrecord(6,0),Symbol,ptr, + { ptr->tfl = xrecord_tfl(Rectype_Symbol,0,6,0); FILL; }); #endif #undef FILL } Index: lispbibl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/lispbibl.d,v retrieving revision 1.520 retrieving revision 1.521 diff -u -d -r1.520 -r1.521 --- lispbibl.d 11 Jun 2004 10:39:49 -0000 1.520 +++ lispbibl.d 14 Jun 2004 10:38:17 -0000 1.521 @@ -4209,12 +4209,13 @@ VAROBJECT_HEADER gcv_object_t symvalue _attribute_aligned_object_; # value cell gcv_object_t symfunction _attribute_aligned_object_; # function definition cell + gcv_object_t hashcode _attribute_aligned_object_; # hash code gcv_object_t proplist _attribute_aligned_object_; # property list gcv_object_t pname _attribute_aligned_object_; # Printname gcv_object_t homepackage _attribute_aligned_object_; # Home-Package or NIL # If necessary, add fillers here to ensure sizeof(subr_t) is a multiple of # varobject_alignment. - #ifdef LINUX_NOEXEC_HEAPCODES + #if defined(LINUX_NOEXEC_HEAPCODES) && 0 gcv_object_t filler _attribute_aligned_object_; #endif } symbol_; Index: genclisph.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/genclisph.d,v retrieving revision 1.124 retrieving revision 1.125 diff -u -d -r1.124 -r1.125 --- genclisph.d 22 May 2004 14:53:56 -0000 1.124 +++ genclisph.d 14 Jun 2004 10:38:19 -0000 1.125 @@ -820,10 +820,10 @@ emit_typedef(buf,"complex_"); emit_typedef("complex_ *","Complex"); #endif -#ifdef LINUX_NOEXEC_HEAPCODES - sprintf(buf,"struct { VAROBJECT_HEADER gcv_object_t symvalue%s; gcv_object_t symfunction%s; gcv_object_t proplist%s; gcv_object_t pname%s; gcv_object_t homepackage%s; gcv_object_t filler%s; }",attribute_aligned_object,attribute_aligned_object,attribute_aligned_object,attribute_aligned_object,attribute_aligned_object,attribute_aligned_object); +#if defined(LINUX_NOEXEC_HEAPCODES) && 0 + sprintf(buf,"struct { VAROBJECT_HEADER gcv_object_t symvalue%s; gcv_object_t symfunction%s; gcv_object_t hashcode%s; gcv_object_t proplist%s; gcv_object_t pname%s; gcv_object_t homepackage%s; gcv_object_t filler%s; }",attribute_aligned_object,attribute_aligned_object,attribute_aligned_object,attribute_aligned_object,attribute_aligned_object,attribute_aligned_object); #else - sprintf(buf,"struct { VAROBJECT_HEADER gcv_object_t symvalue%s; gcv_object_t symfunction%s; gcv_object_t proplist%s; gcv_object_t pname%s; gcv_object_t homepackage%s; }",attribute_aligned_object,attribute_aligned_object,attribute_aligned_object,attribute_aligned_object,attribute_aligned_object); + sprintf(buf,"struct { VAROBJECT_HEADER gcv_object_t symvalue%s; gcv_object_t symfunction%s; gcv_object_t hashcode%s; gcv_object_t proplist%s; gcv_object_t pname%s; gcv_object_t homepackage%s; }",attribute_aligned_object,attribute_aligned_object,attribute_aligned_object,attribute_aligned_object,attribute_aligned_object); #endif emit_typedef(buf,"symbol_"); emit_typedef("symbol_ *","Symbol"); Index: spvw_update.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/spvw_update.d,v retrieving revision 1.27 retrieving revision 1.28 diff -u -d -r1.27 -r1.28 --- spvw_update.d 9 Jun 2004 11:10:33 -0000 1.27 +++ spvw_update.d 14 Jun 2004 10:38:19 -0000 1.28 @@ -64,6 +64,7 @@ var gcv_object_t* p; \ p = &ptr->symvalue; update(p); \ p = &ptr->symfunction; update(p); \ + p = &ptr->hashcode; update(p); \ p = &ptr->proplist; update(p); \ p = &ptr->pname; update(p); \ p = &ptr->homepackage; update(p); \ --__--__-- Message: 3 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src io.d,1.235,1.236 ChangeLog,1.3175,1.3176 Date: Mon, 14 Jun 2004 10:39:55 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8778/src Modified Files: io.d ChangeLog Log Message: Update the hash table reader/writer to care for the new hash table attributes. Index: io.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/io.d,v retrieving revision 1.235 retrieving revision 1.236 diff -u -d -r1.235 -r1.236 --- io.d 11 Jun 2004 10:34:08 -0000 1.235 +++ io.d 14 Jun 2004 10:39:52 -0000 1.236 @@ -3938,12 +3938,29 @@ pushSTACK(S(hash_table)); pushSTACK(*stream_); pushSTACK(S(read)); fehler(stream_error,GETTEXT("~S from ~S: bad ~S")); } - # (MAKE-HASH-TABLE :TEST (car args) :INITIAL-CONTENTS (cdr args)) - pushSTACK(S(Ktest)); # :TEST - pushSTACK(Car(args)); # Test (Symbol) - pushSTACK(S(Kinitial_contents)); # :INITIAL-CONTENTS - pushSTACK(Cdr(args)); # Alist ((Key_1 . Value_1) ... (Key_n . Value_n)) - funcall(L(make_hash_table),4); # build Hash-Table + if (symbolp(Car(args)) && keywordp(Car(args))) { + # New syntax with implicit :INITIAL-CONTENTS keyword: + var uintL argcount = 2; + while (consp(args) && symbolp(Car(args)) && mconsp(Cdr(args))) { + get_space_on_STACK(2); + pushSTACK(Car(args)); + args = Cdr(args); + pushSTACK(Car(args)); + args = Cdr(args); + argcount += 2; + } + pushSTACK(S(Kinitial_contents)); # :INITIAL-CONTENTS + pushSTACK(args); # Alist ((Key_1 . Value_1) ... (Key_n . Value_n)) + funcall(L(make_hash_table),argcount); # build Hash-Table + } else { + # Old syntax with implicit :TEST and :INITIAL-CONTENTS keywords: + # (MAKE-HASH-TABLE :TEST (car args) :INITIAL-CONTENTS (cdr args)) + pushSTACK(S(Ktest)); # :TEST + pushSTACK(Car(args)); # Test (Symbol) + pushSTACK(S(Kinitial_contents)); # :INITIAL-CONTENTS + pushSTACK(Cdr(args)); # Alist ((Key_1 . Value_1) ... (Key_n . Value_n)) + funcall(L(make_hash_table),4); # build Hash-Table + } mv_count=1; # value1 as value skipSTACK(3); return; } @@ -8448,90 +8465,94 @@ case Rectype_Hashtable: # depending on *PRINT-ARRAY* : # #<HASH-TABLE #x...> or - # #S(HASH-TABLE test (Key_1 . Value_1) ... (Key_n . Value_n)) - if (!nullpSv(print_array) || !nullpSv(print_readably)) { - LEVEL_CHECK; - { - pushSTACK(obj); # save Hash-Table - var gcv_object_t* obj_ = &STACK_0; # and memorize, where it is - if (ht_weak_p(obj)) { # weak ==> #<HASH-TABLE :WEAK ...> - CHECK_PRINT_READABLY(obj); - UNREADABLE_START; - JUSTIFY_LAST(false); - } else { # non-weak ==> #S(HASH-TABLE ...) - write_ascii_char(stream_,'#'); write_ascii_char(stream_,'S'); - KLAMMER_AUF; - INDENT_START(3); # indent by 3 characters, because of '#S(' - JUSTIFY_START(1); - JUSTIFY_LAST(false); - } - prin_object(stream_,S(hash_table)); # print symbol HASH-TABLE - if (ht_weak_p(*obj_)) { - JUSTIFY_SPACE; JUSTIFY_LAST(false); - { - JUSTIFY_START(0); JUSTIFY_LAST(false); - prin_object(stream_,S(Kweak)); # print :WEAK - JUSTIFY_SPACE; JUSTIFY_LAST(true); - prin_object(stream_,hash_table_weak_type(*obj_)); /*:KEY/:VALUE/:BOTH/:EITHER*/ - JUSTIFY_END_FILL; - } + # #S(HASH-TABLE :TEST test [:WEAK ...] [:WARN-IF-NEEDS-REHASH-AFTER-GC T] + # (Key_1 . Value_1) ... (Key_n . Value_n)) + LEVEL_CHECK; + { + var bool detailed_contents = (!nullpSv(print_array) || !nullpSv(print_readably)); + var bool readable = (detailed_contents && !ht_weak_p(obj)); + pushSTACK(obj); # save Hash-Table + var gcv_object_t* obj_ = &STACK_0; # and memorize, where it is + if (readable) { + # #S(HASH-TABLE ...) + write_ascii_char(stream_,'#'); write_ascii_char(stream_,'S'); + KLAMMER_AUF; + INDENT_START(3); # indent by 3 characters, because of '#S(' + JUSTIFY_START(1); + } else { + # #<HASH-TABLE ...> + CHECK_PRINT_READABLY(obj); + UNREADABLE_START; + } + JUSTIFY_LAST(false); + prin_object(stream_,S(hash_table)); # print symbol HASH-TABLE + obj = *obj_; + var bool show_test = true; + var bool show_weak = ht_weak_p(obj); + var bool show_warn = ((record_flags(TheHashtable(obj)) & htflags_warn_gc_rehash_B) != 0); + var bool show_contents = (!detailed_contents || !eq(TheHashedAlist(TheHashtable(obj)->ht_kvtable)->hal_count,Fixnum_0)); + if (show_test) { + JUSTIFY_SPACE; JUSTIFY_LAST(!(show_weak||show_warn||show_contents)); + { + JUSTIFY_START(0); JUSTIFY_LAST(false); + prin_object(stream_,S(Ktest)); # print :TEST + JUSTIFY_SPACE; JUSTIFY_LAST(true); + prin_object(stream_,hash_table_test(*obj_)); + JUSTIFY_END_FILL; } - if (record_flags(TheHashtable(*obj_)) & htflags_warn_gc_rehash_B) { - JUSTIFY_SPACE; JUSTIFY_LAST(false); - { - JUSTIFY_START(0); JUSTIFY_LAST(false); - prin_object(stream_,S(Kwarn_if_needs_rehash_after_gc)); # print :WARN-IF-NEEDS-REHASH-AFTER-GC - JUSTIFY_SPACE; JUSTIFY_LAST(true); - prin_object(stream_,T); # print T - JUSTIFY_END_FILL; - } + } + if (show_weak) { + JUSTIFY_SPACE; JUSTIFY_LAST(!(show_warn||show_contents)); + { + JUSTIFY_START(0); JUSTIFY_LAST(false); + prin_object(stream_,S(Kweak)); # print :WEAK + JUSTIFY_SPACE; JUSTIFY_LAST(true); + prin_object(stream_,hash_table_weak_type(*obj_)); /*:KEY/:VALUE/:BOTH/:EITHER*/ + JUSTIFY_END_FILL; } - obj = *obj_; + } + if (show_warn) { + JUSTIFY_SPACE; JUSTIFY_LAST(!show_contents); { + JUSTIFY_START(0); JUSTIFY_LAST(false); + prin_object(stream_,S(Kwarn_if_needs_rehash_after_gc)); # print :WARN-IF-NEEDS-REHASH-AFTER-GC + JUSTIFY_SPACE; JUSTIFY_LAST(true); + prin_object(stream_,T); # print T + JUSTIFY_END_FILL; + } + } + obj = *obj_; + if (show_contents) { + if (detailed_contents) { var uintL index = # move Index into the Key-Value-Vector 3*posfixnum_to_L(TheHashtable(obj)->ht_maxcount); pushSTACK(TheHashtable(obj)->ht_kvtable); # Key-Value-Vector var uintL count = posfixnum_to_L(TheHashedAlist(STACK_0)->hal_count); - JUSTIFY_SPACE; # print Space - # test for attaining of *PRINT-LINES* : - CHECK_LINES_LIMIT(goto kvtable_end); - JUSTIFY_LAST(count==0); - /* print Hash-Test: */ - prin_object(stream_,hash_table_test(*obj_)); pr_kvtable(stream_,&STACK_0,index,count); - kvtable_end: # output of Key-Value-Pairs finished skipSTACK(1); - } - JUSTIFY_END_FILL; - if (ht_weak_p(*obj_)) { - UNREADABLE_END; } else { - INDENT_END; - KLAMMER_ZU; + JUSTIFY_SPACE; JUSTIFY_LAST(false); + { + JUSTIFY_START(0); JUSTIFY_LAST(false); + prin_object(stream_,S(Kcount)); # print :COUNT + JUSTIFY_SPACE; JUSTIFY_LAST(true); + prin_object(stream_,TheHashedAlist(TheHashtable(*obj_)->ht_kvtable)->hal_count); # print hash-table-count + JUSTIFY_END_FILL; + } + JUSTIFY_SPACE; JUSTIFY_LAST(true); + pr_hex6(stream_,*obj_); } - skipSTACK(1); - } - LEVEL_END; - } else { - var uintL count = posfixnum_to_L(TheHashedAlist(TheHashtable(obj)->ht_kvtable)->hal_count); - pushSTACK(obj); - var gcv_object_t* obj_ = &STACK_0; - UNREADABLE_START; JUSTIFY_LAST(false); - prin_object(stream_,S(hash_table)); # print symbol HASH-TABLE - if (ht_weak_p(*obj_)) { - JUSTIFY_SPACE; JUSTIFY_LAST(false); - prin_object(stream_,S(Kweak)); # print :WEAK } - JUSTIFY_SPACE; JUSTIFY_LAST(false); - prin_object(stream_,hash_table_test(*obj_)); - JUSTIFY_SPACE; JUSTIFY_LAST(false); - pr_uint(stream_,count); # print HASH-TABLE-COUNT - JUSTIFY_SPACE; JUSTIFY_LAST(true); - pr_hex6(stream_,*obj_); JUSTIFY_END_FILL; - UNREADABLE_END; + if (readable) { + INDENT_END; + KLAMMER_ZU; + } else { + UNREADABLE_END; + } skipSTACK(1); } + LEVEL_END; break; case Rectype_Package: # depending on *PRINT-READABLY*: Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3175 retrieving revision 1.3176 diff -u -d -r1.3175 -r1.3176 --- ChangeLog 14 Jun 2004 10:38:20 -0000 1.3175 +++ ChangeLog 14 Jun 2004 10:39:52 -0000 1.3176 @@ -1,5 +1,12 @@ 2004-05-15 Bruno Haible <br...@cl...> + * io.d (structure_reader): Accept both the new syntax with :TEST and + the old syntax. + (pr_orecord): For hash tables, make the output in the three possible + cases more consistent. + +2004-05-15 Bruno Haible <br...@cl...> + Add a hash code to symbols. * lispbibl.d (symbol_): Add hashcode field. Disable filler for LINUX_NOEXEC_HEAPCODES. --__--__-- Message: 4 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src hashtabl.d,1.98,1.99 ChangeLog,1.3176,1.3177 Date: Mon, 14 Jun 2004 10:41:09 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10182/src Modified Files: hashtabl.d ChangeLog Log Message: Optimize clrhash(). Index: hashtabl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/hashtabl.d,v retrieving revision 1.98 retrieving revision 1.99 diff -u -d -r1.98 -r1.99 --- hashtabl.d 14 Jun 2004 10:38:17 -0000 1.98 +++ hashtabl.d 14 Jun 2004 10:41:06 -0000 1.99 @@ -1930,19 +1930,32 @@ local void clrhash (object ht) { set_break_sem_2(); /* protect from breaks */ var object kvtable = TheHashtable(ht)->ht_kvtable; + /* Delete pairs and build up freelist: */ { - var uintL count = posfixnum_to_L(TheHashtable(ht)->ht_maxcount); - if (count > 0) { - var gcv_object_t* KVptr = TheHashedAlist(kvtable)->hal_data; - dotimespL(count,count, { /* in each entry */ - *KVptr++ = leer; *KVptr++ = leer; /* deplete key and value */ - *KVptr++ = leer; /* and next-index */ - }); + var object index = TheHashtable(ht)->ht_maxcount; /* MAXCOUNT */ + var uintL maxcount = posfixnum_to_L(index); + var object freelist = nix; + if (maxcount > 0) { + var gcv_object_t* KVptr = &TheHashedAlist(kvtable)->hal_data[3*maxcount]; /* end of kvtable */ + do { + index = fixnum_inc(index,-1); /* decrement index */ + *--KVptr = freelist; /* delete next-index */ + *--KVptr = leer; *--KVptr = leer; /* delete key and value */ + freelist = index; + } while (!eq(index,Fixnum_0)); } + TheHashedAlist(kvtable)->hal_freelist = freelist; /* save freelist */ } TheHashedAlist(kvtable)->hal_count = Fixnum_0; /* COUNT := 0 */ + /* Fill index-vector with "nix" : */ + var object Ivektor = TheHashedAlist(kvtable)->hal_itable; /* index-vector */ + { + var gcv_object_t* ptr = &TheSvector(Ivektor)->data[0]; + var uintL count = TheHashtable(ht)->ht_size; /* SIZE, >0 */ + dotimespL(count,count, { *ptr++ = nix; } ); + } record_flags_clr(TheHashtable(ht),htflags_gc_rehash_B); /* no dangerous keys now */ - set_ht_invalid(TheHashtable(ht)); /* reorganize hashtable later */ + set_ht_valid(TheHashtable(ht)); /* hashtable is now completely organized */ clr_break_sem_2(); /* allow breaks again */ } Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3176 retrieving revision 1.3177 diff -u -d -r1.3176 -r1.3177 --- ChangeLog 14 Jun 2004 10:39:52 -0000 1.3176 +++ ChangeLog 14 Jun 2004 10:41:06 -0000 1.3177 @@ -1,5 +1,10 @@ 2004-05-15 Bruno Haible <br...@cl...> + * hashtabl.d (clrhash): Reorganize the hash table immediately, + instead of delaying the reorganization. + +2004-05-15 Bruno Haible <br...@cl...> + * io.d (structure_reader): Accept both the new syntax with :TEST and the old syntax. (pr_orecord): For hash tables, make the output in the three possible --__--__-- Message: 5 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/tests hashtable.tst,NONE,1.1 Date: Mon, 14 Jun 2004 10:44:14 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/tests In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv12736/tests Added Files: hashtable.tst Log Message: Hash table tests. --- NEW FILE: hashtable.tst --- ;; Test :warn-if-needs-rehash-after-gc. (block nil (handler-bind ((WARNING #'(lambda (w) (declare (ignore w)) (return 'WARNING)))) (let ((x1 (make-instance 'ext:standard-stablehash)) (x2 (make-instance 'ext:standard-stablehash)) (ht (make-hash-table :test 'ext:stablehash-eq))) (setf (gethash x1 ht) 11) (setf (gethash x2 ht) 22) (setf (gethash '1000 ht) 11999) (gc) (gethash x1 ht) (setf (gethash '10000000000000000000 ht) 11999999999999) (gc) (gethash x1 ht)))) 11 (block nil (handler-bind ((WARNING #'(lambda (w) (declare (ignore w)) (return 'WARNING)))) (let ((x1 (make-instance 'ext:standard-stablehash)) (x2 (make-instance 'ext:standard-stablehash)) (ht (make-hash-table :test 'ext:stablehash-eq :warn-if-needs-rehash-after-gc t))) (setf (gethash x1 ht) 11) (setf (gethash x2 ht) 22) (setf (gethash '1000 ht) 11999) (gc) (gethash x1 ht) (setf (gethash '10000000000000000000 ht) 11999999999999)))) WARNING ;; Test *warn-on-hashtable-needing-rehash-after-gc*. (block nil (handler-bind ((WARNING #'(lambda (w) (declare (ignore w)) (return 'WARNING)))) (let ((custom:*warn-on-hashtable-needing-rehash-after-gc* t)) (let ((x1 (make-instance 'ext:standard-stablehash)) (x2 (make-instance 'ext:standard-stablehash)) (ht (make-hash-table :test 'ext:stablehash-eq))) (setf (gethash x1 ht) 11) (setf (gethash x2 ht) 22) (setf (gethash '1000 ht) 11999) (gc) (gethash x1 ht) (setf (gethash '10000000000000000000 ht) 11999999999999) (gc) (gethash x1 ht))))) WARNING --__--__-- Message: 6 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/doc impbody.xml,1.248,1.249 Date: Mon, 14 Jun 2004 10:45:00 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/doc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13034/doc Modified Files: impbody.xml Log Message: New variable *WARN-ON-HASHTABLE-NEEDING-REHASH-AFTER-GC*. Index: impbody.xml =================================================================== RCS file: /cvsroot/clisp/clisp/doc/impbody.xml,v retrieving revision 1.248 retrieving revision 1.249 diff -u -d -r1.248 -r1.249 --- impbody.xml 14 Jun 2004 10:38:22 -0000 1.248 +++ impbody.xml 14 Jun 2004 10:44:58 -0000 1.249 @@ -2534,6 +2534,14 @@ <para>See also <olink targetdoc="impnotes" targetptr="weak-ht"/>.</para> +<para>While <constant>:WARN-IF-NEEDS-REHASH-AFTER-GC</constant> can help + checking the efficiency of a particular hash table, the variable + <constant>CUSTOM:*WARN-ON-HASHTABLE-NEEDING-REHASH-AFTER-GC*</constant> + achieves the same effect for all hash table in the system at once: When + <constant>CUSTOM:*WARN-ON-HASHTABLE-NEEDING-REHASH-AFTER-GC*</constant> + is true and a hash table needs to be rehashed after a &gc;ion, a warning + is issued that shows the inefficient hash table.</para> + </section> <section id="defhash"><title>Macro &defhash;</title> --__--__-- Message: 7 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/tests tests.lisp,1.35,1.36 ChangeLog,1.180,1.181 Date: Mon, 14 Jun 2004 10:45:02 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/tests In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13034/tests Modified Files: tests.lisp ChangeLog Log Message: New variable *WARN-ON-HASHTABLE-NEEDING-REHASH-AFTER-GC*. Index: tests.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/tests/tests.lisp,v retrieving revision 1.35 retrieving revision 1.36 diff -u -d -r1.35 -r1.36 --- tests.lisp 9 Jun 2004 19:30:08 -0000 1.35 +++ tests.lisp 14 Jun 2004 10:44:59 -0000 1.36 @@ -170,6 +170,7 @@ #+CLISP "genstream" #+XCL "hash" "hashlong" + #+CLISP "hashtable" "iofkts" "lambda" "lists151" Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/tests/ChangeLog,v retrieving revision 1.180 retrieving revision 1.181 diff -u -d -r1.180 -r1.181 --- ChangeLog 9 Jun 2004 19:30:09 -0000 1.180 +++ ChangeLog 14 Jun 2004 10:44:59 -0000 1.181 @@ -1,3 +1,8 @@ +2004-05-15 Bruno Haible <br...@cl...> + + * hashtable.tst: New file. + * tests.lisp (run-all-tests): Run also hashtable.tst. + 2004-06-09 Sam Steingold <sd...@gn...> * tests.lisp (with-ignored-errors): return the error message on --__--__-- Message: 8 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src spvw.d,1.300,1.301 hashtabl.d,1.99,1.100 constsym.d,1.251,1.252 ChangeLog,1.3177,1.3178 Date: Mon, 14 Jun 2004 10:45:01 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13034/src Modified Files: spvw.d hashtabl.d constsym.d ChangeLog Log Message: New variable *WARN-ON-HASHTABLE-NEEDING-REHASH-AFTER-GC*. Index: spvw.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/spvw.d,v retrieving revision 1.300 retrieving revision 1.301 diff -u -d -r1.300 -r1.301 --- spvw.d 14 Jun 2004 10:38:13 -0000 1.300 +++ spvw.d 14 Jun 2004 10:44:58 -0000 1.301 @@ -1154,6 +1154,7 @@ define_variable(S(eq_hashfunction),S(fasthash_eq)); # EXT:*EQ-HASHFUNCTION* := 'EXT:FASTHASH-EQ define_variable(S(eql_hashfunction),S(fasthash_eql)); # EXT:*EQL-HASHFUNCTION* := 'EXT:FASTHASH-EQL define_variable(S(equal_hashfunction),S(fasthash_equal)); # EXT:*EQUAL-HASHFUNCTION* := 'EXT:FASTHASH-EQUAL + define_variable(S(warn_on_hashtable_needing_rehash_after_gc),NIL); # CUSTOM:*WARN-ON-HASHTABLE-NEEDING-REHASH-AFTER-GC* := NIL # for PACKAGE: define_variable(S(packagestern),Car(O(all_packages))); # *PACKAGE* := '#<PACKAGE LISP> # for SYMBOL: Index: constsym.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/constsym.d,v retrieving revision 1.251 retrieving revision 1.252 diff -u -d -r1.251 -r1.252 --- constsym.d 14 Jun 2004 10:38:19 -0000 1.251 +++ constsym.d 14 Jun 2004 10:44:58 -0000 1.252 @@ -1344,6 +1344,7 @@ LISPSYM(stablehash_equal,"STABLEHASH-EQUAL",ext) /* test for HASHTABL */ LISPSYM(equal_hashfunction,"*EQUAL-HASHFUNCTION*",ext) /* variable for HASHTABL */ LISPSYM(structure_stablehash,"STRUCTURE-STABLEHASH",clos) /* class for HASHTABL */ +LISPSYM(warn_on_hashtable_needing_rehash_after_gc,"*WARN-ON-HASHTABLE-NEEDING-REHASH-AFTER-GC*",custom) /* variable for HASHTABL */ LISPSYM(simple_vector,"SIMPLE-VECTOR",lisp) /* type in SEQUENCE, PREDTYPE */ LISPSYM(simple_string,"SIMPLE-STRING",lisp) /* type in SEQUENCE, PREDTYPE */ LISPSYM(base_string,"BASE-STRING",lisp) /* type in SEQUENCE, PREDTYPE */ Index: hashtabl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/hashtabl.d,v retrieving revision 1.99 retrieving revision 1.100 diff -u -d -r1.99 -r1.100 --- hashtabl.d 14 Jun 2004 10:41:06 -0000 1.99 +++ hashtabl.d 14 Jun 2004 10:44:58 -0000 1.100 @@ -1535,6 +1535,16 @@ return ht; } +/* Warn if a hash table is rehashed because of a GC, degrading performance. + can trigger GC */ +local void warn_forced_gc_rehash (object ht) { + pushSTACK(CLSTEXT("Performance/scalability warning: The hash table ~S needs " + "to be rehashed after a garbage collection, since it " + "contains key whose hash code is not GC-invariant.")); + pushSTACK(ht); + funcall(S(warn),2); +} + /* UP: Searches a key in a hash-table. hash_lookup_builtin(ht,obj,&KVptr,&Iptr) > ht: hash-table @@ -1549,8 +1559,18 @@ global bool hash_lookup_builtin (object ht, object obj, gcv_object_t** KVptr_, gcv_object_t** Iptr_) { #ifdef GENERATIONAL_GC - if (!ht_validp(TheHashtable(ht))) /* hash-table must be reorganized */ + if (!ht_validp(TheHashtable(ht))) { /* hash-table must be reorganized */ + # Rehash it before the warning, otherwise we risk an endless recursion. ht = rehash(ht); + # Warn if *WARN-ON-HASHTABLE-NEEDING-REHASH-AFTER-GC* is true: + if (!nullpSv(warn_on_hashtable_needing_rehash_after_gc)) { + pushSTACK(ht); pushSTACK(obj); + warn_forced_gc_rehash(ht); + obj = popSTACK(); ht = popSTACK(); + } + if (!ht_validp(TheHashtable(ht))) /* must be reorganized again? */ + ht = rehash(ht); + } #endif ASSERT(ht_validp(TheHashtable(ht))); var uintB flags = record_flags(TheHashtable(ht)); @@ -1579,8 +1599,18 @@ #ifndef GENERATIONAL_GC global bool hash_lookup_builtin_with_rehash (object ht, object obj, gcv_object_t** KVptr_, gcv_object_t** Iptr_) { - if (!ht_validp(TheHashtable(ht))) /* hash-table must be reorganized */ + if (!ht_validp(TheHashtable(ht))) { /* hash-table must be reorganized */ + # Rehash it before the warning, otherwise we risk an endless recursion. ht = rehash(ht); + # Warn if *WARN-ON-HASHTABLE-NEEDING-REHASH-AFTER-GC* is true: + if (!nullpSv(warn_on_hashtable_needing_rehash_after_gc)) { + pushSTACK(ht); pushSTACK(obj); + warn_forced_gc_rehash(ht); + obj = popSTACK(); ht = popSTACK(); + } + if (!ht_validp(TheHashtable(ht))) /* must be reorganized again? */ + ht = rehash(ht); + } return hash_lookup_builtin(ht,obj,KVptr_,Iptr_); } #endif Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3177 retrieving revision 1.3178 diff -u -d -r1.3177 -r1.3178 --- ChangeLog 14 Jun 2004 10:41:06 -0000 1.3177 +++ ChangeLog 14 Jun 2004 10:44:58 -0000 1.3178 @@ -1,5 +1,13 @@ 2004-05-15 Bruno Haible <br...@cl...> + * spvw.d (init_symbol_values): Initialize + *WARN-ON-HASHTABLE-NEEDING-REHASH-AFTER-GC* to NIL. + * hashtabl.d (warn_forced_gc_rehash): New function. + (hash_lookup_builtin, hash_lookup_builtin_with_rehash): Call it when + *WARN-ON-HASHTABLE-NEEDING-REHASH-AFTER-GC* is true. + +2004-05-15 Bruno Haible <br...@cl...> + * hashtabl.d (clrhash): Reorganize the hash table immediately, instead of delaying the reorganization. --__--__-- _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest |