YaK:: FORTH Homework Assignment ( problems by Bill Ragsdale for SVFIG 2020-09-26 ) [Changes]   [Calendar]   [Search]   [Index]   [PhotoTags]

## FORTH Homework Assignment ( problems by Bill Ragsdale for SVFIG 2020-09-26 )

 Dear Forther, You are invited to participate in a Forth Programming Challenge on Saturday, Sept. 26, 2020 as part of the monthly Silicon Valley Forth Interest Group meeting. This is not a contest, just show and tell. You are welcome to program solution(s) or just comment on any of the challenges. When: Zoom meeting Sept. 26, 2020, 1:00 PM Pacific Daylight Time, 20:00 UTC. The Challenges: 1) Print the alphabet "AbCdEfGh . . . z" in alternating case using three methods. 2) Print a table headed by 240 to 249 across with 170 to 179 down. At each intersection show the Greatest Common Divisor. 3) Print the five largest prime numbers less than 10,000. 4) Using numbers, terminal characters or graphics plot x-squared from 1 to 10. Questions or suggestions: Bill Ragsdale

Solutions by strick: ( also available at https://github.com/strickyak/forth-homework-2020-09-26 )

## 1) Print the alphabet "AbCdEfGh . . . z" in alternating case using three methods.

### Method One

```\$ cat alphabet1.4th
\ Print alphabet in alternating case: AbCd...z    ; strick for gforth

30000 constant SIZE
create tape SIZE cells allot  \ The tape.

variable p                  \ Tape pointer.

: reset
tape p !                  \ Initialize p to beginning of tape.
SIZE 0 do
0  i cells tape +  !  \ Clear the tape.
loop ;
reset

: {-}  - ;   \ save - before redefining it.
: {+}  + ;   \ save + before redefining it.
: {.}  . ;   \ save . before redefining it.

: show           \ show begining of tape, and pointer.
cr 10 0 do
i cells tape {+}  p @  = if ." ^" then
i cells tape {+} @ {.}
loop cr ;

: -   p @ @   1 {-}        p @ !  ;  \  (*p)--;
: +   p @ @   1 {+}        p @ !  ;  \  (*p)++;
: .   p @ @   emit                ;  \  putchar(*p);
: <   p @     1 cells {-}  p !    ;  \  p--;
: >   p @     1 cells {+}  p !    ;  \  p++;

: [  POSTPONE begin  ; immediate
: ]        POSTPONE p POSTPONE @ POSTPONE @
POSTPONE while
POSTPONE repeat  ; immediate

: program

> > > + + + + [ < + + + + [ < + + + + [ < + > - ] > - ] > - ] < < < +               show \ ^65

> + + + + + + + + + + + + +                                                         show \ 65 ^13 _

> > > > + + + + [ < + + + + + [ < + + + + + [ < + > - ] > - ] > - ] < < < - - <     show \ 65 ^13 98

[
< . + + >
> . + + <
-
]

;
program

\$ gforth < alphabet1.4th
^65 0 0 0 0 0 0 0 0 0

65 ^13 0 0 0 0 0 0 0 0

65 ^13 98 0 0 0 0 0 0 0
AbCdEfGhIjKlMnOpQrStUvWxYz ok

```

BTW, here is a web-based evaluator you can check my BF implementation with: https://sange.fi/esoteric/brainfuck/impl/interp/i.html

Paste everthing from ": program" to "; program" in the top right textarea, and hit "execute". Check my results against the bottom right textarea.

### Method Two

```\$ cat alphabet2.4th

\ Print alphabet in alternating case.   strick for gforth

s" NoPqRsTuVwXyZaBcDeFgHiJkLm"  \ pay no attention
constant MAGIC_LEN              \ to that man
constant MAGIC_ADDR             \ behind the curtain

13 constant M     \ M is 13th letter of alphabet.
31 constant MASK  \ Removes bits marking upper/lower/figs.

: rot13c ( char -- char )
dup MASK and M <= if
M else
M negate then
+ ;

: .rot13s ( addr len -- )
2dup
( addr len ) 0 do
( addr ) dup i + c@ rot13c emit
loop drop ;

cr cr MAGIC_ADDR MAGIC_LEN .rot13s cr

\$ gforth  < alphabet2.4th

AbCdEfGhIjKlMnOpQrStUvWxYz
ok

```

### Method Three

```\$ cat alphabet3.4th

: program
13 0 do
65 i + i + emit
98 i + i + emit
loop ;
cr program cr

\$ gforth < alphabet3.4th
AbCdEfGhIjKlMnOpQrStUvWxYz
ok

```

## 2) Print a table headed by 240 to 249 across with 170 to 179 down. At each intersection show the Greatest Common Divisor.

```\$ cat gcd.4th
\ Problem 2: Print an gcd table.    strick for gforth
: gcd ( a b -- z )
( a b ) dup 0 = if  drop exit  then
( a b ) over 0 = if  swap drop exit  then
( a b ) 2dup < if
( a b ) over mod  recurse   else
( a b ) dup rot   swap mod  recurse   then
;
: 3d.  \ fixed-length, print a 3 digit number and a space.
dup 100 >= if  . exit then
dup 10 >= if   ."  "  . exit then
."   "  .
;
: gcd-table cr
."      : "
10 0 do i
240 i + 3d.
loop cr
10 0 do
170 i + 3d.
."  : "
10 0 do
i 240 +   j 170 +   gcd 3d.
loop cr
loop cr
;
gcd-table

\$ gforth < gcd.4th
: 240 241 242 243 244 245 246 247 248 249
170  :  10   1   2   1   2   5   2   1   2   1
171  :   3   1   1   9   1   1   3  19   1   3
172  :   4   1   2   1   4   1   2   1   4   1
173  :   1   1   1   1   1   1   1   1   1   1
174  :   6   1   2   3   2   1   6   1   2   3
175  :   5   1   1   1   1  35   1   1   1   1
176  :  16   1  22   1   4   1   2   1   8   1
177  :   3   1   1   3   1   1   3   1   1   3
178  :   2   1   2   1   2   1   2   1   2   1
179  :   1   1   1   1   1   1   1   1   1   1

ok

```

## 3) Print the five largest prime numbers less than 10,000.

```\$ cat sieve.4th
\ Print 5 largest primes less than 10000.  strick for  gforth
10000 constant N   \ limit of seive (exclusive)
5 constant K       \ how many primes to print
1 constant TRUE
0 constant FALSE
create sieve  N cells  allot  \ the array sieve

: top-primes
N 0 do  FALSE  sieve i cells +  !  loop  \ clear the sieve

N 2 /  2  do
N  i 2 *  ?do
TRUE   sieve i cells +  !
j +loop
loop
K
( k ) N 0 do  \ loop forward, but meaning is backward: N 1 - i -
( k ) sieve  N 1 - i - cells + @  FALSE =  if
( K ) N 1 - i - .      \ print the prime
( K ) 1 -              \ decrement k
then
( k ) dup 0 = if drop leave then  \ leave after printing 5 primes.
loop
;
top-primes

\$ gforth < sieve.4th
9973 9967 9949 9941 9931  ok
```

## 4) Using numbers, terminal characters or graphics plot x-squared from 1 to 10.

```
\$ cat square.4th
40 constant H   \ screen height
72 constant W   \ screen width

42 constant STAR
46 constant DOT
32 constant SP
124 constant VBAR
45 constant DASH
48 constant ZERO
: digit ( n -- ch ) ZERO + ;   \ compute ascii digit

\ ---- screen graphics -----
create screen  H W * cells allot
: set-char ( x y ch -- ) rot rot  W * + cells screen + ! ;
: emit-char ( x y -- ch ) W * + cells screen + @ emit ;
: set-blank ( x y -- ) SP set-char ;  \ actually '.' not ' '
: set-star ( x y -- ) 42 set-char ;   \ sets '*'
: cls ( -- ) H 0 do  W 0 do  i j set-blank  loop loop ;
: display ( -- ) cr H 0 do  W 0 do  i j emit-char  loop cr loop ;
10000 constant XMAX000
100000 constant YMAX000
: draw-point-fixed-millis ( x000 y000 ch -- )
rot rot         \ push char down to bottom
YMAX000 swap -  \ flip screen so y000 increases bottom to top
H * YMAX000 /  0 max   H 1 - min  \ y -> integer from 0 to H
swap                              \ x on top
W * XMAX000 /  0 max   W 1 - min  \ x -> integer from 0 to W
swap                              \ y on top again
rot set-char ;   \ recover the char & set it.
\ --------------------------
: draw-x-squared
XMAX000 0 do   i   i dup * 1000 /   35 draw-point-fixed-millis  loop ;
: draw-x-axis
XMAX000 0 do   i   0   45 draw-point-fixed-millis  loop
YMAX000 0 do  11 1 do i 1000 *   j  DOT  draw-point-fixed-millis  loop loop
10 0 do i 1000 *   0  48 i +  draw-point-fixed-millis  loop ;
: draw-y-axis
YMAX000 0 do   0   i   VBAR draw-point-fixed-millis  loop
XMAX000 0 do  11 1 do  j   i 10 * 1000 *     DOT  draw-point-fixed-millis  loop  loop
10 0 do  0   i 10 * 1000 *     i digit  draw-point-fixed-millis  loop \ first digit
10 0 do  XMAX000 W / 1 +   i 10 * 1000 *     0 digit  draw-point-fixed-millis  loop ; \ second digit

cls  draw-x-axis draw-y-axis draw-x-squared  display bye

\$ gforth < square.4th
.......................................................................#
|      .      .      .      .       .      .      .      .      .     ##
|      .      .      .      .       .      .      .      .      .    ##.
|      .      .      .      .       .      .      .      .      .   ## .
90.................................................................##...
|      .      .      .      .       .      .      .      .      . ##   .
|      .      .      .      .       .      .      .      .      .##    .
|      .      .      .      .       .      .      .      .      ##     .
80.............................................................##.......
|      .      .      .      .       .      .      .      .    ##.      .
|      .      .      .      .       .      .      .      .   ## .      .
|      .      .      .      .       .      .      .      .  ##  .      .
70.........................................................##...........
|      .      .      .      .       .      .      .      .##    .      .
|      .      .      .      .       .      .      .     ###     .      .
|      .      .      .      .       .      .      .    ##.      .      .
60....................................................##................
|      .      .      .      .       .      .      .  ##  .      .      .
|      .      .      .      .       .      .      . ##   .      .      .
|      .      .      .      .       .      .      ###    .      .      .
50...............................................##.....................
|      .      .      .      .       .      .    ##.      .      .      .
|      .      .      .      .       .      .  ### .      .      .      .
|      .      .      .      .       .      . ##   .      .      .      .
40..........................................##..........................
|      .      .      .      .       .     ###     .      .      .      .
|      .      .      .      .       .    ##.      .      .      .      .
|      .      .      .      .       .  ### .      .      .      .      .
30...................................###................................
|      .      .      .      .       ##     .      .      .      .      .
|      .      .      .      .     ###      .      .      .      .      .
|      .      .      .      .   ### .      .      .      .      .      .
20............................###.......................................
|      .      .      .     ####     .      .      .      .      .      .
|      .      .      .   ###.       .      .      .      .      .      .
|      .      .      .####  .       .      .      .      .      .      .
10.................####.................................................
|      .      . #### .      .       .      .      .      .      .      .
|      .   ######    .      .       .      .      .      .      .      .
############--2------3------4-------5------6------7------8------9------.

```