From f53af07f681dd908ef7464aa0890395c3617dc2e Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Sat, 5 Jan 2019 03:36:51 +0000 Subject: [PATCH] Tidy up compiler utility return addresses. Use compiled returns for the ones that are likely to return to Scheme like lookups and assignments, and compiled entries for the ones that are likely to return to microcode like interrupts. Architectures on which compiled entries and compiled returns have the same format will see no difference: compiled code passes in an untagged return address either way. On amd64, where compiled entries and compiled returns are different: - For hooks that act like leaf subroutines and never return to microcode, use plain CALL/RET in pairs. - For hooks that are subroutines likely to return to Scheme immediately but might return to microcode in screw cases, use (CALL ,hook) ; Invoke hook with untagged ret addr... (JMP (@PCR ,continuation)) ; ...which jumps to formatted entry. (WORD ...) (BLOCK-OFFSET ,continuation) (QUAD U 0) (LABEL ,continuation) ... ; continuation instructions For the non-screw cases this keeps CALL/RET paired. - For hooks that always defer to microcode, namely to handle interrupts, use (LEA Q (R ,rbx) (@PCR ,continuation)) (JMP ,hook) Here it doesn't really whether the CALL/RET is paired because we're going to wreck the return address branch prediction stack no matter what, but it is convenient to have the entry address rather than the return address in the compiled utility. --- src/compiler/machines/x86-64/lapgen.scm | 42 ++++++++--- src/compiler/machines/x86-64/rules3.scm | 98 ++++++++++++------------- src/compiler/machines/x86-64/rules4.scm | 43 +++++------ src/microcode/cmpauxmd/x86-64.m4 | 21 +++--- src/microcode/cmpint.c | 62 +++++++++------- 5 files changed, 143 insertions(+), 123 deletions(-) diff --git a/src/compiler/machines/x86-64/lapgen.scm b/src/compiler/machines/x86-64/lapgen.scm index 4b007dd4e..911cf09e5 100644 --- a/src/compiler/machines/x86-64/lapgen.scm +++ b/src/compiler/machines/x86-64/lapgen.scm @@ -724,27 +724,47 @@ USA. (LAP (JMP ,entry))) ;; Invoke a hook that will pop an untagged return address off the stack -;; and jump to it with RET, just like a C subroutine. +;; and jump to it with RET, just like a C subroutine. To be used for +;; super-cheap assembly hooks that never fail but are a little too +;; large to copy in every caller. (define-integrable (invoke-hook/subroutine entry) (LAP (CALL ,entry))) -;; Invoke a hook that expects a compiled entry address in rbx and will -;; jump to it with JMP. - -(define (invoke-hook/reentry entry) - (let ((label (generate-label 'HOOK-REENTRY))) - (LAP (LEA Q (R ,rbx) (@PCRO ,label 12)) ;Skip format word and PC offset. - ,@(invoke-hook entry) - (LABEL ,label)))) +;; Invoke a hook that expects a compiled return address on the stack, +;; may examine it, and will eventually pop it and return to it with +;; RET. It is worthwhile to use paired CALL/RET here because in the +;; fast path, non-error case, the hook will just return to Scheme; only +;; in error or complicated cases will it return to C. To be used for +;; compiler utilities that are usually cheap but may have error cases +;; and may call back into C. + +(define-integrable (invoke-hook/call entry label) + (LAP (CALL ,entry) + (JMP (@PCR ,label)))) + +;; Invoke a hook that expects a compiled entry address in rbx (first +;; utility argument) and will later jump to it with JMP. It is not +;; worthwhile to use paired CALL/RET here because the microcode will +;; RET back into C code on the C stack to handle it, which wrecks the +;; return address branch target predictor anyway. To be used for, +;; e.g., interrupts, which are assumed to be always expensive. + +(define-integrable (invoke-hook/reentry entry label) + (LAP (LEA Q (R ,rbx) (@PCR ,label)) + ,@(invoke-hook entry))) (define-integrable (invoke-interface code) (LAP (MOV B (R ,r9) (& ,code)) ,@(invoke-hook entry:compiler-scheme-to-interface))) -(define-integrable (invoke-interface/call code) +(define-integrable (invoke-interface/call code label) + (LAP (MOV B (R ,r9) (& ,code)) + ,@(invoke-hook/call entry:compiler-scheme-to-interface/call label))) + +(define-integrable (invoke-interface/reentry code label) (LAP (MOV B (R ,r9) (& ,code)) - ,@(invoke-hook/reentry entry:compiler-scheme-to-interface/call))) + ,@(invoke-hook/reentry entry:compiler-scheme-to-interface label))) (define-syntax define-entries (sc-macro-transformer diff --git a/src/compiler/machines/x86-64/rules3.scm b/src/compiler/machines/x86-64/rules3.scm index ea9cbc64d..10a4b410d 100644 --- a/src/compiler/machines/x86-64/rules3.scm +++ b/src/compiler/machines/x86-64/rules3.scm @@ -532,17 +532,19 @@ USA. ;;; interrupt handler that saves and restores the dynamic link ;;; register. -(define (interrupt-check interrupt-label checks) +(define (interrupt-check checks invoke) ;; This always does interrupt checks in line. (let ((branch-target (generate-label 'INTERRUPT))) ;; Put the interrupt check branch target after the branch so that ;; it is a forward branch, which Intel and AMD CPUs will predict ;; not taken by default, in the absence of dynamic branch - ;; prediction profile data. + ;; prediction profile data. Also probably worthwhile to keep it + ;; far away so that it doesn't occupy space in the instruction + ;; cache. (add-end-of-block-code! (lambda () (LAP (LABEL ,branch-target) - (JMP (@PCR ,interrupt-label))))) + ,@invoke))) (LAP ,@(if (or (memq 'INTERRUPT checks) (memq 'HEAP checks)) (LAP (CMP Q (R ,regnum:free-pointer) ,reg:compiled-memtop) (JGE (@PCR ,branch-target))) @@ -554,13 +556,8 @@ USA. (define (simple-procedure-header code-word label entry) (let ((checks (get-entry-interrupt-checks))) - (if (null? checks) - (LAP ,@(make-external-label code-word label)) - (let ((gc-label (generate-label))) - (LAP (LABEL ,gc-label) - ,@(invoke-hook/reentry entry) - ,@(make-external-label code-word label) - ,@(interrupt-check gc-label checks)))))) + (LAP ,@(make-external-label code-word label) + ,@(interrupt-check checks (invoke-hook/reentry entry label))))) (define-rule statement (CONTINUATION-ENTRY (? internal-label)) @@ -571,10 +568,6 @@ USA. (define-rule statement (CONTINUATION-HEADER (? internal-label)) #| - ;; Note: This is wrong -- compiler-interrupt-continuation expects a - ;; compiled return address on the stack, but this will yield compiled - ;; entry addresses. If you uncomment this, prepare to deal with the - ;; consequences. (simple-procedure-header (continuation-code-word internal-label) internal-label entry:compiler-interrupt-continuation) @@ -583,18 +576,21 @@ USA. (make-external-label (continuation-code-word internal-label) internal-label)) +;;; XXX This rule has obviously never been exercised, since it was +;;; broken for a decade and nobody noticed. Maybe we should delete it. + (define-rule statement (IC-PROCEDURE-HEADER (? internal-label)) - (get-entry-interrupt-checks) ; force search (let ((procedure (label->object internal-label))) (let ((external-label (rtl-procedure/external-label procedure)) - (gc-label (generate-label))) + (checks (get-entry-interrupt-checks))) (LAP (ENTRY-POINT ,external-label) (EQUATE ,external-label ,internal-label) - (LABEL ,gc-label) - ,@(invoke-interface/call code:compiler-interrupt-ic-procedure) ,@(make-external-label expression-code-word internal-label) - ,@(interrupt-check gc-label))))) + ,@(interrupt-check + checks + (invoke-interface/reentry code:compiler-interrupt-ic-procedure + internal-label)))))) (define-rule statement (OPEN-PROCEDURE-HEADER (? internal-label)) @@ -718,11 +714,10 @@ USA. internal-label entry:compiler-interrupt-procedure))) ((pair? checks) - (let ((gc-label (generate-label 'GC-LABEL))) - (LAP (LABEL ,gc-label) - ,@(invoke-hook entry:compiler-interrupt-closure) - ,@(label+adjustment) - ,@(interrupt-check gc-label checks)))) + (LAP ,@(label+adjustment) + ,@(interrupt-check + checks + (invoke-hook entry:compiler-interrupt-closure)))) (else (label+adjustment))))) @@ -785,41 +780,44 @@ USA. ;;; This is invoked by the top level of the LAP generator. (define (generate/quotation-header environment-label free-ref-label n-sections) - (LAP (MOV Q (R ,rax) ,reg:environment) - (MOV Q (@PCR ,environment-label) (R ,rax)) - (LEA Q (R ,rdx) (@PCR ,*block-label*)) - (LEA Q (R ,rcx) (@PCR ,free-ref-label)) - (MOV Q (R ,r8) (&U ,n-sections)) - #| - ,@(invoke-interface/call code:compiler-link) - |# - ,@(invoke-hook/reentry entry:compiler-link) - ,@(make-external-label (continuation-code-word #f) - (generate-label)))) + (let ((continuation-label (generate-label 'LINKED))) + (LAP (MOV Q (R ,rax) ,reg:environment) + (MOV Q (@PCR ,environment-label) (R ,rax)) + (LEA Q (R ,rdx) (@PCR ,*block-label*)) + (LEA Q (R ,rcx) (@PCR ,free-ref-label)) + (MOV Q (R ,r8) (&U ,n-sections)) + #| + ,@(invoke-interface/call code:compiler-link continuation-label) + |# + ,@(invoke-hook/call entry:compiler-link continuation-label) + ,@(make-external-label (continuation-code-word #f) + continuation-label)))) (define (generate/remote-link code-block-label environment-offset free-ref-offset n-sections) - (LAP (MOV Q (R ,rdx) (@PCR ,code-block-label)) - (AND Q (R ,rdx) (R ,regnum:datum-mask)) - (LEA Q (R ,rcx) (@RO ,rdx ,free-ref-offset)) - (MOV Q (R ,rax) ,reg:environment) - (MOV Q (@RO ,rdx ,environment-offset) (R ,rax)) - (MOV Q (R ,r8) (&U ,n-sections)) - #| - ,@(invoke-interface/call code:compiler-link) - |# - ,@(invoke-hook/reentry entry:compiler-link) - ,@(make-external-label (continuation-code-word #f) - (generate-label)))) + (let ((continuation-label (generate-label 'LINKED))) + (LAP (MOV Q (R ,rdx) (@PCR ,code-block-label)) + (AND Q (R ,rdx) (R ,regnum:datum-mask)) + (LEA Q (R ,rcx) (@RO ,rdx ,free-ref-offset)) + (MOV Q (R ,rax) ,reg:environment) + (MOV Q (@RO ,rdx ,environment-offset) (R ,rax)) + (MOV Q (R ,r8) (&U ,n-sections)) + #| + ,@(invoke-interface/call code:compiler-link continuation-label) + |# + ,@(invoke-hook/call entry:compiler-link continuation-label) + ,@(make-external-label (continuation-code-word #f) + continuation-label)))) (define (generate/remote-links n-blocks vector-label nsects) (if (zero? n-blocks) (LAP) (let ((loop (generate-label)) (bytes (generate-label)) - (end (generate-label))) + (end (generate-label)) + (continuation (generate-label 'LINKED))) (LAP ;; Push counter (PUSH Q (& 0)) @@ -859,9 +857,9 @@ USA. (@ROI ,rdx ,(* 2 address-units-per-object) ,rax ,address-units-per-object)) ;; Invoke linker - ,@(invoke-hook/reentry entry:compiler-link) + ,@(invoke-hook/call entry:compiler-link continuation) ,@(make-external-label (continuation-code-word false) - (generate-label)) + continuation) ;; Increment counter and loop (ADD Q (@R ,rsp) (&U 1)) ,@(receive (temp prefix comparand) diff --git a/src/compiler/machines/x86-64/rules4.scm b/src/compiler/machines/x86-64/rules4.scm index 61a361b47..ad4c4d6bc 100644 --- a/src/compiler/machines/x86-64/rules4.scm +++ b/src/compiler/machines/x86-64/rules4.scm @@ -34,7 +34,6 @@ USA. (define-rule statement (INTERPRETER-CALL:CACHE-REFERENCE (? cont) (? extension) (? safe?)) (QUALIFIER (interpreter-call-argument? extension)) - cont ; ignored (let ((set-extension (interpreter-call-argument->machine-register! extension rdx))) (LAP ,@set-extension @@ -43,18 +42,19 @@ USA. ,@(invoke-interface/call (if safe? code:compiler-safe-reference-trap - code:compiler-reference-trap)) + code:compiler-reference-trap) + cont) |# - ,@(invoke-hook/reentry + ,@(invoke-hook/call (if safe? entry:compiler-safe-reference-trap - entry:compiler-reference-trap))))) + entry:compiler-reference-trap) + cont)))) (define-rule statement (INTERPRETER-CALL:CACHE-ASSIGNMENT (? cont) (? extension) (? value)) (QUALIFIER (and (interpreter-call-argument? extension) (interpreter-call-argument? value))) - cont ; ignored (let* ((set-extension (interpreter-call-argument->machine-register! extension rdx)) (set-value (interpreter-call-argument->machine-register! value rcx))) @@ -62,19 +62,18 @@ USA. ,@set-value ,@(clear-map!) #| - ,@(invoke-interface/call code:compiler-assignment-trap) + ,@(invoke-interface/call code:compiler-assignment-trap cont) |# - ,@(invoke-hook/reentry entry:compiler-assignment-trap)))) + ,@(invoke-hook/call entry:compiler-assignment-trap cont)))) (define-rule statement (INTERPRETER-CALL:CACHE-UNASSIGNED? (? cont) (? extension)) (QUALIFIER (interpreter-call-argument? extension)) - cont ; ignored (let ((set-extension (interpreter-call-argument->machine-register! extension rdx))) (LAP ,@set-extension ,@(clear-map!) - ,@(invoke-interface/call code:compiler-unassigned?-trap)))) + ,@(invoke-interface/call code:compiler-unassigned?-trap cont)))) ;;;; Interpreter Calls @@ -85,51 +84,45 @@ USA. (define-rule statement (INTERPRETER-CALL:ACCESS (? cont) (? environment) (? name)) (QUALIFIER (interpreter-call-argument? environment)) - cont ; ignored - (lookup-call code:compiler-access environment name)) + (lookup-call code:compiler-access environment name cont)) (define-rule statement (INTERPRETER-CALL:LOOKUP (? cont) (? environment) (? name) (? safe?)) (QUALIFIER (interpreter-call-argument? environment)) - cont ; ignored (lookup-call (if safe? code:compiler-safe-lookup code:compiler-lookup) - environment name)) + environment name cont)) (define-rule statement (INTERPRETER-CALL:UNASSIGNED? (? cont) (? environment) (? name)) (QUALIFIER (interpreter-call-argument? environment)) - cont ; ignored - (lookup-call code:compiler-unassigned? environment name)) + (lookup-call code:compiler-unassigned? environment name cont)) (define-rule statement (INTERPRETER-CALL:UNBOUND? (? cont) (? environment) (? name)) (QUALIFIER (interpreter-call-argument? environment)) - cont ; ignored - (lookup-call code:compiler-unbound? environment name)) + (lookup-call code:compiler-unbound? environment name cont)) -(define (lookup-call code environment name) +(define (lookup-call code environment name cont) (let ((set-environment (interpreter-call-argument->machine-register! environment rdx))) (LAP ,@set-environment ,@(clear-map (clear-map!)) ,@(load-constant (INST-EA (R ,rcx)) name) - ,@(invoke-interface/call code)))) + ,@(invoke-interface/call code cont)))) (define-rule statement (INTERPRETER-CALL:DEFINE (? cont) (? environment) (? name) (? value)) (QUALIFIER (and (interpreter-call-argument? environment) (interpreter-call-argument? value))) - cont ; ignored - (assignment-call code:compiler-define environment name value)) + (assignment-call code:compiler-define environment name value cont)) (define-rule statement (INTERPRETER-CALL:SET! (? cont) (? environment) (? name) (? value)) (QUALIFIER (and (interpreter-call-argument? environment) (interpreter-call-argument? value))) - cont ; ignored - (assignment-call code:compiler-set! environment name value)) + (assignment-call code:compiler-set! environment name value cont)) -(define (assignment-call code environment name value) +(define (assignment-call code environment name value cont) (let* ((set-environment (interpreter-call-argument->machine-register! environment rdx)) (set-value (interpreter-call-argument->machine-register! value r8))) @@ -137,4 +130,4 @@ USA. ,@set-value ,@(clear-map!) ,@(load-constant (INST-EA (R ,rcx)) name) - ,@(invoke-interface/call code)))) \ No newline at end of file + ,@(invoke-interface/call code cont)))) \ No newline at end of file diff --git a/src/microcode/cmpauxmd/x86-64.m4 b/src/microcode/cmpauxmd/x86-64.m4 index 2a241d511..8089b3e72 100644 --- a/src/microcode/cmpauxmd/x86-64.m4 +++ b/src/microcode/cmpauxmd/x86-64.m4 @@ -438,13 +438,10 @@ define_debugging_label(trampoline_to_interface) OP(mov,q) TW(REG(rcx),REG(rbx)) # argument in rbx jmp scheme_to_interface -# We used to CALL this to get the return address on the stack, but now -# we use RIP-relative addressing to load directly into %rbx -- which -# doesn't ruin the return address branch target prediction stack -- so -# that this is no longer needed. define_hook_label(scheme_to_interface_call) define_debugging_label(scheme_to_interface_call) - nop + OP(pop,q) REG(rbx) # pop untagged ret addr +define_debugging_label(scheme_to_interface_reentry) # jmp scheme_to_interface # scheme_to_interface passes control from compiled Scheme code to a @@ -571,19 +568,25 @@ define(define_call_indirection, OP(mov,b) TW(IMM(HEX($2)),REG(r9b)) jmp scheme_to_interface_call') -define_call_indirection(interrupt_procedure,1a) -define_call_indirection(interrupt_continuation,1b) +# Expects compiled entry address (with zero offset) in rbx. +define(define_reentry_indirection, +`define_hook_label($1) + OP(mov,b) TW(IMM(HEX($2)),REG(r9b)) + jmp scheme_to_interface') + +define_reentry_indirection(interrupt_procedure,1a) +define_reentry_indirection(interrupt_continuation,1b) define_jump_indirection(interrupt_closure,18) define_jump_indirection(interrupt_continuation_2,3b) +# Expects compiled entry address (with zero offset) in rbx. define_hook_label(interrupt_dlink) OP(mov,q) TW(QOF(REGBLOCK_DLINK(),regs),REG(rdx)) OP(mov,b) TW(IMM(HEX(19)),REG(r9b)) - jmp scheme_to_interface_call + jmp scheme_to_interface_reentry declare_alignment(2) define_jump_indirection(primitive_apply,12) - define_jump_indirection(primitive_lexpr_apply,13) define_jump_indirection(error,15) define_call_indirection(link,17) diff --git a/src/microcode/cmpint.c b/src/microcode/cmpint.c index 3e5ef1995..db75a9491 100644 --- a/src/microcode/cmpint.c +++ b/src/microcode/cmpint.c @@ -851,7 +851,7 @@ DEFINE_SCHEME_UTILITY_4 (comutil_link, if (result != PRIM_DONE) RETURN_TO_C (result); } - RETURN_TO_SCHEME_ENTRY (s.return_address); + RETURN_TO_SCHEME_CONTINUATION (s.return_address); } /* comp_link_caches_restart is used to continue the linking process @@ -875,7 +875,7 @@ DEFINE_SCHEME_ENTRY (comp_link_caches_restart) if (result != PRIM_DONE) return (result); - ENTER_SCHEME_ENTRY (s.return_address); + ENTER_SCHEME_CONTINUATION (s.return_address); } static long @@ -921,7 +921,7 @@ update_cache_after_link (link_cc_state_t * s) { #if defined(FLUSH_I_CACHE_REGION) || defined(PUSH_D_CACHE_REGION) SCHEME_OBJECT * addr = (s->block_address); - if ((cc_entry_address_to_block_address (s->return_address)) == addr) + if ((cc_return_address_to_block_address (s->return_address)) == addr) #ifdef FLUSH_I_CACHE_REGION FLUSH_I_CACHE_REGION (addr, (CC_BLOCK_ADDR_LENGTH (addr))); #else @@ -1047,7 +1047,7 @@ static void back_out_of_link_section (link_cc_state_t * s) { /* Save enough state to restart. */ - STACK_PUSH (MAKE_CC_ENTRY (s->return_address)); + STACK_PUSH (MAKE_CC_RETURN (s->return_address)); STACK_PUSH (ULONG_TO_FIXNUM ((s->n_sections) - (s->n_linked_sections))); STACK_PUSH (ULONG_TO_FIXNUM ((s->scan0) - (s->block_address))); STACK_PUSH (ULONG_TO_FIXNUM ((s->scan) - (s->block_address))); @@ -1067,7 +1067,7 @@ restore_link_cc_state (link_cc_state_t * s) (s->scan) = ((s->block_address) + (OBJECT_DATUM (STACK_POP ()))); (s->scan0) = ((s->block_address) + (OBJECT_DATUM (STACK_POP ()))); (s->n_sections) = (OBJECT_DATUM (STACK_POP ())); - (s->return_address) = (CC_ENTRY_ADDRESS (STACK_POP ())); + (s->return_address) = (CC_RETURN_ADDRESS (STACK_POP ())); (s->n_linked_sections) = 0; (s->type) = (linkage_section_type (* (s->scan0))); @@ -1172,6 +1172,8 @@ section_execute_p (SCHEME_OBJECT h) continuation is a piece of state that will be returned to GET_VAL and GET_ENV (both) upon return. */ +/* Stack has invocation frame with tagged closure on top. */ + DEFINE_SCHEME_UTILITY_0 (comutil_interrupt_closure) { compiler_interrupt_common (DSU_result, 0, SHARP_F); @@ -1194,10 +1196,10 @@ DEFINE_SCHEME_UTILITY_1 (comutil_interrupt_procedure, entry_point) /* GET_VAL has live data, and there is no entry address on the stack */ -DEFINE_SCHEME_UTILITY_1 (comutil_interrupt_continuation, return_addr) +DEFINE_SCHEME_UTILITY_1 (comutil_interrupt_continuation, entry_point) { - DECLARE_UTILITY_ARG (insn_t *, return_addr); - compiler_interrupt_common (DSU_result, return_addr, GET_VAL); + DECLARE_UTILITY_ARG (insn_t *, entry_point); + compiler_interrupt_common (DSU_result, entry_point, GET_VAL); } /* GET_ENV has live data; no entry point on the stack */ @@ -1208,6 +1210,8 @@ DEFINE_SCHEME_UTILITY_1 (comutil_interrupt_ic_procedure, entry_point) compiler_interrupt_common (DSU_result, entry_point, GET_ENV); } +/* GET_VAL has live data, and the tagged continuation is on top of stack. */ + DEFINE_SCHEME_UTILITY_0 (comutil_interrupt_continuation_2) { compiler_interrupt_return_to_entry (); @@ -1216,7 +1220,9 @@ DEFINE_SCHEME_UTILITY_0 (comutil_interrupt_continuation_2) /* Convert the compiled return address on the stack to a compiled entry. This is easier than adding a different interpreter return - code, &c. */ + code, or creating a stub compiled entry that just does pop-return. + It's OK if we ruin return address branch target prediction: + servicing interrupts is expensive anyway. */ static void compiler_interrupt_return_to_entry (void) @@ -1231,14 +1237,14 @@ compiler_interrupt_return_to_entry (void) void compiler_interrupt_common (utility_result_t * DSU_result, - insn_t * address, + insn_t * entry_address, SCHEME_OBJECT state) { if (!FREE_OK_P (Free)) REQUEST_GC (Free - heap_alloc_limit); STACK_CHECK (0); - if (address != 0) - STACK_PUSH (MAKE_CC_ENTRY (address)); + if (entry_address != 0) + STACK_PUSH (MAKE_CC_ENTRY (entry_address)); assert (CC_ENTRY_P (STACK_REF (0))); STACK_PUSH (state); SAVE_LAST_RETURN_CODE (RC_COMP_INTERRUPT_RESTART); @@ -1271,8 +1277,8 @@ DEFINE_SCHEME_UTILITY_3 (comutil_assignment_trap, long code = (compiler_assignment_trap (cache, new_val, (&old_val))); if (code != PRIM_DONE) { - SCHEME_OBJECT sra = (MAKE_CC_ENTRY (ret_addr)); - SCHEME_OBJECT block = (cc_entry_to_block (sra)); + SCHEME_OBJECT sra = (MAKE_CC_RETURN (ret_addr)); + SCHEME_OBJECT block = (cc_return_to_block (sra)); STACK_PUSH (sra); STACK_PUSH (new_val); STACK_PUSH (cc_block_environment (block)); @@ -1282,7 +1288,7 @@ DEFINE_SCHEME_UTILITY_3 (comutil_assignment_trap, RETURN_TO_C (code); } SET_VAL (old_val); - RETURN_TO_SCHEME_ENTRY (ret_addr); + RETURN_TO_SCHEME_CONTINUATION (ret_addr); } DEFINE_SCHEME_ENTRY (comp_assignment_trap_restart) @@ -1303,7 +1309,7 @@ DEFINE_SCHEME_ENTRY (comp_assignment_trap_restart) return (code); } SET_VAL (old_val); - JUMP_TO_CC_ENTRY (STACK_POP ()); + JUMP_TO_CC_RETURN (STACK_POP ()); } } @@ -1372,8 +1378,8 @@ DEFINE_SCHEME_UTILITY_2 (comutil_lookup_trap, ret_addr, cache_addr) long code = (compiler_lookup_trap (cache, (&val))); if (code != PRIM_DONE) { - SCHEME_OBJECT sra = (MAKE_CC_ENTRY (ret_addr)); - SCHEME_OBJECT block = (cc_entry_to_block (sra)); + SCHEME_OBJECT sra = (MAKE_CC_RETURN (ret_addr)); + SCHEME_OBJECT block = (cc_return_to_block (sra)); STACK_PUSH (sra); STACK_PUSH (cc_block_environment (block)); STACK_PUSH (compiler_var_error (cache, block, CACHE_REFERENCES_LOOKUP)); @@ -1381,7 +1387,7 @@ DEFINE_SCHEME_UTILITY_2 (comutil_lookup_trap, ret_addr, cache_addr) RETURN_TO_C (code); } SET_VAL (val); - RETURN_TO_SCHEME_ENTRY (ret_addr); + RETURN_TO_SCHEME_CONTINUATION (ret_addr); } DEFINE_SCHEME_ENTRY (comp_lookup_trap_restart) @@ -1400,7 +1406,7 @@ DEFINE_SCHEME_ENTRY (comp_lookup_trap_restart) return (code); } SET_VAL (val); - JUMP_TO_CC_ENTRY (STACK_POP ()); + JUMP_TO_CC_RETURN (STACK_POP ()); } } @@ -1413,8 +1419,8 @@ DEFINE_SCHEME_UTILITY_2 (comutil_safe_lookup_trap, ret_addr, cache_addr) long code = (compiler_safe_lookup_trap (cache, (&val))); if (code != PRIM_DONE) { - SCHEME_OBJECT sra = (MAKE_CC_ENTRY (ret_addr)); - SCHEME_OBJECT block = (cc_entry_to_block (sra)); + SCHEME_OBJECT sra = (MAKE_CC_RETURN (ret_addr)); + SCHEME_OBJECT block = (cc_return_to_block (sra)); STACK_PUSH (sra); STACK_PUSH (cc_block_environment (block)); STACK_PUSH (compiler_var_error (cache, block, CACHE_REFERENCES_LOOKUP)); @@ -1422,7 +1428,7 @@ DEFINE_SCHEME_UTILITY_2 (comutil_safe_lookup_trap, ret_addr, cache_addr) RETURN_TO_C (code); } SET_VAL (val); - RETURN_TO_SCHEME_ENTRY (ret_addr); + RETURN_TO_SCHEME_CONTINUATION (ret_addr); } DEFINE_SCHEME_ENTRY (comp_safe_lookup_trap_restart) @@ -1441,7 +1447,7 @@ DEFINE_SCHEME_ENTRY (comp_safe_lookup_trap_restart) return (code); } SET_VAL (val); - JUMP_TO_CC_ENTRY (STACK_POP ()); + JUMP_TO_CC_RETURN (STACK_POP ()); } } @@ -1454,8 +1460,8 @@ DEFINE_SCHEME_UTILITY_2 (comutil_unassigned_p_trap, ret_addr, cache_addr) long code = (compiler_unassigned_p_trap (cache, (&val))); if (code != PRIM_DONE) { - SCHEME_OBJECT sra = (MAKE_CC_ENTRY (ret_addr)); - SCHEME_OBJECT block = (cc_entry_to_block (sra)); + SCHEME_OBJECT sra = (MAKE_CC_RETURN (ret_addr)); + SCHEME_OBJECT block = (cc_return_to_block (sra)); STACK_PUSH (sra); STACK_PUSH (cc_block_environment (block)); STACK_PUSH (compiler_var_error (cache, block, CACHE_REFERENCES_LOOKUP)); @@ -1463,7 +1469,7 @@ DEFINE_SCHEME_UTILITY_2 (comutil_unassigned_p_trap, ret_addr, cache_addr) RETURN_TO_C (code); } SET_VAL (val); - RETURN_TO_SCHEME_ENTRY (ret_addr); + RETURN_TO_SCHEME_CONTINUATION (ret_addr); } DEFINE_SCHEME_ENTRY (comp_unassigned_p_trap_restart) @@ -1482,7 +1488,7 @@ DEFINE_SCHEME_ENTRY (comp_unassigned_p_trap_restart) return (code); } SET_VAL (val); - JUMP_TO_CC_ENTRY (STACK_POP ()); + JUMP_TO_CC_RETURN (STACK_POP ()); } } -- 2.25.1