forth_usual forth_83 misc

"Usual Forth extensions"

forth_usual FORTH
* the value for BackSpace to be used with EMIT - compare with BL
#BACKSPACE-CHAR

[] no special info, see general notes

FORTH/BASE forth_usual ordinary constant

* C+! ( n addr -- )

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

FORTH/BASE forth_usual ordinary primitive

* 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

FORTH/BASE forth_usual ordinary primitive

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

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

FORTH/BASE forth_usual ordinary primitive

OFF!

[] no special info, see general notes

FORTH/BASE forth_usual ordinary primitive

* ON! ( addr -- )

Store -1 at _addr_. Defined in f83 as ON. See antonym OFF!. 
  : ON!  ( addr -- )  -1 SWAP ! ;

FORTH/BASE forth_usual ordinary primitive

* OFF ( addr -- )

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

FORTH/BASE forth_usual forthword synonym

* ON ( addr -- )

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

FORTH/BASE forth_usual forthword synonym

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

FORTH/BASE forth_usual ordinary primitive

* +PLACE ( str len add2 -- )

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

FORTH/BASE forth_usual ordinary primitive

* C+PLACE ( char addr -- )

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

FORTH/BASE forth_usual ordinary primitive

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

FORTH/BASE forth_usual forthword synonym

* APPEND-CHAR ( char addr -- )

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

FORTH/BASE forth_usual forthword synonym

* @EXECUTE ( xt -- ? )

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 ;

FORTH/BASE forth_usual ordinary primitive

* ?LEAVE ( cond -- )

leave a (innermost) loop if condition is true

FORTH/BASE forth_usual compiling primitive

* NOOP ( -- )

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

FORTH/BASE forth_usual ordinary primitive

* RP@ ( -- addr )

returns the return stack pointer 
 example:
   : R@ RP@ @ ;

FORTH/BASE forth_usual compiling primitive

* RP! ( addr -- )

sets the return stack pointer, reverse of RP@

FORTH/BASE forth_usual ordinary primitive

* SP! ( ... addr -- )

sets the stack pointer, reverse of SP@

FORTH/BASE forth_usual ordinary primitive

* -ROT ( a b c -- c a b )

inverse of ROT

FORTH/BASE forth_usual ordinary primitive

* CSET ( n addr -- )

set bits in byte at given address 
 simulate:
   : CSET  TUCK @ SWAP OR SWAP ! ;

FORTH/BASE forth_usual ordinary primitive

* CRESET ( n addr -- )

reset bits in byte at given address 
 simulate:
   : CRESET  TUCK @ SWAP NOT AND SWAP ! ;

FORTH/BASE forth_usual ordinary primitive

* CTOGGLE ( n addr -- )

toggle bits in byte at given address 
 simulate:
   : CTOGGLE  TUCK @ SWAP XOR SWAP ! ;

FORTH/BASE forth_usual ordinary primitive

* TOGGLE ( c-addr charmask -- )

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 ;

FORTH/BASE forth_usual ordinary primitive

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

FORTH/BASE forth_usual ordinary primitive

* 3DROP ( x y z -- )

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

FORTH/BASE forth_usual ordinary primitive

* 4DUP ( a b c d -- a b c d a b c d )
 simulate:
  : 4DUP  4 PICK 4 PICK 4 PICK 4 PICK ;

FORTH/BASE forth_usual ordinary primitive

* 4DROP ( x y z -- )

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

FORTH/BASE forth_usual ordinary primitive

* TOUPPER ( c1 -- c2 )

convert a single character to upper case 
   : TOUPPER  >R _toupper ;

FORTH/BASE forth_usual ordinary primitive

* UPPER ( addr cnt -- )

convert string to upper case 
 simulate:
   : UPPER  0 DO  DUP I +  DUP C@ UPC SWAP C!  LOOP  DROP ;

FORTH/BASE forth_usual ordinary primitive

* LOWER ( addr cnt -- )

convert string to lower case
This is not in LP's F83 but provided for symmetry 
 simulate:
   : LOWER  0 DO  DUP I +  DUP C@ >R _tolower SWAP C!  LOOP  DROP ;

FORTH/BASE forth_usual ordinary primitive

* ASCII ( [word] -- val )

state smart version of CHAR or [CHAR] resp. 
 simulate:
   : ASCII  [COMPILE] [CHAR] 
            STATE @ IF [COMPILE] LITERAL THEN ;

FORTH/BASE forth_usual compiling primitive

* CONTROL ( [word] -- val )

see ASCII, but returns char - '@' 
 simulate:
   : CONTROL  [COMPILE] [CHAR]  [CHAR] @ -  
              STATE @ IF [COMPILE] LITERAL THEN ;

FORTH/BASE forth_usual compiling primitive

* NUMBER? ( addr -- d flag )

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 .

FORTH/BASE forth_usual ordinary primitive

* VOCS ( -- )

list all vocabularies in the system 
 simulate:
   : VOCS VOC-LINK @ BEGIN DUP WHILE
                           DUP ->WORDLIST.NAME @ ID.
                           ->WORDLIST.LINK @
                     REPEAT DROP ;

FORTH/BASE forth_usual ordinary primitive

* EMITS ( n char -- )

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

FORTH/BASE forth_usual ordinary primitive

* FILE-CHECK ( n -- )

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

FORTH/BASE forth_usual ordinary primitive

* MEMORY-CHECK ( n -- )

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

FORTH/BASE forth_usual ordinary primitive

* ++ ( addr -- )

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

FORTH/BASE forth_usual ordinary primitive

* @++ ( addr -- addr' x )

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

FORTH/BASE forth_usual ordinary primitive

* !++ ( addr x -- addr' )

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

FORTH/BASE forth_usual ordinary primitive

* @+ ( addr -- addr' x )

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

FORTH/BASE forth_usual forthword synonym

* !+ ( addr x -- addr' )

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

FORTH/BASE forth_usual forthword synonym

ENDIF

[] no special info, see general notes

FORTH/BASE forth_usual immediate synonym

EXTENSIONS
* >WORDLIST ( xt -- wordl* )

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

EXTENSIONS forth_usual ordinary primitive

PERFORM

[] no special info, see general notes

EXTENSIONS forth_usual obsolete forthword

UPC

[] no special info, see general notes

EXTENSIONS forth_usual obsolete forthword