mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

Devolve more validate macros

Browse source 
* 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
This commit is contained in:
Andy Wingo 2018-06-18 10:23:04 +02:00
parent 8a6f46ee96
commit 6f294ecc75
33 changed files with 363 additions and 271 deletions
Download patch file Download diff file Expand all files Collapse all files

4
libguile.h
View file

@ -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"

2
libguile/Makefile.am
View file

@ -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 \

1
libguile/array-map.c
View file

@ -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"

8
libguile/atomic.h
View file

@ -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

114
libguile/chooks.c Normal file
View file

@ -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:
*/

79
libguile/chooks.h Normal file
View file

@ -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:
*/

8
libguile/deprecated.h
View file

@ -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

12
libguile/deprecation.c
View file

@ -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 ());
}
}
}

7
libguile/error.c
View file

@ -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: */

8
libguile/filesys.h
View file

@ -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);

7
libguile/fluids.h
View file

@ -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>

9
libguile/fports.h
View file

@ -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,

3
libguile/gc.c
View file

@ -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 ()
{

8
libguile/gc.h
View file

@ -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;

12
libguile/generalized-arrays.h
View file

@ -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);

84
libguile/hooks.c
View file

@ -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
@ -34,87 +35,6 @@
#include "libguile/validate.h"
#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
*

50
libguile/hooks.h
View file

@ -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);

1
libguile/i18n.c
View file

@ -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"

7
libguile/keywords.h
View file

@ -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),

28
libguile/ports.h
View file

@ -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. */

5
libguile/procs.h
View file

@ -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);

1
libguile/r6rs-ports.c
View file

@ -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"

7
libguile/random.h
View file

@ -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;

6
libguile/regex-posix.h
View file

@ -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);

9
libguile/stacks.h
View file

@ -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")

8
libguile/strports.h
View file

@ -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;

8
libguile/struct.h
View file

@ -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))

11
libguile/symbols.h
View file

@ -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.

1
libguile/threads.h
View file

@ -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

102
libguile/validate.h
View file

@ -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 */
/*

8
libguile/variable.h
View file

@ -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);

14
libguile/vectors.h
View file

@ -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)

2
libguile/vm.c
View file

@ -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"