Internal - Internal implementation of the forth virtual machine
[Forth - Forth virtual machine]
Collaboration diagram for Internal - Internal implementation of the forth virtual machine:
|
Detailed Description
- Version:
- 2005-12-27
- Fixed various bugs in Forth virtual machine which manifested when
sizeof(CELL)was greater thansizeof(CELL*).
- Fixed various bugs in Forth virtual machine which manifested when
-
2007-01-13
- Fixed GCC compilation warnings.
-
2007-05-28
- Moved uncaught
THROWhandling into new member function ForthVM::UncaughtException. This improves the code generated by GCC.
- Moved uncaught
-
2009-10-02
- Fixed bug in the implemntation
QUIT. TheWHILEbranch in XT_DO_QUIT was jumping one token to far, which would produce unpredicable results ifREFILLreturned false. - Updated the example class StdForthIo (mentioned in ForthIo), to use standard posix functions rather than Microsoft's
conio.h. - Updated ForthVM::Accept to accept alternative keys for backspace (0x08 and 0x7F) and input end (0x0a and 0x0d).
- Fixed bug in the implemntation
Define Documentation
| #define LITTLE_ENDIAN |
| #define ALIGNED | ( | x | ) | (((x)+CELLS(1)-1)&~(CELLS(1)-1)) |
| #define XT_BRANCH | ( | offset | ) | XT_PAREN_BRANCH,CELLS(offset) |
| #define XT_0BRANCH | ( | offset | ) | XT_PAREN_0BRANCH,CELLS(offset) |
| #define LIT | ( | x | ) | XT_PAREN_LITERAL,(CELL)x |
| #define XT_M_SLASH_MOD (((-1)/2) ? (CELL)XT_FM_SLASH_MOD : (CELL)XT_SM_SLASH_REM) |
Enumeration Type Documentation
| enum Exception |
| enum ControlStackMarkers |
| enum ForthXT |
Enumeration of forth execution tokens.
- Enumerator:
Function Documentation
| bool ForthVM::DoReset | ( | ) | [private, inherited] |
Implementation of Forth::Reset
Implementation of Forth::Execute
| CELL ForthVM::DoQuit | ( | ) | [private, inherited] |
Implementation of Forth::Quit
Implementation of Forth::Evaluate
| const CELL * ForthVM::DoPop | ( | unsigned | numCells | ) | [private, inherited] |
Implementation of Forth::Pop
| void ForthVM::DoPush | ( | const CELL * | cells, | |
| unsigned | numCells | |||
| ) | [private, inherited] |
Implementation of Forth::Push
Variable Documentation
const CELL BitsPerCell = BITS_PER_CHAR*CHARS_PER_CELL [static] |
const CELL CellLoMask = ((CELL)1<<(BitsPerCell/2))-1 [static] |
const CELL SlashCountedString = 255 [static] |
const CELL NameLengthMask = 31 [static] |
const CELL DictionaryOverhead = CHARS(SlashCountedString+2+SlashPad) [static] |
const CELL MaxWordlists = 16 [static] |
const CELL StackCells = 256 [static] |
const CELL ReturnStackCells = 256 [static] |
const CELL XT_NEST_CHECK[] [static] |
const CELL XT_FORWARD_BRANCH_COMMA[] [static] |
const CELL XT_BACKWARD_BRANCH_COMMA[] [static] |
const CELL XT_UM_SLASH_MOD[] [static] |
const CELL XT_CHECK_NEG[] [static] |
const CELL XT_CHECK_POS[] [static] |
const CELL XT_SM_SLASH_REM[] [static] |
const CELL XT_FM_SLASH_MOD[] [static] |
const CELL XT_SLASH_MOD[] [static] |
const CELL XT_STAR_SLASH_MOD[] [static] |
const CELL XT_NUMBER_SIGN_S[] [static] |
const CELL XT_CREATE_WORD[] [static] |
Definition of non standard forth word.
: CREATE-WORD ( c-addr u -- )
\ Create a dictionary entry for a word named by the string c-addr u.
\ This entry cannot be found until VALIDATE is called. OVER 0<> OVER 0> INVERT AND IF -16 THROW THEN \ check address and length are valid
NameLengthMask MIN \ truncate name to maximum
ALIGN HERE >R \ get location to store word's header
CURRENT @ \ get current wordlist
DUP @ R@ - , \ write link field
R@ SWAP ! \ update current wordlist
DUP C, \ write name length
BEGIN DUP \ write each character in name...
WHILE OVER C@ C, SWAP CHAR+ SWAP 1-
REPEAT
2DROP ALIGN \ tidy up
R> LATEST ! \ update LATEST to point to new word
;
const CELL XT_VALIDATE[] [static] |
const CELL XT_PAREN_CREATE[] [static] |
const CELL XT_PAREN_DOES[] [static] |
const CELL XT_LITERAL[] [static] |
const CELL XT_PAREN_S_QUOTE[] [static] |
const CELL XT_S_QUOTE[] [static] |
const CELL XT_PAREN_FIND[] [static] |
Definition of non standard forth word.
: (find) ( c-addr u -- xt flag header | c-addr u 0 )
\ Find the defination named by the string c-addr u.
\ If the definition is not found return c-addr u and zero.
\ If the definition is found, return its execution token xt,
\ a flag which is true if the word is immediate, and it's header address. CONTEXT @ 0 \ loop through number of wordlists in CONTEXT
DO
CONTEXT I 1+ CELLS + \ get pointer to next wordlist
@ (search-wordlist) \ search this wordlist
?DUP IF UNLOOP EXIT THEN \ exit if found
LOOP
FALSE \ return FALSE for words not found
;
const CELL XT_THROW_QUOTE[] [static] |
const CELL XT_PAREN_TICK[] [static] |
const CELL XT_TO_SIGN[] [static] |
Definition of non standard forth word.
: >SIGN ( c-addr1 u1 -- c-addr2 u2 true | c-addr1 u1 false )
\ If the string specified by c-addr1 u1 begings with a minus sign \ then adjust string to remove it and return true, \ else return then original string and false.
DUP 0= IF FALSE EXIT THEN OVER C@ [CHAR] - = IF SWAP CHAR+ SWAP 1- TRUE EXIT THEN FALSE ;
const CELL XT_NUMBER_QUERY[] [static] |
Definition of non standard forth word.
: NUMBER? ( c-addr1 u1 -- d 2 | n 1 | 0 )
\ Convert the string specified by c-addr1 u1 into a number.
\ Return d and 2 if the number is a double number,
\ return n and 1 if the number is a single number;
\ otherwise return zero. >SIGN >R \ check for leading minus sign
0 0 2SWAP >NUMBER 2SWAP \ convert string to a number
R> IF DNEGATE THEN \ apply sign to number
2SWAP DUP 0= \ all of string converted?
IF 2DROP DROP 1 EXIT THEN \ return a single cell number
1 = SWAP C@ [CHAR] . = AND \ remainder of string is a single decimal point?
IF 2 EXIT THEN \ return a double cell number
2DROP 0 \ not a number, so return 0
;
const CELL XT_INTERPRET_WORD[] [static] |
Definition of non standard forth word.
: INTERPRET-WORD ( c-addr u -- i*x | d | n )
\ Find the defination named by the string c-addr u.
\ If the definition is found, perform it's execution semantics,
\ i*x represents the results of this.
\ If the definition is not found, convert c-addr u into a number.
\ If the number is valid double number, leave its value d on the stack.
\ If the number is valid single number, leave its value n on the stack.
\ If the number isn't valid, throw exception -13. (find) \ search dictionary for the word
IF DROP EXECUTE EXIT THEN \ if found, execute it and end
2DUP 2>R \ save string
NUMBER? \ convert string into a number
IF \ if it is a valid number
R> DROP R> DROP \ discard saved string
EXIT \ leave number's value on stack and end
THEN
2R> -13 THROW \ throw -13 (with string on top of stack)
;
const CELL XT_COMPILE_WORD[] [static] |
Definition of non standard forth word.
: COMPILE-WORD ( c-addr u -- i*x | )
\ Find the defination named by the string c-addr u.
\ If the definition is found, then if the word is immediate perform it's
\ execution semantics, i*x represents the results of this. If the word
\ isn't immediate, append it's execution semantics to the current definition.
\ If the definition is not found, convert c-addr u into a number.
\ If the number is valid single or double number, append code to the current
\ definition which when executed will leave the number's value on the stack.
\ If the number isn't valid, throw exception -13. (find) \ search dictionary for the word
IF \ if found
IF \ and it's immediate,
EXECUTE EXIT \ then execute it and end
THEN \ else
, EXIT \ compile it and end
THEN
2DUP 2>R \ save string
NUMBER? DUP \ convert string into a number
IF \ if it is a valid number
R> DROP R> DROP \ discard saved string
1- IF SWAP POSTPONE LITERAL THEN \ compile number as a literal...
POSTPONE LITERAL EXIT
THEN
2R> -13 THROW \ throw -13 (with string on top of stack)
;
const CELL XT_INTERPRET[] [static] |
Definition of non standard forth word.
: INTERPRET ( -- i*x) \ Interpret the current input, i*x is the result of this
BEGIN
PARSE-WORD DUP \ get a word from the input
WHILE \ while there is a word
STATE @ \ if in compile state
IF COMPILE-WORD \ compile the word
ELSE INTERPRET-WORD \ else interpret the word
THEN
REPEAT \ get next word
2DROP \ discard empty word and end
;
const CELL XT_EVALUATE[] [static] |
const CELL XT_REFILL_TIB[] [static] |
Definition of non standard forth word.
: REFILL-TIB ( -- true )
\ Refill the terminal input buffer (TIB)
\ and make it the current input source. TIB DUP /TIB ACCEPT SPACE \ get input from terminal
(source) 2! \ make SOURCE point to TIB
0 >IN ! TRUE \ set >IN to zero
;
Definition of ANS forth word.
: REFILL ( -- flag )
\ Attempt to fill the input buffer from the input source,
\ returning a true flag if successful. >IN CELL+ @ 0= \ if input source is 0
IF REFILL-TIB EXIT THEN \ get input from terminal and return true
FALSE \ otherwise, return false
;
const CELL XT_DO_QUIT[] [static] |
| const CELL XT_EXCEPTION_DOT[] |
Definition of ANS forth word.
: EXCEPTION. ( n -- n )
DUP -1 =
IF ." ABORT" EXIT THEN // Print 'ABORT', and end
DUP -2 =
IF EXCEPTION-STRING 2@ TYPE EXIT THEN // Print exception message, and end
DUP -13 =
IF
EXCEPTION-STRING 2@ TYPE // Print word name
SPACE [CHAR] ? EMIT EXIT // followed by " ?", then end
THEN
." Exception" DUP . // Print "Exception n", then end
;
const CELL ForthDictionary[] [static] |
const CELL EnvironmentDictionary[] [static] |
