mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-03 16:20:39 +02:00
Code Activity

vm: BUILDING_LIBGUILE-guarded defs to internal headers

Browse source 
Also make "struct scm_vm" private, now that scm_thread is also private.

* libguile/vm-internal.h: New file.
* libguile/Makefile.am: Add new file.
* libguile/continuations.c:
* libguile/debug.c:
* libguile/frames.c:
* libguile/init.c:
* libguile/print.c:
* libguile/programs.c:
* libguile/script.c:
* libguile/stacks.c:
* libguile/threads-internal.h:
* libguile/threads.c:
* libguile/threads.h:
* libguile/throw.c:
* libguile/vm.c: Include new file.
* libguile/vm.h: Remove private defs.
This commit is contained in:
Andy Wingo 2025-07-01 11:04:57 +02:00
parent 6a32628e18
commit a7801c750f
16 changed files with 162 additions and 138 deletions
Download patch file Download diff file Expand all files Collapse all files

1
libguile/Makefile.am
View file

@ -541,6 +541,7 @@ noinst_HEADERS = atomic.h \
trace.h \
values-internal.h \
vectors-internal.h \
vm-internal.h \
whippet-embedder.h
# vm instructions

2
libguile/continuations.c
View file

@ -48,7 +48,7 @@
#include "stackchk.h"
#include "stacks.h"
#include "symbols.h"
#include "vm.h"
#include "vm-internal.h"
#include "continuations-internal.h"

2
libguile/debug.c
View file

@ -59,7 +59,7 @@
#include "struct.h"
#include "throw.h"
#include "variable.h"
#include "vm.h"
#include "vm-internal.h"
#include "debug.h"

2
libguile/frames.c
View file

@ -38,7 +38,7 @@
#include "threads-internal.h"
#include "variable.h"
#include "version.h"
#include "vm.h"
#include "vm-internal.h"
#include "frames-internal.h"

2
libguile/init.c
View file

@ -140,7 +140,7 @@
#include "variable.h"
#include "vectors-internal.h"
#include "version.h"
#include "vm.h"
#include "vm-internal.h"
#include "init.h"

2
libguile/print.c
View file

@ -72,7 +72,7 @@
#include "values-internal.h"
#include "variable.h"
#include "vectors.h"
#include "vm.h"
#include "vm-internal.h"
#include "print.h"

2
libguile/programs.c
View file

@ -36,7 +36,7 @@
#include "procprop.h" /* scm_sym_name */
#include "variable.h"
#include "version.h"
#include "vm.h"
#include "vm-internal.h"
#include "programs.h"

4
libguile/script.c
View file

@ -1,4 +1,4 @@
/* Copyright 1994-1998,2000-2011,2013-2014,2018
/* Copyright 1994-1998,2000-2011,2013-2014,2018,2025
Free Software Foundation, Inc.
This file is part of Guile.
@ -48,7 +48,7 @@
#include "strports.h"
#include "throw.h"
#include "version.h"
#include "vm.h"
#include "vm-internal.h"
#include "script.h"

2
libguile/stacks.c
View file

@ -44,7 +44,7 @@
#include "struct.h"
#include "symbols.h"
#include "threads-internal.h"
#include "vm.h" /* to capture vm stacks */
#include "vm-internal.h" /* to capture vm stacks */
#include "stacks.h"

3
libguile/threads-internal.h
View file

@ -23,7 +23,10 @@
#include "libguile/dynstack.h"
#include "libguile/iselect.h"
#include "libguile/fluids-internal.h"
#include "libguile/vm-internal.h"
#include "libguile/threads.h"

1
libguile/threads.c
View file

@ -67,7 +67,6 @@
#include "variable.h"
#include "vectors-internal.h"
#include "version.h"
#include "vm.h"
#include "whippet-embedder.h"
#include "threads-internal.h"

2
libguile/threads.h
View file

@ -24,8 +24,6 @@
#include "libguile/procs.h"
#include "libguile/throw.h"
#include "libguile/iselect.h"
#include "libguile/vm.h"
#if SCM_USE_PTHREAD_THREADS
#include "libguile/pthread-threads.h"

2
libguile/throw.c
View file

@ -49,7 +49,7 @@
#include "strings-internal.h"
#include "symbols.h"
#include "variable.h"
#include "vm.h"
#include "vm-internal.h"
#include "throw.h"

147
libguile/vm-internal.h Normal file
View file

@ -0,0 +1,147 @@
/* Copyright 2001,2009-2015,2017-2018,2025
Free Software Foundation, Inc.
This file is part of Guile.
Guile is free software: you can redistribute it and/or modify it
under the terms of the GNU Lesser General Public License as published
by the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
Guile is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
License for more details.
You should have received a copy of the GNU Lesser General Public
License along with Guile. If not, see
<https://www.gnu.org/licenses/>. */
#ifndef _SCM_VM_INTERNAL_H_
#define _SCM_VM_INTERNAL_H_
#ifndef _WIN64
#include <setjmp.h>
#else
#include "libguile/setjump-win.h"
#endif
#include <libguile/vm.h>
#include <libguile/frames-internal.h>
#define SCM_VM_REGULAR_ENGINE 0
#define SCM_VM_DEBUG_ENGINE 1
#define SCM_VM_NUM_ENGINES 2
enum scm_compare {
SCM_F_COMPARE_NONE = 0x0,
SCM_F_COMPARE_EQUAL = 0x1,
SCM_F_COMPARE_LESS_THAN = 0x2,
SCM_F_COMPARE_INVALID = 0x3
};
struct scm_vm {
uint32_t *ip; /* instruction pointer */
union scm_vm_stack_element *sp; /* stack pointer */
union scm_vm_stack_element *fp; /* frame pointer */
union scm_vm_stack_element *stack_limit; /* stack limit address */
uint8_t compare_result; /* flags register: a value from scm_compare */
uint8_t apply_hook_enabled; /* if apply hook is enabled */
uint8_t return_hook_enabled; /* if return hook is enabled */
uint8_t next_hook_enabled; /* if next hook is enabled */
uint8_t abort_hook_enabled; /* if abort hook is enabled */
uint8_t disable_mcode; /* if mcode is disabled (because debugging) */
uint8_t engine; /* which vm engine we're using */
uint8_t unused; /* padding */
size_t stack_size; /* stack size */
union scm_vm_stack_element *stack_bottom; /* lowest address in allocated stack */
SCM apply_hook; /* apply hook */
SCM return_hook; /* return hook */
SCM next_hook; /* next hook */
SCM abort_hook; /* abort hook */
union scm_vm_stack_element *stack_top; /* highest address in allocated stack */
SCM overflow_handler_stack; /* alist of max-stack-size -> thunk */
jmp_buf *registers; /* registers captured at latest vm entry */
uint8_t *mra_after_abort; /* mra to resume after nonlocal exit, or NULL */
int trace_level; /* traces enabled if trace_level > 0 */
};
SCM_INTERNAL SCM scm_vm_add_apply_hook_x (SCM);
SCM_INTERNAL SCM scm_vm_add_return_hook_x (SCM);
SCM_INTERNAL SCM scm_vm_add_abort_hook_x (SCM);
SCM_INTERNAL SCM scm_vm_add_next_hook_x (SCM);
SCM_INTERNAL SCM scm_vm_remove_apply_hook_x (SCM);
SCM_INTERNAL SCM scm_vm_remove_return_hook_x (SCM);
SCM_INTERNAL SCM scm_vm_remove_abort_hook_x (SCM);
SCM_INTERNAL SCM scm_vm_remove_next_hook_x (SCM);
SCM_INTERNAL void scm_i_vm_prepare_stack (struct scm_vm *vp);
SCM_INTERNAL void scm_i_vm_free_stack (struct scm_vm *vp);
#define SCM_F_VM_CONT_PARTIAL 0x100
#define SCM_F_VM_CONT_REWINDABLE 0x200
struct scm_vm_cont {
/* vmcont tc7 in low 8 bits, partial and/or rewindable flags above. */
scm_t_bits tag_and_flags;
/* Saved dynamic stack, with prompts relocated to record saved SP/FP
offsets from the stack top of this scm_vm_cont. */
scm_t_dynstack *dynstack;
/* IP of newest frame. */
uint32_t *vra;
/* Machine code corresponding to IP. */
uint8_t *mra;
/* Offset of FP of newest frame, relative to stack top. */
ptrdiff_t fp_offset;
/* Besides being the stack size, this is also the offset of the SP of
the newest frame. */
ptrdiff_t stack_size;
/* Stack bottom, which also keeps saved stack alive for GC. */
union scm_vm_stack_element stack_slice[];
};
static inline int
scm_is_vm_cont (SCM x)
{
return SCM_HAS_TYP7 (x, scm_tc7_vm_cont);
}
static inline struct scm_vm_cont *
scm_to_vm_cont (SCM cont)
{
if (!scm_is_vm_cont (cont)) abort ();
return (struct scm_vm_cont *) SCM_UNPACK_POINTER (cont);
}
static inline SCM
scm_from_vm_cont (struct scm_vm_cont *cont)
{
return SCM_PACK_POINTER (cont);
}
static inline int
scm_vm_cont_is_partial (SCM cont)
{
return scm_to_vm_cont (cont)->tag_and_flags & SCM_F_VM_CONT_PARTIAL;
}
static inline int
scm_vm_cont_is_rewindable (SCM cont)
{
return scm_to_vm_cont (cont)->tag_and_flags & SCM_F_VM_CONT_REWINDABLE;
}
SCM_INTERNAL struct scm_vm_cont *scm_i_capture_current_stack (void);
SCM_INTERNAL int scm_i_vm_cont_to_frame (SCM cont, struct scm_frame *frame);
SCM_INTERNAL void scm_i_vm_cont_print (SCM x, SCM port,
scm_print_state *pstate);
SCM_INTERNAL void scm_i_vm_abort (SCM *tag_and_argv, size_t n) SCM_NORETURN;
SCM_INTERNAL void scm_i_vm_emergency_abort (SCM *tag_and_argv, size_t n) SCM_NORETURN;
SCM_INTERNAL SCM scm_i_call_with_current_continuation (SCM proc);
SCM_INTERNAL int scm_i_vm_is_boot_continuation_code (uint32_t *ip);
SCM_INTERNAL void scm_bootstrap_vm (void);
SCM_INTERNAL void scm_init_vm (void);
#endif /* _SCM_VM_INTERNAL_H_ */

2
libguile/vm.c
View file

@ -75,7 +75,7 @@
#include "posix-w32.h"
#endif
#include "vm.h"
#include "vm-internal.h"
#if (defined __GNUC__)
# define SCM_NOINLINE __attribute__ ((__noinline__))

124
libguile/vm.h
View file

@ -20,65 +20,13 @@
#ifndef _SCM_VM_H_
#define _SCM_VM_H_
#ifndef _WIN64
#include <setjmp.h>
#else
#include "libguile/setjump-win.h"
#endif
#include <libguile/gc.h>
#include <libguile/frames.h>
#define SCM_VM_REGULAR_ENGINE 0
#define SCM_VM_DEBUG_ENGINE 1
#define SCM_VM_NUM_ENGINES 2
enum scm_compare {
SCM_F_COMPARE_NONE = 0x0,
SCM_F_COMPARE_EQUAL = 0x1,
SCM_F_COMPARE_LESS_THAN = 0x2,
SCM_F_COMPARE_INVALID = 0x3
};
struct scm_vm {
uint32_t *ip; /* instruction pointer */
union scm_vm_stack_element *sp; /* stack pointer */
union scm_vm_stack_element *fp; /* frame pointer */
union scm_vm_stack_element *stack_limit; /* stack limit address */
uint8_t compare_result; /* flags register: a value from scm_compare */
uint8_t apply_hook_enabled; /* if apply hook is enabled */
uint8_t return_hook_enabled; /* if return hook is enabled */
uint8_t next_hook_enabled; /* if next hook is enabled */
uint8_t abort_hook_enabled; /* if abort hook is enabled */
uint8_t disable_mcode; /* if mcode is disabled (because debugging) */
uint8_t engine; /* which vm engine we're using */
uint8_t unused; /* padding */
size_t stack_size; /* stack size */
union scm_vm_stack_element *stack_bottom; /* lowest address in allocated stack */
SCM apply_hook; /* apply hook */
SCM return_hook; /* return hook */
SCM next_hook; /* next hook */
SCM abort_hook; /* abort hook */
union scm_vm_stack_element *stack_top; /* highest address in allocated stack */
SCM overflow_handler_stack; /* alist of max-stack-size -> thunk */
jmp_buf *registers; /* registers captured at latest vm entry */
uint8_t *mra_after_abort; /* mra to resume after nonlocal exit, or NULL */
int trace_level; /* traces enabled if trace_level > 0 */
};
SCM_API SCM scm_call_with_vm (SCM proc, SCM args);
SCM_API SCM scm_call_with_stack_overflow_handler (SCM limit, SCM thunk,
SCM handler);
SCM_INTERNAL SCM scm_vm_add_apply_hook_x (SCM);
SCM_INTERNAL SCM scm_vm_add_return_hook_x (SCM);
SCM_INTERNAL SCM scm_vm_add_abort_hook_x (SCM);
SCM_INTERNAL SCM scm_vm_add_next_hook_x (SCM);
SCM_INTERNAL SCM scm_vm_remove_apply_hook_x (SCM);
SCM_INTERNAL SCM scm_vm_remove_return_hook_x (SCM);
SCM_INTERNAL SCM scm_vm_remove_abort_hook_x (SCM);
SCM_INTERNAL SCM scm_vm_remove_next_hook_x (SCM);
SCM_API SCM scm_vm_trace_level (void);
SCM_API SCM scm_set_vm_trace_level_x (SCM level);
SCM_API SCM scm_vm_engine (void);
@ -87,78 +35,6 @@ SCM_API SCM scm_set_default_vm_engine_x (SCM engine);
SCM_API void scm_c_set_vm_engine_x (int engine);
SCM_API void scm_c_set_default_vm_engine_x (int engine);
SCM_INTERNAL void scm_i_vm_prepare_stack (struct scm_vm *vp);
SCM_INTERNAL void scm_i_vm_free_stack (struct scm_vm *vp);
#ifdef BUILDING_LIBGUILE
#define SCM_F_VM_CONT_PARTIAL 0x100
#define SCM_F_VM_CONT_REWINDABLE 0x200
struct scm_vm_cont {
/* vmcont tc7 in low 8 bits, partial and/or rewindable flags above. */
scm_t_bits tag_and_flags;
/* Saved dynamic stack, with prompts relocated to record saved SP/FP
offsets from the stack top of this scm_vm_cont. */
scm_t_dynstack *dynstack;
/* IP of newest frame. */
uint32_t *vra;
/* Machine code corresponding to IP. */
uint8_t *mra;
/* Offset of FP of newest frame, relative to stack top. */
ptrdiff_t fp_offset;
/* Besides being the stack size, this is also the offset of the SP of
the newest frame. */
ptrdiff_t stack_size;
/* Stack bottom, which also keeps saved stack alive for GC. */
union scm_vm_stack_element stack_slice[];
};
static inline int
scm_is_vm_cont (SCM x)
{
return SCM_HAS_TYP7 (x, scm_tc7_vm_cont);
}
static inline struct scm_vm_cont *
scm_to_vm_cont (SCM cont)
{
if (!scm_is_vm_cont (cont)) abort ();
return (struct scm_vm_cont *) SCM_UNPACK_POINTER (cont);
}
static inline SCM
scm_from_vm_cont (struct scm_vm_cont *cont)
{
return SCM_PACK_POINTER (cont);
}
static inline int
scm_vm_cont_is_partial (SCM cont)
{
return scm_to_vm_cont (cont)->tag_and_flags & SCM_F_VM_CONT_PARTIAL;
}
static inline int
scm_vm_cont_is_rewindable (SCM cont)
{
return scm_to_vm_cont (cont)->tag_and_flags & SCM_F_VM_CONT_REWINDABLE;
}
SCM_INTERNAL struct scm_vm_cont *scm_i_capture_current_stack (void);
SCM_INTERNAL int scm_i_vm_cont_to_frame (SCM cont, struct scm_frame *frame);
SCM_INTERNAL void scm_i_vm_cont_print (SCM x, SCM port,
scm_print_state *pstate);
#endif /* BUILDING_LIBGUILE */
SCM_INTERNAL void scm_i_vm_abort (SCM *tag_and_argv, size_t n) SCM_NORETURN;
SCM_INTERNAL void scm_i_vm_emergency_abort (SCM *tag_and_argv, size_t n) SCM_NORETURN;
SCM_API SCM scm_load_compiled_with_vm (SCM file);
SCM_INTERNAL SCM scm_i_call_with_current_continuation (SCM proc);
SCM_INTERNAL int scm_i_vm_is_boot_continuation_code (uint32_t *ip);
SCM_INTERNAL void scm_bootstrap_vm (void);
SCM_INTERNAL void scm_init_vm (void);
#endif /* _SCM_VM_H_ */