mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 06:20:23 +02:00
Code Activity

* load.c: #include "dynwind.h";

Browse source 
(scm_primitive_load): Use scm_inner_dynamic_wind to update
scm_cur_loadp.
This commit is contained in:
Mikael Djurfeldt 1998-06-18 21:53:45 +00:00
parent 1a64191ee6
commit d7834b915b
1 changed files with 30 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

38
libguile/load.c
View file

@ -48,6 +48,7 @@
#include "eval.h" #include "eval.h"
#include "throw.h" #include "throw.h"
#include "alist.h" #include "alist.h"
#include "dynwind.h"
#include "load.h" #include "load.h"
@ -69,6 +70,28 @@
Applied to the full name of the file. */ Applied to the full name of the file. */
static SCM *scm_loc_load_hook; static SCM *scm_loc_load_hook;
void
swap_port (void *data)
{
SCM *save_port = data, tmp = scm_cur_loadp;
scm_cur_loadp = *save_port;
*save_port = tmp;
}
static SCM
load (void *data)
{
SCM port = (SCM) data, form;
while (1)
{
form = scm_read (port);
if (SCM_EOF_OBJECT_P (form))
break;
scm_eval_x (form);
}
return SCM_UNSPECIFIED;
}
SCM_PROC(s_primitive_load, "primitive-load", 1, 0, 0, scm_primitive_load); SCM_PROC(s_primitive_load, "primitive-load", 1, 0, 0, scm_primitive_load);
SCM SCM
scm_primitive_load (filename) scm_primitive_load (filename)
@ -86,16 +109,15 @@ scm_primitive_load (filename)
scm_apply (hook, scm_listify (filename, SCM_UNDEFINED), SCM_EOL); scm_apply (hook, scm_listify (filename, SCM_UNDEFINED), SCM_EOL);
{ {
SCM form, port; SCM port, save_port;
port = scm_open_file (filename, port = scm_open_file (filename,
scm_makfromstr ("r", (scm_sizet) sizeof (char), 0)); scm_makfromstr ("r", (scm_sizet) sizeof (char), 0));
while (1) save_port = port;
{ scm_internal_dynamic_wind (swap_port,
form = scm_read (port); load,
if (SCM_EOF_OBJECT_P (form)) swap_port,
break; (void *) port,
scm_eval_x (form); &save_port);
}
scm_close_port (port); scm_close_port (port);
} }
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;