* init.c (scm_boot_guile_1): Added scm_init_objects ().
Added #include "objects.h" * eval.c (scm_makprom): Added SCM_DEFER_INTS and SCM_ALLOW_INTS. Add #include "feature.h". * ports.h (SCM_EOF_OBJECT_P): New macro predicate. This test is needed at many places in the code and should be abstracted. (Motivated by the need of this test in libguiletk.) * ports.c (scm_eof_object_p), vports.c (sfgetc), strports.c (scm_eval_string), load.c (scm_primitive_load, scm_read_and_eval_x), gh_eval.c (gh_eval_str): Use SCM_EOF_OBJECT_P. * eval.c (scm_init_eval): Add feature `delay'.
This commit is contained in:
Mikael Djurfeldt
parent
25eaf21abc
commit
0c32d76caf
9 changed files with 82 additions and 7 deletions
|
|
@ -1,4 +1,22 @@
|
|||
Sat Sep 20 15:17:58 1997 Mikael Djurfeldt <mdj@kenneth>
|
||||
Mon Sep 22 01:21:54 1997 Mikael Djurfeldt <mdj@kenneth>
|
||||
|
||||
* init.c (scm_boot_guile_1): Added scm_init_objects ().
|
||||
Added #include "objects.h"
|
||||
|
||||
* eval.c (scm_makprom): Added SCM_DEFER_INTS and SCM_ALLOW_INTS.
|
||||
Add #include "feature.h".
|
||||
|
||||
* Makefile.am (libguile_la_SOURCES): Added objects.c.
|
||||
(modinclude_HEADERS): Added objects.h.
|
||||
|
||||
* ports.h (SCM_EOF_OBJECT_P): New macro predicate.
|
||||
This test is needed at many places in the code and should be
|
||||
abstracted. (Motivated by the need of this test in libguiletk.)
|
||||
|
||||
* ports.c (scm_eof_object_p), vports.c (sfgetc), strports.c
|
||||
(scm_eval_string), load.c (scm_primitive_load,
|
||||
scm_read_and_eval_x), gh_eval.c (gh_eval_str):
|
||||
Use SCM_EOF_OBJECT_P.
|
||||
|
||||
* eval.c (scm_init_eval): Add feature `delay'.
|
||||
|
||||
|
|
|
|||
|
|
@ -93,6 +93,8 @@ char *alloca ();
|
|||
|
||||
#include "srcprop.h"
|
||||
#include "stackchk.h"
|
||||
#include "objects.h"
|
||||
#include "feature.h"
|
||||
|
||||
#include "eval.h"
|
||||
|
||||
|
|
@ -2203,6 +2205,25 @@ evapply:
|
|||
goto cdrxbegin;
|
||||
case scm_tc7_contin:
|
||||
scm_call_continuation (proc, t.arg1);
|
||||
case scm_tcs_cons_gloc:
|
||||
if (SCM_I_ENTITYP (proc))
|
||||
{
|
||||
x = SCM_ENTITY_PROC_1 (proc);
|
||||
if (SCM_TYP7 (x) == scm_tc7_subr_2)
|
||||
RETURN (SCM_SUBRF (x) (proc, t.arg1))
|
||||
else if (SCM_CLOSUREP (x))
|
||||
{
|
||||
arg2 = t.arg1;
|
||||
t.arg1 = proc;
|
||||
proc = x;
|
||||
#ifdef DEVAL
|
||||
debug.info->a.args = scm_cons (t.arg1, debug.info->a.args);
|
||||
debug.info->a.proc = proc;
|
||||
#endif
|
||||
goto clos2;
|
||||
}
|
||||
/* Fall through. */
|
||||
}
|
||||
case scm_tc7_subr_2:
|
||||
case scm_tc7_subr_0:
|
||||
case scm_tc7_subr_3:
|
||||
|
|
@ -2261,6 +2282,28 @@ evapply:
|
|||
proc = SCM_CCLO_SUBR(proc);
|
||||
goto evap3; */
|
||||
#endif
|
||||
case scm_tcs_cons_gloc:
|
||||
if (SCM_I_ENTITYP (proc))
|
||||
{
|
||||
x = SCM_ENTITY_PROC_2 (proc);
|
||||
if (SCM_TYP7 (x) == scm_tc7_subr_3)
|
||||
RETURN (SCM_SUBRF (x) (proc, t.arg1, arg2))
|
||||
else if (SCM_CLOSUREP (x))
|
||||
{
|
||||
#ifdef DEVAL
|
||||
SCM_SET_ARGSREADY (debug);
|
||||
debug.info->a.args = scm_cons (proc, debug.info->a.args);
|
||||
debug.info->a.proc = x;
|
||||
#endif
|
||||
env = EXTEND_ENV (SCM_CAR (SCM_CODE (x)),
|
||||
scm_cons2 (proc, t.arg1,
|
||||
scm_cons (arg2, env)),
|
||||
SCM_ENV (proc));
|
||||
x = SCM_CODE (proc);
|
||||
goto cdrxbegin;
|
||||
}
|
||||
/* Fall through. */
|
||||
}
|
||||
case scm_tc7_subr_0:
|
||||
case scm_tc7_cxr:
|
||||
case scm_tc7_subr_1o:
|
||||
|
|
@ -2271,6 +2314,7 @@ evapply:
|
|||
default:
|
||||
goto badfun;
|
||||
case scm_tcs_closures:
|
||||
clos2:
|
||||
#ifdef DEVAL
|
||||
env = EXTEND_ENV (SCM_CAR (SCM_CODE (proc)), debug.info->a.args, SCM_ENV (proc));
|
||||
#else
|
||||
|
|
@ -2285,6 +2329,7 @@ evapply:
|
|||
scm_deval_args (x, env, SCM_CDRLOC (SCM_CDR (debug.info->a.args))));
|
||||
#endif
|
||||
ENTER_APPLY;
|
||||
evap3:
|
||||
switch (SCM_TYP7 (proc))
|
||||
{ /* have 3 or more arguments */
|
||||
#ifdef DEVAL
|
||||
|
|
@ -2377,6 +2422,9 @@ evapply:
|
|||
x = SCM_CODE (proc);
|
||||
goto cdrxbegin;
|
||||
#endif /* DEVAL */
|
||||
case scm_tcs_cons_gloc:
|
||||
if (SCM_I_ENTITYP (proc))
|
||||
;
|
||||
case scm_tc7_subr_2:
|
||||
case scm_tc7_subr_1o:
|
||||
case scm_tc7_subr_2o:
|
||||
|
|
@ -2728,6 +2776,9 @@ tail:
|
|||
#endif
|
||||
goto tail;
|
||||
#endif
|
||||
case scm_tcs_cons_gloc:
|
||||
if (SCM_I_ENTITYP (proc))
|
||||
;
|
||||
wrongnumargs:
|
||||
scm_wrong_num_args (proc);
|
||||
default:
|
||||
|
|
@ -2883,8 +2934,10 @@ scm_makprom (code)
|
|||
{
|
||||
register SCM z;
|
||||
SCM_NEWCELL (z);
|
||||
SCM_DEFER_INTS;
|
||||
SCM_SETCDR (z, code);
|
||||
SCM_SETCAR (z, scm_tc16_promise);
|
||||
SCM_ALLOW_INTS;
|
||||
return z;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -61,7 +61,7 @@ gh_eval_str (char *scheme_code)
|
|||
SCM form;
|
||||
|
||||
/* Read expressions from that port; ignore the values. */
|
||||
while ((form = scm_read (port, SCM_BOOL_F, SCM_BOOL_F)) != SCM_EOF_VAL)
|
||||
while (!SCM_EOF_OBJECT_P (form = scm_read (port, SCM_BOOL_F, SCM_BOOL_F)))
|
||||
scm_eval_x (form);
|
||||
|
||||
/* Dispose of the port when done. (Oh icky.) */
|
||||
|
|
|
|||
|
|
@ -76,6 +76,7 @@
|
|||
#include "mbstrings.h"
|
||||
#include "net_db.h"
|
||||
#include "numbers.h"
|
||||
#include "objects.h"
|
||||
#include "objprop.h"
|
||||
#include "options.h"
|
||||
#include "pairs.h"
|
||||
|
|
@ -436,6 +437,7 @@ scm_boot_guile_1 (base, closure)
|
|||
scm_init_symbols ();
|
||||
scm_init_tag ();
|
||||
scm_init_load ();
|
||||
scm_init_objects (); /* Requires struct */
|
||||
scm_init_print (); /* Requires struct */
|
||||
scm_init_read ();
|
||||
scm_init_stime ();
|
||||
|
|
|
|||
|
|
@ -92,7 +92,7 @@ scm_primitive_load (filename)
|
|||
while (1)
|
||||
{
|
||||
form = scm_read (port);
|
||||
if (SCM_EOF_VAL == form)
|
||||
if (SCM_EOF_OBJECT_P (form))
|
||||
break;
|
||||
scm_eval_x (form);
|
||||
}
|
||||
|
|
@ -317,7 +317,7 @@ scm_read_and_eval_x (port)
|
|||
SCM port;
|
||||
{
|
||||
SCM form = scm_read (port);
|
||||
if (form == SCM_EOF_VAL)
|
||||
if (SCM_EOF_OBJECT_P (form))
|
||||
scm_ithrow (scm_end_of_file_key, SCM_EOL, 1);
|
||||
return scm_eval_x (form);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -494,7 +494,7 @@ SCM
|
|||
scm_eof_object_p (x)
|
||||
SCM x;
|
||||
{
|
||||
return (SCM_EOF_VAL == x) ? SCM_BOOL_T : SCM_BOOL_F;
|
||||
return SCM_EOF_OBJECT_P (x) ? SCM_BOOL_T : SCM_BOOL_F;
|
||||
}
|
||||
|
||||
SCM_PROC(s_force_output, "force-output", 0, 1, 0, scm_force_output);
|
||||
|
|
|
|||
|
|
@ -86,6 +86,8 @@ extern int scm_port_table_size; /* Number of ports in scm_port_table. */
|
|||
|
||||
|
||||
|
||||
#define SCM_EOF_OBJECT_P(x) ((x) == SCM_EOF_VAL)
|
||||
|
||||
/* PORT FLAGS
|
||||
* A set of flags characterizes a port.
|
||||
*/
|
||||
|
|
|
|||
|
|
@ -270,7 +270,7 @@ scm_eval_string (string)
|
|||
SCM ans = SCM_UNSPECIFIED;
|
||||
|
||||
/* Read expressions from that port; ignore the values. */
|
||||
while ((form = scm_read (port)) != SCM_EOF_VAL)
|
||||
while (!SCM_EOF_OBJECT_P (form = scm_read (port)))
|
||||
ans = scm_eval_x (form);
|
||||
|
||||
scm_close_port (port);
|
||||
|
|
|
|||
|
|
@ -147,7 +147,7 @@ sfgetc (p)
|
|||
SCM ans;
|
||||
ans = scm_apply (SCM_VELTS (p)[3], SCM_EOL, SCM_EOL);
|
||||
errno = 0;
|
||||
if (SCM_FALSEP (ans) || SCM_EOF_VAL == ans)
|
||||
if (SCM_FALSEP (ans) || SCM_EOF_OBJECT_P (ans))
|
||||
return EOF;
|
||||
SCM_ASSERT (SCM_ICHRP (ans), ans, SCM_ARG1, "getc");
|
||||
return SCM_ICHR (ans);
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue