diff options
-rw-r--r-- | doc/ref/vm.texi | 14 | ||||
-rw-r--r-- | libguile/vm-i-system.c | 56 | ||||
-rw-r--r-- | module/language/glil/compile-assembly.scm | 24 |
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)) |