diff --git a/.makefile b/.makefile index 3407359659..44160c0d5a 100644 --- a/.makefile +++ b/.makefile @@ -344,7 +344,7 @@ RACKET_FOR_BOOTFILES = $(RACKET) RACKET_FOR_BUILD = $(RACKET) # This branch name changes each time the pb boot files are updated: -PB_BRANCH == circa-8.0.0.7-1 +PB_BRANCH == circa-8.0.0.10-1 PB_REPO = https://github.com/racket/pb # Alternative source for Chez Scheme boot files, normally set by diff --git a/Makefile b/Makefile index 7badf755d7..c35ef39bed 100644 --- a/Makefile +++ b/Makefile @@ -47,7 +47,7 @@ RACKETCS_SUFFIX = RACKET = RACKET_FOR_BOOTFILES = $(RACKET) RACKET_FOR_BUILD = $(RACKET) -PB_BRANCH = circa-8.0.0.7-1 +PB_BRANCH = circa-8.0.0.10-1 PB_REPO = https://github.com/racket/pb EXTRA_REPOS_BASE = CS_CROSS_SUFFIX = @@ -309,18 +309,18 @@ maybe-fetch-pb-as-is: echo done fetch-pb-from: mkdir -p racket/src/ChezScheme/boot - if [ ! -d racket/src/ChezScheme/boot/pb ] ; then git clone -q -b circa-8.0.0.7-1 $(PB_REPO) racket/src/ChezScheme/boot/pb ; else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-8.0.0.7-1:remotes/origin/circa-8.0.0.7-1 ; fi - cd racket/src/ChezScheme/boot/pb && git checkout -q circa-8.0.0.7-1 + if [ ! -d racket/src/ChezScheme/boot/pb ] ; then git clone -q -b circa-8.0.0.10-1 $(PB_REPO) racket/src/ChezScheme/boot/pb ; else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-8.0.0.10-1:remotes/origin/circa-8.0.0.10-1 ; fi + cd racket/src/ChezScheme/boot/pb && git checkout -q circa-8.0.0.10-1 pb-fetch: $(MAKE) fetch-pb EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" PB_REPO="$(PB_REPO)" pb-build: cd racket/src/ChezScheme && racket rktboot/main.rkt --machine pb pb-stage: - cd racket/src/ChezScheme/boot/pb && git branch circa-8.0.0.7-1 - cd racket/src/ChezScheme/boot/pb && git checkout circa-8.0.0.7-1 + cd racket/src/ChezScheme/boot/pb && git branch circa-8.0.0.10-1 + cd racket/src/ChezScheme/boot/pb && git checkout circa-8.0.0.10-1 cd racket/src/ChezScheme/boot/pb && git add . && git commit --amend -m "new build" pb-push: - cd racket/src/ChezScheme/boot/pb && git push -u origin circa-8.0.0.7-1 + cd racket/src/ChezScheme/boot/pb && git push -u origin circa-8.0.0.10-1 win-cs-base: IF "$(RACKET_FOR_BUILD)" == "" $(MAKE) win-bc-then-cs-base SETUP_BOOT_MODE=--boot WIN32_BUILD_LEVEL=bc PLAIN_RACKET=racket\racketbc DISABLE_STATIC_LIBS="$(DISABLE_STATIC_LIBS)" EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" JOB_OPTIONS="$(JOB_OPTIONS)" PLT_SETUP_OPTIONS="$(PLT_SETUP_OPTIONS)" RACKETBC_SUFFIX="$(RACKETBC_SUFFIX)" RACKETCS_SUFFIX="$(RACKETCS_SUFFIX)" IF not "$(RACKET_FOR_BUILD)" == "" $(MAKE) win-just-cs-base SETUP_BOOT_MODE=--chain DISABLE_STATIC_LIBS="$(DISABLE_STATIC_LIBS)" EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" JOB_OPTIONS="$(JOB_OPTIONS)" PLT_SETUP_OPTIONS="$(PLT_SETUP_OPTIONS)" RACKETCS_SUFFIX="$(RACKETCS_SUFFIX)" RACKET_FOR_BUILD="$(RACKET_FOR_BUILD)" diff --git a/racket/src/ChezScheme/c/alloc.c b/racket/src/ChezScheme/c/alloc.c index e077ec07cd..d690c0c28a 100644 --- a/racket/src/ChezScheme/c/alloc.c +++ b/racket/src/ChezScheme/c/alloc.c @@ -374,7 +374,7 @@ void S_dirty_set(ptr *loc, ptr x) { seginfo *si = SegInfo(addr_get_segment(TO_PTR(loc))); if (si->use_marks) { /* GC must be in progress */ - if (!IMMEDIATE(x)) { + if (!FIXMEDIATE(x)) { seginfo *t_si = SegInfo(ptr_get_segment(x)); if (t_si->generation < si->generation) S_record_new_dirty_card(THREAD_GC(get_thread_context()), loc, t_si->generation); diff --git a/racket/src/ChezScheme/c/gc.c b/racket/src/ChezScheme/c/gc.c index 234ad5df76..ad9ba75215 100644 --- a/racket/src/ChezScheme/c/gc.c +++ b/racket/src/ChezScheme/c/gc.c @@ -563,7 +563,7 @@ static int flonum_is_forwarded_p(ptr p, seginfo *si) { #define relocate_pure_help(ppp, pp) do { \ seginfo *SI; \ - if (!IMMEDIATE(pp) && (SI = MaybeSegInfo(ptr_get_segment(pp))) != NULL) { \ + if (!FIXMEDIATE(pp) && (SI = MaybeSegInfo(ptr_get_segment(pp))) != NULL) { \ if (SI->old_space) \ relocate_pure_help_help(ppp, pp, SI); \ ELSE_MEASURE_NONOLDSPACE(pp) \ @@ -609,7 +609,7 @@ static int flonum_is_forwarded_p(ptr p, seginfo *si) { static void do_relocate_pure_in_owner(thread_gc *tgc, ptr *ppp) { seginfo *si; ptr pp = *ppp; - if (!IMMEDIATE(pp) + if (!FIXMEDIATE(pp) && (si = MaybeSegInfo(ptr_get_segment(pp))) != NULL && si->old_space) { BLOCK_SET_THREAD(si->creator); @@ -639,7 +639,7 @@ static void do_relocate_pure_in_owner(thread_gc *tgc, ptr *ppp) { #define relocate_impure_help(ppp, pp, from_g) do { \ seginfo *SI; \ - if (!IMMEDIATE(pp) && (SI = MaybeSegInfo(ptr_get_segment(pp))) != NULL) { \ + if (!FIXMEDIATE(pp) && (SI = MaybeSegInfo(ptr_get_segment(pp))) != NULL) { \ if (SI->old_space) \ relocate_impure_help_help(ppp, pp, from_g, SI); \ ELSE_MEASURE_NONOLDSPACE(pp) \ @@ -673,7 +673,7 @@ static void do_relocate_pure_in_owner(thread_gc *tgc, ptr *ppp) { #define relocate_dirty(PPP, YOUNGEST) do { \ seginfo *_si; ptr *_ppp = PPP, _pp = *_ppp; IGEN _pg; \ - if (!IMMEDIATE(_pp) && (_si = MaybeSegInfo(ptr_get_segment(_pp))) != NULL) { \ + if (!FIXMEDIATE(_pp) && (_si = MaybeSegInfo(ptr_get_segment(_pp))) != NULL) { \ if (!_si->old_space) { \ _pg = _si->generation; \ } else { \ @@ -815,7 +815,7 @@ static ptr copy_stack(thread_gc *tgc, ptr old, iptr *length, iptr clength) { } } -#define NONSTATICINHEAP(si, x) (!IMMEDIATE(x) && (si = MaybeSegInfo(ptr_get_segment(x))) != NULL && si->generation != static_generation) +#define NONSTATICINHEAP(si, x) (!FIXMEDIATE(x) && (si = MaybeSegInfo(ptr_get_segment(x))) != NULL && si->generation != static_generation) #define ALWAYSTRUE(si, x) (si = SegInfo(ptr_get_segment(x)), 1) #define partition_guardians(LS, FILTER) do { \ ptr ls; seginfo *si; \ @@ -1070,7 +1070,7 @@ ptr GCENTRY(ptr tc, ptr count_roots_ls) { for (ls = count_roots_ls, i = 0; ls != Snil; ls = Scdr(ls), i++) { ptr p = Scar(ls); - if (IMMEDIATE(p)) { + if (FIXMEDIATE(p)) { count_roots[i].p = p; count_roots[i].weak = 0; } else { @@ -1106,7 +1106,7 @@ ptr GCENTRY(ptr tc, ptr count_roots_ls) { for (i = 0; i < count_roots_len; i++) { uptr total; ptr p = count_roots[i].p; - if (IMMEDIATE(p)) { + if (FIXMEDIATE(p)) { /* nothing to do */ } else { seginfo *si = SegInfo(ptr_get_segment(p)); @@ -1152,7 +1152,7 @@ ptr GCENTRY(ptr tc, ptr count_roots_ls) { /* clear `counting_mask`s */ for (i = 0; i < count_roots_len; i++) { ptr p = count_roots[i].p; - if (!IMMEDIATE(p)) { + if (!FIXMEDIATE(p)) { seginfo *si = SegInfo(ptr_get_segment(p)); si->counting_mask = NULL; } @@ -1368,7 +1368,7 @@ ptr GCENTRY(ptr tc, ptr count_roots_ls) { pend_hold_ls = ls; } else { seginfo *si; - if (!IMMEDIATE(rep) && (si = MaybeSegInfo(ptr_get_segment(rep))) != NULL && si->old_space) { + if (!FIXMEDIATE(rep) && (si = MaybeSegInfo(ptr_get_segment(rep))) != NULL && si->old_space) { /* mark things reachable from `rep`, but not `rep` itself, unless `rep` is immediately reachable from itself */ PUSH_BACKREFERENCE(ls) @@ -1885,7 +1885,7 @@ static void resweep_weak_pairs(seginfo *oldweakspacesegments) { static void forward_or_bwp(pp, p) ptr *pp; ptr p; { seginfo *si; /* adapted from relocate */ - if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && si->old_space && !new_marked(si, p)) { + if (!FIXMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && si->old_space && !new_marked(si, p)) { if (FORWARDEDP(p, si)) { *pp = GET_FWDADDRESS(p); } else { @@ -2526,7 +2526,7 @@ static void resweep_dirty_weak_pairs(thread_gc *tgc) { seginfo *si; /* handle car field */ - if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL) { + if (!FIXMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL) { if (si->old_space) { if (new_marked(si, p)) { youngest = TARGET_GENERATION(si); @@ -2637,7 +2637,7 @@ static void check_ephemeron(thread_gc *tgc, ptr pe) { from_g = GENERATION(pe); p = Scar(pe); - if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && si->old_space) { + if (!FIXMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && si->old_space) { if (SEGMENT_IS_LOCAL(si, p)) { if (new_marked(si, p)) { #ifndef NO_DIRTY_NEWSPACE_POINTERS @@ -2696,7 +2696,7 @@ static IGEN check_dirty_ephemeron(thread_gc *tgc, ptr pe, IGEN youngest) { PUSH_BACKREFERENCE(pe); p = Scar(pe); - if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL) { + if (!FIXMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL) { if (si->old_space) { if (SEGMENT_IS_LOCAL(si, p)) { if (new_marked(si, p)) { @@ -3305,7 +3305,7 @@ static void add_ephemeron_to_pending_measure(thread_gc *tgc, ptr pe) { seginfo *si; ptr p = Scar(pe); - if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && si->old_space) + if (!FIXMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && si->old_space) add_ephemeron_to_pending(tgc, pe); else { if (EPHEMERONPREVREF(pe)) @@ -3326,7 +3326,7 @@ static void check_ephemeron_measure(thread_gc *tgc, ptr pe) { EPHEMERONNEXT(pe) = 0; p = Scar(pe); - if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL + if (!FIXMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && (si->generation <= max_measure_generation) && (si->generation >= min_measure_generation) && (!(si->old_space) || !FORWARDEDP(p, si)) @@ -3341,7 +3341,7 @@ static void check_ephemeron_measure(thread_gc *tgc, ptr pe) { } p = Scdr(pe); - if (!IMMEDIATE(p)) + if (!FIXMEDIATE(p)) push_measure(tgc, p); } @@ -3398,7 +3398,7 @@ ptr S_count_size_increments(ptr ls, IGEN generation) { for (l = ls; l != Snil; l = Scdr(l)) { ptr p = Scar(l); - if (!IMMEDIATE(p)) { + if (!FIXMEDIATE(p)) { seginfo *si = SegInfo(ptr_get_segment(p)); if (!si->measured_mask) @@ -3416,7 +3416,7 @@ ptr S_count_size_increments(ptr ls, IGEN generation) { measure_total = 0; - if (!IMMEDIATE(p)) { + if (!FIXMEDIATE(p)) { seginfo *si = SegInfo(ptr_get_segment(p)); measure_mask_unset(si->counting_mask, si, p); gc_measure_one(tgc, p); @@ -3432,7 +3432,7 @@ ptr S_count_size_increments(ptr ls, IGEN generation) { for (l = ls; l != Snil; l = Scdr(l)) { ptr p = Scar(l); - if (!IMMEDIATE(p)) { + if (!FIXMEDIATE(p)) { seginfo *si = SegInfo(ptr_get_segment(p)); si->counting_mask = NULL; } diff --git a/racket/src/ChezScheme/c/gcwrapper.c b/racket/src/ChezScheme/c/gcwrapper.c index 857cf5d7c5..fe71922135 100644 --- a/racket/src/ChezScheme/c/gcwrapper.c +++ b/racket/src/ChezScheme/c/gcwrapper.c @@ -185,7 +185,7 @@ void S_set_minmarkgen(IGEN g) { void S_immobilize_object(x) ptr x; { seginfo *si; - if (IMMEDIATE(x)) + if (FIXMEDIATE(x)) si = NULL; else si = MaybeSegInfo(ptr_get_segment(x)); @@ -212,7 +212,7 @@ void S_immobilize_object(x) ptr x; { void S_mobilize_object(x) ptr x; { seginfo *si; - if (IMMEDIATE(x)) + if (FIXMEDIATE(x)) si = NULL; else si = MaybeSegInfo(ptr_get_segment(x)); @@ -261,7 +261,7 @@ static IBOOL remove_first_nomorep(x, pls, look) ptr x, *pls; IBOOL look; { IBOOL Slocked_objectp(x) ptr x; { seginfo *si; IGEN g; IBOOL ans; ptr ls; - if (IMMEDIATE(x) || (si = MaybeSegInfo(ptr_get_segment(x))) == NULL || (g = si->generation) == static_generation) return 1; + if (FIXMEDIATE(x) || (si = MaybeSegInfo(ptr_get_segment(x))) == NULL || (g = si->generation) == static_generation) return 1; tc_mutex_acquire(); @@ -299,7 +299,7 @@ void Slock_object(x) ptr x; { seginfo *si; IGEN g; /* weed out pointers that won't be relocated */ - if (!IMMEDIATE(x) && (si = MaybeSegInfo(ptr_get_segment(x))) != NULL && (g = si->generation) != static_generation) { + if (!FIXMEDIATE(x) && (si = MaybeSegInfo(ptr_get_segment(x))) != NULL && (g = si->generation) != static_generation) { ptr tc = get_thread_context(); tc_mutex_acquire(); THREAD_GC(tc)->during_alloc += 1; @@ -323,7 +323,7 @@ void Slock_object(x) ptr x; { void Sunlock_object(x) ptr x; { seginfo *si; IGEN g; - if (!IMMEDIATE(x) && (si = MaybeSegInfo(ptr_get_segment(x))) != NULL && (g = si->generation) != static_generation) { + if (!FIXMEDIATE(x) && (si = MaybeSegInfo(ptr_get_segment(x))) != NULL && (g = si->generation) != static_generation) { ptr tc = get_thread_context(); tc_mutex_acquire(); THREAD_GC(tc)->during_alloc += 1; @@ -550,7 +550,7 @@ void S_addr_tell(ptr p) { static void check_pointer(ptr *pp, IBOOL address_is_meaningful, ptr base, uptr seg, ISPC s, IBOOL aftergc) { ptr p = *pp; - if (!IMMEDIATE(p)) { + if (!FIXMEDIATE(p)) { seginfo *psi = MaybeSegInfo(ptr_get_segment(p)); if (psi != NULL) { if ((psi->space == space_empty) @@ -945,7 +945,7 @@ void S_check_heap(aftergc, mcg) IBOOL aftergc; IGEN mcg; { found_eos = 1; pp1 = pp2; break; - } else if (!IMMEDIATE(p)) { + } else if (!FIXMEDIATE(p)) { seginfo *psi = MaybeSegInfo(ptr_get_segment(p)); if ((psi != NULL) && ((pg = psi->generation) < g)) { if (pg < dirty) dirty = pg; diff --git a/racket/src/ChezScheme/c/schlib.c b/racket/src/ChezScheme/c/schlib.c index 243e1f6233..127361edc8 100644 --- a/racket/src/ChezScheme/c/schlib.c +++ b/racket/src/ChezScheme/c/schlib.c @@ -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); - if (!IMMEDIATE(code) && !Scodep(code)) + if (!FIXMEDIATE(code) && !Scodep(code)) S_error_abort("S_call_help: invalid code pointer"); S_immobilize_object(code); diff --git a/racket/src/ChezScheme/c/thread.c b/racket/src/ChezScheme/c/thread.c index 92a58f565a..a3bf0ecda9 100644 --- a/racket/src/ChezScheme/c/thread.c +++ b/racket/src/ChezScheme/c/thread.c @@ -277,7 +277,7 @@ static IBOOL destroy_thread(tc) ptr tc; { for (ges = GUARDIANENTRIES(tc); ges != Snil; ges = next) { obj = GUARDIANOBJ(ges); next = GUARDIANNEXT(ges); - if (!IMMEDIATE(obj) && (si = MaybeSegInfo(ptr_get_segment(obj))) != NULL && si->generation != static_generation) { + if (!FIXMEDIATE(obj) && (si = MaybeSegInfo(ptr_get_segment(obj))) != NULL && si->generation != static_generation) { INITGUARDIANNEXT(ges) = target; target = ges; } diff --git a/racket/src/ChezScheme/c/types.h b/racket/src/ChezScheme/c/types.h index e2a12749f9..4122b06476 100644 --- a/racket/src/ChezScheme/c/types.h +++ b/racket/src/ChezScheme/c/types.h @@ -552,7 +552,7 @@ typedef struct thread_gc { #define SETPTRFIELD(x,disp,y) DIRTYSET(((ptr *)TO_VOIDP((uptr)(x)+disp)),(y)) #define INCRGEN(g) (g = g == S_G.max_nonstatic_generation ? static_generation : g+1) -#define IMMEDIATE(x) (Sfixnump(x) || Simmediatep(x)) +#define FIXMEDIATE(x) (Sfixnump(x) || Simmediatep(x)) /* For `memcpy_aligned, that the first two arguments are word-aligned and it would be ok to round up the length to a word size. But diff --git a/racket/src/ChezScheme/c/vfasl.c b/racket/src/ChezScheme/c/vfasl.c index 61de95cb9b..c86bd94041 100644 --- a/racket/src/ChezScheme/c/vfasl.c +++ b/racket/src/ChezScheme/c/vfasl.c @@ -519,7 +519,7 @@ static void relink_code(ptr co, ptr sym_base, ptr *vspaces, uptr *vspace_offsets /* offset is stored in place of constant-loading code: */ memcpy(&obj, TO_VOIDP((ptr)((uptr)co + a)), sizeof(ptr)); - if (IMMEDIATE(obj)) { + if (FIXMEDIATE(obj)) { if (Sfixnump(obj)) { int tag = VFASL_RELOC_TAG(obj); iptr pos = VFASL_RELOC_POS(obj); diff --git a/racket/src/ChezScheme/mats/cptypes.ms b/racket/src/ChezScheme/mats/cptypes.ms index 91a48ccdc8..594a02cf8a 100644 --- a/racket/src/ChezScheme/mats/cptypes.ms +++ b/racket/src/ChezScheme/mats/cptypes.ms @@ -1174,8 +1174,8 @@ '(lambda (v) (let loop ([i 0]) (when (fx< i (vector-length v)) - (vector-set! v i (#3%$immediate i)) + (vector-set! v i (#3%$fixmediate i)) (loop (fx+ i 1)))))) (cptypes-equivalent-expansion? '(lambda (x y) (set-box! x (if (vector? y) #t (error 't)))) - '(lambda (x y) (set-box! x (#3%$immediate (if (vector? y) #t (error 't))))))) + '(lambda (x y) (set-box! x (#3%$fixmediate (if (vector? y) #t (error 't))))))) diff --git a/racket/src/ChezScheme/s/5_2.ss b/racket/src/ChezScheme/s/5_2.ss index f2d05cbd35..e171180eb8 100644 --- a/racket/src/ChezScheme/s/5_2.ss +++ b/racket/src/ChezScheme/s/5_2.ss @@ -353,7 +353,7 @@ (set! assv (lambda (x alist) - (if (or (symbol? x) (#%$immediate? x)) + (if (or (symbol? x) (fixmediate? x)) (ass-eq? x alist 'assv) (do-assoc x alist 'assv eqv?)))) @@ -363,7 +363,7 @@ [(string? x) (do-assoc x alist 'assoc (lambda (x y) (and (string? x) (string=? x y))))] - [(or (symbol? x) (#%$immediate? x)) + [(or (symbol? x) (fixmediate? x)) (ass-eq? x alist 'assoc)] [else (do-assoc x alist 'assoc equal?)]))) diff --git a/racket/src/ChezScheme/s/cmacros.ss b/racket/src/ChezScheme/s/cmacros.ss index 716f07a095..23144cdb8c 100644 --- a/racket/src/ChezScheme/s/cmacros.ss +++ b/racket/src/ChezScheme/s/cmacros.ss @@ -2197,6 +2197,11 @@ (define-constant time-collector-cpu 5) (define-constant time-collector-real 6) +(define-syntax fixmediate? + (lambda (stx) + (syntax-case stx () + [(_ e) #'(let ([v e]) (or (fixnum? v) ($immediate? v)))]))) + ;; --------------------------------------------------------------------- ;; vfasl diff --git a/racket/src/ChezScheme/s/cp0.ss b/racket/src/ChezScheme/s/cp0.ss index e27f01a43e..0c6543a010 100644 --- a/racket/src/ChezScheme/s/cp0.ss +++ b/racket/src/ChezScheme/s/cp0.ss @@ -5244,7 +5244,7 @@ [else `(call ,preinfo ,pr ,e1 ,e2 ,e3)]))] [(call ,preinfo ,pr ,e) - (guard (eq? (primref-name pr) '$immediate)) + (guard (eq? (primref-name pr) '$fixmediate)) (context-case ctxt [(ignored) (cp0 e ctxt env sc wd name moi)] [else diff --git a/racket/src/ChezScheme/s/cpnanopass.ss b/racket/src/ChezScheme/s/cpnanopass.ss index 4d6e285b78..27ac09f521 100644 --- a/racket/src/ChezScheme/s/cpnanopass.ss +++ b/racket/src/ChezScheme/s/cpnanopass.ss @@ -3846,7 +3846,7 @@ (lambda (multiple-ref? type e) (nanopass-case (L7 Expr) e [(call ,info ,mdcl ,pr ,e) - (guard (eq? (primref-name pr) '$immediate)) + (guard (eq? (primref-name pr) '$fixmediate)) (let-values ([(t dobind) (binder multiple-ref? type e)]) (values `(call ,info ,mdcl ,pr ,t) dobind))] [else @@ -4124,7 +4124,7 @@ [(base index offset e build-assign build-remember-seq) (nanopass-case (L7 Expr) e [(call ,info ,mdcl ,pr ,e) - (guard (eq? (primref-name pr) '$immediate)) + (guard (eq? (primref-name pr) '$fixmediate)) (build-assign base index offset e)] [else (if (nanopass-case (L7 Expr) e @@ -6098,11 +6098,8 @@ ,(%constant strue) ,(%typed-object-check mask-inexactnum type-inexactnum ,e)))]) (define-inline 2 $immediate? - [(e) (bind #t (e) - `(if ,(%type-check mask-fixnum type-fixnum ,e) - ,(%constant strue) - ,(%type-check mask-immediate type-immediate ,e)))]) - (define-inline 3 $immediate + [(e) (bind #t (e) (%type-check mask-immediate type-immediate ,e))]) + (define-inline 3 $fixmediate [(e) e]) (define-inline 3 $inexactnum-real-part diff --git a/racket/src/ChezScheme/s/cptypes.ss b/racket/src/ChezScheme/s/cptypes.ss index 4f7a01c85a..93112e9563 100644 --- a/racket/src/ChezScheme/s/cptypes.ss +++ b/racket/src/ChezScheme/s/cptypes.ss @@ -698,17 +698,16 @@ Notes: (define (primref->unsafe-primref pr) (lookup-primref 3 (primref-name pr))) - (define (predicate-implies-immediate? x) + (define (predicate-implies-fixmediate? x) (and (not (eq? x 'ptr)) ;fast path to avoid duplicated computation - (or (check-constant-is? x (lambda (x) (and ($immediate? x) - (not (fixnum? x))))) + (or (check-constant-is? x $immediate?) (predicate-implies? x 'fixnum) (predicate-implies? x 'boolean) (predicate-implies? x 'char)))) - (define (non-literal-immediate? e x) + (define (non-literal-fixmediate? e x) (and (not (check-constant-is? e (lambda (e) #t))) - (predicate-implies-immediate? x))) + (predicate-implies-fixmediate? x))) (module () @@ -917,9 +916,9 @@ Notes: (define-specialize 2 set [(args ... val) (values `(call ,preinfo ,pr ,args ... - ,(if (non-literal-immediate? val (get-type val)) + ,(if (non-literal-fixmediate? val (get-type val)) `(call ,(make-preinfo-call) - ,(lookup-primref 3 '$immediate) + ,(lookup-primref 3 '$fixmediate) ,val) val)) ret ntypes #f #f)])])) @@ -1550,8 +1549,8 @@ Notes: types1 new-types)])))])))])] [(set! ,maybe-src ,x ,[e 'value types plxc -> e ret types t-types f-types]) - (values `(set! ,maybe-src ,x ,(if (non-literal-immediate? e ret) - `(call ,(make-preinfo-call) ,(lookup-primref 3 '$immediate) ,e) + (values `(set! ,maybe-src ,x ,(if (non-literal-fixmediate? e ret) + `(call ,(make-preinfo-call) ,(lookup-primref 3 '$fixmediate) ,e) e)) void-rec types #f #f)] [(call ,preinfo ,pr ,e* ...) @@ -1622,9 +1621,9 @@ Notes: (values `(record-set! ,rtd ,type ,index ,e1 ,(cond [(and (eq? type 'scheme-object) - (non-literal-immediate? e2 ret2)) + (non-literal-fixmediate? e2 ret2)) `(call ,(make-preinfo-call) - ,(lookup-primref 3 '$immediate) + ,(lookup-primref 3 '$fixmediate) ,e2)] [else e2])) void-rec diff --git a/racket/src/ChezScheme/s/inspect.ss b/racket/src/ChezScheme/s/inspect.ss index 7f07fb6f2b..17dbfe2883 100644 --- a/racket/src/ChezScheme/s/inspect.ss +++ b/racket/src/ChezScheme/s/inspect.ss @@ -2591,7 +2591,7 @@ (define cookie (cons 'date 'nut)) ; recreate on each call to $compute-size (define compute-size (lambda (x) - (if (or ($immediate? x) + (if (or (fixmediate? x) (let ([g ($generation x)]) (or (not g) (fx> g maxgen)))) 0 @@ -2784,7 +2784,7 @@ rtd-counts phantom) (define compute-composition! (lambda (x) - (unless (or ($immediate? x) + (unless (or (fixmediate? x) (let ([g ($generation x)]) (or (not g) (fx> g maxgen)))) (let ([a (eq-hashtable-cell seen-ht x #f)]) @@ -2945,7 +2945,7 @@ (lambda (x path next-proc) (let ([path (cons x path)]) (cond - [(or ($immediate? x) (let ([g ($generation x)]) (or (not g) (fx> g maxgen)))) + [(or (fixmediate? x) (let ([g ($generation x)]) (or (not g) (fx> g maxgen)))) (if (pred x) (begin (set! saved-next-proc next-proc) path) (next-proc))] diff --git a/racket/src/ChezScheme/s/library.ss b/racket/src/ChezScheme/s/library.ss index 09542d98c7..c1c3dfa412 100644 --- a/racket/src/ChezScheme/s/library.ss +++ b/racket/src/ChezScheme/s/library.ss @@ -1473,7 +1473,7 @@ [else #f]))) (define-library-entry (memv x ls) - (if (or (symbol? x) (#%$immediate? x)) + (if (or (symbol? x) (fixmediate? x)) (memq x ls) (let memv ([ls ls]) (and (not (null? ls)) diff --git a/racket/src/ChezScheme/s/mkgc.ss b/racket/src/ChezScheme/s/mkgc.ss index e65a9bbd84..6a4ef32370 100644 --- a/racket/src/ChezScheme/s/mkgc.ss +++ b/racket/src/ChezScheme/s/mkgc.ss @@ -2058,7 +2058,7 @@ (code "{ /* measure */" (format " ptr r_p = ~a;" e) - " if (!IMMEDIATE(r_p))" + " if (!FIXMEDIATE(r_p))" " push_measure(tgc, r_p);" "}")) diff --git a/racket/src/ChezScheme/s/primdata.ss b/racket/src/ChezScheme/s/primdata.ss index bc9f8889b2..5e3254a7af 100644 --- a/racket/src/ChezScheme/s/primdata.ss +++ b/racket/src/ChezScheme/s/primdata.ss @@ -1964,6 +1964,7 @@ ($filter-conv [flags single-valued]) ($filter-foreign-type [flags single-valued]) ($fixed-path? [sig [(string) -> (boolean)]] [flags pure safeongoodargs]) + ($fixmediate [sig [(ptr) -> (ptr)]] [flags pure discard]) ($flvector-ref-check? [sig [(ptr ptr) -> (boolean)]] [flags unrestricted pure]) ($flvector-set!-check? [sig [(ptr ptr) -> (boolean)]] [flags unrestricted discard]) ($<= [flags single-valued]) @@ -2165,8 +2166,7 @@ ($hashtable-veclen [flags discard]) ($ht-minlen [flags single-valued discard]) ($ht-veclen [flags single-valued discard]) - ($immediate [sig [(ptr) -> (ptr)]] [flags pure discard]) - ($immediate? [sig [(ptr) -> (boolean)]] [flags pure unrestricted]) ; no mifoldable due to fixnum + ($immediate? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable]) ($impoops [flags abort-op]) ($import-library [flags single-valued]) ($inexactnum? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable]) diff --git a/racket/src/ChezScheme/s/prims.ss b/racket/src/ChezScheme/s/prims.ss index baa10ae658..60875b9f86 100644 --- a/racket/src/ChezScheme/s/prims.ss +++ b/racket/src/ChezScheme/s/prims.ss @@ -1412,12 +1412,6 @@ (lambda (b) (#3%immutable-box? b))) -(define-who $immediate - (lambda (x) - (if ($immediate? x) - x - ($oops who "~s is not an immediate value" x)))) - (define pair? (lambda (x) (pair? x))) (define box? (lambda (x) (box? x))) @@ -1593,6 +1587,14 @@ (display-string s)])) (define $immediate? (lambda (x) ($immediate? x))) + +;; Used to communicate fixmediateness from cptypes to cpnanopass: +(define-who $fixmediate + (lambda (x) + (if (fixmediate? x) + x + ($oops who "~s is not a fixnum or immediate value" x)))) + (define $inexactnum? (lambda (x) ($inexactnum? x))) (define $inexactnum-real-part diff --git a/racket/src/ChezScheme/s/print.ss b/racket/src/ChezScheme/s/print.ss index 535b5e1e34..baecb0fc10 100644 --- a/racket/src/ChezScheme/s/print.ss +++ b/racket/src/ChezScheme/s/print.ss @@ -95,7 +95,7 @@ (define hashable? (lambda (x) - (if ($immediate? x) + (if (fixmediate? x) (eq? x black-hole) (and ($object-in-heap? x) @@ -203,7 +203,7 @@ (define cyclic? (lambda (x curlev lstlen) - (if ($immediate? x) + (if (fixmediate? x) (if (eq? x black-hole) (not lev) #f) (and ($object-in-heap? x) (cond @@ -279,7 +279,7 @@ (constant cycle-node-max))]) (cond [(fx= xlev 0) (or (not lev) (fx> lev (constant cycle-node-max)))] - [($immediate? x) (if (eq? x black-hole) (not lev) #f)] + [(fixmediate? x) (if (eq? x black-hole) (not lev) #f)] [else (and ($object-in-heap? x) (cond @@ -322,7 +322,7 @@ (set! $make-graph-env (lambda (who x lev len) - (and (if ($immediate? x) + (and (if (fixmediate? x) (eq? x black-hole) (and ($object-in-heap? x) (or (pair? x) (vector? x) (stencil-vector? x) (box? x) (and ($record? x) (not (eq? x #!base-rtd)))))) @@ -634,7 +634,6 @@ floating point returns with (1 0 -1 ...). (cond [($immediate? x) (type-case x - [(fixnum?) (wrfixnum x r d? p)] [(null?) (display-string "()" p)] [(boolean?) (display-string (if x "#t" "#f") p)] [(char?) (if d? (write-char x p) (wrchar x p))] @@ -644,6 +643,7 @@ floating point returns with (1 0 -1 ...). [(void?) (display-string "#" p)] [(black-hole?) (wrblack-hole x r lev len d? env p)] [else (display-string "#" p)])] + [(fixnum? x) (wrfixnum x r d? p)] [($object-in-heap? x) (type-case x [(symbol?)