(loader '((title |hash.lo|)))
(if (not (>= (version) 15.2)) (progn (error 'load 'erricf 'hash)))
(defvar #:sys-package:colon 'hash-table)
(add-feature 'hash-table)
(defvar #:hash-table:debug ())
(defvar #:hash-table:errnht "L'argument n'est pas une table de hachage")
(defvar #:hash-table:errbht "Le type de la table de hachage est inconnu")
(loader'((entry #:hash-table:error-nht subr2)
(mov a2 a3)
(mov '#:hash-table:errnht a2)
(jmp error)
))
(loader'((entry #:hash-table:error-bht subr2)
(mov a2 a3)
(mov '#:hash-table:errbht a2)
(jmp error)
))
(defvar #:hash-table:default-lowest-size 17)
(defvar #:hash-table:default-biggest-size 9239)
(defvar #:hash-table:default-max-number-of-entries 32767)
(defvar #:hash-table:default-max-bucket-length 12)
(defvar #:hash-table:default-growing-threshold (scale #:hash-table:default-max-bucket-length 1 2))
(defvar #:hash-table:default-growing-factor 1.6)
(defvar #:hash-table:default-shrinking-threshold 2)
(defvar #:hash-table:default-shrinking-factor 2.)
(defvar #:hash-table:max-significative-element 10)
(putprop 'hash-table '(('eq #[] 0 (dynamic #:hash-table:default-lowest-size) (dynamic #:hash-table:default-max-bucket-length) (dynamic #:hash-table:default-growing-threshold) (dynamic #:hash-table:default-growing-factor) (dynamic #:hash-table:default-shrinking-threshold) (dynamic #:hash-table:default-shrinking-factor)) type vect entries size max-bucket-length growing-threshold growing-factor shrinking-threshold shrinking-factor) 'defstruct)
(loader'((entry #:hash-table:make subr0)
(push (@ 101))
(push 'eq)
(push '#[])
(push '0)
(push (cvalq #:hash-table:default-lowest-size))
(push (cvalq #:hash-table:default-max-bucket-length))
(push (cvalq #:hash-table:default-growing-threshold))
(push (cvalq #:hash-table:default-growing-factor))
(push (cvalq #:hash-table:default-shrinking-threshold))
(push (cvalq #:hash-table:default-shrinking-factor))
(mov '9 a4)
(jmp vector)
101
(eval ())
(push a1)
(push (@ 102))
(push a1)
(push 'hash-table)
(mov '2 a4)
(jmp typevector)
102
(eval ())
(mov (& 0) a1)
(adjstk '1)
(return)
))
(if (featurep 'setf) (progn (progn (putprop '#:hash-table:type '#:hash-table:type 'setf-inverse) '#:hash-table:type)))
(if (featurep 'compiler) (progn (defmacro-open #:hash-table:type (struct . valeur) (ifn valeur (list 'vref struct 0) (list 'vset struct 0 (car valeur))))))
(if (featurep 'setf) (progn (progn (putprop '#:hash-table:vect '#:hash-table:vect 'setf-inverse) '#:hash-table:vect)))
(if (featurep 'compiler) (progn (defmacro-open #:hash-table:vect (struct . valeur) (ifn valeur (list 'vref struct 1) (list 'vset struct 1 (car valeur))))))
(if (featurep 'setf) (progn (progn (putprop '#:hash-table:entries '#:hash-table:entries 'setf-inverse) '#:hash-table:entries)))
(if (featurep 'compiler) (progn (defmacro-open #:hash-table:entries (struct . valeur) (ifn valeur (list 'vref struct 2) (list 'vset struct 2 (car valeur))))))
(if (featurep 'setf) (progn (progn (putprop '#:hash-table:size '#:hash-table:size 'setf-inverse) '#:hash-table:size)))
(if (featurep 'compiler) (progn (defmacro-open #:hash-table:size (struct . valeur) (ifn valeur (list 'vref struct 3) (list 'vset struct 3 (car valeur))))))
(if (featurep 'setf) (progn (progn (putprop '#:hash-table:max-bucket-length '#:hash-table:max-bucket-length 'setf-inverse) '#:hash-table:max-bucket-length)))
(if (featurep 'compiler) (progn (defmacro-open #:hash-table:max-bucket-length (struct . valeur) (ifn valeur (list 'vref struct 4) (list 'vset struct 4 (car valeur))))))
(if (featurep 'setf) (progn (progn (putprop '#:hash-table:growing-threshold '#:hash-table:growing-threshold 'setf-inverse) '#:hash-table:growing-threshold)))
(if (featurep 'compiler) (progn (defmacro-open #:hash-table:growing-threshold (struct . valeur) (ifn valeur (list 'vref struct 5) (list 'vset struct 5 (car valeur))))))
(if (featurep 'setf) (progn (progn (putprop '#:hash-table:growing-factor '#:hash-table:growing-factor 'setf-inverse) '#:hash-table:growing-factor)))
(if (featurep 'compiler) (progn (defmacro-open #:hash-table:growing-factor (struct . valeur) (ifn valeur (list 'vref struct 6) (list 'vset struct 6 (car valeur))))))
(if (featurep 'setf) (progn (progn (putprop '#:hash-table:shrinking-threshold '#:hash-table:shrinking-threshold 'setf-inverse) '#:hash-table:shrinking-threshold)))
(if (featurep 'compiler) (progn (defmacro-open #:hash-table:shrinking-threshold (struct . valeur) (ifn valeur (list 'vref struct 7) (list 'vset struct 7 (car valeur))))))
(if (featurep 'setf) (progn (progn (putprop '#:hash-table:shrinking-factor '#:hash-table:shrinking-factor 'setf-inverse) '#:hash-table:shrinking-factor)))
(if (featurep 'compiler) (progn (defmacro-open #:hash-table:shrinking-factor (struct . valeur) (ifn valeur (list 'vref struct 8) (list 'vset struct 8 (car valeur))))))
(putprop 'gethash (lambda (value key hash-table) (list 'puthash key hash-table value)) 'setf-expander)
'gethash
(loader'((fentry hash-table-p subr1)
(entry hash-table-p subr1)
(jcall type-of)
(cabne a1 'hash-table 101)
(mov 't a1)
(return)
101
(mov nil a1)
(return)
))
(loader'((fentry #:hash-table:eval subr1)
(entry #:hash-table:eval subr1)
(return)
))
(loader'((fentry #:hash-table:prin subr1)
(entry #:hash-table:prin subr1)
(push a1)
(push nil)
(push (cvalq #:system:print-for-read))
(mov (& 1) (cvalq #:system:print-for-read))
(push '1)
(push '(#:system:print-for-read))
(push 'lambda)
(push llink)
(push dlink)
(push cbindn)
(stack dlink)
(push (@ 101))
(push (@ 102))
(push '"#")
(hpxmov a1 '3 a4)
(push a4)
(push '"H")
(mov '3 a4)
(jmp catenate)
102
(eval ())
(push a1)
(mov '1 a4)
(jmp prin)
101
(eval ())
(mov (& 1) dlink)
(mov (& 6) (cvalq #:system:print-for-read))
(adjstk '8)
(btnil (cvalq #:system:print-for-read) 103)
(push nil)
(push (cvalq #:system:print-for-read))
(mov (& 1) (cvalq #:system:print-for-read))
(push '1)
(push '(#:system:print-for-read))
(push 'lambda)
(push llink)
(push dlink)
(push cbindn)
(stack dlink)
(push (@ 105))
(push '"(")
(mov '1 a4)
(jmp prin)
105
(eval ())
(mov (& 1) dlink)
(mov (& 6) (cvalq #:system:print-for-read))
(adjstk '8)
(push (@ 106))
(hpxmov (& 1) '0 a4)
(push a4)
(mov '1 a4)
(jmp prin)
106
(eval ())
(push '0)
(hpxmov (& 1) '1 a4)
(push a4)
(hgsize a4 a3)
(push a3)
107
(cnbge (& 2) (& 0) 108)
(hpxmov (& 1) (& 2) a4)
(bfcons a4 110)
(push a4)
111
(bfcons (& 0) 112)
(mov (& 0) a4)
(mov (cdr a4) (& 0))
(push (car a4))
(mov (& 0) a4)
(push (car a4))
(push (cdr a4))
(push (@ 113))
(push (@ 114))
(push (& 3))
(push (& 3))
(mov '2 a4)
(jmp list)
114
(eval ())
(push a1)
(mov '1 a4)
(jmp prin)
113
(eval ())
(adjstk '3)
(bra 111)
112
(adjstk '1)
110
(mov (& 2) a4)
(plus '1 a4)
(mov a4 (& 2))
(bra 107)
108
(adjstk '3)
(push nil)
(push (cvalq #:system:print-for-read))
(mov (& 1) (cvalq #:system:print-for-read))
(push '1)
(push '(#:system:print-for-read))
(push 'lambda)
(push llink)
(push dlink)
(push cbindn)
(stack dlink)
(push (@ 115))
(push '")")
(mov '1 a4)
(jmp prin)
115
(eval ())
(mov (& 1) dlink)
(mov (& 6) (cvalq #:system:print-for-read))
(adjstk '9)
(return)
103
(push (@ 116))
(push (@ 117))
(push '"<")
(hpxmov (& 3) '2 a4)
(push a4)
(push '">")
(mov '3 a4)
(jmp catenate)
117
(eval ())
(push a1)
(mov '1 a4)
(jmp prin)
116
(eval ())
(adjstk '1)
(return)
))
(defsharp H (size) (let ((lst (read))) (if (atom lst) (error '|#H| 'errsxt "not printed properly") (let ((hash-table (make-hash-table size (car lst)))) (mapc (lambda (key value) (setf (gethash hash-table key) value)) (cdr lst)) hash-table))))
(loader'((fentry make-hash-table-eq nsubr)
(entry make-hash-table-eq nsubr)
(push a4)
(mov (& 0) a1)
(cabne a1 '0 102)
(mov 'eq a2)
(mov (cvalq #:hash-table:default-lowest-size) a1)
(call #:hash-table:create-internal)
(bra 101)
102
(cabne a1 '1 103)
(mov (& 0) a4)
(plus '0 a4)
(xspmov a4 a2)
(mov 'make-hash-table-eq a1)
(call #:hash-table:default-size)
(mov 'eq a2)
(call #:hash-table:create-internal)
(bra 101)
103
(mov '1 a3)
(mov 'errwna a2)
(mov 'make-hash-table-equ a1)
(jcall error)
101
(pop a4)
(adjstk a4)
(return)
))
(loader'((fentry make-hash-table-equal nsubr)
(entry make-hash-table-equal nsubr)
(push a4)
(mov (& 0) a1)
(cabne a1 '0 102)
(mov 'equal a2)
(mov (cvalq #:hash-table:default-lowest-size) a1)
(call #:hash-table:create-internal)
(bra 101)
102
(cabne a1 '1 103)
(mov (& 0) a4)
(plus '0 a4)
(xspmov a4 a2)
(mov 'make-hash-table-equal a1)
(call #:hash-table:default-size)
(mov 'equal a2)
(call #:hash-table:create-internal)
(bra 101)
103
(mov '1 a3)
(mov 'errwna a2)
(mov 'make-hash-table-equal a1)
(jcall error)
101
(pop a4)
(adjstk a4)
(return)
))
(loader'((fentry make-hash-table nsubr)
(entry make-hash-table nsubr)
(push a4)
(mov (& 0) a1)
(cabne a1 '0 102)
(mov 'eq a2)
(mov (cvalq #:hash-table:default-lowest-size) a1)
(call #:hash-table:create-internal)
(bra 101)
102
(cabne a1 '1 103)
(mov (& 0) a4)
(plus '0 a4)
(xspmov a4 a2)
(mov 'make-hash-table a1)
(call #:hash-table:default-size)
(mov 'eq a2)
(call #:hash-table:create-internal)
(bra 101)
103
(cabne a1 '2 104)
(mov (& 0) a4)
(plus '0 a4)
(xspmov a4 a2)
(mov 'make-hash-table a1)
(call #:hash-table:default-size)
(push a1)
(mov (& 1) a4)
(plus '0 a4)
(xspmov a4 a4)
(mov a4 a3)
(cabeq a3 'eq 107)
(cabne a3 'equal 105)
107
(mov a3 a2)
(bra 106)
105
(mov a3 a2)
(mov 'make-hash-table a1)
(call #:hash-table:error-bht)
(mov a1 a2)
106
(pop a1)
(call #:hash-table:create-internal)
(bra 101)
104
(mov '2 a3)
(mov 'errwna a2)
(mov 'make-hash-table a1)
(jcall error)
101
(pop a4)
(adjstk a4)
(return)
))
(loader'((entry #:hash-table:default-size subr2)
(bfnil a2 101)
(mov (cvalq #:hash-table:default-lowest-size) a1)
(return)
101
(bffix a2 103)
(mov a2 a1)
(bra #:hash-table:compute-good-size)
103
(mov a2 a3)
(mov 'errnia a2)
(jmp error)
))
(loader'((entry #:hash-table:create-internal subr2)
(push a2)
(push a1)
(call #:hash-table:make)
(push a1)
(hpmovx (& 2) a1 '0)
(hpmovx (& 1) a1 '3)
(hpmovx '0 a1 '2)
(push a1)
(mov nil a2)
(mov (& 2) a1)
(jcall makevector)
(pop a4)
(hpmovx a1 a4 '1)
(mov (& 0) a1)
(adjstk '3)
(return)
))
(loader'((fentry sxhash subr1)
(entry sxhash subr1)
(call #:hash-table:sxhash)
(land '32767 a1)
(return)
))
(loader'((entry #:hash-table:sxhash subr1)
(bffix a1 101)
(return)
101
(btcons a1 105)
(bfvect a1 103)
105
(push (cvalq #:hash-table:max-significative-element))
(push '0)
(push (cvalq #:hash-table:result))
(mov (& 1) (cvalq #:hash-table:result))
(push (cvalq #:hash-table:count))
(mov (& 3) (cvalq #:hash-table:count))
(push '2)
(push '(#:hash-table:result #:hash-table:count))
(push 'lambda)
(push llink)
(push dlink)
(push cbindn)
(stack dlink)
(push (@ 106))
(push 'finish)
(push dlink)
(push tag)
(stack dlink)
(call #:hash-table:hash-sequence)
(mov (& 1) dlink)
(adjstk '4)
106
(eval ())
(mov (cvalq #:hash-table:result) a1)
(mov (& 1) dlink)
(mov (& 6) (cvalq #:hash-table:count))
(mov (& 7) (cvalq #:hash-table:result))
(adjstk '10)
(return)
103
(bfsymb a1 107)
(bra #:hash-table:hash-symbol)
107
(bfstrg a1 109)
(bra #:hash-table:hash-string)
109
(jmp #:system:locint)
))
(loader'((entry #:hash-table:hash-symbol subr1)
(push (pkgc a1))
(btnil (& 0) 101)
(bfsymb (& 0) 101)
(jcall string)
(call #:hash-table:hash-string)
(push a1)
(mov (& 1) a1)
(call #:hash-table:hash-symbol)
(pop a4)
(plus a1 a4)
(mov a4 a1)
(adjstk '1)
(return)
101
(jcall string)
(adjstk '1)
(bra #:hash-table:hash-string)
))
(loader'((entry #:hash-table:hash-sequence subr1)
(mov (cvalq #:hash-table:count) a4)
(diff '1 a4)
(mov a4 (cvalq #:hash-table:count))
(cabne a4 '0 101)
(mov nil a1)
(mov 'finish a2)
(jmp #:llcp:exit)
101
(bffix a1 103)
(plus (cvalq #:hash-table:result) a1)
(mov a1 (cvalq #:hash-table:result))
(return)
103
(bfcons a1 105)
(bra #:hash-table:hash-sequence-list)
105
(bfvect a1 107)
(bra #:hash-table:hash-sequence-vector)
107
(bfsymb a1 109)
(call #:hash-table:hash-symbol)
(plus (cvalq #:hash-table:result) a1)
(mov a1 (cvalq #:hash-table:result))
(return)
109
(bfstrg a1 111)
(call #:hash-table:hash-string)
(plus (cvalq #:hash-table:result) a1)
(mov a1 (cvalq #:hash-table:result))
(return)
111
(jcall #:system:locint)
(plus (cvalq #:hash-table:result) a1)
(mov a1 (cvalq #:hash-table:result))
(return)
))
(loader'((entry #:hash-table:hash-sequence-list subr1)
(push a1)
(btcons a1 101)
(adjstk '1)
(bra #:hash-table:hash-sequence)
101
(mov (car a1) a1)
(call #:hash-table:hash-sequence)
(mov (& 0) a1)
(mov (cdr a1) a1)
(adjstk '1)
(bra #:hash-table:hash-sequence-list)
))
(loader'((entry #:hash-table:hash-sequence-vector subr1)
(push a1)
(hgsize a1 a4)
(push a4)
101
(cabeq (& 0) '0 102)
(mov (& 0) a4)
(diff '1 a4)
(mov a4 (& 0))
(hpxmov (& 1) a4 a1)
(call #:hash-table:hash-sequence)
(bra 101)
102
(mov nil a1)
(adjstk '2)
(return)
))
(loader'((entry #:hash-table:hash-string subr1)
(push a1)
(hgsize a1 a4)
(push a4)
(push (cvalq #:hash-table:max-significative-element))
(push a4)
(cabne (& 2) '0 101)
(mov '1 a1)
(adjstk '4)
(return)
101
(cnbgt (& 2) (& 1) 103)
105
(cabeq (& 2) '0 106)
(mov (& 0) a4)
(plus (& 0) a4)
(mov a4 (& 0))
(cnbge a4 '0 108)
(land '32767 a4)
(lor '1 a4)
(mov a4 (& 0))
108
(mov (& 2) a3)
(diff '1 a3)
(mov a3 (& 2))
(hbxmov (& 3) a3 a3)
(plus a3 a4)
(mov a4 (& 0))
(bra 105)
106
(mov (& 0) a1)
(adjstk '4)
(return)
103
(mov (& 1) a3)
(quo '2 a3)
(push a3)
(mov (& 2) a2)
(mov (& 3) a1)
(jcall quo)
(plus '1 a1)
(push '0)
(push a1)
(mov (& 2) a4)
(bra 110)
109
(push a4)
(mov (& 4) a4)
(plus (& 4) a4)
(mov a4 (& 4))
(cnbge a4 '0 112)
(land '32767 a4)
(lor '1 a4)
(mov a4 (& 4))
112
(hbxmov (& 7) (& 2) a3)
(plus a3 a4)
(mov a4 (& 4))
(mov (& 2) a3)
(plus (& 1) a3)
(mov a3 (& 2))
(pop a4)
110
(sobgez a4 109)
(mov (& 5) a4)
(diff '1 a4)
(mov a4 (& 1))
(mov (& 2) a3)
(bra 114)
113
(push a3)
(mov (& 4) a4)
(plus (& 4) a4)
(mov a4 (& 4))
(cnbge a4 '0 116)
(land '32767 a4)
(lor '1 a4)
(mov a4 (& 4))
116
(hbxmov (& 7) (& 2) a3)
(plus a3 a4)
(mov a4 (& 4))
(mov (& 2) a3)
(diff (& 1) a3)
(mov a3 (& 2))
(pop a3)
114
(sobgez a3 113)
(mov (& 3) a1)
(adjstk '7)
(return)
))
(loader'((entry #:hash-table:get-slot-index subr3)
(push a3)
(push a2)
(push a1)
(mov a2 a1)
(jcall hash-table-p)
(btnil a1 101)
(hpxmov (& 1) '0 a1)
(cabne a1 'eq 104)
(mov (& 0) a1)
(jcall #:system:locint)
(hpxmov (& 1) '3 a4)
(rem a4 a1)
(adjstk '3)
(return)
104
(cabne a1 'equal 105)
(mov (& 0) a1)
(jcall sxhash)
(hpxmov (& 1) '3 a4)
(rem a4 a1)
(adjstk '3)
(return)
105
(mov (& 1) a2)
(mov (& 2) a1)
(adjstk '3)
(bra #:hash-table:error-bht)
101
(mov (& 1) a2)
(mov (& 2) a1)
(adjstk '3)
(bra #:hash-table:error-nht)
))
(loader'((entry #:hash-table:get-slot subr3)
(push a3)
(push a2)
(push a1)
(call #:hash-table:get-slot-index)
(push a1)
(hpxmov (& 2) '0 a1)
(cabne a1 'eq 102)
(hpxmov (& 2) '1 a2)
(hpxmov a2 (& 0) a2)
(mov (& 1) a1)
(jcall assq)
(bfnil a1 103)
(mov (& 0) a1)
103
(adjstk '4)
(return)
102
(cabne a1 'equal 104)
(hpxmov (& 2) '1 a2)
(hpxmov a2 (& 0) a2)
(mov (& 1) a1)
(jcall assoc)
(bfnil a1 105)
(mov (& 0) a1)
105
(adjstk '4)
(return)
104
(mov (& 2) a2)
(mov (& 3) a1)
(adjstk '4)
(bra #:hash-table:error-bht)
))
(loader'((entry #:hash-table:set-new-slot nsubr)
(hpxmov (& 3) '3 a4)
(push a4)
(hpxmov (& 4) '1 a3)
(push a3)
(hpxmov a3 (& 3) a2)
(push a2)
(hpxmov (& 6) '2 a1)
(cnblt a1 (cvalq #:hash-table:default-max-number-of-entries) 102)
(mov (& 7) a3)
(mov 'erroob a2)
(mov 'puthash a1)
(jcall error)
102
(hpxmov (& 6) '2 a4)
(plus '1 a4)
(hpmovx a4 (& 6) '2)
(mov (& 0) a3)
(mov (& 5) a2)
(mov (& 7) a1)
(jcall acons)
(hpmovx a1 (& 1) (& 4))
(mov (& 0) a1)
(jcall length)
(hpxmov (& 6) '4 a4)
(cnble a1 a4 106)
(hpxmov (& 6) '2 a4)
(quo (& 2) a4)
(cnbgt a4 '2 105)
106
(hpxmov (& 6) '2 a4)
(quo (& 2) a4)
(hpxmov (& 6) '5 a3)
(cnble a4 a3 104)
105
(cabeq (& 2) (cvalq #:hash-table:default-biggest-size) 104)
(mov (& 6) a1)
(call #:hash-table:growing-rehash)
104
(adjstk '3)
(mov (& 2) a1)
(adjstk '5)
(return)
))
(loader'((entry #:hash-table:rem-slot subr3)
(push a3)
(push a2)
(push a1)
(hpxmov a2 '3 a4)
(push a4)
(hpxmov a2 '0 a4)
(cabne a4 'eq 101)
(mov 't a4)
(bra 102)
101
(mov nil a4)
102
(push a4)
(hpxmov a2 '1 a4)
(push a4)
(hpxmov a4 a3 a4)
(push a4)
(push nil)
(push (@ 103))
(mov 'complete a1)
(jcall #:llcp:block)
104
(btnil (& 7) 108)
(mov (& 5) a2)
(mov (car a2) a2)
(mov (car a2) a2)
(mov (& 9) a1)
(jcall eq)
(mov a1 a4)
(bra 109)
108
(mov (& 5) a2)
(mov (car a2) a2)
(mov (car a2) a2)
(mov (& 9) a1)
(jcall equal)
(mov a1 a4)
109
(btnil a4 106)
(btnil (& 4) 110)
(push (& 4))
(mov (& 6) a4)
(push (cdr a4))
(mov (& 1) a3)
(mov (& 0) (cdr a3))
(adjstk '2)
(bra 111)
110
(mov (& 5) a4)
(hpmovx (cdr a4) (& 6) (& 11))
111
(hpxmov (& 10) '2 a3)
(diff '1 a3)
(hpmovx a3 (& 10) '2)
(hpxmov (& 10) '2 a3)
(quo (& 8) a3)
(hpxmov (& 10) '7 a2)
(cnbge a3 a2 113)
(cabeq (& 8) (cvalq #:hash-table:default-lowest-size) 113)
(mov (& 10) a1)
(call #:hash-table:shrinking-rehash)
113
(mov 't a1)
(mov 'complete a2)
(jmp #:llcp:retfrom)
106
(mov (& 5) (& 4))
(mov (& 5) a4)
(mov (cdr a4) (& 5))
(bfnil (& 5) 104)
(mov nil a1)
(mov 'complete a2)
(jmp #:llcp:retfrom)
105
(mov nil a1)
(return)
103
(eval ())
(adjstk '8)
(return)
))
(loader'((entry #:hash-table:growing-rehash subr1)
(push a1)
(push (@ 101))
(hpxmov a1 '3 a4)
(push a4)
(hpxmov a1 '6 a4)
(push a4)
(mov '2 a4)
(jmp *)
101
(eval ())
(jcall fix)
(call #:hash-table:compute-good-size)
(hpxmov (& 0) '0 a2)
(call #:hash-table:create-internal)
(mov a1 a2)
(mov (& 0) a1)
(adjstk '1)
(bra #:hash-table:internal-rehash)
))
(loader'((entry #:hash-table:shrinking-rehash subr1)
(push a1)
(push (@ 101))
(hpxmov a1 '3 a4)
(push a4)
(hpxmov a1 '8 a4)
(push a4)
(mov '2 a4)
(jmp /)
101
(eval ())
(jcall fix)
(call #:hash-table:compute-good-size)
(hpxmov (& 0) '0 a2)
(call #:hash-table:create-internal)
(mov a1 a2)
(mov (& 0) a1)
(adjstk '1)
(bra #:hash-table:internal-rehash)
))
(loader'((entry #:hash-table:internal-rehash subr2)
(push a1)
(push (cvalq new-hash-table))
(mov a2 (cvalq new-hash-table))
(push '1)
(push '(new-hash-table))
(push (@ #:hash-table:internal-rehash))
(push llink)
(mov nil llink)
(push dlink)
(push cbindn)
(stack dlink)
(btnil (cvalq #:hash-table:debug) 103)
(mov a1 a2)
(mov '"rehash: old hash-table" a1)
(jcall #:hash-table:print-stat)
(bra 103)
(fentry #:hash-table:internal-rehash:g117 subr2)
(entry #:hash-table:internal-rehash:g117 subr2)
(push (cvalq new-hash-table))
(mov a2 a3)
(mov (& 0) a2)
(adjstk '1)
(jmp puthash)
103
(mov (& 7) a2)
(mov '#:hash-table:internal-rehash:g117 a1)
(jcall maphash)
(hpxmov (cvalq new-hash-table) '3 a4)
(hpmovx a4 (& 7) '3)
(hpxmov (cvalq new-hash-table) '1 a4)
(hpmovx a4 (& 7) '1)
(hpxmov (cvalq new-hash-table) '2 a4)
(hpmovx a4 (& 7) '2)
(btnil (cvalq #:hash-table:debug) 105)
(mov (& 7) a2)
(mov '"rehash: new hash-table" a1)
(jcall #:hash-table:print-stat)
105
(mov (& 7) a1)
(mov (& 1) dlink)
(mov (& 2) llink)
(mov (& 6) (cvalq new-hash-table))
(adjstk '8)
(return)
))
(loader'((entry #:hash-table:compute-good-size subr1)
(push a1)
(cnbgt a1 (cvalq #:hash-table:default-lowest-size) 101)
(mov (cvalq #:hash-table:default-lowest-size) a1)
(adjstk '1)
(return)
101
(cnblt a1 (cvalq #:hash-table:default-biggest-size) 103)
(mov (cvalq #:hash-table:default-biggest-size) a1)
(adjstk '1)
(return)
103
(jcall evenp)
(btnil a1 107)
(mov (& 0) a4)
(plus '1 a4)
(mov a4 (& 0))
107
(push '(3 5 7 11 13))
(push nil)
109
(bfcons (& 1) 110)
(mov (& 1) a4)
(mov (cdr a4) (& 1))
(push (car a4))
(mov (& 3) a4)
(rem (& 0) a4)
(mov '0 a2)
(mov a4 a1)
(jcall eq)
(adjstk '1)
(mov a1 (& 0))
(bfnil a1 110)
(bra 109)
110
(mov (& 0) a4)
(adjstk '2)
(btnil a4 108)
(mov (& 0) a4)
(plus '2 a4)
(mov a4 (& 0))
(bra 107)
108
(mov (& 0) a1)
(adjstk '1)
(return)
))
(loader'((fentry gethash nsubr)
(entry gethash nsubr)
(cnbge a4 '2 0)
(mov 'gethash a1)
(mov '2 a2)
(jmp #:llcp:errwna)
0
(diff '2 a4)
(jcall #:llcp:nlist)
(btnil (cdr a1) 101)
(mov '2 a3)
(mov 'errwna a2)
(mov 'gethash a1)
(adjstk '2)
(jmp error)
101
(push (car a1))
(mov 'gethash a3)
(mov (& 1) a2)
(mov (& 2) a1)
(call #:hash-table:get-slot)
(bfcons a1 103)
(mov (cdr a1) a1)
(adjstk '3)
(return)
103
(mov (& 0) a1)
(adjstk '3)
(return)
))
(loader'((fentry puthash subr3)
(entry puthash subr3)
(push a3)
(push a2)
(push a1)
(mov 'puthash a3)
(call #:hash-table:get-slot)
(bfcons a1 101)
(push (& 2))
(mov (& 0) (cdr a1))
(mov (& 0) a1)
(adjstk '4)
(return)
101
(push (@ 103))
(push (& 1))
(push (& 3))
(push (& 5))
(push a1)
(push 'puthash)
(mov '5 a4)
(bra #:hash-table:set-new-slot)
103
(eval ())
(adjstk '3)
(return)
))
(loader'((fentry inchash nsubr)
(entry inchash nsubr)
(cnbeq a4 '4 0)
(mov 'inchash a1)
(mov '4 a2)
(jmp #:llcp:errwna)
0
(mov 'inchash a3)
(mov (& 2) a2)
(mov (& 3) a1)
(call #:hash-table:get-slot)
(push a1)
(bfcons a1 101)
(push a1)
(push (@ 103))
(mov (& 2) a4)
(push (cdr a4))
(push (& 5))
(mov '2 a4)
(jmp +)
103
(eval ())
(mov (& 0) a4)
(mov a1 (cdr a4))
(adjstk '6)
(return)
101
(push (@ 104))
(push (& 5))
(push (& 5))
(push (& 4))
(push a1)
(push 'inchash)
(mov '5 a4)
(bra #:hash-table:set-new-slot)
104
(eval ())
(adjstk '5)
(return)
))
(loader'((fentry dechash nsubr)
(entry dechash nsubr)
(cnbeq a4 '4 0)
(mov 'dechash a1)
(mov '4 a2)
(jmp #:llcp:errwna)
0
(mov 'dechash a3)
(mov (& 2) a2)
(mov (& 3) a1)
(call #:hash-table:get-slot)
(push a1)
(bfcons a1 101)
(push a1)
(push (@ 103))
(mov (& 2) a4)
(push (cdr a4))
(push (& 5))
(mov '2 a4)
(jmp -)
103
(eval ())
(mov (& 0) a4)
(mov a1 (cdr a4))
(adjstk '6)
(return)
101
(push (@ 104))
(push (& 5))
(push (& 5))
(push (& 4))
(push a1)
(push 'dechash)
(mov '5 a4)
(bra #:hash-table:set-new-slot)
104
(eval ())
(adjstk '5)
(return)
))
(loader'((fentry remhash subr2)
(entry remhash subr2)
(push a2)
(push a1)
(mov 'remhash a3)
(call #:hash-table:get-slot-index)
(mov a1 a3)
(mov (& 1) a2)
(mov (& 0) a1)
(adjstk '2)
(bra #:hash-table:rem-slot)
))
(loader'((fentry maphash subr2)
(entry maphash subr2)
(push a2)
(push a1)
(mov a2 a1)
(jcall hash-table-p)
(btnil a1 101)
(push '0)
(hpxmov (& 2) '1 a4)
(push a4)
(hgsize a4 a3)
(push a3)
103
(cnbge (& 2) (& 0) 104)
(hpxmov (& 1) (& 2) a4)
(bfcons a4 106)
(push a4)
107
(bfcons (& 0) 108)
(mov (& 0) a4)
(mov (cdr a4) (& 0))
(push (car a4))
(mov (& 0) a4)
(push (car a4))
(push (cdr a4))
(push (@ 109))
(push (& 8))
(push (& 3))
(push (& 3))
(mov '3 a4)
(jmp funcall)
109
(eval ())
(adjstk '3)
(bra 107)
108
(adjstk '1)
106
(mov (& 2) a4)
(plus '1 a4)
(mov a4 (& 2))
(bra 103)
104
(mov nil a1)
(adjstk '5)
(return)
101
(mov (& 1) a2)
(mov 'maphash a1)
(adjstk '2)
(bra #:hash-table:error-nht)
))
(loader'((fentry clrhash subr1)
(entry clrhash subr1)
(push a1)
(jcall hash-table-p)
(btnil a1 101)
(hpxmov (& 0) '1 a4)
(push a4)
(hpxmov (& 1) '3 a3)
(diff '1 a3)
(push '0)
(push a3)
103
(push (@ 105))
(push (& 2))
(push (& 2))
(mov '2 a4)
(jmp <=)
105
(eval ())
(btnil a1 104)
(hpmovx nil (& 2) (& 1))
(push (@ 106))
(push (& 2))
(push '1)
(mov '2 a4)
(jmp +)
106
(eval ())
(mov a1 (& 1))
(bra 103)
104
(adjstk '2)
(hpmovx '0 (& 1) '2)
(mov (& 1) a1)
(adjstk '2)
(return)
101
(mov (& 0) a2)
(mov 'clrhash a1)
(adjstk '1)
(bra #:hash-table:error-nht)
))
(loader'((fentry hash-table-count subr1)
(entry hash-table-count subr1)
(push a1)
(jcall hash-table-p)
(btnil a1 101)
(hpxmov (& 0) '2 a1)
(adjstk '1)
(return)
101
(mov (& 0) a2)
(mov 'hash-table-count a1)
(adjstk '1)
(bra #:hash-table:error-nht)
))
(loader'((fentry hash-table-values subr1)
(entry hash-table-values subr1)
(push a1)
(jcall hash-table-p)
(btnil a1 101)
(hpxmov (& 0) '1 a1)
(adjstk '1)
(return)
101
(mov (& 0) a2)
(mov 'hash-table-values a1)
(adjstk '1)
(bra #:hash-table:error-nht)
))
(loader'((fentry #:hash-table:print-stat subr2)
(entry #:hash-table:print-stat subr2)
(push a2)
(push a1)
(push (@ 101))
(mov '0 a4)
(jmp print)
101
(eval ())
(push (@ 102))
(push (& 1))
(push '"  HT=   ")
(push (& 4))
(mov '3 a4)
(jmp print)
102
(eval ())
(push (@ 103))
(push '"  list of size: ")
(mov '1 a4)
(jmp print)
103
(eval ())
(hpxmov (& 1) '3 a4)
(hpxmov (& 1) '2 a3)
(hpxmov (& 1) '1 a2)
(push nil)
(push a2)
(push a3)
(push a4)
(hgsize a2 a1)
(diff '1 a1)
(push '0)
(push a1)
104
(push (@ 106))
(push (& 2))
(push (& 2))
(mov '2 a4)
(jmp <=)
106
(eval ())
(btnil a1 105)
(hpxmov (& 4) (& 1) a1)
(jcall length)
(mov (& 5) a2)
(jcall cons)
(mov a1 (& 5))
(push (@ 107))
(push (& 2))
(push '1)
(mov '2 a4)
(jmp +)
107
(eval ())
(mov a1 (& 1))
(bra 104)
105
(adjstk '2)
(push (@ 108))
(mov (& 4) a1)
(jcall sortn)
(mov a1 (& 4))
(push a1)
(mov '1 a4)
(jmp print)
108
(eval ())
(push (@ 109))
(mov '(+) a1)
(jcall function)
(push a1)
(push (& 5))
(mov '2 a4)
(jmp apply)
109
(eval ())
(cabeq (& 1) a1 111)
(push (@ 112))
(push '"Pb with entries : :entries=")
(push (& 3))
(push '"  len=")
(push a1)
(mov '4 a4)
(jmp print)
112
(eval ())
111
(push (@ 113))
(push '" average size: ")
(push (@ 114))
(push (& 4))
(push (& 4))
(mov '2 a4)
(jmp /)
114
(eval ())
(push a1)
(mov '2 a4)
(jmp print)
113
(eval ())
(adjstk '6)
(return)
))
(loader '((end)))