forth.cpp

这个是关于G.726算法的源程序

		LIT(XT_PAREN_QUESTION_DO),							//   ['] (?do)
		(CELL)XT_FORWARD_BRANCH_COMMA, (CELL)XT_BEGIN,		//   >BRANCH, POSTPONE BEGIN
		XT_EXIT,											// ; IMMEDIATE
	H5('A','G','A','I','N',IMMEDIATE|TOKEN), (CELL)XT_AGAIN,
	H8('C','O','M','P','I','L','E',',',TOKEN), XT_COMMA,
	H5('E','R','A','S','E',TOKEN), XT_ERASE,
	H5('F','A','L','S','E',TOKEN), XT_FALSE,
	H3('H','E','X',5),										// : HEX   ( -- )
		LIT(16), XT_BASE, XT_STORE, XT_EXIT,				//   16 BASE ! ;
	H3('N','I','P',TOKEN), XT_NIP,
	H3('P','A','D',TOKEN), XT_PAD,
	H5('P','A','R','S','E',TOKEN), XT_PARSE,
	H4('P','I','C','K',TOKEN), XT_PICK,
	H4('R','O','L','L',TOKEN), XT_ROLL,
	H4('T','R','U','E',TOKEN), XT_TRUE,
	H4('T','U','C','K',TOKEN), XT_TUCK,
	H2('U','>',TOKEN), XT_U_GREATER_THAN,
	H6('U','N','U','S','E','D',TOKEN), XT_UNUSED,
	H1('\\',IMMEDIATE|8),									// : \   ( "ccc<eol>"-- )
		XT_PAREN_CR, XT_1_MINUS, XT_CHARS, XT_PLUS,			//   (cr) 1- CHARS +
		XT_C_FETCH, XT_PARSE, XT_2DROP, XT_EXIT,			//   C@ PARSE 2DROP ; IMMEDIATE

	//
	// DOUBLE
	//

	H2('D','+',TOKEN), XT_D_PLUS,
	H2('D','.',TOKEN), (CELL)XT_D_DOT,
	H4('D','A','B','S',TOKEN), XT_DABS,
	H7('D','N','E','G','A','T','E',TOKEN), XT_DNEGATE,
	H2('M','+',TOKEN), XT_M_PLUS,

	//
	// EXCEPTION
	//

	H5('C','A','T','C','H',TOKEN), XT_CATCH,
	H5('T','H','R','O','W',TOKEN), XT_THROW,

	//
	// SEARCH
	//

	H14('F','O','R','T','H','-','W','O','R','D','L','I','S','T',TOKEN), XT_FORTH_WORDLIST, // : FORTH-WORDLIST   ( -- wid )
	H15('S','E','A','R','C','H','-','W','O','R','D','L','I','S','T',13), // : SEARCH-WORDLIST   ( c-addr u wid -- 0 | xt 1 | xt -1 )
		XT_PAREN_SEARCH_WORDLIST, XT_0BRANCH(8),			//   (SEARCH-WORDLIST) IF
		XT_0BRANCH(4), LIT(1), XT_EXIT, XT_TRUE, XT_EXIT,	//   IF 1 EXIT THEN -1 EXIT
		XT_2DROP, XT_FALSE, XT_EXIT,						//   2DROP FALSE ;

	//
	// STRING
	//

	H5('C','M','O','V','E',TOKEN), XT_CMOVE,
	H6('C','M','O','V','E','>',TOKEN), XT_CMOVE_UP,

	//
	// TOOLS
	//

	H2('.','S',18),											// : .S   ( -- )
		(CELL)XT_CR, XT_DEPTH, LIT(StackCells), XT_MIN,		//   CR DEPTH STACK-CELLS MIN
		XT_FALSE, XT_MAX, XT_DUP, XT_0BRANCH(7),			//   0 MAX BEGIN DUP WHILE
		XT_DUP, XT_PICK, (CELL)XT_DOT, XT_1_MINUS,			//   DUP PICK . 1-
		XT_BRANCH(-8), XT_DROP, XT_EXIT,					//   REPEAT DROP ;
	H5('A','H','E','A','D',TOKEN), (CELL)XT_AHEAD,
	H3('B','Y','E',TOKEN), XT_END,							// : BYE   ( -- )   END ;

	//
	// NOT ANS
	//

	H7('C','O','N','T','E','X','T',TOKEN), XT_CONTEXT,		// : CONTEXT   ( -- a-addr )
	H7('C','U','R','R','E','N','T',TOKEN), XT_CURRENT,		// : CURRENT   ( -- a-addr )
	H6('L','A','T','E','S','T',TOKEN), XT_LATEST,			// : LATEST   ( -- a-addr )
	H8('(','s','o','u','r','c','e',')',TOKEN), XT_PAREN_SOURCE, // : (source)   ( -- a-addr )
	H9('I','N','T','E','R','P','R','E','T',TOKEN), (CELL)XT_INTERPRET, // : INTERPRET   ( i*x -- j*x )
	H10('B','R','E','A','K','P','O','I','N','T',TOKEN), XT_BREAKPOINT, // : BREAKPOINT   ( -- )

	0
	};


/**
Initial contents for ENVIRONMENT dictionary
*/
static const CELL EnvironmentDictionary[] = 
	{
	H15('/','C','O','U','N','T','E','D','-','S','T','R','I','N','G',2), XT_PAREN_CONSTANT, SlashCountedString,
	H5('/','H','O','L','D',2), XT_PAREN_CONSTANT, SlashCountedString,
	H4('/','P','A','D',2), XT_PAREN_CONSTANT, SlashPad,
	H17('A','D','D','R','E','S','S','-','U','N','I','T','-','B','I','T','S',2), XT_PAREN_CONSTANT, BITS_PER_CHAR/CHARS(1),
	H4('C','O','R','E',TOKEN), XT_TRUE,
	H7('F','L','O','O','R','E','D',2), XT_PAREN_CONSTANT, ((-1)/2),
	H8('M','A','X','-','C','H','A','R',2), XT_PAREN_CONSTANT, (1<<BITS_PER_CHAR)-1,
	H5('M','A','X','-','U',TOKEN), XT_TRUE,
	H5('M','A','X','-','D',4), XT_TRUE, LIT((CELL)(((UCELL)(~0))>>1)), XT_EXIT,
	H5('M','A','X','-','N',2), XT_PAREN_CONSTANT, (CELL)(((UCELL)(~0))>>1),
	H6('M','A','X','-','U','D',3), XT_TRUE, XT_TRUE, XT_EXIT,
	H18('R','E','T','U','R','N','-','S','T','A','C','K','-','C','E','L','L','S',2), XT_PAREN_CONSTANT, ReturnStackCells,
	H11('S','T','A','C','K','-','C','E','L','L','S',2), XT_PAREN_CONSTANT, StackCells,
	0
	};


/**
@brief Implementation of the forth virtual machine.
*/
class ForthVM : public Forth
	{
private:
	/** Implementation of Forth::Reset */
	bool DoReset();

	/** Implementation of Forth::Quit */
	CELL DoQuit();

	/** Implementation of Forth::Execute */
	CELL DoExecute(CELL xt);

	/** Implementation of Forth::Evaluate */
	CELL DoEvaluate(const CHAR* text,uint textLength);

	/** Implementation of Forth::Push */
	void DoPush(const CELL* cells, uint numCells);

	/** Implementation of Forth::Pop */
	const CELL* DoPop(uint numCells);
private:
	/**
	Execute forth code.
	@param ip Pointer to the forth execution tokens to execute.
	*/
	CELL Run(const CELL* ip);
private:
	/**
	Object used to perform console i/o.
	*/
	ForthIo*	Io;

	/**
	Initial value for the parameter stack.
	*/
	CELL*		Sp0;

	/**
	Initial value for the return stack.
	*/
	CELL*		Rp0;

	/**
	The address immediately after the memory used by the virtual machine.
	Note, member data after this member is zeroed on reboot of forth VM
	*/
	CELL*		MemoryEnd;

	/**
	Saved value for the parameter stack.
	Only valid when VM code is not executing.
	*/
	CELL*		Sp;

	/**
	Saved value for the restore stack.
	Only valid when VM code is not executing.
	*/
	CELL*		Rp;

	/**
	The Dictionary Pointer. (The value returned by \c HERE.)
	*/
	CHAR*		Dp;

	/**
	The maximum valid value for #Dp
	*/
	UCELL		DpLimit;

	/**
	Length of the current input buffer.
	*/
	UCELL		SourceSize;

	/**
	Start address of the current input buffer.
	Note, this member must immediately follow #SourceSize.
	*/
	CELL		SourceBase;

	/**
	The address of this member is returned by \c >IN.
	*/
	UCELL		SourceOffset;

	/**
	Stores the value returned by \c SOURCE-ID
	Note, this member must immediately follow #SourceOffset.
	*/
	CELL		SourceId;

	/**
	List of wordlists in the dictionary search order. The first cell contains
	a count of the number of wordlists, following cells contain pointers to
	wordlists in the order they will be searched.
	*/
	CELL		Context[MaxWordlists+1];

	/**
	Pointer to the wordlist to which new definitions will be added.
	I.e. contains the value returned by \c GET-CURRENT.
	*/
	CELL		Current;

	/**
	Pointer to the Link Field Address of the last word to be defined.
	(Or the current word being defined.)
	*/
	CELL		Latest;	
									
	/**
	The address of this member is returned by \c STATE.
	*/
	CELL		State;

	/**
	The address of this member is returned by \c BASE.
	*/
	CELL		Base;

	/**
	Pointer to the latest exception frame used by \c CATCH and \c THROW.
	*/
	CELL*		ExceptionFrame;

	/**
	\c c-addr and \c u which indicate the string
	associated with the last \c ABORT" performed.
	Also used to store the name of a word when it
	wasn't found in the dictionary.
	This member is used in the implementation of
	\c QUIT to display a message when an uncaught
	\c THROW is executed.
	*/
	CELL		ExceptionMessage[2];

	/**
	The main forth wordlist.
	*/
	Wordlist	ForthWordlist;

	/**
	Wordlist used to store words for environment queries.
	*/
	Wordlist	EnvironmentWordlist;

	static void MultiplyPrimitive(CELL* sp);
	static void DividePrimitive(CELL* sp);
	static void ToNumber(CELL* sp,UCELL base);
	void ParsePrimitive(CELL* sp,CELL delimiter);
	CELL FindPrimitive(CELL* sp,CELL wordlist);
	CELL Accept(CHAR* buffer, CELL maxLen);

	friend class Forth;
	};


bool ForthVM::DoReset()
	{
	// clear all memory
	CELL* end = MemoryEnd;
	CELL* ptr = (CELL*)(&this->MemoryEnd+1);
	while(ptr<end) *((uint*&)ptr)++=0;

	// make space for TIB at end of memory
	end -= (NumberTIB*sizeof(CHAR)+(sizeof(CELL)-1))/sizeof(CELL);

	// initialise stacks
	Rp0 = end;
	Rp = end;
	end -= ReturnStackCells;

	Sp0 = end;
	Sp = end;
	end -= StackCells;

	// initialse user variables
	DpLimit = (UCELL)end-DictionaryOverhead;
	Dp = (CHAR*)(this+1);
	if((UCELL)Dp>=DpLimit)
		return false;
	Base = 10;

	// initialise dictionary
	ForthWordlist.LastWord = (CELL)ForthDictionary;
	ForthWordlist.Previous = (CELL)&EnvironmentWordlist;
	EnvironmentWordlist.LastWord = (CELL)EnvironmentDictionary;

	Context[0] = 2;
	Context[1] = (CELL)&ForthWordlist;
	Context[2] = (CELL)&EnvironmentWordlist;
	Current = (CELL)&ForthWordlist;

	return true;
	}


inline CELL ForthVM::DoQuit()
	{
	return DoExecute((CELL)XT_QUIT);
	}


inline CELL ForthVM::DoExecute(CELL xt)
	{
	CELL execute[2];
	execute[0] = xt;
	execute[1] = XT_END;
	return ((ForthVM*)this)->Run(execute);
	}


inline CELL ForthVM::DoEvaluate(const CHAR* text,uint textLength)
	{
	SourceBase = (CELL)text;
	SourceSize = textLength;
	SourceOffset = 0;
	SourceId = -2;
	return Execute((CELL)XT_INTERPRET);
	}


inline const CELL* ForthVM::DoPop(uint numCells)
	{
	CELL* cells = Sp;
	Sp+=numCells;
	return cells;
	}


inline void ForthVM::DoPush(const CELL* cells, uint numCells)
	{
	CELL* sp = Sp-numCells;
	Sp = sp;
	while(numCells--)
		*sp++ = *cells++;
	}


#define NEXT			goto next
#define BRANCH			ip = (CELL*)((CELL)ip+(CELL)ip[0]); NEXT
#define THROW(a)		{ t=a; goto exception; }
#define CALL(a)			{ xt=(CELL)(a); goto call; }

#if 1
#define PUSH(a)			{ *--sp=(CELL)(a); }
#define POP(a)			{ (CELL&)(a)=*sp++; }
#define RPUSH(a)		{ *--rp=(CELL)(a); }
#define RPOP(a)			{ (CELL&)(a)=*rp++; }
#else
#define PUSH(a)			asm("str %2,[%0,#-4]!" : "=r"(sp) : "0"(sp), "r" (a): );
#define POP(a)			asm("ldr %2,[%0],#4" : "=r"(sp) : "0"(sp), "r" (a): );
#define RPUSH(a)		asm("str