From 574751f5962dfe48c92839a45e4187d1d8ad244e Mon Sep 17 00:00:00 2001 From: Guilherme Affonso Date: Thu, 5 May 2022 19:52:34 +0900 Subject: [PATCH 1/4] Add hashtable and package symvector tests --- test/hashtable.l | 105 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 105 insertions(+) create mode 100644 test/hashtable.l diff --git a/test/hashtable.l b/test/hashtable.l new file mode 100644 index 000000000..3fb5c94e5 --- /dev/null +++ b/test/hashtable.l @@ -0,0 +1,105 @@ +(require :unittest "lib/llib/unittest.l") + +(init-unit-test) + +(deftest test-hashtable-delete () + (let ((ht (make-hash-table :size 10))) + (dotimes (i (send ht :size)) + (send ht :enter i t) + (send ht :delete i)) + (assert (find (lisp::hash-table-empty ht) (hash-table-key ht)) + "No empty members left in hash table"))) + +(deftest test-hashtable-count () + (flet ((check-count (ht) + (assert (= (hash-table-count ht) + (- (hash-table-size ht) + (count (lisp::hash-table-empty ht) (hash-table-key ht)) + (count (lisp::hash-table-deleted ht) (hash-table-key ht)))) + "Hash-table count value does not match!") + (when (find 'lisp::fill-count (send hash-table :slots)) + (assert (= (ht . lisp::fill-count) + (- (hash-table-size ht) + (count (lisp::hash-table-empty ht) (hash-table-key ht)))) + "Hash-table count value does not match!")))) + (let ((ht (make-hash-table :size 10 :rehash-size 2.0))) + (dotimes (i 6) (send ht :enter i t)) + (check-count ht) + (dotimes (i 6) (send ht :delete i)) + (check-count ht) + (send ht :extend) + (check-count ht)))) + +(deftest test-package-unintern () + (let ((pkg (make-package (symbol-pname (gensym "TEST-PACKAGE"))))) + (dotimes (i (length (package-intsymvector pkg))) + (unintern + (intern (format nil "A~c" (+ #\A i)) pkg) + pkg)) + (assert (find 0 (package-intsymvector pkg)) + "No empty members left in package"))) + +(deftest test-package-unintern-export () + (let ((pkg (make-package (symbol-pname (gensym "TEST-PACKAGE"))))) + (dotimes (i (length (package-intsymvector pkg))) + (let ((sym (intern (format nil "A~c" (+ #\A i)) pkg))) + (export sym pkg) + (unintern sym pkg))) + (assert (find 0 (package-intsymvector pkg)) + "No empty internal members left in package") + (assert (find 0 (package-symvector pkg)) + "No empty external members left in package"))) + +;; (deftest test-package-enter-unintern () +;; (let ((pkg (make-package "TEST-PACKAGE"))) +;; (dotimes (i (length (package-intsymvector pkg))) +;; (let ((sym (intern (format nil "~c" (+ #\A i)) *user-package*))) +;; (send pkg :unintern (send pkg :enter sym)))) +;; (assert (find 0 (package-intsymvector pkg)) +;; "No empty members left in package"))) + +(deftest test-package-intsymcount () + (flet ((check-count (pkg) + (assert (= (package-intsymcount pkg) + (- (length (package-intsymvector pkg)) + (count 0 (package-intsymvector pkg)))) + "Package intsymcount value does not match!"))) + (let* ((pkg (make-package (symbol-pname (gensym "TEST-PACKAGE")))) + (half-len (/ (length (package-intsymvector pkg)) 2))) + (dotimes (i half-len) + (intern (format nil "A~c" (+ #\A i)) pkg)) + (check-count pkg) + (dotimes (i half-len) + (unintern (intern (format nil "A~c" (+ #\A i)) pkg) pkg)) + (check-count pkg) + ;; assuming a rehash-size of 2.0 + (intern (format nil "A~c" (+ #\A half-len)) pkg) ;; extend + (check-count pkg)))) + +(deftest test-package-symcount () + (flet ((check-count (pkg) + (assert (= (package-intsymcount pkg) + (- (length (package-intsymvector pkg)) + (count 0 (package-intsymvector pkg)))) + "Package intsymcount value does not match!") + (assert (= (package-symcount pkg) + (- (length (package-symvector pkg)) + (count 0 (package-symvector pkg)))) + "Package symcount value does not match!"))) + (let* ((pkg (make-package (symbol-pname (gensym "TEST-PACKAGE")))) + (half-len (/ (length (package-intsymvector pkg)) 2))) + (dotimes (i half-len) + (let ((sym (intern (format nil "A~c" (+ #\A i)) pkg))) + (export sym pkg))) + (check-count pkg) + (dotimes (i half-len) + (unintern (intern (format nil "A~c" (+ #\A i)) pkg) pkg)) + (check-count pkg) + ;; assuming a rehash-size of 2.0 + (intern (format nil "A~c" (+ #\A half-len)) pkg) ;; extend + (check-count pkg)))) + + +(eval-when (load eval) + (run-all-tests) + (exit)) From 0fe480566486f4e24b1164988915c3b6345aa20a Mon Sep 17 00:00:00 2001 From: Guilherme Affonso Date: Thu, 5 May 2022 19:54:12 +0900 Subject: [PATCH 2/4] Add fill-count to count deleted members in hash-tables (fixes #405) --- lisp/l/hashtab.l | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/lisp/l/hashtab.l b/lisp/l/hashtab.l index 525b9ce5d..aab35fce8 100644 --- a/lisp/l/hashtab.l +++ b/lisp/l/hashtab.l @@ -12,6 +12,7 @@ ((key :type vector) (value :type vector) (size :type :integer) + (fill-count :type :integer) (count :type :integer) (hash-function) (test-function) @@ -45,11 +46,13 @@ (:enter (sym val) (let ((entry (send self :find sym))) (when (>= entry size) ;new entry? - (when (> count (/ size rehash-size)) + (when (> fill-count (/ size rehash-size)) (send self :extend) (setq entry (send self :find sym)) ) + (setq entry (- entry size)) (inc count) - (setq entry (- entry size))) + (if (eq (svref key entry) empty) + (inc fill-count))) (svset key entry sym) (svset value entry val) val)) @@ -74,6 +77,7 @@ x size size altsize altsize x + fill-count 0 count 0) (dotimes (i altsize) (setq x (svref altkey i)) @@ -133,6 +137,7 @@ empty (gensym "EMPTY") deleted (gensym "DEL") not-found nofound + fill-count 0 count 0 rehash-size rehash) (dotimes (i s) (svset key i empty)) From 29b12fa4e706f544d6b47161515985780abbb555 Mon Sep 17 00:00:00 2001 From: Guilherme Affonso Date: Thu, 5 May 2022 19:54:44 +0900 Subject: [PATCH 3/4] Count deleted members in package intsymcount and symcount --- lisp/c/intern.c | 25 ++++++++++++++++--------- lisp/l/packsym.l | 10 +++++----- 2 files changed, 21 insertions(+), 14 deletions(-) diff --git a/lisp/c/intern.c b/lisp/c/intern.c index b8f6d1901..f3b683d97 100644 --- a/lisp/c/intern.c +++ b/lisp/c/intern.c @@ -45,8 +45,9 @@ register pointer symvec; if (++hash>=size) hash=0;} while (1);} -static pointer extendsymvec(symvec) +static pointer extendsymvec(symvec, count) pointer symvec; +int* count; { register pointer newsymvec,sym; bpointer bp; register int i,newsize,size,hash; @@ -58,10 +59,12 @@ pointer symvec; newsize=buddysize[bp->h.bix+1]-2; #endif newsymvec=makevector(C_VECTOR,newsize); + *count=0; for (i=0; ic.vec.v[i]=makeint(0); /*empty mark*/ for (i=0; ic.vec.v[i]; if (issymbol(sym)) { + ++(*count); hash=rehash(sym->c.sym.pname) % newsize; while (newsymvec->c.vec.v[hash]!=makeint(0)) { /*find an empty slot*/ if (++hash>=newsize) hash=0;} @@ -74,8 +77,8 @@ pointer symvec; pointer export(sym,pkg) pointer sym,pkg; { register pointer symvec=pkg->c.pkg.symvector; /*external symbol table*/ - register int size, newsymcount; - int hash; + register int size; + int hash, newsymcount; pointer usedby,usedbylist=pkg->c.pkg.used_by; pointer pnam,s; @@ -93,11 +96,13 @@ pointer sym,pkg; while (1) { if (symvec->c.vec.v[hash]==sym) return(sym); if (isint(symvec->c.vec.v[hash])) { + newsymcount=intval(pkg->c.pkg.symcount); + if(intval(symvec->c.vec.v[hash]) == 0) // only increase count if empty + newsymcount+=1; pointer_update(symvec->c.vec.v[hash],sym); - newsymcount=intval(pkg->c.pkg.symcount)+1; + if (newsymcount > (size / 2)) + pointer_update(pkg->c.pkg.symvector, extendsymvec(symvec, &newsymcount)); pkg->c.pkg.symcount=makeint(newsymcount); - if (newsymcount > (size / 2)) - pointer_update(pkg->c.pkg.symvector, extendsymvec(symvec)); return(sym);} else if (++hash>=size) hash=0;} } @@ -123,17 +128,19 @@ pointer pkg; /*destination package*/ newsym=makesymbol(ctx,id,l,pkg); /*put it in the package*/ while (issymbol(symvec->c.vec.v[hash])) if (++hash>=size) hash=0; + l=intval(pkg->c.pkg.intsymcount); + if (intval(symvec->c.vec.v[hash]) == 0) // only increase count if empty + l+=1; pointer_update(symvec->c.vec.v[hash],newsym); if (pkg==keywordpkg) { newsym->c.sym.vtype=V_CONSTANT; pointer_update(newsym->c.sym.speval,newsym); export(newsym,pkg);} - l=intval(pkg->c.pkg.intsymcount)+1; - pkg->c.pkg.intsymcount=makeint(l); if (l>(size/2)) { /*extend hash table*/ vpush(newsym); - pointer_update(pkg->c.pkg.intsymvector,extendsymvec(symvec)); + pointer_update(pkg->c.pkg.intsymvector,extendsymvec(symvec, &l)); vpop();} + pkg->c.pkg.intsymcount=makeint(l); /* export all the symbols to avoid incompatibility with old EusLisp*/ if (export_all) export(newsym, pkg); #ifdef SAFETY diff --git a/lisp/l/packsym.l b/lisp/l/packsym.l index 7ed3cc73c..3fb3c388c 100644 --- a/lisp/l/packsym.l +++ b/lisp/l/packsym.l @@ -150,8 +150,10 @@ (if (>= intsymcount size) (error "can not enter ~a into this package, maximum symbol size is ~a" sym size)) (while (symbolp (svref intsymvector hash)) (if (>= (setq hash (1+ hash)) size) (setq hash 0))) + (if (= (elt intsymvector hash) 0) + (setq intsymcount (1+ intsymcount))) (svset intsymvector hash sym) - (setq intsymcount (1+ intsymcount)) + ;; TODO: expand if necessary sym)) (:find (s) ;find symbol just in this package (declare (symbol s)) @@ -179,12 +181,10 @@ (setq (sym . homepkg) nil)) (setq pos (send self :find sym)) (when pos - (svset intsymvector pos 1) ;deleted mark - (setq intsymcount (1- intsymcount))) + (svset intsymvector pos 1)) ;deleted mark (setq pos (send self :find-external sym)) (when pos - (svset symvector pos 1) ;deleted mark - (setq symcount (1- symcount))) + (svset symvector pos 1)) ;deleted mark )) (:find-external (s) (declare (symbol s)) From d689c003d7d7b09b105615c3e39b3023277bfeef Mon Sep 17 00:00:00 2001 From: Guilherme Affonso Date: Thu, 5 May 2022 19:56:09 +0900 Subject: [PATCH 4/4] Reset hash-table count and fill-count in :clear --- lisp/l/hashtab.l | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/l/hashtab.l b/lisp/l/hashtab.l index aab35fce8..3558f177a 100644 --- a/lisp/l/hashtab.l +++ b/lisp/l/hashtab.l @@ -122,6 +122,8 @@ (dotimes (i size) (setf (aref key i) empty (aref value i) nil)) + (setq count 0) + (setq fill-count 0) self) (:prin1 (&optional (strm t) &rest mesgs) (send-super* :prin1 strm