2348 |
|
|
2349 |
|
|
2350 |
/* new syntactic forms go here. */ |
/* new syntactic forms go here. */ |
2351 |
case SCM_BIT8(SCM_MAKISYM (0)): |
case SCM_BIT8 (SCM_MAKISYM (0)): |
2352 |
proc = SCM_CAR (x); |
proc = SCM_CAR (x); |
2353 |
SCM_ASRTGO (SCM_ISYMP (proc), badfun); |
SCM_ASRTGO (SCM_ISYMP (proc), badfun); |
2354 |
switch (SCM_ISYMNUM (proc)) |
switch (SCM_ISYMNUM (proc)) |
2355 |
{ |
{ |
2356 |
|
|
2357 |
|
|
2358 |
case (SCM_ISYMNUM (SCM_IM_APPLY)): |
case (SCM_ISYMNUM (SCM_IM_APPLY)): |
2359 |
proc = SCM_CDR (x); |
proc = SCM_CDR (x); |
2360 |
proc = EVALCAR (proc, env); |
proc = EVALCAR (proc, env); |
2361 |
SCM_ASRTGO (SCM_NIMP (proc), badfun); |
SCM_ASRTGO (!SCM_IMP (proc), badfun); |
2362 |
if (SCM_CLOSUREP (proc)) |
if (SCM_CLOSUREP (proc)) |
2363 |
{ |
{ |
|
SCM argl, tl; |
|
2364 |
PREP_APPLY (proc, SCM_EOL); |
PREP_APPLY (proc, SCM_EOL); |
2365 |
t.arg1 = SCM_CDDR (x); |
t.arg1 = SCM_CDDR (x); |
2366 |
t.arg1 = EVALCAR (t.arg1, env); |
t.arg1 = EVALCAR (t.arg1, env); |
2368 |
/* Go here to tail-call a closure. PROC is the closure |
/* Go here to tail-call a closure. PROC is the closure |
2369 |
and T.ARG1 is the list of arguments. Do not forget to |
and T.ARG1 is the list of arguments. Do not forget to |
2370 |
call PREP_APPLY. */ |
call PREP_APPLY. */ |
2371 |
|
{ |
2372 |
|
SCM formals = SCM_CLOSURE_FORMALS (proc); |
2373 |
#ifdef DEVAL |
#ifdef DEVAL |
2374 |
debug.info->a.args = t.arg1; |
debug.info->a.args = t.arg1; |
2375 |
#endif |
#endif |
2376 |
#ifndef SCM_RECKLESS |
#ifndef SCM_RECKLESS |
2377 |
if (scm_badargsp (SCM_CLOSURE_FORMALS (proc), t.arg1)) |
if (scm_badargsp (formals, t.arg1)) |
2378 |
goto wrongnumargs; |
goto wrongnumargs; |
2379 |
#endif |
#endif |
2380 |
ENTER_APPLY; |
ENTER_APPLY; |
2381 |
/* Copy argument list */ |
/* Copy argument list */ |
2382 |
if (SCM_IMP (t.arg1)) |
if (SCM_NULL_OR_NIL_P (t.arg1)) |
2383 |
argl = t.arg1; |
env = EXTEND_ENV (formals, SCM_EOL, SCM_ENV (proc)); |
2384 |
else |
else |
2385 |
{ |
{ |
2386 |
argl = tl = scm_cons (SCM_CAR (t.arg1), SCM_UNSPECIFIED); |
SCM args = scm_list_1 (SCM_CAR (t.arg1)); |
2387 |
while (SCM_NIMP (t.arg1 = SCM_CDR (t.arg1)) |
SCM tail = args; |
2388 |
&& SCM_CONSP (t.arg1)) |
t.arg1 = SCM_CDR (t.arg1); |
2389 |
{ |
while (!SCM_NULL_OR_NIL_P (t.arg1)) |
2390 |
SCM_SETCDR (tl, scm_cons (SCM_CAR (t.arg1), |
{ |
2391 |
SCM_UNSPECIFIED)); |
SCM new_tail = scm_list_1 (SCM_CAR (t.arg1)); |
2392 |
tl = SCM_CDR (tl); |
SCM_SETCDR (tail, new_tail); |
2393 |
} |
tail = new_tail; |
2394 |
SCM_SETCDR (tl, t.arg1); |
t.arg1 = SCM_CDR (t.arg1); |
2395 |
} |
} |
2396 |
|
env = EXTEND_ENV (formals, args, SCM_ENV (proc)); |
2397 |
|
} |
2398 |
|
|
2399 |
env = EXTEND_ENV (SCM_CLOSURE_FORMALS (proc), argl, SCM_ENV (proc)); |
x = SCM_CLOSURE_BODY (proc); |
2400 |
x = SCM_CLOSURE_BODY (proc); |
goto nontoplevel_begin; |
2401 |
goto nontoplevel_begin; |
} |
2402 |
} |
} |
2403 |
proc = scm_f_apply; |
else |
2404 |
goto evapply; |
{ |
2405 |
|
proc = scm_f_apply; |
2406 |
|
goto evapply; |
2407 |
|
} |
2408 |
|
|
2409 |
|
|
2410 |
case (SCM_ISYMNUM (SCM_IM_CONT)): |
case (SCM_ISYMNUM (SCM_IM_CONT)): |
2411 |
{ |
{ |