guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 22/86: Devolve more validate macros


From: Andy Wingo
Subject: [Guile-commits] 22/86: Devolve more validate macros
Date: Wed, 20 Jun 2018 14:09:32 -0400 (EDT)

wingo pushed a commit to branch master
in repository guile.

commit 6f294ecc7522343be2774b18e2fe8e37ac58779c
Author: Andy Wingo <address@hidden>
Date:   Mon Jun 18 10:23:04 2018 +0200

    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
---
 libguile.h                     |   4 +-
 libguile/Makefile.am           |   2 +
 libguile/array-map.c           |   1 +
 libguile/atomic.h              |   8 ++-
 libguile/chooks.c              | 114 +++++++++++++++++++++++++++++++++++++++++
 libguile/{hooks.h => chooks.h} |  31 ++---------
 libguile/deprecated.h          |   8 +++
 libguile/deprecation.c         |  12 ++---
 libguile/error.c               |   7 ---
 libguile/filesys.h             |   8 ++-
 libguile/fluids.h              |   7 ++-
 libguile/fports.h              |   9 +++-
 libguile/gc.c                  |   3 +-
 libguile/gc.h                  |   8 +--
 libguile/generalized-arrays.h  |  12 ++++-
 libguile/hooks.c               |  84 +-----------------------------
 libguile/hooks.h               |  50 +++---------------
 libguile/i18n.c                |   1 +
 libguile/keywords.h            |   7 ++-
 libguile/ports.h               |  28 +++++++++-
 libguile/procs.h               |   5 ++
 libguile/r6rs-ports.c          |   1 +
 libguile/random.h              |   7 ++-
 libguile/regex-posix.h         |   6 ++-
 libguile/stacks.h              |   9 +++-
 libguile/strports.h            |   8 ++-
 libguile/struct.h              |   8 +++
 libguile/symbols.h             |  11 +++-
 libguile/threads.h             |   1 +
 libguile/validate.h            | 102 ------------------------------------
 libguile/variable.h            |   8 ++-
 libguile/vectors.h             |  14 ++++-
 libguile/vm.c                  |   2 +
 33 files changed, 289 insertions(+), 297 deletions(-)

diff --git a/libguile.h b/libguile.h
index 3f7f0b7..e37b081 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 3d2eef9..286d3d1 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -130,6 +130,7 @@ address@hidden@_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 c24b088..d18527b 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 9a33f8d..0b19d9a 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 0000000..9d4bed1
--- /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/hooks.h b/libguile/chooks.h
similarity index 65%
copy from libguile/hooks.h
copy to libguile/chooks.h
index dc930cb..873c36f 100644
--- a/libguile/hooks.h
+++ b/libguile/chooks.h
@@ -1,9 +1,10 @@
 /* classes: h_files */
 
-#ifndef SCM_HOOKS_H
-#define SCM_HOOKS_H
+#ifndef SCM_CHOOKS_H
+#define SCM_CHOOKS_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
@@ -68,30 +69,8 @@ SCM_API void scm_c_hook_remove (scm_t_c_hook *hook,
                                void *fn_data);
 SCM_API void *scm_c_hook_run (scm_t_c_hook *hook, void *data);
 
-/*
- * Scheme level hooks
- */
-
-SCM_API scm_t_bits scm_tc16_hook;
-
-#define SCM_HOOKP(x)                   SCM_SMOB_PREDICATE (scm_tc16_hook, x)
-#define SCM_HOOK_ARITY(hook)           SCM_SMOB_FLAGS (hook)
-#define SCM_HOOK_PROCEDURES(hook)      SCM_SMOB_OBJECT (hook)
-#define SCM_SET_HOOK_PROCEDURES(hook, procs) SCM_SET_SMOB_OBJECT ((hook), 
(procs))
-
-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);
-SCM_API SCM scm_add_hook_x (SCM hook, SCM thunk, SCM appendp);
-SCM_API SCM scm_remove_hook_x (SCM hook, SCM thunk);
-SCM_API SCM scm_reset_hook_x (SCM hook);
-SCM_API SCM scm_run_hook (SCM hook, SCM args);
-SCM_API void scm_c_run_hook (SCM hook, SCM args);
-SCM_API void scm_c_run_hookn (SCM hook, SCM *argv, size_t nargs);
-SCM_API SCM scm_hook_to_list (SCM hook);
-SCM_INTERNAL void scm_init_hooks (void);
 
-#endif  /* SCM_HOOKS_H */
+#endif  /* SCM_CHOOKS_H */
 
 /*
   Local Variables:
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index d183619..0c0f6e5 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 aa50eaf..1ae8b67 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 51bf65a..e998cbe 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 fc66e40..39a917f 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 7997ad4..b132f50 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 e397fcc..5f3de62 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 0551e9c..646adff 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 728bb07..1b9adde 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 cfa6905..f3d6ddf 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 2a953a9..fce2ff3 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 dc930cb..d1a76cc 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 0f8b0ea..efb5dd5 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 32311dd..5479849 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 d131db5..eb7c5e9 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 51ae441..5415f84 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 15646be..34b790a 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 109969e..57afdbf 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 8060fe3..3a84b37 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 ba97e08..498a901 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 4208092..7f1af48 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 66812ee..fad4dad 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 f345e70..7789dd7 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 e56994c..e46211e 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 66aa38b..3956920 100644
--- a/libguile/validate.h
+++ b/libguile/validate.h
@@ -24,108 +24,6 @@
 
 /* Written by Greg J. Badros <address@hidden>, 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 c024c85..6262e0c 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 d279787..a3db9f0 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 7ab2986..400f7b8 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"



reply via email to

[Prev in Thread] Current Thread [Next in Thread]