6502.org

Posted: **Mon Feb 25, 2019 9:46 pm**

I didn't intend to digress into the differences between ASCII" and CONTROL . I got the wrong screen shot. Instead of showing the screen from the original Blazin' Forth system loader, it was from the disk I modified to be compatable with Fleet Forth.

Posted: **Fri May 03, 2019 9:00 pm**

Computing the Fibonacci numbers is a common CS-101 problem used to introduce the concept of recursion. However, if you analyze stack usage it's hideously inefficient, and likely to exceed the size of the return stack for any large value of N. So instead I constructed a sample that couples iteration with Forth's stack manipulations to make the Fibonacci pairs, and then the final Nth number.

Code: Select all

\ Computes the n number in the Fibonacci sequence.
: fibonacci ( n -- n )
  \ First make sure we have a positive integer.
  dup
  0<= if
    cr ." Fibonacci requires a positive integer. "
    drop
  else
    \ if 1 then return 1
    dup
    1 = if
      drop 1
    else
      \ if 2 then return 1
      dup
      2 = if
        drop 1
      else
        \ seed the stack with 1 1 n
        1 tuck swap
        \ loop using the stack to generate Fibonacci pairs.
        2 do
          tuck +
        loop
        \ add the last two pairs.
        +
      then
    then
  then ;

Posted: **Sat May 04, 2019 11:14 pm**

Martin_H wrote:

Computing the Fibonacci numbers is a common CS-101 problem used to introduce the concept of recursion. However, if you analyze stack usage it's hideously inefficient, and likely to exceed the size of the return stack for any large value of N.

CS classes really should pick an example of recursion that doesn't depict it in a bad light since finding the Nth Fibonacci number is best solved iteratively rather than recursively ( although I do remember a technique in Python where a small dictionary was used to cache the latest Fibonacci numbers with their respective N as the key. By checking the dictionary first, the second recursion is eliminated. )

What about the bidirectional Fibonacci sequence?

Code: Select all

...  -21 13 -8 5 -3 2 -1 1 0 1 1 2 3 5 8 13 21 ...

[Edit: fixed formatting error on my part.]

Posted: **Sat May 04, 2019 11:30 pm**

Yeah, that's always struck me funny - I don't doubt that there are probably useful applications for recursion, but man alive do they always pick the worst ones to demonstrate.

Posted: **Wed Jun 26, 2019 3:28 am**

Hi Martin,

I ran your Mandelbrot in Tachyon on the P2 as a quick test but even though it only takes about half a second to run, it doesn't look right

I can zoom in by 100 instead and it does zoom (takes about a second) so that part works correctly. BTW, this code is one of the simple benchmark tests I will run on the 65816/37702 chips when I convert Tachyon.

I haven't really looked into what is going wrong. Any ideas?

Code: Select all

-------------------------------------------------------------------------------
  Parallax P2  *TAQOZ* Extensible Firmware  V2.0 'CHIP' 125MHz 190212-1700
-------------------------------------------------------------------------------
TAQOZ# 300 P2MHZ ---  ok
$0004_0627   Parallax P2  *TAQOZ* Extensible Firmware  V2.0 'CHIP' 300MHz 190212-1700
  52    ---   
53 lines and 274 bytes compiled,  with 0 errors in 72ms  ok
TAQOZ# GO --- 
     ..!..     .,'.~     ,.!.'     .,.!....~~',.!.,.,.,.....^..~...,,...,...,'.
    ,.~,'     ..,!.     .:'...    .'.'.'.^.',^..,.!.,.,....,.,',..,....^.',,,.'
   ,.'..     ~,'..     ~.,.',    ,.........''',.,...~!.'.'..~...,,.''~.,.'!,..,
  .^.,:     ^..'.     ''~;'.    ,,.!., ~,''..'...''.'.'....,'...~!.,,,....'.,,,
 ,^,..     ,'..,     ,,',..    '~.~..  .'''...,'.,'.!,'....,.~.,...''..^.',,..!
.'..'     ...,~     '...'.    '.,,!,   ,......,..~...'^.,'.~,                  
!...     ..!.,     ..,,.,    ,.'...                                            
.!.     .,...     ~.,.,~    ....,^    ~                                        
,.     ...^^     .~',.!    ..,.,.    ~'                                        
,     ,...'     ,.,~~'    ',.~..    ,..                                        
     ,,,.,     ...!~.    .!,.,~    ..,.~...'..,..,,,.~'',.'.'.'.:...^..,,~.''..
    ..,..     .,,'..    ,~...,    .....~~..,.',',,..,...,~.,,'...';'...~',.,'..
   '....     ..,,,,    ',~..'    ',,.,,..,,........,.''.,,'..,...,,~.!,.,,...'.
  ,.'~,     '.'.,'    .,~~..    ,.''., !.,~.,~.'^....~,.,,,.,.'.,.,,...',,.',.!
 ,.!..     '...''    ,!...!    ......  .............'....,.!.,.:.,.~.~.~,,.!^.,
.,.,.     ''.,..    '',...    .',.,.   ,.',.:.,.',~~,.'.,,!..'.,.,.,,,'.       
.,~'     ...,.,    ,.,,.,    .,.'..                                            
'..     ,.,,..    ..!.^.    .,.,',    .                                        
'.     ,'.,,.    .:.~,~    .;'.,,    '.                                        
.     .~,...    ......    '~...,    ''.                                        
     '.~'.,    ''.~.~    ...''.    '..,..',,...!.....~....,....,~~.:,.''.',,...
    ,,.,'.    .',..~    .,...,    .'..,,,...,,'.',.';.,!.,'!...~''.!'....,'.,,,
   '..,..    ''..,.    ,'.,^~    ''[.,....,.'.,~,,.',.~,.~','.'.'~....'',,.,...
  .,....    ,,,...    ,.,,'.    :..:.. .'...',,./'...,...',,.,.'..~~~',',..'.,.
 ,.~..'    .',,'.    ^,,'..    :''~'^  ~.,,'...,...!'.~'~...',,...'..!',.,',...
,.,.~,    ~^..'!    .....,    .....,   ..,',,,..,''!,.,,,....,.,..^..'..,...,  
.,,,,    ',,...    ,.....    ,...~.                                            
.',.    ,.,.'.    ..'',.    ..,.~.    ,                                        
~.^    ,.~,,,    ,~'...    '.....    ..                                        
'.    .',,~,    .~'''.    .,.',.    ...                                        
     ....',    ,:...,    ,,.'.'    ,.'',.,,''..,.,,.!,.,^.,..~,^.~,.':,...:..,.
    .!.,,.    .,~.,.    .!'.~,    ~..,..'...!...'..,,,.',,....~'....,,.~,!.,,.,
   ,.~.,'    ..^'..    ,,...,    ..:',,.,...,...,.,.',.,'.'.:...'..'.',...~~,,.
  ....![    ',,.,'    ...,',    ::,..' ..,..'...,,.'..'...,'!.,.....,,'...~'~,.
 ,^~..,    .~.,',    ,...,.    .,~,!.  ,,....~'~..,.....,.'.~.,,..~.~..,',.''.'
,,,~.,    ..~',,    ..,.!~    ,,....   .,.,'.'',.,,.....,.~.,...!.../'[...,!.,.
,.,..    .,,..,    '.'..,    .,~.!.                                            
'!!,    ~.,~.,    ,:..,!    ..,,..    .                                        
^..    ......    ,..,:'    ...',.    ..                                        
..!,.'    .,,!~,    '~..~,    .,.,'.   WWWWWW<:^!~''',,,,,,,...................
.'...^    .!,,.!    .,.!,,    .,',,,   .WWWWWW[^!~''',,,,,,....................
'.,,'.    ,...'.    ~.~...    !....,   .WWWWWWW;!~''',,,,,,....................
,,..,;    '.~!.,    .''~.!    .,':.,   .WWWWWWW:!~''',,,,,,....................
'.~,!.    ~....!    .,,'.'    .~',.[   .WWWWWWW~~;''',,,,,,....................
.'...~    .'..,.    ,.....    ,.~,.,   ..WWWWW~!;~''',,,,,,....................
..^:..    '...,!    .~!'.,    .,..,.   ..,WWW'''~~'',,,,,,,....................
.,....    ,...,,    .!,,,'    '.....   ...,,''!!'~'',,,,,,.....................
,.',,,    .;,!,.    .,;,.,    '...!.   ...,,,,,'!:!!,,,,,,.....................
',..,.    ....,,    '...~.    .!'',.   ,...,,,,,,,!',,,,,,.................... 
,.,'~'    ,...,.    ^.,...    .,,,.^   ^....~''''~,,,,,,,..................... 
,.'!.'    '...,!    ..~.~.    ^.....   ',...~,,,,,,~~~,,,..................... 
''^,,'    ,.,.,.    .!',.~    .,.,^~   ,~,...,,!~'~!',,,...................... 
!.,,.'    ^.,.,.    ~,.,.'    ~...,.   ,!,'...~~,,,,,,,,.....................  
.,..~.    ,...!,    .','.,    '...:.   .~~',...,'',,,,,......................  
.'...,    ,.~...    ^...^.    .,.^^.   ...,,'...,'~,,,.......................  
.,..,,    ~.'...    .,',..    ~.,...   ....',,..','',,......................   
,.!'..    !...,.    .!',..    .'!,.'   ,....~'!..!,',.......................   
,.,,,'    .,'~.~    ,...!.    '.~,.,   ,,,...,',..,'.......................    
;.''.,    .!,,.~    .,,~..    ,...'.   ,!,'...,,,..........................    
.,..''    !.,,..    .,',.'    .!,.~.   .,'''...~'~........................     
'...,.    ,,',..    .....;    ....,,   ...',,,..'!'.......................     
.'.,,     '~.'..    .!,.,,    ,,,,..   '....~,'...,,.....................      
,.'..     .,'.,.    .'/.',    '..^.~   !,'...,,'...!,...................       
.,',.     ,..'..    ...'.,    ,..,.'   ,,,~....',...',..................       
,.,..     ,....,    .,,.^,    ,,,,..   ...,',...^,,..',................        
.'.,,     ,..,..    ,',,!.    ,..,.,   ....'~,^..',,..,'..............         
....'     .,'.~~    .,'.,,    ....,'   ~',...,[,...,,..~,............          
.,.,'     .,,.'.    ,..~..    ~...'~   .,'',...,'~..'~..,~..........           
!.,..     .'!.'.    ....,~    .,~'..   ...&':,..;,,..,'..,^........            
,.''.     ,..,.,    .....,    ..'.,'   ~....,,~...^~..,'..~,......             
...'.     ..~.,,    !~.~.,    ,^'...   ',,,...,,^..~;'..,..!,....              
.,,.'     ,.'...    '!,...    ...,,~   ..',!,...~:,..!,..',.,,..               
,~,.'     .~.,!     ~~.,.'    ,'.,..   ,....~',...,,..,,..,,.'                 
.,,.,     '^.'.     ..,.^.    ...,,,   ,,~'...~,!..,^..,,..!,                  
,..,.     .'.,.     ,,.,',    ..,.,,   ...,''...'',..,'..'!                    
...,.     ..!.,     ...,,!    ...,:,   ,....,'!...''..,'.                      
,..~.     ...!,     ..,.,.    !^.,..   ,~,'...!,,...,'.                        
.,'.'     ...!'     ,'.,~     ...,,^   ...~,',...,,.                           
.,,.,     ,,'..     !,.'.     ~''.':   ,~....,,,                                ok
TAQOZ#

This is my source code:

Code: Select all

TAQOZ

FORGET *MANDELBROT*

: *MANDELBROT*	;

\ Setup constants to remove magic numbers to allow
\ for greater zoom with different scale factors.
20		:= #MAXITER
40		:= #MAXVAL
-39		:= #MINVAL

: SCALE		5 << ;
20 SCALE	:= #RESCALE

\ These variables hold values during the escape calculation.
long CREAL
long CIMAG
long ZREAL
long ZIMAG
long ESCCNT

\ Compute squares, but rescale to remove extra scaling factor.
: ZSQ		@ DUP #RESCALE */ ;

\ Translate escape ESCCNT 1 to MAXITER+1 to ascii greyscale 1=black
\		..0123456789ABCDEF012345
: .GRAY  	"   .,'~!^:;[/<&?oxOX#MW"  + C@ EMIT ;

\ Increment ESCCNT and compare to max iterations.
: COUNT?  	ESCCNT ++ ESCCNT @ #MAXITER > ;

\ stores the row column values from the stack for the escape calculation.
: INIT_VARS
  SCALE DUP CREAL ! ZREAL !
  SCALE DUP CIMAG ! ZIMAG !
  1 ESCCNT ! ;

\ Performs a single iteration of the escape calculation.
: DOESCAPE
    ZREAL ZSQ  ZIMAG ZSQ 2DUP +
    #RESCALE 4* > IF
      2DROP
      TRUE
    ELSE
      - CREAL @ +   ( result )
      ZREAL @ ZIMAG @ #RESCALE */ 2* ( result val )
      CIMAG @ + ZIMAG ! ( result )
      ZREAL !
      COUNT?
    THEN ;

\ Iterates on a single cell to compute its escape factor.
: DOCELL ( row cell -- )
  INIT_VARS
  BEGIN
    DOESCAPE
  UNTIL
  ESCCNT @ .GRAY
  ;

\ For each cell in a row.
: DOROW
  #MAXVAL #MINVAL DO
    DUP I DOCELL
  LOOP
  DROP ;

\ For each row in the set.
: MANDELBROT
  #MAXVAL #MINVAL DO
    CRLF I DOROW
  LOOP ;

: ZOOM ( n -- )		SCALE ' #RESCALE :=! MANDELBROT ;

\ Run the computation with defaults
: GO			20 ZOOM ;

END

Posted: **Wed Jun 26, 2019 7:00 am**

Ahhh, my bad, I found a sign bug in my */ routine. Just did a quick workaround as * and / and it all looks sweet. Time to go and fix that bug now.

Code: Select all

                               .................                               
                           .........................                           
                        ...............................                        
                      ...................................                      
                    .......................................                    
                  ...........................................                  
                 .............................................                 
               .................................................               
              ...................................................              
             .....................................................             
            .......................................................            
           .........................................................           
          ...........................................................          
         ...............,,,,,,,,,,,...................................         
        ............,,,,,,,,,,,,,,,,,,,................................        
       ..........,,,,,,,,,,,,,,,,,,,,,,,,,..............................       
       .......,,,,,,,,,,,,,,,,,,''''~''',,,,,...........................       
      .......,,,,,,,,,,,,,,,,'''''~ ^~~''',,,,...........................      
     ......,,,,,,,,,,,,,,,,''''''~!:<!!~'''',,,,..........................     
     .....,,,,,,,,,,,,,,,,''''''~~!^/;/ ~'''',,,,.........................     
    ....,,,,,,,,,,,,,,,,'''''''~~~^:[X[^!~'''',,,,,........................    
    ...,,,,,,,,,,,,,,,,'''''''~~~!:;  /:!~~'''',,,,,.......................    
   ...,,,,,,,,,,,,,,,,'''''''~~~!/ o  Xx^~~~'''',,,,,.......................   
   ..,,,,,,,,,,,,,,,,'''''''~~!!^:?     :!~~~~'',,,,,,......................   
  ...,,,,,,,,,,,,,,,''''''~~!!!^^;      :^!!~~~'',,,,,.......................  
  ..,,,,,,,,,,,,,,''''''~~!:::::;[?    &[;:!!!<~'',,,,,......................  
  .,,,,,,,,,,,,,,'''''~~~!^& <[          ? :::o^~',,,,,,.....................  
 ..,,,,,,,,,,,,,''''~~~~!!^<  x            <?ooo~',,,,,,...................... 
 .,,,,,,,,,,,,,''~~~~~~!!^:[                   ;~~',,,,,,..................... 
 .,,,,,,,,,,,''~~~~~~~!!!: <                   ^!~',,,,,,..................... 
 ,,,,,,,,,'''~!!!~~~!!!^^                     <^!~'',,,,,,.................... 
.,,,,,,,'''~~^<^^^^^^^^^:/                    O[o~'',,,,,,.....................
.,,,,'''''~~!^o;;;&[::::[                        ~'',,,,,,.....................
,,,''''''~~~!^[x#<& ?/;[/                      ?:!'',,,,,,,....................
,,''''''~~~~^^;o      &/&                      ?;~''',,,,,,....................
,''''''~~~~^^;/        xO                       ^~''',,,,,,....................
''''''~~~!^<;/O                                 !~''',,,,,,....................
'''''!!!!^:<&o                                 :!~''',,,,,,....................
~~!^:^!^:;[o                                  [^!~''',,,,,,....................
                                             <:^!~''',,,,,,,...................
~~!^:^!^:;[o                                  [^!~''',,,,,,....................
'''''!!!!^:<&o                                 :!~''',,,,,,....................
''''''~~~!^<;/O                                 !~''',,,,,,....................
,''''''~~~~^^;/        xO                       ^~''',,,,,,....................
,,''''''~~~~^^;o      &/&                      ?;~''',,,,,,....................
,,,''''''~~~!^[x#<& ?/;[/                      ?:!'',,,,,,,....................
.,,,,'''''~~!^o;;;&[::::[                        ~'',,,,,,.....................
.,,,,,,,'''~~^<^^^^^^^^^:/                    O[o~'',,,,,,.....................
 ,,,,,,,,,'''~!!!~~~!!!^^                     <^!~'',,,,,,.................... 
 .,,,,,,,,,,,''~~~~~~~!!!: <                   ^!~',,,,,,..................... 
 .,,,,,,,,,,,,,''~~~~~~!!^:[                   ;~~',,,,,,..................... 
 ..,,,,,,,,,,,,,''''~~~~!!^<  x            <?ooo~',,,,,,...................... 
  .,,,,,,,,,,,,,,'''''~~~!^& <[          ? :::o^~',,,,,,.....................  
  ..,,,,,,,,,,,,,,''''''~~!:::::;[?    &[;:!!!<~'',,,,,......................  
  ...,,,,,,,,,,,,,,,''''''~~!!!^^;      :^!!~~~'',,,,,.......................  
   ..,,,,,,,,,,,,,,,,'''''''~~!!^:?     :!~~~~'',,,,,,......................   
   ...,,,,,,,,,,,,,,,,'''''''~~~!/ o  Xx^~~~'''',,,,,.......................   
    ...,,,,,,,,,,,,,,,,'''''''~~~!:;  /:!~~'''',,,,,.......................    
    ....,,,,,,,,,,,,,,,,'''''''~~~^:[X[^!~'''',,,,,........................    
     .....,,,,,,,,,,,,,,,,''''''~~!^/;/ ~'''',,,,.........................     
     ......,,,,,,,,,,,,,,,,''''''~!:<!!~'''',,,,..........................     
      .......,,,,,,,,,,,,,,,,'''''~ ^~~''',,,,...........................      
       .......,,,,,,,,,,,,,,,,,,''''~''',,,,,...........................       
       ..........,,,,,,,,,,,,,,,,,,,,,,,,,..............................       
        ............,,,,,,,,,,,,,,,,,,,................................        
         ...............,,,,,,,,,,,...................................         
          ...........................................................          
           .........................................................           
            .......................................................            
             .....................................................             
              ...................................................              
               .................................................               
                 .............................................                 
                  ...........................................                  
                    .......................................                    
                      ...................................                      
                        ...............................                        
                           .........................                           
                               .................                                ok

Posted: **Wed Jun 26, 2019 8:17 am**

I converted the Mandelbrot routine to output to VGA over a higher resolution on the P2.

Code: Select all

TAQOZ

FORGET *MANDELBROT*

: *MANDELBROT*	;
( NOTE: Adapted from a routine written by Martin H )

20		:= #MAXITER
220		:= #MAXVAL
-229		:= #MINVAL

pub SCALE		5 << ;
20 SCALE	:= #RESCALE

\ These variables hold values during the escape calculation.
long CREAL
long CIMAG
long ZREAL
long ZIMAG
long ESCCNT

\ stores the row column values from the stack for the escape calculation.
pri INIT_VARS
  SCALE DUP CREAL ! ZREAL !
  SCALE DUP CIMAG ! ZIMAG !
  1 ESCCNT ! ;

\ Compute squares, but rescale to remove extra scaling factor.
pri ZSQ		@ ABS DUP #RESCALE */ ;
\ Increment ESCCNT and compare to max iterations.
pri COUNT?  	ESCCNT ++ ESCCNT @ #MAXITER > ;

\ Performs a single iteration of the escape calculation.
pri DOESCAPE
    ZREAL ZSQ  ZIMAG ZSQ 2DUP +
    #RESCALE 4* > IF
      2DROP TRUE
    ELSE
      - CREAL @ +   ( result )
      ZREAL @ ABS ZIMAG @ ABS #RESCALE 2/ */
--- workaround for */ sign bug
      ZREAL @ ZIMAG @ XOR 31 >> IF NEGATE THEN ( result val )
      CIMAG @ + ZIMAG ! ZREAL !
      COUNT?
    THEN ;

\ Iterates on a single cell to compute its escape factor.
pri DOCELL ( row cell -- )
  INIT_VARS BEGIN DOESCAPE UNTIL
--- expand the color and plot the pixel
  ESCCNT @ 11 W* PIXEL! 1 X+!
  ;

\ For each cell in a row.
pri DOROW  	#MAXVAL #MINVAL DO DUP I DOCELL LOOP DROP ;

\ For each row in the set.
pub MANDELBROT
  CLRSCR !PALETTE TL
  #MAXVAL #MINVAL DO 1 Y+! 0 x I DOROW LOOP
  ;

pub ZOOM ( n -- )		SCALE ' #RESCALE :=! MANDELBROT ;

\ Run the computation with defaults
pub GO			200 ZOOM ;

END

Posted: **Tue Mar 02, 2021 3:51 am**

commodorejohn wrote:

Yeah, that's always struck me funny - I don't doubt that there are probably useful applications for recursion

Tree traversal comes to mind.
The recursive routines in Turtle Geometry that draw the Koch snowflake and C curve are other examples.

Quote:

but man alive do they always pick the worst ones to demonstrate.

On one hand, I'd like to give them the benefit of the doubt. Maybe they didn't know about some of these other examples.
On the other, maybe they don't like recursion. It occurs to me that some people when confronted with a technique they don't like, will pick examples to cast it in the worst possible light.

Posted: **Tue Mar 02, 2021 9:11 am**

I think recursion is (or can be) a classic case of divide and conquer: when you're fully embracing structured programming, and not agonising about the cost of procedure calls, it's natural (or it becomes natural) to solve a tiny slice of the problem and then solve the remaining problem - or, to solve the simplest case and then to solve the problem as two half-sized problems.

When it comes to picking examples, perhaps the point of some of the simplest examples is illustration, not motivation. It's not that factorial or fibonacci are such excellent fits, it's that they are simple enough to see what's going on.

Posted: **Wed Mar 03, 2021 1:03 am**

Basic tree traversal would actually be a nice balance of "simple" and "actually makes any dang sense" if you could put together a trivial, easily-understood test-case for it.

Posted: **Sat Mar 06, 2021 1:25 am**

The last time I wrote anything with trees was not in Forth or the 65XX family of processors so here are examples of recursion with turtle graphics. The first draws a C curve similar to a Levy C curve but this one skips every other step.

Code: Select all

30 VALUE LIM
: CCURVE  ( SIZE -- )
   DUP LIM < IF  FD EXIT  THEN 
   90 LT DUP 2/ RECURSE 
   90 RT DUP 2/ RECURSE  DUP 2/ RECURSE 
   90 RT 2/ RECURSE 
   90 LT ;

This version stops the recursion when the line length is less than the value of LIM .
Setting LIM to 5 and executing CCURVE with 64 on the stack produces the following image:

This version limits the recursion based on the depth of recursion:

Code: Select all

: CCURVE  ( SIZE DEPTH -- )
   ?DUP
   IF
      1- SWAP 2/ SWAP
      90 LT  2DUP RECURSE
      90 RT  2DUP RECURSE  2DUP RECURSE
      90 RT  RECURSE
      90 LT
      EXIT
   THEN
   FD ;

With this version, the following will produce the same curve:

Code: Select all

64 4 CCURVE

This draws the Koch snowflake:

Code: Select all

: KOCH/3 
   DUP LIM < IF  FD EXIT  THEN 
   DUP 3 / RECURSE 
   60 LT DUP 3 / RECURSE 
   120 RT DUP 3 / RECURSE 
   60 LT 3 / RECURSE ;

: KOCH 30 RT 
   3 0 
   DO 
      DUP KOCH/3 120 RT 
   LOOP 
   DROP 30 LT ;

This example could ( and maybe should) be rewritten to limit recursion by depth. Here are a series of images based on depth of recursion:

Notice the brevity of the code versus the complexity of the images. With a higher video resolution, these words could achieve even more complexity of the image just by setting the recursion depth deeper ( with a larger starting size). With the second version of CCURVE and a system that had much higher video resolution, just think what 1024 8 CCURVE would look like.

Posted: **Thu Sep 09, 2021 2:53 am**

Previously in this thread, I mentioned porting Blazin' Forth's TRACE word to Fleet Forth. One limitation was the inability to trace a word using Forth's pictured numeric output words (not Forth's words . .R and so on, but <# #S #> HOLD and so on) because .S overwrites the area below PAD . The following modification overcomes this limitation by temporarily moving PAD an extra 170 bytes above HERE and saving the value of HLD while the trace information is displayed then restoring both.

Code: Select all

VARIABLE CON
: CONT   CON ON ;
: +PAD
   $FF ?MEM
   [ ' PAD >BODY 2+ 2+ ] LITERAL
   C! ;
: -PAD
   $55
   [ ' PAD >BODY 2+ 2+ ] LITERAL
   C! ;
: NOTRACE
   NEXT>  -PAD
   ." TRACING OFF" QUIT ;
: STEP  ( CFA -- )
   NEXT>  HLD @ >R +PAD
   CR @ .NAME TAB .S
   KEY DUP>R ASCII" {CONTROL P}" =
   IF
      CON OFF
      BEGIN
         CR ." P? "
         QUERY INTERPRET  CON @
      UNTIL
   THEN
   -PAD  R> R> HLD !
   ASCII" {RUN/STOP}" = IF   NOTRACE  THEN
   <IP> >NEXT ;NEXT ;
' STEP 'TRACE !

[Edit: Updated code. This is the latest version.]

Posted: **Sat Sep 11, 2021 8:30 pm**

@Jim, thanks for the C curve and snowflake code. Interesting and easy with turtle graphics.

Posted: **Sat Sep 18, 2021 12:04 am**

You're welcome.
Scott Ballantyne's Blazin' Forth for the C64 has more examples of recursion with turtle graphics. The examples are on the system loader disk on screens 130 through 138. Some of these recursive routines are mentioned in the book "Turtle Geometry: The Computer as a Medium for Exploring Mathematics" by Harold Abelson and Andrea A. diSessa from The MIT Press.

Posted: **Sat May 14, 2022 5:03 pm**

Conway's game of life is a classic CS-101 problem that people encounter, and I realized that I've never written one. For me the only way to truly understand an algorithm is to write one myself, so I decided to give it a whirl using Forth.

On modern hardware it's plenty fast enough. But upon completion I realized there's a number of inefficiencies. The top few are:
* I used a byte array to store bit values. A bit vector would be slower, but more space efficient.
* Copying the next gen memory back to the current gen is inefficient. Swapping pointers would likely be better.
* While iterating a single cell I use multiply row * width nine times. Even on modern hardware integer multiply is about five times more costly than addition. Reusing the first multiply would be better.

Update: I realized that if row enumeration added width instead of 1 I would effectively by multiplying through addition. But only once per line, rather than nine times per cell. So I updated the code and it should be a performance boost.

My version is in my git hub repo https://github.com/Martin-H1/Forth-CS-1 ... r/life.fth
But here's a cut and paste of the code:

Code: Select all


\ See http://en.wikipedia.org/wiki/Conway's_Game_of_Life

\ constants for board height and width
24 constant height
32 constant width
height width * constant size

\ allocate two arrays to hold current and next generations
create gen_curr size allot
create gen_next size allot

\ iterators and their associated operators
variable row
variable col

\ Sets the row offset to zero
: rowFirst ( -- ) 0 row ! ;

\ Advances the offset by the width.
: rowNext ( -- )
    width row +! ;

\ At end if current offset exceeds array size.
: rowAtEnd?
    row @ size >= ;

\ Iterator used to apply a function to the rows.
: rowForEach ( xt -- )
    rowFirst
    begin
	dup execute rowNext rowAtEnd?
    until
    drop ;

\ Returns index of the row after current using wrap around.
: row+ ( -- index )
    row @ width + size mod ;

\ Returns index of the column before current using wrap around.
: row- ( -- index )
    row @ width - size mod ;

: colFirst 0 col ! ;

: colNext
    1 col +! ;

: colAtEnd?
    col @ width >= ;

: colForEach ( xt -- )
    colFirst
    begin
	dup execute colNext colAtEnd?
    until
    drop ;

\ Returns index of the column after current using wrap around.
: col+ ( -- index )
    col @ 1 + width mod ;

\ Returns index of the column before current using wrap around.
: col- ( -- index )
    col @ 1 - width mod ;

\ moves bytes from next gen to current.
: moveCurr ( -- )
    gen_next gen_curr size move ;

\ clears curr array to clear out junk in ram
: currErase ( -- )
    gen_curr size erase ;

\ retrieve a cell value from the current generation
: curr@ ( col row -- n )
    + gen_curr + c@ ;

\ stores a value into a cell from the current generation
: curr! ( n col row -- )
    + gen_curr + c! ;

\ Parses a pattern string into current board.
\ This function is unsafe and will over write memory.
: >curr ( addr count -- )
    currErase
    rowFirst colFirst
    1-
    for
        dup c@
        dup '|' <> if
            bl <> 1 and
            col @ row @ curr!
	    colNext
	else
	    drop
	    rowNext
	    colFirst
	then
	1+
    next
    drop ;

: .cell ( -- )
    col @ row @ curr@
    if '*' else '.' then
    emit ;

\ prints the row from the current generation to output
: .currRow ( -- )
    cr ['] .cell colForEach ;

\ Prints the current board generation to standard output
: .curr
    ['] .currRow rowForEach
    cr ;

\ retrieve a cell value from the next generation
: next@ ( col row -- n )
    + gen_next + c@ ;

\ stores a cell into the next generation
: next! ( n col row -- )
    + gen_next + c! ;

\ computes the sum of the neigbors of the current cell.
: calcSum ( -- n )
   col-  row-  curr@
   col @ row-  curr@ +
   col+  row-  curr@ +
   col-  row @ curr@ +
   col+  row @ curr@ +
   col-  row+  curr@ +
   col @ row+  curr@ +
   col+  row+  curr@ + ;

: calcCell ( -- )
    calcSum

    \ Unless explicitly marked live, all cells die in the next generation.
    \ There are two rules we'll apply to mark a cell live.

    \ Is the current cell dead?
    col @ row @ curr@ 0=
    if
        \ Any dead cell with three live neighbours becomes a live cell.
	3 =
    else
	\ Any live cell with two or three live neighbours survives.
        dup 2 >= swap 3 <= and
    then
    1 and
    col @ row @ next! ;

: calcRow ( row -- )
    ['] calcCell colForEach ;

: calcGen ( -- )
    ['] calcRow rowForEach
    moveCurr ;

: life ( -- )
    page
    begin calcGen 0 0 at-xy .curr key? until ;

\ Test cases taken from Rosetta code's implementation
: blinker s" |***" >curr ;
: toad s" ***| ***" >curr ;
: pentomino s" **| **| *" >curr ;
: pi s" **| **|**" >curr ;
: glider s"  *|  *|***" >curr ;
: pulsar s" *****|*   *" >curr ;
: ship s"  ****|*   *|    *|   *" >curr ;
: pentadecathalon s" **********" >curr ;
: clock s"  *|  **|**|  *" >curr ;

6502.org

CS-101 problems and their FORTH solutions.

Re: CS-101 problems and their FORTH solutions.

Re: CS-101 problems and their FORTH solutions.

Re: CS-101 problems and their FORTH solutions.

Re: CS-101 problems and their FORTH solutions.

Re: CS-101 problems and their FORTH solutions.

Re: CS-101 problems and their FORTH solutions.

Re: CS-101 problems and their FORTH solutions.

Re: CS-101 problems and their FORTH solutions.

Re: CS-101 problems and their FORTH solutions.

Re: CS-101 problems and their FORTH solutions.

Re: CS-101 problems and their FORTH solutions.

Re: CS-101 problems and their FORTH solutions.

Re: CS-101 problems and their FORTH solutions.

Re: CS-101 problems and their FORTH solutions.

Re: CS-101 problems and their FORTH solutions.