toolbelt wordset
Prev Chapter 3. Wordset Reference Next

toolbelt wordset

description

LGPL (C) 2000 - 2001 Guido Draheim <guidod@gmx.de>

description:: Words as defined by Neil Bawd's toolbelt, quite a few of these have been around for a while, invented and implemented independently. Some of these were also present as PFE's extensions words, and they are referenced here due to the fact that Neil Bawd's website had been given quite some attention, hence these words should be assembled in a wordset to clarify their behaviour is compatible. Comments taken from toolbelt.txt 

FORTH

[VOID] ( .. )();
as:"bracket-void";

( 0 )  constant [VOID]

an immediate constant (no special usage info)

FORTH
[DEFINED] ( [name] -- flag )(); 
 ;

Search the dictionary for _name_. If _name_ is found, return TRUE; otherwise return FALSE. Immediate for use in definitions.

This word will actually return what FIND returns (the NFA). does check for the word using find (so it does not throw like ' ) and puts it on stack. As it is immediate it does work in compile-mode too, so it places its argument in the cs-stack then. This is most useful with a directly following [IF] clause, so that sth. like an [IFDEF] word can be simulated through [DEFINED] word [IF] 

 : [DEFINED] DEFINED ; IMMEDIATE
 : [DEFINED] BL WORD COUNT (FIND-NFA) ; IMMEDIATE
 
FORTH
[UNDEFINED] ( [name] -- flag )(); 
 ;

Search the dictionary for _name_. If _name_ is found, return FALSE; otherwise return TRUE. Immediate for use in definitions.

see [DEFINED] 

 : [UNDEFINED] DEFINED 0= ; IMMEDIATE
 
FORTH

NOT ( .. )();
as:"not";

ordinary primitive NOT

an executable word (no special usage info)

or wrapper call around p4_zero_equal

FORTH

C+! ( n addr -- )();
p4:"c-plus-store";

Add the low-order byte of _n_ to the byte at _addr_, removing both from the stack. 

FORTH

EMPTY ( -- )();
p4:"empty";

Reset the dictionary to a predefined golden state, discarding all definitions and releasing all allocated data space beyond that state. 

FORTH

VOCABULARY ( 'name' -- )();
p4:"vocabulary";

create a vocabulary of that name. If the named vocabulary is called later, it will run ((VOCABULARY)) , thereby putting it into the current search order. Special pfe-extensions are accessible via CASE-SENSITIVE-VOC and SEARCH-ALSO-VOC 

 simulate:
   : VOCABULARY  CREATE ALLOT-WORDLIST
        DOES> ( the ((VOCABULARY)) runtime )
          CONTEXT ! 
   ; IMMEDIATE
 
FORTH
BOUNDS ( str len -- str+len str )(); 
 ;

Convert _str len_ to range for DO-loop. 

 : BOUNDS  ( str len -- str+len str )  OVER + SWAP ;
 
FORTH

OFF ( addr -- )();
p4:"off-store";

Store 0 at _addr_. Defined in f84 as OFF. See antonym ON!. 

  : OFF  ( addr -- )  0 SWAP ! ;
 
FORTH

ON ( .. )();
as:"on";

ordinary primitive ON

an executable word (no special usage info)

or wrapper call around p4_on_store

FORTH

APPEND ( str len add2 -- )();
p4:"append";

Append string _str len_ to the counted string at _addr_. a.k.a. +PLACE of the PLACE family 

 : APPEND   2DUP 2>R  COUNT +  SWAP MOVE ( ) 2R> C+! ;

Append string _str len_ to the counted string at _addr_. a.k.a. APPEND (being a SYNONYM now) 

 : +PLACE   2DUP 2>R  COUNT +  SWAP MOVE ( ) 2R> C+! ;
 
FORTH
APPEND-CHAR ( char addr -- )(); 
 ;

Append _char_ to the counted string at _addr_. a.k.a. C+PLACE of the PLACE family 

 : APPEND-CHAR   DUP >R  COUNT  DUP 1+ R> C!  +  C! ;

Append _char_ to the counted string at _addr_. a.k.a. APPEND-CHAR (being a SYNONYM now) 

 : C+PLACE   DUP >R  COUNT  DUP 1+ R> C!  +  C! ;
 
FORTH

PLACE ( str len addr -- )();
p4:"place";

Place the string _str len_ at _addr_, formatting it as a counted string. 

 : PLACE  2DUP 2>R  1+ SWAP  MOVE  2R> C! ;
 : PLACE  2DUP C!   1+ SWAP CMOVE ;
 
FORTH

STRING, ( str len -- )();
p4:"string-comma";

Store a string in data space as a counted string. 

 : STRING, HERE  OVER 1+  ALLOT  PLACE ;
 
FORTH

," ( .. )();
as:"comma-quote";

immediate primitive ,"

an executable word (no special usage info)

or wrapper call around p4_parse_comma_quote

FORTH

THIRD ( x y z -- x y z x )();
p4:"third";

Copy third element on the stack onto top of stack. 

 : THIRD   2 PICK ;
 
FORTH
FOURTH ( w x y z -- w x y z w )(); 
 ;

Copy fourth element on the stack onto top of stack. 

 : FOURTH  3 PICK ;
 
FORTH
3DUP ( x y z -- x y z x y z )(); 
 ;

Copy top three elements on the stack onto top of stack. 

 : 3DUP   THIRD THIRD THIRD ;

or 

 : 3DUP  3 PICK 3 PICK 3 PICK ;
 
FORTH

3DROP ( x y z -- )();
p4:"three-drop";

Drop the top three elements from the stack. 

 : 3DROP   DROP 2DROP ;
 
FORTH

2NIP ( w x y z -- y z )();
p4:"two-nip";

Drop the third and fourth elements from the stack. 

 : 2NIP   2SWAP 2DROP ;
 
FORTH
R'@ ( R: a b -- a R: a b )(); 
 ;

fetch the next-under value from the returnstack. used to interpret the returnstack to hold two LOCALS| values. ( R@ / 2R@ / R>DROP / R"@) 

FORTH

ANDIF ( p ... -- flag )();
p4:"andif";

Given `p ANDIF q THEN`, _q_ will not be performed if _p_ is false. 

 : ANDIF  S" DUP IF DROP " EVALUATE ; IMMEDIATE
 
FORTH

ORIF ( p ... -- flag )();
p4:"orif";

Given `p ORIF q THEN`, _q_ will not be performed if _p_ is true. 

 : ORIF   S" DUP 0= IF DROP " EVALUATE ; IMMEDIATE
 
FORTH
SCAN ( str len char -- str+i len-i )(); 
 ;

Look for a particular character in the specified string. 

 : SCAN     
    >R  BEGIN  DUP WHILE  OVER C@ R@ -
        WHILE  1 /STRING  REPEAT THEN
    R> DROP ;

ie. scan for first occurence of c in string 

   : SCAN >R BEGIN DUP OVER C@ R@ = 0= OR WHILE 
                    1- SWAP 1- SWAP REPEAT R> DROP ;
 
FORTH
SKIP ( str len char -- str+i len-i )(); 
 ;

Advance past leading characters in the specified string. 

 : SKIP     
   >R  BEGIN  DUP WHILE  OVER C@ R@ =
        WHILE  1 /STRING  REPEAT THEN
    R> DROP ;

ie. skip leading characters c 

   : SKIP  >R BEGIN DUP OVER C@ R@ = OR WHILE 
                    1- SWAP 1- SWAP REPEAT R> DROP ;
 
FORTH
BACK ( str len char -- str len-i )(); 
 ;

Look for a particular character in the string from the back toward the front. 

 : BACK     
    >R  BEGIN  DUP WHILE
        1-  2DUP + C@  R@ =
    UNTIL 1+ THEN
    R> DROP ;
 
FORTH
/SPLIT ( a m a+i m-i -- a+i m-i a i )(); 
 ;

Split a character string _a m_ at place given by _a+i m-i_. Called "cut-split" because "slash-split" is a tongue twister. 

 : /SPLIT  DUP >R  2SWAP  R> - ;
 
FORTH

IS-WHITE ( char -- flag )();
p4:"is-white";

Test char for white space. 

 : IS-WHITE   33 - 0< ;
 
FORTH

TRIM ( str len -- str len-i )();
p4:"trim";

Trim white space from end of string. 

 : TRIM    
    BEGIN  DUP WHILE
        1-  2DUP + C@ IS-WHITE NOT
    UNTIL 1+ THEN ;
 
FORTH
BL-SCAN ( str len -- str+i len-i )(); 
 ;

Look for white space from start of string 

 : BL-SCAN 
    BEGIN  DUP WHILE  OVER C@ IS-WHITE NOT
    WHILE  1 /STRING  REPEAT THEN ;
 
FORTH
BL-SKIP ( str len -- str+i len-i )(); 
 ;

Skip over white space at start of string. 

 : BL-SKIP 
    BEGIN  DUP WHILE  OVER C@ IS-WHITE
    WHILE  1 /STRING  REPEAT THEN ;

 
FORTH
STARTS? ( str len pattern len2 -- str len flag )(); 
 ;

Check start of string. 

 : STARTS?   DUP >R  2OVER  R> MIN  COMPARE 0= ;
 
FORTH
ENDS? ( str len pattern len2 -- str len flag )(); 
 ;

Check end of string. 

 : ENDS?   DUP >R  2OVER  DUP R> - /STRING  COMPARE 0= ;
 
FORTH

IS-DIGIT ( char -- flag )();
p4:"is-digit";

Test _char_ for digit [0-9]. 

 : IS-DIGIT   [CHAR] 0 -  10 U< ;
 
FORTH

IS-ALPHA ( char -- flag )();
p4:"is-alpha";

Test _char_ for alphabetic [A-Za-z]. 

 : IS-ALPHA  32 OR  [CHAR] a -  26 U< ;
 
FORTH

IS-ALNUM ( char -- flag )();
p4:"is-alnum";

Test _char_ for alphanumeric [A-Za-z0-9]. 

 : IS-ALNUM  
    DUP IS-ALPHA  ORIF  DUP IS-DIGIT  THEN  NIP ;
 
FORTH
#BACKSPACE-CHAR ( .. )(); 
 ;
( '\b' )  constant #BACKSPACE-CHAR

an ordinary constant (no special usage info)

FORTH
#CHARS/LINE ( .. )(); 
 ;
( 80 )  constant #CHARS/LINE

an ordinary constant (no special usage info)

FORTH
#EOL-CHAR ( .. )(); 
 ;
( EOL_CHAR )  constant #EOL-CHAR

an ordinary constant (no special usage info)

FORTH
#TAB-CHAR ( .. )(); 
 ;
( '\t' )  constant #TAB-CHAR

an ordinary constant (no special usage info)

FORTH

MAX-N ( .. )();
as:"max-minus-n";

( CELL_MAX )  constant MAX-N

an ordinary constant (no special usage info)

FORTH

CELL ( .. )();
as:"cell";

( sizeof(p4cell) )  constant CELL

an ordinary constant (no special usage info)

FORTH

-CELL ( .. )();
as:"minus-cell";

( - sizeof(p4cell) )  constant -CELL

an ordinary constant (no special usage info)

FORTH
SPLIT-NEXT-LINE ( src . -- src' . str len )(); 
 ;

Split the next line from the string. 

 : SPLIT-NEXT-LINE 
    2DUP #EOL-CHAR SCAN  
    DUP >R  1 /STRING  2SWAP R> - ;

FIXME: inform Neil Bawd that this is probably not what he wanted. replace /STRING with /SPLIT here. 

FORTH
VIEW-NEXT-LINE ( src . str len -- src . str len str2 len2 )(); 
 ;

Copy next line above current line. 

 : VIEW-NEXT-LINE 
    2OVER 2DUP #EOL-CHAR SCAN NIP - ;
 
FORTH

OUT ( .. )();
as:"out";

threadstate variable OUT

out (no special usage info)

FORTH

NEXT-WORD ( -- str len )();
p4:"next-word";

Get the next word across line breaks as a character string. _len_ will be 0 at end of file. 

 : NEXT-WORD         
    BEGIN   BL WORD COUNT      ( str len )
        DUP IF EXIT THEN
        REFILL
    WHILE  2DROP ( ) REPEAT ;  
 
FORTH

LEXEME ( "name" -- str len )();
p4:"lexeme";

Get the next word on the line as a character string. If it's a single character, use it as the delimiter to get a phrase. 

 : LEXEME             
    BL WORD ( addr) DUP C@ 1 =
        IF  CHAR+ C@ WORD  THEN
    COUNT ;
 
FORTH

H# ( "hexnumber" -- n )();
p4:"h-sh";

Get the next word in the input stream as a hex single-number literal. (Adopted from Open Firmware.) 

 : H#  ( "hexnumber" -- n )  \  Simplified for easy porting.
    0 0 BL WORD COUNT                  
    BASE @ >R  HEX  >NUMBER  R> BASE !
        ABORT" Not Hex " 2DROP          ( n)
    STATE @ IF  POSTPONE LITERAL  THEN
    ; IMMEDIATE
 
FORTH
\\ ( "...<eof>" -- )(); 
 ;

Ignore the rest of the input stream. 

 : \\   BEGIN  -1 PARSE  2DROP  REFILL 0= UNTIL ;
 
FORTH

FILE-CHECK ( n -- )();
p4:"file-check";

Check for file access error. 

 \ : FILE-CHECK    ( n -- )  THROW ;
 : FILE-CHECK      ( n -- )  ABORT" File Access Error " ;
 
FORTH

MEMORY-CHECK ( n -- )();
p4:"memory-check";

Check for memory allocation error. 

 \ : MEMORY-CHECK  ( n -- )  THROW ;
 : MEMORY-CHECK    ( n -- )  ABORT" Memory Allocation Error " ;
 
FORTH

++ ( addr -- )();
p4:"plus-plus";

Increment the value at _addr_. 

 : ++  ( addr -- )  1 SWAP +! ;
 
FORTH

@+ ( .. )();
as:"fetch-plus";

ordinary primitive @+

an executable word (no special usage info)

or wrapper call around p4_fetch_plus_plus

FORTH

!+ ( .. )();
as:"store-plus";

ordinary primitive !+

an executable word (no special usage info)

or wrapper call around p4_store_plus_plus

FORTH
'th ( n "addr" -- &addr[n] )(); 
 ;

Address `n CELLS addr +`. 

 : 'th     ( n "addr" -- &addr[n] )
    S" 2 LSHIFT " EVALUATE
    BL WORD COUNT EVALUATE
    S" + " EVALUATE
    ; IMMEDIATE
 
FORTH

(.) ( .. )();
as:"paren-dot";

ordinary primitive (.)

an executable word (no special usage info)

or wrapper call around p4_paren_dot

FORTH

CELL- ( addr -- addr' )();
p4:"cell-minus";

Decrement address by one cell 

 : CELL-  ( addr -- addr' )  CELL - ;
 
FORTH

EMITS ( n char -- )();
p4:"emits";

Emit _char_ _n_ times. 

 : EMITS             ( n char -- )
    SWAP 0 ?DO  DUP EMIT  LOOP DROP ;

also compare 

 : SPACES BL EMITS ;
 : SPACE BL EMIT ;
 
FORTH

HIWORD ( xxyy -- xx )();
p4:"hiword";

The high half of the value. 

 : HIWORD  ( xxyy -- xx )  16 RSHIFT ;
 
FORTH

LOWORD ( xxyy -- yy )();
p4:"loword";

The low half of the value. 

 : LOWORD  ( xxyy -- yy )  65535 AND ;
 
FORTH
REWIND-FILE ( file-id -- ior )(); 
 ;

Rewind the file. 

 : REWIND-FILE       ( file-id -- ior )
    0 0 ROT REPOSITION-FILE ;
 
ENVIRONMENT
TOOLBELT-EXT ( .. )(); 
 ;
( 1999  )  constant TOOLBELT-EXT

an ordinary constant (no special usage info)

Prev Up Next
term wordset Home tools wordset