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

frames, values: BUILDING_LIBGUILE-guarded defs to internal headers

Browse source 
I was writing the trace function, which is included by Whippet, which
doesn't have the BUILDING_LIBGUILE define.  It is just as fine to put
these in private headers; better, even.

* libguile/frames-internal.h:
* libguile/values-internal.h: New files.
* libguile/Makefile.am (noinst_HEADERS): Add new files.
* libguile/backtrace.c:
* libguile/continuations.c:
* libguile/control.c:
* libguile/eval.c:
* libguile/frames.c:
* libguile/frames.h:
* libguile/gsubr.c:
* libguile/init.c:
* libguile/intrinsics.c:
* libguile/numbers.c:
* libguile/print.c:
* libguile/smob.c:
* libguile/smob.h:
* libguile/stacks.c:
* libguile/stacks.h:
* libguile/values.c:
* libguile/values.h:
* libguile/vm.c: Include new files.
This commit is contained in:
Andy Wingo 2025-07-01 10:43:14 +02:00
parent 65a265adea
commit 6a32628e18
21 changed files with 213 additions and 148 deletions
Download patch file Download diff file Expand all files Collapse all files

2
libguile/Makefile.am
View file

@ -522,6 +522,7 @@ noinst_HEADERS = atomic.h \
dynstack.h \
filesys-internal.h \
fluids-internal.h \
frames-internal.h \
gc-inline.h \
gc-internal.h \
gsubr-internal.h \
@ -538,6 +539,7 @@ noinst_HEADERS = atomic.h \
syntax.h \
threads-internal.h \
trace.h \
values-internal.h \
vectors-internal.h \
whippet-embedder.h

4
libguile/backtrace.c
View file

@ -37,7 +37,7 @@
#include "eval.h"
#include "filesys.h"
#include "fluids.h"
#include "frames.h"
#include "frames-internal.h"
#include "gsubr.h"
#include "keywords.h"
#include "list.h"
@ -113,7 +113,7 @@ scm_print_exception (SCM port, SCM frame, SCM key, SCM args)
SCM_VALIDATE_OPOUTPORT (1, port);
if (scm_is_true (frame))
SCM_VALIDATE_FRAME (2, frame);
SCM_VALIDATE_VM_FRAME (2, frame);
SCM_VALIDATE_SYMBOL (3, key);
SCM_VALIDATE_LIST (4, args);

1
libguile/continuations.c
View file

@ -34,6 +34,7 @@
#include "debug.h"
#include "dynstack.h"
#include "eval.h"
#include "frames-internal.h"
#include "gc-internal.h"
#include "gsubr.h"
#include "init.h"

2
libguile/control.c
View file

@ -25,7 +25,7 @@
#include "dynstack.h"
#include "extensions.h"
#include "frames.h"
#include "frames-internal.h"
#include "gsubr.h"
#include "instructions.h"
#include "jit.h"

4
libguile/eval.c
View file

@ -37,7 +37,7 @@
#include "eq.h"
#include "expand.h"
#include "feature.h"
#include "frames.h"
#include "frames-internal.h"
#include "fluids.h"
#include "goops.h"
#include "gsubr-internal.h"
@ -60,7 +60,7 @@
#include "symbols.h"
#include "threads-internal.h"
#include "throw.h"
#include "values.h"
#include "values-internal.h"
#include "variable.h"
#include "vectors.h"
#include "vm.h"

111
libguile/frames-internal.h Normal file
View file

@ -0,0 +1,111 @@
/* Copyright 2001,2009-2015,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_FRAMES_INTERNAL_H_
#define _SCM_FRAMES_INTERNAL_H_
#include <libguile/frames.h>
struct scm_frame
{
void *stack_holder;
ptrdiff_t fp_offset;
ptrdiff_t sp_offset;
uint32_t *ip;
};
struct scm_vm_frame
{
scm_t_bits tag_and_flags;
struct scm_frame frame;
};
enum scm_vm_frame_kind
{
SCM_VM_FRAME_KIND_VM,
SCM_VM_FRAME_KIND_CONT
};
static inline int
scm_is_vm_frame (SCM x)
{
return SCM_HAS_TYP7 (x, scm_tc7_frame);
}
#define SCM_VM_FRAME_P(x) (scm_is_vm_frame (x))
#define SCM_VALIDATE_VM_FRAME(p,x) SCM_MAKE_VALIDATE (p, x, VM_FRAME_P)
static inline struct scm_vm_frame*
scm_vm_frame (SCM x)
{
if (!scm_is_vm_frame (x))
abort ();
return (struct scm_vm_frame *) SCM_UNPACK_POINTER (x);
}
static inline enum scm_vm_frame_kind
scm_vm_frame_kind (struct scm_vm_frame *frame)
{
return (enum scm_vm_frame_kind) (frame->tag_and_flags >> 8);
}
SCM_INTERNAL union scm_vm_stack_element*
scm_vm_frame_stack_top (struct scm_vm_frame *frame);
static inline union scm_vm_stack_element*
scm_vm_frame_fp (struct scm_vm_frame *frame)
{
return scm_vm_frame_stack_top (frame) - frame->frame.fp_offset;
}
static inline union scm_vm_stack_element*
scm_vm_frame_sp (struct scm_vm_frame *frame)
{
return scm_vm_frame_stack_top (frame) - frame->frame.sp_offset;
}
static inline uint32_t*
scm_vm_frame_ip (struct scm_vm_frame *frame)
{
return frame->frame.ip;
}
/* See notes in frames.c before using this. */
SCM_INTERNAL SCM scm_c_frame_closure (enum scm_vm_frame_kind kind,
const struct scm_frame *frame);
SCM_INTERNAL SCM scm_c_make_frame (enum scm_vm_frame_kind kind,
const struct scm_frame *frame);
SCM_INTERNAL int scm_c_frame_previous (enum scm_vm_frame_kind kind,
struct scm_frame *frame);
static inline void
scm_frame_init_from_vm_frame (struct scm_frame *frame,
const struct scm_vm_frame *vm_frame)
{
memcpy (frame, &vm_frame->frame, sizeof (*frame));
}
SCM_INTERNAL void scm_i_frame_print (SCM frame, SCM port,
scm_print_state *pstate);
SCM_INTERNAL void scm_init_frames (void);
#endif /* _SCM_FRAMES_INTERNAL_H_ */

2
libguile/frames.c
View file

@ -40,7 +40,7 @@
#include "version.h"
#include "vm.h"
#include "frames.h"
#include "frames-internal.h"
SCM

89
libguile/frames.h
View file

@ -118,91 +118,6 @@ union scm_vm_stack_element
* Heap frames
*/
#ifdef BUILDING_LIBGUILE
struct scm_frame
{
void *stack_holder;
ptrdiff_t fp_offset;
ptrdiff_t sp_offset;
uint32_t *ip;
};
struct scm_vm_frame
{
scm_t_bits tag_and_flags;
struct scm_frame frame;
};
enum scm_vm_frame_kind
{
SCM_VM_FRAME_KIND_VM,
SCM_VM_FRAME_KIND_CONT
};
static inline int
scm_is_vm_frame (SCM x)
{
return SCM_HAS_TYP7 (x, scm_tc7_frame);
}
#define SCM_VM_FRAME_P(x) (scm_is_vm_frame (x))
#define SCM_VALIDATE_VM_FRAME(p,x) SCM_MAKE_VALIDATE (p, x, VM_FRAME_P)
static inline struct scm_vm_frame*
scm_vm_frame (SCM x)
{
if (!scm_is_vm_frame (x))
abort ();
return (struct scm_vm_frame *) SCM_UNPACK_POINTER (x);
}
static inline enum scm_vm_frame_kind
scm_vm_frame_kind (struct scm_vm_frame *frame)
{
return (enum scm_vm_frame_kind) (frame->tag_and_flags >> 8);
}
SCM_INTERNAL union scm_vm_stack_element*
scm_vm_frame_stack_top (struct scm_vm_frame *frame);
static inline union scm_vm_stack_element*
scm_vm_frame_fp (struct scm_vm_frame *frame)
{
return scm_vm_frame_stack_top (frame) - frame->frame.fp_offset;
}
static inline union scm_vm_stack_element*
scm_vm_frame_sp (struct scm_vm_frame *frame)
{
return scm_vm_frame_stack_top (frame) - frame->frame.sp_offset;
}
static inline uint32_t*
scm_vm_frame_ip (struct scm_vm_frame *frame)
{
return frame->frame.ip;
}
/* See notes in frames.c before using this. */
SCM_INTERNAL SCM scm_c_frame_closure (enum scm_vm_frame_kind kind,
const struct scm_frame *frame);
SCM_INTERNAL SCM scm_c_make_frame (enum scm_vm_frame_kind kind,
const struct scm_frame *frame);
SCM_INTERNAL int scm_c_frame_previous (enum scm_vm_frame_kind kind,
struct scm_frame *frame);
static inline void
scm_frame_init_from_vm_frame (struct scm_frame *frame,
const struct scm_vm_frame *vm_frame)
{
memcpy (frame, &vm_frame->frame, sizeof (*frame));
}
#endif
SCM_API SCM scm_frame_p (SCM obj);
SCM_API SCM scm_frame_procedure_name (SCM frame);
SCM_API SCM scm_frame_call_representation (SCM frame);
@ -215,8 +130,4 @@ SCM_API SCM scm_frame_return_address (SCM frame);
SCM_API SCM scm_frame_dynamic_link (SCM frame);
SCM_API SCM scm_frame_previous (SCM frame);
SCM_INTERNAL void scm_i_frame_print (SCM frame, SCM port,
scm_print_state *pstate);
SCM_INTERNAL void scm_init_frames (void);
#endif /* _SCM_FRAMES_H_ */

2
libguile/gsubr.c
View file

@ -29,7 +29,7 @@
#include <string.h>
#include "foreign.h"
#include "frames.h"
#include "frames-internal.h"
#include "gc-inline.h"
#include "instructions.h"
#include "jit.h"

4
libguile/init.c
View file

@ -73,7 +73,7 @@
#include "foreign-object.h"
#include "foreign.h"
#include "fports.h"
#include "frames.h"
#include "frames-internal.h"
#include "gc.h"
#include "gc-internal.h"
#include "generalized-vectors.h"
@ -136,7 +136,7 @@
#include "throw.h"
#include "unicode.h"
#include "uniform.h"
#include "values.h"
#include "values-internal.h"
#include "variable.h"
#include "vectors-internal.h"
#include "version.h"

2
libguile/intrinsics.c
View file

@ -30,7 +30,7 @@
#include "cache-internal.h"
#include "extensions.h"
#include "fluids-internal.h"
#include "frames.h"
#include "frames-internal.h"
#include "gc-inline.h"
#include "goops.h"
#include "gsubr.h"

2
libguile/numbers.c
View file

@ -72,7 +72,7 @@
#include "simpos.h"
#include "strings-internal.h"
#include "threads-internal.h"
#include "values.h"
#include "values-internal.h"
#include "numbers.h"

4
libguile/print.c
View file

@ -47,7 +47,7 @@
#include "filesys-internal.h"
#include "fluids-internal.h"
#include "foreign.h"
#include "frames.h"
#include "frames-internal.h"
#include "goops.h"
#include "gsubr.h"
#include "hashtab.h"
@ -69,7 +69,7 @@
#include "symbols.h"
#include "syntax.h"
#include "threads-internal.h"
#include "values.h"
#include "values-internal.h"
#include "variable.h"
#include "vectors.h"
#include "vm.h"

22
libguile/smob.c
View file

@ -283,11 +283,20 @@ SCM
scm_new_smob (scm_t_bits tc, scm_t_bits data)
{
scm_t_bits smobnum = SCM_TC2SMOBNUM (tc);
const scm_smob_descriptor* desc = &scm_smobs[smobnum];
scm_smob_descriptor* desc = &scm_smobs[smobnum];
scm_thread *thr = SCM_I_CURRENT_THREAD;
struct scm_single_smob *ret;
size_t sz = sizeof (*ret);
scm_i_pthread_mutex_lock (&scm_i_misc_mutex);
if (desc->observed_size != 2)
{
if (desc->observed_size)
abort ();
desc->observed_size = 2;
}
scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
if (desc->field_count)
{
if (desc->field_count != 1)
@ -317,11 +326,20 @@ scm_new_double_smob (scm_t_bits tc, scm_t_bits data1,
scm_t_bits data2, scm_t_bits data3)
{
scm_t_bits smobnum = SCM_TC2SMOBNUM (tc);
const scm_smob_descriptor* desc = &scm_smobs[smobnum];
scm_smob_descriptor* desc = &scm_smobs[smobnum];
scm_thread *thr = SCM_I_CURRENT_THREAD;
struct scm_double_smob *ret;
size_t sz = sizeof (*ret);
scm_i_pthread_mutex_lock (&scm_i_misc_mutex);
if (desc->observed_size != 4)
{
if (desc->observed_size)
abort ();
desc->observed_size = 4;
}
scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
if (desc->field_count)
{
if (!(desc->field_count == 2 || desc->field_count == 3))

1
libguile/smob.h
View file

@ -42,6 +42,7 @@ typedef struct scm_smob_descriptor
SCM apply_trampoline;
size_t field_count;
uint32_t unmanaged_fields;
size_t observed_size;
} scm_smob_descriptor;

2
libguile/stacks.c
View file

@ -30,7 +30,7 @@
#include "debug.h"
#include "eval.h"
#include "fluids.h"
#include "frames.h" /* vm frames */
#include "frames-internal.h" /* vm frames */
#include "gsubr.h"
#include "list.h"
#include "macros.h"

4
libguile/stacks.h
View file

@ -43,12 +43,8 @@ SCM_API SCM scm_stack_type;
#define SCM_STACK_FRAME(obj) (SCM_STRUCT_SLOT_REF (obj,2))
#define SCM_SET_STACK_FRAME(obj,f) (SCM_STRUCT_SLOT_SET (obj,2,f))
#define SCM_FRAMEP(obj) (scm_is_vm_frame (obj))
#define SCM_VALIDATE_STACK(pos, v) \
SCM_MAKE_VALIDATE_MSG (pos, v, STACKP, "stack")
#define SCM_VALIDATE_FRAME(pos, v) \
SCM_MAKE_VALIDATE_MSG (pos, v, FRAMEP, "frame")

62
libguile/values-internal.h Normal file
View file

@ -0,0 +1,62 @@
#ifndef SCM_VALUES_INTERNAL_H
#define SCM_VALUES_INTERNAL_H
/* Copyright 2000-2001,2006,2008,2012,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/>. */
#include "libguile/values.h"
struct scm_values
{
scm_t_bits tag_and_count;
SCM values[];
};
static inline struct scm_values*
scm_to_values (SCM x)
{
if (!scm_is_values (x))
abort ();
return (struct scm_values*) SCM_UNPACK_POINTER (x);
}
static inline SCM
scm_from_values (struct scm_values *values)
{
return SCM_PACK_POINTER (values);
}
static inline size_t
scm_values_count (struct scm_values *x)
{
return x->tag_and_count >> 8;
}
static inline SCM
scm_values_ref (struct scm_values *values, size_t n)
{
return values->values[n];
}
SCM_INTERNAL void scm_values_extract_2 (SCM obj, SCM *p1, SCM *p2);
SCM_INTERNAL void scm_init_values (void);
#endif /* SCM_VALUES_INTERNAL_H */

2
libguile/values.c
View file

@ -29,7 +29,7 @@
#include "pairs.h"
#include "threads-internal.h"
#include "values.h"
#include "values-internal.h"
/* OBJ must be a values object containing exactly two values.

37
libguile/values.h
View file

@ -30,50 +30,13 @@ scm_is_values (SCM x)
return SCM_HAS_TYP7 (x, scm_tc7_values);
}
#ifdef BUILDING_LIBGUILE
struct scm_values
{
scm_t_bits tag_and_count;
SCM values[];
};
static inline struct scm_values*
scm_to_values (SCM x)
{
if (!scm_is_values (x))
abort ();
return (struct scm_values*) SCM_UNPACK_POINTER (x);
}
static inline SCM
scm_from_values (struct scm_values *values)
{
return SCM_PACK_POINTER (values);
}
static inline size_t
scm_values_count (struct scm_values *x)
{
return x->tag_and_count >> 8;
}
static inline SCM
scm_values_ref (struct scm_values *values, size_t n)
{
return values->values[n];
}
#endif
#define SCM_VALUESP(x) (scm_is_values (x))
SCM_INTERNAL void scm_values_extract_2 (SCM obj, SCM *p1, SCM *p2);
SCM_API SCM scm_values (SCM args);
SCM_API SCM scm_c_values (SCM *base, size_t n);
SCM_API SCM scm_values_2 (SCM a, SCM b);
SCM_API SCM scm_values_3 (SCM a, SCM b, SCM c);
SCM_API size_t scm_c_nvalues (SCM obj);
SCM_API SCM scm_c_value_ref (SCM obj, size_t idx);
SCM_INTERNAL void scm_init_values (void);
#endif /* SCM_VALUES_H */

2
libguile/vm.c
View file

@ -46,7 +46,7 @@
#include "eval.h"
#include "extensions.h"
#include "foreign.h"
#include "frames.h"
#include "frames-internal.h"
#include "gc-inline.h"
#include "gsubr-internal.h"
#include "instructions.h"