… | |
… | |
219 | T_FOREIGN, |
219 | T_FOREIGN, |
220 | T_PORT, |
220 | T_PORT, |
221 | T_VECTOR, |
221 | T_VECTOR, |
222 | T_PROMISE, |
222 | T_PROMISE, |
223 | T_ENVIRONMENT, |
223 | T_ENVIRONMENT, |
|
|
224 | T_SPECIAL, // #t, #f, '(), eof-object |
224 | |
225 | |
225 | T_NUM_SYSTEM_TYPES |
226 | T_NUM_SYSTEM_TYPES |
226 | }; |
227 | }; |
227 | |
228 | |
228 | #define T_MASKTYPE 0x000f |
229 | #define T_MASKTYPE 0x001f |
229 | #define T_SYNTAX 0x0010 |
230 | #define T_SYNTAX 0x0020 |
230 | #define T_IMMUTABLE 0x0020 |
231 | #define T_IMMUTABLE 0x0040 |
231 | #define T_ATOM 0x0040 /* only for gc */ |
232 | #define T_ATOM 0x0080 /* only for gc */ |
232 | #define T_MARK 0x0080 /* only for gc */ |
233 | //#define T_MARK 0x0080 /* only for gc */ |
233 | |
234 | |
234 | /* num, for generic arithmetic */ |
235 | /* num, for generic arithmetic */ |
235 | struct num |
236 | struct num |
236 | { |
237 | { |
237 | IVALUE ivalue; |
238 | IVALUE ivalue; |
… | |
… | |
510 | |
511 | |
511 | #define is_atom(p) (typeflag (p) & T_ATOM) |
512 | #define is_atom(p) (typeflag (p) & T_ATOM) |
512 | #define setatom(p) set_typeflag ((p), typeflag (p) | T_ATOM) |
513 | #define setatom(p) set_typeflag ((p), typeflag (p) | T_ATOM) |
513 | #define clratom(p) set_typeflag ((p), typeflag (p) & ~T_ATOM) |
514 | #define clratom(p) set_typeflag ((p), typeflag (p) & ~T_ATOM) |
514 | |
515 | |
|
|
516 | #if 1 |
|
|
517 | #define is_mark(p) (CELL(p)->mark) |
|
|
518 | #define setmark(p) (CELL(p)->mark = 1) |
|
|
519 | #define clrmark(p) (CELL(p)->mark = 0) |
|
|
520 | #else |
515 | #define is_mark(p) (typeflag (p) & T_MARK) |
521 | #define is_mark(p) (typeflag (p) & T_MARK) |
516 | #define setmark(p) set_typeflag ((p), typeflag (p) | T_MARK) |
522 | #define setmark(p) set_typeflag ((p), typeflag (p) | T_MARK) |
517 | #define clrmark(p) set_typeflag ((p), typeflag (p) & ~T_MARK) |
523 | #define clrmark(p) set_typeflag ((p), typeflag (p) & ~T_MARK) |
|
|
524 | #endif |
518 | |
525 | |
519 | INTERFACE int |
526 | INTERFACE int |
520 | is_immutable (pointer p) |
527 | is_immutable (pointer p) |
521 | { |
528 | { |
522 | return typeflag (p) & T_IMMUTABLE && USE_ERROR_CHECKING; |
529 | return typeflag (p) & T_IMMUTABLE && USE_ERROR_CHECKING; |
… | |
… | |
928 | last = newp + segsize - 1; |
935 | last = newp + segsize - 1; |
929 | |
936 | |
930 | for (p = newp; p <= last; p++) |
937 | for (p = newp; p <= last; p++) |
931 | { |
938 | { |
932 | pointer cp = POINTER (p); |
939 | pointer cp = POINTER (p); |
|
|
940 | clrmark (cp); |
933 | set_typeflag (cp, T_PAIR); |
941 | set_typeflag (cp, T_PAIR); |
934 | set_car (cp, NIL); |
942 | set_car (cp, NIL); |
935 | set_cdr (cp, POINTER (p + 1)); |
943 | set_cdr (cp, POINTER (p + 1)); |
936 | } |
944 | } |
937 | |
945 | |
… | |
… | |
3338 | stream_put (s, stream_data (o)[i]); |
3346 | stream_put (s, stream_data (o)[i]); |
3339 | |
3347 | |
3340 | stream_free (o); |
3348 | stream_free (o); |
3341 | } |
3349 | } |
3342 | |
3350 | |
|
|
3351 | ecb_cold static uint32_t |
|
|
3352 | cell_id (SCHEME_P_ pointer x) |
|
|
3353 | { |
|
|
3354 | struct cell *p = CELL (x); |
|
|
3355 | int i; |
|
|
3356 | |
|
|
3357 | for (i = SCHEME_V->last_cell_seg; i >= 0; --i) |
|
|
3358 | if (SCHEME_V->cell_seg[i] <= p && p < SCHEME_V->cell_seg[i] + SCHEME_V->cell_segsize[i]) |
|
|
3359 | return i | ((p - SCHEME_V->cell_seg[i]) << CELL_NSEGMENT_LOG); |
|
|
3360 | |
|
|
3361 | abort (); |
|
|
3362 | } |
|
|
3363 | |
3343 | // calculates a (preferably small) integer that makes it possible to find |
3364 | // calculates a (preferably small) integer that makes it possible to find |
3344 | // the symbol again. if pointers were offsets into a memory area... until |
3365 | // the symbol again. if pointers were offsets into a memory area... until |
3345 | // then, we return segment number in the low bits, and offset in the high |
3366 | // then, we return segment number in the low bits, and offset in the high |
3346 | // bits. |
3367 | // bits. |
3347 | // also, this function must never return 0. |
3368 | // also, this function must never return 0. |
3348 | ecb_cold static uint32_t |
3369 | ecb_cold static uint32_t |
3349 | symbol_id (SCHEME_P_ pointer sym) |
3370 | symbol_id (SCHEME_P_ pointer sym) |
3350 | { |
3371 | { |
3351 | struct cell *p = CELL (sym); |
|
|
3352 | int i; |
|
|
3353 | |
|
|
3354 | for (i = SCHEME_V->last_cell_seg; i >= 0; --i) |
|
|
3355 | if (SCHEME_V->cell_seg[i] <= p && p < SCHEME_V->cell_seg[i] + SCHEME_V->cell_segsize[i]) |
|
|
3356 | return i | ((p - SCHEME_V->cell_seg[i]) << CELL_NSEGMENT_LOG); |
|
|
3357 | |
|
|
3358 | abort (); |
|
|
3359 | } |
|
|
3360 | |
|
|
3361 | ecb_cold static uint32_t |
|
|
3362 | cell_id (SCHEME_P_ pointer p) |
|
|
3363 | { |
|
|
3364 | return symbol_id (SCHEME_A_ p); |
3372 | return cell_id (SCHEME_A_ sym); |
3365 | } |
3373 | } |
3366 | |
3374 | |
3367 | enum byteop |
3375 | enum byteop |
3368 | { |
3376 | { |
3369 | BOP_NIL, |
3377 | BOP_NIL, |
3370 | BOP_SYNTAX, |
|
|
3371 | BOP_INTEGER, |
3378 | BOP_INTEGER, |
3372 | BOP_SYMBOL, |
3379 | BOP_SYMBOL, |
|
|
3380 | BOP_DATUM, |
3373 | BOP_LIST_BEG, |
3381 | BOP_LIST_BEG, |
3374 | BOP_LIST_END, |
3382 | BOP_LIST_END, |
3375 | BOP_BIFT, // branch if true |
3383 | BOP_IF, |
3376 | BOP_BIFF, // branch if false |
3384 | BOP_AND, |
3377 | BOP_BIFNE, // branch if not eqv? |
3385 | BOP_OR, |
3378 | BOP_BRA, // "short" branch |
3386 | BOP_CASE, |
3379 | BOP_JMP, // "long" jump |
3387 | BOP_COND, |
3380 | BOP_DATUM, |
|
|
3381 | BOP_LET, |
3388 | BOP_LET, |
3382 | BOP_LETAST, |
3389 | BOP_LETAST, |
3383 | BOP_LETREC, |
3390 | BOP_LETREC, |
3384 | BOP_DEFINE, |
3391 | BOP_DEFINE, |
3385 | BOP_MACRO, |
3392 | BOP_MACRO, |
3386 | BOP_SET, |
3393 | BOP_SET, |
3387 | BOP_BEGIN, |
3394 | BOP_BEGIN, |
3388 | BOP_LAMBDA, |
3395 | BOP_LAMBDA, |
|
|
3396 | BOP_OP, |
3389 | }; |
3397 | }; |
3390 | |
3398 | |
3391 | ecb_cold static void compile_expr (SCHEME_P_ stream s, pointer x); |
3399 | ecb_cold static void compile_expr (SCHEME_P_ stream s, pointer x); |
3392 | |
3400 | |
3393 | ecb_cold static void |
3401 | ecb_cold static void |
3394 | compile_list (SCHEME_P_ stream s, pointer x) |
3402 | compile_list (SCHEME_P_ stream s, pointer x) |
3395 | { |
3403 | { |
|
|
3404 | // TODO: improper list |
|
|
3405 | |
3396 | for (; x != NIL; x = cdr (x)) |
3406 | for (; x != NIL; x = cdr (x)) |
|
|
3407 | { |
|
|
3408 | stream t = stream_init (); |
3397 | compile_expr (SCHEME_A_ s, car (x)); |
3409 | compile_expr (SCHEME_A_ t, car (x)); |
|
|
3410 | stream_put_v (s, stream_size (t)); |
|
|
3411 | stream_put_stream (s, t); |
|
|
3412 | } |
|
|
3413 | |
|
|
3414 | stream_put_v (s, 0); |
3398 | } |
3415 | } |
3399 | |
3416 | |
3400 | static void |
3417 | static void |
3401 | compile_if (SCHEME_P_ stream s, pointer cond, pointer ift, pointer iff) |
3418 | compile_if (SCHEME_P_ stream s, pointer cond, pointer ift, pointer iff) |
3402 | { |
3419 | { |
3403 | //TODO: borked |
|
|
3404 | stream sift = stream_init (); compile_expr (SCHEME_A_ sift, ift); |
3420 | stream sift = stream_init (); compile_expr (SCHEME_A_ sift, ift); |
3405 | |
3421 | |
3406 | stream_put (s, BOP_BIFF); |
3422 | stream_put (s, BOP_IF); |
3407 | compile_expr (SCHEME_A_ s, cond); |
3423 | compile_expr (SCHEME_A_ s, cond); |
3408 | stream_put_v (s, stream_size (sift)); |
3424 | stream_put_v (s, stream_size (sift)); |
3409 | stream_put_stream (s, sift); |
3425 | stream_put_stream (s, sift); |
3410 | |
3426 | compile_expr (SCHEME_A_ s, iff); |
3411 | if (iff != NIL) |
|
|
3412 | { |
|
|
3413 | stream siff = stream_init (); compile_expr (SCHEME_A_ siff, iff); |
|
|
3414 | stream_put_tv (s, BOP_BRA, stream_size (siff)); |
|
|
3415 | stream_put_stream (s, siff); |
|
|
3416 | } |
|
|
3417 | } |
3427 | } |
3418 | |
3428 | |
3419 | typedef uint32_t stream_fixup; |
3429 | typedef uint32_t stream_fixup; |
3420 | |
3430 | |
3421 | static stream_fixup |
3431 | static stream_fixup |
… | |
… | |
3437 | } |
3447 | } |
3438 | |
3448 | |
3439 | static void |
3449 | static void |
3440 | compile_and_or (SCHEME_P_ stream s, int and, pointer x) |
3450 | compile_and_or (SCHEME_P_ stream s, int and, pointer x) |
3441 | { |
3451 | { |
3442 | if (cdr (x) == NIL) |
3452 | for (; cdr (x) != NIL; x = cdr (x)) |
|
|
3453 | { |
|
|
3454 | stream t = stream_init (); |
|
|
3455 | compile_expr (SCHEME_A_ t, car (x)); |
|
|
3456 | stream_put_v (s, stream_size (t)); |
|
|
3457 | stream_put_stream (s, t); |
|
|
3458 | } |
|
|
3459 | |
|
|
3460 | stream_put_v (s, 0); |
|
|
3461 | } |
|
|
3462 | |
|
|
3463 | static void |
|
|
3464 | compile_case (SCHEME_P_ stream s, pointer x) |
|
|
3465 | { |
3443 | compile_expr (SCHEME_A_ s, car (x)); |
3466 | compile_expr (SCHEME_A_ s, caar (x)); |
3444 | else |
3467 | |
|
|
3468 | for (;;) |
3445 | { |
3469 | { |
3446 | stream_put (s, and ? BOP_BIFF : BOP_BIFT); |
3470 | x = cdr (x); |
|
|
3471 | |
|
|
3472 | if (x == NIL) |
|
|
3473 | break; |
|
|
3474 | |
3447 | compile_expr (SCHEME_A_ s, car (x)); |
3475 | compile_expr (SCHEME_A_ s, caar (x)); |
3448 | stream_fixup end = stream_put_fixup (s); |
3476 | stream t = stream_init (); compile_expr (SCHEME_A_ t, cdar (x)); |
|
|
3477 | stream_put_v (s, stream_size (t)); |
|
|
3478 | stream_put_stream (s, t); |
|
|
3479 | } |
3449 | |
3480 | |
|
|
3481 | stream_put_v (s, 0); |
|
|
3482 | } |
|
|
3483 | |
|
|
3484 | static void |
|
|
3485 | compile_cond (SCHEME_P_ stream s, pointer x) |
|
|
3486 | { |
|
|
3487 | for ( ; x != NIL; x = cdr (x)) |
|
|
3488 | { |
3450 | compile_and_or (SCHEME_A_ s, and, cdr (x)); |
3489 | compile_expr (SCHEME_A_ s, caar (x)); |
|
|
3490 | stream t = stream_init (); compile_expr (SCHEME_A_ t, cdar (x)); |
3451 | stream_fix_fixup (s, end, stream_size (s)); |
3491 | stream_put_v (s, stream_size (t)); |
|
|
3492 | stream_put_stream (s, t); |
3452 | } |
3493 | } |
|
|
3494 | |
|
|
3495 | stream_put_v (s, 0); |
|
|
3496 | } |
|
|
3497 | |
|
|
3498 | static pointer |
|
|
3499 | lookup (SCHEME_P_ pointer x) |
|
|
3500 | { |
|
|
3501 | x = find_slot_in_env (SCHEME_A_ SCHEME_V->envir, x, 1); |
|
|
3502 | |
|
|
3503 | if (x != NIL) |
|
|
3504 | x = slot_value_in_env (x); |
|
|
3505 | |
|
|
3506 | return x; |
3453 | } |
3507 | } |
3454 | |
3508 | |
3455 | ecb_cold static void |
3509 | ecb_cold static void |
3456 | compile_expr (SCHEME_P_ stream s, pointer x) |
3510 | compile_expr (SCHEME_P_ stream s, pointer x) |
3457 | { |
3511 | { |
… | |
… | |
3470 | x = cdr (x); |
3524 | x = cdr (x); |
3471 | |
3525 | |
3472 | switch (syntaxnum (head)) |
3526 | switch (syntaxnum (head)) |
3473 | { |
3527 | { |
3474 | case OP_IF0: /* if */ |
3528 | case OP_IF0: /* if */ |
|
|
3529 | stream_put_v (s, BOP_IF); |
3475 | compile_if (SCHEME_A_ s, car (x), cadr (x), caddr (x)); |
3530 | compile_if (SCHEME_A_ s, car (x), cadr (x), caddr (x)); |
3476 | break; |
3531 | break; |
3477 | |
3532 | |
3478 | case OP_OR0: /* or */ |
3533 | case OP_OR0: /* or */ |
|
|
3534 | stream_put_v (s, BOP_OR); |
3479 | compile_and_or (SCHEME_A_ s, 0, x); |
3535 | compile_and_or (SCHEME_A_ s, 0, x); |
3480 | break; |
3536 | break; |
3481 | |
3537 | |
3482 | case OP_AND0: /* and */ |
3538 | case OP_AND0: /* and */ |
|
|
3539 | stream_put_v (s, BOP_AND); |
3483 | compile_and_or (SCHEME_A_ s, 1, x); |
3540 | compile_and_or (SCHEME_A_ s, 1, x); |
3484 | break; |
3541 | break; |
3485 | |
3542 | |
3486 | case OP_CASE0: /* case */ |
3543 | case OP_CASE0: /* case */ |
3487 | abort (); |
3544 | stream_put_v (s, BOP_CASE); |
|
|
3545 | compile_case (SCHEME_A_ s, x); |
3488 | break; |
3546 | break; |
3489 | |
3547 | |
3490 | case OP_COND0: /* cond */ |
3548 | case OP_COND0: /* cond */ |
3491 | abort (); |
3549 | stream_put_v (s, BOP_COND); |
|
|
3550 | compile_cond (SCHEME_A_ s, x); |
3492 | break; |
3551 | break; |
3493 | |
3552 | |
3494 | case OP_LET0: /* let */ |
3553 | case OP_LET0: /* let */ |
3495 | case OP_LET0AST: /* let* */ |
3554 | case OP_LET0AST: /* let* */ |
3496 | case OP_LET0REC: /* letrec */ |
3555 | case OP_LET0REC: /* letrec */ |
… | |
… | |
3574 | } |
3633 | } |
3575 | |
3634 | |
3576 | return; |
3635 | return; |
3577 | } |
3636 | } |
3578 | |
3637 | |
3579 | pointer m = find_slot_in_env (SCHEME_A_ SCHEME_V->envir, head, 1); |
3638 | pointer m = lookup (SCHEME_A_ head); |
3580 | |
3639 | |
3581 | if (m != NIL) |
3640 | if (is_macro (m)) |
3582 | { |
3641 | { |
3583 | m = slot_value_in_env (m); |
|
|
3584 | |
|
|
3585 | if (is_macro (m)) |
|
|
3586 | { |
|
|
3587 | s_save (SCHEME_A_ OP_DEBUG2, SCHEME_V->args, SCHEME_V->code); |
3642 | s_save (SCHEME_A_ OP_DEBUG2, SCHEME_V->args, SCHEME_V->code); |
3588 | SCHEME_V->code = m; |
3643 | SCHEME_V->code = m; |
3589 | SCHEME_V->args = cons (x, NIL); |
3644 | SCHEME_V->args = cons (x, NIL); |
3590 | Eval_Cycle (SCHEME_A_ OP_APPLY); |
3645 | Eval_Cycle (SCHEME_A_ OP_APPLY); |
3591 | x = SCHEME_V->value; |
3646 | x = SCHEME_V->value; |
3592 | compile_expr (SCHEME_A_ s, SCHEME_V->value); |
3647 | compile_expr (SCHEME_A_ s, SCHEME_V->value); |
3593 | return; |
3648 | return; |
3594 | } |
|
|
3595 | } |
3649 | } |
|
|
3650 | |
|
|
3651 | stream_put (s, BOP_LIST_BEG); |
|
|
3652 | |
|
|
3653 | for (; x != NIL; x = cdr (x)) |
|
|
3654 | compile_expr (SCHEME_A_ s, car (x)); |
|
|
3655 | |
|
|
3656 | stream_put (s, BOP_LIST_END); |
|
|
3657 | return; |
3596 | } |
3658 | } |
3597 | |
3659 | |
3598 | switch (type (x)) |
3660 | switch (type (x)) |
3599 | { |
3661 | { |
3600 | case T_INTEGER: |
3662 | case T_INTEGER: |
3601 | { |
3663 | { |
3602 | IVALUE iv = ivalue_unchecked (x); |
3664 | IVALUE iv = ivalue_unchecked (x); |
3603 | iv = iv < 0 ? ((uint32_t)-iv << 1) | 1 : (uint32_t)iv << 1; |
3665 | iv = iv < 0 ? ((~(uint32_t)iv) << 1) | 1 : (uint32_t)iv << 1; |
3604 | stream_put_tv (s, BOP_INTEGER, iv); |
3666 | stream_put_tv (s, BOP_INTEGER, iv); |
3605 | } |
3667 | } |
3606 | return; |
3668 | return; |
3607 | |
3669 | |
3608 | case T_SYMBOL: |
3670 | case T_SYMBOL: |
|
|
3671 | if (0) |
|
|
3672 | { |
|
|
3673 | // no can do without more analysis |
|
|
3674 | pointer m = lookup (SCHEME_A_ x); |
|
|
3675 | |
|
|
3676 | if (is_proc (m)) |
|
|
3677 | { |
|
|
3678 | printf ("compile proc %s %d\n", procname(m), procnum(m)); |
|
|
3679 | stream_put_tv (s, BOP_SYMBOL, BOP_OP + procnum (m)); |
|
|
3680 | } |
|
|
3681 | else |
|
|
3682 | stream_put_tv (s, BOP_SYMBOL, symbol_id (SCHEME_A_ x)); |
|
|
3683 | } |
|
|
3684 | |
3609 | stream_put_tv (s, BOP_SYMBOL, symbol_id (SCHEME_A_ x)); |
3685 | stream_put_tv (s, BOP_SYMBOL, symbol_id (SCHEME_A_ x)); |
3610 | return; |
|
|
3611 | |
|
|
3612 | case T_PAIR: |
|
|
3613 | stream_put (s, BOP_LIST_BEG); |
|
|
3614 | |
|
|
3615 | for (; x != NIL; x = cdr (x)) |
|
|
3616 | compile_expr (SCHEME_A_ s, car (x)); |
|
|
3617 | |
|
|
3618 | stream_put (s, BOP_LIST_END); |
|
|
3619 | return; |
3686 | return; |
3620 | |
3687 | |
3621 | default: |
3688 | default: |
3622 | stream_put_tv (s, BOP_DATUM, cell_id (SCHEME_A_ x)); |
3689 | stream_put_tv (s, BOP_DATUM, cell_id (SCHEME_A_ x)); |
3623 | break; |
3690 | break; |
… | |
… | |
5947 | |
6014 | |
5948 | ecb_cold int |
6015 | ecb_cold int |
5949 | scheme_init (SCHEME_P) |
6016 | scheme_init (SCHEME_P) |
5950 | { |
6017 | { |
5951 | int i, n = sizeof (dispatch_table) / sizeof (dispatch_table[0]); |
6018 | int i, n = sizeof (dispatch_table) / sizeof (dispatch_table[0]); |
5952 | pointer x; |
|
|
5953 | |
6019 | |
5954 | /* this memset is not strictly correct, as we assume (intcache) |
6020 | /* this memset is not strictly correct, as we assume (intcache) |
5955 | * that memset 0 will also set pointers to 0, but memset does |
6021 | * that memset 0 will also set pointers to 0, but memset does |
5956 | * of course not guarantee that. screw such systems. |
6022 | * of course not guarantee that. screw such systems. |
5957 | */ |
6023 | */ |
… | |
… | |
5992 | SCHEME_V->envir = NIL; |
6058 | SCHEME_V->envir = NIL; |
5993 | SCHEME_V->value = NIL; |
6059 | SCHEME_V->value = NIL; |
5994 | SCHEME_V->tracing = 0; |
6060 | SCHEME_V->tracing = 0; |
5995 | |
6061 | |
5996 | /* init NIL */ |
6062 | /* init NIL */ |
5997 | set_typeflag (NIL, T_ATOM | T_MARK); |
6063 | set_typeflag (NIL, T_SPECIAL | T_ATOM); |
5998 | set_car (NIL, NIL); |
6064 | set_car (NIL, NIL); |
5999 | set_cdr (NIL, NIL); |
6065 | set_cdr (NIL, NIL); |
6000 | /* init T */ |
6066 | /* init T */ |
6001 | set_typeflag (S_T, T_ATOM | T_MARK); |
6067 | set_typeflag (S_T, T_SPECIAL | T_ATOM); |
6002 | set_car (S_T, S_T); |
6068 | set_car (S_T, S_T); |
6003 | set_cdr (S_T, S_T); |
6069 | set_cdr (S_T, S_T); |
6004 | /* init F */ |
6070 | /* init F */ |
6005 | set_typeflag (S_F, T_ATOM | T_MARK); |
6071 | set_typeflag (S_F, T_SPECIAL | T_ATOM); |
6006 | set_car (S_F, S_F); |
6072 | set_car (S_F, S_F); |
6007 | set_cdr (S_F, S_F); |
6073 | set_cdr (S_F, S_F); |
6008 | /* init EOF_OBJ */ |
6074 | /* init EOF_OBJ */ |
6009 | set_typeflag (S_EOF, T_ATOM | T_MARK); |
6075 | set_typeflag (S_EOF, T_SPECIAL | T_ATOM); |
6010 | set_car (S_EOF, S_EOF); |
6076 | set_car (S_EOF, S_EOF); |
6011 | set_cdr (S_EOF, S_EOF); |
6077 | set_cdr (S_EOF, S_EOF); |
6012 | /* init sink */ |
6078 | /* init sink */ |
6013 | set_typeflag (S_SINK, T_PAIR | T_MARK); |
6079 | set_typeflag (S_SINK, T_PAIR); |
6014 | set_car (S_SINK, NIL); |
6080 | set_car (S_SINK, NIL); |
6015 | |
6081 | |
6016 | /* init c_nest */ |
6082 | /* init c_nest */ |
6017 | SCHEME_V->c_nest = NIL; |
6083 | SCHEME_V->c_nest = NIL; |
6018 | |
6084 | |
6019 | SCHEME_V->oblist = oblist_initial_value (SCHEME_A); |
6085 | SCHEME_V->oblist = oblist_initial_value (SCHEME_A); |
6020 | /* init global_env */ |
6086 | /* init global_env */ |
6021 | new_frame_in_env (SCHEME_A_ NIL); |
6087 | new_frame_in_env (SCHEME_A_ NIL); |
6022 | SCHEME_V->global_env = SCHEME_V->envir; |
6088 | SCHEME_V->global_env = SCHEME_V->envir; |
6023 | /* init else */ |
6089 | /* init else */ |
6024 | x = mk_symbol (SCHEME_A_ "else"); |
6090 | new_slot_in_env (SCHEME_A_ mk_symbol (SCHEME_A_ "else"), S_T); |
6025 | new_slot_in_env (SCHEME_A_ x, S_T); |
|
|
6026 | |
6091 | |
6027 | { |
6092 | { |
6028 | static const char *syntax_names[] = { |
6093 | static const char *syntax_names[] = { |
6029 | "lambda", "quote", "define", "if", "begin", "set!", |
6094 | "lambda", "quote", "define", "if", "begin", "set!", |
6030 | "let", "let*", "letrec", "cond", "delay", "and", |
6095 | "let", "let*", "letrec", "cond", "delay", "and", |