summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-06-05 12:08:02 +0200
committerAndy Wingo <wingo@pobox.com>2009-06-05 12:08:02 +0200
commita9b0f876c12bbbca9bdf1890eb014a30f004d9f8 (patch)
tree25651e1fee31f04629109488c11560017dbfdd8c
parent5e89cd13c077de1419cab140590f76f92a457807 (diff)
downloadguile-a9b0f876c12bbbca9bdf1890eb014a30f004d9f8.tar.gz
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.
-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))