mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-17 09:10:22 +02:00
replace frame implementation with VM frames
* libguile/stacks.h: Rework so that a stack doesn't copy information out of VM frames, it just holds onto a VM frame, along with the stack id and length. VM frames are now the only representation of frames in Guile. (scm_t_info_frame, SCM_FRAME_N_SLOTS, SCM_FRAME_REF, SCM_FRAME_NUMBER) (SCM_FRAME_FLAGS, SCM_FRAME_SOURCE, SCM_FRAME_PROC, SCM_FRAME_ARGS) (SCM_FRAME_PREV, SCM_FRAME_NEXT) (SCM_FRAMEF_VOID, SCM_FRAMEF_REAL, SCM_FRAMEF_PROC) (SCM_FRAMEF_EVAL_ARGS, SCM_FRAMEF_OVERFLOW) (SCM_FRAME_VOID_P, SCM_FRAME_REAL_P, SCM_FRAME_PROC_P) (SCM_FRAME_EVAL_ARGS_P, SCM_FRAME_OVERFLOW_P): Remove these macros corresponding to the old frame implementation. (scm_frame_p scm_frame_source, scm_frame_procedure) (scm_frame_arguments): These definitions are now in frames.h. (scm_last_stack_frame): Remove declaration of previously-removed constructor. Probably should re-instate it though. (scm_frame_number, scm_frame_previous, scm_frame_next) (scm_frame_real_p, scm_frame_procedure_p, scm_frame_evaluating_args_p) (scm_frame_overflow_p) : Remove these procedures corresponding to the old stack implementation. * libguile/stacks.c: Update for new frames implementation. * libguile/frames.h: * libguile/frames.c: Rename functions operating on VM frames to have a scm_frame prefix, not scm_vm_frame -- because they really are the only frames we have. Rename corresponding Scheme functions too, from vm-frame-foo to frame-foo. * libguile/deprecated.h: Remove scm_stack and scm_info_frame data types. * libguile/vm.c (vm_dispatch_hook): Adapt to scm_c_make_frame name change. * module/system/vm/frame.scm: No need to export functions provided frames.c now, as we load those procedures into the default environment now. Rename functions, and remove a couple of outdated, unused functions. The bottom half of this file is still bitrotten, though. * libguile/backtrace.c: Rework to operate on the new frame representation. Also fix a bug displaying file names for compiled procedures. * libguile/init.c: Load the VM much earlier, just because we can. Also it allows us to have frames.[ch] loaded in time for stacks to be initialized, so that scm_frame_arguments can do the right thing.
This commit is contained in:
parent
14aa25e410
commit
aa3f69519f
9 changed files with 249 additions and 542 deletions
|
@ -24,21 +24,19 @@
|
|||
#:use-module (system vm instruction)
|
||||
#:use-module (system vm objcode)
|
||||
#:use-module ((srfi srfi-1) #:select (fold))
|
||||
#:export (vm-frame?
|
||||
vm-frame-program
|
||||
vm-frame-local-ref vm-frame-local-set!
|
||||
vm-frame-instruction-pointer
|
||||
vm-frame-return-address vm-frame-mv-return-address
|
||||
vm-frame-dynamic-link
|
||||
vm-frame-num-locals
|
||||
#:export (frame-local-ref frame-local-set!
|
||||
frame-instruction-pointer
|
||||
frame-return-address frame-mv-return-address
|
||||
frame-dynamic-link
|
||||
frame-num-locals
|
||||
|
||||
vm-frame-bindings vm-frame-binding-ref vm-frame-binding-set!
|
||||
vm-frame-arguments
|
||||
frame-bindings frame-binding-ref frame-binding-set!
|
||||
; frame-arguments
|
||||
|
||||
vm-frame-number vm-frame-address
|
||||
frame-number frame-address
|
||||
make-frame-chain
|
||||
print-frame print-frame-chain-as-backtrace
|
||||
frame-arguments frame-local-variables
|
||||
frame-local-variables
|
||||
frame-environment
|
||||
frame-variable-exists? frame-variable-ref frame-variable-set!
|
||||
frame-object-name
|
||||
|
@ -48,22 +46,22 @@
|
|||
|
||||
(load-extension "libguile" "scm_init_frames")
|
||||
|
||||
(define (vm-frame-bindings frame)
|
||||
(define (frame-bindings frame)
|
||||
(map (lambda (b)
|
||||
(cons (binding:name b) (binding:index b)))
|
||||
(program-bindings-for-ip (vm-frame-program frame)
|
||||
(vm-frame-instruction-pointer frame))))
|
||||
(program-bindings-for-ip (frame-procedure frame)
|
||||
(frame-instruction-pointer frame))))
|
||||
|
||||
(define (vm-frame-binding-set! frame var val)
|
||||
(let ((i (assq-ref (vm-frame-bindings frame) var)))
|
||||
(define (frame-binding-set! frame var val)
|
||||
(let ((i (assq-ref (frame-bindings frame) var)))
|
||||
(if i
|
||||
(vm-frame-local-set! frame i val)
|
||||
(frame-local-set! frame i val)
|
||||
(error "variable not bound in frame" var frame))))
|
||||
|
||||
(define (vm-frame-binding-ref frame var)
|
||||
(let ((i (assq-ref (vm-frame-bindings frame) var)))
|
||||
(define (frame-binding-ref frame var)
|
||||
(let ((i (assq-ref (frame-bindings frame) var)))
|
||||
(if i
|
||||
(vm-frame-local-ref frame i)
|
||||
(frame-local-ref frame i)
|
||||
(error "variable not bound in frame" var frame))))
|
||||
|
||||
;; Basically there are two cases to deal with here:
|
||||
|
@ -80,37 +78,37 @@
|
|||
;; number of arguments, or perhaps we're doing a typed dispatch and
|
||||
;; the types don't match. In that case the arguments are all on the
|
||||
;; stack, and nothing else is on the stack.
|
||||
(define (vm-frame-arguments frame)
|
||||
(define (frame-arguments frame)
|
||||
(cond
|
||||
((program-lambda-list (vm-frame-program frame)
|
||||
(vm-frame-instruction-pointer frame))
|
||||
((program-lambda-list (frame-procedure frame)
|
||||
(frame-instruction-pointer frame))
|
||||
;; case 1
|
||||
=> (lambda (formals)
|
||||
(let lp ((formals formals))
|
||||
(pmatch formals
|
||||
(() '())
|
||||
((,x . ,rest) (guard (symbol? x))
|
||||
(cons (vm-frame-binding-ref frame x) (lp rest)))
|
||||
(cons (frame-binding-ref frame x) (lp rest)))
|
||||
((,x . ,rest)
|
||||
;; could be a keyword
|
||||
(cons x (lp rest)))
|
||||
(,rest (guard (symbol? rest))
|
||||
(vm-frame-binding-ref frame rest))
|
||||
(frame-binding-ref frame rest))
|
||||
;; let's not error here, as we are called during
|
||||
;; backtraces...
|
||||
(else '???)))))
|
||||
(else
|
||||
;; case 2
|
||||
(map (lambda (i)
|
||||
(vm-frame-local-ref frame i))
|
||||
(iota (vm-frame-num-locals frame))))))
|
||||
(frame-local-ref frame i))
|
||||
(iota (frame-num-locals frame))))))
|
||||
|
||||
;;;
|
||||
;;; Frame chain
|
||||
;;;
|
||||
|
||||
(define vm-frame-number (make-object-property))
|
||||
(define vm-frame-address (make-object-property))
|
||||
(define frame-number (make-object-property))
|
||||
(define frame-address (make-object-property))
|
||||
|
||||
;; FIXME: the header.
|
||||
(define (bootstrap-frame? frame)
|
||||
|
@ -201,17 +199,9 @@
|
|||
prog (module-obarray (current-module))))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Frames
|
||||
;;;
|
||||
|
||||
(define (frame-arguments frame)
|
||||
(let* ((prog (frame-program frame))
|
||||
(arity (program-arity prog)))
|
||||
(do ((n (+ (arity:nargs arity) -1) (1- n))
|
||||
(l '() (cons (frame-local-ref frame n) l)))
|
||||
((< n 0) l))))
|
||||
|
||||
(define (frame-local-variables frame)
|
||||
(let* ((prog (frame-program frame))
|
||||
(arity (program-arity prog)))
|
||||
|
@ -219,26 +209,6 @@
|
|||
(l '() (cons (frame-local-ref frame n) l)))
|
||||
((< n 0) l))))
|
||||
|
||||
(define (frame-binding-ref frame binding)
|
||||
(let ((x (frame-local-ref frame (binding:index binding))))
|
||||
(if (and (binding:boxed? binding) (variable? x))
|
||||
(variable-ref x)
|
||||
x)))
|
||||
|
||||
(define (frame-binding-set! frame binding val)
|
||||
(if (binding:boxed? binding)
|
||||
(let ((v (frame-local-ref frame binding)))
|
||||
(if (variable? v)
|
||||
(variable-set! v val)
|
||||
(frame-local-set! frame binding (make-variable val))))
|
||||
(frame-local-set! frame binding val)))
|
||||
|
||||
;; FIXME handle #f program-bindings return
|
||||
(define (frame-bindings frame addr)
|
||||
(filter (lambda (b) (and (>= addr (binding:start b))
|
||||
(<= addr (binding:end b))))
|
||||
(program-bindings (frame-program frame))))
|
||||
|
||||
(define (frame-lookup-binding frame addr sym)
|
||||
(assq sym (reverse (frame-bindings frame addr))))
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue