1
Fork 0
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:
Andy Wingo 2009-12-03 13:09:58 +01:00
parent 14aa25e410
commit aa3f69519f
9 changed files with 249 additions and 542 deletions

View file

@ -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))))