summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/ref/vm.texi14
-rw-r--r--libguile/vm-i-system.c56
-rw-r--r--module/language/glil/compile-assembly.scm24
3 files changed, 86 insertions, 8 deletions
diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi
index 49b420c50..8d7778c1c 100644
--- a/doc/ref/vm.texi
+++ b/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
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 32b772afa..36ff5bde8 100644
--- a/libguile/vm-i-system.c
+++ b/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"
diff --git a/module/language/glil/compile-assembly.scm b/module/language/glil/compile-assembly.scm
index 4c92e0f5a..1fb10c146 100644
--- a/module/language/glil/compile-assembly.scm
+++ b/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))