steps on the way to have the callee check the number of arguments

* libguile/_scm.h (SCM_OBJCODE_MINOR_VERSION): Bump.

* libguile/vm-i-system.c (assert-nargs-ee, assert-nargs-ge)
  (push-rest-list): New instructions, which for now don't actually do
  anything. Renumber the rest of the ops in this file.

* module/language/glil.scm (<glil-arity>): New GLIL type, an entity that
  checks the number of args for a block, optionally consing a rest list,
  and either branching or erroring if the arity doesn't match.

* module/language/glil/compile-assembly.scm (glil->assembly): Compile
  <glil-arity> to assembly. Some of these VM ops are not implemented --
  notably the branching case.

* module/language/tree-il/compile-glil.scm (flatten-lambda): Emit
  <glil-arity>.

* test-suite/tests/tree-il.test: Update.

module/language/glil.scm

@@ -27,6 +27,9 @@
    glil-program-nargs glil-program-nrest glil-program-nlocs
    glil-program-meta glil-program-body
    
+   <glil-arity> make-glil-arity glil-arity?
+   glil-arity-nargs glil-arity-nrest glil-arity-label
+
    <glil-bind> make-glil-bind glil-bind?
    glil-bind-vars
 
@@ -72,6 +75,7 @@
 (define-type (<glil> #:printer print-glil)
   ;; Meta operations
   (<glil-program> nargs nrest nlocs meta body)
+  (<glil-arity> nargs nrest label)
   (<glil-bind> vars)
   (<glil-mv-bind> vars rest)
   (<glil-unbind>)
@@ -95,6 +99,7 @@
   (pmatch x
     ((program ,nargs ,nrest ,nlocs ,meta . ,body)
      (make-glil-program nargs nrest nlocs meta (map parse-glil body)))
+    ((arity ,nargs ,nrest ,label) (make-glil-arity nargs nrest label))
     ((bind . ,vars) (make-glil-bind vars))
     ((mv-bind ,vars ,rest) (make-glil-mv-bind vars rest))
     ((unbind) (make-glil-unbind))
@@ -116,6 +121,7 @@
     ;; meta
     ((<glil-program> nargs nrest nlocs meta body)
      `(program ,nargs ,nrest ,nlocs ,meta ,@(map unparse-glil body)))
+    ((<glil-arity> nargs nrest label) `(arity ,nargs ,nrest ,label))
     ((<glil-bind> vars) `(bind ,@vars))
     ((<glil-mv-bind> vars rest) `(mv-bind ,vars ,rest))
     ((<glil-unbind>) `(unbind))

module/language/glil/compile-assembly.scm

@@ -356,6 +356,26 @@
     ((<glil-branch> inst label)
      (emit-code `((,inst ,label))))
 
+    ((<glil-arity> nargs nrest label)
+     (emit-code (if label
+                    (if (zero? nrest)
+                        `((br-if-nargs-ne ,(quotient nargs 256) ,label))
+                        `(,@(if (> nargs 1)
+                                `((br-if-nargs-lt ,(quotient (1- nargs) 256)
+                                                  ,(modulo (1- nargs 256))
+                                                  ,label))
+                                '())
+                          (push-rest-list ,(quotient (1- nargs) 256))))
+                    (if (zero? nrest)
+                        `((assert-nargs-ee ,(quotient nargs 256)
+                                           ,(modulo nargs 256)))
+                        `(,@(if (> nargs 1)
+                                `((assert-nargs-ge ,(quotient (1- nargs) 256)
+                                                   ,(modulo (1- nargs) 256)))
+                                '())
+                          (push-rest-list ,(quotient (1- nargs) 256)
+                                          ,(modulo (1- nargs) 256)))))))
+    
     ;; nargs is number of stack args to insn. probably should rename.
     ((<glil-call> inst nargs)
      (if (not (instruction? inst))

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

@@ -189,21 +189,24 @@
        nargs nrest nlocs (lambda-meta x)
        (with-output-to-code
         (lambda (emit-code)
-          ;; emit label for self tail calls
-          (if self-label
-              (emit-code #f (make-glil-label self-label)))
-          ;; write bindings and source debugging info
-          (if (not (null? ids))
-              (emit-bindings #f ids vars allocation x emit-code))
+          ;; write source info for proc
           (if (lambda-src x)
               (emit-code #f (make-glil-source (lambda-src x))))
+          ;; check arity, potentially consing a rest list
+          (emit-code #f (make-glil-arity nargs nrest #f))
+          ;; write bindings info
+          (if (not (null? ids))
+              (emit-bindings #f ids vars allocation x emit-code))
+          ;; emit post-prelude label for self tail calls
+          (if self-label
+              (emit-code #f (make-glil-label self-label)))
           ;; box args if necessary
           (for-each
            (lambda (v)
              (pmatch (hashq-ref (hashq-ref allocation v) x)
-                     ((#t #t . ,n)
-                      (emit-code #f (make-glil-lexical #t #f 'ref n))
-                      (emit-code #f (make-glil-lexical #t #t 'box n)))))
+               ((#t #t . ,n)
+                (emit-code #f (make-glil-lexical #t #f 'ref n))
+                (emit-code #f (make-glil-lexical #t #t 'box n)))))
            vars)
           ;; and here, here, dear reader: we compile.
           (flatten (lambda-body x) allocation x self-label