mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 06:20:30 +02:00
Code Activity

*** empty log message ***

Browse source
This commit is contained in:
Keisuke Nishida 2001-04-23 06:17:52 +00:00
parent af988bbf9c
commit a6df585ae7
4 changed files with 23 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

4
module/system/il/compile.scm
View file

@ -251,10 +251,10 @@
;; (set VARS)...
;; BODY
(for-each comp-push vals)
(for-each (lambda (var) (push-code! (make-glil-var 'set env var)))
(reverse vars))
(let ((vars (map (lambda (v) (list v.name v.kind v.index)) vars)))
(if (not (null? vars)) (push-code! (<glil-bind> vars))))
(for-each (lambda (var) (push-code! (make-glil-var 'set env var)))
(reverse vars))
(comp-tail body)
(push-code! (<glil-unbind>)))

6
module/system/vm/trace.scm
View file

@ -45,11 +45,15 @@
(define (trace-next vm)
(define (puts x) (display #\tab) (write x))
(define (truncate! x n)
(if (> (length x) n)
(list-cdr-set! x (1- n) '(...))) x)
;; main
(format #t "0x~8X ~16S" (vm:ip vm) (vm-fetch-code vm))
(do ((opts (vm-option vm 'trace-options) (cdr opts)))
((null? opts) (newline))
(case (car opts)
((:s) (puts (vm-fetch-stack vm)))
((:s) (puts (truncate! (vm-fetch-stack vm) 3)))
((:l) (puts (vm-fetch-locals vm)))
((:e) (puts (vm-fetch-externals vm))))))

32
src/vm.c
View file

@ -149,34 +149,28 @@ vm_fetch_length (scm_byte_t *ip, size_t *lenp)
}
static SCM
vm_heapify_frames_1 (struct scm_vm *vp, SCM *fp, SCM *limit, SCM **basep)
vm_heapify_frames_1 (struct scm_vm *vp, SCM *fp, SCM *sp, SCM **destp)
{
SCM *base, frame;
SCM frame;
SCM *dl = SCM_FRAME_DYNAMIC_LINK (fp);
SCM *sp = SCM_FRAME_UPPER_ADDRESS (fp);
SCM *src = SCM_FRAME_UPPER_ADDRESS (fp);
SCM *dest = SCM_FRAME_LOWER_ADDRESS (fp);
if (!dl)
{
/* The top frame */
base = vp->stack_base;
frame = scm_c_make_heap_frame (fp);
fp = SCM_HEAP_FRAME_POINTER (frame);
SCM_FRAME_HEAP_LINK (fp) = SCM_BOOL_T;
}
else
{
/* Other frames */
/* Child frames */
SCM link = SCM_FRAME_HEAP_LINK (dl);
if (!SCM_FALSEP (link))
{
link = SCM_FRAME_LOWER_ADDRESS (dl)[-1]; /* self link */
base = SCM_FRAME_LOWER_ADDRESS (fp);
}
link = SCM_FRAME_LOWER_ADDRESS (dl)[-1]; /* self link */
else
{
link = vm_heapify_frames_1 (vp, dl, SCM_FRAME_LOWER_ADDRESS (fp),
&base);
}
link = vm_heapify_frames_1 (vp, dl, dest - 1, &dest);
frame = scm_c_make_heap_frame (fp);
fp = SCM_HEAP_FRAME_POINTER (frame);
SCM_FRAME_HEAP_LINK (fp) = link;
@ -184,9 +178,9 @@ vm_heapify_frames_1 (struct scm_vm *vp, SCM *fp, SCM *limit, SCM **basep)
}
/* Move stack data */
for (; sp < limit; base++, sp++)
*base = *sp;
*basep = base;
for (; src <= sp; src++, dest++)
*dest = *src;
*destp = dest;
return frame;
}
@ -197,10 +191,10 @@ vm_heapify_frames (SCM vm)
struct scm_vm *vp = SCM_VM_DATA (vm);
if (SCM_FALSEP (SCM_FRAME_HEAP_LINK (vp->fp)))
{
SCM *base;
vp->this_frame = vm_heapify_frames_1 (vp, vp->fp, vp->sp + 1, &base);
SCM *dest;
vp->this_frame = vm_heapify_frames_1 (vp, vp->fp, vp->sp, &dest);
vp->fp = SCM_HEAP_FRAME_POINTER (vp->this_frame);
vp->sp = base - 1;
vp->sp = dest - 1;
}
return vp->this_frame;
}

5
src/vm_system.c
View file

@ -54,9 +54,10 @@ VM_DEFINE_INSTRUCTION (nop, "nop", 0, 0, 0)
VM_DEFINE_INSTRUCTION (halt, "halt", 0, 0, 0)
{
SCM ret = *sp;
SCM ret;
vp->time += scm_c_get_internal_run_time () - start_time;
HALT_HOOK ();
POP (ret);
FREE_FRAME ();
SYNC_ALL ();
return ret;
@ -490,9 +491,9 @@ VM_DEFINE_INSTRUCTION (return, "return", 0, 0, 1)
{
SCM ret;
vm_return:
POP (ret);
EXIT_HOOK ();
RETURN_HOOK ();
POP (ret);
FREE_FRAME ();
/* Restore the last program */