1890 |
SCM |
SCM |
1891 |
SCM_CEVAL (SCM x, SCM env) |
SCM_CEVAL (SCM x, SCM env) |
1892 |
{ |
{ |
1893 |
union |
SCM proc, arg1, arg2, orig_sym; |
|
{ |
|
|
SCM *lloc; |
|
|
SCM arg1; |
|
|
} t; |
|
|
SCM proc, arg2, orig_sym; |
|
1894 |
#ifdef DEVAL |
#ifdef DEVAL |
1895 |
scm_t_debug_frame debug; |
scm_t_debug_frame debug; |
1896 |
scm_t_debug_info *debug_info_end; |
scm_t_debug_info *debug_info_end; |
1956 |
SCM tail = SCM_BOOL(SCM_TAILRECP (debug)); |
SCM tail = SCM_BOOL(SCM_TAILRECP (debug)); |
1957 |
SCM_SET_TAILREC (debug); |
SCM_SET_TAILREC (debug); |
1958 |
if (SCM_CHEAPTRAPS_P) |
if (SCM_CHEAPTRAPS_P) |
1959 |
t.arg1 = scm_make_debugobj (&debug); |
arg1 = scm_make_debugobj (&debug); |
1960 |
else |
else |
1961 |
{ |
{ |
1962 |
int first; |
int first; |
1963 |
SCM val = scm_make_continuation (&first); |
SCM val = scm_make_continuation (&first); |
1964 |
|
|
1965 |
if (first) |
if (first) |
1966 |
t.arg1 = val; |
arg1 = val; |
1967 |
else |
else |
1968 |
{ |
{ |
1969 |
x = val; |
x = val; |
1978 |
SCM_TRAPS_P = 0; |
SCM_TRAPS_P = 0; |
1979 |
scm_call_4 (SCM_ENTER_FRAME_HDLR, |
scm_call_4 (SCM_ENTER_FRAME_HDLR, |
1980 |
scm_sym_enter_frame, |
scm_sym_enter_frame, |
1981 |
t.arg1, |
arg1, |
1982 |
tail, |
tail, |
1983 |
scm_unmemocopy (x, env)); |
scm_unmemocopy (x, env)); |
1984 |
SCM_TRAPS_P = 1; |
SCM_TRAPS_P = 1; |
2125 |
} |
} |
2126 |
else |
else |
2127 |
{ |
{ |
2128 |
t.arg1 = EVALCAR (clause, env); |
arg1 = EVALCAR (clause, env); |
2129 |
if (!SCM_FALSEP (t.arg1) && !SCM_NILP (t.arg1)) |
if (!SCM_FALSEP (arg1) && !SCM_NILP (arg1)) |
2130 |
{ |
{ |
2131 |
x = SCM_CDR (clause); |
x = SCM_CDR (clause); |
2132 |
if (SCM_NULLP (x)) |
if (SCM_NULLP (x)) |
2133 |
RETURN (t.arg1); |
RETURN (arg1); |
2134 |
else if (!SCM_EQ_P (SCM_CAR (x), scm_sym_arrow)) |
else if (!SCM_EQ_P (SCM_CAR (x), scm_sym_arrow)) |
2135 |
{ |
{ |
2136 |
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); |
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); |
2141 |
proc = SCM_CDR (x); |
proc = SCM_CDR (x); |
2142 |
proc = EVALCAR (proc, env); |
proc = EVALCAR (proc, env); |
2143 |
SCM_ASRTGO (!SCM_IMP (proc), badfun); |
SCM_ASRTGO (!SCM_IMP (proc), badfun); |
2144 |
PREP_APPLY (proc, scm_list_1 (t.arg1)); |
PREP_APPLY (proc, scm_list_1 (arg1)); |
2145 |
ENTER_APPLY; |
ENTER_APPLY; |
2146 |
if (SCM_CLOSUREP(proc) && scm_badformalsp (proc, 1)) |
if (SCM_CLOSUREP(proc) && scm_badformalsp (proc, 1)) |
2147 |
goto umwrongnumargs; |
goto umwrongnumargs; |
2357 |
if (SCM_CLOSUREP (proc)) |
if (SCM_CLOSUREP (proc)) |
2358 |
{ |
{ |
2359 |
PREP_APPLY (proc, SCM_EOL); |
PREP_APPLY (proc, SCM_EOL); |
2360 |
t.arg1 = SCM_CDDR (x); |
arg1 = SCM_CDDR (x); |
2361 |
t.arg1 = EVALCAR (t.arg1, env); |
arg1 = EVALCAR (arg1, env); |
2362 |
apply_closure: |
apply_closure: |
2363 |
/* Go here to tail-call a closure. PROC is the closure |
/* Go here to tail-call a closure. PROC is the closure |
2364 |
and T.ARG1 is the list of arguments. Do not forget to |
and ARG1 is the list of arguments. Do not forget to |
2365 |
call PREP_APPLY. */ |
call PREP_APPLY. */ |
2366 |
{ |
{ |
2367 |
SCM formals = SCM_CLOSURE_FORMALS (proc); |
SCM formals = SCM_CLOSURE_FORMALS (proc); |
2368 |
#ifdef DEVAL |
#ifdef DEVAL |
2369 |
debug.info->a.args = t.arg1; |
debug.info->a.args = arg1; |
2370 |
#endif |
#endif |
2371 |
#ifndef SCM_RECKLESS |
#ifndef SCM_RECKLESS |
2372 |
if (scm_badargsp (formals, t.arg1)) |
if (scm_badargsp (formals, arg1)) |
2373 |
goto wrongnumargs; |
goto wrongnumargs; |
2374 |
#endif |
#endif |
2375 |
ENTER_APPLY; |
ENTER_APPLY; |
2376 |
/* Copy argument list */ |
/* Copy argument list */ |
2377 |
if (SCM_NULL_OR_NIL_P (t.arg1)) |
if (SCM_NULL_OR_NIL_P (arg1)) |
2378 |
env = EXTEND_ENV (formals, SCM_EOL, SCM_ENV (proc)); |
env = EXTEND_ENV (formals, SCM_EOL, SCM_ENV (proc)); |
2379 |
else |
else |
2380 |
{ |
{ |
2381 |
SCM args = scm_list_1 (SCM_CAR (t.arg1)); |
SCM args = scm_list_1 (SCM_CAR (arg1)); |
2382 |
SCM tail = args; |
SCM tail = args; |
2383 |
t.arg1 = SCM_CDR (t.arg1); |
arg1 = SCM_CDR (arg1); |
2384 |
while (!SCM_NULL_OR_NIL_P (t.arg1)) |
while (!SCM_NULL_OR_NIL_P (arg1)) |
2385 |
{ |
{ |
2386 |
SCM new_tail = scm_list_1 (SCM_CAR (t.arg1)); |
SCM new_tail = scm_list_1 (SCM_CAR (arg1)); |
2387 |
SCM_SETCDR (tail, new_tail); |
SCM_SETCDR (tail, new_tail); |
2388 |
tail = new_tail; |
tail = new_tail; |
2389 |
t.arg1 = SCM_CDR (t.arg1); |
arg1 = SCM_CDR (arg1); |
2390 |
} |
} |
2391 |
env = EXTEND_ENV (formals, args, SCM_ENV (proc)); |
env = EXTEND_ENV (formals, args, SCM_ENV (proc)); |
2392 |
} |
} |
2408 |
SCM val = scm_make_continuation (&first); |
SCM val = scm_make_continuation (&first); |
2409 |
|
|
2410 |
if (first) |
if (first) |
2411 |
t.arg1 = val; |
arg1 = val; |
2412 |
else |
else |
2413 |
RETURN (val); |
RETURN (val); |
2414 |
} |
} |
2415 |
proc = SCM_CDR (x); |
proc = SCM_CDR (x); |
2416 |
proc = scm_eval_car (proc, env); |
proc = scm_eval_car (proc, env); |
2417 |
SCM_ASRTGO (SCM_NIMP (proc), badfun); |
SCM_ASRTGO (SCM_NIMP (proc), badfun); |
2418 |
PREP_APPLY (proc, scm_list_1 (t.arg1)); |
PREP_APPLY (proc, scm_list_1 (arg1)); |
2419 |
ENTER_APPLY; |
ENTER_APPLY; |
2420 |
if (SCM_CLOSUREP(proc) && scm_badformalsp (proc, 1)) |
if (SCM_CLOSUREP(proc) && scm_badformalsp (proc, 1)) |
2421 |
goto umwrongnumargs; |
goto umwrongnumargs; |
2427 |
case (SCM_ISYMNUM (SCM_IM_DISPATCH)): |
case (SCM_ISYMNUM (SCM_IM_DISPATCH)): |
2428 |
{ |
{ |
2429 |
/* If not done yet, evaluate the operand forms. The result is a |
/* If not done yet, evaluate the operand forms. The result is a |
2430 |
* list of arguments stored in t.arg1, which is used to perform the |
* list of arguments stored in arg1, which is used to perform the |
2431 |
* function dispatch. */ |
* function dispatch. */ |
2432 |
SCM operand_forms = SCM_CADR (x); |
SCM operand_forms = SCM_CADR (x); |
2433 |
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); |
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); |
2434 |
if (SCM_ILOCP (operand_forms)) |
if (SCM_ILOCP (operand_forms)) |
2435 |
t.arg1 = *scm_ilookup (operand_forms, env); |
arg1 = *scm_ilookup (operand_forms, env); |
2436 |
else if (SCM_VARIABLEP (operand_forms)) |
else if (SCM_VARIABLEP (operand_forms)) |
2437 |
t.arg1 = SCM_VARIABLE_REF (operand_forms); |
arg1 = SCM_VARIABLE_REF (operand_forms); |
2438 |
else if (!SCM_CONSP (operand_forms)) |
else if (!SCM_CONSP (operand_forms)) |
2439 |
t.arg1 = *scm_lookupcar (SCM_CDR (x), env, 1); |
arg1 = *scm_lookupcar (SCM_CDR (x), env, 1); |
2440 |
else |
else |
2441 |
{ |
{ |
2442 |
SCM tail = t.arg1 = scm_list_1 (EVALCAR (operand_forms, env)); |
SCM tail = arg1 = scm_list_1 (EVALCAR (operand_forms, env)); |
2443 |
operand_forms = SCM_CDR (operand_forms); |
operand_forms = SCM_CDR (operand_forms); |
2444 |
while (!SCM_NULLP (operand_forms)) |
while (!SCM_NULLP (operand_forms)) |
2445 |
{ |
{ |
2454 |
/* The type dispatch code is duplicated below |
/* The type dispatch code is duplicated below |
2455 |
* (c.f. objects.c:scm_mcache_compute_cmethod) since that |
* (c.f. objects.c:scm_mcache_compute_cmethod) since that |
2456 |
* cuts down execution time for type dispatch to 50%. */ |
* cuts down execution time for type dispatch to 50%. */ |
2457 |
type_dispatch: /* inputs: x, t.arg1 */ |
type_dispatch: /* inputs: x, arg1 */ |
2458 |
/* Type dispatch means to determine from the types of the function |
/* Type dispatch means to determine from the types of the function |
2459 |
* arguments (i. e. the 'signature' of the call), which method from |
* arguments (i. e. the 'signature' of the call), which method from |
2460 |
* a generic function is to be called. This process of selecting |
* a generic function is to be called. This process of selecting |
2509 |
* method in the method cache. */ |
* method in the method cache. */ |
2510 |
unsigned long int hashset = SCM_INUM (tmp); |
unsigned long int hashset = SCM_INUM (tmp); |
2511 |
unsigned long int counter = specializers + 1; |
unsigned long int counter = specializers + 1; |
2512 |
SCM tmp_arg = t.arg1; |
SCM tmp_arg = arg1; |
2513 |
hash_value = 0; |
hash_value = 0; |
2514 |
while (!SCM_NULLP (tmp_arg) && counter != 0) |
while (!SCM_NULLP (tmp_arg) && counter != 0) |
2515 |
{ |
{ |
2548 |
SCM z; |
SCM z; |
2549 |
do |
do |
2550 |
{ |
{ |
2551 |
SCM args = t.arg1; /* list of arguments */ |
SCM args = arg1; /* list of arguments */ |
2552 |
z = SCM_VELTS (method_cache)[hash_value]; |
z = SCM_VELTS (method_cache)[hash_value]; |
2553 |
while (!SCM_NULLP (args)) |
while (!SCM_NULLP (args)) |
2554 |
{ |
{ |
2567 |
} while (hash_value != cache_end_pos); |
} while (hash_value != cache_end_pos); |
2568 |
|
|
2569 |
/* No appropriate method was found in the cache. */ |
/* No appropriate method was found in the cache. */ |
2570 |
z = scm_memoize_method (x, t.arg1); |
z = scm_memoize_method (x, arg1); |
2571 |
|
|
2572 |
apply_cmethod: /* inputs: z, t.arg1 */ |
apply_cmethod: /* inputs: z, arg1 */ |
2573 |
{ |
{ |
2574 |
SCM formals = SCM_CMETHOD_FORMALS (z); |
SCM formals = SCM_CMETHOD_FORMALS (z); |
2575 |
env = EXTEND_ENV (formals, t.arg1, SCM_CMETHOD_ENV (z)); |
env = EXTEND_ENV (formals, arg1, SCM_CMETHOD_ENV (z)); |
2576 |
x = SCM_CMETHOD_BODY (z); |
x = SCM_CMETHOD_BODY (z); |
2577 |
goto nontoplevel_begin; |
goto nontoplevel_begin; |
2578 |
} |
} |
2670 |
x = EVALCAR (proc, env); |
x = EVALCAR (proc, env); |
2671 |
proc = SCM_CDR (proc); |
proc = SCM_CDR (proc); |
2672 |
proc = EVALCAR (proc, env); |
proc = EVALCAR (proc, env); |
2673 |
t.arg1 = SCM_APPLY (x, SCM_EOL, SCM_EOL); |
arg1 = SCM_APPLY (x, SCM_EOL, SCM_EOL); |
2674 |
if (SCM_VALUESP (t.arg1)) |
if (SCM_VALUESP (arg1)) |
2675 |
t.arg1 = scm_struct_ref (t.arg1, SCM_INUM0); |
arg1 = scm_struct_ref (arg1, SCM_INUM0); |
2676 |
else |
else |
2677 |
t.arg1 = scm_list_1 (t.arg1); |
arg1 = scm_list_1 (arg1); |
2678 |
if (SCM_CLOSUREP (proc)) |
if (SCM_CLOSUREP (proc)) |
2679 |
{ |
{ |
2680 |
PREP_APPLY (proc, t.arg1); |
PREP_APPLY (proc, arg1); |
2681 |
goto apply_closure; |
goto apply_closure; |
2682 |
} |
} |
2683 |
return SCM_APPLY (proc, t.arg1, SCM_EOL); |
return SCM_APPLY (proc, arg1, SCM_EOL); |
2684 |
} |
} |
2685 |
|
|
2686 |
|
|
2765 |
application frames can be deleted from the backtrace. */ |
application frames can be deleted from the backtrace. */ |
2766 |
SCM_SET_MACROEXP (debug); |
SCM_SET_MACROEXP (debug); |
2767 |
#endif |
#endif |
2768 |
t.arg1 = SCM_APPLY (SCM_MACRO_CODE (proc), x, |
arg1 = SCM_APPLY (SCM_MACRO_CODE (proc), x, |
2769 |
scm_cons (env, scm_listofnull)); |
scm_cons (env, scm_listofnull)); |
2770 |
|
|
2771 |
#ifdef DEVAL |
#ifdef DEVAL |
2774 |
switch (SCM_MACRO_TYPE (proc)) |
switch (SCM_MACRO_TYPE (proc)) |
2775 |
{ |
{ |
2776 |
case 2: |
case 2: |
2777 |
if (scm_ilength (t.arg1) <= 0) |
if (scm_ilength (arg1) <= 0) |
2778 |
t.arg1 = scm_list_2 (SCM_IM_BEGIN, t.arg1); |
arg1 = scm_list_2 (SCM_IM_BEGIN, arg1); |
2779 |
#ifdef DEVAL |
#ifdef DEVAL |
2780 |
if (!SCM_CLOSUREP (SCM_MACRO_CODE (proc))) |
if (!SCM_CLOSUREP (SCM_MACRO_CODE (proc))) |
2781 |
{ |
{ |
2782 |
SCM_DEFER_INTS; |
SCM_DEFER_INTS; |
2783 |
SCM_SETCAR (x, SCM_CAR (t.arg1)); |
SCM_SETCAR (x, SCM_CAR (arg1)); |
2784 |
SCM_SETCDR (x, SCM_CDR (t.arg1)); |
SCM_SETCDR (x, SCM_CDR (arg1)); |
2785 |
SCM_ALLOW_INTS; |
SCM_ALLOW_INTS; |
2786 |
goto dispatch; |
goto dispatch; |
2787 |
} |
} |
2791 |
SCM_CDR (x)); |
SCM_CDR (x)); |
2792 |
#endif |
#endif |
2793 |
SCM_DEFER_INTS; |
SCM_DEFER_INTS; |
2794 |
SCM_SETCAR (x, SCM_CAR (t.arg1)); |
SCM_SETCAR (x, SCM_CAR (arg1)); |
2795 |
SCM_SETCDR (x, SCM_CDR (t.arg1)); |
SCM_SETCDR (x, SCM_CDR (arg1)); |
2796 |
SCM_ALLOW_INTS; |
SCM_ALLOW_INTS; |
2797 |
goto loopnoap; |
goto loopnoap; |
2798 |
case 1: |
case 1: |
2799 |
if (SCM_NIMP (x = t.arg1)) |
if (SCM_NIMP (x = arg1)) |
2800 |
goto loopnoap; |
goto loopnoap; |
2801 |
case 0: |
case 0: |
2802 |
RETURN (t.arg1); |
RETURN (arg1); |
2803 |
} |
} |
2804 |
} |
} |
2805 |
} |
} |
2813 |
if (SCM_CLOSUREP (proc)) |
if (SCM_CLOSUREP (proc)) |
2814 |
{ |
{ |
2815 |
arg2 = SCM_CLOSURE_FORMALS (proc); |
arg2 = SCM_CLOSURE_FORMALS (proc); |
2816 |
t.arg1 = SCM_CDR (x); |
arg1 = SCM_CDR (x); |
2817 |
while (!SCM_NULLP (arg2)) |
while (!SCM_NULLP (arg2)) |
2818 |
{ |
{ |
2819 |
if (!SCM_CONSP (arg2)) |
if (!SCM_CONSP (arg2)) |
2820 |
goto evapply; |
goto evapply; |
2821 |
if (SCM_IMP (t.arg1)) |
if (SCM_IMP (arg1)) |
2822 |
goto umwrongnumargs; |
goto umwrongnumargs; |
2823 |
arg2 = SCM_CDR (arg2); |
arg2 = SCM_CDR (arg2); |
2824 |
t.arg1 = SCM_CDR (t.arg1); |
arg1 = SCM_CDR (arg1); |
2825 |
} |
} |
2826 |
if (!SCM_NULLP (t.arg1)) |
if (!SCM_NULLP (arg1)) |
2827 |
goto umwrongnumargs; |
goto umwrongnumargs; |
2828 |
} |
} |
2829 |
else if (SCM_MACROP (proc)) |
else if (SCM_MACROP (proc)) |
2854 |
goto badfun; |
goto badfun; |
2855 |
RETURN (SCM_SMOB_APPLY_0 (proc)); |
RETURN (SCM_SMOB_APPLY_0 (proc)); |
2856 |
case scm_tc7_cclo: |
case scm_tc7_cclo: |
2857 |
t.arg1 = proc; |
arg1 = proc; |
2858 |
proc = SCM_CCLO_SUBR (proc); |
proc = SCM_CCLO_SUBR (proc); |
2859 |
#ifdef DEVAL |
#ifdef DEVAL |
2860 |
debug.info->a.proc = proc; |
debug.info->a.proc = proc; |
2861 |
debug.info->a.args = scm_list_1 (t.arg1); |
debug.info->a.args = scm_list_1 (arg1); |
2862 |
#endif |
#endif |
2863 |
goto evap1; |
goto evap1; |
2864 |
case scm_tc7_pws: |
case scm_tc7_pws: |
2878 |
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC) |
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC) |
2879 |
{ |
{ |
2880 |
x = SCM_ENTITY_PROCEDURE (proc); |
x = SCM_ENTITY_PROCEDURE (proc); |
2881 |
t.arg1 = SCM_EOL; |
arg1 = SCM_EOL; |
2882 |
goto type_dispatch; |
goto type_dispatch; |
2883 |
} |
} |
2884 |
else if (!SCM_I_OPERATORP (proc)) |
else if (!SCM_I_OPERATORP (proc)) |
2885 |
goto badfun; |
goto badfun; |
2886 |
else |
else |
2887 |
{ |
{ |
2888 |
t.arg1 = proc; |
arg1 = proc; |
2889 |
proc = (SCM_I_ENTITYP (proc) |
proc = (SCM_I_ENTITYP (proc) |
2890 |
? SCM_ENTITY_PROCEDURE (proc) |
? SCM_ENTITY_PROCEDURE (proc) |
2891 |
: SCM_OPERATOR_PROCEDURE (proc)); |
: SCM_OPERATOR_PROCEDURE (proc)); |
2892 |
#ifdef DEVAL |
#ifdef DEVAL |
2893 |
debug.info->a.proc = proc; |
debug.info->a.proc = proc; |
2894 |
debug.info->a.args = scm_list_1 (t.arg1); |
debug.info->a.args = scm_list_1 (arg1); |
2895 |
#endif |
#endif |
2896 |
if (SCM_NIMP (proc)) |
if (SCM_NIMP (proc)) |
2897 |
goto evap1; |
goto evap1; |
2917 |
/* must handle macros by here */ |
/* must handle macros by here */ |
2918 |
x = SCM_CDR (x); |
x = SCM_CDR (x); |
2919 |
#ifdef SCM_CAUTIOUS |
#ifdef SCM_CAUTIOUS |
2920 |
if (SCM_IMP (x)) |
if (SCM_CONSP (x)) |
2921 |
goto wrongnumargs; |
arg1 = EVALCAR (x, env); |
|
else if (SCM_CONSP (x)) |
|
|
{ |
|
|
if (SCM_IMP (SCM_CAR (x))) |
|
|
t.arg1 = SCM_EVALIM (SCM_CAR (x), env); |
|
|
else |
|
|
t.arg1 = EVALCELLCAR (x, env); |
|
|
} |
|
2922 |
else |
else |
2923 |
goto wrongnumargs; |
goto wrongnumargs; |
2924 |
#else |
#else |
2925 |
t.arg1 = EVALCAR (x, env); |
arg1 = EVALCAR (x, env); |
2926 |
#endif |
#endif |
2927 |
#ifdef DEVAL |
#ifdef DEVAL |
2928 |
debug.info->a.args = scm_list_1 (t.arg1); |
debug.info->a.args = scm_list_1 (arg1); |
2929 |
#endif |
#endif |
2930 |
x = SCM_CDR (x); |
x = SCM_CDR (x); |
2931 |
if (SCM_NULLP (x)) |
if (SCM_NULLP (x)) |
2933 |
ENTER_APPLY; |
ENTER_APPLY; |
2934 |
evap1: |
evap1: |
2935 |
switch (SCM_TYP7 (proc)) |
switch (SCM_TYP7 (proc)) |
2936 |
{ /* have one argument in t.arg1 */ |
{ /* have one argument in arg1 */ |
2937 |
case scm_tc7_subr_2o: |
case scm_tc7_subr_2o: |
2938 |
RETURN (SCM_SUBRF (proc) (t.arg1, SCM_UNDEFINED)); |
RETURN (SCM_SUBRF (proc) (arg1, SCM_UNDEFINED)); |
2939 |
case scm_tc7_subr_1: |
case scm_tc7_subr_1: |
2940 |
case scm_tc7_subr_1o: |
case scm_tc7_subr_1o: |
2941 |
RETURN (SCM_SUBRF (proc) (t.arg1)); |
RETURN (SCM_SUBRF (proc) (arg1)); |
2942 |
case scm_tc7_cxr: |
case scm_tc7_cxr: |
2943 |
if (SCM_SUBRF (proc)) |
if (SCM_SUBRF (proc)) |
2944 |
{ |
{ |
2945 |
if (SCM_INUMP (t.arg1)) |
if (SCM_INUMP (arg1)) |
2946 |
{ |
{ |
2947 |
RETURN (scm_make_real (SCM_DSUBRF (proc) ((double) SCM_INUM (t.arg1)))); |
RETURN (scm_make_real (SCM_DSUBRF (proc) ((double) SCM_INUM (arg1)))); |
2948 |
} |
} |
2949 |
else if (SCM_REALP (t.arg1)) |
else if (SCM_REALP (arg1)) |
2950 |
{ |
{ |
2951 |
RETURN (scm_make_real (SCM_DSUBRF (proc) (SCM_REAL_VALUE (t.arg1)))); |
RETURN (scm_make_real (SCM_DSUBRF (proc) (SCM_REAL_VALUE (arg1)))); |
2952 |
} |
} |
2953 |
#ifdef SCM_BIGDIG |
#ifdef SCM_BIGDIG |
2954 |
else if (SCM_BIGP (t.arg1)) |
else if (SCM_BIGP (arg1)) |
2955 |
{ |
{ |
2956 |
RETURN (scm_make_real (SCM_DSUBRF (proc) (scm_i_big2dbl (t.arg1)))); |
RETURN (scm_make_real (SCM_DSUBRF (proc) (scm_i_big2dbl (arg1)))); |
2957 |
} |
} |
2958 |
#endif |
#endif |
2959 |
SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), t.arg1, |
SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1, |
2960 |
SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc))); |
SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc))); |
2961 |
} |
} |
2962 |
proc = SCM_SNAME (proc); |
proc = SCM_SNAME (proc); |
2964 |
char *chrs = SCM_SYMBOL_CHARS (proc) + SCM_SYMBOL_LENGTH (proc) - 1; |
char *chrs = SCM_SYMBOL_CHARS (proc) + SCM_SYMBOL_LENGTH (proc) - 1; |
2965 |
while ('c' != *--chrs) |
while ('c' != *--chrs) |
2966 |
{ |
{ |
2967 |
SCM_ASSERT (SCM_CONSP (t.arg1), |
SCM_ASSERT (SCM_CONSP (arg1), |
2968 |
t.arg1, SCM_ARG1, SCM_SYMBOL_CHARS (proc)); |
arg1, SCM_ARG1, SCM_SYMBOL_CHARS (proc)); |
2969 |
t.arg1 = ('a' == *chrs) ? SCM_CAR (t.arg1) : SCM_CDR (t.arg1); |
arg1 = ('a' == *chrs) ? SCM_CAR (arg1) : SCM_CDR (arg1); |
2970 |
} |
} |
2971 |
RETURN (t.arg1); |
RETURN (arg1); |
2972 |
} |
} |
2973 |
case scm_tc7_rpsubr: |
case scm_tc7_rpsubr: |
2974 |
RETURN (SCM_BOOL_T); |
RETURN (SCM_BOOL_T); |
2975 |
case scm_tc7_asubr: |
case scm_tc7_asubr: |
2976 |
RETURN (SCM_SUBRF (proc) (t.arg1, SCM_UNDEFINED)); |
RETURN (SCM_SUBRF (proc) (arg1, SCM_UNDEFINED)); |
2977 |
case scm_tc7_lsubr: |
case scm_tc7_lsubr: |
2978 |
#ifdef DEVAL |
#ifdef DEVAL |
2979 |
RETURN (SCM_SUBRF (proc) (debug.info->a.args)); |
RETURN (SCM_SUBRF (proc) (debug.info->a.args)); |
2980 |
#else |
#else |
2981 |
RETURN (SCM_SUBRF (proc) (scm_list_1 (t.arg1))); |
RETURN (SCM_SUBRF (proc) (scm_list_1 (arg1))); |
2982 |
#endif |
#endif |
2983 |
case scm_tc7_smob: |
case scm_tc7_smob: |
2984 |
if (!SCM_SMOB_APPLICABLE_P (proc)) |
if (!SCM_SMOB_APPLICABLE_P (proc)) |
2985 |
goto badfun; |
goto badfun; |
2986 |
RETURN (SCM_SMOB_APPLY_1 (proc, t.arg1)); |
RETURN (SCM_SMOB_APPLY_1 (proc, arg1)); |
2987 |
case scm_tc7_cclo: |
case scm_tc7_cclo: |
2988 |
arg2 = t.arg1; |
arg2 = arg1; |
2989 |
t.arg1 = proc; |
arg1 = proc; |
2990 |
proc = SCM_CCLO_SUBR (proc); |
proc = SCM_CCLO_SUBR (proc); |
2991 |
#ifdef DEVAL |
#ifdef DEVAL |
2992 |
debug.info->a.args = scm_cons (t.arg1, debug.info->a.args); |
debug.info->a.args = scm_cons (arg1, debug.info->a.args); |
2993 |
debug.info->a.proc = proc; |
debug.info->a.proc = proc; |
2994 |
#endif |
#endif |
2995 |
goto evap2; |
goto evap2; |
3008 |
#ifdef DEVAL |
#ifdef DEVAL |
3009 |
env = EXTEND_ENV (SCM_CLOSURE_FORMALS (proc), debug.info->a.args, SCM_ENV (proc)); |
env = EXTEND_ENV (SCM_CLOSURE_FORMALS (proc), debug.info->a.args, SCM_ENV (proc)); |
3010 |
#else |
#else |
3011 |
env = EXTEND_ENV (SCM_CLOSURE_FORMALS (proc), scm_list_1 (t.arg1), SCM_ENV (proc)); |
env = EXTEND_ENV (SCM_CLOSURE_FORMALS (proc), scm_list_1 (arg1), SCM_ENV (proc)); |
3012 |
#endif |
#endif |
3013 |
goto nontoplevel_begin; |
goto nontoplevel_begin; |
3014 |
case scm_tcs_struct: |
case scm_tcs_struct: |
3016 |
{ |
{ |
3017 |
x = SCM_ENTITY_PROCEDURE (proc); |
x = SCM_ENTITY_PROCEDURE (proc); |
3018 |
#ifdef DEVAL |
#ifdef DEVAL |
3019 |
t.arg1 = debug.info->a.args; |
arg1 = debug.info->a.args; |
3020 |
#else |
#else |
3021 |
t.arg1 = scm_list_1 (t.arg1); |
arg1 = scm_list_1 (arg1); |
3022 |
#endif |
#endif |
3023 |
goto type_dispatch; |
goto type_dispatch; |
3024 |
} |
} |
3026 |
goto badfun; |
goto badfun; |
3027 |
else |
else |
3028 |
{ |
{ |
3029 |
arg2 = t.arg1; |
arg2 = arg1; |
3030 |
t.arg1 = proc; |
arg1 = proc; |
3031 |
proc = (SCM_I_ENTITYP (proc) |
proc = (SCM_I_ENTITYP (proc) |
3032 |
? SCM_ENTITY_PROCEDURE (proc) |
? SCM_ENTITY_PROCEDURE (proc) |
3033 |
: SCM_OPERATOR_PROCEDURE (proc)); |
: SCM_OPERATOR_PROCEDURE (proc)); |
3034 |
#ifdef DEVAL |
#ifdef DEVAL |
3035 |
debug.info->a.args = scm_cons (t.arg1, debug.info->a.args); |
debug.info->a.args = scm_cons (arg1, debug.info->a.args); |
3036 |
debug.info->a.proc = proc; |
debug.info->a.proc = proc; |
3037 |
#endif |
#endif |
3038 |
if (SCM_NIMP (proc)) |
if (SCM_NIMP (proc)) |
3066 |
#endif |
#endif |
3067 |
{ /* have two or more arguments */ |
{ /* have two or more arguments */ |
3068 |
#ifdef DEVAL |
#ifdef DEVAL |
3069 |
debug.info->a.args = scm_list_2 (t.arg1, arg2); |
debug.info->a.args = scm_list_2 (arg1, arg2); |
3070 |
#endif |
#endif |
3071 |
x = SCM_CDR (x); |
x = SCM_CDR (x); |
3072 |
if (SCM_NULLP (x)) { |
if (SCM_NULLP (x)) { |
3076 |
{ /* have two arguments */ |
{ /* have two arguments */ |
3077 |
case scm_tc7_subr_2: |
case scm_tc7_subr_2: |
3078 |
case scm_tc7_subr_2o: |
case scm_tc7_subr_2o: |
3079 |
RETURN (SCM_SUBRF (proc) (t.arg1, arg2)); |
RETURN (SCM_SUBRF (proc) (arg1, arg2)); |
3080 |
case scm_tc7_lsubr: |
case scm_tc7_lsubr: |
3081 |
#ifdef DEVAL |
#ifdef DEVAL |
3082 |
RETURN (SCM_SUBRF (proc) (debug.info->a.args)); |
RETURN (SCM_SUBRF (proc) (debug.info->a.args)); |
3083 |
#else |
#else |
3084 |
RETURN (SCM_SUBRF (proc) (scm_list_2 (t.arg1, arg2))); |
RETURN (SCM_SUBRF (proc) (scm_list_2 (arg1, arg2))); |
3085 |
#endif |
#endif |
3086 |
case scm_tc7_lsubr_2: |
case scm_tc7_lsubr_2: |
3087 |
RETURN (SCM_SUBRF (proc) (t.arg1, arg2, SCM_EOL)); |
RETURN (SCM_SUBRF (proc) (arg1, arg2, SCM_EOL)); |
3088 |
case scm_tc7_rpsubr: |
case scm_tc7_rpsubr: |
3089 |
case scm_tc7_asubr: |
case scm_tc7_asubr: |
3090 |
RETURN (SCM_SUBRF (proc) (t.arg1, arg2)); |
RETURN (SCM_SUBRF (proc) (arg1, arg2)); |
3091 |
case scm_tc7_smob: |
case scm_tc7_smob: |
3092 |
if (!SCM_SMOB_APPLICABLE_P (proc)) |
if (!SCM_SMOB_APPLICABLE_P (proc)) |
3093 |
goto badfun; |
goto badfun; |
3094 |
RETURN (SCM_SMOB_APPLY_2 (proc, t.arg1, arg2)); |
RETURN (SCM_SMOB_APPLY_2 (proc, arg1, arg2)); |
3095 |
cclon: |
cclon: |
3096 |
case scm_tc7_cclo: |
case scm_tc7_cclo: |
3097 |
#ifdef DEVAL |
#ifdef DEVAL |
3100 |
SCM_EOL)); |
SCM_EOL)); |
3101 |
#else |
#else |
3102 |
RETURN (SCM_APPLY (SCM_CCLO_SUBR (proc), |
RETURN (SCM_APPLY (SCM_CCLO_SUBR (proc), |
3103 |
scm_cons2 (proc, t.arg1, |
scm_cons2 (proc, arg1, |
3104 |
scm_cons (arg2, |
scm_cons (arg2, |
3105 |
scm_eval_args (x, |
scm_eval_args (x, |
3106 |
env, |
env, |
3112 |
{ |
{ |
3113 |
x = SCM_ENTITY_PROCEDURE (proc); |
x = SCM_ENTITY_PROCEDURE (proc); |
3114 |
#ifdef DEVAL |
#ifdef DEVAL |
3115 |
t.arg1 = debug.info->a.args; |
arg1 = debug.info->a.args; |
3116 |
#else |
#else |
3117 |
t.arg1 = scm_list_2 (t.arg1, arg2); |
arg1 = scm_list_2 (arg1, arg2); |
3118 |
#endif |
#endif |
3119 |
goto type_dispatch; |
goto type_dispatch; |
3120 |
} |
} |
3133 |
RETURN (SCM_APPLY (SCM_I_ENTITYP (proc) |
RETURN (SCM_APPLY (SCM_I_ENTITYP (proc) |
3134 |
? SCM_ENTITY_PROCEDURE (proc) |
? SCM_ENTITY_PROCEDURE (proc) |
3135 |
: SCM_OPERATOR_PROCEDURE (proc), |
: SCM_OPERATOR_PROCEDURE (proc), |
3136 |
scm_cons2 (proc, t.arg1, |
scm_cons2 (proc, arg1, |
3137 |
scm_cons (arg2, |
scm_cons (arg2, |
3138 |
scm_eval_args (x, |
scm_eval_args (x, |
3139 |
env, |
env, |
3166 |
SCM_ENV (proc)); |
SCM_ENV (proc)); |
3167 |
#else |
#else |
3168 |
env = EXTEND_ENV (SCM_CLOSURE_FORMALS (proc), |
env = EXTEND_ENV (SCM_CLOSURE_FORMALS (proc), |
3169 |
scm_list_2 (t.arg1, arg2), SCM_ENV (proc)); |
scm_list_2 (arg1, arg2), SCM_ENV (proc)); |
3170 |
#endif |
#endif |
3171 |
x = SCM_CLOSURE_BODY (proc); |
x = SCM_CLOSURE_BODY (proc); |
3172 |
goto nontoplevel_begin; |
goto nontoplevel_begin; |
3177 |
goto wrongnumargs; |
goto wrongnumargs; |
3178 |
#endif |
#endif |
3179 |
#ifdef DEVAL |
#ifdef DEVAL |
3180 |
debug.info->a.args = scm_cons2 (t.arg1, arg2, |
debug.info->a.args = scm_cons2 (arg1, arg2, |
3181 |
deval_args (x, env, proc, SCM_CDRLOC (SCM_CDR (debug.info->a.args)))); |
deval_args (x, env, proc, SCM_CDRLOC (SCM_CDR (debug.info->a.args)))); |
3182 |
#endif |
#endif |
3183 |
ENTER_APPLY; |
ENTER_APPLY; |
3187 |
#ifdef DEVAL |
#ifdef DEVAL |
3188 |
case scm_tc7_subr_3: |
case scm_tc7_subr_3: |
3189 |
SCM_ASRTGO (SCM_NULLP (SCM_CDR (x)), wrongnumargs); |
SCM_ASRTGO (SCM_NULLP (SCM_CDR (x)), wrongnumargs); |
3190 |
RETURN (SCM_SUBRF (proc) (t.arg1, arg2, |
RETURN (SCM_SUBRF (proc) (arg1, arg2, |
3191 |
SCM_CADDR (debug.info->a.args))); |
SCM_CADDR (debug.info->a.args))); |
3192 |
case scm_tc7_asubr: |
case scm_tc7_asubr: |
3193 |
#ifdef BUILTIN_RPASUBR |
#ifdef BUILTIN_RPASUBR |
3194 |
t.arg1 = SCM_SUBRF(proc)(t.arg1, arg2); |
arg1 = SCM_SUBRF(proc)(arg1, arg2); |
3195 |
arg2 = SCM_CDDR (debug.info->a.args); |
arg2 = SCM_CDDR (debug.info->a.args); |
3196 |
do |
do |
3197 |
{ |
{ |
3198 |
t.arg1 = SCM_SUBRF(proc)(t.arg1, SCM_CAR (arg2)); |
arg1 = SCM_SUBRF(proc)(arg1, SCM_CAR (arg2)); |
3199 |
arg2 = SCM_CDR (arg2); |
arg2 = SCM_CDR (arg2); |
3200 |
} |
} |
3201 |
while (SCM_NIMP (arg2)); |
while (SCM_NIMP (arg2)); |
3202 |
RETURN (t.arg1); |
RETURN (arg1); |
3203 |
#endif /* BUILTIN_RPASUBR */ |
#endif /* BUILTIN_RPASUBR */ |
3204 |
case scm_tc7_rpsubr: |
case scm_tc7_rpsubr: |
3205 |
#ifdef BUILTIN_RPASUBR |
#ifdef BUILTIN_RPASUBR |
3206 |
if (SCM_FALSEP (SCM_SUBRF (proc) (t.arg1, arg2))) |
if (SCM_FALSEP (SCM_SUBRF (proc) (arg1, arg2))) |
3207 |
RETURN (SCM_BOOL_F); |
RETURN (SCM_BOOL_F); |
3208 |
t.arg1 = SCM_CDDR (debug.info->a.args); |
arg1 = SCM_CDDR (debug.info->a.args); |
3209 |
do |
do |
3210 |
{ |
{ |
3211 |
if (SCM_FALSEP (SCM_SUBRF (proc) (arg2, SCM_CAR (t.arg1)))) |
if (SCM_FALSEP (SCM_SUBRF (proc) (arg2, SCM_CAR (arg1)))) |
3212 |
RETURN (SCM_BOOL_F); |
RETURN (SCM_BOOL_F); |
3213 |
arg2 = SCM_CAR (t.arg1); |
arg2 = SCM_CAR (arg1); |
3214 |
t.arg1 = SCM_CDR (t.arg1); |
arg1 = SCM_CDR (arg1); |
3215 |
} |
} |
3216 |
while (SCM_NIMP (t.arg1)); |
while (SCM_NIMP (arg1)); |
3217 |
RETURN (SCM_BOOL_T); |
RETURN (SCM_BOOL_T); |
3218 |
#else /* BUILTIN_RPASUBR */ |
#else /* BUILTIN_RPASUBR */ |
3219 |
RETURN (SCM_APPLY (proc, t.arg1, |
RETURN (SCM_APPLY (proc, arg1, |
3220 |
scm_acons (arg2, |
scm_acons (arg2, |
3221 |
SCM_CDDR (debug.info->a.args), |
SCM_CDDR (debug.info->a.args), |
3222 |
SCM_EOL))); |
SCM_EOL))); |
3223 |
#endif /* BUILTIN_RPASUBR */ |
#endif /* BUILTIN_RPASUBR */ |
3224 |
case scm_tc7_lsubr_2: |
case scm_tc7_lsubr_2: |
3225 |
RETURN (SCM_SUBRF (proc) (t.arg1, arg2, |
RETURN (SCM_SUBRF (proc) (arg1, arg2, |
3226 |
SCM_CDDR (debug.info->a.args))); |
SCM_CDDR (debug.info->a.args))); |
3227 |
case scm_tc7_lsubr: |
case scm_tc7_lsubr: |
3228 |
RETURN (SCM_SUBRF (proc) (debug.info->a.args)); |
RETURN (SCM_SUBRF (proc) (debug.info->a.args)); |
3229 |
case scm_tc7_smob: |
case scm_tc7_smob: |
3230 |
if (!SCM_SMOB_APPLICABLE_P (proc)) |
if (!SCM_SMOB_APPLICABLE_P (proc)) |
3231 |
goto badfun; |
goto badfun; |
3232 |
RETURN (SCM_SMOB_APPLY_3 (proc, t.arg1, arg2, |
RETURN (SCM_SMOB_APPLY_3 (proc, arg1, arg2, |
3233 |
SCM_CDDR (debug.info->a.args))); |
SCM_CDDR (debug.info->a.args))); |
3234 |
case scm_tc7_cclo: |
case scm_tc7_cclo: |
3235 |
goto cclon; |
goto cclon; |
3250 |
#else /* DEVAL */ |
#else /* DEVAL */ |
3251 |
case scm_tc7_subr_3: |
case scm_tc7_subr_3: |
3252 |
SCM_ASRTGO (SCM_NULLP (SCM_CDR (x)), wrongnumargs); |
SCM_ASRTGO (SCM_NULLP (SCM_CDR (x)), wrongnumargs); |
3253 |
RETURN (SCM_SUBRF (proc) (t.arg1, arg2, EVALCAR (x, env))); |
RETURN (SCM_SUBRF (proc) (arg1, arg2, EVALCAR (x, env))); |
3254 |
case scm_tc7_asubr: |
case scm_tc7_asubr: |
3255 |
#ifdef BUILTIN_RPASUBR |
#ifdef BUILTIN_RPASUBR |
3256 |
t.arg1 = SCM_SUBRF (proc) (t.arg1, arg2); |
arg1 = SCM_SUBRF (proc) (arg1, arg2); |
3257 |
do |
do |
3258 |
{ |
{ |
3259 |
t.arg1 = SCM_SUBRF(proc)(t.arg1, EVALCAR(x, env)); |
arg1 = SCM_SUBRF(proc)(arg1, EVALCAR(x, env)); |
3260 |
x = SCM_CDR(x); |
x = SCM_CDR(x); |
3261 |
} |
} |
3262 |
while (SCM_NIMP (x)); |
while (SCM_NIMP (x)); |
3263 |
RETURN (t.arg1); |
RETURN (arg1); |
3264 |
#endif /* BUILTIN_RPASUBR */ |
#endif /* BUILTIN_RPASUBR */ |
3265 |
case scm_tc7_rpsubr: |
case scm_tc7_rpsubr: |
3266 |
#ifdef BUILTIN_RPASUBR |
#ifdef BUILTIN_RPASUBR |
3267 |
if (SCM_FALSEP (SCM_SUBRF (proc) (t.arg1, arg2))) |
if (SCM_FALSEP (SCM_SUBRF (proc) (arg1, arg2))) |
3268 |
RETURN (SCM_BOOL_F); |
RETURN (SCM_BOOL_F); |
3269 |
do |
do |
3270 |
{ |
{ |
3271 |
t.arg1 = EVALCAR (x, env); |
arg1 = EVALCAR (x, env); |
3272 |
if (SCM_FALSEP (SCM_SUBRF (proc) (arg2, t.arg1))) |
if (SCM_FALSEP (SCM_SUBRF (proc) (arg2, arg1))) |
3273 |
RETURN (SCM_BOOL_F); |
RETURN (SCM_BOOL_F); |
3274 |
arg2 = t.arg1; |
arg2 = arg1; |
3275 |
x = SCM_CDR (x); |
x = SCM_CDR (x); |
3276 |
} |
} |
3277 |
while (SCM_NIMP (x)); |
while (SCM_NIMP (x)); |
3278 |
RETURN (SCM_BOOL_T); |
RETURN (SCM_BOOL_T); |
3279 |
#else /* BUILTIN_RPASUBR */ |
#else /* BUILTIN_RPASUBR */ |
3280 |
RETURN (SCM_APPLY (proc, t.arg1, |
RETURN (SCM_APPLY (proc, arg1, |
3281 |
scm_acons (arg2, |
scm_acons (arg2, |
3282 |
scm_eval_args (x, env, proc), |
scm_eval_args (x, env, proc), |
3283 |
SCM_EOL))); |
SCM_EOL))); |
3284 |
#endif /* BUILTIN_RPASUBR */ |
#endif /* BUILTIN_RPASUBR */ |
3285 |
case scm_tc7_lsubr_2: |
case scm_tc7_lsubr_2: |
3286 |
RETURN (SCM_SUBRF (proc) (t.arg1, arg2, scm_eval_args (x, env, proc))); |
RETURN (SCM_SUBRF (proc) (arg1, arg2, scm_eval_args (x, env, proc))); |
3287 |
case scm_tc7_lsubr: |
case scm_tc7_lsubr: |
3288 |
RETURN (SCM_SUBRF (proc) (scm_cons2 (t.arg1, |
RETURN (SCM_SUBRF (proc) (scm_cons2 (arg1, |
3289 |
arg2, |
arg2, |
3290 |
scm_eval_args (x, env, proc)))); |
scm_eval_args (x, env, proc)))); |
3291 |
case scm_tc7_smob: |
case scm_tc7_smob: |
3292 |
if (!SCM_SMOB_APPLICABLE_P (proc)) |
if (!SCM_SMOB_APPLICABLE_P (proc)) |
3293 |
goto badfun; |
goto badfun; |
3294 |
RETURN (SCM_SMOB_APPLY_3 (proc, t.arg1, arg2, |
RETURN (SCM_SMOB_APPLY_3 (proc, arg1, arg2, |
3295 |
scm_eval_args (x, env, proc))); |
scm_eval_args (x, env, proc))); |
3296 |
case scm_tc7_cclo: |
case scm_tc7_cclo: |
3297 |
goto cclon; |
goto cclon; |
3313 |
SCM_SET_ARGSREADY (debug); |
SCM_SET_ARGSREADY (debug); |
3314 |
#endif |
#endif |
3315 |
env = EXTEND_ENV (SCM_CLOSURE_FORMALS (proc), |
env = EXTEND_ENV (SCM_CLOSURE_FORMALS (proc), |
3316 |
scm_cons2 (t.arg1, |
scm_cons2 (arg1, |
3317 |
arg2, |
arg2, |
3318 |
scm_eval_args (x, env, proc)), |
scm_eval_args (x, env, proc)), |
3319 |
SCM_ENV (proc)); |
SCM_ENV (proc)); |
3324 |
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC) |
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC) |
3325 |
{ |
{ |
3326 |
#ifdef DEVAL |
#ifdef DEVAL |
3327 |
t.arg1 = debug.info->a.args; |
arg1 = debug.info->a.args; |
3328 |
#else |
#else |
3329 |
t.arg1 = scm_cons2 (t.arg1, arg2, scm_eval_args (x, env, proc)); |
arg1 = scm_cons2 (arg1, arg2, scm_eval_args (x, env, proc)); |
3330 |
#endif |
#endif |
3331 |
x = SCM_ENTITY_PROCEDURE (proc); |
x = SCM_ENTITY_PROCEDURE (proc); |
3332 |
goto type_dispatch; |
goto type_dispatch; |
3353 |
{ |
{ |
3354 |
SCM_CLEAR_TRACED_FRAME (debug); |
SCM_CLEAR_TRACED_FRAME (debug); |
3355 |
if (SCM_CHEAPTRAPS_P) |
if (SCM_CHEAPTRAPS_P) |
3356 |
t.arg1 = scm_make_debugobj (&debug); |
arg1 = scm_make_debugobj (&debug); |
3357 |
else |
else |
3358 |
{ |
{ |
3359 |
int first; |
int first; |
3360 |
SCM val = scm_make_continuation (&first); |
SCM val = scm_make_continuation (&first); |
3361 |
|
|
3362 |
if (first) |
if (first) |
3363 |
t.arg1 = val; |
arg1 = val; |
3364 |
else |
else |
3365 |
{ |
{ |
3366 |
proc = val; |
proc = val; |
3368 |
} |
} |
3369 |
} |
} |
3370 |
SCM_TRAPS_P = 0; |
SCM_TRAPS_P = 0; |
3371 |
scm_call_3 (SCM_EXIT_FRAME_HDLR, scm_sym_exit_frame, t.arg1, proc); |
scm_call_3 (SCM_EXIT_FRAME_HDLR, scm_sym_exit_frame, arg1, proc); |
3372 |
SCM_TRAPS_P = 1; |
SCM_TRAPS_P = 1; |
3373 |
} |
} |
3374 |
ret: |
ret: |