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 8bd08595370b00f5aa25654e4ebb95866d806637..09311c7f310c66129005253e4820ed6bf7bb7f3f 100644 (file)
--- 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 db75a9491b32cab8e6bcd07442b711415d13352f..b8181497e607643ded41ed8e515b58a158c3aeaa 100644 (file)
--- 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);
 }
 \f
 /* 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 83d3525e35f2a872641c017eb901b1ae4bfe4cd4..aa9dc66134d661e41218c1b0ac4d8a1f4c06db2c 100644 (file)
--- 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)))))
 \f