6502.org • View topic - CS-101 problems and their FORTH solutions.

View unanswered posts | View active topics

Board index » 6502.org Users Forum » Forth

All times are UTC

CS-101 problems and their FORTH solutions.

Page 4 of 6

[ 85 posts ]

Go to page Previous 1, 2, 3, 4, 5, 6 Next

Previous topic | Next topic

Author

Message

JimBoyd

Post subject: Re: CS-101 problems and their FORTH solutions.

Posted: Tue Jan 29, 2019 10:23 pm

Joined: Fri May 05, 2017 9:27 pm
Posts: 864

GARTHWILSON wrote:

Martin_H wrote:

This might be an embarrassing admission, but does Forth usually contain a run time trace and profile feature? I've never used one.

This was one of the things I had in mind when I implemented an indirect jump to NEXT in my '816 Forth; but have never used the trace. The idea is that if you want to start/stop a trace, you just put the address of a different (more complex) version of NEXT in variable NEXTadr which you use as the address for the indirect jump. Then JMP NEXT becomes JMP (NEXTadr). You could invent versions of NEXT on the fly to meet special needs.

Blazin' Forth had TRACE as part of the system loader ( Blazin' Forth included a disk with the system loader in source form on Forth blocks). There was a code word >NEXT that took an address from the stack and patched NEXT with a jump to that address. The new NEXT would be something like:

Code:

   1 # LDY,
   IP )Y LDA,  W 1+ STA,  DEY,
   IP )Y LDA,  W    STA,
   <some.address> JMP,

There was also the code word NEXT> to restore NEXT .
Here is the code from the Blazin' Forth system loader.

Code:

SCR #19 
 0 ( UTILITIES -- DEBUGGING: RP@ UNRAVEL ?PARAMS         SDBJUN85)
 1 CODE RP@ ( -- ADDR RETURN STACK 1- )
 2 XSAVE STX, TSX, TXA, PHA, 1 # LDA, XSAVE LDX, PUSH JMP, END-CODE
 3 
 4 : ID? ( TRUE IF VALID NAME)
 5       DUP @ [ ' : @ ] LITERAL =
 6      SWAP @ C@ [ ' FORTH @ C@ ] LITERAL = OR ;

SCR #20 
 0 ( UTILITIES -- DEBUGGING: ;NEXT NEXT> >NEXT           SDBJUN85)
 1 HEX
 2 VARIABLE 'TRACE   VARIABLE <IP  VARIABLE IP>
 3 
 4 CODE ;NEXT ( EXIT THEN NEXT )
 5 ( EXIT) PLA, IP STA, PLA, IP 1+ STA,
 6 ( GET W) PLA, W STA, PLA, W 1+ STA,
 7 ( NEXT) CLC, IP LDA, 2 # ADC, IP STA, CS
 8   IF, IP 1+ INC, THEN, 0 # LDY, W 1- JMP, END-CODE
 9 
10 CODE NEXT> ( RESTORE NEXT)
11  018 # LDA, NEXT 0B + STA, 0A5 # LDA, NEXT 0C + STA,
12  084 # LDA, NEXT 0D + STA, NEXT JMP, END-CODE
13 
14 
15 DECIMAL

SCR #21 
 0 ( UTILITIES - DEBUGGING: >NEXT <IP> ID.L              SDBJUL85)
 1 HEX
 2 CODE >NEXT ( N -- POINT NEXT TO N)
 3  04C # LDA, NEXT 0B + STA, BOT LDA, NEXT 0C + STA,
 4  BOT 1+ LDA, NEXT 0D + STA, POP JMP, END-CODE
 5 
 6 CREATE <IP>   ASSEMBLER
 7   <IP LDA, IP CMP, <IP 1+ LDA, IP 1+ SBC, CS NOT
 8     IF, IP> LDA, IP CMP, IP> 1+ LDA, IP 1+ SBC, CS
 9      IF, DEX, DEX, IP LDA, BOT STA, IP 1+ LDA, BOT 1+ STA,
10      W 1+ LDA, PHA, W LDA, PHA,
11      'TRACE LDA, W STA, 'TRACE 1+ LDA, W 1+ STA, W 1- JMP,
12     THEN, THEN, ' ;NEXT @ 0C + JMP, DECIMAL
13 
14 : ID.L  ( CFA LEN -- )
15    OVER >NAME DUP ID. SPACE ROT 1- - + SPACES ;

SCR #22 
 0 ( UTILITIES - DEBUGGERS: 'EXIT STEP TRACE CONT        SDBJUL85)
 1 : 'EXIT ( CFA -- LAST WORD)
 2    BEGIN 1+ DUP @ ['] EXIT = UNTIL ;
 3 VARIABLE CON
 4 : STEP ( CFA -- )
 5    NEXT>  CR @ 10 ID.L .S SPACE KEY CONTROL "{CONTROL P}" OVER = IF
 6     CON OFF DROP CR ." P? "
 7     BEGIN QUERY RUN CR ." P? " CON @ UNTIL
 8    THEN CONTROL "{RUN/STOP}" OVER = IF
 9     DROP CR ." TRACING OFF" QUIT
10    THEN DROP <IP> >NEXT ;NEXT ;  ' STEP 'TRACE !
11 
12 : TRACE   NEXT> ' DUP ID? NOT ABORT" CAN'T TRACE"
13           DUP <IP !  'EXIT IP> !  <IP> >NEXT ;
14 : NOTRACE   NEXT>  ." TRACING OFF" QUIT ;
15 : CONT     CON ON 0 ;

I was able to get this to work with Fleet Forth, but I had to change one thing.

Code:

084 # LDA,

Was changed to:

Code:

IP # LDA,

Because Blazin' Forth's IP is at $84-$85 and Fleet Forth's is at $FB-$FC. Besides, using the constant for IP makes it a little more portable.
TRACE was followed by the name of a word to trace but did not initiate a trace, tracing occurred when IP was between two addresses stored in <IP and IP> so the word was traced whenever it was executed until tracing was turned off.
Blazin' Forth used ID? to determine if a word was one that could be traced. It used 'EXIT to find where the word to be traced ended. Since my decompiler does a better job at determining where a word ends and low level code in the trace range is harmless, I put TRACE in its own block and modified the load screen slightly:

Code:

SCR# 1 
 0: ( BLAZIN' FORTH 85 SYSTEM LOADER        )
 1:  VIEW OFF
 2:  DECIMAL
 3:  CR 13     LOAD
 4:  CR 15  22 THRU .// UTILITIES
 5:  " SAD" FIND NIP 9 AND 23 LINELOAD
 6: 
 7:  CR 50  57 THRU .// STRINGS
 8:  CR 58  70 THRU .// SID SUPPORT
 9:  CR 71 104 THRU .// VIC SUPPORT
10: 
11:  VIEW ON    .( LOCATE ENABLED) CR

SCR# 23 
 0: // TRACE
 1: DECIMAL
 2: : TRACE
 3:    NEXT>  ' DUP ID? NOT
 4:    ABORT" CAN'T TRACE"
 5:    DUP <IP !  'EXIT IP> !
 6:    <IP> >NEXT ;
 7: ;S
 8: // IF THE DECOMPILER IS AVAILABLE
 9: // HERE IS A BETTER TRACE
10: : TRACE
11:    NEXT>  SAD OFF  SEE
12:    SAD @ ?DUP 0=
13:    ABORT" CAN'T TRACE"
14:    2- <IP !  EAD @ IP> !
15:    <IP> >NEXT ;

;S stops loading of a block ( it will also stop interpretation/compilation of text from the keyboard). it is an alias for EXIT . It is actually a 'code word' with its CFA pointing to the body of EXIT , it has no body of its own.
SAD is a variable that holds the starting address of the latest decompiled word ( the address of its parameter field or body). EAD holds the ending address, or rather the address just past the end of the latest decompiled word.

Code:

EAD @ SAD @ - .

Gives the size of the latest decompiled word's body.
Oh and where there is a // , just think backslash ( \ ). The Commodore 64 has no backslash key.

[Edit: Fixed the source code. This source is from a print dump and the print dump functionality does not support the Commodore 64's quote mode. Where the source shows {CONTROL P} , press the C64's control key and the P key. Where it shows {RUN/STOP} , press the C64's run/stop key.]

Last edited by JimBoyd on Wed Feb 06, 2019 9:18 pm, edited 1 time in total.

Top

GARTHWILSON

Post subject: Re: CS-101 problems and their FORTH solutions.

Posted: Tue Jan 29, 2019 10:34 pm

Joined: Fri Aug 30, 2002 1:09 am
Posts: 8453
Location: Southern California

JimBoyd wrote:

That would be a little more efficient than mine, as it eliminates the indirect jump. The comparison of the overall efficiency might vary, because I also used mine to service interrupts in high-level Forth. If you had a lot of interrupts, the extra overhead of constantly patching and restoring the beginning part of NEXT would make for a performance hit.

_________________
http://WilsonMinesCo.com/ lots of 6502 resources
The "second front page" is http://wilsonminesco.com/links.html .
What's an additional VIA among friends, anyhow?

Top

JimBoyd

Post subject: Re: CS-101 problems and their FORTH solutions.

Posted: Wed Jan 30, 2019 10:46 pm

Joined: Fri May 05, 2017 9:27 pm
Posts: 864

GARTHWILSON wrote:

JimBoyd wrote:

Huh? Patching NEXT is waaaay faster than I can type TRACE SOMEWORD .When a word is set to be traced, NEXT stays patched until NOTRACE is executed.
Suppose I have a word, BADWORD , that's not doing what I expect. I type TRACE BADWORD . The trace does not begin right away. Whenever BADWORD is executed, whether directly or from another word, the trace begins. The stack contents and the word to be executed are displayed and Forth waits for a keypress before resuming the trace. When I no longer wish to have BADWORD traced, I type NOTRACE and the trace is stopped.
A range of words can be traced by setting <IP to the low address of the trace range and setting IP> to the high address +1 of the trace range. For example:

Code:

NEXT>
HERE <IP !
<LOAD SOME NEW DEFINITIONS>
HERE IP> ! 
<IP> >NEXT

Will cause all the definitions just loaded to be traced whenever they are executed.

Top

JimBoyd

Post subject: Re: CS-101 problems and their FORTH solutions.

Posted: Wed Jan 30, 2019 10:51 pm

Joined: Fri May 05, 2017 9:27 pm
Posts: 864

Oh wait! Do you mean if the code level ISR patched the beginning of NEXT to handle high level interrupts and the high level interrupt called the code to unpatch it?

Top

GARTHWILSON

Post subject: Re: CS-101 problems and their FORTH solutions.

Posted: Wed Jan 30, 2019 11:15 pm

Joined: Fri Aug 30, 2002 1:09 am
Posts: 8453
Location: Southern California

Right, and for the Forth ISR's exit word to know which patch to put back in NEXT. Actually that part could go in a stack as well, so you could have more than one level of different NEXTs stored. Due to the kind of things I've used my workbench computer and other embedded systems for, I've very interrupt-conscious, and always looking for much faster interrupt performance than other users typically think in terms of. I have not had time to think about this much. Hopefully I can get back to it this year. You've had a ton of good posts I hope to be able to digest better in the future.

_________________
http://WilsonMinesCo.com/ lots of 6502 resources
The "second front page" is http://wilsonminesco.com/links.html .
What's an additional VIA among friends, anyhow?

Top

JimBoyd

Post subject: Re: CS-101 problems and their FORTH solutions.

Posted: Fri Feb 01, 2019 11:06 pm

Joined: Fri May 05, 2017 9:27 pm
Posts: 864

GARTHWILSON wrote:

Due to the kind of things I've used my workbench computer and other embedded systems for, I've very interrupt-conscious, and always looking for much faster interrupt performance than other users typically think in terms of.

Good thing you're using an indirect jump to NEXT if you have tracing capability. Blazin' Forth's TRACE slows down the system. The code NEXT is redirected to checks to see if IP is within a specific address range to determine if it should trace or not, and that takes time. It's worth it if you need to trace something though. 64Forth, which was a superset of FIG Forth, had a different TRACE . Any needed parameters were placed on the data stack and the sequence

Code:

TRACE SOME.WORD

was entered. The trace began immediately. This did not slow the system down because the trace took place right then and only then, but it was not the best way to perform a trace, if you ask me. There are two situations where the method used by Blazin' Forth is better. The first is when tracing words like (MAKE) , a high level word compiled by MAKE from Leo Brodie's DOER/MAKE . (MAKE) , like BRANCH and ?BRANCH , must be executed from within a Forth word. Here is a session showing a trace of (MAKE)

Code:

TRACE (MAKE) 
(MAKE)
 A071 1205 R>
 A073 1422 DUP
 A075 126B 2+
 A077 1422 DUP
 A079 126B 2+
 A07B 13EA SWAP
 A07D 1313 @
 A07F 1A36 >BODY
 A081 1337 !
 A083 1313 @
 A085 1433 ?DUP
 A087  9F6 ?BRANCH A08D 
 A08B 11F5 >R
 A08D  94F EXIT
 OK
RECITAL 
YOUR DADDY IS STANDING ON THE TABLE.  ASK HIM 'WHY?' 
R>         STACK EMPTY  
DUP         A14F  
2+          A14F  A14F  
DUP         A14F  A151  
2+          A14F  A151  A151  
SWAP        A14F  A151  A153  
@           A14F  A153  A151  
>BODY       A14F  A153  A101  
!           A14F  A153  A103  
@           A14F  
?DUP           0  
?BRANCH        0  
EXIT       STACK EMPTY   OK
WHY? 
TO CHANGE THE LIGHT BULB.
R>         STACK EMPTY  
DUP         A171  
2+          A171  A171  
DUP         A171  A173  
2+          A171  A173  A173  
SWAP        A171  A173  A175  
@           A171  A175  A173  
>BODY       A171  A175  A101  
!           A171  A175  A103  
@           A171  
?DUP           0  
?BRANCH        0  
EXIT       STACK EMPTY  
WHY? 
BECAUSE IT'S BURNED OUT.
R>         STACK EMPTY  
DUP         A192  
2+          A192  A192  
DUP         A192  A194  
2+          A192  A194  A194  
SWAP        A192  A194  A196  
@           A192  A196  A194  
>BODY       A192  A196  A101  
!           A192  A196  A103  
@           A192  
?DUP           0  
?BRANCH        0  
EXIT       STACK EMPTY  
WHY? 
BECAUSE IT WAS OLD.
R>         STACK EMPTY  
DUP         A1AE  
2+          A1AE  A1AE  
DUP         A1AE  A1B0  
2+          A1AE  A1B0  A1B0  
SWAP        A1AE  A1B0  A1B2  
@           A1AE  A1B2  A1B0  
>BODY       A1AE  A1B2  A101  
!           A1AE  A1B2  A103  
@           A1AE  
?DUP           0  
?BRANCH        0  
EXIT       STACK EMPTY  
WHY? 
BECAUSE WE PUT IT IN THERE A LONG TIME AGO.
R>         STACK EMPTY  
DUP         A1E2  
2+          A1E2  A1E2  
DUP         A1E2  A1E4  
2+          A1E2  A1E4  A1E4  
SWAP        A1E2  A1E4  A1E6  
@           A1E2  A1E6  A1E4  
>BODY       A1E2  A1E6  A101  
!           A1E2  A1E6  A103  
@           A1E2  
?DUP           0  
?BRANCH        0  
EXIT       STACK EMPTY  
NOTRACE TRACING OFF
WHY? 
BECAUSE IT WAS DARK!
WHY? 
BECAUSE IT WAS NIGHT TIME!!
WHY? 
STOP SAYING WHY?
WHY? 
BECAUSE IT'S DRIVING ME CRAZY.
WHY? 
JUST LET ME CHANGE THIS LIGHT BULB!
CONSOLE  OK

The other situation is when you suspect SOME.WORD is not working right and you want to trace it. When executing SOME.WORD with the right parameters everything works fine. you execute BAD.WORD , which calls SOME.WORD and the trace begins. You see that SOME.WORD got called with some oddball parameters. Aha! Let's trace BAD.WORD.

Top

JimBoyd

Post subject: Re: CS-101 problems and their FORTH solutions.

Posted: Wed Feb 06, 2019 9:44 pm

Joined: Fri May 05, 2017 9:27 pm
Posts: 864

A few posts back, I showed the source code for Blazin' Forth's TRACE utility. The source was a print dump of the listing of the blocks from Blazin' Forth's system loader disk. The print dump functionality does not support the C64's quote mode and the first instance of using Blazin' Forth's word CONTROL to get the ASCII value of the control-P key combination printed nothing. The next instance to get the ASCII value of the Run/Stop key printed a dot. The original post has been edited and here is a screen shot showing the source from the disk that was modified to support Fleet Forth. It uses ASCII" instead of CONTROL .

Attachment:

step source.png [ 21.87 KiB | Viewed 4003 times ]

ASCII" is more efficient:

Code:

: ASCII"
   [COMPILE] ASCII ; IMMEDIATE

and used as:

Code:

ASCII" C"

Where C is one of the C64's reverse video control characters.
Here is Blazin' Forth's CONTROL

Code:

: CONTROL  ASCII " WORD 1+ C@ STATE @
           IF [COMPILE] LITERAL THEN ; IMMEDIATE

And it's used as:

Code:

CONTROL "C"

Top

JimBoyd

Post subject: Re: CS-101 problems and their FORTH solutions.

Posted: Mon Feb 25, 2019 9:46 pm

Joined: Fri May 05, 2017 9:27 pm
Posts: 864

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.

Top

Martin_H

Post subject: Re: CS-101 problems and their FORTH solutions.

Posted: Fri May 03, 2019 9:00 pm

Joined: Wed Jan 08, 2014 3:31 pm
Posts: 575

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:

\ 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 ;

Top

JimBoyd

Post subject: Re: CS-101 problems and their FORTH solutions.

Posted: Sat May 04, 2019 11:14 pm

Joined: Fri May 05, 2017 9:27 pm
Posts: 864

Martin_H wrote:

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:

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

[Edit: fixed formatting error on my part.]

Last edited by JimBoyd on Tue Jul 02, 2019 8:06 pm, edited 1 time in total.

Top

commodorejohn

Post subject: Re: CS-101 problems and their FORTH solutions.

Posted: Sat May 04, 2019 11:30 pm

Joined: Thu Jan 21, 2016 7:33 pm
Posts: 270
Location: Placerville, CA

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.

Top

pbj

Post subject: Re: CS-101 problems and their FORTH solutions.

Posted: Wed Jun 26, 2019 3:28 am

Joined: Mon Jun 24, 2019 1:13 pm
Posts: 34

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:

-------------------------------------------------------------------------------
  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:

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

Top

pbj

Post subject: Re: CS-101 problems and their FORTH solutions.

Posted: Wed Jun 26, 2019 7:00 am

Joined: Mon Jun 24, 2019 1:13 pm
Posts: 34

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:

                               .................                               
                           .........................                           
                        ...............................                        
                      ...................................                      
                    .......................................                    
                  ...........................................                  
                 .............................................                 
               .................................................               
              ...................................................              
             .....................................................             
            .......................................................            
           .........................................................           
          ...........................................................          
         ...............,,,,,,,,,,,...................................         
        ............,,,,,,,,,,,,,,,,,,,................................        
       ..........,,,,,,,,,,,,,,,,,,,,,,,,,..............................       
       .......,,,,,,,,,,,,,,,,,,''''~''',,,,,...........................       
      .......,,,,,,,,,,,,,,,,'''''~ ^~~''',,,,...........................      
     ......,,,,,,,,,,,,,,,,''''''~!:<!!~'''',,,,..........................     
     .....,,,,,,,,,,,,,,,,''''''~~!^/;/ ~'''',,,,.........................     
    ....,,,,,,,,,,,,,,,,'''''''~~~^:[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

Top

pbj

Post subject: Re: CS-101 problems and their FORTH solutions.

Posted: Wed Jun 26, 2019 8:17 am

Joined: Mon Jun 24, 2019 1:13 pm
Posts: 34

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

Code:

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

Attachments:

mandelbrot.jpg [ 519.24 KiB | Viewed 5987 times ]

Top

JimBoyd

Post subject: Re: CS-101 problems and their FORTH solutions.

Posted: Tue Mar 02, 2021 3:51 am

Joined: Fri May 05, 2017 9:27 pm
Posts: 864

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.

Top

Page 4 of 6

[ 85 posts ]

Go to page Previous 1, 2, 3, 4, 5, 6 Next

Board index » 6502.org Users Forum » Forth

All times are UTC

Who is online

Users browsing this forum: No registered users and 9 guests

You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot post attachments in this forum