ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/cvsroot/microscheme/scheme.c

Comparing cvsroot/microscheme/scheme.c (file contents):
Revision 1.13 by root, Thu Nov 26 07:59:42 2015 UTC vs.
Revision 1.17 by root, Thu Nov 26 10:15:51 2015 UTC

…		…
70	/* should use libecb */	70	/* should use libecb */
71	#if __GNUC__ >= 4	71	#if __GNUC__ >= 4
72	# define ecb_expect(expr,value) __builtin_expect ((expr),(value))	72	# define ecb_expect(expr,value) __builtin_expect ((expr),(value))
73	# define ecb_expect_false(expr) ecb_expect (!!(expr), 0)	73	# define ecb_expect_false(expr) ecb_expect (!!(expr), 0)
74	# define ecb_expect_true(expr) ecb_expect (!!(expr), 1)	74	# define ecb_expect_true(expr) ecb_expect (!!(expr), 1)
		75	#else
		76	# define ecb_expect_false(expr) !!(expr)
		77	# define ecb_expect_true(expr) !!(expr)
75	#endif	78	#endif
76		79
77	#if !USE_MULTIPLICITY	80	#if !USE_MULTIPLICITY
78	static scheme sc;	81	static scheme sc;
79	#endif	82	#endif
…		…
208	#define T_SYNTAX 0x0010	211	#define T_SYNTAX 0x0010
209	#define T_IMMUTABLE 0x0020	212	#define T_IMMUTABLE 0x0020
210	#define T_ATOM 0x0040 /* only for gc */	213	#define T_ATOM 0x0040 /* only for gc */
211	#define T_MARK 0x0080 /* only for gc */	214	#define T_MARK 0x0080 /* only for gc */
212		215
		216	enum num_op { NUM_ADD, NUM_SUB, NUM_MUL, NUM_INTDIV };
		217
213	static num num_op (char op, num a, num b);	218	static num num_op (enum num_op op, num a, num b);
214	static num num_intdiv (num a, num b);	219	static num num_intdiv (num a, num b);
215	static num num_rem (num a, num b);	220	static num num_rem (num a, num b);
216	static num num_mod (num a, num b);	221	static num num_mod (num a, num b);
217	static int num_eq (num a, num b);
218	static int num_gt (num a, num b);
219	static int num_ge (num a, num b);
220	static int num_lt (num a, num b);
221	static int num_le (num a, num b);
222		222
223	#if USE_MATH	223	#if USE_MATH
224	static double round_per_R5RS (double x);	224	static double round_per_R5RS (double x);
225	#endif	225	#endif
226	static int is_zero_rvalue (RVALUE x);	226	static int is_zero_rvalue (RVALUE x);
…		…
668	static pointer ss_get_cont (SCHEME_P);	668	static pointer ss_get_cont (SCHEME_P);
669	static void ss_set_cont (SCHEME_P_ pointer cont);	669	static void ss_set_cont (SCHEME_P_ pointer cont);
670	static void dump_stack_mark (SCHEME_P);	670	static void dump_stack_mark (SCHEME_P);
671	static pointer opexe_0 (SCHEME_P_ enum scheme_opcodes op);	671	static pointer opexe_0 (SCHEME_P_ enum scheme_opcodes op);
672	static pointer opexe_2 (SCHEME_P_ enum scheme_opcodes op);	672	static pointer opexe_2 (SCHEME_P_ enum scheme_opcodes op);
		673	static pointer opexe_r (SCHEME_P_ enum scheme_opcodes op);
673	static pointer opexe_3 (SCHEME_P_ enum scheme_opcodes op);	674	static pointer opexe_3 (SCHEME_P_ enum scheme_opcodes op);
674	static pointer opexe_4 (SCHEME_P_ enum scheme_opcodes op);	675	static pointer opexe_4 (SCHEME_P_ enum scheme_opcodes op);
675	static pointer opexe_5 (SCHEME_P_ enum scheme_opcodes op);	676	static pointer opexe_5 (SCHEME_P_ enum scheme_opcodes op);
676	static pointer opexe_6 (SCHEME_P_ enum scheme_opcodes op);	677	static pointer opexe_6 (SCHEME_P_ enum scheme_opcodes op);
677	static void Eval_Cycle (SCHEME_P_ enum scheme_opcodes op);	678	static void Eval_Cycle (SCHEME_P_ enum scheme_opcodes op);
678	static void assign_syntax (SCHEME_P_ const char *name);	679	static void assign_syntax (SCHEME_P_ const char *name);
679	static int syntaxnum (pointer p);	680	static int syntaxnum (pointer p);
680	static void assign_proc (SCHEME_P_ enum scheme_opcodes, const char *name);	681	static void assign_proc (SCHEME_P_ enum scheme_opcodes, const char *name);
681		682
682	static num	683	static num
683	num_op (char op, num a, num b)	684	num_op (enum num_op op, num a, num b)
684	{	685	{
685	num ret;	686	num ret;
686		687
687	num_set_fixnum (ret, num_is_fixnum (a) && num_is_fixnum (b));	688	num_set_fixnum (ret, num_is_fixnum (a) && num_is_fixnum (b));
688		689
…		…
691	IVALUE av = num_get_ivalue (a);	692	IVALUE av = num_get_ivalue (a);
692	IVALUE bv = num_get_ivalue (b);	693	IVALUE bv = num_get_ivalue (b);
693		694
694	switch (op)	695	switch (op)
695	{	696	{
696	case '+': av += bv; break;	697	case NUM_ADD: av += bv; break;
697	case '-': av -= bv; break;	698	case NUM_SUB: av -= bv; break;
698	case '*': av *= bv; break;	699	case NUM_MUL: av *= bv; break;
699	case '/': av /= bv; break;	700	case NUM_INTDIV: av /= bv; break;
700	}	701	}
701		702
702	num_set_ivalue (ret, av);	703	num_set_ivalue (ret, av);
703	}	704	}
704	else	705	else
…		…
706	RVALUE av = num_get_rvalue (a);	707	RVALUE av = num_get_rvalue (a);
707	RVALUE bv = num_get_rvalue (b);	708	RVALUE bv = num_get_rvalue (b);
708		709
709	switch (op)	710	switch (op)
710	{	711	{
711	case '+': av += bv; break;	712	case NUM_ADD: av += bv; break;
712	case '-': av -= bv; break;	713	case NUM_SUB: av -= bv; break;
713	case '*': av *= bv; break;	714	case NUM_MUL: av *= bv; break;
714	case '/': av /= bv; break;	715	case NUM_INTDIV: av /= bv; break;
715	}	716	}
716		717
717	num_set_rvalue (ret, av);	718	num_set_rvalue (ret, av);
718	}	719	}
719		720
…		…
779		780
780	num_set_ivalue (ret, res);	781	num_set_ivalue (ret, res);
781	return ret;	782	return ret;
782	}	783	}
783		784
		785	/* this completely disrespects NaNs */
784	static int	786	static int
785	num_eq (num a, num b)	787	num_cmp (num a, num b)
786	{	788	{
		789	int is_fixnum = num_is_fixnum (a) && num_is_fixnum (b);
787	int ret;	790	int ret;
788	int is_fixnum = num_is_fixnum (a) && num_is_fixnum (b);
789		791
790	if (is_fixnum)	792	if (is_fixnum)
791	ret = num_get_ivalue (a) == num_get_ivalue (b);	793	{
		794	IVALUE av = num_get_ivalue (a);
		795	IVALUE bv = num_get_ivalue (b);
		796
		797	ret = av == bv ? 0 : av < bv ? -1 : +1;
		798	}
792	else	799	else
793	ret = num_get_rvalue (a) == num_get_rvalue (b);	800	{
		801	RVALUE av = num_get_rvalue (a);
		802	RVALUE bv = num_get_rvalue (b);
		803
		804	ret = av == bv ? 0 : av < bv ? -1 : +1;
		805	}
794		806
795	return ret;	807	return ret;
796	}
797
798
799	static int
800	num_gt (num a, num b)
801	{
802	int ret;
803	int is_fixnum = num_is_fixnum (a) && num_is_fixnum (b);
804
805	if (is_fixnum)
806	ret = num_get_ivalue (a) > num_get_ivalue (b);
807	else
808	ret = num_get_rvalue (a) > num_get_rvalue (b);
809
810	return ret;
811	}
812
813	static int
814	num_ge (num a, num b)
815	{
816	return !num_lt (a, b);
817	}
818
819	static int
820	num_lt (num a, num b)
821	{
822	int ret;
823	int is_fixnum = num_is_fixnum (a) && num_is_fixnum (b);
824
825	if (is_fixnum)
826	ret = num_get_ivalue (a) < num_get_ivalue (b);
827	else
828	ret = num_get_rvalue (a) < num_get_rvalue (b);
829
830	return ret;
831	}
832
833	static int
834	num_le (num a, num b)
835	{
836	return !num_gt (a, b);
837	}	808	}
838		809
839	#if USE_MATH	810	#if USE_MATH
840		811
841	/* Round to nearest. Round to even if midway */	812	/* Round to nearest. Round to even if midway */
…		…
851	return ce;	822	return ce;
852	else if (dfl < dce)	823	else if (dfl < dce)
853	return fl;	824	return fl;
854	else	825	else
855	{	826	{
856	if (fmod (fl, 2.0) == 0.0) /* I imagine this holds */	827	if (fmod (fl, 2) == 0) /* I imagine this holds */
857	return fl;	828	return fl;
858	else	829	else
859	return ce;	830	return ce;
860	}	831	}
861	}	832	}
…		…
2774	}	2745	}
2775	else if (is_number (a))	2746	else if (is_number (a))
2776	{	2747	{
2777	if (is_number (b))	2748	if (is_number (b))
2778	if (num_is_integer (a) == num_is_integer (b))	2749	if (num_is_integer (a) == num_is_integer (b))
2779	return num_eq (nvalue (a), nvalue (b));	2750	return num_cmp (nvalue (a), nvalue (b)) == 0;
2780		2751
2781	return 0;	2752	return 0;
2782	}	2753	}
2783	else if (is_character (a))	2754	else if (is_character (a))
2784	{	2755	{
…		…
3063	next_frame = SCHEME_V->dump_base + nframes;	3034	next_frame = SCHEME_V->dump_base + nframes;
3064		3035
3065	next_frame->op = op;	3036	next_frame->op = op;
3066	next_frame->args = args;	3037	next_frame->args = args;
3067	next_frame->envir = SCHEME_V->envir;	3038	next_frame->envir = SCHEME_V->envir;
3068	next_frame->code = code;	3039	next_frame->code = code;
3069		3040
3070	SCHEME_V->dump = (pointer)(uintptr_t)(nframes + 1);	3041	SCHEME_V->dump = (pointer)(uintptr_t)(nframes + 1);
3071	}	3042	}
3072		3043
3073	static pointer	3044	static pointer
…		…
3246	#define s_retbool(tf) s_return ((tf) ? S_T : S_F)	3217	#define s_retbool(tf) s_return ((tf) ? S_T : S_F)
3247		3218
3248	static pointer	3219	static pointer
3249	opexe_0 (SCHEME_P_ enum scheme_opcodes op)	3220	opexe_0 (SCHEME_P_ enum scheme_opcodes op)
3250	{	3221	{
		3222	pointer args = SCHEME_V->args;
3251	pointer x, y;	3223	pointer x, y;
3252		3224
3253	switch (op)	3225	switch (op)
3254	{	3226	{
3255	case OP_LOAD: /* load */	3227	case OP_LOAD: /* load */
3256	if (file_interactive (SCHEME_A))	3228	if (file_interactive (SCHEME_A))
3257	{	3229	{
3258	xwrstr ("Loading "); xwrstr (strvalue (car (SCHEME_V->args))); xwrstr ("\n");	3230	xwrstr ("Loading "); xwrstr (strvalue (car (args))); xwrstr ("\n");
3259	//D fprintf (SCHEME_V->outport->object.port->rep.stdio.file, "Loading %s\n", strvalue (car (SCHEME_V->args)));	3231	//D fprintf (SCHEME_V->outport->object.port->rep.stdio.file, "Loading %s\n", strvalue (car (args)));
3260	}	3232	}
3261		3233
3262	if (!file_push (SCHEME_A_ strvalue (car (SCHEME_V->args))))	3234	if (!file_push (SCHEME_A_ strvalue (car (args))))
3263	Error_1 ("unable to open", car (SCHEME_V->args));	3235	Error_1 ("unable to open", car (args));
3264	else	3236	else
3265	{	3237	{
3266	SCHEME_V->args = mk_integer (SCHEME_A_ SCHEME_V->file_i);	3238	SCHEME_V->args = mk_integer (SCHEME_A_ SCHEME_V->file_i);
3267	s_goto (OP_T0LVL);	3239	s_goto (OP_T0LVL);
3268	}	3240	}
…		…
3342	case OP_EVAL: /* main part of evaluation */	3314	case OP_EVAL: /* main part of evaluation */
3343	#if USE_TRACING	3315	#if USE_TRACING
3344	if (SCHEME_V->tracing)	3316	if (SCHEME_V->tracing)
3345	{	3317	{
3346	/*s_save(SCHEME_A_ OP_VALUEPRINT,NIL,NIL); */	3318	/*s_save(SCHEME_A_ OP_VALUEPRINT,NIL,NIL); */
3347	s_save (SCHEME_A_ OP_REAL_EVAL, SCHEME_V->args, SCHEME_V->code);	3319	s_save (SCHEME_A_ OP_REAL_EVAL, args, SCHEME_V->code);
3348	SCHEME_V->args = SCHEME_V->code;	3320	SCHEME_V->args = SCHEME_V->code;
3349	putstr (SCHEME_A_ "\nEval: ");	3321	putstr (SCHEME_A_ "\nEval: ");
3350	s_goto (OP_P0LIST);	3322	s_goto (OP_P0LIST);
3351	}	3323	}
3352		3324
…		…
3396	SCHEME_V->code = cdr (SCHEME_V->code);	3368	SCHEME_V->code = cdr (SCHEME_V->code);
3397	s_goto (OP_E1ARGS);	3369	s_goto (OP_E1ARGS);
3398	}	3370	}
3399		3371
3400	case OP_E1ARGS: /* eval arguments */	3372	case OP_E1ARGS: /* eval arguments */
3401	SCHEME_V->args = cons (SCHEME_V->value, SCHEME_V->args);	3373	args = cons (SCHEME_V->value, args);
3402		3374
3403	if (is_pair (SCHEME_V->code)) /* continue */	3375	if (is_pair (SCHEME_V->code)) /* continue */
3404	{	3376	{
3405	s_save (SCHEME_A_ OP_E1ARGS, SCHEME_V->args, cdr (SCHEME_V->code));	3377	s_save (SCHEME_A_ OP_E1ARGS, args, cdr (SCHEME_V->code));
3406	SCHEME_V->code = car (SCHEME_V->code);	3378	SCHEME_V->code = car (SCHEME_V->code);
3407	SCHEME_V->args = NIL;	3379	SCHEME_V->args = NIL;
3408	s_goto (OP_EVAL);	3380	s_goto (OP_EVAL);
3409	}	3381	}
3410	else /* end */	3382	else /* end */
3411	{	3383	{
3412	SCHEME_V->args = reverse_in_place (SCHEME_A_ NIL, SCHEME_V->args);	3384	args = reverse_in_place (SCHEME_A_ NIL, args);
3413	SCHEME_V->code = car (SCHEME_V->args);	3385	SCHEME_V->code = car (args);
3414	SCHEME_V->args = cdr (SCHEME_V->args);	3386	SCHEME_V->args = cdr (args);
3415	s_goto (OP_APPLY);	3387	s_goto (OP_APPLY);
3416	}	3388	}
3417		3389
3418	#if USE_TRACING	3390	#if USE_TRACING
3419		3391
3420	case OP_TRACING:	3392	case OP_TRACING:
3421	{	3393	{
3422	int tr = SCHEME_V->tracing;	3394	int tr = SCHEME_V->tracing;
3423		3395
3424	SCHEME_V->tracing = ivalue (car (SCHEME_V->args));	3396	SCHEME_V->tracing = ivalue (car (args));
3425	s_return (mk_integer (SCHEME_A_ tr));	3397	s_return (mk_integer (SCHEME_A_ tr));
3426	}	3398	}
3427		3399
3428	#endif	3400	#endif
3429		3401
3430	case OP_APPLY: /* apply 'code' to 'args' */	3402	case OP_APPLY: /* apply 'code' to 'args' */
3431	#if USE_TRACING	3403	#if USE_TRACING
3432	if (SCHEME_V->tracing)	3404	if (SCHEME_V->tracing)
3433	{	3405	{
3434	s_save (SCHEME_A_ OP_REAL_APPLY, SCHEME_V->args, SCHEME_V->code);	3406	s_save (SCHEME_A_ OP_REAL_APPLY, args, SCHEME_V->code);
3435	SCHEME_V->print_flag = 1;	3407	SCHEME_V->print_flag = 1;
3436	/* SCHEME_V->args=cons(SCHEME_V->code,SCHEME_V->args); */	3408	/* args=cons(SCHEME_V->code,args); */
3437	putstr (SCHEME_A_ "\nApply to: ");	3409	putstr (SCHEME_A_ "\nApply to: ");
3438	s_goto (OP_P0LIST);	3410	s_goto (OP_P0LIST);
3439	}	3411	}
3440		3412
3441	/* fall through */	3413	/* fall through */
…		…
3447	s_goto (procnum (SCHEME_V->code)); /* PROCEDURE */	3419	s_goto (procnum (SCHEME_V->code)); /* PROCEDURE */
3448	}	3420	}
3449	else if (is_foreign (SCHEME_V->code))	3421	else if (is_foreign (SCHEME_V->code))
3450	{	3422	{
3451	/* Keep nested calls from GC'ing the arglist */	3423	/* Keep nested calls from GC'ing the arglist */
3452	push_recent_alloc (SCHEME_A_ SCHEME_V->args, NIL);	3424	push_recent_alloc (SCHEME_A_ args, NIL);
3453	x = SCHEME_V->code->object.ff (SCHEME_A_ SCHEME_V->args);	3425	x = SCHEME_V->code->object.ff (SCHEME_A_ args);
3454		3426
3455	s_return (x);	3427	s_return (x);
3456	}	3428	}
3457	else if (is_closure (SCHEME_V->code) || is_macro (SCHEME_V->code) || is_promise (SCHEME_V->code)) /* CLOSURE */	3429	else if (is_closure (SCHEME_V->code) || is_macro (SCHEME_V->code) || is_promise (SCHEME_V->code)) /* CLOSURE */
3458	{	3430	{
3459	/* Should not accept promise */	3431	/* Should not accept promise */
3460	/* make environment */	3432	/* make environment */
3461	new_frame_in_env (SCHEME_A_ closure_env (SCHEME_V->code));	3433	new_frame_in_env (SCHEME_A_ closure_env (SCHEME_V->code));
3462		3434
3463	for (x = car (closure_code (SCHEME_V->code)), y = SCHEME_V->args; is_pair (x); x = cdr (x), y = cdr (y))	3435	for (x = car (closure_code (SCHEME_V->code)), y = args; is_pair (x); x = cdr (x), y = cdr (y))
3464	{	3436	{
3465	if (y == NIL)	3437	if (y == NIL)
3466	Error_0 ("not enough arguments");	3438	Error_0 ("not enough arguments");
3467	else	3439	else
3468	new_slot_in_env (SCHEME_A_ car (x), car (y));	3440	new_slot_in_env (SCHEME_A_ car (x), car (y));
…		…
3486	s_goto (OP_BEGIN);	3458	s_goto (OP_BEGIN);
3487	}	3459	}
3488	else if (is_continuation (SCHEME_V->code)) /* CONTINUATION */	3460	else if (is_continuation (SCHEME_V->code)) /* CONTINUATION */
3489	{	3461	{
3490	ss_set_cont (SCHEME_A_ cont_dump (SCHEME_V->code));	3462	ss_set_cont (SCHEME_A_ cont_dump (SCHEME_V->code));
3491	s_return (SCHEME_V->args != NIL ? car (SCHEME_V->args) : NIL);	3463	s_return (args != NIL ? car (args) : NIL);
3492	}	3464	}
3493	else	3465	else
3494	Error_0 ("illegal function");	3466	Error_0 ("illegal function");
3495		3467
3496	case OP_DOMACRO: /* do macro */	3468	case OP_DOMACRO: /* do macro */
…		…
3505	{	3477	{
3506	pointer f = find_slot_in_env (SCHEME_A_ SCHEME_V->envir, SCHEME_V->COMPILE_HOOK, 1);	3478	pointer f = find_slot_in_env (SCHEME_A_ SCHEME_V->envir, SCHEME_V->COMPILE_HOOK, 1);
3507		3479
3508	if (f != NIL)	3480	if (f != NIL)
3509	{	3481	{
3510	s_save (SCHEME_A_ OP_LAMBDA1, SCHEME_V->args, SCHEME_V->code);	3482	s_save (SCHEME_A_ OP_LAMBDA1, args, SCHEME_V->code);
3511	SCHEME_V->args = cons (SCHEME_V->code, NIL);	3483	SCHEME_V->args = cons (SCHEME_V->code, NIL);
3512	SCHEME_V->code = slot_value_in_env (f);	3484	SCHEME_V->code = slot_value_in_env (f);
3513	s_goto (OP_APPLY);	3485	s_goto (OP_APPLY);
3514	}	3486	}
3515		3487
…		…
3526	s_return (mk_closure (SCHEME_A_ SCHEME_V->code, SCHEME_V->envir));	3498	s_return (mk_closure (SCHEME_A_ SCHEME_V->code, SCHEME_V->envir));
3527		3499
3528	#endif	3500	#endif
3529		3501
3530	case OP_MKCLOSURE: /* make-closure */	3502	case OP_MKCLOSURE: /* make-closure */
3531	x = car (SCHEME_V->args);	3503	x = car (args);
3532		3504
3533	if (car (x) == SCHEME_V->LAMBDA)	3505	if (car (x) == SCHEME_V->LAMBDA)
3534	x = cdr (x);	3506	x = cdr (x);
3535		3507
3536	if (cdr (SCHEME_V->args) == NIL)	3508	if (cdr (args) == NIL)
3537	y = SCHEME_V->envir;	3509	y = SCHEME_V->envir;
3538	else	3510	else
3539	y = cadr (SCHEME_V->args);	3511	y = cadr (args);
3540		3512
3541	s_return (mk_closure (SCHEME_A_ x, y));	3513	s_return (mk_closure (SCHEME_A_ x, y));
3542		3514
3543	case OP_QUOTE: /* quote */	3515	case OP_QUOTE: /* quote */
3544	s_return (car (SCHEME_V->code));	3516	s_return (car (SCHEME_V->code));
…		…
3576		3548
3577		3549
3578	case OP_DEFP: /* defined? */	3550	case OP_DEFP: /* defined? */
3579	x = SCHEME_V->envir;	3551	x = SCHEME_V->envir;
3580		3552
3581	if (cdr (SCHEME_V->args) != NIL)	3553	if (cdr (args) != NIL)
3582	x = cadr (SCHEME_V->args);	3554	x = cadr (args);
3583		3555
3584	s_retbool (find_slot_in_env (SCHEME_A_ x, car (SCHEME_V->args), 1) != NIL);	3556	s_retbool (find_slot_in_env (SCHEME_A_ x, car (args), 1) != NIL);
3585		3557
3586	case OP_SET0: /* set! */	3558	case OP_SET0: /* set! */
3587	if (is_immutable (car (SCHEME_V->code)))	3559	if (is_immutable (car (SCHEME_V->code)))
3588	Error_1 ("set!: unable to alter immutable variable", car (SCHEME_V->code));	3560	Error_1 ("set!: unable to alter immutable variable", car (SCHEME_V->code));
3589		3561
…		…
3632	SCHEME_V->value = SCHEME_V->code;	3604	SCHEME_V->value = SCHEME_V->code;
3633	SCHEME_V->code = is_symbol (car (SCHEME_V->code)) ? cadr (SCHEME_V->code) : car (SCHEME_V->code);	3605	SCHEME_V->code = is_symbol (car (SCHEME_V->code)) ? cadr (SCHEME_V->code) : car (SCHEME_V->code);
3634	s_goto (OP_LET1);	3606	s_goto (OP_LET1);
3635		3607
3636	case OP_LET1: /* let (calculate parameters) */	3608	case OP_LET1: /* let (calculate parameters) */
3637	SCHEME_V->args = cons (SCHEME_V->value, SCHEME_V->args);	3609	args = cons (SCHEME_V->value, args);
3638		3610
3639	if (is_pair (SCHEME_V->code)) /* continue */	3611	if (is_pair (SCHEME_V->code)) /* continue */
3640	{	3612	{
3641	if (!is_pair (car (SCHEME_V->code)) || !is_pair (cdar (SCHEME_V->code)))	3613	if (!is_pair (car (SCHEME_V->code)) || !is_pair (cdar (SCHEME_V->code)))
3642	Error_1 ("Bad syntax of binding spec in let :", car (SCHEME_V->code));	3614	Error_1 ("Bad syntax of binding spec in let :", car (SCHEME_V->code));
3643		3615
3644	s_save (SCHEME_A_ OP_LET1, SCHEME_V->args, cdr (SCHEME_V->code));	3616	s_save (SCHEME_A_ OP_LET1, args, cdr (SCHEME_V->code));
3645	SCHEME_V->code = cadar (SCHEME_V->code);	3617	SCHEME_V->code = cadar (SCHEME_V->code);
3646	SCHEME_V->args = NIL;	3618	SCHEME_V->args = NIL;
3647	s_goto (OP_EVAL);	3619	s_goto (OP_EVAL);
3648	}	3620	}
3649	else /* end */	3621	else /* end */
3650	{	3622	{
3651	SCHEME_V->args = reverse_in_place (SCHEME_A_ NIL, SCHEME_V->args);	3623	args = reverse_in_place (SCHEME_A_ NIL, args);
3652	SCHEME_V->code = car (SCHEME_V->args);	3624	SCHEME_V->code = car (args);
3653	SCHEME_V->args = cdr (SCHEME_V->args);	3625	SCHEME_V->args = cdr (args);
3654	s_goto (OP_LET2);	3626	s_goto (OP_LET2);
3655	}	3627	}
3656		3628
3657	case OP_LET2: /* let */	3629	case OP_LET2: /* let */
3658	new_frame_in_env (SCHEME_A_ SCHEME_V->envir);	3630	new_frame_in_env (SCHEME_A_ SCHEME_V->envir);
3659		3631
3660	for (x = is_symbol (car (SCHEME_V->code)) ? cadr (SCHEME_V->code) : car (SCHEME_V->code), y = SCHEME_V->args;	3632	for (x = is_symbol (car (SCHEME_V->code)) ? cadr (SCHEME_V->code) : car (SCHEME_V->code), y = args;
3661	y != NIL; x = cdr (x), y = cdr (y))	3633	y != NIL; x = cdr (x), y = cdr (y))
3662	new_slot_in_env (SCHEME_A_ caar (x), car (y));	3634	new_slot_in_env (SCHEME_A_ caar (x), car (y));
3663		3635
3664	if (is_symbol (car (SCHEME_V->code))) /* named let */	3636	if (is_symbol (car (SCHEME_V->code))) /* named let */
3665	{	3637	{
3666	for (x = cadr (SCHEME_V->code), SCHEME_V->args = NIL; x != NIL; x = cdr (x))	3638	for (x = cadr (SCHEME_V->code), args = NIL; x != NIL; x = cdr (x))
3667	{	3639	{
3668	if (!is_pair (x))	3640	if (!is_pair (x))
3669	Error_1 ("Bad syntax of binding in let :", x);	3641	Error_1 ("Bad syntax of binding in let :", x);
3670		3642
3671	if (!is_list (SCHEME_A_ car (x)))	3643	if (!is_list (SCHEME_A_ car (x)))
3672	Error_1 ("Bad syntax of binding in let :", car (x));	3644	Error_1 ("Bad syntax of binding in let :", car (x));
3673		3645
3674	SCHEME_V->args = cons (caar (x), SCHEME_V->args);	3646	args = cons (caar (x), args);
3675	}	3647	}
3676		3648
3677	x =
3678	mk_closure (SCHEME_A_ cons (reverse_in_place (SCHEME_A_ NIL, SCHEME_V->args), cddr (SCHEME_V->code)),	3649	x = mk_closure (SCHEME_A_ cons (reverse_in_place (SCHEME_A_ NIL, args), cddr (SCHEME_V->code)),
3679	SCHEME_V->envir);	3650	SCHEME_V->envir);
3680	new_slot_in_env (SCHEME_A_ car (SCHEME_V->code), x);	3651	new_slot_in_env (SCHEME_A_ car (SCHEME_V->code), x);
3681	SCHEME_V->code = cddr (SCHEME_V->code);	3652	SCHEME_V->code = cddr (SCHEME_V->code);
3682	SCHEME_V->args = NIL;
3683	}	3653	}
3684	else	3654	else
3685	{	3655	{
3686	SCHEME_V->code = cdr (SCHEME_V->code);	3656	SCHEME_V->code = cdr (SCHEME_V->code);
		3657	}
		3658
3687	SCHEME_V->args = NIL;	3659	SCHEME_V->args = NIL;
3688	}
3689
3690	s_goto (OP_BEGIN);	3660	s_goto (OP_BEGIN);
3691		3661
3692	case OP_LET0AST: /* let* */	3662	case OP_LET0AST: /* let* */
3693	if (car (SCHEME_V->code) == NIL)	3663	if (car (SCHEME_V->code) == NIL)
3694	{	3664	{
…		…
3712	new_slot_in_env (SCHEME_A_ caar (SCHEME_V->code), SCHEME_V->value);	3682	new_slot_in_env (SCHEME_A_ caar (SCHEME_V->code), SCHEME_V->value);
3713	SCHEME_V->code = cdr (SCHEME_V->code);	3683	SCHEME_V->code = cdr (SCHEME_V->code);
3714		3684
3715	if (is_pair (SCHEME_V->code)) /* continue */	3685	if (is_pair (SCHEME_V->code)) /* continue */
3716	{	3686	{
3717	s_save (SCHEME_A_ OP_LET2AST, SCHEME_V->args, SCHEME_V->code);	3687	s_save (SCHEME_A_ OP_LET2AST, args, SCHEME_V->code);
3718	SCHEME_V->code = cadar (SCHEME_V->code);	3688	SCHEME_V->code = cadar (SCHEME_V->code);
3719	SCHEME_V->args = NIL;	3689	SCHEME_V->args = NIL;
3720	s_goto (OP_EVAL);	3690	s_goto (OP_EVAL);
3721	}	3691	}
3722	else /* end */	3692	else /* end */
3723	{	3693	{
3724	SCHEME_V->code = SCHEME_V->args;	3694	SCHEME_V->code = args;
3725	SCHEME_V->args = NIL;	3695	SCHEME_V->args = NIL;
3726	s_goto (OP_BEGIN);	3696	s_goto (OP_BEGIN);
3727	}	3697	}
3728		3698
3729	case OP_LET0REC: /* letrec */	3699	case OP_LET0REC: /* letrec */
…		…
3732	SCHEME_V->value = SCHEME_V->code;	3702	SCHEME_V->value = SCHEME_V->code;
3733	SCHEME_V->code = car (SCHEME_V->code);	3703	SCHEME_V->code = car (SCHEME_V->code);
3734	s_goto (OP_LET1REC);	3704	s_goto (OP_LET1REC);
3735		3705
3736	case OP_LET1REC: /* letrec (calculate parameters) */	3706	case OP_LET1REC: /* letrec (calculate parameters) */
3737	SCHEME_V->args = cons (SCHEME_V->value, SCHEME_V->args);	3707	args = cons (SCHEME_V->value, args);
3738		3708
3739	if (is_pair (SCHEME_V->code)) /* continue */	3709	if (is_pair (SCHEME_V->code)) /* continue */
3740	{	3710	{
3741	if (!is_pair (car (SCHEME_V->code)) || !is_pair (cdar (SCHEME_V->code)))	3711	if (!is_pair (car (SCHEME_V->code)) || !is_pair (cdar (SCHEME_V->code)))
3742	Error_1 ("Bad syntax of binding spec in letrec :", car (SCHEME_V->code));	3712	Error_1 ("Bad syntax of binding spec in letrec :", car (SCHEME_V->code));
3743		3713
3744	s_save (SCHEME_A_ OP_LET1REC, SCHEME_V->args, cdr (SCHEME_V->code));	3714	s_save (SCHEME_A_ OP_LET1REC, args, cdr (SCHEME_V->code));
3745	SCHEME_V->code = cadar (SCHEME_V->code);	3715	SCHEME_V->code = cadar (SCHEME_V->code);
3746	SCHEME_V->args = NIL;	3716	SCHEME_V->args = NIL;
3747	s_goto (OP_EVAL);	3717	s_goto (OP_EVAL);
3748	}	3718	}
3749	else /* end */	3719	else /* end */
3750	{	3720	{
3751	SCHEME_V->args = reverse_in_place (SCHEME_A_ NIL, SCHEME_V->args);	3721	args = reverse_in_place (SCHEME_A_ NIL, args);
3752	SCHEME_V->code = car (SCHEME_V->args);	3722	SCHEME_V->code = car (args);
3753	SCHEME_V->args = cdr (SCHEME_V->args);	3723	SCHEME_V->args = cdr (args);
3754	s_goto (OP_LET2REC);	3724	s_goto (OP_LET2REC);
3755	}	3725	}
3756		3726
3757	case OP_LET2REC: /* letrec */	3727	case OP_LET2REC: /* letrec */
3758	for (x = car (SCHEME_V->code), y = SCHEME_V->args; y != NIL; x = cdr (x), y = cdr (y))	3728	for (x = car (SCHEME_V->code), y = args; y != NIL; x = cdr (x), y = cdr (y))
3759	new_slot_in_env (SCHEME_A_ caar (x), car (y));	3729	new_slot_in_env (SCHEME_A_ caar (x), car (y));
3760		3730
3761	SCHEME_V->code = cdr (SCHEME_V->code);	3731	SCHEME_V->code = cdr (SCHEME_V->code);
3762	SCHEME_V->args = NIL;	3732	SCHEME_V->args = NIL;
3763	s_goto (OP_BEGIN);	3733	s_goto (OP_BEGIN);
…		…
3849	s_save (SCHEME_A_ OP_C1STREAM, NIL, cdr (SCHEME_V->code));	3819	s_save (SCHEME_A_ OP_C1STREAM, NIL, cdr (SCHEME_V->code));
3850	SCHEME_V->code = car (SCHEME_V->code);	3820	SCHEME_V->code = car (SCHEME_V->code);
3851	s_goto (OP_EVAL);	3821	s_goto (OP_EVAL);
3852		3822
3853	case OP_C1STREAM: /* cons-stream */	3823	case OP_C1STREAM: /* cons-stream */
3854	SCHEME_V->args = SCHEME_V->value; /* save SCHEME_V->value to register SCHEME_V->args for gc */	3824	SCHEME_V->args = SCHEME_V->value; /* save SCHEME_V->value to register args for gc */
3855	x = mk_closure (SCHEME_A_ cons (NIL, SCHEME_V->code), SCHEME_V->envir);	3825	x = mk_closure (SCHEME_A_ cons (NIL, SCHEME_V->code), SCHEME_V->envir);
3856	set_typeflag (x, T_PROMISE);	3826	set_typeflag (x, T_PROMISE);
3857	s_return (cons (SCHEME_V->args, x));	3827	s_return (cons (args, x));
3858		3828
3859	case OP_MACRO0: /* macro */	3829	case OP_MACRO0: /* macro */
3860	if (is_pair (car (SCHEME_V->code)))	3830	if (is_pair (car (SCHEME_V->code)))
3861	{	3831	{
3862	x = caar (SCHEME_V->code);	3832	x = caar (SCHEME_V->code);
…		…
3895	{	3865	{
3896	if (!is_pair (y = caar (x)))	3866	if (!is_pair (y = caar (x)))
3897	break;	3867	break;
3898		3868
3899	for (; y != NIL; y = cdr (y))	3869	for (; y != NIL; y = cdr (y))
3900	{
3901	if (eqv (car (y), SCHEME_V->value))	3870	if (eqv (car (y), SCHEME_V->value))
3902	break;	3871	break;
3903	}
3904		3872
3905	if (y != NIL)	3873	if (y != NIL)
3906	break;	3874	break;
3907	}	3875	}
3908		3876
…		…
3928	s_goto (OP_BEGIN);	3896	s_goto (OP_BEGIN);
3929	else	3897	else
3930	s_return (NIL);	3898	s_return (NIL);
3931		3899
3932	case OP_PAPPLY: /* apply */	3900	case OP_PAPPLY: /* apply */
3933	SCHEME_V->code = car (SCHEME_V->args);	3901	SCHEME_V->code = car (args);
3934	SCHEME_V->args = list_star (SCHEME_A_ cdr (SCHEME_V->args));	3902	SCHEME_V->args = list_star (SCHEME_A_ cdr (args));
3935	/*SCHEME_V->args = cadr(SCHEME_V->args); */	3903	/*SCHEME_V->args = cadr(args); */
3936	s_goto (OP_APPLY);	3904	s_goto (OP_APPLY);
3937		3905
3938	case OP_PEVAL: /* eval */	3906	case OP_PEVAL: /* eval */
3939	if (cdr (SCHEME_V->args) != NIL)	3907	if (cdr (args) != NIL)
3940	SCHEME_V->envir = cadr (SCHEME_V->args);	3908	SCHEME_V->envir = cadr (args);
3941		3909
3942	SCHEME_V->code = car (SCHEME_V->args);	3910	SCHEME_V->code = car (args);
3943	s_goto (OP_EVAL);	3911	s_goto (OP_EVAL);
3944		3912
3945	case OP_CONTINUATION: /* call-with-current-continuation */	3913	case OP_CONTINUATION: /* call-with-current-continuation */
3946	SCHEME_V->code = car (SCHEME_V->args);	3914	SCHEME_V->code = car (args);
3947	SCHEME_V->args = cons (mk_continuation (SCHEME_A_ ss_get_cont (SCHEME_A)), NIL);	3915	SCHEME_V->args = cons (mk_continuation (SCHEME_A_ ss_get_cont (SCHEME_A)), NIL);
3948	s_goto (OP_APPLY);	3916	s_goto (OP_APPLY);
3949	}	3917	}
3950		3918
3951	return S_T;	3919	abort ();
3952	}	3920	}
3953		3921
3954	static pointer	3922	static pointer
3955	opexe_2 (SCHEME_P_ enum scheme_opcodes op)	3923	opexe_2 (SCHEME_P_ enum scheme_opcodes op)
3956	{	3924	{
3957	pointer x;	3925	pointer args = SCHEME_V->args;
		3926	pointer x = car (args);
3958	num v;	3927	num v;
3959		3928
3960	#if USE_MATH	3929	#if USE_MATH
3961	RVALUE dd;	3930	RVALUE dd;
3962	#endif	3931	#endif
3963		3932
3964	switch (op)	3933	switch (op)
3965	{	3934	{
3966	#if USE_MATH	3935	#if USE_MATH
3967
3968	case OP_INEX2EX: /* inexact->exact */	3936	case OP_INEX2EX: /* inexact->exact */
3969	x = car (SCHEME_V->args);
3970
3971	if (num_is_integer (x))	3937	if (num_is_integer (x))
3972	s_return (x);	3938	s_return (x);
3973	else if (modf (rvalue_unchecked (x), &dd) == 0.0)	3939	else if (modf (rvalue_unchecked (x), &dd) == 0)
3974	s_return (mk_integer (SCHEME_A_ ivalue (x)));	3940	s_return (mk_integer (SCHEME_A_ ivalue (x)));
3975	else	3941	else
3976	Error_1 ("inexact->exact: not integral:", x);	3942	Error_1 ("inexact->exact: not integral:", x);
3977		3943
3978	case OP_EXP:
3979	x = car (SCHEME_V->args);
3980	s_return (mk_real (SCHEME_A_ exp (rvalue (x))));	3944	case OP_EXP: s_return (mk_real (SCHEME_A_ exp (rvalue (x))));
3981
3982	case OP_LOG:
3983	x = car (SCHEME_V->args);
3984	s_return (mk_real (SCHEME_A_ log (rvalue (x))));	3945	case OP_LOG: s_return (mk_real (SCHEME_A_ log (rvalue (x))));
3985
3986	case OP_SIN:
3987	x = car (SCHEME_V->args);
3988	s_return (mk_real (SCHEME_A_ sin (rvalue (x))));	3946	case OP_SIN: s_return (mk_real (SCHEME_A_ sin (rvalue (x))));
3989
3990	case OP_COS:
3991	x = car (SCHEME_V->args);
3992	s_return (mk_real (SCHEME_A_ cos (rvalue (x))));	3947	case OP_COS: s_return (mk_real (SCHEME_A_ cos (rvalue (x))));
3993
3994	case OP_TAN:
3995	x = car (SCHEME_V->args);
3996	s_return (mk_real (SCHEME_A_ tan (rvalue (x))));	3948	case OP_TAN: s_return (mk_real (SCHEME_A_ tan (rvalue (x))));
3997
3998	case OP_ASIN:
3999	x = car (SCHEME_V->args);
4000	s_return (mk_real (SCHEME_A_ asin (rvalue (x))));	3949	case OP_ASIN: s_return (mk_real (SCHEME_A_ asin (rvalue (x))));
4001
4002	case OP_ACOS:
4003	x = car (SCHEME_V->args);
4004	s_return (mk_real (SCHEME_A_ acos (rvalue (x))));	3950	case OP_ACOS: s_return (mk_real (SCHEME_A_ acos (rvalue (x))));
4005		3951
4006	case OP_ATAN:	3952	case OP_ATAN:
4007	x = car (SCHEME_V->args);
4008
4009	if (cdr (SCHEME_V->args) == NIL)	3953	if (cdr (args) == NIL)
4010	s_return (mk_real (SCHEME_A_ atan (rvalue (x))));	3954	s_return (mk_real (SCHEME_A_ atan (rvalue (x))));
4011	else	3955	else
4012	{	3956	{
4013	pointer y = cadr (SCHEME_V->args);	3957	pointer y = cadr (args);
4014
4015	s_return (mk_real (SCHEME_A_ atan2 (rvalue (x), rvalue (y))));	3958	s_return (mk_real (SCHEME_A_ atan2 (rvalue (x), rvalue (y))));
4016	}	3959	}
4017		3960
4018	case OP_SQRT:	3961	case OP_SQRT:
4019	x = car (SCHEME_V->args);
4020	s_return (mk_real (SCHEME_A_ sqrt (rvalue (x))));	3962	s_return (mk_real (SCHEME_A_ sqrt (rvalue (x))));
4021		3963
4022	case OP_EXPT:	3964	case OP_EXPT:
4023	{	3965	{
4024	RVALUE result;	3966	RVALUE result;
4025	int real_result = 1;	3967	int real_result = 1;
4026	pointer y = cadr (SCHEME_V->args);	3968	pointer y = cadr (args);
4027
4028	x = car (SCHEME_V->args);
4029		3969
4030	if (num_is_integer (x) && num_is_integer (y))	3970	if (num_is_integer (x) && num_is_integer (y))
4031	real_result = 0;	3971	real_result = 0;
4032		3972
4033	/* This 'if' is an R5RS compatibility fix. */	3973	/* This 'if' is an R5RS compatibility fix. */
4034	/* NOTE: Remove this 'if' fix for R6RS. */	3974	/* NOTE: Remove this 'if' fix for R6RS. */
4035	if (rvalue (x) == 0 && rvalue (y) < 0)	3975	if (rvalue (x) == 0 && rvalue (y) < 0)
4036	result = 0.0;	3976	result = 0;
4037	else	3977	else
4038	result = pow (rvalue (x), rvalue (y));	3978	result = pow (rvalue (x), rvalue (y));
4039		3979
4040	/* Before returning integer result make sure we can. */	3980	/* Before returning integer result make sure we can. */
4041	/* If the test fails, result is too big for integer. */	3981	/* If the test fails, result is too big for integer. */
4042	if (!real_result)	3982	if (!real_result)
4043	{	3983	{
4044	long result_as_long = (long) result;	3984	long result_as_long = result;
4045		3985
4046	if (result != (RVALUE) result_as_long)	3986	if (result != (RVALUE) result_as_long)
4047	real_result = 1;	3987	real_result = 1;
4048	}	3988	}
4049		3989
…		…
4051	s_return (mk_real (SCHEME_A_ result));	3991	s_return (mk_real (SCHEME_A_ result));
4052	else	3992	else
4053	s_return (mk_integer (SCHEME_A_ result));	3993	s_return (mk_integer (SCHEME_A_ result));
4054	}	3994	}
4055		3995
4056	case OP_FLOOR:
4057	x = car (SCHEME_V->args);
4058	s_return (mk_real (SCHEME_A_ floor (rvalue (x))));	3996	case OP_FLOOR: s_return (mk_real (SCHEME_A_ floor (rvalue (x))));
4059
4060	case OP_CEILING:
4061	x = car (SCHEME_V->args);
4062	s_return (mk_real (SCHEME_A_ ceil (rvalue (x))));	3997	case OP_CEILING: s_return (mk_real (SCHEME_A_ ceil (rvalue (x))));
4063		3998
4064	case OP_TRUNCATE:	3999	case OP_TRUNCATE:
4065	{	4000	{
4066	RVALUE rvalue_of_x;	4001	RVALUE rvalue_of_x;
4067		4002
4068	x = car (SCHEME_V->args);
4069	rvalue_of_x = rvalue (x);	4003	rvalue_of_x = rvalue (x);
4070		4004
4071	if (rvalue_of_x > 0)	4005	if (rvalue_of_x > 0)
4072	s_return (mk_real (SCHEME_A_ floor (rvalue_of_x)));	4006	s_return (mk_real (SCHEME_A_ floor (rvalue_of_x)));
4073	else	4007	else
4074	s_return (mk_real (SCHEME_A_ ceil (rvalue_of_x)));	4008	s_return (mk_real (SCHEME_A_ ceil (rvalue_of_x)));
4075	}	4009	}
4076		4010
4077	case OP_ROUND:	4011	case OP_ROUND:
4078	x = car (SCHEME_V->args);
4079
4080	if (num_is_integer (x))	4012	if (num_is_integer (x))
4081	s_return (x);	4013	s_return (x);
4082		4014
4083	s_return (mk_real (SCHEME_A_ round_per_R5RS (rvalue (x))));	4015	s_return (mk_real (SCHEME_A_ round_per_R5RS (rvalue (x))));
4084	#endif	4016	#endif
4085		4017
4086	case OP_ADD: /* + */	4018	case OP_ADD: /* + */
4087	v = num_zero;	4019	v = num_zero;
4088		4020
4089	for (x = SCHEME_V->args; x != NIL; x = cdr (x))	4021	for (x = args; x != NIL; x = cdr (x))
4090	v = num_op ('+', v, nvalue (car (x)));	4022	v = num_op ('+', v, nvalue (car (x)));
4091		4023
4092	s_return (mk_number (SCHEME_A_ v));	4024	s_return (mk_number (SCHEME_A_ v));
4093		4025
4094	case OP_MUL: /* * */	4026	case OP_MUL: /* * */
4095	v = num_one;	4027	v = num_one;
4096		4028
4097	for (x = SCHEME_V->args; x != NIL; x = cdr (x))	4029	for (x = args; x != NIL; x = cdr (x))
4098	v = num_op ('+', v, nvalue (car (x)));	4030	v = num_op ('+', v, nvalue (car (x)));
4099		4031
4100	s_return (mk_number (SCHEME_A_ v));	4032	s_return (mk_number (SCHEME_A_ v));
4101		4033
4102	case OP_SUB: /* - */	4034	case OP_SUB: /* - */
4103	if (cdr (SCHEME_V->args) == NIL)	4035	if (cdr (args) == NIL)
4104	{	4036	{
4105	x = SCHEME_V->args;	4037	x = args;
4106	v = num_zero;	4038	v = num_zero;
4107	}	4039	}
4108	else	4040	else
4109	{	4041	{
4110	x = cdr (SCHEME_V->args);	4042	x = cdr (args);
4111	v = nvalue (car (SCHEME_V->args));	4043	v = nvalue (car (args));
4112	}	4044	}
4113		4045
4114	for (; x != NIL; x = cdr (x))	4046	for (; x != NIL; x = cdr (x))
4115	v = num_op ('+', v, nvalue (car (x)));	4047	v = num_op ('+', v, nvalue (car (x)));
4116		4048
4117	s_return (mk_number (SCHEME_A_ v));	4049	s_return (mk_number (SCHEME_A_ v));
4118		4050
4119	case OP_DIV: /* / */	4051	case OP_DIV: /* / */
4120	if (cdr (SCHEME_V->args) == NIL)	4052	if (cdr (args) == NIL)
4121	{	4053	{
4122	x = SCHEME_V->args;	4054	x = args;
4123	v = num_one;	4055	v = num_one;
4124	}	4056	}
4125	else	4057	else
4126	{	4058	{
4127	x = cdr (SCHEME_V->args);	4059	x = cdr (args);
4128	v = nvalue (car (SCHEME_V->args));	4060	v = nvalue (car (args));
4129	}	4061	}
4130		4062
4131	for (; x != NIL; x = cdr (x))	4063	for (; x != NIL; x = cdr (x))
4132	{	4064	{
4133	if (!is_zero_rvalue (rvalue (car (x))))	4065	if (!is_zero_rvalue (rvalue (car (x))))
…		…
4137	}	4069	}
4138		4070
4139	s_return (mk_number (SCHEME_A_ v));	4071	s_return (mk_number (SCHEME_A_ v));
4140		4072
4141	case OP_INTDIV: /* quotient */	4073	case OP_INTDIV: /* quotient */
4142	if (cdr (SCHEME_V->args) == NIL)	4074	if (cdr (args) == NIL)
4143	{	4075	{
4144	x = SCHEME_V->args;	4076	x = args;
4145	v = num_one;	4077	v = num_one;
4146	}	4078	}
4147	else	4079	else
4148	{	4080	{
4149	x = cdr (SCHEME_V->args);	4081	x = cdr (args);
4150	v = nvalue (car (SCHEME_V->args));	4082	v = nvalue (car (args));
4151	}	4083	}
4152		4084
4153	for (; x != NIL; x = cdr (x))	4085	for (; x != NIL; x = cdr (x))
4154	{	4086	{
4155	if (ivalue (car (x)) != 0)	4087	if (ivalue (car (x)) != 0)
…		…
4159	}	4091	}
4160		4092
4161	s_return (mk_number (SCHEME_A_ v));	4093	s_return (mk_number (SCHEME_A_ v));
4162		4094
4163	case OP_REM: /* remainder */	4095	case OP_REM: /* remainder */
4164	v = nvalue (car (SCHEME_V->args));	4096	v = nvalue (x);
4165		4097
4166	if (ivalue (cadr (SCHEME_V->args)) != 0)	4098	if (ivalue (cadr (args)) != 0)
4167	v = num_rem (v, nvalue (cadr (SCHEME_V->args)));	4099	v = num_rem (v, nvalue (cadr (args)));
4168	else	4100	else
4169	Error_0 ("remainder: division by zero");	4101	Error_0 ("remainder: division by zero");
4170		4102
4171	s_return (mk_number (SCHEME_A_ v));	4103	s_return (mk_number (SCHEME_A_ v));
4172		4104
4173	case OP_MOD: /* modulo */	4105	case OP_MOD: /* modulo */
4174	v = nvalue (car (SCHEME_V->args));	4106	v = nvalue (x);
4175		4107
4176	if (ivalue (cadr (SCHEME_V->args)) != 0)	4108	if (ivalue (cadr (args)) != 0)
4177	v = num_mod (v, nvalue (cadr (SCHEME_V->args)));	4109	v = num_mod (v, nvalue (cadr (args)));
4178	else	4110	else
4179	Error_0 ("modulo: division by zero");	4111	Error_0 ("modulo: division by zero");
4180		4112
4181	s_return (mk_number (SCHEME_A_ v));	4113	s_return (mk_number (SCHEME_A_ v));
4182		4114
4183	case OP_CAR: /* car */	4115	case OP_CAR: /* car */
4184	s_return (caar (SCHEME_V->args));	4116	s_return (caar (args));
4185		4117
4186	case OP_CDR: /* cdr */	4118	case OP_CDR: /* cdr */
4187	s_return (cdar (SCHEME_V->args));	4119	s_return (cdar (args));
4188		4120
4189	case OP_CONS: /* cons */	4121	case OP_CONS: /* cons */
4190	set_cdr (SCHEME_V->args, cadr (SCHEME_V->args));	4122	set_cdr (args, cadr (args));
4191	s_return (SCHEME_V->args);	4123	s_return (args);
4192		4124
4193	case OP_SETCAR: /* set-car! */	4125	case OP_SETCAR: /* set-car! */
4194	if (!is_immutable (car (SCHEME_V->args)))	4126	if (!is_immutable (x))
4195	{	4127	{
4196	set_car (car (SCHEME_V->args), cadr (SCHEME_V->args));	4128	set_car (x, cadr (args));
4197	s_return (car (SCHEME_V->args));	4129	s_return (car (args));
4198	}	4130	}
4199	else	4131	else
4200	Error_0 ("set-car!: unable to alter immutable pair");	4132	Error_0 ("set-car!: unable to alter immutable pair");
4201		4133
4202	case OP_SETCDR: /* set-cdr! */	4134	case OP_SETCDR: /* set-cdr! */
4203	if (!is_immutable (car (SCHEME_V->args)))	4135	if (!is_immutable (x))
4204	{	4136	{
4205	set_cdr (car (SCHEME_V->args), cadr (SCHEME_V->args));	4137	set_cdr (x, cadr (args));
4206	s_return (car (SCHEME_V->args));	4138	s_return (car (args));
4207	}	4139	}
4208	else	4140	else
4209	Error_0 ("set-cdr!: unable to alter immutable pair");	4141	Error_0 ("set-cdr!: unable to alter immutable pair");
4210		4142
4211	case OP_CHAR2INT: /* char->integer */	4143	case OP_CHAR2INT: /* char->integer */
4212	s_return (mk_integer (SCHEME_A_ ivalue (car (SCHEME_V->args))));	4144	s_return (mk_integer (SCHEME_A_ ivalue (x)));
4213		4145
4214	case OP_INT2CHAR: /* integer->char */	4146	case OP_INT2CHAR: /* integer->char */
4215	s_return (mk_character (SCHEME_A_ ivalue (car (SCHEME_V->args))));	4147	s_return (mk_character (SCHEME_A_ ivalue (x)));
4216		4148
4217	case OP_CHARUPCASE:	4149	case OP_CHARUPCASE:
4218	{	4150	{
4219	unsigned char c = ivalue (car (SCHEME_V->args));	4151	unsigned char c = ivalue (x);
4220	c = toupper (c);	4152	c = toupper (c);
4221	s_return (mk_character (SCHEME_A_ c));	4153	s_return (mk_character (SCHEME_A_ c));
4222	}	4154	}
4223		4155
4224	case OP_CHARDNCASE:	4156	case OP_CHARDNCASE:
4225	{	4157	{
4226	unsigned char c = ivalue (car (SCHEME_V->args));	4158	unsigned char c = ivalue (x);
4227	c = tolower (c);	4159	c = tolower (c);
4228	s_return (mk_character (SCHEME_A_ c));	4160	s_return (mk_character (SCHEME_A_ c));
4229	}	4161	}
4230		4162
4231	case OP_STR2SYM: /* string->symbol */	4163	case OP_STR2SYM: /* string->symbol */
4232	s_return (mk_symbol (SCHEME_A_ strvalue (car (SCHEME_V->args))));	4164	s_return (mk_symbol (SCHEME_A_ strvalue (x)));
4233		4165
4234	case OP_STR2ATOM: /* string->atom */	4166	case OP_STR2ATOM: /* string->atom */
4235	{	4167	{
4236	char *s = strvalue (car (SCHEME_V->args));	4168	char *s = strvalue (x);
4237	long pf = 0;	4169	long pf = 0;
4238		4170
4239	if (cdr (SCHEME_V->args) != NIL)	4171	if (cdr (args) != NIL)
4240	{	4172	{
4241	/* we know cadr(SCHEME_V->args) is a natural number */	4173	/* we know cadr(args) is a natural number */
4242	/* see if it is 2, 8, 10, or 16, or error */	4174	/* see if it is 2, 8, 10, or 16, or error */
4243	pf = ivalue_unchecked (cadr (SCHEME_V->args));	4175	pf = ivalue_unchecked (cadr (args));
4244		4176
4245	if (pf == 16 || pf == 10 || pf == 8 || pf == 2)	4177	if (pf == 16 || pf == 10 || pf == 8 || pf == 2)
4246	{	4178	{
4247	/* base is OK */	4179	/* base is OK */
4248	}	4180	}
4249	else	4181	else
4250	pf = -1;	4182	pf = -1;
4251	}	4183	}
4252		4184
4253	if (pf < 0)	4185	if (pf < 0)
4254	Error_1 ("string->atom: bad base:", cadr (SCHEME_V->args));	4186	Error_1 ("string->atom: bad base:", cadr (args));
4255	else if (*s == '#') /* no use of base! */	4187	else if (*s == '#') /* no use of base! */
4256	s_return (mk_sharp_const (SCHEME_A_ s + 1));	4188	s_return (mk_sharp_const (SCHEME_A_ s + 1));
4257	else	4189	else
4258	{	4190	{
4259	if (pf == 0 || pf == 10)	4191	if (pf == 0 || pf == 10)
…		…
4270	}	4202	}
4271	}	4203	}
4272	}	4204	}
4273		4205
4274	case OP_SYM2STR: /* symbol->string */	4206	case OP_SYM2STR: /* symbol->string */
4275	x = mk_string (SCHEME_A_ symname (car (SCHEME_V->args)));	4207	x = mk_string (SCHEME_A_ symname (x));
4276	setimmutable (x);	4208	setimmutable (x);
4277	s_return (x);	4209	s_return (x);
4278		4210
4279	case OP_ATOM2STR: /* atom->string */	4211	case OP_ATOM2STR: /* atom->string */
4280	{	4212	{
4281	long pf = 0;	4213	long pf = 0;
4282		4214
4283	x = car (SCHEME_V->args);
4284
4285	if (cdr (SCHEME_V->args) != NIL)	4215	if (cdr (args) != NIL)
4286	{	4216	{
4287	/* we know cadr(SCHEME_V->args) is a natural number */	4217	/* we know cadr(args) is a natural number */
4288	/* see if it is 2, 8, 10, or 16, or error */	4218	/* see if it is 2, 8, 10, or 16, or error */
4289	pf = ivalue_unchecked (cadr (SCHEME_V->args));	4219	pf = ivalue_unchecked (cadr (args));
4290		4220
4291	if (is_number (x) && (pf == 16 || pf == 10 || pf == 8 || pf == 2))	4221	if (is_number (x) && (pf == 16 || pf == 10 || pf == 8 || pf == 2))
4292	{	4222	{
4293	/* base is OK */	4223	/* base is OK */
4294	}	4224	}
4295	else	4225	else
4296	pf = -1;	4226	pf = -1;
4297	}	4227	}
4298		4228
4299	if (pf < 0)	4229	if (pf < 0)
4300	Error_1 ("atom->string: bad base:", cadr (SCHEME_V->args));	4230	Error_1 ("atom->string: bad base:", cadr (args));
4301	else if (is_number (x) || is_character (x) || is_string (x) || is_symbol (x))	4231	else if (is_number (x) || is_character (x) || is_string (x) || is_symbol (x))
4302	{	4232	{
4303	char *p;	4233	char *p;
4304	int len;	4234	int len;
4305		4235
…		…
4313	case OP_MKSTRING: /* make-string */	4243	case OP_MKSTRING: /* make-string */
4314	{	4244	{
4315	int fill = ' ';	4245	int fill = ' ';
4316	int len;	4246	int len;
4317		4247
4318	len = ivalue (car (SCHEME_V->args));	4248	len = ivalue (x);
4319		4249
4320	if (cdr (SCHEME_V->args) != NIL)	4250	if (cdr (args) != NIL)
4321	fill = charvalue (cadr (SCHEME_V->args));	4251	fill = charvalue (cadr (args));
4322		4252
4323	s_return (mk_empty_string (SCHEME_A_ len, (char) fill));	4253	s_return (mk_empty_string (SCHEME_A_ len, fill));
4324	}	4254	}
4325		4255
4326	case OP_STRLEN: /* string-length */	4256	case OP_STRLEN: /* string-length */
4327	s_return (mk_integer (SCHEME_A_ strlength (car (SCHEME_V->args))));	4257	s_return (mk_integer (SCHEME_A_ strlength (x)));
4328		4258
4329	case OP_STRREF: /* string-ref */	4259	case OP_STRREF: /* string-ref */
4330	{	4260	{
4331	char *str;	4261	char *str;
4332	int index;	4262	int index;
4333		4263
4334	str = strvalue (car (SCHEME_V->args));	4264	str = strvalue (x);
4335		4265
4336	index = ivalue (cadr (SCHEME_V->args));	4266	index = ivalue (cadr (args));
4337		4267
4338	if (index >= strlength (car (SCHEME_V->args)))	4268	if (index >= strlength (x))
4339	Error_1 ("string-ref: out of bounds:", cadr (SCHEME_V->args));	4269	Error_1 ("string-ref: out of bounds:", cadr (args));
4340		4270
4341	s_return (mk_character (SCHEME_A_ ((unsigned char *) str)[index]));	4271	s_return (mk_character (SCHEME_A_ ((unsigned char *)str)[index]));
4342	}	4272	}
4343		4273
4344	case OP_STRSET: /* string-set! */	4274	case OP_STRSET: /* string-set! */
4345	{	4275	{
4346	char *str;	4276	char *str;
4347	int index;	4277	int index;
4348	int c;	4278	int c;
4349		4279
4350	if (is_immutable (car (SCHEME_V->args)))	4280	if (is_immutable (x))
4351	Error_1 ("string-set!: unable to alter immutable string:", car (SCHEME_V->args));	4281	Error_1 ("string-set!: unable to alter immutable string:", x);
4352		4282
4353	str = strvalue (car (SCHEME_V->args));	4283	str = strvalue (x);
4354		4284
4355	index = ivalue (cadr (SCHEME_V->args));	4285	index = ivalue (cadr (args));
4356		4286
4357	if (index >= strlength (car (SCHEME_V->args)))	4287	if (index >= strlength (x))
4358	Error_1 ("string-set!: out of bounds:", cadr (SCHEME_V->args));	4288	Error_1 ("string-set!: out of bounds:", cadr (args));
4359		4289
4360	c = charvalue (caddr (SCHEME_V->args));	4290	c = charvalue (caddr (args));
4361		4291
4362	str[index] = (char) c;	4292	str[index] = c;
4363	s_return (car (SCHEME_V->args));	4293	s_return (car (args));
4364	}	4294	}
4365		4295
4366	case OP_STRAPPEND: /* string-append */	4296	case OP_STRAPPEND: /* string-append */
4367	{	4297	{
4368	/* in 1.29 string-append was in Scheme in init.scm but was too slow */	4298	/* in 1.29 string-append was in Scheme in init.scm but was too slow */
4369	int len = 0;	4299	int len = 0;
4370	pointer newstr;	4300	pointer newstr;
4371	char *pos;	4301	char *pos;
4372		4302
4373	/* compute needed length for new string */	4303	/* compute needed length for new string */
4374	for (x = SCHEME_V->args; x != NIL; x = cdr (x))	4304	for (x = args; x != NIL; x = cdr (x))
4375	len += strlength (car (x));	4305	len += strlength (car (x));
4376		4306
4377	newstr = mk_empty_string (SCHEME_A_ len, ' ');	4307	newstr = mk_empty_string (SCHEME_A_ len, ' ');
4378		4308
4379	/* store the contents of the argument strings into the new string */	4309	/* store the contents of the argument strings into the new string */
4380	for (pos = strvalue (newstr), x = SCHEME_V->args; x != NIL; pos += strlength (car (x)), x = cdr (x))	4310	for (pos = strvalue (newstr), x = args; x != NIL; pos += strlength (car (x)), x = cdr (x))
4381	memcpy (pos, strvalue (car (x)), strlength (car (x)));	4311	memcpy (pos, strvalue (car (x)), strlength (car (x)));
4382		4312
4383	s_return (newstr);	4313	s_return (newstr);
4384	}	4314	}
4385		4315
…		…
4388	char *str;	4318	char *str;
4389	int index0;	4319	int index0;
4390	int index1;	4320	int index1;
4391	int len;	4321	int len;
4392		4322
4393	str = strvalue (car (SCHEME_V->args));	4323	str = strvalue (x);
4394		4324
4395	index0 = ivalue (cadr (SCHEME_V->args));	4325	index0 = ivalue (cadr (args));
4396		4326
4397	if (index0 > strlength (car (SCHEME_V->args)))	4327	if (index0 > strlength (x))
4398	Error_1 ("substring: start out of bounds:", cadr (SCHEME_V->args));	4328	Error_1 ("substring: start out of bounds:", cadr (args));
4399		4329
4400	if (cddr (SCHEME_V->args) != NIL)	4330	if (cddr (args) != NIL)
4401	{	4331	{
4402	index1 = ivalue (caddr (SCHEME_V->args));	4332	index1 = ivalue (caddr (args));
4403		4333
4404	if (index1 > strlength (car (SCHEME_V->args)) || index1 < index0)	4334	if (index1 > strlength (x) || index1 < index0)
4405	Error_1 ("substring: end out of bounds:", caddr (SCHEME_V->args));	4335	Error_1 ("substring: end out of bounds:", caddr (args));
4406	}	4336	}
4407	else	4337	else
4408	index1 = strlength (car (SCHEME_V->args));	4338	index1 = strlength (x);
4409		4339
4410	len = index1 - index0;	4340	len = index1 - index0;
4411	x = mk_empty_string (SCHEME_A_ len, ' ');	4341	x = mk_empty_string (SCHEME_A_ len, ' ');
4412	memcpy (strvalue (x), str + index0, len);	4342	memcpy (strvalue (x), str + index0, len);
4413	strvalue (x)[len] = 0;	4343	strvalue (x)[len] = 0;
…		…
4417		4347
4418	case OP_VECTOR: /* vector */	4348	case OP_VECTOR: /* vector */
4419	{	4349	{
4420	int i;	4350	int i;
4421	pointer vec;	4351	pointer vec;
4422	int len = list_length (SCHEME_A_ SCHEME_V->args);	4352	int len = list_length (SCHEME_A_ args);
4423		4353
4424	if (len < 0)	4354	if (len < 0)
4425	Error_1 ("vector: not a proper list:", SCHEME_V->args);	4355	Error_1 ("vector: not a proper list:", args);
4426		4356
4427	vec = mk_vector (SCHEME_A_ len);	4357	vec = mk_vector (SCHEME_A_ len);
4428		4358
4429	#if USE_ERROR_CHECKING	4359	#if USE_ERROR_CHECKING
4430	if (SCHEME_V->no_memory)	4360	if (SCHEME_V->no_memory)
4431	s_return (S_SINK);	4361	s_return (S_SINK);
4432	#endif	4362	#endif
4433		4363
4434	for (x = SCHEME_V->args, i = 0; is_pair (x); x = cdr (x), i++)	4364	for (x = args, i = 0; is_pair (x); x = cdr (x), i++)
4435	set_vector_elem (vec, i, car (x));	4365	set_vector_elem (vec, i, car (x));
4436		4366
4437	s_return (vec);	4367	s_return (vec);
4438	}	4368	}
4439		4369
…		…
4441	{	4371	{
4442	pointer fill = NIL;	4372	pointer fill = NIL;
4443	int len;	4373	int len;
4444	pointer vec;	4374	pointer vec;
4445		4375
4446	len = ivalue (car (SCHEME_V->args));	4376	len = ivalue (x);
4447		4377
4448	if (cdr (SCHEME_V->args) != NIL)	4378	if (cdr (args) != NIL)
4449	fill = cadr (SCHEME_V->args);	4379	fill = cadr (args);
4450		4380
4451	vec = mk_vector (SCHEME_A_ len);	4381	vec = mk_vector (SCHEME_A_ len);
4452		4382
4453	#if USE_ERROR_CHECKING	4383	#if USE_ERROR_CHECKING
4454	if (SCHEME_V->no_memory)	4384	if (SCHEME_V->no_memory)
…		…
4460		4390
4461	s_return (vec);	4391	s_return (vec);
4462	}	4392	}
4463		4393
4464	case OP_VECLEN: /* vector-length */	4394	case OP_VECLEN: /* vector-length */
4465	s_return (mk_integer (SCHEME_A_ veclength (car (SCHEME_V->args))));	4395	s_return (mk_integer (SCHEME_A_ veclength (x)));
4466		4396
4467	case OP_VECREF: /* vector-ref */	4397	case OP_VECREF: /* vector-ref */
4468	{	4398	{
4469	int index;	4399	int index;
4470		4400
4471	index = ivalue (cadr (SCHEME_V->args));	4401	index = ivalue (cadr (args));
4472		4402
4473	if (index >= veclength (car (SCHEME_V->args)) && USE_ERROR_CHECKING)	4403	if (index >= veclength (car (args)) && USE_ERROR_CHECKING)
4474	Error_1 ("vector-ref: out of bounds:", cadr (SCHEME_V->args));	4404	Error_1 ("vector-ref: out of bounds:", cadr (args));
4475		4405
4476	s_return (vector_elem (car (SCHEME_V->args), index));	4406	s_return (vector_elem (x, index));
4477	}	4407	}
4478		4408
4479	case OP_VECSET: /* vector-set! */	4409	case OP_VECSET: /* vector-set! */
4480	{	4410	{
4481	int index;	4411	int index;
4482		4412
4483	if (is_immutable (car (SCHEME_V->args)))	4413	if (is_immutable (x))
4484	Error_1 ("vector-set!: unable to alter immutable vector:", car (SCHEME_V->args));	4414	Error_1 ("vector-set!: unable to alter immutable vector:", x);
4485		4415
4486	index = ivalue (cadr (SCHEME_V->args));	4416	index = ivalue (cadr (args));
4487		4417
4488	if (index >= veclength (car (SCHEME_V->args)) && USE_ERROR_CHECKING)	4418	if (index >= veclength (car (args)) && USE_ERROR_CHECKING)
4489	Error_1 ("vector-set!: out of bounds:", cadr (SCHEME_V->args));	4419	Error_1 ("vector-set!: out of bounds:", cadr (args));
4490		4420
4491	set_vector_elem (car (SCHEME_V->args), index, caddr (SCHEME_V->args));	4421	set_vector_elem (x, index, caddr (args));
4492	s_return (car (SCHEME_V->args));	4422	s_return (x);
4493	}	4423	}
4494	}	4424	}
4495		4425
4496	return S_T;	4426	return S_T;
4497	}	4427	}
…		…
4549	}	4479	}
4550	}	4480	}
4551	}	4481	}
4552		4482
4553	static pointer	4483	static pointer
		4484	opexe_r (SCHEME_P_ enum scheme_opcodes op)
		4485	{
		4486	pointer x = SCHEME_V->args;
		4487
		4488	for (;;)
		4489	{
		4490	num v = nvalue (car (x));
		4491	x = cdr (x);
		4492
		4493	if (x == NIL)
		4494	break;
		4495
		4496	int r = num_cmp (v, nvalue (car (x)));
		4497
		4498	switch (op)
		4499	{
		4500	case OP_NUMEQ: r = r == 0; break;
		4501	case OP_LESS: r = r < 0; break;
		4502	case OP_GRE: r = r > 0; break;
		4503	case OP_LEQ: r = r <= 0; break;
		4504	case OP_GEQ: r = r >= 0; break;
		4505	}
		4506
		4507	if (!r)
		4508	s_return (S_F);
		4509	}
		4510
		4511	s_return (S_T);
		4512	}
		4513
		4514	static pointer
4554	opexe_3 (SCHEME_P_ enum scheme_opcodes op)	4515	opexe_3 (SCHEME_P_ enum scheme_opcodes op)
4555	{	4516	{
4556	pointer x;	4517	pointer args = SCHEME_V->args;
4557	num v;	4518	pointer a = car (args);
4558	int (*comp_func) (num, num);	4519	pointer d = cdr (args);
		4520	int r;
4559		4521
4560	switch (op)	4522	switch (op)
4561	{	4523	{
4562	case OP_NOT: /* not */	4524	case OP_NOT: /* not */ r = is_false (a) ; break;
4563	s_retbool (is_false (car (SCHEME_V->args)));	4525	case OP_BOOLP: /* boolean? */ r = a == S_F || a == S_T; break;
		4526	case OP_EOFOBJP: /* eof-object? */ r = a == S_EOF ; break;
		4527	case OP_NULLP: /* null? */ r = a == NIL ; break;
		4528	case OP_SYMBOLP: /* symbol? */ r = is_symbol (a) ; break;
		4529	case OP_NUMBERP: /* number? */ r = is_number (a) ; break;
		4530	case OP_STRINGP: /* string? */ r = is_string (a) ; break;
		4531	case OP_INTEGERP: /* integer? */ r = is_integer (a) ; break;
		4532	case OP_REALP: /* real? */ r = is_number (a) ; break; /* all numbers are real */
		4533	case OP_CHARP: /* char? */ r = is_character (a) ; break;
4564		4534
4565	case OP_BOOLP: /* boolean? */
4566	s_retbool (car (SCHEME_V->args) == S_F || car (SCHEME_V->args) == S_T);
4567
4568	case OP_EOFOBJP: /* boolean? */
4569	s_retbool (car (SCHEME_V->args) == S_EOF);
4570
4571	case OP_NULLP: /* null? */
4572	s_retbool (car (SCHEME_V->args) == NIL);
4573
4574	case OP_NUMEQ: /* = */
4575	case OP_LESS: /* < */
4576	case OP_GRE: /* > */
4577	case OP_LEQ: /* <= */
4578	case OP_GEQ: /* >= */
4579	switch (op)
4580	{
4581	case OP_NUMEQ:
4582	comp_func = num_eq;
4583	break;
4584
4585	case OP_LESS:
4586	comp_func = num_lt;
4587	break;
4588
4589	case OP_GRE:
4590	comp_func = num_gt;
4591	break;
4592
4593	case OP_LEQ:
4594	comp_func = num_le;
4595	break;
4596
4597	case OP_GEQ:
4598	comp_func = num_ge;
4599	break;
4600	}
4601
4602	x = SCHEME_V->args;
4603	v = nvalue (car (x));
4604	x = cdr (x);
4605
4606	for (; x != NIL; x = cdr (x))
4607	{
4608	if (!comp_func (v, nvalue (car (x))))
4609	s_retbool (0);
4610
4611	v = nvalue (car (x));
4612	}
4613
4614	s_retbool (1);
4615
4616	case OP_SYMBOLP: /* symbol? */
4617	s_retbool (is_symbol (car (SCHEME_V->args)));
4618
4619	case OP_NUMBERP: /* number? */
4620	s_retbool (is_number (car (SCHEME_V->args)));
4621
4622	case OP_STRINGP: /* string? */
4623	s_retbool (is_string (car (SCHEME_V->args)));
4624
4625	case OP_INTEGERP: /* integer? */
4626	s_retbool (is_integer (car (SCHEME_V->args)));
4627
4628	case OP_REALP: /* real? */
4629	s_retbool (is_number (car (SCHEME_V->args))); /* All numbers are real */
4630
4631	case OP_CHARP: /* char? */
4632	s_retbool (is_character (car (SCHEME_V->args)));
4633	#if USE_CHAR_CLASSIFIERS	4535	#if USE_CHAR_CLASSIFIERS
4634
4635	case OP_CHARAP: /* char-alphabetic? */	4536	case OP_CHARAP: /* char-alphabetic? */ r = Cisalpha (ivalue (a)); break;
4636	s_retbool (Cisalpha (ivalue (car (SCHEME_V->args))));	4537	case OP_CHARNP: /* char-numeric? */ r = Cisdigit (ivalue (a)); break;
4637
4638	case OP_CHARNP: /* char-numeric? */
4639	s_retbool (Cisdigit (ivalue (car (SCHEME_V->args))));
4640
4641	case OP_CHARWP: /* char-whitespace? */	4538	case OP_CHARWP: /* char-whitespace? */ r = Cisspace (ivalue (a)); break;
4642	s_retbool (Cisspace (ivalue (car (SCHEME_V->args))));
4643
4644	case OP_CHARUP: /* char-upper-case? */	4539	case OP_CHARUP: /* char-upper-case? */ r = Cisupper (ivalue (a)); break;
4645	s_retbool (Cisupper (ivalue (car (SCHEME_V->args))));
4646
4647	case OP_CHARLP: /* char-lower-case? */	4540	case OP_CHARLP: /* char-lower-case? */ r = Cislower (ivalue (a)); break;
4648	s_retbool (Cislower (ivalue (car (SCHEME_V->args))));
4649	#endif	4541	#endif
		4542
4650	#if USE_PORTS	4543	#if USE_PORTS
4651		4544	case OP_PORTP: /* port? */ r = is_port (a) ; break;
4652	case OP_PORTP: /* port? */
4653	s_retbool (is_port (car (SCHEME_V->args)));
4654
4655	case OP_INPORTP: /* input-port? */	4545	case OP_INPORTP: /* input-port? */ r = is_inport (a) ; break;
4656	s_retbool (is_inport (car (SCHEME_V->args)));
4657
4658	case OP_OUTPORTP: /* output-port? */	4546	case OP_OUTPORTP: /* output-port? */ r = is_outport (a); break;
4659	s_retbool (is_outport (car (SCHEME_V->args)));
4660	#endif	4547	#endif
4661		4548
4662	case OP_PROCP: /* procedure? */	4549	case OP_PROCP: /* procedure? */
4663		4550
4664	/*--	4551	/*--
4665	* continuation should be procedure by the example	4552	* continuation should be procedure by the example
4666	* (call-with-current-continuation procedure?) ==> #t	4553	* (call-with-current-continuation procedure?) ==> #t
4667	* in R^3 report sec. 6.9	4554	* in R^3 report sec. 6.9
4668	*/	4555	*/
4669	s_retbool (is_proc (car (SCHEME_V->args)) || is_closure (car (SCHEME_V->args))	4556	r = is_proc (a) || is_closure (a) || is_continuation (a) || is_foreign (a);
4670	|| is_continuation (car (SCHEME_V->args)) || is_foreign (car (SCHEME_V->args)));	4557	break;
4671		4558
4672	case OP_PAIRP: /* pair? */	4559	case OP_PAIRP: /* pair? */ r = is_pair (a) ; break;
4673	s_retbool (is_pair (car (SCHEME_V->args)));	4560	case OP_LISTP: /* list? */ r = list_length (SCHEME_A_ a) >= 0; break;
4674		4561	case OP_ENVP: /* environment? */ r = is_environment (a) ; break;
4675	case OP_LISTP: /* list? */	4562	case OP_VECTORP: /* vector? */ r = is_vector (a) ; break;
4676	s_retbool (list_length (SCHEME_A_ car (SCHEME_V->args)) >= 0);	4563	case OP_EQ: /* eq? */ r = a == cadr (args) ; break;
4677		4564	case OP_EQV: /* eqv? */ r = eqv (a, cadr (args)) ; break;
4678	case OP_ENVP: /* environment? */
4679	s_retbool (is_environment (car (SCHEME_V->args)));
4680
4681	case OP_VECTORP: /* vector? */
4682	s_retbool (is_vector (car (SCHEME_V->args)));
4683
4684	case OP_EQ: /* eq? */
4685	s_retbool (car (SCHEME_V->args) == cadr (SCHEME_V->args));
4686
4687	case OP_EQV: /* eqv? */
4688	s_retbool (eqv (car (SCHEME_V->args), cadr (SCHEME_V->args)));
4689	}	4565	}
4690		4566
4691	return S_T;	4567	s_retbool (r);
4692	}	4568	}
4693		4569
4694	static pointer	4570	static pointer
4695	opexe_4 (SCHEME_P_ enum scheme_opcodes op)	4571	opexe_4 (SCHEME_P_ enum scheme_opcodes op)
4696	{	4572	{
		4573	pointer args = SCHEME_V->args;
		4574	pointer a = car (args);
4697	pointer x, y;	4575	pointer x, y;
4698		4576
4699	switch (op)	4577	switch (op)
4700	{	4578	{
4701	case OP_FORCE: /* force */	4579	case OP_FORCE: /* force */
4702	SCHEME_V->code = car (SCHEME_V->args);	4580	SCHEME_V->code = a;
4703		4581
4704	if (is_promise (SCHEME_V->code))	4582	if (is_promise (SCHEME_V->code))
4705	{	4583	{
4706	/* Should change type to closure here */	4584	/* Should change type to closure here */
4707	s_save (SCHEME_A_ OP_SAVE_FORCED, NIL, SCHEME_V->code);	4585	s_save (SCHEME_A_ OP_SAVE_FORCED, NIL, SCHEME_V->code);
…		…
4728	s_save (SCHEME_A_ OP_SET_OUTPORT, x, NIL);	4606	s_save (SCHEME_A_ OP_SET_OUTPORT, x, NIL);
4729	SCHEME_V->outport = cadr (SCHEME_V->args);	4607	SCHEME_V->outport = cadr (SCHEME_V->args);
4730	}	4608	}
4731	}	4609	}
4732		4610
4733	SCHEME_V->args = car (SCHEME_V->args);	4611	SCHEME_V->args = a;
4734		4612
4735	if (op == OP_WRITE)	4613	if (op == OP_WRITE)
4736	SCHEME_V->print_flag = 1;	4614	SCHEME_V->print_flag = 1;
4737	else	4615	else
4738	SCHEME_V->print_flag = 0;	4616	SCHEME_V->print_flag = 0;
4739		4617
4740	s_goto (OP_P0LIST);	4618	s_goto (OP_P0LIST);
4741		4619
4742	case OP_NEWLINE: /* newline */	4620	case OP_NEWLINE: /* newline */
4743	if (is_pair (SCHEME_V->args))	4621	if (is_pair (args))
4744	{	4622	{
4745	if (car (SCHEME_V->args) != SCHEME_V->outport)	4623	if (a != SCHEME_V->outport)
4746	{	4624	{
4747	x = cons (SCHEME_V->outport, NIL);	4625	x = cons (SCHEME_V->outport, NIL);
4748	s_save (SCHEME_A_ OP_SET_OUTPORT, x, NIL);	4626	s_save (SCHEME_A_ OP_SET_OUTPORT, x, NIL);
4749	SCHEME_V->outport = car (SCHEME_V->args);	4627	SCHEME_V->outport = a;
4750	}	4628	}
4751	}	4629	}
4752		4630
4753	putstr (SCHEME_A_ "\n");	4631	putstr (SCHEME_A_ "\n");
4754	s_return (S_T);	4632	s_return (S_T);
4755	#endif	4633	#endif
4756		4634
4757	case OP_ERR0: /* error */	4635	case OP_ERR0: /* error */
4758	SCHEME_V->retcode = -1;	4636	SCHEME_V->retcode = -1;
4759		4637
4760	if (!is_string (car (SCHEME_V->args)))	4638	if (!is_string (a))
4761	{	4639	{
4762	SCHEME_V->args = cons (mk_string (SCHEME_A_ " -- "), SCHEME_V->args);	4640	args = cons (mk_string (SCHEME_A_ " -- "), args);
4763	setimmutable (car (SCHEME_V->args));	4641	setimmutable (car (args));
4764	}	4642	}
4765		4643
4766	putstr (SCHEME_A_ "Error: ");	4644	putstr (SCHEME_A_ "Error: ");
4767	putstr (SCHEME_A_ strvalue (car (SCHEME_V->args)));	4645	putstr (SCHEME_A_ strvalue (car (args)));
4768	SCHEME_V->args = cdr (SCHEME_V->args);	4646	SCHEME_V->args = cdr (args);
4769	s_goto (OP_ERR1);	4647	s_goto (OP_ERR1);
4770		4648
4771	case OP_ERR1: /* error */	4649	case OP_ERR1: /* error */
4772	putstr (SCHEME_A_ " ");	4650	putstr (SCHEME_A_ " ");
4773		4651
4774	if (SCHEME_V->args != NIL)	4652	if (args != NIL)
4775	{	4653	{
4776	s_save (SCHEME_A_ OP_ERR1, cdr (SCHEME_V->args), NIL);	4654	s_save (SCHEME_A_ OP_ERR1, cdr (args), NIL);
4777	SCHEME_V->args = car (SCHEME_V->args);	4655	SCHEME_V->args = a;
4778	SCHEME_V->print_flag = 1;	4656	SCHEME_V->print_flag = 1;
4779	s_goto (OP_P0LIST);	4657	s_goto (OP_P0LIST);
4780	}	4658	}
4781	else	4659	else
4782	{	4660	{
…		…
4787	else	4665	else
4788	return NIL;	4666	return NIL;
4789	}	4667	}
4790		4668
4791	case OP_REVERSE: /* reverse */	4669	case OP_REVERSE: /* reverse */
4792	s_return (reverse (SCHEME_A_ car (SCHEME_V->args)));	4670	s_return (reverse (SCHEME_A_ a));
4793		4671
4794	case OP_LIST_STAR: /* list* */	4672	case OP_LIST_STAR: /* list* */
4795	s_return (list_star (SCHEME_A_ SCHEME_V->args));	4673	s_return (list_star (SCHEME_A_ SCHEME_V->args));
4796		4674
4797	case OP_APPEND: /* append */	4675	case OP_APPEND: /* append */
4798	x = NIL;	4676	x = NIL;
4799	y = SCHEME_V->args;	4677	y = args;
4800		4678
4801	if (y == x)	4679	if (y == x)
4802	s_return (x);	4680	s_return (x);
4803		4681
4804	/* cdr() in the while condition is not a typo. If car() */	4682	/* cdr() in the while condition is not a typo. If car() */
…		…
4815	s_return (reverse_in_place (SCHEME_A_ car (y), x));	4693	s_return (reverse_in_place (SCHEME_A_ car (y), x));
4816		4694
4817	#if USE_PLIST	4695	#if USE_PLIST
4818		4696
4819	case OP_PUT: /* put */	4697	case OP_PUT: /* put */
4820	if (!hasprop (car (SCHEME_V->args)) || !hasprop (cadr (SCHEME_V->args)))	4698	if (!hasprop (a) || !hasprop (cadr (args)))
4821	Error_0 ("illegal use of put");	4699	Error_0 ("illegal use of put");
4822		4700
4823	for (x = symprop (car (SCHEME_V->args)), y = cadr (SCHEME_V->args); x != NIL; x = cdr (x))	4701	for (x = symprop (a), y = cadr (args); x != NIL; x = cdr (x))
4824	{	4702	{
4825	if (caar (x) == y)	4703	if (caar (x) == y)
4826	break;	4704	break;
4827	}	4705	}
4828		4706
4829	if (x != NIL)	4707	if (x != NIL)
4830	cdar (x) = caddr (SCHEME_V->args);	4708	cdar (x) = caddr (args);
4831	else	4709	else
4832	symprop (car (SCHEME_V->args)) = cons (cons (y, caddr (SCHEME_V->args)), symprop (car (SCHEME_V->args)));	4710	symprop (a) = cons (cons (y, caddr (args)), symprop (a));
4833		4711
4834	s_return (S_T);	4712	s_return (S_T);
4835		4713
4836	case OP_GET: /* get */	4714	case OP_GET: /* get */
4837	if (!hasprop (car (SCHEME_V->args)) || !hasprop (cadr (SCHEME_V->args)))	4715	if (!hasprop (a) || !hasprop (cadr (args)))
4838	Error_0 ("illegal use of get");	4716	Error_0 ("illegal use of get");
4839		4717
4840	for (x = symprop (car (SCHEME_V->args)), y = cadr (SCHEME_V->args); x != NIL; x = cdr (x))	4718	for (x = symprop (a), y = cadr (args); x != NIL; x = cdr (x))
4841	if (caar (x) == y)	4719	if (caar (x) == y)
4842	break;	4720	break;
4843		4721
4844	if (x != NIL)	4722	if (x != NIL)
4845	s_return (cdar (x));	4723	s_return (cdar (x));
…		…
4847	s_return (NIL);	4725	s_return (NIL);
4848		4726
4849	#endif /* USE_PLIST */	4727	#endif /* USE_PLIST */
4850		4728
4851	case OP_QUIT: /* quit */	4729	case OP_QUIT: /* quit */
4852	if (is_pair (SCHEME_V->args))	4730	if (is_pair (args))
4853	SCHEME_V->retcode = ivalue (car (SCHEME_V->args));	4731	SCHEME_V->retcode = ivalue (a);
4854		4732
4855	return NIL;	4733	return NIL;
4856		4734
4857	case OP_GC: /* gc */	4735	case OP_GC: /* gc */
4858	gc (SCHEME_A_ NIL, NIL);	4736	gc (SCHEME_A_ NIL, NIL);
…		…
4860		4738
4861	case OP_GCVERB: /* gc-verbose */	4739	case OP_GCVERB: /* gc-verbose */
4862	{	4740	{
4863	int was = SCHEME_V->gc_verbose;	4741	int was = SCHEME_V->gc_verbose;
4864		4742
4865	SCHEME_V->gc_verbose = (car (SCHEME_V->args) != S_F);	4743	SCHEME_V->gc_verbose = (a != S_F);
4866	s_retbool (was);	4744	s_retbool (was);
4867	}	4745	}
4868		4746
4869	case OP_NEWSEGMENT: /* new-segment */	4747	case OP_NEWSEGMENT: /* new-segment */
4870	if (!is_pair (SCHEME_V->args) || !is_number (car (SCHEME_V->args)))	4748	if (!is_pair (args) || !is_number (a))
4871	Error_0 ("new-segment: argument must be a number");	4749	Error_0 ("new-segment: argument must be a number");
4872		4750
4873	alloc_cellseg (SCHEME_A_ (int)ivalue (car (SCHEME_V->args)));	4751	alloc_cellseg (SCHEME_A_ (int)ivalue (a));
4874		4752
4875	s_return (S_T);	4753	s_return (S_T);
4876		4754
4877	case OP_OBLIST: /* oblist */	4755	case OP_OBLIST: /* oblist */
4878	s_return (oblist_all_symbols (SCHEME_A));	4756	s_return (oblist_all_symbols (SCHEME_A));
…		…
4905	case OP_OPEN_INOUTFILE:	4783	case OP_OPEN_INOUTFILE:
4906	prop = port_input | port_output;	4784	prop = port_input | port_output;
4907	break;	4785	break;
4908	}	4786	}
4909		4787
4910	p = port_from_filename (SCHEME_A_ strvalue (car (SCHEME_V->args)), prop);	4788	p = port_from_filename (SCHEME_A_ strvalue (a), prop);
4911		4789
4912	if (p == NIL)	4790	if (p == NIL)
4913	s_return (S_F);	4791	s_return (S_F);
4914		4792
4915	s_return (p);	4793	s_return (p);
…		…
4932	case OP_OPEN_INOUTSTRING:	4810	case OP_OPEN_INOUTSTRING:
4933	prop = port_input | port_output;	4811	prop = port_input | port_output;
4934	break;	4812	break;
4935	}	4813	}
4936		4814
4937	p = port_from_string (SCHEME_A_ strvalue (car (SCHEME_V->args)),	4815	p = port_from_string (SCHEME_A_ strvalue (a),
4938	strvalue (car (SCHEME_V->args)) + strlength (car (SCHEME_V->args)), prop);	4816	strvalue (a) + strlength (a), prop);
4939		4817
4940	if (p == NIL)	4818	if (p == NIL)
4941	s_return (S_F);	4819	s_return (S_F);
4942		4820
4943	s_return (p);	4821	s_return (p);
…		…
4945		4823
4946	case OP_OPEN_OUTSTRING: /* open-output-string */	4824	case OP_OPEN_OUTSTRING: /* open-output-string */
4947	{	4825	{
4948	pointer p;	4826	pointer p;
4949		4827
4950	if (car (SCHEME_V->args) == NIL)	4828	if (a == NIL)
4951	{	4829	{
4952	p = port_from_scratch (SCHEME_A);	4830	p = port_from_scratch (SCHEME_A);
4953		4831
4954	if (p == NIL)	4832	if (p == NIL)
4955	s_return (S_F);	4833	s_return (S_F);
4956	}	4834	}
4957	else	4835	else
4958	{	4836	{
4959	p = port_from_string (SCHEME_A_ strvalue (car (SCHEME_V->args)),	4837	p = port_from_string (SCHEME_A_ strvalue (a),
4960	strvalue (car (SCHEME_V->args)) + strlength (car (SCHEME_V->args)), port_output);	4838	strvalue (a) + strlength (a), port_output);
4961		4839
4962	if (p == NIL)	4840	if (p == NIL)
4963	s_return (S_F);	4841	s_return (S_F);
4964	}	4842	}
4965		4843
…		…
4968		4846
4969	case OP_GET_OUTSTRING: /* get-output-string */	4847	case OP_GET_OUTSTRING: /* get-output-string */
4970	{	4848	{
4971	port *p;	4849	port *p;
4972		4850
4973	if ((p = car (SCHEME_V->args)->object.port)->kind & port_string)	4851	if ((p = a->object.port)->kind & port_string)
4974	{	4852	{
4975	off_t size;	4853	off_t size;
4976	char *str;	4854	char *str;
4977		4855
4978	size = p->rep.string.curr - p->rep.string.start + 1;	4856	size = p->rep.string.curr - p->rep.string.start + 1;
…		…
4994	}	4872	}
4995		4873
4996	# endif	4874	# endif
4997		4875
4998	case OP_CLOSE_INPORT: /* close-input-port */	4876	case OP_CLOSE_INPORT: /* close-input-port */
4999	port_close (SCHEME_A_ car (SCHEME_V->args), port_input);	4877	port_close (SCHEME_A_ a, port_input);
5000	s_return (S_T);	4878	s_return (S_T);
5001		4879
5002	case OP_CLOSE_OUTPORT: /* close-output-port */	4880	case OP_CLOSE_OUTPORT: /* close-output-port */
5003	port_close (SCHEME_A_ car (SCHEME_V->args), port_output);	4881	port_close (SCHEME_A_ a, port_output);
5004	s_return (S_T);	4882	s_return (S_T);
5005	#endif	4883	#endif
5006		4884
5007	case OP_INT_ENV: /* interaction-environment */	4885	case OP_INT_ENV: /* interaction-environment */
5008	s_return (SCHEME_V->global_env);	4886	s_return (SCHEME_V->global_env);
…		…
5010	case OP_CURR_ENV: /* current-environment */	4888	case OP_CURR_ENV: /* current-environment */
5011	s_return (SCHEME_V->envir);	4889	s_return (SCHEME_V->envir);
5012		4890
5013	}	4891	}
5014		4892
5015	return S_T;	4893	abort ();
5016	}	4894	}
5017		4895
5018	static pointer	4896	static pointer
5019	opexe_5 (SCHEME_P_ enum scheme_opcodes op)	4897	opexe_5 (SCHEME_P_ enum scheme_opcodes op)
5020	{	4898	{
…		…
5359	s_goto (OP_P0LIST);	5237	s_goto (OP_P0LIST);
5360	}	5238	}
5361	}	5239	}
5362	}	5240	}
5363		5241
5364	return S_T;	5242	abort ();
5365	}	5243	}
5366		5244
5367	static pointer	5245	static pointer
5368	opexe_6 (SCHEME_P_ enum scheme_opcodes op)	5246	opexe_6 (SCHEME_P_ enum scheme_opcodes op)
5369	{	5247	{
…		…
5420		5298
5421	case OP_MACROP: /* macro? */	5299	case OP_MACROP: /* macro? */
5422	s_retbool (is_macro (car (SCHEME_V->args)));	5300	s_retbool (is_macro (car (SCHEME_V->args)));
5423	}	5301	}
5424		5302
5425	return S_T; /* NOTREACHED */	5303	abort ();
5426	}	5304	}
5427		5305
5428	typedef pointer (*dispatch_func) (SCHEME_P_ enum scheme_opcodes);	5306	typedef pointer (*dispatch_func) (SCHEME_P_ enum scheme_opcodes);
5429		5307
5430	typedef int (*test_predicate) (pointer);	5308	typedef int (*test_predicate) (pointer);
…		…
5531	{	5409	{
5532	ok = 0;	5410	ok = 0;
5533	snprintf (msg, STRBUFFSIZE, "%s: needs%s %d argument(s)",	5411	snprintf (msg, STRBUFFSIZE, "%s: needs%s %d argument(s)",
5534	pcd->name, pcd->min_arity == pcd->max_arity ? "" : " at least", pcd->min_arity);	5412	pcd->name, pcd->min_arity == pcd->max_arity ? "" : " at least", pcd->min_arity);
5535	}	5413	}
5536	else if (ecb_excpect_false (n > pcd->max_arity))	5414	else if (ecb_expect_false (n > pcd->max_arity))
5537	{	5415	{
5538	ok = 0;	5416	ok = 0;
5539	snprintf (msg, STRBUFFSIZE, "%s: needs%s %d argument(s)",	5417	snprintf (msg, STRBUFFSIZE, "%s: needs%s %d argument(s)",
5540	pcd->name, pcd->min_arity == pcd->max_arity ? "" : " at most", pcd->max_arity);	5418	pcd->name, pcd->min_arity == pcd->max_arity ? "" : " at most", pcd->max_arity);
5541	}	5419	}
…		…
5952	{	5830	{
5953	dump_stack_reset (SCHEME_A);	5831	dump_stack_reset (SCHEME_A);
5954	SCHEME_V->envir = SCHEME_V->global_env;	5832	SCHEME_V->envir = SCHEME_V->global_env;
5955	SCHEME_V->file_i = 0;	5833	SCHEME_V->file_i = 0;
5956	SCHEME_V->load_stack[0].kind = port_input | port_string;	5834	SCHEME_V->load_stack[0].kind = port_input | port_string;
5957	SCHEME_V->load_stack[0].rep.string.start = (char *) cmd; /* This func respects const */	5835	SCHEME_V->load_stack[0].rep.string.start = (char *)cmd; /* This func respects const */
5958	SCHEME_V->load_stack[0].rep.string.past_the_end = (char *) cmd + strlen (cmd);	5836	SCHEME_V->load_stack[0].rep.string.past_the_end = (char *)cmd + strlen (cmd);
5959	SCHEME_V->load_stack[0].rep.string.curr = (char *) cmd;	5837	SCHEME_V->load_stack[0].rep.string.curr = (char *)cmd;
5960	#if USE_PORTS	5838	#if USE_PORTS
5961	SCHEME_V->loadport = mk_port (SCHEME_A_ SCHEME_V->load_stack);	5839	SCHEME_V->loadport = mk_port (SCHEME_A_ SCHEME_V->load_stack);
5962	#endif	5840	#endif
5963	SCHEME_V->retcode = 0;	5841	SCHEME_V->retcode = 0;
5964	SCHEME_V->interactive_repl = 0;	5842	SCHEME_V->interactive_repl = 0;

Diff Legend

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