Skip to content

fix a bug in type hashconsing #103

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open

fix a bug in type hashconsing #103

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
8410c66
fix a bug in type hashconsing
deyaaeldeen Apr 8, 2020
e131cd0
removing the index field from types
deyaaeldeen Apr 8, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 2 additions & 5 deletions src/backend-c/generate-c.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -163,7 +163,7 @@
(: emit-var-declarations (-> (Listof Uid) Void))
(define (emit-var-declarations d*)
(display "\n//These are the variable declarations\n")
(display "\ntable types_ht;\nint64_t types_unique_index_counter;\n")
(display "\ntable types_ht;\n")
(display "\ncast_queue* mref_cast_q;\ncast_queue* mvect_cast_q;\n")
(display cast-profiler/external-c-decl*)
(display-seq (map uid->string d*) "" (string-append IMDT-C-TYPE " ") "" ";\n" ""))
Expand All @@ -179,8 +179,7 @@
(: initialize-types-table (-> Void))
(define (initialize-types-table)
(printf "types_ht = alloc_hash_table(~a, ~a);\n"
(init-types-hash-table-slots) (types-hash-table-load-factor))
(display "types_unique_index_counter = 0;"))
(init-types-hash-table-slots) (types-hash-table-load-factor)))

(: initialize-suspended-cast-queues (-> Void))
(define (initialize-suspended-cast-queues)
Expand Down Expand Up @@ -650,8 +649,6 @@
(display ",")
(emit-value hcode)
(display ")")]
[('Types-gen-index! (list))
(display "types_unique_index_counter++")]
[('mref-cast-queue-enqueue (list addr ty))
(display "cast_queue_enqueue(mref_cast_q,")
(emit-value addr)
Expand Down
40 changes: 22 additions & 18 deletions src/backend-c/runtime/hashcons.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -17,26 +17,31 @@ table alloc_hash_table(int64_t slots, float load_factor)
return ht;
}

void ht_resize(table ht) {
int64_t old_slots = ht->slots;
chain* old_array = ht->array;
int64_t new_slots = old_slots * 2;
ht->slots = new_slots;
ht->array = GC_MALLOC(8 * new_slots);
int i;
for (i = 0; i < old_slots; ++i) {
chain C = old_array[i];
if (C != NULL) {
list p = C->list;
while (p != NULL) {
types_reinsert(ht, p->data);
p = p->next;
}
}
}
if (old_array) GC_FREE(old_array);
}

int64_t hashcons(table ht, int64_t e, int64_t hcode)
{
float current_load = (float) ht->num_elems/(float) ht->slots;
if (current_load > ht->load_factor) {
int64_t old_slots = ht->slots;
chain* old_array = ht->array;
int64_t new_slots = old_slots * 2;
ht->slots = new_slots;
ht->array = GC_MALLOC(8 * new_slots);
int i;
for (i = 0; i < old_slots; ++i) {
chain C = old_array[i];
if (C != NULL) {
list p = C->list;
while (p != NULL) {
types_reinsert(ht, p->data);
p = p->next;
}
}
}
ht_resize(ht);
}
int h = hcode % ht->slots;
h = h < 0 ? h + ht->slots : h;
Expand Down Expand Up @@ -122,8 +127,7 @@ void types_reinsert(table ht, int64_t ty)
int64_t h;
switch (tag) {
case TYPE_FN_TAG ... TYPE_MU_TAG:
// the hash index is the same for all types
h = ((int64_t*)untagged_ty)[TYPE_FN_HASH_INDEX] % ht->slots;
h = ((int64_t*)untagged_ty)[TYPE_HASHCONS_HASHCODE_INDEX] % ht->slots;
h = h < 0 ? h + ht->slots : h;
chain C = ht->array[h];
if (C == NULL) {
Expand Down
1 change: 1 addition & 0 deletions src/backend-c/runtime/hashcons.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -27,5 +27,6 @@ table alloc_hash_table(int64_t slots, float load_factor);
int64_t hashcons(table ht, int64_t e, int64_t hcode);
int types_equal(int64_t t1, int64_t t2);
void types_reinsert(table ht, int64_t ty);
void ht_resize(table ht);

#endif
1 change: 0 additions & 1 deletion src/backend-c/runtime/runtime.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,6 @@
#include "suspended_cast.h"

extern table types_ht;
extern int64_t types_unique_index_counter;
extern cast_queue* mref_cast_q;
extern cast_queue* mvect_cast_q;

Expand Down
61 changes: 11 additions & 50 deletions src/casts/constants-and-codes.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -44,6 +44,7 @@
(TYPE-FLOAT-RT-VALUE #b100111)
(TYPE-CHAR-RT-VALUE #b101111)
(TYPE-MAX-ATOMIC-RT-VALUE #b111111)
(TYPE-HASHCONS-HASHCODE-INDEX 0)

(HC-PRJ-TAG-MASK #b10)
(HC-INJ-TAG-MASK #b01)
Expand Down Expand Up @@ -227,8 +228,6 @@
(format-id stx "~a-~a?" namespace-string name-string))
(define/with-syntax namespace-mask-def
(format-id stx "~a-TAG-MASK" namespace-string-caps))
(define/with-syntax index-def
(format-id stx "~a-INDEX-INDEX" qualified-upcase-name))
(define/with-syntax hash-def
(format-id stx "~a-HASH-INDEX" qualified-upcase-name))
(define/with-syntax tag-def (format-id stx "~a-TAG" qualified-upcase-name))
Expand Down Expand Up @@ -257,8 +256,7 @@
[else
#`(sr-alloc
#,name-string tag-def
`(("index" . ,(Quote 0))
("hashcode" . ,(Quote 0))
`(("hashcode" . ,(Quote 0))
(field* . ,alloc-val*) ...))]))))
(define/with-syntax equal-arg (generate-temporary))
(define (gen-func-access*)
Expand Down Expand Up @@ -307,8 +305,7 @@
#`(begin
(define-constants
(tag-def tag)
(index-def 0)
(hash-def 1)
(hash-def 0)
(sindex/offset-def* sindex/offset-val*) ...)
func-alloc
(define (func-huh-name equal-arg)
Expand Down Expand Up @@ -393,52 +390,16 @@
[(op$ <= ty TYPE-MAX-ATOMIC-RT-VALUE) ty]
[else
(begin$
(assign$ hcode (calculate-type-hashcode ty))
(assign$ hcode (calculate-type-hashcode ty))
(assign$ hty (op$ Types-hashcons! ty hcode))
(cond$
[(op$ = ty hty)
(begin$
(assign$ index (op$ Types-gen-index!))
(assign$ tag (sr-get-tag ty TYPE-TAG-MASK))
(case$ tag
[(data:TYPE-GREF-TAG)
;; Assumtion: All structural types have two fields in the front,
;; one for the index in the hashconsing table and one for the
;; hashcode.
(when$ (op$ = ty hty)
(assign$ tag (sr-get-tag ty TYPE-TAG-MASK))
(sr-tagged-array-set!
hty TYPE-GREF-TAG TYPE-GREF-INDEX-INDEX index)
(sr-tagged-array-set!
hty TYPE-GREF-TAG TYPE-GREF-HASH-INDEX hcode)]
[(data:TYPE-GVECT-TAG)
(sr-tagged-array-set!
hty TYPE-GVECT-TAG TYPE-GVECT-INDEX-INDEX index)
(sr-tagged-array-set!
hty TYPE-GVECT-TAG TYPE-GVECT-HASH-INDEX hcode)]
[(data:TYPE-MREF-TAG)
(sr-tagged-array-set!
hty TYPE-MREF-TAG TYPE-MREF-INDEX-INDEX index)
(sr-tagged-array-set!
hty TYPE-MREF-TAG TYPE-MREF-HASH-INDEX hcode)]
[(data:TYPE-MVECT-TAG)
(sr-tagged-array-set!
hty TYPE-MVECT-TAG TYPE-MVECT-INDEX-INDEX index)
(sr-tagged-array-set!
hty TYPE-MVECT-TAG TYPE-MVECT-HASH-INDEX hcode)]
[(data:TYPE-TUPLE-TAG)
(sr-tagged-array-set!
hty TYPE-TUPLE-TAG TYPE-TUPLE-INDEX-INDEX index)
(sr-tagged-array-set!
hty TYPE-TUPLE-TAG TYPE-TUPLE-HASH-INDEX hcode)]
[(data:TYPE-FN-TAG)
(sr-tagged-array-set!
hty TYPE-FN-TAG TYPE-FN-INDEX-INDEX index)
(sr-tagged-array-set!
hty TYPE-FN-TAG TYPE-FN-HASH-INDEX hcode)]
[(data:TYPE-MU-TAG)
(sr-tagged-array-set!
hty TYPE-MU-TAG TYPE-MU-INDEX-INDEX index)
(sr-tagged-array-set!
hty TYPE-MU-TAG TYPE-MU-HASH-INDEX hcode)]
[else (op$ Print err-msg) (op$ Exit (Quote 1)) UNDEF-IMDT])
hty)]
[else hty]))])))
hty tag TYPE-HASHCONS-HASHCODE-INDEX hcode))
hty)])))
(add-new-code! (cons hashcons-type runtime-code))
(set-box! hashcons-type-code-label? hashcons-type-code-label)
(App-Code hashcons-type-code-label (list ty))]))
Expand Down
6 changes: 2 additions & 4 deletions src/casts/interpret-casts-common.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -618,8 +618,7 @@ TODO write unit tests
(let$ ([len (Mvector-length address)])
(repeat$ (i ZERO-EXPR len) ()
(let*$ ([vi (Mvector-val-ref address i 'no-check-bounds)]
[cvi (interp-cast vi t1 t3 monotonic-blame suspend-monotonic-heap-casts)]
[t4 (Mvector-rtti-ref address)])
[cvi (interp-cast vi t1 t3 monotonic-blame suspend-monotonic-heap-casts)])
(Mvector-val-set! address i cvi 'no-check-bounds)))
(Mvector-rtti-set! address t3))))))
(define (interp-mvect-state-reduction)
Expand Down Expand Up @@ -1957,8 +1956,7 @@ TODO write unit tests
(let$ ([len (Mvector-length address)])
(repeat$ (i ZERO-EXPR len) ()
(let*$ ([vi (Mvector-val-ref address i 'no-check-bounds)]
[cvi (interp-cast vi t1 t3 monotonic-blame suspend-monotonic-heap-casts)]
[t4 (Mvector-rtti-ref address)])
[cvi (interp-cast vi t1 t3 monotonic-blame suspend-monotonic-heap-casts)])
(Mvector-val-set! address i cvi 'no-check-bounds)))
(Mvector-rtti-set! address t3)
(mvect-state-reduction)))))
Expand Down
3 changes: 2 additions & 1 deletion src/language/primitives.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -136,7 +136,8 @@
(Array-set! #t ((Array Obj) Int Obj -> Unit))
(Array-ref #f ((Array Obj) Int -> Obj))
(Types-hashcons! #t (Type -> Type))
(Types-gen-index! #t (Type -> Unit))
(Types-gen-index! #t (-> Unit))
(get-types-hashcons-index #f (-> Int))
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Is this left in by mistake?

(Printf #t (String (List Obj) -> Unit))
(Print #t (String -> Unit))
(Exit #t (Int -> Bottom)))
Expand Down