mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

compiler support for nlocs >= 256

Browse source 
* libguile/vm-i-system.c (long-local-ref, long-local-set)
  (make-variable): New intructions, for handling nlocs >= 256.
* module/language/glil/compile-assembly.scm (glil->assembly): Compile
  <glil-lexical> with support for nlocs >= 256.
This commit is contained in:
Andy Wingo 2009-07-24 11:00:32 +02:00
parent ccf77d955c
commit 80545853d5
2 changed files with 62 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

28
libguile/vm-i-system.c
View file

@ -278,6 +278,16 @@ VM_DEFINE_INSTRUCTION (25, local_ref, "local-ref", 1, 0, 1)
NEXT;
}
VM_DEFINE_INSTRUCTION (26, long_local_ref, "long-local-ref", 2, 0, 1)
{
unsigned int i = FETCH ();
i <<= 8;
i += FETCH ();
PUSH (LOCAL_REF (i))
ASSERT_BOUND (*sp);
NEXT;
}
VM_DEFINE_INSTRUCTION (27, variable_ref, "variable-ref", 0, 0, 1)
{
SCM x = *sp;
@ -354,6 +364,16 @@ VM_DEFINE_INSTRUCTION (30, local_set, "local-set", 1, 1, 0)
NEXT;
}
VM_DEFINE_INSTRUCTION (31, long_local_set, "long-local-set", 2, 1, 0)
{
unsigned int i = FETCH ();
i <<= 8;
i += FETCH ();
LOCAL_SET (i, *sp);
DROP ();
NEXT;
}
VM_DEFINE_INSTRUCTION (32, variable_set, "variable-set", 0, 1, 0)
{
VARIABLE_SET (sp[0], sp[-1]);
@ -1183,6 +1203,14 @@ VM_DEFINE_INSTRUCTION (63, make_closure, "make-closure", 0, 2, 1)
NEXT;
}
VM_DEFINE_INSTRUCTION (64, make_variable, "make-variable", 0, 0, 1)
{
SYNC_BEFORE_GC ();
/* fixme underflow */
PUSH (scm_cell (scm_tc7_variable, SCM_UNPACK (SCM_UNDEFINED)));
NEXT;
}
/*
(defun renumber-ops ()

44
module/language/glil/compile-assembly.scm
View file

@ -242,18 +242,42 @@
((<glil-lexical> local? boxed? op index)
(emit-code
`((,(if local?
(case op
((ref) (if boxed? 'local-boxed-ref 'local-ref))
((set) (if boxed? 'local-boxed-set 'local-set))
((box) 'box)
((empty-box) 'empty-box)
(else (error "what" op)))
(case op
(if local?
(if (< index 256)
`((,(case op
((ref) (if boxed? 'local-boxed-ref 'local-ref))
((set) (if boxed? 'local-boxed-set 'local-set))
((box) 'box)
((empty-box) 'empty-box)
(else (error "what" op)))
,index))
(let ((a (quotient i 256))
(b (modulo i 256)))
`((,(case op
((ref)
(if boxed?
`((long-local-ref ,a ,b)
(variable-ref))
`((long-local-ref ,a ,b))))
((set)
(if boxed?
`((long-local-ref ,a ,b)
(variable-set))
`((long-local-set ,a ,b))))
((box)
`((make-variable)
(variable-set)
(long-local-set ,a ,b)))
((empty-box)
`((make-variable)
(long-local-set ,a ,b)))
(else (error "what" op)))
,index))))
`((,(case op
((ref) (if boxed? 'free-boxed-ref 'free-ref))
((set) (if boxed? 'free-boxed-set (error "what." glil)))
(else (error "what" op))))
,index))))
(else (error "what" op)))
,index)))))
((<glil-toplevel> op name)
(case op