Last revised 15 February 2000
. means display. means display
. is pronounced "dot".
. displays a number as an integer.
In Forth, most of what look like punctuation or other symbols are words ( = routines = procedures = functions).
Some other Forth words are:
U.("u-dot")
!("store")
+!("plus-store")
@("fetch")
?("question")
,("comma")
For authoritative information about Forth and particular Forth words, see the ANS Forth Document.
Try from the keyboard:1 . -1 . -1 U. -1 INVERT U. -1 INVERT INVERT U. -1 NEGATE . -1 NEGATE NEGATE . -1 ABS . -1 ABS ABS . \ Name a place CREATE THERE THERE U. \ , a number there 0 , \ @ it and . it THERE @ . \ ? does @ . THERE ? \ ! ( don't , ) a different number -1 THERE ! THERE ? 1 THERE ! THERE ? 1 THERE +! THERE ? BYE
The two most common Forth words
are : ("colon") and ; ("semicolon").
: and ; make new words from words that already exist.
Probably the third most common Forth word is DUP ("doop").
: SQUARED DUP * ; 2 SQUARED . : CUBED DUP SQUARED * ; 2 CUBED . : ^4 SQUARED SQUARED ; 2 ^4 . : ^16 ^4 ^4 ; 2 ^16 . 2 ^16 SQUARED . ( Forth does not check for overflow. )
Spaces are delimiters
IF THESE BE WORDS SEVEN THERE BE A-WORD-CAN-HAVE-UP-2-31-CHRCTRS
Some Forths are case sensitive, oTHerS NoT.
Try from the keyboard:2 BASE ! TRUE U. FALSE U. 1 0 > U. 0 1 > U. TRUE TRUE AND U. TRUE FALSE AND U. 1 TRUE AND U. 1 FALSE AND U. HEX TRUE U. FALSE U. DECIMAL 65 . \ EMIT displays a "character" 65 EMIT 66 EMIT 67 EMIT 97 EMIT 98 EMIT 99 EMIT 48 EMIT 49 EMIT 1 48 + EMIT 10 48 + EMIT 10 7 + 48 + EMIT 1 9 > . 10 9 > . TRUE 7 AND . FALSE 7 AND . 0 DUP 9 > 7 AND + 48 + EMIT 1 DUP 9 > 7 AND + 48 + EMIT 10 DUP 9 > 7 AND + 48 + EMIT 11 DUP 9 > 7 AND + 48 + EMIT : .digit DUP 9 > 7 AND + 48 + EMIT ; 1 .digit 2 .digit 3 .digit 15 .digit 24 .digit 27 .digit 29 .digit 17 .digit
Messages
Try from the keyboard:.(("dot-paren") displays now.
."("dot-quote") displays later.
CR("c-r") goes to the next line, now or later.
: Wicked-Witch CR ." SURRENDER DOROTHY " ; : Dorothy CR ." There's no place like home. " ; CR .( From the Wizard of Oz ) Wicked-Witch Dorothy
Comments
( This is a comment ) \ So is this
Forth ignores comments. Don't you.
Always tell what a new word expects and what it returns.
The usual form is: ( expects -- returns ).
Try from the keyboard:: nonplus ( n -- n ) 1+ 1- ; 0 nonplus . \ Declaration : LOVE ( -- ) 0 PARSE \ get love object CR TYPE SPACE \ present it ." is a beautiful language!" ; \ with feeling LOVE C++ LOVE Java LOVE The next great programming language
Guilty with explanation
ABORT" ("abort-quote") can stop a program and tell you why.
TRUE 0= . FALSE 0= . -1 0= . 1 0= . 0 0= . : COOL ( x -- ) 0= ABORT" Uncool. " ." Yeah, cool. " ; TRUE COOL FALSE COOL 2 COOL 0 COOL : FIRE-ME? ( x -- ) ABORT" I quit! " ." Then how about a raise? " ; FALSE FIRE-ME? TRUE FIRE-ME? 0 FIRE-ME? 1 FIRE-ME?
Putting 2 and 2 together
The 2's come first.
Try from the keyboard:2 2 + . 2 2 - . \ "star" 2 2 * . \ "slash" 2 2 / . 2 2* . 2 2/ . 2 2 MOD . 2 2 /MOD . . 2 2 2 */ . 2 2 2 */MOD . . 2 2 = . 2 2 <> . 2 2 AND . 2 2 OR . 2 2 XOR . 2 2 LSHIFT . 2 2 RSHIFT . 2 2 + 2 MIN . 2 2 + 2 MAX . \ From 0 - for Sister Dorothy A. Flood, CSJ : AWAY ( n u -- +n+u | -n-u ) OVER ( n u n ) 0< 1 OR * + ; 0 2 AWAY . 2 0 AWAY . 2 2 AWAY . -2 2 AWAY .
Looking for an argument?
Find it with .S ("dot-s").
1 .S . 1 2 .S . . 1 2 3 .S . . . 1 .S 2 .S 3 .S + .S + .S . \ Check arguments within a word : .STOP ( -- ) CR .S ." Press a key." KEY DROP ; : .DOWN ( ... x -- ... ) .STOP DROP ; : COUNTDOWN ( -- ) 1 2 3 4 5 6 7 8 9 10 .DOWN .DOWN .DOWN .DOWN .DOWN .DOWN .DOWN .DOWN .DOWN .DOWN .STOP ; COUNTDOWN
Friends
Arguments sometimes need to be dropped, duplicated, switched, rotated, and so on. In these cases, these words are friends indeed:
Try from the keyboard:DROP( x -- )
DUP( x -- x x )
?DUP( x|0 -- x x | 0 ) ("question-doop")
SWAP( x y -- y x )
NIP( x y -- y )
TUCK( x y -- y x y )
OVER( x y -- x y x )
2DROP( x y -- )
2DUP( x y -- x y x y )
ROT( x y z -- y z x ) ("rote")
2SWAP( w x y z -- y z w x )
2OVER( w x y z -- w x y z w x )
.S
1 .S
DROP .S
1 DUP .S
2DROP .S
0 DUP .S
2DROP
1 ?DUP .S
2DROP
0 ?DUP .S
DROP
1 2 .S
SWAP .S
NIP .S
DROP
1 2 TUCK .S
2DROP DROP
1 2 OVER .S
2DROP DROP
1 2 2DUP .S
2DROP 2DROP
1 2 3 .S
ROT .S
ROT .S
ROT .S
2DROP DROP
1 2 3 4 .S
2SWAP .S
2SWAP .S
2OVER .S
+ + + .S
+ + .S
.
: BINARY ( -- ) 2 BASE ! ;
: IN ( n -- )
BASE @ TUCK ." base " DECIMAL .
." is "
DUP . ." decimal "
DUP HEX . ." hex "
BINARY . ." binary "
BASE ! ;
DECIMAL 10 IN
99 IN
HEX 10 IN
FF IN
BINARY 10 IN
11 IN
DECIMAL
CHAR A IN
BL IN
Repeating while
As in: BEGIN words1 condition WHILE words2 REPEAT .
While condition <> 0 , words2 and repeat words1.
Use BEGIN WHILE REPEAT only within a word.
: COUNTDOWN ( +n -- )
BEGIN DUP . ?DUP WHILE 1- REPEAT ;
10 COUNTDOWN
\ Display bits
\ x CONSTANT "name" makes a constant
\ "name" then returns x
\ Set most significant bit
TRUE 1 RSHIFT INVERT CONSTANT 100...
2 BASE !
100... U.
DECIMAL
: .BITS ( x -- )
100... ( x mask )
BEGIN DUP \ Mask not all zeros?
WHILE
2DUP AND 0= -1 AND [CHAR] 1 + EMIT
1 RSHIFT \ Shift mask 1 to the right
REPEAT 2DROP ;
1 .BITS
2 .BITS
3 .BITS
100... .BITS
TRUE .BITS
FALSE .BITS
\ from Wil Baden
: LO-BITS ( n -- mask )
TRUE SWAP LSHIFT INVERT ;
: HI-BITS ( n -- mask )
TRUE SWAP RSHIFT INVERT ;
1 CONSTANT LO-BIT
1 HI-BITS CONSTANT HI-BIT
LO-BIT .BITS
HI-BIT .BITS
HI-BIT .
HI-BIT U.
8 LO-BITS .BITS
8 HI-BITS .BITS
: FACTORIAL ( +n -- n! )
1 SWAP BEGIN ?DUP WHILE TUCK * SWAP 1- REPEAT ;
0 FACTORIAL U.
1 FACTORIAL U.
5 FACTORIAL U.
Repeating until
As in: BEGIN words condition UNTIL .
Repeat words until condition <> 0.
Use BEGIN UNTIL only within a word.
: COUNTDOWN ( +n -- )
BEGIN DUP . 1- DUP 0< UNTIL DROP ;
10 COUNTDOWN
\ [CHAR] ("bracket-char") and CHAR to be explained.
: toZ ( char[acter] -- )
BEGIN DUP EMIT 1+ DUP [CHAR] Z > UNTIL DROP ;
CHAR A toZ
: ABC's ( -- )
[CHAR] A toZ ;
ABC's
: FROM ( -- char ) CHAR ;
FROM A toZ
Repeating again
Never AGAIN .
: COUNTDOWN ( +n -- ) BEGIN DUP . 1- DUP 0< IF DROP EXIT THEN AGAIN ; 10 COUNTDOWN
Do you loop?
As in: limit start DO ... I ... LOOP .
I am - is - optional. I returns start start+1 ... start+n-1.
start should be smaller than limit.
Use DO LOOP only within a word.
: AYE ( -- ) ." Yes! " ; AYE : AYES ( +n -- ) 0 DO AYE LOOP ; 1 AYES 10 AYES ( Avoid 0 AYES ) : I's ( limit start -- ) DO I . LOOP ; 10 0 I's 0 -10 I's 5 -5 I's : I-AYES 0 DO I . AYE LOOP ; 10 I-AYES ( Avoid 0 I-AYES ) \ N! again : FACTORIAL ( +n -- n! ) 1 TUCK MAX 1+ 1 DO I * LOOP ; 0 FACTORIAL U. 1 FACTORIAL U. 5 FACTORIAL U. \ Forth doesn't check for overflow 100 FACTORIAL .
?Do you loop?
As in: replace DO with ?DO ("question-do").
?DO doesn't DO if start = limit.
: AYE ( -- ) ." Yes! " ; : AYES ( u -- ) 0 ?DO AYE LOOP ; 0 AYES 10 AYES : UP ( +n -- ) 1+ 1 ?DO I . LOOP ; 10 UP 0 UP : DOWN ( +n -- ) 1- DUP -1 ?DO DUP I - . LOOP DROP ; 10 DOWN 0 DOWN : CLIMB ( +n -- ) DUP UP SPACE DOWN ; 10 CLIMB 0 CLIMB \ N! again : FACTORIAL ( +n -- n! ) 1 SWAP 1+ 1 ?DO I * LOOP ; 0 FACTORIAL U. 1 FACTORIAL U. 5 FACTORIAL U. \ I seldom use I \ Redefine CLIMB : UP ( +n -- ) 0 TUCK ?DO 1+ DUP . LOOP DROP ; 10 UP 0 UP : DOWN ( +n -- ) DUP 0 ?DO DUP . 1- LOOP DROP ; 10 DOWN 0 DOWN : CLIMB ( +n -- ) DUP UP SPACE DOWN ; 10 CLIMB 0 CLIMB \ COUNT is an interesting Forth word \ If u cn COUNT u cn SPELL : SPELL ( -- ) 0 PARSE 0 ?DO COUNT EMIT SPACE LOOP DROP ; SPELL www.albany.net/~hello
Do you +loop?
No.
Try from the keyboard (and observe carefully):: STEP ( limit start step -- ) ROT ROT ( step limit start ) ?DO I . DUP +LOOP DROP ; 10 0 1 STEP 0 10 -1 STEP 10 0 2 STEP 0 10 -2 STEP
If so facto
As in: condition IF words1 ELSE words2 THEN .
If conditon <> 0 , words1 , else words2 then.
ELSE is optional.
Use IF ELSE THEN only within a word.
: T|F ( x -- ) IF ." True " ELSE ." False " THEN ; TRUE T|F FALSE T|F TRUE TRUE AND T|F TRUE TRUE XOR T|F TRUE FALSE AND T|F TRUE FALSE OR T|F TRUE FALSE XOR T|F TRUE 0= T|F TRUE INVERT T|F FALSE 0= T|F FALSE INVERT T|F 0 T|F 0 0= T|F 0 INVERT T|F 1 T|F 1 0= T|F 1 INVERT T|F TRUE . TRUE U. TRUE FALSE < T|F TRUE FALSE U< T|F TRUE FALSE > T|F TRUE FALSE U> T|F
Re: recursion
A Forth word can call itself, but not by its own name. It must say RECURSE .
Real programmers use recursion. I myself have never used it in a real program. See, however, 0123 Forth, Stacks of Forth, and most Quicksorts.
Try from the keyboard:: COUNTDOWN ( u -- ) DUP . ?DUP IF 1- RECURSE THEN ; 10 COUNTDOWN \ Greatest common divisor \ Unsigned MOD \ UM/MOD is worth looking up : UMOD ( u1 u2 - remainder) 0 SWAP UM/MOD DROP ; -1 2 MOD . -1 2 UMOD U. \ Euclid's algorithm with recursion : GCD ( u1 u2 - gcd ) ?DUP IF TUCK UMOD RECURSE THEN ; 10 40 GCD . 40 10 GCD . \ Display a positive number in binary : .B ( +n -- ) DUP 1 > IF DUP 2/ RECURSE THEN 2 MOD 0 U.R ; 0 .B 1 .B 2 .B 3 .B 4 .B 15 .B 16 .B \ N! again : FACTORIAL ( +n -- +n!) DUP 2 < IF DROP 1 EXIT THEN DUP 1- RECURSE * ; 0 FACTORIAL . 1 FACTORIAL . 5 FACTORIAL . \ By Marcel Hendrix : Hello ( -- ) ." Hello, World! " RECURSE ;
Many are numbers, few are characters
Since this is so, and since x bits can represent 2^x items, fewer bits are needed to represent characters than to represent numbers.
If data space (a passel of bits collected into bytes or other groupings that represent data) is thought of as a series of addresses, then the same amount of space can have more addresses for characters than for numbers.
For example, in some Forth systems:Addresses: a0 a1 a2 a3 a4 a5 etc. Numbers: n0---> n1---> n2---> etc. Characters: c0 c1 c2 c3 c4 c5 etc.
In this example, a0 a2 a4 are addresses for numbers.
a0 a1 a2 a3 a4 a5 are addresses for characters.
The address of a number is an "aligned address" (a-addr) The size of a number is one "cell".
The address of a character is a character address (c-addr). The size of a character is one "char" (how do you say char?).
@ ! ? are among the Forth words that expect cell data; cell data are usually interpreted as integers.
Some Forth words that expect character data are:
Try from the keyboard:C@( c-addr -- char ) fetches a character
C!( char c-addr -- ) stores a character
EMIT( char -- ) . for a character
COUNT( c-addr1 -- c-addr2 u|char ) fetches a count or a character at c-addr and returns the next c-addr after c-addr; often used beforeTYPE
TYPE( c-addr u -- )EMITs u characters beginning with the character at c-addr
BL( -- char ) ("b-l") returns the value of the space character
SPACE( -- ) doesBL EMIT
SPACES( n -- ) doesSPACEn times
CHAR( -- char ) waits for a character, returns it
[CHAR]( -- char ) ("bracket-char") returns the following character. Use only in a word.
PARSE( char -- c-addr u ) seeGREEKbelow
\ Size of a character in your system:
0 CHAR+ U. .( address units)
1 CHARS .
2 CHARS .
\ Size of an number in your system
0 CELL+ U. .( address units)
1 CELLS .
2 CELLS .
\ For O
CREATE TA-DA TRUE TRUE TRUE , , ,
TA-DA ?
\ Number of numbers after 0 in your system
TA-DA @ U.
\ Number of characters after character=0
TA-DA C@ U.
\ A number in bits
2 BASE !
TA-DA @ U.
\ A character in bits
TA-DA C@ U.
DECIMAL
FALSE TA-DA !
TA-DA ?
TRUE TA-DA C!
TA-DA C@ U.
TA-DA ?
1 TA-DA !
2 TA-DA CELL+ !
3 TA-DA 2 CELLS + !
TA-DA ?
TA-DA CELL+ ?
TA-DA CELL+ CELL+ ?
TA-DA 2 CELLS + ?
CHAR A EMIT BL EMIT CHAR B EMIT
CHAR A EMIT SPACE CHAR B EMIT
CHAR A EMIT 10 SPACES CHAR B EMIT
\ PAD ( -- c-addr ) start of a scratch area for characters
PAD U.
CHAR A PAD C!
PAD C@ .
PAD C@ EMIT
CHAR B PAD CHAR+ C!
PAD CHAR+ C@ EMIT
CHAR C PAD 2 CHARS + C!
PAD 2 CHARS + C@ EMIT
PAD CHAR+ CHAR+ C@ EMIT
PAD .S
COUNT .S
EMIT
.S
DROP
PAD COUNT EMIT COUNT EMIT COUNT EMIT DROP
PAD 3 TYPE
\ A count makes a "counted string" of characters
\ At PAD , for example
PAD .S
\ Store count
3 OVER C! .S
\ Store characters
CHAR+ CHAR X OVER C! .S
CHAR+ CHAR Y OVER C! .S
CHAR+ CHAR Z SWAP C! .S
PAD .S
COUNT .S
TYPE .S
PAD COUNT TYPE
: .A ( -- ) [CHAR] A EMIT ;
.A
: .CHAR ( -- ) CHAR EMIT ;
.CHAR A
.CHAR B
.CHAR ABRACADABRA
\ Ancient texts are even harder to read than Forth
: GREEK
0 PARSE
0 ?DO COUNT DUP
BL <> IF EMIT ELSE DROP THEN LOOP DROP ;
GREEK THE WRATH OF PELEUS SON O GODDESS SING
Another hand
Sometimes it's convenient to temporarily move an argument to another place.
The words that do this are:
>R("to-r") moves an argument
R>("r-from") returns an argument
R@("r-fetch") returns a copy of what was moved
These words do the same with two arguments:
2>R
2R>
2R@
All these words can only be used in a word. In that word you must return what is moved. Remember "R" for Return.
There are also special rules, which I won't discuss in this series, when using "R" words with DO loops.
\ Least common multiple
\ Greatest common divisor
\ Euclid's algorithm without recursion
: GCD ( +n1 +n2 -- gcd )
BEGIN ?DUP WHILE TUCK MOD REPEAT ;
10 40 GCD .
\ lcm(x,y) = x*y / gcd(x,y)
: LCM ( +n1 +n2 -- lcm )
2DUP GCD >R * R> / ;
10 40 LCM .
\ FLIP: Split a string and swap the pieces
\ A "string" is a lineup of characters.
\ A string is commonly identified by its
\ starting address and its length (c-addr u).
\ Swap characters
: CSWAP ( c-addr1 c-addr2 -- )
2DUP 2>R C@ SWAP C@ R> C! R> C! ;
\ Shorten distance between addresses
: SQUEEZE ( addr1 addr2 n - addr1+n addr2-n )
TUCK - >R + R> ;
\ Reverse a string
: TURN ( c-addr u -- )
1- CHARS OVER + ( start-addr end-addr )
BEGIN 2DUP U< \ addr1 U< addr2 ?
WHILE 2DUP CSWAP
1 CHARS SQUEEZE
REPEAT
2DROP ;
\ S" ( -- c-addr u ) ("s-quote") makes a string
S" ABCD" PAD SWAP CHARS MOVE
PAD 4 TYPE
PAD 4 TURN
PAD 4 TYPE
\ /STRING "slash-string" ( c-addr u n -- c-addr+nchars u-n )
\ "cut-string" would have been nicer
: FLIP ( c-addr u n -- )
>R \ n to hand
2DUP OVER R@ TURN \ turn substring c-addr n
R> /STRING TURN \ turn substring after n
TURN ; \ turn string c-addr u
S" Charles Moore " PAD SWAP CHARS MOVE
PAD 14 TYPE
PAD 14 8 FLIP
PAD 14 TYPE
PAD 14 6 FLIP
PAD 14 TYPE
A little about allot
CREATE names an aligned address but does not reserve space for data. One way to reserve space is to ALLOT it.
Try from the keyboard:HERE( -- addr ) returns an address
ALLOT( n -- ) reserves space beginning at the address returned byHEREand moves the address that will be returned by the next use ofHEREbeyond that space
\ Creating may itself take up some space and move "here"
HERE U.
CREATE SOMETHING
HERE U.
SOMETHING U.
2 CELLS U.
SOMETHING 2 CELLS + U.
2 CELLS ALLOT
HERE U.
\ The Forth word VARIABLE could be:
: VARIABLE ( -- ) CREATE 1 CELLS ALLOT ;
VARIABLE A
A U.
A ?
1 A !
A ?
CREATE INTEGERS 10 CELLS ALLOT
\ Address of ith integer
: INTEGER ( i -- a-addr ) CELLS INTEGERS + ;
INTEGERS U.
0 INTEGER U.
1 INTEGER U.
\ From low to high
: INITIALIZE ( -- )
10 0 DO I DUP INTEGER ! LOOP ;
: .INTEGERS ( -- )
10 0 DO I INTEGER ? LOOP ;
INITIALIZE .INTEGERS
\ Simple bubble sort from high to low
\ Is a cell's integer smaller than its next neighbor's?
: SMALLER ( a-addr -- flag )
DUP @ \ get the integer
SWAP CELL+ @ \ get the next integer
< \ 1st smaller than 2nd?
;
0 INTEGER ?
1 INTEGER ?
0 INTEGER SMALLER .
\ Trade values between addresses
: EXCHANGE ( a-addr1 a-addr2 -- )
2DUP 2>R @ SWAP @ R> ! R> ! ;
0 INTEGER 1 INTEGER EXCHANGE
0 INTEGER ?
1 INTEGER ?
\ Trade a cell's integer for its neighbor's
: NSWAP ( a-addr -- )
DUP CELL+ EXCHANGE ;
0 INTEGER NSWAP
0 INTEGER ?
1 INTEGER ?
\ Upwardly mobile, using DO LOOP
: RISE ( start_address #elements -- )
0 DO
DUP SMALLER IF DUP NSWAP THEN CELL+
LOOP DROP ;
: BUBBLE ( start_address #elements)
1- BEGIN 2DUP RISE 1- DUP 0= UNTIL 2DROP ;
.INTEGERS
INTEGERS 10 BUBBLE
.INTEGERS
CREATE PROGRAMMER 50 CHARS ALLOT
: FIRSTNAME ( -- c-addr ) PROGRAMMER ;
: LASTNAME ( -- c-addr ) PROGRAMMER 25 CHARS + ;
\ FILL ( c-addr u c ) inserts u chars c beginning at c-addr
\ ACCEPT ( c-addr u1 -- u2 ) receives up to u1 chars at c-addr
\ returns u2, the number of chars actually entered
\ New entry in a field
: GET ( c-addr u -- ) 2DUP BL FILL ACCEPT DROP ;
: WHO? ( -- )
CR ." Your last name? " LASTNAME 25 GET
CR ." Your first name? " FIRSTNAME 25 GET ;
\ -TRAILING ( c-addr u1 - c-addr u2 )
\ "dash-trailing" removes trailing spaces
: HELLO! ( -- )
CR ." Hello, "
FIRSTNAME 25 -TRAILING TYPE SPACE
LASTNAME 25 -TRAILING TYPE
[CHAR] ! EMIT ;
: FORMALITY ( -- ) WHO? HELLO! ;
FORMALITY
PROGRAMMER 50 TYPE
Comma here !
Inserting data with , ("comma") or C, ("c-comma") also reserves data space:
,( x -- ) acts like:HERE 1 CELLS ALLOT !
C,( char -- ) acts like:HERE 1 CHARS ALLOT C!
HERE returns the address where the datum will be inserted. , inserts a number at the address and bumps the address one cell. C, inserts a character at the address and bumps the address one char.
Because , and C, insert different sized data, two words help to ensure that HERE returns an aligned address:
Try from the keyboard:ALIGN( -- ) ensures thatHEREreturns an aligned address
ALIGNED( addr -- a-addr ) returns the first aligned address at or after addr
CREATE DATA DATA U. HERE U. ALIGN HERE U. HERE ALIGNED U. 1 , 2 , 3 , HERE U. DATA U. DATA ? DATA CELL+ ? DATA 2 CELLS + ? CREATE CDATA CDATA U. HERE U. CHAR L C, CHAR e C, CHAR o C, CDATA 3 TYPE HERE U. HERE ALIGNED U. HERE ALIGNED ALIGNED U. HERE U. ALIGN HERE U. ALIGN ALIGN HERE U. \ Another VARIABLE : VARIABLE ( -- ) CREATE 0 , ; VARIABLE A A U. A ? 1 A ! A ? \ Comma powers of 2 : 2^, ( +n -- ) 1 SWAP 0 DO DUP , 2* LOOP DROP ; \ n may depend on the number of bits in a cell CREATE 2^N 16 2^, \ 2 to the +nth power : 2^ ( n -- 2^n ) CELLS 2^N + @ ; 0 2^ U. 1 2^ U. 8 2^ U.
Meet me at-xy
Better yet, get a Life that uses PAGE and
AT-XY . Also see Meme Virtual Reality
: A ( -- ) [CHAR] A EMIT ; 10 0 AT-XY A 0 10 AT-XY A 10 10 AT-XY A PAGE \ random number generator from Brodie, Starting Forth VARIABLE RND HERE RND ! : RANDOM ( -- u ) RND @ 31421 * 6927 + DUP RND ! ; : CHOOSE ( u - 0...u-1) RANDOM UM* NIP ; 10 CHOOSE . 10 CHOOSE . 10 CHOOSE . : FISH ." ><>" ; FISH \ FISH eat FISH \ Previous FISH no longer available to new words \ 64 and 16 are screen dimensions : FISH ( +n -- ) PAGE 0 ?DO 64 CHOOSE 16 CHOOSE AT-XY FISH LOOP ; 10 FISH 20 FISH 30 FISH
Does is as does does
CREATE names a data address.
DOES> ("duz") takes the address as an argument for the code that follows DOES> .
CREATE DOES> is used to make words that make other words that share code.
Try from the keyboard:
\ Yet another VARIABLE, in which DOES> does nothing.
: VARIABLE
CREATE ( -- ) 0 ,
DOES> ( -- a-addr ) ;
VARIABLE X
VARIABLE Y
TRUE X !
X ?
FALSE Y !
Y ?
X @ Y @ X ! Y !
X ?
Y ?
: VSWAP ( a-addr1 a-addr2 -- )
2DUP 2>R @ SWAP @ R> ! R> ! ;
X Y VSWAP
X ?
Y ?
\ CONSTANT could be:
: CONSTANT
CREATE ( x -- ) , \ comma x
DOES> ( -- x ) @ ; \ fetch x
10 CONSTANT C
20 CONSTANT D
C .
D .
\ CREATE and DOES> don't have to be in the same word.
\ Yet another CONSTANT
: STEPIN ( x -- ) CREATE , ;
: FETCHIT ( -- x ) DOES> @ ;
: CONSTANT
STEPIN ( x -- )
FETCHIT ( -- x )
;
TRUE CONSTANT REDUNDANT
REDUNDANT TRUE = .
\ One-dimensional array
: ARRAY
CREATE ( #elements -- )
CELLS ALLOT
DOES> ( i -- a-addr )
SWAP CELLS + ;
10 ARRAY A
0 A U.
1 A U.
10 0 A !
0 A ?
20 9 A !
9 A ?
\ Two-dimensional array
: 2ARRAY
CREATE ( x y -- )
OVER , \ comma x
* CELLS ALLOT
DOES> ( i j -- a-addr )
DUP >R
@ ( i j x )
* + 1+ CELLS ( offset )
R> + ;
5 5 2ARRAY TABLE
0 0 TABLE U.
1 0 TABLE U.
0 1 TABLE U.
1 1 TABLE U.
1 0 0 TABLE !
0 0 TABLE ?
1024 4 4 TABLE !
4 4 TABLE ?
\ String constant
\ Move a string and make it a string for COUNTing
: PLACE ( c-addr1 u c-addr2 -- )
2DUP 2>R CHAR+ SWAP CHARS MOVE 2R> C! ;
S" Nice pad! " PAD PLACE
PAD COUNT TYPE
\ comma a string as a counted string
: S, ( c-addr u -- )
HERE OVER 1+ CHARS ALLOT PLACE ;
: SCONSTANT
CREATE ( c-addr u -- ) S,
DOES> ( -- c-addr u ) COUNT ;
S" How are you today?" SCONSTANT Howdy
Howdy TYPE
\ Array of string constants
\ Get keyboard input
: STRING ( -- c-addr u )
PAD DUP 84 ACCEPT ;
\ The array-making word
: SOME
CREATE ( +n -- )
BEGIN ?DUP
WHILE CR STRING ?DUP
IF S, 1- ELSE DROP THEN
REPEAT
DOES> ( i -- c-addr u )
SWAP ( c-addr i )
0 ?DO COUNT + LOOP COUNT ;
3 SOME B
Bach
Beethoven
Berlioz
0 B TYPE
1 B TYPE
2 B TYPE
Words with :noname
:NONAME ( -- xt ), used instead of : <name>, creates a word with an execution token (xt) but no name. EXECUTEing the execution token evokes the word.
:NONAME ( -- ) ." Anonymous" ; CR .( Call me ) EXECUTE CHAR . EMIT \ "commas" by Wil Baden : ,S ( x1 ... xn n -- ) BEGIN ?DUP WHILE DUP ROLL , 1- REPEAT ; \ Fetch a value and bump the address : @+ ( a-addr1 -- a-addr2 x ) DUP CELL+ SWAP @ ; \ The menu word : COURSE CREATE ( x1 ... xn n -- ) DUP , ,S DOES> ( -- ) @+ 0 ?DO @+ EXECUTE LOOP DROP ; \ Banquet ordered by Nathan Yuen :NONAME CR ." Bird Nest Soup" ; :NONAME CR ." Peking Duck with Steamed Buns" ; :NONAME CR ." Shrimp Canton" ; :NONAME CR ." Ginger Chicken" ; :NONAME CR ." Sam See Mein" ; :NONAME CR ." Spicy Mongolian Beef" ; :NONAME CR ." Black Bean Lobster" ; :NONAME CR ." Steamed Fish in Hot Oil" ; :NONAME CR ." Roast Pork" ; 9 COURSE MEAL MEAL
Note: a master chef might have defined:
: DISH" :NONAME POSTPONE CR POSTPONE ." POSTPONE ; ;
Then:
DISH" Bird Nest Soup"
etc.
For you a lei
Mahalo nui loa to Kalinapuanani Cady for sending me the lyrics to Johnny Noble's song.
\ Begin in memory
: LEI ( -- )
CREATE \ something lovely
\ current next previous
HERE CELL+ DUP , DUP , ,
;
\ Delicate finger work
: NEEDLE ( first new -- )
TUCK OVER , \ first is new's next
OVER CELL+ @ DUP , \ last is new's previous
! \ new is last's next
CELL+ ! \ and first's previous
;
\ Ties a knot
: THREAD ( lei -- )
CELL+ ALIGN HERE NEEDLE ;
: FIRST ( lei -- a-addr )
DUP CELL+ TUCK SWAP ! ;
: LAST ( lei -- a-addr )
DUP CELL+ CELL+ @ TUCK SWAP ! ;
: AGAIN ( lei -- a-addr ) @ ;
: NEXT ( lei -- a-addr )
DUP @ @ DUP ROT ! ;
: PREVIOUS ( lei -- a-addr )
DUP @ CELL+ @ DUP ROT ! ;
: PLACE ( c-addr1 u c-addr2 -- )
2DUP 2>R CHAR+ SWAP CHARS MOVE 2R> C! ;
: S, ( c-addr u -- )
HERE OVER 1+ CHARS ALLOT PLACE ;
: MEMORY ( -- ) 0 PARSE S, ;
: RECALL ( a-addr -- )
CELL+ CELL+ COUNT TYPE ;
LEI HAWAII
MEMORY HAWAIIAN MEMORIES
: F HAWAII FIRST RECALL ;
: L HAWAII LAST RECALL ;
: A HAWAII AGAIN RECALL ;
: N HAWAII NEXT RECALL ;
: P HAWAII PREVIOUS RECALL ;
: O HAWAII DUP NEXT DROP NEXT RECALL ;
: U HAWAII DUP PREVIOUS DROP PREVIOUS RECALL ;
: REMEMBER HAWAII THREAD MEMORY ;
REMEMBER Iliahi Street
REMEMBER Royal School
REMEMBER Cathedral School
REMEMBER Our Lady of Peace
REMEMBER DC-3
REMEMBER Wong Family Christmas
REMEMBER Nu`uanu Pali
REMEMBER Boy Scout Camp at Punalu`u
REMEMBER gau
REMEMBER 49th State Fair
REMEMBER St. Louis High School
REMEMBER The House of Intellect
REMEMBER Sister Adele Marie Lemon
REMEMBER Waipi`o
F
You must remember this
A kiss is just a kiss
A cell is just a cell
A char is just a char
But not in Forth.
Here's looking at you, Forth programmer. I think this could be the start of a beautiful friendship.
Play it again.Albany NY +
Leo Wong hello@albany.net