1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 08:40:19 +02:00

VM manages hook sets itself

* libguile/vm.h (SCM_VM_ABORT_HOOK): Rename from
  SCM_VM_ABORT_CONTINUATION_HOOK.
* libguile/vm-engine.c (ABORT_HOOK):
* libguile/vm.c (invoke_abort_hook): Adapt to SCM_VM_ABORT_HOOK name
change.
(reset_vm_hook_enabled): New helper.
(VM_ADD_HOOK, VM_REMOVE_HOOK): New helper macros, replacing
VM_DEFINE_HOOK.
(scm_vm_add_abort_hook_x, scm_vm_remove_abort_hook_x)
(scm_vm_add_apply_hook_x, scm_vm_remove_apply_hook_x)
(scm_vm_add_return_hook_x, scm_vm_remove_return_hook_x)
(scm_vm_add_next_hook_x, scm_vm_remove_next_hook_x): New functions,
replacing direct access to the hooks.  Allows us to know in a more
fine-grained way when to enable hooks.
(scm_set_vm_trace_level_x): Use reset_vm_hook_enabled to update the
individual hook_enabled flags.
* module/statprof.scm:
* module/system/vm/coverage.scm:
* module/system/vm/traps.scm:
* module/system/vm/vm.scm: Adapt VM hook users to the new API.
This commit is contained in:
Andy Wingo 2018-09-14 08:42:41 +02:00
parent ce5c05ac4a
commit bf31fe4cf6
7 changed files with 130 additions and 62 deletions

View file

@ -1,6 +1,6 @@
;;; -*- mode: scheme; coding: utf-8; -*-
;;;
;;; Copyright (C) 2010, 2013 Free Software Foundation, Inc.
;;; Copyright (C) 2010, 2013, 2018 Free Software Foundation, Inc.
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
@ -70,17 +70,16 @@ by THUNK."
;; VM is different from the current one, continuations will not be
;; resumable.
(call-with-values (lambda ()
(let ((level (vm-trace-level))
(hook (vm-next-hook)))
(let ((level (vm-trace-level)))
(dynamic-wind
(lambda ()
(set-vm-trace-level! (+ level 1))
(add-hook! hook collect!))
(vm-add-next-hook! collect!))
(lambda ()
(call-with-vm thunk))
(lambda ()
(set-vm-trace-level! level)
(remove-hook! hook collect!)))))
(vm-remove-next-hook! collect!)))))
(lambda args
(apply values (make-coverage-data ip-counts) args))))