"TOOLBELT - Neil Bawd's common extensions"

toolbelt:
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
INTO ("EXTENSIONS", 0 ) ?
* [VOID] ( -- flag )

Immediate FALSE. Used to comment out sections of code.
IMMEDIATE so it can be inside definitions.

toolbelt loader code P4_ICoN

* [DEFINED] ( "name" -- flag )

Search the dictionary for _name_. If _name_ is found,
return TRUE; otherwise return FALSE. Immediate for use in
definitions.
  
[DEFINED] word ( -- nfa|0 ) immediate
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] BL WORD FIND NIP ; IMMEDIATE

toolbelt loader code P4_IXco

* [UNDEFINED] ( "name" -- flag )

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

see [DEFINED]

toolbelt loader code P4_IXco

* NOT ( x -- flag )

Identical to `0=`, used for program clarity to reverse the
result of a previous test.

WARNING: PFE's NOT uses bitwise complement INVERT
instead of the logical complement 0=, so
that loading TOOLBELT will change semantics.
... this difference in semantics has caused dpans94 to
depracate the word. Only if TRUE is -1 it would be identical
but not all words return -1 for true.

toolbelt loader code P4_FXco

* C+! ( n addr -- )

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

toolbelt loader code P4_FXco

* EMPTY ( -- )

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

toolbelt loader code P4_FXco

* VOCABULARY ( 'name' -- )

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

toolbelt loader code P4_FXco

* BOUNDS ( str len -- str+len str )

Convert _str len_ to range for DO-loop.
 : BOUNDS  ( str len -- str+len str )  OVER + SWAP ;

toolbelt loader code P4_FXco

* OFF ( addr -- )

Store 0 at _addr_. See `ON`.
  : OFF  ( addr -- )  0 SWAP ! ;

toolbelt loader code P4_FXco

* ON ( addr -- )

Store -1 at _addr_. See `OFF`.
  : ON  ( addr -- )  -1 SWAP ! ;

toolbelt loader code P4_FXco

* APPEND ( str len add2 -- )

Append string _str len_ to the counted string at _addr_.
AKA `+PLACE`.
 : APPEND   2DUP 2>R  COUNT +  SWAP MOVE ( ) 2R> C+! ;

toolbelt loader code P4_FXco

* APPEND-CHAR ( char addr -- )

Append _char_ to the counted string at _addr_.
 : APPEND-CHAR   DUP >R  COUNT  DUP 1+ R> C!  +  C! ;

toolbelt loader code P4_FXco

* PLACE ( str len addr -- )

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 ;

toolbelt loader code P4_FXco

* STRING, ( str len -- )

Store a string in data space as a counted string.
 : STRING, HERE  OVER 1+  ALLOT  PLACE ;

toolbelt loader code P4_FXco

,"

no special info, see general notes

toolbelt loader code P4_IXco

* THIRD ( x y z -- x y z x )

Copy third element on the stack onto top of stack.
 : THIRD   2 PICK ;

toolbelt loader code P4_FXco

* FOURTH ( w x y z -- w x y z w )

Copy fourth element on the stack onto top of stack.
 : FOURTH  3 PICK ;

toolbelt loader code P4_FXco

* 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 ;

toolbelt loader code P4_FXco

* 3DROP ( x y z -- )

Drop the top three elements from the stack.
 : 3DROP   DROP 2DROP ;

toolbelt loader code P4_FXco

* 2NIP ( w x y z -- y z )

Drop the third and fourth elements from the stack.
 : 2NIP   2SWAP 2DROP ;

toolbelt loader code P4_FXco

* R'@ ( -- x )( R: x y -- x y )

The second element on the return stack.
 : R'@   S" 2R@ DROP " EVALUATE ; IMMEDIATE

toolbelt loader code P4_FXco

* ANDIF ( p ... -- flag )

Given `p ANDIF q THEN`, _q_ will not be performed if
_p_ is false.
 : ANDIF  S" DUP IF DROP " EVALUATE ; IMMEDIATE

toolbelt loader code P4_SXco

* ORIF ( p ... -- flag )

Given `p ORIF q THEN`, _q_ will not be performed if
_p_ is true.
 : ORIF   S" DUP 0= IF DROP " EVALUATE ; IMMEDIATE

toolbelt loader code P4_SXco

* 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 ;

toolbelt loader code P4_FXco

* 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 ;

toolbelt loader code P4_FXco

* 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 ;

toolbelt loader code P4_FXco

* /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> - ;

toolbelt loader code P4_FXco

* IS-WHITE ( char -- flag )

Test char for white space.
 : IS-WHITE   33 - 0< ;

toolbelt loader code P4_FXco

* TRIM ( str len -- str len-i )

Trim white space from end of string.
 : TRIM    
    BEGIN  DUP WHILE
        1-  2DUP + C@ IS-WHITE NOT
    UNTIL 1+ THEN ;

toolbelt loader code P4_FXco

* 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 ;

toolbelt loader code P4_FXco

* 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 ;


toolbelt loader code P4_FXco

* STARTS? ( str len pattern len2 -- str len flag )

Check start of string.
 : STARTS?   DUP >R  2OVER  R> MIN  COMPARE 0= ;

toolbelt loader code P4_FXco

* ENDS? ( str len pattern len2 -- str len flag )

Check end of string.
 : ENDS?   DUP >R  2OVER  DUP R> - /STRING  COMPARE 0= ;

toolbelt loader code P4_FXco

* IS-DIGIT ( char -- flag )

Test _char_ for digit [0-9].
 : IS-DIGIT   [CHAR] 0 -  10 U< ;

toolbelt loader code P4_FXco

* IS-ALPHA ( char -- flag )

Test _char_ for alphabetic [A-Za-z].
 : IS-ALPHA  32 OR  [CHAR] a -  26 U< ;

toolbelt loader code P4_FXco

* IS-ALNUM ( char -- flag )

Test _char_ for alphanumeric [A-Za-z0-9].
 : IS-ALNUM  
    DUP IS-ALPHA  ORIF  DUP IS-DIGIT  THEN  NIP ;

toolbelt loader code P4_FXco

* #BACKSPACE-CHAR ( -- char )

Backspace character.
 8 CONSTANT #BACKSPACE-CHAR

toolbelt loader code P4_OCoN

* #CHARS/LINE ( -- n )

Preferred width of line in source files. Suit yourself.
 62 VALUE    #CHARS/LINE

toolbelt loader code P4_OCoN

* #EOL-CHAR ( -- char )

End-of-line character. 13 for Mac and DOS, 10 for Unix.
 13 CONSTANT #EOL-CHAR

toolbelt loader code P4_OCoN

* #TAB-CHAR ( -- char )

Tab character.
 9 CONSTANT #TAB-CHAR

toolbelt loader code P4_OCoN

* MAX-N ( -- n )

Largest usable signed integer.
 TRUE 1 RSHIFT        CONSTANT MAX-N

toolbelt loader code P4_OCoN

P4_OCoN ("SIGN-BIT", (1 << (sizeof(p4cell)-1))),
* CELL ( -- n )

Address units (i.e. bytes) in a cell.
 1 CELLS CONSTANT CELL

toolbelt loader code P4_OCoN

P4_OCoN ("-CELL", - sizeof(p4cell)),
* 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.

toolbelt loader code P4_FXco

* 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 - ;

toolbelt loader code P4_FXco

* OUT ( -- addr )

Promiscuous variable.
 VARIABLE OUT

toolbelt loader code P4_DVaR

* NEXT-WORD ( -- str len )

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 ;  

toolbelt loader code P4_FXco

* LEXEME ( "name" -- str len )

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 ;

toolbelt loader code P4_FXco

* H# ( "hexnumber" -- n )

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

toolbelt loader code P4_IXco

* \\ ( "..." -- )

Ignore the rest of the input stream.
 : \\   BEGIN  -1 PARSE  2DROP  REFILL 0= UNTIL ;

toolbelt loader code P4_FXco

* FILE-CHECK ( n -- )

Check for file access error.
 \ : FILE-CHECK    ( n -- )  THROW ;
 : FILE-CHECK      ( n -- )  ABORT" File Access Error " ;

toolbelt loader code P4_FXco

* MEMORY-CHECK ( n -- )

Check for memory allocation error.
 \ : MEMORY-CHECK  ( n -- )  THROW ;
 : MEMORY-CHECK    ( n -- )  ABORT" Memory Allocation Error " ;

toolbelt loader code P4_FXco

* ++ ( addr -- )

Increment the value at _addr_.
 : ++  ( addr -- )  1 SWAP +! ;

toolbelt loader code P4_FXco

* @+ ( addr -- addr' x )

Fetch the value _x_ from _addr_, and increment the address
by one cell.
 : @+  ( addr -- addr' x )  DUP CELL+ SWAP  @ ;

toolbelt loader code P4_FXco

* !+ ( addr x -- addr' )

Store the value _x_ into _addr_, and increment the address
by one cell.
 : !+  ( addr x -- addr' )  OVER !  CELL+ ;

toolbelt loader code P4_FXco

'th

no special info, see general notes

toolbelt loader code P4_SXco

* (.) ( n -- addr u )

Convert _n_ to characters, without punctuation, as for `.`
(dot), returning the address and length of the resulting
string.
 : (.)  ( n -- addr u )  DUP ABS 0 <# #S ROT SIGN #> ;

toolbelt loader code P4_FXco

* CELL- ( addr -- addr' )

Decrement address by one cell
 : CELL-  ( addr -- addr' )  CELL - ;

toolbelt loader code P4_FXco

* EMITS ( n char -- )

Emit _char_ _n_ times.
 : EMITS             ( n char -- )
    SWAP 0 ?DO  DUP EMIT  LOOP DROP ;

toolbelt loader code P4_FXco

* HIWORD ( xxyy -- xx )

The high half of the value.
 : HIWORD  ( xxyy -- xx )  16 RSHIFT ;

toolbelt loader code P4_FXco

* LOWORD ( xxyy -- yy )

The low half of the value.
 : LOWORD  ( xxyy -- yy )  65535 AND ;

toolbelt loader code P4_FXco

* REWIND-FILE ( file-id -- ior )

Rewind the file.
 : REWIND-FILE       ( file-id -- ior )
    0 0 ROT REPOSITION-FILE ;

toolbelt loader code P4_FXco

ENVIRONMENT ENVIRONMENT TOOLBELT-EXT

no special info, see general notes

toolbelt ordinary constant