6502.org Forum  Projects  Code  Documents  Tools  Forum
It is currently Sun Nov 24, 2024 12:17 pm

All times are UTC




Post new topic Reply to topic  [ 87 posts ]  Go to page 1, 2, 3, 4, 5, 6  Next
Author Message
PostPosted: Mon May 09, 2016 1:33 pm 
Offline

Joined: Wed Jan 08, 2014 3:31 pm
Posts: 578
My flute/whistle instructor said the way to learn an instrument is to learn 100 songs. The approach worked well, so I learn new computer languages using the same technique. I write solutions to classic programming problems using my new target language. Several years ago I taught myself FORTH with this approach, and I figured I would post some of them here as people might enjoy them. One of these days I need to get these working on a 6502 FORTH.

The first program prints all the factors of a number. I found this one pretty simple to do.

Code:
\ predicate used to determine if a number is a divisor
: factor? ( n1 n2 - f )
   mod 0= ;

\ prints n2 if it is a factor of n1
: .factor ( n1 n2 - )
    tuck    \ n2 n1 n2
    factor? \ n2 f
    if
       .
    else
       drop
    then ;

\ prints all the numbers less than the number that are factors.
: factors ( n - )
  dup 2     \ from 2 to n
  do
    dup i   \ n n i
    .factor \ n
  loop
  drop ;


The second calculates the integer square root with rounding. I went kinda overboard with stack manipulations

Code:
\ compute the number with the highest non sign bit set.
1 cell 8 * 2 - lshift
create max_bit 1 cells allot
max_bit !

\ shift "bit" to the highest power of four <= n.
: starting_bit ( n - n start_bit )
   max_bit @
   begin 2dup <= while \ one > n
      2 rshift
   repeat ;

\ predicate who's name says it all
: n>=r+b? ( n r b - n r b f )
      \ copy n to return stack
      rot dup >r -rot

      \ compute result + bit
      2dup +

      \ n >= result + bit
      r> swap >= ;

\ round up n2 by one if n1 is greater
: round_up ( n1 n2 - n1 n2 )
   2dup > if
       1+
   then ;

\ Fast integer square root algorithm, with rounding the result to
\ the next greater integer if the fractional part is 0.5 or greater.
\ For example 2->1, 3->2, 4->2, 6->2, 7->3, 9->3
: isqrtr \ ( n - n^1/2 )
   \ Throughout the function we'll juggle three numbers on the stack:
   \ n (input), bit (computed), and result (output, starts at 0).
   starting_bit 0

   begin over while       \ bit is not zero

      n>=r+b? if
         2dup + >r        \ push result + bit to return stack
         rot r> - -rot    \ n = n - (result + one)
         over 2 * +       \ result += 2 * bit;
      then

      1 rshift swap       \ divide result by 2
      2 rshift swap       \ divide bit by 4.
   repeat

   \ bit has outlived its usefulness
   swap drop

   \ Do arithmetic rounding to nearest integer
   round_up

   \ clean off n to return only result.
   swap drop ;


The sieve of Eratosthenes for the first 1024 numbers using a bit vector for efficiency and the bit set and clear operations. One thing I don't like is that when it produces its output there's always a space between the number and the comma (e.g. 2 , 3 , 5 , ...). I would prefer something like 2, 3, 5, 7, ... but I can't figure out how to do that.

Code:
\ Begin borrowed code from http://www.forth.org/svfig/Len/bits.htm
\ Note: that code had a bug I fixed as indicated below.

\ Bit_array is a defining word that will create a bit array.
\ l is the number of bytes
create masks 128 c, 64 c, 32 c, 16 c, 8 c, 4 c, 2 c, 1 c,
: bit_array \ ( len -- ) ( i -- m a)
   create allot does>
      swap   \ a i
      8      \ a i 8
      /mod   \ a remainder whole
      swap   \ a whole remainder !MCH bug fix!
      masks  \ a whole remainder a
      +      \ a whole mask_a
      c@     \ a whole m
      -rot   \ m a whole
      + ;    \ m a

\ We also need words to store and fetch bits. The words .@ and .!
\ Will fetch and store, respectively, a Boolean flag on the stack to
\ a bit array. (Do not confuse .! with cset or .@ with creset.)

: .! ( f m a -- ) rot if cset else creset then ;
: .@ ( m a -- f ) c@ and 0<> ;

\ Examples
\ 3 bit-array thflag  \ Create a bit array for 24 bit-flags
\ 11 thflag ctoggle    \ Toggle the 11th bit
\ 10 thFLAG .@ ( -- f) \ Extract the 10th bit and leave as well-formed Boolean flag

\ End of borrowed code.

\ Create a bit vector to hold the sieve.
\ 128 bytes allows for all primes less than 1024.
128 bit_array sieve

\ locates the index of the first non-zero bit in the sieve
\ with an index greater than the input.
: find_one ( n -- n )
   1+ dup 1024 swap do
      i sieve .@ \ get the bit corresponding to the integer.
      if
         leave
      else
         1+
      then
   loop ;

\ sets bits starting at n.
: set_bits ( n -- )
   1024 swap
   do
      i sieve cset
   loop ;

\ clears bits starting at n in steps of n. So n=2 starts at 2
\ and clears every other bit. While n=3 starts at three and
\ clears every third bit. However, it then resets the first
\ bit as that number is prime.
: clear_bits ( n -- )
   dup 1024 swap
   do
      i sieve creset
      dup
   +loop
   sieve cset ;

\ We'll waste two bits for integers 0 and 1 which can't be prime
: do_sieve
  2 set_bits   \ Assume all numbers 2 or greater are prime.
  2            \ Initially, let p equal 2, the first prime number.

  begin dup 1024 < while
     dup          \ n n
     clear_bits   \ n
     find_one     \ index of first one > n
  repeat ;

\ iterates through the bit vector printing the index of a prime number
: .sieve
   ." List of primes "
   1024 0 do
      i sieve .@ \ get the bit corresponding to the integer.
      if
         i . ." , "
      then
   loop ;


String parsing is another important part of a language to understand. So I started looking into a FORTH program to parse a Roman numeral into an Arabic one. I found some pretty freaky FORTH to do this, so I began reverse engineering it, then completely re-wrote it.

Code:
\ Helpers used to create cell values, and access portion of the cell.
: makePair 7 lshift + ;  ( char value -- array[i] )
: >char  127 and ;       ( array[i] -- char )
: >value 7 rshift ;      ( array[i] -- value )

\ Create an associative array by left shifting Roman values with the assoicated character
create (arabic)
   char M 1000 makePair ,  \ 128077
   char D  500 makePair ,  \  64068
   char C  100 makePair ,  \  12867
   char L   50 makePair ,  \   6476
   char X   10 makePair ,  \   1368
   char V    5 makePair ,  \    726
   char I    1 makePair ,  \    201
does> ( char addr -- value value )
   7 cells      \ char addr 7*cell_size
   bounds       \ char addr+7*cell_size addr
   do
      i @       \ char array[i]
      over over \ char array[i] char array[i]
      >char =   \ char array[i] f
      if        \ chars match, then return value
         nip >value leave
      else
         drop   \ char
      then
      1 cells  \ increment index one cell.
   +loop
   dup
;

\ adds the value of char to sum and keeps a copy of its value in digit
: do_digit (  sum digit char -- new_sum new_digit )
   (arabic) >r   \ sum digit new_digit
   over over     \ sum digit new_digit digit new_digit
   < if
      \ old digit is less than new, so subtract it from sum
      -rot 2* negate +
      swap       \ adjusted_sum new_digit
   else
      nip        \ sum new_digit
   then
   + r>          \ new_sum new_digit
;

\ parses a counted string in roman numeral form.
: >arabic ( addr count - )
   0 -rot 0 -rot \ sum digit addr count
   begin
      over over  \ sum digit addr count addr count
      while      \ count is non-zero
      c@         \ load the character at addr
      -rot >r >r \ sum digit char
      do_digit   \ sum digit
      r> r>      \ sum digit addr count
      1 /string  \ advance to next character
   repeat
   \ ( sum digit addr count addr )
   2drop         \ sum digit addr
   2drop         \ sum
;

s" MCMLXXXIV" >arabic .


Top
 Profile  
Reply with quote  
PostPosted: Mon May 09, 2016 2:37 pm 
Offline
User avatar

Joined: Thu Dec 11, 2008 1:28 pm
Posts: 10986
Location: England
A nice idea, and thanks for sharing your code. I'm reminded of Project Euler which is a collection of simply-stated programming challenges.


Top
 Profile  
Reply with quote  
PostPosted: Fri May 13, 2016 1:06 am 
Offline

Joined: Wed Jan 08, 2014 3:31 pm
Posts: 578
Glad you enjoyed them.


Top
 Profile  
Reply with quote  
PostPosted: Fri May 13, 2016 6:32 pm 
Offline

Joined: Mon Jan 26, 2015 6:19 am
Posts: 85
I once did something similar with Commodore 64 Basic. Implementing recursion and linked lists in a language that is designed for neither was an interesting exercise.


Top
 Profile  
Reply with quote  
PostPosted: Fri May 13, 2016 8:13 pm 
Offline

Joined: Thu Jan 21, 2016 7:33 pm
Posts: 282
Location: Placerville, CA
theGSman wrote:
I once did something similar with Commodore 64 Basic. Implementing recursion and linked lists in a language that is designed for neither was an interesting exercise.

Hah :lol: I'd be interested to hear about this - did you just use PEEK & POKE for the linked lists? Because IIRC Commodore BASIC doesn't have any pointer facilities at all...


Top
 Profile  
Reply with quote  
PostPosted: Sat May 14, 2016 3:53 am 
Offline

Joined: Mon Jan 26, 2015 6:19 am
Posts: 85
commodorejohn wrote:
Hah :lol: I'd be interested to hear about this - did you just use PEEK & POKE for the linked lists? Because IIRC Commodore BASIC doesn't have any pointer facilities at all...

No, I used a parallel array of integers where NX%(I) gave the index number of the next element in the main array.

This is the wrong forum for this type of stuff but if you are interested then http://www.c64-wiki.com/index.php/Recursion and http://www.c64-wiki.com/index.php/Linked_lists gives further details of the techniques.


Top
 Profile  
Reply with quote  
PostPosted: Mon Aug 15, 2016 1:46 pm 
Offline

Joined: Wed Jan 08, 2014 3:31 pm
Posts: 578
Here's the Collatz conjecture in Forth:

Code:
: odd? dup 1 and ;
: 3n+1 dup 2* + 1 + ;
: collatz(n) odd? if 3n+1 else 2/ then ;
: .n dup . ;
: collatz begin .n dup 1 = invert while collatz(n) repeat cr drop ;
15 collatz
15 46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1
1024 collatz
1024 512 256 128 64 32 16 8 4 2 1
16385 collatz
16385 49156 24578 12289 36868 18434 9217 27652 13826 6913 20740 10370 5185 15556 7778 3889 11668 5834 2917 8752 4376 2188 1094 547 1642 821 2464 1232 616 308 154 77 232 116 58 29 88 44 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1


Top
 Profile  
Reply with quote  
PostPosted: Tue Dec 13, 2016 4:18 pm 
Offline

Joined: Wed Jan 08, 2014 3:31 pm
Posts: 578
I saw an ASCII Mandelbrot in a video demoing an rc2014 machine and they posted a link to the source code here:

https://github.com/RC2014Z80/RC2014-BAS ... brot/Ascii

Given that it is in MS Basic it could probably be ported to a 6502 machine. However the use of floating point is massive overkill and is probably why it was so slow in the demo. So I ported it to a fixed point Forth program which should run much faster on retro-hardware.

Code:
\ Setup constants to remove magic numbers to allow
\ for greater zoom with different scale factors.
20  CONSTANT MAXITER
-39 CONSTANT MINVAL
40  CONSTANT MAXVAL
20  CONSTANT RESCALE
80  CONSTANT S_ESCAPE

\ These variables hold values during the escape calculation.
VARIABLE CREAL
VARIABLE CIMAG
VARIABLE ZREAL
VARIABLE ZIMAG
VARIABLE COUNT

\ Compute squares, but rescale to remove extra scaling factor.
: ZR_SQ ZREAL @ DUP RESCALE */ ;
: ZI_SQ ZIMAG @ DUP RESCALE */ ;

\ Translate escape count to ascii greyscale.
: .CHAR
  S" . .,'~!^:;[/<&?oxOX#  "
  DROP
  SWAP + 1
  TYPE ;

\ Numbers above 4 will always escape, so compare to a scaled value.
: ESCAPES?
  S_ESCAPE > ;

\ Increment count and compare to max iterations.
: COUNT_AND_TEST?
  COUNT @ 1+ DUP COUNT !
  MAXITER > ;

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

\ Performs a single iteration of the escape calculation.
: DOESCAPE
    ZR_SQ ZI_SQ +
    ESCAPES? IF
      TRUE
    ELSE
      ZR_SQ ZI_SQ - CREAL @ +   \ leave result on stack
      ZREAL @ ZIMAG @ RESCALE */ 2*
      CIMAG @ + ZIMAG !
      ZREAL !                   \ Store stack item into ZREAL
      COUNT_AND_TEST?
    THEN ;

\ Iterates on a single cell to compute its escape factor.
: DOCELL
  INIT_VARS
  BEGIN
    DOESCAPE
  UNTIL
  COUNT @
  .CHAR ;

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

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

\ Run the computation.
MANDELBROT


Last edited by Martin_H on Thu Dec 29, 2016 3:22 pm, edited 1 time in total.

Top
 Profile  
Reply with quote  
PostPosted: Tue Dec 27, 2016 6:03 pm 
Offline

Joined: Wed Jan 08, 2014 3:31 pm
Posts: 578
I updated the Forth Mandelbrot with bit shifting to increase the size of the fractional portion. This improves the output and makes it more closely match the BASIC program which uses floating point. Here's the latest source:

https://github.com/Martin-H1/Forth-CS-1 ... delbrot.fs

There is no comparison in speed as BASIC takes 21 minutes 48 seconds, while the Forth program takes 6 minutes 4 seconds to produce this output:

Code:
...............................,,,,,,,,,,,,,,,,,...............................
...........................,,,,,,,,,,,,,,,,,,,,,,,,,...........................
........................,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,........................
......................,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,......................
....................,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,....................
..................,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,..................
.................,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,.................
...............,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,...............
..............,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,..............
.............,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,.............
............,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,............
...........,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,...........
..........,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,..........
.........,,,,,,,,,,,,,,,''''''''''',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,.........
........,,,,,,,,,,,,''''''''''''''''''',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,........
.......,,,,,,,,,,''''''''''''''''''''''''',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,.......
.......,,,,,,,''''''''''''''''''~~~~!~~~''''',,,,,,,,,,,,,,,,,,,,,,,,,,,.......
......,,,,,,,''''''''''''''''~~~~~! :!!~~~'''',,,,,,,,,,,,,,,,,,,,,,,,,,,......
.....,,,,,,''''''''''''''''~~~~~~!^;&^^!~~~~'''',,,,,,,,,,,,,,,,,,,,,,,,,,.....
.....,,,,,''''''''''''''''~~~~~~!!^:<[< !~~~~'''',,,,,,,,,,,,,,,,,,,,,,,,,.....
....,,,,''''''''''''''''~~~~~~~!!!:;/#/:^!~~~~''''',,,,,,,,,,,,,,,,,,,,,,,,....
....,,,''''''''''''''''~~~~~~~!!!^;[  <;^!!~~~~''''',,,,,,,,,,,,,,,,,,,,,,,....
...,,,''''''''''''''''~~~~~~~!!!^< x  #O:!!!~~~~''''',,,,,,,,,,,,,,,,,,,,,,,...
...,,''''''''''''''''~~~~~~~!!^^:;o     ;^!!!!~~'''''',,,,,,,,,,,,,,,,,,,,,,...
..,,,'''''''''''''''~~~~~~!!^^^::[      ;:^^!!!~~''''',,,,,,,,,,,,,,,,,,,,,,,..
..,,''''''''''''''~~~~~~!!^;;;;;[/o    ?/[;^^^&!~~''''',,,,,,,,,,,,,,,,,,,,,,..
..,''''''''''''''~~~~~!!!^:? &/          o ;;;x:!~'''''',,,,,,,,,,,,,,,,,,,,,..
.,,'''''''''''''~~~~!!!!^^:&  O            &oxxx!~'''''',,,,,,,,,,,,,,,,,,,,,,.
.,'''''''''''''~~!!!!!!^^:;/                   [!!~'''''',,,,,,,,,,,,,,,,,,,,,.
.,'''''''''''~~!!!!!!!^^^; &                   :^!~'''''',,,,,,,,,,,,,,,,,,,,,.
.'''''''''~~~!^^^!!!^^^::                     &:^!~~'''''',,,,,,,,,,,,,,,,,,,,.
,'''''''~~~!!:&:::::::::;<                    X/x!~~'''''',,,,,,,,,,,,,,,,,,,,,
,''''~~~~~!!^:x[[[?/;;;;/                        !~~'''''',,,,,,,,,,,,,,,,,,,,,
'''~~~~~~!!!^:/O &? o<[/<                      o;^~~''''''',,,,,,,,,,,,,,,,,,,,
''~~~~~~!!!!::[x      ?<?                      o[!~~~'''''',,,,,,,,,,,,,,,,,,,,
'~~~~~~!!!!::[<        OX                       :!~~~'''''',,,,,,,,,,,,,,,,,,,,
~~~~~~!!!^:&[<X                                 ^!~~~'''''',,,,,,,,,,,,,,,,,,,,
~~~~~^^^^:;&?x                                 ;^!~~~'''''',,,,,,,,,,,,,,,,,,,,
!!^:;:^:;[/x                                  /:^!~~~'''''',,,,,,,,,,,,,,,,,,,,
                                             &;:^!~~~''''''',,,,,,,,,,,,,,,,,,,
!!^:;:^:;[/x                                  /:^!~~~'''''',,,,,,,,,,,,,,,,,,,,
~~~~~^^^^:;&?x                                 ;^!~~~'''''',,,,,,,,,,,,,,,,,,,,
~~~~~~!!!^:&[<X                                 ^!~~~'''''',,,,,,,,,,,,,,,,,,,,
'~~~~~~!!!!::[<        OX                       :!~~~'''''',,,,,,,,,,,,,,,,,,,,
''~~~~~~!!!!::[x      ?<?                      o[!~~~'''''',,,,,,,,,,,,,,,,,,,,
'''~~~~~~!!!^:/O &? o<[/<                      o;^~~''''''',,,,,,,,,,,,,,,,,,,,
,''''~~~~~!!^:x[[[?/;;;;/                        !~~'''''',,,,,,,,,,,,,,,,,,,,,
,'''''''~~~!!:&:::::::::;<                    X/x!~~'''''',,,,,,,,,,,,,,,,,,,,,
.'''''''''~~~!^^^!!!^^^::                     &:^!~~'''''',,,,,,,,,,,,,,,,,,,,.
.,'''''''''''~~!!!!!!!^^^; &                   :^!~'''''',,,,,,,,,,,,,,,,,,,,,.
.,'''''''''''''~~!!!!!!^^:;/                   [!!~'''''',,,,,,,,,,,,,,,,,,,,,.
.,,'''''''''''''~~~~!!!!^^:&  O            &oxxx!~'''''',,,,,,,,,,,,,,,,,,,,,,.
..,''''''''''''''~~~~~!!!^:? &/          o ;;;x:!~'''''',,,,,,,,,,,,,,,,,,,,,..
..,,''''''''''''''~~~~~~!!^;;;;;[/o    ?/[;^^^&!~~''''',,,,,,,,,,,,,,,,,,,,,,..
..,,,'''''''''''''''~~~~~~!!^^^::[      ;:^^!!!~~''''',,,,,,,,,,,,,,,,,,,,,,,..
...,,''''''''''''''''~~~~~~~!!^^:;o     ;^!!!!~~'''''',,,,,,,,,,,,,,,,,,,,,,...
...,,,''''''''''''''''~~~~~~~!!!^< x  #O:!!!~~~~''''',,,,,,,,,,,,,,,,,,,,,,,...
....,,,''''''''''''''''~~~~~~~!!!^;[  <;^!!~~~~''''',,,,,,,,,,,,,,,,,,,,,,,....
....,,,,''''''''''''''''~~~~~~~!!!:;/#/:^!~~~~''''',,,,,,,,,,,,,,,,,,,,,,,,....
.....,,,,,''''''''''''''''~~~~~~!!^:<[< !~~~~'''',,,,,,,,,,,,,,,,,,,,,,,,,.....
.....,,,,,,''''''''''''''''~~~~~~!^;&^^!~~~~'''',,,,,,,,,,,,,,,,,,,,,,,,,,.....
......,,,,,,,''''''''''''''''~~~~~! :!!~~~'''',,,,,,,,,,,,,,,,,,,,,,,,,,,......
.......,,,,,,,''''''''''''''''''~~~~!~~~''''',,,,,,,,,,,,,,,,,,,,,,,,,,,.......
.......,,,,,,,,,,''''''''''''''''''''''''',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,.......
........,,,,,,,,,,,,''''''''''''''''''',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,........
.........,,,,,,,,,,,,,,,''''''''''',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,.........
..........,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,..........
...........,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,...........
............,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,............
.............,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,.............
..............,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,..............
...............,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,...............
.................,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,.................
..................,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,..................
....................,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,....................
......................,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,......................
........................,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,........................
...........................,,,,,,,,,,,,,,,,,,,,,,,,,...........................
...............................,,,,,,,,,,,,,,,,,...............................

Update: I compared this closely with an image of the Mandelbrot set and the Forth program matches it more closely. So I think the Forth program is superior. BASIC fans are welcome to improve the original. Assembly fans, the gauntlet has been thrown down.


Last edited by Martin_H on Thu Dec 29, 2016 3:23 pm, edited 2 times in total.

Top
 Profile  
Reply with quote  
PostPosted: Wed Dec 28, 2016 2:54 am 
Offline

Joined: Wed Jan 08, 2014 3:31 pm
Posts: 578
With some performance tweaks I got the program rendering the Mandelbrot set in 4 minutes 6 seconds. I added a video with some links to my YouTube Channel:

https://youtu.be/fVa3Fx7dwBM


Last edited by Martin_H on Thu Dec 29, 2016 3:21 pm, edited 1 time in total.

Top
 Profile  
Reply with quote  
PostPosted: Wed Dec 28, 2016 6:19 pm 
Offline
User avatar

Joined: Thu Dec 11, 2008 1:28 pm
Posts: 10986
Location: England
Interesting -you're using 16bit variables and just 5 bits of fraction? Or 11 bits of fraction? I'd thought it should be enough to be able to express up to magnitude 4.0, which should only be three or maybe four bits to the left of the point - would that leave 11 or 12 bits of fraction?


Top
 Profile  
Reply with quote  
PostPosted: Wed Dec 28, 2016 7:24 pm 
Offline

Joined: Wed Jan 08, 2014 3:31 pm
Posts: 578
The original BASIC sample used for loops that went from -39 to 40 to create an 80 x 80 grid. It then iterated on that X, Y value with floating point, and compared it to a scaled escape value of 80 instead of 4. So they used floating point, and a scaling factor of 20 which doesn't map onto an integer number of bits.

When I translated it to Forth I retained the -39 to 40 loop values because it mapped nicely onto an 80 column display. But I used 5 lshift to add five additional bits for the fractional component, coupled with their initial scaling factor of 20 decimal.

Since the actual calculation should go from -2.0 to 2.0, the scaling factor of 20 is close to a four bit fractional component, and coupled with my 5 bits adds up to a nine bit fractional component, and 7 bits for the whole number portion. You could probably add a few more bits to the fractional component, but at the resolution of ASCII art it probably wouldn't be noticed.


Top
 Profile  
Reply with quote  
PostPosted: Sun Jan 22, 2017 2:51 pm 
Offline

Joined: Tue Jun 08, 2004 11:51 pm
Posts: 213
Hi
I hope you are still around. For your problem of not printing a space,
there is a lower level work in most Forths to do a right justified print.
it is .R.
You give it the minimum number of digits you want printed.
As example:

55 3 .R
prints 055

55 3 .R ASCII , EMIT 0 3 .R
prints 055,000

and so on. ( not all Forths have ASCII )
Dwight


Top
 Profile  
Reply with quote  
PostPosted: Sun Mar 19, 2017 11:43 am 
Offline

Joined: Mon Jan 07, 2013 2:42 pm
Posts: 576
Location: Just outside Berlin, Germany
Just noticed that mandelbrot it its current form redefines COUNT. Not really a problem - COUNT is mostly used by people who still use WORD and FIND :D - but something that might be changed just to be sure.


Top
 Profile  
Reply with quote  
PostPosted: Mon Mar 20, 2017 12:19 am 
Offline

Joined: Wed Jan 08, 2014 3:31 pm
Posts: 578
scotws wrote:
Just noticed that mandelbrot it its current form redefines COUNT. Not really a problem - COUNT is mostly used by people who still use WORD and FIND :D - but something that might be changed just to be sure.

Thanks for the heads up. I will change it to something like ICOUNT in the future.

@dwight, thanks for the information about formatting. I will try that in the future.


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 87 posts ]  Go to page 1, 2, 3, 4, 5, 6  Next

All times are UTC


Who is online

Users browsing this forum: No registered users and 5 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

Search for:
Jump to: