Clear the instruction cache; needed when we clear memory. Problem occures as follows.
1) empty with executable code in memory. 2) new code to dictionary. 3) Old code in cache
( -- )
Make the most recent definition an immediate word. An ambiguous condition exists if the most recent definition does not have a name.
Typical use: : X ... ; IMMEDIATEIMMEDIATE words carry a lot of baggage, refer to the ANS standard for clarification.
An immediate word will be executed when in the compiling state.
: IMMEDIATE ( --)
last \ addr(-- contain last list added to
@ \ addr1(-- last list added to
@ \ addr2(-- address of last word
lfa>nfa
DUP C@ \ addr3 count (--
_#immediate_bit OR
SWAP C!
;
Sets a bit in the words name so it can't be found by FIND, allows you to redefine words.
: smudge ( --)
last @ ?DUP IF
\ thread(--
@ \ lfa(--
lfa>nfa \ nfa(--
DUP name_count \ nfa addr count(--
NIP \ nfa count+flags(--
_#smudge_bit XOR
SWAP \ count+flags nfa(--
C!
THEN
;
Set the inline bit in the words name field.
: inline ( --)
last \ addr(-- contain last list added to
@ \ addr1(-- last list added to
@ \ addr2(-- address of last word
lfa>nfa
DUP C@ \ addr3 count (--
_#pure_bit OR
SWAP C!
;
\ #### temp zap
: pure_code inline ;
Given xt work out how long the code fragment is.
: code_copy_length ( xt -- length )
xt>cfa
zero
BEGIN
2DUP + W@
4E75 \ ##code RTS
= IF
NIP
EXIT
THEN
2+
AGAIN
;
Test to see if xt points to a pure code word. This will only work if a word has a head. You can't find a word to compile it if it doesn't have a head.
: ?inline ( xt --flag)
xt>cfa
cfa>nfa
char@
_#pure_bit AND 0<>
;
If it is pure code copy the code fragment to the dictionary. If not do a subroutine call.
| : _:compile, ( xt --)
DUP ?inline IF
DUP xt>cfa \ xt cfa (--
SWAP code_copy_length \ cfa num (--
HERE SWAP \ from to num (--
DUP ALLOT \ from to num (--
MOVE \ (--
ELSE
4EB9 W, xt>cfa ,
THEN
;
compile-comma CORE EXT
Interpretation: Interpretation semantics for this word are undefined.
Execution: ( xt -- )
Append the execution semantics of the definition represented by xt to the execution semantics of the current definition.
COMPILE, is the compilation equivalent of EXECUTE. In many cases, it is possible to compile a word by using POSTPONE without resorting to the use of COMPILE,. However, the use of POSTPONE requires that the name of the word must be known at compile time, whereas COMPILE, allows the word to be located at any time. It is sometime possible to use EVALUATE to compile a word whose name is not known until run time. This has two possible problems:
EVALUATE is slower than COMPILE, because a dictionary search is required. The current search order affects the outcome of EVALUATE.
In traditional threaded-code implementations, compilation is performed by , (comma). This usage is not portable; it doesn't work for subroutine-threaded, native code, or relocatable implementations. Use of COMPILE, is portable.
In most systems it is possible to implement COMPILE, so it will generate code that is optimized to the same extent as code that is generated by the normal compilation process. However, in some implementations there are two different tokens corresponding to a particular definition name: the normal execution token that is used while interpreting or with EXECUTE, and another compilation token that is used while compiling. It is not always possible to obtain the compilation token from the execution token. In these implementations, COMPILE, might not generate code that is as efficient as normally compiled code.
Can't use _:copile in all cases as it requires a head. This version always compiles a subroutine call.
: COMPILE, ( xt --)
4EB9 W, xt>cfa ,
;
\ Used in USE. This version patches the subroutine address found at the
\ start of create.
: _compile! ( addr cfa --) 2+ ! ;
\ This version uses COMPILE, as the xt being compiled may be from a word that doesn't
\ have a head.
: _do_compile
R@ @ COMPILE,
R> CELL+ >R
;
: COMPILE
['] _do_compile COMPILE, ' ,
; IMMEDIATE
forth : COMPILE ( --)
HOST COMPILE _do_compile
' t,
forth
;
TARGET
HOST
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( -- )
Append the execution semantics of the current definition to the current definition. An ambiguous condition exists if RECURSE appears in a definition after DOES>.
Typical use: : X ... RECURSE ... ;
This is Forth's recursion operator; in some implementations it is called MYSELF. The usual example is the coding of the factorial function.
: FACTORIAL ( +n1 -- +n2)
DUP 2 < IF DROP 1 EXIT THEN
DUP 1- RECURSE *
;
n2 = n1(n1-1)(n1-2)...(2)(1), the product of n1 with all positive integers less than itself (as a special case, zero factorial equals one). While beloved by computer scientists, recursion makes unusually heavy use of both stacks and should therefore be used with caution.
: RECURSE ( --)
last @ @ lfa>xt COMPILE,
; IMMEDIATE
CORE
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( x -- )
Append the run-time semantics given below to the current definition.
Run-time: ( -- x )
Place x on the stack.
: LITERAL \ compile time ( n--)
\ runtime ( --n)
2D3C W, \ ##code # S -) MOV
,
; IMMEDIATE
two-literal DOUBLE
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( x1 x2 -- )
Append the run-time semantics below to the current definition.
Run-time: ( -- x1 x2 )
Place cell pair x1 x2 on the stack.
: 2LITERAL \ compile time ( x1 x2 --)
\ runtime ( -- x1 x2 )
2D3C W, \ ##code # S -) MOV
SWAP ,
2D3C W, \ ##code # S -) MOV
,
; IMMEDIATE
bracket-tick CORE
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( " name" -- )
Skip leading space delimiters. Parse name delimited by a space. Find name. Append the run-time semantics given below to the current definition.
An ambiguous condition exists if name is not found.
Run-time: ( -- xt )
Place name's execution token xt on the stack. The execution token returned by the compiled phrase ['] X is the same value returned by ' X outside of compilation state.
: ['] ( -- \ --addr)
' [COMPILE] LITERAL
; IMMEDIATE
: use ( addr cfa --)
last @ @ lfa>cfa _compile!
;
| : ;code ( --)
R> ( addr ) use
;
\ This version is used if ;CODE is used in the cross compiler code.
\ As the aim is to remove all assember it is no longer used.
forth : ;CODE
HOST
forth _%local_use @ IF
forth _%local_input_bytes @ IF
forth _%local_input_bytes @ 4 / 7000 OR
tw, \ ##code # D0 MOV
204D tw, \ ##cope LP A0 MOV
\ ##code BEGIN
2D20 tw, \ ##code A0 -) S -) MOV
5380 tw, \ ##code 1 # D0 SUB
66FA tw, \ ##code EQ UNTIL
THEN
4E5D tw, \ ##code LP UNLK
HOST target_previous
_end_xlocal_dictionary
forth THEN
_%t_save_op @ IF
245F tw, \ ##code R )+ OP MOV
zero _%t_save_op !
THEN
HOST
COMPILE ;code
smudge
forth
FALSE tstate !
[COMPILE] assembler
HOST
; TARGET
This version is used IN target words that will create child words when the target is running. See file XCOM2 for the definition of DOES> used in HOST words that manipulate the target It has to be defined after the target version of ;code is defined
forth : DOES>
forth _%local_use @ IF
_%local_input_bytes @ IF
_%local_input_bytes forth @ 4 / 7000 OR tw, \ ##code # D0 MOV
204D tw, \ ##cope LP A0 MOV
\ ##code BEGIN
2D20 tw, \ ##code A0 -) S -) MOV
5380 tw, \ ##code 1 # D0 SUB
66FA tw, \ ##code EQ UNTIL
THEN
4E5D tw, \ ##code LP UNLK
target_previous
_end_xlocal_dictionary
THEN
_%t_save_op @ IF
245F tw, \ ##code R )+ OP MOV
zero _%t_save_op !
THEN
HOST
COMPILE ;code
\ Host version of ['] this finds a word in the target
\ and compiles the literal in the host.
\ The assembler code is the host version, these words add code
\ to the target.
['] _do_does> t_xt>cfa assembler AB L. JSR
( There is a host and forth version of ; we need the forth)
( version, this ends a host word.)
forth
; TARGET
HOST
\CORE
( x "name" -- )
Skip leading space delimiters. Parse name delimited by a space. Create a definition for name with the execution semantics defined below.
name is referred to as a constant.
name Execution: ( -- x )
Place x on the stack.
: CONSTANT
CREATE
_recover_cfa
2D3C W, \ ##code # S -) MOV
,
4E75 W, \ ##code RTS
inline \ Tell system child word is pure code
;
two-constant DOUBLE
( x1 x2 "<spaces>name" -- )
Skip leading space delimiters. Parse name delimited by a space. Create a definition for name with the execution semantics defined below.
name is referred to as a two-constant.
name Execution: ( -- x1 x2 )
Place cell pair x1 x2 on the stack.
: 2CONSTANT
CREATE
_recover_cfa
2D3C W, \ ##code # S -) MOV
SWAP ,
2D3C W, \ ##code # S -) MOV
,
4E75 W, \ ##code RTS
inline \ Tell system child word is pure code
;
: user_create ( n --)
CREATE
_recover_cfa
DUP IF
41EB W, \ ##code 3) A0 LEA
W,
2D08 W, \ ##code A0 S -) MOV
ELSE
2D0B W, \ ##code U S -) MOV
THEN
4E75 W, \ ##code RTS
inline \ Tell system child word is pure code
;
: user_variable \ parent ( --)
\ child ( --addr)
'user @ DUP CELL+ \ old new(--
DUP _'user_top @ < not ABORT" Ran out of user space" \ > old new(--
'user ! \ old(--
user_create \ (--
;
: user_allot ( u --)
'user @ + \ old new(--
DUP _'user_top @ < not ABORT" Ran out of user space" \ > old new(--
'user ! \ old(--
;
\ a buffer that is returned on an abort
: ubuffer ( n--)
CREATE
'user \ n addr (--
@ \ n offset (--
, \ n (--
cell 'user +!
, \ (--
DOES>
user_buffer_runtime
;
\ a buffer that remains once created
: ufree_buffer ( n--)
CREATE
'user \ n addr (--
@ \ n offset (--
, \ n (--
cell 'user +!
, \ (--
HERE
%free_ubuffers @ , %free_ubuffers !
DOES>
user_free_buffer_runtime
;
colon CORE
( C: "name" -- colon-sys )
Skip leading space delimiters. Parse name delimited by a space. Create a definition for name, called a colon definition. Enter compilation state and start the current definition, producing colon-sys. Append the initiation semantics given below to the current definition.
The execution semantics of name will be determined by the words compiled into the body of the definition. The current definition shall not be findable in the dictionary until it is ended (or until the execution of DOES> in some systems).
Initiation: ( i*x -- i*x ) ( R: -- nest-sys )
Save implementation-dependent information nest-sys about the calling definition. The stack effects i*x represent arguments to name.
name Execution: ( i*x -- j*x )
Execute the definition name. The stack effects i*x and j*x represent arguments to and results from name, respectively.
Typical use: : name ... ;
Note that colon does not itself invoke the compiler. Colon sets compilation state so that later words in the parse area are compiled.
: : ( --)
CREATE
_recover_cfa
smudge
@s csp !
TRUE STATE !
FALSE _%local_use !
_%save_op @ IF
2F0A W, \ ##code OP R -) MOV
245E W, \ ##code S )+ OP MOV
THEN
;
colon-no-name CORE EXT
( C: -- colon-sys ) ( S: -- xt )
Create an execution token xt, enter compilation state and start the current definition, producing colon-sys. Append the initiation semantics given below to the current definition.
The execution semantics of xt will be determined by the words compiled into the body of the definition. This definition can be executed later by using xt EXECUTE.
If the control-flow stack is implemented using the data stack, colon-sys shall be the topmost item on the data stack.
Initiation: ( i*x -- i*x ) ( R: -- nest-sys )
Save implementation-dependent information nest-sys about the calling definition. The stack effects i*x represent arguments to xt.
xt Execution: ( i*x -- j*x )
Execute the definition specified by xt. The stack effects i*x and j*x represent arguments to and results from xt, respectively.
:NONAME allows a user to create an execution token with the semantics of a colon definition without an associated name. Previously, only : (colon) could create an execution token with these semantics. Thus, Forth code could only be compiled using the syntax of :, that is:
: NAME ... ;
:NONAME removes this constraint and places the Forth compiler in the hands of the programmer.
:NONAME can be used to create application-specific programming languages. One technique is to mix Forth code fragments with application-specific constructs. The application-specific constructs use :NONAME to compile the Forth code and store the corresponding execution tokens in data structures.
The functionality of :NONAME can be built on any Forth system. For years, expert Forth programmers have exploited intimate knowledge of their systems to generate unnamed code fragments. Now, this function has been named and can be used in a portable program.
For example, :NONAME can be used to build a table of code fragments where indexing into the table allows executing a particular fragment. The declaration syntax of the table is:
:NONAME .. code for command 0 .. ; 0 CMD ! :NONAME .. code for command 1 .. ; 1 CMD ! ... :NONAME .. code for command 99 .. ; 99 CMD ! ... 5 CMD @ EXECUTE ...
The definitions of the table building words are:
CREATE CMD-TABLE \ table for command execution tokens
100 CELLS ALLOT
: CMD ( n -- a-addr ) \ nth element address in table
CELLS CMD-TABLE + ;
As a further example, a defining word can be created to allow performance monitoring. In the example below, the number of times a word is executed is counted. : must first be renamed to allow the definition of the new ;.
: DOCOLON ( -- ) \ Modify CREATEd word to execute like a colon def
DOES> ( i*x a-addr -- j*x )
1 OVER +! \ count executions
CELL+ @ EXECUTE \ execute :NONAME definition
;
: OLD: : ; \ just an alias
OLD: : ( "name" -- a-addr xt colon-sys )
\ begins an execution-counting colon definition
CREATE HERE 0 , \ storage for execution counter
0 , \ storage for execution token
DOCOLON \ set run time for CREATEd word
:NONAME \ begin unnamed colon definition
;
( Note the placement of DOES>: DOES> must modify the CREATEd word and not the :NONAME definition, so DOES> must execute before :NONAME.)
OLD: ; ( a-addr xt colon-sys -- )
\ ends an execution-counting colon definition )
POSTPONE ; \ complete compilation of colon def
SWAP CELL+ ! \ save execution token
; IMMEDIATE
The new : and ; are used just like the standard ones to define words:
... : xxx ... ; ... xxx ...
Now however, these words may be ticked to retrieve the count (and execution token):
... ' xxx >BODY ? ...
: :NONAME ( --xt)
HERE
zero last !
@s csp !
TRUE STATE !
FALSE _%local_use !
_%save_op @ IF
2F0A W, \ ##code OP R -) MOV
245E W, \ ##code S )+ OP MOV
THEN
;
right-bracket CORE
( -- )
Enter compilation state.
: ] ( --)
TRUE STATE !
;
left-bracket CORE
Interpretation: Interpretation semantics for this word are undefined.
Compilation: Perform the execution semantics given below.
Execution: ( -- )
Enter interpretation state. [ is an immediate word.
: [ ( --)
FALSE STATE !
; IMMEDIATE
two-variable DOUBLE
( "name" -- )
Skip leading space delimiters. Parse name delimited by a space. Create a definition for name with the execution semantics defined below. Reserve two consecutive cells of data space.
name is referred to as a two-variable.
name Execution: ( -- a-addr )
a-addr is the address of the first (lowest address) cell of two consecutive cells in data space reserved by 2VARIABLE when it defined name. A program is responsible for initializing the contents.
: 2VARIABLE \ parent ( --)
\ child ( --addr)
CREATE 2 CELLS ALLOT
;
CORE
( "name" -- )
Skip leading space delimiters. Parse name delimited by a space. Create a definition for name with the execution semantics defined below. Reserve one cell of data space at an aligned address.
name is referred to as a variable.
name Execution: ( -- a-addr )
a-addr is the address of the reserved cell. A program is responsible for initializing the contents of the reserved cell.
: VARIABLE \ parent ( --)
\ child ( --)
CREATE cell ALLOT
;
Ram variable are preset to zero on a system restart.
: ram_create \ parent( --)
\ child ( -- addr)
ram_here CONSTANT
;
: ram_variable ( --)
ram_create four ram_allot
;
fast variable reside on the CPU chip, They are not reset on a system restart. They can be used to store data threw a power on reset.
: fast_create \ child ( --addr)
fast_here CONSTANT
;
: fast_variable ( --)
fast_create four fast_allot
;
port variable
: port_create ( --addr)
port_here CONSTANT
;
: port_variable ( --)
port_create four port_allot
;
static variable
#BVP5502 #BVP5501 + #BVP5552 + #BVP5551 + [IF]
: static_create ( --addr)
static_here CONSTANT
;
: static_variable ( --)
static_create four static_allot
;
[THEN]
bank variable
#BVP5502 #BVP5501 + #BVP5552 + #BVP5551 + [IF]
: bank_create ( --addr)
bank_here CONSTANT
;
: bank_variable ( --)
bank_create four bank_allot
;
[THEN]
backslash CORE EXT
Compilation: Perform the execution semantics given below.
Execution: ( "ccc"-- )
Parse and discard the remainder of the parse area. \ is an immediate word.
: \ ( --)
#TIB @ >IN !
; IMMEDIATE
Compile codes. Used to check that strcutures are correctly formed.
1 CONSTANT _#comp_code_origin
2 CONSTANT _#comp_code_destination
3 CONSTANT _#comp_code_do_origin
4 CONSTANT _#comp_code_do_destination
5 CONSTANT _#comp_code_leave
0A CONSTANT _#comp_code_task
We are going to resolve LEAVE at compile time. As a result all control structures other than ?D0 and DO have to roll out the start code from under the leave codes. The leave codes are resolved at compile time by DO and ?DO. The advantage, we dont have to put the termination address on the stack at runtime.
| : roll_out_initiator
zero >R
BEGIN
R@ CS-PICK NIP
_#comp_code_leave =
WHILE
R> 1 + >R
REPEAT
R> CS-ROLL
;
| : ?pair ( n1 n1 -- )
- ABORT" Conditionals not matched"
;
\ resolve a destination
| : !back ( addr --)
HERE - W,
;
\ resolve an origin
| : !forward ( addr --) HERE OVER - SWAP W! ;
TOOLS EXT
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( C: -- orig )
Put the location of a new unresolved forward reference orig onto the control flow stack. Append the run-time semantics given below to the current definition. The semantics are incomplete until orig is resolved (e.g., by THEN).
Run-time: ( -- )
Continue execution at the location specified by the resolution of orig.
\ supply an origin
: AHEAD \ runtime ( --)
\ compile time ( addr #code_origin --)
6000 W, \ ##code BRA
HERE two ALLOT _#comp_code_origin
; IMMEDIATE
CORE
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( C: -- dest )
Put the next location for a transfer of control, dest, onto the control flow stack. Append the run-time semantics given below to the current definition.
Run-time: ( -- )
Continue execution.
\ supply a destination
: BEGIN \ runtime ( -- )
\ compile time ( addr #code_destination--)
HERE
_#comp_code_destination
; IMMEDIATE
CORE
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( C: dest -- )
Append the run-time semantics given below to the current definition, resolving the backward reference dest.
Run-time: ( x -- )
If all bits of x are zero, continue execution at the location specified by dest.
\ resolve destintion
: UNTIL \ runtime ( flag --)
\ compie time ( addr #code_destination ??leave --)
roll_out_initiator
_#comp_code_destination ?pair
4A9E W, \ ##code S )+ TST
6700 W, \ ##code EQ BCC
!back
; IMMEDIATE
CORE EXT
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( C: dest -- )
Append the run-time semantics given below to the current definition, resolving the backward reference dest.
Run-time: ( -- )
Continue execution at the location specified by dest. If no other control flow words are used, any program code after AGAIN will not be executed.
: AGAIN \ runtime ( --)
\ compile time ( addr #code_destination ??leave --)
roll_out_initiator
_#comp_code_destination ?pair
6000 W, \ ##code BRA
!back
; IMMEDIATE
CORE
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( C: orig -- )
Append the run-time semantics given below to the current definition. Resolve the forward reference orig using the location of the appended run-time semantics.
Run-time: ( -- )
Continue execution.
: THEN \ runtime ( --)
\ compile time ( addr #code_origin ??leave --)
roll_out_initiator
_#comp_code_origin ?pair
!forward
; IMMEDIATE
CORE
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( C: -- orig )
Put the location of a new unresolved forward reference orig onto the control flow stack. Append the run-time semantics given below to the current definition. The semantics are incomplete until orig is resolved, e.g., by THEN or ELSE.
Run-time: ( x -- )
If all bits of x are zero, continue execution at the location specified by the resolution of orig.
\ supplies origin
: IF \ runtime ( flag --)
\ compile time ( -- addr 2)
4A9E W, \ ##code S )+ TST
6700 W, \ ##code EQ BCC
HERE two ALLOT _#comp_code_origin
; IMMEDIATE
CORE
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( C: dest -- orig dest )
Put the location of a new unresolved forward reference orig onto the control flow stack, under the existing dest. Append the run-time semantics given below to the current definition. The semantics are incomplete until orig and dest are resolved (e.g., by REPEAT).
Run-time: ( x -- )
If all bits of x are zero, continue execution at the location specified by the resolution of orig.
\ takes an destination
\ supplies a origin destination
: WHILE \ runtime ( flag -- )
\ compile time ( addr1 destination ??leave -- addr2 origin addr1 dest)
roll_out_initiator
[COMPILE] IF 1 CS-ROLL
; IMMEDIATE
CORE
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( C: orig dest -- )
Append the run-time semantics given below to the current definition, resolving the backward reference dest. Resolve the forward reference orig using the location following the appended run-time semantics.
Run-time: ( -- )
Continue execution at the location given by dest.
\ takes destination origin
: REPEAT \ runtime ( -- )
\ compile time ( addr2 origin ??leave addr1 dest ??leave --)
[COMPILE] AGAIN
[COMPILE] THEN
; IMMEDIATE
CORE
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( C: orig1 -- orig2 )
Put the location of a new unresolved forward reference orig2 onto the control flow stack. Append the run-time semantics given below to the current definition. The semantics will be incomplete until orig2 is resolved (e.g., by THEN). Resolve the forward reference orig1 using the location following the appended run-time semantics.
Run-time: ( -- )
Continue execution at the location given by the resolution of orig2.
: ELSE \ runtime ( -- )
\ compile time ( addr1 2 -- addr2 2 )
[COMPILE] AHEAD
1 CS-ROLL
[COMPILE] THEN
; IMMEDIATE
CORE
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( C: -- do-sys )
Place do-sys onto the control-flow stack. Append the run-time semantics given below to the current definition. The semantics are incomplete until resolved by a consumer of do-sys such as LOOP.
Run-time: ( n1|u1 n2|u2 -- ) ( R: -- loop-sys )
Set up loop control parameters with index n2|u2 and limit n1|u1. An ambiguous condition exists if n1|u1 and n2|u2 are not both the same type. Anything already on the return stack becomes unavailable until the loop-control parameters are discarded.
: DO \ runtime ( limit start -- )
\ compile_time ( -- addr 3 )
COMPILE _do_do
HERE _#comp_code_do_destination
; IMMEDIATE
question-do CORE EXT
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( C: -- do-sys )
Put do-sys onto the control-flow stack. Append the run-time semantics given below to the current definition. The semantics are incomplete until resolved by a consumer of do-sys such as LOOP.
Run-time: ( n1|u1 n2|u2 -- ) ( R: -- | loop-sys )
If n1|u1 is equal to n2|u2, continue execution at the location given by the consumer of do-sys. Otherwise set up loop control parameters with index n2|u2 and limit n1|u1 and continue executing immediately following ?DO. Anything already on the return stack becomes unavailable until the loop control parameters are discarded. An ambiguous condition exists if n1|u1 and n2|u2 are not both of the same type.
: ?DO \ runtime ( limit start --)
\ compile time (-- addr -3 )
COMPILE _do_?do HERE _#comp_code_do_origin 2 ALLOT
HERE _#comp_code_do_destination
; IMMEDIATE
CORE
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( C: do-sys -- )
Append the run-time semantics given below to the current definition. Resolve the destination of all unresolved occurrences of LEAVE between the location given by do-sys and the next location for a transfer of control, to execute the words following the LOOP.
Run-time: ( -- ) ( R: loop-sys1 -- | loop-sys2 )
An ambiguous condition exists if the loop control parameters are unavailable. Add one to the loop index. If the loop index is then equal to the loop limit, discard the loop parameters and continue execution immediately following the loop. Otherwise continue execution at the beginning of the loop.
The stack should contain leave pairs and then a DO or ?DO destination. If we roll_out_destination first then we may incorrectly compile leaves from the previous loops. So we deal with the leaves and expect to find a DO or ?DO destination.
: LOOP ( -- \ addr 3 --)
COMPILE _do_loop
2 ALLOT
BEGIN
DUP _#comp_code_leave =
WHILE
DROP
!forward
REPEAT
_#comp_code_do_destination ?pair
-2 ALLOT
!back
_#comp_code_do_origin OVER = IF
DROP !forward
THEN
; IMMEDIATE
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( C: do-sys -- )
Append the run-time semantics given below to the current definition.
Resolve the destination of all unresolved occurrences of LEAVE between
the location given by do-sys and the next location for a transfer of control,
to execute the words following +LOOP.
Run-time: ( n -- ) ( R: loop-sys1 -- | loop-sys2 )
An ambiguous condition exists if the loop control parameters are unavailable.
Add n to the loop index. If the loop index did not cross the boundary between the loop
limit minus one and the loop limit, continue execution at the beginning of the loop.
Otherwise, discard the current loop control parameters and continue execution
immediately following the loop.
The stack should contain leave pairs and then a DO or ?DO initiator. If we roll_out_iniator first then we may incorrectly compile leaves from the previous loops. So we deal with the leaves and expect to finish leave resolution when we hit the DO or ?DO initiator.
: +LOOP ( -- \ addr 3 --)
COMPILE _do_+loop
\ get the address right for all the resolves
2 ALLOT
BEGIN
DUP _#comp_code_leave =
WHILE
DROP
!forward
REPEAT
_#comp_code_do_destination ?pair
-2 ALLOT
!back
_#comp_code_do_origin OVER = IF
DROP !forward
THEN
; IMMEDIATE
HEX
CORE
Interpretation: Interpretation semantics for this word are undefined.
Execution: ( -- ) ( R: loop-sys -- )
Discard the current loop control parameters. An ambiguous condition exists if they are unavailable. Continue execution immediately following the innermost syntactically enclosing DO ... LOOP or DO ... +LOOP.
Note that LEAVE immediately exits the loop. No words following LEAVE within the loop will be executed. Typical use: : X ... DO ... IF ... LEAVE THEN ... LOOP ... ;: LEAVE \ runtime ( -- ) \ compile time ( -- addr leave_code ) 508F W, \ ##code 8 # R ADD 6000 W, \ ##code BRA HERE 2 ALLOT _#comp_code_leave ; IMMEDIATE6.2.0873 CASE
CORE EXT
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( C: -- case-sys )
Mark the start of the CASE ... OF ... ENDOF ... ENDCASE structure. Append the run-time semantics given below to the current definition.
Run-time: ( -- )
Continue execution.
Typical use: : X ... CASE test1 OF ... ENDOF testn OF ... ENDOF ... ( default ) ENDCASE ... ;0 CONSTANT CASE IMMEDIATE \ init count of OF6.2.1950 OF
CORE EXT
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( C: -- of-sys )
Put of-sys onto the control flow stack. Append the run-time semantics given below to the current definition. The semantics are incomplete until resolved by a consumer of of-sys such as ENDOF.
Run-time: ( x1 x2 -- | x1 )
If the two values on the stack are not equal, discard the top value and continue execution at the location specified by the consumer of of-sys, e.g., following the next ENDOF. Otherwise, discard both values and continue execution in line.
: OF \ compile time ( #of -- orig #of+1 \ runtime ( xtest x -- xtest) 1+ \ count OFs >R \ move off the stack as the control-flow ) \ stack is the data stack. COMPILE OVER COMPILE = \ copy and test case value) [COMPILE] IF \ add orig to control flow stack ) COMPILE DROP \ discards case value if = R> \ we can bring count back now ; IMMEDIATE6.2.1343 ENDOF
end-of CORE EXT
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( C: case-sys1 of-sys -- case-sys2 )
Mark the end of the OF ... ENDOF part of the CASE structure. The next location for a transfer of control resolves the reference given by of-sys. Append the run-time semantics given below to the current definition. Replace case-sys1 with case-sys2 on the control-flow stack, to be resolved by ENDCASE.
Run-time: ( -- )
Continue execution at the location specified by the consumer of case-sys2.
: ENDOF \ compile time ( orig1 #of -- orig2 #of ) >R \ move off the stack as the control-flow ) \ stack is the data stack. ) [COMPILE] ELSE R> ( we can bring count back now ) ; IMMEDIATE6.2.1342 ENDCASE
end-case CORE EXT
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( C: case-sys -- )
Mark the end of the CASE ... OF ... ENDOF ... ENDCASE structure. Use case-sys to resolve the entire structure. Append the run-time semantics given below to the current definition.
Run-time: ( x -- )
Discard the case selector x and continue execution.
: ENDCASE \ compile time ( orig1..orign #of -- ) COMPILE DROP ( discard case value ) 0 ?DO [COMPILE] THEN LOOP ; IMMEDIATEANS 6.1.0580 >R
CORE
Interpretation: Interpretation semantics for this word are undefined.
Execution: ( x -- ) ( R: -- x )
Move x to the return stack.
: >R ( --\ -- 32b) 2F1E W, \ ##code S )- R )+ MOV ; IMMEDIATEANS 6.1.1680 I
Interpretation: Interpretation semantics for this word are undefined.
Execution: ( -- n|u ) ( R: loop-sys -- loop-sys )
n|u is a copy of the current (innermost) loop index. An ambiguous condition exists if the loop control parameters are unavailable.
: I ( --x) 2D17 W, \ ##code R ) S -) MOV ; IMMEDIATEANS 6.1.2060 R>
Interpretation: Interpretation semantics for this word are undefined.
Execution: ( -- x ) ( R: x -- )Move x from the return stack to the data stack.
: R> ( - 32b) 2D1F W, \ ##code R )+ S -) MOV ; IMMEDIATEANS 6.1.2070 R@
Interpretation: Interpretation semantics for this word are undefined.
Execution: ( -- x ) ( R: x -- x )Copy x from the return stack to the data stack.
: R@ ( --x) 2D17 W, \ ##code R ) S -) MOV ; IMMEDIATEANS 6.2.0340 2>R
CORE EXT
Interpretation: Interpretation semantics for this word are undefined.
Execution: ( x1 x2 -- ) ( R: -- x1 x2 )Transfer cell pair x1 x2 to the return stack. Semantically equivalent to SWAP >R >R .
Historically, 2>R has been used to implement DO. Hence the order of parameters on the return stack.The primary advantage of 2>R is that it puts the top stack entry on the top of the return stack. For instance, a double-cell number may be transferred to the return stack and still have the most significant cell accessible on the top of the return stack.
: 2>R 201E W, \ ##code S )+ D0 MOV 2F1E W, \ ##code S )+ R -) MOV 2F00 W, \ ##code D0 R -) MOV ; IMMEDIATEANS 6.2.0410 2R>
CORE EXT
Interpretation: Interpretation semantics for this word are undefined.
Execution: ( -- x1 x2 ) ( R: x1 x2 -- )Transfer cell pair x1 x2 from the return stack. Semantically equivalent to R> R> SWAP .
Note that 2R> is not equivalent to R> R>. Instead, it mirrors the action of 2>R
: 2R> 201F W, \ ##code R )+ D0 MOV 2D1F W, \ ##code R )+ S -) MOV 2D00 W, \ ##code D0 S -) MOB ; IMMEDIATEr>drop
Hard to beleive but this is not a standard word. Discard one return stack item.
: r>drop ( --) 588F W, \ ##code 4 # R ADD ; IMMEDIATE2r>drop
Remove two items from the return stack
: 2r>drop ( --) 508F W, \ ##code 8 # R ADD ; IMMEDIATE4r>drop
Remove four items from the return stack
: 4r>drop ( --) 508F W, \ ##code 8 # R ADD 508F W, \ ##code 8 # R ADD ; IMMEDIATEdup>r
Duplicate the top stack item and send it to the return stack.
: dup>r ( --) 2F16 W, \ ##code S ) R -) MOV ; IMMEDIATE6.1.0460 ;
semicolon CORE
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( C: colon-sys -- )
Append the run-time semantics below to the current definition. End the current definition, allow it to be found in the dictionary and enter interpretation state, consuming colon-sys. If the data-space pointer is not aligned, reserve enough data space to align it.
Run-time: ( -- ) ( R: nest-sys -- )
Return to the calling definition specified by nest-sys.
: ; \ word exit code _%local_use @ IF _%local_output_bytes @ IF _%local_output_bytes @ 4 / 7000 OR W, \ ##code # D0 MOV 204D W, \ ##cope LP A0 MOV \ ##code BEGIN 2D20 W, \ ##code A0 -) S -) MOV 5380 W, \ ##code 1 # D0 SUB 66FA W, \ ##code EQ UNTIL THEN 4E5D W, \ ##code LP UNLK PREVIOUS \ get rid of &local _end_local_dictionary THEN _%save_op @ IF zero _%save_op ! 245F W, \ ##code R )+ OP MOV THEN 4E75 W, \ ##code RTS smudge @s csp @ ?pair [COMPILE] [ ; IMMEDIATE6.1.1380 EXIT
CORE
Interpretation: Interpretation semantics for this word are undefined.
Execution: ( -- ) ( R: nest-sys -- )
Return control to the calling definition specified by nest-sys. Before executing EXIT within a do-loop, a program shall discard the loop-control parameters by executing UNLOOP.
: EXIT \ word exit code _%local_use @ IF _%local_output_bytes @ IF _%local_output_bytes @ 4 / 7000 OR W, \ ##code # D0 MOV 204D W, \ ##cope LP A0 MOV \ ##code BEGIN 2D20 W, \ ##code A0 -) S -) MOV 5380 W, \ ##code 1 # D0 SUB 66FA W, \ ##code EQ UNTIL THEN 4E5D W, \ ##code LP UNLK THEN _%save_op @ IF 245F W, \ ##code R )+ OP MOV THEN 4E75 W, \ ##code RTS ; IMMEDIATE15.6.2.0470 ;CODE
semicolon-code TOOLS EXT
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( C: colon-sys -- )
Append the run-time semantics below to the current definition. End the current definition, allow it to be found in the dictionary, and enter interpretation state, consuming colon-sys.
Subsequent characters in the parse area typically represent source code in a programming language, usually some form of assembly language. Those characters are processed in an implementation-defined manner, generating the corresponding machine code. The process continues, refilling the input buffer as needed, until an implementation-defined ending sequence is processed.
Run-time: ( -- ) ( R: nest-sys -- )
Replace the execution semantics of the most recent definition with the name execution semantics given below. Return control to the calling definition specified by nest-sys. An ambiguous condition exists if the most recent definition was not defined with CREATE or a user-defined word that calls CREATE.
name Execution: ( i*x -- j*x )
Perform the machine code sequence that was generated following ;CODE.
: ;CODE ( -- \ --) _%local_use @ IF _%local_output_bytes @ IF _%local_output_bytes @ 4 / 7000 OR W, \ ##code # D0 MOV 204D W, \ ##cope LP A0 MOV \ ##code BEGIN 2D20 W, \ ##code A0 -) S -) MOV 5380 W, \ ##code 1 # D0 SUB 66FA W, \ ##code EQ UNTIL THEN 4E5D W, \ ##code LP UNLK PREVIOUS \ get rid of &local _end_local_dictionary THEN _%save_op @ IF zero _%save_op ! 245F W, \ ##code R )+ OP MOV THEN \ ;code points the cf of the just CREATEd word to the following cell \ and exits this word. The return stack has to be ready for \ exit before ;code is called. ;CODE is a valid terminator for \ a m: word. COMPILE ;code smudge [COMPILE] [ init_assembler ALSO ASSEMBLER FALSE _%local_use ! ; IMMEDIATE6.1.1250 DOES>
does CORE
Interpretation: Interpretation semantics for this word are undefined.
Compilation: ( C: colon-sys1 -- colon-sys2 )
Append the run-time semantics below to the current definition. Whether or not the current definition is rendered findable in the dictionary by the compilation of DOES> is implementation defined. Consume colon-sys1 and produce colon-sys2. Append the initiation semantics given below to the current definition.
Run-time: ( -- ) ( R: nest-sys1 -- )
Replace the execution semantics of the most recent definition, referred to as name, with the name execution semantics given below. Return control to the calling definition specified by nest-sys1. An ambiguous condition exists if name was not defined with CREATE or a user-defined word that calls CREATE.
Initiation: ( i*x -- i*x a-addr ) ( R: -- nest-sys2 )
Save implementation-dependent information nest-sys2 about the calling definition. Place name's data field address on the stack. The stack effects i*x represent arguments to name.
name Execution: ( i*x -- j*x )
Execute the portion of the definition that begins with the initiation semantics appended by the DOES> which modified name. The stack effects i*x and j*x represent arguments to and results from name, respectively.
: DOES> ( -- addr \ --) \ word exit code _%local_use @ IF _%local_output_bytes @ IF _%local_output_bytes @ 4 / 7000 OR W, \ ##code # D0 MOV 204D W, \ ##cope LP A0 MOV \ ##code BEGIN 2D20 W, \ ##code A0 -) S -) MOV 5380 W, \ ##code 1 # D0 SUB 66FA W, \ ##code EQ UNTIL THEN 4E5D W, \ ##code LP UNLK PREVIOUS \ get rid of &local _end_local_dictionary THEN _%save_op @ IF zero _%save_op ! 245F W, \ ##code R )+ OP MOV THEN \ ;code points the code field of the last defined word \ to the cell following ;code and exits this word. \ Therefor we have to have the return stack values removed \ before we call ;code. DOES> is a valid terminator for a m: word. COMPILE ;code 4EB9 W, ( ##code AB L. JSR ) ['] _do_does> xt>cfa , FALSE _%local_use ! ; IMMEDIATE15.6.2.0930 CODE
TOOLS EXT
( "name" -- )
Skip leading space delimiters. Parse name delimited by a space. Create a definition for name, called a code definition, with the execution semantics defined below.
Subsequent characters in the parse area typically represent source code in a programming language, usually some form of assembly language. Those characters are processed in an implementation-defined manner, generating the corresponding machine code. The process continues, refilling the input buffer as needed, until an implementation-defined ending sequence is processed.
name Execution: ( i*x -- j*x )
Execute the machine code sequence that was generated following CODE.
Note the assembler works in interpretive mode)
: CODE ( --) CREATE _recover_cfa init_assembler ALSO ASSEMBLER FALSE _%local_use ! ;vocabulary
This words creates children that behave as FORTH does we supply wid so the following is allowed.
WORDLIST DUP vocabulary FORTH name_wordlist FORTH-WORDLIST: last_wordname> ( --addr) last \ user variable @ \ address of haed last name added to @ \ lfa of last entry lfa>nfa \ ; : vocabulary \ parent ( wid --) \ child ( --) CREATE last_wordname> OVER \ wid name> wid (-- [ _#voc_name> _#voc_wid - ]T LITERAL + ! , DOES> @ context ! ;name_wordlist
This word creates children that behave as FORTH-WORDLIST does.
: name_wordlist \ parent ( wid --) \ child ( -- wid) CREATE , DOES> @ ;