[Forthy-cvs] forthy fcode.c,1.7,1.8 fcode.h,1.5,1.6 fcompile.c,1.6,1.7 finternal.h,1.2,1.3 fmachine.c,1.4,1.5 fmachine.h,1.2,1.3 forthy.dsp,1.5,1.6 fparse.h,1.1,1.2 fsystem.c,1.13,1.14 fsystem.h,1.10,1.11 ftype.h,1.6,1.7 fvalue.c,1.7,1.8 main.c,1.20,1.21 test.txt,1.5,1.6

[Paul P. <ppr...@us...>]

Update of /cvsroot/forthy/forthy
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13032

Modified Files:
	fcode.c fcode.h fcompile.c finternal.h fmachine.c fmachine.h 
	forthy.dsp fparse.h fsystem.c fsystem.h ftype.h fvalue.c 
	main.c test.txt 
Log Message:
- added evaluation functionality (using fs_load_input() at runtime)
- seperated control-flow stack from call stack... it was just too convoluted. Associated stack juggling removed from code
- added fs_reset(), now needed to recover from an error. This sets it up later for post-error stack dumps and such
- fs_forget() now throws an exception if you execute it while running code. It works fine when executed purely as a primitive during interpretation. Input stack depth must match the call stack depth (meaning that you're only interpreting) for it to not abort execution

Index: finternal.h
===================================================================
RCS file: /cvsroot/forthy/forthy/finternal.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** finternal.h	16 Nov 2003 16:45:06 -0000	1.2
--- finternal.h	5 Aug 2004 04:18:37 -0000	1.3
***************
*** 2,12 ****
  #define __FINTERNAL_H__
  
  // Stuff that shouldn't be visible through FSYSTEM.H
  void	in_push_wordref(FSYSTEM *sys, FSYMREC *ptr);
  void	in_get_word(FSYSTEM *sys, int offset, FSYMREC **ptr);
- void	in_exit_inner(FSYSTEM *sys);
  
  // Dictionary word access
  FSYMREC *voc_new_word(FSYSTEM *sys, char *name, int flags);
  
  // Exception macros
--- 2,22 ----
  #define __FINTERNAL_H__
  
+ #ifdef _DEBUGZ
+ #define TRACEF	printf
+ #else
+ #define TRACEF	(void)
+ #endif
+ 
  // Stuff that shouldn't be visible through FSYSTEM.H
  void	in_push_wordref(FSYSTEM *sys, FSYMREC *ptr);
  void	in_get_word(FSYSTEM *sys, int offset, FSYMREC **ptr);
  
  // Dictionary word access
  FSYMREC *voc_new_word(FSYSTEM *sys, char *name, int flags);
+ FSYMREC *voc_get_word(FSYSTEM *sys, char *name, unsigned len, 
+ 	FDICT **where);
+ 
+ // System words
+ void sys_input_drop(FSYSTEM *sys);
  
  // Exception macros

Index: fparse.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fparse.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** fparse.h	7 Aug 2003 01:22:55 -0000	1.1
--- fparse.h	5 Aug 2004 04:18:37 -0000	1.2
***************
*** 7,10 ****
--- 7,12 ----
  #include "fsystem.h"
  
+ #define WHITESPACES	" \r\n\t"
+ 
  enum {TOK_END=0, TOK_INT, TOK_FLOAT, TOK_STRING, TOK_UNKNOWN};
  

Index: fvalue.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fvalue.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** fvalue.c	25 Jul 2004 20:25:47 -0000	1.7
--- fvalue.c	5 Aug 2004 04:18:37 -0000	1.8
***************
*** 542,546 ****
  	}
  
! 	return NULL;
  }
  
--- 542,547 ----
  	}
  
! 	return string_set_temp_str(str_ptr, "", TRUE);
! //	return NULL;
  }
  

Index: fcompile.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fcompile.c,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** fcompile.c	18 Nov 2003 13:49:41 -0000	1.6
--- fcompile.c	5 Aug 2004 04:18:37 -0000	1.7
***************
*** 25,28 ****
--- 25,29 ----
  
  #include <stdlib.h>
+ #include <stdio.h>
  #include <string.h>
  #include "fsystem.h"
***************
*** 291,294 ****
--- 292,296 ----
  
  
+ // TODO: Split into compile_now and compile_later
  // POSTPONE behaviour
  void fs_postpone(FSYSTEM *sys, int offset)
***************
*** 324,371 ****
  
  
- // Keep the XT on TOS in case control-flow gets mixed with XT's on return stack
- static int bubble_token(FSYSTEM *sys, int count)
- {
- 	FVALUE *value;
- 
- 	// Check depth of stack
- 	if(stack_depth(sys->rstack)<count)
- 		return FALSE;
- 
- 	// ...check type. If it's a token, then -rot
- 	value=stack_get_value(sys, sys->rstack, -count);	
- 	if(value_get_type(value)!=FS_TOKEN)
- 		return FALSE;
- 	
- 	stack_rotl(sys, sys->rstack, -1, count);
- 
- 	return TRUE;
- }
- 
- 
- // Adjust for XT's on return stack that block control-flow
- static void tuck_token(FSYSTEM *sys, int count)
- {
- 	FVALUE *value;
- 
- 	// Check depth of stack
- 	if(stack_depth(sys->rstack)<count)
- 		return;
- 
- 	// ...check type. If it's a token, then -rot
- 	value=stack_get_value(sys, sys->rstack, -1);	
- 	if(value_get_type(value)!=FS_TOKEN)
- 		return;
- 	
- 	stack_rotr(sys, sys->rstack, -1, count);
- }
- 
- 
  static void mark_colon(FSYSTEM *sys)
  {
  	// Push colon-sys onto the stack
! 	vm_push_int(sys, (int)colon_tag);
! 
! 	bubble_token(sys, 2);
  }
  
--- 326,333 ----
  
  
  static void mark_colon(FSYSTEM *sys)
  {
  	// Push colon-sys onto the stack
! 	vm_push_marker(sys, (int)colon_tag);
  }
  
***************
*** 373,384 ****
  static int resolve_colon(FSYSTEM *sys)
  {
- 	// If there's an XT on TOS we need to tuck it under before we resolve
- 	tuck_token(sys, 2);
- 
  	// Retrieve colon-sys from the stack
! 	if(vm_get_int(sys, -1)!=(int)colon_tag)
  		return FALSE;
  
! 	vm_pop(sys);
  
  	return TRUE;
--- 335,343 ----
  static int resolve_colon(FSYSTEM *sys)
  {
  	// Retrieve colon-sys from the stack
! 	if(vm_get_marker(sys, -1)!=(int)colon_tag)
  		return FALSE;
  
! 	vm_pop_cs(sys);
  
  	return TRUE;
***************
*** 395,441 ****
  
  	// Push break-sys onto the stack
! 	vm_push_int(sys, sys->code_off);
! 	vm_push_int(sys, (int)(break_tag));
! 
! 	// If there's an XT buried under break-sys
! 	if(bubble_token(sys, 3))
! 	{
! 		depth=4;
! 
! 		// Find depth of "orig" tags below
! 		while((tag=vm_get_int(sys, -depth))==(int)orig_tag)
! 			depth+=2;
! 
! 		if(tag==(int)colon_tag)
! 			VOID_THROW(sys, FS_ERROR); 
! 
! 		if(depth==4)
! 			return;
  
! 		// tuck XT under first "orig"
! 		tuck_token(sys, depth-1);
! 		depth--;
! 	}
! 	else
! 	{
! 		depth=3;
  
! 		// Find depth of "orig" tags below
! 		while((tag=vm_get_int(sys, -depth))==(int)orig_tag)
! 			depth+=2;
  
! 		if(tag==(int)colon_tag)
! 			VOID_THROW(sys, FS_ERROR); 
  
! 		if(depth==3)
! 			return;
! 	}
  
  	// cs-roll break-sys underneath first orig
  	for(i=0; i<((depth/2)-1); i++)
  		vm_cs_roll(sys, (depth/2)-1);
- 
- 	// bubble XT back to top of stack
- 	bubble_token(sys, depth);
  }
  
--- 354,375 ----
  
  	// Push break-sys onto the stack
! 	vm_push_marker(sys, sys->code_off);
! 	vm_push_marker(sys, (int)(break_tag));
  
! 	depth=3;
  
! 	// Find depth of "orig" tags below
! 	while((tag=vm_get_marker(sys, -depth))==(int)orig_tag)
! 		depth+=2;
  
! 	if(tag==(int)colon_tag)
! 		VOID_THROW(sys, FS_ERROR); 
  
! 	if(depth==3)
! 		return;
  
  	// cs-roll break-sys underneath first orig
  	for(i=0; i<((depth/2)-1); i++)
  		vm_cs_roll(sys, (depth/2)-1);
  }
  
***************
*** 445,453 ****
  
  	// Push orig onto the stack (code offset of forward conditional branch)
! 	vm_push_int(sys, sys->code_off);
! 
! 	vm_push_int(sys, (int)(orig_tag));
  
! 	bubble_token(sys, 3);
  }
  
--- 379,385 ----
  
  	// Push orig onto the stack (code offset of forward conditional branch)
! 	vm_push_marker(sys, sys->code_off);
  
! 	vm_push_marker(sys, (int)(orig_tag));
  }
  
***************
*** 456,464 ****
  {
  	// Push dest onto the stack (code offset of destination jump point)
! 	vm_push_int(sys, sys->code_off);
! 
! 	vm_push_int(sys, (int)(dest_tag));
  
! 	bubble_token(sys, 3);
  }
  
--- 388,394 ----
  {
  	// Push dest onto the stack (code offset of destination jump point)
! 	vm_push_marker(sys, sys->code_off);
  
! 	vm_push_marker(sys, (int)(dest_tag));
  }
  
***************
*** 468,476 ****
  	// Push for-sys onto the stack (code offset of forward conditional branch)
  	// - Destination jump point will be the cell following branch offset (+1)
! 	vm_push_int(sys, sys->code_off);
! 
! 	vm_push_int(sys, (int)(for_tag));
  
! 	bubble_token(sys, 3);
  }
  
--- 398,404 ----
  	// Push for-sys onto the stack (code offset of forward conditional branch)
  	// - Destination jump point will be the cell following branch offset (+1)
! 	vm_push_marker(sys, sys->code_off);
  
! 	vm_push_marker(sys, (int)(for_tag));
  }
  
***************
*** 478,491 ****
  static int resolve_tag(FSYSTEM *sys, int tag)
  {
- 	// If there's an XT on TOS we need to tuck it under before we resolve
- 	tuck_token(sys, 3);
- 
  	// Retrieve for-sys from the stack
! 	if(vm_get_int(sys, -1)!=tag)
  		return FALSE;
  
  	// Dump orig
! 	vm_pop(sys);
! 	
  	return TRUE;
  }
--- 406,416 ----
  static int resolve_tag(FSYSTEM *sys, int tag)
  {
  	// Retrieve for-sys from the stack
! 	if(vm_get_marker(sys, -1)!=tag)
  		return FALSE;
  
  	// Dump orig
! 	vm_pop_cs(sys);
! 
  	return TRUE;
  }
***************
*** 500,507 ****
  
  		// Get BREAK's jump offset code offset
! 		off=vm_get_int(sys, -1);
  
  		// Dump offset
! 		vm_pop(sys);
  
  		// Backpatch the BREAK to point past end of the loop
--- 425,432 ----
  
  		// Get BREAK's jump offset code offset
! 		off=vm_get_marker(sys, -1);
  
  		// Dump offset
! 		vm_pop_cs(sys);
  
  		// Backpatch the BREAK to point past end of the loop
***************
*** 527,531 ****
  	// We set SMUDGE so that it can't call itself during compile, or do
  	// recursion. We will control recursion with a recursion primitive
- //	sym=dict_new(&(sys->table), name, FS_SMUDGE);
  	sym=voc_new_word(sys, name, FS_SMUDGE);
  	if(!sym)
--- 452,455 ----
***************
*** 536,542 ****
  	sys->current=sym;
  
- 	// Our last valid constant string literal
- //	string_set_last(sys);
- 
  	if(!add_chunk(sys))
  	{
--- 460,463 ----
***************
*** 544,549 ****
  		// UPDATE: If we call VOID_THROW(), then the exception handler
  		// will compile_abort() for us
- //		compile_abort(sys);
- 
  		VOID_THROW(sys, FS_OUT_OF_MEMORY);
  	}
--- 465,468 ----
***************
*** 636,643 ****
  	fs_ahead(sys);
  
- 	// If there's an XT on TOS we need to tuck it under before we resolve
- 	// (5 stack slots, 2 for each control-sys and 1 for the XT)
- 	tuck_token(sys, 5);
- 
  	vm_cs_roll(sys, 1);
  
--- 555,558 ----
***************
*** 658,666 ****
  
  		// Backpatch the branch to point to current offset
! 		off=vm_get_int(sys, -1);
  		sys->code[off]=(void*)(sys->code_off-off); // Relative
  
  		// Dump offset
! 		vm_pop(sys);
  		i++;
  
--- 573,581 ----
  
  		// Backpatch the branch to point to current offset
! 		off=vm_get_marker(sys, -1);
  		sys->code[off]=(void*)(sys->code_off-off); // Relative
  
  		// Dump offset
! 		vm_pop_cs(sys);
  		i++;
  
***************
*** 671,676 ****
  	if(!i)
  		VOID_THROW(sys, FS_ERROR); // TODO: Control-flow error
- 
- 	bubble_token(sys, 3);
  }
  
--- 586,589 ----
***************
*** 699,706 ****
  
  	// Get dest offset
! 	off=vm_get_int(sys, -1);
  
  	// Dump offset
! 	vm_pop(sys);
  
  	// Compile BRANCH_NE back to dest
--- 612,619 ----
  
  	// Get dest offset
! 	off=vm_get_marker(sys, -1);
  
  	// Dump offset
! 	vm_pop_cs(sys);
  
  	// Compile BRANCH_NE back to dest
***************
*** 713,718 ****
  
  	CELL_INC(sys);
- 
- 	bubble_token(sys, 3);
  }
  
--- 626,629 ----
***************
*** 725,731 ****
  	NEED_COMPILE(sys);
  
- 	// NEEDED?
- //	tuck_token(sys, 3);
- 
  	// Resolve and backpatch all BREAKs
  	patch_breaks(sys);
--- 636,639 ----
***************
*** 735,742 ****
  
  	// Get dest offset
! 	off=vm_get_int(sys, -1);
  
  	// Dump offset
! 	vm_pop(sys);
  
  	// Compile BRANCH back to dest
--- 643,650 ----
  
  	// Get dest offset
! 	off=vm_get_marker(sys, -1);
  
  	// Dump offset
! 	vm_pop_cs(sys);
  
  	// Compile BRANCH back to dest
***************
*** 748,753 ****
  
  	CELL_INC(sys);
- 
- 	bubble_token(sys, 3);
  }
  
--- 656,659 ----
***************
*** 759,767 ****
  	fs_if(sys);
  
- 	tuck_token(sys, 5);
- 
  	// 1 cs-roll
  	vm_cs_roll(sys, 1);
- 	bubble_token(sys, 5);
  }
  
--- 665,670 ----
***************
*** 828,835 ****
  
  	// Get for-sys offset
! 	off=vm_get_int(sys, -1);
  
  	// Dump offset
! 	vm_pop(sys);
  
  	// Compile FOR/NEXT opcode
--- 731,738 ----
  
  	// Get for-sys offset
! 	off=vm_get_marker(sys, -1);
  
  	// Dump offset
! 	vm_pop_cs(sys);
  
  	// Compile FOR/NEXT opcode
***************
*** 845,850 ****
  	// Backpatch the 0 FOR to point to ending offset
  	sys->code[off]=(void*)(sys->code_off-off); // Relative
- 
- 	bubble_token(sys, 3);
  }
  
--- 748,751 ----

Index: fcode.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fcode.h,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** fcode.h	18 Nov 2003 13:49:41 -0000	1.5
--- fcode.h	5 Aug 2004 04:18:37 -0000	1.6
***************
*** 8,15 ****
  #define OPFUNC(code)	(code_table[(code)].exec)
  
! enum{OP_EXIT_INNER, OP_DOCON, OP_DOVAR, OP_ENTER, OP_EXIT_FAST, OP_EXIT, 
! 	OP_LITINT, OP_LITFLOAT, OP_LITSTRING, OP_LITWORDREF, OP_BRANCH, 
  	OP_BRANCH_NE, OP_FOR, OP_NEXT, OP_BREAK, OP_COMPILE, OP_DOES, OP_DODOES,
! 	OP_DODEFER};
  
  // Refer to "Heart Of Forth":
--- 8,15 ----
  #define OPFUNC(code)	(code_table[(code)].exec)
  
! enum{OP_EXIT_INNER, OP_DOCON, OP_DOVAR, OP_ENTER, OP_EXIT_FAST,
! 	OP_EXIT, OP_LITINT, OP_LITFLOAT, OP_LITSTRING, OP_LITWORDREF, OP_BRANCH,
  	OP_BRANCH_NE, OP_FOR, OP_NEXT, OP_BREAK, OP_COMPILE, OP_DOES, OP_DODOES,
! 	OP_DODEFER, OP_INTERPRET, OP_FATAL};
  
  // Refer to "Heart Of Forth":
***************
*** 17,22 ****
  // - (DO) (?DO) (+LOOP) (LOOP) (LEAVE)
  
- //extern FCFUNC code_table[];
  extern FOPCODE code_table[];
  
  #endif
--- 17,23 ----
  // - (DO) (?DO) (+LOOP) (LOOP) (LEAVE)
  
  extern FOPCODE code_table[];
+ extern FTOKEN *code_soft_interpreter[];
+ extern FTOKEN *code_soft_exit_inner[];
  
  #endif

Index: ftype.h
===================================================================
RCS file: /cvsroot/forthy/forthy/ftype.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** ftype.h	27 Jul 2004 04:31:02 -0000	1.6
--- ftype.h	5 Aug 2004 04:18:37 -0000	1.7
***************
*** 42,46 ****
  // FS_BAD_WORD?
  
! enum {FS_OK=0, FS_READY, FS_PAUSE, FS_BYE, FS_USER_RESULT, FS_RESULT_TOP};
  
  
--- 42,47 ----
  // FS_BAD_WORD?
  
! enum {FS_OK=0, FS_EXIT_INNER, FS_STEP, FS_PAUSE, FS_RESET, FS_BYE, 
! 	FS_USER_RESULT, FS_RESULT_TOP};
  
  

Index: fsystem.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.h,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** fsystem.h	31 Jul 2004 21:51:13 -0000	1.10
--- fsystem.h	5 Aug 2004 04:18:37 -0000	1.11
***************
*** 32,35 ****
--- 32,36 ----
  	FSTACK *stack;			// data stack
  	FSTACK *rstack;			// return stack
+ 	FSTACK *cstack;			// control-flow stack
  	FSTACK *vstack;			// vocabulary stack
  	FSTACK *istack;			// input stack
***************
*** 45,52 ****
  	FCFUNC vm_inner;		// Which inner loop we're using
  
! 	int running;			// TODO: Execution state management (restrict)
  
  	jmp_buf *env;			// C exceptions
! 	FTOKEN *exit_inner;		// TODO: Move this to fcode.c
  
  	// TEMP: Profiling
--- 46,54 ----
  	FCFUNC vm_inner;		// Which inner loop we're using
  
! 	int stepping;			// TODO: Execution state management (restrict)
  
  	jmp_buf *env;			// C exceptions
! 	FXTOKEN exit_inner;
! 	FXTOKEN interpreter;
  
  	// TEMP: Profiling
***************
*** 86,91 ****
  int		fs_run(FSYSTEM *sys);
  int		fs_step(FSYSTEM *sys);
- int		fs_clear_input(FSYSTEM *sys);
  //int		fs_trace(FSYSTEM *sys);
  
  int		fs_find_word_handle(FSYSTEM *sys, char *name);
--- 88,94 ----
  int		fs_run(FSYSTEM *sys);
  int		fs_step(FSYSTEM *sys);
  //int		fs_trace(FSYSTEM *sys);
+ int		fs_clear_input(FSYSTEM *sys);
+ int		fs_reset(FSYSTEM *sys);
  
  int		fs_find_word_handle(FSYSTEM *sys, char *name);

Index: fmachine.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fmachine.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** fmachine.c	28 Jul 2004 03:53:10 -0000	1.4
--- fmachine.c	5 Aug 2004 04:18:37 -0000	1.5
***************
*** 51,70 ****
  void vm_inner_step(FSYSTEM *sys)
  {
- 	// Set-up for if we get EXIT_INNER, this will let us know we exited
- 	// normally
- 	sys->running=FALSE;
- 
- 	// Execute the current FXTOKEN
- 	sys->w->func(sys);
- 
  	// NEXT
  	sys->w=*(sys)->ip++;
! 
! 	// TEMP: Profiling
! 	sys->icount++;
! 
! 	// Finished executing everything - we *didn't* bail out using EXIT_INNER,
! 	// so we are still stepping
! 	sys->running=TRUE;
  }
  
--- 51,57 ----
  void vm_inner_step(FSYSTEM *sys)
  {
  	// NEXT
  	sys->w=*(sys)->ip++;
! 	VOID_THROW(sys, FS_STEP);
  }
  
***************
*** 74,79 ****
  	FTOKEN *w;
  	
- 	sys->w->func(sys);
- 
  	for(;;)
  	{
--- 61,64 ----
***************
*** 93,102 ****
  
  
  // Abort the current execution
  void vm_abort(FSYSTEM *sys)
  {
- 	sys->ip=NULL;
  	stack_remove(sys, sys->rstack, stack_depth(sys->rstack));
  	compile_abort(sys);
  }
  
--- 78,102 ----
  
  
+ void vm_reset(FSYSTEM *sys)
+ {
+ 	sys->w=NULL;
+ 	sys->ip=sys->exit_inner;
+ }
+ 
+ 
  // Abort the current execution
  void vm_abort(FSYSTEM *sys)
  {
  	stack_remove(sys, sys->rstack, stack_depth(sys->rstack));
+ 	stack_remove(sys, sys->cstack, stack_depth(sys->cstack));
+ /*
+ 	if(sys->vstack)
+ 	{
+ 		stack_remove(sys, sys->vstack, stack_depth(sys->vstack));
+ 	}
+ 	stack_remove(sys, sys->stack, stack_depth(sys->stack));
+ */
  	compile_abort(sys);
+ 	vm_reset(sys);
  }
  
***************
*** 106,112 ****
  	FVALUE *value;
  
! 	if(!(value=stack_push(sys, sys->rstack)))
! 		VOID_THROW(sys, FS_OVERFLOW);
  
  	value_init_int(value, i);
  }
--- 106,119 ----
  	FVALUE *value;
  
! 	value=stack_push(sys, sys->rstack);
! 	value_init_int(value, i);
! }
! 
  
+ void vm_push_marker(FSYSTEM *sys, int i)
+ {
+ 	FVALUE *value;
+ 
+ 	value=stack_push(sys, sys->cstack);
  	value_init_int(value, i);
  }
***************
*** 129,132 ****
--- 136,155 ----
  
  
+ int vm_get_marker(FSYSTEM *sys, int offset)
+ {
+ 	int sp;
+ 	FVALUE *val;
+ 
+ 	sp=stack_convert_offset(sys, sys->cstack, offset);
+ 
+ 	val=&((sys->cstack)->mem[sp]);
+ 
+ 	if(val->type!=FS_INT)
+ 		return 0;
+ 
+ 	return val->value.i;
+ }
+ 
+ 
  // TODO: Consider adding this to API (user return stack access?)
  // Roll the items on the control-flow stack
***************
*** 138,146 ****
  		VOID_THROW(sys, FS_BAD_PARAMETER);
  
! 	if(stack_depth(sys->rstack)<items)
  		VOID_THROW(sys, FS_ERROR); // TODO: Specific error?
  
! 	stack_rotl(sys, sys->rstack, -1, items);
! 	stack_rotl(sys, sys->rstack, -1, items);
  }
  
--- 161,169 ----
  		VOID_THROW(sys, FS_BAD_PARAMETER);
  
! 	if(stack_depth(sys->cstack)<items)
  		VOID_THROW(sys, FS_ERROR); // TODO: Specific error?
  
! 	stack_rotl(sys, sys->cstack, -1, items);
! 	stack_rotl(sys, sys->cstack, -1, items);
  }
  
***************
*** 156,167 ****
  
  
! /*
! int *vs_get_top_int(FSTACK *stack)
  {
! 	int sp=stack->stack_size-stack->sp;
! 	int *i=&(stack->mem[sp].value.i);
! 	
! 	return i;
  }
! */
  
--- 179,200 ----
  
  
! void vm_push_ip(FSYSTEM *sys, FXTOKEN new_ip)
  {
! 	FVALUE *value;
! 
! 	// - Push the current IP onto the return stack
! 	value=stack_push(sys, sys->rstack);
! 	value_init_token(value, (sys->ip));
! 
! 	// - Set IP to the new value
! 	sys->ip=new_ip;
  }
! 
! 
! void vm_load_word(FSYSTEM *sys, FTOKEN* word)
! {
! 	// Ret running word to handle
! 	sys->w=(FTOKEN*)word;
! }
! 
  

Index: fcode.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fcode.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** fcode.c	26 Jul 2004 03:28:30 -0000	1.7
--- fcode.c	5 Aug 2004 04:18:37 -0000	1.8
***************
*** 1,3 ****
! //#include <stdio.h>
  #include <stdlib.h>
  #include "fsystem.h"
--- 1,3 ----
! #include <stdio.h>
  #include <stdlib.h>
  #include "fsystem.h"
***************
*** 7,10 ****
--- 7,11 ----
  #include "fcompile.h"
  #include "fdict.h"
+ #include "fparse.h"
  #include "fcode.h"
  
***************
*** 56,61 ****
  void code_dodefer(FSYSTEM *sys);
  
  
- //void code_compile(FSYSTEM *sys);
  
  FOPCODE code_table[]=
--- 57,64 ----
  void code_dodefer(FSYSTEM *sys);
  
+ void code_interpret(FSYSTEM *sys);
+ 
+ void code_fatal(FSYSTEM *sys);
  
  
  FOPCODE code_table[]=
***************
*** 80,83 ****
--- 83,103 ----
  	{code_dodoes, "DO_DOES"},
  	{code_dodefer, "DO_DEFER"},
+ 	{code_interpret, "INTERPRET"},
+ 	{code_fatal, "FATAL"},
+ };
+ 
+ 
+ FTOKEN *code_soft_interpreter[]=
+ {
+ 	(FTOKEN*)OPCODE(OP_INTERPRET),
+ 	(FTOKEN*)OPCODE(OP_EXIT_FAST),
+ 	(FTOKEN*)OPCODE(OP_FATAL)
+ };
+ 
+ 
+ FTOKEN *code_soft_exit_inner[]=
+ {
+ 	(FTOKEN*)OPCODE(OP_EXIT_INNER),
+ 	(FTOKEN*)OPCODE(OP_FATAL)
  };
  
***************
*** 102,115 ****
  
  
- /*
- void code_lit_string(FSYSTEM *sys)
- {
- 	// Take the following cell value (which will be a pointer to a string in
- 	// the constant string table) and push the string value onto the stack
- 	sys->ip++;
- 	fs_push_string(sys, *((char**)(sys->ip-1)));
- }
- */
- 
  void code_lit_string(FSYSTEM *sys)
  {
--- 122,125 ----
***************
*** 183,189 ****
  
  	// - Push the current IP onto the return stack
! 	if(!(value=stack_push(sys, sys->rstack)))
! 		VOID_THROW(sys, FS_OVERFLOW);
! 
  	value_init_token(value, (sys->ip));
  
--- 193,197 ----
  
  	// - Push the current IP onto the return stack
! 	value=stack_push(sys, sys->rstack);
  	value_init_token(value, (sys->ip));
  
***************
*** 215,221 ****
  void code_branch_ne(FSYSTEM *sys)
  {
- //	if(!stack_depth(sys->stack))
- //		VOID_THROW(sys, FS_UNDERFLOW);
- 
  	// FALSE, so branch
  	if(!fs_get_int(sys, -1))
--- 223,226 ----
***************
*** 238,244 ****
  
  	// OPTIMIZE:
- //	if(!fs_depth(sys))
- //		VOID_THROW(sys, FS_UNDERFLOW);
- 
  	count=fs_get_int(sys, -1);
  	fs_pop(sys);
--- 243,246 ----
***************
*** 272,277 ****
  		(*count)++;
  
  	// FALSE, so skip out
! 	if(!*count)
  	{
  		sys->ip++;
--- 274,284 ----
  		(*count)++;
  
+ 	// TRUE, jump back to the FOR
+ 	if(*count)
+ 	{
+ 		sys->ip+=*((int*)(sys->ip));
+ 	}
  	// FALSE, so skip out
! 	else
  	{
  		sys->ip++;
***************
*** 279,286 ****
  		return;
  	}
- 	else // TRUE, jump back to the FOR
- 	{
- 		sys->ip+=*((int*)(sys->ip));
- 	}
  
  }
--- 286,289 ----
***************
*** 340,346 ****
  
  	// ENTER the word by pushing our IP
! 	if(!(value=stack_push(sys, sys->rstack)))
! 		VOID_THROW(sys, FS_OVERFLOW);
! 
  	value_init_token(value, (sys->ip));
  
--- 343,347 ----
  
  	// ENTER the word by pushing our IP
! 	value=stack_push(sys, sys->rstack);
  	value_init_token(value, (sys->ip));
  
***************
*** 356,360 ****
  void code_exit_inner(FSYSTEM *sys)
  {
! 	VOID_THROW(sys, FS_READY);
  }
  
--- 357,367 ----
  void code_exit_inner(FSYSTEM *sys)
  {
! 	VOID_THROW(sys, FS_EXIT_INNER);
! }
! 
! 
! void code_fatal(FSYSTEM *sys)
! {
! 	VOID_THROW(sys, FS_UNHANDLED);
  }
  
***************
*** 378,379 ****
--- 385,491 ----
  }
  
+ 
+ // Interpreter that gets pushed with fs_load_input()
+ // TODO: Configurable delimiters?
+ void code_interpret(FSYSTEM *sys)
+ {
+ 	char *start;
+ 	FSYMREC *ptr;
+ 	int flags;
+ 
+ 	int i;
+ 	double f;
+ 	int len;
+ 
+ 	// BEGIN
+ 	if (parse_general(sys->in_source, WHITESPACES, WHITESPACES, &start, 
+ 		&(sys->in_parse), &(sys->in_source)))
+ 	{
+ 		len=sys->in_parse-start;
+ 
+ 		// Set pointer to start of current token
+ 		sys->in_token=start;
+ 
+ 		// If it's a space-delimited word in the dictionary...
+ 		if((ptr=voc_get_word(sys, start, len, NULL)))
+ 		{
+ 			flags=dict_get_flags(ptr);
+ 
+ 			// If it's an immediate word, or it's not in compile state...
+ 			if(flags&FS_IMMEDIATE||!(sys->state))
+ 			{
+ 				// if the word is COMPILE only, and it's not compile state...
+ 				if(flags&FS_COMPILE&&!(sys->state))
+ 				{
+ 					// Error
+ 					VOID_THROW(sys, FS_COMPILE_ONLY);
+ 				}
+ 				// Otherwise, execute the word!
+ 				else
+ 				{
+ 					// Word to execute
+ 					vm_load_word(sys, (FTOKEN*)ptr);
+ 
+ 					// AGAIN, our IP gets pushed if HL word
+ 					sys->ip=sys->interpreter;
+ 					ptr->exec(sys);
+ 					return;
+ 				}
+ 			}
+ 			else
+ 				compile_word(sys, ptr);
+ 		}
+ 		// Otherwise try to convert to a basic type
+ 		else
+ 		{
+ 			int tok_type;
+ 			
+ 			tok_type=parse_get_token(start, &start, &(sys->in_parse),
+ 				&(sys->in_source));
+ 
+ 			len=sys->in_parse-start;
+ 
+ 			switch(tok_type)
+ 			{
+ 				case TOK_INT:
+ 					i=atoi(start);
+ 	
+ 					if(sys->state)
+ 						compile_int(sys, i);
+ 					else
+ 						fs_push_int(sys, i);
+ 					break;
+ 
+ 				case TOK_FLOAT:
+ 					f=atof(start);
+ 
+ 					if(sys->state)
+ 						compile_float(sys, f);
+ 					else
+ 						fs_push_float(sys, f);
+ 
+ 					break;
+ 
+ 				case TOK_STRING:
+ 
+ 					if(sys->state)
+ 						compile_string(sys, start, len);
+ 					else
+ 						fs_push_string_span(sys, start, len);
+ 
+ 					break;
+ 
+ 				default:
+ 					VOID_THROW(sys, FS_NOT_FOUND);
+ 			}
+ 		}
+ 	
+ 		// AGAIN
+ 		sys->ip=sys->interpreter;
+ 		return;
+ 	}
+ 
+ 	// LEAVE
+ 	sys_input_drop(sys);
+ 	code_exit_fast(sys);
+ }

Index: fsystem.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.c,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -d -r1.13 -r1.14
*** fsystem.c	31 Jul 2004 21:51:13 -0000	1.13
--- fsystem.c	5 Aug 2004 04:18:37 -0000	1.14
***************
*** 112,117 ****
  #include "fsystem.h"
  
- #define WHITESPACES	" \r\n\t"
- 
  #define DEFAULT_STACK_SIZE	8
  
--- 112,115 ----
***************
*** 163,168 ****
  {
  	"ok",
! 	"ready",
  	"pause",
  	"bye",
  };
--- 161,168 ----
  {
  	"ok",
! 	"exit inner",
! 	"step",
  	"pause",
+ 	"reset",
  	"bye",
  };
***************
*** 194,197 ****
--- 194,200 ----
  		return FS_OUT_OF_MEMORY;
  
+ 	if(!((sys->cstack)=stack_new(return_stack_size)))
+ 		return FS_OUT_OF_MEMORY;
+ 
  	sys->temp_str=NULL;
  	sys->result_str=NULL;
***************
*** 209,220 ****
  	sys->shared=NULL;
  
! 	sys->exit_inner=(FTOKEN*)OPCODE(OP_EXIT_INNER); // TODO:
  
  	sys->vm_inner=vm_inner_loop;
! 	sys->ip=NULL;
  	sys->w=NULL;
  	sys->env=NULL;
! 	sys->running=FALSE;
! //	sys->tib[0]=0;
  
  	sys->icount=0;
--- 212,223 ----
  	sys->shared=NULL;
  
! 	sys->interpreter=&code_soft_interpreter[0];
! 	sys->exit_inner=&code_soft_exit_inner[0];
  
  	sys->vm_inner=vm_inner_loop;
! 	sys->ip=sys->exit_inner;
  	sys->w=NULL;
  	sys->env=NULL;
! 	sys->stepping=FALSE;
  
  	sys->icount=0;
***************
*** 482,486 ****
  // TODO: Use vocab stack to search dict
  // - Use this function instead of dict_get() in all relevent functions
! static FSYMREC *voc_get_word(FSYSTEM *sys, char *name, unsigned len, 
  	FDICT **where)
  {
--- 485,489 ----
  // TODO: Use vocab stack to search dict
  // - Use this function instead of dict_get() in all relevent functions
! FSYMREC *voc_get_word(FSYSTEM *sys, char *name, unsigned len, 
  	FDICT **where)
  {
***************
*** 700,704 ****
--- 703,709 ----
  	// Get the stack if it exists
  	if(!(stack=get_stack(sys, stack_off)))
+ 	{
  		VOID_THROW(sys, FS_BAD_TYPE);
+ 	}
  
  	stack_pop_to(sys, sys->stack, stack);
***************
*** 722,726 ****
--- 727,733 ----
  		func(sys);
  	else
+ 	{
  		VOID_THROW(sys, FS_NULL);
+ 	}
  }
  
***************
*** 1167,1175 ****
  	FDICT *where;
  
- /*
- 	if(!(sym=voc_get_word(sys, name, strlen(name), &where)))
- 		VOID_THROW(sys, FS_NOT_FOUND);
- */
- 
  	in_get_word(sys, offset, &sym);
  
--- 1174,1177 ----
***************
*** 1188,1197 ****
  	// If executing, abort so that high-level words can't forget 
  	// themselves and continue running. That would crash it!
! 	if(stack_depth(sys->rstack))
  	{
  		// Cancel any high-level execution
! 		vm_abort(sys);
! 		sys->ip=&(sys->exit_inner);
! 		//VOID_THROW(sys, FS_EXECUTION_ABORTED);
  	}
  }
--- 1190,1199 ----
  	// If executing, abort so that high-level words can't forget 
  	// themselves and continue running. That would crash it!
! 	if(stack_depth(sys->rstack)!=stack_depth(sys->istack))
  	{
  		// Cancel any high-level execution
! //		vm_abort(sys);
! //		fs_clear_input(sys);
! 		VOID_THROW(sys, FS_EXECUTION_ABORTED);
  	}
  }
***************
*** 1327,1341 ****
  
  
! static void load_word(FSYSTEM *sys, int handle)
! {
! 	// Ret running word to handle
! 	sys->w=(FTOKEN*)handle;
! 	// This will get us out of the loop when the program is finished 
! 	// executing
! 	sys->ip=&(sys->exit_inner);
! }
! 
! 
! static void input_drop(FSYSTEM *sys)
  {
  	// pop top string value from the stack (bye bye!)
--- 1329,1333 ----
  
  
! void sys_input_drop(FSYSTEM *sys)
  {
  	// pop top string value from the stack (bye bye!)
***************
*** 1368,1536 ****
  
  
! void do_interpret(FSYSTEM *sys)
  {
! 	char *start;
! 	FSYMREC *ptr;
! 	int flags;
  
! 	int i;
! 	double f;
! 	int len;
  
! 	// Continue while there are words in the buffer
! 	// TODO: Configurable delimiters?
! 	if(parse_general(sys->in_source, WHITESPACES, WHITESPACES, &start, 
! 		&(sys->in_parse), &(sys->in_source)))
  	{
! 		len=sys->in_parse-start;
  
! 		// Set pointer to start of current token
! 		sys->in_token=start;
  
! 		// If it's a space-delimited word in the dictionary...
! 		if((ptr=voc_get_word(sys, start, len, NULL)))
  		{
! 			flags=dict_get_flags(ptr);
! 
! 			// If it's an immediate word, or it's not in compile state...
! 			if(flags&FS_IMMEDIATE||!(sys->state))
! 			{
! 				// if the word is COMPILE only, and it's not compile state...
! 				if(flags&FS_COMPILE&&!(sys->state))
  				{
! 					// Error
! 					VOID_THROW(sys, FS_COMPILE_ONLY);
  				}
- 				// Otherwise, execute the word!
  				else
  				{
! 					load_word(sys, (int)ptr);
! 					vm_inner_loop(sys);
  				}
! 			}
! 			else
! 				compile_word(sys, ptr);
! 		}
! 		// Otherwise try to convert to a basic type
! 		else
! 		{
! 			int tok_type;
! 			
! 			tok_type=parse_get_token(start, &start, &(sys->in_parse),
! 				&(sys->in_source));
! 
! 			len=sys->in_parse-start;
! 
! 			switch(tok_type)
! 			{
! 				case TOK_INT:
! 					i=atoi(start);
! //					sscanf(temp, "%d", &i);
! 	
! 					if(sys->state)
! 						compile_int(sys, i);
! 					else
! 						fs_push_int(sys, i);
! 					break;
! 
! 				case TOK_FLOAT:
! 					f=atof(start);
! //					sscanf(temp, "%f", &f);
! 
! 					if(sys->state)
! 						compile_float(sys, f);
! 					else
! 						fs_push_float(sys, f);
! 
! 					break;
! 
! 				case TOK_STRING:
! 
! 					if(sys->state)
! 						compile_string(sys, start, len);
! 					else
! 						fs_push_string_span(sys, start, len);
! 
! 					break;
! 
! 				default:
! 					VOID_THROW(sys, FS_NOT_FOUND);
! 			}
! 		}
! 
! 		return;
! 	}
! 
! 	input_drop(sys);
! 
! 	VOID_THROW(sys, FS_READY);
! }
  
  
! // TODO: Run either interpret-mode or execute-mode words
! int outer_loop(FSYSTEM *sys)
! {
! 	int ret, exit=FALSE;
! 	jmp_buf env;
  
! 	sys->env=&env;
! 	ret=setjmp(env);
  
! 	for(;;)
! 	{
! 		if(!ret)
! 		{
! 			// TODO: Use istack depth?
! 			if((sys->in_source)&&(!sys->running))
! 			{
! 				do_interpret(sys);
! 			}
! 			// Do a step() or run() on the current word
! 			else if (sys->w)
! 			{
! 				sys->vm_inner(sys);
! 			}
! 			else
! 			{
! 				ret=FS_OK;
! 				break;
! 			}
! 		}
! 		// If there are words left in the string, and there's no error 
! 		// exception
! 		else if(ret==FS_READY)
! 		{
! 			// run mode, keep interpreting
! 			if((sys->vm_inner==vm_inner_loop)&&(sys->in_source))
! 			{
! 				do_interpret(sys);
! 			}
! 			// step mode, break out with an FS_OK to indicate there's more
! 			// to do
! 			else if(sys->vm_inner==vm_inner_step&&(sys->running))
! 			{
! 				ret=FS_READY;
! 				break;
! 			}
! 			// All done?
! 			else if(!(sys->in_source))
! 			{
! 				ret=FS_OK;
  				break;
- 			}
- 		}
- 		// Either it's an error, or a custom return value
- 		else
- 		{
- 			// If it's an error, clear the return stack, abort compile, etc.
- 			if(ret<FS_OK)
- 				vm_abort(sys);
- 			break;
- 		}
- 
- 		if(sys->vm_inner==vm_inner_step)
- 		{
- 			ret=FS_READY;
- 			break;
  		}
  	}
--- 1360,1427 ----
  
  
! static int run_system(FSYSTEM *sys)
  {
! 	int ret, quit=FALSE;
! 	jmp_buf env;
  
! 	// Can't call this when we're already running the system
! 	if(sys->env)
! 	{
! 		INT_THROW(sys, FS_EXECUTION_ABORTED);
! 	}
  
! 	// System is faulted, can't run until it's cleared
! 	if(sys->result<FS_OK)
  	{
! 		INT_THROW(sys, sys->result);
! 	}
  
! 	sys->env=&env;
! 	ret=setjmp(env);
  
! 	while(!quit)
! 	{
! 		switch(ret)
  		{
! 			case FS_OK:
! 				if(sys->w)
  				{
! 					// Execute any currently loaded word
! 					sys->w->func(sys);
! 				}
! 				if(sys->ip)
! 				{
! 					sys->vm_inner(sys);
! 
! 					ret=FS_UNHANDLED;
! 					quit=TRUE;
  				}
  				else
  				{
! 					ret=FS_UNHANDLED;
! 					quit=TRUE;
  				}
! 				break;
  
+ 			// Exited normally
+ 			case FS_EXIT_INNER:
+ 				ret=FS_OK;
+ 				quit=TRUE;
  
! 				vm_reset(sys);
! 				break;
  
! 			// Either it's an error, or a custom return value
! 			default:
! 				// If it's an error, clear the return stack, abort compile, etc.
! 				if(ret<FS_OK)
! 				{
! 					// Clear this for safety, but leave rest of system intact
! 					compile_abort(sys);
! 				}
  
! 				// Result value, system can be re-entered using fs_run()
! 				quit=TRUE;
  				break;
  		}
  	}
***************
*** 1546,1557 ****
  {
  	if(!handle)
  		INT_THROW(sys, FS_NULL);
  
! 	// Dump return stack
! 	vm_abort(sys);
  
! 	load_word(sys, handle);
  
- 	// Ready to execute with fs_step() or fs_run()
  	return FS_OK;
  }
--- 1437,1451 ----
  {
  	if(!handle)
+ 	{
  		INT_THROW(sys, FS_NULL);
+ 	}
  
! 	if(!sys->ip)
! 	{
! 		sys->ip=sys->exit_inner;
! 	}
  
! 	vm_load_word(sys, (FTOKEN*)handle);
  
  	return FS_OK;
  }
***************
*** 1560,1563 ****
--- 1454,1458 ----
  int fs_clear_input(FSYSTEM *sys)
  {
+ 
  	stack_remove(sys, sys->istack, stack_depth(sys->istack));
  	sys->in_load=NULL;
***************
*** 1570,1573 ****
--- 1465,1478 ----
  
  
+ int fs_reset(FSYSTEM *sys)
+ {
+ 	vm_abort(sys);
+ 	fs_clear_input(sys);
+ 	sys->result=FS_OK;
+ 
+ 	return FS_OK;
+ }
+ 
+ 
  // Attach a string to the string buffer
  int fs_load_input(FSYSTEM *sys, char *input)
***************
*** 1578,1586 ****
  	if(!input)
  	{
! 		if(stack_depth(sys->istack))
! 		{
! 			input_drop(sys);
! 		}
! 		return FS_OK;
  	}
  
--- 1483,1487 ----
  	if(!input)
  	{
! 		INT_THROW(sys, FS_NULL);
  	}
  
***************
*** 1599,1603 ****
  	if(!value)
  	{
! 		return FS_OVERFLOW;
  	}
  
--- 1500,1504 ----
  	if(!value)
  	{
! 		INT_THROW(sys, FS_OVERFLOW);
  	}
  
***************
*** 1611,1614 ****
--- 1512,1521 ----
  	sys->in_token=NULL;
  
+ 	// Store whatever's currently on the stack
+ 	vm_push_ip(sys, sys->interpreter);
+ 
+ //	vm_load_word(sys, (FTOKEN*)OPCODE(OP_INTERPRET));
+ 	sys->w=NULL;
+ 
  	return FS_OK;
  }
***************
*** 1639,1647 ****
  int fs_step(FSYSTEM *sys)
  {
- 	if(!sys->w&&!sys->in_source)
- 		return FS_NULL; // TODO: NOTHING_TO_RUN
- 
  	sys->vm_inner=vm_inner_step;
! 	return outer_loop(sys);
  }
  
--- 1546,1551 ----
  int fs_step(FSYSTEM *sys)
  {
  	sys->vm_inner=vm_inner_step;
! 	return run_system(sys);
  }
  
***************
*** 1658,1666 ****
  int fs_run(FSYSTEM *sys)
  {
- 	if(!sys->w&&!sys->in_source)
- 		return FS_NULL;
- 
  	sys->vm_inner=vm_inner_loop;
! 	return outer_loop(sys);
  }
  
--- 1562,1567 ----
  int fs_run(FSYSTEM *sys)
  {
  	sys->vm_inner=vm_inner_loop;
! 	return run_system(sys);
  }
  
***************
*** 1985,1988 ****
--- 1886,1892 ----
  		stack_delete(sys->istack);
  
+ 	if(sys->cstack)
+ 		stack_delete(sys->cstack);
+ 
  	if(sys->temp_str)
  		free(sys->temp_str);

Index: main.c
===================================================================
RCS file: /cvsroot/forthy/forthy/main.c,v
retrieving revision 1.20
retrieving revision 1.21
diff -C2 -d -r1.20 -r1.21
*** main.c	31 Jul 2004 21:51:13 -0000	1.20
--- main.c	5 Aug 2004 04:18:37 -0000	1.21
***************
*** 312,319 ****
  
  	// Validate types for above same reason
! 	if(!(size=fs_strlen(sys, -1, NULL)))
! 		fs_throw(sys, FS_BAD_TYPE);
! 	if(!(size2=fs_strlen(sys, -2, &temp2)))
! 		fs_throw(sys, FS_BAD_TYPE);
  	
  	size+=size2+1;
--- 312,317 ----
  
  	// Validate types for above same reason
! 	size=fs_strlen(sys, -1, NULL);
! 	size2=fs_strlen(sys, -2, &temp2);
  	
  	size+=size2+1;
***************
*** 775,778 ****
--- 773,791 ----
  
  
+ void word_forget(FSYSTEM *sys)
+ {
+ 	char *str; 
+ 
+ 	fs_scan_word(sys);
+ 
+ 	str=fs_get_string(sys, -1);
+ 	fs_pop(sys);
+ 	fs_push_word(sys, str);
+ 
+ 	fs_forget(sys, -1);
+ 	fs_pop(sys);
+ }
+ 
+ 
  void word_zot(FSYSTEM *sys)
  {
***************
*** 1504,1507 ****
--- 1517,1521 ----
  
  
+ 
  void word_evaluate(FSYSTEM *sys)
  {
***************
*** 1511,1515 ****
  	fs_pop(sys);
  	fs_load_input(sys, str);
- 	fs_throw(sys, FS_READY);
  }
  
--- 1525,1528 ----
***************
*** 1568,1572 ****
  	fs_register_func(sys, ".", word_dot, FS_DEFAULT);
  	fs_register_func(sys, "cr", word_cr, FS_DEFAULT);
! 	fs_register_func(sys, "(forget)", word_xtforget, FS_DEFAULT);
  	fs_register_func(sys, "recurse", fs_recurse, FS_IMMEDIATE);
  	fs_register_func(sys, "literal", fs_literal, FS_IMMEDIATE);
--- 1581,1586 ----
  	fs_register_func(sys, ".", word_dot, FS_DEFAULT);
  	fs_register_func(sys, "cr", word_cr, FS_DEFAULT);
! 	fs_register_func(sys, "'forget", word_xtforget, FS_DEFAULT);
! 	fs_register_func(sys, "forget", word_forget, FS_DEFAULT);
  	fs_register_func(sys, "recurse", fs_recurse, FS_IMMEDIATE);
  	fs_register_func(sys, "literal", fs_literal, FS_IMMEDIATE);
***************
*** 1652,1656 ****
  	fs_register_func(sys, "$load", word_strload, FS_DEFAULT);
  	fs_register_func(sys, ".s", show_stack, FS_DEFAULT);
! //	fs_register_func(sys, "evaluate", word_evaluate, FS_DEFAULT);
  
  	fs_push_int(sys, '\n');
--- 1666,1670 ----
  	fs_register_func(sys, "$load", word_strload, FS_DEFAULT);
  	fs_register_func(sys, ".s", show_stack, FS_DEFAULT);
! 	fs_register_func(sys, "evaluate", word_evaluate, FS_DEFAULT);
  
  	fs_push_int(sys, '\n');
***************
*** 1731,1742 ****
  	handle=fs_find_word_handle(sys, "test2");
  	fs_load_word(sys, handle);
  
! 	while(fs_step(sys)==FS_READY)
! 	{
  		printf("*");
- 	}
  
  	for(i=0; i<5; i++)
  		fs_step(sys);
  }
  
--- 1745,1760 ----
  	handle=fs_find_word_handle(sys, "test2");
  	fs_load_word(sys, handle);
+ 	fs_run(sys);
  
! 	fs_load_word(sys, handle);
! 	while(fs_step(sys)==FS_STEP)
  		printf("*");
  
  	for(i=0; i<5; i++)
  		fs_step(sys);
+ 
+ 	fs_load_input(sys, "1 . 2 . 3 .");
+ 	while(fs_step(sys)==FS_STEP)
+ 		printf("$");
  }
  
***************
*** 1822,1825 ****
--- 1840,1845 ----
  	fs_strlen(sys, -1, NULL);
  	fs_pop(sys);
+ 
+ 	fs_reset(sys);
  }
  
***************
*** 1875,1885 ****
  			if(ret<FS_OK)
  			{
- 				// Clear the stack
- 				fs_remove(&sys, fs_depth(&sys));
- 				
  				printf("ERROR at '%s': ", fs_get_last_token(&sys));
  				printf("%s\n", fs_get_result_string(&sys, ret));
  			
! 				fs_clear_input(&sys);
  			}
  			else
--- 1895,1906 ----
  			if(ret<FS_OK)
  			{
  				printf("ERROR at '%s': ", fs_get_last_token(&sys));
  				printf("%s\n", fs_get_result_string(&sys, ret));
+ 				printf("Stack was ");
+ 				show_stack(&sys);
  			
! 				fs_reset(&sys);
! 				fs_remove(&sys, fs_depth(&sys));
! 				fs_voc_clear(&sys);
  			}
  			else

Index: fmachine.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fmachine.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** fmachine.h	13 Nov 2003 07:18:04 -0000	1.2
--- fmachine.h	5 Aug 2004 04:18:37 -0000	1.3
***************
*** 2,5 ****
--- 2,6 ----
  #define __FMACHINE_H__
  
+ #include "ftype.h"
  #include "fstack.h"
  
***************
*** 7,10 ****
--- 8,12 ----
  void	vm_inner_step(FSYSTEM *sys);
  void	vm_abort(FSYSTEM *sys);
+ void	vm_reset(FSYSTEM *sys);
  
  // Return stack access
***************
*** 12,18 ****
--- 14,30 ----
  int		vm_get_int(FSYSTEM *sys, int offset);
  #define vm_pop(sys)	stack_pop(sys, (sys)->rstack);
+ #define vm_pop_cs(sys)	stack_pop(sys, (sys)->cstack);
+ 
  int		vm_cs_roll(FSYSTEM *sys, int count);
  int		vm_get_type(FSYSTEM *sys, int offset);
  
+ void	vm_push_ip(FSYSTEM *sys, FXTOKEN new_ip);
+ void	vm_load_word(FSYSTEM *sys, FTOKEN *word);
+ 
+ // Control-flow stack
+ void vm_push_marker(FSYSTEM *sys, int i);
+ int vm_get_marker(FSYSTEM *sys, int offset);
+ 
+ 
  // Inline
  

Index: test.txt
===================================================================
RCS file: /cvsroot/forthy/forthy/test.txt,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** test.txt	26 Jul 2004 03:28:30 -0000	1.5
--- test.txt	5 Aug 2004 04:18:37 -0000	1.6
***************
*** 7,12 ****
  ; immediate
  
! : forget
! 	' (forget)
  ;
  
--- 7,13 ----
  ; immediate
  
! ( This forget is evil, since it can forget running code, so it causes an error )
! : forget!
! 	' 'forget
  ;
  

Index: forthy.dsp
===================================================================
RCS file: /cvsroot/forthy/forthy/forthy.dsp,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** forthy.dsp	24 Jul 2004 07:21:17 -0000	1.5
--- forthy.dsp	5 Aug 2004 04:18:37 -0000	1.6
***************
*** 68,72 ****
  # PROP Target_Dir ""
  # ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
! # ADD CPP /nologo /W3 /Gm /GX /ZI /Od /I "..\fortify" /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /D "FORTIFY" /FR /YX /FD /GZ /c
  # ADD BASE RSC /l 0x1009 /d "_DEBUG"
  # ADD RSC /l 0x1009 /d "_DEBUG"
--- 68,72 ----
  # PROP Target_Dir ""
  # ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
! # ADD CPP /nologo /W3 /WX /Gm /GX /ZI /Od /I "..\fortify" /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /D "FORTIFY" /FR /YX /FD /GZ /c
  # ADD BASE RSC /l 0x1009 /d "_DEBUG"
  # ADD RSC /l 0x1009 /d "_DEBUG"