add long-object-ref, long-toplevel-ref, long-toplevel-set

* libguile/vm-i-system.c (long-object-ref, long-toplevel-ref)
  (long-toplevel-set): Add new instructions, for accessing the object
  table with a 16-bit offset. HTMLprag defines a test program that has
  more than 256 constants, necessitating this addition.

* doc/ref/vm.texi: Mention the new instructions.

* module/language/glil/compile-assembly.scm: Emit long refs for object
  tables bigger than 256 entries.

doc/ref/vm.texi

@@ -417,6 +417,7 @@ external variables are all consed onto a list, which results in O(N)
 lookup time.
 
 @deffn Instruction toplevel-ref index
+@deffnx Instruction long-toplevel-ref index
 Push the value of the toplevel binding whose location is stored in at
 position @var{index} in the object table.
 
@@ -441,14 +442,19 @@ in-place mutation of the object table. This mechanism provides for
 lazy variable resolution, and an important cached fast-path once the
 variable has been successfully resolved.
 
+The ``long'' variant has a 16-bit index instead of an 8-bit index,
+with the most significant byte first.
+
 This instruction pushes the value of the variable onto the stack.
 @end deffn
 
-@deffn Instruction toplevel-ref index
+@deffn Instruction toplevel-set index
+@deffnx Instruction long-toplevel-set index
 Pop a value off the stack, and set it as the value of the toplevel
 variable stored at @var{index} in the object table. If the variable
 has not yet been looked up, we do the lookup as in
-@code{toplevel-ref}.
+@code{toplevel-ref}. The ``long'' variant has a 16-bit index instead
+of an 8-bit index.
 @end deffn
 
 @deffn Instruction link-now
@@ -471,7 +477,9 @@ the variable to the value.
 @end deffn
 
 @deffn Instruction object-ref n
-Push @var{n}th value from the current program's object vector.
+@deffnx Instruction long-object-ref n
+Push @var{n}th value from the current program's object vector. The
+``long'' variant has a 16-bit index instead of an 8-bit index.
 @end deffn
 
 @node Branch Instructions

libguile/vm-i-system.c

@@ -1062,6 +1062,62 @@ VM_DEFINE_INSTRUCTION (51, truncate_values, "truncate-values", 2, -1, -1)
   NEXT;
 }
 
+VM_DEFINE_INSTRUCTION (52, long_object_ref, "long-object-ref", 2, 0, 1)
+{
+  unsigned int objnum = FETCH ();
+  objnum <<= 8;
+  objnum += FETCH ();
+  CHECK_OBJECT (objnum);
+  PUSH (OBJECT_REF (objnum));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (53, long_toplevel_ref, "long-toplevel-ref", 2, 0, 1)
+{
+  SCM what;
+  unsigned int objnum = FETCH ();
+  objnum <<= 8;
+  objnum += FETCH ();
+  CHECK_OBJECT (objnum);
+  what = OBJECT_REF (objnum);
+
+  if (!SCM_VARIABLEP (what)) 
+    {
+      SYNC_REGISTER ();
+      what = resolve_variable (what, scm_program_module (program));
+      if (!VARIABLE_BOUNDP (what))
+        {
+          finish_args = scm_list_1 (what);
+          goto vm_error_unbound;
+        }
+      OBJECT_SET (objnum, what);
+    }
+
+  PUSH (VARIABLE_REF (what));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (54, long_toplevel_set, "long-toplevel-set", 2, 1, 0)
+{
+  SCM what;
+  unsigned int objnum = FETCH ();
+  objnum <<= 8;
+  objnum += FETCH ();
+  CHECK_OBJECT (objnum);
+  what = OBJECT_REF (objnum);
+
+  if (!SCM_VARIABLEP (what)) 
+    {
+      SYNC_BEFORE_GC ();
+      what = resolve_variable (what, scm_program_module (program));
+      OBJECT_SET (objnum, what);
+    }
+
+  VARIABLE_SET (what, *sp);
+  DROP ();
+  NEXT;
+}
+
 /*
 (defun renumber-ops ()
   "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences"

module/language/glil/compile-assembly.scm

@@ -186,7 +186,11 @@
                  (receive (i object-alist)
                      (object-index-and-alist (make-subprogram table prog)
                                              object-alist)
-                   (emit-code/object `((object-ref ,i) ,@closure)
+                   (emit-code/object `(,(if (< i 256)
+                                            `(object-ref ,i)
+                                            `(long-object-ref ,(quotient i 256)
+                                                              ,(modulo i 256)))
+                                       ,@closure)
                                      object-alist)))
                 (else
                  ;; otherwise emit a load directly
@@ -234,7 +238,10 @@
       (else
        (receive (i object-alist)
            (object-index-and-alist obj object-alist)
-         (emit-code/object `((object-ref ,i))
+         (emit-code/object (if (< i 256)
+                               `((object-ref ,i))
+                               `((long-object-ref ,(quotient i 256)
+                                                  ,(modulo i 256))))
                            object-alist)))))
 
     ((<glil-local> op index)
@@ -264,9 +271,16 @@
           (receive (i object-alist)
               (object-index-and-alist (make-variable-cache-cell name)
                                       object-alist)
-            (emit-code/object (case op
-                                ((ref) `((toplevel-ref ,i)))
-                                ((set) `((toplevel-set ,i))))
+            (emit-code/object (if (< i 256)
+                                  `((,(case op
+                                        ((ref) 'toplevel-ref)
+                                        ((set) 'toplevel-set))
+                                     ,i))
+                                  `((,(case op
+                                        ((ref) 'long-toplevel-ref)
+                                        ((set) 'long-toplevel-set))
+                                     ,(quotient i 256)
+                                     ,(modulo i 256))))
                               object-alist)))))
        ((define)
         (emit-code `((define ,(symbol->string name))