Google

FORTH-83-L&P Laxen&Perry extensions

There are lots of useful words in F83 that do not appear in any standard. This wordset defines some of them.

BS  
constant
the value for BackSpace to be used with EMIT - compare with BL

reference: '\b' in ../src/lpf83.c:0407, export OC BS

BOUNDS ( a b -- b+a a )   

 simulate:
   : BOUNDS  OVER + SWAP ;

reference: p4_bounds in ../src/lpf83.c:0040, export CO BOUNDS

PERFORM ( addr -- ? )   

  simulate:
    : PERFORM  @ EXECUTE

reference: p4_perform in ../src/lpf83.c:0052, export CO PERFORM

?LEAVE ( cond -- )  

leave a (innermost) loop if condition is true

reference: p4_question_leave in ../src/lpf83.c:0060, export CO ?LEAVE

NOOP ( -- )  

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

reference: p4_noop in ../src/lpf83.c:0074, export CO NOOP

RP@ ( -- addr )  

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

reference: p4_r_p_fetch in ../src/lpf83.c:0083, export CO RP@

RP! ( addr -- )  

sets the return stack pointer, reverse of RP@

reference: p4_r_p_store in ../src/lpf83.c:0091, export CO RP!

SP! ( ... addr -- )  

sets the stack pointer, reverse of SP@

reference: p4_s_p_store in ../src/lpf83.c:0099, export CO SP!

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

inverse of ROT

reference: p4_dash_rot in ../src/lpf83.c:0107, export CO -ROT

CSET ( n addr -- )  

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

reference: p4_c_set in ../src/lpf83.c:0121, export CO CSET

CRESET ( n addr -- )  

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

reference: p4_c_reset in ../src/lpf83.c:0132, export CO CRESET

CTOGGLE ( n addr -- )  

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

reference: p4_c_toggle in ../src/lpf83.c:0143, export CO CTOGGLE

OFF ( addr -- )   

 simulate:
   : OFF  FALSE SWAP ! ;

reference: p4_off in ../src/lpf83.c:0153, export CO OFF

ON ( addr -- )  

simulate: 
   : ON  TRUE SWAP ! ;

reference: p4_on in ../src/lpf83.c:0162, export CO ON

3DUP ( a b c -- a b c a b c )   

 simulate:
   : 3DUP  3 PICK 3 PICK 3 PICK ;

reference: p4_three_dup in ../src/lpf83.c:0171, export CO 3DUP

4DUP ( a b c d -- a b c d a b c d )   

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

reference: p4_four_dup in ../src/lpf83.c:0183, export CO 4DUP

UPC ( c1 -- c2 )  

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

reference: p4_upc in ../src/lpf83.c:0196, export CO UPC

UPPER ( addr cnt -- )  

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

reference: p4_upper in ../src/lpf83.c:0206, export CO UPPER

LOWER ( addr cnt -- )  

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 ;

reference: p4_lower in ../src/lpf83.c:0218, export CO LOWER

SKIP ( addr cnt c -- addr' cnt' )  

skip leading characters c 
 simulate:
   : SKIP  >R BEGIN DUP OVER C@ R@ = OR WHILE 
                    1- SWAP 1- SWAP REPEAT R> DROP ;

reference: p4_skip in ../src/lpf83.c:0230, export CO SKIP

SCAN ( addr cnt c -- addr' cnt' )  

scan for first occurence of c in string 
 simulate:
   : SCAN >R BEGIN DUP OVER C@ R@ = 0= OR WHILE 
                    1- SWAP 1- SWAP REPEAT R> DROP ;

reference: p4_scan in ../src/lpf83.c:0248, export CO SCAN

PLACE ( addr1 len addr2 -- )  

store string addr1/len at addr2 
 simulate:
   : PLACE  2DUP C! 1+ SWAP CMOVE ;

reference: p4_place in ../src/lpf83.c:0265, export CO PLACE

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

reference: p4_ascii in ../src/lpf83.c:0280, export CS ASCII

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

reference: p4_control in ../src/lpf83.c:0306, export CS CONTROL

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 .

reference: p4_number_question in ../src/lpf83.c:0336, export CO NUMBER?

VOCS ( -- )  

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

reference: p4_vocs in ../src/lpf83.c:0356, export CO VOCS

DEFER word ( -- )  

create a new word with ((DEFER))-semantics 
 simulate:
   : DEFER  CREATE 0, DOES> ( the ((DEFER)) runtime ) 
      @ ?DUP IF EXECUTE THEN ;
declare as "DEFER deferword"
and set as "['] executionword TO deferword"

reference: p4_defer in ../src/lpf83.c:0386, export CO DEFER

>EXECUTE ( xt -- ? )  

same as EXECUTE , but checks for null as xt argument 
 simulate:
   : >EXECUTE  ?DUP IF EXECUTE THEN ;

reference: p4_to_execute in ../src/lpf83.c:0397, export CO >EXECUTE