Allow $kargs as entry of $kfun

* module/language/cps.scm:
* module/language/cps/contification.scm:
* module/language/cps/cse.scm:
* module/language/cps/dce.scm:
* module/language/cps/simplify.scm:
* module/language/cps/slot-allocation.scm:
* module/language/cps/types.scm: Allow $kargs to follow $kfun.  In that
case, the function must be well-known and callers are responsible for
calling with the appropriate arity.
* module/language/cps/compile-bytecode.scm: Emit "unchecked-arity" for
$kargs following $kfun.
* module/system/vm/assembler.scm: Adapt.

1 files changed, 15 insertions, 0 deletions

diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 8139263a8..c94cec3af 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -1640,11 +1640,26 @@ returned instead."
      (else
       (emit-standard-prelude asm nreq nlocals alternate)))))
 
+(define-macro-assembler (begin-unchecked-arity asm has-closure? req nlocals)
+  (assert-match req ((? symbol?) ...) "list of symbols")
+  (assert-match nlocals (? integer?) "integer")
+  (let* ((meta (car (asm-meta asm)))
+         (arity (make-arity req '() #f '() #f has-closure?
+                            (meta-low-pc meta) #f '()))
+         (nclosure (if has-closure? 1 0))
+         (nreq (+ nclosure (length req))))
+    (set-meta-arities! meta (cons arity (meta-arities meta)))
+    (emit-unchecked-prelude asm nreq nlocals)))
+
 (define-macro-assembler (end-arity asm)
   (let ((arity (car (meta-arities (car (asm-meta asm))))))
     (set-arity-definitions! arity (reverse (arity-definitions arity)))
     (set-arity-high-pc! arity (asm-start asm))))
 
+(define-macro-assembler (unchecked-prelude asm nreq nlocals)
+  (unless (= nlocals nreq)
+    (emit-alloc-frame asm nlocals)))
+
 (define-macro-assembler (standard-prelude asm nreq nlocals alternate)
   (cond
    (alternate