summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2018-06-18 10:23:04 +0200
committerAndy Wingo <wingo@pobox.com>2018-06-18 10:50:17 +0200
commit6f294ecc7522343be2774b18e2fe8e37ac58779c (patch)
treea564d7ff9c60443673167d6f8c913308a62f6c5b
parent8a6f46ee96e0946e539e3a33c95c3228b63e9fb3 (diff)
downloadguile-6f294ecc7522343be2774b18e2fe8e37ac58779c.tar.gz
Devolve more validate macros
* libguile.h: Add chooks.h. * libguile/Makefile.am: Add chooks.h and chooks.c. * libguile/chooks.c: * libguile/chooks.h: New files, for the C implementation of hooks. Broken out to avoid cycles in gc.h includes. * libguile/gc.h: * libguile/gc.c (scm_i_gc_admin_mutex, scm_i_sweep_mutex): Remove unused mutexes. Include chooks instead of hooks in the main header. * libguile/deprecated.h (scm_gc_running_p): Deprecate this macro always defined to 0. (SCM_VALIDATE_VECTOR_OR_DVECTOR): Deprecate this weird one too. * libguile/array-map.c: Add procs.h include. * libguile/threads.h: * libguile/vm.c: * libguile/r6rs-ports.c: Add smob.h include. * libguile/atomic.h (SCM_VALIDATE_ATOMIC_BOX): Devolve. * libguile/deprecation.c (scm_c_issue_deprecation_warning): Remove use of scm_gc_running_p. * libguile/error.c (scm_error_scm): Remove use of scm_gc_running_p. * libguile/filesys.h (SCM_VALIDATE_DIR) * libguile/fluids.h (SCM_VALIDATE_FLUID) * libguile/fports.h (SCM_VALIDATE_FPORT, SCM_VALIDATE_OPFPORT) * libguile/generalized-arrays.h (SCM_VALIDATE_ARRAY) * libguile/hooks.h (SCM_VALIDATE_HOOK) * libguile/keywords.h (SCM_VALIDATE_KEYWORD) * libguile/ports.h (SCM_VALIDATE_PORT, SCM_VALIDATE_INPUT_PORT) (SCM_VALIDATE_OUTPUT_PORT, SCM_VALIDATE_OPINPORT) (SCM_VALIDATE_OPENPORT, SCM_VALIDATE_OPPORT, SCM_VALIDATE_OPOUTPORT) * libguile/procs.h (SCM_VALIDATE_PROC) * libguile/random.h (SCM_VALIDATE_RSTATE) * libguile/regex-posix.h (SCM_VALIDATE_RGXP) * libguile/stacks.h (SCM_VALIDATE_STACK, SCM_VALIDATE_FRAME) * libguile/strports.h (SCM_VALIDATE_OPOUTSTRPORT) * libguile/struct.h (SCM_VALIDATE_STRUCT SCM_VALIDATE_VTABLE) * libguile/symbols.h (SCM_VALIDATE_SYMBOL) * libguile/variable.h (SCM_VALIDATE_VARIABLE) * libguile/vectors.h (SCM_VALIDATE_VECTOR SCM_VALIDATE_VECTOR_LEN): Devolve. * libguile/validate.h: It's empty now! hooks squish
-rw-r--r--libguile.h4
-rw-r--r--libguile/Makefile.am2
-rw-r--r--libguile/array-map.c1
-rw-r--r--libguile/atomic.h8
-rw-r--r--libguile/chooks.c114
-rw-r--r--libguile/chooks.h79
-rw-r--r--libguile/deprecated.h8
-rw-r--r--libguile/deprecation.c12
-rw-r--r--libguile/error.c7
-rw-r--r--libguile/filesys.h8
-rw-r--r--libguile/fluids.h7
-rw-r--r--libguile/fports.h9
-rw-r--r--libguile/gc.c3
-rw-r--r--libguile/gc.h8
-rw-r--r--libguile/generalized-arrays.h12
-rw-r--r--libguile/hooks.c84
-rw-r--r--libguile/hooks.h50
-rw-r--r--libguile/i18n.c1
-rw-r--r--libguile/keywords.h7
-rw-r--r--libguile/ports.h28
-rw-r--r--libguile/procs.h5
-rw-r--r--libguile/r6rs-ports.c1
-rw-r--r--libguile/random.h7
-rw-r--r--libguile/regex-posix.h6
-rw-r--r--libguile/stacks.h9
-rw-r--r--libguile/strports.h8
-rw-r--r--libguile/struct.h8
-rw-r--r--libguile/symbols.h11
-rw-r--r--libguile/threads.h1
-rw-r--r--libguile/validate.h102
-rw-r--r--libguile/variable.h8
-rw-r--r--libguile/vectors.h14
-rw-r--r--libguile/vm.c2
33 files changed, 363 insertions, 271 deletions
diff --git a/libguile.h b/libguile.h
index 3f7f0b791..e37b081c3 100644
--- a/libguile.h
+++ b/libguile.h
@@ -1,7 +1,8 @@
#ifndef SCM_LIBGUILE_H
#define SCM_LIBGUILE_H
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+/* Copyright (C) 1995-1998,2000-2004,2006,2008-2014,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 License
@@ -39,6 +40,7 @@ extern "C" {
#include "libguile/bitvectors.h"
#include "libguile/bytevectors.h"
#include "libguile/chars.h"
+#include "libguile/chooks.h"
#include "libguile/continuations.h"
#include "libguile/dynl.h"
#include "libguile/dynwind.h"
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 3d2eef9f4..286d3d152 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -130,6 +130,7 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = \
bitvectors.c \
bytevectors.c \
chars.c \
+ chooks.c \
control.c \
continuations.c \
debug.c \
@@ -591,6 +592,7 @@ modinclude_HEADERS = \
bitvectors.h \
bytevectors.h \
chars.h \
+ chooks.h \
control.h \
continuations.h \
debug-malloc.h \
diff --git a/libguile/array-map.c b/libguile/array-map.c
index c24b08837..d18527ba2 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -37,6 +37,7 @@
#include "libguile/vectors.h"
#include "libguile/bitvectors.h"
#include "libguile/srfi-4.h"
+#include "libguile/procs.h"
#include "libguile/generalized-arrays.h"
#include "libguile/validate.h"
diff --git a/libguile/atomic.h b/libguile/atomic.h
index 9a33f8d1a..0b19d9a83 100644
--- a/libguile/atomic.h
+++ b/libguile/atomic.h
@@ -1,7 +1,7 @@
#ifndef SCM_ATOMIC_H
#define SCM_ATOMIC_H
-/* Copyright (C) 2016 Free Software Foundation, Inc.
+/* Copyright (C) 2016, 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 License
@@ -39,6 +39,12 @@ scm_atomic_box_loc (SCM obj)
return SCM_CELL_OBJECT_LOC (obj, 1);
}
+#define SCM_VALIDATE_ATOMIC_BOX(pos, var) \
+ do { \
+ SCM_ASSERT_TYPE (scm_is_atomic_box (var), var, pos, FUNC_NAME, \
+ "atomic box"); \
+ } while (0)
+
#ifdef BUILDING_LIBGUILE
diff --git a/libguile/chooks.c b/libguile/chooks.c
new file mode 100644
index 000000000..9d4bed172
--- /dev/null
+++ b/libguile/chooks.c
@@ -0,0 +1,114 @@
+/* Copyright (C) 1995-1996,1998-2001,2003,2006,2008-2009,2011,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 License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library 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 this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <stdio.h>
+
+#include "libguile/__scm.h"
+#include "libguile/gc.h"
+#include "libguile/chooks.h"
+
+
+/* C level hooks
+ *
+ */
+
+/* Hint for `scm_gc_malloc ()' and friends. */
+static const char hook_entry_gc_hint[] = "hook entry";
+
+void
+scm_c_hook_init (scm_t_c_hook *hook, void *hook_data, scm_t_c_hook_type type)
+{
+ hook->first = 0;
+ hook->type = type;
+ hook->data = hook_data;
+}
+
+void
+scm_c_hook_add (scm_t_c_hook *hook,
+ scm_t_c_hook_function func,
+ void *fn_data,
+ int appendp)
+{
+ scm_t_c_hook_entry *entry;
+ scm_t_c_hook_entry **loc = &hook->first;
+
+ entry = scm_gc_malloc (sizeof (scm_t_c_hook_entry), hook_entry_gc_hint);
+ if (appendp)
+ while (*loc)
+ loc = &(*loc)->next;
+ entry->next = *loc;
+ entry->func = func;
+ entry->data = fn_data;
+ *loc = entry;
+}
+
+void
+scm_c_hook_remove (scm_t_c_hook *hook,
+ scm_t_c_hook_function func,
+ void *fn_data)
+{
+ scm_t_c_hook_entry **loc = &hook->first;
+ while (*loc)
+ {
+ if ((*loc)->func == func && (*loc)->data == fn_data)
+ {
+ *loc = (*loc)->next;
+ return;
+ }
+ loc = &(*loc)->next;
+ }
+ fprintf (stderr, "Attempt to remove non-existent hook function\n");
+ abort ();
+}
+
+void *
+scm_c_hook_run (scm_t_c_hook *hook, void *data)
+{
+ scm_t_c_hook_entry *entry = hook->first;
+ scm_t_c_hook_type type = hook->type;
+ void *res = 0;
+ while (entry)
+ {
+ res = (entry->func) (hook->data, entry->data, data);
+ if (res)
+ {
+ if (type == SCM_C_HOOK_OR)
+ break;
+ }
+ else
+ {
+ if (type == SCM_C_HOOK_AND)
+ break;
+ }
+ entry = entry->next;
+ }
+ return res;
+}
+
+/*
+ Local Variables:
+ c-file-style: "gnu"
+ End:
+*/
diff --git a/libguile/chooks.h b/libguile/chooks.h
new file mode 100644
index 000000000..873c36fc3
--- /dev/null
+++ b/libguile/chooks.h
@@ -0,0 +1,79 @@
+/* classes: h_files */
+
+#ifndef SCM_CHOOKS_H
+#define SCM_CHOOKS_H
+
+/* Copyright (C) 1995-1996,1999,2000-2001,2006,2008-2009,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 License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library 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 this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+#include "libguile/__scm.h"
+
+/*
+ * C level hooks
+ */
+
+/*
+ * The interface is designed for and- and or-type hooks which
+ * both may want to indicate success/failure and return a result.
+ */
+
+typedef enum scm_t_c_hook_type {
+ SCM_C_HOOK_NORMAL,
+ SCM_C_HOOK_OR,
+ SCM_C_HOOK_AND
+} scm_t_c_hook_type;
+
+typedef void *(*scm_t_c_hook_function) (void *hook_data,
+ void *fn_data,
+ void *data);
+
+typedef struct scm_t_c_hook_entry {
+ struct scm_t_c_hook_entry *next;
+ scm_t_c_hook_function func;
+ void *data;
+} scm_t_c_hook_entry;
+
+typedef struct scm_t_c_hook {
+ scm_t_c_hook_entry *first;
+ scm_t_c_hook_type type;
+ void *data;
+} scm_t_c_hook;
+
+SCM_API void scm_c_hook_init (scm_t_c_hook *hook,
+ void *hook_data,
+ scm_t_c_hook_type type);
+SCM_API void scm_c_hook_add (scm_t_c_hook *hook,
+ scm_t_c_hook_function func,
+ void *fn_data,
+ int appendp);
+SCM_API void scm_c_hook_remove (scm_t_c_hook *hook,
+ scm_t_c_hook_function func,
+ void *fn_data);
+SCM_API void *scm_c_hook_run (scm_t_c_hook *hook, void *data);
+
+
+#endif /* SCM_CHOOKS_H */
+
+/*
+ Local Variables:
+ c-file-style: "gnu"
+ End:
+*/
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index d1836192b..0c0f6e56b 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -36,6 +36,14 @@
#define scm_i_jmp_buf scm_i_jmp_buf_GONE__USE_JMP_BUF_INSTEAD
+#define SCM_VALIDATE_VECTOR_OR_DVECTOR(pos, v) \
+ do { \
+ SCM_ASSERT (scm_is_vector (v) || scm_is_true (scm_f64vector_p (v)), \
+ v, pos, FUNC_NAME); \
+ } while (0)
+
+#define scm_gc_running_p 0
+
void scm_i_init_deprecated (void);
#endif
diff --git a/libguile/deprecation.c b/libguile/deprecation.c
index aa50eaf8c..1ae8b6750 100644
--- a/libguile/deprecation.c
+++ b/libguile/deprecation.c
@@ -1,4 +1,5 @@
-/* Copyright (C) 2001, 2006, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 2001,2006,2010-2011,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 License
@@ -79,13 +80,8 @@ scm_c_issue_deprecation_warning (const char *msg)
which could recurse and deadlock. */
if (msg)
{
- if (scm_gc_running_p)
- fprintf (stderr, "%s\n", msg);
- else
- {
- scm_puts (msg, scm_current_warning_port ());
- scm_newline (scm_current_warning_port ());
- }
+ scm_puts (msg, scm_current_warning_port ());
+ scm_newline (scm_current_warning_port ());
}
}
}
diff --git a/libguile/error.c b/libguile/error.c
index 51bf65a2a..e998cbe26 100644
--- a/libguile/error.c
+++ b/libguile/error.c
@@ -85,13 +85,6 @@ SCM_DEFINE (scm_error_scm, "scm-error", 5, 0, 0,
"it will usually be @code{#f}.")
#define FUNC_NAME s_scm_error_scm
{
- if (scm_gc_running_p)
- {
- /* The error occured during GC --- abort */
- fprintf (stderr, "Guile: error during GC.\n"),
- abort ();
- }
-
scm_ithrow (key, scm_list_4 (subr, message, args, data), 1);
/* No return, but just in case: */
diff --git a/libguile/filesys.h b/libguile/filesys.h
index fc66e40b2..39a917f56 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -3,8 +3,8 @@
#ifndef SCM_FILESYS_H
#define SCM_FILESYS_H
-/* Copyright (C) 1995, 1997, 1998, 1999, 2000, 2001, 2006, 2008, 2009,
- * 2010, 2011, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1997-2001,2006,2008-2011,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 License
@@ -25,6 +25,7 @@
#include "libguile/__scm.h"
+#include <libguile/error.h>
@@ -35,6 +36,9 @@ SCM_API scm_t_bits scm_tc16_dir;
#define SCM_DIRP(x) (SCM_HAS_TYP16 (x, scm_tc16_dir))
#define SCM_DIR_OPEN_P(x) (SCM_SMOB_FLAGS (x) & SCM_DIR_FLAG_OPEN)
+#define SCM_VALIDATE_DIR(pos, port) \
+ SCM_MAKE_VALIDATE_MSG (pos, port, DIRP, "directory port")
+
SCM_API SCM scm_chown (SCM object, SCM owner, SCM group);
diff --git a/libguile/fluids.h b/libguile/fluids.h
index 7997ad4d3..b132f50ac 100644
--- a/libguile/fluids.h
+++ b/libguile/fluids.h
@@ -3,7 +3,8 @@
#ifndef SCM_FLUIDS_H
#define SCM_FLUIDS_H
-/* Copyright (C) 1996,2000,2001, 2006, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1996,2000-2001,2006,2008-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 License
@@ -24,6 +25,7 @@
#include "libguile/__scm.h"
+#include <libguile/error.h>
#include "libguile/vectors.h"
@@ -39,6 +41,9 @@
#define SCM_FLUID_P(x) (SCM_HAS_TYP7 (x, scm_tc7_fluid))
+#define SCM_VALIDATE_FLUID(pos, fluid) \
+ SCM_I_MAKE_VALIDATE_MSG2 (pos, fluid, scm_is_fluid, "fluid")
+
#ifdef BUILDING_LIBGUILE
# include <libguile/cache-internal.h>
diff --git a/libguile/fports.h b/libguile/fports.h
index e397fcc59..5f3de622a 100644
--- a/libguile/fports.h
+++ b/libguile/fports.h
@@ -3,8 +3,8 @@
#ifndef SCM_FPORTS_H
#define SCM_FPORTS_H
-/* Copyright (C) 1995-2001, 2006, 2008, 2009, 2011, 2012,
- * 2017 Free Software Foundation, Inc.
+/* Copyright (C) 1995-2001,2006,2008-2009,2011-2012,2017-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 License
@@ -51,6 +51,11 @@ SCM_API scm_t_port_type *scm_file_port_type;
#define SCM_OPINFPORTP(x) (SCM_OPFPORTP (x) && (SCM_CELL_WORD_0 (x) & SCM_RDNG))
#define SCM_OPOUTFPORTP(x) (SCM_OPFPORTP (x) && (SCM_CELL_WORD_0 (x) & SCM_WRTNG))
+#define SCM_VALIDATE_FPORT(pos, port) \
+ SCM_MAKE_VALIDATE_MSG (pos, port, FPORTP, "file port")
+#define SCM_VALIDATE_OPFPORT(pos, port) \
+ SCM_MAKE_VALIDATE_MSG (pos, port, OPFPORTP, "open file port")
+
SCM_API void scm_evict_ports (int fd);
SCM_INTERNAL int scm_i_mode_to_open_flags (SCM mode, int *is_binary,
diff --git a/libguile/gc.c b/libguile/gc.c
index 0551e9c45..646adff1a 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -40,6 +40,7 @@
#include "libguile/arrays.h"
#include "libguile/async.h"
#include "libguile/ports.h"
+#include "libguile/hooks.h"
#include "libguile/simpos.h"
#include "libguile/strings.h"
#include "libguile/vectors.h"
@@ -491,8 +492,6 @@ scm_storage_prehistory ()
scm_c_hook_init (&scm_after_gc_c_hook, 0, SCM_C_HOOK_NORMAL);
}
-scm_i_pthread_mutex_t scm_i_gc_admin_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
-
void
scm_init_gc_protect_object ()
{
diff --git a/libguile/gc.h b/libguile/gc.h
index 728bb0717..1b9adde79 100644
--- a/libguile/gc.h
+++ b/libguile/gc.h
@@ -26,8 +26,7 @@
#include "libguile/__scm.h"
-#include "libguile/hooks.h"
-#include "libguile/threads.h"
+#include "libguile/chooks.h"
/* Before Guile 2.0, Guile had a custom garbage collector and memory
@@ -88,11 +87,6 @@ typedef struct scm_t_cell
#define SCM_SET_CELL_TYPE(x, t) SCM_SET_CELL_WORD_0 ((x), (t))
-SCM_INTERNAL scm_i_pthread_mutex_t scm_i_gc_admin_mutex;
-
-#define scm_gc_running_p 0
-SCM_INTERNAL scm_i_pthread_mutex_t scm_i_sweep_mutex;
-
SCM_API unsigned long scm_gc_ports_collected;
diff --git a/libguile/generalized-arrays.h b/libguile/generalized-arrays.h
index cfa69051b..f3d6ddf22 100644
--- a/libguile/generalized-arrays.h
+++ b/libguile/generalized-arrays.h
@@ -3,7 +3,8 @@
#ifndef SCM_GENERALIZED_ARRAYS_H
#define SCM_GENERALIZED_ARRAYS_H
-/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009, 2013, 2014 Free Software Foundation, Inc.
+/* Copyright (C) 1995-1997,1999-2001,2004,2006,2008-2009,2013-2014,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 License
@@ -25,6 +26,7 @@
#include "libguile/__scm.h"
#include "libguile/array-handle.h"
+#include <libguile/error.h>
@@ -32,6 +34,14 @@
*/
+#define SCM_VALIDATE_ARRAY(pos, v) \
+ do { \
+ SCM_ASSERT (SCM_HEAP_OBJECT_P (v) \
+ && scm_is_true (scm_array_p (v, SCM_UNDEFINED)), \
+ v, pos, FUNC_NAME); \
+ } while (0)
+
+
/** Arrays */
SCM_API int scm_is_array (SCM obj);
diff --git a/libguile/hooks.c b/libguile/hooks.c
index 2a953a9b7..fce2ff387 100644
--- a/libguile/hooks.c
+++ b/libguile/hooks.c
@@ -1,4 +1,5 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2006, 2008, 2009, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995-1996,1998-2001,2003,2006,2008-2009,2011,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 License
@@ -35,87 +36,6 @@
#include "libguile/hooks.h"
-/* C level hooks
- *
- * Currently, this implementation is separate from the Scheme level
- * hooks. The possibility exists to implement the Scheme level hooks
- * using C level hooks.
- */
-
-/* Hint for `scm_gc_malloc ()' and friends. */
-static const char hook_entry_gc_hint[] = "hook entry";
-
-void
-scm_c_hook_init (scm_t_c_hook *hook, void *hook_data, scm_t_c_hook_type type)
-{
- hook->first = 0;
- hook->type = type;
- hook->data = hook_data;
-}
-
-void
-scm_c_hook_add (scm_t_c_hook *hook,
- scm_t_c_hook_function func,
- void *fn_data,
- int appendp)
-{
- scm_t_c_hook_entry *entry;
- scm_t_c_hook_entry **loc = &hook->first;
-
- entry = scm_gc_malloc (sizeof (scm_t_c_hook_entry), hook_entry_gc_hint);
- if (appendp)
- while (*loc)
- loc = &(*loc)->next;
- entry->next = *loc;
- entry->func = func;
- entry->data = fn_data;
- *loc = entry;
-}
-
-void
-scm_c_hook_remove (scm_t_c_hook *hook,
- scm_t_c_hook_function func,
- void *fn_data)
-{
- scm_t_c_hook_entry **loc = &hook->first;
- while (*loc)
- {
- if ((*loc)->func == func && (*loc)->data == fn_data)
- {
- *loc = (*loc)->next;
- return;
- }
- loc = &(*loc)->next;
- }
- fprintf (stderr, "Attempt to remove non-existent hook function\n");
- abort ();
-}
-
-void *
-scm_c_hook_run (scm_t_c_hook *hook, void *data)
-{
- scm_t_c_hook_entry *entry = hook->first;
- scm_t_c_hook_type type = hook->type;
- void *res = 0;
- while (entry)
- {
- res = (entry->func) (hook->data, entry->data, data);
- if (res)
- {
- if (type == SCM_C_HOOK_OR)
- break;
- }
- else
- {
- if (type == SCM_C_HOOK_AND)
- break;
- }
- entry = entry->next;
- }
- return res;
-}
-
-
/* Scheme level hooks
*
* A hook is basically a list of procedures to be called at well defined
diff --git a/libguile/hooks.h b/libguile/hooks.h
index dc930cb0a..d1a76ccf1 100644
--- a/libguile/hooks.h
+++ b/libguile/hooks.h
@@ -3,7 +3,8 @@
#ifndef SCM_HOOKS_H
#define SCM_HOOKS_H
-/* Copyright (C) 1995,1996,1999,2000,2001, 2006, 2008, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 1995-1996,1999,2000-2001,2006,2008-2009,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 License
@@ -24,49 +25,8 @@
#include "libguile/__scm.h"
-
-/*
- * C level hooks
- */
-
-/*
- * The interface is designed for and- and or-type hooks which
- * both may want to indicate success/failure and return a result.
- */
-
-typedef enum scm_t_c_hook_type {
- SCM_C_HOOK_NORMAL,
- SCM_C_HOOK_OR,
- SCM_C_HOOK_AND
-} scm_t_c_hook_type;
-
-typedef void *(*scm_t_c_hook_function) (void *hook_data,
- void *fn_data,
- void *data);
-
-typedef struct scm_t_c_hook_entry {
- struct scm_t_c_hook_entry *next;
- scm_t_c_hook_function func;
- void *data;
-} scm_t_c_hook_entry;
-
-typedef struct scm_t_c_hook {
- scm_t_c_hook_entry *first;
- scm_t_c_hook_type type;
- void *data;
-} scm_t_c_hook;
-
-SCM_API void scm_c_hook_init (scm_t_c_hook *hook,
- void *hook_data,
- scm_t_c_hook_type type);
-SCM_API void scm_c_hook_add (scm_t_c_hook *hook,
- scm_t_c_hook_function func,
- void *fn_data,
- int appendp);
-SCM_API void scm_c_hook_remove (scm_t_c_hook *hook,
- scm_t_c_hook_function func,
- void *fn_data);
-SCM_API void *scm_c_hook_run (scm_t_c_hook *hook, void *data);
+#include <libguile/error.h>
+#include <libguile/smob.h>
/*
* Scheme level hooks
@@ -79,6 +39,8 @@ SCM_API scm_t_bits scm_tc16_hook;
#define SCM_HOOK_PROCEDURES(hook) SCM_SMOB_OBJECT (hook)
#define SCM_SET_HOOK_PROCEDURES(hook, procs) SCM_SET_SMOB_OBJECT ((hook), (procs))
+#define SCM_VALIDATE_HOOK(pos, a) SCM_MAKE_VALIDATE_MSG (pos, a, HOOKP, "hook")
+
SCM_API SCM scm_make_hook (SCM n_args);
SCM_API SCM scm_hook_p (SCM x);
SCM_API SCM scm_hook_empty_p (SCM hook);
diff --git a/libguile/i18n.c b/libguile/i18n.c
index 0f8b0ea7b..efb5dd5af 100644
--- a/libguile/i18n.c
+++ b/libguile/i18n.c
@@ -30,6 +30,7 @@
#include "libguile/chars.h"
#include "libguile/dynwind.h"
#include "libguile/syscalls.h"
+#include "libguile/smob.h"
#include "libguile/validate.h"
#include "libguile/values.h"
#include "libguile/threads.h"
diff --git a/libguile/keywords.h b/libguile/keywords.h
index 32311dd49..547984949 100644
--- a/libguile/keywords.h
+++ b/libguile/keywords.h
@@ -3,7 +3,8 @@
#ifndef SCM_KEYWORDS_H
#define SCM_KEYWORDS_H
-/* Copyright (C) 1995,1996,1999,2000,2001, 2006, 2008, 2015 Free Software Foundation, Inc.
+/* Copyright (C) 1995-1996,1999-2001,2006,2008,2015,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 License
@@ -24,6 +25,7 @@
#include "libguile/__scm.h"
+#include <libguile/error.h>
@@ -37,6 +39,9 @@ SCM_API SCM scm_from_locale_keywordn (const char *name, size_t len);
SCM_API SCM scm_from_latin1_keyword (const char *name);
SCM_API SCM scm_from_utf8_keyword (const char *name);
+#define SCM_VALIDATE_KEYWORD(pos, v) \
+ SCM_MAKE_VALIDATE_MSG (pos, v, KEYWORDP, "keyword")
+
enum scm_keyword_arguments_flags
{
SCM_ALLOW_OTHER_KEYS = (1U << 0),
diff --git a/libguile/ports.h b/libguile/ports.h
index d131db5be..eb7c5e990 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -3,8 +3,8 @@
#ifndef SCM_PORTS_H
#define SCM_PORTS_H
-/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004,
- * 2006, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+/* Copyright (C) 1995-2001,2003-2004,2006,2008-2014,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 License
@@ -87,6 +87,30 @@ typedef struct scm_t_port scm_t_port;
#define SCM_PORT_TYPE(port) ((scm_t_port_type *) SCM_CELL_WORD_3 (port))
+#define SCM_VALIDATE_PORT(pos, port) \
+ SCM_MAKE_VALIDATE_MSG (pos, port, PORTP, "port")
+
+#define SCM_VALIDATE_INPUT_PORT(pos, port) \
+ SCM_MAKE_VALIDATE_MSG (pos, port, INPUT_PORT_P, "input port")
+
+#define SCM_VALIDATE_OUTPUT_PORT(pos, port) \
+ SCM_MAKE_VALIDATE_MSG (pos, port, OUTPUT_PORT_P, "output port")
+
+#define SCM_VALIDATE_OPINPORT(pos, port) \
+ SCM_MAKE_VALIDATE_MSG (pos, port, OPINPORTP, "open input port")
+
+#define SCM_VALIDATE_OPENPORT(pos, port) \
+ do { \
+ SCM_ASSERT (SCM_PORTP (port) && SCM_OPENP (port), \
+ port, pos, FUNC_NAME); \
+ } while (0)
+
+#define SCM_VALIDATE_OPPORT(pos, port) \
+ SCM_MAKE_VALIDATE_MSG (pos, port, OPPORTP, "open port")
+
+#define SCM_VALIDATE_OPOUTPORT(pos, port) \
+ SCM_MAKE_VALIDATE_MSG (pos, port, OPOUTPORTP, "open output port")
+
/* Port types, and their vtables. */
diff --git a/libguile/procs.h b/libguile/procs.h
index 51ae441f3..5415f84a4 100644
--- a/libguile/procs.h
+++ b/libguile/procs.h
@@ -34,6 +34,11 @@
SCM_ASSERT (scm_is_true (scm_thunk_p (thunk)), thunk, pos, FUNC_NAME); \
} while (0)
+#define SCM_VALIDATE_PROC(pos, proc) \
+ do { \
+ SCM_ASSERT (scm_is_true (scm_procedure_p (proc)), proc, pos, FUNC_NAME); \
+ } while (0)
+
SCM_API SCM scm_procedure_p (SCM obj);
SCM_API SCM scm_thunk_p (SCM obj);
SCM_API SCM scm_procedure_with_setter_p (SCM obj);
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index 15646be72..34b790a76 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -32,6 +32,7 @@
#include "libguile/extensions.h"
#include "libguile/r6rs-ports.h"
#include "libguile/strings.h"
+#include "libguile/smob.h"
#include "libguile/validate.h"
#include "libguile/values.h"
#include "libguile/vectors.h"
diff --git a/libguile/random.h b/libguile/random.h
index 109969e01..57afdbf56 100644
--- a/libguile/random.h
+++ b/libguile/random.h
@@ -3,7 +3,8 @@
#ifndef SCM_RANDOM_H
#define SCM_RANDOM_H
-/* Copyright (C) 1999,2000,2001, 2006, 2008, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1999-2001,2006,2008,2010,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 License
@@ -24,6 +25,7 @@
#include "libguile/__scm.h"
+#include <libguile/error.h>
/*
@@ -78,6 +80,9 @@ SCM_API scm_t_bits scm_tc16_rstate;
#define SCM_RSTATEP(obj) SCM_SMOB_PREDICATE (scm_tc16_rstate, obj)
#define SCM_RSTATE(obj) ((scm_t_rstate *) SCM_SMOB_DATA (obj))
+#define SCM_VALIDATE_RSTATE(pos, v) \
+ SCM_MAKE_VALIDATE_MSG (pos, v, RSTATEP, "random-generator-state")
+
SCM_API unsigned char scm_masktab[256];
SCM_API SCM scm_var_random_state;
diff --git a/libguile/regex-posix.h b/libguile/regex-posix.h
index 8060fe3b7..3a84b37e7 100644
--- a/libguile/regex-posix.h
+++ b/libguile/regex-posix.h
@@ -3,7 +3,8 @@
#ifndef SCM_REGEX_POSIX_H
#define SCM_REGEX_POSIX_H
-/* Copyright (C) 1997,1998,2000,2001, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1997-1998,2000-2001,2006,2008,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 License
@@ -24,11 +25,14 @@
#include "libguile/__scm.h"
+#include <libguile/error.h>
SCM_API scm_t_bits scm_tc16_regex;
#define SCM_RGX(X) ((regex_t *) SCM_SMOB_DATA (X))
#define SCM_RGXP(X) (SCM_SMOB_PREDICATE (scm_tc16_regex, (X)))
+#define SCM_VALIDATE_RGXP(pos, a) SCM_MAKE_VALIDATE_MSG (pos, a, RGXP, "regexp")
+
SCM_API SCM scm_make_regexp (SCM pat, SCM flags);
SCM_API SCM scm_regexp_p (SCM x);
SCM_API SCM scm_regexp_exec (SCM rx, SCM str, SCM start, SCM flags);
diff --git a/libguile/stacks.h b/libguile/stacks.h
index ba97e0892..498a90169 100644
--- a/libguile/stacks.h
+++ b/libguile/stacks.h
@@ -3,7 +3,8 @@
#ifndef SCM_STACKS_H
#define SCM_STACKS_H
-/* Copyright (C) 1995,1996,2000,2001, 2004, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995-1996,2000-2001,2004,2006,2008,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 License
@@ -24,6 +25,7 @@
#include "libguile/__scm.h"
+#include <libguile/error.h>
#include "libguile/frames.h"
/* {Frames and stacks}
@@ -46,6 +48,11 @@ SCM_API SCM scm_stack_type;
#define SCM_FRAMEP(obj) (SCM_VM_FRAME_P (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")
+
diff --git a/libguile/strports.h b/libguile/strports.h
index 42080928b..7f1af48f1 100644
--- a/libguile/strports.h
+++ b/libguile/strports.h
@@ -3,7 +3,8 @@
#ifndef SCM_STRPORTS_H
#define SCM_STRPORTS_H
-/* Copyright (C) 1995,1996,2000,2001,2002, 2006, 2008, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995-1996,2000-2002,2006,2008,2010-2011,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 License
@@ -24,6 +25,8 @@
#include "libguile/__scm.h"
+#include <libguile/error.h>
+#include <libguile/ports.h>
@@ -37,6 +40,9 @@
#define SCM_OPOUTSTRPORTP(x) (SCM_OPSTRPORTP (x) && \
(SCM_CELL_WORD_0 (x) & SCM_WRTNG))
+#define SCM_VALIDATE_OPOUTSTRPORT(pos, port) \
+ SCM_MAKE_VALIDATE_MSG (pos, port, OPOUTSTRPORTP, "open output string port")
+
SCM_API scm_t_port_type *scm_string_port_type;
diff --git a/libguile/struct.h b/libguile/struct.h
index 66812eea8..fad4dadbb 100644
--- a/libguile/struct.h
+++ b/libguile/struct.h
@@ -25,6 +25,7 @@
#include "libguile/__scm.h"
+#include <libguile/error.h>
#include "libguile/print.h"
@@ -117,6 +118,13 @@ typedef void (*scm_t_struct_finalize) (SCM obj);
#define SCM_STRUCT_DATA_REF(X,I) (SCM_STRUCT_DATA (X)[(I)])
#define SCM_STRUCT_DATA_SET(X,I,V) SCM_STRUCT_DATA (X)[(I)]=(V)
+#define SCM_VALIDATE_STRUCT(pos, v) \
+ SCM_MAKE_VALIDATE_MSG (pos, v, STRUCTP, "struct")
+#define SCM_VALIDATE_VTABLE(pos, v) \
+ do { \
+ SCM_ASSERT (scm_is_true (scm_struct_vtable_p (v)), v, pos, FUNC_NAME); \
+ } while (0)
+
/* The SCM_VTABLE_* macros assume that you're passing them a struct which is a
valid vtable. */
#define SCM_VTABLE_LAYOUT(X) (SCM_STRUCT_SLOT_REF ((X), scm_vtable_index_layout))
diff --git a/libguile/symbols.h b/libguile/symbols.h
index f345e7033..7789dd757 100644
--- a/libguile/symbols.h
+++ b/libguile/symbols.h
@@ -3,7 +3,8 @@
#ifndef SCM_SYMBOLS_H
#define SCM_SYMBOLS_H
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006, 2008, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995-1998,2000-2001,2003-2004,2006,2008,2010-2011,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 License
@@ -24,6 +25,9 @@
#include "libguile/__scm.h"
+#include <libguile/error.h>
+
+
#define scm_is_symbol(x) (SCM_HAS_TYP7 (x, scm_tc7_symbol))
@@ -33,6 +37,11 @@
#define SCM_I_F_SYMBOL_UNINTERNED 0x100
+#define SCM_VALIDATE_SYMBOL(pos, str) \
+ do { \
+ SCM_ASSERT_TYPE (scm_is_symbol (str), str, pos, FUNC_NAME, "symbol"); \
+ } while (0)
+
/* Older spellings; don't use in new code.
diff --git a/libguile/threads.h b/libguile/threads.h
index e56994c8a..e46211eeb 100644
--- a/libguile/threads.h
+++ b/libguile/threads.h
@@ -31,6 +31,7 @@
#include "libguile/throw.h"
#include "libguile/dynstack.h"
#include "libguile/iselect.h"
+#include "libguile/smob.h"
#include "libguile/continuations.h"
#if SCM_USE_PTHREAD_THREADS
diff --git a/libguile/validate.h b/libguile/validate.h
index 66aa38b28..39569209c 100644
--- a/libguile/validate.h
+++ b/libguile/validate.h
@@ -24,108 +24,6 @@
/* Written by Greg J. Badros <gjb@cs.washington.edu>, Dec-1999 */
-
-
-#include <libguile/error.h>
-
-
-
-
-#define SCM_VALIDATE_SYMBOL(pos, str) \
- do { \
- SCM_ASSERT_TYPE (scm_is_symbol (str), str, pos, FUNC_NAME, "symbol"); \
- } while (0)
-
-#define SCM_VALIDATE_VARIABLE(pos, var) SCM_MAKE_VALIDATE_MSG (pos, var, VARIABLEP, "variable")
-
-#define SCM_VALIDATE_ATOMIC_BOX(pos, var) \
- do { \
- SCM_ASSERT_TYPE (scm_is_atomic_box (var), var, pos, FUNC_NAME, \
- "atomic box"); \
- } while (0)
-
-#define SCM_VALIDATE_PROC(pos, proc) \
- do { \
- SCM_ASSERT (scm_is_true (scm_procedure_p (proc)), proc, pos, FUNC_NAME); \
- } while (0)
-
-#define SCM_VALIDATE_HOOK(pos, a) SCM_MAKE_VALIDATE_MSG (pos, a, HOOKP, "hook")
-
-#define SCM_VALIDATE_RGXP(pos, a) SCM_MAKE_VALIDATE_MSG (pos, a, RGXP, "regexp")
-
-#define SCM_VALIDATE_DIR(pos, port) SCM_MAKE_VALIDATE_MSG (pos, port, DIRP, "directory port")
-
-#define SCM_VALIDATE_PORT(pos, port) SCM_MAKE_VALIDATE_MSG (pos, port, PORTP, "port")
-
-#define SCM_VALIDATE_INPUT_PORT(pos, port) \
- SCM_MAKE_VALIDATE_MSG (pos, port, INPUT_PORT_P, "input port")
-
-#define SCM_VALIDATE_OUTPUT_PORT(pos, port) \
- SCM_MAKE_VALIDATE_MSG (pos, port, OUTPUT_PORT_P, "output port")
-
-#define SCM_VALIDATE_FPORT(pos, port) SCM_MAKE_VALIDATE_MSG (pos, port, FPORTP, "file port")
-
-#define SCM_VALIDATE_OPFPORT(pos, port) SCM_MAKE_VALIDATE_MSG (pos, port, OPFPORTP, "open file port")
-
-#define SCM_VALIDATE_OPINPORT(pos, port) \
- SCM_MAKE_VALIDATE_MSG (pos, port, OPINPORTP, "open input port")
-
-#define SCM_VALIDATE_OPENPORT(pos, port) \
- do { \
- SCM_ASSERT (SCM_PORTP (port) && SCM_OPENP (port), \
- port, pos, FUNC_NAME); \
- } while (0)
-
-#define SCM_VALIDATE_OPPORT(pos, port) SCM_MAKE_VALIDATE_MSG (pos, port, OPPORTP, "open port")
-
-#define SCM_VALIDATE_OPOUTPORT(pos, port) \
- SCM_MAKE_VALIDATE_MSG (pos, port, OPOUTPORTP, "open output port")
-
-#define SCM_VALIDATE_OPOUTSTRPORT(pos, port) \
- SCM_MAKE_VALIDATE_MSG (pos, port, OPOUTSTRPORTP, "open output string port")
-
-#define SCM_VALIDATE_FLUID(pos, fluid) \
- SCM_I_MAKE_VALIDATE_MSG2 (pos, fluid, scm_is_fluid, "fluid")
-
-#define SCM_VALIDATE_KEYWORD(pos, v) SCM_MAKE_VALIDATE_MSG (pos, v, KEYWORDP, "keyword")
-
-#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")
-
-#define SCM_VALIDATE_RSTATE(pos, v) SCM_MAKE_VALIDATE_MSG (pos, v, RSTATEP, "random-generator-state")
-
-#define SCM_VALIDATE_ARRAY(pos, v) \
- do { \
- SCM_ASSERT (SCM_HEAP_OBJECT_P (v) \
- && scm_is_true (scm_array_p (v, SCM_UNDEFINED)), \
- v, pos, FUNC_NAME); \
- } while (0)
-
-#define SCM_VALIDATE_VECTOR(pos, v) \
- do { \
- SCM_ASSERT (scm_is_vector (v), v, pos, FUNC_NAME); \
- } while (0)
-
-#define SCM_VALIDATE_VECTOR_OR_DVECTOR(pos, v) \
- do { \
- SCM_ASSERT (scm_is_vector (v) || scm_is_true (scm_f64vector_p (v)), \
- v, pos, FUNC_NAME); \
- } while (0)
-
-#define SCM_VALIDATE_STRUCT(pos, v) SCM_MAKE_VALIDATE_MSG (pos, v, STRUCTP, "struct")
-
-#define SCM_VALIDATE_VTABLE(pos, v) \
- do { \
- SCM_ASSERT (scm_is_true (scm_struct_vtable_p (v)), v, pos, FUNC_NAME); \
- } while (0)
-
-#define SCM_VALIDATE_VECTOR_LEN(pos, v, len) \
- do { \
- SCM_ASSERT (scm_is_vector (v) && len == scm_c_vector_length (v), v, pos, FUNC_NAME); \
- } while (0)
-
-
#endif /* SCM_VALIDATE_H */
/*
diff --git a/libguile/variable.h b/libguile/variable.h
index c024c8519..6262e0c52 100644
--- a/libguile/variable.h
+++ b/libguile/variable.h
@@ -3,7 +3,8 @@
#ifndef SCM_VARIABLE_H
#define SCM_VARIABLE_H
-/* Copyright (C) 1995,1996,2000,2001, 2006, 2008, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995-1996,2000-2001,2006,2008,2011,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 License
@@ -24,7 +25,7 @@
#include "libguile/__scm.h"
-#include "libguile/smob.h"
+#include <libguile/error.h>
@@ -35,6 +36,9 @@
#define SCM_VARIABLE_SET(V, X) SCM_SET_CELL_OBJECT_1 (V, X)
#define SCM_VARIABLE_LOC(V) (SCM_CELL_OBJECT_LOC ((V), 1))
+#define SCM_VALIDATE_VARIABLE(pos, var) \
+ SCM_MAKE_VALIDATE_MSG (pos, var, VARIABLEP, "variable")
+
SCM_API SCM scm_make_variable (SCM init);
diff --git a/libguile/vectors.h b/libguile/vectors.h
index d279787c8..a3db9f0b6 100644
--- a/libguile/vectors.h
+++ b/libguile/vectors.h
@@ -3,7 +3,8 @@
#ifndef SCM_VECTORS_H
#define SCM_VECTORS_H
-/* Copyright (C) 1995,1996,1998,2000,2001,2002,2004,2005, 2006, 2008, 2009, 2011, 2014 Free Software Foundation, Inc.
+/* Copyright (C) 1995-1996,1998,2000-2002,2004-2006,2008-2009,2011,2014,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 License
@@ -24,6 +25,7 @@
#include "libguile/__scm.h"
+#include <libguile/error.h>
@@ -54,6 +56,16 @@ SCM_API SCM *scm_vector_writable_elements (SCM vec,
scm_t_array_handle *h,
size_t *lenp, ssize_t *incp);
+#define SCM_VALIDATE_VECTOR(pos, v) \
+ do { \
+ SCM_ASSERT (scm_is_vector (v), v, pos, FUNC_NAME); \
+ } while (0)
+
+#define SCM_VALIDATE_VECTOR_LEN(pos, v, len) \
+ do { \
+ SCM_ASSERT (scm_is_vector (v) && len == scm_c_vector_length (v), v, pos, FUNC_NAME); \
+ } while (0)
+
/* Fast, non-checking accessors for simple vectors.
*/
#define SCM_SIMPLE_VECTOR_LENGTH(x) SCM_I_VECTOR_LENGTH(x)
diff --git a/libguile/vm.c b/libguile/vm.c
index 7ab298657..400f7b8d7 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -50,6 +50,8 @@
#include "libguile/alist.h"
#include "libguile/procprop.h"
#include "libguile/stackchk.h"
+#include "libguile/hooks.h"
+#include "libguile/smob.h"
#include "libguile/frames.h"
#include "libguile/gc-inline.h"
#include "libguile/instructions.h"