PFE 0.33.70

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

Usual

Forth extensions

---

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]

---

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!  => "FORTH"

(no description)

primitive code = [p4_off_store]

---

ON!( addr -- )  => "FORTH"

Store -1 at _addr_. Defined in f83 as ON. See antonym OFF!.

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

primitive code = [p4_on_store]

---

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]

---

+PLACE( str len add2 -- )  => "FORTH"

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+! ;
  

primitive code = [p4_append]

---

C+PLACE( char addr -- )  => "FORTH"

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

primitive code = [p4_append_char]

---

@EXECUTE( xt -- ? )  => "FORTH"

same as @ EXECUTE , but checks for null as xt and silently ignores it. Same as in most forths where defined.

  simulate:
    : @EXECUTE  @ ?DUP IF EXECUTE THEN ;
  

primitive code = [p4_fetch_execute]

---

?LEAVE( cond -- )  => "FORTH"

leave a (innermost) loop if condition is true

compiling word = [p4_question_leave]

---

NOOP( -- )  => "FORTH"

do nothing, used as a place-holder where an execution word is needed

primitive code = [p4_noop]

---

RP@( -- addr )  => "FORTH"

returns the return stack pointer

  example:
    : R@ RP@ @ ;
  

compiling word = [p4_r_p_fetch]

---

RP!( addr -- )  => "FORTH"

sets the return stack pointer, reverse of RP@

primitive code = [p4_r_p_store]

---

SP!( ... addr -- )  => "FORTH"

sets the stack pointer, reverse of SP@

primitive code = [p4_s_p_store]

---

-ROT( a b c -- c a b )  => "FORTH"

inverse of ROT

primitive code = [p4_dash_rot]

---

CSET( n addr -- )  => "FORTH"

set bits in byte at given address

  simulate:
    : CSET  TUCK @ SWAP OR SWAP ! ;
  

primitive code = [p4_c_set]

---

CRESET( n addr -- )  => "FORTH"

reset bits in byte at given address

  simulate:
    : CRESET  TUCK @ SWAP NOT AND SWAP ! ;
  

primitive code = [p4_c_reset]

---

CTOGGLE( n addr -- )  => "FORTH"

toggle bits in byte at given address

  simulate:
    : CTOGGLE  TUCK @ SWAP XOR SWAP ! ;
  

primitive code = [p4_c_toggle]

---

TOGGLE( c-addr charmask -- )  => "FORTH"

toggle the bits given in charmask, see also SMUDGE and = UNSMUDGE

  example: the fig-style SMUDGE had been defined such
    : FIG-SMUDGE LATEST >FFA (SMUDGE#) TOGGLE ;
  

primitive code = [p4_toggle]

---

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]

---

4DUP( a b c d -- a b c d a b c d )  => "FORTH"

 
  simulate:
   : 4DUP  4 PICK 4 PICK 4 PICK 4 PICK ;
  

primitive code = [p4_four_dup]

---

4DROP( x y z -- )  => "FORTH"

Drop the top three elements from the stack.

  : 4DROP   2DROP 2DROP ;
  

primitive code = [p4_four_drop]

---

TOUPPER( c1 -- c2 )  => "FORTH"

convert a single character to upper case

    : TOUPPER  >R _toupper ;
  

primitive code = [p4_toupper]

---

UPPER( addr cnt -- )  => "FORTH"

convert string to upper case

  simulate:
    : UPPER  0 DO  DUP I +  DUP C@ UPC SWAP C!  LOOP  DROP ;
  

primitive code = [p4_upper]

---

LOWER( addr cnt -- )  => "FORTH"

convert string to lower case This is not in L&P's F83 but provided for symmetry

  simulate:
    : LOWER  0 DO  DUP I +  DUP C@ >R _tolower SWAP C!  LOOP  DROP ;
  

primitive code = [p4_lower]

---

ASCII( [word] -- val )  => "FORTH"

state smart version of CHAR or [CHAR] resp.

  simulate:
    : ASCII  [COMPILE] [CHAR] 
             STATE @ IF [COMPILE] LITERAL THEN ;
  

compiling word = [p4_ascii]

---

CONTROL( [word] -- val )  => "FORTH"

see ASCII, but returns char - '@'

  simulate:
    : CONTROL  [COMPILE] [CHAR]  [CHAR] @ -  
               STATE @ IF [COMPILE] LITERAL THEN ;
  

compiling word = [p4_control]

---

NUMBER?( addr -- d flag )  => "FORTH"

convert counted string to number - used in inner interpreter ( INTERPRET ), flags if conversion was successful

  example:
    BL WORD  HERE NUMBER? 0= IF ." not a number " THEN . 
  

primitive code = [p4_number_question]

---

VOCS( -- )  => "FORTH"

list all vocabularies in the system

  simulate:
    : VOCS VOC-LINK @ BEGIN DUP WHILE
                            DUP ->WORDLIST.NAME @ ID.
                            ->WORDLIST.LINK @
                      REPEAT DROP ; 
  

primitive code = [p4_vocs]

---

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]

---

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]

---

>WORDLIST( xt -- wordl* )  => "EXTENSIONS"

convert a VOCABULARY-xt into its wordlist reference (as in win32forth)

primitive code = [p4_to_wordlist]