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];
?
," ( "<ccc><quote>" -- ) ?=>? ();?
[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];
?
\\ ( "...<eof>" -- ) ?=>? ();?
[FORTH];
?
FILE-CHECK ( n -- ) ?=>? ();?
[FORTH];
?
MEMORY-CHECK ( n -- ) ?=>? ();?
[FORTH];
?
++ ( addr -- ) ?=>? ();?
[FORTH];
?
@+ ( addr -- addr' x ) ?=>? ();?
[FORTH];
?
!+ ( addr x -- addr' ) ?=>? ();?
[FORTH];
?
'th ( n "addr" -- &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> ( 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>R  COUNT +  SWAP MOVE ( ) 2R> 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 >R  COUNT  DUP 1+ R> C!  +  C! ;
  

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 ;
  

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

Store a string in data space as a counted string.

  : STRING, HERE  OVER 1+  ALLOT  PLACE ;
  

," ( "<ccc><quote>" -- ) => [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     
     >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 ;
  

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 ;
  

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 ;
  

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

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

Test char for white space.

  : IS-WHITE   33 - 0< ;
  

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 >R  2OVER  R> MIN  COMPARE 0= ;
  

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

Check end of string.

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

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

Test _char_ for digit [0-9].

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

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

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

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

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

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

\\ ( "...<eof>" -- ) => [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" -- &addr[n] ) => [FORTH]

Address `n CELLS addr +`.

  : 'th     ( n "addr" -- &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 ;