Word Index

<   <=   =   !=   >   >=   0=   0<   -   *   +   /   <<   >>   s>>   [']  

@   !   C@   C!   2@   2!   !+   @n++   @n--   C,   S"   >R   R@   R>   R[n]  

DATA-STACK   RETURN-STACK     BRANCH   0BRANCH   1BRANCH     2DROP   2DUP   2OVER   2SWAP  

ABS   AGAIN   ALLOT   AND   [ASM]  

BASE   BEGIN   BREAK  

FALSE   FDEMIT   FDTELL   FIND   FORTH  

HERE   HEX  

NEGATE   NIP   NL   NOT   NUMBER  

OPEN-FILE   OR   OVER  

QUIT  

XOR  

Word Descriptions

Word: [ASM]

data stack: ( -- )

"[ASM]" is a function word that introduces inline assembly in an RRQFORTH definition. Such assembly code may return to subsequence RRQFORTH executon by means of the following instruction sequence:

        mov rsi,forthcode
        lodsq
        jmp qword [rax]
forthcode:

Note that the FORTH compiler does not invoke an assembler so any inline assembly code must be provided in its binary form.

_______________________________________________________

Word: 0BRANCH

Data stack: ( v -- )

"0BRANCH" is a function word that implements execution conditional by means of optionally adding the subsequent branch offset, or not, to the point of execution. If the value, v, is 0 then the branch offset is added, and otherwise execution continues with the cell following the branch offset in the definition.

Note that the branch offset is a byte count and each FORTH word of a definition take up a cell of 8 bytes. The offset is relative to the cell address immediately subsequent to the offset cell. In other words, offset 0 is not branching anywhere and an offset of -16 would make a tight loop back to the branch instruction itself. The latter would pull data stack values until and including the first non-zero value.

See also 1BRANCH, BRANCH, IF, ELSE, IFBREAK and IFAGAIN.

_______________________________________________________

Word: 0=

Data stack: ( v -- 0/-1 )

"0=" is a function word that replaces a value with its logical complement; the result is zero if the value non-zero, and the result is non-zero if the value is zero.

This is the same function as NOT.

_______________________________________________________

Word: 0<

Data stack: ( v -- 0/-1 )

"0<" is a function word that replaces a value with -1 if the value is less than 0, and 0 otherwise.

Definition concept for 0<

( v — 0/1 ) : 0= 0 SWAP < ;

See also SWAP and <.

_______________________________________________________

Word: 1BRANCH

Data stack: ( v -- )

"1BRANCH" is a function word that implements execution conditional by means of optionally adding the subsequent branch offset, or not, to the point of execution. If the value, v, is non-zero then the branch offset is added, and otherwise execution continues with the cell following the branch offset in the definition.

Note that the branch offset is a byte count and each FORTH word of a definition take up a cell of 8 bytes. The offset is relative to the cell address immediately subsequent to the offset cell. In other words, offset 0 is not branching anywhere and an offset of -16 would make a tight loop back to the branch instruction itself. The latter would pull data stack values until and including the first zero value.

See also 0BRANCH, BRANCH, IF, ELSE, IFBREAK and IFAGAIN.

_______________________________________________________

Word: 2DROP

Data stack: ( v1 v2 -- )

"2DROP" is a function word that plainly discards the top 2 cells from the data stack.

_______________________________________________________

Word: 2DUP

Data stack: ( v1 v2 -- v1 v2 v1 v2 )

"2DUP" is a function word that duplicates the top 2 cells on the data stack.

Definition concept for 2DUP

( v1 v2 — v1 v2 v1 v2 ) : 2DUP OVER OVER ;

_______________________________________________________

Word: 2@

Data stack: ( a -- v2 v1 )

"2@" is a function word that pushes the two concecutive values v1 and v2 from the address a onto the data stack. Value v1 is from address a and value v2 is from address a + 8.

_______________________________________________________

Word: 2OVER

Data stack: ( v1 v2 v3 v4 -- v1 v2 v3 v4 v1 v2 )

"2OVER" is a function word that replicates the second duble-cell pair onto the top of the data stack. This is similar to OVER but working with cell pairs rather than single cells.

Definition concept for 2OVER

( v1 v2 v3 v4 — v1 v2 v3 v4 v1 v2 ) : 2OVER 3 PICK 3 PICK ;

_______________________________________________________

Word: 2!

Data stack: ( v2 v1 a -- )

"2!" is a function word that stors two concecutive values v1 and v2 to the address a from the data stack. Value v1 is stored at address a and value v2 is stored at address a + 8.

_______________________________________________________

Word: 2SWAP

Data stack: ( v1 v2 v3 v4 -- v3 v4 v1 v2 )

"2SWAP" is a function word the reorgnizes the top 4 cells swappping the upper and lower pair. This is similar to SWAP but working with cell pairs rather than single cells.

Definition concept for 2SWAP

( v1 v2 v3 v4 — v3 v4 v1 v2 ) : 2SWAP 3 ROLL 3 ROLL ;

_______________________________________________________

Word: C,

Data stack: ( v -- )

"C," (C-comma) is a function word that puts a byte on the HERE heap. The least significant byte of the value is put at the current free head address, which also is incremented.

Definition concept for C,

: C, HERE @ 1 ALLOT C! ; ( v — ; Claim 1 byte and put lsb value there )

See also :, [p_comma]. HERE, @, ALLOT, C! and ;.

_______________________________________________________

Word: CFA>TFA

Data stack: ( cfa -- tfa )

"CFA>TFA" is a function word that pushes word tfa of the given cfa.

Definition concept for CFA>TFA

: CFA>TFA 14 - @ ;

_______________________________________________________

Word: C@

Data stack: ( a -- v )

"C@" is a function word that pushes the byte value v from the address a.

_______________________________________________________

Word: C!

Data stack: ( v a -- )

"C!" is a function word that stores the byte value v (the least significant byte of the cell) at the address a.

_______________________________________________________

Word: R@

Data stack: ( -- v )   Return stack: ( v -- v )

"R@" is a function word that "copies" the top return stack value onto the data stack.

_______________________________________________________

Word: R>

Data stack: ( -- v )   Return stack: ( v -- )

"R>" is a function word that "moves" the top return stack value onto the data stack.

_______________________________________________________

Word: ABS

Data stack: ( v1 -- v2 )

"ABS" is a function word that replaces a value with its absolute value. To that end, the values are 64-bit signed integers.

_______________________________________________________

Word: AGAIN

Data stack: Compiling: ( -- a )

"AGAIN" is an immediate function word that is used together with BEGIN and instead of END to implement structured execution control. AGAIN scans the datastack for the nearest preceding BEGIN marker and lays out an unconditional branch from this point the beginning of the block during execution. It thereafter performs the END compile action to end the block.

_______________________________________________________

Word: ALLOT

Data stack: ( n -- )

"ALLOT" is a function word that merely increments the HERE variable with n so as to claim that amount of the heap.

Defintion concept for ALLOT

( n — ) : ALLOT HERE @ + HERE ! ;

Usage example 1: claim 16 bytes for variable FOO

CREATE FOO DROP HERE @ 16 ALLOT

_______________________________________________________

Word: AND

Data stack: ( v1 v2 -- v3 )

"AND" is a function word that replaces a value pair with their bitwise conjunction; each bit is 1 if the corresponding bits of both operands are 1 and 0 if not.

_______________________________________________________

Word: MAIN-ARGS

Data stack: ( -- p[argv** argc] )

"ARGS" is a value word that holds a pointer to the command line data block which consists of a count cell followed by that many asciiz pointers and then a 0 cell.

Usage example 2: the command line argument block
ARGS -> 8 bytes: count of non-zero asciiz pointers following
        8 bytes: command name string
        8 bytes: first argument string
        8* ...
        8 zero
_______________________________________________________

Word: BASE

Data stack: ( -- a )

"BASE" is a variable word for the numerical base used by input and output functions, NUMBER and [p_dot], when translating numbers between cell value form and text form. The numerical base is set to 10 or 16 by DECIMAL and HEX respectively, and those are the only two bases currently supported.

See also DIGITS, which holds the mapping table from digits to text.

_______________________________________________________

Word: BEGIN

Data stack: Compiling: ( -- a 0 )

"BEGIN" is an immediate function word that is used together with IFBREAK, IFAGAIN and END to implement structured execution control. BEGIN simply places the address for resolving branches back to this point during execution, and then a 0 as a marker so as to allow for an unknown number of block exit points.

Usage example 3:
: WTELL ( tfa -- ; Print word pname )
  24 + DUP 8 + SWAP @ TELL SP EMIT
;

: WORDS ( wordlist -- ; Print all words of word list )
  BEGIN
    @ DUP 0= IFBREAK
    DUP WTELL
  END
  DROP
  NL EMIT
;
_______________________________________________________

Word: [']

Data stack: ( -- cfa )   Input stream: word

"[']" is an immediate function word that reads the next word on the input stream and pushes its cfa.

Definition concept for [']

: ['] IMMEDIATE ' ;

_______________________________________________________

Word: BRANCH

Data stack: ( -- )

"BRANCH" is a function word that implements execution transfer by means of adding the subsequent branch offset to the point of execution.

Note that the branch offset is a byte count and each FORTH word of a definition take up a cell of 8 bytes. The offset is relative to the cell address immediately subsequent to the offset cell. In other words, offset 0 is not branching anywhere and an offset of -16 would make a tight loop back to the branch instruction itself. The latter would pull data stack values until and including the first zero value.

See also 0BRANCH, 1BRANCH, IF, ELSE, IFBREAK and IFAGAIN.

_______________________________________________________

Word: BREAK

"BREAK" is an immediate function word that lays out an unconditional branch out of an enclosing xef:p_begin[BEGIN]-END block. Similar to IFBREAK it lays out the branch cell followed by a reserved cell for the branch offset, and inserts the resolution address just above the required 0 on the data stack.

Usage example 4: unconditional break with a condition.
: WTELL ( tfa -- ; Print word pname )
  24 + DUP 8 + SWAP @ TELL SP EMIT
;

: WORDS ( wordlist -- ; Print all words of word list )
  BEGIN
    @ DUP IF DUP WTELL ELSE BREAK THEN
    1 IFAGAIN
  END
  DROP
  NL EMIT
;
_______________________________________________________

Word: [calltrace]

"[calltrace]" is a variable word that ccontains a small assembly snippet that may be used for debugging when running under gdb.

_______________________________________________________

Word: CFA>FLAGS@

Data stack: ( cfa -- flags )

"CFA>FLAGS@" is a function word that pushes word flags of the given cfa.

Defintion concept for CFA>FLAGS@

: CFA>FLAGS@ 16 - @ 16 + ;

_______________________________________________________

Word: CLEAR-STREAM

Data stack: ( stream -- )

"CLEAR-STREAM" is a function word that discards whatever is currently remaining in the buffer for the stream, so that a subsequent read will pull in more data from its source.

_______________________________________________________

Word: :

Data stack: ( -- )    Input stream: word

":" (colon) is a function word that starts a new forth definition. This includes reading the next word for making a new dictionary entry and setting evaluation state to compiling mode.

Definition concept for :

: : doFORTH READ-WORD CREATE TFA>CFA ! ] ;

See also doFORTH, READ-WORD, CREATE, TFA>CFA, !, ] and ;.

_______________________________________________________

Word: ,

Data stack: ( v -- )

"," (comma) is a function word that puts a cell value on the HERE heap.

Definition concept for ,

: , HERE @ 8 ALLOT ! ; ( v — ; Claim 8 bytes and put value there )

See also :, [p_Ccomma]. HERE, @, ALLOT, ! and ;.

_______________________________________________________

Word: CREATE

Data stack: ( char* n -- tfa )

"CREATE" is a function word that allocates a "word header" with the indicated [n:char*] print name, and returns the "TFA" (Token Field Address) of the word. The header memory layout is as follows:

Layout 1: rrqforth word structure
struct WORD
TFA  8 link ; tfa of previous word
pCFA 8 cfap ; CFA = Code Field Address of this word
     8 flags ;
PFA  8 length ; length of pname representation
     ? pname ; the pname bytes
     1 nul ; a forced nul byte following the pname
pTFA 8 tfap ; TFA = Token Field Address of this word
OFF  8 doff ; entry offset for FORTH level execution
CFA  8 doer ; word execution semantics
DFA  0 content ; DFA = Data Field Address
end_struct

A "word" is generally understod as a marker in memory for some content as held in the memory space following the DFA (Data Field Address).

The words CFA (Code Field Address) is the most important field for RRQFORTH execution, as holding a jump address to the assembly code that implements the particular execution semantics for the word. "CREATE" will assign this as "dovariable", which makes the word push its DFA when executed. This is changed to "doforth" for RRQFORTH function words initiated by ":" (aka "COLON") or changed to "dovalue" for RRQFORTH constants created by "CONSTANT".

Definition concept for CREATE

HERE @ R> ( save tfa on RS ) R@ CURRENT-WORD @ DUP @ , ! ( link in a new word ) DUP 49 + R@ + , ( pCFA ) 0 , ( flags ) DUP , ( length ) HERE @ ROT ROT MEMCPY 0 C, ( pname + NUL ) R@ , ( pTFA ) 0 , ( OFF ) doVARIABLE ( CFA, default semantics )

Usage example 5: a possible definition of CONSTANT
: CONSTANT READ-WORD CREATE TFA>DFA doVALUE OVER 8 - ! ! ;

See also !, +, [p_comma], @, [p_Ccomma], CURRENT-WORD, DUP, HERE, HERE, R@, ROT, and doVARIABLE, as well as EXECUTE about the range of "doer" assignments and their meanings.

_______________________________________________________

Word: CURRENT-WORDLIST

Data stack: ( -- a )

"CURRENT-WORDLIST" is a variable word that points out the DFA of the current word list word for FIND to use finding words. The word list word content is as follows:

Layout 2: word list word content
  8 TFA of latest word in the word list
  8 DFA of the/a subsequent word list to search through

Note that word lists are chained by "extension" and in general it ends with the FORTH word list. Initially the SYSTEM word list is the only other word list.

_______________________________________________________

Word: DATA-STACK

Data stack: ( -- a )

"DATA-STACK" is a variable word that harbours the data stack.

_______________________________________________________

Word: DECIMAL

Data stack: ( -- )

"DECIMAL" is a function word that sets BASE to 10.

Definition concept for DECIMAL

: DECIMAL 10 BASE ! ;

_______________________________________________________

Word: DEFINITIONS

Data stack: ( wordlist -- )

"DEFINITIONS" is a function word that installs the given wordlist as the CURRENT-WORDLIST one.

Definition concept for DEFINITIONS

: DEFINITIONS CURRENT-WORDLIST ! ;

_______________________________________________________

Word: DEPTH

Data stack: ( -- v )

"DEPTH" is a function word that pushes the count of data stack cells onto the data stack.

_______________________________________________________

Word: DFA>TFA

Data stack: ( dfa -- tfa )

"DFA>TFA" is a function word that pushes word tfa of the given dfa.

Definition concept for DFA>TFA

: DFA>TFA 24 - @ ;

_______________________________________________________

Word: DIGITS

Data stack: ( -- a )

"DIGITS" is a variable word that holds the character array for mapping digit values to characters. It contains the 16 characters 0-9 and a-f.

_______________________________________________________

Word: /

Data stack: ( v1 v2 -- q )

"/" (div) is a function word that replaces a pair of values with the results of signed integer division of the first, v1, divided by the second, v2. To that end, the values are 64-bit signed integers. The result is the integer quotient, q, and the discarded remainder, r, where q and r are the respectively largest and smallest integers to satisfy the formula:

       v1 = q * v2 + r
_______________________________________________________

Word: /MOD

Data stack: ( v1 v2 -- q r )

"/MOD" (div-mod) is a function word that replaces a pair of values with the results of signed integer division of the first, v1, divided by the second, v2. To that end, the values are 64-bit signed integers. The result is the integer quotient, q, and the remainder, r, where q and r are the respectively largest and smallest integers to satisfy the formula:

       v1 = q * v2 + r
_______________________________________________________

Word: doDOES

Data stack: ( -- a )

"doDOES" is a variable word whose value is the implementation of the [p_does] execution semantics. This is the same as doFORTH but it starts at an offset into the word concerned.

_______________________________________________________

WORD: DOES>

Data stack: ( -- )

"DOES>" is a function that in execution mode does nothing but in compilation mode it changes the execution semantics assignments for the most recent word to use the dodoes sematics with adjustment offset to the current heap address. I.e., the word being defined will have its execution start at whatever comes after "DOES>".

Defintion concept for DOES>

: DOES> IMMEDIATE STATE @ != IF ( only for compilation mode ) CURRENT-WORDLIST @ @ TFA>CFA ( cfa of current word ) doDOES OVER ! ( set up doer ) HERE @ OVER 8 + - SWAP 8 - ! ( set up offset THEN ;

See also !, !⇒>, →>, @, CURRENT-WORDLIST, HERE, IF, IMMEDIATE, OVER, STATE, SWAP, TFA>CFA, THEN, doDOES, as well as EXECUTE about the range of "doer" assignments and their meanings.

_______________________________________________________

Word: doFASM

Data stack: ( -- a )

"doFASM" is a variable word whose value is the implementation of the execution semantics for assembly code content.

_______________________________________________________

Word: doFORTH

Data stack: ( -- a )

"doFORTH" is a variable word whose value is the implementation of the RRQFORTH execution semantics.

_______________________________________________________

Word: doSTRING

Data stack: ( -- a )

"doFASM" is a variable word whose value is the implementation of the execution semantics for assembly code implemented words. In those cases the execution leads to the word content.

The register context at entry to an assembly code implemented word is as follows:

    rax = cfa* of word to execute
    rsi = cell* in the calling definition, after calling cell
    rsp = data stack pointer
    rbp = return stack pointer

The assembly code must ensure that rsi is preserved and that rsp and rbp are used according to their roles.

_______________________________________________________

Word: .

Data stack: ( v -- )

"." is a function word that prints the top stack value to stdout using the current BASE (either DECIMAL or HEX).

_______________________________________________________

Word: .TEMP

Data stack: ( v -- char* n )

".TEMP" is a function word that renders a cell value as an integer using the current BASE, which is either DECIMAL or HEX. In DECIMAL BASE, a negative value is rendered as such with a leading minus sign, whereas HEX BASE rendering is unsigned.

_______________________________________________________

Word: "

data stack: ( -- char n )    Input stream: ...."

""" (double quote) is a function word that copies the input stream text up to next double quote to PAD, and returns the [n:char*] cell pair for that string.

_______________________________________________________

Word: doVALUE

Data stack: ( -- a )

"doVALUE" is a variable word whose value is the implementation of the execution semantics for cell values, which are variables with a single 64-bit cell holding the value.

The execution of this result in pushing the value:

Resulting data stack: ( -- v )
_______________________________________________________

Word: doVARIABLE

Data stack: ( -- a )

"doVARIABLE" is a variable word whose value is the implementation of the execution semantics for "variables", which basically are markers into the heap for some number block of memory.

The execution of a variable results in pushing its content address:

Resulting data stack: ( -- a )
_______________________________________________________

Word: DROP

Data stack: ( v -- )

"DROP" is a function word that discards the top stack cell.

_______________________________________________________

Word: DUP

Data stack: ( v -- v v )

"DUP" is a function word that duplicates the top stack cell.

_______________________________________________________

Word: ELSE

Data stack: Compiling: ( a -- a )

"ELSE" is an immediate function word that is used together with IF and THEN to implement structured execution control. ELSE lays out an unresolved unconditional branch as an ending for the "then-part" of the structured statement, and it then performs the branch resolution for the "else-part". To that end it replaces the stacked address which pin-points the foot address the branch offset to resolve, so that at execution time there is an appropriate conditional branch past the "then-part" and the "else-part" of the "structured statement".

_______________________________________________________

Word: EMIT

Data stack: ( c -- )

"EMIT" is a function word that puts the given character code to standard output (file descriptor 1). The character is the least significant byte of the top cell.

_______________________________________________________

Word: END

Data stack: Compiling: ( a 0 * -- )

"END" is an immediate function word that is used together with BEGIN, IFBREAK and IFAGAIN to implement structured execution control. END processes the data stack to resolve any dangling IFBREAK branch offset for the block of the matching BEGIN.

_______________________________________________________

Word: =

Data stack: ( v1 v2 -- 0/-1 )

"=" is a function word that replaces a pair of values with -1 of the values are equal, and 0 otherwise.

_______________________________________________________

Word: ERASE

Data stack: ( a n -- )

"ERASE" is a function word that stores n NUL bytes at address a an up.

_______________________________________________________

Word: EVALUATE-STREAM

Data stack: ( stream -- ??? 0/1 )     Input stream: ......

"EVALUATE-STREAM" is a function word that reads words separated by whitespace from the stream until it discovers an unknown word, or the stream is exhausted. Depending on STATE, the words are either executed or compiled, and all ther stack and heap effects are preserved. "EVALUATE-STREAM" returns with an additional 0 or 1 on the stack to respectively indicate that the last word was unkown, i.e. not found (FIND) in the current word list (CURRENT-WORDLIST) and not a NUMBER of the current BASE.

Note that numbers in the current BASE are treated as known words that are parsed into cell values. If interpreting, then the value is left on the stack. If compiling, then the value is added to the heap subsequent to first adding LIT, which is done so as to make that value be push to the data stack upon a later execution.

In the DECIMAL base, the number word may begin with a minus sign.

The words are read and executed one by one, accounting for whether its a number word or not, whether it is an IMMEDIATE word or not, and whether the state at the time of execution indicates "compiling" of "interpreting". Immediate words are executed in both interpreting and compiling state, while other words have their CFA get added to the heap so as to gain their execution effect upon a later execution.

Note that "EVALUATE-STREAM" keeps the stream (pointer) on the return stack while reading, parsing and executing.

If "EVALUATE-STREAM" ends with 0, then THIS-WORD holds the [n:chars] reference of the offending word in the stream buffer.

_______________________________________________________

Word: EXECUTE

Data stack: ( cfa -- )

"EXECUTE" is a function word that transfers the execution to the indicated "Code Field Address", which typically is the CFA of an RRQFORTH word with the CFA cell containing a jump address for the code that implements the execution semnatics of the word.

The following execution semantics are predefined:

  • assembler implemented words constitute their own execution semantics;

  • [p_doforth] implements the FORTH machine. This treats the word content as a succession of cells that hold the cfa pointers for the words that make of the definition. As is customary in FORTH machines, the advance through that succession is provided by each word code ending making an explicit jump to its successor. The RETURN-STACK serves as a call stack for tracking the nesting of FORTH executions by saving the "addresses" of the successor cells.

  • [p_dodoes] implements the variation of starting the FORTH execution somewhere within a definition rather than at the beginning.

  • [p_dostring], [p_dovalue] and [p_dovariable] implement different common ways of using word content other the as FORTH definitions.

_______________________________________________________

Word: EXIT

Data stack: ( v -- )

"EXIT" is a function word that terminates the rrqforth process immediately with the given exit code.

_______________________________________________________

Word: FALSE

Data stack: ( -- 0 )

"FALSE" is a value word representing logical false.

_______________________________________________________

Word: FDEMIT

Data stack: ( c fd -- )

"FDEMIT" is a function word that puts the given character code to the given file descriptor. The character is the least significant byte of the data stack cell.

_______________________________________________________

Word: FDTELL

Data stack: ( char* n fd -- )

"FDTELL" is a function word that prints a string to the given file descriptor.

_______________________________________________________

Word: FIND

Data stack: ( char* n -- [ char* n 0 ]/[ tfa ] )

"FIND" is a function word that searches the current word list search path for the given [n:char*] word, and returns the TFA of the matching word if any. Otherwise FIND preserves the initial data stack but adds 0 to it.

The word is sought starting with the CURRENT-WORDLIST word list, for the first occurence of a match. If not found, the search continues with the subsequent word list, and so on.

When a word is found, then the data stack is changed by discarding the [n:char*] double cell string pointer and pushing (only) the TFA of the matching word instead.

_______________________________________________________

Word: FORTH

data stack: ( -- a )

"FORTH" is a variable word for the FORTH word list, which does not have any subsequent word list.

_______________________________________________________

Word: @

Data stack: ( a -- v )

"@" is a function word that pushes the value v from the address a.

_______________________________________________________

Word: @n--

Data stack: ( a n -- v )

"@n--" is a function word that pushes the value from the address, a, then decrements the cell at that address by n.

Defintion concept for @n++

: @n++ OVER @ DUP ROT - ROT ! ;

_______________________________________________________

Word: @n++

Data stack: ( a n -- v )

"@n++" is a function word that pushes the value from the address, a, then increments the cell at that address by n.

Defintion concept for @n++

( a n — v ) : @n++ OVER @ DUP ROT + ROT ! ;

_______________________________________________________

Word: >=

Data stack: ( v1 v2 -- 0/-1 )

">=" is a function word that replaces a pair of values with -1 if the first, v1, is greater than or equal to the second, v1, otherwise 0. To that end, the values are 64-bit signed integers.

_______________________________________________________

Word: >

Data stack: ( v1 v2 -- 0/-1 )

">" is a function word that replaces a pair of values with -1 if the first, v1, is greater than the second, v1, otherwise 0. To that end, the values are 64-bit signed integers.

_______________________________________________________

Word: >R

Data stack: ( v -- )   Return stack: ( -- v )

">R" is a function word that "moves" the top data stack value onto the return stack.

_______________________________________________________

Word: HERE

Data stack: ( -- a )

"HERE" is a variable word that keeps the lowest address of the free allocation space. It get updated by all words that allocate memory.

allocate 1024 bytes on the heap

1024 HEAP @ + HEAP !

See also ALLOT.

_______________________________________________________

Word: HEX

Data stack: ( -- )

"HEX" is a function word that sets BASE to 16, which uses letters a-f as additional digits. (Uppercase letter are also accepted on input).

Definition concept for HEX

: HEX 16 BASE ! ;

_______________________________________________________

Word: IF

Data stack: Compiling: ( -- a )

"IF" is an immediate function word that is used together with ELSE and THEN to implement structured execution control. IF results in layout of a 0BRANCH instruction with an unresolved branch offset, and places the address for resolving this instruction on the datastack. This address will then be resolved and asssigned by a subsequent ELSE or THEN so that at execution time there is an appropriate conditional branch past the "then-part" of the "structured statement".

_______________________________________________________

Word: IFAGAIN

Data stack: Compiling: ( -- a )

"IFAGAIN" is an immediate function word that is used together with BEGIN, BREAK and END to implement structured execution control. IFAGAIN scans the datastack for the nearest preceding BEGIN marker and lays out a branch from this point the beginning of the block during execution.

_______________________________________________________

Word: IFBREAK

Data stack: Compiling: ( -- a )

"IFBREAK" is an immediate function word that is used together with BEGIN, IFAGAIN and END to implement structured execution control. IFBREAK simply places the address for resolving branches from this point the end of the block during execution.

_______________________________________________________

Word: IMMEDIATE

Data stack: ( -- )

"IMMEDIATE" is an immediate function word that sets the flags field of the most recent word to 1, thereby making that word an immediate word.

Definition concept for IMMEDIATE

: IMMEDIATE IMMEDIATE 1 CURRENT-WORDLIST @ @ 16 + ! ;

See also :, CURRENT-WORDLIST, @, +, !, and [p_semicolon;].

_______________________________________________________

Word: INPUT

Data stack: ( -- a )

"INPUT" is a variable word for the input stream buffer used by EVALUATE-STREAM.

_______________________________________________________

Word: [

Data stack: ( -- )

"[" (left bracket) is a function word that sets the stream evaluation mode to be intepreting. In this mode, words are executed immediately after parsing, by invoking their "doer".

Definition concept for [

: [ IMMEDIATE 0 STATE ! ;

_______________________________________________________

Word: <=

Data stack: ( v1 v2 -- 0/-1 )

"<=" is a function word that replaces a pair of values with -1 if the first, v1, is less than or equal to the second, v1, otherwise 0. To that end, the values are 64-bit signed integers.

_______________________________________________________

Word: <

Data stack: ( v1 v2 -- 0/-1 )

"<" is a function word that replaces a pair of values with -1 if the first, v1, is less than the second, v1, otherwise 0. To that end, the values are 64-bit signed integers.

_______________________________________________________

Word: LIT

Data stack: ( -- v )

"LIT" is a function word that pushes the cell subsequent and moves excution past that. The literal value is thus layed out as if a subsequent CFA pointer in the containing definition, and the LIT execution will make the execution skip past that and instead contine with the CFA pointer following the value.

It’s not a good idea to use "LIT" interactively.

Definition concept for LIT

: LIT R> DUP 8 + >R @ ;

_______________________________________________________

Word: S"

Data stack: ( -- chars* n )

"S"" is a function word that pushes the [n:char] pointer for a string inlined subsequently to it in the containing definition. This is similar to LIT but for a string literal.

Definition concept for LIT

: LIT R> DUP @ 2DUP + 8 + >R SWAP 8 + SWAP ;

_______________________________________________________

Word: LOAD-BUFFER-SIZE

data stack: ( -- a )

"LOAD-BUFFER-SIZE" is a variable word telling the buffer size in bytes that LOAD-FILE should use.

_______________________________________________________

Word: LOAD-FILE

data stack: ( chaz* -- * 0/1 )

"LOAD-FILE" is a function word that evaluates a text file. It opens a file via OPEN-FILE and sets up a stream with a buffer of LOAD-BUFFER-SIZE bytes for reading it. The stream is passed to EVALUATE-STREAM for processing its words. Upon its return the file is closed and the stream memory is reclaimed, and then the function returns whatever EVALUATE-STREAM returns.

_______________________________________________________

Word: (

Data stack: ( -- )

"(" (left parenthesis) is a function word that scans and ignores words until the next right parenthesis, or the end of the stream. This is used for comments in RRQFORTH code.

Note that the terminating right parenthesis is a word, i.e. must have whitespace before and after it.

_______________________________________________________

Word: MALLOC

Data stack: ( n -- a )

"MALLOC" is a word that allocates memory using mmap of at least n bytes and returns the lowest address of the allocated block.

Note that this makes new page allocations for the process from the kernel, and the granularity is in pages, i.e. a multiple of 4 kb.

The memory is allocated with READ and WRITE access but not EXEC access, and flagged as PRIVATE, ANONYMOUS and LOCKED. See the "man page" of mmap for details.

See also STREAM

_______________________________________________________

Word: -

Data stack: ( v1 v2 -- v3 )

"-" (minus) is a function word that replaces a pair of values with the result of reducing the first, v1, with the second, v2. To that end, the values are 64-bit signed integers.

_______________________________________________________

Word: *

Data stack: ( v1 v2 -- v3 )

"*" is a function word that replaces a pair of values with the result of multiplying them. To that end, the values are 64-bit signed integers, and clipping the result to the least signifcant 64 bits.

_______________________________________________________

Word: NEGATE

Data stack: ( v1 -- v2 )

"NEGATE" is a function word that replaces a value with its 2’s-complement negation. To that end, the values are 64-bit signed integers.

_______________________________________________________

Word: NIP

Data stack: ( v1 v2 -- v2 )

"NIP" is a function word that discards the second of the top two cells on the data stack.

Definition concept for NIP

: NIP SWAP DROP ;

_______________________________________________________

Word: NL

Data stack: ( -- v )

"NL" is a value word pushing a newline character onto the data stack.

_______________________________________________________

Word: NOT

Data stack: ( v1 -- v2 )

"NOT" is a function word that replaces a value with its bitwise complement; each bit is zero if non-zero, and non-zero if zero.

Compare with <<p_0equal,0⇒>.

_______________________________________________________

Word: NUMBER

Data stack: ( char n -- [ 0 ]/[ v 1 ] )

"NUMBER" is a function word that parses a text number using BASE as numerical base, then returns the result number and a 1 on top, or just a 0 if the word didn’t parse.

A number consists of, first an optional minus sign, if in DECIMAL base, then digits 0-9 and, if in HEX base, letters a-f or A-F for values 10-15. I.e. the normal positive or negative decimal integers or normal (positive only) hexadecimal integers.

_______________________________________________________

Word: OPEN-FILE

Data stack: ( chaz* -- fd )

"OPEN-FILE" is a function word that opens the file named by the zero terminated character string and returns the file descriptor, or if less than 0, the system call error code.

_______________________________________________________

Word: OR

Data stack: ( v1 v2 -- v3 )

"OR" is a function word that replaces a value pair with their bitwise disjunction; each bit is 1 if the corresponding bits of any operand is 1 and 0 if not.

_______________________________________________________

Word: OVER

Data stack: ( v1 v2 -- v1 v2 v1 )

"OVER" is a function word that duplicates the second top stack cell on the data stack.

_______________________________________________________

Word: PAD

Data stack: ( -- a )

"PAD" is a variable word for a 1 kb data space that is used by [p_double_quote] (only), and otherwise free for temporary use.

_______________________________________________________

Word: PICK

Data stack: ( vu...v1 v0 u -- vu...v1 v0 vu )

"PICK" is a function word that pushes the u:th data stack cell down from top onto the data stack. 0 indicates the top cell making it the same as DUP, and 1 indicates the second top cell making it the same as OVER.

_______________________________________________________

Word: +

Data stack: ( v1 v2 -- v3 )

"+" (plus) is a function word that replaces a pair of values with the result of adding them. To that end, the values are 64-bit signed integers.

_______________________________________________________

Word: PROGRAM_VERSION

Data stack: ( -- char* length )

"PROGRAM_VERSION" is a string variable hilding the version string.

_______________________________________________________

Word: !

Data stack: ( v a -- )

"!" is a function word that stores the cell value v at the address a.

_______________________________________________________

Word: !+

Data stack: ( a n -- )

"!+" is a function word that adds n to the cell value at a.

definition concept for !+

( a n — ) : !+ OVER @ + SWAP ! ;

_______________________________________________________

Word: QUIT

Data stack: ??

"QUIT" is a function word that implements the root execution loop of RRQFORTH. First it resets the stacks to their original settings, and thereafter it enters loop of reading words from STDIN and executing them.

_______________________________________________________

Word: '

data stack: ( -- cfa )    Input stream: word

"'" (single quote) is a function word that reads and find the next word on the input stream and pushes its cfa.

_______________________________________________________

Word: RSP

Data stack: ( -- a )

"RSP" is a function word that pushes the return stack pointer value onto the data stack.

_______________________________________________________

Word: R[n]

Data stack: ( n -- a )

"R[n]" is a function word that pushes the address for the n:th cell on the top return stack value onto the data stack.

Defintion concept for R[n]

( n — a ) : R[n] 8 * RSP + ;

_______________________________________________________

Word: READ-STREAM-CHAR

Data stack: ( stream -- c )

"READ-STREAM-CHAR" is a function word that gets the next character from the given stream buffer, possibly refilling the buffer if it is backed by a file descriptor. The refill is done by a SYS_READ call when more characters are needed. The next character is pushed on the stack, unless the stream is exhausted in which case the -1 is pushed instead.

See also STREAM.

_______________________________________________________

Word: READ-WORD

Data stack: ( stream -- char* n )

"READ-WORD" is a function word that "reads" the next whitespace separated word from the given stream and returns the [n:char*] duoble cell pointer for it. The characters of the word are copied to PAD, and there is a limit of 1024 characters.

At the end of the stream READ-WORD returns 0 length.

Special syntax 1: Whitespace

All character codes less or equal to 32 are regarded as "whitespace".

Special syntax 2: Rest-of-line comment

The "#" character following whitespace starts a line comment and the rest of the line is ignored. Note that this is also recognised with parethesis commenting.

_______________________________________________________

Word: REALLOC

Data stack: ( a m n -- a )

"REALLOC" is a word that reallocates memory using mremap of address a of size m to be size n bytes and returns the lowest address of the allocated block.

Note that this makes new page allocations for the process from the kernel, and the granularity is in pages, i.e. a multiple of 4 kb.

The memory is reampped using the MREMAP_MAYMOVE flag,

See also MALLOC

_______________________________________________________

Word: RETURN

Data stack: ( -- )

"RETURN" is a function word that implements the ending of a FORTH definition and make execution return to the next step in the calling definition.

_______________________________________________________

compile.asm: WORD p_right_bracket,],fasm

Word: ]

Data stack: ( -- )

"]" (right bracket) is a function word that sets the stream evaluation mode to be compiling. In this mode words parsed into CFA pointers which are placed on the heap in the given order, unless the word is flagged as IMMEDIATE or a NUMBER. An immediate word is executed immediately, and a number is parsed and left on the stack.

Note that a word is parsed as a number only if it is not found in the wordlist; i.e., the word list may contain definitions for numbers.

Definition concept for ]

: ] 1 STATE ! ;

_______________________________________________________

Word: ROLL

Data stack: ( vu...v1 v0 u -- ...v1 v0 vu )

"ROLL" is a function word that "moves" the u:th data stack cell down from top onto the data stack while discarding it. 0 indicates the top cell; 1 indicates the second top cell making it the same as SWAP; 2 indicates the third top cell making it the same as ROT.

_______________________________________________________

Word: ROT

Data stack: ( v1 v2 v3 -- v2 v3 v1 )

"ROT" is a function word that "rotates" the top three data stack cells such that the third becomes the first while the second becomes third and the first becomes the second.

See also ROLL.

_______________________________________________________

Word: ;

Data stack: ( -- )

";" (semi-colon) is a function word that ends a new forth definition by means of adding an EXIT

Definition concept for ;

: ; IMMEDIATE ' EXIT , ;

_______________________________________________________

Word: [p_setup_signals]

Data stack: ( -- a )

"[p_setup_signals]" is a variable word that contains the assembly code sniippet for setting up the signal handling. rrqforth handles SEGV by restarting the interpreter loop on STDIN.

_______________________________________________________

Word: <<

Data stack: ( v1 n -- v2 )

"<<" is a function word that shifts value v1 n steps left (i.e. "moving" bits towards more significant bits) to form value v2.

_______________________________________________________

Word: >>

Data stack: ( v1 n -- v2 )

">>" is a function word that shifts value v1 n steps right (i.e. "moving" bits towards less significant bits) to form value v2.

_______________________________________________________

Word: s>>

Data stack: ( v1 n -- v2 )

"s>>" is a function word that shifts value v1 n steps right (i.e. "moving" bits towards less significant bits) to form value v2, but preserving (and copying) the sign bit.

_______________________________________________________

Word: SP

Data stack: ( -- v )

"SP" is a value word pushing a space character onto the data stack.

_______________________________________________________

Word: STATE

Data stack: ( -- a )

"STATE" is a variable word marking whether the stream evaluator is in compiling mode (1) or interpreting (0) mode.

_______________________________________________________

Word: STDIN

Data stack: ( -- stream )

"STDIN" is a value word referring to the stream buffer for the standard input file descriptor.

_______________________________________________________

Word: STREAM

Data stack: ( fd size -- addr ) or ( block -1 -- addr )

"STREAM" is a function word that sets up a buffer for an input file descriptor or for a memory block (of size+data).

File descriptor backed STREAM

A file descriptor backed STREAM gains a buffer of the given size prefixed by a 32 byte STREAM header of the following layout:

Layout 3: file descriptor stream
  8 bytes = size of buffer (excluding the 32 byte header)
  8 bytes source file descriptor
  8 bytes current fill
  8 current read position

Memory block backed STREAM

A memory block stream is only the header (though allocated via MALLOC which reserves a full kernel page) with the following layout:

Layout 4: memory block stream
  8 bytes = block address
  8 -1 (indicates memory block)
  8 size of block (taken from the block's first 8 bytes)
  8 current read position
_______________________________________________________

Word: STREAM-NCHARS

Data stack: ( stream -- n )

"STREAM-NCHARS" is a function word that scans ahead in the stream buffer for the next non-whitespace character, and returns its position relative to the end of the buffer. This is done without changing the stream (or filling it by reading the backing file).

_______________________________________________________

Word: STRLEN

Data stack: ( s -- n )

"STRLEN" is a function words that counts how many bytes there are from s to the first NUL byte and returns that count, n, not including the NUL byte.

_______________________________________________________

Word: STRNCMP

Data stack: ( s1 s2 n -- v )

"STRNCMP" is a function words that compares up to n characters of character sequences s1 and s2, and returns the difference of the first differing characters, as in s2[i] - s1[i], or 0 if all n characters are the same.

I.e., the value v is less than 0 if string [n:s1] is alpha-numerically less than [n:s2], v is greater than 0 if [n:s1] is greater than [n:s2], and v is 0 if [n:s1] and [n:s2] are equal.

_______________________________________________________

Word: STRNCPY

Data stack: ( s1 s2 n -- )

"STRNCPY" is a function words that copies n bytes of byte sequence s1 to s2.

_______________________________________________________

Word: SWAP

Data stack: ( v1 v2 -- v2 v1 )

"SWAP" is a function word the swaps the top two data stack cells.

_______________________________________________________

Word: SYSTEM

Data value: ( -- a )

"SYSTEM" is a variable that holds the word list data for the system calls. This is set up as separate word list from FORTH merely as a matter of segregation.

_______________________________________________________

Word: TELL

Data stack: ( char* n -- )

"TELL" is a function word that prints a string to stdout (file descriptor 1).

_______________________________________________________

Word: TERMINATE0

Data stack: ( -- )

"TERMINATE0" is a function word that terminates the program with exit code 0.

_______________________________________________________

Word: TFA>CFA

Data stack: ( tfa -- cfa )

"TFA>CFA" is a function word that pushes word cfa of the given tfa.

Definition concept for TFA>CFA

: TFA>CFA 8 + @ ;

_______________________________________________________

Word: TFA>DFA

Data stack: ( tfa -- dfa )

"TFA>DFA" is a function word that pushes word dfa of the given tfa.

Definition concept for TFA>DFA

: TFA>DFA TFA>CFA 8 + ;

_______________________________________________________

Word: TFA>FLAGS@

Data stack: ( tfa -- flags )

"TFA>FLAGS@" is a function word that pushes word flags of the given tfa.

Defintion concept for TFA>FLAGS@

: TFA>FLAGS@ 16 + @ ;

_______________________________________________________

Word: TFA>NAMEZ

Data stack: ( tfa -- char* )

"TFA>NAMEZ" is a function word that pushes changes a tfa pointer to a pointer to the word pname’s character sequence, which is zero terminated as well as preceded by a length cell.

Defintion concept for TFA>NAMEZ

: TFA>NAMEZ 32 + ;

_______________________________________________________

Word: THEN

Data stack: Compiling: ( a -- )

"THEN" is an immediate function word that is used together with IF and ELSE to implement structured execution control. THEN performs the branch resolution for the stacked address which pinpoints the foot address the branch offset to resolve, so that at execution time there is an appropriate conditional branch past the "then-part" or the "else-part" of the "structured statement".

_______________________________________________________

Word: THIS-WORD

Data stack: ( -- a )

"THIS-WORD" is a variable word used in [p_evaluate_stream:EVALUATE-STREAM] as cache for the [n:char*] values of the successive words being evaluated. This typically points into the input stream buffer and remain valid until further stream buffering functions are used.

_______________________________________________________

Word: TRUE

Data stack: ( -- -1 )

"TRUE" is a value word representing logical true.

_______________________________________________________

Word: TUCK

Data stack ( v1 v2 -- v2 v1 v2 )

"TUCK" is a function word that "inserts" the top cell below the second cell on the data stack.

Definition concept for TUCK

: TUCK SWAP OVER ;

_______________________________________________________

Word: !=

Data stack: ( v1 v2 -- 0/-1 )

"!=" is a function word that replaces a pair of values with -1 of the values are unequal, and 0 otherwise.

_______________________________________________________

Word: UNSTREAM

Data stack: ( stream* -- )

"UNSTREAM" is a function word that releases the memory allocated for a stream, and closes the associated file if it’s a file stream.

File descriptor backed stream

This kind of stream has the stream header as a prefix within the allocated memory. Thus, stream* is the base address for the memory to reclaim, and the size of this is determined from the cell at (stream* + 16) plus the 32 bytes head itself.

Memory block backed STREAM

This kind of stream has a separate header which points at the memory area to reclaim. The cell at stream* is the base address, and the cell at (stream* + 16) is its size.

_______________________________________________________

Word: USE

Data value: ( wordlist -- )  Input stream: word

"USE" is a function word that looks up next word given the wordlist. It reads next word on INPUT via READ-WORD, then temporarily changes CURRENT-WORDLIST to FIND the word via the given wordlist, and returns the TFA of that word, or just 0 if the word coudn’t be found.

_______________________________________________________

Word: VERBOSE?

Data stack: ( -- a )

"VERBOSE?" is a variable word that is assigned at start up to -1 or 0 signify whether or not the command line arguments includes "-v". When non-zero (i.e. running rrqforth with "-v") the evaluation loop is more verbose.

_______________________________________________________

Word: WITHIN

Data stack: ( v lo hi -- 0/-1

"WITHIN" is a function word that replaces a triple of values with -1 of the the first, v, is within the value range spanned by the second, lo, inclusive and third, hi, exclusive.

Definition concept for WITHIN

: WITHIN 2 PICK > ROT ROT ⇐ AND ;

_______________________________________________________

Word: WORDS

Data stack: ( wl -- )

"WORDS" is a function word that prints all words of teh given word list to stdout (file descriptor 1).

_______________________________________________________

Word: XOR

Data stack: ( v1 v2 -- v3 )

"XOR" is a function word that replaces a value pair with their bitwise exclusion; each bit is 1 if the corresponding bits of the two operands differ and 0 if not.

_______________________________________________________

Word: RETURN-STACK

Data stack: ( -- a )

"RETURN-STACK" is a variable word harbouring the return stack.

System calls

RRQFORTH includes function wrapping for all "Linux syscalls", which generally are described in their "man pages. This wrapping takes the arguments fro the data stack in reverse order, i.e. the first argument is deepest.

Use SYSTEM WORDS to get a list of all (321) available syscalls.