VM has "builtins": primitives addressable by emitted RTL code

* libguile/Makefile.am:
* libguile/vm-builtins.h: New header, declaring stubs needed by the
  compiler like values, apply, and abort-to-prompt.

* libguile/vm.c: Adapt the apply and values stubs to conform to a
  standard interface.  Add an abort-to-prompt stub.  Add call/cc and
  call-with-values stubs.
  (scm_vm_builtin_ref): New helper, for the builtin-ref opcode.
  (scm_vm_builtin_name_to_index)
  (scm_vm_builtin_index_to_name): New helpers, for the compiler and
  disassembler, respectively.
  (scm_init_vm_builtins, scm_bootstrap_vm): Allow the compiler helpers
  to be loaded later into a module.
* module/language/rtl.scm: Export builtin-index->name and
  builtin-name->index.

* libguile/vm-engine.c (RETURN_VALUE_LIST): Update to use new names of
  "apply" and "values".
  (tail-call/shuffle): New opcode.
  (abort): Update to be a tail VM op, and reorder and renumber other
  ops.
  (builtin-ref): New opcode.

* libguile/continuations.h:
* libguile/continuations.c (scm_i_call_with_current_continuation):
  Move this to vm.[ch], implemented as a builtin.

* module/language/tree-il/compile-cps.scm (convert): Convert to
  'abort-to-prompt calls, possibly with 'apply, effectively undoing the
  tree-il transformation.

* module/language/cps/reify-primitives.scm (builtin-ref): New helper.
  (reify-primitives): Convert builtin primitives to builtin-ref.

* module/language/cps/dfg.scm (constant-needs-allocation?):
* module/language/cps/compile-rtl.scm (emit-rtl-sequence): Add support
  for compiling builtin-ref.

* module/system/vm/disassembler.scm (code-annotation): Add annotation
  for builtin-ref.

module/language/cps/compile-rtl.scm

@@ -211,6 +211,8 @@
                   (emit-constant-vector-ref asm dst (slot vector) index)))
             (else
              (emit-vector-ref asm dst (slot vector) (slot index)))))
+          (($ $primcall 'builtin-ref (name))
+           (emit-builtin-ref asm dst (constant name)))
           (($ $primcall name args)
            ;; FIXME: Inline all the cases.
            (let ((inst (prim-rtl-instruction name)))

module/language/cps/dfg.scm

@@ -810,6 +810,8 @@
               (not (and (eq? sym i) (immediate-u8? val))))
              (($ $primcall 'vector-set! (v i x))
               (not (and (eq? sym i) (immediate-u8? val))))
+             (($ $primcall 'builtin-ref (idx))
+              #f)
              (_ #t)))
          uses))))))
 

module/language/cps/reify-primitives.scm

@@ -50,6 +50,13 @@
                 (build-cps-term
                   ($continue k ($primcall 'box-ref (box)))))))
 
+(define (builtin-ref idx k)
+  (let-gensyms (idx-sym)
+    (build-cps-term
+      ($letconst (('idx idx-sym idx))
+        ($continue k
+          ($primcall 'builtin-ref (idx-sym)))))))
+
 (define (reify-clause ktail)
   (let-gensyms (kclause kbody wna false str eol kthrow throw)
     (build-cps-cont
@@ -97,7 +104,12 @@
          ,(match exp
             (($ $prim name)
              (match (lookup-cont k conts)
-               (($ $kargs (_)) (primitive-ref name k))
+               (($ $kargs (_))
+                (cond
+                 ((builtin-name->index name)
+                  => (lambda (idx)
+                       (builtin-ref idx k)))
+                 (else (primitive-ref name k))))
                (_ (build-cps-term ($continue k ($void))))))
             (($ $fun)
              (build-cps-term ($continue k ,(visit-fun exp))))
@@ -114,7 +126,11 @@
                  (build-cps-term
                    ($letk ((k* #f ($kargs (v) (v)
                                     ($continue k ($call v args)))))
-                     ,(primitive-ref name k*)))))))
+                     ,(cond
+                       ((builtin-name->index name)
+                        => (lambda (idx)
+                             (builtin-ref idx k*)))
+                       (else (primitive-ref name k*)))))))))
             (_ term)))))
 
     (visit-fun fun)))

module/language/rtl.scm

@@ -23,7 +23,12 @@
   #:use-module ((srfi srfi-1) #:select (fold))
   #:use-module (system vm instruction)
   #:re-export (rtl-instruction-list)
-  #:export (rtl-instruction-arity))
+  #:export (rtl-instruction-arity
+            builtin-name->index
+            builtin-index->name))
+
+(load-extension (string-append "libguile-" (effective-version))
+                "scm_init_vm_builtins")
 
 (define (compute-rtl-instruction-arity name args)
   (define (first-word-arity word)

module/language/tree-il/compile-cps.scm

@@ -433,10 +433,20 @@
         k
         subst)))
 
-    (($ <abort> src tag args tail)
-     (convert-args (append (list tag) args (list tail))
+    (($ <abort> src tag args ($ <const> _ ()))
+     (convert-args (cons tag args)
        (lambda (args*)
-         (build-cps-term ($continue k ($primcall 'abort args*))))))
+         (build-cps-term
+           ($continue k ($primcall 'abort-to-prompt args*))))))
+
+    (($ <abort> src tag args tail)
+     (convert-args (append (list (make-primitive-ref #f 'abort-to-prompt)
+                                 tag)
+                           args
+                           (list tail))
+       (lambda (args*)
+         (build-cps-term
+           ($continue k ($primcall 'apply args*))))))
 
     (($ <conditional> src test consequent alternate)
      (let-gensyms (kif kt kf)