[ViewVC] Diff of: cvs/cvsroot/microscheme/scheme.c

Comparing cvsroot/microscheme/scheme.c (file contents):
Revision 1.65 by root, Wed Dec 2 17:01:51 2015 UTC vs.
Revision 1.67 by root, Mon Dec 7 19:49:35 2015 UTC

…		…
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;
…		…
328	string_value (pointer p)	329	string_value (pointer p)
329	{	330	{
330	return strvalue (p);	331	return strvalue (p);
331	}	332	}
332		333
333	#define ivalue_unchecked(p) CELL(p)->object.ivalue	334	#define ivalue_unchecked(p) (CELL(p)->object.ivalue + 0)
334	#define set_ivalue(p,v) CELL(p)->object.ivalue = (v)	335	#define set_ivalue(p,v) CELL(p)->object.ivalue = (v)
335		336
336	#if USE_REAL	337	#if USE_REAL
337	#define rvalue_unchecked(p) CELL(p)->object.rvalue	338	#define rvalue_unchecked(p) CELL(p)->object.rvalue
338	#define set_rvalue(p,v) CELL(p)->object.rvalue = (v)	339	#define set_rvalue(p,v) CELL(p)->object.rvalue = (v)
…		…
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
…		…
1251	if (!*pp)	1259	if (!*pp)
1252	{	1260	{
1253	pointer x = get_cell (SCHEME_A_ NIL, NIL);	1261	pointer x = get_cell (SCHEME_A_ NIL, NIL);
1254		1262
1255	set_typeflag (x, T_INTEGER \| T_ATOM);	1263	set_typeflag (x, T_INTEGER \| T_ATOM);
1256	setimmutable (x); /* shouldn't do anythi9ng, doesn't cost anything */	1264	setimmutable (x); /* shouldn't do anything, doesn't cost anything */
1257	set_ivalue (x, n);	1265	set_ivalue (x, n);
1258		1266
1259	*pp = x;	1267	*pp = x;
1260	}	1268	}
1261		1269
…		…
1538	return mk_character (SCHEME_A_ c);	1546	return mk_character (SCHEME_A_ c);
1539	}	1547	}
1540	else	1548	else
1541	{	1549	{
1542	/* identify base by string index */	1550	/* identify base by string index */
1543	const char baseidx[17] = "ffbf" "ffff" "ofdf" "ffff" "x";	1551	const char baseidx[18] = "ffbf" "ffff" "ofdf" "ffff" "x";
1544	char base = strchr (baseidx, name);	1552	char base = strchr (baseidx, name);
1545		1553
1546	if (base)	1554	if (base && *base)
1547	return mk_integer (SCHEME_A_ strtol (name + 1, 0, base - baseidx));	1555	return mk_integer (SCHEME_A_ strtol (name + 1, 0, base - baseidx));
1548		1556
1549	return NIL;	1557	return NIL;
1550	}	1558	}
1551	}	1559	}
…		…
2605	}	2613	}
2606	else if (is_symbol (l))	2614	else if (is_symbol (l))
2607	p = symname (l);	2615	p = symname (l);
2608	else if (is_proc (l))	2616	else if (is_proc (l))
2609	{	2617	{
		2618	p = (char *)procname (l); // ok with r7rs display, but not r7rs write
		2619	#if 0
2610	#if USE_PRINTF	2620	#if USE_PRINTF
2611	p = SCHEME_V->strbuff;	2621	p = SCHEME_V->strbuff;
2612	snprintf (p, STRBUFFSIZE, "#<%s PROCEDURE %ld>", procname (l), procnum (l));	2622	snprintf (p, STRBUFFSIZE, " PROCEDURE %ld>", procname (l), procnum (l));
2613	#else	2623	#else
2614	p = "#<PROCEDURE>";	2624	p = "#<PROCEDURE>";
		2625	#endif
2615	#endif	2626	#endif
2616	}	2627	}
2617	else if (is_macro (l))	2628	else if (is_macro (l))
2618	p = "#<MACRO>";	2629	p = "#<MACRO>";
2619	else if (is_closure (l))	2630	else if (is_closure (l))
…		…
3338	stream_put (s, stream_data (o)[i]);	3349	stream_put (s, stream_data (o)[i]);
3339		3350
3340	stream_free (o);	3351	stream_free (o);
3341	}	3352	}
3342		3353
		3354	ecb_cold static uint32_t
		3355	cell_id (SCHEME_P_ pointer x)
		3356	{
		3357	struct cell *p = CELL (x);
		3358	int i;
		3359
		3360	for (i = SCHEME_V->last_cell_seg; i >= 0; --i)
		3361	if (SCHEME_V->cell_seg[i] <= p && p < SCHEME_V->cell_seg[i] + SCHEME_V->cell_segsize[i])
		3362	return i \| ((p - SCHEME_V->cell_seg[i]) << CELL_NSEGMENT_LOG);
		3363
		3364	abort ();
		3365	}
		3366
3343	// calculates a (preferably small) integer that makes it possible to find	3367	// calculates a (preferably small) integer that makes it possible to find
3344	// the symbol again. if pointers were offsets into a memory area... until	3368	// 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	3369	// then, we return segment number in the low bits, and offset in the high
3346	// bits.	3370	// bits.
3347	// also, this function must never return 0.	3371	// also, this function must never return 0.
3348	ecb_cold static uint32_t	3372	ecb_cold static uint32_t
3349	symbol_id (SCHEME_P_ pointer sym)	3373	symbol_id (SCHEME_P_ pointer sym)
3350	{	3374	{
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);	3375	return cell_id (SCHEME_A_ sym);
3365	}	3376	}
3366		3377
3367	enum byteop	3378	enum byteop
3368	{	3379	{
3369	BOP_NIL,	3380	BOP_NIL,
3370	BOP_SYNTAX,
3371	BOP_INTEGER,	3381	BOP_INTEGER,
3372	BOP_SYMBOL,	3382	BOP_SYMBOL,
		3383	BOP_DATUM,
3373	BOP_LIST_BEG,	3384	BOP_LIST_BEG,
3374	BOP_LIST_END,	3385	BOP_LIST_END,
3375	BOP_BIFT, // branch if true	3386	BOP_IF,
3376	BOP_BIFF, // branch if false	3387	BOP_AND,
3377	BOP_BIFNE, // branch if not eqv?	3388	BOP_OR,
3378	BOP_BRA, // "short" branch	3389	BOP_CASE,
3379	BOP_JMP, // "long" jump	3390	BOP_COND,
3380	BOP_DATUM,
3381	BOP_LET,	3391	BOP_LET,
3382	BOP_LETAST,	3392	BOP_LETAST,
3383	BOP_LETREC,	3393	BOP_LETREC,
3384	BOP_DEFINE,	3394	BOP_DEFINE,
3385	BOP_MACRO,	3395	BOP_MACRO,
3386	BOP_SET,	3396	BOP_SET,
3387	BOP_BEGIN,	3397	BOP_BEGIN,
3388	BOP_LAMBDA,	3398	BOP_LAMBDA,
		3399	BOP_OP,
3389	};	3400	};
3390		3401
3391	ecb_cold static void compile_expr (SCHEME_P_ stream s, pointer x);	3402	ecb_cold static void compile_expr (SCHEME_P_ stream s, pointer x);
3392		3403
3393	ecb_cold static void	3404	ecb_cold static void
3394	compile_list (SCHEME_P_ stream s, pointer x)	3405	compile_list (SCHEME_P_ stream s, pointer x)
3395	{	3406	{
		3407	// TODO: improper list
		3408
3396	for (; x != NIL; x = cdr (x))	3409	for (; x != NIL; x = cdr (x))
		3410	{
		3411	stream t = stream_init ();
3397	compile_expr (SCHEME_A_ s, car (x));	3412	compile_expr (SCHEME_A_ t, car (x));
		3413	stream_put_v (s, stream_size (t));
		3414	stream_put_stream (s, t);
		3415	}
		3416
		3417	stream_put_v (s, 0);
3398	}	3418	}
3399		3419
3400	static void	3420	static void
3401	compile_if (SCHEME_P_ stream s, pointer cond, pointer ift, pointer iff)	3421	compile_if (SCHEME_P_ stream s, pointer cond, pointer ift, pointer iff)
3402	{	3422	{
3403	//TODO: borked
3404	stream sift = stream_init (); compile_expr (SCHEME_A_ sift, ift);	3423	stream sift = stream_init (); compile_expr (SCHEME_A_ sift, ift);
3405		3424
3406	stream_put (s, BOP_BIFF);	3425	stream_put (s, BOP_IF);
3407	compile_expr (SCHEME_A_ s, cond);	3426	compile_expr (SCHEME_A_ s, cond);
3408	stream_put_v (s, stream_size (sift));	3427	stream_put_v (s, stream_size (sift));
3409	stream_put_stream (s, sift);	3428	stream_put_stream (s, sift);
3410		3429	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	}	3430	}
3418		3431
3419	typedef uint32_t stream_fixup;	3432	typedef uint32_t stream_fixup;
3420		3433
3421	static stream_fixup	3434	static stream_fixup
…		…
3437	}	3450	}
3438		3451
3439	static void	3452	static void
3440	compile_and_or (SCHEME_P_ stream s, int and, pointer x)	3453	compile_and_or (SCHEME_P_ stream s, int and, pointer x)
3441	{	3454	{
3442	if (cdr (x) == NIL)	3455	for (; cdr (x) != NIL; x = cdr (x))
		3456	{
		3457	stream t = stream_init ();
		3458	compile_expr (SCHEME_A_ t, car (x));
		3459	stream_put_v (s, stream_size (t));
		3460	stream_put_stream (s, t);
		3461	}
		3462
		3463	stream_put_v (s, 0);
		3464	}
		3465
		3466	static void
		3467	compile_case (SCHEME_P_ stream s, pointer x)
		3468	{
3443	compile_expr (SCHEME_A_ s, car (x));	3469	compile_expr (SCHEME_A_ s, caar (x));
3444	else	3470
		3471	for (;;)
3445	{	3472	{
3446	stream_put (s, and ? BOP_BIFF : BOP_BIFT);	3473	x = cdr (x);
		3474
		3475	if (x == NIL)
		3476	break;
		3477
3447	compile_expr (SCHEME_A_ s, car (x));	3478	compile_expr (SCHEME_A_ s, caar (x));
3448	stream_fixup end = stream_put_fixup (s);	3479	stream t = stream_init (); compile_expr (SCHEME_A_ t, cdar (x));
		3480	stream_put_v (s, stream_size (t));
		3481	stream_put_stream (s, t);
		3482	}
3449		3483
		3484	stream_put_v (s, 0);
		3485	}
		3486
		3487	static void
		3488	compile_cond (SCHEME_P_ stream s, pointer x)
		3489	{
		3490	for ( ; x != NIL; x = cdr (x))
		3491	{
3450	compile_and_or (SCHEME_A_ s, and, cdr (x));	3492	compile_expr (SCHEME_A_ s, caar (x));
		3493	stream t = stream_init (); compile_expr (SCHEME_A_ t, cdar (x));
3451	stream_fix_fixup (s, end, stream_size (s));	3494	stream_put_v (s, stream_size (t));
		3495	stream_put_stream (s, t);
3452	}	3496	}
		3497
		3498	stream_put_v (s, 0);
		3499	}
		3500
		3501	static pointer
		3502	lookup (SCHEME_P_ pointer x)
		3503	{
		3504	x = find_slot_in_env (SCHEME_A_ SCHEME_V->envir, x, 1);
		3505
		3506	if (x != NIL)
		3507	x = slot_value_in_env (x);
		3508
		3509	return x;
3453	}	3510	}
3454		3511
3455	ecb_cold static void	3512	ecb_cold static void
3456	compile_expr (SCHEME_P_ stream s, pointer x)	3513	compile_expr (SCHEME_P_ stream s, pointer x)
3457	{	3514	{
…		…
3470	x = cdr (x);	3527	x = cdr (x);
3471		3528
3472	switch (syntaxnum (head))	3529	switch (syntaxnum (head))
3473	{	3530	{
3474	case OP_IF0: /* if */	3531	case OP_IF0: /* if */
		3532	stream_put_v (s, BOP_IF);
3475	compile_if (SCHEME_A_ s, car (x), cadr (x), caddr (x));	3533	compile_if (SCHEME_A_ s, car (x), cadr (x), caddr (x));
3476	break;	3534	break;
3477		3535
3478	case OP_OR0: /* or */	3536	case OP_OR0: /* or */
		3537	stream_put_v (s, BOP_OR);
3479	compile_and_or (SCHEME_A_ s, 0, x);	3538	compile_and_or (SCHEME_A_ s, 0, x);
3480	break;	3539	break;
3481		3540
3482	case OP_AND0: /* and */	3541	case OP_AND0: /* and */
		3542	stream_put_v (s, BOP_AND);
3483	compile_and_or (SCHEME_A_ s, 1, x);	3543	compile_and_or (SCHEME_A_ s, 1, x);
3484	break;	3544	break;
3485		3545
3486	case OP_CASE0: /* case */	3546	case OP_CASE0: /* case */
3487	abort ();	3547	stream_put_v (s, BOP_CASE);
		3548	compile_case (SCHEME_A_ s, x);
3488	break;	3549	break;
3489		3550
3490	case OP_COND0: /* cond */	3551	case OP_COND0: /* cond */
3491	abort ();	3552	stream_put_v (s, BOP_COND);
		3553	compile_cond (SCHEME_A_ s, x);
3492	break;	3554	break;
3493		3555
3494	case OP_LET0: /* let */	3556	case OP_LET0: /* let */
3495	case OP_LET0AST: /* let* */	3557	case OP_LET0AST: /* let* */
3496	case OP_LET0REC: /* letrec */	3558	case OP_LET0REC: /* letrec */
…		…
3574	}	3636	}
3575		3637
3576	return;	3638	return;
3577	}	3639	}
3578		3640
3579	pointer m = find_slot_in_env (SCHEME_A_ SCHEME_V->envir, head, 1);	3641	pointer m = lookup (SCHEME_A_ head);
3580		3642
3581	if (m != NIL)	3643	if (is_macro (m))
3582	{	3644	{
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);	3645	s_save (SCHEME_A_ OP_DEBUG2, SCHEME_V->args, SCHEME_V->code);
3588	SCHEME_V->code = m;	3646	SCHEME_V->code = m;
3589	SCHEME_V->args = cons (x, NIL);	3647	SCHEME_V->args = cons (x, NIL);
3590	Eval_Cycle (SCHEME_A_ OP_APPLY);	3648	Eval_Cycle (SCHEME_A_ OP_APPLY);
3591	x = SCHEME_V->value;	3649	x = SCHEME_V->value;
3592	compile_expr (SCHEME_A_ s, SCHEME_V->value);	3650	compile_expr (SCHEME_A_ s, SCHEME_V->value);
3593	return;	3651	return;
3594	}
3595	}	3652	}
		3653
		3654	stream_put (s, BOP_LIST_BEG);
		3655
		3656	for (; x != NIL; x = cdr (x))
		3657	compile_expr (SCHEME_A_ s, car (x));
		3658
		3659	stream_put (s, BOP_LIST_END);
		3660	return;
3596	}	3661	}
3597		3662
3598	switch (type (x))	3663	switch (type (x))
3599	{	3664	{
3600	case T_INTEGER:	3665	case T_INTEGER:
3601	{	3666	{
3602	IVALUE iv = ivalue_unchecked (x);	3667	IVALUE iv = ivalue_unchecked (x);
3603	iv = iv < 0 ? ((uint32_t)-iv << 1) \| 1 : (uint32_t)iv << 1;	3668	iv = iv < 0 ? ((~(uint32_t)iv) << 1) \| 1 : (uint32_t)iv << 1;
3604	stream_put_tv (s, BOP_INTEGER, iv);	3669	stream_put_tv (s, BOP_INTEGER, iv);
3605	}	3670	}
3606	return;	3671	return;
3607		3672
3608	case T_SYMBOL:	3673	case T_SYMBOL:
		3674	if (0)
		3675	{
		3676	// no can do without more analysis
		3677	pointer m = lookup (SCHEME_A_ x);
		3678
		3679	if (is_proc (m))
		3680	{
		3681	printf ("compile proc %s %d\n", procname(m), procnum(m));
		3682	stream_put_tv (s, BOP_SYMBOL, BOP_OP + procnum (m));
		3683	}
		3684	else
		3685	stream_put_tv (s, BOP_SYMBOL, symbol_id (SCHEME_A_ x));
		3686	}
		3687
3609	stream_put_tv (s, BOP_SYMBOL, symbol_id (SCHEME_A_ x));	3688	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;	3689	return;
3620		3690
3621	default:	3691	default:
3622	stream_put_tv (s, BOP_DATUM, cell_id (SCHEME_A_ x));	3692	stream_put_tv (s, BOP_DATUM, cell_id (SCHEME_A_ x));
3623	break;	3693	break;
…		…
5530	s_return (S_T);	5600	s_return (S_T);
5531	}	5601	}
5532		5602
5533	case OP_PVECFROM:	5603	case OP_PVECFROM:
5534	{	5604	{
5535	int i = ivalue_unchecked (cdr (args));	5605	IVALUE i = ivalue_unchecked (cdr (args));
5536	pointer vec = car (args);	5606	pointer vec = car (args);
5537	int len = veclength (vec);	5607	uint32_t len = veclength (vec);
5538		5608
5539	if (i == len)	5609	if (i == len)
5540	{	5610	{
5541	putcharacter (SCHEME_A_ ')');	5611	putcharacter (SCHEME_A_ ')');
5542	s_return (S_T);	5612	s_return (S_T);
5543	}	5613	}
5544	else	5614	else
5545	{	5615	{
5546	pointer elem = vector_get (vec, i);	5616	pointer elem = vector_get (vec, i);
5547		5617
5548	ivalue_unchecked (cdr (args)) = i + 1;	5618	set_cdr (args, mk_integer (SCHEME_A_ i + 1));
5549	s_save (SCHEME_A_ OP_PVECFROM, args, NIL);	5619	s_save (SCHEME_A_ OP_PVECFROM, args, NIL);
5550	SCHEME_V->args = elem;	5620	SCHEME_V->args = elem;
5551		5621
5552	if (i > 0)	5622	if (i > 0)
5553	putcharacter (SCHEME_A_ ' ');	5623	putcharacter (SCHEME_A_ ' ');
…		…
5853	static pointer	5923	static pointer
5854	mk_proc (SCHEME_P_ enum scheme_opcodes op)	5924	mk_proc (SCHEME_P_ enum scheme_opcodes op)
5855	{	5925	{
5856	pointer y = get_cell (SCHEME_A_ NIL, NIL);	5926	pointer y = get_cell (SCHEME_A_ NIL, NIL);
5857	set_typeflag (y, (T_PROC \| T_ATOM));	5927	set_typeflag (y, (T_PROC \| T_ATOM));
5858	ivalue_unchecked (y) = op;	5928	set_ivalue (y, op);
5859	return y;	5929	return y;
5860	}	5930	}
5861		5931
5862	/* Hard-coded for the given keywords. Remember to rewrite if more are added! */	5932	/* Hard-coded for the given keywords. Remember to rewrite if more are added! */
5863	ecb_hot static int	5933	ecb_hot static int
…		…
5947		6017
5948	ecb_cold int	6018	ecb_cold int
5949	scheme_init (SCHEME_P)	6019	scheme_init (SCHEME_P)
5950	{	6020	{
5951	int i, n = sizeof (dispatch_table) / sizeof (dispatch_table[0]);	6021	int i, n = sizeof (dispatch_table) / sizeof (dispatch_table[0]);
5952	pointer x;
5953		6022
5954	/* this memset is not strictly correct, as we assume (intcache)	6023	/* this memset is not strictly correct, as we assume (intcache)
5955	* that memset 0 will also set pointers to 0, but memset does	6024	* that memset 0 will also set pointers to 0, but memset does
5956	* of course not guarantee that. screw such systems.	6025	* of course not guarantee that. screw such systems.
5957	*/	6026	*/
…		…
5992	SCHEME_V->envir = NIL;	6061	SCHEME_V->envir = NIL;
5993	SCHEME_V->value = NIL;	6062	SCHEME_V->value = NIL;
5994	SCHEME_V->tracing = 0;	6063	SCHEME_V->tracing = 0;
5995		6064
5996	/* init NIL */	6065	/* init NIL */
5997	set_typeflag (NIL, T_ATOM \| T_MARK);	6066	set_typeflag (NIL, T_SPECIAL \| T_ATOM);
5998	set_car (NIL, NIL);	6067	set_car (NIL, NIL);
5999	set_cdr (NIL, NIL);	6068	set_cdr (NIL, NIL);
6000	/* init T */	6069	/* init T */
6001	set_typeflag (S_T, T_ATOM \| T_MARK);	6070	set_typeflag (S_T, T_SPECIAL \| T_ATOM);
6002	set_car (S_T, S_T);	6071	set_car (S_T, S_T);
6003	set_cdr (S_T, S_T);	6072	set_cdr (S_T, S_T);
6004	/* init F */	6073	/* init F */
6005	set_typeflag (S_F, T_ATOM \| T_MARK);	6074	set_typeflag (S_F, T_SPECIAL \| T_ATOM);
6006	set_car (S_F, S_F);	6075	set_car (S_F, S_F);
6007	set_cdr (S_F, S_F);	6076	set_cdr (S_F, S_F);
6008	/* init EOF_OBJ */	6077	/* init EOF_OBJ */
6009	set_typeflag (S_EOF, T_ATOM \| T_MARK);	6078	set_typeflag (S_EOF, T_SPECIAL \| T_ATOM);
6010	set_car (S_EOF, S_EOF);	6079	set_car (S_EOF, S_EOF);
6011	set_cdr (S_EOF, S_EOF);	6080	set_cdr (S_EOF, S_EOF);
6012	/* init sink */	6081	/* init sink */
6013	set_typeflag (S_SINK, T_PAIR \| T_MARK);	6082	set_typeflag (S_SINK, T_PAIR);
6014	set_car (S_SINK, NIL);	6083	set_car (S_SINK, NIL);
6015		6084
6016	/* init c_nest */	6085	/* init c_nest */
6017	SCHEME_V->c_nest = NIL;	6086	SCHEME_V->c_nest = NIL;
6018		6087
6019	SCHEME_V->oblist = oblist_initial_value (SCHEME_A);	6088	SCHEME_V->oblist = oblist_initial_value (SCHEME_A);
6020	/* init global_env */	6089	/* init global_env */
6021	new_frame_in_env (SCHEME_A_ NIL);	6090	new_frame_in_env (SCHEME_A_ NIL);
6022	SCHEME_V->global_env = SCHEME_V->envir;	6091	SCHEME_V->global_env = SCHEME_V->envir;
6023	/* init else */	6092	/* init else */
6024	x = mk_symbol (SCHEME_A_ "else");	6093	new_slot_in_env (SCHEME_A_ mk_symbol (SCHEME_A_ "else"), S_T);
6025	new_slot_in_env (SCHEME_A_ x, S_T);
6026		6094
6027	{	6095	{
6028	static const char *syntax_names[] = {	6096	static const char *syntax_names[] = {
6029	"lambda", "quote", "define", "if", "begin", "set!",	6097	"lambda", "quote", "define", "if", "begin", "set!",
6030	"let", "let*", "letrec", "cond", "delay", "and",	6098	"let", "let*", "letrec", "cond", "delay", "and",

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing cvsroot/microscheme/scheme.c (file contents): Revision 1.65 by root, Wed Dec 2 17:01:51 2015 UTC vs. Revision 1.67 by root, Mon Dec 7 19:49:35 2015 UTC

Diff Legend

Comparing cvsroot/microscheme/scheme.c (file contents):
Revision 1.65 by root, Wed Dec 2 17:01:51 2015 UTC vs.
Revision 1.67 by root, Mon Dec 7 19:49:35 2015 UTC