mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 11:50:28 +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:
parent
9b7ca73cfe
commit
b9c100d008
4 changed files with 104 additions and 0 deletions
|
@ -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
72
libguile/control.c
Normal 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
26
libguile/control.h
Normal 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 */
|
|
@ -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 */
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue