Hello

Forth

Comus

Some Commonly Used Forth Words

27 April 1999

Compiled by Leo Wong hello@albany.net

Comus explains some common Forth words that aren't in the ANS Forth Standard. The name Comus was suggested by Neil Bawd.

Peter Knaggs maintains a forum for proposing and discussing words that might be added to the Standard: Proposed ANS Forth Extensions.

Forth Interest Group (FIG) Members can see Forth Programming Gems not included in Comus.

In ASCII order:
!+ See @+
#DO
(.)
.'
-ROT
1/F
2+
2-
3DUP
4DUP
?? See ?LEAVE
?LEAVE
@+
@EXECUTE See PERFORM
APPEND
B#
BETWEEN
BOUNDS
BUFFER:
C!+ See @+
C+!
C@+ See @+
CELL
CELL-
CHOOSE See RANDOM
CLEAR
D#
DASM
DEFER
F**2
F-ROT
FNIP
FOR
FPI
FTUCK
H#
HIGH-BIT
INCLUDE
IS
M-
M/
MACRO See #DO
MAX-N
NEXT See FOR
NOOP
NOT
O#
OFF
ON
PARSE-WORD
PERFORM
PLACE
RANDOM
RANDOMIZE See RANDOM
RND See RANDOM
S>F
SCAN
SKIP
STRING,
T*
T/
TH
UNDER+
VOCABULARY
[DEFINED]
[UNDEFINED]

Sources:
ANS ANS Forth Standard document
CMF cmForth
FPH Forth Programmer's Handbook
JVN Julian V. Noble jvn@virginia.edu
OF Open Firmware
SF Starting Forth, by Leo Brodie (FIG, Reprint of 2nd Edition [1987])
TF Thinking Forth, by Leo Brodie (FIG, Reprint Edition, 1994)

Comments by Wil Baden neilbawd@earthlink.net:
FTI From Time Immemorial
Incorrigible Can't be defined in Standard Forth
NFPC Not For Portable Code - unless built in, it slows execution


Comus:

#DO ( n|u -- )
Short for: 0 ?DO.

\ Wil Baden implements #DO with MACRO
: MACRO  ( "name <char> ccc<char>" -- )
   : CHAR PARSE  POSTPONE SLITERAL  POSTPONE EVALUATE
   POSTPONE ; IMMEDIATE
;

MACRO #DO " 0 ?DO"

\ This gives the same result:
: #DO  ( n|u -- )  S" 0 ?DO" EVALUATE ; IMMEDIATE

\ Yet another implementation:
0 CONSTANT 0
: #DO  ( n|u -- )  POSTPONE 0  POSTPONE ?DO ; IMMEDIATE

(.) ( n -- str len ) OF
Convert n into the string specified by str len. Baden: FTI.

\ Implementation by Wil Baden
: (.)  ( n -- str len )
   BASE @ 10 = IF DUP ABS ELSE 0 SWAP THEN
   0 <# #S ROT SIGN #> ;

.' ( addr -- ) FPH
"Return [display] the name of the nearest definition before addr, and the offset of addr within that definition." Baden: Incorrigible.

-ROT ( x1 x2 x3 -- x3 x1 x2 )
Rotate top stack item below the next two items. Baden: NFPC.

: -ROT  ( x1 x2 x3 -- x3 x1 x2 )  ROT ROT ;

1/F ( F: r1 -- r2 ) JVN
r2 is 1.0 divided by r1.

: 1/F   ( F: r1 -- r2 )  1.e0  FSWAP  F/  ;

2+ ( n1|u1 -- n2|u2 )
Add two (2) to n1|u1 giving the sum n2|u2.

: 2+  ( n1|u1 -- n2|u2 )  2 + ;

2- ( n1|u1 -- n2|u2 )
Subtract two (2) from n1|u1 giving the difference n2|u2.

: 2-  ( n1|u1 -- n2|u2 )  2 - ;

3DUP ( x1 x2 x3 -- x1 x2 x3 x1 x2 x3 )
Duplicate cell trio x1 x2 x3.

: 3DUP  ( x1 x2 x3 -- x1 x2 x3 x1 x2 x3 )  DUP 2OVER ROT ;
\ Or:
: 3DUP  ( x1 x2 x3 -- x1 x2 x3 x1 x2 x3 )
   2 PICK 2 PICK 2 PICK ;

4DUP ( x1 x2 x3 x4 -- x1 x2 x3 x4 x1 x2 x3 x4 )
Duplicate cell quartet x1 x2 x3 x4.

: 4DUP  ( x1 x2 x3 -- x1 x2 x3 x1 x2 x3 )  2OVER 2OVER ;

?LEAVE ( flag -- ) OF
If x is nonzero, continue execution immediately following the innermost DO (or ?DO) ... LOOP (or +LOOP). Baden: Some users also have ?EXIT ?QUIT ?STOP etc., and their complements. Rather than adding all of these Baden uses

?? LEAVE  ?? EXIT  ?? QUIT  ?? STOP  0= ?? EXIT
and for any other single word,
?? CR  ?? NEGATE  ?? RECURSE
etc. The presentation of ?? at FORML in 1986 was the first appearance of Neil Bawd.
: ??  S" IF" EVALUATE
      BL WORD COUNT EVALUATE
      S" THEN" EVALUATE
; IMMEDIATE
: TRIES  ( u -- )
   #DO  I DUP 1+ .  2 U< NOT ?? LEAVE  LOOP
   ." No more than three." ;
 0 TRIES
 3 TRIES
10 TRIES

@+ ( a-addr1 -- a-addr2 x )
x is the value stored at a-addr1; a-addr2 is the next aligned address after a-addr1. Baden: Although @+ is an ugly name, it is well established. If you have a use for it, you may want the others:!+ C@+ C!+.

: @+  ( a-addr1 -- a-addr2 x )  DUP CELL+  SWAP @ ;

\ !+ expects: addr1 x
: !+  ( addr1 x -- addr2 )  OVER !  CELL+ ;

\ Same as COUNT
: C@+  ( c-addr1 -- c-addr2 c )  DUP CHAR+  SWAP C@ ;

\ C!+ expects: c-addr1 c
: C!+  ( c-addr1 c -- c-addr2 )  OVER C!  CHAR+ ;

CREATE COMBINATION  3 CELLS ALLOT
COMBINATION  16 !+  33 !+  8 !
COMBINATION  @+ . @+ . @ .

APPEND ( c-addr1 u c-addr2 -- )
Append string specified by c-addr1 u to counted string specified by c-addr2.

: APPEND  ( c-addr len counted-string -- )
   2DUP 2>R  COUNT CHARS +  SWAP CHARS MOVE  2R> C+! ;

B# number OF
Assume that number is binary and convert it to a number. If interpreting, push the number on the stack; if compiling, compile the number as a literal. Do not change the contents of BASE. Compare D#, H#, O#. Usage example: #H. Some Forths support: %number.

BETWEEN ( n min max -- flag ) OF
Return true flag if min<=n<=max, else return false flag.

: BETWEEN  ( n min max - flag )  1+ WITHIN ;
10 1 10 BETWEEN .

BOUNDS ( start cnt -- start+cnt start ) OF
"Convert a starting value and count into the form required for a DO or ?DO loop. For example, to perform as loop 20 times counting up from 4000 to 401F inclusive use: 4000 20 BOUNDS DO ... LOOP." Discussed in TF as RANGE.

: BOUNDS  ( n1|u1 n2|u2 -- n3|u3 n1|u1 )  OVER + SWAP ;

BUFFER: name ( +n -- ) OF
Reserve +n address units of data space beginning at the aligned address to be returned by name.

: BUFFER:  \ <name> ( +n -- )  CREATE ALLOT ;
50 CELLS BUFFER: MONKS

C+! ( n c-addr -- )
Add n to the character-size value at c-addr.

: C+!  ( n c-addr -- )  DUP >R C@ + R> C! ;
\ Or:
: C+!  ( n c-addr -- )  DUP C@ UNDER+ C! ;

CELL ( -- +n )
Number of address units in 1 CELL. Also seen as /CELL along with /CHAR.

1 CELLS CONSTANT CELL

CELL- ( a-addr1 -- a-addr2 ) JVN
Subtract the size in address units of a cell from a-addr1, giving a-addr2.

: CELL-  ( a-addr1 -- a-addr2 )  CELL - ; 

CLEAR ( i*x -- ) OF
Empty the stack.

: CLEAR  ( i*x -- )  DEPTH 0 ?DO DROP LOOP ;

Baden:

CLEAR has also been used to clear the screen, clear a variable or structure, and other similar uses. It's use is almost certain to cause confusion to someone. Save it for a temporary debug.

The oldest debug tool I use is .. .

: ..  ( i*x -- )
   DEPTH IF  .S  DEPTH 0 DO DROP LOOP  THEN ;

This is the only way I would ever clear the stack.

D# number OF
Assume that number is decimal and convert it to a number. If interpreting, push the number on the stack; if compiling, compile the number as a literal. Do not change the contents of BASE. Compare B#, H#, O#. Usage example: #H. Some Forths support: #number.

DASM ( addr -- ) FPH
"Begin disassembly at the address addr on top of the stack. The disassembler stops when it encounters an unconditional transfer of control outside the range of the definition, such as returns from interrupt or from subroutines, branches, and jumps. Subroutine calls are excluded, as control is assumed to return to the location following the call." Baden: Incorrigible.

DEFER name ( -- )
Create the word name whose behavior will be determined later and may be varied. See IS.

F**2 ( F: r1 -- r2 ) JVN
r2 is the square of r1. Also called F^2.

: F**2  ( F: r1 -- r2 )  FDUP  F* ;

F-ROT ( F: r1 r2 r3 -- r3 r1 r2 ) JVN
Rotate the top floating-point stack item below the next two floating-point stack items.

: F-ROT  ( F: r1 r2 r3 -- r3 r1 r2 )   FROT  FROT  ; 

FNIP ( F: r1 r2 -- r2 ) JVN
Drop r1.

: FNIP  ( F: r1 r2 -- r2 )  FSWAP  FDROP  ;

FOR ( n -- ) CMF

Start of a FOR ... NEXT loop. The loop iterates n (Pygmy Forth, Quartus, Timbre, botForth, Mops) or n+1 (cmForth, eForth, Gforth, iForth, F-PC) times. eForth and F-PC have AFT for jumping to THEN the first time through.

FPI ( F: -- r1 ) JVN
r1 is a floating-point approximation of pi.

3.1415926535897932385E0 FCONSTANT FPI

FTUCK ( F: r1 r2 -- r2 r1 r2 ) JVN
Copy the top floating-point stack item below the second floating-point stack item.

: FTUCK  ( F: r1 r2 -- r2 r1 r2 )  FSWAP  FOVER ;

H# number OF
Assume that number is hexadecimal and convert it to a number. If interpreting, push the number on the stack; if compiling, compile the number as a literal. Do not change the contents of BASE. Compare B#, D#, O#. Some Forths support: $number, 0xnumber, numberh.

100 .  B# 100 .  O# 100 .  D# 100 .  H# 100 .  100 .

HIGH-BIT ( -- mask ) ANS
Return a bit mask with only the most-significant bit set. Also called HI-BIT.

\ Implementation by Wil Baden
TRUE 1 RSHIFT INVERT CONSTANT HIGH-BIT

INCLUDE filename ( -- ) FPH
Same as ANS INCLUDE-FILE, except the file is specified by filename. Baden: A preferred suffix for Forth source files may be appended. The path to a master directory may be prepended.

IS name ( xt -- )
Give the behavior identified by xt to the DEFER word name. In some systems, IS is used with VALUE words and DEFER words. In some systems, TO is used with VALUE words and DEFER words.

DEFER display
: signed  ( -- )  ['] . IS display ;
signed  -1 display  -2 display
: unsigned  ( -- )  ['] U. IS display ;
unsigned  -1 display  -2 display

M- ( d1|ud1 n -- d2|ud2 ) FPH
Subtract n from d1|u1, giving the difference d2|ud2.

: M-  ( d1|u1 n -- d2|ud2 )  NEGATE M+ ;

M/ ( d n1 -- n2 ) FPH
Divide d by n1, giving the signed quotient n2.

/ For floored quotient:
: M/  ( d n1 -- n2 )  FM/MOD NIP ;
/ For symmetric quotient:
: M/  ( d n1 -- n2 )  SM/REM NIP ;

MAX-N ( -- +n ) ANS
Return largest usable signed integer.

TRUE 1 RSHIFT CONSTANT MAX-N

NOOP ( -- )
Do nothing. Baden: FTI.

: NOOP ;

NOT ( x|x1 -- flag|x2 )
Some systems: 0= ( x -- flag ), others: INVERT ( x1 -- x2 ). Baden: The traditional meaning was 0=. Forth-83 made it INVERT. FPH retains 0=. 0= is the only meaning that makes sense with native or optimized object code.

: NOT?  ( -- )
   ." NOT: " 1 NOT IF ." INVERT" ELSE ." 0=" THEN ;

O# number OF
Assume that number is octal and convert it to a number. If interpreting, push the number on the stack; if compiling, compile the number as a literal. Do not change the contents of BASE. Compare B#, D#, H#. Usage example: #H. Some Forths support: @number.

OFF ( a-addr -- )
Store false flag at a-addr. May have a different but related action in a particular application. Opposite of ON.

: OFF  ( a-addr -- )  FALSE SWAP ! ;

ON ( a-addr -- )
Store true flag at a-addr. May have a different but related action in a particular application. Opposite of OFF.

: ON  ( a-addr -- )  TRUE SWAP ! ;

PARSE-WORD name ( -- c-addr u) ANS

"Skip leading spaces and parse name delimited by a space. c-addr is the address within the input buffer and u is the length of the selected string. If the parse area is empty, the resulting string has a zero length. If both PARSE and PARSE-WORD are present, the need for WORD is largely eliminated."

PERFORM ( i*x a-addr -- j*x )
EXECUTE the word whose execution token is stored at a-addr. Other stack effects are due to the word EXECUTEd. Baden: NFPC. Classical Forth has @EXECUTE as a primitive. Contents of zero is a noop. This is very useful for execution tables.

: PERFORM  ( i*x a-addr -- j*x )  @ EXECUTE ;

PLACE ( c-addr1 u c-addr2 -- )
Store the character string specified by c-addr1 u as a counted string in data space beginning at c-addr-2. See also STRING,.

: PLACE  ( c-addr1 u c-addr2 -- )
   2DUP >R >R CHAR+ SWAP CHARS MOVE R> R> C! ;

RANDOM ( -- u ) SF
Return a random integer.

\ Baden: these implementations aren't for serious work
VARIABLE RND  \ Holds current result
HERE RND !    \ Possible initialization
\ 16-bit Starting Forth version
: RANDOM  ( -- u ) RND @  31421 *  6927 +  DUP RND ! ;
\ Wil Baden's 32-bit version
: RANDOM  ( -- u ) RND @  3141592621 *  1+ DUP RND ! ;
\ Return a random integer between 0 and u-1
: CHOOSE  ( u -- 0...u-1 ) RANDOM UM* NIP ;
\ Another way of initializing
: RANDOMIZE  ( -- )  TIME&DATE 5 0 DO 65599 * + LOOP  RND ! ;

S>F ( n -- ) ( F: -- r ) JVN
r is the floating-point equivalent of n.

: S>F  ( n -- ) ( F: -- r )   S>D  D>F ;

SCAN ( c-addr1 u1 char -- c-addr2 u2 )
c-addr2 u2 is string c-addr1 u1 from first instance, if any, of char. Contrast SKIP.

: SCAN  ( c-addr u1 char -- c-addr2 u2 )
   >R
   BEGIN DUP WHILE OVER C@ R@ <> WHILE 1 /STRING REPEAT THEN
   R> DROP ;
\ From string c-addr1 u1
\ return first "word" c-addr3 u3
\ and remaining string c-addr2 u2
: word>  ( c-addr1 u2 -- c-addr2 u2 c-addr3 u3 )
   BL SKIP 2DUP 2>R BL SCAN DUP 2R> ROT - ;

SKIP ( c-addr1 u1 char -- c-addr2 u2 ) c-addr2 u2 is string c-addr1 u1 beyond any leading instances of char. Contrast SCAN.

: SKIP  ( c-addr1 u1 char -- c-addr2 u2 )
   >R
   BEGIN DUP WHILE OVER C@ R@ = WHILE 1 /STRING REPEAT THEN
   R> DROP ;
\ Skip leading spaces
: -leading  ( c-addr1 u1 -- c-addr2 u2 )
   BL SKIP ;

STRING, ( c-addr u -- )
Reserve space for and store a string.

: STRING,  ( c-addr u -- )
   HERE  OVER 1+ CHARS ALLOT PLACE ;

T* ( d n -- t ) FPH
"Multiply d by n, yielding the triple-precision result t. Used in [ANS] M*/."

: M*/  ( d1 n1 +n2 -- d2 )  >R  T*  R> T/ ;

T/ ( t +n -- d ) FPH
"Divide the triple-precision number t by the positive number +n, leaving a double-precision result d. Used in [ANS] M*/."

TH ( a-addr1 n -- a-addr2 ) TF
Add n CELLS (typically) to a-addr1, giving a-addr2.

: TH  ( a-addr1 n -- a-addr2 ) CELLS + ;
CREATE language 1001 CELLS ALLOT
TRUE language 4 TH !

UNDER+ ( n1|u1 x n2|u2 -- n3|u3 x ) TF
Add n2|u2 to n1|u1, giving the sum n3|u3. Called +UNDER in Pygmy Forth. PFE gives different semantics.

: UNDER+  ( n1|u1 x n2|u2 -- n3|u3 x ) ROT + SWAP ;
\ Count spaces in a string
: #spaces  ( c-addr u -- +n )
   0 ROT ROT  0 ?DO  COUNT BL = 1 AND UNDER+  LOOP  DROP ;

VOCABULARY name ( -- ) FPH
"Create a word list name. Subsequent execution of name replaces the first word list in the search order with name. When name becomes the complilation word list, new definitions will be appended in name's list."

[DEFINED] name ( -- flag ) FPH
Search the dictionary for name. If found, return true flag, else return false flag.

: [DEFINED]  \ <name>  ( -- flag )
   BL WORD FIND NIP 0<> ; IMMEDIATE

[UNDEFINED] name ( -- flag ) FPH
Search the dictionary for name. If found, return false flag, else return true flag.

: [UNDEFINED]  \ <name>  ( -- flag )
   BL WORD FIND NIP 0= ; IMMEDIATE

Back to ASCII list.

Leo Wong hello@albany.net

Forth

Hello