home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / CLISP-1.LHA / CLISP960530-sr.lha / tests / hashlong.tst < prev    next >
Encoding:
Text File  |  1996-04-15  |  1.6 KB  |  45 lines
  1. #+CLISP (progn (setf (symbol-function 'setf-gethash)
  2.                      (symbol-function 'sys::puthash)) t)
  3. #+CLISP t
  4. #+AKCL (progn (setf (symbol-function 'setf-gethash)
  5.                     (symbol-function 'sys:hash-set)) t)
  6. #+AKCL t
  7.  
  8. (DEFUN SYMBOLE ()
  9.   (LET ((B 0.)
  10.         (HASH-TABLE (MAKE-HASH-TABLE :SIZE 20. :REHASH-THRESHOLD #+XCL 15. #-XCL 0.75))
  11.         (LISTE (MAKE-LIST 50.))
  12.         (LISTE2 (MAKE-LIST 50.)))
  13.     (RPLACD (LAST LISTE) LISTE)
  14.     (RPLACD (LAST LISTE2) LISTE2)
  15.     (DO-SYMBOLS (X (FIND-PACKAGE #+XCL 'lisptest #-XCL "LISP"))
  16. ;     (PRINT X) (FINISH-OUTPUT)
  17.       (COND ((CAR LISTE)
  18.              (LET ((HVAL (GETHASH (CAR LISTE) HASH-TABLE))
  19.                    (LVAL (CAR LISTE2)))
  20.                (UNLESS (EQ HVAL LVAL)
  21.                  (PRINT "mist, hash-tabelle kaputt")
  22.                  (PRINT (CAR LISTE))
  23.                  (PRINT HASH-TABLE)
  24.                  (PRINT (HASH-TABLE-COUNT HASH-TABLE))
  25.                  (PRINT "hval:") (PRINT HVAL)
  26.                  (PRINT "lval:") (PRINT LVAL)
  27.                  (return-from symbols 'error))
  28.                (REMHASH (CAR LISTE) HASH-TABLE)
  29.                #+XCL (WHEN (< (ROOM) 30000.) (SYSTEM::%GARBAGE-COLLECTION))
  30.                (SETF-GETHASH X HASH-TABLE (SETQ B (+ 1. B)))
  31.                (RPLACA LISTE X)
  32.                (RPLACA LISTE2 B)
  33.                (SETQ LISTE (CDR LISTE))
  34.                (SETQ LISTE2 (CDR LISTE2))))
  35.             (T (SETF-GETHASH X HASH-TABLE (SETQ B (+ 1. B)))
  36.                (RPLACA LISTE X)
  37.                (RPLACA LISTE2 B)
  38.                (SETQ LISTE (CDR LISTE))
  39.                (SETQ LISTE2 (CDR LISTE2)))))))
  40. symbole
  41.  
  42.  
  43. (SYMBOLE) nil
  44.  
  45.