forthy-cvs

[Forthy-cvs] forthy fcode.c,1.12,1.13 fcode.h,1.8,1.9 fcompile.c,1.12,1.13 fcompile.h,1.2,1.3 fdict.c,1.5,1.6 fdict.h,1.2,1.3 finternal.h,1.4,1.5 fmachine.c,1.7,1.8 fsystem.c,1.23,1.24 fsystem.h,1.16,1.17 ftype.h,1.9,1.10 fvalue.c,1.9,1.10 fvalue.h,1.5,1.6 main.c,1.27,1.28 test.txt,1.6,1.7

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

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

Modified Files:
	fcode.c fcode.h fcompile.c fcompile.h fdict.c fdict.h 
	finternal.h fmachine.c fsystem.c fsystem.h ftype.h fvalue.c 
	fvalue.h main.c test.txt 
Log Message:
- initial modifications to support 64-bit architectures
- changed ordering of some opcode IP accesses

Index: finternal.h
===================================================================
RCS file: /cvsroot/forthy/forthy/finternal.h,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** finternal.h	13 Aug 2004 15:56:54 -0000	1.4
--- finternal.h	8 Mar 2006 03:47:32 -0000	1.5
***************
*** 9,18 ****
  
  // 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);
  
--- 9,18 ----
  
  // Stuff that shouldn't be visible through FSYSTEM.H
! void	in_push_wordref(FSYSTEM *sys, FHEADER *ptr);
! void	in_get_word(FSYSTEM *sys, int offset, FHEADER **ptr);
  
  // Dictionary word access
! FHEADER *voc_new_word(FSYSTEM *sys, char *name, int flags);
! FHEADER *voc_get_word(FSYSTEM *sys, char *name, unsigned len, 
  	FDICT **where);
  

Index: fvalue.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fvalue.c,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** fvalue.c	27 Jan 2006 19:14:19 -0000	1.9
--- fvalue.c	8 Mar 2006 03:47:32 -0000	1.10
***************
*** 36,40 ****
  
  /*
! void value_init_symbol(FVALUE *value, FSYMREC *sym)
  {
  	value->type=FS_SYMBOL;
--- 36,40 ----
  
  /*
! void value_init_symbol(FVALUE *value, FHEADER *sym)
  {
  	value->type=FS_SYMBOL;
***************
*** 141,145 ****
  
  
! FREF *value_new_wordref(FSYMREC *rec)
  {
  	FREF *ref;
--- 141,145 ----
  
  
! FREF *value_new_wordref(FHEADER *rec)
  {
  	FREF *ref;
***************
*** 188,192 ****
  
  
! int value_init_wordref(FVALUE *value, FSYMREC *refsrc)
  {
  	FREF *ref;
--- 188,192 ----
  
  
! int value_init_wordref(FVALUE *value, FHEADER *refsrc)
  {
  	FREF *ref;
***************
*** 221,225 ****
  	// Shift the type ID
  	dest->type=src->type;
! 	src->type=FS_NONE;
  }
  
--- 221,225 ----
  	// Shift the type ID
  	dest->type=src->type;
! 	src->type=FS_NIL;
  }
  
***************
*** 290,294 ****
  	{
  		FREF *ref;
! 		FSYMREC *rec;
  
  		rec=value_dewordref(src);
--- 290,294 ----
  	{
  		FREF *ref;
! 		FHEADER *rec;
  
  		rec=value_dewordref(src);
***************
*** 338,342 ****
  	// doesn't corrupt the heap
  	value->value.v=NULL;
! 	value->type=FS_NONE;
  
  	// Kill any references pointing at this value (due to the value being 
--- 338,342 ----
  	// doesn't corrupt the heap
  	value->value.v=NULL;
! 	value->type=FS_NIL;
  
  	// Kill any references pointing at this value (due to the value being 
***************
*** 352,356 ****
  // Kill a FREF pointing to this word
  /*
! void value_kill_wordref(FSYMREC *value)
  {
  	if(value->back_ref)
--- 352,356 ----
  // Kill a FREF pointing to this word
  /*
! void value_kill_wordref(FHEADER *value)
  {
  	if(value->back_ref)
***************
*** 664,668 ****
  
  
! FSYMREC *value_dewordref(FVALUE *data)
  {
  	if(data->type!=FS_WORDREF)
--- 664,668 ----
  
  
! FHEADER *value_dewordref(FVALUE *data)
  {
  	if(data->type!=FS_WORDREF)
***************
*** 719,723 ****
  
  /*
! FSYMREC *value_dewordref(FVALUE *data)
  {
  	if((data->type!=FS_WORDREF)||(!data->value.ref))
--- 719,723 ----
  
  /*
! FHEADER *value_dewordref(FVALUE *data)
  {
  	if((data->type!=FS_WORDREF)||(!data->value.ref))

Index: fcompile.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fcompile.c,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** fcompile.c	27 Jan 2006 19:14:19 -0000	1.12
--- fcompile.c	8 Mar 2006 03:47:32 -0000	1.13
***************
*** 39,43 ****
  #define CELL_INC(sys)	if(!inc_cell(sys)) \
  						VOID_THROW(sys, FS_OUT_OF_MEMORY);
- 
  // Control Flow
  static char colon_tag[] = "colon";
--- 39,42 ----
***************
*** 53,57 ****
  {
  	sys->current=NULL;
! 	sys->code=NULL;
  	sys->code_off=0;
  	sys->code_size=0;
--- 52,56 ----
  {
  	sys->current=NULL;
! 	sys->code.cell=NULL;
  	sys->code_off=0;
  	sys->code_size=0;
***************
*** 64,69 ****
  {
  	// Delete compiling code block
! 	if(sys->code)
! 		free(sys->code);
  
  	// Delete currently compiling word
--- 63,68 ----
  {
  	// Delete compiling code block
! 	if(sys->code.cell)
! 		free(sys->code.cell);
  
  	// Delete currently compiling word
***************
*** 77,81 ****
  	// Don't want to delete any strings etc. unless we are in the compile
  	// state!
! 	if(!sys->code)
  		return;
  
--- 76,80 ----
  	// Don't want to delete any strings etc. unless we are in the compile
  	// state!
! 	if(!sys->code.cell)
  		return;
  
***************
*** 90,99 ****
  	sys->code_size+=CODE_CHUNK_SIZE;
  	
! 	if(sys->code)
! 		sys->code=(void**)realloc(sys->code, (sys->code_size)*CELL_SIZE);
  	else
! 		sys->code=(void**)malloc((sys->code_size)*CELL_SIZE);
  
! 	if(!sys->code)
  		return FALSE;
  	
--- 89,98 ----
  	sys->code_size+=CODE_CHUNK_SIZE;
  	
! 	if(sys->code.cell)
! 		sys->code.cell=realloc(sys->code.cell, (sys->code_size)*CELL_SIZE);
  	else
! 		sys->code.cell=malloc((sys->code_size)*CELL_SIZE);
  
! 	if(!sys->code.cell)
  		return FALSE;
  	
***************
*** 115,122 ****
  
  
! void compile_word(FSYSTEM *sys, FSYMREC *sym)
  {
  	// Put address of word in current cell
! 	sys->code[sys->code_off]=sym;
  
  	// Allocate a new cell
--- 114,121 ----
  
  
! void compile_word(FSYSTEM *sys, FHEADER *sym)
  {
  	// Put address of word in current cell
! 	sys->code.cell[sys->code_off]=sym;
  
  	// Allocate a new cell
***************
*** 125,132 ****
  
  
! void compile_postponed(FSYSTEM *sys, FSYMREC *sym)
  {
  	// "postpone" compilation by compiling with OP_COMPILE
! 	sys->code[sys->code_off]=OPCODE(OP_COMPILE);
  
  	CELL_INC(sys);
--- 124,131 ----
  
  
! void compile_postponed(FSYSTEM *sys, FHEADER *sym)
  {
  	// "postpone" compilation by compiling with OP_COMPILE
! 	sys->code.cell[sys->code_off]=OPCODE(OP_COMPILE);
  
  	CELL_INC(sys);
***************
*** 140,144 ****
  {
  	// Compile the LITERAL opcode for int
! 	sys->code[sys->code_off]=OPCODE(OP_LITINT);
  
  	// Allocate a new cell
--- 139,143 ----
  {
  	// Compile the LITERAL opcode for int
! 	sys->code.cell[sys->code_off]=OPCODE(OP_LITINT);
  
  	// Allocate a new cell
***************
*** 146,150 ****
  
  	// Store the value
! 	sys->code[sys->code_off]=(void*)value;
  
  	// Allocate a new cell
--- 145,149 ----
  
  	// Store the value
! 	sys->code.cell[sys->code_off]=(FCELL)value;
  
  	// Allocate a new cell
***************
*** 159,163 ****
  
  	// Compile the LITERAL opcode for float
! 	sys->code[sys->code_off]=OPCODE(OP_LITFLOAT);
  
  	// 2 "cells" for a double
--- 158,162 ----
  
  	// Compile the LITERAL opcode for float
! 	sys->code.cell[sys->code_off]=OPCODE(OP_LITFLOAT);
  
  	// 2 "cells" for a double
***************
*** 171,175 ****
  
  	// Write the double
! 	data=(double*)&(sys->code[off]);
  	*data=(double)value;
  
--- 170,174 ----
  
  	// Write the double
! 	data=(double*)&(sys->code.cell[off]);
  	*data=(double)value;
  
***************
*** 188,201 ****
  
  	// Compile the LITERAL opcode for string
! 	sys->code[sys->code_off]=OPCODE(OP_LITSTRING);
  
  	CELL_INC(sys);
  
  	count_off=sys->code_off;
! 	(int)(sys->code[sys->code_off])=0;
  
  	CELL_INC(sys);
  
! 	ptr=(char*)&(sys->code[sys->code_off]);
  
  	// Compile the string
--- 187,200 ----
  
  	// Compile the LITERAL opcode for string
! 	sys->code.cell[sys->code_off]=OPCODE(OP_LITSTRING);
  
  	CELL_INC(sys);
  
  	count_off=sys->code_off;
! 	(int)(sys->code.cell[sys->code_off])=0;
  
  	CELL_INC(sys);
  
! 	ptr=(char*)&(sys->code.cell[sys->code_off]);
  
  	// Compile the string
***************
*** 207,214 ****
  		{
  			dest=0;
! 			((int)(sys->code[count_off]))++;
  
  			CELL_INC(sys);
! 			ptr=(char*)&(sys->code[sys->code_off]);
  		}
  		
--- 206,213 ----
  		{
  			dest=0;
! 			((int)(sys->code.cell[count_off]))++;
  
  			CELL_INC(sys);
! 			ptr=(char*)&(sys->code.cell[sys->code_off]);
  		}
  		
***************
*** 224,231 ****
  
  
! void compile_wordref(FSYSTEM *sys, FSYMREC *ptr)
  {
  	// Compile the LITERAL opcode for int
! 	sys->code[sys->code_off]=OPCODE(OP_LITWORDREF);
  
  	// Allocate a new cell
--- 223,230 ----
  
  
! void compile_wordref(FSYSTEM *sys, FHEADER *ptr)
  {
  	// Compile the LITERAL opcode for int
! 	sys->code.cell[sys->code_off]=OPCODE(OP_LITWORDREF);
  
  	// Allocate a new cell
***************
*** 233,237 ****
  
  	// Store the value
! 	sys->code[sys->code_off]=(void*)ptr;
  
  	// Allocate a new cell
--- 232,236 ----
  
  	// Store the value
! 	sys->code.cell[sys->code_off]=ptr;
  
  	// Allocate a new cell
***************
*** 278,282 ****
  		case FS_WORDREF:
  		{
! 			FSYMREC *ptr;
  
  			in_get_word(sys, offset, &ptr);
--- 277,281 ----
  		case FS_WORDREF:
  		{
! 			FHEADER *ptr;
  
  			in_get_word(sys, offset, &ptr);
***************
*** 295,299 ****
  void fs_postpone(FSYSTEM *sys, int offset)
  {
! 	FSYMREC *ptr;
  	int flags;
  
--- 294,298 ----
  void fs_postpone(FSYSTEM *sys, int offset)
  {
! 	FHEADER *ptr;
  	int flags;
  
***************
*** 319,323 ****
  
  	// Compile the current word
! 	sys->code[sys->code_off]=sys->current;
  
  	CELL_INC(sys);
--- 318,322 ----
  
  	// Compile the current word
! 	sys->code.cell[sys->code_off]=sys->current;
  
  	CELL_INC(sys);
***************
*** 430,437 ****
  
  		// Use the supplied break opcode for type of loop
! 		sys->code[off-1]=opcode;
  
  		// Backpatch the BREAK to point past end of the loop
! 		sys->code[off]=(void*)((sys->code_off+2)-off); // Relative
  	}
  }
--- 429,436 ----
  
  		// Use the supplied break opcode for type of loop
! 		sys->code.cell[off-1]=opcode;
  
  		// Backpatch the BREAK to point past end of the loop
! 		sys->code.cell[off]=(FCELL)((sys->code_off+2)-off); // Relative
  	}
  }
***************
*** 440,446 ****
  void fs_compile_begin(FSYSTEM *sys, char *name)
  {
! 	FSYMREC *sym;
  
! 	if(sys->state==COMPILE_STATE||sys->code)
  	{
  		VOID_THROW(sys, FS_NESTED_COMPILE);
--- 439,445 ----
  void fs_compile_begin(FSYSTEM *sys, char *name)
  {
! 	FHEADER *sym;
  
! 	if(sys->state==COMPILE_STATE||sys->code.cell)
  	{
  		VOID_THROW(sys, FS_NESTED_COMPILE);
***************
*** 483,487 ****
  void fs_compile_resume(FSYSTEM *sys)
  {
! 	if(!sys->code)
  		VOID_THROW(sys, FS_COMPILE_ONLY);
  									
--- 482,486 ----
  void fs_compile_resume(FSYSTEM *sys)
  {
! 	if(!sys->code.cell)
  		VOID_THROW(sys, FS_COMPILE_ONLY);
  									
***************
*** 499,503 ****
  
  	// Make sure we're in compile state
! 	if(sys->state!=COMPILE_STATE||!sys->code)
  	{
  		VOID_THROW(sys, FS_COMPILE_ONLY);
--- 498,502 ----
  
  	// Make sure we're in compile state
! 	if(sys->state!=COMPILE_STATE||!sys->code.cell)
  	{
  		VOID_THROW(sys, FS_COMPILE_ONLY);
***************
*** 508,512 ****
  	if(sys->code_off<sys->code_size)
  	{
! 		if(!(sys->code=realloc(sys->code, (sys->code_off+1)*CELL_SIZE)))
  		{
  			VOID_THROW(sys, FS_OUT_OF_MEMORY);
--- 507,511 ----
  	if(sys->code_off<sys->code_size)
  	{
! 		if(!(sys->code.cell=realloc(sys->code.cell, (sys->code_off+1)*CELL_SIZE)))
  		{
  			VOID_THROW(sys, FS_OUT_OF_MEMORY);
***************
*** 519,523 ****
  
  	// Compile the EXIT opcode, close the word
! 	sys->code[sys->code_off]=OPCODE(OP_EXIT);
  
  	// Relocate the code block to the current dict entry
--- 518,522 ----
  
  	// Compile the EXIT opcode, close the word
! 	sys->code.cell[sys->code_off]=OPCODE(OP_EXIT);
  
  	// Relocate the code block to the current dict entry
***************
*** 538,542 ****
  
  	// Put branchnif in current cell
! 	sys->code[sys->code_off]=OPCODE(OP_BRANCH_NE);
  
  	// Allocate a new cell for forward branch resolution
--- 537,541 ----
  
  	// Put branchnif in current cell
! 	sys->code.cell[sys->code_off]=OPCODE(OP_BRANCH_NE);
  
  	// Allocate a new cell for forward branch resolution
***************
*** 576,580 ****
  		// 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
--- 575,579 ----
  		// Backpatch the branch to point to current offset
  		off=vm_get_marker(sys, -1);
! 		sys->code.cell[off]=(FCELL)(sys->code_off-off); // Relative
  
  		// Dump offset
***************
*** 620,629 ****
  
  	// Compile BRANCH_NE back to dest
! 	sys->code[sys->code_off]=OPCODE(OP_BRANCH_NE);
  
  	CELL_INC(sys);
  
  	// Compile offset
! 	sys->code[sys->code_off]=(void*)(-(sys->code_off-off)); // Relative
  
  	CELL_INC(sys);
--- 619,628 ----
  
  	// Compile BRANCH_NE back to dest
! 	sys->code.cell[sys->code_off]=OPCODE(OP_BRANCH_NE);
  
  	CELL_INC(sys);
  
  	// Compile offset
! 	sys->code.cell[sys->code_off]=(FCELL)(-(sys->code_off-off)); // Relative
  
  	CELL_INC(sys);
***************
*** 651,659 ****
  
  	// Compile BRANCH back to dest
! 	sys->code[sys->code_off]=OPCODE(OP_BRANCH);
  
  	CELL_INC(sys);
  
! 	sys->code[sys->code_off]=(void*)(-(sys->code_off-off)); // Relative
  
  	CELL_INC(sys);
--- 650,658 ----
  
  	// Compile BRANCH back to dest
! 	sys->code.cell[sys->code_off]=OPCODE(OP_BRANCH);
  
  	CELL_INC(sys);
  
! 	sys->code.cell[sys->code_off]=(FCELL)(-(sys->code_off-off)); // Relative
  
  	CELL_INC(sys);
***************
*** 687,691 ****
  
  	// Put branchn in current cell
! 	sys->code[sys->code_off]=OPCODE(OP_BRANCH);
  
  	// Allocate a new cell for forward branch resolution
--- 686,690 ----
  
  	// Put branchn in current cell
! 	sys->code.cell[sys->code_off]=OPCODE(OP_BRANCH);
  
  	// Allocate a new cell for forward branch resolution
***************
*** 706,710 ****
  
  	// Put FOR in current cell
! 	sys->code[sys->code_off]=OPCODE(OP_FOR);
  
  	// Allocate a new cell for forward branch resolution
--- 705,709 ----
  
  	// Put FOR in current cell
! 	sys->code.cell[sys->code_off]=OPCODE(OP_FOR);
  
  	// Allocate a new cell for forward branch resolution
***************
*** 739,753 ****
  
  	// Compile FOR/NEXT opcode
! 	sys->code[sys->code_off]=OPCODE(OP_NEXT);
  
  	CELL_INC(sys);
  
  	// Offset pointing back to FOR (plus a cell)
! 	sys->code[sys->code_off]=(void*)(-(sys->code_off-off-1)); // Relative
  
  	CELL_INC(sys);
  
  	// Backpatch the 0 FOR to point to ending offset
! 	sys->code[off]=(void*)(sys->code_off-off); // Relative
  }
  
--- 738,752 ----
  
  	// Compile FOR/NEXT opcode
! 	sys->code.cell[sys->code_off]=OPCODE(OP_NEXT);
  
  	CELL_INC(sys);
  
  	// Offset pointing back to FOR (plus a cell)
! 	sys->code.cell[sys->code_off]=(FCELL)(-(sys->code_off-off-1)); // Relative
  
  	CELL_INC(sys);
  
  	// Backpatch the 0 FOR to point to ending offset
! 	sys->code.cell[off]=(FCELL)(sys->code_off-off); // Relative
  }
  
***************
*** 760,764 ****
  
  	// Put fatal in current cell, patch during resolve
! 	sys->code[sys->code_off]=OPCODE(OP_FATAL);
  
  	// Allocate a new cell for forward break resolution
--- 759,763 ----
  
  	// Put fatal in current cell, patch during resolve
! 	sys->code.cell[sys->code_off]=OPCODE(OP_FATAL);
  
  	// Allocate a new cell for forward break resolution
***************
*** 778,782 ****
  
  	// Compile DOES in current cell
! 	sys->code[sys->code_off]=OPCODE(OP_DOES);
  
  	CELL_INC(sys);
--- 777,781 ----
  
  	// Compile DOES in current cell
! 	sys->code.cell[sys->code_off]=OPCODE(OP_DOES);
  
  	CELL_INC(sys);

Index: fdict.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fdict.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** fdict.h	27 Jul 2004 04:31:02 -0000	1.2
--- fdict.h	8 Mar 2006 03:47:32 -0000	1.3
***************
*** 11,35 ****
  int		dict_attached(FDICT *dict);
  
! FSYMREC *dict_new(FDICT *table, char *name, FSYMREC *vocab, int flags);
! FSYMREC *dict_get(FDICT *table, char *name, unsigned len, FSYMREC *id);
  
! FSYMREC *dict_get_last(FDICT *table);
! FSYMREC *dict_get_first(FDICT *table);
! FSYMREC *dict_get_next(FSYMREC *rec);
! FSYMREC *dict_get_prev(FSYMREC *rec);
  
! FDICT	*dict_get_word_dict(FSYMREC *sym);
  
! int		dict_del(FDICT *table, FSYMREC *sym);
! int		dict_forget(FDICT *table, FSYMREC *rec);
  
! void	dict_set_exec(FSYMREC *rec, FCFUNC exec);
! void	dict_set_code(FSYMREC *rec, void **code);
! char	*dict_get_name(FSYMREC *rec);
! char	*dict_set_name(FSYMREC *rec, char *name);
  
! int		dict_get_flags(FSYMREC *rec);
! void	dict_set_flags(FSYMREC *rec, int flags);
! FVALUE	*dict_value(FSYMREC *sym);
  
  
--- 11,35 ----
  int		dict_attached(FDICT *dict);
  
! FHEADER *dict_new(FDICT *table, char *name, FHEADER *vocab, int flags);
! FHEADER *dict_get(FDICT *table, char *name, unsigned len, FHEADER *id);
  
! FHEADER *dict_get_last(FDICT *table);
! FHEADER *dict_get_first(FDICT *table);
! FHEADER *dict_get_next(FHEADER *rec);
! FHEADER *dict_get_prev(FHEADER *rec);
  
! FDICT	*dict_get_word_dict(FHEADER *sym);
  
! int		dict_del(FDICT *table, FHEADER *sym);
! int		dict_forget(FDICT *table, FHEADER *rec);
  
! void	dict_set_exec(FHEADER *rec, FCFUNC exec);
! void	dict_set_code(FHEADER *rec, FPTR code);
! char	*dict_get_name(FHEADER *rec);
! char	*dict_set_name(FHEADER *rec, char *name);
  
! int		dict_get_flags(FHEADER *rec);
! void	dict_set_flags(FHEADER *rec, int flags);
! FVALUE	*dict_value(FHEADER *sym);
  
  

Index: fcode.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fcode.h,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** fcode.h	6 Dec 2004 03:50:56 -0000	1.8
--- fcode.h	8 Mar 2006 03:47:32 -0000	1.9
***************
*** 4,8 ****
  #include "ftype.h"
  
- 
  #define OPCODE(code)	(&code_table[(code)].exec)
  #define OPFUNC(code)	(code_table[(code)].exec)
--- 4,7 ----

Index: ftype.h
===================================================================
RCS file: /cvsroot/forthy/forthy/ftype.h,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** ftype.h	27 Jan 2006 19:14:19 -0000	1.9
--- ftype.h	8 Mar 2006 03:47:32 -0000	1.10
***************
*** 23,27 ****
  #endif
  
! typedef enum{FS_NONE=0, FS_INT, FS_FLOAT, FS_STRING, FS_FUNC, FS_WORDREF, 
  	FS_TOKEN, FS_TABLE, FS_STACK, FS_REF, FS_USER, FS_COUNT} FTYPE;
  
--- 23,27 ----
  #endif
  
! typedef enum{FS_NIL=0, FS_INT, FS_FLOAT, FS_STRING, FS_FUNC, FS_WORDREF, 
  	FS_TOKEN, FS_TABLE, FS_STACK, FS_REF, FS_USER, FS_COUNT} FTYPE;
  
***************
*** 47,55 ****
  
  
  typedef union FTOKEN FTOKEN;
  typedef FTOKEN **FXTOKEN;
  typedef struct FSYSTEM FSYSTEM;
  typedef struct FVALUE FVALUE;
! typedef struct FSYMREC FSYMREC;
  typedef struct FOPCODE FOPCODE;
  typedef struct FSTACK FSTACK;
--- 47,57 ----
  
  
+ 
  typedef union FTOKEN FTOKEN;
+ 
  typedef FTOKEN **FXTOKEN;
  typedef struct FSYSTEM FSYSTEM;
  typedef struct FVALUE FVALUE;
! typedef struct FHEADER FHEADER;
  typedef struct FOPCODE FOPCODE;
  typedef struct FSTACK FSTACK;
***************
*** 59,66 ****
  typedef void (*FCFUNC)(FSYSTEM*);
  
! //typedef FSYMREC *FDICT;
  typedef struct FDICT FDICT;
  typedef struct FDICTNODE FDICTNODE;
  
  
  struct FDICTNODE
--- 61,88 ----
  typedef void (*FCFUNC)(FSYSTEM*);
  
! //typedef FHEADER *FDICT;
  typedef struct FDICT FDICT;
  typedef struct FDICTNODE FDICTNODE;
  
+ typedef double FFLOAT;
+ typedef int FINT;
+ typedef char FBYTE;
+ typedef void* FCELL;
+ typedef char* FSTR;
+ 
+ // Sizes of everything in bytes
+ #define CELL_SIZE		sizeof(FCELL)
+ #define FLOAT_SIZE		sizeof(FFLOAT)
+ #define INT_SIZE		sizeof(FINT)
+ 
+ typedef union
+ {
+ 	FBYTE	*b;
+ 	FINT	*i;
+ 	FFLOAT	*f;
+ 	FTOKEN	**xt;
+ 	FCELL	*cell;
+ 	FSTR	*str;
+ }FPTR;
  
  struct FDICTNODE
***************
*** 75,93 ****
  	int refcount;
  	int attached;
! 	FSYMREC *list;
! 	// FSYMREC *fence;
  };
  
  
- 
  /*
! struct FUSER
  {
! 	// void *data;
! 	// get
! 	// set
  	// destroy
- 	// copy
- 	// convert (FSYSTEM* sys, type)
  };
  */
--- 97,119 ----
  	int refcount;
  	int attached;
! 	FHEADER *list;
! 	// FHEADER *fence;
  };
  
  
  /*
! struct FTYPEINTERFACE
  {
! 	// toint
! 	// toreal
! 	// tostring
! 	
! 	// fetch
! 	// store
! 	// push
! 	// pop
! 	// index
! 
  	// destroy
  };
  */
***************
*** 101,105 ****
  	{
  		FVALUE *value;
! 		FSYMREC *word;
  	}item;
  };
--- 127,131 ----
  	{
  		FVALUE *value;
! 		FHEADER *word;
  	}item;
  };
***************
*** 126,130 ****
  };
  
! struct FSYMREC
  {
  	FCFUNC exec;	// Code Field
--- 152,162 ----
  };
  
! struct FOPCODE
! {
! 	FCFUNC exec;	// Code Field
! 	char *name;		// Name Field
! };
! 
! struct FHEADER
  {
  	FCFUNC exec;	// Code Field
***************
*** 132,143 ****
  	int flags;		// FS_IMMEDIATE, FS_COMPILE
  	FVALUE data;	// Parameter Field -- Make as a pointer?
! 	void **code;	// Code data array for compiled words
  
  	// char *user	// USER var, for source code or whatever
  
! 	FSYMREC *prev;
! 	FSYMREC *next;	// Link Field
  
! 	FSYMREC *vocab;	// Vocabulary ID for this word
  	FDICT *dict;	// Parent dictionary
  
--- 164,175 ----
  	int flags;		// FS_IMMEDIATE, FS_COMPILE
  	FVALUE data;	// Parameter Field -- Make as a pointer?
! 	FPTR code;		// Code data array for compiled words
  
  	// char *user	// USER var, for source code or whatever
  
! 	FHEADER *prev;
! 	FHEADER *next;	// Link Field
  
! 	FHEADER *vocab;	// Vocabulary ID for this word
  	FDICT *dict;	// Parent dictionary
  
***************
*** 145,154 ****
  };
  
- struct FOPCODE
- {
- 	FCFUNC exec;	// Code Field
- 	char *name;		// Name Field
- };
- 
  // Execution token union
  union FTOKEN
--- 177,180 ----
***************
*** 156,163 ****
  	FCFUNC func;
  	FOPCODE code;
! 	FSYMREC rec; 
  };
  
! // TODO: Execution token union... pointer to FSYMREC union with FCFUNC. Then I
  // can change the "symbol" type into a "token" type. This token will be useful
  // for the code thread, allowing for overlap of word and function types, and I
--- 182,189 ----
  	FCFUNC func;
  	FOPCODE code;
! 	FHEADER rec; 
  };
  
! // TODO: Execution token union... pointer to FHEADER union with FCFUNC. Then I
  // can change the "symbol" type into a "token" type. This token will be useful
  // for the code thread, allowing for overlap of word and function types, and I

Index: fdict.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fdict.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** fdict.c	27 Jan 2006 19:14:19 -0000	1.5
--- fdict.c	8 Mar 2006 03:47:32 -0000	1.6
***************
*** 14,18 ****
  	+ dict_forget()
  
! 	+ FSYMREC accessor functions
  	+ Forth CFA/PFA like behaviour
  	+ Decouple 
--- 14,18 ----
  	+ dict_forget()
  
! 	+ FHEADER accessor functions
  	+ Forth CFA/PFA like behaviour
  	+ Decouple 
***************
*** 58,66 ****
  
  
! FSYMREC *dict_new(FDICT *table, char *name, FSYMREC *vocab, int flags)
  {
! 	FSYMREC *ptr;
  
! 	if(!(ptr=malloc(sizeof(FSYMREC))))
  		return NULL;
  
--- 58,66 ----
  
  
! FHEADER *dict_new(FDICT *table, char *name, FHEADER *vocab, int flags)
  {
! 	FHEADER *ptr;
  
! 	if(!(ptr=malloc(sizeof(FHEADER))))
  		return NULL;
  
***************
*** 77,81 ****
  	ptr->next=table->list;
  	ptr->prev=NULL;	
! 	ptr->code=NULL;
  	ptr->flags=flags;
  	ptr->back_ref=NULL;
--- 77,81 ----
  	ptr->next=table->list;
  	ptr->prev=NULL;	
! 	ptr->code.cell=NULL;
  	ptr->flags=flags;
  	ptr->back_ref=NULL;
***************
*** 93,97 ****
  
  
! FDICT *dict_get_word_dict(FSYMREC *sym)
  {
  	return sym->dict;
--- 93,97 ----
  
  
! FDICT *dict_get_word_dict(FHEADER *sym)
  {
  	return sym->dict;
***************
*** 99,105 ****
  
  
! FSYMREC *dict_get(FDICT *table, char *name, unsigned len, FSYMREC *id)
  {
! 	FSYMREC *ptr=table->list;
  
  	while(ptr)
--- 99,105 ----
  
  
! FHEADER *dict_get(FDICT *table, char *name, unsigned len, FHEADER *id)
  {
! 	FHEADER *ptr=table->list;
  
  	while(ptr)
***************
*** 119,123 ****
  
  
! FVALUE *dict_value(FSYMREC *sym)
  {
  	if(sym)
--- 119,123 ----
  
  
! FVALUE *dict_value(FHEADER *sym)
  {
  	if(sym)
***************
*** 128,132 ****
  
  
! int dict_del(FDICT *table, FSYMREC *ptr)
  {
  	if(!ptr)
--- 128,132 ----
  
  
! int dict_del(FDICT *table, FHEADER *ptr)
  {
  	if(!ptr)
***************
*** 151,157 ****
  
  	// High-level word code
! 	if(ptr->code)
  	{
! 		free(ptr->code);
  
  	}
--- 151,157 ----
  
  	// High-level word code
! 	if(ptr->code.cell)
  	{
! 		free(ptr->code.cell);
  
  	}
***************
*** 168,174 ****
  
  
! int dict_forget(FDICT *table, FSYMREC *rec)
  {
! 	FSYMREC *new_end, *ptr, *temp;
  
  	new_end=rec->next;
--- 168,174 ----
  
  
! int dict_forget(FDICT *table, FHEADER *rec)
  {
! 	FHEADER *new_end, *ptr, *temp;
  
  	new_end=rec->next;
***************
*** 193,197 ****
  
  
! void dict_set_exec(FSYMREC *rec, FCFUNC exec)
  {
  	rec->exec=exec;	
--- 193,197 ----
  
  
! void dict_set_exec(FHEADER *rec, FCFUNC exec)
  {
  	rec->exec=exec;	
***************
*** 199,209 ****
  
  
! void dict_set_code(FSYMREC *rec, void **code)
  {
! 	rec->code=code;	
  }
  
  
! int dict_get_flags(FSYMREC *rec)
  {
  	return rec->flags;
--- 199,209 ----
  
  
! void dict_set_code(FHEADER *rec, FPTR code)
  {
! 	rec->code = code;	
  }
  
  
! int dict_get_flags(FHEADER *rec)
  {
  	return rec->flags;
***************
*** 211,215 ****
  
  
! void dict_set_flags(FSYMREC *rec, int flags)
  {
  	rec->flags=flags;
--- 211,215 ----
  
  
! void dict_set_flags(FHEADER *rec, int flags)
  {
  	rec->flags=flags;
***************
*** 217,223 ****
  
  
! FSYMREC *dict_get_last(FDICT *table)
  {
! 	FSYMREC *ptr, *rec = NULL;
  
  	ptr=table->list;
--- 217,223 ----
  
  
! FHEADER *dict_get_last(FDICT *table)
  {
! 	FHEADER *ptr, *rec = NULL;
  
  	ptr=table->list;
***************
*** 237,243 ****
  
  
! FSYMREC *dict_get_first(FDICT *table)
  {
! 	FSYMREC *ptr, *rec=NULL;
  
  	ptr=table->list;
--- 237,243 ----
  
  
! FHEADER *dict_get_first(FDICT *table)
  {
! 	FHEADER *ptr, *rec=NULL;
  
  	ptr=table->list;
***************
*** 256,260 ****
  
  
! FSYMREC *dict_get_next(FSYMREC *rec)
  {
  	return rec->next;
--- 256,260 ----
  
  
! FHEADER *dict_get_next(FHEADER *rec)
  {
  	return rec->next;
***************
*** 262,266 ****
  
  
! FSYMREC *dict_get_prev(FSYMREC *rec)
  {
  	return rec->prev;
--- 262,266 ----
  
  
! FHEADER *dict_get_prev(FHEADER *rec)
  {
  	return rec->prev;
***************
*** 268,272 ****
  
  
! char *dict_get_name(FSYMREC *rec)
  {
  	return rec->name;
--- 268,272 ----
  
  
! char *dict_get_name(FHEADER *rec)
  {
  	return rec->name;
***************
*** 275,279 ****
  
  // Rename
! char *dict_set_name(FSYMREC *rec, char *name)
  {
  	if(rec->name)
--- 275,279 ----
  
  // Rename
! char *dict_set_name(FHEADER *rec, char *name)
  {
  	if(rec->name)
***************
*** 314,318 ****
  int dict_release(FDICT *table)
  {
! 	FSYMREC *ptr;
  	int symcount=0;
  
--- 314,318 ----
  int dict_release(FDICT *table)
  {
! 	FHEADER *ptr;
  	int symcount=0;
  

Index: fvalue.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fvalue.h,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** fvalue.h	27 Jan 2006 19:14:19 -0000	1.5
--- fvalue.h	8 Mar 2006 03:47:32 -0000	1.6
***************
*** 26,30 ****
  
  // Dictionary word related functions
! int		value_init_wordref(FVALUE *value, FSYMREC *refsrc);
  int		value_unwordref(FVALUE *data);
  
--- 26,30 ----
  
  // Dictionary word related functions
! int		value_init_wordref(FVALUE *value, FHEADER *refsrc);
  int		value_unwordref(FVALUE *data);
  
***************
*** 134,138 ****
  
  
! //FSYMREC *value_dewordref(FVALUE *data);
  
  #define value_dewordref(data) \
--- 134,138 ----
  
  
! //FHEADER *value_dewordref(FVALUE *data);
  
  #define value_dewordref(data) \

Index: test.txt
===================================================================
RCS file: /cvsroot/forthy/forthy/test.txt,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** test.txt	5 Aug 2004 04:18:37 -0000	1.6
--- test.txt	8 Mar 2006 03:47:32 -0000	1.7
***************
*** 81,82 ****
--- 81,88 ----
  load loadtest1.txt
  
+ : teststrings "foobar!" . ;
+ : testfloats 1.2 3.4 + ;
+ : testints 1 2 + 3 * ;
+ : testwords teststrings testfloats testints + . ;
+ 
+ testwords

Index: fmachine.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fmachine.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** fmachine.c	6 Aug 2004 02:52:04 -0000	1.7
--- fmachine.c	8 Mar 2006 03:47:32 -0000	1.8
***************
*** 52,56 ****
  {
  	// NEXT
! 	sys->w=*(sys)->ip++;
  	sys->w->func(sys);
  	VOID_THROW(sys, FS_STEP);
--- 52,56 ----
  {
  	// NEXT
! 	sys->w=*(sys)->ip.cell++;
  	sys->w->func(sys);
  	VOID_THROW(sys, FS_STEP);
***************
*** 64,68 ****
  	for(;;)
  	{
! 		w=*(sys)->ip++;
  
  		// NEXT
--- 64,68 ----
  	for(;;)
  	{
! 		w=*(sys)->ip.cell++;
  
  		// NEXT
***************
*** 81,85 ****
  {
  	sys->w=NULL;
! 	sys->ip=code_soft_exit_inner;
  }
  
--- 81,85 ----
  {
  	sys->w=NULL;
! 	sys->ip.cell=code_soft_exit_inner;
  }
  
***************
*** 185,192 ****
  	// - 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;
  }
  
--- 185,192 ----
  	// - Push the current IP onto the return stack
  	value=stack_push(sys, sys->rstack);
! 	value_init_token(value, (sys->ip.xt));
  
  	// - Set IP to the new value
! 	sys->ip.cell=new_ip;
  }
  

Index: fcode.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fcode.c,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** fcode.c	6 Dec 2004 03:50:56 -0000	1.12
--- fcode.c	8 Mar 2006 03:47:32 -0000	1.13
***************
*** 27,31 ****
  	+ LIT for literals... LIT_INT, LIT_FLOAT, LIT_STR (will need a special 
  	constant string table, using pointers to access the strings)
! 		+ LIT_WORD, take FSYMREC and push an FREF onto the stack
  */
  
--- 27,31 ----
  	+ LIT for literals... LIT_INT, LIT_FLOAT, LIT_STR (will need a special 
  	constant string table, using pointers to access the strings)
! 		+ LIT_WORD, take FHEADER and push an FREF onto the stack
  */
  
***************
*** 109,114 ****
  
  	// IP is currently pointing at our int... SKIP over it
! 	sys->ip++;
! 	fs_push_int(sys, *((int*)(sys->ip-1)));
  }
  
--- 109,114 ----
  
  	// IP is currently pointing at our int... SKIP over it
! 	fs_push_int(sys, *sys->ip.i);
! 	sys->ip.cell++;
  }
  
***************
*** 116,132 ****
  void code_lit_float(FSYSTEM *sys)
  {
! 	// As with lit_int, but the "float" is 2 cells cast as a double
! 	sys->ip+=2; // double is 8 bytes, or 2 dwords
! 	fs_push_float(sys, *((double*)(sys->ip-2)));
  }
  
  
  void code_lit_string(FSYSTEM *sys)
  {
  	// Take the following cell's address (which will be a pointer to a string 
  	// in the code block itself) and push the string value onto the stack
! 	sys->ip+=2;
! 	fs_push_string(sys, ((char*)(sys->ip-1)));
! 	sys->ip+=*((int*)(sys->ip-2));
  }
  
--- 116,134 ----
  void code_lit_float(FSYSTEM *sys)
  {
! 	// As with lit_int, but the "float" may be 1 or 2 cells, depending in architecture
! 	fs_push_float(sys, *sys->ip.f);
! 	sys->ip.cell += FLOAT_CELLS; 
  }
  
  
+ // TODO: instead use refcounted strings in dictionary
  void code_lit_string(FSYSTEM *sys)
  {
  	// Take the following cell's address (which will be a pointer to a string 
  	// in the code block itself) and push the string value onto the stack
! 
! //	sys->ip.cell += 2; // One cell for address, and one for count
! 	fs_push_string(sys, ((char*)(sys->ip.cell+1)));
! 	sys->ip.cell += *((FINT*)(sys->ip.cell)) + 2; // skip the count and address
  }
  
***************
*** 135,140 ****
  {
  	// IP is currently pointing at our int... SKIP over it
! 	sys->ip++;
! 	in_push_wordref(sys, *((FSYMREC**)(sys->ip-1)));
  }
  
--- 137,142 ----
  {
  	// IP is currently pointing at our int... SKIP over it
! 	in_push_wordref(sys, *((FHEADER**)(sys->ip.cell)));
! 	sys->ip.cell++;
  }
  
***************
*** 160,164 ****
  void code_dodefer(FSYSTEM *sys)
  {
! 	FSYMREC *ptr;
  
  	if(!(ptr=value_dewordref(&((sys->w)->rec.data))))
--- 162,166 ----
  void code_dodefer(FSYSTEM *sys)
  {
! 	FHEADER *ptr;
  
  	if(!(ptr=value_dewordref(&((sys->w)->rec.data))))
***************
*** 175,186 ****
  void code_compile(FSYSTEM *sys)
  {
! 	FSYMREC *ptr;
  
  	NEED_COMPILE(sys);
  
! 	// IP is currently pointing at our postponed word, skip it
! 	sys->ip++;
  
! 	ptr=*((FSYMREC**)(sys->ip-1));
  
  	compile_word(sys, ptr);
--- 177,188 ----
  void code_compile(FSYSTEM *sys)
  {
! 	FHEADER *ptr;
  
  	NEED_COMPILE(sys);
  
! 	ptr=*((FHEADER**)(sys->ip.cell));
  
! 	// IP is currently pointing at our postponed word, skip it
! 	sys->ip.cell++;
  
  	compile_word(sys, ptr);
***************
*** 194,201 ****
  	// - Push the current IP onto the return stack
  	value=stack_push(sys, sys->rstack);
! 	value_init_token(value, (sys->ip));
  
  	// - Set IP to the start of the word's code
! 	sys->ip=(FXTOKEN)&((sys->w)->rec.code[0]);
  }
  
--- 196,203 ----
  	// - Push the current IP onto the return stack
  	value=stack_push(sys, sys->rstack);
! 	value_init_token(value, sys->ip.xt);
  
  	// - Set IP to the start of the word's code
! 	sys->ip.cell=(FXTOKEN)&((sys->w)->rec.code.cell[0]);
  }
  
***************
*** 217,221 ****
  
  	// - Set IP to popped XT
! 	sys->ip=value_get_token(value);	
  
  	stack_pop(sys, sys->rstack);
--- 219,223 ----
  
  	// - Set IP to popped XT
! 	sys->ip.cell=value_get_token(value);	
  
  	stack_pop(sys, sys->rstack);
***************
*** 228,237 ****
  	if(!fs_get_int(sys, -1))
  	{
! 		sys->ip+=*((int*)(sys->ip));
  	}
  	// TRUE, so just SKIP the branch offset
  	else
  	{
! 		sys->ip++;
  	}
  
--- 230,239 ----
  	if(!fs_get_int(sys, -1))
  	{
! 		sys->ip.cell+=*((FINT*)(sys->ip.cell));
  	}
  	// TRUE, so just SKIP the branch offset
  	else
  	{
! 		sys->ip.cell++;
  	}
  
***************
*** 251,260 ****
  	if(!count)
  	{
! 		sys->ip+=*((int*)(sys->ip));
  	}
  	// TRUE, so just SKIP the branch offset
  	else
  	{
! 		sys->ip++;
  
  		// Put our FOR count on the return stack
--- 253,262 ----
  	if(!count)
  	{
! 		sys->ip.cell+=*((FINT*)(sys->ip.cell));
  	}
  	// TRUE, so just SKIP the branch offset
  	else
  	{
! 		sys->ip.cell++;
  
  		// Put our FOR count on the return stack
***************
*** 279,288 ****
  	if(*count)
  	{
! 		sys->ip+=*((int*)(sys->ip));
  	}
  	// FALSE, so skip out
  	else
  	{
! 		sys->ip++;
  		vm_pop(sys);
  		return;
--- 281,290 ----
  	if(*count)
  	{
! 		sys->ip.cell+=*((FINT*)(sys->ip.cell));
  	}
  	// FALSE, so skip out
  	else
  	{
! 		sys->ip.cell++;
  		vm_pop(sys);
  		return;
***************
*** 294,298 ****
  void code_branch(FSYSTEM *sys)
  {
! 	sys->ip+=*((int*)(sys->ip));
  }
  
--- 296,300 ----
  void code_branch(FSYSTEM *sys)
  {
! 	sys->ip.cell+=*((FINT*)(sys->ip.cell));
  }
  
***************
*** 301,305 ****
  {
  	// Branch to the specified offset
! 	sys->ip+=*((int*)(sys->ip));
  
  	// Drop the for iterator
--- 303,307 ----
  {
  	// Branch to the specified offset
! 	sys->ip.cell+=*((FINT*)(sys->ip.cell));
  
  	// Drop the for iterator
***************
*** 319,323 ****
  void code_does(FSYSTEM *sys)
  {
! 	FSYMREC *ptr;
  
  	// Get last word
--- 321,325 ----
  void code_does(FSYSTEM *sys)
  {
! 	FHEADER *ptr;
  
  	// Get last word
***************
*** 326,336 ****
  
  	// If code is not NULL, throw error
! 	if(ptr->code)
  		VOID_THROW(sys, FS_ERROR); // TODO: Can't compiled to already compiled word
  
  	// Compile code for last word that points to the following word in the 
  	// current code thread
! 	ptr->code=(void**)malloc(CELL_SIZE);
! 	ptr->code[0]=sys->ip;
  	
  	// Set last word's exec to DODOES
--- 328,338 ----
  
  	// If code is not NULL, throw error
! 	if(ptr->code.cell)
  		VOID_THROW(sys, FS_ERROR); // TODO: Can't compiled to already compiled word
  
  	// Compile code for last word that points to the following word in the 
  	// current code thread
! 	ptr->code.cell=malloc(CELL_SIZE);
! 	ptr->code.cell[0]=sys->ip.cell;
  	
  	// Set last word's exec to DODOES
***************
*** 348,352 ****
  	// ENTER the word by pushing our IP
  	value=stack_push(sys, sys->rstack);
! 	value_init_token(value, (sys->ip));
  
  	// Put current word's DATA ref on the stack
--- 350,354 ----
  	// ENTER the word by pushing our IP
  	value=stack_push(sys, sys->rstack);
! 	value_init_token(value, sys->ip.xt);
  
  	// Put current word's DATA ref on the stack
***************
*** 355,359 ****
  	// Start executing code, by setting IP to the value pointed to by the 
  	// word's code
! 	sys->ip=(FXTOKEN)((sys->w)->rec.code[0]);
  }
  
--- 357,361 ----
  	// Start executing code, by setting IP to the value pointed to by the 
  	// word's code
! 	sys->ip.cell=(FXTOKEN)((sys->w)->rec.code.cell[0]);
  }
  
***************
*** 396,400 ****
  {
  	char *start;
! 	FSYMREC *ptr;
  	int flags;
  
--- 398,402 ----
  {
  	char *start;
! 	FHEADER *ptr;
  	int flags;
  
***************
*** 433,437 ****
  
  					// AGAIN, our IP gets pushed if HL word
! 					sys->ip=code_soft_interpreter;
  					// EXECUTE
  					ptr->exec(sys);
--- 435,439 ----
  
  					// AGAIN, our IP gets pushed if HL word
! 					sys->ip.cell=code_soft_interpreter;
  					// EXECUTE
  					ptr->exec(sys);
***************
*** 488,492 ****
  	
  		// AGAIN
! 		sys->ip=code_soft_interpreter;
  		return;
  	}
--- 490,494 ----
  	
  		// AGAIN
! 		sys->ip.cell=code_soft_interpreter;
  		return;
  	}

Index: main.c
===================================================================
RCS file: /cvsroot/forthy/forthy/main.c,v
retrieving revision 1.27
retrieving revision 1.28
diff -C2 -d -r1.27 -r1.28
*** main.c	27 Jan 2006 19:14:19 -0000	1.27
--- main.c	8 Mar 2006 03:47:32 -0000	1.28
***************
*** 118,122 ****
  
  			case FS_STACK:
! 				printf("<stack %d/%d> ", fs_stack_depth(sys, i+1), 
  					fs_stack_size(sys, i+1));
  				break;
--- 118,122 ----
  
  			case FS_STACK:
! 				printf("<stack:%d/%d> ", fs_stack_depth(sys, i+1), 
  					fs_stack_size(sys, i+1));
  				break;
***************
*** 130,139 ****
  				if(type>=FS_USER)
  				{
! 					printf("<%s %p> ", fs_get_type_name(sys, type), 
  						fs_get_user(sys, i+1));
  				}
  				else
  				{
! 					printf("?(%p) ", (void*)fs_get_void(sys, i+1));
  				}
  		}
--- 130,139 ----
  				if(type>=FS_USER)
  				{
! 					printf("<%s:%p> ", fs_get_type_name(sys, type), 
  						fs_get_user(sys, i+1));
  				}
  				else
  				{
! 					printf("<%s> ", fs_get_type_name(sys, type));
  				}
  		}
***************
*** 1178,1182 ****
  			temp=fs_get_int(sys, -1);
  			fs_pop(sys);
! 			// It's a NONE, end of list
  			if(!temp)
  			{
--- 1178,1182 ----
  			temp=fs_get_int(sys, -1);
  			fs_pop(sys);
! 			// It's a NIL, end of list
  			if(!temp)
  			{
***************
*** 1229,1234 ****
  			type=fs_get_type(sys, -1);
  
! 			// It's a NONE, end of list
! 			if(type==FS_NONE)
  			{
  				fs_pop(sys);
--- 1229,1234 ----
  			type=fs_get_type(sys, -1);
  
! 			// It's a NIL, end of list
! 			if(type==FS_NIL)
  			{
  				fs_pop(sys);
***************
*** 1304,1308 ****
  		temp=fs_get_int(sys, -1);
  		fs_pop(sys);
! 		// It's a NONE, end of list
  		if(!temp)
  		{
--- 1304,1308 ----
  		temp=fs_get_int(sys, -1);
  		fs_pop(sys);
! 		// It's a NIL, end of list
  		if(!temp)
  		{

Index: fcompile.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fcompile.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** fcompile.h	27 Jan 2006 19:14:19 -0000	1.2
--- fcompile.h	8 Mar 2006 03:47:32 -0000	1.3
***************
*** 2,10 ****
  #define __FCOMPILE_H__
  
  #define COMPILE_STATE	1
  #define INTEPRET_STATE	0
  
- #define CELL_SIZE		sizeof(void*) // bytes
- 
  #define NEED_COMPILE(sys)	if((sys)->state!=COMPILE_STATE)\
  							VOID_THROW(sys, FS_COMPILE_ONLY)
--- 2,19 ----
  #define __FCOMPILE_H__
  
+ #include "ftype.h"
+ 
+ #if INT_MAX < LONG_MAX
+ 	#define ARCH_BITS		64
+ 	#define FLOAT_CELLS	1
+ #else // assume 32-bit
+ 	#define ARCH_BITS		32
+ 	#define FLOAT_CELLS	2
+ #endif
+ 
+ 
  #define COMPILE_STATE	1
  #define INTEPRET_STATE	0
  
  #define NEED_COMPILE(sys)	if((sys)->state!=COMPILE_STATE)\
  							VOID_THROW(sys, FS_COMPILE_ONLY)
***************
*** 15,19 ****
  void	compile_abort(FSYSTEM *sys);
  
! void	compile_word(FSYSTEM *sys, FSYMREC *sym);
  void	compile_int(FSYSTEM *sys, int value);
  void	compile_float(FSYSTEM *sys, double value);
--- 24,28 ----
  void	compile_abort(FSYSTEM *sys);
  
! void	compile_word(FSYSTEM *sys, FHEADER *sym);
  void	compile_int(FSYSTEM *sys, int value);
  void	compile_float(FSYSTEM *sys, double value);

Index: fsystem.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.h,v
retrieving revision 1.16
retrieving revision 1.17
diff -C2 -d -r1.16 -r1.17
*** fsystem.h	27 Jan 2006 19:14:19 -0000	1.16
--- fsystem.h	8 Mar 2006 03:47:32 -0000	1.17
***************
*** 37,41 ****
  	FVALUE vcompile;		// "current" compilation vocabulary
  
! 	FXTOKEN ip;				// interpreter pointer
  	FTOKEN *w;				// work (usually currently executing word XT)
  	int state;				// compile, etc
--- 37,41 ----
  	FVALUE vcompile;		// "current" compilation vocabulary
  
! 	FPTR ip;				// interpreter pointer
  	FTOKEN *w;				// work (usually currently executing word XT)
  	int state;				// compile, etc
***************
*** 69,74 ****
  
  	*/
! 	FSYMREC *current;		// word being compiled
! 	void **code;			// compile code block
  	int code_off;			// offset into code block during compile
  	int code_size;			// current size of code block
--- 69,74 ----
  
  	*/
! 	FHEADER *current;		// word being compiled
! 	FPTR code;			// compile code block
  	int code_off;			// offset into code block during compile
  	int code_size;			// current size of code block

Index: fsystem.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.c,v
retrieving revision 1.23
retrieving revision 1.24
diff -C2 -d -r1.23 -r1.24
*** fsystem.c	27 Jan 2006 19:14:19 -0000	1.23
--- fsystem.c	8 Mar 2006 03:47:32 -0000	1.24
***************
*** 118,122 ****
  static char *_type_name[]=
  {
! 	"none",
  	"int", 
  	"float", 
--- 118,122 ----
  static char *_type_name[]=
  {
! 	"nil",
  	"int", 
  	"float", 
***************
*** 216,220 ****
  
  	sys->vm_inner=vm_inner_loop;
! 	sys->ip=code_soft_exit_inner;
  	sys->w=NULL;
  	sys->env=NULL;
--- 216,220 ----
  
  	sys->vm_inner=vm_inner_loop;
! 	sys->ip.cell=code_soft_exit_inner;
  	sys->w=NULL;
  	sys->env=NULL;
***************
*** 340,344 ****
  int fs_register_func(FSYSTEM *sys, char *name, FCFUNC func, int flags)
  {
! 	FSYMREC *ptr;
  
  	if(!name)
--- 340,344 ----
  int fs_register_func(FSYSTEM *sys, char *name, FCFUNC func, int flags)
  {
! 	FHEADER *ptr;
  
  	if(!name)
***************
*** 350,354 ****
  		INT_THROW(sys, FS_NULL);
  
! 	if(sys->state==COMPILE_STATE||sys->code)
  		INT_THROW(sys, FS_NESTED_COMPILE);
  
--- 350,354 ----
  		INT_THROW(sys, FS_NULL);
  
! 	if(sys->state==COMPILE_STATE||sys->code.cell)
  		INT_THROW(sys, FS_NESTED_COMPILE);
  
***************
*** 365,369 ****
  int fs_register_defer(FSYSTEM *sys, char *name, int flags)
  {
! 	FSYMREC *ptr;
  
  	if(!name)
--- 365,369 ----
  int fs_register_defer(FSYSTEM *sys, char *name, int flags)
  {
! 	FHEADER *ptr;
  
  	if(!name)
***************
*** 372,376 ****
  	}
  
! 	if(sys->state==COMPILE_STATE||sys->code)
  		INT_THROW(sys, FS_NESTED_COMPILE);
  
--- 372,376 ----
  	}
  
! 	if(sys->state==COMPILE_STATE||sys->code.cell)
  		INT_THROW(sys, FS_NESTED_COMPILE);
  
***************
*** 387,391 ****
  int fs_register_const(FSYSTEM *sys, char *name, int flags)
  {
! 	FSYMREC *sym;
  	FVALUE *value;
  
--- 387,391 ----
  int fs_register_const(FSYSTEM *sys, char *name, int flags)
  {
! 	FHEADER *sym;
  	FVALUE *value;
  
***************
*** 395,399 ****
  	}
  
! 	if(sys->state==COMPILE_STATE||sys->code)
  		INT_THROW(sys, FS_NESTED_COMPILE);
  
--- 395,399 ----
  	}
  
! 	if(sys->state==COMPILE_STATE||sys->code.cell)
  		INT_THROW(sys, FS_NESTED_COMPILE);
  
***************
*** 417,421 ****
  int fs_register_var(FSYSTEM *sys, char *name, int flags)
  {
! 	FSYMREC *sym;
  
  	if(!name)
--- 417,421 ----
  int fs_register_var(FSYSTEM *sys, char *name, int flags)
  {
! 	FHEADER *sym;
  
  	if(!name)
***************
*** 424,428 ****
  	}
  
! 	if(sys->state==COMPILE_STATE||sys->code)
  		INT_THROW(sys, FS_NESTED_COMPILE);
  
--- 424,428 ----
  	}
  
! 	if(sys->state==COMPILE_STATE||sys->code.cell)
  		INT_THROW(sys, FS_NESTED_COMPILE);
  
***************
*** 440,444 ****
  
  // Put a new word in the dict, including vocabulary ID from sys-vcompile
! FSYMREC *voc_new_word(FSYSTEM *sys, char *name, int flags)
  {
  	return dict_new(sys->table, name, value_dewordref(&sys->vcompile), 
--- 440,444 ----
  
  // Put a new word in the dict, including vocabulary ID from sys-vcompile
! FHEADER *voc_new_word(FSYSTEM *sys, char *name, int flags)
  {
  	return dict_new(sys->table, name, value_dewordref(&sys->vcompile), 
***************
*** 447,455 ****
  
  
! static FSYMREC *search_dictionaries(FSYSTEM *sys, char *name, unsigned len,
! 	FSYMREC *voc, FDICT **where)
  {
  	FDICTNODE *node;
! 	FSYMREC *word=NULL;
  
  	// Search the local dictionary
--- 447,455 ----
  
  
! static FHEADER *search_dictionaries(FSYSTEM *sys, char *name, unsigned len,
! 	FHEADER *voc, FDICT **where)
  {
  	FDICTNODE *node;
! 	FHEADER *word=NULL;
  
  	// Search the local dictionary
***************
*** 485,493 ****
  // 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)
  {
  	int depth;
! 	FSYMREC *word=NULL;
  
  	// Search the vocabulary
--- 485,493 ----
  // TODO: Use vocab stack to search dict
  // - Use this function instead of dict_get() in all relevent functions
! FHEADER *voc_get_word(FSYSTEM *sys, char *name, unsigned len, 
  	FDICT **where)
  {
  	int depth;
! 	FHEADER *word=NULL;
  
  	// Search the vocabulary
***************
*** 496,500 ****
  		int i;
  		FVALUE *value;
! 		FSYMREC *vocword;
  
  		depth=stack_depth(sys->vstack);
--- 496,500 ----
  		int i;
  		FVALUE *value;
! 		FHEADER *vocword;
  
  		depth=stack_depth(sys->vstack);
***************
*** 802,806 ****
  
  
! void in_push_wordref(FSYSTEM *sys, FSYMREC *ptr)
  {
  	FVALUE *value;
--- 802,806 ----
  
  
! void in_push_wordref(FSYSTEM *sys, FHEADER *ptr)
  {
  	FVALUE *value;
***************
*** 809,813 ****
  	value=stack_push(sys, sys->stack);
  
! 	// Create an FWORDREF for FSYMREC ptr,
  	// Put the reference on the stack
  	if(value)
--- 809,813 ----
  	value=stack_push(sys, sys->stack);
  
! 	// Create an FWORDREF for FHEADER ptr,
  	// Put the reference on the stack
  	if(value)
***************
*** 818,822 ****
  
  
! void in_get_word(FSYSTEM *sys, int offset, FSYMREC **ptr)
  {
  	FVALUE *value;
--- 818,822 ----
  
  
! void in_get_word(FSYSTEM *sys, int offset, FHEADER **ptr)
  {
  	FVALUE *value;
***************
*** 833,837 ****
  void fs_push_word(FSYSTEM *sys, char *name)
  {
! 	FSYMREC *ptr;
  
  	if(!name)
--- 833,837 ----
  void fs_push_word(FSYSTEM *sys, char *name)
  {
! 	FHEADER *ptr;
  
  	if(!name)
***************
*** 850,854 ****
  int fs_is_push_word(FSYSTEM *sys, char *name, int push)
  {
! 	FSYMREC *ptr;
  
  	if(!name)
--- 850,854 ----
  int fs_is_push_word(FSYSTEM *sys, char *name, int push)
  {
! 	FHEADER *ptr;
  
  	if(!name)
***************
*** 874,878 ****
  void fs_push_last_word(FSYSTEM *sys)
  {
! 	FSYMREC *ptr;
  
  	if(!(ptr=dict_get_last(sys->table)))
--- 874,878 ----
  void fs_push_last_word(FSYSTEM *sys)
  {
! 	FHEADER *ptr;
  
  	if(!(ptr=dict_get_last(sys->table)))
***************
*** 885,889 ****
  void fs_push_first_word(FSYSTEM *sys)
  {
! 	FSYMREC *ptr;
  
  	if(!(ptr=dict_get_first(sys->table)))
--- 885,889 ----
  void fs_push_first_word(FSYSTEM *sys)
  {
! 	FHEADER *ptr;
  
  	if(!(ptr=dict_get_first(sys->table)))
***************
*** 948,952 ****
  void fs_push_last_shared_word(FSYSTEM *sys, unsigned i)
  {
! 	FSYMREC *ptr;
  	FDICT *dict;
  
--- 948,952 ----
  void fs_push_last_shared_word(FSYSTEM *sys, unsigned i)
  {
! 	FHEADER *ptr;
  	FDICT *dict;
  
***************
*** 967,971 ****
  void fs_push_first_shared_word(FSYSTEM *sys, unsigned i)
  {
! 	FSYMREC *ptr;
  	FDICT *dict;
  
--- 967,971 ----
  void fs_push_first_shared_word(FSYSTEM *sys, unsigned i)
  {
! 	FHEADER *ptr;
  	FDICT *dict;
  
***************
*** 987,991 ****
  void fs_push_next_word(FSYSTEM *sys, int offset)
  {
! 	FSYMREC *ptr, *word;
  	FVALUE *value;
  
--- 987,991 ----
  void fs_push_next_word(FSYSTEM *sys, int offset)
  {
! 	FHEADER *ptr, *word;
  	FVALUE *value;
  
***************
*** 1021,1025 ****
  void fs_push_previous_word(FSYSTEM *sys, int offset)
  {
! 	FSYMREC *ptr, *word;
  	FVALUE *value;
  
--- 1021,1025 ----
  void fs_push_previous_word(FSYSTEM *sys, int offset)
  {
! 	FHEADER *ptr, *word;
  	FVALUE *value;
  
***************
*** 1082,1086 ****
  
  	if(!(value=value_deref(value)))
! 		return FS_NONE;
  
  	return value_get_type(value);
--- 1082,1086 ----
  
  	if(!(value=value_deref(value)))
! 		return FS_NIL;
  
  	return value_get_type(value);
***************
*** 1105,1110 ****
  	//value_dewordref(value) // get vocab ID
  
! 	((FSYMREC*)handle)=voc_get_word(sys, name, strlen(name), NULL);
! //	((FSYMREC*)handle)=dict_get(sys->table, name);
  
  /*
--- 1105,1110 ----
  	//value_dewordref(value) // get vocab ID
  
! 	((FHEADER*)handle)=voc_get_word(sys, name, strlen(name), NULL);
! //	((FHEADER*)handle)=dict_get(sys->table, name);
  
  /*
***************
*** 1118,1122 ****
  FWORD fs_get_word_handle(FSYSTEM *sys, int offset)
  {
! 	FSYMREC *ptr=NULL;
  
  	in_get_word(sys, offset, &ptr);
--- 1118,1122 ----
  FWORD fs_get_word_handle(FSYSTEM *sys, int offset)
  {
! 	FHEADER *ptr=NULL;
  
  	in_get_word(sys, offset, &ptr);
***************
*** 1196,1200 ****
  void fs_forget(FSYSTEM *sys, int offset)
  {
! 	FSYMREC *sym;
  	FDICT *where;
  
--- 1196,1200 ----
  void fs_forget(FSYSTEM *sys, int offset)
  {
! 	FHEADER *sym;
  	FDICT *where;
  
***************
*** 1227,1231 ****
  int fs_get_word_flags(FSYSTEM *sys, int offset)
  {
! 	FSYMREC *ptr;
  
  	in_get_word(sys, offset, &ptr);
--- 1227,1231 ----
  int fs_get_word_flags(FSYSTEM *sys, int offset)
  {
! 	FHEADER *ptr;
  
  	in_get_word(sys, offset, &ptr);
***************
*** 1237,1241 ****
  void fs_set_word_flags(FSYSTEM *sys, int offset, int flags)
  {
! 	FSYMREC *ptr;
  	FVALUE *value;
  
--- 1237,1241 ----
  void fs_set_word_flags(FSYSTEM *sys, int offset, int flags)
  {
! 	FHEADER *ptr;
  	FVALUE *value;
  
***************
*** 1251,1255 ****
  char *fs_get_word_name(FSYSTEM *sys, int offset)
  {
! 	FSYMREC *ptr;
  	FVALUE *value;
  
--- 1251,1255 ----
  char *fs_get_word_name(FSYSTEM *sys, int offset)
  {
! 	FHEADER *ptr;
  	FVALUE *value;
  
***************
*** 1267,1271 ****
  void fs_set_word_name(FSYSTEM *sys, int offset, char *name)
  {
! 	FSYMREC *ptr;
  	FVALUE *value;
  
--- 1267,1271 ----
  void fs_set_word_name(FSYSTEM *sys, int offset, char *name)
  {
! 	FHEADER *ptr;
  	FVALUE *value;
  
***************
*** 1387,1391 ****
  					}
  				}
! 				if(sys->ip)
  				{
  					sys->vm_inner(sys);
--- 1387,1391 ----
  					}
  				}
! 				if(sys->ip.cell)
  				{
  					sys->vm_inner(sys);
***************
*** 1516,1520 ****
  
  		// Store current input pointer in the value's unused back_ref field
! 		value->back_ref=(void*)(sys->in_source);
  	}
  
--- 1516,1520 ----
  
  		// Store current input pointer in the value's unused back_ref field
! 		value->back_ref=(FREF*)(sys->in_source);
  	}
  
***************
*** 1593,1602 ****
  void fs_execute(FSYSTEM *sys, FWORD handle)
  {
! 	FSYMREC *ptr;
  
  	if(!handle)
  		VOID_THROW(sys, FS_BAD_REF);
  
! 	ptr=(FSYMREC*)handle;
  
  	// Set currently executing word to ptr
--- 1593,1602 ----
  void fs_execute(FSYSTEM *sys, FWORD handle)
  {
! 	FHEADER *ptr;
  
  	if(!handle)
  		VOID_THROW(sys, FS_BAD_REF);
  
! 	ptr=(FHEADER*)handle;
  
  	// Set currently executing word to ptr
***************
*** 1672,1676 ****
  void fs_push_word_data(FSYSTEM *sys, int offset)
  {
! 	FSYMREC *ptr=NULL;
  
  	in_get_word(sys, offset, &ptr);
--- 1672,1676 ----
  void fs_push_word_data(FSYSTEM *sys, int offset)
  {
! 	FHEADER *ptr=NULL;
  
  	in_get_word(sys, offset, &ptr);
***************
*** 1683,1687 ****
  void fs_push_word_voc(FSYSTEM *sys, int offset)
  {
! 	FSYMREC *ptr=NULL, *word;
  	FVALUE *value;
  
--- 1683,1687 ----
  void fs_push_word_voc(FSYSTEM *sys, int offset)
  {
! 	FHEADER *ptr=NULL, *word;
  	FVALUE *value;
  

[Forthy-cvs] forthy fcompile.c,1.11,1.12 fcompile.h,1.1,1.2 fdict.c,1.4,1.5 fstack.c,1.5,1.6 fsystem.c,1.22,1.23 fsystem.h,1.15,1.16 ftype.h,1.8,1.9 fvalue.c,1.8,1.9 fvalue.h,1.4,1.5 main.c,1.26,1.27

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

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

Modified Files:
	fcompile.c fcompile.h fdict.c fstack.c fsystem.c fsystem.h 
	ftype.h fvalue.c fvalue.h main.c 
Log Message:
- removed the "hidden" void pointer array from FGUTS
- changed input stack so that it uses the back_ref pointer for saving the input source instead of the void pointer array
- changed the functions that use "handles" to use a typedefed FWORD instead of int

Index: fvalue.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fvalue.c,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** fvalue.c	5 Aug 2004 04:18:37 -0000	1.8
--- fvalue.c	27 Jan 2006 19:14:19 -0000	1.9
***************
*** 316,331 ****
  void value_clean(FVALUE *value, int kill_ref)
  {
! 	if(value->type==FS_STRING)
! 		free(value->value.str);
! 	else if(value->type==FS_STACK)
! 		stack_delete(value->value.stack);
! 	else if(value->type==FS_REF)
! 		value_unref(value);
! 	else if(value->type==FS_WORDREF)
! 		value_unwordref(value);
  
  	// Get rid of any invalid pointers, so cleaning an old stack cell on exit
  	// doesn't corrupt the heap
! 	value->value.v[0]=NULL;
  	value->type=FS_NONE;
  
--- 316,341 ----
  void value_clean(FVALUE *value, int kill_ref)
  {
! 	switch(value->type)
! 	{
! 		case FS_STRING:
! 			free(value->value.str);
! 			break;
! 
! 		case FS_STACK:
! 			stack_delete(value->value.stack);
! 			break;
! 
! 		case FS_REF:
! 			value_unref(value);
! 			break;
! 
! 		case FS_WORDREF:
! 			value_unwordref(value);
! 			break;
! 	}
  
  	// Get rid of any invalid pointers, so cleaning an old stack cell on exit
  	// doesn't corrupt the heap
! 	value->value.v=NULL;
  	value->type=FS_NONE;
  

Index: ftype.h
===================================================================
RCS file: /cvsroot/forthy/forthy/ftype.h,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** ftype.h	6 Aug 2004 05:13:12 -0000	1.8
--- ftype.h	27 Jan 2006 19:14:19 -0000	1.9
***************
*** 112,116 ****
  		char *str;
  		// TODO: Userdata (void*)? Copy/clone/convert/delete interface, etc.
! 		void *v[2];
  		FCFUNC func;
  		FSTACK *stack;
--- 112,116 ----
  		char *str;
  		// TODO: Userdata (void*)? Copy/clone/convert/delete interface, etc.
! 		void *v;
  		FCFUNC func;
  		FSTACK *stack;

Index: fdict.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fdict.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** fdict.c	27 Jul 2004 04:31:02 -0000	1.4
--- fdict.c	27 Jan 2006 19:14:19 -0000	1.5
***************
*** 219,223 ****
  FSYMREC *dict_get_last(FDICT *table)
  {
! 	FSYMREC *ptr, *rec;
  
  	ptr=table->list;
--- 219,223 ----
  FSYMREC *dict_get_last(FDICT *table)
  {
! 	FSYMREC *ptr, *rec = NULL;
  
  	ptr=table->list;

Index: fvalue.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fvalue.h,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** fvalue.h	25 Jul 2004 20:25:47 -0000	1.4
--- fvalue.h	27 Jan 2006 19:14:19 -0000	1.5
***************
*** 59,63 ****
  #define value_init_user(val, user, subtype) \
  	(val)->type=FS_USER+subtype; \
! 	(val)->value.v[0]=(user); \
  	(val)->back_ref=NULL
  
--- 59,63 ----
  #define value_init_user(val, user, subtype) \
  	(val)->type=FS_USER+subtype; \
! 	(val)->value.v=(user); \
  	(val)->back_ref=NULL
  
***************
*** 107,114 ****
  // DANGEROUS
  #define value_get_void(val) \
! 	(val->value.v[0])
! 
! #define value_get_void1(val) \
! 	(val->value.v[1])
  
  #define value_string_direct(val) \
--- 107,111 ----
  // DANGEROUS
  #define value_get_void(val) \
! 	(val->value.v)
  
  #define value_string_direct(val) \

Index: fsystem.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.c,v
retrieving revision 1.22
retrieving revision 1.23
diff -C2 -d -r1.22 -r1.23
*** fsystem.c	6 Dec 2004 03:50:56 -0000	1.22
--- fsystem.c	27 Jan 2006 19:14:19 -0000	1.23
***************
*** 1098,1104 ****
  
  
! int fs_find_word_handle(FSYSTEM *sys, char *name)
  {
! 	int handle;
  
  	// For each word in vstack:
--- 1098,1104 ----
  
  
! FWORD fs_find_word_handle(FSYSTEM *sys, char *name)
  {
! 	FWORD handle;
  
  	// For each word in vstack:
***************
*** 1116,1125 ****
  
  
! int fs_get_word_handle(FSYSTEM *sys, int offset)
  {
  	FSYMREC *ptr=NULL;
  
  	in_get_word(sys, offset, &ptr);
! 	return (int)ptr;
  }
  
--- 1116,1126 ----
  
  
! FWORD fs_get_word_handle(FSYSTEM *sys, int offset)
  {
  	FSYMREC *ptr=NULL;
  
  	in_get_word(sys, offset, &ptr);
! 	
! 	return (FWORD)ptr;
  }
  
***************
*** 1320,1339 ****
  void sys_input_drop(FSYSTEM *sys)
  {
! 	// pop top string value from the stack (bye bye!)
  	stack_pop(sys, sys->istack);
  
  	if(stack_depth(sys->istack))
  	{
- 		int offset;
- 		FVALUE *value;
  
  		// get string/offset from input stack
  		value=stack_get_value(sys, sys->istack, -1);
- 		offset=(int)value->value.v[1];
  
  		// want direct access to avoid copying big strings
! 		sys->in_load=(char*)value_get_void(value);
! 		
! 		sys->in_source=sys->in_load+offset;
  		sys->in_parse=NULL;
  		sys->in_token=NULL;
--- 1321,1343 ----
  void sys_input_drop(FSYSTEM *sys)
  {
! 	FVALUE *value;
! 
! 	value = stack_get_value(sys, sys->istack, -1);
! 	// clear the hidden input source pointer so that it doesn't affect cleanup
! 	value->back_ref = NULL;
! 
! 	// pop top string value from the stack
  	stack_pop(sys, sys->istack);
  
  	if(stack_depth(sys->istack))
  	{
  
  		// get string/offset from input stack
  		value=stack_get_value(sys, sys->istack, -1);
  
  		// want direct access to avoid copying big strings
! 		sys->in_load=(char*)value_string_direct(value);
! 		sys->in_source=(char*)value->back_ref;
! 
  		sys->in_parse=NULL;
  		sys->in_token=NULL;
***************
*** 1428,1432 ****
  
  // Load word to be executed by run() or step()
! int fs_load_word(FSYSTEM *sys, int handle)
  {
  	if(!handle)
--- 1432,1436 ----
  
  // Load word to be executed by run() or step()
! int fs_load_word(FSYSTEM *sys, FWORD handle)
  {
  	if(!handle)
***************
*** 1465,1474 ****
  int fs_clear_input(FSYSTEM *sys)
  {
! 
! 	stack_remove(sys, sys->istack, stack_depth(sys->istack));
! 	sys->in_load=NULL;
! 	sys->in_source=NULL;
! 	sys->in_parse=NULL;
! 	sys->in_token=NULL;
  
  	return FS_OK;
--- 1469,1476 ----
  int fs_clear_input(FSYSTEM *sys)
  {
! 	while(stack_depth(sys->istack))
! 	{
! 		sys_input_drop(sys);
! 	}
  
  	return FS_OK;
***************
*** 1513,1519 ****
  		value=stack_get_value(sys, sys->istack, -1);
  
! 		// Store current offset in the super secret unused upper 32-bits of 
! 		// the value
! 		value->value.v[1]=(void*)(sys->in_source-sys->in_load);
  	}
  
--- 1515,1520 ----
  		value=stack_get_value(sys, sys->istack, -1);
  
! 		// Store current input pointer in the value's unused back_ref field
! 		value->back_ref=(void*)(sys->in_source);
  	}
  
***************
*** 1590,1594 ****
  // This is the EXECUTE *primitive*
  // TODO: Change to consume XT from stack?
! void fs_execute(FSYSTEM *sys, int handle)
  {
  	FSYMREC *ptr;
--- 1591,1595 ----
  // This is the EXECUTE *primitive*
  // TODO: Change to consume XT from stack?
! void fs_execute(FSYSTEM *sys, FWORD handle)
  {
  	FSYMREC *ptr;

Index: fcompile.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fcompile.c,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** fcompile.c	6 Dec 2004 03:50:56 -0000	1.11
--- fcompile.c	27 Jan 2006 19:14:19 -0000	1.12
***************
*** 46,50 ****
  static char for_tag[]  = "for";
  static char break_tag[]  = "break";
! static char breakfor_tag[]  = "breakfor";
  
  
--- 46,50 ----
  static char for_tag[]  = "for";
  static char break_tag[]  = "break";
! //static char breakfor_tag[]  = "breakfor";
  
  

Index: main.c
===================================================================
RCS file: /cvsroot/forthy/forthy/main.c,v
retrieving revision 1.26
retrieving revision 1.27
diff -C2 -d -r1.26 -r1.27
*** main.c	6 Dec 2004 03:50:56 -0000	1.26
--- main.c	27 Jan 2006 19:14:19 -0000	1.27
***************
*** 123,128 ****
  
  			case FS_REF:
! 				printf("<$%s:%08X> ", fs_get_type_name(sys, 
! 					fs_get_ref_type(sys, i+1)), (int)fs_get_void(sys, i+1));
  				break;
  
--- 123,128 ----
  
  			case FS_REF:
! 				printf("<ref:%s> ", fs_get_type_name(sys, 
! 					fs_get_ref_type(sys, i+1)));
  				break;
  
***************
*** 1020,1024 ****
  void word_execute(FSYSTEM *sys)
  {
! 	int handle;
  
  	// Get word handle from top of stack
--- 1020,1024 ----
  void word_execute(FSYSTEM *sys)
  {
! 	FWORD handle;
  
  	// Get word handle from top of stack
***************
*** 1836,1840 ****
  {
  
! 	int handle;
  	int i;
  
--- 1836,1840 ----
  {
  
! 	FWORD handle;
  	int i;
  
***************
*** 1906,1910 ****
  	fs_push_int(sys, i);
  	fs_push_func(sys, word_dup);
! 	fs_push_user(sys, (void*)i, 0);
  	fs_create_stack(sys, 10);
  	show_stack(sys);
--- 1906,1910 ----
  	fs_push_int(sys, i);
  	fs_push_func(sys, word_dup);
! 	fs_push_user(sys, (void*)&i, 0);
  	fs_create_stack(sys, 10);
  	show_stack(sys);

Index: fcompile.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fcompile.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** fcompile.h	7 Aug 2003 01:22:55 -0000	1.1
--- fcompile.h	27 Jan 2006 19:14:19 -0000	1.2
***************
*** 5,9 ****
  #define INTEPRET_STATE	0
  
! #define CELL_SIZE		4 // bytes
  
  #define NEED_COMPILE(sys)	if((sys)->state!=COMPILE_STATE)\
--- 5,9 ----
  #define INTEPRET_STATE	0
  
! #define CELL_SIZE		sizeof(void*) // bytes
  
  #define NEED_COMPILE(sys)	if((sys)->state!=COMPILE_STATE)\

Index: fsystem.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.h,v
retrieving revision 1.15
retrieving revision 1.16
diff -C2 -d -r1.15 -r1.16
*** fsystem.h	26 Aug 2004 01:28:49 -0000	1.15
--- fsystem.h	27 Jan 2006 19:14:19 -0000	1.16
***************
*** 75,78 ****
--- 75,80 ----
  };
  
+ typedef void* FWORD;
+ 
  
  // System interface
***************
*** 83,87 ****
  
  int		fs_load_input(FSYSTEM *sys, char *str);
! int		fs_load_word(FSYSTEM *sys, int handle);
  int		fs_run(FSYSTEM *sys);
  int		fs_step(FSYSTEM *sys);
--- 85,89 ----
  
  int		fs_load_input(FSYSTEM *sys, char *str);
! int		fs_load_word(FSYSTEM *sys, FWORD handle);
  int		fs_run(FSYSTEM *sys);
  int		fs_step(FSYSTEM *sys);
***************
*** 95,99 ****
  
  
! int		fs_find_word_handle(FSYSTEM *sys, char *name);
  int		fs_throw_it(FSYSTEM *sys, int value);
  #define fs_throw(sys, value) { fs_throw_it(sys, value); return; }
--- 97,101 ----
  
  
! FWORD	fs_find_word_handle(FSYSTEM *sys, char *name);
  int		fs_throw_it(FSYSTEM *sys, int value);
  #define fs_throw(sys, value) { fs_throw_it(sys, value); return; }
***************
*** 242,248 ****
  char	*fs_get_word_name(FSYSTEM *sys, int offset);
  void	fs_set_word_name(FSYSTEM *sys, int offset, char *name);
! int		fs_get_word_handle(FSYSTEM *sys, int offset);
  
! void	fs_execute(FSYSTEM *sys, int handle);
  
  void	fs_exit(FSYSTEM *sys);
--- 244,250 ----
  char	*fs_get_word_name(FSYSTEM *sys, int offset);
  void	fs_set_word_name(FSYSTEM *sys, int offset, char *name);
! FWORD	fs_get_word_handle(FSYSTEM *sys, int offset);
  
! void	fs_execute(FSYSTEM *sys, FWORD handle);
  
  void	fs_exit(FSYSTEM *sys);

Index: fstack.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fstack.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** fstack.c	18 Nov 2003 13:49:41 -0000	1.5
--- fstack.c	27 Jan 2006 19:14:19 -0000	1.6
***************
*** 156,160 ****
  {
  	int top=stack_depth(stack);
- 	int stack_size=stack->stack_size;
  
  	// Positive offset, give me sp starting from bottom
--- 156,159 ----

[Forthy-cvs] forthy fcode.c,1.11,1.12 fcode.h,1.7,1.8 fcompile.c,1.10,1.11 fsystem.c,1.21,1.22 main.c,1.25,1.26

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

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

Modified Files:
	fcode.c fcode.h fcompile.c fsystem.c main.c 
Log Message:
- changed behaviour of fs_exit(). It now executes the return stack drop immediately instead of compiling an opcode for this into the current word.

Index: fcode.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fcode.h,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** fcode.h	25 Nov 2004 02:58:50 -0000	1.7
--- fcode.h	6 Dec 2004 03:50:56 -0000	1.8
***************
*** 9,19 ****
  
  enum{OP_EXIT_INNER, OP_DOCON, OP_DOVAR, OP_ENTER, OP_EXIT,
! 	OP_EXIT_FOR, 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":
! // + LIT BRANCH ?BRANCH 
! // - (DO) (?DO) (+LOOP) (LOOP) (LEAVE)
  
  extern FOPCODE code_table[];
--- 9,15 ----
  
  enum{OP_EXIT_INNER, OP_DOCON, OP_DOVAR, OP_ENTER, OP_EXIT,
! 	/* OP_EXIT_FOR, */ 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};
  
  extern FOPCODE code_table[];
***************
*** 21,24 ****
--- 17,22 ----
  extern FTOKEN *code_soft_exit_inner[];
  
+ extern void code_exit(FSYSTEM *sys);
+ 
  #endif
  

Index: main.c
===================================================================
RCS file: /cvsroot/forthy/forthy/main.c,v
retrieving revision 1.25
retrieving revision 1.26
diff -C2 -d -r1.25 -r1.26
*** main.c	26 Aug 2004 01:28:49 -0000	1.25
--- main.c	6 Dec 2004 03:50:56 -0000	1.26
***************
*** 1571,1574 ****
--- 1571,1594 ----
  
  
+ void word_exits(FSYSTEM *sys)
+ {
+ 	int i;
+ 	
+ 	i=fs_get_int(sys, -1);
+ 	fs_pop(sys);
+ 
+ 	while(i--)
+ 	{
+ 		fs_exit(sys);
+ 	}
+ }
+ 
+ 
+ static void word_rdepth(FSYSTEM *sys)
+ {
+ 	fs_push_int(sys, stack_depth(sys->rstack));
+ }
+ 
+ 
  void word_evaluate(FSYSTEM *sys)
  {
***************
*** 1621,1624 ****
--- 1641,1645 ----
  	fs_register_func(sys, "words.like", word_words_like, FS_DEFAULT);
  	fs_register_func(sys, "depth", word_depth, FS_DEFAULT);
+ 	fs_register_func(sys, "rdepth", word_rdepth, FS_DEFAULT);
  	fs_register_func(sys, "call", word_call, FS_DEFAULT);
  	fs_register_func(sys, "stack", word_stack, FS_DEFAULT);
***************
*** 1681,1685 ****
  	fs_register_func(sys, "poke", word_poke, FS_DEFAULT);
  	fs_register_func(sys, "pause", word_pause, FS_DEFAULT);
! 	fs_register_func(sys, "exit", fs_exit, FS_IMMEDIATE);
  	fs_register_func(sys, "immediate", word_immediate, FS_DEFAULT);
  	fs_register_func(sys, "for", fs_for, FS_IMMEDIATE);
--- 1702,1707 ----
  	fs_register_func(sys, "poke", word_poke, FS_DEFAULT);
  	fs_register_func(sys, "pause", word_pause, FS_DEFAULT);
! 	fs_register_func(sys, "exit", fs_exit, FS_DEFAULT);
! 	fs_register_func(sys, "exits", word_exits, FS_DEFAULT);
  	fs_register_func(sys, "immediate", word_immediate, FS_DEFAULT);
  	fs_register_func(sys, "for", fs_for, FS_IMMEDIATE);

Index: fsystem.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.c,v
retrieving revision 1.21
retrieving revision 1.22
diff -C2 -d -r1.21 -r1.22
*** fsystem.c	9 Sep 2004 19:10:41 -0000	1.21
--- fsystem.c	6 Dec 2004 03:50:56 -0000	1.22
***************
*** 1887,1890 ****
--- 1887,1915 ----
  
  
+ void fs_exit(FSYSTEM *sys)
+ {
+ 	// While there are non-FXTOKENs (control-flow) on the stack 
+ 
+ 	while(stack_depth(sys->rstack))
+ 	{
+ 		if(vm_get_type(sys, -1)==FS_TOKEN)
+ 			break;
+ 		else
+ 		{
+ 			vm_pop(sys);
+ 		}
+ 	}
+ 
+ 	code_exit(sys);
+ /*
+ 	NEED_COMPILE(sys);
+ 	
+ 	sys->code[sys->code_off]=OPCODE(OP_EXIT_FOR);
+ 
+ 	CELL_INC(sys);
+ */
+ }
+ 
+ 
  int fs_sys_exit(FSYSTEM *sys)
  {

Index: fcompile.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fcompile.c,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** fcompile.c	25 Nov 2004 02:58:50 -0000	1.10
--- fcompile.c	6 Dec 2004 03:50:56 -0000	1.11
***************
*** 783,794 ****
  }
  
- 
- void fs_exit(FSYSTEM *sys)
- {
- 	NEED_COMPILE(sys);
- 	
- 	sys->code[sys->code_off]=OPCODE(OP_EXIT_FOR);
- 
- 	CELL_INC(sys);
- }
- 
--- 783,784 ----

Index: fcode.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fcode.c,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** fcode.c	25 Nov 2004 02:58:50 -0000	1.11
--- fcode.c	6 Dec 2004 03:50:56 -0000	1.12
***************
*** 34,39 ****
  
  void code_enter(FSYSTEM *sys);
! void code_exit(FSYSTEM *sys);
! void code_exit_for(FSYSTEM *sys);
  void code_exit_inner(FSYSTEM *sys);
  
--- 34,39 ----
  
  void code_enter(FSYSTEM *sys);
! // void code_exit(FSYSTEM *sys);
! // void code_exit_for(FSYSTEM *sys);
  void code_exit_inner(FSYSTEM *sys);
  
***************
*** 69,73 ****
  	{code_enter, "ENTER"},
  	{code_exit, "EXIT"},
! 	{code_exit_for, "EXIT_FOR"},
  	{code_lit_int, "LIT_INT"},
  	{code_lit_float, "LIT_FLOAT"},
--- 69,73 ----
  	{code_enter, "ENTER"},
  	{code_exit, "EXIT"},
! //	{code_exit_for, "EXIT_FOR"},
  	{code_lit_int, "LIT_INT"},
  	{code_lit_float, "LIT_FLOAT"},
***************
*** 372,375 ****
--- 372,376 ----
  
  // Special exit that drops control-flow data and returns immediately
+ /*
  void code_exit_for(FSYSTEM *sys)
  {
***************
*** 388,392 ****
  	code_exit(sys);
  }
! 
  
  // Interpreter that gets pushed with fs_load_input()
--- 389,393 ----
  	code_exit(sys);
  }
! */
  
  // Interpreter that gets pushed with fs_load_input()

[Forthy-cvs] forthy fcode.c,1.10,1.11 fcode.h,1.6,1.7 fcompile.c,1.9,1.10

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

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

Modified Files:
	fcode.c fcode.h fcompile.c 
Log Message:
- fixed bug where doing a BREAK from within a REPEAT loop that was nested in a FOR loop would destroy the iterator for the FOR loop
- renamed the code_exit* functions to be more obvious

Index: fcode.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fcode.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** fcode.h	5 Aug 2004 04:18:37 -0000	1.6
--- fcode.h	25 Nov 2004 02:58:50 -0000	1.7
***************
*** 8,13 ****
  #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};
--- 8,13 ----
  #define OPFUNC(code)	(code_table[(code)].exec)
  
! enum{OP_EXIT_INNER, OP_DOCON, OP_DOVAR, OP_ENTER, OP_EXIT,
! 	OP_EXIT_FOR, 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};

Index: fcompile.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fcompile.c,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** fcompile.c	10 Aug 2004 16:43:02 -0000	1.9
--- fcompile.c	25 Nov 2004 02:58:50 -0000	1.10
***************
*** 46,49 ****
--- 46,50 ----
  static char for_tag[]  = "for";
  static char break_tag[]  = "break";
+ static char breakfor_tag[]  = "breakfor";
  
  
***************
*** 415,419 ****
  
  
! static void patch_breaks(FSYSTEM *sys)
  {
  	int off;
--- 416,420 ----
  
  
! static void patch_breaks(FSYSTEM *sys, FCFUNC *opcode)
  {
  	int off;
***************
*** 428,431 ****
--- 429,435 ----
  		vm_pop_cs(sys);
  
+ 		// Use the supplied break opcode for type of loop
+ 		sys->code[off-1]=opcode;
+ 
  		// Backpatch the BREAK to point past end of the loop
  		sys->code[off]=(void*)((sys->code_off+2)-off); // Relative
***************
*** 515,519 ****
  
  	// Compile the EXIT opcode, close the word
! 	sys->code[sys->code_off]=OPCODE(OP_EXIT_FAST);
  
  	// Relocate the code block to the current dict entry
--- 519,523 ----
  
  	// Compile the EXIT opcode, close the word
! 	sys->code[sys->code_off]=OPCODE(OP_EXIT);
  
  	// Relocate the code block to the current dict entry
***************
*** 604,608 ****
  
  	// Resolve and backpatch all BREAKs
! 	patch_breaks(sys);
  
  	if(!resolve_tag(sys, (int)dest_tag))
--- 608,612 ----
  
  	// Resolve and backpatch all BREAKs
! 	patch_breaks(sys, OPCODE(OP_BRANCH));
  
  	if(!resolve_tag(sys, (int)dest_tag))
***************
*** 635,639 ****
  
  	// Resolve and backpatch all BREAKs
! 	patch_breaks(sys);
  
  	if(!resolve_tag(sys, (int)dest_tag))
--- 639,643 ----
  
  	// Resolve and backpatch all BREAKs
! 	patch_breaks(sys, OPCODE(OP_BRANCH));
  
  	if(!resolve_tag(sys, (int)dest_tag))
***************
*** 723,727 ****
  
  	// Resolve and backpatch all BREAKs
! 	patch_breaks(sys);
  
  	if(!resolve_tag(sys, (int)for_tag))
--- 727,731 ----
  
  	// Resolve and backpatch all BREAKs
! 	patch_breaks(sys, OPCODE(OP_BREAK));
  
  	if(!resolve_tag(sys, (int)for_tag))
***************
*** 755,760 ****
  	NEED_COMPILE(sys);
  
! 	// Put break in current cell
! 	sys->code[sys->code_off]=OPCODE(OP_BREAK);
  
  	// Allocate a new cell for forward break resolution
--- 759,764 ----
  	NEED_COMPILE(sys);
  
! 	// Put fatal in current cell, patch during resolve
! 	sys->code[sys->code_off]=OPCODE(OP_FATAL);
  
  	// Allocate a new cell for forward break resolution
***************
*** 784,788 ****
  	NEED_COMPILE(sys);
  	
! 	sys->code[sys->code_off]=OPCODE(OP_EXIT);
  
  	CELL_INC(sys);
--- 788,792 ----
  	NEED_COMPILE(sys);
  	
! 	sys->code[sys->code_off]=OPCODE(OP_EXIT_FOR);
  
  	CELL_INC(sys);

Index: fcode.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fcode.c,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** fcode.c	6 Aug 2004 02:52:04 -0000	1.10
--- fcode.c	25 Nov 2004 02:58:50 -0000	1.11
***************
*** 34,39 ****
  
  void code_enter(FSYSTEM *sys);
- void code_exit_fast(FSYSTEM *sys);
  void code_exit(FSYSTEM *sys);
  void code_exit_inner(FSYSTEM *sys);
  
--- 34,39 ----
  
  void code_enter(FSYSTEM *sys);
  void code_exit(FSYSTEM *sys);
+ void code_exit_for(FSYSTEM *sys);
  void code_exit_inner(FSYSTEM *sys);
  
***************
*** 68,73 ****
  	{code_dovar, "DO_VAR"},
  	{code_enter, "ENTER"},
- 	{code_exit_fast, "EXIT_FAST"},
  	{code_exit, "EXIT"},
  	{code_lit_int, "LIT_INT"},
  	{code_lit_float, "LIT_FLOAT"},
--- 68,73 ----
  	{code_dovar, "DO_VAR"},
  	{code_enter, "ENTER"},
  	{code_exit, "EXIT"},
+ 	{code_exit_for, "EXIT_FOR"},
  	{code_lit_int, "LIT_INT"},
  	{code_lit_float, "LIT_FLOAT"},
***************
*** 91,95 ****
  {
  	(FTOKEN*)OPCODE(OP_INTERPRET),
! 	(FTOKEN*)OPCODE(OP_EXIT_FAST),
  	(FTOKEN*)OPCODE(OP_FATAL)
  };
--- 91,95 ----
  {
  	(FTOKEN*)OPCODE(OP_INTERPRET),
! 	(FTOKEN*)OPCODE(OP_EXIT),
  	(FTOKEN*)OPCODE(OP_FATAL)
  };
***************
*** 201,205 ****
  
  
! void code_exit_fast(FSYSTEM *sys)
  {
  	FVALUE *value;
--- 201,205 ----
  
  
! void code_exit(FSYSTEM *sys)
  {
  	FVALUE *value;
***************
*** 211,216 ****
--- 211,218 ----
  	// return stack
  	// - _DEBUG only verification here? Speed things up...
+ #ifdef _DEBUG
  	if(value->type!=FS_TOKEN)
  		VOID_THROW(sys, FS_INTERNAL);
+ #endif
  
  	// - Set IP to popped XT
***************
*** 298,314 ****
  void code_break(FSYSTEM *sys)
  {
- 	FVALUE *value;
- 
  	// Branch to the specified offset
  	sys->ip+=*((int*)(sys->ip));
  
! 	// If the top of the stack is an int (FOR/NEXT count), then drop it
! 	value=stack_get_value(sys, sys->rstack, -1);	
  
! 	if(value_get_type(value)==FS_INT)
! 	{
! 		stack_pop(sys, sys->rstack);
! 	}
  }
  
  
--- 300,318 ----
  void code_break(FSYSTEM *sys)
  {
  	// Branch to the specified offset
  	sys->ip+=*((int*)(sys->ip));
  
! 	// Drop the for iterator
! 	stack_pop(sys, sys->rstack);
! }
  
! 
! /*
! void code_break(FSYSTEM *sys)
! {
! 	// Branch to the specified offset
! 	sys->ip+=*((int*)(sys->ip));
  }
+ */
  
  
***************
*** 334,338 ****
  
  	// Exit the current word
! 	code_exit_fast(sys);
  }
  
--- 338,342 ----
  
  	// Exit the current word
! 	code_exit(sys);
  }
  
***************
*** 368,372 ****
  
  // Special exit that drops control-flow data and returns immediately
! void code_exit(FSYSTEM *sys)
  {
  	// While there are non-FXTOKENs (control-flow) on the stack 
--- 372,376 ----
  
  // Special exit that drops control-flow data and returns immediately
! void code_exit_for(FSYSTEM *sys)
  {
  	// While there are non-FXTOKENs (control-flow) on the stack 
***************
*** 382,386 ****
  	}
  
! 	code_exit_fast(sys);
  }
  
--- 386,390 ----
  	}
  
! 	code_exit(sys);
  }
  
***************
*** 489,492 ****
  	// LEAVE
  	sys_input_drop(sys);
! 	code_exit_fast(sys);
  }
--- 493,496 ----
  	// LEAVE
  	sys_input_drop(sys);
! 	code_exit(sys);
  }

[Forthy-cvs] forthy fsystem.c,1.20,1.21

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

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

Modified Files:
	fsystem.c 
Log Message:
- changed order of error checking in fs_forget()

Index: fsystem.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.c,v
retrieving revision 1.20
retrieving revision 1.21
diff -C2 -d -r1.20 -r1.21
*** fsystem.c	26 Aug 2004 01:28:49 -0000	1.20
--- fsystem.c	9 Sep 2004 19:10:41 -0000	1.21
***************
*** 1209,1215 ****
  		VOID_THROW(sys, FS_PROTECTED);
  
- 	if(!dict_forget(sys->table, sym))
- 		VOID_THROW(sys, FS_INTERNAL);
- 
  	// If executing, abort so that high-level words can't forget 
  	// themselves and continue running. That would crash it!
--- 1209,1212 ----
***************
*** 1221,1224 ****
--- 1218,1224 ----
  		VOID_THROW(sys, FS_EXECUTION_ABORTED);
  	}
+ 
+ 	if(!dict_forget(sys->table, sym))
+ 		VOID_THROW(sys, FS_INTERNAL);
  }
  

[Forthy-cvs] forthy fsystem.c,1.19,1.20 fsystem.h,1.14,1.15 main.c,1.24,1.25

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

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

Modified Files:
	fsystem.c fsystem.h main.c 
Log Message:
- added functions for getting length and offset of current input source, so you can avoid "out of text" exceptions if you want

Index: main.c
===================================================================
RCS file: /cvsroot/forthy/forthy/main.c,v
retrieving revision 1.24
retrieving revision 1.25
diff -C2 -d -r1.24 -r1.25
*** main.c	11 Aug 2004 14:33:44 -0000	1.24
--- main.c	26 Aug 2004 01:28:49 -0000	1.25
***************
*** 1559,1562 ****
--- 1559,1574 ----
  
  
+ void word_inlen(FSYSTEM *sys)
+ {
+ 	fs_push_int(sys, fs_input_length(sys));
+ }
+ 
+ 
+ void word_inoff(FSYSTEM *sys)
+ {
+ 	fs_push_int(sys, fs_input_offset(sys));
+ }
+ 
+ 
  void word_evaluate(FSYSTEM *sys)
  {
***************
*** 1730,1733 ****
--- 1742,1747 ----
  	fs_register_func(sys, "evaluate", word_evaluate, FS_DEFAULT);
  	fs_register_func(sys, "anew", word_anew, FS_DEFAULT);
+ 	fs_register_func(sys, "in.len", word_inlen, FS_DEFAULT);
+ 	fs_register_func(sys, "in.off", word_inoff, FS_DEFAULT);
  
  	fs_push_int(sys, '\n');

Index: fsystem.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.c,v
retrieving revision 1.19
retrieving revision 1.20
diff -C2 -d -r1.19 -r1.20
*** fsystem.c	13 Aug 2004 15:56:55 -0000	1.19
--- fsystem.c	26 Aug 2004 01:28:49 -0000	1.20
***************
*** 8,12 ****
  			- Other hooks?
  			- USER pointer in word definitions
- 	- Input stack for scripts/text being evaluated
  
  	- Seperate primitives from C interface
--- 8,11 ----
***************
*** 30,39 ****
  	- >IN functionality with input string... manipulate the input pointer for
  	re-parsing tokens and such... look at SOURCE also
- 	- EVALUATE a string
  	- Decompile, return/data stack dump, etc. (for debug)
  		- Also for return stack, random access decompile (decompile current)
  		- Get depth of return stack, user can pick values to decompile at will
  		- Look at FICL debugger
- 	- Auto-remove data stack on abort?
  	- Debug mode to save all stacks for analysis
  	- DEBUG hooks for user intervention during execution of words in inner loop
--- 29,36 ----
***************
*** 48,51 ****
--- 45,52 ----
  	DONE:
  
+ 	+ Auto-remove data stack on abort?
+ 		+ handled with fs_reset() and fs_reset_ex()
+ 	+ EVALUATE a string
+ 	+ Input stack for scripts/text being evaluated
  	+ Pass FSYSTEM down to stack and value modules, to reduce return value
  	checking
***************
*** 1303,1343 ****
  
  
- // NOTE: This is C-recursive... keep an eye on it for dangerous 
- // effects and such!
- // TODO: Load this string somewhere and evaluate by redirecting the 
- // text input for the interpreter
- /*
- int fs_evaluate(FSYSTEM *sys)
- {
- 	int ret;
- 
- 	char *str, *store;
- 
- 	if(!fs_depth(sys))
- 		return FS_UNDERFLOW;
- 
- 	if(!(str=fs_get_string(sys, -1)))
- 		return FS_BAD_PARAMETER;
- 
- 	fs_pop(sys);
- 
- 	str=strdup(str);
- 
- 	// Save our FSYSTEM token pointer for the previous buffer
- 	store=sys->in_source;
- 
- 	ret=fs_do_string(sys, str);
- 	free(str);
- 
- 	// Restore token pointer
- 	sys->in_source=store;
- 
- 	if(ret)
- 		return ret;
- 
- 	return FS_OK;
- }
- */
- 
  int fs_strlen(FSYSTEM *sys, int offset, char **buf)
  {
--- 1304,1307 ----
***************
*** 1477,1480 ****
--- 1441,1466 ----
  
  
+ int fs_input_length(FSYSTEM *sys)
+ {
+ 	if(sys->in_load)
+ 	{
+ 		return strlen(sys->in_load);
+ 	}
+ 
+ 	return 0;
+ }
+ 
+ 
+ int fs_input_offset(FSYSTEM *sys)
+ {
+ 	if(sys->in_source&&sys->in_load)
+ 	{
+ 		return sys->in_source-sys->in_load;
+ 	}
+ 
+ 	return 0;
+ }
+ 
+ 
  int fs_clear_input(FSYSTEM *sys)
  {

Index: fsystem.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.h,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** fsystem.h	11 Aug 2004 14:33:44 -0000	1.14
--- fsystem.h	26 Aug 2004 01:28:49 -0000	1.15
***************
*** 89,93 ****
--- 89,97 ----
  int		fs_reset(FSYSTEM *sys);
  int		fs_reset_ex(FSYSTEM *sys);
+ 
  int		fs_clear_input(FSYSTEM *sys);
+ int		fs_input_length(FSYSTEM *sys);
+ int		fs_input_offset(FSYSTEM *sys);
+ 
  
  int		fs_find_word_handle(FSYSTEM *sys, char *name);

[Forthy-cvs] forthy finternal.h,1.3,1.4 fsystem.c,1.18,1.19

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

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

Modified Files:
	finternal.h fsystem.c 
Log Message:
- fs_get_word_name() throws an exception if the parameter is not a word, and safely returns "" if not running protected

Index: finternal.h
===================================================================
RCS file: /cvsroot/forthy/forthy/finternal.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** finternal.h	5 Aug 2004 04:18:37 -0000	1.3
--- finternal.h	13 Aug 2004 15:56:54 -0000	1.4
***************
*** 23,26 ****
--- 23,27 ----
  #define INT_THROW(sys, result) { return fs_throw_it(sys, result); }
  #define VOID_THROW(sys, result) { fs_throw_it(sys, result); return; }
+ #define STRING_THROW(sys, result) { fs_throw_it(sys, result); return ""; }
  
  #endif

Index: fsystem.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.c,v
retrieving revision 1.18
retrieving revision 1.19
diff -C2 -d -r1.18 -r1.19
*** fsystem.c	11 Aug 2004 14:33:43 -0000	1.18
--- fsystem.c	13 Aug 2004 15:56:55 -0000	1.19
***************
*** 1255,1259 ****
  
  	if(!(ptr=value_dewordref(value)))
! 		return NULL;
  
  	return string_set_temp_str(&(sys->temp_str), dict_get_name(ptr), TRUE);
--- 1255,1261 ----
  
  	if(!(ptr=value_dewordref(value)))
! 	{
! 		STRING_THROW(sys, FS_BAD_REF);
! 	}
  
  	return string_set_temp_str(&(sys->temp_str), dict_get_name(ptr), TRUE);

[Forthy-cvs] forthy fsystem.c,1.17,1.18 fsystem.h,1.13,1.14 main.c,1.23,1.24

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

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

Modified Files:
	fsystem.c fsystem.h main.c 
Log Message:
- added fs_is_push_word() to avoid throwing exceptions if the word we're finding doesn't exist
- example for ANEW added to main.c

Index: main.c
===================================================================
RCS file: /cvsroot/forthy/forthy/main.c,v
retrieving revision 1.23
retrieving revision 1.24
diff -C2 -d -r1.23 -r1.24
*** main.c	10 Aug 2004 16:43:02 -0000	1.23
--- main.c	11 Aug 2004 14:33:44 -0000	1.24
***************
*** 953,957 ****
  	fs_pop(sys);
  
! 	if(!fs_find_word_handle(sys, str))
  	{
  		fs_push_int(sys, 0);
--- 953,957 ----
  	fs_pop(sys);
  
! 	if(!fs_is_push_word(sys, str, TRUE))
  	{
  		fs_push_int(sys, 0);
***************
*** 959,963 ****
  	else
  	{
- 		fs_push_word(sys, str);
  		fs_push_int(sys, -1);
  	}
--- 959,962 ----
***************
*** 1570,1573 ****
--- 1569,1592 ----
  
  
+ void word_anew(FSYSTEM *sys)
+ {
+ 	char *str;
+ 
+ 	fs_scan_word(sys);
+ 	str=fs_get_string(sys, -1);
+ 	fs_pop(sys);
+ 
+ 	// If it's there, forget it and everything after it
+ 	if(fs_is_push_word(sys, str, TRUE))
+ 	{
+ 		fs_forget(sys, -1);
+ 		fs_pop(sys);
+ 	}
+ 
+ 	// Stick a variable in the dictionary as a marker
+ 	fs_register_var(sys, str, FS_DEFAULT);
+ }
+ 
+ 
  int load(FSYSTEM *sys)
  {
***************
*** 1710,1713 ****
--- 1729,1733 ----
  	fs_register_func(sys, ".s", show_stack, FS_DEFAULT);
  	fs_register_func(sys, "evaluate", word_evaluate, FS_DEFAULT);
+ 	fs_register_func(sys, "anew", word_anew, FS_DEFAULT);
  
  	fs_push_int(sys, '\n');

Index: fsystem.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.c,v
retrieving revision 1.17
retrieving revision 1.18
diff -C2 -d -r1.17 -r1.18
*** fsystem.c	6 Aug 2004 05:13:12 -0000	1.17
--- fsystem.c	11 Aug 2004 14:33:43 -0000	1.18
***************
*** 838,843 ****
  		VOID_THROW(sys, FS_NULL);
  	}
  	// Look up the word in the dictionary
- //	if(!(ptr=dict_get(sys->table, name)))
  	if(!(ptr=voc_get_word(sys, name, strlen(name), NULL)))
  		VOID_THROW(sys, FS_NOT_FOUND);
--- 838,843 ----
  		VOID_THROW(sys, FS_NULL);
  	}
+ 
  	// Look up the word in the dictionary
  	if(!(ptr=voc_get_word(sys, name, strlen(name), NULL)))
  		VOID_THROW(sys, FS_NOT_FOUND);
***************
*** 847,850 ****
--- 847,874 ----
  
  
+ int fs_is_push_word(FSYSTEM *sys, char *name, int push)
+ {
+ 	FSYMREC *ptr;
+ 
+ 	if(!name)
+ 	{
+ 		return FALSE;
+ 	}
+ 
+ 	// Look up the word in the dictionary
+ 	if(!(ptr=voc_get_word(sys, name, strlen(name), NULL)))
+ 	{
+ 		return FALSE;
+ 	}
+ 
+ 	if(push)
+ 	{
+ 		in_push_wordref(sys, ptr);
+ 	}
+ 	
+ 	return TRUE;
+ }
+ 
+ 
  void fs_push_last_word(FSYSTEM *sys)
  {

Index: fsystem.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.h,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -d -r1.13 -r1.14
*** fsystem.h	10 Aug 2004 16:43:02 -0000	1.13
--- fsystem.h	11 Aug 2004 14:33:44 -0000	1.14
***************
*** 223,227 ****
  void	fs_func_call(FSYSTEM *sys, FCFUNC func);
  
! void	fs_push_word(FSYSTEM *sys, char *name); // FIND
  void	fs_push_word_data(FSYSTEM *sys, int offset); // >BODY
  void	fs_push_word_voc(FSYSTEM *sys, int offset);
--- 223,228 ----
  void	fs_func_call(FSYSTEM *sys, FCFUNC func);
  
! void	fs_push_word(FSYSTEM *sys, char *name);
! int		fs_is_push_word(FSYSTEM *sys, char *name, int push); // FIND
  void	fs_push_word_data(FSYSTEM *sys, int offset); // >BODY
  void	fs_push_word_voc(FSYSTEM *sys, int offset);

[Forthy-cvs] forthy fcompile.c,1.8,1.9 forthy.dsp,1.6,1.7 fsystem.h,1.12,1.13 main.c,1.22,1.23

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

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

Modified Files:
	fcompile.c forthy.dsp fsystem.h main.c 
Log Message:
- changed fs_literal() arguments/behaviour, now specify offset of value to literalize, must pop manually

Index: main.c
===================================================================
RCS file: /cvsroot/forthy/forthy/main.c,v
retrieving revision 1.22
retrieving revision 1.23
diff -C2 -d -r1.22 -r1.23
*** main.c	5 Aug 2004 23:32:01 -0000	1.22
--- main.c	10 Aug 2004 16:43:02 -0000	1.23
***************
*** 1198,1255 ****
  
  
! void word_words(FSYSTEM *sys)
  {
  	int i=0;
! 	int temp;
  	char *str;
- 	int vhandle, whandle;
  
! 	fs_push_first_word(sys);
  
! 	for(;;)
  	{
! 		temp=fs_get_type(sys, -1);
! 		// It's a NONE, end of list
! 		if(!temp)
  		{
! 			fs_pop(sys);
! 			break;
  		}
- 
- 		word_dup(sys);
- 		word_to_voc(sys);
- 
- 		// Make sure they are not NONEs
- 		temp=fs_get_type(sys, -1);
- 		if(temp==FS_NONE)
- 			whandle=0;
  		else
- 			whandle=fs_get_word_handle(sys, -1);
- 
- 		fs_pop(sys);
- 
- 		vhandle=0;
- 		if(fs_voc_depth(sys))
  		{
! 			fs_voc_pick(sys, -1);
  
! 			temp=fs_get_type(sys, -1);
! 			if(temp!=FS_NONE)
! 				vhandle=fs_get_word_handle(sys, -1);
! 			fs_pop(sys);
  		}
  
  
! 		if(whandle==vhandle)
  		{
! 			i++;
  			str=fs_get_word_name(sys, -1);
! 			printf("%-20s", str);
  		}
  
! 		word_word_next(sys);
! 	}
  
! 	printf("\n%d words\n", i);
  }
  
--- 1198,1291 ----
  
  
! static void words_like(FSYSTEM *sys, char *wordlet)
  {
+ 
  	int i=0;
! 	int type;
! 	int count, last;
  	char *str;
  
! 	last=count=fs_get_shared_count(sys);
  
! 	do
  	{
! 		if(count)
  		{
! 			fs_push_first_shared_word(sys, (last-count)+1);
  		}
  		else
  		{
! 			if(fs_is_dict_empty(sys))
! 				break;
  
! 			fs_push_first_word(sys);
  		}
  
+ 		count--;
  
! 		for(;;)
  		{
! 			int match=FALSE;
! 			
! 			type=fs_get_type(sys, -1);
! 
! 			// It's a NONE, end of list
! 			if(type==FS_NONE)
! 			{
! 				fs_pop(sys);
! 				break;
! 			}
! 
  			str=fs_get_word_name(sys, -1);
! 
! 			if(!wordlet)
! 			{
! 				match=TRUE;
! 			}
! 			else 
! 			{
! 				char *first;
! 				first=strstr(str, wordlet);
! 				
! 				if(first)
! 					match=TRUE;
! 			}
! 
! 
! 			if(match)
! 			{
! 				i++;
! 
! 				printf("%-20s", str);
! 			}
! 
! 			fs_push_next_word(sys, -1);
! 			fs_swap(sys, -1, -2);
! 			fs_pop(sys);
  		}
  
! 	}while(count>=0);
  
! 	printf("\n%d words ", i);
! }
! 
! 
! static void word_words(FSYSTEM *sys)
! {
! 	words_like(sys, NULL);
! }
! 
! 
! static void word_words_like(FSYSTEM *sys)
! {
! 	char *str;
! 
! 	fs_scan_word(sys);
! 
! 	str=strdup(fs_get_string(sys, -1));
! 	fs_pop(sys);
! 
! 	words_like(sys, str);
! 	free(str);
  }
  
***************
*** 1517,1520 ****
--- 1553,1562 ----
  
  
+ void word_literal(FSYSTEM *sys)
+ {
+ 	fs_literal(sys, -1);
+ 	fs_pop(sys);
+ }
+ 
  
  void word_evaluate(FSYSTEM *sys)
***************
*** 1546,1549 ****
--- 1588,1592 ----
  	fs_register_func(sys, "tuck", word_tuck, FS_DEFAULT);
  	fs_register_func(sys, "words", word_words, FS_DEFAULT);
+ 	fs_register_func(sys, "words.like", word_words_like, FS_DEFAULT);
  	fs_register_func(sys, "depth", word_depth, FS_DEFAULT);
  	fs_register_func(sys, "call", word_call, FS_DEFAULT);
***************
*** 1553,1557 ****
  	fs_register_func(sys, "pop", word_pop, FS_DEFAULT);
  	fs_register_func(sys, "#pop", word_depthpop, FS_DEFAULT);
! 	fs_register_func(sys, "type$", word_type, FS_DEFAULT);
  	fs_register_func(sys, "pickref", word_pickref, FS_DEFAULT);
  	fs_register_func(sys, "reftype", word_reftype, FS_DEFAULT);
--- 1596,1600 ----
  	fs_register_func(sys, "pop", word_pop, FS_DEFAULT);
  	fs_register_func(sys, "#pop", word_depthpop, FS_DEFAULT);
! 	fs_register_func(sys, "$type", word_type, FS_DEFAULT);
  	fs_register_func(sys, "pickref", word_pickref, FS_DEFAULT);
  	fs_register_func(sys, "reftype", word_reftype, FS_DEFAULT);
***************
*** 1584,1588 ****
  	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);
  	fs_register_func(sys, "[", fs_compile_pause, FS_IMMEDIATE);
  	fs_register_func(sys, "]", fs_compile_resume, FS_IMMEDIATE);
--- 1627,1631 ----
  	fs_register_func(sys, "forget", word_forget, FS_DEFAULT);
  	fs_register_func(sys, "recurse", fs_recurse, FS_IMMEDIATE);
! 	fs_register_func(sys, "literal", word_literal, FS_IMMEDIATE);
  	fs_register_func(sys, "[", fs_compile_pause, FS_IMMEDIATE);
  	fs_register_func(sys, "]", fs_compile_resume, FS_IMMEDIATE);

Index: fcompile.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fcompile.c,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** fcompile.c	6 Aug 2004 05:13:12 -0000	1.8
--- fcompile.c	10 Aug 2004 16:43:02 -0000	1.9
***************
*** 239,243 ****
  
  
! void fs_literal(FSYSTEM *sys)
  {
  	NEED_COMPILE(sys);
--- 239,243 ----
  
  
! void fs_literal(FSYSTEM *sys, int offset)
  {
  	NEED_COMPILE(sys);
***************
*** 246,250 ****
  		VOID_THROW(sys, FS_UNDERFLOW);
  
! 	switch(fs_get_type(sys, -1))
  	{
  		case FS_INT:
--- 246,250 ----
  		VOID_THROW(sys, FS_UNDERFLOW);
  
! 	switch(fs_get_type(sys, offset))
  	{
  		case FS_INT:
***************
*** 252,256 ****
  			int i;
  
! 			i=fs_get_int(sys, -1);
  			compile_int(sys, i);
  		}
--- 252,256 ----
  			int i;
  
! 			i=fs_get_int(sys, offset);
  			compile_int(sys, i);
  		}
***************
*** 261,265 ****
  			double f;
  
! 			f=fs_get_float(sys, -1);
  			compile_float(sys, f);
  		}
--- 261,265 ----
  			double f;
  
! 			f=fs_get_float(sys, offset);
  			compile_float(sys, f);
  		}
***************
*** 270,274 ****
  			char *str;
  
! 			str=fs_get_string(sys, -1);
  			compile_string(sys, str, strlen(str));
  		}
--- 270,274 ----
  			char *str;
  
! 			str=fs_get_string(sys, offset);
  			compile_string(sys, str, strlen(str));
  		}
***************
*** 279,283 ****
  			FSYMREC *ptr;
  
! 			in_get_word(sys, -1, &ptr);
  			compile_wordref(sys, ptr);
  		}
--- 279,283 ----
  			FSYMREC *ptr;
  
! 			in_get_word(sys, offset, &ptr);
  			compile_wordref(sys, ptr);
  		}
***************
*** 287,292 ****
  			VOID_THROW(sys, FS_BAD_TYPE);
  	}
- 
- 	fs_pop(sys);
  }
  
--- 287,290 ----

Index: fsystem.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.h,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** fsystem.h	5 Aug 2004 23:32:01 -0000	1.12
--- fsystem.h	10 Aug 2004 16:43:02 -0000	1.13
***************
*** 201,205 ****
  void	fs_postpone(FSYSTEM *sys, int offset);
  void	fs_recurse(FSYSTEM *sys);
! void	fs_literal(FSYSTEM *sys);
  
  void	fs_if(FSYSTEM *sys);
--- 201,205 ----
  void	fs_postpone(FSYSTEM *sys, int offset);
  void	fs_recurse(FSYSTEM *sys);
! void	fs_literal(FSYSTEM *sys, int offset);
  
  void	fs_if(FSYSTEM *sys);

Index: forthy.dsp
===================================================================
RCS file: /cvsroot/forthy/forthy/forthy.dsp,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** forthy.dsp	5 Aug 2004 04:18:37 -0000	1.6
--- forthy.dsp	10 Aug 2004 16:43:02 -0000	1.7
***************
*** 106,110 ****
  # Begin Source File
  
! SOURCE=..\Fortify\FORTIFY.C
  # End Source File
  # Begin Source File
--- 106,110 ----
  # Begin Source File
  
! SOURCE=..\fortify\fortify.c
  # End Source File
  # Begin Source File

[Forthy-cvs] forthy fcompile.c,1.7,1.8 fsystem.c,1.16,1.17 ftype.h,1.7,1.8

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

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

Modified Files:
	fcompile.c fsystem.c ftype.h 
Log Message:
- added some error codes/strings

Index: ftype.h
===================================================================
RCS file: /cvsroot/forthy/forthy/ftype.h,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** ftype.h	5 Aug 2004 04:18:37 -0000	1.7
--- ftype.h	6 Aug 2004 05:13:12 -0000	1.8
***************
*** 31,35 ****
  	FS_INTERNAL, FS_BAD_PARAMETER, FS_BAD_REF, FS_NULL, FS_OUT_OF_TEXT, 
  	FS_COMPILE_ONLY, FS_NESTED_COMPILE, FS_INTERPRET_ONLY, 
! 	FS_EXECUTION_ABORTED, FS_ERROR, FS_ERR_TOP} FERRORS;
  
  // Flags for words' behaviour
--- 31,36 ----
  	FS_INTERNAL, FS_BAD_PARAMETER, FS_BAD_REF, FS_NULL, FS_OUT_OF_TEXT, 
  	FS_COMPILE_ONLY, FS_NESTED_COMPILE, FS_INTERPRET_ONLY, 
! 	FS_EXECUTION_ABORTED, FS_CONTROL_FLOW_MISMATCH, FS_PROTECTED, 
! 	FS_ERROR, FS_ERR_TOP} FERRORS;
  
  // Flags for words' behaviour

Index: fsystem.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.c,v
retrieving revision 1.16
retrieving revision 1.17
diff -C2 -d -r1.16 -r1.17
*** fsystem.c	6 Aug 2004 02:52:04 -0000	1.16
--- fsystem.c	6 Aug 2004 05:13:12 -0000	1.17
***************
*** 154,157 ****
--- 154,159 ----
  	"interpret only",
  	"execution aborted",
+ 	"control-flow mismatch",
+ 	"protected",
  	"error"
  };
***************
*** 427,431 ****
  //	if(!(sym=dict_new(sys->table, name, flags)))
  	if(!(sym=voc_new_word(sys, name, flags)))
! 		INT_THROW(sys, FS_ERROR);
  
  	// Set exec to code_dovar
--- 429,433 ----
  //	if(!(sym=dict_new(sys->table, name, flags)))
  	if(!(sym=voc_new_word(sys, name, flags)))
! 		INT_THROW(sys, FS_OUT_OF_MEMORY);
  
  	// Set exec to code_dovar
***************
*** 1180,1184 ****
  	// Can't delete words from shared dictionaries
  	if(dict_attached(where))
! 		VOID_THROW(sys, FS_ERROR);
  
  	if(!dict_forget(sys->table, sym))
--- 1182,1186 ----
  	// Can't delete words from shared dictionaries
  	if(dict_attached(where))
! 		VOID_THROW(sys, FS_PROTECTED);
  
  	if(!dict_forget(sys->table, sym))

Index: fcompile.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fcompile.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** fcompile.c	5 Aug 2004 04:18:37 -0000	1.7
--- fcompile.c	6 Aug 2004 05:13:12 -0000	1.8
***************
*** 364,368 ****
  
  	if(tag==(int)colon_tag)
! 		VOID_THROW(sys, FS_ERROR); 
  
  	if(depth==3)
--- 364,368 ----
  
  	if(tag==(int)colon_tag)
! 		VOID_THROW(sys, FS_CONTROL_FLOW_MISMATCH);
  
  	if(depth==3)
***************
*** 514,518 ****
  
  	if(!resolve_colon(sys))
! 		VOID_THROW(sys, FS_ERROR); // TODO: Compile error
  
  	// Compile the EXIT opcode, close the word
--- 514,518 ----
  
  	if(!resolve_colon(sys))
! 		VOID_THROW(sys, FS_CONTROL_FLOW_MISMATCH); // TODO: Compile error
  
  	// Compile the EXIT opcode, close the word
***************
*** 585,589 ****
  
  	if(!i)
! 		VOID_THROW(sys, FS_ERROR); // TODO: Control-flow error
  }
  
--- 585,589 ----
  
  	if(!i)
! 		VOID_THROW(sys, FS_CONTROL_FLOW_MISMATCH); // TODO: Control-flow error
  }
  
***************
*** 609,613 ****
  
  	if(!resolve_tag(sys, (int)dest_tag))
! 		VOID_THROW(sys, FS_ERROR);
  
  	// Get dest offset
--- 609,613 ----
  
  	if(!resolve_tag(sys, (int)dest_tag))
! 		VOID_THROW(sys, FS_CONTROL_FLOW_MISMATCH);
  
  	// Get dest offset
***************
*** 640,644 ****
  
  	if(!resolve_tag(sys, (int)dest_tag))
! 		VOID_THROW(sys, FS_ERROR);
  
  	// Get dest offset
--- 640,644 ----
  
  	if(!resolve_tag(sys, (int)dest_tag))
! 		VOID_THROW(sys, FS_CONTROL_FLOW_MISMATCH);
  
  	// Get dest offset
***************
*** 728,732 ****
  
  	if(!resolve_tag(sys, (int)for_tag))
! 		VOID_THROW(sys, FS_ERROR); // TODO: FOR/NEXT error
  
  	// Get for-sys offset
--- 728,732 ----
  
  	if(!resolve_tag(sys, (int)for_tag))
! 		VOID_THROW(sys, FS_CONTROL_FLOW_MISMATCH); // TODO: FOR/NEXT error
  
  	// Get for-sys offset

[Forthy-cvs] forthy fcode.c,1.9,1.10 fmachine.c,1.6,1.7 fsystem.c,1.15,1.16

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

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

Modified Files:
	fcode.c fmachine.c fsystem.c 
Log Message:
- improved fs_step() behaviour
- tweaks

Index: fsystem.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.c,v
retrieving revision 1.15
retrieving revision 1.16
diff -C2 -d -r1.15 -r1.16
*** fsystem.c	5 Aug 2004 23:32:01 -0000	1.15
--- fsystem.c	6 Aug 2004 02:52:04 -0000	1.16
***************
*** 1386,1389 ****
--- 1386,1393 ----
  					// Execute any currently loaded word
  					sys->w->func(sys);
+ 					if(sys->vm_inner==vm_inner_step)
+ 					{
+ 						INT_THROW(sys, FS_STEP);
+ 					}
  				}
  				if(sys->ip)
***************
*** 1425,1428 ****
--- 1429,1433 ----
  
  	sys->env=NULL;
+ 	sys->w=NULL;
  	
  	return ret;
***************
*** 1438,1446 ****
  	}
  
- 	if(!sys->ip)
- 	{
- 		sys->ip=code_soft_exit_inner;
- 	}
- 
  	vm_load_word(sys, (FTOKEN*)handle);
  
--- 1443,1446 ----
***************
*** 1477,1480 ****
--- 1477,1481 ----
  	fs_remove(sys, fs_depth(sys));
  	fs_voc_clear(sys);
+ 	fs_voc_clear_compile(sys);
  
  	return FS_OK;
***************
*** 1522,1526 ****
  	vm_push_ip(sys, code_soft_interpreter);
  
- //	vm_load_word(sys, (FTOKEN*)OPCODE(OP_INTERPRET));
  	sys->w=NULL;
  
--- 1523,1526 ----

Index: fmachine.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fmachine.c,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** fmachine.c	5 Aug 2004 23:32:01 -0000	1.6
--- fmachine.c	6 Aug 2004 02:52:04 -0000	1.7
***************
*** 53,56 ****
--- 53,57 ----
  	// NEXT
  	sys->w=*(sys)->ip++;
+ 	sys->w->func(sys);
  	VOID_THROW(sys, FS_STEP);
  }
***************
*** 66,70 ****
  
  		// NEXT
- 
  		sys->w=w;
  
--- 67,70 ----

Index: fcode.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fcode.c,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** fcode.c	5 Aug 2004 23:32:01 -0000	1.9
--- fcode.c	6 Aug 2004 02:52:04 -0000	1.10
***************
*** 429,432 ****
--- 429,433 ----
  					// AGAIN, our IP gets pushed if HL word
  					sys->ip=code_soft_interpreter;
+ 					// EXECUTE
  					ptr->exec(sys);
  					return;

[Forthy-cvs] forthy fcode.c,1.8,1.9 fmachine.c,1.5,1.6 fsystem.c,1.14,1.15 fsystem.h,1.11,1.12 main.c,1.21,1.22

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

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

Modified Files:
	fcode.c fmachine.c fsystem.c fsystem.h main.c 
Log Message:
- reset functions
- cleanup

Index: fmachine.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fmachine.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** fmachine.c	5 Aug 2004 04:18:37 -0000	1.5
--- fmachine.c	5 Aug 2004 23:32:01 -0000	1.6
***************
*** 81,85 ****
  {
  	sys->w=NULL;
! 	sys->ip=sys->exit_inner;
  }
  
--- 81,85 ----
  {
  	sys->w=NULL;
! 	sys->ip=code_soft_exit_inner;
  }
  

Index: main.c
===================================================================
RCS file: /cvsroot/forthy/forthy/main.c,v
retrieving revision 1.21
retrieving revision 1.22
diff -C2 -d -r1.21 -r1.22
*** main.c	5 Aug 2004 04:18:37 -0000	1.21
--- main.c	5 Aug 2004 23:32:01 -0000	1.22
***************
*** 1901,1906 ****
  			
  				fs_reset(&sys);
- 				fs_remove(&sys, fs_depth(&sys));
- 				fs_voc_clear(&sys);
  			}
  			else
--- 1901,1904 ----

Index: fsystem.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.c,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** fsystem.c	5 Aug 2004 04:18:37 -0000	1.14
--- fsystem.c	5 Aug 2004 23:32:01 -0000	1.15
***************
*** 201,205 ****
  	sys->result=FS_OK;
  
! 	if(!((sys->istack)=stack_new(DEFAULT_STACK_SIZE)))
  		return FS_OUT_OF_MEMORY;
  
--- 201,205 ----
  	sys->result=FS_OK;
  
! 	if(!((sys->istack)=stack_new(return_stack_size)))
  		return FS_OUT_OF_MEMORY;
  
***************
*** 212,220 ****
  	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;
--- 212,217 ----
  	sys->shared=NULL;
  
  	sys->vm_inner=vm_inner_loop;
! 	sys->ip=code_soft_exit_inner;
  	sys->w=NULL;
  	sys->env=NULL;
***************
*** 1443,1447 ****
  	if(!sys->ip)
  	{
! 		sys->ip=sys->exit_inner;
  	}
  
--- 1440,1444 ----
  	if(!sys->ip)
  	{
! 		sys->ip=code_soft_exit_inner;
  	}
  
***************
*** 1465,1469 ****
  
  
! int fs_reset(FSYSTEM *sys)
  {
  	vm_abort(sys);
--- 1462,1466 ----
  
  
! int fs_reset_ex(FSYSTEM *sys)
  {
  	vm_abort(sys);
***************
*** 1475,1478 ****
--- 1472,1485 ----
  
  
+ int fs_reset(FSYSTEM *sys)
+ {
+ 	fs_reset_ex(sys);
+ 	fs_remove(sys, fs_depth(sys));
+ 	fs_voc_clear(sys);
+ 
+ 	return FS_OK;
+ }
+ 
+ 
  // Attach a string to the string buffer
  int fs_load_input(FSYSTEM *sys, char *input)
***************
*** 1513,1517 ****
  
  	// Store whatever's currently on the stack
! 	vm_push_ip(sys, sys->interpreter);
  
  //	vm_load_word(sys, (FTOKEN*)OPCODE(OP_INTERPRET));
--- 1520,1524 ----
  
  	// Store whatever's currently on the stack
! 	vm_push_ip(sys, code_soft_interpreter);
  
  //	vm_load_word(sys, (FTOKEN*)OPCODE(OP_INTERPRET));

Index: fsystem.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.h,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** fsystem.h	5 Aug 2004 04:18:37 -0000	1.11
--- fsystem.h	5 Aug 2004 23:32:01 -0000	1.12
***************
*** 49,54 ****
  
  	jmp_buf *env;			// C exceptions
- 	FXTOKEN exit_inner;
- 	FXTOKEN interpreter;
  
  	// TEMP: Profiling
--- 49,52 ----
***************
*** 89,94 ****
  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);
--- 87,93 ----
  int		fs_step(FSYSTEM *sys);
  //int		fs_trace(FSYSTEM *sys);
  int		fs_reset(FSYSTEM *sys);
+ int		fs_reset_ex(FSYSTEM *sys);
+ int		fs_clear_input(FSYSTEM *sys);
  
  int		fs_find_word_handle(FSYSTEM *sys, char *name);

Index: fcode.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fcode.c,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** fcode.c	5 Aug 2004 04:18:37 -0000	1.8
--- fcode.c	5 Aug 2004 23:32:01 -0000	1.9
***************
*** 428,432 ****
  
  					// AGAIN, our IP gets pushed if HL word
! 					sys->ip=sys->interpreter;
  					ptr->exec(sys);
  					return;
--- 428,432 ----
  
  					// AGAIN, our IP gets pushed if HL word
! 					sys->ip=code_soft_interpreter;
  					ptr->exec(sys);
  					return;
***************
*** 482,486 ****
  	
  		// AGAIN
! 		sys->ip=sys->interpreter;
  		return;
  	}
--- 482,486 ----
  	
  		// AGAIN
! 		sys->ip=code_soft_interpreter;
  		return;
  	}

[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"

[Forthy-cvs] forthy fsystem.c,1.12,1.13 fsystem.h,1.9,1.10 main.c,1.19,1.20

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

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

Modified Files:
	fsystem.c fsystem.h main.c 
Log Message:
- changed variables named "index" to "i"

Index: main.c
===================================================================
RCS file: /cvsroot/forthy/forthy/main.c,v
retrieving revision 1.19
retrieving revision 1.20
diff -C2 -d -r1.19 -r1.20
*** main.c	30 Jul 2004 00:36:41 -0000	1.19
--- main.c	31 Jul 2004 21:51:13 -0000	1.20
***************
*** 1284,1293 ****
  void word_shared_first(FSYSTEM *sys)
  {
! 	int index;
  
! 	index=fs_get_int(sys, -1);
  	fs_pop(sys);
  
! 	fs_push_first_shared_word(sys, index);
  }
  
--- 1284,1293 ----
  void word_shared_first(FSYSTEM *sys)
  {
! 	int i;
  
! 	i=fs_get_int(sys, -1);
  	fs_pop(sys);
  
! 	fs_push_first_shared_word(sys, i);
  }
  
***************
*** 1295,1304 ****
  void word_shared_last(FSYSTEM *sys)
  {
! 	int index;
  
! 	index=fs_get_int(sys, -1);
  	fs_pop(sys);
  
! 	fs_push_last_shared_word(sys, index);
  }
  
--- 1295,1304 ----
  void word_shared_last(FSYSTEM *sys)
  {
! 	int i;
  
! 	i=fs_get_int(sys, -1);
  	fs_pop(sys);
  
! 	fs_push_last_shared_word(sys, i);
  }
  
***************
*** 1314,1317 ****
--- 1314,1327 ----
  
  
+ void word_xor(FSYSTEM *sys)
+ {
+ 	int result;
+ 
+ 	result=fs_get_int(sys, -1)^fs_get_int(sys, -2);
+ 	fs_remove(sys, 2);
+ 	fs_push_int(sys, result);
+ }
+ 
+ 
  void word_or(FSYSTEM *sys)
  {
***************
*** 1626,1629 ****
--- 1636,1640 ----
  	fs_register_func(sys, "or", word_or, FS_DEFAULT);
  	fs_register_func(sys, "not", word_not, FS_DEFAULT);
+ 	fs_register_func(sys, "xor", word_xor, FS_DEFAULT);
  	fs_register_func(sys, "<<", word_lshift, FS_DEFAULT);
  	fs_register_func(sys, ">>", word_rshift, FS_DEFAULT);

Index: fsystem.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.c,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** fsystem.c	28 Jul 2004 03:53:11 -0000	1.12
--- fsystem.c	31 Jul 2004 21:51:13 -0000	1.13
***************
*** 915,924 ****
  
  
! void fs_push_last_shared_word(FSYSTEM *sys, unsigned index)
  {
  	FSYMREC *ptr;
  	FDICT *dict;
  
! 	dict=get_shared_dict(sys, index);
  	if(!dict)
  	{
--- 915,924 ----
  
  
! void fs_push_last_shared_word(FSYSTEM *sys, unsigned i)
  {
  	FSYMREC *ptr;
  	FDICT *dict;
  
! 	dict=get_shared_dict(sys, i);
  	if(!dict)
  	{
***************
*** 934,943 ****
  
  
! void fs_push_first_shared_word(FSYSTEM *sys, unsigned index)
  {
  	FSYMREC *ptr;
  	FDICT *dict;
  
! 	dict=get_shared_dict(sys, index);
  	if(!dict)
  	{
--- 934,943 ----
  
  
! void fs_push_first_shared_word(FSYSTEM *sys, unsigned i)
  {
  	FSYMREC *ptr;
  	FDICT *dict;
  
! 	dict=get_shared_dict(sys, i);
  	if(!dict)
  	{

Index: fsystem.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.h,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** fsystem.h	28 Jul 2004 03:53:11 -0000	1.9
--- fsystem.h	31 Jul 2004 21:51:13 -0000	1.10
***************
*** 183,188 ****
  void	fs_voc_clear_compile(FSYSTEM *sys);
  
! void	fs_push_last_shared_word(FSYSTEM *sys, unsigned index);
! void	fs_push_first_shared_word(FSYSTEM *sys, unsigned index);
  int		fs_get_shared_count(FSYSTEM *sys);
  
--- 183,188 ----
  void	fs_voc_clear_compile(FSYSTEM *sys);
  
! void	fs_push_last_shared_word(FSYSTEM *sys, unsigned i);
! void	fs_push_first_shared_word(FSYSTEM *sys, unsigned i);
  int		fs_get_shared_count(FSYSTEM *sys);
  

[Forthy-cvs] forthy license.txt,NONE,1.1 main.c,1.18,1.19

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

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

Modified Files:
	main.c 
Added Files:
	license.txt 
Log Message:
- added Artistic license text

Index: main.c
===================================================================
RCS file: /cvsroot/forthy/forthy/main.c,v
retrieving revision 1.18
retrieving revision 1.19
diff -C2 -d -r1.18 -r1.19
*** main.c	28 Jul 2004 03:53:11 -0000	1.18
--- main.c	30 Jul 2004 00:36:41 -0000	1.19
***************
*** 1640,1643 ****
--- 1640,1644 ----
  	fs_register_func(sys, "int", word_int, FS_DEFAULT);
  	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);
  
***************
*** 1888,1892 ****
  
  			show_stack(&sys);
! 			printf("@ ");
  		}
  
--- 1889,1893 ----
  
  			show_stack(&sys);
! 			printf("> ");
  		}
  

--- NEW FILE: license.txt ---
                         The "Artistic License"

                                Preamble

The intent of this document is to state the conditions under which a
Package may be copied, such that the Copyright Holder maintains some
semblance of artistic control over the development of the package,
while giving the users of the package the right to use and distribute
the Package in a more-or-less customary fashion, plus the right to make
reasonable modifications.

Definitions:

    "Package" refers to the collection of files distributed by the
    Copyright Holder, and derivatives of that collection of files
    created through textual modification.

    "Standard Version" refers to such a Package if it has not been
    modified, or has been modified in accordance with the wishes
    of the Copyright Holder as specified below.

    "Copyright Holder" is whoever is named in the copyright or
    copyrights for the package.

    "You" is you, if you're thinking about copying or distributing
    this Package.

    "Reasonable copying fee" is whatever you can justify on the
    basis of media cost, duplication charges, time of people involved,
    and so on.  (You will not be required to justify it to the
    Copyright Holder, but only to the computing community at large
    as a market that must bear the fee.)

    "Freely Available" means that no fee is charged for the item
    itself, though there may be fees involved in handling the item.
    It also means that recipients of the item may redistribute it
    under the same conditions they received it.

1. You may make and give away verbatim copies of the source form of the
Standard Version of this Package without restriction, provided that you
duplicate all of the original copyright notices and associated disclaimers.

2. You may apply bug fixes, portability fixes and other modifications
derived from the Public Domain or from the Copyright Holder.  A Package
modified in such a way shall still be considered the Standard Version.

3. You may otherwise modify your copy of this Package in any way, provided
that you insert a prominent notice in each changed file stating how and
when you changed that file, and provided that you do at least ONE of the
following:

    a) place your modifications in the Public Domain or otherwise make them
    Freely Available, such as by posting said modifications to Usenet or
    an equivalent medium, or placing the modifications on a major archive
    site such as uunet.uu.net, or by allowing the Copyright Holder to include
    your modifications in the Standard Version of the Package.

    b) use the modified Package only within your corporation or organization.

    c) rename any non-standard executables so the names do not conflict
    with standard executables, which must also be provided, and provide
    a separate manual page for each non-standard executable that clearly
    documents how it differs from the Standard Version.

    d) make other distribution arrangements with the Copyright Holder.

4. You may distribute the programs of this Package in object code or
executable form, provided that you do at least ONE of the following:

    a) distribute a Standard Version of the executables and library files,
    together with instructions (in the manual page or equivalent) on where
    to get the Standard Version.

    b) accompany the distribution with the machine-readable source of
    the Package with your modifications.

    c) give non-standard executables non-standard names, and clearly
    document the differences in manual pages (or equivalent), together
    with instructions on where to get the Standard Version.

    d) make other distribution arrangements with the Copyright Holder.

5. You may charge a reasonable copying fee for any distribution of this
Package.  You may charge any fee you choose for support of this
Package.  You may not charge a fee for this Package itself.  However,
you may distribute this Package in aggregate with other (possibly
commercial) programs as part of a larger (possibly commercial) software
distribution provided that you do not advertise this Package as a
product of your own.  You may embed this Package's interpreter within
an executable of yours (by linking); this shall be construed as a mere
form of aggregation, provided that the complete Standard Version of the
interpreter is so embedded.

6. The scripts and library files supplied as input to or produced as
output from the programs of this Package do not automatically fall
under the copyright of this Package, but belong to whoever generated
them, and may be sold commercially, and may be aggregated with this
Package.  If such scripts or library files are aggregated with this
Package via the so-called "undump" or "unexec" methods of producing a
binary executable image, then distribution of such an image shall
neither be construed as a distribution of this Package nor shall it
fall under the restrictions of Paragraphs 3 and 4, provided that you do
not represent such an executable image as a Standard Version of this
Package.

7. C subroutines (or comparably compiled subroutines in other
languages) supplied by you and linked into this Package in order to
emulate subroutines and variables of the language defined by this
Package shall not be considered part of this Package, but are the
equivalent of input as in Paragraph 6, provided these subroutines do
not change the language in any way that would cause it to fail the
regression tests for the language.

8. Aggregation of this Package with a commercial distribution is always
permitted provided that the use of this Package is embedded; that is,
when no overt attempt is made to make this Package's interfaces visible
to the end user of the commercial distribution.  Such use shall not be
construed as a distribution of this Package.

9. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.

10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

                                The End

[Forthy-cvs] forthy fmachine.c,1.3,1.4 fsystem.c,1.11,1.12 fsystem.h,1.8,1.9 main.c,1.17,1.18

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

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

Modified Files:
	fmachine.c fsystem.c fsystem.h main.c 
Log Message:
- removed some old comments
- added null string checking to some fs_* functions
- removed NULL checking for stack_get_value() calls, since it is handled by exceptions, or it will always return the bottom stack value if not running under the VM (this will be 0/NULL if the stack is empty).
- added some tests to main.c

Index: fmachine.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fmachine.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** fmachine.c	16 Nov 2003 16:45:06 -0000	1.3
--- fmachine.c	28 Jul 2004 03:53:10 -0000	1.4
***************
*** 113,129 ****
  
  
- /*
- int vm_get_int(FSYSTEM *sys, int offset)
- {
- 	FVALUE *value;
- 
- 	if(!(value=stack_get_value(sys->rstack, offset)))
- 		return 0;
- 
- 	return value_get_int(value);
- }
- */
- 
- 
  int vm_get_int(FSYSTEM *sys, int offset)
  {
--- 113,116 ----
***************
*** 159,175 ****
  
  
- /*
- int vm_get_type(FSYSTEM *sys, int offset)
- {
- 	FVALUE *value;
- 
- 	if(!(value=stack_get_value(sys->rstack, offset)))
- 		return FS_NONE;
- 
- 	return value_get_type(value);
- }
- */
- 
- 
  int vm_get_type(FSYSTEM *sys, int offset)
  {
--- 146,149 ----
***************
*** 177,182 ****
  
  	sp=stack_convert_offset(sys, sys->rstack, offset);
- //	if((sp=stack_convert_offset(sys->rstack, offset))<0)
- //		return FS_NONE;
  
  	return ((sys->rstack)->mem[sp]).type;
--- 151,154 ----

Index: main.c
===================================================================
RCS file: /cvsroot/forthy/forthy/main.c,v
retrieving revision 1.17
retrieving revision 1.18
diff -C2 -d -r1.17 -r1.18
*** main.c	27 Jul 2004 04:31:02 -0000	1.17
--- main.c	28 Jul 2004 03:53:11 -0000	1.18
***************
*** 1787,1790 ****
--- 1787,1808 ----
  	fs_remove(sys, 64);
  
+ 	fs_get_int(sys, -1);
+ 	fs_get_float(sys, -1);
+ 	fs_get_string(sys, -1);
+ 	fs_get_func(sys, -1);
+ 	fs_get_user(sys, -1);
+ 	fs_get_void(sys, -1);
+ 	fs_get_int(sys, -10);
+ 	fs_get_float(sys, -10);
+ 	fs_get_string(sys, -10);
+ 	fs_get_func(sys, -10);
+ 	fs_get_user(sys, -10);
+ 	fs_get_void(sys, -10);
+ 	fs_get_int(sys, 100);
+ 	fs_get_float(sys, 100);
+ 	fs_get_string(sys, 100);
+ 	fs_get_func(sys, 100);
+ 	fs_get_user(sys, 100);
+ 	fs_get_void(sys, 100);
  
  	fs_strlen(sys, -5, NULL);

Index: fsystem.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.c,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** fsystem.c	27 Jul 2004 04:31:02 -0000	1.11
--- fsystem.c	28 Jul 2004 03:53:11 -0000	1.12
***************
*** 339,342 ****
--- 339,347 ----
  	FSYMREC *ptr;
  
+ 	if(!name)
+ 	{
+ 		INT_THROW(sys, FS_NULL);
+ 	}
+ 
  	if(!func)
  		INT_THROW(sys, FS_NULL);
***************
*** 359,362 ****
--- 364,372 ----
  	FSYMREC *ptr;
  
+ 	if(!name)
+ 	{
+ 		INT_THROW(sys, FS_NULL);
+ 	}
+ 
  	if(sys->state==COMPILE_STATE||sys->code)
  		INT_THROW(sys, FS_NESTED_COMPILE);
***************
*** 377,380 ****
--- 387,395 ----
  	FVALUE *value;
  
+ 	if(!name)
+ 	{
+ 		INT_THROW(sys, FS_NULL);
+ 	}
+ 
  	if(sys->state==COMPILE_STATE||sys->code)
  		INT_THROW(sys, FS_NESTED_COMPILE);
***************
*** 385,390 ****
  
  	// Get value at offset
! 	if(!(value=stack_get_value(sys, sys->stack, -1)))
! 		INT_THROW(sys, FS_UNDERFLOW);
  
  	// Set value to dict entry
--- 400,404 ----
  
  	// Get value at offset
! 	value=stack_get_value(sys, sys->stack, -1);
  
  	// Set value to dict entry
***************
*** 402,405 ****
--- 416,424 ----
  	FSYMREC *sym;
  
+ 	if(!name)
+ 	{
+ 		INT_THROW(sys, FS_NULL);
+ 	}
+ 
  	if(sys->state==COMPILE_STATE||sys->code)
  		INT_THROW(sys, FS_NESTED_COMPILE);
***************
*** 761,765 ****
  
  
! static void push_string_span(FSYSTEM *sys, char *str, unsigned len)
  {
  	FVALUE *value;
--- 780,784 ----
  
  
! void fs_push_string_span(FSYSTEM *sys, char *str, unsigned len)
  {
  	FVALUE *value;
***************
*** 809,812 ****
--- 828,835 ----
  	FSYMREC *ptr;
  
+ 	if(!name)
+ 	{
+ 		VOID_THROW(sys, FS_NULL);
+ 	}
  	// Look up the word in the dictionary
  //	if(!(ptr=dict_get(sys->table, name)))
***************
*** 1025,1030 ****
  	FVALUE *value;
  
! 	if(!(value=stack_get_value(sys, sys->stack, offset)))
! 		return FS_NONE;
  
  	if(!(value=value_deref(value)))
--- 1048,1052 ----
  	FVALUE *value;
  
! 	value=stack_get_value(sys, sys->stack, offset);
  
  	if(!(value=value_deref(value)))
***************
*** 1040,1046 ****
  	FVALUE *value;
  
! 	if(!(value=stack_get_value(sys, sys->stack, offset)))
! 		return NULL;
! 
  	return value_get_func(value);
  }
--- 1062,1066 ----
  	FVALUE *value;
  
! 	value=stack_get_value(sys, sys->stack, offset);
  	return value_get_func(value);
  }
***************
*** 1079,1085 ****
  	FVALUE *value;
  
! 	if(!(value=stack_get_value(sys, sys->stack, offset)))
! 		return NULL;
! 
  	return value_get_void(value);
  }
--- 1099,1103 ----
  	FVALUE *value;
  
! 	value=stack_get_value(sys, sys->stack, offset);
  	return value_get_void(value);
  }
***************
*** 1090,1096 ****
  	FVALUE *value;
  
! 	if(!(value=stack_get_value(sys, sys->stack, offset)))
! 		return NULL;
! 
  	return value_get_user(value);
  }
--- 1108,1112 ----
  	FVALUE *value;
  
! 	value=stack_get_value(sys, sys->stack, offset);
  	return value_get_user(value);
  }
***************
*** 1102,1108 ****
  	FVALUE *value;
  
! 	if(!(value=stack_get_value(sys, sys->stack, offset)))
! 		return 0;
! 
  	return value_get_int(value);
  }
--- 1118,1122 ----
  	FVALUE *value;
  
! 	value=stack_get_value(sys, sys->stack, offset);
  	return value_get_int(value);
  }
***************
*** 1113,1119 ****
  	FVALUE *value;
  
! 	if(!(value=stack_get_value(sys, sys->stack, offset)))
! 		return 0;
! 
  	return value_get_float(value);
  }
--- 1127,1131 ----
  	FVALUE *value;
  
! 	value=stack_get_value(sys, sys->stack, offset);
  	return value_get_float(value);
  }
***************
*** 1124,1130 ****
  	FVALUE *value;
  
! 	if(!(value=stack_get_value(sys, sys->stack, offset)))
! 		return NULL;
! 
  	return value_get_string(value, &(sys->temp_str));
  }
--- 1136,1140 ----
  	FVALUE *value;
  
! 	value=stack_get_value(sys, sys->stack, offset);
  	return value_get_string(value, &(sys->temp_str));
  }
***************
*** 1143,1147 ****
  	{
  		len=sys->in_parse-start;
! 		push_string_span(sys, start, sys->in_parse-start);
  		return;
  	}
--- 1153,1157 ----
  	{
  		len=sys->in_parse-start;
! 		fs_push_string_span(sys, start, sys->in_parse-start);
  		return;
  	}
***************
*** 1440,1444 ****
  						compile_string(sys, start, len);
  					else
! 						push_string_span(sys, start, len);
  
  					break;
--- 1450,1454 ----
  						compile_string(sys, start, len);
  					else
! 						fs_push_string_span(sys, start, len);
  
  					break;

Index: fsystem.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.h,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** fsystem.h	24 Jul 2004 07:21:17 -0000	1.8
--- fsystem.h	28 Jul 2004 03:53:11 -0000	1.9
***************
*** 137,140 ****
--- 137,141 ----
  void	fs_push_float(FSYSTEM *sys, double f);
  void	fs_push_string(FSYSTEM *sys, char *str);
+ void	fs_push_string_span(FSYSTEM *sys, char *str, unsigned len);
  void	fs_push_func(FSYSTEM *sys, FCFUNC func);
  void	fs_push_user(FSYSTEM *sys, void* user, unsigned subtype);

[Forthy-cvs] forthy fdict.c,1.3,1.4 fdict.h,1.1,1.2 fsystem.c,1.10,1.11 ftype.h,1.5,1.6 main.c,1.16,1.17

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

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

Modified Files:
	fdict.c fdict.h fsystem.c ftype.h main.c 
Log Message:
- fixed bug where attached dictionaries could be forget'ed from if they were not shared with other FSYSTEMs
- tempfile in main.c for loading scripts, so no memory leak possible

Index: fdict.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fdict.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** fdict.c	16 Nov 2003 16:24:58 -0000	1.3
--- fdict.c	27 Jul 2004 04:31:02 -0000	1.4
***************
*** 53,56 ****
--- 53,57 ----
  	table->list=NULL;
  	table->refcount=1;
+ 	table->attached=FALSE;
  	return table;
  }
***************
*** 292,296 ****
  
  	dict->refcount++;
! 
  	return dict;
  }
--- 293,297 ----
  
  	dict->refcount++;
! 	dict->attached=TRUE;
  	return dict;
  }
***************
*** 302,305 ****
--- 303,313 ----
  }
  
+ 
+ int dict_attached(FDICT *dict)
+ {
+ 	return dict->attached;
+ }
+ 
+ 
  // TODO: Delete all symbols, do cleanup on any buffers and user types in the
  // list

Index: ftype.h
===================================================================
RCS file: /cvsroot/forthy/forthy/ftype.h,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** ftype.h	25 Jul 2004 20:25:47 -0000	1.5
--- ftype.h	27 Jul 2004 04:31:02 -0000	1.6
***************
*** 72,75 ****
--- 72,76 ----
  {
  	int refcount;
+ 	int attached;
  	FSYMREC *list;
  	// FSYMREC *fence;

Index: main.c
===================================================================
RCS file: /cvsroot/forthy/forthy/main.c,v
retrieving revision 1.16
retrieving revision 1.17
diff -C2 -d -r1.16 -r1.17
*** main.c	26 Jul 2004 03:28:30 -0000	1.16
--- main.c	27 Jul 2004 04:31:02 -0000	1.17
***************
*** 9,12 ****
--- 9,13 ----
  static int user_var=0;
  static int hex=0;
+ static char *tempfile=NULL;
  
  #ifdef FORTIFY
***************
*** 59,71 ****
  {
  	int ret;
- 	char *script;
  
! 	script=load_text(filename);
  
! 	if(!script)
  		return FS_ERROR;
  
! 	ret=fs_load_input(sys, script);
! 	free(script);
  
  	return ret;
--- 60,75 ----
  {
  	int ret;
  
! 	if(tempfile)
! 		free(tempfile);
  
! 	tempfile=load_text(filename);
! 
! 	if(!tempfile)
  		return FS_ERROR;
  
! 	ret=fs_load_input(sys, tempfile);
! 	free(tempfile);
! 	tempfile=NULL;
  
  	return ret;
***************
*** 1901,1904 ****
--- 1905,1911 ----
  	fs_sys_exit(&sys);
  
+ 	if(tempfile)
+ 		free(tempfile);
+ 
  #ifdef _DEBUG
  	fs_sys_exit(&sub);

Index: fsystem.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.c,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** fsystem.c	25 Jul 2004 20:25:47 -0000	1.10
--- fsystem.c	27 Jul 2004 04:31:02 -0000	1.11
***************
*** 1170,1174 ****
  
  	// Can't delete words from shared dictionaries
! 	if(dict_refcount(where)>1)
  		VOID_THROW(sys, FS_ERROR);
  
--- 1170,1174 ----
  
  	// Can't delete words from shared dictionaries
! 	if(dict_attached(where))
  		VOID_THROW(sys, FS_ERROR);
  

Index: fdict.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fdict.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** fdict.h	7 Aug 2003 01:22:55 -0000	1.1
--- fdict.h	27 Jul 2004 04:31:02 -0000	1.2
***************
*** 9,12 ****
--- 9,13 ----
  FDICT	*dict_attach(FDICT *table);
  int		dict_refcount(FDICT *dict);
+ int		dict_attached(FDICT *dict);
  
  FSYMREC *dict_new(FDICT *table, char *name, FSYMREC *vocab, int flags);

[Forthy-cvs] forthy fcode.c,1.6,1.7 main.c,1.15,1.16 test.txt,1.4,1.5

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

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

Modified Files:
	fcode.c main.c test.txt 
Log Message:
- some clean up
- realize how crappy my "outer loop" is, must fix to support proper EVALUATE

Index: test.txt
===================================================================
RCS file: /cvsroot/forthy/forthy/test.txt,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** test.txt	25 Jul 2004 20:25:47 -0000	1.4
--- test.txt	26 Jul 2004 03:28:30 -0000	1.5
***************
*** 42,46 ****
  : namespace 
  	32 word
! 	"{" cat ncreate last last >body ! immediate
  	does> @ dup voc.push current! 
  ; 
--- 42,46 ----
  : namespace 
  	32 word
! 	"{" cat $create last last >body ! immediate
  	does> @ dup voc.push current! 
  ; 
***************
*** 49,53 ****
  : namespace 
  	32 word
! 	ncreate last dup >body ! immediate
  	does> @
  ; 
--- 49,53 ----
  : namespace 
  	32 word
! 	$create last dup >body ! immediate
  	does> @
  ; 
***************
*** 76,79 ****
--- 76,81 ----
  ;
  
+ : load token $load ;
+ 
  load loadtest1.txt
  

Index: fcode.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fcode.c,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** fcode.c	18 Nov 2003 13:49:41 -0000	1.6
--- fcode.c	26 Jul 2004 03:28:30 -0000	1.7
***************
*** 82,109 ****
  };
  
- /*
- FCFUNC code_table[]=
- {
- 	code_exit_inner,
- 	code_docon,
- 	code_dovar,
- 	code_enter,
- 	code_exit,
- 	code_exit_all,
- 	code_lit_int,
- 	code_lit_float,
- 	code_lit_string,
- 	code_lit_wordref,
- 	code_branch,
- 	code_branch_ne,
- 	code_for,
- 	code_next,
- 	code_break,
- 	code_compile,
- 	code_does,
- 	code_dodoes,
- 	code_dodefer,
- };
- */
  
  void code_lit_int(FSYSTEM *sys)
--- 82,85 ----

Index: main.c
===================================================================
RCS file: /cvsroot/forthy/forthy/main.c,v
retrieving revision 1.15
retrieving revision 1.16
diff -C2 -d -r1.15 -r1.16
*** main.c	25 Jul 2004 20:25:47 -0000	1.15
--- main.c	26 Jul 2004 03:28:30 -0000	1.16
***************
*** 1458,1462 ****
  
  
! void word_ncreate(FSYSTEM *sys)
  {
  	char *str;
--- 1458,1462 ----
  
  
! void word_strcreate(FSYSTEM *sys)
  {
  	char *str;
***************
*** 1480,1496 ****
  
  
! void word_load(FSYSTEM *sys)
  {
  	char *str;
  
- 	fs_scan_word(sys);
  	str=fs_get_string(sys, -1);
- 
  	fs_pop(sys);
- 
  	fs_throw(sys, load_script(sys, str));
  }
  
  
  int load(FSYSTEM *sys)
  {
--- 1480,1504 ----
  
  
! void word_strload(FSYSTEM *sys)
  {
  	char *str;
  
  	str=fs_get_string(sys, -1);
  	fs_pop(sys);
  	fs_throw(sys, load_script(sys, str));
  }
  
  
+ void word_evaluate(FSYSTEM *sys)
+ {
+ 	char *str;
+ 
+ 	str=fs_get_string(sys, -1);
+ 	fs_pop(sys);
+ 	fs_load_input(sys, str);
+ 	fs_throw(sys, FS_READY);
+ }
+ 
+ 
  int load(FSYSTEM *sys)
  {
***************
*** 1578,1582 ****
  	fs_register_func(sys, "j", word_j, FS_DEFAULT);
  	fs_register_func(sys, "k", word_k, FS_DEFAULT);
- //	fs_register_func(sys, "evaluate", fs_evaluate, FS_DEFAULT);
  	fs_register_func(sys, "'", word_tick, FS_DEFAULT);
  	fs_register_func(sys, "name", word_name, FS_DEFAULT);
--- 1586,1589 ----
***************
*** 1626,1632 ****
  	fs_register_func(sys, "randnopush", word_randnopush, FS_DEFAULT);
  	fs_register_func(sys, "defer", word_defer, FS_DEFAULT);
! 	fs_register_func(sys, "ncreate", word_ncreate, FS_DEFAULT);
  	fs_register_func(sys, "int", word_int, FS_DEFAULT);
! 	fs_register_func(sys, "load", word_load, FS_DEFAULT);
  
  	fs_push_int(sys, '\n');
--- 1633,1640 ----
  	fs_register_func(sys, "randnopush", word_randnopush, FS_DEFAULT);
  	fs_register_func(sys, "defer", word_defer, FS_DEFAULT);
! 	fs_register_func(sys, "$create", word_strcreate, FS_DEFAULT);
  	fs_register_func(sys, "int", word_int, FS_DEFAULT);
! 	fs_register_func(sys, "$load", word_strload, FS_DEFAULT);
! //	fs_register_func(sys, "evaluate", word_evaluate, FS_DEFAULT);
  
  	fs_push_int(sys, '\n');
***************
*** 1715,1727 ****
  	for(i=0; i<5; i++)
  		fs_step(sys);
- 
- /*
- //	fs_load_word(sys, handle);
- 	fs_run(sys);
- 	fs_run(sys);
- 
- 	fs_load_string(sys, "test2");
- 	fs_run(sys);
- */
  }
  
--- 1723,1726 ----
***************
*** 1908,1912 ****
  
  #ifdef FORTIFY
- //	Fortify_LeaveScope();
  	Fortify_OutputStatistics();
  	Fortify_ListAllMemory();
--- 1907,1910 ----

[Forthy-cvs] forthy loadtest1.txt,NONE,1.1 loadtest2.txt,NONE,1.1 fsystem.c,1.9,1.10 ftype.h,1.4,1.5 fvalue.c,1.6,1.7 fvalue.h,1.3,1.4 main.c,1.14,1.15 test.txt,1.3,1.4

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

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

Modified Files:
	fsystem.c ftype.h fvalue.c fvalue.h main.c test.txt 
Added Files:
	loadtest1.txt loadtest2.txt 
Log Message:
- fixed input stack (it didn't work at all)
- changed how strings are initialized internally
- added a "load" word to main.c, and some test files for loading

--- NEW FILE: loadtest1.txt ---
load loadtest2.txt

: loadtest1 "LOADTEST 1!" . ;
loadtest1
Index: fvalue.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fvalue.c,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** fvalue.c	24 Jul 2004 07:21:17 -0000	1.6
--- fvalue.c	25 Jul 2004 20:25:47 -0000	1.7
***************
*** 106,118 ****
  	val->type=FS_STRING;
  	val->value.str=malloc(len+1);
! 	{ 
! 		int i, cnt; 
! 		cnt=len; 
! 		for(i=0; i<cnt; i++)
! 		{ 
! 			val->value.str[i]=string[i];
! 		} 
! 		val->value.str[i]=0; 
! 	} 
  	val->back_ref=NULL;
  }
--- 106,113 ----
  	val->type=FS_STRING;
  	val->value.str=malloc(len+1);
! 
! 	memcpy(val->value.str, string, len);
! 	val->value.str[len]=0; 
! 
  	val->back_ref=NULL;
  }
***************
*** 332,336 ****
  	// Get rid of any invalid pointers, so cleaning an old stack cell on exit
  	// doesn't corrupt the heap
! 	value->value.v=NULL;
  	value->type=FS_NONE;
  
--- 327,331 ----
  	// Get rid of any invalid pointers, so cleaning an old stack cell on exit
  	// doesn't corrupt the heap
! 	value->value.v[0]=NULL;
  	value->type=FS_NONE;
  

--- NEW FILE: loadtest2.txt ---
: loadtest2 "LOADTEST 2!!" . ;
loadtest2
Index: fsystem.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.c,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** fsystem.c	24 Jul 2004 07:21:17 -0000	1.9
--- fsystem.c	25 Jul 2004 20:25:47 -0000	1.10
***************
*** 941,949 ****
--- 941,953 ----
  
  	if(value_get_type(value)!=FS_WORDREF)
+ 	{
  		VOID_THROW(sys, FS_BAD_TYPE);
+ 	}
  
  	word=value_dewordref(value);
  	if(!word)
+ 	{
  		VOID_THROW(sys, FS_BAD_REF);
+ 	}
  
  	// No next
***************
*** 971,979 ****
--- 975,987 ----
  
  	if(value_get_type(value)!=FS_WORDREF)
+ 	{
  		VOID_THROW(sys, FS_BAD_TYPE);
+ 	}
  
  	word=value_dewordref(value);
  	if(!word)
+ 	{
  		VOID_THROW(sys, FS_BAD_REF);
+ 	}
  
  	// No prev
***************
*** 1319,1322 ****
--- 1327,1361 ----
  
  
+ static void input_drop(FSYSTEM *sys)
+ {
+ 	// pop top string value from the stack (bye bye!)
+ 	stack_pop(sys, sys->istack);
+ 
+ 	if(stack_depth(sys->istack))
+ 	{
+ 		int offset;
+ 		FVALUE *value;
+ 
+ 		// get string/offset from input stack
+ 		value=stack_get_value(sys, sys->istack, -1);
+ 		offset=(int)value->value.v[1];
+ 
+ 		// want direct access to avoid copying big strings
+ 		sys->in_load=(char*)value_get_void(value);
+ 		
+ 		sys->in_source=sys->in_load+offset;
+ 		sys->in_parse=NULL;
+ 		sys->in_token=NULL;
+ 	}
+ 	else
+ 	{
+ 		sys->in_load=NULL;
+ 		sys->in_source=NULL;
+ 		sys->in_parse=NULL;
+ 		sys->in_token=NULL;
+ 	}
+ }
+ 
+ 
  void do_interpret(FSYSTEM *sys)
  {
***************
*** 1413,1448 ****
  	}
  
! 
! 
! 	// pop top string value from the stack (bye bye!)
! 	stack_pop(sys, sys->istack);
! 
! 	if(stack_depth(sys->istack))
! 	{
! 		int offset;
! 		FVALUE *value;
! 
! 		// get and pop the offset from stack, no longer need to store
! 		value=stack_get_value(sys, sys->stack, -1);
! 		offset=value_get_int(value);
! 		stack_pop(sys, sys->istack);
! 
! 		// get input source start as void
! 		value=stack_get_value(sys, sys->stack, -1);
! 		
! 		// want direct access to avoid copying big strings
! 		sys->in_load=(char*)value_get_void(value);
! 		
! 		sys->in_source=sys->in_load+offset;
! 		sys->in_parse=NULL;
! 		sys->in_token=NULL;
! 	}
! 	else
! 	{
! 		sys->in_load=NULL;
! 		sys->in_source=NULL;
! 		sys->in_parse=NULL;
! 		sys->in_token=NULL;
! 	}
  
  	VOID_THROW(sys, FS_READY);
--- 1452,1456 ----
  	}
  
! 	input_drop(sys);
  
  	VOID_THROW(sys, FS_READY);
***************
*** 1524,1563 ****
  
  
- /*
- int fs_do_string(FSYSTEM *sys, char *str)
- {
- 	int ret;
- 
- 	jmp_buf env;
- 
- 	sys->vm_inner=vm_inner_loop;
- 	sys->env=&env;
- 
- 	ret=setjmp(env);
- 
- 	switch(ret)
- 	{
- 		case FS_OK:
- 			do_buffer(sys, str);
- 			ret=FS_READY;
- 			break;
- 
- 		case FS_READY:
- 			do_buffer(sys, sys->in_source);
- //			ret=FS_OK;
- 			break;
- 	
- 		default:
- 			if(ret<0)
- 				vm_abort(sys);
- 	}
- 
- 	sys->env=NULL;
- 
- 	return ret;
- }
- */
- 
- 
  // Load word to be executed by run() or step()
  int fs_load_word(FSYSTEM *sys, int handle)
--- 1532,1535 ----
***************
*** 1589,1604 ****
  
  // Attach a string to the string buffer
! int fs_load_input(FSYSTEM *sys, char *str)
  {
  	FVALUE *value;
  
  	// If we're already interpreting input
  	if(sys->in_source)
  	{		
! 		value=stack_push(sys, sys->istack);
! 		if(!value)
! 			return FS_OVERFLOW;
  
! 		value_init_int(value, sys->in_source-sys->in_load);
  	}
  
--- 1561,1586 ----
  
  // Attach a string to the string buffer
! int fs_load_input(FSYSTEM *sys, char *input)
  {
  	FVALUE *value;
+ 	char *str;
+ 
+ 	if(!input)
+ 	{
+ 		if(stack_depth(sys->istack))
+ 		{
+ 			input_drop(sys);
+ 		}
+ 		return FS_OK;
+ 	}
  
  	// If we're already interpreting input
  	if(sys->in_source)
  	{		
! 		value=stack_get_value(sys, sys->istack, -1);
  
! 		// Store current offset in the super secret unused upper 32-bits of 
! 		// the value
! 		value->value.v[1]=(void*)(sys->in_source-sys->in_load);
  	}
  
***************
*** 1606,1613 ****
  	value=stack_push(sys, sys->istack);
  	if(!value)
  		return FS_OVERFLOW;
  
! 	value_init_string(value, str, strlen(str));
! 
  	// Set input sources
  
--- 1588,1597 ----
  	value=stack_push(sys, sys->istack);
  	if(!value)
+ 	{
  		return FS_OVERFLOW;
+ 	}
  
! 	value_init_string(value, input, strlen(input));
! 	str=value_string_direct(value);
  	// Set input sources
  
***************
*** 1791,1795 ****
--- 1775,1781 ----
  
  	if(!value)
+ 	{
  		return FS_OK;
+ 	}
  	
  	// No jump set, so return
***************
*** 1866,1870 ****
--- 1852,1858 ----
  	// Must be a word
  	if(value->type!=FS_WORDREF)
+ 	{
  		VOID_THROW(sys, FS_BAD_TYPE);
+ 	}
  
  	stack_push_value(sys, sys->vstack, value);
***************
*** 1910,1914 ****
--- 1898,1904 ----
  
  	if(value->type!=FS_WORDREF)
+ 	{
  		VOID_THROW(sys, FS_BAD_TYPE);
+ 	}
  
  	value_copy(sys, &sys->vcompile, value);
***************
*** 1977,1982 ****
--- 1967,1975 ----
  	if(sys->rstack)
  		stack_delete(sys->rstack);
+ 
+ 	value_clean(&sys->vcompile, FALSE);
  	if(sys->vstack)
  		stack_delete(sys->vstack);
+ 
  	if(sys->istack)
  		stack_delete(sys->istack);

Index: ftype.h
===================================================================
RCS file: /cvsroot/forthy/forthy/ftype.h,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** ftype.h	24 Jul 2004 07:21:17 -0000	1.4
--- ftype.h	25 Jul 2004 20:25:47 -0000	1.5
***************
*** 109,113 ****
  		char *str;
  		// TODO: Userdata (void*)? Copy/clone/convert/delete interface, etc.
! 		void *v;
  		FCFUNC func;
  		FSTACK *stack;
--- 109,113 ----
  		char *str;
  		// TODO: Userdata (void*)? Copy/clone/convert/delete interface, etc.
! 		void *v[2];
  		FCFUNC func;
  		FSTACK *stack;

Index: main.c
===================================================================
RCS file: /cvsroot/forthy/forthy/main.c,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** main.c	24 Jul 2004 07:21:17 -0000	1.14
--- main.c	25 Jul 2004 20:25:47 -0000	1.15
***************
*** 56,59 ****
--- 56,76 ----
  
  
+ int load_script(FSYSTEM *sys, char *filename)
+ {
+ 	int ret;
+ 	char *script;
+ 
+ 	script=load_text(filename);
+ 
+ 	if(!script)
+ 		return FS_ERROR;
+ 
+ 	ret=fs_load_input(sys, script);
+ 	free(script);
+ 
+ 	return ret;
+ }
+ 
+ 
  void show_stack(FSYSTEM *sys)
  {
***************
*** 1433,1439 ****
  
  	fs_scan_word(sys);
! 
! 	if(!(str=fs_get_string(sys, -1)))
! 		fs_throw(sys, FS_BAD_PARAMETER);
  
  	fs_pop(sys);
--- 1450,1454 ----
  
  	fs_scan_word(sys);
! 	str=fs_get_string(sys, -1);
  
  	fs_pop(sys);
***************
*** 1465,1468 ****
--- 1480,1496 ----
  
  
+ void word_load(FSYSTEM *sys)
+ {
+ 	char *str;
+ 
+ 	fs_scan_word(sys);
+ 	str=fs_get_string(sys, -1);
+ 
+ 	fs_pop(sys);
+ 
+ 	fs_throw(sys, load_script(sys, str));
+ }
+ 
+ 
  int load(FSYSTEM *sys)
  {
***************
*** 1543,1547 ****
  	fs_register_func(sys, "poke", word_poke, FS_DEFAULT);
  	fs_register_func(sys, "pause", word_pause, FS_DEFAULT);
- //	fs_register_func(sys, "endif", word_endif, FS_IMMEDIATE);
  	fs_register_func(sys, "exit", fs_exit, FS_IMMEDIATE);
  	fs_register_func(sys, "immediate", word_immediate, FS_DEFAULT);
--- 1571,1574 ----
***************
*** 1601,1604 ****
--- 1628,1632 ----
  	fs_register_func(sys, "ncreate", word_ncreate, FS_DEFAULT);
  	fs_register_func(sys, "int", word_int, FS_DEFAULT);
+ 	fs_register_func(sys, "load", word_load, FS_DEFAULT);
  
  	fs_push_int(sys, '\n');
***************
*** 1616,1648 ****
  
  
- /*
- char *script=
- {
- 	"8 voc.new\n"
- 
- 	": also\n"
- 	"0 voc.pick voc.push ;\n"
- 
- 	": definitions\n"
- 	"voc.depth if 0 voc.pick current! else current.clear then ;\n"
- 
- 	": vocabulary\n"
- 	"variable last last >data ! does> voc.depth if voc.pop drop then\n"
- 	"@ voc.push ;\n"
- 
- 	": order\n"
- 	"\"CONTEXT: \" . voc.depth dup for dup i - voc.pick name . next cr\n"
- 	"\"CURRENT: \" . current@ dup datatype if name . else drop then cr drop ;\n"
- 
- 	": voc.path ( word -- )"
- 	"\"/\" begin over >voc datatype while ( word str )\n"
- 	"over >voc name swap cat ( word str )\n"
- 	"swap >voc swap \"/\" swap cat ( word str )\n"
- 	"repeat swap drop ;\n"
- 
- 	": which ' dup voc.path swap name cat . ; "
- };
- */
- 
  void word_root_1(FSYSTEM *sys)
  {
--- 1644,1647 ----
***************
*** 1793,1825 ****
  
  
- int load_script(FSYSTEM *sys, char *filename)
- {
- 	int ret;
- 	char *script;
- 
- 	script=load_text(filename);
- 
- 	if(!script)
- 		return FS_ERROR;
- 
- 	fs_load_input(sys, script);
- 	ret=fs_run(sys);
- 
- 	if(ret<FS_OK)
- 	{
- 		// Clear the stack
- 		fs_remove(sys, fs_depth(sys));
- 		
- 		printf("ERROR line %d at '%s': ", fs_get_current_line_number(sys),
- 			fs_get_last_token(sys));
- 		printf("%s\n", fs_get_result_string(sys, ret));
- 	}
- 
- 	free(script);
- 
- 	return FS_OK;
- }
- 
- 
  int main()
  {
--- 1792,1795 ----
***************
*** 1858,1863 ****
  	load(&sys);
  
- 	ret=load_script(&sys, "test.txt");
- 
  	#ifdef _DEBUG
  	test(&sys);
--- 1828,1831 ----
***************
*** 1865,1886 ****
  	#endif
  
! /*
! 	handle=fs_find_handle(&sys, "user");
! 	if(handle)
! 		fs_execute(&sys, handle);
! */
! 
! 
! /*
! 	fs_load_string(&sys, "variable 'ftest "
! 	": ftest \n'ftest @ execute ; "
! 	": test \npstart ftest pend / bye ; "
! 	": mytest \n50000 for 1 dup + drop next ; "
! 	"' mytest \n'ftest ! ");
! 
! 	fs_run(&sys);
  
- //	fs_do_string(&sys, ": test 100000 for next ; test");
- */
  	while(cont)
  	{
--- 1833,1839 ----
  	#endif
  
! 	load_script(&sys, "test.txt");
! 	ret=fs_run(&sys);
  
  	while(cont)
  	{

Index: test.txt
===================================================================
RCS file: /cvsroot/forthy/forthy/test.txt,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** test.txt	23 Jul 2004 06:11:08 -0000	1.3
--- test.txt	25 Jul 2004 20:25:47 -0000	1.4
***************
*** 76,77 ****
--- 76,79 ----
  ;
  
+ load loadtest1.txt
+ 

Index: fvalue.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fvalue.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** fvalue.h	16 Nov 2003 16:24:58 -0000	1.3
--- fvalue.h	25 Jul 2004 20:25:47 -0000	1.4
***************
*** 59,63 ****
  #define value_init_user(val, user, subtype) \
  	(val)->type=FS_USER+subtype; \
! 	(val)->value.v=(user); \
  	(val)->back_ref=NULL
  
--- 59,63 ----
  #define value_init_user(val, user, subtype) \
  	(val)->type=FS_USER+subtype; \
! 	(val)->value.v[0]=(user); \
  	(val)->back_ref=NULL
  
***************
*** 107,111 ****
  // DANGEROUS
  #define value_get_void(val) \
! 	(val->value.v)
  
  
--- 107,117 ----
  // DANGEROUS
  #define value_get_void(val) \
! 	(val->value.v[0])
! 
! #define value_get_void1(val) \
! 	(val->value.v[1])
! 
! #define value_string_direct(val) \
! 	(val->value.str)
  
  

[Forthy-cvs] forthy forthy.dsp,1.4,1.5 fparse.c,1.1,1.2 fstack.h,1.2,1.3 fsystem.c,1.8,1.9 fsystem.h,1.7,1.8 ftype.h,1.3,1.4 fvalue.c,1.5,1.6 main.c,1.13,1.14

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

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

Modified Files:
	forthy.dsp fparse.c fstack.h fsystem.c fsystem.h ftype.h 
	fvalue.c main.c 
Log Message:
- fixed swap fs_store() parameters
- fixed memory leak when trying to fs_store() on a bad reference (non-reference)
- changed input parsing behaviour, fs_load_input() replaces fs_load_string(). This now makes an internal copy of the source text, and puts it on an input stack. Should allow "included" files (untested as of yet)

Index: fvalue.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fvalue.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** fvalue.c	17 Nov 2003 06:18:00 -0000	1.5
--- fvalue.c	24 Jul 2004 07:21:17 -0000	1.6
***************
*** 631,635 ****
--- 631,638 ----
  	// Clean the destination value
  	if(!(dest=value_deref(destref)))
+ 	{
+ 		value_clean(&temp, FALSE);
  		VOID_THROW(sys, FS_BAD_REF);
+ 	}
  
  	value_clean(dest, FALSE);

Index: fparse.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fparse.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** fparse.c	7 Aug 2003 01:22:55 -0000	1.1
--- fparse.c	24 Jul 2004 07:21:17 -0000	1.2
***************
*** 31,34 ****
--- 31,42 ----
  
  
+ /*
+ ** parse_general:
+ ** - str, input to parse
+ ** - pre, post, delimiters
+ ** - start, where parsed token starts
+ ** - end, where parsed token ends
+ ** - next, where input will be parsed next time (past end of last token)
+ */
  int parse_general(char *str, char *pre, char *post, char **start, char **end, char **next)
  {

Index: ftype.h
===================================================================
RCS file: /cvsroot/forthy/forthy/ftype.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** ftype.h	17 Nov 2003 06:18:00 -0000	1.3
--- ftype.h	24 Jul 2004 07:21:17 -0000	1.4
***************
*** 108,116 ****
  		double f;
  		char *str;
! 		// TODO: Userdata (void*)? Copy/delete functions, etc.?
  		void *v;
  		FCFUNC func;
- //		FSYMREC *word;
- //		FDICT *table;
  		FSTACK *stack;
  		FXTOKEN tok;
--- 108,114 ----
  		double f;
  		char *str;
! 		// TODO: Userdata (void*)? Copy/clone/convert/delete interface, etc.
  		void *v;
  		FCFUNC func;
  		FSTACK *stack;
  		FXTOKEN tok;

Index: fstack.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fstack.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** fstack.h	13 Nov 2003 07:18:04 -0000	1.2
--- fstack.h	24 Jul 2004 07:21:17 -0000	1.3
***************
*** 18,21 ****
--- 18,22 ----
  void	stack_remove(FSYSTEM *sys, FSTACK *stack, int count);
  
+ char	*stack_pop_detach_string(FSYSTEM *sys, FSTACK *stack);
  void	stack_pop_to(FSYSTEM *sys, FSTACK *dest, FSTACK *src);
  void	stack_swap(FSYSTEM *sys, FSTACK *stack, int off1, int off2);

Index: fsystem.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.c,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** fsystem.c	23 Jul 2004 06:11:08 -0000	1.8
--- fsystem.c	24 Jul 2004 07:21:17 -0000	1.9
***************
*** 114,117 ****
--- 114,119 ----
  #define WHITESPACES	" \r\n\t"
  
+ #define DEFAULT_STACK_SIZE	8
+ 
  // ** Info strings **
  static char *_type_name[]=
***************
*** 170,173 ****
--- 172,176 ----
  //static char _other_error_name[33];
  
+ // TODO: Make the data/return stacks resizable
  int fs_sys_init(FSYSTEM *sys, int stack_size, int return_stack_size)
  {
***************
*** 178,185 ****
  	if(!sys->table)
  		return FS_NULL; // TODO: Error handling
! 	
  	if(!((sys->stack)=stack_new(stack_size)))
  		return FS_OUT_OF_MEMORY;
  
  	if(!((sys->rstack)=stack_new(return_stack_size)))
  		return FS_OUT_OF_MEMORY;
--- 181,194 ----
  	if(!sys->table)
  		return FS_NULL; // TODO: Error handling
! 
! 	if(!stack_size)
! 		stack_size=DEFAULT_STACK_SIZE;	
! 
  	if(!((sys->stack)=stack_new(stack_size)))
  		return FS_OUT_OF_MEMORY;
  
+ 	if(!return_stack_size)
+ 		stack_size=DEFAULT_STACK_SIZE;	
+ 
  	if(!((sys->rstack)=stack_new(return_stack_size)))
  		return FS_OUT_OF_MEMORY;
***************
*** 189,192 ****
--- 198,204 ----
  	sys->result=FS_OK;
  
+ 	if(!((sys->istack)=stack_new(DEFAULT_STACK_SIZE)))
+ 		return FS_OUT_OF_MEMORY;
+ 
  	sys->in_source=NULL;
  	sys->in_load=NULL;
***************
*** 275,278 ****
--- 287,293 ----
  	char *start, *end;
  
+ 	if(!sys->in_token)
+ 		return "<no token>";
+ 
  	if(parse_general(sys->in_token, WHITESPACES, WHITESPACES, &start, 
  		&end, NULL))
***************
*** 1315,1318 ****
--- 1330,1334 ----
  
  	// 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)))
***************
*** 1397,1402 ****
  	}
  
! 	sys->in_source=NULL;
! 	sys->in_parse=NULL;
  	VOID_THROW(sys, FS_READY);
  }
--- 1413,1449 ----
  	}
  
! 
! 
! 	// pop top string value from the stack (bye bye!)
! 	stack_pop(sys, sys->istack);
! 
! 	if(stack_depth(sys->istack))
! 	{
! 		int offset;
! 		FVALUE *value;
! 
! 		// get and pop the offset from stack, no longer need to store
! 		value=stack_get_value(sys, sys->stack, -1);
! 		offset=value_get_int(value);
! 		stack_pop(sys, sys->istack);
! 
! 		// get input source start as void
! 		value=stack_get_value(sys, sys->stack, -1);
! 		
! 		// want direct access to avoid copying big strings
! 		sys->in_load=(char*)value_get_void(value);
! 		
! 		sys->in_source=sys->in_load+offset;
! 		sys->in_parse=NULL;
! 		sys->in_token=NULL;
! 	}
! 	else
! 	{
! 		sys->in_load=NULL;
! 		sys->in_source=NULL;
! 		sys->in_parse=NULL;
! 		sys->in_token=NULL;
! 	}
! 
  	VOID_THROW(sys, FS_READY);
  }
***************
*** 1416,1419 ****
--- 1463,1467 ----
  		if(!ret)
  		{
+ 			// TODO: Use istack depth?
  			if((sys->in_source)&&(!sys->running))
  			{
***************
*** 1528,1546 ****
  
  
  // Attach a string to the string buffer
! int fs_load_string(FSYSTEM *sys, char *str)
  {
  	sys->in_source=str;
  	sys->in_load=str;
! 	sys->in_parse=str;
  	sys->in_token=NULL;
  
- 	// Clear the return stack? Behave like QUIT?
- //	vm_abort(sys);
- 
  	return FS_OK;
  }
  
  
  /* One step of the VM (not a debugging step/trace)
  	TODO: 
--- 1576,1638 ----
  
  
+ int fs_clear_input(FSYSTEM *sys)
+ {
+ 	stack_remove(sys, sys->istack, stack_depth(sys->istack));
+ 	sys->in_load=NULL;
+ 	sys->in_source=NULL;
+ 	sys->in_parse=NULL;
+ 	sys->in_token=NULL;
+ 
+ 	return FS_OK;
+ }
+ 
+ 
  // Attach a string to the string buffer
! int fs_load_input(FSYSTEM *sys, char *str)
  {
+ 	FVALUE *value;
+ 
+ 	// If we're already interpreting input
+ 	if(sys->in_source)
+ 	{		
+ 		value=stack_push(sys, sys->istack);
+ 		if(!value)
+ 			return FS_OVERFLOW;
+ 
+ 		value_init_int(value, sys->in_source-sys->in_load);
+ 	}
+ 
+ 	// Put input string on the istack
+ 	value=stack_push(sys, sys->istack);
+ 	if(!value)
+ 		return FS_OVERFLOW;
+ 
+ 	value_init_string(value, str, strlen(str));
+ 
+ 	// Set input sources
+ 
  	sys->in_source=str;
  	sys->in_load=str;
! 	sys->in_parse=NULL;
  	sys->in_token=NULL;
  
  	return FS_OK;
  }
  
  
+ int fs_input_new(FSYSTEM *sys, int size)
+ {
+ 	if(!size)
+ 		return FS_OK;
+ 
+ 	sys->istack=stack_new((size*2)-1);
+ 
+ 	if(sys->istack)
+ 		return FS_OK;
+ 
+ 	INT_THROW(sys, FS_OUT_OF_MEMORY);
+ }
+ 
+ 
  /* One step of the VM (not a debugging step/trace)
  	TODO: 
***************
*** 1727,1731 ****
  		return FS_OK;
  
! 	return FS_OUT_OF_MEMORY;
  }
  
--- 1819,1823 ----
  		return FS_OK;
  
! 	INT_THROW(sys, FS_OUT_OF_MEMORY);
  }
  
***************
*** 1887,1890 ****
--- 1979,1984 ----
  	if(sys->vstack)
  		stack_delete(sys->vstack);
+ 	if(sys->istack)
+ 		stack_delete(sys->istack);
  
  	if(sys->temp_str)
***************
*** 1894,1897 ****
--- 1988,1993 ----
  		free(sys->result_str);
  
+ 	memset(sys, 0, sizeof(FSYSTEM));
+ 
  	return FS_OK;
  }

Index: forthy.dsp
===================================================================
RCS file: /cvsroot/forthy/forthy/forthy.dsp,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** forthy.dsp	23 Jul 2004 15:48:08 -0000	1.4
--- forthy.dsp	24 Jul 2004 07:21:17 -0000	1.5
***************
*** 106,109 ****
--- 106,113 ----
  # Begin Source File
  
+ SOURCE=..\Fortify\FORTIFY.C
+ # End Source File
+ # Begin Source File
+ 
  SOURCE=.\fparse.c
  # End Source File

Index: main.c
===================================================================
RCS file: /cvsroot/forthy/forthy/main.c,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -d -r1.13 -r1.14
*** main.c	23 Jul 2004 15:48:08 -0000	1.13
--- main.c	24 Jul 2004 07:21:17 -0000	1.14
***************
*** 473,477 ****
  void word_store(FSYSTEM *sys)
  {
! 	fs_store(sys, -2, -1);
  	fs_remove(sys, 2);
  }
--- 473,477 ----
  void word_store(FSYSTEM *sys)
  {
! 	fs_store(sys, -1, -2);
  	fs_remove(sys, 2);
  }
***************
*** 1703,1707 ****
  	int i;
  
! 	fs_load_string(sys, ": test 1 2 3 ; : test2 test swap drop dup + - . ; ");
  	fs_run(sys);
  
--- 1703,1707 ----
  	int i;
  
! 	fs_load_input(sys, ": test 1 2 3 ; : test2 test swap drop dup + - . ; ");
  	fs_run(sys);
  
***************
*** 1742,1746 ****
  	fs_pop(sys);
  
! 	fs_store(sys, -2, -1);
  	show_stack(sys);
  	fs_pop(sys);
--- 1742,1746 ----
  	fs_pop(sys);
  
! 	fs_store(sys, -1, -2);
  	show_stack(sys);
  	fs_pop(sys);
***************
*** 1803,1807 ****
  		return FS_ERROR;
  
! 	fs_load_string(sys, script);
  	ret=fs_run(sys);
  
--- 1803,1807 ----
  		return FS_ERROR;
  
! 	fs_load_input(sys, script);
  	ret=fs_run(sys);
  
***************
*** 1894,1897 ****
--- 1894,1899 ----
  				printf("ERROR at '%s': ", fs_get_last_token(&sys));
  				printf("%s\n", fs_get_result_string(&sys, ret));
+ 			
+ 				fs_clear_input(&sys);
  			}
  			else
***************
*** 1935,1940 ****
  				if(pos)
  				{
! 					fs_load_string(&sys, buffer);
! 
  					ret=fs_run(&sys);
  				}
--- 1937,1941 ----
  				if(pos)
  				{
! 					fs_load_input(&sys, buffer);
  					ret=fs_run(&sys);
  				}

Index: fsystem.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.h,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** fsystem.h	23 Jul 2004 06:11:08 -0000	1.7
--- fsystem.h	24 Jul 2004 07:21:17 -0000	1.8
***************
*** 33,36 ****
--- 33,37 ----
  	FSTACK *rstack;			// return stack
  	FSTACK *vstack;			// vocabulary stack
+ 	FSTACK *istack;			// input stack
  	FVALUE vcompile;		// "current" compilation vocabulary
  
***************
*** 81,88 ****
  int		fs_dict_attach(FSYSTEM *sys, FSYSTEM *source);
  
! int		fs_load_string(FSYSTEM *sys, char *str);
  int		fs_load_word(FSYSTEM *sys, int handle);
  int		fs_run(FSYSTEM *sys);
  int		fs_step(FSYSTEM *sys);
  //int		fs_trace(FSYSTEM *sys);
  
--- 82,90 ----
  int		fs_dict_attach(FSYSTEM *sys, FSYSTEM *source);
  
! int		fs_load_input(FSYSTEM *sys, char *str);
  int		fs_load_word(FSYSTEM *sys, int handle);
  int		fs_run(FSYSTEM *sys);
  int		fs_step(FSYSTEM *sys);
+ int		fs_clear_input(FSYSTEM *sys);
  //int		fs_trace(FSYSTEM *sys);
  

[Forthy-cvs] forthy forthy.dsp,1.3,1.4 main.c,1.12,1.13

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

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

Modified Files:
	forthy.dsp main.c 
Log Message:
- fixed main.c compile errors for fs_store()
- removed fortify.c from MSVC project

Index: main.c
===================================================================
RCS file: /cvsroot/forthy/forthy/main.c,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** main.c	23 Jul 2004 06:11:08 -0000	1.12
--- main.c	23 Jul 2004 15:48:08 -0000	1.13
***************
*** 1742,1746 ****
  	fs_pop(sys);
  
! 	fs_store(sys, -1);
  	show_stack(sys);
  	fs_pop(sys);
--- 1742,1746 ----
  	fs_pop(sys);
  
! 	fs_store(sys, -2, -1);
  	show_stack(sys);
  	fs_pop(sys);

Index: forthy.dsp
===================================================================
RCS file: /cvsroot/forthy/forthy/forthy.dsp,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** forthy.dsp	16 Nov 2003 16:24:58 -0000	1.3
--- forthy.dsp	23 Jul 2004 15:48:08 -0000	1.4
***************
*** 106,113 ****
  # Begin Source File
  
- SOURCE=..\Fortify\FORTIFY.C
- # End Source File
- # Begin Source File
- 
  SOURCE=.\fparse.c
  # End Source File
--- 106,109 ----

[Forthy-cvs] forthy fsystem.c,1.7,1.8 fsystem.h,1.6,1.7 main.c,1.11,1.12 test.txt,1.2,1.3

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

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

Modified Files:
	fsystem.c fsystem.h main.c test.txt 
Log Message:
- changed fs_store() to use src and dest
- added fs_is_dict_empty()
- tweaked main.c

Index: main.c
===================================================================
RCS file: /cvsroot/forthy/forthy/main.c,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** main.c	17 Nov 2003 06:18:00 -0000	1.11
--- main.c	23 Jul 2004 06:11:08 -0000	1.12
***************
*** 83,87 ****
  			case FS_INT:
  				if(hex)
! 					printf("%x ", fs_get_int(sys, i+1));
  				else
  					printf("%d ", fs_get_int(sys, i+1));
--- 83,87 ----
  			case FS_INT:
  				if(hex)
! 					printf("0x%x ", fs_get_int(sys, i+1));
  				else
  					printf("%d ", fs_get_int(sys, i+1));
***************
*** 473,478 ****
  void word_store(FSYSTEM *sys)
  {
! 	fs_swap(sys, -1, -2);
! 	fs_store(sys, -2);
  	fs_remove(sys, 2);
  }
--- 473,477 ----
  void word_store(FSYSTEM *sys)
  {
! 	fs_store(sys, -2, -1);
  	fs_remove(sys, 2);
  }
***************
*** 645,655 ****
  
  
- void word_paren(FSYSTEM *sys)
- {
- 	fs_scan_text(sys, NULL, ")\n");
- 	fs_pop(sys);
- }
- 
- 
  void word_string(FSYSTEM *sys)
  {
--- 644,647 ----
***************
*** 716,720 ****
  			i=fs_get_int(sys, -1);
  			if(hex)
! 				printf("%x ", i);
  			else
  				printf("%d ", i);
--- 708,712 ----
  			i=fs_get_int(sys, -1);
  			if(hex)
! 				printf("0x%x ", i);
  			else
  				printf("%d ", i);
***************
*** 919,929 ****
  
  
- void word_forget(FSYSTEM *sys)
- {
- 	word_tick(sys);
- 	word_xtforget(sys);
- }
- 
- 
  void word_find(FSYSTEM *sys)
  {
--- 911,914 ----
***************
*** 1041,1045 ****
  
  
! void word_to_data(FSYSTEM *sys)
  {
  	fs_push_word_data(sys, -1);
--- 1026,1030 ----
  
  
! void word_to_body(FSYSTEM *sys)
  {
  	fs_push_word_data(sys, -1);
***************
*** 1521,1530 ****
  	fs_register_func(sys, ".swap", word_stackswap, FS_DEFAULT);
  	fs_register_func(sys, ".swapout", word_stackswapout, FS_DEFAULT);
! 	fs_register_func(sys, "const", word_const, FS_DEFAULT);
  	fs_register_func(sys, "variable", word_variable, FS_DEFAULT);
  	fs_register_func(sys, "err", word_err, FS_DEFAULT);
  	fs_register_func(sys, "retuser", word_retuser, FS_DEFAULT);
  	fs_register_func(sys, "token", word_token, FS_DEFAULT);
- 	fs_register_func(sys, "(", word_paren, FS_IMMEDIATE);
  	fs_register_func(sys, "s\"", word_string, FS_DEFAULT);
  	fs_register_func(sys, "parse", word_parse, FS_DEFAULT);
--- 1506,1514 ----
  	fs_register_func(sys, ".swap", word_stackswap, FS_DEFAULT);
  	fs_register_func(sys, ".swapout", word_stackswapout, FS_DEFAULT);
! 	fs_register_func(sys, "constant", word_const, FS_DEFAULT);
  	fs_register_func(sys, "variable", word_variable, FS_DEFAULT);
  	fs_register_func(sys, "err", word_err, FS_DEFAULT);
  	fs_register_func(sys, "retuser", word_retuser, FS_DEFAULT);
  	fs_register_func(sys, "token", word_token, FS_DEFAULT);
  	fs_register_func(sys, "s\"", word_string, FS_DEFAULT);
  	fs_register_func(sys, "parse", word_parse, FS_DEFAULT);
***************
*** 1534,1539 ****
  	fs_register_func(sys, ".", word_dot, FS_DEFAULT);
  	fs_register_func(sys, "cr", word_cr, FS_DEFAULT);
! 	fs_register_func(sys, "xtforget", 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);
--- 1518,1522 ----
  	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);
***************
*** 1579,1583 ****
  	fs_register_func(sys, "bye", word_bye, FS_DEFAULT);
  	fs_register_func(sys, "break", fs_break, FS_IMMEDIATE);
! 	fs_register_func(sys, ">data", word_to_data, FS_DEFAULT);
  	fs_register_func(sys, "find", word_find, FS_DEFAULT);
  	fs_register_func(sys, "does>", fs_does, FS_IMMEDIATE);
--- 1562,1566 ----
  	fs_register_func(sys, "bye", word_bye, FS_DEFAULT);
  	fs_register_func(sys, "break", fs_break, FS_IMMEDIATE);
! 	fs_register_func(sys, ">body", word_to_body, FS_DEFAULT);
  	fs_register_func(sys, "find", word_find, FS_DEFAULT);
  	fs_register_func(sys, "does>", fs_does, FS_IMMEDIATE);
***************
*** 1619,1622 ****
--- 1602,1609 ----
  	fs_register_func(sys, "int", word_int, FS_DEFAULT);
  
+ 	fs_push_int(sys, '\n');
+ 	fs_register_const(sys, "eol", FS_DEFAULT);
+ 	fs_pop(sys);
+ 
  	fs_push_user(sys, (void*)&user_var, 1);
  	fs_register_const(sys, "user", FS_DEFAULT);
***************
*** 1806,1811 ****
  
  
! void load_script(FSYSTEM *sys, char *filename)
  {
  	char *script;
  
--- 1793,1799 ----
  
  
! int load_script(FSYSTEM *sys, char *filename)
  {
+ 	int ret;
  	char *script;
  
***************
*** 1813,1821 ****
  
  	if(!script)
! 		return;
  
  	fs_load_string(sys, script);
! 	fs_run(sys);
  	free(script);
  }
  
--- 1801,1822 ----
  
  	if(!script)
! 		return FS_ERROR;
  
  	fs_load_string(sys, script);
! 	ret=fs_run(sys);
! 
! 	if(ret<FS_OK)
! 	{
! 		// Clear the stack
! 		fs_remove(sys, fs_depth(sys));
! 		
! 		printf("ERROR line %d at '%s': ", fs_get_current_line_number(sys),
! 			fs_get_last_token(sys));
! 		printf("%s\n", fs_get_result_string(sys, ret));
! 	}
! 
  	free(script);
+ 
+ 	return FS_OK;
  }
  
***************
*** 1857,1861 ****
  	load(&sys);
  
! 	load_script(&sys, "test.txt");
  
  	#ifdef _DEBUG
--- 1858,1862 ----
  	load(&sys);
  
! 	ret=load_script(&sys, "test.txt");
  
  	#ifdef _DEBUG
***************
*** 1885,1889 ****
--- 1886,1917 ----
  	{
  		if(!fs_is_compiling(&sys))
+ 		{
+ 			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));
+ 			}
+ 			else
+ 			{
+ 				if(ret==FS_BYE)
+ 				{
+ 					cont=FALSE;
+ 					break;
+ 				}
+ 				else if(ret!=FS_OK)
+ 				{
+ 					printf("RESULT at '%s': ", fs_get_last_token(&sys));
+ 				}
+ 
+ 
+ 				printf("%s\n", fs_get_result_string(&sys, ret));
+ 			}
+ 
+ 			show_stack(&sys);
  			printf("@ ");
+ 		}
  
  		for(;;)
***************
*** 1910,1945 ****
  
  					ret=fs_run(&sys);
- 
- 					if(!fs_is_compiling(&sys))
- 					{
- 						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));
- 						}
- 						else
- 						{
- 							if(ret==FS_BYE)
- 							{
- 								cont=FALSE;
- 								break;
- 							}
- 							else if(ret!=FS_OK)
- 							{
- 								printf("RESULT at '%s': ", fs_get_last_token(&sys));
- 							}
- 
- 
- 							printf("%s\n", fs_get_result_string(&sys, ret));
- 						}
- 					}
  				}
  
- 				if(!fs_is_compiling(&sys))
- 					show_stack(&sys);
- 
  				pos=0;
  				break;
--- 1938,1943 ----

Index: fsystem.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** fsystem.h	17 Nov 2003 06:18:00 -0000	1.6
--- fsystem.h	23 Jul 2004 06:11:08 -0000	1.7
***************
*** 115,121 ****
  void	fs_pick(FSYSTEM *sys, int offset);			
  void	fs_pick_ref(FSYSTEM *sys, int offset);		
  void	fs_fetch(FSYSTEM *sys, int offset); // Change to just fetch()
! // fs_store() stores to top value; add another offset for dest?
! void	fs_store(FSYSTEM *sys, int ref_offset); 
  void	fs_swap(FSYSTEM *sys, int off1, int off2);		
  void	fs_rotl(FSYSTEM *sys, int offset, int count);	
--- 115,121 ----
  void	fs_pick(FSYSTEM *sys, int offset);			
  void	fs_pick_ref(FSYSTEM *sys, int offset);		
+ 
  void	fs_fetch(FSYSTEM *sys, int offset); // Change to just fetch()
! void	fs_store(FSYSTEM *sys, int ref_offset, int src_offset); 
  void	fs_swap(FSYSTEM *sys, int off1, int off2);		
  void	fs_rotl(FSYSTEM *sys, int offset, int count);	
***************
*** 222,225 ****
--- 222,226 ----
  void	fs_push_word_voc(FSYSTEM *sys, int offset);
  
+ int		fs_is_dict_empty(FSYSTEM *sys);
  void	fs_push_first_word(FSYSTEM *sys);
  void	fs_push_next_word(FSYSTEM *sys, int offset);

Index: test.txt
===================================================================
RCS file: /cvsroot/forthy/forthy/test.txt,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** test.txt	18 Nov 2003 13:49:41 -0000	1.2
--- test.txt	23 Jul 2004 06:11:08 -0000	1.3
***************
*** 1,4 ****
--- 1,14 ----
  8 voc.new
  
+ : \ eol word drop ;
+  
+ : ( 
+ 	[ char ) ] literal word drop
+ ; immediate
+ 
+ : forget
+ 	' (forget)
+ ;
+ 
  : also
  	0 voc.pick voc.push 
***************
*** 10,14 ****
  
  : vocabulary
! 	variable last last >data ! does> voc.depth if voc.pop drop then
  	@ voc.push 
  ;
--- 20,24 ----
  
  : vocabulary
! 	variable last last >body ! does> voc.depth if voc.pop drop then
  	@ voc.push 
  ;
***************
*** 30,33 ****
--- 40,62 ----
  ;
  
+ : namespace 
+ 	32 word
+ 	"{" cat ncreate last last >body ! immediate
+ 	does> @ dup voc.push current! 
+ ; 
+ 
+ ( ** Alternative namespace method
+ : namespace 
+ 	32 word
+ 	ncreate last dup >body ! immediate
+ 	does> @
+ ; 
+ 
+ : {
+ 	dup voc.push current!
+ ; immediate
+ ** )
+ 
+ 
  : } 
  	voc.pop drop
***************
*** 38,47 ****
  ; immediate
  
- : namespace 
- 	32 word
- 	"{" cat ncreate last last >data ! immediate
- 	does> @ dup voc.push current! 
- ;
- 
  : maze
  	[ 80 50 * ] literal
--- 67,70 ----
***************
*** 52,53 ****
--- 75,77 ----
  	then next cr 
  ;
+ 

Index: fsystem.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** fsystem.c	17 Nov 2003 06:18:00 -0000	1.7
--- fsystem.c	23 Jul 2004 06:11:08 -0000	1.8
***************
*** 2,8 ****
  	TODO:@
  
  	- Seperate primitives from C interface
  		- Create FS_TRY/CATCH macros to allow use of primitives outside system
! 	- Some form of range-covering DO/LOOP
  	- Better depth checking in system so user doesn't have to do it everywhere
  	- macros for float/double interchange
--- 2,17 ----
  	TODO:@
  
+ 	- FVALUE interfaces, like in the Parrot VM's Parrot Magic Cookie (PMC)
+ 		- Can be used to handle user types, as well as complex built in 
+ 		types such as stack, wordref. Can be used to unify these types
+ 		- (was) USER type hooks for copying and deleting... register_user_type()
+ 			- Other hooks?
+ 			- USER pointer in word definitions
+ 	- Input stack for scripts/text being evaluated
+ 
  	- Seperate primitives from C interface
  		- Create FS_TRY/CATCH macros to allow use of primitives outside system
! 	- Some form of range-covering DO/LOOP?
! 	- Interpret compile to temporary buffer, then execute?
  	- Better depth checking in system so user doesn't have to do it everywhere
  	- macros for float/double interchange
***************
*** 15,19 ****
  		- Allow compilation with only previously defined words
  		- Only successful compilation will replace old word
! 	- Tail-call recursion
  	- API review and overhaul
  		- WORDREF-based lookups for most things
--- 24,28 ----
  		- Allow compilation with only previously defined words
  		- Only successful compilation will replace old word
! 	- Tail calls and tail recursion
  	- API review and overhaul
  		- WORDREF-based lookups for most things
***************
*** 22,28 ****
  	re-parsing tokens and such... look at SOURCE also
  	- EVALUATE a string
- 	- USER type hooks for copying and deleting... register_user_type()
- 		- Other hooks?
- 		- USER pointer in word definitions
  	- Decompile, return/data stack dump, etc. (for debug)
  		- Also for return stack, random access decompile (decompile current)
--- 31,34 ----
***************
*** 31,35 ****
  	- Auto-remove data stack on abort?
  	- Debug mode to save all stacks for analysis
! 	- Debug hooks for user intervention during execution of words in inner loop
  	- Line/word/column counter to aid in debugging and error reporting
  	- Move fs_push_* and fs_get_* back to fstack.c? This way multiple stacks
--- 37,42 ----
  	- Auto-remove data stack on abort?
  	- Debug mode to save all stacks for analysis
! 	- DEBUG hooks for user intervention during execution of words in inner loop
! 		- Check FICL and Lua for similarities
  	- Line/word/column counter to aid in debugging and error reporting
  	- Move fs_push_* and fs_get_* back to fstack.c? This way multiple stacks
***************
*** 666,675 ****
  
  // TODO: Change to use source and dest-ref offset
! void fs_store(FSYSTEM *sys, int ref_offset/*, int src_offset*/)
  {
  	FVALUE *dest, *src;
  
  	dest=stack_get_value(sys, sys->stack, ref_offset);
! 	src=stack_get_value(sys, sys->stack, -1);
  	value_store(sys, dest, src);
  }
--- 673,682 ----
  
  // TODO: Change to use source and dest-ref offset
! void fs_store(FSYSTEM *sys, int ref_offset, int src_offset)
  {
  	FVALUE *dest, *src;
  
  	dest=stack_get_value(sys, sys->stack, ref_offset);
! 	src=stack_get_value(sys, sys->stack, src_offset);
  	value_store(sys, dest, src);
  }
***************
*** 818,821 ****
--- 825,839 ----
  
  
+ int fs_is_dict_empty(FSYSTEM *sys)
+ {
+ 	if((dict_get_first(sys->table)))
+ 	{
+ 		return FALSE;
+ 	}
+ 
+ 	return TRUE;
+ }
+ 
+ 
  int fs_get_shared_count(FSYSTEM *sys)
  {

[Forthy-cvs] forthy fcode.c,1.5,1.6 fcode.h,1.4,1.5 fcompile.c,1.5,1.6 fstack.c,1.4,1.5 test.txt,1.1,1.2

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

Update of /cvsroot/forthy/forthy
In directory sc8-pr-cvs1:/tmp/cvs-serv8784

Modified Files:
	fcode.c fcode.h fcompile.c fstack.c test.txt 
Log Message:
- tweaks

Index: fcode.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fcode.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** fcode.c	17 Nov 2003 06:18:00 -0000	1.5
--- fcode.c	18 Nov 2003 13:49:41 -0000	1.6
***************
*** 43,47 ****
  
  void code_branch(FSYSTEM *sys);
! void code_branch_z(FSYSTEM *sys);
  
  void code_for(FSYSTEM *sys);
--- 43,47 ----
  
  void code_branch(FSYSTEM *sys);
! void code_branch_ne(FSYSTEM *sys);
  
  void code_for(FSYSTEM *sys);
***************
*** 72,76 ****
  	{code_lit_wordref, "LIT_WORD"},
  	{code_branch, "BRANCH"},
! 	{code_branch_z, "BRANCH_Z"},
  	{code_for, "FOR"},
  	{code_next, "NEXT"},
--- 72,76 ----
  	{code_lit_wordref, "LIT_WORD"},
  	{code_branch, "BRANCH"},
! 	{code_branch_ne, "BRANCH_NE"},
  	{code_for, "FOR"},
  	{code_next, "NEXT"},
***************
*** 237,241 ****
  
  
! void code_branch_z(FSYSTEM *sys)
  {
  //	if(!stack_depth(sys->stack))
--- 237,241 ----
  
  
! void code_branch_ne(FSYSTEM *sys)
  {
  //	if(!stack_depth(sys->stack))

Index: fcode.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fcode.h,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** fcode.h	17 Nov 2003 06:18:00 -0000	1.4
--- fcode.h	18 Nov 2003 13:49:41 -0000	1.5
***************
*** 8,12 ****
  #define OPFUNC(code)	(code_table[(code)].exec)
  
! enum{OP_EXIT_INNER, OP_DOCON, OP_DOVAR, OP_ENTER, OP_EXIT, OP_EXIT_ALL, 
  	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,
--- 8,12 ----
  #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,

Index: fcompile.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fcompile.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** fcompile.c	16 Nov 2003 16:45:06 -0000	1.5
--- fcompile.c	18 Nov 2003 13:49:41 -0000	1.6
***************
*** 598,602 ****
  
  	// Compile the EXIT opcode, close the word
! 	sys->code[sys->code_off]=OPCODE(OP_EXIT);
  
  	// Relocate the code block to the current dict entry
--- 598,602 ----
  
  	// Compile the EXIT opcode, close the word
! 	sys->code[sys->code_off]=OPCODE(OP_EXIT_FAST);
  
  	// Relocate the code block to the current dict entry
***************
*** 885,889 ****
  	NEED_COMPILE(sys);
  	
! 	sys->code[sys->code_off]=OPCODE(OP_EXIT_ALL);
  
  	CELL_INC(sys);
--- 885,889 ----
  	NEED_COMPILE(sys);
  	
! 	sys->code[sys->code_off]=OPCODE(OP_EXIT);
  
  	CELL_INC(sys);

Index: fstack.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fstack.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** fstack.c	17 Nov 2003 06:18:00 -0000	1.4
--- fstack.c	18 Nov 2003 13:49:41 -0000	1.5
***************
*** 326,338 ****
  	int sp=stack->sp;
  
! 	// Stack is already empty
! 	if(sp>=stack->stack_size)
! 	{
! 		VOID_THROW(sys, FS_UNDERFLOW);
! 	}
  
  	value_clean(&(stack->mem[sp]), TRUE);
  
- 	stack_sp_dec(sys, stack);
  }
  
--- 326,333 ----
  	int sp=stack->sp;
  
! 	stack_sp_dec(sys, stack);
  
  	value_clean(&(stack->mem[sp]), TRUE);
  
  }
  
***************
*** 349,353 ****
  
  // Pop a value from one stack and push it onto another
! // TODO: THROW
  void stack_pop_to(FSYSTEM *sys, FSTACK *dest, FSTACK *src)
  {
--- 344,348 ----
  
  // Pop a value from one stack and push it onto another
! // TODO: OPTIMIZE
  void stack_pop_to(FSYSTEM *sys, FSTACK *dest, FSTACK *src)
  {

Index: test.txt
===================================================================
RCS file: /cvsroot/forthy/forthy/test.txt,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** test.txt	17 Nov 2003 06:18:00 -0000	1.1
--- test.txt	18 Nov 2003 13:49:41 -0000	1.2
***************
*** 30,48 ****
  ;
  
! : } voc.pop drop
! voc.depth if
! voc.pop dup current! voc.push
! else current.clear
! then ; immediate
  
! : namespace 32 word
! "{" cat ncreate last last >data ! immediate
! does> @ dup voc.push current! ;
  
  : maze
! [ 80 50 * ] literal
! for rand 2 % if
! [ char \ ] literal emit
! else
! [ char / ] literal emit
! then next cr ;
--- 30,53 ----
  ;
  
! : } 
! 	voc.pop drop
! 	voc.depth if
! 	voc.pop dup current! voc.push
! 	else current.clear
! 	then 
! ; immediate
  
! : namespace 
! 	32 word
! 	"{" cat ncreate last last >data ! immediate
! 	does> @ dup voc.push current! 
! ;
  
  : maze
! 	[ 80 50 * ] literal
! 	for rand 2 % if
! 	[ char \ ] literal emit
! 	else
! 	[ char / ] literal emit
! 	then next cr 
! ;

[Forthy-cvs] forthy test.txt,NONE,1.1 fcode.c,1.4,1.5 fcode.h,1.3,1.4 fstack.c,1.3,1.4 fsystem.c,1.6,1.7 fsystem.h,1.5,1.6 ftype.h,1.2,1.3 fvalue.c,1.4,1.5 main.c,1.10,1.11

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

Update of /cvsroot/forthy/forthy
In directory sc8-pr-cvs1:/tmp/cvs-serv26139

Modified Files:
	fcode.c fcode.h fstack.c fsystem.c fsystem.h ftype.h fvalue.c 
	main.c 
Added Files:
	test.txt 
Log Message:
- null value deref bux fix
- script loading function added to main
- external test script
- changed code table layout in preperation for decompile


--- NEW FILE: test.txt ---
8 voc.new

: also
	0 voc.pick voc.push 
;

: definitions
	voc.depth if 0 voc.pick current! else current.clear then 
;

: vocabulary
	variable last last >data ! does> voc.depth if voc.pop drop then
	@ voc.push 
;

: order
	"CONTEXT: " . voc.depth dup for dup i - voc.pick name . next cr
	"CURRENT: " . current@ dup datatype if name . else drop then cr drop 
;

: voc.path ( word -- )
	"/" begin over >voc datatype while ( word str )
	over >voc name swap cat ( word str )
	swap >voc swap "/" swap cat ( word str )
	repeat swap drop
;

: which 
	' dup voc.path swap name cat .
;

: } voc.pop drop
voc.depth if
voc.pop dup current! voc.push
else current.clear
then ; immediate

: namespace 32 word
"{" cat ncreate last last >data ! immediate
does> @ dup voc.push current! ;

: maze
[ 80 50 * ] literal
for rand 2 % if
[ char \ ] literal emit
else
[ char / ] literal emit
then next cr ;

Index: fcode.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fcode.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** fcode.c	16 Nov 2003 16:45:06 -0000	1.4
--- fcode.c	17 Nov 2003 06:18:00 -0000	1.5
***************
*** 33,38 ****
  
  void code_enter(FSYSTEM *sys);
  void code_exit(FSYSTEM *sys);
- void code_exit_all(FSYSTEM *sys);
  void code_exit_inner(FSYSTEM *sys);
  
--- 33,38 ----
  
  void code_enter(FSYSTEM *sys);
+ void code_exit_fast(FSYSTEM *sys);
  void code_exit(FSYSTEM *sys);
  void code_exit_inner(FSYSTEM *sys);
  
***************
*** 43,47 ****
  
  void code_branch(FSYSTEM *sys);
! void code_branch_ne(FSYSTEM *sys);
  
  void code_for(FSYSTEM *sys);
--- 43,47 ----
  
  void code_branch(FSYSTEM *sys);
! void code_branch_z(FSYSTEM *sys);
  
  void code_for(FSYSTEM *sys);
***************
*** 59,62 ****
--- 59,86 ----
  //void code_compile(FSYSTEM *sys);
  
+ FOPCODE code_table[]=
+ {
+ 	{code_exit_inner, "EXIT_INNER"},
+ 	{code_docon, "DO_CON"},
+ 	{code_dovar, "DO_VAR"},
+ 	{code_enter, "ENTER"},
+ 	{code_exit_fast, "EXIT_FAST"},
+ 	{code_exit, "EXIT"},
+ 	{code_lit_int, "LIT_INT"},
+ 	{code_lit_float, "LIT_FLOAT"},
+ 	{code_lit_string, "LIT_STRING"},
+ 	{code_lit_wordref, "LIT_WORD"},
+ 	{code_branch, "BRANCH"},
+ 	{code_branch_z, "BRANCH_Z"},
+ 	{code_for, "FOR"},
+ 	{code_next, "NEXT"},
+ 	{code_break, "BREAK"},
+ 	{code_compile, "COMPILE"},
+ 	{code_does, "DOES"},
+ 	{code_dodoes, "DO_DOES"},
+ 	{code_dodefer, "DO_DEFER"},
+ };
+ 
+ /*
  FCFUNC code_table[]=
  {
***************
*** 81,85 ****
  	code_dodefer,
  };
! 
  
  void code_lit_int(FSYSTEM *sys)
--- 105,109 ----
  	code_dodefer,
  };
! */
  
  void code_lit_int(FSYSTEM *sys)
***************
*** 193,197 ****
  
  
! void code_exit(FSYSTEM *sys)
  {
  	FVALUE *value;
--- 217,221 ----
  
  
! void code_exit_fast(FSYSTEM *sys)
  {
  	FVALUE *value;
***************
*** 213,220 ****
  
  
! void code_branch_ne(FSYSTEM *sys)
  {
! 	if(!stack_depth(sys->stack))
! 		VOID_THROW(sys, FS_UNDERFLOW);
  
  	// FALSE, so branch
--- 237,244 ----
  
  
! void code_branch_z(FSYSTEM *sys)
  {
! //	if(!stack_depth(sys->stack))
! //		VOID_THROW(sys, FS_UNDERFLOW);
  
  	// FALSE, so branch
***************
*** 238,243 ****
  
  	// OPTIMIZE:
! 	if(!fs_depth(sys))
! 		VOID_THROW(sys, FS_UNDERFLOW);
  
  	count=fs_get_int(sys, -1);
--- 262,267 ----
  
  	// OPTIMIZE:
! //	if(!fs_depth(sys))
! //		VOID_THROW(sys, FS_UNDERFLOW);
  
  	count=fs_get_int(sys, -1);
***************
*** 331,335 ****
  
  	// Exit the current word
! 	code_exit(sys);
  }
  
--- 355,359 ----
  
  	// Exit the current word
! 	code_exit_fast(sys);
  }
  
***************
*** 361,365 ****
  
  // Special exit that drops control-flow data and returns immediately
! void code_exit_all(FSYSTEM *sys)
  {
  	// While there are non-FXTOKENs (control-flow) on the stack 
--- 385,389 ----
  
  // Special exit that drops control-flow data and returns immediately
! void code_exit(FSYSTEM *sys)
  {
  	// While there are non-FXTOKENs (control-flow) on the stack 
***************
*** 375,379 ****
  	}
  
! 	code_exit(sys);
  }
  
--- 399,403 ----
  	}
  
! 	code_exit_fast(sys);
  }
  

Index: fcode.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fcode.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** fcode.h	16 Nov 2003 16:54:54 -0000	1.3
--- fcode.h	17 Nov 2003 06:18:00 -0000	1.4
***************
*** 5,10 ****
  
  
! #define OPCODE(code)	(&code_table[(code)])
! #define OPFUNC(code)	(code_table[(code)])
  
  enum{OP_EXIT_INNER, OP_DOCON, OP_DOVAR, OP_ENTER, OP_EXIT, OP_EXIT_ALL, 
--- 5,10 ----
  
  
! #define OPCODE(code)	(&code_table[(code)].exec)
! #define OPFUNC(code)	(code_table[(code)].exec)
  
  enum{OP_EXIT_INNER, OP_DOCON, OP_DOVAR, OP_ENTER, OP_EXIT, OP_EXIT_ALL, 
***************
*** 17,21 ****
  // - (DO) (?DO) (+LOOP) (LOOP) (LEAVE)
  
! extern FCFUNC code_table[];
  
  #endif
--- 17,22 ----
  // - (DO) (?DO) (+LOOP) (LOOP) (LEAVE)
  
! //extern FCFUNC code_table[];
! extern FOPCODE code_table[];
  
  #endif

Index: fstack.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fstack.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** fstack.c	16 Nov 2003 16:24:58 -0000	1.3
--- fstack.c	17 Nov 2003 06:18:00 -0000	1.4
***************
*** 285,288 ****
--- 285,291 ----
  	value=stack_get_deref(sys, stack, offset);
  
+ 	if(!value)
+ 		VOID_THROW(sys, FS_BAD_REF);
+ 
  	stack_push_value(sys, stack, value);
  }

Index: fsystem.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.c,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** fsystem.c	16 Nov 2003 16:45:06 -0000	1.6
--- fsystem.c	17 Nov 2003 06:18:00 -0000	1.7
***************
*** 180,183 ****
--- 180,184 ----
  	sys->temp_str=NULL;
  	sys->result_str=NULL;
+ 	sys->result=FS_OK;
  
  	sys->in_source=NULL;
***************
*** 1497,1501 ****
  {
  	if(!handle)
! 		return FS_NULL;
  
  	// Dump return stack
--- 1498,1502 ----
  {
  	if(!handle)
! 		INT_THROW(sys, FS_NULL);
  
  	// Dump return stack
***************
*** 1677,1680 ****
--- 1678,1683 ----
  int fs_throw_it(FSYSTEM *sys, int value)
  {
+ 	sys->result=value;
+ 
  	if(!value)
  		return FS_OK;

Index: fsystem.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fsystem.h,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** fsystem.h	16 Nov 2003 16:24:58 -0000	1.5
--- fsystem.h	17 Nov 2003 06:18:00 -0000	1.6
***************
*** 40,43 ****
--- 40,44 ----
  	char *temp_str;			// last read string value
  	char *result_str;		// last requested error string value
+ 	int result;				// last thrown result
  
  	FCFUNC vm_inner;		// Which inner loop we're using

Index: ftype.h
===================================================================
RCS file: /cvsroot/forthy/forthy/ftype.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** ftype.h	20 Oct 2003 00:26:41 -0000	1.2
--- ftype.h	17 Nov 2003 06:18:00 -0000	1.3
***************
*** 50,53 ****
--- 50,54 ----
  typedef struct FVALUE FVALUE;
  typedef struct FSYMREC FSYMREC;
+ typedef struct FOPCODE FOPCODE;
  typedef struct FSTACK FSTACK;
  typedef struct FREFCOUNT FREFCOUNT;
***************
*** 143,150 ****
--- 144,158 ----
  };
  
+ struct FOPCODE
+ {
+ 	FCFUNC exec;	// Code Field
+ 	char *name;		// Name Field
+ };
+ 
  // Execution token union
  union FTOKEN
  {
  	FCFUNC func;
+ 	FOPCODE code;
  	FSYMREC rec; 
  };

Index: fvalue.c
===================================================================
RCS file: /cvsroot/forthy/forthy/fvalue.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** fvalue.c	16 Nov 2003 16:45:06 -0000	1.4
--- fvalue.c	17 Nov 2003 06:18:00 -0000	1.5
***************
*** 482,485 ****
--- 482,488 ----
  			return atoi(value->value.str);
  			break;
+ 
+ 		default:
+ 			break;
  	}
  
***************
*** 503,506 ****
--- 506,512 ----
  			return (double)atof(value->value.str);
  			break;
+ 
+ 		default:
+ 			break;
  	}
  
***************
*** 536,539 ****
--- 542,548 ----
  			break;
  		}
+ 	
+ 		default:
+ 			break;
  	}
  

Index: main.c
===================================================================
RCS file: /cvsroot/forthy/forthy/main.c,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** main.c	16 Nov 2003 16:45:06 -0000	1.10
--- main.c	17 Nov 2003 06:18:00 -0000	1.11
***************
*** 18,21 ****
--- 18,22 ----
  }
  
+ 
  void fortify_output(const char *text)
  {
***************
*** 29,32 ****
--- 30,59 ----
  
  
+ char *load_text(char *filename)
+ {
+ 	FILE *fp;
+ 	char *text;
+ 	int size;
+ 
+ 	fp=fopen(filename, "rb");
+ 
+ 	if(!fp)
+ 		return NULL;
+ 
+ 	fseek(fp, 0, SEEK_END);
+ 	size=ftell(fp);
+ 	fseek(fp, 0, SEEK_SET);
+ 
+ 	text=malloc(size+1);
+ 
+ 	fread(text, size, 1, fp);
+ 	fclose(fp);
+ 
+ 	text[size]=0;
+ 
+ 	return text;
+ }
+ 
+ 
  void show_stack(FSYSTEM *sys)
  {
***************
*** 1455,1460 ****
  int load(FSYSTEM *sys)
  {
- 	int i=0;
- 
  	fs_register_func(sys, "*", word_mul, FS_DEFAULT);
  	fs_register_func(sys, "+", word_add, FS_DEFAULT);
--- 1482,1485 ----
***************
*** 1604,1607 ****
--- 1629,1633 ----
  
  
+ /*
  char *script=
  {
***************
*** 1630,1634 ****
  	": which ' dup voc.path swap name cat . ; "
  };
! 
  
  void word_root_1(FSYSTEM *sys)
--- 1656,1660 ----
  	": which ' dup voc.path swap name cat . ; "
  };
! */
  
  void word_root_1(FSYSTEM *sys)
***************
*** 1690,1696 ****
  	int i;
  
- 	fs_load_string(sys, script);
- 	fs_run(sys);
- 
  	fs_load_string(sys, ": test 1 2 3 ; : test2 test swap drop dup + - . ; ");
  	fs_run(sys);
--- 1716,1719 ----
***************
*** 1783,1786 ****
--- 1806,1824 ----
  
  
+ void load_script(FSYSTEM *sys, char *filename)
+ {
+ 	char *script;
+ 
+ 	script=load_text(filename);
+ 
+ 	if(!script)
+ 		return;
+ 
+ 	fs_load_string(sys, script);
+ 	fs_run(sys);
+ 	free(script);
+ }
+ 
+ 
  int main()
  {
***************
*** 1818,1821 ****
--- 1856,1862 ----
  
  	load(&sys);
+ 
+ 	load_script(&sys, "test.txt");
+ 
  	#ifdef _DEBUG
  	test(&sys);
***************
*** 1846,1852 ****
  			printf("@ ");
  
! 		while(1)
  		{
! 			ch=getchar();
  			if(ch==EOF)
  			{
--- 1887,1893 ----
  			printf("@ ");
  
! 		for(;;)
  		{
! 			ch=(char)getchar();
  			if(ch==EOF)
  			{

[Forthy-cvs] forthy fcode.h,1.2,1.3

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

Update of /cvsroot/forthy/forthy
In directory sc8-pr-cvs1:/tmp/cvs-serv21390

Modified Files:
	fcode.h 
Log Message:
- missing extern for code table declaration

Index: fcode.h
===================================================================
RCS file: /cvsroot/forthy/forthy/fcode.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** fcode.h	20 Oct 2003 00:26:41 -0000	1.2
--- fcode.h	16 Nov 2003 16:54:54 -0000	1.3
***************
*** 17,21 ****
  // - (DO) (?DO) (+LOOP) (LOOP) (LEAVE)
  
! FCFUNC code_table[];
  
  #endif
--- 17,21 ----
  // - (DO) (?DO) (+LOOP) (LOOP) (LEAVE)
  
! extern FCFUNC code_table[];
  
  #endif