Context Navigation

← Previous Change
Next Change →

eval.c

Timestamp:

06/20/06 05:09:27 (3 years ago)

Author:

krobillard

Message:

Thune - Major improvement to the handling of local function values.
Locals can now be passed to inner functions and caught when returned.
Functions are no longer tied to the thread which created them.

The localArgBlk has been eliminated and locals are now stored on the stack.
To accomodate this, the data stack is now separate from the control stack
and grows upwards. This also means that functions can no longer access the
stack below the function call. A limit of one returned value is in place.

To regain full stack usage, locals could be stored on the control stack.
The only downside would be an extra copy of arguments from the data to
the control stack.

ur_wordCell() is now a function rather than a macro.

uc_do() has been merged into ur_eval() and 'do is now implemented as an opcode.

. & .s now use uc_console_out() rather than dprint.

Files:

: 1 modified

trunk/thune/eval.c (modified) (33 diffs)

Legend:

: Unmodified
: Added
: Removed

trunk/thune/eval.c

r186	r187
23	23	#include "urlan_atoms.h"
24	24	#include "internal.h"
	25
	26
	27	extern void uc_console_out( UThread, UCell );
25	28
26	29
…	…
69	72
70	73	#define PUSHC_FUNC(bod,sig,lpos,varc) \
71		UR_TOC->func.code = CC_FUNC; \
72		UR_TOC->func.~~argc~~ = varc; \
73		UR_TOC->func.bodyN = bod; \
74		UR_TOC->func.sigN = sig; \
75		UR_TOC->func.lpos = lpos; \
	74	UR_TOC->func.code = CC_FUNC; \
	75	UR_TOC->func.locals = varc; \
	76	UR_TOC->func.bodyN = bod; \
	77	UR_TOC->func.sigN = sig; \
	78	UR_TOC->func.lpos = lpos; \
76	79	UR_C_GROW
77	80
78		#define POPC_FUNC~~(lpos,varc)~~ \
79		~~varc = UR_TOC->func.argc;~~ \
80		~~lpos = UR_TOC->func.lpos~~; \
	81	#define POPC_FUNC \
	82	if( UR_TOC->func.locals ) \
	83	UR_S_DROPN( UR_TOC->func.locals ); \
81	84	UR_C_DEC
82	85
…	…
141	144
142	145
143		void ur_probe( UCell* cell )
144		{
145		UString str;
146
147		ur_arrayInit( &str, 1, 0 );
148		ur_toStr( cell, &str, 0 );
149		if( str.used )
150		{
151		UString* sp = &str;
152		ur_termCStr( sp );
153
154		dprint( str.ptr.c );
155		dprint( "\n" );
156		}
157		ur_arrayFree( &str );
158		}
159
160
161		static void ur_makeProc( UThread* ur_thread )
162		{
163		UCell* tos = UR_TOS;
164		if( ur_is(tos, UT_BLOCK) )
165		{
166		UIndex blkN;
167
168		blkN = tos->series.n;
169		ur_initType( tos, UT_FUNCTION );
170		// localArgs cleared by ur_initType().
171		tos->func.bodyN = blkN;
172		tos->func.closureN = 0;
173		tos->func.sigN = 0;
174		}
175		//else error
176		}
	146	#if 0
	147	// (body -- func)
	148	UR_CALL( ur_makeProc )
	149	{
	150	UIndex blkN;
	151	UR_CALL_UNUSED_TH
	152
	153	blkN = tos->series.n;
	154	ur_initType( tos, UT_FUNCTION );
	155	// localArgs & localVars cleared by ur_initType().
	156	tos->func.bodyN = blkN;
	157	tos->func.closureN = 0;
	158	tos->func.sigN = 0;
	159	}
	160	#endif
177	161
178	162
…	…
223	207	UCell* val;
224	208
225		ur_wordCell( sel, blk, val );
	209	val = ur_wordCell( ur_thread, sel );
	210	if( ! val )
	211	return 0;
226	212
227	213	switch( ur_type(val) )
…	…
285	271
286	272
	273	#if 0
287	274	// (value -- [result])
288	275	UR_CALL( uc_do )
…	…
374	361	}
375	362	}
	363	#endif
376	364
377	365
…	…
392	380
393	381	UR_S_DROPN(2);
394		~~uc_do( ur_thread, res )~~;
	382	UR_CALL_OP = OP_DO;
395	383	}
396	384
…	…
405	393	else if( ur_is(tos, UT_WORD) )
406	394	{
407		~~UBlock* blk;~~
408	395	UCell* val;
409
410		ur_wordCell( tos, blk, val );
411		ur_copyCell( tos, *val );
	396	val = ur_wordCell( ur_thread, tos );
	397	if( val )
	398	{
	399	ur_copyCell( tos, *val );
	400	}
412	401	}
413	402	else if( ur_is(tos, UT_LITWORD) )
…	…
442	431	UCell* end;
443	432
444		dt = ~~UR_TOS~~;
	433	dt = ur_s_backN( UR_TOS, (count - 1) );
445	434	it = ur_s_backN( dt, count );
446		end = ~~ur_s_backN( it, count )~~;
	435	end = dt;
447	436
448	437	while( it != end )
…	…
487	476	#define _throwUnbound(th,cell) _throwUnsetF(th,cell,"unbound")
488	477
489		static void _throwUnsetF( UThread* ur_thread, UCell* wcell,
	478	static void _throwUnsetF( UThread* ur_thread, const UCell* wcell,
490	479	const char* umsg )
491	480	{
…	…
502	491	/*
503	492	Returns control code or -1 if bad code found.
	493	Scan starts at *tocp.
504	494	*/
505	495	static int _scanControlStack( CEntry** tocp, int retMask )
…	…
521	511	{
522	512	case CC_FUNC:
523		if( toc->func.argc )
524		toc -= toc->func.argc;
525		--toc;
	513	toc -= CC_LEN_FUNC;
526	514	break;
527	515
…	…
552	540
553	541
554		extern void ur_copyCellsRev( const UCell* src, UCell* dest, int n );
	542	extern void ur_copyCells( const UCell* src, const UCell* end, UCell* dest );
	543	//extern void ur_copyCellsRev( const UCell* src, UCell* dest, int n );
555	544
556	545	#define DO_BLOCK(vp) \
557	546	PUSHC_EVAL( blkN, start, pc ); \
558	547	SET_BLK_PC( vp->series.n, vp->series.it )
	548
	549
	550	/*
	551	Returns cell pointer or zero if word does not reference a valid cell.
	552	*/
	553	UCell* ur_wordCell( UThread* ur_thread, const UCell* pc )
	554	{
	555	UCell* val;
	556	int i;
	557
	558	i = pc->word.valBlk;
	559	if( i < 0 )
	560	{
	561	CEntry* toc;
	562
	563	// Find function local frame i.
	564
	565	i = -i;
	566	toc = UR_TOC;
	567
	568	while( CC_FUNC == _scanControlStack( &toc, 1 << CC_FUNC ) )
	569	{
	570	--toc;
	571	if( toc->func.sigN == i )
	572	{
	573	val = UR_BOS + toc->func.lpos;
	574	goto val_set;
	575	}
	576	}
	577	_throwUnsetF( ur_thread, pc, "out-of-scope local" );
	578	return 0;
	579	}
	580	else
	581	{
	582	val = ur_blockPtr( i )->ptr.cells;
	583	}
	584
	585	val_set:
	586
	587	i = pc->word.index;
	588	if( i < 0 )
	589	{
	590	_throwUnbound(ur_thread, pc);
	591	return 0;
	592	}
	593
	594	return val + i;
	595	}
559	596
560	597
…	…
572	609	PUSHC_END( blkN );
573	610
574		blk = ur_blockPtr( blkN );
	611	blk = ur_blockPtr( blkN );
575	612	start = blk->ptr.cells;
576	613	pc = start + si;
…	…
579	616	execute:
580	617
581		while( pc != end )
582		{
583		EMH_STEP(pc, end)
584
585		switch( pc->id.type )
586		{
587		case UT_OPCODE:
588		switch( ur_opcode(pc) )
	618	if( pc >= end )
	619	goto control;
	620	EMH_STEP(pc, end)
	621	val = pc++;
	622
	623	if( ur_is(val, UT_WORD) )
	624	{
	625	val = ur_wordCell( ur_thread, val );
	626	if( ! val )
	627	goto throw_cc;
	628
	629	if( ur_is(val, UT_PAREN) )
	630	{
	631	UR_S_PUSH( *val );
	632	goto execute;
	633	}
	634	}
	635
	636	do_val:
	637
	638	switch( ur_type(val) )
	639	{
	640	case UT_UNSET:
	641	--pc;
	642	_throwUnset( ur_thread, pc );
	643	_appendTraceBlk( &UR_TOS->err, blkN, pc - start );
	644	goto throw_cc;
	645
	646	case UT_OPCODE:
	647	switch( ur_opcode(val) )
	648	{
	649	case OP_NOP:
	650	#ifdef DEBUG
	651	val = 0;
	652	#endif
	653	break;
	654
	655	case OP_DROP: // (a -- )
	656	UR_S_SAFE_DROP;
	657	break;
	658
	659	case OP_DUP: // (a -- a a)
	660	UR_S_DUP;
	661	break;
	662
	663	case OP_DUP2: // (a b -- a b a b)
	664	val = UR_TOS;
	665	ur_copyCells( ur_s_prev(val), ur_s_next(val),
	666	ur_s_next(val) );
	667	UR_S_GROWN(2);
	668	break;
	669
	670	case OP_OVER: // (a b -- a b a)
	671	UR_S_GROW;
	672	*UR_TOS = UR_TOS[-2];
	673	break;
	674
	675	case OP_SWAP: // (a b -- b a)
589	676	{
590		case OP_NOP:
591		++pc;
592		break;
593		#if 0
594		case OP_MODE_COMPILE:
595		++pc;
596		goto compile;
597
598		case OP_MODE_RUN:
599		++pc;
600		break;
601		#endif
602		case OP_DROP: // (a -- )
603		UR_S_SAFE_DROP;
604		++pc;
605		break;
606
607		case OP_DUP: // (a -- a a)
608		UR_S_DUP;
609		++pc;
610		break;
611
612		case OP_DUP2: // (a b -- a b a b)
613		UR_S_GROWN(2);
614		memCpy( UR_TOS, UR_TOS + 2, sizeof(UCell) * 2 );
615		++pc;
616		break;
617
618		case OP_OVER: // (a b -- a b a)
619		UR_S_GROW;
620		*UR_TOS = UR_TOS[2];
621		++pc;
622		break;
623
624		case OP_SWAP: // (a b -- b a)
	677	UCell tmp = *UR_TOS;
	678	*UR_TOS = UR_TOS[-1];
	679	UR_TOS[-1] = tmp;
	680	}
	681	break;
	682
	683	case OP_NIP: // (a b -- b)
	684	UR_S_NIP;
	685	break;
	686
	687	case OP_TUCK: // (a b -- b a b)
	688	{
	689	UR_S_GROW;
	690	*UR_TOS = UR_TOS[-1];
	691	UR_TOS[-1] = UR_TOS[-2];
	692	UR_TOS[-2] = *UR_TOS;
	693	}
	694	break;
	695
	696	case OP_ROT: // (a b c -- b c a)
	697	{
	698	UCell tmp = UR_TOS[-2];
	699	UR_TOS[-2] = UR_TOS[-1];
	700	UR_TOS[-1] = *UR_TOS;
	701	*UR_TOS = tmp;
	702	}
	703	break;
	704
	705	case OP_ROT_R: // (a b c -- c a b)
	706	{
	707	UCell tmp = *UR_TOS;
	708	*UR_TOS = UR_TOS[-1];
	709	UR_TOS[-1] = UR_TOS[-2];
	710	UR_TOS[-2] = tmp;
	711	}
	712	break;
	713
	714	case OP_DO: // (value -- [result])
	715	op_do:
	716	val = UR_TOS;
	717	UR_S_DROP;
	718	if( ur_is(val, UT_BLOCK) )
625	719	{
626		UCell tmp = *UR_TOS;
627		*UR_TOS = UR_TOS[1];
628		UR_TOS[1] = tmp;
	720	do_block:
	721	DO_BLOCK( val );
	722	PUSHC_EVAL_RUNNING( val->series.n );
	723	goto execute;
629	724	}
630		++pc;
631		break;
632
633		case OP_NIP: // (a b -- b)
634		UR_S_NIP;
635		++pc;
636		break;
637
638		case OP_TUCK: // (a b -- b a b)
	725	else if( ur_is(val, UT_STRING) )
639	726	{
640		UR_S_GROW;
641		*UR_TOS = UR_TOS[1];
642		UR_TOS[1] = UR_TOS[2];
643		UR_TOS[2] = *UR_TOS;
	727	UIndex tblkN;
	728	UString* str = ur_bin(val);
	729	if( str->used )
	730	{
	731	tblkN = ur_tokenize( str->ptr.c + val->series.it,
	732	str->ptr.c + str->used );
	733	if( tblkN )
	734	{
	735	_infuseOpcodes( tblkN );
	736	ur_setSeries(val, tblkN, 0);
	737	goto do_block;
	738	}
	739	}
	740	goto execute;
644	741	}
645		++pc;
646		break;
647
648		case OP_ROT: // (a b c -- b c a)
	742	else if( ur_is(val, UT_WORD) )
649	743	{
650		UCell tmp = UR_TOS[2];
651		UR_TOS[2] = UR_TOS[1];
652		UR_TOS[1] = *UR_TOS;
653		*UR_TOS = tmp;
	744	val = ur_wordCell( ur_thread, val );
	745	if( ! val )
	746	goto throw_cc;
654	747	}
655		++pc;
656		break;
657
658		case OP_ROT_R: // (a b c -- c a b)
	748	goto do_val;
	749
	750	case OP_PROC:
	751	if( ! ur_is(UR_TOS, UT_BLOCK) )
	752	goto bad_opcode_type;
	753
	754	val = UR_TOS;
	755	ur_initType( val, UT_FUNCTION );
	756	// localArgs & localVars cleared by ur_initType().
	757	// bodyN = series.n
	758	val->func.closureN = 0;
	759	val->func.sigN = 0;
	760	break;
	761
	762	case OP_ITER: // (series blk -- )
	763	if( ur_is(UR_TOS, UT_BLOCK) &&
	764	(ur_itLen( ur_s_prev(UR_TOS) ) > 0) )
659	765	{
660		UCell tmp = *UR_TOS;
661		*UR_TOS = UR_TOS[1];
662		UR_TOS[1] = UR_TOS[2];
663		UR_TOS[2] = tmp;
664		}
665		++pc;
666		break;
667		#if 0
668		case OP_DO: // (value -- [result])
669		++pc;
670		uc_do( UR_TOS );
671		goto call_return;
672		#endif
673		case OP_PROC:
674		++pc;
675		ur_makeProc( ur_thread );
676		break;
677
678		case OP_ITER: // (series blk -- )
679		++pc;
680		if( ur_is(UR_TOS, UT_BLOCK) &&
681		(ur_itLen( ur_s_prev(UR_TOS) ) > 0) )
682		{
683		PUSHC_EVAL( blkN, start, pc );
684		SET_BLK_PC( UR_TOS->series.n,
685		UR_TOS->series.it );
686		PUSHC_ITER( blkN, pc, end );
687
688		// Loop code must drop TOS.
689		*UR_TOS = UR_TOS[1]; // drop dup
690		}
691		else
692		{
693		UR_S_DROPN(2);
694		}
695		break;
696
697		case OP_RECURSE:
698		goto op_recurse;
699
700		case OP_RETURN:
701		goto op_return;
702
703		case OP_THROW: // (val -- val)
704		goto op_throw;
705
706		case OP_TRY: // (block! block! -- )
707		//check0( UT_BLOCK );
708		//check1( UT_BLOCK );
709
710		PUSHC_EVAL( blkN, start, pc + 1 );
711
712		// Push catch block.
713		UR_TOC->eval.n = UR_TOS->series.n;
714		UR_TOC->eval.it = UR_TOS->series.it;
715		UR_C_GROW;
716
717		UR_S_DROP;
	766	PUSHC_EVAL( blkN, start, pc );
718	767	SET_BLK_PC( UR_TOS->series.n,
719	768	UR_TOS->series.it );
720		UR_S_DROP;
721
722		// Save stack position.
723		UR_TOC->cp.code = CC_CATCH;
724		UR_TOC->cp.cell = UR_TOS;
725		UR_C_GROW;
726		break;
727
728		case OP_IF_TRUE: // (logic -- )
	769	PUSHC_ITER( blkN, pc, end );
	770
	771	// Loop code must drop TOS.
	772	*UR_TOS = UR_TOS[-1]; // drop dup
	773	}
	774	else
	775	{
	776	UR_S_DROPN(2);
	777	}
	778	break;
	779
	780	case OP_RECURSE:
	781	goto op_recurse;
	782
	783	case OP_RETURN:
	784	goto op_return;
	785
	786	case OP_THROW: // (val -- val)
	787	goto op_throw;
	788
	789	case OP_TRY: // (block! block! -- )
	790	//check0( UT_BLOCK );
	791	//check1( UT_BLOCK );
	792
	793	PUSHC_EVAL( blkN, start, pc );
	794
	795	// Push catch block.
	796	UR_TOC->eval.n = UR_TOS->series.n;
	797	UR_TOC->eval.it = UR_TOS->series.it;
	798	UR_C_GROW;
	799
	800	UR_S_DROP;
	801	SET_BLK_PC( UR_TOS->series.n,
	802	UR_TOS->series.it );
	803	UR_S_DROP;
	804
	805	// Save stack position.
	806	UR_TOC->cp.code = CC_CATCH;
	807	UR_TOC->cp.cell = UR_TOS;
	808	UR_C_GROW;
	809	break;
	810
	811	case OP_IF_TRUE: // (logic -- )
	812	val = UR_TOS;
	813	if( ur_is(val, UT_NONE) \|\|
	814	(ur_is(val, UT_LOGIC) && ! ur_logic(val)) )
	815	goto if_skip;
	816	UR_S_DROP;
	817	break;
	818
	819	case OP_IF_FALSE: // (logic -- )
	820	val = UR_TOS;
	821	if( ur_is(val, UT_NONE) \|\|
	822	(ur_is(val, UT_LOGIC) && ! ur_logic(val)) )
	823	goto if_do;
	824	if_skip:
	825	if( pc != end )
729	826	++pc;
730		~~val = UR_TOS;~~
731		~~if( ur_is(val, UT_NONE) \|\|~~
732		~~(ur_is(val, UT_LOGIC) && ! ur_logic(val)) )~~
733		~~goto if_skip;~~
734		~~UR_S_DROP;~~
735		~~break;~~
736
737		~~case OP_IF_FALSE: // (logic -- )~~
738		~~++pc;~~
739		~~val = UR_TOS;~~
740		~~if( ur_is(val, UT_NONE) \|\|~~
741		~~(ur_is(val, UT_LOGIC) && ! ur_logic(val)) )~~
742		~~goto if_do;~~
743		~~if_skip:~~
744		~~if( pc != end )~~
745		~~++pc;~~
746	827	if_do:
747		UR_S_DROP;
748		break;
749
750		case OP_HALT:
751		++pc;
752		EMH_HALT(pc, end)
753		goto halt;
754
755		case OP_QUIT:
756		goto quit;
757
758		case OP_INCREMENT:
759		if( ! ur_is(UR_TOS, UT_INT) )
760		goto bad_opcode_type;
761		ur_int(UR_TOS) += 1;
762		++pc;
763		break;
764
765		case OP_DECREMENT:
766		if( ! ur_is(UR_TOS, UT_INT) )
767		goto bad_opcode_type;
768		ur_int(UR_TOS) -= 1;
769		++pc;
770		break;
771
772		case OP_VERIFY: // (val type -- val)
773		// (v1 v2 t1 t2 -- v1 v2)
774		// (v1 v2 v3 t1 t2 t3 -- v1 v2 v3)
775		// etc.
	828	UR_S_DROP;
	829	break;
	830
	831	case OP_HALT:
	832	EMH_HALT(pc, end)
	833	goto halt;
	834
	835	case OP_QUIT:
	836	goto quit;
	837
	838	case OP_INCREMENT:
	839	if( ! ur_is(UR_TOS, UT_INT) )
	840	goto bad_opcode_type;
	841	ur_int(UR_TOS) += 1;
	842	break;
	843
	844	case OP_DECREMENT:
	845	if( ! ur_is(UR_TOS, UT_INT) )
	846	goto bad_opcode_type;
	847	ur_int(UR_TOS) -= 1;
	848	break;
	849
	850	case OP_VERIFY: // (val type -- val)
	851	// (v1 v2 t1 t2 -- v1 v2)
	852	// (v1 v2 v3 t1 t2 t3 -- v1 v2 v3)
	853