338 |
if (!SCM_NULLP (env) || SCM_UNBNDP (SCM_VARIABLE_REF (real_var))) |
if (!SCM_NULLP (env) || SCM_UNBNDP (SCM_VARIABLE_REF (real_var))) |
339 |
{ |
{ |
340 |
errout: |
errout: |
|
/* scm_everr (vloc, genv,...) */ |
|
341 |
if (check) |
if (check) |
342 |
{ |
{ |
343 |
if (SCM_NULLP (env)) |
if (SCM_NULLP (env)) |
1597 |
} |
} |
1598 |
return !SCM_NULLP (args) ? 1 : 0; |
return !SCM_NULLP (args) ? 1 : 0; |
1599 |
} |
} |
1600 |
|
|
1601 |
#endif |
#endif |
1602 |
|
|
1603 |
static int |
static int |
1826 |
#undef FUNC_NAME |
#undef FUNC_NAME |
1827 |
|
|
1828 |
static SCM |
static SCM |
1829 |
scm_deval_args (SCM l, SCM env, SCM proc, SCM *lloc) |
deval_args (SCM l, SCM env, SCM proc, SCM *lloc) |
1830 |
{ |
{ |
1831 |
SCM *results = lloc, res; |
SCM *results = lloc, res; |
1832 |
while (SCM_CONSP (l)) |
while (SCM_CONSP (l)) |
1847 |
#endif /* !DEVAL */ |
#endif /* !DEVAL */ |
1848 |
|
|
1849 |
|
|
1850 |
/* SECTION: Some local definitions for the evaluator. |
/* SECTION: This code is compiled twice. |
1851 |
*/ |
*/ |
1852 |
|
|
1853 |
|
|
1854 |
/* Update the toplevel environment frame ENV so that it refers to the |
/* Update the toplevel environment frame ENV so that it refers to the |
1855 |
current module. |
* current module. */ |
|
*/ |
|
1856 |
#define UPDATE_TOPLEVEL_ENV(env) \ |
#define UPDATE_TOPLEVEL_ENV(env) \ |
1857 |
do { \ |
do { \ |
1858 |
SCM p = scm_current_module_lookup_closure (); \ |
SCM p = scm_current_module_lookup_closure (); \ |
1864 |
#define CHECK_EQVISH(A,B) (SCM_EQ_P ((A), (B)) || (!SCM_FALSEP (scm_eqv_p ((A), (B))))) |
#define CHECK_EQVISH(A,B) (SCM_EQ_P ((A), (B)) || (!SCM_FALSEP (scm_eqv_p ((A), (B))))) |
1865 |
#endif /* DEVAL */ |
#endif /* DEVAL */ |
1866 |
|
|
1867 |
#define BUILTIN_RPASUBR /* Handle rpsubrs and asubrs without calling apply */ |
/* This is the evaluator. Like any real monster, it has three heads: |
1868 |
|
* |
1869 |
/* SECTION: This is the evaluator. Like any real monster, it has |
* scm_ceval is the non-debugging evaluator, scm_deval is the debugging |
1870 |
* three heads. This code is compiled twice. |
* version. Both are implemented using a common code base, using the |
1871 |
*/ |
* following mechanism: SCM_CEVAL is a macro, which is either defined to |
1872 |
|
* scm_ceval or scm_deval. Thus, there is no function SCM_CEVAL, but the code |
1873 |
|
* for SCM_CEVAL actually compiles to either scm_ceval or scm_deval. When |
1874 |
|
* SCM_CEVAL is defined to scm_ceval, it is known that the macro DEVAL is not |
1875 |
|
* defined. When SCM_CEVAL is defined to scm_deval, then the macro DEVAL is |
1876 |
|
* known to be defined. Thus, in SCM_CEVAL parts for the debugging evaluator |
1877 |
|
* are enclosed within #ifdef DEVAL ... #endif. |
1878 |
|
* |
1879 |
|
* All three (scm_ceval, scm_deval and their common implementation SCM_CEVAL) |
1880 |
|
* take two input parameters, x and env: x is a single expression to be |
1881 |
|
* evalutated. env is the environment in which bindings are searched. |
1882 |
|
* |
1883 |
|
* x is known to be a cell (i. e. a pair or any other non-immediate). Since x |
1884 |
|
* is a single expression, it is necessarily in a tail position. If x is just |
1885 |
|
* a call to another function like in the expression (foo exp1 exp2 ...), the |
1886 |
|
* realization of that call therefore _must_not_ increase stack usage (the |
1887 |
|
* evaluation of exp1, exp2 etc., however, may do so). This is realized by |
1888 |
|
* making extensive use of 'goto' statements within the evaluator: The gotos |
1889 |
|
* replace recursive calls to SCM_CEVAL, thus re-using the same stack frame |
1890 |
|
* that SCM_CEVAL was already using. If, however, x represents some form that |
1891 |
|
* requires to evaluate a sequence of expressions like (begin exp1 exp2 ...), |
1892 |
|
* then recursive calls to SCM_CEVAL are performed for all but the last |
1893 |
|
* expression of that sequence. */ |
1894 |
|
|
1895 |
#if 0 |
#if 0 |
|
|
|
1896 |
SCM |
SCM |
1897 |
scm_ceval (SCM x, SCM env) |
scm_ceval (SCM x, SCM env) |
1898 |
{} |
{} |
1899 |
#endif |
#endif |
|
#if 0 |
|
1900 |
|
|
1901 |
|
#if 0 |
1902 |
SCM |
SCM |
1903 |
scm_deval (SCM x, SCM env) |
scm_deval (SCM x, SCM env) |
1904 |
{} |
{} |
1925 |
* Even frames are eval frames, odd frames are apply frames. |
* Even frames are eval frames, odd frames are apply frames. |
1926 |
*/ |
*/ |
1927 |
debug.vect = (scm_t_debug_info *) alloca (scm_debug_eframe_size |
debug.vect = (scm_t_debug_info *) alloca (scm_debug_eframe_size |
1928 |
* sizeof (debug.vect[0])); |
* sizeof (scm_t_debug_info)); |
1929 |
debug.info = debug.vect; |
debug.info = debug.vect; |
1930 |
debug_info_end = debug.vect + scm_debug_eframe_size; |
debug_info_end = debug.vect + scm_debug_eframe_size; |
1931 |
scm_last_debug_frame = &debug; |
scm_last_debug_frame = &debug; |
2010 |
switch (SCM_TYP7 (x)) |
switch (SCM_TYP7 (x)) |
2011 |
{ |
{ |
2012 |
case scm_tc7_symbol: |
case scm_tc7_symbol: |
2013 |
/* Only happens when called at top level. |
/* Only happens when called at top level. */ |
|
*/ |
|
2014 |
x = scm_cons (x, SCM_UNDEFINED); |
x = scm_cons (x, SCM_UNDEFINED); |
2015 |
RETURN (*scm_lookupcar (x, env, 1)); |
RETURN (*scm_lookupcar (x, env, 1)); |
2016 |
|
|
2299 |
case SCM_BIT8(SCM_MAKISYM (0)): |
case SCM_BIT8(SCM_MAKISYM (0)): |
2300 |
proc = SCM_CAR (x); |
proc = SCM_CAR (x); |
2301 |
SCM_ASRTGO (SCM_ISYMP (proc), badfun); |
SCM_ASRTGO (SCM_ISYMP (proc), badfun); |
2302 |
switch SCM_ISYMNUM (proc) |
switch (SCM_ISYMNUM (proc)) |
2303 |
{ |
{ |
2304 |
case (SCM_ISYMNUM (SCM_IM_APPLY)): |
case (SCM_ISYMNUM (SCM_IM_APPLY)): |
2305 |
proc = SCM_CDR (x); |
proc = SCM_CDR (x); |
2595 |
default: |
default: |
2596 |
proc = x; |
proc = x; |
2597 |
badfun: |
badfun: |
|
/* scm_everr (x, env,...) */ |
|
2598 |
scm_misc_error (NULL, "Wrong type to apply: ~S", scm_list_1 (proc)); |
scm_misc_error (NULL, "Wrong type to apply: ~S", scm_list_1 (proc)); |
2599 |
case scm_tc7_vector: |
case scm_tc7_vector: |
2600 |
case scm_tc7_wvect: |
case scm_tc7_wvect: |
2809 |
umwrongnumargs: |
umwrongnumargs: |
2810 |
unmemocar (x, env); |
unmemocar (x, env); |
2811 |
wrongnumargs: |
wrongnumargs: |
|
/* scm_everr (x, env,...) */ |
|
2812 |
scm_wrong_num_args (proc); |
scm_wrong_num_args (proc); |
2813 |
default: |
default: |
2814 |
/* handle macros here */ |
/* handle macros here */ |
3087 |
#endif |
#endif |
3088 |
#ifdef DEVAL |
#ifdef DEVAL |
3089 |
debug.info->a.args = scm_cons2 (t.arg1, arg2, |
debug.info->a.args = scm_cons2 (t.arg1, arg2, |
3090 |
scm_deval_args (x, env, proc, |
deval_args (x, env, proc, SCM_CDRLOC (SCM_CDR (debug.info->a.args)))); |
|
SCM_CDRLOC (SCM_CDR (debug.info->a.args)))); |
|
3091 |
#endif |
#endif |
3092 |
ENTER_APPLY; |
ENTER_APPLY; |
3093 |
evap3: |
evap3: |
3404 |
*/ |
*/ |
3405 |
|
|
3406 |
#if 0 |
#if 0 |
|
|
|
3407 |
SCM |
SCM |
3408 |
scm_apply (SCM proc, SCM arg1, SCM args) |
scm_apply (SCM proc, SCM arg1, SCM args) |
3409 |
{} |
{} |
3410 |
#endif |
#endif |
3411 |
|
|
3412 |
#if 0 |
#if 0 |
|
|
|
3413 |
SCM |
SCM |
3414 |
scm_dapply (SCM proc, SCM arg1, SCM args) |
scm_dapply (SCM proc, SCM arg1, SCM args) |
3415 |
{ /* empty */ } |
{ /* empty */ } |