pfe-toolbelt-ext
Prev? | pfe Forth Wordset List | ?Next

## Name

pfe-toolbelt-ext ? TOOLBELT - Neil Bawd's common extensions

## Synopsis

`[DEFINED] ( "name" -- flag ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`[UNDEFINED] ( "name" -- flag ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`NOT ( x -- flag ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`C+! ( n addr -- ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`EMPTY ( -- ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`VOCABULARY ( "name" -- ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`BOUNDS ( str len -- str+len str ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`OFF ( addr -- ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`ON ( addr -- ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`APPEND ( str len add2 -- ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`APPEND-CHAR ( char addr -- ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`PLACE ( str len addr -- ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`STRING, ( str len -- ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`," ( "&lt;ccc&gt;&lt;quote&gt;" -- ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`THIRD ( x y z -- x y z x ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`FOURTH ( w x y z -- w x y z w ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`3DUP ( x y z -- x y z x y z ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`3DROP ( x y z -- ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`2NIP ( w x y z -- y z ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`R'@ ( R: a b -- a R: a b ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`ANDIF ( p ... -- flag ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`ORIF ( p ... -- flag ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`SCAN ( str len char -- str+i len-i ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`SKIP ( str len char -- str+i len-i ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`BACK ( str len char -- str len-i ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`/SPLIT ( a m a+i m-i -- a+i m-i a i ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`IS-WHITE ( char -- flag ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`TRIM ( str len -- str len-i ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`BL-SCAN ( str len -- str+i len-i ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`BL-SKIP ( str len -- str+i len-i ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`STARTS? ( str len pattern len2 -- str len flag ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`ENDS? ( str len pattern len2 -- str len flag ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`IS-DIGIT ( char -- flag ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`IS-ALPHA ( char -- flag ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`IS-ALNUM ( char -- flag ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`SPLIT-NEXT-LINE ( src . -- src' . str len ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`VIEW-NEXT-LINE ( src . str len -- src . str len str2 len2 ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`NEXT-WORD ( -- str len ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`LEXEME ( "name" -- str len ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`H# ( "hexnumber" -- n ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`\\ ( "...&lt;eof&gt;" -- ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`FILE-CHECK ( n -- ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`MEMORY-CHECK ( n -- ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`++ ( addr -- ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`@+ ( addr -- addr' x ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`!+ ( addr x -- addr' ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`'th ( n "addr" -- &amp;addr[n] ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`(.) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`CELL- ( addr -- addr' ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`EMITS ( n char -- ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`HIWORD ( xxyy -- xx ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`LOWORD ( xxyy -- yy ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

`REWIND-FILE ( file-id -- ior ) ?=>? (` | `)`; | ?

`[FORTH]`;
?

## Description

[DEFINED] ( "name" -- flag ) => [FORTH]

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

[UNDEFINED] ( "name" -- flag ) => [FORTH]

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

see `[DEFINED]`

NOT ( x -- flag ) => [FORTH]

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.

C+! ( n addr -- ) => [FORTH]

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

EMPTY ( -- ) => [FORTH]

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

VOCABULARY ( "name" -- ) [FTH] => [FORTH]

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&gt; ( the ((VOCABULARY)) runtime )
               CONTEXT !
        ; IMMEDIATE

BOUNDS ( str len -- str+len str ) => [FORTH]

Convert _str len_ to range for DO-loop.

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

OFF ( addr -- ) => [FORTH]

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

       : OFF  ( addr -- )  0 SWAP ! ;

ON ( addr -- ) => [FORTH]

Store -1 at _addr_. See `OFF`.

       : ON  ( addr -- )  -1 SWAP ! ;

APPEND ( str len add2 -- ) => [FORTH]

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

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

APPEND-CHAR ( char addr -- ) => [FORTH]

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

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

PLACE ( str len addr -- ) => [FORTH]

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

      : PLACE  2DUP 2&gt;R  1+ SWAP  MOVE  2R&gt; C! ;
      : PLACE  2DUP C!   1+ SWAP CMOVE ;

STRING, ( str len -- ) => [FORTH]

Store a string in data space as a counted string.

      : STRING, HERE  OVER 1+  ALLOT  PLACE ;

," ( "&lt;ccc&gt;&lt;quote&gt;" -- ) => [FORTH]

Store a quote-delimited string in data space as a counted string.

      : ," [CHAR] " PARSE  STRING, ; IMMEDIATE

THIRD ( x y z -- x y z x ) => [FORTH]

Copy third element on the stack onto top of stack.

      : THIRD   2 PICK ;

FOURTH ( w x y z -- w x y z w ) => [FORTH]

Copy fourth element on the stack onto top of stack.

      : FOURTH  3 PICK ;

3DUP ( x y z -- x y z x y z ) => [FORTH]

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

      : 3DUP   THIRD THIRD THIRD ;

or

      : 3DUP  3 PICK 3 PICK 3 PICK ;

3DROP ( x y z -- ) => [FORTH]

Drop the top three elements from the stack.

      : 3DROP   DROP 2DROP ;

2NIP ( w x y z -- y z ) => [FORTH]

Drop the third and fourth elements from the stack.

      : 2NIP   2SWAP 2DROP ;

R'@ ( R: a b -- a R: a b ) [FTH] => [FORTH]

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

ANDIF ( p ... -- flag ) => [FORTH]

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

      : ANDIF  S" DUP IF DROP " EVALUATE ; IMMEDIATE

ORIF ( p ... -- flag ) => [FORTH]

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

      : ORIF   S" DUP 0= IF DROP " EVALUATE ; IMMEDIATE

SCAN ( str len char -- str+i len-i ) => [FORTH]

Look for a particular character in the specified string.

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

ie. scan for first occurence of c in string

        : SCAN &gt;R BEGIN DUP OVER C@ R@ = 0= OR WHILE
                         1- SWAP 1- SWAP REPEAT R&gt; DROP ;

SKIP ( str len char -- str+i len-i ) => [FORTH]

Advance past leading characters in the specified string.

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

ie. skip leading characters c

        : SKIP  &gt;R BEGIN DUP OVER C@ R@ = OR WHILE
                         1- SWAP 1- SWAP REPEAT R&gt; DROP ;

BACK ( str len char -- str len-i ) => [FORTH]

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

      : BACK
         &gt;R  BEGIN  DUP WHILE
             1-  2DUP + C@  R@ =
         UNTIL 1+ THEN
         R&gt; DROP ;

/SPLIT ( a m a+i m-i -- a+i m-i a i ) => [FORTH]

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 &gt;R  2SWAP  R&gt; - ;

IS-WHITE ( char -- flag ) => [FORTH]

Test char for white space.

      : IS-WHITE   33 - 0&lt; ;

TRIM ( str len -- str len-i ) => [FORTH]

Trim white space from end of string.

      : TRIM
         BEGIN  DUP WHILE
             1-  2DUP + C@ IS-WHITE NOT
         UNTIL 1+ THEN ;

BL-SCAN ( str len -- str+i len-i ) => [FORTH]

Look for white space from start of string

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

BL-SKIP ( str len -- str+i len-i ) => [FORTH]

Skip over white space at start of string.

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

STARTS? ( str len pattern len2 -- str len flag ) => [FORTH]

Check start of string.

      : STARTS?   DUP &gt;R  2OVER  R&gt; MIN  COMPARE 0= ;

ENDS? ( str len pattern len2 -- str len flag ) => [FORTH]

Check end of string.

      : ENDS?   DUP &gt;R  2OVER  DUP R&gt; - /STRING  COMPARE 0= ;

IS-DIGIT ( char -- flag ) => [FORTH]

Test _char_ for digit [0-9].

      : IS-DIGIT   [CHAR] 0 -  10 U&lt; ;

IS-ALPHA ( char -- flag ) => [FORTH]

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

      : IS-ALPHA  32 OR  [CHAR] a -  26 U&lt; ;

IS-ALNUM ( char -- flag ) => [FORTH]

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

      : IS-ALNUM
         DUP IS-ALPHA  ORIF  DUP IS-DIGIT  THEN  NIP ;

SPLIT-NEXT-LINE ( src . -- src' . str len ) => [FORTH]

Split the next line from the string.

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

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

VIEW-NEXT-LINE ( src . str len -- src . str len str2 len2 ) => [FORTH]

Copy next line above current line.

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

NEXT-WORD ( -- str len ) => [FORTH]

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 ;

LEXEME ( "name" -- str len ) => [FORTH]

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 ;

H# ( "hexnumber" -- n ) => [FORTH]

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 @ &gt;R  HEX  &gt;NUMBER  R&gt; BASE !
             ABORT" Not Hex " 2DROP          ( n)
         STATE @ IF  POSTPONE LITERAL  THEN
         ; IMMEDIATE

\\ ( "...&lt;eof&gt;" -- ) => [FORTH]

Ignore the rest of the input stream.

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

FILE-CHECK ( n -- ) => [FORTH]

Check for file access error.

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

MEMORY-CHECK ( n -- ) => [FORTH]

Check for memory allocation error.

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

++ ( addr -- ) => [FORTH]

Increment the value at _addr_.

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

@+ ( addr -- addr' x ) => [FORTH]

Fetch the value _x_ from _addr_, and increment the address by one cell.

      : @+  ( addr -- addr' x )  DUP CELL+ SWAP  @ ;

!+ ( addr x -- addr' ) => [FORTH]

Store the value _x_ into _addr_, and increment the address by one cell.

      : !+  ( addr x -- addr' )  OVER !  CELL+ ;

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

Address `n CELLS addr +`.

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

(.) - no description, sorry

CELL- ( addr -- addr' ) => [FORTH]

Decrement address by one cell

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

EMITS ( n char -- ) => [FORTH]

Emit _char_ _n_ times.

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

also compare

      : SPACES BL EMITS ;
      : SPACE BL EMIT ;

HIWORD ( xxyy -- xx ) => [FORTH]

The high half of the value.

      : HIWORD  ( xxyy -- xx )  16 RSHIFT ;

LOWORD ( xxyy -- yy ) => [FORTH]

The low half of the value.

      : LOWORD  ( xxyy -- yy )  65535 AND ;

REWIND-FILE ( file-id -- ior ) => [FORTH]

Rewind the file.

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

Prev? | Up | ?Next
pfe-termcatch-ext? | Home | ?pfe-tools-ext