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

*** empty log message ***

Browse source
This commit is contained in:
Keisuke Nishida 2001-04-06 05:00:10 +00:00
parent 3d5ee0cdcc
commit 499a4c07c7
11 changed files with 67 additions and 38 deletions
Download patch file Download diff file Expand all files Collapse all files

2
module/system/repl/common.scm
View file

@ -37,7 +37,7 @@
vm language module value-count value-history tm-stats vm-stats gc-stats)
(define (make-repl lang)
(let ((vm (make-vm)))
(let ((vm (the-vm)))
(make <repl>
:vm vm
:language (lookup-language lang)

5
module/system/vm/core.scm
View file

@ -25,9 +25,8 @@
(export vms:cons vms:time vms:clock)
(define (vms:cons stat) (vector-ref stat 0))
(define (vms:time stat) (vector-ref stat 1))
(define (vms:clock stat) (vector-ref stat 2))
(define (vms:time stat) (vector-ref stat 0))
(define (vms:clock stat) (vector-ref stat 1))
(module-export! (current-module)
(delq! '%module-public-interface

12
module/system/vm/frame.scm
View file

@ -24,8 +24,16 @@
:export (frame->call))
(define (frame->call frame)
(let ((prog (frame-program frame)))
(cons prog (reverse! (vector->list (frame-variables frame))))))
(let* ((prog (frame-program frame))
(nargs (car (program-arity prog))))
(do ((i 0 (1+ i))
(l (reverse! (vector->list (frame-variables frame))) (cdr l))
(r '() (cons (car l) r)))
((= i nargs) (cons (program-name prog) r)))))
(define (program-name x)
(hash-fold (lambda (s v d) (if (eq? x (variable-ref v)) s d)) x
(module-obarray (current-module))))
; (define-method (binding (prog <program>))
; (fold (lambda (s v d) (if (eq? v prog) s d))

4
module/system/vm/load.scm
View file

@ -25,8 +25,6 @@
:use-module (ice-9 regex)
:export (load/compile))
(define *the-vm* (make-vm))
(define (load/compile file)
(let* ((file (file-name-full-name file))
(compiled (object-file-name file)))
@ -36,7 +34,7 @@
(let ((bytes (make-uniform-vector (stat:size (stat compiled)) #\a)))
(call-with-input-file compiled
(lambda (p) (uniform-vector-read! bytes p)))
(vm-load *the-vm* bytes))))
(vm-load (the-vm) bytes))))
(define (file-name-full-name filename)
(let ((oldname (and (current-load-port)

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

@ -44,11 +44,8 @@
(define (trace-next vm)
(let ((frame (vm-current-frame vm)))
(format #t "0x~8X ~20S~S\t~S\n"
(vm:ip vm)
(vm-fetch-code vm)
(frame-variables frame)
(vm-fetch-stack vm))))
(format #t "0x~8X ~20S~S\n"
(vm:ip vm) (vm-fetch-code vm) (vm-fetch-stack vm))))
(define (trace-apply vm)
(if (vm-option vm 'trace-first)