Chez Scheme: move ptr-tagging assumption out of rktboot
Add `record-ptr-offset` so that rktboot can use that instead of assuming an offest of 1. Also, introduce `type-untyped` and use it instead of `typemod` when the intent is to leave an address unchanged by tagging. That makes the implementation a little clearer, and it reduces the code that would have to be changed to modify the tagging discipline (e.g., to tag by adding instead of subtracting from an address).
This commit is contained in:
Matthew Flatt
parent
a6ada06ae2
commit
35bce0ac20
|
|
@ -344,7 +344,7 @@ RACKET_FOR_BOOTFILES = $(RACKET)
|
|||
RACKET_FOR_BUILD = $(RACKET)
|
||||
|
||||
# This branch name changes each time the pb boot files are updated:
|
||||
PB_BRANCH == circa-8.1.0.6-1
|
||||
PB_BRANCH == circa-8.1.0.6-2
|
||||
PB_REPO = https://github.com/racket/pb
|
||||
|
||||
# Set to empty for Git before v1.7.10:
|
||||
|
|
|
|||
14
Makefile
14
Makefile
|
|
@ -47,7 +47,7 @@ RACKETCS_SUFFIX =
|
|||
RACKET =
|
||||
RACKET_FOR_BOOTFILES = $(RACKET)
|
||||
RACKET_FOR_BUILD = $(RACKET)
|
||||
PB_BRANCH = circa-8.1.0.6-1
|
||||
PB_BRANCH = circa-8.1.0.6-2
|
||||
PB_REPO = https://github.com/racket/pb
|
||||
SINGLE_BRANCH_FLAG = --single-branch
|
||||
EXTRA_REPOS_BASE =
|
||||
|
|
@ -310,19 +310,19 @@ maybe-fetch-pb-as-is:
|
|||
echo done
|
||||
fetch-pb-from:
|
||||
mkdir -p racket/src/ChezScheme/boot
|
||||
if [ ! -d racket/src/ChezScheme/boot/pb ] ; then git clone -q $(SINGLE_BRANCH_FLAG) -b circa-8.1.0.6-1 $(PB_REPO) racket/src/ChezScheme/boot/pb ; else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-8.1.0.6-1:remotes/origin/circa-8.1.0.6-1 ; fi
|
||||
cd racket/src/ChezScheme/boot/pb && git remote set-branches origin circa-8.1.0.6-1
|
||||
cd racket/src/ChezScheme/boot/pb && git checkout -q circa-8.1.0.6-1
|
||||
if [ ! -d racket/src/ChezScheme/boot/pb ] ; then git clone -q $(SINGLE_BRANCH_FLAG) -b circa-8.1.0.6-2 $(PB_REPO) racket/src/ChezScheme/boot/pb ; else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-8.1.0.6-2:remotes/origin/circa-8.1.0.6-2 ; fi
|
||||
cd racket/src/ChezScheme/boot/pb && git remote set-branches origin circa-8.1.0.6-2
|
||||
cd racket/src/ChezScheme/boot/pb && git checkout -q circa-8.1.0.6-2
|
||||
pb-fetch:
|
||||
$(MAKE) fetch-pb EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" PB_REPO="$(PB_REPO)" SINGLE_BRANCH_FLAG="$(SINGLE_BRANCH_FLAG)"
|
||||
pb-build:
|
||||
cd racket/src/ChezScheme && racket rktboot/main.rkt --machine pb
|
||||
pb-stage:
|
||||
cd racket/src/ChezScheme/boot/pb && git branch circa-8.1.0.6-1
|
||||
cd racket/src/ChezScheme/boot/pb && git checkout circa-8.1.0.6-1
|
||||
cd racket/src/ChezScheme/boot/pb && git branch circa-8.1.0.6-2
|
||||
cd racket/src/ChezScheme/boot/pb && git checkout circa-8.1.0.6-2
|
||||
cd racket/src/ChezScheme/boot/pb && git add . && git commit --amend -m "new build"
|
||||
pb-push:
|
||||
cd racket/src/ChezScheme/boot/pb && git push -u origin circa-8.1.0.6-1
|
||||
cd racket/src/ChezScheme/boot/pb && git push -u origin circa-8.1.0.6-2
|
||||
win-cs-base:
|
||||
IF "$(RACKET_FOR_BUILD)" == "" $(MAKE) win-bc-then-cs-base SETUP_BOOT_MODE=--boot WIN32_BUILD_LEVEL=bc PLAIN_RACKET=racket\racketbc DISABLE_STATIC_LIBS="$(DISABLE_STATIC_LIBS)" EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" JOB_OPTIONS="$(JOB_OPTIONS)" PLT_SETUP_OPTIONS="$(PLT_SETUP_OPTIONS)" RACKETBC_SUFFIX="$(RACKETBC_SUFFIX)" RACKETCS_SUFFIX="$(RACKETCS_SUFFIX)"
|
||||
IF not "$(RACKET_FOR_BUILD)" == "" $(MAKE) win-just-cs-base SETUP_BOOT_MODE=--chain DISABLE_STATIC_LIBS="$(DISABLE_STATIC_LIBS)" EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" JOB_OPTIONS="$(JOB_OPTIONS)" PLT_SETUP_OPTIONS="$(PLT_SETUP_OPTIONS)" RACKETCS_SUFFIX="$(RACKETCS_SUFFIX)" RACKET_FOR_BUILD="$(RACKET_FOR_BUILD)"
|
||||
|
|
|
|||
|
|
@ -320,10 +320,10 @@ For example, if "cmacro.ss" says
|
|||
|
||||
then that means an address with only the lowest bit set among the low
|
||||
three bits refers to a pair. To get the address where the pair content
|
||||
is stored, round *up* to the nearest word. So, on a 64-bit machine,
|
||||
add 7 to get to the `car` and add 15 to get to the `cdr`. Since
|
||||
allocation on a 64-byte machine is 16-byte aligned, the hexadecimal
|
||||
form of every pair pointer will end in "9".
|
||||
is stored, round *up* to the nearest multiple 8 bytes. So, on a 64-bit
|
||||
machine, add 7 to get to the `car` and add 15 to get to the `cdr`.
|
||||
Since allocation on a 64-byte machine is 16-byte aligned, the
|
||||
hexadecimal form of every pair pointer will end in "9".
|
||||
|
||||
The `type-typed-object` type,
|
||||
|
||||
|
|
@ -337,14 +337,14 @@ of a Scheme record, that first word will be a record-type descriptor
|
|||
as a record. The based record type, `#!base-rtd` has itself as its
|
||||
record type. Since the type bits are all ones, on a 64-bit machine,
|
||||
every object tagged with an additional type workd will end in "F" in
|
||||
hexadecimal, and adding 1 to the pointer produces the <address
|
||||
hexadecimal, and adding 1 to the pointer produces the address
|
||||
containing the record content (which starts with the record type, so
|
||||
add 9 instead to get to the first field in the record).
|
||||
|
||||
As another example, a vector is represented as `type-typed-object`
|
||||
pointer where the first word is a fixnum. That is, a fixnum used a
|
||||
type word indicates a vector. The fixnum value is the vector's length
|
||||
in wordobjects, but shifted up by 1 bit, and then the low bit is set
|
||||
in words/objects, but shifted up by 1 bit, and then the low bit is set
|
||||
to 1 for an immutable vector.
|
||||
|
||||
Most kinds of Scheme values are represented records, so the layout is
|
||||
|
|
|
|||
|
|
@ -109,7 +109,7 @@ void S_reset_scheme_stack(tc, n) ptr tc; iptr n; {
|
|||
if (*x == snil) {
|
||||
if (n < default_stack_size) n = default_stack_size;
|
||||
/* stacks are untyped objects */
|
||||
find_room(tc, space_new, 0, typemod, n, SCHEMESTACK(tc));
|
||||
find_room(tc, space_new, 0, type_untyped, n, SCHEMESTACK(tc));
|
||||
break;
|
||||
}
|
||||
if ((m = CACHEDSTACKSIZE(*x)) >= n) {
|
||||
|
|
@ -477,7 +477,8 @@ void S_get_more_room() {
|
|||
ptr xp; uptr ap, type, size;
|
||||
|
||||
xp = XP(tc);
|
||||
if ((type = TYPEBITS(xp)) == 0) type = typemod;
|
||||
type = TYPEBITS(xp);
|
||||
if ((type_untyped != 0) && (type == 0)) type = type_untyped;
|
||||
ap = (uptr)UNTYPE(xp, type);
|
||||
size = (uptr)((iptr)AP(tc) - (iptr)ap);
|
||||
|
||||
|
|
@ -1070,7 +1071,7 @@ ptr S_relocation_table(n) iptr n; {
|
|||
ptr p; iptr d;
|
||||
|
||||
d = size_reloc_table(n);
|
||||
newspace_find_room(tc, typemod, d, p);
|
||||
newspace_find_room(tc, type_untyped, d, p);
|
||||
RELOCSIZE(p) = n;
|
||||
return p;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -223,7 +223,7 @@ static void record_dirty_segment PROTO((IGEN from_g, IGEN to_g, seginfo *si));
|
|||
static void setup_sweep_dirty PROTO((thread_gc *tgc));
|
||||
static uptr sweep_dirty_segments PROTO((thread_gc *tgc, seginfo **dirty_segments));
|
||||
static void resweep_dirty_weak_pairs PROTO((thread_gc *tgc));
|
||||
static void mark_typemod_data_object PROTO((thread_gc *tgc, ptr p, uptr len, seginfo *si));
|
||||
static void mark_untyped_data_object PROTO((thread_gc *tgc, ptr p, uptr len, seginfo *si));
|
||||
static void add_pending_guardian PROTO((ptr gdn, ptr tconc));
|
||||
static void add_trigger_guardians_to_recheck PROTO((ptr ls));
|
||||
static void add_ephemeron_to_pending PROTO((thread_gc *tgc, ptr p));
|
||||
|
|
@ -805,7 +805,7 @@ static ptr copy_stack(thread_gc *tgc, ptr old, iptr *length, iptr clength) {
|
|||
#ifndef NO_NEWSPACE_MARKS
|
||||
if (si->use_marks) {
|
||||
if (!marked(si, old)) {
|
||||
mark_typemod_data_object(tgc, old, n, si);
|
||||
mark_untyped_data_object(tgc, old, n, si);
|
||||
|
||||
#ifdef ENABLE_OBJECT_COUNTS
|
||||
S_G.countof[newg][countof_stack] += 1;
|
||||
|
|
@ -831,7 +831,7 @@ static ptr copy_stack(thread_gc *tgc, ptr old, iptr *length, iptr clength) {
|
|||
if (n == 0) {
|
||||
return (ptr)0;
|
||||
} else {
|
||||
find_gc_room(tgc, space_data, newg, typemod, n, new);
|
||||
find_gc_room(tgc, space_data, newg, type_untyped, n, new);
|
||||
n = ptr_align(clength);
|
||||
/* warning: stack may have been left non-double-aligned by split_and_resize */
|
||||
memcpy_aligned(TO_VOIDP(new), TO_VOIDP(old), n);
|
||||
|
|
@ -1466,7 +1466,7 @@ ptr GCENTRY(ptr tc, ptr count_roots_ls) {
|
|||
/* In backreference mode, we rely on sweep of the guardian
|
||||
entry not registering any backreferences. Otherwise,
|
||||
bogus pair pointers would get created. */
|
||||
find_gc_room(tgc, space_pure, g, typemod, size_guardian_entry, p);
|
||||
find_gc_room(tgc, space_pure, g, type_untyped, size_guardian_entry, p);
|
||||
INITGUARDIANOBJ(p) = GUARDIANOBJ(ls);
|
||||
INITGUARDIANREP(p) = rep;
|
||||
INITGUARDIANTCONC(p) = tconc;
|
||||
|
|
@ -2060,7 +2060,7 @@ void enlarge_stack(thread_gc *tgc, ptr *stack, ptr *stack_start, ptr *stack_limi
|
|||
uptr new_sz = 2 * ((sz == 0) ? (uptr)sweep_stack_min_size : sz);
|
||||
ptr new_stack;
|
||||
if (new_sz - sz < grow_at_least) new_sz += grow_at_least;
|
||||
find_gc_room(tgc, space_data, 0, typemod, ptr_align(new_sz), new_stack);
|
||||
find_gc_room(tgc, space_data, 0, type_untyped, ptr_align(new_sz), new_stack);
|
||||
if (sz != 0)
|
||||
memcpy(TO_VOIDP(new_stack), TO_VOIDP(*stack_start), sz);
|
||||
tgc->bitmask_overhead[0] += ptr_align(new_sz);
|
||||
|
|
|
|||
|
|
@ -273,6 +273,14 @@ static void idiot_checks() {
|
|||
fprintf(stderr, "sizeof(string_char) [%ld] != string_char_bytes [%d]\n", (long)sizeof(string_char), string_char_bytes);
|
||||
oops = 1;
|
||||
}
|
||||
if (TYPE((ptr)0, type_untyped) != (ptr)0) {
|
||||
fprintf(stderr, "tagging with type_untyped changes an address\n");
|
||||
oops = 1;
|
||||
}
|
||||
if (record_ptr_offset != record_type_disp) {
|
||||
fprintf(stderr, "record_ptr_offset != record_type_disp\n");
|
||||
oops = 1;
|
||||
}
|
||||
if (UNFIX(fixtest) != -1) {
|
||||
fprintf(stderr, "UNFIX operation failed\n");
|
||||
oops = 1;
|
||||
|
|
|
|||
|
|
@ -92,8 +92,8 @@ typedef int IFASLCODE; /* fasl type codes */
|
|||
|
||||
#define find_room(tc, s, g, t, n, x) find_gc_room_T(THREAD_GC(tc), s, g, t, n, ALREADY_PTR, x)
|
||||
#define find_gc_room(tgc, s, g, t, n, x) find_gc_room_T(tgc, s, g, t, n, ALREADY_PTR, x)
|
||||
#define find_room_voidp(tc, s, g, n, x) find_gc_room_T(THREAD_GC(tc), s, g, typemod, n, TO_VOIDP, x)
|
||||
#define find_gc_room_voidp(tgc, s, g, n, x) find_gc_room_T(tgc, s, g, typemod, n, TO_VOIDP, x)
|
||||
#define find_room_voidp(tc, s, g, n, x) find_gc_room_T(THREAD_GC(tc), s, g, type_untyped, n, TO_VOIDP, x)
|
||||
#define find_gc_room_voidp(tgc, s, g, n, x) find_gc_room_T(tgc, s, g, type_untyped, n, TO_VOIDP, x)
|
||||
|
||||
/* new-space inline allocation --- no mutex required */
|
||||
/* Like `find_room`, but always `space_new` and generation 0,
|
||||
|
|
@ -111,7 +111,7 @@ typedef int IFASLCODE; /* fasl type codes */
|
|||
} while(0)
|
||||
|
||||
#define newspace_find_room(tc, t, n, x) newspace_find_room_T(tc, t, n, ALREADY_PTR, x)
|
||||
#define newspace_find_room_voidp(tc, n, x) newspace_find_room_T(tc, typemod, n, TO_VOIDP, x)
|
||||
#define newspace_find_room_voidp(tc, n, x) newspace_find_room_T(tc, type_untyped, n, TO_VOIDP, x)
|
||||
|
||||
#ifndef NO_PRESERVE_FLONUM_EQ
|
||||
# define PRESERVE_FLONUM_EQ
|
||||
|
|
|
|||
|
|
@ -135,9 +135,9 @@ ptr S_vfasl(ptr bv, void *stream, iptr offset, iptr input_len)
|
|||
uptr sz = vspace_offsets[s+1] - vspace_offsets[s];
|
||||
if (sz > 0) {
|
||||
if ((s == vspace_reloc) && to_static && !S_G.retain_static_relocation) {
|
||||
newspace_find_room(tc, typemod, sz, vspaces[s]);
|
||||
newspace_find_room(tc, type_untyped, sz, vspaces[s]);
|
||||
} else {
|
||||
find_room(tc, vspace_spaces[s], (to_static ? static_generation : 0), typemod, sz, vspaces[s]);
|
||||
find_room(tc, vspace_spaces[s], (to_static ? static_generation : 0), type_untyped, sz, vspaces[s]);
|
||||
}
|
||||
if (bv) {
|
||||
memcpy(TO_VOIDP(vspaces[s]), bv_addr, sz);
|
||||
|
|
@ -146,7 +146,7 @@ ptr S_vfasl(ptr bv, void *stream, iptr offset, iptr input_len)
|
|||
ptr dest;
|
||||
#ifdef CANNOT_READ_DIRECTLY_INTO_CODE
|
||||
if (s == vspace_code)
|
||||
newspace_find_room(tc, typemod, sz, dest);
|
||||
newspace_find_room(tc, type_untyped, sz, dest);
|
||||
else
|
||||
dest = vspaces[s];
|
||||
#else
|
||||
|
|
@ -170,7 +170,7 @@ ptr S_vfasl(ptr bv, void *stream, iptr offset, iptr input_len)
|
|||
if (bv)
|
||||
table = TO_PTR(bv_addr);
|
||||
else {
|
||||
newspace_find_room(tc, typemod, ptr_align(VFASLHEADER_TABLE_SIZE(header)), table);
|
||||
newspace_find_room(tc, type_untyped, ptr_align(VFASLHEADER_TABLE_SIZE(header)), table);
|
||||
if (S_fasl_stream_read(stream, TO_VOIDP(table), VFASLHEADER_TABLE_SIZE(header)) < 0)
|
||||
S_error("fasl-read", "input truncated");
|
||||
}
|
||||
|
|
@ -489,7 +489,7 @@ static void relink_code(ptr co, ptr sym_base, ptr *vspaces, uptr *vspace_offsets
|
|||
ptr tc = get_thread_context();
|
||||
iptr sz = size_reloc_table(RELOCSIZE(t));
|
||||
ptr new_t;
|
||||
find_room(tc, space_data, static_generation, typemod, ptr_align(sz), new_t);
|
||||
find_room(tc, space_data, static_generation, type_untyped, ptr_align(sz), new_t);
|
||||
memcpy(TO_VOIDP(new_t), TO_VOIDP(t), sz);
|
||||
t = new_t;
|
||||
CODERELOC(co) = t;
|
||||
|
|
|
|||
|
|
@ -53,6 +53,10 @@
|
|||
[(=)
|
||||
(= (constant-eval (cadr e) ht)
|
||||
(constant-eval (caddr e) ht))]
|
||||
[(fx- -)
|
||||
(apply - (map (lambda (e) (constant-eval e esc)) (cdr e)))]
|
||||
[(fx+ +)
|
||||
(apply + (map (lambda (e) (constant-eval e esc)) (cdr e)))]
|
||||
[(quote)
|
||||
(cadr e)]
|
||||
[else (esc)])]
|
||||
|
|
@ -88,7 +92,5 @@
|
|||
prelex-sticky-mask
|
||||
prelex-is-mask
|
||||
scheme-version
|
||||
code-flag-lift-barrier)
|
||||
|
||||
(provide record-ptr-offset)
|
||||
(define record-ptr-offset 1)
|
||||
code-flag-lift-barrier
|
||||
record-ptr-offset)
|
||||
|
|
|
|||
|
|
@ -809,6 +809,10 @@
|
|||
(define-constant type-immediate #b110)
|
||||
(define-constant type-typed-object #b111)
|
||||
|
||||
;; Applying this type tag to an address shouldproduce a pointer
|
||||
;; that's equal to the address:
|
||||
(define-constant type-untyped (constant typemod))
|
||||
|
||||
;; ---------------------------------------------------------------------
|
||||
;; Immediate values; note that these all end with `type-immediate`:
|
||||
|
||||
|
|
@ -1305,6 +1309,9 @@
|
|||
[else x]))])))
|
||||
)
|
||||
|
||||
;; This is the same as `record-type-disp`, but helps bootstrap:
|
||||
(define-constant record-ptr-offset (- (constant typemod) (constant type-record)))
|
||||
|
||||
(define-syntax define-primitive-structure-disps
|
||||
(lambda (x)
|
||||
(include "layout.ss")
|
||||
|
|
@ -1515,7 +1522,7 @@
|
|||
[ptr pinfo*]
|
||||
[octet data 0]))
|
||||
|
||||
(define-primitive-structure-disps reloc-table typemod
|
||||
(define-primitive-structure-disps reloc-table type-untyped
|
||||
([iptr size]
|
||||
[ptr code]
|
||||
[uptr data 0]))
|
||||
|
|
@ -1542,7 +1549,7 @@
|
|||
(define-constant maximum-parallel-collect-threads 16)
|
||||
|
||||
;;; make sure gc sweeps all ptrs
|
||||
(define-primitive-structure-disps tc typemod
|
||||
(define-primitive-structure-disps tc type-untyped
|
||||
([xptr arg-regs (constant asm-arg-reg-max)]
|
||||
[xptr ac0]
|
||||
[xptr ac1]
|
||||
|
|
@ -1682,7 +1689,7 @@
|
|||
(+ b (constant ptr-bytes))
|
||||
(cdr e*)))])))))))
|
||||
|
||||
(define-primitive-structure-disps guardian-entry typemod
|
||||
(define-primitive-structure-disps guardian-entry type-untyped
|
||||
([ptr obj]
|
||||
[ptr rep]
|
||||
[ptr tconc]
|
||||
|
|
@ -1697,15 +1704,15 @@
|
|||
;;; forwarding addresses are recorded with a single forward-marker
|
||||
;;; bit pattern (a special Scheme object) followed by the forwarding
|
||||
;;; address, a ptr to the forwarded object.
|
||||
(define-primitive-structure-disps forward typemod
|
||||
(define-primitive-structure-disps forward type-untyped
|
||||
([ptr marker]
|
||||
[ptr address]))
|
||||
|
||||
(define-primitive-structure-disps cached-stack typemod
|
||||
(define-primitive-structure-disps cached-stack type-untyped
|
||||
([iptr size]
|
||||
[ptr link]))
|
||||
|
||||
(define-primitive-structure-disps rp-header typemod
|
||||
(define-primitive-structure-disps rp-header type-untyped
|
||||
([uptr toplink]
|
||||
[uptr mv-return-address]
|
||||
[ptr livemask]
|
||||
|
|
@ -1719,7 +1726,7 @@
|
|||
(define-constant return-address-livemask-disp
|
||||
(- (constant rp-header-livemask-disp) (constant size-rp-header)))
|
||||
|
||||
(define-primitive-structure-disps rp-compact-header typemod
|
||||
(define-primitive-structure-disps rp-compact-header type-untyped
|
||||
([uptr toplink]
|
||||
[iptr mask+size+mode])) ; low bit is 1 to distinguish from a `rp-header`
|
||||
;; mask+size+mode: bit 0 is 1 [=> compact-header-mask]
|
||||
|
|
@ -2237,7 +2244,7 @@
|
|||
|
||||
(define-constant vspaces-offsets-count (- (constant vspaces-count) 1))
|
||||
|
||||
(define-primitive-structure-disps vfasl-header typemod
|
||||
(define-primitive-structure-disps vfasl-header type-untyped
|
||||
([uptr data-size]
|
||||
[uptr table-size]
|
||||
|
||||
|
|
|
|||
|
|
@ -5312,7 +5312,7 @@
|
|||
(if ,(%inline eq? ,%sfp ,(%constant snil))
|
||||
,(%seq
|
||||
(set! ,%ac0 ,%xp)
|
||||
(set! ,%xp ,(%constant-alloc typemod (constant default-stack-size)))
|
||||
(set! ,%xp ,(%constant-alloc type-untyped (constant default-stack-size)))
|
||||
(set! ,%sfp ,%xp)
|
||||
(set! ,(%tc-ref scheme-stack) ,%sfp)
|
||||
(set! ,(%tc-ref scheme-stack-size) ,(%constant default-stack-size))
|
||||
|
|
|
|||
|
|
@ -3443,7 +3443,7 @@
|
|||
(define-inline 3 $install-guardian
|
||||
[(e-obj e-rep e-tconc ordered?)
|
||||
(bind #f (e-obj e-rep e-tconc ordered?)
|
||||
(bind #t ([t (%constant-alloc typemod (constant size-guardian-entry))])
|
||||
(bind #t ([t (%constant-alloc type-untyped (constant size-guardian-entry))])
|
||||
(%seq
|
||||
(set! ,(%mref ,t ,(constant guardian-entry-obj-disp)) ,e-obj)
|
||||
(set! ,(%mref ,t ,(constant guardian-entry-rep-disp)) ,e-rep)
|
||||
|
|
@ -3456,7 +3456,7 @@
|
|||
(define-inline 3 $install-ftype-guardian
|
||||
[(e-obj e-tconc)
|
||||
(bind #f (e-obj e-tconc)
|
||||
(bind #t ([t (%constant-alloc typemod (constant size-guardian-entry))])
|
||||
(bind #t ([t (%constant-alloc type-untyped (constant size-guardian-entry))])
|
||||
(%seq
|
||||
(set! ,(%mref ,t ,(constant guardian-entry-obj-disp)) ,e-obj)
|
||||
(set! ,(%mref ,t ,(constant guardian-entry-rep-disp)) (immediate ,(constant ftype-guardian-rep)))
|
||||
|
|
@ -7872,7 +7872,7 @@
|
|||
,(%primcall #f sexpr $gensym->pretty-name ,e-sym))))])
|
||||
(define-inline 3 $fxaddress
|
||||
[(e) (%inline logand
|
||||
,(let ([n (- (log2 (constant typemod)) (constant fixnum-offset))])
|
||||
,(let ([n (- (constant primary-type-bits) (constant fixnum-offset))])
|
||||
(if (> n 0) (%inline sra ,e (immediate ,n)) e))
|
||||
(immediate ,(- (constant fixnum-factor))))])
|
||||
(define-inline 3 $set-timer
|
||||
|
|
|
|||
|
|
@ -1143,10 +1143,10 @@
|
|||
[(-> t_si use_marks)
|
||||
(cond
|
||||
[(! (marked t_si t))
|
||||
(mark_typemod_data_object _tgc_ t n t_si)])]
|
||||
(mark_untyped_data_object _tgc_ t n t_si)])]
|
||||
[else
|
||||
(let* ([oldt : ptr t])
|
||||
(find_gc_room _tgc_ space_data from_g typemod n t)
|
||||
(find_gc_room _tgc_ space_data from_g type-untyped n t)
|
||||
(memcpy_aligned (TO_VOIDP t) (TO_VOIDP oldt) n))])]
|
||||
[else
|
||||
(RECORD_REMOTE t_si)])))
|
||||
|
|
@ -2176,7 +2176,7 @@
|
|||
final
|
||||
"}"))]
|
||||
[type (let ([t (lookup 'basetype config)])
|
||||
(if (eq? t 'typemod)
|
||||
(if (eq? t 'type-untyped)
|
||||
#f
|
||||
(as-c 'type (lookup 'basetype config))))]
|
||||
[untype (lambda ()
|
||||
|
|
@ -2526,13 +2526,13 @@
|
|||
(parallel? ,parallel?))))
|
||||
(print-code (generate "object_directly_refers_to_self"
|
||||
`((mode self-test))))
|
||||
(print-code (code "static void mark_typemod_data_object(thread_gc *tgc, ptr p, uptr p_sz, seginfo *si)"
|
||||
(print-code (code "static void mark_untyped_data_object(thread_gc *tgc, ptr p, uptr p_sz, seginfo *si)"
|
||||
(code-block
|
||||
(ensure-segment-mark-mask "si" "")
|
||||
(mark-statement '(one-bit no-sweep)
|
||||
(cons
|
||||
(list 'used (make-eq-hashtable))
|
||||
'((basetype typemod)))))))
|
||||
'((basetype type-untyped)))))))
|
||||
(when measure?
|
||||
(print-code (generate "measure" `((mode measure))))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -1030,7 +1030,7 @@
|
|||
(let* ([new-p (find-room 'reloc vfi
|
||||
(constant vspace-reloc)
|
||||
(fx+ (constant header-size-reloc-table) (fx* m (constant ptr-bytes)))
|
||||
(constant typemod))])
|
||||
(constant type-untyped))])
|
||||
(set-uptr! new-p (constant reloc-table-size-disp) m vfi)
|
||||
(set-ptr!/no-record new-p (constant reloc-table-code-disp) code-p vfi)
|
||||
(let loop ([n 0] [a 0] [i 0])
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user