diff --git a/bin/ikarus b/bin/ikarus index c8e9047..b6a1177 100755 Binary files a/bin/ikarus and b/bin/ikarus differ diff --git a/bin/ikarus-collect.c b/bin/ikarus-collect.c index fecfdb1..0941f98 100644 --- a/bin/ikarus-collect.c +++ b/bin/ikarus-collect.c @@ -886,6 +886,7 @@ add_code_entry(gc_t* gc, ikp entry){ int code_size = unfix(ref(x, disp_code_code_size)); ikp reloc_vec = ref(x, disp_code_reloc_vector); ikp freevars = ref(x, disp_code_freevars); + ikp annotation = ref(x, disp_code_annotation); int required_mem = align(disp_code_data + code_size); if(required_mem >= pagesize){ int new_tag = next_gen_tag[gen]; @@ -907,6 +908,7 @@ add_code_entry(gc_t* gc, ikp entry){ ref(y, disp_code_code_size) = fix(code_size); ref(y, disp_code_reloc_vector) = reloc_vec; ref(y, disp_code_freevars) = freevars; + ref(y, disp_code_annotation) = annotation; memcpy(y+disp_code_data, x+disp_code_data, code_size); ref(x, 0) = forward_ptr; ref(x, wordsize) = y + vector_tag; @@ -1354,6 +1356,8 @@ relocate_new_code(ikp x, gc_t* gc){ ikp relocvector = ref(x, disp_code_reloc_vector); relocvector = add_object(gc, relocvector, "relocvec"); ref(x, disp_code_reloc_vector) = relocvector; + ref(x, disp_code_annotation) = + add_object(gc, ref(x, disp_code_annotation), "annotation"); int relocsize = (int)ref(relocvector, off_vector_length); ikp p = relocvector + off_vector_data; ikp q = p + relocsize; diff --git a/bin/ikarus-data.h b/bin/ikarus-data.h index 93c3ce3..4acbe20 100644 --- a/bin/ikarus-data.h +++ b/bin/ikarus-data.h @@ -10,7 +10,9 @@ #define disp_code_code_size 4 #define disp_code_reloc_vector 8 #define disp_code_freevars 12 +#define disp_code_annotation 16 #define disp_code_data 24 +#define off_code_annotation (disp_code_annotation - code_pri_tag) #define off_code_data (disp_code_data - code_pri_tag) #define off_code_reloc_vector (disp_code_reloc_vector - code_pri_tag) diff --git a/bin/ikarus-runtime.c b/bin/ikarus-runtime.c index 31c79fa..2b95a38 100644 --- a/bin/ikarus-runtime.c +++ b/bin/ikarus-runtime.c @@ -747,6 +747,7 @@ ikrt_make_code(ikp codesizeptr, ikp freevars, ikp rvec, ikpcb* pcb){ ref(mem, disp_code_code_size) = codesizeptr; ref(mem, disp_code_freevars) = freevars; ref(mem, disp_code_reloc_vector) = rvec; + ref(mem, disp_code_annotation) = false_object; ik_relocate_code(mem); return mem+vector_tag; } @@ -759,6 +760,15 @@ ikrt_set_code_reloc_vector(ikp code, ikp vec, ikpcb* pcb){ return void_object; } +ikp +ikrt_set_code_annotation(ikp code, ikp annot, ikpcb* pcb){ + ref(code, off_code_annotation) = annot; + pcb->dirty_vector[page_index(code)] = -1; + return void_object; +} + + + ikp ikrt_bvftime(ikp outbv, ikp fmtbv){ time_t t; diff --git a/src/ikarus.boot b/src/ikarus.boot index 2aefbcc..357fae1 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.code-objects.ss b/src/ikarus.code-objects.ss index 7b5c53a..d03e274 100644 --- a/src/ikarus.code-objects.ss +++ b/src/ikarus.code-objects.ss @@ -3,12 +3,14 @@ (export make-code code-reloc-vector code-freevars code-size code-ref code-set! set-code-reloc-vector! + set-code-annotation! code->thunk) (import (ikarus system $fx) (ikarus system $codes) (except (ikarus) make-code code-reloc-vector code-freevars - code-size code-ref code-set! set-code-reloc-vector!)) + code-size code-ref code-set! set-code-reloc-vector! + set-code-annotation!)) (define make-code (lambda (code-size freevars) @@ -63,6 +65,13 @@ (error 'set-code-reloc-vector! "~s is not a vector" v)) (foreign-call "ikrt_set_code_reloc_vector" x v))) + + (define set-code-annotation! + (lambda (x v) + (unless (code? x) + (error 'set-code-annotation! "~s is not a code" x)) + (foreign-call "ikrt_set_code_annotation" x v))) + (define code->thunk (lambda (x) (unless (code? x) diff --git a/src/ikarus.compiler.ss b/src/ikarus.compiler.ss index 2557b92..43ae82d 100644 --- a/src/ikarus.compiler.ss +++ b/src/ikarus.compiler.ss @@ -1795,6 +1795,7 @@ (define disp-code-instrsize 4) (define disp-code-relocsize 8) (define disp-code-freevars 12) + (define disp-code-annotation 16) (define disp-code-data 24) (define port-tag #x3F) diff --git a/src/makefile.ss b/src/makefile.ss index e81455a..95978b0 100755 --- a/src/makefile.ss +++ b/src/makefile.ss @@ -775,8 +775,10 @@ [$code-reloc-vector $codes] [$code-freevars $codes] [$code-size $codes] + [$code-annotation $codes] [$code-ref $codes] [$code-set! $codes] + [$set-code-annotation! $codes] [$make-tcbucket $tcbuckets] [$tcbucket-key $tcbuckets] diff --git a/src/pass-specify-rep-primops.ss b/src/pass-specify-rep-primops.ss index 104439b..a950bdd 100644 --- a/src/pass-specify-rep-primops.ss +++ b/src/pass-specify-rep-primops.ss @@ -1579,6 +1579,9 @@ (define-primop $code-size unsafe [(V x) (prm 'mref (T x) (K (- disp-code-instrsize vector-tag)))]) +(define-primop $code-annotation unsafe + [(V x) (prm 'mref (T x) (K (- disp-code-annotation vector-tag)))]) + (define-primop $code->closure unsafe [(V x) (with-tmp ([v (prm 'alloc @@ -1609,6 +1612,8 @@ (K (- disp-code-data vector-tag))) (prm 'sll (T v) (K (- 8 fixnum-shift))))]) +(define-primop $set-code-annotation! unsafe + [(E x v) (mem-assign v (T x) (- disp-code-annotation vector-tag))]) /section)