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

*** empty log message ***

Browse source
This commit is contained in:
Keisuke Nishida 2001-04-07 10:16:48 +00:00
parent 3616e9e963
commit 731f329c29
4 changed files with 16 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

8
module/system/repl/command.scm
View file

@ -301,11 +301,9 @@ Generate compiled code.
-O Enable optimization
-D Add debug information"
(let ((x (apply repl-compile repl form opts)))
(cond ((null? opts)
(disassemble-bootcode x))
((memq :c opts)
(pprint-glil x))
(else (puts x)))))
(cond ((or (memq :e opts) (memq :t opts)) (puts x))
((memq :c opts) (pprint-glil x))
(else (disassemble-bootcode x)))))
(define (compile-file repl file . opts)
"compile-file [options] FILE

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

@ -30,22 +30,23 @@
(dynamic-wind
(lambda ()
(set-vm-option! vm 'trace-first #t)
(if (memq :b opts)
(add-hook! (vm-next-hook vm) trace-next))
(if (memq :b opts) (add-hook! (vm-next-hook vm) trace-next))
(set-vm-option! vm 'trace-variables (if (memq :v opts) #t #f))
(add-hook! (vm-apply-hook vm) trace-apply)
(add-hook! (vm-return-hook vm) trace-return))
(lambda ()
(vm-load vm bytes))
(lambda ()
(if (memq :b opts)
(remove-hook! (vm-next-hook vm) trace-next))
(if (memq :b opts) (remove-hook! (vm-next-hook vm) trace-next))
(remove-hook! (vm-apply-hook vm) trace-apply)
(remove-hook! (vm-return-hook vm) trace-return))))
(define (trace-next vm)
(let ((frame (vm-current-frame vm)))
(format #t "0x~8X ~20S~S\n"
(vm:ip vm) (vm-fetch-code vm) (vm-fetch-stack vm))))
(format #t "0x~8X ~20S" (vm:ip vm) (vm-fetch-code vm))
(if (vm-option vm 'trace-variables)
(format #t "~S\t" (frame-variables frame)))
(format #t "~S\n" (vm-fetch-stack vm))))
(define (trace-apply vm)
(if (vm-option vm 'trace-first)

2
src/vm.h
View file

@ -82,7 +82,7 @@
(SCM_VM_FRAME_DATA_ADDRESS (fp) + 2)
#define SCM_VM_FRAME_DYNAMIC_LINK(fp) SCM_VM_FRAME_DATA_ADDRESS (fp)[1]
#define SCM_VM_FRAME_RETURN_ADDRESS(fp) SCM_VM_FRAME_DATA_ADDRESS (fp)[2]
#define SCM_VM_FRAME_RETURN_ADDRESS(fp) SCM_VM_FRAME_DATA_ADDRESS (fp)[0]
#define SCM_VM_FRAME_VARIABLE(fp,i) fp[i]
#define SCM_VM_FRAME_PROGRAM(fp) fp[-1]

8
src/vm_engine.h
View file

@ -276,12 +276,14 @@ do { \
#define NEW_FRAME() \
{ \
sp[1] = SCM_VM_MAKE_BYTE_ADDRESS (ip); \
sp[2] = SCM_VM_MAKE_STACK_ADDRESS (fp); \
SCM ra = SCM_VM_MAKE_BYTE_ADDRESS (ip); \
SCM dl = SCM_VM_MAKE_STACK_ADDRESS (fp); \
ip = bp->base; \
fp = sp - bp->nargs + 1; \
sp = sp + 2; \
sp = sp + bp->nlocs + 2; \
CHECK_OVERFLOW (); \
sp[0] = dl; \
sp[-1] = ra; \
}
#define FREE_FRAME() \