diff --git a/module/system/vm/trap-state.scm b/module/system/vm/trap-state.scm index 02a4c8818..f45f98121 100644 --- a/module/system/vm/trap-state.scm +++ b/module/system/vm/trap-state.scm @@ -38,7 +38,8 @@ add-trap-at-procedure-call! add-trace-at-procedure-call! - add-trap-at-source-location!)) + add-trap-at-source-location! + add-trap-at-frame-finish!)) (define %default-trap-handler (make-fluid)) @@ -57,6 +58,7 @@ (define-record (handler default-trap-handler) (next-idx 0) + (next-ephemeral-idx -1) (wrappers '())) (define (trap-wrapper nothing +(define* (add-trap-at-frame-finish! frame handler + #:optional (trap-state (the-trap-state))) + (let* ((idx (next-ephemeral-index! trap-state)) + (trap (trap-frame-finish + frame + (ephemeral-handler-for-index trap-state idx handler) + (lambda (frame) (delete-trap! idx trap-state))))) + (add-trap-wrapper! + trap-state + (make-trap-wrapper + idx #t trap + (format #f "Return from ~a" frame))))) + (define* (add-trap! trap name #:optional (trap-state (the-trap-state))) (let* ((idx (next-index! trap-state))) (add-trap-wrapper! diff --git a/module/system/vm/traps.scm b/module/system/vm/traps.scm index 3b2a43875..dfaedc584 100644 --- a/module/system/vm/traps.scm +++ b/module/system/vm/traps.scm @@ -268,7 +268,7 @@ range)) ;; Building on trap-instructions-in-procedure, we have -;; trap-instructions-in-procedure. +;; trap-at-procedure-ip-in-range. ;; (define* (trap-at-procedure-ip-in-range proc range handler #:key current-frame (vm (the-vm))