From: Taylor R Campbell <campbell@mumble.net>
Date: Sun, 6 Jan 2019 03:59:31 +0000 (+0000)
Subject: Use a different reflect code number for compiled invocations.
X-Git-Tag: mit-scheme-pucked-10.1.20~11^2~80^2~4
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6f458ab1eb3c96f5fead81cf844e8074a2921b33;p=mit-scheme.git

Use a different reflect code number for compiled invocations.

Teach the continuation parser about it.

Turns out this doesn't actually coincide with the format the v8
microcode used for APPLY-COMPILED, which also has a frame size,
presumably so arity dispatch could be done in the callee.

(Not that the v8 stuff matters these days; maybe we should just flush
those parts of conpar.scm.)
---

diff --git a/src/compiler/machines/x86-64/rules3.scm b/src/compiler/machines/x86-64/rules3.scm
index 8bd085953..09311c7f3 100644
--- a/src/compiler/machines/x86-64/rules3.scm
+++ b/src/compiler/machines/x86-64/rules3.scm
@@ -227,7 +227,7 @@ USA.
 (define-integrable reflect-code:restore-interrupt-mask 1)
 (define-integrable reflect-code:stack-marker 2)
 (define-integrable reflect-code:compiled-code-bkpt 3)
-(define-integrable reflect-code:apply-compiled 6)
+(define-integrable reflect-code:compiled-invocation 8)
 
 (define-rule statement
   (INVOCATION:PRIMITIVE (? frame-size) (? continuation) (? primitive))
diff --git a/src/microcode/cmpint.c b/src/microcode/cmpint.c
index db75a9491..b8181497e 100644
--- a/src/microcode/cmpint.c
+++ b/src/microcode/cmpint.c
@@ -78,8 +78,9 @@ typedef enum
   REFLECT_CODE_CC_BKPT,
   REFLECT_CODE_UNUSED_4,	/* Formerly used for v8 microcode.  */
   REFLECT_CODE_UNUSED_5,
-  REFLECT_CODE_APPLY_COMPILED,
+  REFLECT_CODE_UNUSED_6,
   REFLECT_CODE_UNUSED_7,
+  REFLECT_CODE_COMPILED_INVOCATION,
 } reflect_code_t;
 
 #define PUSH_REFLECTION(code) do					\
@@ -1620,7 +1621,7 @@ setup_compiled_invocation_from_primitive (SCHEME_OBJECT procedure,
       PRIMITIVE_ABORT (code);
     }
   STACK_PUSH (procedure);
-  PUSH_REFLECTION (REFLECT_CODE_APPLY_COMPILED);
+  PUSH_REFLECTION (REFLECT_CODE_COMPILED_INVOCATION);
 }
 
 /* Adjust the stack frame for applying a compiled procedure.  Returns
@@ -2198,7 +2199,7 @@ DEFINE_TRAMPOLINE (comutil_reflect_to_interface)
 
   switch (OBJECT_DATUM (code))
     {
-    case REFLECT_CODE_APPLY_COMPILED:
+    case REFLECT_CODE_COMPILED_INVOCATION:
       {
 	SCHEME_OBJECT procedure = (STACK_POP ());
 	RETURN_TO_SCHEME_ENTRY (CC_ENTRY_ADDRESS (procedure));
diff --git a/src/runtime/conpar.scm b/src/runtime/conpar.scm
index 83d3525e3..aa9dc6613 100644
--- a/src/runtime/conpar.scm
+++ b/src/runtime/conpar.scm
@@ -360,6 +360,7 @@ USA.
 (define-integrable code/restore-regs 5)
 (define-integrable code/apply-compiled 6)
 (define-integrable code/continue-linking 7)
+(define-integrable code/special-compiled/compiled-invocation 8)
 
 (define (parser/special-compiled type elements state)
   (let ((code (vector-ref elements 1)))
@@ -376,7 +377,8 @@ USA.
 	       (fix:= code code/interrupt-restart)
 	       (fix:= code code/restore-regs)
 	       (fix:= code code/apply-compiled)
-	       (fix:= code code/continue-linking))
+	       (fix:= code code/continue-linking)
+	       (fix:= code code/special-compiled/compiled-invocation))
 	   (parse/standard-next type elements state #f #f))
 	  (else
 	   (error "Unknown special compiled frame code:" code)))))
@@ -647,6 +649,13 @@ USA.
 	   ;; block, environment, offset, last header offset,sections,
 	   ;; return address
 	   (fix:- 10 1))
+	  ((fix:= code code/special-compiled/compiled-invocation)
+	   ;; Stream[2] is compiled entry, followed by arguments.
+	   (let ((procedure (stream-ref stream 2)))
+	     (cond ((compiled-code-address/frame-size procedure)
+		    => (lambda (frame-size)
+			 (+ 2 frame-size)))
+		   (else (lose)))))
 	  (else
 	   (lose)))))