GC marking (non-copying) mode
Change the GC so that it can mark and sweep objects in-place, instead of always copying. This change is helpful for reducing peak memory use while performing a collection on a large, old heap. Some non-copying support was already in place for locked objects, but the new implementation is faster and more general. As an alternative to locking, the storage manager now provides "immobile" allocation (currently only for bytevectors, vectors, and boxes), which allocates an object that won't move but that can be GCed if it's not referenced. A locked object is an object that has been immobiled and that is on a global list --- mostly the old, non-scalable implementation of locked objects brought back, since immobile objects cover the cases that need to scale. original commit: aecb7b736cb1d52764c292fa6364a674958dfde3
This commit is contained in:
Matthew Flatt
parent
f4de537e1c
commit
f53f20b5b9
48
c/alloc.c
48
c/alloc.c
|
|
@ -147,7 +147,7 @@ ptr S_compute_bytes_allocated(xg, xs) ptr xg; ptr xs; {
|
|||
|
||||
g = gmin;
|
||||
while (g <= gmax) {
|
||||
n += S_G.phantom_sizes[g];
|
||||
n += S_G.bytesof[g][countof_phantom];
|
||||
for (s = smin; s <= smax; s++) {
|
||||
/* add in bytes previously recorded */
|
||||
n += S_G.bytes_of_space[s][g];
|
||||
|
|
@ -176,7 +176,7 @@ static void maybe_fire_collector() {
|
|||
ISPC s;
|
||||
uptr bytes, fudge;
|
||||
|
||||
bytes = S_G.phantom_sizes[0];
|
||||
bytes = S_G.bytesof[0][countof_phantom];
|
||||
|
||||
for (s = 0; s <= max_real_space; s += 1) {
|
||||
/* bytes already accounted for */
|
||||
|
|
@ -308,10 +308,19 @@ void S_dirty_set(ptr *loc, ptr x) {
|
|||
*loc = x;
|
||||
if (!Sfixnump(x)) {
|
||||
seginfo *si = SegInfo(addr_get_segment(loc));
|
||||
IGEN from_g = si->generation;
|
||||
if (from_g != 0) {
|
||||
si->dirty_bytes[((uptr)loc >> card_offset_bits) & ((1 << segment_card_offset_bits) - 1)] = 0;
|
||||
mark_segment_dirty(si, from_g);
|
||||
if (si->use_marks) {
|
||||
/* GC must be in progress */
|
||||
if (!IMMEDIATE(x)) {
|
||||
seginfo *t_si = SegInfo(ptr_get_segment(x));
|
||||
if (t_si->generation < si->generation)
|
||||
S_error_abort("wrong-way pointer installed during GC");
|
||||
}
|
||||
} else {
|
||||
IGEN from_g = si->generation;
|
||||
if (from_g != 0) {
|
||||
si->dirty_bytes[((uptr)loc >> card_offset_bits) & ((1 << segment_card_offset_bits) - 1)] = 0;
|
||||
mark_segment_dirty(si, from_g);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -455,16 +464,25 @@ ptr Scons(car, cdr) ptr car, cdr; {
|
|||
return p;
|
||||
}
|
||||
|
||||
ptr Sbox(ref) ptr ref; {
|
||||
ptr S_box2(ref, immobile) ptr ref; IBOOL immobile; {
|
||||
ptr tc = get_thread_context();
|
||||
ptr p;
|
||||
|
||||
thread_find_room(tc, type_typed_object, size_box, p);
|
||||
if (immobile) {
|
||||
tc_mutex_acquire()
|
||||
find_room(space_immobile_impure, 0, type_typed_object, size_box, p);
|
||||
tc_mutex_release()
|
||||
} else
|
||||
thread_find_room(tc, type_typed_object, size_box, p);
|
||||
BOXTYPE(p) = type_box;
|
||||
INITBOXREF(p) = ref;
|
||||
return p;
|
||||
}
|
||||
|
||||
ptr Sbox(ref) ptr ref; {
|
||||
return S_box2(ref, 0);
|
||||
}
|
||||
|
||||
ptr S_symbol(name) ptr name; {
|
||||
ptr tc = get_thread_context();
|
||||
ptr p;
|
||||
|
|
@ -557,6 +575,10 @@ ptr S_fxvector(n) iptr n; {
|
|||
}
|
||||
|
||||
ptr S_bytevector(n) iptr n; {
|
||||
return S_bytevector2(n, 0);
|
||||
}
|
||||
|
||||
ptr S_bytevector2(n, immobile) iptr n; IBOOL immobile; {
|
||||
ptr tc;
|
||||
ptr p; iptr d;
|
||||
|
||||
|
|
@ -568,7 +590,12 @@ ptr S_bytevector(n) iptr n; {
|
|||
tc = get_thread_context();
|
||||
|
||||
d = size_bytevector(n);
|
||||
thread_find_room(tc, type_typed_object, d, p);
|
||||
if (immobile) {
|
||||
tc_mutex_acquire()
|
||||
find_room(space_immobile_data, 0, type_typed_object, d, p);
|
||||
tc_mutex_release()
|
||||
} else
|
||||
thread_find_room(tc, type_typed_object, d, p);
|
||||
BYTEVECTOR_TYPE(p) = (n << bytevector_length_offset) | type_bytevector;
|
||||
return p;
|
||||
}
|
||||
|
|
@ -921,7 +948,8 @@ void S_phantom_bytevector_adjust(ph, new_sz) ptr ph; uptr new_sz; {
|
|||
si = SegInfo(ptr_get_segment(ph));
|
||||
g = si->generation;
|
||||
|
||||
S_G.phantom_sizes[g] += (new_sz - old_sz);
|
||||
S_G.bytesof[g][countof_phantom] += (new_sz - old_sz);
|
||||
S_adjustmembytes(new_sz - old_sz);
|
||||
PHANTOMLEN(ph) = new_sz;
|
||||
|
||||
tc_mutex_release()
|
||||
|
|
|
|||
|
|
@ -79,6 +79,7 @@ extern ptr S_vector_in PROTO((ISPC s, IGEN g, iptr n));
|
|||
extern ptr S_vector PROTO((iptr n));
|
||||
extern ptr S_fxvector PROTO((iptr n));
|
||||
extern ptr S_bytevector PROTO((iptr n));
|
||||
extern ptr S_bytevector2 PROTO((iptr n, IBOOL immobile));
|
||||
extern ptr S_null_immutable_vector PROTO((void));
|
||||
extern ptr S_null_immutable_fxvector PROTO((void));
|
||||
extern ptr S_null_immutable_bytevector PROTO((void));
|
||||
|
|
@ -97,6 +98,7 @@ extern ptr S_bignum PROTO((ptr tc, iptr n, IBOOL sign));
|
|||
extern ptr S_code PROTO((ptr tc, iptr type, iptr n));
|
||||
extern ptr S_relocation_table PROTO((iptr n));
|
||||
extern ptr S_weak_cons PROTO((ptr car, ptr cdr));
|
||||
extern ptr S_box2 PROTO((ptr ref, IBOOL immobile));
|
||||
extern ptr S_phantom_bytevector PROTO((uptr sz));
|
||||
extern void S_phantom_bytevector_adjust PROTO((ptr ph, uptr new_sz));
|
||||
|
||||
|
|
@ -147,6 +149,9 @@ extern void S_set_maxgen PROTO((IGEN g));
|
|||
extern IGEN S_maxgen PROTO((void));
|
||||
extern void S_set_minfreegen PROTO((IGEN g));
|
||||
extern IGEN S_minfreegen PROTO((void));
|
||||
extern void S_set_minmarkgen PROTO((IGEN g));
|
||||
extern IGEN S_minmarkgen PROTO((void));
|
||||
extern ptr S_locked_objects PROTO((void));
|
||||
#ifndef WIN32
|
||||
extern void S_register_child_process PROTO((INT child));
|
||||
#endif /* WIN32 */
|
||||
|
|
@ -156,7 +161,8 @@ extern ptr S_object_counts PROTO((void));
|
|||
extern IBOOL S_enable_object_backreferences PROTO((void));
|
||||
extern void S_set_enable_object_backreferences PROTO((IBOOL eoc));
|
||||
extern ptr S_object_backreferences PROTO((void));
|
||||
extern ptr S_locked_objects PROTO((void));
|
||||
extern void S_immobilize_object PROTO((ptr v));
|
||||
extern void S_mobilize_object PROTO((ptr v));
|
||||
extern ptr S_unregister_guardian PROTO((ptr tconc));
|
||||
extern void S_compact_heap PROTO((void));
|
||||
extern void S_check_heap PROTO((IBOOL aftergc));
|
||||
|
|
@ -371,6 +377,7 @@ extern void S_free_chunks PROTO((void));
|
|||
extern uptr S_curmembytes PROTO((void));
|
||||
extern uptr S_maxmembytes PROTO((void));
|
||||
extern void S_resetmaxmembytes PROTO((void));
|
||||
extern void S_adjustmembytes PROTO((iptr amt));
|
||||
extern void S_move_to_chunk_list PROTO((chunkinfo *chunk, chunkinfo **pchunk_list));
|
||||
|
||||
/* stats.c */
|
||||
|
|
|
|||
224
c/gcwrapper.c
224
c/gcwrapper.c
|
|
@ -17,8 +17,6 @@
|
|||
#include "system.h"
|
||||
|
||||
/* locally defined functions */
|
||||
static IBOOL memqp PROTO((ptr x, ptr ls));
|
||||
static IBOOL remove_first_nomorep PROTO((ptr x, ptr *pls, IBOOL look));
|
||||
static void segment_tell PROTO((uptr seg));
|
||||
static void check_heap_dirty_msg PROTO((char *msg, ptr *x));
|
||||
static IBOOL dirty_listedp PROTO((seginfo *x, IGEN from_g, IGEN to_g));
|
||||
|
|
@ -50,11 +48,14 @@ void S_gc_init() {
|
|||
|
||||
for (g = 0; g <= static_generation; g++) {
|
||||
S_G.guardians[g] = Snil;
|
||||
S_G.locked_objects[g] = Snil;
|
||||
S_G.unlocked_objects[g] = Snil;
|
||||
}
|
||||
S_G.max_nonstatic_generation =
|
||||
S_G.new_max_nonstatic_generation =
|
||||
S_G.min_free_gen =
|
||||
S_G.new_min_free_gen = default_max_nonstatic_generation;
|
||||
S_G.new_min_free_gen =
|
||||
S_G.min_mark_gen = default_max_nonstatic_generation;
|
||||
|
||||
for (g = 0; g <= static_generation; g += 1) {
|
||||
for (i = 0; i < countof_types; i += 1) {
|
||||
|
|
@ -133,6 +134,8 @@ void S_gc_init() {
|
|||
S_G.countof_size[countof_stencil_vector] = 0;
|
||||
INITVECTIT(S_G.countof_names, countof_record) = S_intern((const unsigned char *)"record");
|
||||
S_G.countof_size[countof_record] = 0;
|
||||
INITVECTIT(S_G.countof_names, countof_phantom) = S_intern((const unsigned char *)"phantom");
|
||||
S_G.countof_size[countof_phantom] = 0;
|
||||
for (i = 0; i < countof_types; i += 1) {
|
||||
if (Svector_ref(S_G.countof_names, i) == FIX(0)) {
|
||||
fprintf(stderr, "uninitialized countof_name at index %d\n", i);
|
||||
|
|
@ -167,6 +170,60 @@ void S_set_minfreegen(IGEN g) {
|
|||
}
|
||||
}
|
||||
|
||||
IGEN S_minmarkgen(void) {
|
||||
return S_G.min_mark_gen;
|
||||
}
|
||||
|
||||
void S_set_minmarkgen(IGEN g) {
|
||||
S_G.min_mark_gen = g;
|
||||
}
|
||||
|
||||
void S_immobilize_object(x) ptr x; {
|
||||
seginfo *si;
|
||||
|
||||
if (IMMEDIATE(x))
|
||||
si = NULL;
|
||||
else
|
||||
si = MaybeSegInfo(ptr_get_segment(x));
|
||||
|
||||
if ((si != NULL) && (si->generation != static_generation)) {
|
||||
tc_mutex_acquire()
|
||||
|
||||
/* Try a little to to support cancellation of segment-level
|
||||
* immobilzation --- but we don't try too hard */
|
||||
if (si->must_mark < MUST_MARK_INFINITY)
|
||||
si->must_mark++;
|
||||
|
||||
/* Note: for `space_new`, `must_mark` doesn't really mean all
|
||||
objects must be marked; only those in the locked list must be
|
||||
marked. Non-locked objects on `space_new` cannot be immobilized. */
|
||||
|
||||
tc_mutex_release()
|
||||
}
|
||||
}
|
||||
|
||||
void S_mobilize_object(x) ptr x; {
|
||||
seginfo *si;
|
||||
|
||||
if (IMMEDIATE(x))
|
||||
si = NULL;
|
||||
else
|
||||
si = MaybeSegInfo(ptr_get_segment(x));
|
||||
|
||||
if ((si != NULL) && (si->generation != static_generation)) {
|
||||
tc_mutex_acquire()
|
||||
|
||||
if (si->must_mark == 0)
|
||||
S_error_abort("S_mobilize_object(): object was definitely not immobilzed");
|
||||
|
||||
/* See S_immobilize_object() about this vague try at canceling immobilation: */
|
||||
if (si->must_mark < MUST_MARK_INFINITY)
|
||||
--si->must_mark;
|
||||
|
||||
tc_mutex_release()
|
||||
}
|
||||
}
|
||||
|
||||
static IBOOL memqp(x, ls) ptr x, ls; {
|
||||
for (;;) {
|
||||
if (ls == Snil) return 0;
|
||||
|
|
@ -202,7 +259,7 @@ IBOOL Slocked_objectp(x) ptr x; {
|
|||
tc_mutex_acquire()
|
||||
|
||||
ans = 0;
|
||||
for (ls = si->locked_objects; ls != Snil; ls = Scdr(ls)) {
|
||||
for (ls = S_G.locked_objects[g]; ls != Snil; ls = Scdr(ls)) {
|
||||
if (x == Scar(ls)) {
|
||||
ans = 1;
|
||||
break;
|
||||
|
|
@ -215,18 +272,14 @@ IBOOL Slocked_objectp(x) ptr x; {
|
|||
}
|
||||
|
||||
ptr S_locked_objects(void) {
|
||||
IGEN g; ptr ans; ptr ls; ISPC s; seginfo *si;
|
||||
IGEN g; ptr ans; ptr ls;
|
||||
|
||||
tc_mutex_acquire()
|
||||
|
||||
ans = Snil;
|
||||
for (g = 0; g <= static_generation; INCRGEN(g)) {
|
||||
for (s = 0; s <= max_real_space; s += 1) {
|
||||
for (si = S_G.occupied_segments[s][g]; si != NULL; si = si->next) {
|
||||
for (ls = si->locked_objects; ls != Snil; ls = Scdr(ls)) {
|
||||
ans = Scons(Scar(ls), ans);
|
||||
}
|
||||
}
|
||||
for (ls = S_G.locked_objects[g]; ls != Snil; ls = Scdr(ls)) {
|
||||
ans = Scons(Scar(ls), ans);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -238,43 +291,44 @@ ptr S_locked_objects(void) {
|
|||
void Slock_object(x) ptr x; {
|
||||
seginfo *si; IGEN g;
|
||||
|
||||
tc_mutex_acquire()
|
||||
|
||||
/* weed out pointers that won't be relocated */
|
||||
if (!IMMEDIATE(x) && (si = MaybeSegInfo(ptr_get_segment(x))) != NULL && (g = si->generation) != static_generation) {
|
||||
tc_mutex_acquire()
|
||||
S_pants_down += 1;
|
||||
/* immobilize */
|
||||
if (si->must_mark < MUST_MARK_INFINITY)
|
||||
si->must_mark++;
|
||||
/* add x to locked list. remove from unlocked list */
|
||||
si->locked_objects = S_cons_in((g == 0 ? space_new : space_impure), g, x, si->locked_objects);
|
||||
S_G.locked_objects[g] = S_cons_in((g == 0 ? space_new : space_impure), g, x, S_G.locked_objects[g]);
|
||||
if (S_G.enable_object_counts) {
|
||||
if (g != 0) S_G.countof[g][countof_pair] += 1;
|
||||
}
|
||||
if (si->space & space_locked)
|
||||
(void)remove_first_nomorep(x, &si->unlocked_objects, 0);
|
||||
(void)remove_first_nomorep(x, &S_G.unlocked_objects[g], 0);
|
||||
S_pants_down -= 1;
|
||||
tc_mutex_release()
|
||||
}
|
||||
|
||||
tc_mutex_release()
|
||||
}
|
||||
|
||||
void Sunlock_object(x) ptr x; {
|
||||
seginfo *si; IGEN g;
|
||||
|
||||
tc_mutex_acquire()
|
||||
|
||||
if (!IMMEDIATE(x) && (si = MaybeSegInfo(ptr_get_segment(x))) != NULL && (g = si->generation) != static_generation) {
|
||||
tc_mutex_acquire()
|
||||
S_pants_down += 1;
|
||||
/* mobilize, if we haven't lost track */
|
||||
if (si->must_mark < MUST_MARK_INFINITY)
|
||||
--si->must_mark;
|
||||
/* remove first occurrence of x from locked list. if there are no
|
||||
others, add x to unlocked list */
|
||||
if (remove_first_nomorep(x, &si->locked_objects, si->space & space_locked)) {
|
||||
si->unlocked_objects = S_cons_in((g == 0 ? space_new : space_impure), g, x, si->unlocked_objects);
|
||||
if (remove_first_nomorep(x, &S_G.locked_objects[g], (si->space == space_new) && (si->generation > 0))) {
|
||||
S_G.unlocked_objects[g] = S_cons_in((g == 0 ? space_new : space_impure), g, x, S_G.unlocked_objects[g]);
|
||||
if (S_G.enable_object_counts) {
|
||||
if (g != 0) S_G.countof[g][countof_pair] += 1;
|
||||
}
|
||||
}
|
||||
S_pants_down -= 1;
|
||||
tc_mutex_release()
|
||||
}
|
||||
|
||||
tc_mutex_release()
|
||||
}
|
||||
|
||||
ptr s_help_unregister_guardian(ptr *pls, ptr tconc, ptr result) {
|
||||
|
|
@ -406,6 +460,10 @@ ptr S_object_backreferences(void) {
|
|||
return ls;
|
||||
}
|
||||
|
||||
seginfo *S_ptr_seginfo(ptr p) {
|
||||
return MaybeSegInfo(ptr_get_segment(p));
|
||||
}
|
||||
|
||||
/* Scompact_heap(). Compact into as few O/S chunks as possible and
|
||||
* move objects into static generation
|
||||
*/
|
||||
|
|
@ -446,13 +504,12 @@ static void segment_tell(seg) uptr seg; {
|
|||
} else {
|
||||
printf(" generation=%d", si->generation);
|
||||
s = si->space;
|
||||
s1 = si->space & ~(space_old|space_locked);
|
||||
s1 = si->space;
|
||||
if (s1 < 0 || s1 > max_space)
|
||||
printf(" space-bogus (%d)", s);
|
||||
else {
|
||||
printf(" space-%s", spacename[s1]);
|
||||
if (s & space_old) printf(" oldspace");
|
||||
if (s & space_locked) printf(" locked");
|
||||
if (si->old_space) printf(" oldspace");
|
||||
}
|
||||
printf("\n");
|
||||
}
|
||||
|
|
@ -567,8 +624,10 @@ void S_check_heap(aftergc) IBOOL aftergc; {
|
|||
S_checkheap_errors += 1;
|
||||
printf("!!! unexpected generation %d segment %#tx in space_new\n", g, (ptrdiff_t)seg);
|
||||
}
|
||||
} else if (s == space_impure || s == space_symbol || s == space_pure || s == space_weakpair /* || s == space_ephemeron */) {
|
||||
/* out of date: doesn't handle space_port, space_continuation, space_code, space_pure_typed_object, space_impure_record */
|
||||
} else if (s == space_impure || s == space_symbol || s == space_pure || s == space_weakpair || s == space_ephemeron
|
||||
|| s == space_immobile_impure || s == space_count_pure || s == space_count_impure || s == space_closure) {
|
||||
/* doesn't handle: space_port, space_continuation, space_code, space_pure_typed_object,
|
||||
space_impure_record, or impure_typed_object */
|
||||
nl = (ptr *)S_G.next_loc[s][g];
|
||||
|
||||
/* check for dangling references */
|
||||
|
|
@ -576,23 +635,43 @@ void S_check_heap(aftergc) IBOOL aftergc; {
|
|||
pp2 = (ptr *)build_ptr(seg + 1, 0);
|
||||
if (pp1 <= nl && nl < pp2) pp2 = nl;
|
||||
|
||||
while (pp1 != pp2) {
|
||||
seginfo *psi; ISPC ps;
|
||||
p = *pp1;
|
||||
if (p == forward_marker) break;
|
||||
if (!IMMEDIATE(p) && (psi = MaybeSegInfo(ptr_get_segment(p))) != NULL && ((ps = psi->space) & space_old || ps == space_empty)) {
|
||||
S_checkheap_errors += 1;
|
||||
printf("!!! dangling reference at %#tx to %#tx\n", (ptrdiff_t)pp1, (ptrdiff_t)p);
|
||||
printf("from: "); segment_tell(seg);
|
||||
printf("to: "); segment_tell(ptr_get_segment(p));
|
||||
}
|
||||
pp1 += 1;
|
||||
while (pp1 < pp2) {
|
||||
if (!si->marked_mask || (si->marked_mask[segment_bitmap_byte(pp1)] & segment_bitmap_bit(pp1))) {
|
||||
int a;
|
||||
for (a = 0; (a < ptr_alignment) && (pp1 < pp2); a++) {
|
||||
#define in_ephemeron_pair_part(pp1, seg) ((((uptr)(pp1) - (uptr)build_ptr(seg, 0)) % size_ephemeron) < size_pair)
|
||||
if ((s == space_ephemeron) && !in_ephemeron_pair_part(pp1, seg)) {
|
||||
/* skip non-pair part of ephemeron */
|
||||
} else {
|
||||
p = *pp1;
|
||||
if (p == forward_marker) {
|
||||
pp1 = pp2; /* break out of outer loop */
|
||||
break;
|
||||
} else if (!IMMEDIATE(p)) {
|
||||
seginfo *psi = MaybeSegInfo(ptr_get_segment(p));
|
||||
if (psi != NULL) {
|
||||
if ((psi->space == space_empty)
|
||||
|| psi->old_space
|
||||
|| (psi->marked_mask && !(psi->marked_mask[segment_bitmap_byte(p)] & segment_bitmap_bit(p)))) {
|
||||
S_checkheap_errors += 1;
|
||||
printf("!!! dangling reference at %#tx to %#tx\n", (ptrdiff_t)pp1, (ptrdiff_t)p);
|
||||
printf("from: "); segment_tell(seg);
|
||||
printf("to: "); segment_tell(ptr_get_segment(p));
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
pp1 += 1;
|
||||
}
|
||||
} else
|
||||
pp1 += ptr_alignment;
|
||||
}
|
||||
|
||||
/* verify that dirty bits are set appropriately */
|
||||
/* out of date: doesn't handle space_impure_record, space_port, and maybe others */
|
||||
/* also doesn't check the SYMCODE for symbols */
|
||||
if (s == space_impure || s == space_symbol || s == space_weakpair /* || s == space_ephemeron */) {
|
||||
if (s == space_impure || s == space_symbol || s == space_weakpair || s == space_ephemeron
|
||||
|| s == space_immobile_impure || s == space_closure) {
|
||||
found_eos = 0;
|
||||
pp2 = pp1 = build_ptr(seg, 0);
|
||||
for (d = 0; d < cards_per_segment; d += 1) {
|
||||
|
|
@ -617,40 +696,57 @@ void S_check_heap(aftergc) IBOOL aftergc; {
|
|||
#endif
|
||||
|
||||
dirty = 0xff;
|
||||
while (pp1 != pp2) {
|
||||
seginfo *psi;
|
||||
p = *pp1;
|
||||
|
||||
if (p == forward_marker) {
|
||||
found_eos = 1;
|
||||
break;
|
||||
}
|
||||
if (!IMMEDIATE(p) && (psi = MaybeSegInfo(ptr_get_segment(p))) != NULL && (pg = psi->generation) < g) {
|
||||
if (pg < dirty) dirty = pg;
|
||||
if (si->dirty_bytes[d] > pg) {
|
||||
S_checkheap_errors += 1;
|
||||
check_heap_dirty_msg("!!! INVALID", pp1);
|
||||
while (pp1 < pp2) {
|
||||
if (!si->marked_mask || (si->marked_mask[segment_bitmap_byte(pp1)] & segment_bitmap_bit(pp1))) {
|
||||
int a;
|
||||
for (a = 0; (a < ptr_alignment) && (pp1 < pp2); a++) {
|
||||
if ((s == space_ephemeron) && !in_ephemeron_pair_part(pp1, seg)) {
|
||||
/* skip non-pair part of ephemeron */
|
||||
} else {
|
||||
p = *pp1;
|
||||
|
||||
if (p == forward_marker) {
|
||||
found_eos = 1;
|
||||
pp1 = pp2;
|
||||
break;
|
||||
} else if (!IMMEDIATE(p)) {
|
||||
seginfo *psi = MaybeSegInfo(ptr_get_segment(p));
|
||||
if ((psi != NULL) && ((pg = psi->generation) < g)) {
|
||||
if (pg < dirty) dirty = pg;
|
||||
if (si->dirty_bytes[d] > pg) {
|
||||
S_checkheap_errors += 1;
|
||||
check_heap_dirty_msg("!!! INVALID", pp1);
|
||||
} else if (checkheap_noisy)
|
||||
check_heap_dirty_msg("... ", pp1);
|
||||
}
|
||||
}
|
||||
}
|
||||
pp1 += 1;
|
||||
}
|
||||
else if (checkheap_noisy)
|
||||
check_heap_dirty_msg("... ", pp1);
|
||||
} else {
|
||||
pp1 += ptr_alignment;
|
||||
}
|
||||
pp1 += 1;
|
||||
}
|
||||
|
||||
if (checkheap_noisy && si->dirty_bytes[d] < dirty) {
|
||||
/* sweep_dirty won't sweep, and update dirty byte, for
|
||||
cards with dirty pointers to segments older than the
|
||||
maximum copyied generation, so we can get legitimate
|
||||
conservative dirty bytes even after gc */
|
||||
printf("... Conservative dirty byte %x (%x) %sfor segment %#tx card %d ",
|
||||
si->dirty_bytes[d], dirty,
|
||||
(aftergc ? "after gc " : ""),
|
||||
(ptrdiff_t)seg, d);
|
||||
si->dirty_bytes[d], dirty,
|
||||
(aftergc ? "after gc " : ""),
|
||||
(ptrdiff_t)seg, d);
|
||||
segment_tell(seg);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if (aftergc && s != space_empty && !(s & space_locked) && (g == 0 || (s != space_impure && s != space_symbol && s != space_port && s != space_weakpair && s != space_ephemeron && s != space_impure_record))) {
|
||||
if (aftergc
|
||||
&& (s != space_empty)
|
||||
&& (g == 0
|
||||
|| (s != space_impure && s != space_symbol && s != space_port && s != space_weakpair && s != space_ephemeron
|
||||
&& s != space_impure_record && s != space_immobile_impure && s != space_count_impure && s != space_closure))) {
|
||||
for (d = 0; d < cards_per_segment; d += 1) {
|
||||
if (si->dirty_bytes[d] != 0xff) {
|
||||
S_checkheap_errors += 1;
|
||||
|
|
@ -680,7 +776,6 @@ static void check_dirty_space(ISPC s) {
|
|||
|
||||
for (from_g = 0; from_g <= static_generation; from_g += 1) {
|
||||
for (si = S_G.occupied_segments[s][from_g]; si != NULL; si = si->next) {
|
||||
if (si->space & space_locked) continue;
|
||||
min_to_g = 0xff;
|
||||
for (d = 0; d < cards_per_segment; d += 1) {
|
||||
to_g = si->dirty_bytes[d];
|
||||
|
|
@ -720,7 +815,7 @@ static void check_dirty() {
|
|||
}
|
||||
} else {
|
||||
while (si != NULL) {
|
||||
ISPC s = si->space & ~space_locked;
|
||||
ISPC s = si->space;
|
||||
IGEN g = si->generation;
|
||||
IGEN mingval = si->min_dirty_byte;
|
||||
if (g != from_g) {
|
||||
|
|
@ -798,6 +893,8 @@ ptr S_do_gc(IGEN mcg, IGEN tg, ptr count_roots) {
|
|||
}
|
||||
}
|
||||
S_G.guardians[new_g] = S_G.guardians[old_g]; S_G.guardians[old_g] = Snil;
|
||||
S_G.locked_objects[new_g] = S_G.locked_objects[old_g]; S_G.locked_objects[old_g] = Snil;
|
||||
S_G.unlocked_objects[new_g] = S_G.unlocked_objects[old_g]; S_G.unlocked_objects[old_g] = Snil;
|
||||
S_G.buckets_of_generation[new_g] = S_G.buckets_of_generation[old_g]; S_G.buckets_of_generation[old_g] = NULL;
|
||||
if (S_G.enable_object_counts) {
|
||||
INT i; ptr ls;
|
||||
|
|
@ -880,7 +977,6 @@ ptr S_do_gc(IGEN mcg, IGEN tg, ptr count_roots) {
|
|||
return result;
|
||||
}
|
||||
|
||||
|
||||
ptr S_gc(ptr tc, IGEN mcg, IGEN tg, ptr count_roots) {
|
||||
if (tg == static_generation
|
||||
|| S_G.enable_object_counts || S_G.enable_object_backreferences
|
||||
|
|
|
|||
|
|
@ -123,10 +123,13 @@ EXTERN struct S_G_struct {
|
|||
|
||||
/* gc.c */
|
||||
ptr guardians[static_generation+1];
|
||||
ptr locked_objects[static_generation+1];
|
||||
ptr unlocked_objects[static_generation+1];
|
||||
IGEN min_free_gen;
|
||||
IGEN new_min_free_gen;
|
||||
IGEN max_nonstatic_generation;
|
||||
IGEN new_max_nonstatic_generation;
|
||||
IGEN min_mark_gen;
|
||||
uptr countof[static_generation+1][countof_types];
|
||||
uptr bytesof[static_generation+1][countof_types];
|
||||
uptr gctimestamp[static_generation+1];
|
||||
|
|
@ -135,7 +138,6 @@ EXTERN struct S_G_struct {
|
|||
ptr static_id;
|
||||
ptr countof_names;
|
||||
ptr gcbackreference[static_generation+1];
|
||||
uptr phantom_sizes[static_generation+1];
|
||||
IGEN prcgeneration;
|
||||
uptr bytes_finalized;
|
||||
|
||||
|
|
|
|||
4
c/prim.c
4
c/prim.c
|
|
@ -189,6 +189,8 @@ void S_prim_init() {
|
|||
Sforeign_symbol("(cs)maxgen", (void *)S_maxgen);
|
||||
Sforeign_symbol("(cs)set_maxgen", (void *)S_set_maxgen);
|
||||
Sforeign_symbol("(cs)minfreegen", (void *)S_minfreegen);
|
||||
Sforeign_symbol("(cs)set_minmarkgen", (void *)S_set_minmarkgen);
|
||||
Sforeign_symbol("(cs)minmarkgen", (void *)S_minmarkgen);
|
||||
Sforeign_symbol("(cs)set_minfreegen", (void *)S_set_minfreegen);
|
||||
Sforeign_symbol("(cs)enable_object_counts", (void *)S_enable_object_counts);
|
||||
Sforeign_symbol("(cs)set_enable_object_counts", (void *)S_set_enable_object_counts);
|
||||
|
|
@ -216,6 +218,8 @@ static void s_instantiate_code_object() {
|
|||
new = S_code(tc, CODETYPE(old), CODELEN(old));
|
||||
tc_mutex_release()
|
||||
|
||||
S_immobilize_object(new);
|
||||
|
||||
oldreloc = CODERELOC(old);
|
||||
size = RELOCSIZE(oldreloc);
|
||||
newreloc = S_relocation_table(size);
|
||||
|
|
|
|||
50
c/prim5.c
50
c/prim5.c
|
|
@ -35,6 +35,9 @@ static ptr s_fltofx PROTO((ptr x));
|
|||
static ptr s_weak_pairp PROTO((ptr p));
|
||||
static ptr s_ephemeron_cons PROTO((ptr car, ptr cdr));
|
||||
static ptr s_ephemeron_pairp PROTO((ptr p));
|
||||
static ptr s_box_immobile PROTO((ptr p));
|
||||
static ptr s_make_immobile_vector PROTO((uptr len, ptr fill));
|
||||
static ptr s_make_immobile_bytevector PROTO((uptr len));
|
||||
static ptr s_oblist PROTO((void));
|
||||
static ptr s_bigoddp PROTO((ptr n));
|
||||
static ptr s_float PROTO((ptr x));
|
||||
|
|
@ -176,7 +179,7 @@ static ptr s_fltofx(x) ptr x; {
|
|||
|
||||
static ptr s_weak_pairp(p) ptr p; {
|
||||
seginfo *si;
|
||||
return Spairp(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && (si->space & ~space_locked) == space_weakpair ? Strue : Sfalse;
|
||||
return Spairp(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && si->space == space_weakpair ? Strue : Sfalse;
|
||||
}
|
||||
|
||||
static ptr s_ephemeron_cons(car, cdr) ptr car, cdr; {
|
||||
|
|
@ -193,7 +196,35 @@ static ptr s_ephemeron_cons(car, cdr) ptr car, cdr; {
|
|||
|
||||
static ptr s_ephemeron_pairp(p) ptr p; {
|
||||
seginfo *si;
|
||||
return Spairp(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && (si->space & ~space_locked) == space_ephemeron ? Strue : Sfalse;
|
||||
return Spairp(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && si->space == space_ephemeron ? Strue : Sfalse;
|
||||
}
|
||||
|
||||
static ptr s_box_immobile(p) ptr p; {
|
||||
ptr b = S_box2(p, 1);
|
||||
S_immobilize_object(b);
|
||||
return b;
|
||||
}
|
||||
|
||||
static ptr s_make_immobile_bytevector(uptr len) {
|
||||
ptr b = S_bytevector2(len, 1);
|
||||
S_immobilize_object(b);
|
||||
return b;
|
||||
}
|
||||
|
||||
static ptr s_make_immobile_vector(uptr len, ptr fill) {
|
||||
ptr v;
|
||||
uptr i;
|
||||
|
||||
tc_mutex_acquire()
|
||||
v = S_vector_in(space_immobile_impure, 0, len);
|
||||
tc_mutex_release()
|
||||
|
||||
S_immobilize_object(v);
|
||||
|
||||
for (i = 0; i < len; i++)
|
||||
INITVECTIT(v, i) = fill;
|
||||
|
||||
return v;
|
||||
}
|
||||
|
||||
static ptr s_oblist() {
|
||||
|
|
@ -508,7 +539,7 @@ static void s_showalloc(IBOOL show_dump, const char *outfn) {
|
|||
|
||||
fprintf(out, "\nMap of occupied segments:\n");
|
||||
for (ls = sorted_chunks; ls != Snil; ls = Scdr(ls)) {
|
||||
seginfo *si; ISPC real_s;
|
||||
seginfo *si;
|
||||
|
||||
chunk = Scar(ls);
|
||||
|
||||
|
|
@ -545,11 +576,9 @@ static void s_showalloc(IBOOL show_dump, const char *outfn) {
|
|||
}
|
||||
|
||||
si = &chunk->sis[i];
|
||||
real_s = si->space;
|
||||
s = real_s & ~(space_locked | space_old);
|
||||
s = si->space;
|
||||
if (s < 0 || s > max_space) s = space_bogus;
|
||||
spaceline[segwidth+segsprinted] =
|
||||
real_s & (space_locked | space_old) ? toupper(spacechar[s]) : spacechar[s];
|
||||
spaceline[segwidth+segsprinted] = spacechar[s];
|
||||
|
||||
g = si->generation;
|
||||
genline[segwidth+segsprinted] =
|
||||
|
|
@ -1414,12 +1443,12 @@ static s_thread_rv_t s_backdoor_thread_start(p) void *p; {
|
|||
display("backdoor thread started\n")
|
||||
(void) Sactivate_thread();
|
||||
display("thread activated\n")
|
||||
Scall0((ptr)p);
|
||||
Scall0((ptr)Sunbox(p));
|
||||
(void) Sdeactivate_thread();
|
||||
display("thread deactivated\n")
|
||||
(void) Sactivate_thread();
|
||||
display("thread reeactivated\n")
|
||||
Scall0((ptr)p);
|
||||
Scall0((ptr)Sunbox(p));
|
||||
Sdestroy_thread();
|
||||
display("thread destroyed\n")
|
||||
s_thread_return;
|
||||
|
|
@ -1535,6 +1564,9 @@ void S_prim5_init() {
|
|||
Sforeign_symbol("(cs)s_weak_pairp", (void *)s_weak_pairp);
|
||||
Sforeign_symbol("(cs)s_ephemeron_cons", (void *)s_ephemeron_cons);
|
||||
Sforeign_symbol("(cs)s_ephemeron_pairp", (void *)s_ephemeron_pairp);
|
||||
Sforeign_symbol("(cs)box_immobile", (void *)s_box_immobile);
|
||||
Sforeign_symbol("(cs)make_immobile_vector", (void *)s_make_immobile_vector);
|
||||
Sforeign_symbol("(cs)make_immobile_bytevector", (void *)s_make_immobile_bytevector);
|
||||
Sforeign_symbol("(cs)continuation_depth", (void *)S_continuation_depth);
|
||||
Sforeign_symbol("(cs)single_continuation", (void *)S_single_continuation);
|
||||
Sforeign_symbol("(cs)c_exit", (void *)c_exit);
|
||||
|
|
|
|||
|
|
@ -216,7 +216,7 @@ void S_call_help(tc_in, singlep, lock_ts) ptr tc_in; IBOOL singlep; IBOOL lock_t
|
|||
the C stack and we may end up in a garbage collection */
|
||||
code = CP(tc);
|
||||
if (Sprocedurep(code)) code = CLOSCODE(code);
|
||||
Slock_object(code);
|
||||
S_immobilize_object(code);
|
||||
|
||||
CP(tc) = AC1(tc);
|
||||
|
||||
|
|
@ -226,7 +226,7 @@ void S_call_help(tc_in, singlep, lock_ts) ptr tc_in; IBOOL singlep; IBOOL lock_t
|
|||
if (lock_ts) {
|
||||
/* Lock a code object passed in TS, which is a more immediate
|
||||
caller whose return address is on the C stack */
|
||||
Slock_object(TS(tc));
|
||||
S_immobilize_object(TS(tc));
|
||||
CCHAIN(tc) = Scons(Scons(jb, Scons(code,TS(tc))), CCHAIN(tc));
|
||||
} else {
|
||||
CCHAIN(tc) = Scons(Scons(jb, Scons(code,Sfalse)), CCHAIN(tc));
|
||||
|
|
@ -293,8 +293,8 @@ void S_return() {
|
|||
/* error checks are done; now unlock affected code objects */
|
||||
for (xp = CCHAIN(tc); ; xp = Scdr(xp)) {
|
||||
ptr p = CDAR(xp);
|
||||
Sunlock_object(Scar(p));
|
||||
if (Scdr(p) != Sfalse) Sunlock_object(Scdr(p));
|
||||
S_mobilize_object(Scar(p));
|
||||
if (Scdr(p) != Sfalse) S_mobilize_object(Scdr(p));
|
||||
if (xp == yp) break;
|
||||
FREEJMPBUF(CAAR(xp));
|
||||
}
|
||||
|
|
|
|||
14
c/segment.c
14
c/segment.c
|
|
@ -229,6 +229,9 @@ static void initialize_seginfo(seginfo *si, ISPC s, IGEN g) {
|
|||
si->space = s;
|
||||
si->generation = g;
|
||||
si->sorted = 0;
|
||||
si->old_space = 0;
|
||||
si->use_marks = 0;
|
||||
si->must_mark = 0;
|
||||
si->min_dirty_byte = 0xff;
|
||||
for (d = 0; d < cards_per_segment; d += sizeof(ptr)) {
|
||||
iptr *dp = (iptr *)(si->dirty_bytes + d);
|
||||
|
|
@ -238,9 +241,7 @@ static void initialize_seginfo(seginfo *si, ISPC s, IGEN g) {
|
|||
si->has_triggers = 0;
|
||||
si->trigger_ephemerons = 0;
|
||||
si->trigger_guardians = 0;
|
||||
si->locked_objects = Snil;
|
||||
si->unlocked_objects = Snil;
|
||||
si->locked_mask = NULL;
|
||||
si->marked_mask = NULL;
|
||||
#ifdef PRESERVE_FLONUM_EQ
|
||||
si->forwarded_flonums = NULL;
|
||||
#endif
|
||||
|
|
@ -380,6 +381,9 @@ static seginfo *allocate_segments(nreq) uptr nreq; {
|
|||
si->space = space_empty;
|
||||
si->generation = 0;
|
||||
si->sorted = 1; /* inserting in reverse order, so emptys are always sorted */
|
||||
si->old_space = 0;
|
||||
si->use_marks = 0;
|
||||
si->must_mark = 0;
|
||||
si->next = chunk->unused_segs;
|
||||
chunk->unused_segs = si;
|
||||
}
|
||||
|
|
@ -434,6 +438,10 @@ void S_resetmaxmembytes(void) {
|
|||
maxmembytes = membytes;
|
||||
}
|
||||
|
||||
void S_adjustmembytes(iptr amt) {
|
||||
if ((membytes += amt) < maxmembytes) maxmembytes = membytes;
|
||||
}
|
||||
|
||||
static void expand_segment_table(uptr base, uptr end, seginfo *si) {
|
||||
#ifdef segment_t2_bits
|
||||
#ifdef segment_t3_bits
|
||||
|
|
|
|||
|
|
@ -81,3 +81,4 @@ FORCEINLINE seginfo *MaybeSegInfo(uptr i) {
|
|||
|
||||
#define SegmentSpace(i) (SegInfo(i)->space)
|
||||
#define SegmentGeneration(i) (SegInfo(i)->generation)
|
||||
#define SegmentOldSpace(i) (SegInfo(i)->old_space)
|
||||
|
|
|
|||
13
c/types.h
13
c/types.h
|
|
@ -121,16 +121,22 @@ typedef int IFASLCODE; /* fasl type codes */
|
|||
|
||||
#define SPACE(p) SegmentSpace(ptr_get_segment(p))
|
||||
#define GENERATION(p) SegmentGeneration(ptr_get_segment(p))
|
||||
#define OLDSPACE(p) SegmentOldSpace(ptr_get_segment(p))
|
||||
|
||||
#define ptr_align(size) (((size)+byte_alignment-1) & ~(byte_alignment-1))
|
||||
|
||||
#define MUST_MARK_INFINITY 3
|
||||
|
||||
/* The inlined implementation of primitives like `weak-pair?`
|
||||
rely on the first two fields of `seginfo`: */
|
||||
typedef struct _seginfo {
|
||||
unsigned char space; /* space the segment is in */
|
||||
unsigned char generation; /* generation the segment is in */
|
||||
unsigned char sorted : 1; /* sorted indicator---possibly to be incorporated into space flags? */
|
||||
unsigned char old_space : 1; /* set during GC to indcate space being collected */
|
||||
unsigned char use_marks : 1; /* set during GC to indicate space to mark in place instead of copy */
|
||||
unsigned char sorted : 1; /* sorted indicator */
|
||||
unsigned char has_triggers : 1; /* set if trigger_ephemerons or trigger_guardians is set */
|
||||
unsigned char must_mark : 2; /* a form of locking, where 3 counts as "infinite" */
|
||||
octet min_dirty_byte; /* dirty byte for full segment, effectively min(dirty_bytes) */
|
||||
uptr number; /* the segment number */
|
||||
struct _chunkinfo *chunk; /* the chunk this segment belongs to */
|
||||
|
|
@ -139,9 +145,8 @@ typedef struct _seginfo {
|
|||
struct _seginfo *dirty_next; /* pointer to the next seginfo on the DirtySegments list */
|
||||
ptr trigger_ephemerons; /* ephemerons to re-check if object in segment is copied out */
|
||||
ptr trigger_guardians; /* guardians to re-check if object in segment is copied out */
|
||||
ptr locked_objects; /* list of objects (including duplicates) for locked in this segment */
|
||||
ptr unlocked_objects; /* list of objects (no duplicates) for formerly locked */
|
||||
octet *locked_mask; /* bitmap of locked objects, used only during GC */
|
||||
octet *marked_mask; /* bitmap of live objects for a segment in "compacting" mode */
|
||||
uptr marked_count; /* number of marked bytes in segment */
|
||||
#ifdef PRESERVE_FLONUM_EQ
|
||||
octet *forwarded_flonums; /* bitmap of flonums whose payload is a forwarding pointer */
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -252,7 +252,7 @@ ptr S_vfasl(ptr bv, void *stream, iptr offset, iptr input_len)
|
|||
if (sz > 0) {
|
||||
if ((s == vspace_reloc) && !S_G.retain_static_relocation) {
|
||||
thread_find_room(tc, typemod, sz, vspaces[s])
|
||||
} else {
|
||||
} else {
|
||||
find_room(vspace_spaces[s], static_generation, typemod, sz, vspaces[s])
|
||||
}
|
||||
if (S_fasl_stream_read(stream, vspaces[s], sz) < 0)
|
||||
|
|
|
|||
|
|
@ -1069,14 +1069,14 @@ the address of the entry point within the code object.
|
|||
(The C-callable library function \scheme{Sforeign_callable_entry_point}, described in
|
||||
Section~\ref{SECTFOREIGNCLIB}, may be used to obtain the entry point
|
||||
as well.)
|
||||
This is an implicit pointer into a Scheme object, and
|
||||
in many cases, it is necessary to lock the code object
|
||||
(using \index{\scheme{lock-object}}\scheme{lock-object})
|
||||
before converting it into an entry point
|
||||
to prevent Scheme's storage management system from
|
||||
relocating or destroying the code object, e.g., when the entry point is
|
||||
This is an implicit pointer into an immobile Scheme object, so
|
||||
it will not be relocated by the storage management system, but
|
||||
it may be reclaimed if the code object becomes unreachable on the Scheme
|
||||
side; lock the code object (using \index{\scheme{lock-object}}\scheme{lock-object})
|
||||
or otherwise retain it if the entry point is, for example,
|
||||
registered as a callback and retained in the ``C'' side indefinitely.
|
||||
|
||||
|
||||
The following code creates a foreign-callable code object, locks
|
||||
the code object, and returns the entry point.
|
||||
|
||||
|
|
@ -1090,9 +1090,9 @@ the code object, and returns the entry point.
|
|||
\endschemedisplay
|
||||
|
||||
\noindent
|
||||
Unless the entry point is intended to be permanent, a pointer to the
|
||||
code object returned by \scheme{foreign-callable} should be retained
|
||||
so that it can be unlocked when no longer needed.
|
||||
Unless the entry point is intended to be permanent, however, a pointer
|
||||
to the code object returned by \scheme{foreign-callable} should be retained,
|
||||
in which case locking is unnecessary.
|
||||
|
||||
Mixed use of \scheme{foreign-callable} and \scheme{foreign-procedure}
|
||||
may result in nesting of foreign and Scheme calls, and this
|
||||
|
|
@ -1871,8 +1871,8 @@ Thus, \scheme{make-ftype-pointer} with a function ftype is an alternative
|
|||
to \scheme{foreign-callable} for creating C-callable wrappers for Scheme
|
||||
procedures.
|
||||
|
||||
Since all Scheme objects, including code objects, can be relocated or
|
||||
even reclaimed by the garbage collector the foreign-callable code object
|
||||
Since the foreign-callable code object can be reclaimed by the garbage
|
||||
collector if it is not otherwise referenced, the implicit foreign-callable's code object
|
||||
is automatically locked, as if via \scheme{lock-object}, before it is
|
||||
embedded in the ftype pointer.
|
||||
The code object should be unlocked after its last use from C,
|
||||
|
|
@ -1890,7 +1890,10 @@ to \scheme{unlock-object}:
|
|||
(ftype-pointer-address fact-fptr)))
|
||||
\endschemedisplay
|
||||
|
||||
Once unlocked, the ftype pointer should not be used again, unless
|
||||
Even after the code object is unlocked, the code code will remain
|
||||
immobile as long as a result of \scheme{foreign-callable-code-object}
|
||||
is retained. However, if only the ftype pointer object is retained,
|
||||
then the ftype pointer should not be used again unless
|
||||
it is relocked, e.g., via:
|
||||
|
||||
\schemedisplay
|
||||
|
|
|
|||
|
|
@ -330,6 +330,26 @@ When \scheme{collect-maximum-generation} is set to a new value \var{g},
|
|||
if (a) the two parameters have the same value before the change, or (b)
|
||||
\scheme{release-minimum-generation} has a value greater than \var{g}.
|
||||
|
||||
%----------------------------------------------------------------------------
|
||||
\entryheader
|
||||
\formdef{in-place-minimum-generation}{\categoryglobalparameter}{in-place-minimum-generation}
|
||||
\listlibraries
|
||||
\endentryheader
|
||||
|
||||
This parameter determines when the storage-management system attempts
|
||||
to trade long-term space usage for the benefit of collection time and
|
||||
short-term space usage. When performing a collection at the generation
|
||||
at least as large as this parameter's value, objects already residing
|
||||
at the generation are kept in place---unless the objects are in a
|
||||
memory region where previously keeping them in place resulted in too
|
||||
much fragmentation.
|
||||
|
||||
Typically, the value of \scheme{release-minimum-generation} should
|
||||
match the value of the \scheme{collect-maximum-generation} parameter,
|
||||
but the value of this parameter can be lower to move objects even less
|
||||
frequently, or it can be higher to disable attempts to keep otherwise
|
||||
mobile objects in place.
|
||||
|
||||
%----------------------------------------------------------------------------
|
||||
\entryheader
|
||||
\formdef{heap-reserve-ratio}{\categoryglobalparameter}{heap-reserve-ratio}
|
||||
|
|
@ -348,6 +368,19 @@ Setting it to a smaller value may result in a smaller average virtual
|
|||
memory footprint, while setting it to a larger value may result in fewer
|
||||
calls into the operating system to request and free memory space.
|
||||
|
||||
%----------------------------------------------------------------------------
|
||||
\entryheader
|
||||
\formdef{keep-live}{\categoryprocedure}{(keep-live \var{v})}
|
||||
\returns unspecified
|
||||
\listlibraries
|
||||
\endentryheader
|
||||
|
||||
\noindent
|
||||
Ensures that the value produced by \var{v} is retained by the store
|
||||
manager until the \scheme{keep-live} call is performed. This function
|
||||
can be particularly useful for ensuring that an immobile object
|
||||
remains in place.
|
||||
|
||||
|
||||
\section{Weak Pairs, Ephemeron Pairs, and Guardians\label{SECTGUARDWEAKPAIRS}}
|
||||
|
||||
|
|
@ -984,6 +1017,53 @@ by the collector, including immediate values, such as fixnums,
|
|||
booleans, and characters, and objects that have been made static.
|
||||
|
||||
|
||||
\section{Immobile Objects\label{SECTSMGMTIMMOBILE}}
|
||||
|
||||
Like a locked object, an \emph{immobile} object will not be relocated by
|
||||
the storage manager. Unlike a locked object, and immobile object will
|
||||
be reclaimed by the storage manager if it is unreachable.
|
||||
Foreign-callable code objects are immobile, as are objects allocated
|
||||
by functions that specifically create immobile objects.
|
||||
|
||||
%----------------------------------------------------------------------------
|
||||
\entryheader
|
||||
\formdef{box-immobile}{\categoryprocedure}{(box-immobile \var{obj})}
|
||||
\returns a box
|
||||
\listlibraries
|
||||
\endentryheader
|
||||
|
||||
\noindent
|
||||
Like \scheme{box}, but creates a box that will not be relocated in memory
|
||||
by the storage management system until it is reclaimed.
|
||||
|
||||
|
||||
%----------------------------------------------------------------------------
|
||||
\entryheader
|
||||
\formdef{make-immobile-vector}{\categoryprocedure}{(make-immobile-vector \var{n})}
|
||||
\formdef{make-immobile-vector}{\categoryprocedure}{(make-immobile-vector \var{n} \var{obj})}
|
||||
\returns a vector
|
||||
\listlibraries
|
||||
\endentryheader
|
||||
|
||||
\noindent
|
||||
Like \scheme{make-vector}, but creates a vector that will not be relocated
|
||||
in memory by the storage management system until it is reclaimed.
|
||||
|
||||
|
||||
%----------------------------------------------------------------------------
|
||||
\entryheader
|
||||
\formdef{make-immobile-bytevector}{\categoryprocedure}{(make-immobile-bytevector \var{n})}
|
||||
\formdef{make-immobile-bytevector}{\categoryprocedure}{(make-immobile-bytevector \var{n} \var{byte})}
|
||||
\returns a vector
|
||||
\listlibraries
|
||||
\endentryheader
|
||||
|
||||
\noindent
|
||||
Like \scheme{make-bytevector}, but creates a bytevector that will not be relocated
|
||||
in memory by the storage management system until it is reclaimed.
|
||||
|
||||
|
||||
|
||||
\section{Phantom Bytevectors\label{SECTSMGMTPHANTOM}}
|
||||
|
||||
\index{phamtom bytevectors}A \emph{phantom bytevector} represents
|
||||
|
|
@ -1016,7 +1096,7 @@ allocation.
|
|||
The value \var{n} must reflect actual allocation in the sense of
|
||||
consuming a portion of the process's address space. Claiming
|
||||
significantly more bytes than are actually allocated introduces the
|
||||
possibility of overflow within the store management system's
|
||||
possibility of overflow within the storage management system's
|
||||
calculations.
|
||||
|
||||
%----------------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -62,7 +62,7 @@ InstallLZ4Target=
|
|||
# no changes should be needed below this point #
|
||||
###############################################################################
|
||||
|
||||
Version=csv9.5.3.26
|
||||
Version=csv9.5.3.27
|
||||
Include=boot/$m
|
||||
PetiteBoot=boot/$m/petite.boot
|
||||
SchemeBoot=boot/$m/scheme.boot
|
||||
|
|
|
|||
|
|
@ -4126,7 +4126,7 @@
|
|||
(let* ([g (make-guardian)] [x (list 'a 'b)])
|
||||
(g x)
|
||||
(collect 0 0)
|
||||
(#%$keep-live x)
|
||||
(keep-live x)
|
||||
(g)))
|
||||
#f)
|
||||
;; same for ordered:
|
||||
|
|
@ -4134,7 +4134,7 @@
|
|||
(let* ([g (make-guardian #t)] [x (list 'a 'b)])
|
||||
(g x)
|
||||
(collect 0 0)
|
||||
(#%$keep-live x)
|
||||
(keep-live x)
|
||||
(g)))
|
||||
#f)
|
||||
|
||||
|
|
|
|||
|
|
@ -92,6 +92,10 @@ cgr = $(defaultcgr)
|
|||
defaultcmg = (collect-maximum-generation)
|
||||
cmg = $(defaultcmg)
|
||||
|
||||
# ipmg is the value to which in-place-minimum-generation is set.
|
||||
defaultipmg = (in-place-minimum-generation)
|
||||
ipmg = $(defaultipmg)
|
||||
|
||||
# rmg is the value to which release-minimum-generation is set.
|
||||
defaultrmg = (release-minimum-generation)
|
||||
rmg = $(defaultrmg)
|
||||
|
|
@ -161,6 +165,7 @@ $(objdir)/%.mo : %.ms mat.so
|
|||
'(collect-trip-bytes ${ctb})'\
|
||||
'(collect-generation-radix ${cgr})'\
|
||||
'(collect-maximum-generation ${cmg})'\
|
||||
'(in-place-minimum-generation ${ipmg})'\
|
||||
'(enable-object-counts #${eoc})'\
|
||||
'(commonization-level ${cl})'\
|
||||
'(compile-interpret-simple #${cis})'\
|
||||
|
|
@ -185,6 +190,7 @@ $(objdir)/%.mo : %.ms mat.so
|
|||
'(collect-trip-bytes ${ctb})'\
|
||||
'(collect-generation-radix ${cgr})'\
|
||||
'(collect-maximum-generation ${cmg})'\
|
||||
'(in-place-minimum-generation ${ipmg})'\
|
||||
'(enable-object-counts #${eoc})'\
|
||||
'(commonization-level ${cl})'\
|
||||
'(compile-interpret-simple #${cis})'\
|
||||
|
|
@ -359,6 +365,7 @@ script.all$o makescript$o:
|
|||
'(collect-trip-bytes ${ctb})'\
|
||||
'(collect-generation-radix ${cgr})'\
|
||||
'(collect-maximum-generation ${cmg})'\
|
||||
'(in-place-minimum-generation ${ipmg})'\
|
||||
'(enable-object-counts #${eoc})'\
|
||||
'(commonization-level ${cl})'\
|
||||
'(compile-interpret-simple #${cis})'\
|
||||
|
|
|
|||
|
|
@ -2002,6 +2002,19 @@
|
|||
)
|
||||
|
||||
(mat foreign-callable
|
||||
(begin
|
||||
;; We don't have to use `lock-object` on the result of a `foreign-callable`,
|
||||
;; because it is immobile. We have to keep it live, though.
|
||||
(define-syntax with-object-kept-live
|
||||
(lambda (x)
|
||||
(syntax-case x ()
|
||||
[(_ id expr)
|
||||
(identifier? #'id)
|
||||
#'(let ([v expr])
|
||||
(keep-live id)
|
||||
v)])))
|
||||
#t)
|
||||
|
||||
(error? ; spam is not a procedure
|
||||
(foreign-callable 'spam () void))
|
||||
(error? ; spam is not a procedure
|
||||
|
|
@ -2085,19 +2098,16 @@
|
|||
(define args3 (list #f #\newline -51293 3.1415 2.5 #f))
|
||||
(let ()
|
||||
(define addr
|
||||
(begin
|
||||
(lock-object Fargtest)
|
||||
(foreign-callable-entry-point Fargtest)))
|
||||
(dynamic-wind
|
||||
void
|
||||
(lambda ()
|
||||
(foreign-callable-entry-point Fargtest))
|
||||
(let ()
|
||||
(collect (collect-maximum-generation))
|
||||
(collect (collect-maximum-generation))
|
||||
(and
|
||||
(with-object-kept-live
|
||||
Fargtest
|
||||
(and
|
||||
(equal? (apply Sargtest addr args1) (reverse args1))
|
||||
(equal? (apply Sargtest addr args2) (reverse args2))
|
||||
(equal? (apply Sargtest addr args3) (reverse args3))))
|
||||
(lambda () (unlock-object Fargtest)))))
|
||||
(equal? (apply Sargtest addr args3) (reverse args3)))))))
|
||||
(let ()
|
||||
(define Fargtest2
|
||||
(foreign-callable
|
||||
|
|
@ -2114,19 +2124,16 @@
|
|||
(define args3 (list -7500 #x987654 #\? +inf.0 3210 #\7))
|
||||
(let ()
|
||||
(define addr
|
||||
(begin
|
||||
(lock-object Fargtest2)
|
||||
(foreign-callable-entry-point Fargtest2)))
|
||||
(dynamic-wind
|
||||
void
|
||||
(lambda ()
|
||||
(foreign-callable-entry-point Fargtest2))
|
||||
(let ()
|
||||
(collect (collect-maximum-generation))
|
||||
(collect (collect-maximum-generation))
|
||||
(and
|
||||
(with-object-kept-live
|
||||
Fargtest2
|
||||
(and
|
||||
(equal? (apply Sargtest2 addr args1) (reverse args1))
|
||||
(equal? (apply Sargtest2 addr args2) (reverse args2))
|
||||
(equal? (apply Sargtest2 addr args3) (reverse args3))))
|
||||
(lambda () (unlock-object Fargtest2)))))
|
||||
(equal? (apply Sargtest2 addr args3) (reverse args3)))))))
|
||||
(let ()
|
||||
(define Frvtest_int32
|
||||
(foreign-callable
|
||||
|
|
@ -2229,9 +2236,9 @@
|
|||
(let ([x 5])
|
||||
(define call-twice (foreign-procedure "call_twice" (void* int int) void))
|
||||
(let ([co (foreign-callable (lambda (y) (set! x (+ x y))) (int) void)])
|
||||
(lock-object co)
|
||||
(call-twice (foreign-callable-entry-point co) 7 31)
|
||||
(unlock-object co))
|
||||
(with-object-kept-live
|
||||
co
|
||||
(call-twice (foreign-callable-entry-point co) 7 31)))
|
||||
x)
|
||||
43)
|
||||
(equal?
|
||||
|
|
@ -2247,7 +2254,6 @@
|
|||
(define callback
|
||||
(lambda (p)
|
||||
(let ([code (foreign-callable p (char) void)])
|
||||
(lock-object code)
|
||||
(foreign-callable-entry-point code))))
|
||||
(let ()
|
||||
(define ouch
|
||||
|
|
@ -2278,9 +2284,9 @@
|
|||
; this form needs to be after the preceding form and not part of it, so that when
|
||||
; we lock code we don't also lock the code object created by foreign-procedure
|
||||
(begin
|
||||
(lock-object code)
|
||||
((foreign-procedure (foreign-callable-entry-point code) () scheme-object))
|
||||
(unlock-object code)
|
||||
(with-object-kept-live
|
||||
code
|
||||
((foreign-procedure (foreign-callable-entry-point code) () scheme-object)))
|
||||
#t)
|
||||
|
||||
(not (locked-object?
|
||||
|
|
@ -2408,11 +2414,11 @@
|
|||
(define fptr (make-ftype-pointer foo f))
|
||||
(define g (ftype-ref foo () fptr))
|
||||
(with-exception-handler
|
||||
(lambda (c) (*k* *m*))
|
||||
(lambda ()
|
||||
(call/cc
|
||||
(lambda (k)
|
||||
(fluid-let ([*k* k]) (f $stack-depth $base-value))))))
|
||||
(lambda (c) (*k* *m*))
|
||||
(lambda ()
|
||||
(call/cc
|
||||
(lambda (k)
|
||||
(fluid-let ([*k* k]) (f $stack-depth $base-value))))))
|
||||
(unlock-object
|
||||
(foreign-callable-code-object
|
||||
(ftype-pointer-address fptr)))
|
||||
|
|
@ -2491,8 +2497,7 @@
|
|||
(ftype-pointer-address fptr)))
|
||||
*m*)
|
||||
(+ $stack-depth $base-value)))
|
||||
;; Make sure that a callable is suitably locked, and that it's
|
||||
;; unlocked when the C stack is popped by an escape
|
||||
;; A callable isn't locked, but it's immobile
|
||||
(equal?
|
||||
(let ()
|
||||
(define Sinvoke2
|
||||
|
|
@ -2502,9 +2507,7 @@
|
|||
(define Fcons
|
||||
(foreign-callable
|
||||
(lambda (k y)
|
||||
;; Escape with locked, which should be #t
|
||||
;; because a callable is locked while it's
|
||||
;; called:
|
||||
(collect) ; might crash if `Fcons` were mobile
|
||||
(k (locked-object? Fcons)))
|
||||
(scheme-object iptr)
|
||||
scheme-object))
|
||||
|
|
@ -2515,7 +2518,7 @@
|
|||
;; Escape from callable:
|
||||
(let ([v ($with-exit-proc (lambda (k) (Sinvoke2 Fcons k 5)))])
|
||||
(list v (locked-object? Fcons)))))
|
||||
'((#t #f) (#t #f)))
|
||||
'((#f #f) (#f #f)))
|
||||
|
||||
;; Make sure the code pointer for a call into a
|
||||
;; foreign procedure is correctly saved for locking
|
||||
|
|
@ -2534,8 +2537,9 @@
|
|||
(set! v (add1 v))
|
||||
(loop (bitwise-arithmetic-shift-right n 1))))))
|
||||
(define handler (foreign-callable work (long) void))
|
||||
(lock-object handler)
|
||||
(call_many_times (foreign-callable-entry-point handler))
|
||||
(with-object-kept-live
|
||||
handler
|
||||
(call_many_times (foreign-callable-entry-point handler)))
|
||||
v)
|
||||
14995143)
|
||||
|
||||
|
|
@ -2557,9 +2561,9 @@
|
|||
(eqv? i3 2))))
|
||||
(int u8* u8* u8* u8* int u8* u8* int)
|
||||
void)])
|
||||
(lock-object cb)
|
||||
(call-with-many-args (foreign-callable-entry-point cb))
|
||||
(unlock-object cb)
|
||||
(with-object-kept-live
|
||||
cb
|
||||
(call-with-many-args (foreign-callable-entry-point cb)))
|
||||
result)
|
||||
|
||||
)
|
||||
|
|
|
|||
190
mats/misc.ms
190
mats/misc.ms
|
|
@ -14,7 +14,7 @@
|
|||
;;; limitations under the License.
|
||||
|
||||
;;; regression and other tests that don't fit somewhere more logical
|
||||
|
||||
|
||||
(define-syntax biglet
|
||||
(lambda (x)
|
||||
(syntax-case x ()
|
||||
|
|
@ -2696,6 +2696,8 @@
|
|||
(time=? (cost-center-time $cc-3) (make-time 'time-duration 0 0))
|
||||
)
|
||||
|
||||
|
||||
|
||||
(mat lock-object
|
||||
(begin
|
||||
(define $locked-objects (foreign-procedure "(cs)locked_objects" () ptr))
|
||||
|
|
@ -3042,7 +3044,7 @@
|
|||
(set-car! p 'yes)
|
||||
(unlock-object v)
|
||||
(equal? '(yes . 2) (vector-ref v (sub1 N)))))
|
||||
)
|
||||
)
|
||||
|
||||
(mat eval-order
|
||||
(eqv? (call/cc (lambda (k) (0 (k 1)))) 1)
|
||||
|
|
@ -4870,7 +4872,6 @@
|
|||
(and
|
||||
(equal? (wrapper-procedure-data a) g)
|
||||
(begin (unlock-object a) #t))))
|
||||
|
||||
)
|
||||
|
||||
(mat fasl-immutable
|
||||
|
|
@ -5093,10 +5094,12 @@
|
|||
(bytes-allocated)
|
||||
(* 2.25 $pre-allocated))
|
||||
|
||||
;; No big change to `(current-memory-bytes)`
|
||||
(< (* 0.75 $pre-memory)
|
||||
;; Big change to `(current-memory-bytes)`
|
||||
(< (+ (* 0.75 $pre-allocated)
|
||||
$pre-memory)
|
||||
(current-memory-bytes)
|
||||
(* 1.25 $pre-memory))
|
||||
(+ (* 1.25 $pre-memory)
|
||||
$pre-memory))
|
||||
|
||||
;; Same change after GC
|
||||
(begin
|
||||
|
|
@ -5140,4 +5143,177 @@
|
|||
(< (* 0.75 $pre-allocated)
|
||||
(bytes-allocated)
|
||||
(* 1.25 $pre-allocated)))
|
||||
)
|
||||
)
|
||||
|
||||
(mat immobile
|
||||
(error? (box-immobile))
|
||||
(error? (box-immobile 1 2))
|
||||
|
||||
(error? (make-immobile-vector))
|
||||
(error? (make-immobile-vector 'a))
|
||||
(error? (make-immobile-vector -10))
|
||||
(error? (make-immobile-vector (expt 2 100)))
|
||||
(error? (make-immobile-vector 10 1 2))
|
||||
|
||||
(error? (make-immobile-bytevector))
|
||||
(error? (make-immobile-bytevector 'a))
|
||||
(error? (make-immobile-byte-vector -10))
|
||||
(error? (make-immobile-bytevector (expt 2 100)))
|
||||
(error? (make-immobile-bytevector 10 1024))
|
||||
(error? (make-immobile-bytevector 10 1 2))
|
||||
|
||||
(box? (box-immobile 10))
|
||||
(vector? (make-immobile-vector 10))
|
||||
(eqv? 0 (vector-ref (make-immobile-vector 10) 9))
|
||||
(bytevector? (make-immobile-bytevector 10))
|
||||
(eqv? 0 (bytevector-u8-ref (make-immobile-bytevector 10 0) 9))
|
||||
|
||||
(begin
|
||||
(define (make-objects)
|
||||
(let loop ([i 16])
|
||||
(cond
|
||||
[(zero? i) '()]
|
||||
[else
|
||||
(let* ([b (box-immobile (format "box ~a" i))]
|
||||
[b-addr (#%$fxaddress b)]
|
||||
[v (make-immobile-vector (expt 2 i) b)]
|
||||
[v-addr (#%$fxaddress v)]
|
||||
[s (make-immobile-bytevector (expt 2 i) i)]
|
||||
[s-addr (#%$fxaddress s)])
|
||||
(cons (list i
|
||||
b b-addr
|
||||
v v-addr
|
||||
s s-addr)
|
||||
(loop (sub1 i))))])))
|
||||
(define (check-objects l)
|
||||
(let loop ([l l])
|
||||
(or (null? l)
|
||||
(let-values ([(i b b-addr v v-addr s s-addr) (apply values (car l))])
|
||||
(and (equal? (format "box ~a" i) (unbox b))
|
||||
(equal? (format "box ~a" i) (unbox (vector-ref v (sub1 (vector-length v)))))
|
||||
(eqv? i (bytevector-u8-ref s (sub1 (bytevector-length s))))
|
||||
(eqv? b-addr (#%$fxaddress b))
|
||||
(eqv? v-addr (#%$fxaddress v))
|
||||
(eqv? s-addr (#%$fxaddress s))
|
||||
(loop (cdr l)))))))
|
||||
(define (mutate-objects l)
|
||||
(let loop ([l l])
|
||||
(or (null? l)
|
||||
(let-values ([(i b b-addr v v-addr s s-addr) (apply values (car l))])
|
||||
(set-box! b (format "box ~a" i))
|
||||
(vector-set! v (sub1 (vector-length v)) (box (unbox b)))
|
||||
(loop (cdr l))))))
|
||||
#t)
|
||||
|
||||
(with-interrupts-disabled
|
||||
(let ([objs (make-objects)])
|
||||
(and (check-objects objs)
|
||||
(begin
|
||||
(collect 0 1)
|
||||
(and
|
||||
(check-objects objs)
|
||||
(begin
|
||||
(mutate-objects objs)
|
||||
(collect 0 0)
|
||||
(and
|
||||
(check-objects objs)
|
||||
(begin
|
||||
(collect (collect-maximum-generation))
|
||||
(check-objects objs)))))))))
|
||||
|
||||
(or
|
||||
(not (threaded?))
|
||||
(let ([m (make-mutex)]
|
||||
[c (make-condition)]
|
||||
[running 4])
|
||||
(let thread-loop ([t running])
|
||||
(unless (= t 0)
|
||||
(fork-thread
|
||||
(lambda ()
|
||||
(let loop ([i 1000] [objs '()] [addrs '()])
|
||||
(cond
|
||||
[(= i 0)
|
||||
(mutex-acquire m)
|
||||
(set! running (sub1 running))
|
||||
(condition-signal c)
|
||||
(mutex-release m)]
|
||||
[else
|
||||
(let ([v (case (modulo i 3)
|
||||
[(0) (box-immobile objs)]
|
||||
[(1) (make-immobile-vector i objs)]
|
||||
[(2) (make-immobile-bytevector i)])])
|
||||
(let ([objs (cons v objs)]
|
||||
[addrs (cons (#%$fxaddress v) addrs)])
|
||||
(collect-rendezvous)
|
||||
(let check ([objs objs] [addrs addrs])
|
||||
(unless (null? objs)
|
||||
(let ([v (car objs)])
|
||||
(unless (= (#%$fxaddress v) (car addrs))
|
||||
(error 'immobile "address changed: ~s" v))
|
||||
(cond
|
||||
[(box? v)
|
||||
(unless (eq? (unbox v) (cdr objs))
|
||||
(error 'immobile "bad box content"))]
|
||||
[(vector? v)
|
||||
(let loop ([j 0])
|
||||
(unless (= j (vector-length v))
|
||||
(unless (eq? (cdr objs) (vector-ref v j))
|
||||
(error 'immobile "bad vector content"))
|
||||
(loop (add1 j))))]
|
||||
[(bytevector? v)
|
||||
(void)]
|
||||
[else
|
||||
(error 'immobile "bad object: ~s" v)]))
|
||||
(check (cdr objs) (cdr addrs))))
|
||||
(loop (sub1 i) objs addrs)))]))))
|
||||
(thread-loop (sub1 t))))
|
||||
(mutex-acquire m)
|
||||
(let loop ()
|
||||
(unless (= running 0)
|
||||
(condition-wait c m)
|
||||
(loop)))
|
||||
(mutex-release m)
|
||||
#t))
|
||||
|
||||
)
|
||||
|
||||
(mat compacting
|
||||
;; try to provoke the GC into putting a record into marked
|
||||
;; (insteda of copied) space and check the write barrier there
|
||||
(let loop ([N 2])
|
||||
(or (= N 8192)
|
||||
(let sel-loop ([sels (list car cadr)])
|
||||
(cond
|
||||
[(null? sels) (loop (* N 2))]
|
||||
[else
|
||||
(let ()
|
||||
(define rtd (make-record-type
|
||||
"r"
|
||||
(let loop ([i N])
|
||||
(if (zero? i)
|
||||
(list '[ptr y])
|
||||
(cons `[uptr ,(string->symbol (format "x~a" i))]
|
||||
(loop (sub1 i)))))))
|
||||
|
||||
(define (make-r)
|
||||
(apply (record-constructor rtd)
|
||||
(let loop ([i N])
|
||||
(if (zero? i)
|
||||
'(the-y-value)
|
||||
(cons 0 (loop (sub1 i)))))))
|
||||
|
||||
(define r-y (record-accessor rtd N))
|
||||
(define set-r-y! (record-mutator rtd N))
|
||||
|
||||
(define rs (list (make-r)
|
||||
(make-r)
|
||||
(make-r)))
|
||||
(collect (collect-maximum-generation))
|
||||
(set! rs (list (car rs) (caddr rs)))
|
||||
(collect (collect-maximum-generation))
|
||||
(set-r-y! ((car sels) rs) (string-copy "new-string-to-go"))
|
||||
(collect)
|
||||
(and (equal? (r-y ((car sels) rs))
|
||||
"new-string-to-go")
|
||||
(sel-loop (cdr sels))))]))))
|
||||
)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
*** errors-compile-0-f-f-f 2020-03-11 22:32:59.000000000 -0600
|
||||
--- errors-compile-0-t-f-f 2020-03-11 22:04:54.000000000 -0600
|
||||
*** errors-compile-0-f-f-f 2020-04-20 14:03:37.000000000 -0600
|
||||
--- errors-compile-0-t-f-f 2020-04-20 14:17:38.000000000 -0600
|
||||
***************
|
||||
*** 222,228 ****
|
||||
3.mo:Expected error in mat case-lambda: "incorrect number of arguments 2 to #<procedure foo>".
|
||||
|
|
@ -3861,7 +3861,7 @@
|
|||
misc.mo:Expected error in mat compiler3: "incorrect argument count in call (consumer 1 2)".
|
||||
misc.mo:Expected error in mat compiler3: "variable goto is not bound".
|
||||
***************
|
||||
*** 4108,4114 ****
|
||||
*** 4113,4119 ****
|
||||
misc.mo:Expected error in mat $fasl-file-equal?: "$fasl-file-equal?: failed for probably-does-not-exist: no such file or directory".
|
||||
misc.mo:Expected error in mat $fasl-file-equal?: "$fasl-file-equal?: failed for probably-does-not-exist: no such file or directory".
|
||||
misc.mo:Expected error in mat $fasl-file-equal?: "$fasl-file-equal?: record comparison failed while comparing testfile-fatfib1.so and testfile-fatfib3.so within fasl entry 4".
|
||||
|
|
@ -3869,7 +3869,7 @@
|
|||
misc.mo:Expected error in mat cost-center: "with-cost-center: foo is not a cost center".
|
||||
misc.mo:Expected error in mat cost-center: "with-cost-center: bar is not a procedure".
|
||||
misc.mo:Expected error in mat cost-center: "cost-center-instruction-count: 5 is not a cost center".
|
||||
--- 4108,4114 ----
|
||||
--- 4113,4119 ----
|
||||
misc.mo:Expected error in mat $fasl-file-equal?: "$fasl-file-equal?: failed for probably-does-not-exist: no such file or directory".
|
||||
misc.mo:Expected error in mat $fasl-file-equal?: "$fasl-file-equal?: failed for probably-does-not-exist: no such file or directory".
|
||||
misc.mo:Expected error in mat $fasl-file-equal?: "$fasl-file-equal?: record comparison failed while comparing testfile-fatfib1.so and testfile-fatfib3.so within fasl entry 4".
|
||||
|
|
@ -3878,7 +3878,7 @@
|
|||
misc.mo:Expected error in mat cost-center: "with-cost-center: bar is not a procedure".
|
||||
misc.mo:Expected error in mat cost-center: "cost-center-instruction-count: 5 is not a cost center".
|
||||
***************
|
||||
*** 4162,4169 ****
|
||||
*** 4167,4174 ****
|
||||
misc.mo:Expected error in mat apropos: "apropos: 3 is not a symbol or string".
|
||||
misc.mo:Expected error in mat apropos: "apropos: (hit me) is not a symbol or string".
|
||||
misc.mo:Expected error in mat apropos: "apropos-list: b is not an environment".
|
||||
|
|
@ -3887,7 +3887,7 @@
|
|||
misc.mo:Expected error in mat apropos: "variable $apropos-unbound1 is not bound".
|
||||
misc.mo:Expected error in mat apropos: "variable $apropos-unbound2 is not bound".
|
||||
misc.mo:Expected error in mat simplify-if: "textual-port?: a is not a port".
|
||||
--- 4162,4169 ----
|
||||
--- 4167,4174 ----
|
||||
misc.mo:Expected error in mat apropos: "apropos: 3 is not a symbol or string".
|
||||
misc.mo:Expected error in mat apropos: "apropos: (hit me) is not a symbol or string".
|
||||
misc.mo:Expected error in mat apropos: "apropos-list: b is not an environment".
|
||||
|
|
@ -3897,7 +3897,7 @@
|
|||
misc.mo:Expected error in mat apropos: "variable $apropos-unbound2 is not bound".
|
||||
misc.mo:Expected error in mat simplify-if: "textual-port?: a is not a port".
|
||||
***************
|
||||
*** 4178,4193 ****
|
||||
*** 4183,4198 ****
|
||||
misc.mo:Expected error in mat pariah: "invalid syntax (pariah)".
|
||||
misc.mo:Expected error in mat pariah: "invalid syntax (pariah . 17)".
|
||||
misc.mo:Expected error in mat procedure-arity-mask: "procedure-arity-mask: 17 is not a procedure".
|
||||
|
|
@ -3914,7 +3914,7 @@
|
|||
misc.mo:Expected error in mat wrapper-procedure: "make-arity-wrapper-procedure: 1 is not a procedure".
|
||||
misc.mo:Expected error in mat wrapper-procedure: "make-arity-wrapper-procedure: not-a-procedure is not a procedure".
|
||||
misc.mo:Expected error in mat wrapper-procedure: "make-arity-wrapper-procedure: not-an-exact-integer is not an arity mask".
|
||||
--- 4178,4193 ----
|
||||
--- 4183,4198 ----
|
||||
misc.mo:Expected error in mat pariah: "invalid syntax (pariah)".
|
||||
misc.mo:Expected error in mat pariah: "invalid syntax (pariah . 17)".
|
||||
misc.mo:Expected error in mat procedure-arity-mask: "procedure-arity-mask: 17 is not a procedure".
|
||||
|
|
@ -3932,7 +3932,7 @@
|
|||
misc.mo:Expected error in mat wrapper-procedure: "make-arity-wrapper-procedure: not-a-procedure is not a procedure".
|
||||
misc.mo:Expected error in mat wrapper-procedure: "make-arity-wrapper-procedure: not-an-exact-integer is not an arity mask".
|
||||
***************
|
||||
*** 4197,4209 ****
|
||||
*** 4202,4233 ****
|
||||
misc.mo:Expected error in mat wrapper-procedure: "wrapper-procedure-data: 1 is not a wrapper procedure".
|
||||
misc.mo:Expected error in mat wrapper-procedure: "wrapper-procedure-data: #<procedure> is not a wrapper procedure".
|
||||
misc.mo:Expected error in mat wrapper-procedure: "wrapper-procedure-data: #<procedure> is not a wrapper procedure".
|
||||
|
|
@ -3946,7 +3946,26 @@
|
|||
misc.mo:Expected error in mat wrapper-procedure: "set-wrapper-procedure-data!: 1 is not a wrapper procedure".
|
||||
misc.mo:Expected error in mat wrapper-procedure: "set-wrapper-procedure-data!: #<procedure> is not a wrapper procedure".
|
||||
misc.mo:Expected error in mat wrapper-procedure: "set-wrapper-procedure-data!: #<procedure> is not a wrapper procedure".
|
||||
--- 4197,4209 ----
|
||||
misc.mo:Expected error in mat phantom-bytevector: "make-phantom-bytevector: -1 is not a valid phantom bytevector length".
|
||||
misc.mo:Expected error in mat phantom-bytevector: "make-phantom-bytevector: 1267650600228229401496703205376 is not a valid phantom bytevector length".
|
||||
misc.mo:Expected error in mat phantom-bytevector: "make-phantom-bytevector: x is not a valid phantom bytevector length".
|
||||
! misc.mo:Expected error in mat immobile: "incorrect argument count in call (box-immobile)".
|
||||
! misc.mo:Expected error in mat immobile: "incorrect argument count in call (box-immobile 1 2)".
|
||||
! misc.mo:Expected error in mat immobile: "incorrect argument count in call (make-immobile-vector)".
|
||||
misc.mo:Expected error in mat immobile: "make-immobile-vector: a is not a valid vector length".
|
||||
misc.mo:Expected error in mat immobile: "make-immobile-vector: -10 is not a valid vector length".
|
||||
misc.mo:Expected error in mat immobile: "make-immobile-vector: 1267650600228229401496703205376 is not a valid vector length".
|
||||
! misc.mo:Expected error in mat immobile: "incorrect argument count in call (make-immobile-vector 10 1 2)".
|
||||
! misc.mo:Expected error in mat immobile: "incorrect argument count in call (make-immobile-bytevector)".
|
||||
misc.mo:Expected error in mat immobile: "make-immobile-bytevector: a is not a valid bytevector length".
|
||||
misc.mo:Expected error in mat immobile: "variable make-immobile-byte-vector is not bound".
|
||||
misc.mo:Expected error in mat immobile: "make-immobile-bytevector: 1267650600228229401496703205376 is not a valid bytevector length".
|
||||
misc.mo:Expected error in mat immobile: "make-immobile-bytevector: 1024 is not a valid fill value".
|
||||
! misc.mo:Expected error in mat immobile: "incorrect argument count in call (make-immobile-bytevector 10 1 2)".
|
||||
cp0.mo:Expected error in mat cp0-regression: "attempt to reference undefined variable x".
|
||||
cp0.mo:Expected error in mat cp0-regression: "incorrect argument count in call (g)".
|
||||
cp0.mo:Expected error in mat cp0-regression: "incorrect argument count in call (cont0 (quote x))".
|
||||
--- 4202,4233 ----
|
||||
misc.mo:Expected error in mat wrapper-procedure: "wrapper-procedure-data: 1 is not a wrapper procedure".
|
||||
misc.mo:Expected error in mat wrapper-procedure: "wrapper-procedure-data: #<procedure> is not a wrapper procedure".
|
||||
misc.mo:Expected error in mat wrapper-procedure: "wrapper-procedure-data: #<procedure> is not a wrapper procedure".
|
||||
|
|
@ -3960,8 +3979,27 @@
|
|||
misc.mo:Expected error in mat wrapper-procedure: "set-wrapper-procedure-data!: 1 is not a wrapper procedure".
|
||||
misc.mo:Expected error in mat wrapper-procedure: "set-wrapper-procedure-data!: #<procedure> is not a wrapper procedure".
|
||||
misc.mo:Expected error in mat wrapper-procedure: "set-wrapper-procedure-data!: #<procedure> is not a wrapper procedure".
|
||||
misc.mo:Expected error in mat phantom-bytevector: "make-phantom-bytevector: -1 is not a valid phantom bytevector length".
|
||||
misc.mo:Expected error in mat phantom-bytevector: "make-phantom-bytevector: 1267650600228229401496703205376 is not a valid phantom bytevector length".
|
||||
misc.mo:Expected error in mat phantom-bytevector: "make-phantom-bytevector: x is not a valid phantom bytevector length".
|
||||
! misc.mo:Expected error in mat immobile: "incorrect number of arguments 0 to #<procedure box-immobile>".
|
||||
! misc.mo:Expected error in mat immobile: "incorrect number of arguments 2 to #<procedure box-immobile>".
|
||||
! misc.mo:Expected error in mat immobile: "incorrect number of arguments 0 to #<procedure make-immobile-vector>".
|
||||
misc.mo:Expected error in mat immobile: "make-immobile-vector: a is not a valid vector length".
|
||||
misc.mo:Expected error in mat immobile: "make-immobile-vector: -10 is not a valid vector length".
|
||||
misc.mo:Expected error in mat immobile: "make-immobile-vector: 1267650600228229401496703205376 is not a valid vector length".
|
||||
! misc.mo:Expected error in mat immobile: "incorrect number of arguments 3 to #<procedure make-immobile-vector>".
|
||||
! misc.mo:Expected error in mat immobile: "incorrect number of arguments 0 to #<procedure make-immobile-bytevector>".
|
||||
misc.mo:Expected error in mat immobile: "make-immobile-bytevector: a is not a valid bytevector length".
|
||||
misc.mo:Expected error in mat immobile: "variable make-immobile-byte-vector is not bound".
|
||||
misc.mo:Expected error in mat immobile: "make-immobile-bytevector: 1267650600228229401496703205376 is not a valid bytevector length".
|
||||
misc.mo:Expected error in mat immobile: "make-immobile-bytevector: 1024 is not a valid fill value".
|
||||
! misc.mo:Expected error in mat immobile: "incorrect number of arguments 3 to #<procedure make-immobile-bytevector>".
|
||||
cp0.mo:Expected error in mat cp0-regression: "attempt to reference undefined variable x".
|
||||
cp0.mo:Expected error in mat cp0-regression: "incorrect argument count in call (g)".
|
||||
cp0.mo:Expected error in mat cp0-regression: "incorrect argument count in call (cont0 (quote x))".
|
||||
***************
|
||||
*** 4223,4231 ****
|
||||
*** 4241,4249 ****
|
||||
cp0.mo:Expected error in mat cp0-regression: "condition: #f is not a condition".
|
||||
cp0.mo:Expected error in mat cp0-regression: "apply: 0 is not a proper list".
|
||||
cp0.mo:Expected error in mat cp0-regression: "apply: 2 is not a proper list".
|
||||
|
|
@ -3971,7 +4009,7 @@
|
|||
cp0.mo:Expected error in mat expand-output: "expand-output: #t is not a textual output port or #f".
|
||||
cp0.mo:Expected error in mat expand-output: "expand-output: #<binary output port bytevector> is not a textual output port or #f".
|
||||
cp0.mo:Expected error in mat expand/optimize-output: "expand/optimize-output: #t is not a textual output port or #f".
|
||||
--- 4223,4231 ----
|
||||
--- 4241,4249 ----
|
||||
cp0.mo:Expected error in mat cp0-regression: "condition: #f is not a condition".
|
||||
cp0.mo:Expected error in mat cp0-regression: "apply: 0 is not a proper list".
|
||||
cp0.mo:Expected error in mat cp0-regression: "apply: 2 is not a proper list".
|
||||
|
|
@ -3982,7 +4020,7 @@
|
|||
cp0.mo:Expected error in mat expand-output: "expand-output: #<binary output port bytevector> is not a textual output port or #f".
|
||||
cp0.mo:Expected error in mat expand/optimize-output: "expand/optimize-output: #t is not a textual output port or #f".
|
||||
***************
|
||||
*** 4289,4297 ****
|
||||
*** 4307,4315 ****
|
||||
5_6.mo:Expected error in mat list->fxvector: "list->fxvector: (1 2 . 3) is not a proper list".
|
||||
5_6.mo:Expected error in mat list->fxvector: "list->fxvector: (1 2 3 2 3 2 ...) is circular".
|
||||
5_6.mo:Expected error in mat fxvector->list: "fxvector->list: (a b c) is not an fxvector".
|
||||
|
|
@ -3992,7 +4030,7 @@
|
|||
5_6.mo:Expected error in mat vector-map: "vector-map: #() is not a procedure".
|
||||
5_6.mo:Expected error in mat vector-map: "vector-map: #() is not a procedure".
|
||||
5_6.mo:Expected error in mat vector-map: "vector-map: #() is not a procedure".
|
||||
--- 4289,4297 ----
|
||||
--- 4307,4315 ----
|
||||
5_6.mo:Expected error in mat list->fxvector: "list->fxvector: (1 2 . 3) is not a proper list".
|
||||
5_6.mo:Expected error in mat list->fxvector: "list->fxvector: (1 2 3 2 3 2 ...) is circular".
|
||||
5_6.mo:Expected error in mat fxvector->list: "fxvector->list: (a b c) is not an fxvector".
|
||||
|
|
@ -4003,7 +4041,7 @@
|
|||
5_6.mo:Expected error in mat vector-map: "vector-map: #() is not a procedure".
|
||||
5_6.mo:Expected error in mat vector-map: "vector-map: #() is not a procedure".
|
||||
***************
|
||||
*** 4306,4314 ****
|
||||
*** 4324,4332 ****
|
||||
5_6.mo:Expected error in mat vector-map: "vector-map: lengths of input vectors #() and #(x) differ".
|
||||
5_6.mo:Expected error in mat vector-map: "vector-map: lengths of input vectors #(y) and #() differ".
|
||||
5_6.mo:Expected error in mat vector-map: "vector-map: lengths of input vectors #(y) and #() differ".
|
||||
|
|
@ -4013,7 +4051,7 @@
|
|||
5_6.mo:Expected error in mat vector-for-each: "vector-for-each: #() is not a procedure".
|
||||
5_6.mo:Expected error in mat vector-for-each: "vector-for-each: #() is not a procedure".
|
||||
5_6.mo:Expected error in mat vector-for-each: "vector-for-each: #() is not a procedure".
|
||||
--- 4306,4314 ----
|
||||
--- 4324,4332 ----
|
||||
5_6.mo:Expected error in mat vector-map: "vector-map: lengths of input vectors #() and #(x) differ".
|
||||
5_6.mo:Expected error in mat vector-map: "vector-map: lengths of input vectors #(y) and #() differ".
|
||||
5_6.mo:Expected error in mat vector-map: "vector-map: lengths of input vectors #(y) and #() differ".
|
||||
|
|
@ -4024,7 +4062,7 @@
|
|||
5_6.mo:Expected error in mat vector-for-each: "vector-for-each: #() is not a procedure".
|
||||
5_6.mo:Expected error in mat vector-for-each: "vector-for-each: #() is not a procedure".
|
||||
***************
|
||||
*** 4323,4340 ****
|
||||
*** 4341,4358 ****
|
||||
5_6.mo:Expected error in mat vector-for-each: "vector-for-each: lengths of input vectors #() and #(x) differ".
|
||||
5_6.mo:Expected error in mat vector-for-each: "vector-for-each: lengths of input vectors #(y) and #() differ".
|
||||
5_6.mo:Expected error in mat vector-for-each: "vector-for-each: lengths of input vectors #(y) and #() differ".
|
||||
|
|
@ -4043,7 +4081,7 @@
|
|||
5_6.mo:Expected error in mat vector-sort!: "vector-sort!: 3 is not a mutable vector".
|
||||
5_6.mo:Expected error in mat vector-sort!: "vector-sort!: (1 2 3) is not a mutable vector".
|
||||
5_6.mo:Expected error in mat vector-sort!: "vector-sort!: #(a b c) is not a procedure".
|
||||
--- 4323,4340 ----
|
||||
--- 4341,4358 ----
|
||||
5_6.mo:Expected error in mat vector-for-each: "vector-for-each: lengths of input vectors #() and #(x) differ".
|
||||
5_6.mo:Expected error in mat vector-for-each: "vector-for-each: lengths of input vectors #(y) and #() differ".
|
||||
5_6.mo:Expected error in mat vector-for-each: "vector-for-each: lengths of input vectors #(y) and #() differ".
|
||||
|
|
@ -4063,7 +4101,7 @@
|
|||
5_6.mo:Expected error in mat vector-sort!: "vector-sort!: (1 2 3) is not a mutable vector".
|
||||
5_6.mo:Expected error in mat vector-sort!: "vector-sort!: #(a b c) is not a procedure".
|
||||
***************
|
||||
*** 4345,4353 ****
|
||||
*** 4363,4371 ****
|
||||
5_6.mo:Expected error in mat vector->immutable-vector: "vector-sort!: #(1 2 3) is not a mutable vector".
|
||||
5_6.mo:Expected error in mat fxvector->immutable-fxvector: "fxvector-set!: #vfx(1 2 3) is not a mutable fxvector".
|
||||
5_6.mo:Expected error in mat fxvector->immutable-fxvector: "fxvector-fill!: #vfx(1 2 3) is not a mutable fxvector".
|
||||
|
|
@ -4073,7 +4111,7 @@
|
|||
5_6.mo:Expected error in mat vector-cas!: "vector-cas!: 1 is not a mutable vector".
|
||||
5_6.mo:Expected error in mat vector-cas!: "vector-cas!: #(4 5 3) is not a mutable vector".
|
||||
5_6.mo:Expected error in mat vector-cas!: "vector-cas!: #(4 5 3) is not a valid index for #(4 5 3)".
|
||||
--- 4345,4353 ----
|
||||
--- 4363,4371 ----
|
||||
5_6.mo:Expected error in mat vector->immutable-vector: "vector-sort!: #(1 2 3) is not a mutable vector".
|
||||
5_6.mo:Expected error in mat fxvector->immutable-fxvector: "fxvector-set!: #vfx(1 2 3) is not a mutable fxvector".
|
||||
5_6.mo:Expected error in mat fxvector->immutable-fxvector: "fxvector-fill!: #vfx(1 2 3) is not a mutable fxvector".
|
||||
|
|
@ -4084,7 +4122,7 @@
|
|||
5_6.mo:Expected error in mat vector-cas!: "vector-cas!: #(4 5 3) is not a mutable vector".
|
||||
5_6.mo:Expected error in mat vector-cas!: "vector-cas!: #(4 5 3) is not a valid index for #(4 5 3)".
|
||||
***************
|
||||
*** 4404,4411 ****
|
||||
*** 4422,4429 ****
|
||||
5_7.mo:Expected error in mat putprop-getprop: "getprop: 3 is not a symbol".
|
||||
5_7.mo:Expected error in mat putprop-getprop: "putprop: "hi" is not a symbol".
|
||||
5_7.mo:Expected error in mat putprop-getprop: "property-list: (a b c) is not a symbol".
|
||||
|
|
@ -4093,7 +4131,7 @@
|
|||
5_8.mo:Expected error in mat box-cas!: "box-cas!: 1 is not a mutable box".
|
||||
5_8.mo:Expected error in mat box-cas!: "box-cas!: #&1 is not a mutable box".
|
||||
6.mo:Expected error in mat port-operations: "open-input-file: failed for nonexistent file: no such file or directory".
|
||||
--- 4404,4411 ----
|
||||
--- 4422,4429 ----
|
||||
5_7.mo:Expected error in mat putprop-getprop: "getprop: 3 is not a symbol".
|
||||
5_7.mo:Expected error in mat putprop-getprop: "putprop: "hi" is not a symbol".
|
||||
5_7.mo:Expected error in mat putprop-getprop: "property-list: (a b c) is not a symbol".
|
||||
|
|
@ -4103,7 +4141,7 @@
|
|||
5_8.mo:Expected error in mat box-cas!: "box-cas!: #&1 is not a mutable box".
|
||||
6.mo:Expected error in mat port-operations: "open-input-file: failed for nonexistent file: no such file or directory".
|
||||
***************
|
||||
*** 4443,4464 ****
|
||||
*** 4461,4482 ****
|
||||
6.mo:Expected error in mat port-operations: "clear-output-port: not permitted on closed port #<output port testfile.ss>".
|
||||
6.mo:Expected error in mat port-operations: "current-output-port: a is not a textual output port".
|
||||
6.mo:Expected error in mat port-operations: "current-input-port: a is not a textual input port".
|
||||
|
|
@ -4126,7 +4164,7 @@
|
|||
6.mo:Expected error in mat port-operations1: "open-input-output-file: furball is not a string".
|
||||
6.mo:Expected error in mat port-operations1: "open-input-output-file: failed for /probably/not/a/good/path: no such file or directory".
|
||||
6.mo:Expected error in mat port-operations1: "open-input-output-file: invalid option compressed".
|
||||
--- 4443,4464 ----
|
||||
--- 4461,4482 ----
|
||||
6.mo:Expected error in mat port-operations: "clear-output-port: not permitted on closed port #<output port testfile.ss>".
|
||||
6.mo:Expected error in mat port-operations: "current-output-port: a is not a textual output port".
|
||||
6.mo:Expected error in mat port-operations: "current-input-port: a is not a textual input port".
|
||||
|
|
@ -4150,7 +4188,7 @@
|
|||
6.mo:Expected error in mat port-operations1: "open-input-output-file: failed for /probably/not/a/good/path: no such file or directory".
|
||||
6.mo:Expected error in mat port-operations1: "open-input-output-file: invalid option compressed".
|
||||
***************
|
||||
*** 4467,4473 ****
|
||||
*** 4485,4491 ****
|
||||
6.mo:Expected error in mat port-operations1: "truncate-file: all-the-way is not a valid length".
|
||||
6.mo:Expected error in mat port-operations1: "truncate-file: #<input port testfile.ss> is not an output port".
|
||||
6.mo:Expected error in mat port-operations1: "truncate-file: animal-crackers is not an output port".
|
||||
|
|
@ -4158,7 +4196,7 @@
|
|||
6.mo:Expected error in mat port-operations1: "truncate-file: not permitted on closed port #<input/output port testfile.ss>".
|
||||
6.mo:Expected error in mat port-operations1: "get-output-string: #<input port string> is not a string output port".
|
||||
6.mo:Expected error in mat port-operations1: "get-output-string: #<output port testfile.ss> is not a string output port".
|
||||
--- 4467,4473 ----
|
||||
--- 4485,4491 ----
|
||||
6.mo:Expected error in mat port-operations1: "truncate-file: all-the-way is not a valid length".
|
||||
6.mo:Expected error in mat port-operations1: "truncate-file: #<input port testfile.ss> is not an output port".
|
||||
6.mo:Expected error in mat port-operations1: "truncate-file: animal-crackers is not an output port".
|
||||
|
|
@ -4167,7 +4205,7 @@
|
|||
6.mo:Expected error in mat port-operations1: "get-output-string: #<input port string> is not a string output port".
|
||||
6.mo:Expected error in mat port-operations1: "get-output-string: #<output port testfile.ss> is not a string output port".
|
||||
***************
|
||||
*** 4484,4491 ****
|
||||
*** 4502,4509 ****
|
||||
6.mo:Expected error in mat string-port-file-position: "file-position: -1 is not a valid position".
|
||||
6.mo:Expected error in mat fresh-line: "fresh-line: 3 is not a textual output port".
|
||||
6.mo:Expected error in mat fresh-line: "fresh-line: #<input port string> is not a textual output port".
|
||||
|
|
@ -4176,7 +4214,7 @@
|
|||
6.mo:Expected error in mat pretty-print: "pretty-format: 3 is not a symbol".
|
||||
6.mo:Expected error in mat pretty-print: "pretty-format: invalid format (bad 0 ... ... 0 format)".
|
||||
6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "~a~~~s" in call to format".
|
||||
--- 4484,4491 ----
|
||||
--- 4502,4509 ----
|
||||
6.mo:Expected error in mat string-port-file-position: "file-position: -1 is not a valid position".
|
||||
6.mo:Expected error in mat fresh-line: "fresh-line: 3 is not a textual output port".
|
||||
6.mo:Expected error in mat fresh-line: "fresh-line: #<input port string> is not a textual output port".
|
||||
|
|
@ -4186,7 +4224,7 @@
|
|||
6.mo:Expected error in mat pretty-print: "pretty-format: invalid format (bad 0 ... ... 0 format)".
|
||||
6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "~a~~~s" in call to format".
|
||||
***************
|
||||
*** 6969,7000 ****
|
||||
*** 6987,7018 ****
|
||||
io.mo:Expected error in mat port-operations: "put-u8: not permitted on closed port #<binary output port testfile.ss>".
|
||||
io.mo:Expected error in mat port-operations: "put-bytevector: not permitted on closed port #<binary output port testfile.ss>".
|
||||
io.mo:Expected error in mat port-operations: "flush-output-port: not permitted on closed port #<binary output port testfile.ss>".
|
||||
|
|
@ -4219,7 +4257,7 @@
|
|||
io.mo:Expected error in mat port-operations1: "open-file-input/output-port: failed for /probably/not/a/good/path: no such file or directory".
|
||||
io.mo:Expected error in mat port-operations1: "invalid file option uncompressed".
|
||||
io.mo:Expected error in mat port-operations1: "invalid file option truncate".
|
||||
--- 6969,7000 ----
|
||||
--- 6987,7018 ----
|
||||
io.mo:Expected error in mat port-operations: "put-u8: not permitted on closed port #<binary output port testfile.ss>".
|
||||
io.mo:Expected error in mat port-operations: "put-bytevector: not permitted on closed port #<binary output port testfile.ss>".
|
||||
io.mo:Expected error in mat port-operations: "flush-output-port: not permitted on closed port #<binary output port testfile.ss>".
|
||||
|
|
@ -4253,7 +4291,7 @@
|
|||
io.mo:Expected error in mat port-operations1: "invalid file option uncompressed".
|
||||
io.mo:Expected error in mat port-operations1: "invalid file option truncate".
|
||||
***************
|
||||
*** 7005,7011 ****
|
||||
*** 7023,7029 ****
|
||||
io.mo:Expected error in mat port-operations1: "set-port-length!: all-the-way is not a valid length".
|
||||
io.mo:Expected error in mat port-operations1: "truncate-port: #<binary input port testfile.ss> is not an output port".
|
||||
io.mo:Expected error in mat port-operations1: "truncate-port: animal-crackers is not an output port".
|
||||
|
|
@ -4261,7 +4299,7 @@
|
|||
io.mo:Expected error in mat port-operations1: "truncate-port: not permitted on closed port #<binary input/output port testfile.ss>".
|
||||
io.mo:Expected error in mat port-operations3: "file-port?: "not a port" is not a port".
|
||||
io.mo:Expected error in mat port-operations3: "port-file-descriptor: oops is not a port".
|
||||
--- 7005,7011 ----
|
||||
--- 7023,7029 ----
|
||||
io.mo:Expected error in mat port-operations1: "set-port-length!: all-the-way is not a valid length".
|
||||
io.mo:Expected error in mat port-operations1: "truncate-port: #<binary input port testfile.ss> is not an output port".
|
||||
io.mo:Expected error in mat port-operations1: "truncate-port: animal-crackers is not an output port".
|
||||
|
|
@ -4270,7 +4308,7 @@
|
|||
io.mo:Expected error in mat port-operations3: "file-port?: "not a port" is not a port".
|
||||
io.mo:Expected error in mat port-operations3: "port-file-descriptor: oops is not a port".
|
||||
***************
|
||||
*** 7188,7200 ****
|
||||
*** 7206,7218 ****
|
||||
io.mo:Expected error in mat low-level-port-operations: "set-binary-port-output-size!: #vu8(1 2 3) is not a valid size for #<binary output port bytevector>".
|
||||
io.mo:Expected error in mat low-level-port-operations: "set-binary-port-output-size!: -1 is not a valid size for #<binary output port bytevector>".
|
||||
io.mo:Expected error in mat low-level-port-operations: "set-binary-port-output-size!: 6 is not a valid size for #<binary output port bytevector>".
|
||||
|
|
@ -4284,7 +4322,7 @@
|
|||
io.mo:Expected error in mat custom-port-buffer-size: "custom-port-buffer-size: shoe is not a positive fixnum".
|
||||
io.mo:Expected error in mat custom-port-buffer-size: "custom-port-buffer-size: 0 is not a positive fixnum".
|
||||
io.mo:Expected error in mat custom-port-buffer-size: "custom-port-buffer-size: -15 is not a positive fixnum".
|
||||
--- 7188,7200 ----
|
||||
--- 7206,7218 ----
|
||||
io.mo:Expected error in mat low-level-port-operations: "set-binary-port-output-size!: #vu8(1 2 3) is not a valid size for #<binary output port bytevector>".
|
||||
io.mo:Expected error in mat low-level-port-operations: "set-binary-port-output-size!: -1 is not a valid size for #<binary output port bytevector>".
|
||||
io.mo:Expected error in mat low-level-port-operations: "set-binary-port-output-size!: 6 is not a valid size for #<binary output port bytevector>".
|
||||
|
|
@ -4299,7 +4337,7 @@
|
|||
io.mo:Expected error in mat custom-port-buffer-size: "custom-port-buffer-size: 0 is not a positive fixnum".
|
||||
io.mo:Expected error in mat custom-port-buffer-size: "custom-port-buffer-size: -15 is not a positive fixnum".
|
||||
***************
|
||||
*** 7220,7235 ****
|
||||
*** 7238,7253 ****
|
||||
io.mo:Expected error in mat compression: "port-file-compressed!: cannot compress input/output port #<binary input/output port testfile.ss>".
|
||||
io.mo:Expected error in mat compression: "port-file-compressed!: #<output port string> is not a file port".
|
||||
io.mo:Expected error in mat compression: "port-file-compressed!: cannot compress input/output port #<binary input/output port testfile.ss>".
|
||||
|
|
@ -4316,7 +4354,7 @@
|
|||
io.mo:Expected error in mat custom-binary-ports: "unget-u8: cannot unget 255 on #<binary input port foo>".
|
||||
io.mo:Expected error in mat custom-binary-ports: "put-u8: #<binary input port foo> is not a binary output port".
|
||||
io.mo:Expected error in mat custom-binary-ports: "port-length: #<binary input port foo> does not support operation".
|
||||
--- 7220,7235 ----
|
||||
--- 7238,7253 ----
|
||||
io.mo:Expected error in mat compression: "port-file-compressed!: cannot compress input/output port #<binary input/output port testfile.ss>".
|
||||
io.mo:Expected error in mat compression: "port-file-compressed!: #<output port string> is not a file port".
|
||||
io.mo:Expected error in mat compression: "port-file-compressed!: cannot compress input/output port #<binary input/output port testfile.ss>".
|
||||
|
|
@ -4334,7 +4372,7 @@
|
|||
io.mo:Expected error in mat custom-binary-ports: "put-u8: #<binary input port foo> is not a binary output port".
|
||||
io.mo:Expected error in mat custom-binary-ports: "port-length: #<binary input port foo> does not support operation".
|
||||
***************
|
||||
*** 7301,7316 ****
|
||||
*** 7319,7334 ****
|
||||
io.mo:Expected error in mat current-ports: "console-output-port: #<input port string> is not a textual output port".
|
||||
io.mo:Expected error in mat current-ports: "console-error-port: #<input port string> is not a textual output port".
|
||||
io.mo:Expected error in mat current-transcoder: "current-transcoder: #<output port string> is not a transcoder".
|
||||
|
|
@ -4351,7 +4389,7 @@
|
|||
io.mo:Expected error in mat utf-16-codec: "utf-16-codec: invalid endianness #f".
|
||||
io.mo:Expected error in mat to-fold-or-not-to-fold: "get-datum: invalid character name #\newLine at char 0 of #<input port string>".
|
||||
io.mo:Expected error in mat to-fold-or-not-to-fold: "get-datum: invalid character name #\newLine at char 15 of #<input port string>".
|
||||
--- 7301,7316 ----
|
||||
--- 7319,7334 ----
|
||||
io.mo:Expected error in mat current-ports: "console-output-port: #<input port string> is not a textual output port".
|
||||
io.mo:Expected error in mat current-ports: "console-error-port: #<input port string> is not a textual output port".
|
||||
io.mo:Expected error in mat current-transcoder: "current-transcoder: #<output port string> is not a transcoder".
|
||||
|
|
@ -4369,7 +4407,7 @@
|
|||
io.mo:Expected error in mat to-fold-or-not-to-fold: "get-datum: invalid character name #\newLine at char 0 of #<input port string>".
|
||||
io.mo:Expected error in mat to-fold-or-not-to-fold: "get-datum: invalid character name #\newLine at char 15 of #<input port string>".
|
||||
***************
|
||||
*** 7482,7488 ****
|
||||
*** 7500,7506 ****
|
||||
7.mo:Expected error in mat eval-when: "invalid syntax visit-x".
|
||||
7.mo:Expected error in mat eval-when: "invalid syntax revisit-x".
|
||||
7.mo:Expected error in mat compile-whole-program: "compile-whole-program: failed for nosuchfile.wpo: no such file or directory".
|
||||
|
|
@ -4377,7 +4415,7 @@
|
|||
7.mo:Expected error in mat compile-whole-program: "separate-eval: Exception in environment: attempt to import invisible library (testfile-wpo-lib)
|
||||
7.mo:Expected error in mat compile-whole-program: "separate-eval: Exception: library (testfile-wpo-a4) not found
|
||||
7.mo:Expected error in mat compile-whole-program: "separate-eval: Exception: library (testfile-wpo-c4) not found
|
||||
--- 7482,7488 ----
|
||||
--- 7500,7506 ----
|
||||
7.mo:Expected error in mat eval-when: "invalid syntax visit-x".
|
||||
7.mo:Expected error in mat eval-when: "invalid syntax revisit-x".
|
||||
7.mo:Expected error in mat compile-whole-program: "compile-whole-program: failed for nosuchfile.wpo: no such file or directory".
|
||||
|
|
@ -4386,7 +4424,7 @@
|
|||
7.mo:Expected error in mat compile-whole-program: "separate-eval: Exception: library (testfile-wpo-a4) not found
|
||||
7.mo:Expected error in mat compile-whole-program: "separate-eval: Exception: library (testfile-wpo-c4) not found
|
||||
***************
|
||||
*** 7548,7574 ****
|
||||
*** 7566,7592 ****
|
||||
7.mo:Expected error in mat concatenate-object-files: "separate-eval: Exception in verify-loadability: cannot find object file for library (testfile-cof1A)
|
||||
7.mo:Expected error in mat concatenate-object-files: "separate-eval: Exception in verify-loadability: cannot find object file for library (testfile-cof1B)
|
||||
7.mo:Expected error in mat top-level-value-functions: "top-level-bound?: "hello" is not a symbol".
|
||||
|
|
@ -4414,7 +4452,7 @@
|
|||
7.mo:Expected error in mat top-level-value-functions: "define-top-level-value: hello is not an environment".
|
||||
7.mo:Expected error in mat top-level-value-functions: "define-top-level-value: #<environment *scheme*> is not a symbol".
|
||||
7.mo:Expected error in mat top-level-value-functions: "variable i-am-not-bound-i-hope is not bound".
|
||||
--- 7548,7574 ----
|
||||
--- 7566,7592 ----
|
||||
7.mo:Expected error in mat concatenate-object-files: "separate-eval: Exception in verify-loadability: cannot find object file for library (testfile-cof1A)
|
||||
7.mo:Expected error in mat concatenate-object-files: "separate-eval: Exception in verify-loadability: cannot find object file for library (testfile-cof1B)
|
||||
7.mo:Expected error in mat top-level-value-functions: "top-level-bound?: "hello" is not a symbol".
|
||||
|
|
@ -4443,7 +4481,7 @@
|
|||
7.mo:Expected error in mat top-level-value-functions: "define-top-level-value: #<environment *scheme*> is not a symbol".
|
||||
7.mo:Expected error in mat top-level-value-functions: "variable i-am-not-bound-i-hope is not bound".
|
||||
***************
|
||||
*** 7883,7889 ****
|
||||
*** 7901,7907 ****
|
||||
record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments 1 to #<procedure>".
|
||||
record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments 1 to #<procedure>".
|
||||
record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments 3 to #<procedure>".
|
||||
|
|
@ -4451,7 +4489,7 @@
|
|||
record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments 4 to #<procedure constructor>".
|
||||
record.mo:Expected error in mat r6rs-records-procedural: "make-record-constructor-descriptor: record constructor descriptor #<record constructor descriptor> is not for parent of record type #<record type grand-child>".
|
||||
record.mo:Expected error in mat r6rs-records-procedural: "make-record-type-descriptor: cannot extend sealed record type #<record type bar>".
|
||||
--- 7883,7889 ----
|
||||
--- 7901,7907 ----
|
||||
record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments 1 to #<procedure>".
|
||||
record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments 1 to #<procedure>".
|
||||
record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments 3 to #<procedure>".
|
||||
|
|
@ -4460,7 +4498,7 @@
|
|||
record.mo:Expected error in mat r6rs-records-procedural: "make-record-constructor-descriptor: record constructor descriptor #<record constructor descriptor> is not for parent of record type #<record type grand-child>".
|
||||
record.mo:Expected error in mat r6rs-records-procedural: "make-record-type-descriptor: cannot extend sealed record type #<record type bar>".
|
||||
***************
|
||||
*** 7973,8087 ****
|
||||
*** 7991,8105 ****
|
||||
hash.mo:Expected error in mat old-hash-table: "hash-table-for-each: ((a . b)) is not an eq hashtable".
|
||||
hash.mo:Expected error in mat old-hash-table: "incorrect number of arguments 2 to #<procedure>".
|
||||
hash.mo:Expected error in mat old-hash-table: "incorrect number of arguments 2 to #<procedure>".
|
||||
|
|
@ -4576,7 +4614,7 @@
|
|||
hash.mo:Expected error in mat hashtable-arguments: "hashtable-ephemeron?: (hash . table) is not a hashtable".
|
||||
hash.mo:Expected error in mat hash-return-value: "hashtable-ref: invalid hash-function #<procedure> return value "oops" for any".
|
||||
hash.mo:Expected error in mat hash-return-value: "hashtable-ref: invalid hash-function #<procedure> return value 3.5 for any".
|
||||
--- 7973,8087 ----
|
||||
--- 7991,8105 ----
|
||||
hash.mo:Expected error in mat old-hash-table: "hash-table-for-each: ((a . b)) is not an eq hashtable".
|
||||
hash.mo:Expected error in mat old-hash-table: "incorrect number of arguments 2 to #<procedure>".
|
||||
hash.mo:Expected error in mat old-hash-table: "incorrect number of arguments 2 to #<procedure>".
|
||||
|
|
@ -4693,7 +4731,7 @@
|
|||
hash.mo:Expected error in mat hash-return-value: "hashtable-ref: invalid hash-function #<procedure> return value "oops" for any".
|
||||
hash.mo:Expected error in mat hash-return-value: "hashtable-ref: invalid hash-function #<procedure> return value 3.5 for any".
|
||||
***************
|
||||
*** 8104,8226 ****
|
||||
*** 8122,8244 ****
|
||||
hash.mo:Expected error in mat hash-return-value: "hashtable-delete!: invalid hash-function #<procedure> return value "oops" for any".
|
||||
hash.mo:Expected error in mat hash-return-value: "hashtable-delete!: invalid hash-function #<procedure> return value 3.5 for any".
|
||||
hash.mo:Expected error in mat hash-return-value: "hashtable-delete!: invalid hash-function #<procedure> return value 1+2i for any".
|
||||
|
|
@ -4817,7 +4855,7 @@
|
|||
hash.mo:Expected error in mat eqv-hashtable-arguments: "make-ephemeron-eqv-hashtable: invalid size argument -1".
|
||||
hash.mo:Expected error in mat eqv-hashtable-arguments: "make-ephemeron-eqv-hashtable: invalid size argument #t".
|
||||
hash.mo:Expected error in mat eqv-hashtable-arguments: "make-ephemeron-eqv-hashtable: invalid size argument #f".
|
||||
--- 8104,8226 ----
|
||||
--- 8122,8244 ----
|
||||
hash.mo:Expected error in mat hash-return-value: "hashtable-delete!: invalid hash-function #<procedure> return value "oops" for any".
|
||||
hash.mo:Expected error in mat hash-return-value: "hashtable-delete!: invalid hash-function #<procedure> return value 3.5 for any".
|
||||
hash.mo:Expected error in mat hash-return-value: "hashtable-delete!: invalid hash-function #<procedure> return value 1+2i for any".
|
||||
|
|
@ -4942,7 +4980,7 @@
|
|||
hash.mo:Expected error in mat eqv-hashtable-arguments: "make-ephemeron-eqv-hashtable: invalid size argument #t".
|
||||
hash.mo:Expected error in mat eqv-hashtable-arguments: "make-ephemeron-eqv-hashtable: invalid size argument #f".
|
||||
***************
|
||||
*** 8228,8243 ****
|
||||
*** 8246,8261 ****
|
||||
hash.mo:Expected error in mat generic-hashtable: "hashtable-delete!: #<hashtable> is not mutable".
|
||||
hash.mo:Expected error in mat generic-hashtable: "hashtable-update!: #<hashtable> is not mutable".
|
||||
hash.mo:Expected error in mat generic-hashtable: "hashtable-update!: #<hashtable> is not mutable".
|
||||
|
|
@ -4959,7 +4997,7 @@
|
|||
hash.mo:Expected error in mat hash-functions: "string-ci-hash: hello is not a string".
|
||||
hash.mo:Expected error in mat fasl-other-hashtable: "fasl-write: invalid fasl object #<eqv hashtable>".
|
||||
hash.mo:Expected error in mat fasl-other-hashtable: "fasl-write: invalid fasl object #<hashtable>".
|
||||
--- 8228,8243 ----
|
||||
--- 8246,8261 ----
|
||||
hash.mo:Expected error in mat generic-hashtable: "hashtable-delete!: #<hashtable> is not mutable".
|
||||
hash.mo:Expected error in mat generic-hashtable: "hashtable-update!: #<hashtable> is not mutable".
|
||||
hash.mo:Expected error in mat generic-hashtable: "hashtable-update!: #<hashtable> is not mutable".
|
||||
|
|
@ -4977,7 +5015,7 @@
|
|||
hash.mo:Expected error in mat fasl-other-hashtable: "fasl-write: invalid fasl object #<eqv hashtable>".
|
||||
hash.mo:Expected error in mat fasl-other-hashtable: "fasl-write: invalid fasl object #<hashtable>".
|
||||
***************
|
||||
*** 8353,8360 ****
|
||||
*** 8371,8378 ****
|
||||
8.mo:Expected error in mat with-syntax: "invalid syntax a".
|
||||
8.mo:Expected error in mat with-syntax: "duplicate pattern variable x in (x x)".
|
||||
8.mo:Expected error in mat with-syntax: "duplicate pattern variable x in (x x)".
|
||||
|
|
@ -4986,7 +5024,7 @@
|
|||
8.mo:Expected error in mat generate-temporaries: "generate-temporaries: improper list structure (a b . c)".
|
||||
8.mo:Expected error in mat generate-temporaries: "generate-temporaries: cyclic list structure (a b c b c b ...)".
|
||||
8.mo:Expected error in mat syntax->list: "syntax->list: invalid argument #<syntax a>".
|
||||
--- 8353,8360 ----
|
||||
--- 8371,8378 ----
|
||||
8.mo:Expected error in mat with-syntax: "invalid syntax a".
|
||||
8.mo:Expected error in mat with-syntax: "duplicate pattern variable x in (x x)".
|
||||
8.mo:Expected error in mat with-syntax: "duplicate pattern variable x in (x x)".
|
||||
|
|
@ -4996,7 +5034,7 @@
|
|||
8.mo:Expected error in mat generate-temporaries: "generate-temporaries: cyclic list structure (a b c b c b ...)".
|
||||
8.mo:Expected error in mat syntax->list: "syntax->list: invalid argument #<syntax a>".
|
||||
***************
|
||||
*** 8971,8986 ****
|
||||
*** 8989,9004 ****
|
||||
8.mo:Expected error in mat rnrs-eval: "attempt to assign unbound identifier foo".
|
||||
8.mo:Expected error in mat rnrs-eval: "invalid definition in immutable environment (define cons (quote #<procedure vector>))".
|
||||
8.mo:Expected error in mat top-level-syntax-functions: "top-level-syntax: "hello" is not a symbol".
|
||||
|
|
@ -5013,7 +5051,7 @@
|
|||
8.mo:Expected error in mat top-level-syntax-functions: "define-top-level-syntax: hello is not an environment".
|
||||
8.mo:Expected error in mat top-level-syntax-functions: "define-top-level-syntax: #<environment *scheme*> is not a symbol".
|
||||
8.mo:Expected error in mat top-level-syntax-functions: "define-top-level-syntax: cannot modify immutable environment #<environment *scheme*>".
|
||||
--- 8971,8986 ----
|
||||
--- 8989,9004 ----
|
||||
8.mo:Expected error in mat rnrs-eval: "attempt to assign unbound identifier foo".
|
||||
8.mo:Expected error in mat rnrs-eval: "invalid definition in immutable environment (define cons (quote #<procedure vector>))".
|
||||
8.mo:Expected error in mat top-level-syntax-functions: "top-level-syntax: "hello" is not a symbol".
|
||||
|
|
@ -5031,7 +5069,7 @@
|
|||
8.mo:Expected error in mat top-level-syntax-functions: "define-top-level-syntax: #<environment *scheme*> is not a symbol".
|
||||
8.mo:Expected error in mat top-level-syntax-functions: "define-top-level-syntax: cannot modify immutable environment #<environment *scheme*>".
|
||||
***************
|
||||
*** 9079,9101 ****
|
||||
*** 9097,9119 ****
|
||||
fx.mo:Expected error in mat fx=?: "fx=?: (a) is not a fixnum".
|
||||
fx.mo:Expected error in mat fx=?: "fx=?: <int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fx=?: "fx=?: <-int> is not a fixnum".
|
||||
|
|
@ -5055,7 +5093,7 @@
|
|||
fx.mo:Expected error in mat $fxu<: "incorrect number of arguments 1 to #<procedure $fxu<>".
|
||||
fx.mo:Expected error in mat $fxu<: "incorrect number of arguments 3 to #<procedure $fxu<>".
|
||||
fx.mo:Expected error in mat $fxu<: "$fxu<: <-int> is not a fixnum".
|
||||
--- 9079,9101 ----
|
||||
--- 9097,9119 ----
|
||||
fx.mo:Expected error in mat fx=?: "fx=?: (a) is not a fixnum".
|
||||
fx.mo:Expected error in mat fx=?: "fx=?: <int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fx=?: "fx=?: <-int> is not a fixnum".
|
||||
|
|
@ -5080,7 +5118,7 @@
|
|||
fx.mo:Expected error in mat $fxu<: "incorrect number of arguments 3 to #<procedure $fxu<>".
|
||||
fx.mo:Expected error in mat $fxu<: "$fxu<: <-int> is not a fixnum".
|
||||
***************
|
||||
*** 9127,9139 ****
|
||||
*** 9145,9157 ****
|
||||
fx.mo:Expected error in mat r6rs:fx-: "fx-: #f is not a fixnum".
|
||||
fx.mo:Expected error in mat r6rs:fx-: "fx-: #f is not a fixnum".
|
||||
fx.mo:Expected error in mat fx*: "fx*: (a . b) is not a fixnum".
|
||||
|
|
@ -5094,7 +5132,7 @@
|
|||
fx.mo:Expected error in mat r6rs:fx*: "fx*: <int> is not a fixnum".
|
||||
fx.mo:Expected error in mat r6rs:fx*: "fx*: <-int> is not a fixnum".
|
||||
fx.mo:Expected error in mat r6rs:fx*: "fx*: #f is not a fixnum".
|
||||
--- 9127,9139 ----
|
||||
--- 9145,9157 ----
|
||||
fx.mo:Expected error in mat r6rs:fx-: "fx-: #f is not a fixnum".
|
||||
fx.mo:Expected error in mat r6rs:fx-: "fx-: #f is not a fixnum".
|
||||
fx.mo:Expected error in mat fx*: "fx*: (a . b) is not a fixnum".
|
||||
|
|
@ -5109,7 +5147,7 @@
|
|||
fx.mo:Expected error in mat r6rs:fx*: "fx*: <-int> is not a fixnum".
|
||||
fx.mo:Expected error in mat r6rs:fx*: "fx*: #f is not a fixnum".
|
||||
***************
|
||||
*** 9183,9195 ****
|
||||
*** 9201,9213 ****
|
||||
fx.mo:Expected error in mat fx1+: "fx1+: <-int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fx1+: "fx1+: <int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fx1+: "fx1+: a is not a fixnum".
|
||||
|
|
@ -5123,7 +5161,7 @@
|
|||
fx.mo:Expected error in mat fxmax: "fxmax: a is not a fixnum".
|
||||
fx.mo:Expected error in mat fxmax: "fxmax: <int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fxmax: "fxmax: <-int> is not a fixnum".
|
||||
--- 9183,9195 ----
|
||||
--- 9201,9213 ----
|
||||
fx.mo:Expected error in mat fx1+: "fx1+: <-int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fx1+: "fx1+: <int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fx1+: "fx1+: a is not a fixnum".
|
||||
|
|
@ -5138,7 +5176,7 @@
|
|||
fx.mo:Expected error in mat fxmax: "fxmax: <int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fxmax: "fxmax: <-int> is not a fixnum".
|
||||
***************
|
||||
*** 9287,9296 ****
|
||||
*** 9305,9314 ****
|
||||
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments <int> and 10".
|
||||
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments -4097 and <int>".
|
||||
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments <-int> and 1".
|
||||
|
|
@ -5149,7 +5187,7 @@
|
|||
fx.mo:Expected error in mat fxbit-field: "fxbit-field: 35.0 is not a fixnum".
|
||||
fx.mo:Expected error in mat fxbit-field: "fxbit-field: 5.0 is not a valid start index".
|
||||
fx.mo:Expected error in mat fxbit-field: "fxbit-field: 8.0 is not a valid end index".
|
||||
--- 9287,9296 ----
|
||||
--- 9305,9314 ----
|
||||
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments <int> and 10".
|
||||
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments -4097 and <int>".
|
||||
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments <-int> and 1".
|
||||
|
|
@ -5161,7 +5199,7 @@
|
|||
fx.mo:Expected error in mat fxbit-field: "fxbit-field: 5.0 is not a valid start index".
|
||||
fx.mo:Expected error in mat fxbit-field: "fxbit-field: 8.0 is not a valid end index".
|
||||
***************
|
||||
*** 9304,9337 ****
|
||||
*** 9322,9355 ****
|
||||
fx.mo:Expected error in mat fxbit-field: "fxbit-field: <int> is not a valid end index".
|
||||
fx.mo:Expected error in mat fxbit-field: "fxbit-field: <int> is not a valid start index".
|
||||
fx.mo:Expected error in mat fxbit-field: "fxbit-field: <int> is not a valid end index".
|
||||
|
|
@ -5196,7 +5234,7 @@
|
|||
fx.mo:Expected error in mat fxif: "fxif: a is not a fixnum".
|
||||
fx.mo:Expected error in mat fxif: "fxif: 3.4 is not a fixnum".
|
||||
fx.mo:Expected error in mat fxif: "fxif: (a) is not a fixnum".
|
||||
--- 9304,9337 ----
|
||||
--- 9322,9355 ----
|
||||
fx.mo:Expected error in mat fxbit-field: "fxbit-field: <int> is not a valid end index".
|
||||
fx.mo:Expected error in mat fxbit-field: "fxbit-field: <int> is not a valid start index".
|
||||
fx.mo:Expected error in mat fxbit-field: "fxbit-field: <int> is not a valid end index".
|
||||
|
|
@ -5232,7 +5270,7 @@
|
|||
fx.mo:Expected error in mat fxif: "fxif: 3.4 is not a fixnum".
|
||||
fx.mo:Expected error in mat fxif: "fxif: (a) is not a fixnum".
|
||||
***************
|
||||
*** 9341,9384 ****
|
||||
*** 9359,9402 ****
|
||||
fx.mo:Expected error in mat fxif: "fxif: <-int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fxif: "fxif: <-int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fxif: "fxif: <-int> is not a fixnum".
|
||||
|
|
@ -5277,7 +5315,7 @@
|
|||
fx.mo:Expected error in mat fxcopy-bit: "fxcopy-bit: 3.4 is not a fixnum".
|
||||
fx.mo:Expected error in mat fxcopy-bit: "fxcopy-bit: "3" is not a fixnum".
|
||||
fx.mo:Expected error in mat fxcopy-bit: "fxcopy-bit: <int> is not a fixnum".
|
||||
--- 9341,9384 ----
|
||||
--- 9359,9402 ----
|
||||
fx.mo:Expected error in mat fxif: "fxif: <-int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fxif: "fxif: <-int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fxif: "fxif: <-int> is not a fixnum".
|
||||
|
|
@ -5323,7 +5361,7 @@
|
|||
fx.mo:Expected error in mat fxcopy-bit: "fxcopy-bit: "3" is not a fixnum".
|
||||
fx.mo:Expected error in mat fxcopy-bit: "fxcopy-bit: <int> is not a fixnum".
|
||||
***************
|
||||
*** 9387,9397 ****
|
||||
*** 9405,9415 ****
|
||||
fx.mo:Expected error in mat fxcopy-bit: "fxcopy-bit: invalid bit index -1".
|
||||
fx.mo:Expected error in mat fxcopy-bit: "fxcopy-bit: invalid bit index <int>".
|
||||
fx.mo:Expected error in mat fxcopy-bit: "fxcopy-bit: invalid bit index <int>".
|
||||
|
|
@ -5335,7 +5373,7 @@
|
|||
fx.mo:Expected error in mat fxcopy-bit-field: "fxcopy-bit-field: "3" is not a fixnum".
|
||||
fx.mo:Expected error in mat fxcopy-bit-field: "fxcopy-bit-field: 3.4 is not a valid start index".
|
||||
fx.mo:Expected error in mat fxcopy-bit-field: "fxcopy-bit-field: 3/4 is not a valid end index".
|
||||
--- 9387,9397 ----
|
||||
--- 9405,9415 ----
|
||||
fx.mo:Expected error in mat fxcopy-bit: "fxcopy-bit: invalid bit index -1".
|
||||
fx.mo:Expected error in mat fxcopy-bit: "fxcopy-bit: invalid bit index <int>".
|
||||
fx.mo:Expected error in mat fxcopy-bit: "fxcopy-bit: invalid bit index <int>".
|
||||
|
|
@ -5348,7 +5386,7 @@
|
|||
fx.mo:Expected error in mat fxcopy-bit-field: "fxcopy-bit-field: 3.4 is not a valid start index".
|
||||
fx.mo:Expected error in mat fxcopy-bit-field: "fxcopy-bit-field: 3/4 is not a valid end index".
|
||||
***************
|
||||
*** 9451,9460 ****
|
||||
*** 9469,9478 ****
|
||||
fx.mo:Expected error in mat fxdiv0-and-mod0: "fxmod0: (a) is not a fixnum".
|
||||
fx.mo:Expected error in mat fxdiv0-and-mod0: "fxmod0: undefined for 0".
|
||||
fx.mo:Expected error in mat fxdiv0-and-mod0: "fxmod0: undefined for 0".
|
||||
|
|
@ -5359,7 +5397,7 @@
|
|||
fx.mo:Expected error in mat fx+/carry: "fx+/carry: 1.0 is not a fixnum".
|
||||
fx.mo:Expected error in mat fx+/carry: "fx+/carry: 2.0 is not a fixnum".
|
||||
fx.mo:Expected error in mat fx+/carry: "fx+/carry: 3.0 is not a fixnum".
|
||||
--- 9451,9460 ----
|
||||
--- 9469,9478 ----
|
||||
fx.mo:Expected error in mat fxdiv0-and-mod0: "fxmod0: (a) is not a fixnum".
|
||||
fx.mo:Expected error in mat fxdiv0-and-mod0: "fxmod0: undefined for 0".
|
||||
fx.mo:Expected error in mat fxdiv0-and-mod0: "fxmod0: undefined for 0".
|
||||
|
|
@ -5371,7 +5409,7 @@
|
|||
fx.mo:Expected error in mat fx+/carry: "fx+/carry: 2.0 is not a fixnum".
|
||||
fx.mo:Expected error in mat fx+/carry: "fx+/carry: 3.0 is not a fixnum".
|
||||
***************
|
||||
*** 9470,9479 ****
|
||||
*** 9488,9497 ****
|
||||
fx.mo:Expected error in mat fx+/carry: "fx+/carry: <-int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fx+/carry: "fx+/carry: <-int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fx+/carry: "fx+/carry: <-int> is not a fixnum".
|
||||
|
|
@ -5382,7 +5420,7 @@
|
|||
fx.mo:Expected error in mat fx-/carry: "fx-/carry: 1.0 is not a fixnum".
|
||||
fx.mo:Expected error in mat fx-/carry: "fx-/carry: 2.0 is not a fixnum".
|
||||
fx.mo:Expected error in mat fx-/carry: "fx-/carry: 3.0 is not a fixnum".
|
||||
--- 9470,9479 ----
|
||||
--- 9488,9497 ----
|
||||
fx.mo:Expected error in mat fx+/carry: "fx+/carry: <-int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fx+/carry: "fx+/carry: <-int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fx+/carry: "fx+/carry: <-int> is not a fixnum".
|
||||
|
|
@ -5394,7 +5432,7 @@
|
|||
fx.mo:Expected error in mat fx-/carry: "fx-/carry: 2.0 is not a fixnum".
|
||||
fx.mo:Expected error in mat fx-/carry: "fx-/carry: 3.0 is not a fixnum".
|
||||
***************
|
||||
*** 9489,9498 ****
|
||||
*** 9507,9516 ****
|
||||
fx.mo:Expected error in mat fx-/carry: "fx-/carry: <-int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fx-/carry: "fx-/carry: <-int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fx-/carry: "fx-/carry: <-int> is not a fixnum".
|
||||
|
|
@ -5405,7 +5443,7 @@
|
|||
fx.mo:Expected error in mat fx*/carry: "fx*/carry: 1.0 is not a fixnum".
|
||||
fx.mo:Expected error in mat fx*/carry: "fx*/carry: 2.0 is not a fixnum".
|
||||
fx.mo:Expected error in mat fx*/carry: "fx*/carry: 3.0 is not a fixnum".
|
||||
--- 9489,9498 ----
|
||||
--- 9507,9516 ----
|
||||
fx.mo:Expected error in mat fx-/carry: "fx-/carry: <-int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fx-/carry: "fx-/carry: <-int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fx-/carry: "fx-/carry: <-int> is not a fixnum".
|
||||
|
|
@ -5417,7 +5455,7 @@
|
|||
fx.mo:Expected error in mat fx*/carry: "fx*/carry: 2.0 is not a fixnum".
|
||||
fx.mo:Expected error in mat fx*/carry: "fx*/carry: 3.0 is not a fixnum".
|
||||
***************
|
||||
*** 9508,9518 ****
|
||||
*** 9526,9536 ****
|
||||
fx.mo:Expected error in mat fx*/carry: "fx*/carry: <-int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fx*/carry: "fx*/carry: <-int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fx*/carry: "fx*/carry: <-int> is not a fixnum".
|
||||
|
|
@ -5429,7 +5467,7 @@
|
|||
fx.mo:Expected error in mat fxrotate-bit-field: "fxrotate-bit-field: a is not a fixnum".
|
||||
fx.mo:Expected error in mat fxrotate-bit-field: "fxrotate-bit-field: invalid start index 0.0".
|
||||
fx.mo:Expected error in mat fxrotate-bit-field: "fxrotate-bit-field: invalid end index 2.0".
|
||||
--- 9508,9518 ----
|
||||
--- 9526,9536 ----
|
||||
fx.mo:Expected error in mat fx*/carry: "fx*/carry: <-int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fx*/carry: "fx*/carry: <-int> is not a fixnum".
|
||||
fx.mo:Expected error in mat fx*/carry: "fx*/carry: <-int> is not a fixnum".
|
||||
|
|
@ -5442,7 +5480,7 @@
|
|||
fx.mo:Expected error in mat fxrotate-bit-field: "fxrotate-bit-field: invalid start index 0.0".
|
||||
fx.mo:Expected error in mat fxrotate-bit-field: "fxrotate-bit-field: invalid end index 2.0".
|
||||
***************
|
||||
*** 9535,9544 ****
|
||||
*** 9553,9562 ****
|
||||
fx.mo:Expected error in mat fxrotate-bit-field: "fxrotate-bit-field: invalid end index <int>".
|
||||
fx.mo:Expected error in mat fxrotate-bit-field: "fxrotate-bit-field: invalid end index <int>".
|
||||
fx.mo:Expected error in mat fxrotate-bit-field: "fxrotate-bit-field: count 1 is greater than difference between end index 5 and start index 5".
|
||||
|
|
@ -5453,7 +5491,7 @@
|
|||
fx.mo:Expected error in mat fxreverse-bit-field: "fxreverse-bit-field: a is not a fixnum".
|
||||
fx.mo:Expected error in mat fxreverse-bit-field: "fxreverse-bit-field: invalid start index 0.0".
|
||||
fx.mo:Expected error in mat fxreverse-bit-field: "fxreverse-bit-field: invalid end index 2.0".
|
||||
--- 9535,9544 ----
|
||||
--- 9553,9562 ----
|
||||
fx.mo:Expected error in mat fxrotate-bit-field: "fxrotate-bit-field: invalid end index <int>".
|
||||
fx.mo:Expected error in mat fxrotate-bit-field: "fxrotate-bit-field: invalid end index <int>".
|
||||
fx.mo:Expected error in mat fxrotate-bit-field: "fxrotate-bit-field: count 1 is greater than difference between end index 5 and start index 5".
|
||||
|
|
@ -5465,7 +5503,7 @@
|
|||
fx.mo:Expected error in mat fxreverse-bit-field: "fxreverse-bit-field: invalid start index 0.0".
|
||||
fx.mo:Expected error in mat fxreverse-bit-field: "fxreverse-bit-field: invalid end index 2.0".
|
||||
***************
|
||||
*** 9554,9571 ****
|
||||
*** 9572,9589 ****
|
||||
fx.mo:Expected error in mat fxreverse-bit-field: "fxreverse-bit-field: invalid end index <int>".
|
||||
fx.mo:Expected error in mat fxreverse-bit-field: "fxreverse-bit-field: invalid end index <-int>".
|
||||
fx.mo:Expected error in mat fxreverse-bit-field: "fxreverse-bit-field: start index 7 is greater than end index 5".
|
||||
|
|
@ -5484,7 +5522,7 @@
|
|||
fl.mo:Expected error in mat fl=: "fl=: (a) is not a flonum".
|
||||
fl.mo:Expected error in mat fl=: "fl=: a is not a flonum".
|
||||
fl.mo:Expected error in mat fl=: "fl=: a is not a flonum".
|
||||
--- 9554,9571 ----
|
||||
--- 9572,9589 ----
|
||||
fx.mo:Expected error in mat fxreverse-bit-field: "fxreverse-bit-field: invalid end index <int>".
|
||||
fx.mo:Expected error in mat fxreverse-bit-field: "fxreverse-bit-field: invalid end index <-int>".
|
||||
fx.mo:Expected error in mat fxreverse-bit-field: "fxreverse-bit-field: start index 7 is greater than end index 5".
|
||||
|
|
@ -5504,7 +5542,7 @@
|
|||
fl.mo:Expected error in mat fl=: "fl=: a is not a flonum".
|
||||
fl.mo:Expected error in mat fl=: "fl=: a is not a flonum".
|
||||
***************
|
||||
*** 9573,9579 ****
|
||||
*** 9591,9597 ****
|
||||
fl.mo:Expected error in mat fl=: "fl=: 3 is not a flonum".
|
||||
fl.mo:Expected error in mat fl=: "fl=: 7/2 is not a flonum".
|
||||
fl.mo:Expected error in mat fl=: "fl=: 7/2 is not a flonum".
|
||||
|
|
@ -5512,7 +5550,7 @@
|
|||
fl.mo:Expected error in mat fl<: "fl<: (a) is not a flonum".
|
||||
fl.mo:Expected error in mat fl<: "fl<: a is not a flonum".
|
||||
fl.mo:Expected error in mat fl<: "fl<: a is not a flonum".
|
||||
--- 9573,9579 ----
|
||||
--- 9591,9597 ----
|
||||
fl.mo:Expected error in mat fl=: "fl=: 3 is not a flonum".
|
||||
fl.mo:Expected error in mat fl=: "fl=: 7/2 is not a flonum".
|
||||
fl.mo:Expected error in mat fl=: "fl=: 7/2 is not a flonum".
|
||||
|
|
@ -5521,7 +5559,7 @@
|
|||
fl.mo:Expected error in mat fl<: "fl<: a is not a flonum".
|
||||
fl.mo:Expected error in mat fl<: "fl<: a is not a flonum".
|
||||
***************
|
||||
*** 9581,9587 ****
|
||||
*** 9599,9605 ****
|
||||
fl.mo:Expected error in mat fl<: "fl<: 3 is not a flonum".
|
||||
fl.mo:Expected error in mat fl<: "fl<: 7/2 is not a flonum".
|
||||
fl.mo:Expected error in mat fl<: "fl<: 7/2 is not a flonum".
|
||||
|
|
@ -5529,7 +5567,7 @@
|
|||
fl.mo:Expected error in mat fl>: "fl>: (a) is not a flonum".
|
||||
fl.mo:Expected error in mat fl>: "fl>: a is not a flonum".
|
||||
fl.mo:Expected error in mat fl>: "fl>: a is not a flonum".
|
||||
--- 9581,9587 ----
|
||||
--- 9599,9605 ----
|
||||
fl.mo:Expected error in mat fl<: "fl<: 3 is not a flonum".
|
||||
fl.mo:Expected error in mat fl<: "fl<: 7/2 is not a flonum".
|
||||
fl.mo:Expected error in mat fl<: "fl<: 7/2 is not a flonum".
|
||||
|
|
@ -5538,7 +5576,7 @@
|
|||
fl.mo:Expected error in mat fl>: "fl>: a is not a flonum".
|
||||
fl.mo:Expected error in mat fl>: "fl>: a is not a flonum".
|
||||
***************
|
||||
*** 9589,9595 ****
|
||||
*** 9607,9613 ****
|
||||
fl.mo:Expected error in mat fl>: "fl>: 3 is not a flonum".
|
||||
fl.mo:Expected error in mat fl>: "fl>: 7/2 is not a flonum".
|
||||
fl.mo:Expected error in mat fl>: "fl>: 7/2 is not a flonum".
|
||||
|
|
@ -5546,7 +5584,7 @@
|
|||
fl.mo:Expected error in mat fl<=: "fl<=: (a) is not a flonum".
|
||||
fl.mo:Expected error in mat fl<=: "fl<=: a is not a flonum".
|
||||
fl.mo:Expected error in mat fl<=: "fl<=: a is not a flonum".
|
||||
--- 9589,9595 ----
|
||||
--- 9607,9613 ----
|
||||
fl.mo:Expected error in mat fl>: "fl>: 3 is not a flonum".
|
||||
fl.mo:Expected error in mat fl>: "fl>: 7/2 is not a flonum".
|
||||
fl.mo:Expected error in mat fl>: "fl>: 7/2 is not a flonum".
|
||||
|
|
@ -5555,7 +5593,7 @@
|
|||
fl.mo:Expected error in mat fl<=: "fl<=: a is not a flonum".
|
||||
fl.mo:Expected error in mat fl<=: "fl<=: a is not a flonum".
|
||||
***************
|
||||
*** 9597,9603 ****
|
||||
*** 9615,9621 ****
|
||||
fl.mo:Expected error in mat fl<=: "fl<=: 3 is not a flonum".
|
||||
fl.mo:Expected error in mat fl<=: "fl<=: 7/2 is not a flonum".
|
||||
fl.mo:Expected error in mat fl<=: "fl<=: 7/2 is not a flonum".
|
||||
|
|
@ -5563,7 +5601,7 @@
|
|||
fl.mo:Expected error in mat fl>=: "fl>=: (a) is not a flonum".
|
||||
fl.mo:Expected error in mat fl>=: "fl>=: a is not a flonum".
|
||||
fl.mo:Expected error in mat fl>=: "fl>=: a is not a flonum".
|
||||
--- 9597,9603 ----
|
||||
--- 9615,9621 ----
|
||||
fl.mo:Expected error in mat fl<=: "fl<=: 3 is not a flonum".
|
||||
fl.mo:Expected error in mat fl<=: "fl<=: 7/2 is not a flonum".
|
||||
fl.mo:Expected error in mat fl<=: "fl<=: 7/2 is not a flonum".
|
||||
|
|
@ -5572,7 +5610,7 @@
|
|||
fl.mo:Expected error in mat fl>=: "fl>=: a is not a flonum".
|
||||
fl.mo:Expected error in mat fl>=: "fl>=: a is not a flonum".
|
||||
***************
|
||||
*** 9605,9644 ****
|
||||
*** 9623,9662 ****
|
||||
fl.mo:Expected error in mat fl>=: "fl>=: 3 is not a flonum".
|
||||
fl.mo:Expected error in mat fl>=: "fl>=: 7/2 is not a flonum".
|
||||
fl.mo:Expected error in mat fl>=: "fl>=: 7/2 is not a flonum".
|
||||
|
|
@ -5613,7 +5651,7 @@
|
|||
fl.mo:Expected error in mat fl>=?: "fl>=?: a is not a flonum".
|
||||
fl.mo:Expected error in mat fl>=?: "fl>=?: a is not a flonum".
|
||||
fl.mo:Expected error in mat fl>=?: "fl>=?: 3 is not a flonum".
|
||||
--- 9605,9644 ----
|
||||
--- 9623,9662 ----
|
||||
fl.mo:Expected error in mat fl>=: "fl>=: 3 is not a flonum".
|
||||
fl.mo:Expected error in mat fl>=: "fl>=: 7/2 is not a flonum".
|
||||
fl.mo:Expected error in mat fl>=: "fl>=: 7/2 is not a flonum".
|
||||
|
|
@ -5655,7 +5693,7 @@
|
|||
fl.mo:Expected error in mat fl>=?: "fl>=?: a is not a flonum".
|
||||
fl.mo:Expected error in mat fl>=?: "fl>=?: 3 is not a flonum".
|
||||
***************
|
||||
*** 9648,9654 ****
|
||||
*** 9666,9672 ****
|
||||
fl.mo:Expected error in mat fl+: "fl+: (a . b) is not a flonum".
|
||||
fl.mo:Expected error in mat fl+: "fl+: 1 is not a flonum".
|
||||
fl.mo:Expected error in mat fl+: "fl+: 2/3 is not a flonum".
|
||||
|
|
@ -5663,7 +5701,7 @@
|
|||
fl.mo:Expected error in mat fl-: "fl-: (a . b) is not a flonum".
|
||||
fl.mo:Expected error in mat fl-: "fl-: 1 is not a flonum".
|
||||
fl.mo:Expected error in mat fl-: "fl-: a is not a flonum".
|
||||
--- 9648,9654 ----
|
||||
--- 9666,9672 ----
|
||||
fl.mo:Expected error in mat fl+: "fl+: (a . b) is not a flonum".
|
||||
fl.mo:Expected error in mat fl+: "fl+: 1 is not a flonum".
|
||||
fl.mo:Expected error in mat fl+: "fl+: 2/3 is not a flonum".
|
||||
|
|
@ -5672,7 +5710,7 @@
|
|||
fl.mo:Expected error in mat fl-: "fl-: 1 is not a flonum".
|
||||
fl.mo:Expected error in mat fl-: "fl-: a is not a flonum".
|
||||
***************
|
||||
*** 9658,9740 ****
|
||||
*** 9676,9758 ****
|
||||
fl.mo:Expected error in mat fl*: "fl*: (a . b) is not a flonum".
|
||||
fl.mo:Expected error in mat fl*: "fl*: 1 is not a flonum".
|
||||
fl.mo:Expected error in mat fl*: "fl*: 2/3 is not a flonum".
|
||||
|
|
@ -5756,7 +5794,7 @@
|
|||
fl.mo:Expected error in mat flround: "flround: a is not a flonum".
|
||||
fl.mo:Expected error in mat flround: "flround: 2.0+1.0i is not a flonum".
|
||||
fl.mo:Expected error in mat flround: "flround: 2+1i is not a flonum".
|
||||
--- 9658,9740 ----
|
||||
--- 9676,9758 ----
|
||||
fl.mo:Expected error in mat fl*: "fl*: (a . b) is not a flonum".
|
||||
fl.mo:Expected error in mat fl*: "fl*: 1 is not a flonum".
|
||||
fl.mo:Expected error in mat fl*: "fl*: 2/3 is not a flonum".
|
||||
|
|
@ -5841,7 +5879,7 @@
|
|||
fl.mo:Expected error in mat flround: "flround: 2.0+1.0i is not a flonum".
|
||||
fl.mo:Expected error in mat flround: "flround: 2+1i is not a flonum".
|
||||
***************
|
||||
*** 9754,9789 ****
|
||||
*** 9772,9807 ****
|
||||
fl.mo:Expected error in mat flinfinite?: "flinfinite?: 3 is not a flonum".
|
||||
fl.mo:Expected error in mat flinfinite?: "flinfinite?: 3/4 is not a flonum".
|
||||
fl.mo:Expected error in mat flinfinite?: "flinfinite?: hi is not a flonum".
|
||||
|
|
@ -5878,7 +5916,7 @@
|
|||
fl.mo:Expected error in mat fleven?: "fleven?: a is not a flonum".
|
||||
fl.mo:Expected error in mat fleven?: "fleven?: 3 is not a flonum".
|
||||
fl.mo:Expected error in mat fleven?: "fleven?: 3.2 is not an integer".
|
||||
--- 9754,9789 ----
|
||||
--- 9772,9807 ----
|
||||
fl.mo:Expected error in mat flinfinite?: "flinfinite?: 3 is not a flonum".
|
||||
fl.mo:Expected error in mat flinfinite?: "flinfinite?: 3/4 is not a flonum".
|
||||
fl.mo:Expected error in mat flinfinite?: "flinfinite?: hi is not a flonum".
|
||||
|
|
@ -5916,7 +5954,7 @@
|
|||
fl.mo:Expected error in mat fleven?: "fleven?: 3 is not a flonum".
|
||||
fl.mo:Expected error in mat fleven?: "fleven?: 3.2 is not an integer".
|
||||
***************
|
||||
*** 9791,9798 ****
|
||||
*** 9809,9816 ****
|
||||
fl.mo:Expected error in mat fleven?: "fleven?: 1+1i is not a flonum".
|
||||
fl.mo:Expected error in mat fleven?: "fleven?: +inf.0 is not an integer".
|
||||
fl.mo:Expected error in mat fleven?: "fleven?: +nan.0 is not an integer".
|
||||
|
|
@ -5925,7 +5963,7 @@
|
|||
fl.mo:Expected error in mat flodd?: "flodd?: a is not a flonum".
|
||||
fl.mo:Expected error in mat flodd?: "flodd?: 3 is not a flonum".
|
||||
fl.mo:Expected error in mat flodd?: "flodd?: 3.2 is not an integer".
|
||||
--- 9791,9798 ----
|
||||
--- 9809,9816 ----
|
||||
fl.mo:Expected error in mat fleven?: "fleven?: 1+1i is not a flonum".
|
||||
fl.mo:Expected error in mat fleven?: "fleven?: +inf.0 is not an integer".
|
||||
fl.mo:Expected error in mat fleven?: "fleven?: +nan.0 is not an integer".
|
||||
|
|
@ -5935,7 +5973,7 @@
|
|||
fl.mo:Expected error in mat flodd?: "flodd?: 3 is not a flonum".
|
||||
fl.mo:Expected error in mat flodd?: "flodd?: 3.2 is not an integer".
|
||||
***************
|
||||
*** 9800,9806 ****
|
||||
*** 9818,9824 ****
|
||||
fl.mo:Expected error in mat flodd?: "flodd?: 3+1i is not a flonum".
|
||||
fl.mo:Expected error in mat flodd?: "flodd?: +inf.0 is not an integer".
|
||||
fl.mo:Expected error in mat flodd?: "flodd?: +nan.0 is not an integer".
|
||||
|
|
@ -5943,7 +5981,7 @@
|
|||
fl.mo:Expected error in mat flmin: "flmin: a is not a flonum".
|
||||
fl.mo:Expected error in mat flmin: "flmin: a is not a flonum".
|
||||
fl.mo:Expected error in mat flmin: "flmin: a is not a flonum".
|
||||
--- 9800,9806 ----
|
||||
--- 9818,9824 ----
|
||||
fl.mo:Expected error in mat flodd?: "flodd?: 3+1i is not a flonum".
|
||||
fl.mo:Expected error in mat flodd?: "flodd?: +inf.0 is not an integer".
|
||||
fl.mo:Expected error in mat flodd?: "flodd?: +nan.0 is not an integer".
|
||||
|
|
@ -5952,7 +5990,7 @@
|
|||
fl.mo:Expected error in mat flmin: "flmin: a is not a flonum".
|
||||
fl.mo:Expected error in mat flmin: "flmin: a is not a flonum".
|
||||
***************
|
||||
*** 9808,9814 ****
|
||||
*** 9826,9832 ****
|
||||
fl.mo:Expected error in mat flmin: "flmin: a is not a flonum".
|
||||
fl.mo:Expected error in mat flmin: "flmin: 0.0+1.0i is not a flonum".
|
||||
fl.mo:Expected error in mat flmin: "flmin: 0+1i is not a flonum".
|
||||
|
|
@ -5960,7 +5998,7 @@
|
|||
fl.mo:Expected error in mat flmax: "flmax: a is not a flonum".
|
||||
fl.mo:Expected error in mat flmax: "flmax: a is not a flonum".
|
||||
fl.mo:Expected error in mat flmax: "flmax: 3 is not a flonum".
|
||||
--- 9808,9814 ----
|
||||
--- 9826,9832 ----
|
||||
fl.mo:Expected error in mat flmin: "flmin: a is not a flonum".
|
||||
fl.mo:Expected error in mat flmin: "flmin: 0.0+1.0i is not a flonum".
|
||||
fl.mo:Expected error in mat flmin: "flmin: 0+1i is not a flonum".
|
||||
|
|
@ -5969,7 +6007,7 @@
|
|||
fl.mo:Expected error in mat flmax: "flmax: a is not a flonum".
|
||||
fl.mo:Expected error in mat flmax: "flmax: 3 is not a flonum".
|
||||
***************
|
||||
*** 9816,9829 ****
|
||||
*** 9834,9847 ****
|
||||
fl.mo:Expected error in mat flmax: "flmax: a is not a flonum".
|
||||
fl.mo:Expected error in mat flmax: "flmax: 0.0+1.0i is not a flonum".
|
||||
fl.mo:Expected error in mat flmax: "flmax: 0+1i is not a flonum".
|
||||
|
|
@ -5984,7 +6022,7 @@
|
|||
fl.mo:Expected error in mat fldenominator: "fldenominator: a is not a flonum".
|
||||
fl.mo:Expected error in mat fldenominator: "fldenominator: 3 is not a flonum".
|
||||
fl.mo:Expected error in mat fldenominator: "fldenominator: 0+1i is not a flonum".
|
||||
--- 9816,9829 ----
|
||||
--- 9834,9847 ----
|
||||
fl.mo:Expected error in mat flmax: "flmax: a is not a flonum".
|
||||
fl.mo:Expected error in mat flmax: "flmax: 0.0+1.0i is not a flonum".
|
||||
fl.mo:Expected error in mat flmax: "flmax: 0+1i is not a flonum".
|
||||
|
|
@ -6000,7 +6038,7 @@
|
|||
fl.mo:Expected error in mat fldenominator: "fldenominator: 3 is not a flonum".
|
||||
fl.mo:Expected error in mat fldenominator: "fldenominator: 0+1i is not a flonum".
|
||||
***************
|
||||
*** 9869,9875 ****
|
||||
*** 9887,9893 ****
|
||||
cfl.mo:Expected error in mat cfl-: "cfl-: a is not a cflonum".
|
||||
cfl.mo:Expected error in mat cfl-: "cfl-: a is not a cflonum".
|
||||
cfl.mo:Expected error in mat cfl-: "cfl-: a is not a cflonum".
|
||||
|
|
@ -6008,7 +6046,7 @@
|
|||
cfl.mo:Expected error in mat cfl-: "cfl-: a is not a cflonum".
|
||||
cfl.mo:Expected error in mat cfl-: "cfl-: a is not a cflonum".
|
||||
cfl.mo:Expected error in mat cfl-: "cfl-: a is not a cflonum".
|
||||
--- 9869,9875 ----
|
||||
--- 9887,9893 ----
|
||||
cfl.mo:Expected error in mat cfl-: "cfl-: a is not a cflonum".
|
||||
cfl.mo:Expected error in mat cfl-: "cfl-: a is not a cflonum".
|
||||
cfl.mo:Expected error in mat cfl-: "cfl-: a is not a cflonum".
|
||||
|
|
@ -6017,7 +6055,7 @@
|
|||
cfl.mo:Expected error in mat cfl-: "cfl-: a is not a cflonum".
|
||||
cfl.mo:Expected error in mat cfl-: "cfl-: a is not a cflonum".
|
||||
***************
|
||||
*** 9879,9892 ****
|
||||
*** 9897,9910 ****
|
||||
cfl.mo:Expected error in mat cfl/: "cfl/: a is not a cflonum".
|
||||
cfl.mo:Expected error in mat cfl/: "cfl/: a is not a cflonum".
|
||||
cfl.mo:Expected error in mat cfl/: "cfl/: a is not a cflonum".
|
||||
|
|
@ -6032,7 +6070,7 @@
|
|||
foreign.mo:Expected error in mat load-shared-object: "load-shared-object: invalid path 3".
|
||||
foreign.mo:Expected error in mat foreign-procedure: "foreign-procedure: no entry for "i do not exist"".
|
||||
foreign.mo:Expected error in mat foreign-procedure: "foreign-procedure: no entry for "i do not exist"".
|
||||
--- 9879,9892 ----
|
||||
--- 9897,9910 ----
|
||||
cfl.mo:Expected error in mat cfl/: "cfl/: a is not a cflonum".
|
||||
cfl.mo:Expected error in mat cfl/: "cfl/: a is not a cflonum".
|
||||
cfl.mo:Expected error in mat cfl/: "cfl/: a is not a cflonum".
|
||||
|
|
@ -6048,7 +6086,7 @@
|
|||
foreign.mo:Expected error in mat foreign-procedure: "foreign-procedure: no entry for "i do not exist"".
|
||||
foreign.mo:Expected error in mat foreign-procedure: "foreign-procedure: no entry for "i do not exist"".
|
||||
***************
|
||||
*** 9921,9928 ****
|
||||
*** 9939,9946 ****
|
||||
foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument foo".
|
||||
foreign.mo:Expected error in mat foreign-procedure: "foreign-procedure: invalid foreign procedure handle abcde".
|
||||
foreign.mo:Expected error in mat foreign-procedure: "float_id: invalid foreign-procedure argument 0".
|
||||
|
|
@ -6057,7 +6095,7 @@
|
|||
foreign.mo:Expected error in mat foreign-sizeof: "foreign-sizeof: invalid foreign type specifier i-am-not-a-type".
|
||||
foreign.mo:Expected error in mat foreign-sizeof: "foreign-sizeof: invalid foreign type specifier 1".
|
||||
foreign.mo:Expected error in mat foreign-bytevectors: "u8*->u8*: invalid foreign-procedure argument "hello"".
|
||||
--- 9921,9928 ----
|
||||
--- 9939,9946 ----
|
||||
foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument foo".
|
||||
foreign.mo:Expected error in mat foreign-procedure: "foreign-procedure: invalid foreign procedure handle abcde".
|
||||
foreign.mo:Expected error in mat foreign-procedure: "float_id: invalid foreign-procedure argument 0".
|
||||
|
|
@ -6067,7 +6105,7 @@
|
|||
foreign.mo:Expected error in mat foreign-sizeof: "foreign-sizeof: invalid foreign type specifier 1".
|
||||
foreign.mo:Expected error in mat foreign-bytevectors: "u8*->u8*: invalid foreign-procedure argument "hello"".
|
||||
***************
|
||||
*** 10420,10432 ****
|
||||
*** 10438,10450 ****
|
||||
unix.mo:Expected error in mat file-operations: "file-access-time: failed for "testlink": no such file or directory".
|
||||
unix.mo:Expected error in mat file-operations: "file-change-time: failed for "testlink": no such file or directory".
|
||||
unix.mo:Expected error in mat file-operations: "file-modification-time: failed for "testlink": no such file or directory".
|
||||
|
|
@ -6081,7 +6119,7 @@
|
|||
windows.mo:Expected error in mat registry: "get-registry: pooh is not a string".
|
||||
windows.mo:Expected error in mat registry: "put-registry!: 3 is not a string".
|
||||
windows.mo:Expected error in mat registry: "put-registry!: 3 is not a string".
|
||||
--- 10420,10432 ----
|
||||
--- 10438,10450 ----
|
||||
unix.mo:Expected error in mat file-operations: "file-access-time: failed for "testlink": no such file or directory".
|
||||
unix.mo:Expected error in mat file-operations: "file-change-time: failed for "testlink": no such file or directory".
|
||||
unix.mo:Expected error in mat file-operations: "file-modification-time: failed for "testlink": no such file or directory".
|
||||
|
|
@ -6096,7 +6134,7 @@
|
|||
windows.mo:Expected error in mat registry: "put-registry!: 3 is not a string".
|
||||
windows.mo:Expected error in mat registry: "put-registry!: 3 is not a string".
|
||||
***************
|
||||
*** 10454,10525 ****
|
||||
*** 10472,10543 ****
|
||||
ieee.mo:Expected error in mat flonum->fixnum: "flonum->fixnum: result for -inf.0 would be outside of fixnum range".
|
||||
ieee.mo:Expected error in mat flonum->fixnum: "flonum->fixnum: result for +nan.0 would be outside of fixnum range".
|
||||
ieee.mo:Expected error in mat fllp: "fllp: 3 is not a flonum".
|
||||
|
|
@ -6169,7 +6207,7 @@
|
|||
date.mo:Expected error in mat time: "time>=?: 3 is not a time record".
|
||||
date.mo:Expected error in mat time: "time>=?: #<procedure car> is not a time record".
|
||||
date.mo:Expected error in mat time: "time>=?: types of <time> and <time> differ".
|
||||
--- 10454,10525 ----
|
||||
--- 10472,10543 ----
|
||||
ieee.mo:Expected error in mat flonum->fixnum: "flonum->fixnum: result for -inf.0 would be outside of fixnum range".
|
||||
ieee.mo:Expected error in mat flonum->fixnum: "flonum->fixnum: result for +nan.0 would be outside of fixnum range".
|
||||
ieee.mo:Expected error in mat fllp: "fllp: 3 is not a flonum".
|
||||
|
|
@ -6243,7 +6281,7 @@
|
|||
date.mo:Expected error in mat time: "time>=?: #<procedure car> is not a time record".
|
||||
date.mo:Expected error in mat time: "time>=?: types of <time> and <time> differ".
|
||||
***************
|
||||
*** 10527,10540 ****
|
||||
*** 10545,10558 ****
|
||||
date.mo:Expected error in mat time: "add-duration: <time> does not have type time-duration".
|
||||
date.mo:Expected error in mat time: "subtract-duration: <time> does not have type time-duration".
|
||||
date.mo:Expected error in mat time: "copy-time: <date> is not a time record".
|
||||
|
|
@ -6258,7 +6296,7 @@
|
|||
date.mo:Expected error in mat date: "make-date: invalid nanosecond -1".
|
||||
date.mo:Expected error in mat date: "make-date: invalid nanosecond <int>".
|
||||
date.mo:Expected error in mat date: "make-date: invalid nanosecond zero".
|
||||
--- 10527,10540 ----
|
||||
--- 10545,10558 ----
|
||||
date.mo:Expected error in mat time: "add-duration: <time> does not have type time-duration".
|
||||
date.mo:Expected error in mat time: "subtract-duration: <time> does not have type time-duration".
|
||||
date.mo:Expected error in mat time: "copy-time: <date> is not a time record".
|
||||
|
|
@ -6274,7 +6312,7 @@
|
|||
date.mo:Expected error in mat date: "make-date: invalid nanosecond <int>".
|
||||
date.mo:Expected error in mat date: "make-date: invalid nanosecond zero".
|
||||
***************
|
||||
*** 10560,10620 ****
|
||||
*** 10578,10638 ****
|
||||
date.mo:Expected error in mat date: "make-date: invalid time-zone offset 90000".
|
||||
date.mo:Expected error in mat date: "make-date: invalid time-zone offset est".
|
||||
date.mo:Expected error in mat date: "make-date: invalid time-zone offset "est"".
|
||||
|
|
@ -6336,7 +6374,7 @@
|
|||
date.mo:Expected error in mat date: "current-date: invalid time-zone offset -90000".
|
||||
date.mo:Expected error in mat date: "current-date: invalid time-zone offset 90000".
|
||||
date.mo:Expected error in mat conversions/sleep: "date->time-utc: <time> is not a date record".
|
||||
--- 10560,10620 ----
|
||||
--- 10578,10638 ----
|
||||
date.mo:Expected error in mat date: "make-date: invalid time-zone offset 90000".
|
||||
date.mo:Expected error in mat date: "make-date: invalid time-zone offset est".
|
||||
date.mo:Expected error in mat date: "make-date: invalid time-zone offset "est"".
|
||||
|
|
|
|||
|
|
@ -4215,6 +4215,19 @@ misc.mo:Expected error in mat wrapper-procedure: "set-wrapper-procedure-data!: #
|
|||
misc.mo:Expected error in mat phantom-bytevector: "make-phantom-bytevector: -1 is not a valid phantom bytevector length".
|
||||
misc.mo:Expected error in mat phantom-bytevector: "make-phantom-bytevector: 1267650600228229401496703205376 is not a valid phantom bytevector length".
|
||||
misc.mo:Expected error in mat phantom-bytevector: "make-phantom-bytevector: x is not a valid phantom bytevector length".
|
||||
misc.mo:Expected error in mat immobile: "incorrect argument count in call (box-immobile)".
|
||||
misc.mo:Expected error in mat immobile: "incorrect argument count in call (box-immobile 1 2)".
|
||||
misc.mo:Expected error in mat immobile: "incorrect argument count in call (make-immobile-vector)".
|
||||
misc.mo:Expected error in mat immobile: "make-immobile-vector: a is not a valid vector length".
|
||||
misc.mo:Expected error in mat immobile: "make-immobile-vector: -10 is not a valid vector length".
|
||||
misc.mo:Expected error in mat immobile: "make-immobile-vector: 1267650600228229401496703205376 is not a valid vector length".
|
||||
misc.mo:Expected error in mat immobile: "incorrect argument count in call (make-immobile-vector 10 1 2)".
|
||||
misc.mo:Expected error in mat immobile: "incorrect argument count in call (make-immobile-bytevector)".
|
||||
misc.mo:Expected error in mat immobile: "make-immobile-bytevector: a is not a valid bytevector length".
|
||||
misc.mo:Expected error in mat immobile: "variable make-immobile-byte-vector is not bound".
|
||||
misc.mo:Expected error in mat immobile: "make-immobile-bytevector: 1267650600228229401496703205376 is not a valid bytevector length".
|
||||
misc.mo:Expected error in mat immobile: "make-immobile-bytevector: 1024 is not a valid fill value".
|
||||
misc.mo:Expected error in mat immobile: "incorrect argument count in call (make-immobile-bytevector 10 1 2)".
|
||||
cp0.mo:Expected error in mat cp0-regression: "attempt to reference undefined variable x".
|
||||
cp0.mo:Expected error in mat cp0-regression: "incorrect argument count in call (g)".
|
||||
cp0.mo:Expected error in mat cp0-regression: "incorrect argument count in call (cont0 (quote x))".
|
||||
|
|
|
|||
|
|
@ -751,11 +751,11 @@
|
|||
(collect))])
|
||||
(chew 0)))
|
||||
(set! q (+ q 7)))])
|
||||
(lock-object p)
|
||||
(bt p)
|
||||
(let f () (when (= q 0) ($yield) (f)))
|
||||
(let f () (unless (= (length ($threads)) 1) ($yield) (f)))
|
||||
(unlock-object p))
|
||||
(let ([b (box-immobile p)])
|
||||
(bt b)
|
||||
(let f () (when (= q 0) ($yield) (f)))
|
||||
(let f () (unless (= (length ($threads)) 1) ($yield) (f)))
|
||||
(set-box! b #f)))
|
||||
(unless (= q 14) (errorf #f "~s isn't 14" q))
|
||||
(f (- n 1)))))
|
||||
'cool)
|
||||
|
|
|
|||
11
s/back.ss
11
s/back.ss
|
|
@ -66,6 +66,17 @@
|
|||
($oops who "new release minimum generation must not be be greater than collect-maximum-generation"))
|
||||
($set-release-minimum-generation! g)])))
|
||||
|
||||
(define-who in-place-minimum-generation
|
||||
(let ([$get-mark-minimum-generation (foreign-procedure "(cs)minmarkgen" () fixnum)]
|
||||
[$set-mark-minimum-generation! (foreign-procedure "(cs)set_minmarkgen" (fixnum) void)])
|
||||
(case-lambda
|
||||
[() ($get-mark-minimum-generation)]
|
||||
[(g)
|
||||
(unless (and (fixnum? g) (fx>= g 0)) ($oops who "invalid generation ~s" g))
|
||||
(let ([limit (fx- (constant static-generation) 1)])
|
||||
(when (fx> g limit) ($oops who "~s exceeds maximum supported value ~s" g limit)))
|
||||
($set-mark-minimum-generation! g)])))
|
||||
|
||||
(define-who enable-object-counts
|
||||
(let ([$get-enable-object-counts (foreign-procedure "(cs)enable_object_counts" () boolean)]
|
||||
[$set-enable-object-counts (foreign-procedure "(cs)set_enable_object_counts" (boolean) void)])
|
||||
|
|
|
|||
|
|
@ -511,6 +511,21 @@
|
|||
($oops who "~s is not a valid bytevector length" n))
|
||||
(#3%make-bytevector n)]))
|
||||
|
||||
(set-who! make-immobile-bytevector
|
||||
(let ([$make-immobile-bytevector (foreign-procedure "(cs)make_immobile_bytevector" (uptr) ptr)])
|
||||
(case-lambda
|
||||
[(n fill)
|
||||
(unless (and (fixnum? n) (not ($fxu< (constant maximum-bytevector-length) n)))
|
||||
($oops who "~s is not a valid bytevector length" n))
|
||||
(unless (fill? fill) (invalid-fill-value who fill))
|
||||
(let ([bv ($make-immobile-bytevector n)])
|
||||
(#3%bytevector-fill! bv fill)
|
||||
bv)]
|
||||
[(n)
|
||||
(unless (and (fixnum? n) (not ($fxu< (constant maximum-bytevector-length) n)))
|
||||
($oops who "~s is not a valid bytevector length" n))
|
||||
($make-immobile-bytevector n)])))
|
||||
|
||||
(set! bytevector? (lambda (x) (#2%bytevector? x)))
|
||||
|
||||
(set! bytevector-length
|
||||
|
|
|
|||
25
s/cmacros.ss
25
s/cmacros.ss
|
|
@ -328,7 +328,7 @@
|
|||
[(_ foo e1 e2) e1] ...
|
||||
[(_ bar e1 e2) e2]))))])))
|
||||
|
||||
(define-constant scheme-version #x0905031A)
|
||||
(define-constant scheme-version #x0905031B)
|
||||
|
||||
(define-syntax define-machine-types
|
||||
(lambda (x)
|
||||
|
|
@ -409,6 +409,8 @@
|
|||
; This is safe since we never forward flonums.
|
||||
(define-constant byte-alignment
|
||||
(max (constant typemod) (* 2 (constant ptr-bytes))))
|
||||
(define-constant ptr-alignment
|
||||
(/ (constant byte-alignment) (constant ptr-bytes)))
|
||||
|
||||
;;; fasl codes---see fasl.c for documentation of representation
|
||||
|
||||
|
|
@ -605,10 +607,6 @@
|
|||
(define-constant ERROR_VALUES 7)
|
||||
(define-constant ERROR_MVLET 8)
|
||||
|
||||
;;; allocation spaces
|
||||
(define-constant space-locked #x20) ; lock flag
|
||||
(define-constant space-old #x40) ; oldspace flag
|
||||
|
||||
(define-syntax define-alloc-spaces
|
||||
(lambda (x)
|
||||
(syntax-case x (real swept unswept unreal)
|
||||
|
|
@ -634,10 +632,6 @@
|
|||
[(cchar ...) #'(real-cchar ... unreal-cchar ... last-unreal-cchar)]
|
||||
[(value ...) #'(real-value ... unreal-value ... last-unreal-value)])
|
||||
(with-syntax ([(space-name ...) (map (lambda (n) (construct-name n "space-" n)) #'(name ...))])
|
||||
(unless (< (syntax->datum #'last-unreal-value) (constant space-locked))
|
||||
($oops 'define-alloc-spaces "conflict with space-locked"))
|
||||
(unless (< (syntax->datum #'last-unreal-value) (constant space-old))
|
||||
($oops 'define-alloc-spaces "conflict with space-old"))
|
||||
#'(begin
|
||||
(define-constant space-name value) ...
|
||||
(define-constant real-space-alist '((real-name . real-value) ...))
|
||||
|
|
@ -663,12 +657,14 @@
|
|||
(impure-record "ip-rec" #\s 10) ;
|
||||
(impure-typed-object "ip-tobj" #\t 11) ; as needed (instead of impure) for backtraces
|
||||
(closure "closure" #\l 12) ; as needed (instead of pure/impure) for backtraces
|
||||
(count-pure "count-pure" #\y 13) ; like pure, but delayed for counting from roots
|
||||
(count-impure "count-impure" #\z 14)); like impure-typed-object, but delayed for counting from roots
|
||||
(immobile-impure "im-impure" #\I 13) ; like impure, but for immobile objects
|
||||
(count-pure "cnt-pure" #\y 14) ; like pure, but delayed for counting from roots
|
||||
(count-impure "cnt-impure" #\z 15)); like impure-typed-object, but delayed for counting from roots
|
||||
(unswept
|
||||
(data "data" #\d 15))) ; unswept objects allocated here
|
||||
(data "data" #\d 16) ; unswept objects allocated here
|
||||
(immobile-data "im-data" #\D 17))) ; like data, but non-moving
|
||||
(unreal
|
||||
(empty "empty" #\e 16))) ; available segments
|
||||
(empty "empty" #\e 18))) ; available segments
|
||||
|
||||
;;; enumeration of types for which gc tracks object counts
|
||||
;;; also update gc.c
|
||||
|
|
@ -701,7 +697,8 @@
|
|||
(define-constant countof-ephemeron 25)
|
||||
(define-constant countof-stencil-vector 26)
|
||||
(define-constant countof-record 27)
|
||||
(define-constant countof-types 28)
|
||||
(define-constant countof-phantom 28)
|
||||
(define-constant countof-types 29)
|
||||
|
||||
;;; type-fixnum is assumed to be all zeros by at least by vector, fxvector,
|
||||
;;; and bytevector index checks
|
||||
|
|
|
|||
|
|
@ -4123,7 +4123,7 @@
|
|||
[(e1 e2)
|
||||
(or (relop-length RELOP= e1 e2)
|
||||
(%inline eq? ,e1 ,e2))])
|
||||
(define-inline 2 $keep-live
|
||||
(define-inline 2 keep-live
|
||||
[(e) (%seq ,(%inline keep-live ,e) ,(%constant svoid))])
|
||||
(let ()
|
||||
(define (zgo src sexpr e e1 e2 r6rs?)
|
||||
|
|
@ -5505,8 +5505,7 @@
|
|||
(if ,(%inline eq? ,si (immediate 0))
|
||||
,(%constant sfalse)
|
||||
,(let ([s `(inline ,(make-info-load 'unsigned-8 #f) ,%load ,si ,%zero (immediate 0))])
|
||||
(%inline eq? (immediate ,space)
|
||||
,(%inline logand ,s (immediate ,(fxnot (constant space-locked))))))))))))
|
||||
(%inline eq? (immediate ,space) ,s))))))))
|
||||
|
||||
(define-inline 2 $maybe-seginfo
|
||||
[(e)
|
||||
|
|
@ -5529,8 +5528,7 @@
|
|||
(define-inline 2 $seginfo-space
|
||||
[(e)
|
||||
(bind #f (e)
|
||||
(%inline logand ,(build-object-ref #f 'unsigned-8 e %zero 0)
|
||||
(immediate ,(fxnot (fix (constant space-locked))))))])
|
||||
(build-object-ref #f 'unsigned-8 e %zero 0))])
|
||||
|
||||
(define-inline 2 $generation
|
||||
[(e)
|
||||
|
|
|
|||
587
s/mkgc.ss
587
s/mkgc.ss
|
|
@ -18,6 +18,7 @@
|
|||
;; Currently supported traversal modes:
|
||||
;; - copy
|
||||
;; - sweep
|
||||
;; - mark
|
||||
;; - self-test : check immediate pointers only for self references
|
||||
;; - size : immediate size, so does not recur
|
||||
;; - measure : recurs for reachable size
|
||||
|
|
@ -67,7 +68,15 @@
|
|||
;; this order (but there are exceptions to the order):
|
||||
;; - (space <space>) : target for copy; works as a constraint for other modes
|
||||
;; - (vspace <vspace>) : target for vfasl
|
||||
;; - (size <size> [<scale>]) : size for copy
|
||||
;; - (size <size> [<scale>]) : size for copy; skips rest in size mode
|
||||
;; - (mark <flag>) : in mark mode, skips rest except counting;
|
||||
;; possible <flags>:
|
||||
;; * one-bit : record as one bit per segment; inferred when size matches
|
||||
;; alignment or for `space-data`
|
||||
;; * within-segment : alloacted within on segment; can be inferred from size
|
||||
;; * no-sweep : no need to sweep content (perhaps covered by `trace-now`);
|
||||
;; inferred for `space-data`
|
||||
;; * counting-root : check a counting root before pushing to sweep stack
|
||||
;; - (trace <field>) : relocate for sweep, copy for copy, recur otherwise
|
||||
;; - (trace-early <field>) : relocate for sweep or copy, recur otherwise
|
||||
;; - (trace-now <field>) : direct recur
|
||||
|
|
@ -79,9 +88,12 @@
|
|||
;; - (copy-flonum* <field>) : copy potentially forwaded flonum
|
||||
;; - (copy-type <field>) : copy type from `_` to `_copy_`
|
||||
;; - (count <counter> [<size> [<scale> [<modes>]]]) :
|
||||
;; : uses preceding `size` declaration unless <size>;
|
||||
;; normally counts in copy mode, but <modes> can override
|
||||
;; uses preceding `size` declaration unless <size>;
|
||||
;; normally counts in copy mode, but <modes> can override
|
||||
;; - (as-mark-end <statment> ...) : declares that <statement>s implement counting,
|
||||
;; which means that it's included for mark mode
|
||||
;; - (skip-forwarding) : disable forward-pointer installation in copy mode
|
||||
;; - (assert <expr>) : assertion
|
||||
;;
|
||||
;; In the above declarations, nonterminals like <space> can be
|
||||
;; an identifier or a Parenthe-C expression. The meaning of a plain
|
||||
|
|
@ -134,6 +146,7 @@
|
|||
;; - _ : object being copied, swept, etc.
|
||||
;; - _copy_ : target in copy or vfasl mode, same as _ otherwise
|
||||
;; - _tf_ : type word
|
||||
;; - _tg_ : target generation
|
||||
;; - _backreferences?_ : dynamic flag indicating whether backreferences are on
|
||||
;;
|
||||
;; Stylistically, prefer constants and fields using the hyphenated
|
||||
|
|
@ -152,6 +165,8 @@
|
|||
(copy pair-car)
|
||||
(copy pair-cdr)
|
||||
(add-ephemeron-to-pending)
|
||||
(mark one-bit no-sweep)
|
||||
(assert-ephemeron-size-ok)
|
||||
(count countof-ephemeron)]
|
||||
[space-weakpair
|
||||
(space space-weakpair)
|
||||
|
|
@ -179,6 +194,7 @@
|
|||
[else space-continuation]))
|
||||
(vfasl-fail "closure")
|
||||
(size size-continuation)
|
||||
(mark one-bit counting-root)
|
||||
(case-mode
|
||||
[self-test]
|
||||
[else
|
||||
|
|
@ -207,8 +223,8 @@
|
|||
(define stack : uptr (cast uptr (continuation-stack _)))
|
||||
(trace-stack stack
|
||||
(+ stack (continuation-stack-clength _))
|
||||
(cast uptr (continuation-return-address _)))])])
|
||||
(count countof-continuation)])]
|
||||
(cast uptr (continuation-return-address _)))])])])
|
||||
(count countof-continuation)]
|
||||
|
||||
[else
|
||||
;; closure (not a continuation)
|
||||
|
|
@ -229,6 +245,14 @@
|
|||
(vfasl-fail "mutable closure")))
|
||||
(define len : uptr (code-closure-length code))
|
||||
(size (size_closure len))
|
||||
(when-mark
|
||||
(case-space
|
||||
[space-pure
|
||||
(mark one-bit counting-root)
|
||||
(count countof-closure)]
|
||||
[else
|
||||
(mark counting-root)
|
||||
(count countof-closure)]))
|
||||
(when (or-not-as-dirty
|
||||
(& (code-type code) (<< code-flag-mutable-closure code-flags-offset)))
|
||||
(copy-clos-code code)
|
||||
|
|
@ -241,6 +265,7 @@
|
|||
(space space-symbol)
|
||||
(vspace vspace_symbol)
|
||||
(size size-symbol)
|
||||
(mark one-bit)
|
||||
(trace/define symbol-value val :vfasl-as (FIX (vfasl_symbol_to_index vfi _)))
|
||||
(trace-symcode symbol-pvalue val)
|
||||
(trace-nonself/vfasl-as-nil symbol-plist)
|
||||
|
|
@ -253,6 +278,7 @@
|
|||
(space space-data)
|
||||
(vspace vspace_data)
|
||||
(size size-flonum)
|
||||
(mark)
|
||||
(copy-flonum flonum-data)
|
||||
(count countof-flonum)
|
||||
(skip-forwarding)]
|
||||
|
|
@ -310,6 +336,7 @@
|
|||
(vfasl-check-parent-rtd rtd)
|
||||
(define len : uptr (UNFIX (record-type-size rtd)))
|
||||
(size (size_record_inst len))
|
||||
(mark counting-root)
|
||||
(trace-record rtd len)
|
||||
(vfasl-set-base-rtd)
|
||||
(pad (when (or-vfasl
|
||||
|
|
@ -337,6 +364,7 @@
|
|||
(vspace vspace_impure)
|
||||
(define len : uptr (Svector_length _))
|
||||
(size (size_vector len))
|
||||
(mark)
|
||||
(copy-type vector-type)
|
||||
(trace-ptrs vector-data len)
|
||||
(pad (when (== (& len 1) 0)
|
||||
|
|
@ -353,6 +381,8 @@
|
|||
(vspace vspace_impure)
|
||||
(define len : uptr (Sstencil_vector_length _))
|
||||
(size (size_stencil_vector len))
|
||||
(mark within-segment) ; see assertion
|
||||
(assert-stencil-vector-size)
|
||||
(copy-type stencil-vector-type)
|
||||
(trace-ptrs stencil-vector-data len)
|
||||
(pad (when (== (& len 1) 0)
|
||||
|
|
@ -364,6 +394,7 @@
|
|||
(vspace vspace_data)
|
||||
(define sz : uptr (size_string (Sstring_length _)))
|
||||
(size (just sz))
|
||||
(mark)
|
||||
(copy-bytes string-type sz)
|
||||
(count countof-string)]
|
||||
|
||||
|
|
@ -372,6 +403,7 @@
|
|||
(vspace vspace_data)
|
||||
(define sz : uptr (size_fxvector (Sfxvector_length _)))
|
||||
(size (just sz))
|
||||
(mark)
|
||||
(copy-bytes fxvector-type sz)
|
||||
(count countof-fxvector)]
|
||||
|
||||
|
|
@ -380,6 +412,7 @@
|
|||
(vspace vspace_data)
|
||||
(define sz : uptr (size_bytevector (Sbytevector_length _)))
|
||||
(size (just sz))
|
||||
(mark)
|
||||
(copy-bytes bytevector-type sz)
|
||||
(count countof-bytevector)]
|
||||
|
||||
|
|
@ -390,10 +423,12 @@
|
|||
[else space-impure]))
|
||||
(vfasl-fail "tlc")
|
||||
(size size-tlc)
|
||||
(mark)
|
||||
(copy-type tlc-type)
|
||||
(trace-nonself tlc-ht)
|
||||
(trace-tlc tlc-next tlc-keyval)
|
||||
(count countof-tlc)]
|
||||
(as-mark-end
|
||||
(trace-tlc tlc-next tlc-keyval)
|
||||
(count countof-tlc))]
|
||||
|
||||
[box
|
||||
(space
|
||||
|
|
@ -408,6 +443,7 @@
|
|||
[else space-impure])]))
|
||||
(vspace vspace_impure)
|
||||
(size size-box)
|
||||
(mark)
|
||||
(copy-type box-type)
|
||||
(trace box-ref)
|
||||
(count countof-box)]
|
||||
|
|
@ -419,6 +455,7 @@
|
|||
(copy-type ratnum-type)
|
||||
(trace-immutable-now ratnum-numerator)
|
||||
(trace-immutable-now ratnum-denominator)
|
||||
(mark)
|
||||
(vfasl-pad-word)
|
||||
(count countof-ratnum)]
|
||||
|
||||
|
|
@ -429,6 +466,7 @@
|
|||
(copy-type exactnum-type)
|
||||
(trace-immutable-now exactnum-real)
|
||||
(trace-immutable-now exactnum-imag)
|
||||
(mark)
|
||||
(vfasl-pad-word)
|
||||
(count countof-exactnum)]
|
||||
|
||||
|
|
@ -436,6 +474,7 @@
|
|||
(space space-data)
|
||||
(vspace vspace_data)
|
||||
(size size-inexactnum)
|
||||
(mark)
|
||||
(copy-type inexactnum-type)
|
||||
(copy-flonum* inexactnum-real)
|
||||
(copy-flonum* inexactnum-imag)
|
||||
|
|
@ -446,6 +485,7 @@
|
|||
(vspace vspace_data)
|
||||
(define sz : uptr (size_bignum (BIGLEN _)))
|
||||
(size (just sz))
|
||||
(mark)
|
||||
(copy-bytes bignum-type sz)
|
||||
(count countof-bignum)]
|
||||
|
||||
|
|
@ -453,6 +493,7 @@
|
|||
(space space-port)
|
||||
(vfasl-fail "port")
|
||||
(size size-port)
|
||||
(mark one-bit)
|
||||
(copy-type port-type)
|
||||
(trace-nonself port-handler)
|
||||
(copy port-ocount)
|
||||
|
|
@ -468,6 +509,7 @@
|
|||
(vspace vspace_code)
|
||||
(define len : uptr (code-length _)) ; in bytes
|
||||
(size (size_code len))
|
||||
(mark one-bit)
|
||||
(when (and-not-as-dirty 1)
|
||||
(copy-type code-type)
|
||||
(copy code-length)
|
||||
|
|
@ -486,18 +528,20 @@
|
|||
[else space-pure-typed-object]))
|
||||
(vfasl-fail "thread")
|
||||
(size size-thread)
|
||||
(mark one-bit)
|
||||
(case-mode
|
||||
[self-test]
|
||||
[else
|
||||
(copy-type thread-type)
|
||||
(when (and-not-as-dirty 1)
|
||||
(trace-tc thread-tc))
|
||||
(count countof-thread)])]
|
||||
(trace-tc thread-tc))])
|
||||
(count countof-thread)]
|
||||
|
||||
[rtd-counts
|
||||
(space space-data)
|
||||
(vfasl-as-false "rtd-counts") ; prune counts, since GC will recreate as needed
|
||||
(size size-rtd-counts)
|
||||
(mark)
|
||||
(copy-bytes rtd-counts-type size_rtd_counts)
|
||||
(count countof-rtd-counts)]
|
||||
|
||||
|
|
@ -505,12 +549,18 @@
|
|||
(space space-data)
|
||||
(vfasl-fail "phantom")
|
||||
(size size-phantom)
|
||||
(mark)
|
||||
(copy-type phantom-type)
|
||||
(copy phantom-length)
|
||||
(case-mode
|
||||
[copy (set! (array-ref S_G.phantom_sizes tg)
|
||||
+=
|
||||
(phantom-length _))]
|
||||
[(copy mark)
|
||||
(as-mark-end
|
||||
(count countof-phantom)
|
||||
;; Separate from `count`, because we want to track sizes even
|
||||
;; if counting is not enabled:
|
||||
(set! (array-ref (array-ref S_G.bytesof _tg_) countof-phantom)
|
||||
+=
|
||||
(phantom-length _)))]
|
||||
[measure (set! measure_total += (phantom-length _))]
|
||||
[else])])]))
|
||||
|
||||
|
|
@ -539,9 +589,13 @@
|
|||
[(&& (!= cdr_p _)
|
||||
(&& (== (TYPEBITS cdr_p) type_pair)
|
||||
(&& (!= (set! qsi (MaybeSegInfo (ptr_get_segment cdr_p))) NULL)
|
||||
(&& (== (-> qsi space) (-> si space))
|
||||
(&& (!= (FWDMARKER cdr_p) forward_marker)
|
||||
(! (locked qsi cdr_p)))))))
|
||||
(&& (-> qsi old_space)
|
||||
(&& (== (-> qsi space) (-> si space))
|
||||
(&& (!= (FWDMARKER cdr_p) forward_marker)
|
||||
(&& (! (-> qsi use_marks))
|
||||
;; Checking `marked_mask`, too, in
|
||||
;; case the pair is locked
|
||||
(! (-> qsi marked_mask)))))))))
|
||||
(check_triggers qsi)
|
||||
(size size-pair 2)
|
||||
(define new_cdr_p : ptr (cast ptr (+ (cast uptr _copy_) size_pair)))
|
||||
|
|
@ -561,19 +615,32 @@
|
|||
(do-cdr pair-cdr)
|
||||
(count count-pair)])]
|
||||
[else
|
||||
(size size-pair)
|
||||
(size size-pair)
|
||||
(mark)
|
||||
(assert (= (constant size-pair) (constant byte-alignment)))
|
||||
(do-car pair-car)
|
||||
(do-cdr pair-cdr)
|
||||
(count count-pair)]))
|
||||
|
||||
(define-trace-macro (add-ephemeron-to-pending)
|
||||
(case-mode
|
||||
[sweep
|
||||
[(sweep mark)
|
||||
(add_ephemeron_to_pending _)]
|
||||
[measure
|
||||
(add_ephemeron_to_pending_measure _)]
|
||||
[else]))
|
||||
|
||||
(define-trace-macro (assert-ephemeron-size-ok)
|
||||
;; needed for dirty sweep strategy:
|
||||
(assert (zero? (modulo (constant bytes-per-card) (constant size-ephemeron)))))
|
||||
|
||||
(define-trace-macro (assert-stencil-vector-size)
|
||||
;; needed for within-mark-byte
|
||||
(assert (< (+ (* (constant stencil-vector-mask-bits) (constant ptr-bytes))
|
||||
(constant header-size-stencil-vector)
|
||||
(constant byte-alignment))
|
||||
(constant bytes-per-segment))))
|
||||
|
||||
(define-trace-macro (trace-immutable-now ref)
|
||||
(when (and-not-as-dirty 1)
|
||||
(trace-now ref)))
|
||||
|
|
@ -643,17 +710,20 @@
|
|||
|
||||
(define-trace-macro (trace-tlc tlc-next tlc-keyval)
|
||||
(case-mode
|
||||
[copy
|
||||
[(copy mark)
|
||||
(define next : ptr (tlc-next _))
|
||||
(define keyval : ptr (tlc-keyval _))
|
||||
(set! (tlc-next _copy_) next)
|
||||
(set! (tlc-keyval _copy_) keyval)
|
||||
(case-mode
|
||||
[copy
|
||||
(set! (tlc-next _copy_) next)
|
||||
(set! (tlc-keyval _copy_) keyval)]
|
||||
[else])
|
||||
;; If next isn't false and keyval is old, add tlc to a list of tlcs
|
||||
;; to process later. Determining if keyval is old is a (conservative)
|
||||
;; approximation to determining if key is old. We can't easily
|
||||
;; determine if key is old, since keyval might or might not have been
|
||||
;; swept already. NB: assuming keyvals are always pairs.
|
||||
(when (&& (!= next Sfalse) (& (SPACE keyval) space_old))
|
||||
(when (&& (!= next Sfalse) (OLDSPACE keyval))
|
||||
(set! tlcs_to_rehash (S_cons_in space_new 0 _copy_ tlcs_to_rehash)))]
|
||||
[else
|
||||
(trace-nonself tlc-keyval)
|
||||
|
|
@ -752,47 +822,51 @@
|
|||
|
||||
(define-trace-macro (count-record rtd)
|
||||
(case-mode
|
||||
[copy
|
||||
(case-flag counts?
|
||||
[on
|
||||
(when S_G.enable_object_counts
|
||||
(let* ([c_rtd : ptr (cond
|
||||
[(== _tf_ _) _copy_]
|
||||
[else rtd])]
|
||||
[counts : ptr (record-type-counts c_rtd)])
|
||||
(cond
|
||||
[(== counts Sfalse)
|
||||
(let* ([grtd : IGEN (GENERATION c_rtd)])
|
||||
(set! (array-ref (array-ref S_G.countof grtd) countof_rtd_counts) += 1)
|
||||
;; Allocate counts struct in same generation as rtd. Initialize timestamp & counts.
|
||||
(find_room space_data grtd type_typed_object size_rtd_counts counts)
|
||||
(set! (rtd-counts-type counts) type_rtd_counts)
|
||||
(set! (rtd-counts-timestamp counts) (array-ref S_G.gctimestamp 0))
|
||||
(let* ([g : IGEN 0])
|
||||
(while
|
||||
:? (<= g static_generation)
|
||||
(set! (rtd-counts-data counts g) 0)
|
||||
(set! g += 1)))
|
||||
(set! (record-type-counts c_rtd) counts)
|
||||
(set! (array-ref S_G.rtds_with_counts grtd)
|
||||
;; For max_copied_generation, the list will get copied again in `rtds_with_counts` fixup;
|
||||
;; meanwhile, allocating in `space_impure` would copy and sweep old list entries causing
|
||||
;; otherwise inaccessible rtds to be retained
|
||||
(S_cons_in (cond [(<= grtd max_copied_generation) space_new] [else space_impure])
|
||||
(cond [(<= grtd max_copied_generation) 0] [else grtd])
|
||||
c_rtd
|
||||
(array-ref S_G.rtds_with_counts grtd)))
|
||||
(set! (array-ref (array-ref S_G.countof grtd) countof_pair) += 1))]
|
||||
[else
|
||||
(trace-early (just counts))
|
||||
(set! (record-type-counts c_rtd) counts)
|
||||
(when (!= (rtd-counts-timestamp counts) (array-ref S_G.gctimestamp 0))
|
||||
(S_fixup_counts counts))])
|
||||
(set! (rtd-counts-data counts tg) (+ (rtd-counts-data counts tg) 1))))
|
||||
;; Copies size that we may have already gathered, but needed for counting from roots:
|
||||
(when (== p_spc space-count-impure) (set! count_root_bytes += p_sz))
|
||||
(count countof-record)]
|
||||
[off])]
|
||||
[(copy mark)
|
||||
(as-mark-end
|
||||
(case-flag counts?
|
||||
[on
|
||||
(when S_G.enable_object_counts
|
||||
(let* ([c_rtd : ptr (cond
|
||||
[(== _tf_ _) _copy_]
|
||||
[else rtd])]
|
||||
[counts : ptr (record-type-counts c_rtd)])
|
||||
(cond
|
||||
[(== counts Sfalse)
|
||||
(let* ([grtd : IGEN (GENERATION c_rtd)])
|
||||
(set! (array-ref (array-ref S_G.countof grtd) countof_rtd_counts) += 1)
|
||||
;; Allocate counts struct in same generation as rtd. Initialize timestamp & counts.
|
||||
(find_room space_data grtd type_typed_object size_rtd_counts counts)
|
||||
(set! (rtd-counts-type counts) type_rtd_counts)
|
||||
(set! (rtd-counts-timestamp counts) (array-ref S_G.gctimestamp 0))
|
||||
(let* ([g : IGEN 0])
|
||||
(while
|
||||
:? (<= g static_generation)
|
||||
(set! (rtd-counts-data counts g) 0)
|
||||
(set! g += 1)))
|
||||
(set! (record-type-counts c_rtd) counts)
|
||||
(set! (array-ref S_G.rtds_with_counts grtd)
|
||||
;; For max_copied_generation, the list will get copied again in `rtds_with_counts` fixup;
|
||||
;; meanwhile, allocating in `space_impure` would copy and sweep old list entries causing
|
||||
;; otherwise inaccessible rtds to be retained
|
||||
(S_cons_in (cond [(<= grtd max_copied_generation) space_new] [else space_impure])
|
||||
(cond [(<= grtd max_copied_generation) 0] [else grtd])
|
||||
c_rtd
|
||||
(array-ref S_G.rtds_with_counts grtd)))
|
||||
(set! (array-ref (array-ref S_G.countof grtd) countof_pair) += 1))]
|
||||
[else
|
||||
(trace-early (just counts))
|
||||
(set! (record-type-counts c_rtd) counts)
|
||||
(when (!= (rtd-counts-timestamp counts) (array-ref S_G.gctimestamp 0))
|
||||
(S_fixup_counts counts))])
|
||||
(set! (rtd-counts-data counts _tg_) (+ (rtd-counts-data counts _tg_) 1))))
|
||||
;; Copies size that we may have already gathered, but needed for counting from roots:
|
||||
(case-mode
|
||||
[(copy)
|
||||
(when (== p_spc space-count-impure) (set! count_root_bytes += p_sz))]
|
||||
[else])
|
||||
(count countof-record)]
|
||||
[off]))]
|
||||
[else]))
|
||||
|
||||
(define-trace-macro (trace-buffer flag port-buffer port-last)
|
||||
|
|
@ -924,27 +998,17 @@
|
|||
(copy copy-field)]
|
||||
[else
|
||||
(define xcp : ptr field)
|
||||
(case-mode
|
||||
[sweep
|
||||
(define x_si : seginfo* (SegInfo (ptr_get_segment xcp)))
|
||||
(when (& (-> x_si space) space_old)
|
||||
(trace-return-code field xcp x_si))]
|
||||
[else
|
||||
(trace-return-code field xcp no_x_si)])]))
|
||||
(trace-return-code field xcp)]))
|
||||
|
||||
(define-trace-macro (trace-return-code field xcp x_si)
|
||||
(define-trace-macro (trace-return-code field xcp)
|
||||
(define co : iptr (+ (ENTRYOFFSET xcp) (- (cast uptr xcp) (cast uptr (ENTRYOFFSETADDR xcp)))))
|
||||
;; In the call to copy below, assuming SPACE(c_p) == SPACE(xcp) since
|
||||
;; c_p and XCP point to/into the same object
|
||||
(define c_p : ptr (cast ptr (- (cast uptr xcp) co)))
|
||||
(case-mode
|
||||
[sweep
|
||||
(cond
|
||||
[(== (FWDMARKER c_p) forward_marker)
|
||||
(set! c_p (FWDADDRESS c_p))]
|
||||
[else
|
||||
(set! c_p (copy c_p x_si))])
|
||||
(set! field (cast ptr (+ (cast uptr c_p) co)))]
|
||||
(define x_si : seginfo* (SegInfo (ptr_get_segment c_p)))
|
||||
(when (-> x_si old_space)
|
||||
(relocate_code c_p x_si)
|
||||
(set! field (cast ptr (+ (cast uptr c_p) co))))]
|
||||
[else
|
||||
(trace (just c_p))]))
|
||||
|
||||
|
|
@ -1011,15 +1075,18 @@
|
|||
(== 0 (& (code-type _) (<< code_flag_template code_flags_offset)))))
|
||||
(set! (code-reloc _) (cast ptr 0))]
|
||||
[else
|
||||
;; Don't copy non-oldspace relocation tables, since we may be
|
||||
;; sweeping a locked code object that is older than target_generation.
|
||||
;; Doing so would be a waste of work anyway.
|
||||
(when (OLDSPACE t)
|
||||
(let* ([oldt : ptr t])
|
||||
(set! n (size_reloc_table (reloc-table-size oldt)))
|
||||
(let* ([t_si : seginfo* (SegInfo (ptr_get_segment t))])
|
||||
(when (-> t_si old_space)
|
||||
(set! n (size_reloc_table (reloc-table-size t)))
|
||||
(count countof-relocation-table (just n) 1 sweep)
|
||||
(find_room space_data target_generation typemod n t)
|
||||
(memcpy_aligned t oldt n)))
|
||||
(cond
|
||||
[(-> t_si use_marks)
|
||||
;; Assert: (! (marked t_si t))
|
||||
(mark_typemod_data_object t n t_si)]
|
||||
[else
|
||||
(let* ([oldt : ptr t])
|
||||
(find_room space_data target_generation typemod n t)
|
||||
(memcpy_aligned t oldt n))])))
|
||||
(set! (reloc-table-code t) _)
|
||||
(set! (code-reloc _) t)])
|
||||
(S_record_code_mod tc_in (cast uptr (& (code-data _ 0))) (cast uptr (code-length _)))]
|
||||
|
|
@ -1072,6 +1139,11 @@
|
|||
[vfasl-sweep reloc_abs]
|
||||
[else e]))
|
||||
|
||||
(define-trace-macro (when-mark e)
|
||||
(case-mode
|
||||
[(mark) e]
|
||||
[else]))
|
||||
|
||||
(define-trace-macro (pad e)
|
||||
(case-mode
|
||||
[(copy vfasl-copy) e]
|
||||
|
|
@ -1240,7 +1312,7 @@
|
|||
(code
|
||||
(format "static ~a ~a(~aptr p~a)"
|
||||
(case (lookup 'mode config)
|
||||
[(copy vfasl-copy) "ptr"]
|
||||
[(copy vfasl-copy mark) "ptr"]
|
||||
[(size vfasl-sweep) "uptr"]
|
||||
[(self-test) "IBOOL"]
|
||||
[(sweep) (if (lookup 'as-dirty? config #f)
|
||||
|
|
@ -1258,7 +1330,7 @@
|
|||
"vfasl_info *vfi, "]
|
||||
[else ""])
|
||||
(case (lookup 'mode config)
|
||||
[(copy vfasl-copy) ", seginfo *si"]
|
||||
[(copy mark vfasl-copy) ", seginfo *si"]
|
||||
[(sweep)
|
||||
(if (lookup 'as-dirty? config #f)
|
||||
", IGEN tg, IGEN youngest"
|
||||
|
|
@ -1291,15 +1363,9 @@
|
|||
(case (lookup 'mode config)
|
||||
[(copy)
|
||||
(code-block
|
||||
(cond
|
||||
[(lookup 'counts? config #f)
|
||||
(code
|
||||
"if (!(si->space & space_old) || locked(si, p)) {"
|
||||
" if (measure_all_enabled) push_measure(p);"
|
||||
" return p;"
|
||||
"}")]
|
||||
[else
|
||||
"if (locked(si, p)) return p;"])
|
||||
"if (si->use_marks) {"
|
||||
" return mark_object(p, si);"
|
||||
"}"
|
||||
"change = 1;"
|
||||
"check_triggers(si);"
|
||||
(code-block
|
||||
|
|
@ -1311,6 +1377,14 @@
|
|||
(and (lookup 'maybe-backreferences? config #f)
|
||||
"ADD_BACKREFERENCE(p)")
|
||||
"return new_p;"))]
|
||||
[(mark)
|
||||
(code-block
|
||||
"change = 1;"
|
||||
"check_triggers(si);"
|
||||
(ensure-segment-mark-mask "si" "" '())
|
||||
(body)
|
||||
"ADD_BACKREFERENCE(p)"
|
||||
"return p;")]
|
||||
[(sweep)
|
||||
(code-block
|
||||
(and (lookup 'maybe-backreferences? config #f)
|
||||
|
|
@ -1402,8 +1476,8 @@
|
|||
(code-block
|
||||
(format "ISPC p_at_spc = ~a;"
|
||||
(case (lookup 'mode config)
|
||||
[(copy vfasl-copy) "si->space"]
|
||||
[else "SPACE(p) & ~(space_locked | space_old)"]))
|
||||
[(copy mark vfasl-copy) "si->space"]
|
||||
[else "SPACE(p)"]))
|
||||
(let loop ([all-clauses all-clauses] [else? #f])
|
||||
(match all-clauses
|
||||
[`([else . ,body])
|
||||
|
|
@ -1414,9 +1488,7 @@
|
|||
(code
|
||||
(format "~aif (p_at_spc == ~a)"
|
||||
(if else? "else " "")
|
||||
(case (lookup 'mode config)
|
||||
[(copy) (format "(~a | space_old)" (as-c spc))]
|
||||
[else (as-c spc)]))
|
||||
(as-c spc))
|
||||
(code-block (statements body config))
|
||||
(loop rest #t))])))
|
||||
(statements (cdr l) config))]
|
||||
|
|
@ -1463,6 +1535,8 @@
|
|||
[(self-test) #f]
|
||||
[(measure vfasl-copy vfasl-sweep)
|
||||
(statements (list `(trace ,field)) config)]
|
||||
[(mark)
|
||||
(relocate-statement (field-expression field config "p" #t) config)]
|
||||
[else
|
||||
(trace-statement field config #f)])
|
||||
(statements (cdr l) config))]
|
||||
|
|
@ -1552,6 +1626,9 @@
|
|||
(cons `(constant-size? ,(symbol? size))
|
||||
config))
|
||||
(statements (cdr l) config))]
|
||||
[`(as-mark-end . ,stmts)
|
||||
(statements (append stmts (cdr l))
|
||||
config)]
|
||||
[`(space ,s)
|
||||
(case (lookup 'mode config)
|
||||
[(copy)
|
||||
|
|
@ -1559,6 +1636,10 @@
|
|||
(expression s config #f #t)
|
||||
";")
|
||||
(statements (cdr l) (cons '(space-ready? #t) config)))]
|
||||
[(mark)
|
||||
(statements (cdr l) (if (symbol? s)
|
||||
(cons `(known-space ,s) config)
|
||||
config))]
|
||||
[else (statements (cdr l) config)])]
|
||||
[`(vspace ,s)
|
||||
(case (lookup 'mode config)
|
||||
|
|
@ -1583,59 +1664,75 @@
|
|||
(case mode
|
||||
[(sweep) 'sweep+size]
|
||||
[else mode])
|
||||
mode)])
|
||||
(code-block
|
||||
(case mode
|
||||
[(copy sweep+size size measure vfasl-copy vfasl-sweep)
|
||||
mode)]
|
||||
[was-used? (let ([used? (hashtable-ref (lookup 'used config) 'p_sz #f)])
|
||||
(hashtable-set! (lookup 'used config) 'p_sz #f)
|
||||
used?)]
|
||||
[config (if (and (symbol? sz)
|
||||
(eqv? scale 1))
|
||||
(cons `(known-size ,sz) config)
|
||||
config)]
|
||||
[config (if (symbol? sz)
|
||||
(cons '(constant-size? #t)
|
||||
config)
|
||||
config)]
|
||||
[rest
|
||||
(case mode
|
||||
[(copy vfasl-copy)
|
||||
(case mode
|
||||
[(copy) (unless (lookup 'space-ready? config #f)
|
||||
(error 'generate "size before space"))]
|
||||
[(vfasl-copy) (unless (lookup 'vspace-ready? config #f)
|
||||
(error 'generate "size before vspace for ~a/~a"
|
||||
(lookup 'basetype config)
|
||||
(lookup 'type config #f)))])
|
||||
(hashtable-set! (lookup 'used config) 'p_sz #t)
|
||||
(code (format "~a, ~a, p_sz, new_p);"
|
||||
(case mode
|
||||
[(copy) "find_room(p_spc, tg"]
|
||||
[(vfasl-copy) "FIND_ROOM(vfi, p_vspc"])
|
||||
(as-c 'type (lookup 'basetype config)))
|
||||
(statements (let ([extra (lookup 'copy-extra config #f)])
|
||||
(if extra
|
||||
(cons `(copy ,extra) (cdr l))
|
||||
(let* ([mode (lookup 'mode config)]
|
||||
[extra (and (memq mode '(copy vfasl-copy))
|
||||
(lookup 'copy-extra-rtd config #f))])
|
||||
(if extra
|
||||
(cons `(set! (,extra _copy_)
|
||||
,(case mode
|
||||
[(copy)
|
||||
`(cond
|
||||
[(== tf _) _copy_]
|
||||
[else rtd])]
|
||||
[else 'rtd]))
|
||||
(cdr l))
|
||||
(cdr l)))))
|
||||
(cons '(copy-ready? #t)
|
||||
config)))]
|
||||
[(size)
|
||||
(hashtable-set! (lookup 'used config) 'p_sz #t)
|
||||
(code "return p_sz;")]
|
||||
[(vfasl-sweep)
|
||||
(hashtable-set! (lookup 'used config) 'p_sz #t)
|
||||
(code "result_sz = p_sz;"
|
||||
(statements (cdr l) config))]
|
||||
[(measure)
|
||||
(hashtable-set! (lookup 'used config) 'p_sz #t)
|
||||
(code "measure_total += p_sz;"
|
||||
(statements (cdr l) config))]
|
||||
[else (statements (cdr l) config)])]
|
||||
[used? (hashtable-ref (lookup 'used config) 'p_sz #f)])
|
||||
(hashtable-set! (lookup 'used config) 'p_sz was-used?)
|
||||
(cond
|
||||
[used?
|
||||
(code-block
|
||||
(format "uptr p_sz = ~a;" (let ([s (size-expression sz config)])
|
||||
(if (= scale 1)
|
||||
s
|
||||
(format "~a * (~a)" scale s))))]
|
||||
[else #f])
|
||||
(case mode
|
||||
[(copy vfasl-copy)
|
||||
(case mode
|
||||
[(copy) (unless (lookup 'space-ready? config #f)
|
||||
(error 'generate "size before space"))]
|
||||
[(vfasl-copy) (unless (lookup 'vspace-ready? config #f)
|
||||
(error 'generate "size before vspace for ~a/~a"
|
||||
(lookup 'basetype config)
|
||||
(lookup 'type config #f)))])
|
||||
(code (format "~a, ~a, p_sz, new_p);"
|
||||
(case mode
|
||||
[(copy) "find_room(p_spc, tg"]
|
||||
[(vfasl-copy) "FIND_ROOM(vfi, p_vspc"])
|
||||
(as-c 'type (lookup 'basetype config)))
|
||||
(statements (let ([extra (lookup 'copy-extra config #f)])
|
||||
(if extra
|
||||
(cons `(copy ,extra) (cdr l))
|
||||
(let* ([mode (lookup 'mode config)]
|
||||
[extra (and (memq mode '(copy vfasl-copy))
|
||||
(lookup 'copy-extra-rtd config #f))])
|
||||
(if extra
|
||||
(cons `(set! (,extra _copy_)
|
||||
,(case mode
|
||||
[(copy)
|
||||
`(cond
|
||||
[(== tf _) _copy_]
|
||||
[else rtd])]
|
||||
[else 'rtd]))
|
||||
(cdr l))
|
||||
(cdr l)))))
|
||||
(cons '(copy-ready? #t)
|
||||
(if (symbol? sz)
|
||||
(cons '(constant-size? #t)
|
||||
config)
|
||||
config))))]
|
||||
[(size)
|
||||
(code "return p_sz;")]
|
||||
[(vfasl-sweep)
|
||||
(code "result_sz = p_sz;"
|
||||
(statements (cdr l) config))]
|
||||
[(measure)
|
||||
(code "measure_total += p_sz;"
|
||||
(statements (cdr l) config))]
|
||||
[else (statements (cdr l) config)])))]
|
||||
(format "~a * (~a)" scale s))))
|
||||
rest)]
|
||||
[else rest]))]
|
||||
[`(skip-forwarding)
|
||||
(case (lookup 'mode config)
|
||||
[(copy)
|
||||
|
|
@ -1644,6 +1741,35 @@
|
|||
(code "return new_p;")]
|
||||
[else
|
||||
(statements (cdr l) config)])]
|
||||
[`(mark . ,flags)
|
||||
(for-each (lambda (flag)
|
||||
(unless (memq flag '(one-bit no-sweep within-segment counting-root))
|
||||
(error 'mark "bad flag ~s" flag)))
|
||||
flags)
|
||||
(case (lookup 'mode config)
|
||||
[(mark)
|
||||
(let* ([count-stmt (let loop ([l (cdr l)])
|
||||
(cond
|
||||
[(null? l) (error 'mark "could not find `count` or `as-mark-end` ~s" config)]
|
||||
[else
|
||||
(match (car l)
|
||||
[`(count . ,rest) (car l)]
|
||||
[`(as-mark-end . ,stmts) (car l)]
|
||||
[`(case-mode . ,all-clauses)
|
||||
(let ([body (find-matching-mode 'mark all-clauses)])
|
||||
(loop (append body (cdr l))))]
|
||||
[`(,id . ,args)
|
||||
(let ([m (eq-hashtable-ref trace-macros id #f)])
|
||||
(if m
|
||||
(loop (append (apply-macro m args)
|
||||
(cdr l)))
|
||||
(loop (cdr l))))]
|
||||
[else (loop (cdr l))])]))])
|
||||
(code
|
||||
(mark-statement flags config)
|
||||
(statements (list count-stmt) config)))]
|
||||
[else
|
||||
(statements (cdr l) config)])]
|
||||
[`(define ,id : ,type ,rhs)
|
||||
(let* ([used (lookup 'used config)]
|
||||
[prev-used? (hashtable-ref used id #f)])
|
||||
|
|
@ -1737,6 +1863,10 @@
|
|||
(statements (cdr l) config))]
|
||||
[`(break)
|
||||
(code "break;")]
|
||||
[`(assert ,expr)
|
||||
(unless (eval expr)
|
||||
(error 'assert "failed: ~s" expr))
|
||||
(statements (cdr l) config)]
|
||||
[`(,id . ,args)
|
||||
(let ([m (eq-hashtable-ref trace-macros id #f)])
|
||||
(if m
|
||||
|
|
@ -1764,6 +1894,10 @@
|
|||
[else "p"])]
|
||||
[`_tf_
|
||||
(lookup 'tf config "TYPEFIELD(p)")]
|
||||
[`_tg_
|
||||
(case (lookup 'mode config)
|
||||
[(copy) "tg"]
|
||||
[else "target_generation"])]
|
||||
[`_backreferences?_
|
||||
(if (lookup 'maybe-backreferences? config #f)
|
||||
"BACKREFERENCES_ENABLED"
|
||||
|
|
@ -1880,7 +2014,8 @@
|
|||
(cond
|
||||
[(or (eq? mode 'sweep)
|
||||
(eq? mode 'vfasl-sweep)
|
||||
(and early? (eq? mode 'copy)))
|
||||
(and early? (or (eq? mode 'copy)
|
||||
(eq? mode 'mark))))
|
||||
(relocate-statement (field-expression field config "p" #t) config)]
|
||||
[(or (eq? mode 'copy)
|
||||
(eq? mode 'vfasl-copy))
|
||||
|
|
@ -1927,12 +2062,13 @@
|
|||
[else #f]))
|
||||
|
||||
(define (count-statement counter size scale modes config)
|
||||
(let ([mode (lookup 'mode config)])
|
||||
(let* ([real-mode (lookup 'mode config)]
|
||||
[mode (if (eq? real-mode 'mark) 'copy real-mode)])
|
||||
(cond
|
||||
[(or (eq? mode modes) (and (pair? modes) (memq mode modes)))
|
||||
(cond
|
||||
[(lookup 'counts? config #f)
|
||||
(let ([tg (if (eq? mode 'copy)
|
||||
(let ([tg (if (eq? real-mode 'copy)
|
||||
"tg"
|
||||
"target_generation")])
|
||||
(code
|
||||
|
|
@ -1944,13 +2080,122 @@
|
|||
(as-c counter)
|
||||
(let ([s (if size
|
||||
(expression size config)
|
||||
"p_sz")])
|
||||
(begin
|
||||
(hashtable-set! (lookup 'used config) 'p_sz #t)
|
||||
"p_sz"))])
|
||||
(if (eqv? scale 1)
|
||||
s
|
||||
(format "~a * (~a)" scale s)))))))]
|
||||
[else #f])]
|
||||
[else #f])))
|
||||
|
||||
(define (mark-statement flags config)
|
||||
(let* ([known-space (lookup 'known-space config #f)]
|
||||
[sz (let ([sz (lookup 'known-size config #f)])
|
||||
(and sz (get-size-value sz)))]
|
||||
[one-bit? (or (memq 'one-bit flags)
|
||||
(eq? 'space-data known-space)
|
||||
(eqv? sz (constant byte-alignment)))]
|
||||
[within-segment? (or (memq 'within-segment flags)
|
||||
(and sz
|
||||
(< sz (constant bytes-per-segment))))]
|
||||
[no-sweep? (or (memq 'no-sweep flags)
|
||||
(eq? known-space 'space-data))]
|
||||
[within-loop-statement
|
||||
(lambda (decl si step count?)
|
||||
(code-block
|
||||
"uptr offset = 0;"
|
||||
"while (offset < p_sz) {"
|
||||
" ptr mark_p = (ptr)((uptr)p + offset);"
|
||||
decl
|
||||
(format " ~a->marked_mask[segment_bitmap_byte(mark_p)] |= segment_bitmap_bit(mark_p);" si)
|
||||
(and count? (format " ~a->marked_count += ~a;" si step))
|
||||
(format " offset += ~a;" step)
|
||||
"}"))]
|
||||
[type (let ([t (lookup 'basetype config)])
|
||||
(if (eq? t 'typemod)
|
||||
#f
|
||||
(as-c 'type (lookup 'basetype config))))]
|
||||
[untype (lambda ()
|
||||
(if type
|
||||
(format "(uptr)UNTYPE(p, ~a)" type)
|
||||
(format "(uptr)p")))])
|
||||
(hashtable-set! (lookup 'used config) 'p_sz #t)
|
||||
(code
|
||||
(cond
|
||||
[one-bit?
|
||||
(code
|
||||
"si->marked_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p);"
|
||||
(cond
|
||||
[within-segment?
|
||||
"si->marked_count += p_sz;"]
|
||||
[else
|
||||
(code-block
|
||||
(format "uptr addr = ~a;" (untype))
|
||||
"uptr seg = addr_get_segment(addr);"
|
||||
"uptr end_seg = addr_get_segment(addr + p_sz - 1);"
|
||||
"if (seg == end_seg) {"
|
||||
" si->marked_count += p_sz;"
|
||||
"} else {"
|
||||
" seginfo *mark_si;"
|
||||
" si->marked_count += ((uptr)build_ptr(seg+1,0)) - addr;"
|
||||
" seg++;"
|
||||
" while (seg < end_seg) {"
|
||||
" mark_si = SegInfo(seg);"
|
||||
" if (!fully_marked_mask) init_fully_marked_mask();"
|
||||
" mark_si->marked_mask = fully_marked_mask;"
|
||||
" mark_si->marked_count = segment_bitmap_bytes;"
|
||||
" seg++;"
|
||||
" }"
|
||||
" mark_si = SegInfo(end_seg);"
|
||||
(ensure-segment-mark-mask "mark_si" " " '())
|
||||
" /* no need to set a bit: just make sure `marked_mask` is non-NULL */"
|
||||
" mark_si->marked_count += addr + p_sz - (uptr)build_ptr(end_seg,0);"
|
||||
"}")]))]
|
||||
[within-segment?
|
||||
(code
|
||||
"si->marked_count += p_sz;"
|
||||
(cond
|
||||
[sz
|
||||
(code-block
|
||||
"ptr mark_p = p;"
|
||||
(let loop ([sz sz])
|
||||
(code
|
||||
"si->marked_mask[segment_bitmap_byte(mark_p)] |= segment_bitmap_bit(mark_p);"
|
||||
(let ([sz (- sz (constant byte-alignment))])
|
||||
(if (zero? sz)
|
||||
#f
|
||||
(code
|
||||
"mark_p = (ptr)((uptr)mark_p + byte_alignment);"
|
||||
(loop sz)))))))]
|
||||
[else
|
||||
(within-loop-statement #f "si" "byte_alignment" #f)]))]
|
||||
[else
|
||||
(let ([step "byte_alignment"])
|
||||
(code-block
|
||||
(format "uptr addr = (uptr)UNTYPE(p, ~a);" type)
|
||||
"if (addr_get_segment(addr) == addr_get_segment(addr + p_sz - 1))"
|
||||
(code-block
|
||||
"si->marked_count += p_sz;"
|
||||
(within-loop-statement #f "si" step #f))
|
||||
"else"
|
||||
(within-loop-statement (code
|
||||
" seginfo *mark_si = SegInfo(ptr_get_segment(mark_p));"
|
||||
(ensure-segment-mark-mask "mark_si" " " '()))
|
||||
"mark_si"
|
||||
step
|
||||
#t)))])
|
||||
(cond
|
||||
[no-sweep? #f]
|
||||
[else
|
||||
(let ([push "push_sweep(p);"])
|
||||
(cond
|
||||
[(and (memq 'counting-root flags)
|
||||
(lookup 'counts? config #f))
|
||||
(code "if (!is_counting_root(si, p))"
|
||||
(code-block push))]
|
||||
[else push]))]))))
|
||||
|
||||
(define (field-expression field config arg protect?)
|
||||
(if (symbol? field)
|
||||
(cond
|
||||
|
|
@ -1983,6 +2228,26 @@
|
|||
(when (and index (not (eq? index 0)))
|
||||
(error 'field-ref "index not allowed for non-array field ~s" acc-name))
|
||||
(format "~a(~a)" c-ref obj)])))
|
||||
|
||||
(define (ensure-segment-mark-mask si inset flags)
|
||||
(code
|
||||
(format "~aif (!~a->marked_mask) {" inset si)
|
||||
(format "~a find_room(space_data, target_generation, typemod, ptr_align(segment_bitmap_bytes), ~a->marked_mask);"
|
||||
inset si)
|
||||
(if (memq 'no-clear flags)
|
||||
(format "~a /* no clearing needed */" inset)
|
||||
(format "~a memset(~a->marked_mask, 0, segment_bitmap_bytes);" inset si))
|
||||
(format "~a}" inset)))
|
||||
|
||||
(define (just-mark-bit-space? sp)
|
||||
(case sp
|
||||
[(space-symbol space-port) #t]
|
||||
[else (atomic-space? sp)]))
|
||||
|
||||
(define (atomic-space? sp)
|
||||
(case sp
|
||||
[(space-data) #t]
|
||||
[else #f]))
|
||||
|
||||
;; Slightly hacky way to check whether `op` is an accessor
|
||||
(define (get-offset-value op)
|
||||
|
|
@ -2180,8 +2445,18 @@
|
|||
(sweep1 'code "sweep_code_object"))
|
||||
(print-code (generate "size_object"
|
||||
`((mode size))))
|
||||
(print-code (generate "mark_object"
|
||||
`((mode mark)
|
||||
(counts? ,count?))))
|
||||
(print-code (generate "object_directly_refers_to_self"
|
||||
`((mode self-test))))
|
||||
(print-code (code "static void mark_typemod_data_object(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)))))))
|
||||
(when measure?
|
||||
(print-code (generate "measure" `((mode measure))))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -979,9 +979,11 @@
|
|||
(gensym-prefix [sig [() -> (ptr)] [(ptr) -> (void)]] [flags unrestricted])
|
||||
(heap-reserve-ratio [sig [() -> (number)] [(sub-number) -> (void)]] [flags])
|
||||
(import-notify [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
|
||||
(in-place-minimum-generation [sig [() -> (ufixnum)] [(sub-ufixnum) -> (void)]] [flags])
|
||||
(interaction-environment [sig [() -> (environment)] [(environment) -> (void)]] [flags ieee r5rs])
|
||||
(internal-defines-as-letrec* [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
|
||||
(invoke-library [sig [(ptr) -> (void)]] [flags true])
|
||||
(keep-live [sig [(ptr) -> (void)]] [flags])
|
||||
(keyboard-interrupt-handler [sig [() -> (procedure)] [(procedure) -> (void)]] [flags])
|
||||
(library-directories [sig [() -> (list)] [(sub-ptr) -> (void)]] [flags])
|
||||
(library-exports [sig [(sub-list) -> (list)]] [flags])
|
||||
|
|
@ -1160,6 +1162,7 @@
|
|||
(box [sig [(ptr) -> (box)]] [flags unrestricted alloc])
|
||||
(box? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard])
|
||||
(box-cas! [sig [(box ptr ptr) -> (boolean)]] [flags])
|
||||
(box-immobile [sig [(ptr) -> (box)]] [flags unrestricted alloc])
|
||||
(box-immutable [sig [(ptr) -> (box)]] [flags unrestricted alloc])
|
||||
(break [sig [(ptr ...) -> (ptr ...)]] [flags])
|
||||
(bwp-object? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard])
|
||||
|
|
@ -1474,6 +1477,8 @@
|
|||
(make-fxvector [sig [(length) (length fixnum) -> (fxvector)]] [flags alloc])
|
||||
(make-guardian [sig [() (ptr) -> (procedure)]] [flags alloc cp02])
|
||||
(make-hash-table [sig [() (ptr) -> (old-hash-table)]] [flags unrestricted alloc])
|
||||
(make-immobile-bytevector [sig [(length) (length u8/s8) -> (bytevector)]] [flags alloc])
|
||||
(make-immobile-vector [sig [(length) (length ptr) -> (vector)]] [flags alloc])
|
||||
(make-input-port [sig [(procedure string) -> (textual-input-port)]] [flags alloc])
|
||||
(make-input/output-port [sig [(procedure string string) -> (textual-input/output-port)]] [flags alloc])
|
||||
(make-list [sig [(length) (length ptr) -> (list)]] [flags alloc])
|
||||
|
|
@ -2150,7 +2155,6 @@
|
|||
($invoke-library [flags single-valued])
|
||||
($invoke-program [flags single-valued])
|
||||
($io-init [flags single-valued])
|
||||
($keep-live [flags single-valued])
|
||||
($last-new-vector-element [flags single-valued])
|
||||
($lexical-error [flags single-valued])
|
||||
($library-search [flags])
|
||||
|
|
|
|||
24
s/prims.ss
24
s/prims.ss
|
|
@ -321,6 +321,18 @@
|
|||
($oops who "~s is not a valid vector length" n))
|
||||
(make-vector n)]))
|
||||
|
||||
(define-who make-immobile-vector
|
||||
(let ([$make-immobile-vector (foreign-procedure "(cs)make_immobile_vector" (uptr ptr) ptr)])
|
||||
(case-lambda
|
||||
[(n x)
|
||||
(unless (and (fixnum? n) (not ($fxu< (constant maximum-vector-length) n)))
|
||||
($oops who "~s is not a valid vector length" n))
|
||||
($make-immobile-vector n x)]
|
||||
[(n)
|
||||
(unless (and (fixnum? n) (not ($fxu< (constant maximum-vector-length) n)))
|
||||
($oops who "~s is not a valid vector length" n))
|
||||
($make-immobile-vector n 0)])))
|
||||
|
||||
(define $make-eqhash-vector
|
||||
(case-lambda
|
||||
[(n)
|
||||
|
|
@ -1279,6 +1291,8 @@
|
|||
|
||||
(define box-immutable (lambda (x) (box-immutable x)))
|
||||
|
||||
(define box-immobile (foreign-procedure "(cs)box_immobile" (ptr) ptr))
|
||||
|
||||
(define unbox
|
||||
(lambda (b)
|
||||
(if (box? b)
|
||||
|
|
@ -1804,7 +1818,7 @@
|
|||
(when (eq? addr 0)
|
||||
($oops 'mutex-acquire "mutex is defunct"))
|
||||
(let ([r ((if block? ma ma-nb) addr)])
|
||||
($keep-live m)
|
||||
(keep-live m)
|
||||
r))]))
|
||||
|
||||
(set! mutex-release
|
||||
|
|
@ -1849,8 +1863,8 @@
|
|||
(when (eq? maddr 0)
|
||||
($oops 'condition-wait "mutex is defunct"))
|
||||
(let ([r (cw caddr maddr t)])
|
||||
($keep-live c)
|
||||
($keep-live m)
|
||||
(keep-live c)
|
||||
(keep-live m)
|
||||
r))]))
|
||||
|
||||
(set! condition-broadcast
|
||||
|
|
@ -2538,9 +2552,9 @@
|
|||
(lambda ()
|
||||
(#3%$read-time-stamp-counter)))
|
||||
|
||||
(define $keep-live
|
||||
(define keep-live
|
||||
(lambda (x)
|
||||
(#2%$keep-live x)))
|
||||
(#2%keep-live x)))
|
||||
|
||||
(when-feature windows
|
||||
(let ()
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user