PFE 0.33.71

Homepage
SourceForge
Download
Documentation
-Overview
-The PFE Manual
old manual / (book)
-ChangeLog
-Authors
-License (LGPL)
-Wordsets / (book)
-Functions .. (book)
-Dp of ANS Forth
-The 4thTutor
-Forthprimer.pdf
- Old Wordsets
- Old Words List
Forth Links
* Forth Repository
* Taygeta Compilation
* TinyBoot FirmWare
* FiCL, Free Forth
* Research Vienna
* Research Bournemouth
* zForth WebRing
Other Links
* Tektronix/MPT
* Forth Org. (FIG)
* Forth Inc.
* MPE Ltd. Forths
* SF Win32Forth
* PD Win32Forth
* Neil Bawd

generated
(C) Guido U. Draheim
guidod@gmx.de

## TOOLBELT

> - Neil Bawd's common extensions

`[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

  immediate code = [p4_defined]

`[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]`

  immediate code = [p4_undefined]

`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.

  primitive code = [p4_zero_equal]

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

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

  primitive code = [p4_c_plus_store]

`EMPTY``( -- )``` => `[FORTH]`

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

  primitive code = [p4_empty]

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

  primitive code = [p4_vocabulary]

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

  Convert _str len_ to range for DO-loop.

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

  primitive code = [p4_bounds]

`OFF``( addr -- )``` => `[FORTH]`

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

         : OFF  ( addr -- )  0 SWAP ! ;

  primitive code = [p4_off_store]

`ON``( addr -- )``` => `[FORTH]`

  Store -1 at _addr_. See `OFF`.

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

  primitive code = [p4_on_store]

`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>R  COUNT +  SWAP MOVE ( ) 2R> C+! ;

  primitive code = [p4_append]

`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 >R  COUNT  DUP 1+ R> C!  +  C! ;

  primitive code = [p4_append_char]

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

  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 ;

  primitive code = [p4_place]

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

  Store a string in data space as a counted string.

        : STRING, HERE  OVER 1+  ALLOT  PLACE ;

  primitive code = [p4_parse_comma]

`,"``( "<ccc><quote>" -- )``` => `[FORTH]`

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

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

  immediate code = [p4_parse_comma_quote]

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

  Copy third element on the stack onto top of stack.

        : THIRD   2 PICK ;

  primitive code = [p4_third]

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

  Copy fourth element on the stack onto top of stack.

        : FOURTH  3 PICK ;

  primitive code = [p4_fourth]

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

  primitive code = [p4_three_dup]

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

  Drop the top three elements from the stack.

        : 3DROP   DROP 2DROP ;

  primitive code = [p4_three_drop]

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

  Drop the third and fourth elements from the stack.

        : 2NIP   2SWAP 2DROP ;

  primitive code = [p4_two_nip]

`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"@`)

  primitive code = [p4_r_tick_fetch]

`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

  compiling word = [p4_andif]

`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

  compiling word = [p4_orif]

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

  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 ;

  primitive code = [p4_scan]

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

  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 ;

  primitive code = [p4_skip]

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

  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 ;

  primitive code = [p4_back]

`/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 >R  2SWAP  R> - ;

  primitive code = [p4_div_split]

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

  Test char for white space.

        : IS-WHITE   33 - 0< ;

  primitive code = [p4_is_white]

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

  primitive code = [p4_trim]

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

  primitive code = [p4_bl_scan]

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

  primitive code = [p4_bl_skip]

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

  Check start of string.

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

  primitive code = [p4_starts_Q]

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

  Check end of string.

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

  primitive code = [p4_ends_Q]

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

  Test _char_ for digit [0-9].

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

  primitive code = [p4_is_digit]

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

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

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

  primitive code = [p4_is_alpha]

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

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

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

  primitive code = [p4_is_alnum]

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

  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.

  primitive code = [p4_split_next_line]

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

  primitive code = [p4_view_next_line]

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

  primitive code = [p4_next_word]

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

  primitive code = [p4_lexeme]

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

  immediate code = [p4_h_sh]

`\\``( "...<eof>" -- )``` => `[FORTH]`

  Ignore the rest of the input stream.

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

  primitive code = [p4_backslash_backslash]

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

  Check for file access error.

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

  primitive code = [p4_file_check]

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

  Check for memory allocation error.

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

  primitive code = [p4_memory_check]

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

  Increment the value at _addr_.

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

  primitive code = [p4_plus_plus]

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

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

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

  primitive code = [p4_fetch_plus_plus]

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

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

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

  primitive code = [p4_store_plus_plus]

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

  Address `n CELLS addr +`.

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

  compiling word = [p4_tick_th]

`(.)``` => `[FORTH]`

  (no description)

  primitive code = [p4_paren_dot]

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

  Decrement address by one cell

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

  primitive code = [p4_cell_minus]

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

  primitive code = [p4_emits]

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

  The high half of the value.

        : HIWORD  ( xxyy -- xx )  16 RSHIFT ;

  primitive code = [p4_hiword]

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

  The low half of the value.

        : LOWORD  ( xxyy -- yy )  65535 AND ;

  primitive code = [p4_loword]

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

  Rewind the file.

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

  primitive code = [p4_rewind_file]