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

Comparing microscheme/scheme.c (file contents):
Revision 1.19 by root, Thu Nov 26 21:36:11 2015 UTC vs.
Revision 1.20 by root, Thu Nov 26 22:53:28 2015 UTC

…		…
667	static pointer reverse_in_place (SCHEME_P_ pointer term, pointer list);	667	static pointer reverse_in_place (SCHEME_P_ pointer term, pointer list);
668	static pointer revappend (SCHEME_P_ pointer a, pointer b);	668	static pointer revappend (SCHEME_P_ pointer a, pointer b);
669	static pointer ss_get_cont (SCHEME_P);	669	static pointer ss_get_cont (SCHEME_P);
670	static void ss_set_cont (SCHEME_P_ pointer cont);	670	static void ss_set_cont (SCHEME_P_ pointer cont);
671	static void dump_stack_mark (SCHEME_P);	671	static void dump_stack_mark (SCHEME_P);
672	static pointer opexe_0 (SCHEME_P_ enum scheme_opcodes op);	672	static int opexe_0 (SCHEME_P_ enum scheme_opcodes op);
		673	static int opexe_1 (SCHEME_P_ enum scheme_opcodes op);
673	static pointer opexe_2 (SCHEME_P_ enum scheme_opcodes op);	674	static int opexe_2 (SCHEME_P_ enum scheme_opcodes op);
674	static pointer opexe_r (SCHEME_P_ enum scheme_opcodes op);
675	static pointer opexe_3 (SCHEME_P_ enum scheme_opcodes op);	675	static int opexe_3 (SCHEME_P_ enum scheme_opcodes op);
676	static pointer opexe_4 (SCHEME_P_ enum scheme_opcodes op);	676	static int opexe_4 (SCHEME_P_ enum scheme_opcodes op);
677	static pointer opexe_5 (SCHEME_P_ enum scheme_opcodes op);	677	static int opexe_5 (SCHEME_P_ enum scheme_opcodes op);
678	static pointer opexe_6 (SCHEME_P_ enum scheme_opcodes op);	678	static int opexe_6 (SCHEME_P_ enum scheme_opcodes op);
679	static void Eval_Cycle (SCHEME_P_ enum scheme_opcodes op);	679	static void Eval_Cycle (SCHEME_P_ enum scheme_opcodes op);
680	static void assign_syntax (SCHEME_P_ const char *name);	680	static void assign_syntax (SCHEME_P_ const char *name);
681	static int syntaxnum (pointer p);	681	static int syntaxnum (pointer p);
682	static void assign_proc (SCHEME_P_ enum scheme_opcodes, const char *name);	682	static void assign_proc (SCHEME_P_ enum scheme_opcodes, const char *name);
683		683
…		…
2932	return cdr (slot);	2932	return cdr (slot);
2933	}	2933	}
2934		2934
2935	/* ========== Evaluation Cycle ========== */	2935	/* ========== Evaluation Cycle ========== */
2936		2936
2937	static pointer	2937	static int
2938	xError_1 (SCHEME_P_ const char *s, pointer a)	2938	xError_1 (SCHEME_P_ const char *s, pointer a)
2939	{	2939	{
2940	#if USE_ERROR_HOOK	2940	#if USE_ERROR_HOOK
2941	pointer x;	2941	pointer x;
2942	pointer hdl = SCHEME_V->ERROR_HOOK;	2942	pointer hdl = SCHEME_V->ERROR_HOOK;
…		…
2977	code = cons (mk_string (SCHEME_A_ s), code);	2977	code = cons (mk_string (SCHEME_A_ s), code);
2978	setimmutable (car (code));	2978	setimmutable (car (code));
2979	SCHEME_V->code = cons (slot_value_in_env (x), code);	2979	SCHEME_V->code = cons (slot_value_in_env (x), code);
2980	SCHEME_V->op = OP_EVAL;	2980	SCHEME_V->op = OP_EVAL;
2981		2981
2982	return S_T;	2982	return 0;
2983	}	2983	}
2984	#endif	2984	#endif
2985		2985
2986	if (a)	2986	if (a)
2987	SCHEME_V->args = cons (a, NIL);	2987	SCHEME_V->args = cons (a, NIL);
…		…
2989	SCHEME_V->args = NIL;	2989	SCHEME_V->args = NIL;
2990		2990
2991	SCHEME_V->args = cons (mk_string (SCHEME_A_ s), SCHEME_V->args);	2991	SCHEME_V->args = cons (mk_string (SCHEME_A_ s), SCHEME_V->args);
2992	setimmutable (car (SCHEME_V->args));	2992	setimmutable (car (SCHEME_V->args));
2993	SCHEME_V->op = OP_ERR0;	2993	SCHEME_V->op = OP_ERR0;
		2994
2994	return S_T;	2995	return 0;
2995	}	2996	}
2996		2997
2997	#define Error_1(s, a) return xError_1(SCHEME_A_ USE_ERROR_CHECKING ? s : "", a)	2998	#define Error_1(s, a) return xError_1(SCHEME_A_ USE_ERROR_CHECKING ? s : "", a)
2998	#define Error_0(s) Error_1 (s, 0)	2999	#define Error_0(s) Error_1 (s, 0)
2999		3000
3000	/* Too small to turn into function */	3001	/* Too small to turn into function */
3001	#define BEGIN do {	3002	#define BEGIN do {
3002	#define END } while (0)	3003	#define END } while (0)
3003	#define s_goto(a) BEGIN \	3004	#define s_goto(a) BEGIN \
3004	SCHEME_V->op = a; \	3005	SCHEME_V->op = a; \
3005	return S_T; END	3006	return 0; END
3006		3007
3007	#define s_return(a) return xs_return (SCHEME_A_ a)	3008	#define s_return(a) return xs_return (SCHEME_A_ a)
3008		3009
3009	#ifndef USE_SCHEME_STACK	3010	#ifndef USE_SCHEME_STACK
3010		3011
…		…
3040	next_frame->code = code;	3041	next_frame->code = code;
3041		3042
3042	SCHEME_V->dump = (pointer)(uintptr_t)(nframes + 1);	3043	SCHEME_V->dump = (pointer)(uintptr_t)(nframes + 1);
3043	}	3044	}
3044		3045
3045	static pointer	3046	static int
3046	xs_return (SCHEME_P_ pointer a)	3047	xs_return (SCHEME_P_ pointer a)
3047	{	3048	{
3048	int nframes = (uintptr_t)SCHEME_V->dump;	3049	int nframes = (uintptr_t)SCHEME_V->dump;
3049	struct dump_stack_frame *frame;	3050	struct dump_stack_frame *frame;
3050		3051
3051	SCHEME_V->value = a;	3052	SCHEME_V->value = a;
3052		3053
3053	if (nframes <= 0)	3054	if (nframes <= 0)
3054	return NIL;	3055	return -1;
3055		3056
3056	frame = &SCHEME_V->dump_base[--nframes];	3057	frame = &SCHEME_V->dump_base[--nframes];
3057	SCHEME_V->op = frame->op;	3058	SCHEME_V->op = frame->op;
3058	SCHEME_V->args = frame->args;	3059	SCHEME_V->args = frame->args;
3059	SCHEME_V->envir = frame->envir;	3060	SCHEME_V->envir = frame->envir;
3060	SCHEME_V->code = frame->code;	3061	SCHEME_V->code = frame->code;
3061	SCHEME_V->dump = (pointer)(uintptr_t)nframes;	3062	SCHEME_V->dump = (pointer)(uintptr_t)nframes;
3062		3063
3063	return S_T;	3064	return 0;
3064	}	3065	}
3065		3066
3066	static INLINE void	3067	static INLINE void
3067	dump_stack_reset (SCHEME_P)	3068	dump_stack_reset (SCHEME_P)
3068	{	3069	{
…		…
3163	dump_stack_free (SCHEME_P)	3164	dump_stack_free (SCHEME_P)
3164	{	3165	{
3165	SCHEME_V->dump = NIL;	3166	SCHEME_V->dump = NIL;
3166	}	3167	}
3167		3168
3168	static pointer	3169	static int
3169	xs_return (SCHEME_P_ pointer a)	3170	xs_return (SCHEME_P_ pointer a)
3170	{	3171	{
3171	pointer dump = SCHEME_V->dump;	3172	pointer dump = SCHEME_V->dump;
3172		3173
3173	SCHEME_V->value = a;	3174	SCHEME_V->value = a;
3174		3175
3175	if (dump == NIL)	3176	if (dump == NIL)
3176	return NIL;	3177	return -1;
3177		3178
3178	SCHEME_V->op = ivalue (car (dump)); dump = cdr (dump);	3179	SCHEME_V->op = ivalue (car (dump)); dump = cdr (dump);
3179	SCHEME_V->args = car (dump) ; dump = cdr (dump);	3180	SCHEME_V->args = car (dump) ; dump = cdr (dump);
3180	SCHEME_V->envir = car (dump) ; dump = cdr (dump);	3181	SCHEME_V->envir = car (dump) ; dump = cdr (dump);
3181	SCHEME_V->code = car (dump) ; dump = cdr (dump);	3182	SCHEME_V->code = car (dump) ; dump = cdr (dump);
3182		3183
3183	SCHEME_V->dump = dump;	3184	SCHEME_V->dump = dump;
3184		3185
3185	return S_T;	3186	return 0;
3186	}	3187	}
3187		3188
3188	static void	3189	static void
3189	s_save (SCHEME_P_ enum scheme_opcodes op, pointer args, pointer code)	3190	s_save (SCHEME_P_ enum scheme_opcodes op, pointer args, pointer code)
3190	{	3191	{
…		…
3215		3216
3216	#endif	3217	#endif
3217		3218
3218	#define s_retbool(tf) s_return ((tf) ? S_T : S_F)	3219	#define s_retbool(tf) s_return ((tf) ? S_T : S_F)
3219		3220
3220	static pointer	3221	static int
3221	opexe_0 (SCHEME_P_ enum scheme_opcodes op)	3222	opexe_0 (SCHEME_P_ enum scheme_opcodes op)
3222	{	3223	{
3223	pointer args = SCHEME_V->args;	3224	pointer args = SCHEME_V->args;
3224	pointer x, y;	3225	pointer x, y;
3225		3226
…		…
3914	}	3915	}
3915		3916
3916	abort ();	3917	abort ();
3917	}	3918	}
3918		3919
3919	static pointer	3920	static int
3920	opexe_2 (SCHEME_P_ enum scheme_opcodes op)	3921	opexe_1 (SCHEME_P_ enum scheme_opcodes op)
3921	{	3922	{
3922	pointer args = SCHEME_V->args;	3923	pointer args = SCHEME_V->args;
3923	pointer x = car (args);	3924	pointer x = car (args);
3924	num v;	3925	num v;
3925		3926
…		…
4418	set_vector_elem (x, index, caddr (args));	4419	set_vector_elem (x, index, caddr (args));
4419	s_return (x);	4420	s_return (x);
4420	}	4421	}
4421	}	4422	}
4422		4423
4423	return S_T;	4424	abort ();
4424	}	4425	}
4425		4426
4426	INTERFACE int	4427	INTERFACE int
4427	is_list (SCHEME_P_ pointer a)	4428	is_list (SCHEME_P_ pointer a)
4428	{	4429	{
…		…
4475	return -1;	4476	return -1;
4476	}	4477	}
4477	}	4478	}
4478	}	4479	}
4479		4480
4480	static pointer	4481	static int
4481	opexe_r (SCHEME_P_ enum scheme_opcodes op)	4482	opexe_2 (SCHEME_P_ enum scheme_opcodes op)
4482	{	4483	{
4483	pointer x = SCHEME_V->args;	4484	pointer x = SCHEME_V->args;
4484		4485
4485	for (;;)	4486	for (;;)
4486	{	4487	{
…		…
4506	}	4507	}
4507		4508
4508	s_return (S_T);	4509	s_return (S_T);
4509	}	4510	}
4510		4511
4511	static pointer	4512	static int
4512	opexe_3 (SCHEME_P_ enum scheme_opcodes op)	4513	opexe_3 (SCHEME_P_ enum scheme_opcodes op)
4513	{	4514	{
4514	pointer args = SCHEME_V->args;	4515	pointer args = SCHEME_V->args;
4515	pointer a = car (args);	4516	pointer a = car (args);
4516	pointer d = cdr (args);	4517	pointer d = cdr (args);
…		…
4562	}	4563	}
4563		4564
4564	s_retbool (r);	4565	s_retbool (r);
4565	}	4566	}
4566		4567
4567	static pointer	4568	static int
4568	opexe_4 (SCHEME_P_ enum scheme_opcodes op)	4569	opexe_4 (SCHEME_P_ enum scheme_opcodes op)
4569	{	4570	{
4570	pointer args = SCHEME_V->args;	4571	pointer args = SCHEME_V->args;
4571	pointer a = car (args);	4572	pointer a = car (args);
4572	pointer x, y;	4573	pointer x, y;
…		…
4658	putstr (SCHEME_A_ "\n");	4659	putstr (SCHEME_A_ "\n");
4659		4660
4660	if (SCHEME_V->interactive_repl)	4661	if (SCHEME_V->interactive_repl)
4661	s_goto (OP_T0LVL);	4662	s_goto (OP_T0LVL);
4662	else	4663	else
4663	return NIL;	4664	return -1;
4664	}	4665	}
4665		4666
4666	case OP_REVERSE: /* reverse */	4667	case OP_REVERSE: /* reverse */
4667	s_return (reverse (SCHEME_A_ a));	4668	s_return (reverse (SCHEME_A_ a));
4668		4669
…		…
4725		4726
4726	case OP_QUIT: /* quit */	4727	case OP_QUIT: /* quit */
4727	if (is_pair (args))	4728	if (is_pair (args))
4728	SCHEME_V->retcode = ivalue (a);	4729	SCHEME_V->retcode = ivalue (a);
4729		4730
4730	return NIL;	4731	return -1;
4731		4732
4732	case OP_GC: /* gc */	4733	case OP_GC: /* gc */
4733	gc (SCHEME_A_ NIL, NIL);	4734	gc (SCHEME_A_ NIL, NIL);
4734	s_return (S_T);	4735	s_return (S_T);
4735		4736
…		…
4888	}	4889	}
4889		4890
4890	abort ();	4891	abort ();
4891	}	4892	}
4892		4893
4893	static pointer	4894	static int
4894	opexe_5 (SCHEME_P_ enum scheme_opcodes op)	4895	opexe_5 (SCHEME_P_ enum scheme_opcodes op)
4895	{	4896	{
4896	pointer args = SCHEME_V->args;	4897	pointer args = SCHEME_V->args;
4897	pointer x;	4898	pointer x;
4898		4899
…		…
5231	}	5232	}
5232		5233
5233	abort ();	5234	abort ();
5234	}	5235	}
5235		5236
5236	static pointer	5237	static int
5237	opexe_6 (SCHEME_P_ enum scheme_opcodes op)	5238	opexe_6 (SCHEME_P_ enum scheme_opcodes op)
5238	{	5239	{
5239	pointer args = SCHEME_V->args;	5240	pointer args = SCHEME_V->args;
5240	pointer a = car (args);	5241	pointer a = car (args);
5241	pointer x, y;	5242	pointer x, y;
…		…
5294	}	5295	}
5295		5296
5296	abort ();	5297	abort ();
5297	}	5298	}
5298		5299
		5300	/* dispatch functions (opexe_x) return new opcode, or 0 for same opcode, or -1 to stop */
5299	typedef pointer (*dispatch_func) (SCHEME_P_ enum scheme_opcodes);	5301	typedef int (*dispatch_func)(SCHEME_P_ enum scheme_opcodes);
5300		5302
5301	typedef int (*test_predicate)(pointer);	5303	typedef int (*test_predicate)(pointer);
5302	static int	5304	static int
5303	is_any (pointer p)	5305	is_any (pointer p)
5304	{	5306	{
…		…
5338	{ is_number, "number" },	5340	{ is_number, "number" },
5339	{ is_integer, "integer" },	5341	{ is_integer, "integer" },
5340	{ is_nonneg, "non-negative integer" }	5342	{ is_nonneg, "non-negative integer" }
5341	};	5343	};
5342		5344
5343	#define TST_NONE 0 /* TST_NONE used for standard procedures, for internal ops, 0 is used */	5345	#define TST_NONE 0 /* TST_NONE used for built-ins, 0 for internal ops */
5344	#define TST_ANY "\001"	5346	#define TST_ANY "\001"
5345	#define TST_STRING "\002"	5347	#define TST_STRING "\002"
5346	#define TST_SYMBOL "\003"	5348	#define TST_SYMBOL "\003"
5347	#define TST_PORT "\004"	5349	#define TST_PORT "\004"
5348	#define TST_INPORT "\005"	5350	#define TST_INPORT "\005"
…		…
5354	#define TST_VECTOR "\013"	5356	#define TST_VECTOR "\013"
5355	#define TST_NUMBER "\014"	5357	#define TST_NUMBER "\014"
5356	#define TST_INTEGER "\015"	5358	#define TST_INTEGER "\015"
5357	#define TST_NATURAL "\016"	5359	#define TST_NATURAL "\016"
5358		5360
		5361	#define INF_ARG 0xff
		5362	#define UNNAMED_OP ""
		5363
		5364	static const char opnames[] =
		5365	#define OP_DEF(func,name,minarity,maxarity,argtest,op) name "\x00"
		5366	#include "opdefines.h"
		5367	#undef OP_DEF
		5368	;
		5369
		5370	static const char *
		5371	opname (int idx)
		5372	{
		5373	const char *name = opnames;
		5374
		5375	/* should do this at compile time, but would require external program, right? */
		5376	while (idx--)
		5377	name += strlen (name) + 1;
		5378
		5379	return *name ? name : "ILLEGAL";
		5380	}
		5381
		5382	static const char *
		5383	procname (pointer x)
		5384	{
		5385	return opname (procnum (x));
		5386	}
		5387
5359	typedef struct	5388	typedef struct
5360	{	5389	{
5361	dispatch_func func;	5390	uint8_t func;
5362	char *name;	5391	/dispatch_func func;//TODO: maybe optionally keep the pointer, for speed? /
		5392	uint8_t builtin;
5363	int min_arity;	5393	uint8_t min_arity;
5364	int max_arity;	5394	uint8_t max_arity;
5365	char arg_tests_encoding[3];	5395	char arg_tests_encoding[3];
5366	} op_code_info;	5396	} op_code_info;
5367		5397
5368	#define INF_ARG 0xffff
5369
5370	static op_code_info dispatch_table[] = {	5398	static const op_code_info dispatch_table[] = {
5371	#define OP_DEF(func,name,minarity,maxarity,argtest,op) { opexe_ ## func, name, minarity, maxarity, argtest },	5399	#define OP_DEF(func,name,minarity,maxarity,argtest,op) { func, sizeof (name) > 1, minarity, maxarity, argtest },
5372	#include "opdefines.h"	5400	#include "opdefines.h"
5373	#undef OP_DEF	5401	#undef OP_DEF
5374	{0}	5402	{0}
5375	};	5403	};
5376		5404
5377	static const char *
5378	procname (pointer x)
5379	{
5380	int n = procnum (x);
5381	const char *name = dispatch_table[n].name;
5382
5383	if (name == 0)
5384	name = "ILLEGAL!";
5385
5386	return name;
5387	}
5388
5389	/* kernel of this interpreter */	5405	/* kernel of this interpreter */
5390	static void	5406	static void
5391	Eval_Cycle (SCHEME_P_ enum scheme_opcodes op)	5407	Eval_Cycle (SCHEME_P_ enum scheme_opcodes op)
5392	{	5408	{
5393	SCHEME_V->op = op;	5409	SCHEME_V->op = op;
5394		5410
5395	for (;;)	5411	for (;;)
5396	{	5412	{
5397	op_code_info *pcd = dispatch_table + SCHEME_V->op;	5413	const op_code_info *pcd = dispatch_table + SCHEME_V->op;
5398		5414
5399	#if USE_ERROR_CHECKING	5415	#if USE_ERROR_CHECKING
5400	if (pcd->name) /* if built-in function, check arguments */	5416	if (pcd->builtin) /* if built-in function, check arguments */
5401	{	5417	{
5402	int ok = 1;	5418	int ok = 1;
5403	char msg[STRBUFFSIZE];	5419	char msg[STRBUFFSIZE];
5404	int n = list_length (SCHEME_A_ SCHEME_V->args);	5420	int n = list_length (SCHEME_A_ SCHEME_V->args);
5405		5421
5406	/* Check number of arguments */	5422	/* Check number of arguments */
5407	if (ecb_expect_false (n < pcd->min_arity))	5423	if (ecb_expect_false (n < pcd->min_arity))
5408	{	5424	{
5409	ok = 0;	5425	ok = 0;
5410	snprintf (msg, STRBUFFSIZE, "%s: needs%s %d argument(s)",	5426	snprintf (msg, STRBUFFSIZE, "%s: needs%s %d argument(s)",
5411	pcd->name, pcd->min_arity == pcd->max_arity ? "" : " at least", pcd->min_arity);	5427	opname (SCHEME_V->op), pcd->min_arity == pcd->max_arity ? "" : " at least", pcd->min_arity);
5412	}	5428	}
5413	else if (ecb_expect_false (n > pcd->max_arity))	5429	else if (ecb_expect_false (n > pcd->max_arity && pcd->max_arity != INF_ARG))
5414	{	5430	{
5415	ok = 0;	5431	ok = 0;
5416	snprintf (msg, STRBUFFSIZE, "%s: needs%s %d argument(s)",	5432	snprintf (msg, STRBUFFSIZE, "%s: needs%s %d argument(s)",
5417	pcd->name, pcd->min_arity == pcd->max_arity ? "" : " at most", pcd->max_arity);	5433	opname (SCHEME_V->op), pcd->min_arity == pcd->max_arity ? "" : " at most", pcd->max_arity);
5418	}	5434	}
5419		5435	else
5420	if (ecb_expect_false (ok))
5421	{	5436	{
5422	if (*pcd->arg_tests_encoding)	5437	if (pcd->arg_tests_encoding) / literal 0 and TST_NONE treated the same */
5423	{	5438	{
5424	int i = 0;	5439	int i = 0;
5425	int j;	5440	int j;
5426	const char *t = pcd->arg_tests_encoding;	5441	const char *t = pcd->arg_tests_encoding;
5427	pointer arglist = SCHEME_V->args;	5442	pointer arglist = SCHEME_V->args;
…		…
5444	while (i < n);	5459	while (i < n);
5445		5460
5446	if (i < n)	5461	if (i < n)
5447	{	5462	{
5448	ok = 0;	5463	ok = 0;
5449	snprintf (msg, STRBUFFSIZE, "%s: argument %d must be: %s", pcd->name, i + 1, tests[j].kind);	5464	snprintf (msg, STRBUFFSIZE, "%s: argument %d must be: %s", opname (SCHEME_V->op), i + 1, tests[j].kind);
5450	}	5465	}
5451	}	5466	}
5452	}	5467	}
5453		5468
5454	if (!ok)	5469	if (!ok)
5455	{	5470	{
		5471	/* tinyscheme tested for returncode, but Error_1 always diverts? */
5456	if (xError_1 (SCHEME_A_ msg, 0) == NIL)	5472	xError_1 (SCHEME_A_ msg, 0);
5457	return;	5473	continue;
5458
5459	pcd = dispatch_table + SCHEME_V->op;
5460	}	5474	}
5461	}	5475	}
5462	#endif	5476	#endif
5463		5477
5464	ok_to_freely_gc (SCHEME_A);	5478	ok_to_freely_gc (SCHEME_A);
5465		5479
		5480	static const dispatch_func dispatch_funcs[] = {
		5481	opexe_0,
		5482	opexe_1,
		5483	opexe_2,
		5484	opexe_3,
		5485	opexe_4,
		5486	opexe_5,
		5487	opexe_6,
		5488	};
		5489
5466	if (ecb_expect_false (pcd->func (SCHEME_A_ SCHEME_V->op) == NIL))	5490	if (ecb_expect_false (dispatch_funcs [pcd->func] (SCHEME_A_ SCHEME_V->op) != 0))
5467	return;	5491	return;
5468		5492
5469	if (SCHEME_V->no_memory && USE_ERROR_CHECKING)	5493	if (SCHEME_V->no_memory && USE_ERROR_CHECKING)
5470	{	5494	{
5471	xwrstr ("No memory!\n");	5495	xwrstr ("No memory!\n");
…		…
5668		5692
5669	for (i = 0; i < sizeof (syntax_names) / sizeof (*syntax_names); ++i)	5693	for (i = 0; i < sizeof (syntax_names) / sizeof (*syntax_names); ++i)
5670	assign_syntax (SCHEME_A_ syntax_names[i]);	5694	assign_syntax (SCHEME_A_ syntax_names[i]);
5671	}	5695	}
5672		5696
		5697	// TODO: should iterate via strlen, to avoid n² complexity
5673	for (i = 0; i < n; i++)	5698	for (i = 0; i < n; i++)
5674	if (dispatch_table[i].name != 0)	5699	if (dispatch_table[i].builtin)
5675	assign_proc (SCHEME_A_ i, dispatch_table[i].name);	5700	assign_proc (SCHEME_A_ i, opname (i));
5676		5701
5677	/* initialization of global pointers to special symbols */	5702	/* initialization of global pointers to special symbols */
5678	SCHEME_V->LAMBDA = mk_symbol (SCHEME_A_ "lambda");	5703	SCHEME_V->LAMBDA = mk_symbol (SCHEME_A_ "lambda");
5679	SCHEME_V->QUOTE = mk_symbol (SCHEME_A_ "quote");	5704	SCHEME_V->QUOTE = mk_symbol (SCHEME_A_ "quote");
5680	SCHEME_V->QQUOTE = mk_symbol (SCHEME_A_ "quasiquote");	5705	SCHEME_V->QQUOTE = mk_symbol (SCHEME_A_ "quasiquote");

Diff Legend

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

Comparing microscheme/scheme.c (file contents): Revision 1.19 by root, Thu Nov 26 21:36:11 2015 UTC vs. Revision 1.20 by root, Thu Nov 26 22:53:28 2015 UTC

Diff Legend

Comparing microscheme/scheme.c (file contents):
Revision 1.19 by root, Thu Nov 26 21:36:11 2015 UTC vs.
Revision 1.20 by root, Thu Nov 26 22:53:28 2015 UTC