| … | |
… | |
| 5413 | const op_code_info *pcd = dispatch_table + SCHEME_V->op; |
5413 | const op_code_info *pcd = dispatch_table + SCHEME_V->op; |
| 5414 | |
5414 | |
| 5415 | #if USE_ERROR_CHECKING |
5415 | #if USE_ERROR_CHECKING |
| 5416 | if (pcd->builtin) /* if built-in function, check arguments */ |
5416 | if (pcd->builtin) /* if built-in function, check arguments */ |
| 5417 | { |
5417 | { |
| 5418 | int ok = 1; |
|
|
| 5419 | char msg[STRBUFFSIZE]; |
5418 | char msg[STRBUFFSIZE]; |
| 5420 | int n = list_length (SCHEME_A_ SCHEME_V->args); |
5419 | int n = list_length (SCHEME_A_ SCHEME_V->args); |
| 5421 | |
5420 | |
| 5422 | /* Check number of arguments */ |
5421 | /* Check number of arguments */ |
| 5423 | if (ecb_expect_false (n < pcd->min_arity)) |
5422 | if (ecb_expect_false (n < pcd->min_arity)) |
| 5424 | { |
5423 | { |
| 5425 | ok = 0; |
|
|
| 5426 | snprintf (msg, STRBUFFSIZE, "%s: needs%s %d argument(s)", |
5424 | snprintf (msg, STRBUFFSIZE, "%s: needs%s %d argument(s)", |
| 5427 | opname (SCHEME_V->op), pcd->min_arity == pcd->max_arity ? "" : " at least", pcd->min_arity); |
5425 | opname (SCHEME_V->op), pcd->min_arity == pcd->max_arity ? "" : " at least", pcd->min_arity); |
|
|
5426 | xError_1 (SCHEME_A_ msg, 0); |
|
|
5427 | continue; |
| 5428 | } |
5428 | } |
| 5429 | else if (ecb_expect_false (n > pcd->max_arity && pcd->max_arity != INF_ARG)) |
5429 | else if (ecb_expect_false (n > pcd->max_arity && pcd->max_arity != INF_ARG)) |
| 5430 | { |
5430 | { |
| 5431 | ok = 0; |
|
|
| 5432 | snprintf (msg, STRBUFFSIZE, "%s: needs%s %d argument(s)", |
5431 | snprintf (msg, STRBUFFSIZE, "%s: needs%s %d argument(s)", |
| 5433 | opname (SCHEME_V->op), pcd->min_arity == pcd->max_arity ? "" : " at most", pcd->max_arity); |
5432 | opname (SCHEME_V->op), pcd->min_arity == pcd->max_arity ? "" : " at most", pcd->max_arity); |
|
|
5433 | xError_1 (SCHEME_A_ msg, 0); |
|
|
5434 | continue; |
| 5434 | } |
5435 | } |
| 5435 | else |
5436 | else |
| 5436 | { |
5437 | { |
| 5437 | if (*pcd->arg_tests_encoding) /* literal 0 and TST_NONE treated the same */ |
5438 | if (*pcd->arg_tests_encoding) /* literal 0 and TST_NONE treated the same */ |
| 5438 | { |
5439 | { |
| … | |
… | |
| 5458 | } |
5459 | } |
| 5459 | while (i < n); |
5460 | while (i < n); |
| 5460 | |
5461 | |
| 5461 | if (i < n) |
5462 | if (i < n) |
| 5462 | { |
5463 | { |
| 5463 | ok = 0; |
|
|
| 5464 | snprintf (msg, STRBUFFSIZE, "%s: argument %d must be: %s", opname (SCHEME_V->op), i + 1, tests[j].kind); |
5464 | snprintf (msg, STRBUFFSIZE, "%s: argument %d must be: %s", opname (SCHEME_V->op), i + 1, tests[j].kind); |
|
|
5465 | xError_1 (SCHEME_A_ msg, 0); |
|
|
5466 | continue; |
| 5465 | } |
5467 | } |
| 5466 | } |
5468 | } |
| 5467 | } |
|
|
| 5468 | |
|
|
| 5469 | if (!ok) |
|
|
| 5470 | { |
|
|
| 5471 | /* tinyscheme tested for returncode, but Error_1 always diverts? */ |
|
|
| 5472 | xError_1 (SCHEME_A_ msg, 0); |
|
|
| 5473 | continue; |
|
|
| 5474 | } |
5469 | } |
| 5475 | } |
5470 | } |
| 5476 | #endif |
5471 | #endif |
| 5477 | |
5472 | |
| 5478 | ok_to_freely_gc (SCHEME_A); |
5473 | ok_to_freely_gc (SCHEME_A); |
