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:
parent
9b7ca73cfe
commit
b9c100d008
4 changed files with 104 additions and 0 deletions
|
@ -116,6 +116,7 @@ libguile_la_SOURCES = \
|
|||
bitvectors.c \
|
||||
bytevectors.c \
|
||||
chars.c \
|
||||
control.c \
|
||||
continuations.c \
|
||||
debug.c \
|
||||
deprecated.c \
|
||||
|
@ -217,6 +218,7 @@ DOT_X_FILES = \
|
|||
bitvectors.x \
|
||||
bytevectors.x \
|
||||
chars.x \
|
||||
control.x \
|
||||
continuations.x \
|
||||
debug.x \
|
||||
deprecated.x \
|
||||
|
@ -316,6 +318,7 @@ DOT_DOC_FILES = \
|
|||
bitvectors.doc \
|
||||
bytevectors.doc \
|
||||
chars.doc \
|
||||
control.doc \
|
||||
continuations.doc \
|
||||
debug.doc \
|
||||
deprecated.doc \
|
||||
|
@ -473,6 +476,7 @@ modinclude_HEADERS = \
|
|||
bitvectors.h \
|
||||
bytevectors.h \
|
||||
chars.h \
|
||||
control.h \
|
||||
continuations.h \
|
||||
debug-malloc.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/bytevectors.h"
|
||||
#include "libguile/chars.h"
|
||||
#include "libguile/control.h"
|
||||
#include "libguile/continuations.h"
|
||||
#include "libguile/debug.h"
|
||||
#ifdef GUILE_DEBUG_MALLOC
|
||||
|
@ -453,6 +454,7 @@ scm_i_init_guile (SCM_STACKITEM *base)
|
|||
scm_bootstrap_programs ();
|
||||
scm_bootstrap_vm ();
|
||||
scm_register_foreign ();
|
||||
scm_register_control ();
|
||||
|
||||
scm_init_strings (); /* Requires array-handle */
|
||||
scm_init_struct (); /* Requires strings */
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue