diff --git a/collects/scheme/private/modbeg.ss b/collects/scheme/private/modbeg.ss index ab8e2c209c..108831d6d0 100644 --- a/collects/scheme/private/modbeg.ss +++ b/collects/scheme/private/modbeg.ss @@ -23,13 +23,22 @@ "bad syntax" stx) (void)) - (datum->syntax - stx - (list (quote-syntax #%module-begin) - (cons (quote-syntax printing-module-begin) - (cdr (syntax-e stx)))) - stx - stx))) + (let-values ([(l) (syntax->list stx)]) + (if l + (void) + (raise-syntax-error + #f + "bad syntax (illegal use of `.')" + stx)) + (datum->syntax + stx + (cons (quote-syntax #%module-begin) + (map (lambda (e) + (list (quote-syntax printing-module-begin) + e)) + (cdr l))) + stx + stx)))) (define-syntaxes (printing-module-begin) (lambda (stx) @@ -65,15 +74,18 @@ #f) #f)) ;; splice `begin' - (datum->syntax - stx - (cons (quote-syntax printing-module-begin) - (append (let-values ([(l) (syntax->list e)]) - (map (lambda (elem) - (syntax-track-origin elem e (car l))) - (cdr l))) - (cdr r))) - stx) + (let-values ([(l) (syntax->list e)]) + (datum->syntax + stx + (cons (car l) + (append + (map (lambda (elem) + (list + (quote-syntax printing-module-begin) + (syntax-track-origin elem e (car l)))) + (cdr l)) + (cdr r))) + stx)) ;; no need to splice (let-values ([(wrap?) (let-values ([(e) (syntax-e e)]) diff --git a/src/mzscheme/src/jit.c b/src/mzscheme/src/jit.c index 1f5811b350..949a3dd09f 100644 --- a/src/mzscheme/src/jit.c +++ b/src/mzscheme/src/jit.c @@ -1638,6 +1638,10 @@ static int generate_tail_call(mz_jit_state *jitter, int num_rands, int direct_na mz_get_local_p(JIT_R1, JIT_LOCAL2); } jit_movr_p(JIT_R2, JIT_RUNSTACK); + if (need_set_rs) { + /* In case arity check fails, need to update runstack now: */ + JIT_UPDATE_THREAD_RSPTR(); + } /* Now jump: */ jit_jmpr(JIT_V1); CHECK_LIMIT(); @@ -1885,6 +1889,10 @@ static int generate_non_tail_call(mz_jit_state *jitter, int num_rands, int direc jit_ldxi_p(JIT_V1, JIT_V1, &((Scheme_Native_Closure_Data *)0x0)->u.tail_code); } else { jit_ldxi_p(JIT_V1, JIT_V1, &((Scheme_Native_Closure_Data *)0x0)->arity_code); + if (need_set_rs) { + /* In case arity check fails, need to update runstack now: */ + JIT_UPDATE_THREAD_RSPTR(); + } } jit_jmpr(JIT_V1); /* callee restores (copied) V registers, etc. */ jit_patch_movi(refr, (_jit.x.pc)); diff --git a/src/mzscheme/src/stxobj.c b/src/mzscheme/src/stxobj.c index 93d2f46019..4bd16a0ccb 100644 --- a/src/mzscheme/src/stxobj.c +++ b/src/mzscheme/src/stxobj.c @@ -2300,7 +2300,7 @@ static Scheme_Object *add_certs(Scheme_Object *o, Scheme_Cert *certs, Scheme_Obj Scheme_Cert *orig_certs, *cl, *now_certs, *next_certs; Scheme_Stx *stx = (Scheme_Stx *)o, *res; Scheme_Object *pr; - int copy_on_write; + int copy_on_write, shortcut; if (!stx->certs) { if (!certs) @@ -2337,6 +2337,25 @@ static Scheme_Object *add_certs(Scheme_Object *o, Scheme_Cert *certs, Scheme_Obj orig_certs = INACTIVE_CERTS(stx); now_certs = orig_certs; + shortcut = 0; + if (now_certs && certs && !use_key && CERT_NO_KEY(certs)) { + if (now_certs->depth < certs->depth) { + /* Maybe we can add now_certs onto certs, instead of the other + way around. */ + for (next_certs = certs; next_certs; next_certs = next_certs->next) { + if (cert_in_chain(next_certs->mark, use_key, now_certs)) { + break; + } + } + if (!next_certs) { + /* Yes, we can take that shortcut. */ + certs = append_certs(now_certs, certs); + now_certs = NULL; + shortcut = 1; + } + } + } + for (; certs; certs = next_certs) { next_certs = certs->next; if (!cert_in_chain(certs->mark, use_key, now_certs)) { @@ -2357,7 +2376,7 @@ static Scheme_Object *add_certs(Scheme_Object *o, Scheme_Cert *certs, Scheme_Obj stx = res; copy_on_write = 0; } - if (!now_certs && !use_key && CERT_NO_KEY(certs)) { + if (!now_certs && !use_key && (shortcut || CERT_NO_KEY(certs))) { cl = certs; next_certs = NULL; } else {