1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

add @control and @prompt stub primitives

* libguile/Makefile.am:
* libguile/control.c:
* libguile/control.h:
* libguile/init.c: Add stub @control and @prompt primitives, for use
  when bootstrapping (ice-9 control).
This commit is contained in:
Andy Wingo 2010-01-31 00:01:11 +01:00
parent 9b7ca73cfe
commit b9c100d008
4 changed files with 104 additions and 0 deletions

View file

@ -116,6 +116,7 @@ libguile_la_SOURCES = \
bitvectors.c \ bitvectors.c \
bytevectors.c \ bytevectors.c \
chars.c \ chars.c \
control.c \
continuations.c \ continuations.c \
debug.c \ debug.c \
deprecated.c \ deprecated.c \
@ -217,6 +218,7 @@ DOT_X_FILES = \
bitvectors.x \ bitvectors.x \
bytevectors.x \ bytevectors.x \
chars.x \ chars.x \
control.x \
continuations.x \ continuations.x \
debug.x \ debug.x \
deprecated.x \ deprecated.x \
@ -316,6 +318,7 @@ DOT_DOC_FILES = \
bitvectors.doc \ bitvectors.doc \
bytevectors.doc \ bytevectors.doc \
chars.doc \ chars.doc \
control.doc \
continuations.doc \ continuations.doc \
debug.doc \ debug.doc \
deprecated.doc \ deprecated.doc \
@ -473,6 +476,7 @@ modinclude_HEADERS = \
bitvectors.h \ bitvectors.h \
bytevectors.h \ bytevectors.h \
chars.h \ chars.h \
control.h \
continuations.h \ continuations.h \
debug-malloc.h \ debug-malloc.h \
debug.h \ debug.h \

72
libguile/control.c Normal file
View file

@ -0,0 +1,72 @@
/* Copyright (C) 2010 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
*/
#if HAVE_CONFIG_H
# include <config.h>
#endif
#include "libguile/_scm.h"
#include "libguile/control.h"
SCM scm_atcontrol (SCM, SCM, SCM);
SCM_DEFINE (scm_atcontrol, "@control", 3, 0, 0,
(SCM tag, SCM type, SCM args),
"Transfer control to the handler of a delimited continuation.")
#define FUNC_NAME s_scm_atcontrol
{
abort ();
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
SCM scm_atprompt (SCM, SCM, SCM, SCM);
SCM_DEFINE (scm_atprompt, "@prompt", 4, 0, 0,
(SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler),
"Begin a delimited continuation.")
#define FUNC_NAME s_scm_atprompt
{
abort ();
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
static void
scm_init_control (void)
{
#ifndef SCM_MAGIC_SNARFER
#include "libguile/control.x"
#endif
}
void
scm_register_control (void)
{
scm_c_register_extension ("libguile", "scm_init_control",
(scm_t_extension_init_func)scm_init_control,
NULL);
}
/*
Local Variables:
c-file-style: "gnu"
End:
*/

26
libguile/control.h Normal file
View file

@ -0,0 +1,26 @@
/* Copyright (C) 2010 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
*/
#ifndef SCM_CONTROL_H
#define SCM_CONTROL_H
SCM_INTERNAL void scm_register_control (void);
#endif /* SCM_CONTROL_H */

View file

@ -41,6 +41,7 @@
#include "libguile/boolean.h" #include "libguile/boolean.h"
#include "libguile/bytevectors.h" #include "libguile/bytevectors.h"
#include "libguile/chars.h" #include "libguile/chars.h"
#include "libguile/control.h"
#include "libguile/continuations.h" #include "libguile/continuations.h"
#include "libguile/debug.h" #include "libguile/debug.h"
#ifdef GUILE_DEBUG_MALLOC #ifdef GUILE_DEBUG_MALLOC
@ -453,6 +454,7 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_bootstrap_programs (); scm_bootstrap_programs ();
scm_bootstrap_vm (); scm_bootstrap_vm ();
scm_register_foreign (); scm_register_foreign ();
scm_register_control ();
scm_init_strings (); /* Requires array-handle */ scm_init_strings (); /* Requires array-handle */
scm_init_struct (); /* Requires strings */ scm_init_struct (); /* Requires strings */