Jump to content
IGNORED

The 7's Problem


Willsy

Recommended Posts

Putting it in the expansion box doesn't work. You'll not get the 16 bit wide memory bus, so you don't get the speed advantage. Also it's not doable at all, since my design sits inside the console's memory decoding logic. It has the ability to hijack the console's access to everything, including operating system ROM, cartridge memory - anything. You can even overlay memory across the internal RAM PAD, sound chip, VDP chip, speech etc. It will kill access to all these functions, but you can use that 8 K bank as a buffer for something, when you don't need to update the screen, play sounds or anything else like that.

 

So the advantage is that you can have contiguous RAM across 64 KBytes, provided the data/code you have at certain locations doesn't have to be available all the time. You have to turn some of it off to access disk drives, video display etc. But you can copy the console ROM into RAM, then modify interrupt vectors, the GPL interpreter - well, everything. I have a program which makes a RAMdisk of these 64 K, plus the memory in a GRAM Kracker/Maximem module.

You could make a game that has an elaborate AI, all in assembly, which can run in, say, 32 K of fast RAM, then with a single CRU instruction, you disable that memory and get the standard console back. But the content of this 32 K is still there, so the next time it's the computer's turn, you execute one CRU instruction and have it all back again.

I'm not saying this just because it's my own design, but it's actually the most versatile memory expansion scheme I've seen for the 99/4A, which also allows a 110% performance upgrade (if you run both workspace and code in normal expansion RAM, compared to both in fast memory). Some other designs are close, but they didn't have the imagination to make the bank switching software controlled, but use manual switches instead. Or they have much more memory, but access it only through a porthole like 4 KBytes wide or so.

 

The big disadvantage with my design is that it's tricky to install. Just imagine if TI had done that from the beginning...

Edited by apersson850
Link to comment
Share on other sites

2 hours ago, apersson850 said:

The big disadvantage with my design is that it's tricky to install. Just imagine if TI had done that from the beginning...

Yeah, I saw all those wires and it did not seem to be an easy plug and play upgrade of a console few if any people would do.  That's why I suggested or questioned the ability to possibly have a card.  I'm guessing even the sidecar peripheral option is not doable as well.

 

Beery

 

Link to comment
Share on other sites

On 10/19/2019 at 10:14 PM, TheBF said:

I don't how I found this old post but the Forth code in the demo has one big over-sight. 

The routine to copy A1 -> A2 has be been written with a DO/LOOP but Forth has a memory move operations.

The big over-sight is that A2 is not necessary!
I tried to understand my forth code after 8 years, but it was easier to read unhuman's XB versionHe was using only one array.


Here is the corrected version:

: CREATE2 ( -- ) <BUILDS DOES> ;
: CELLS ( n -- n ) 2 * ;
-1 CONSTANT TRUE
0 CONSTANT FALSE

180 CONSTANT SIZE
0 VARIABLE V1
0 VARIABLE V2
0 VARIABLE POWER
CREATE2 A1 SIZE CELLS ALLOT
0 VARIABLE LENGTH

: A1*7->A1 ( -- )
  0 V1 !
  0 V2 !
  SIZE 0 DO
    A1 V1 @ CELLS + @ DUP
    0= V1 @ LENGTH @ > AND V2 @ 0= AND IF
      DROP LEAVE
    ELSE
      7 * V2 @ + DUP
      10 MOD A1 V1 @ CELLS + !
      10 / V2 !
      V1 @ 1+ V1 !
    ENDIF
  LOOP
  V1 @ LENGTH ! ;

: TYPE-A1 ( -- )
  0 V1 !
  FALSE V2 !
  -1 LENGTH @ 1- DO
    A1 I CELLS + @ 48 + DUP
    48 = 0= IF TRUE V2 ! ENDIF
    V2 @ IF
      PAD V1 @ 1+ + C!
      V1 @ 1+ V1 !
    ELSE
      DROP
    ENDIF
  -1 +LOOP
  V1 @ PAD C!
  CR PAD COUNT TYPE CR ;

: TEST-A1 ( -- f )
  0 V1 !
  FALSE V2 !
  LENGTH @ 0 DO
    A1 I CELLS + @
    7 = 0= IF      
      0 V1 !
    ELSE
      V1 @ 1+ V1 !
    ENDIF
    V1 @ 5 > IF
      TRUE V2 !
    ENDIF
  LOOP
  V2 @ ;

: 7'S-PROBLEM
  CLS
  A1 SIZE CELLS 0 FILL
  7 A1 !
  2 POWER !
  BEGIN
    A1*7->A1
    CR ." SEVEN TO THE POWER OF " POWER @ . ." IS"
    POWER @ 1+ POWER !
    TYPE-A1
  TEST-A1 UNTIL ;

Link to comment
Share on other sites

LOL. Well that was simple enough.

I simply removed all reference to the A2 array. The computation became:


: A1*7->A2 ( -- )
      0          \ index on stack
      0 X !      \ remainder storage
      BEGIN
        BEGIN
          DUP  ]A1 @ 7 * X @ + 0  10 UM/MOD X !
          OVER ]A1 !
          1+
          DUP LENGTH @ >
        UNTIL
      X @ WHILE ( "while there is a remainder")
      REPEAT       ( Do it again)
      LENGTH !
;

There was only about 0.7 second change in speed versus using 2 arrays.

 

Important to note: This ~33 second version is not compliant with Willy's original code. It only prints the long integer at the end.

 

I converted Lucien's code to do the same thing and used my same elapsed timer and changed a couple of words to the ANS Forth equivalent.

I ran the code on CAMEL99 V2.5 and it takes 63.7 seconds.

 

This demonstrates the challenge of writing for the stack machine. Using lots of variables means you are fetching and storing which in Forth is 2 operations.

1. Put the address of the variable on the stack

2. Fetch the value from the address onto the stack.

Between each operation is the Forth address interpreter which is only 3 instructions but it still takes time.

 

So Forth is much more like coding in assembler where you learn how the processor works in order to be efficient.

Not the preferred mode of thinking for today's programmers. Smart compilers are more the norm.

 

The final routine became this:

: FASTRUN
  A1 SIZE CELLS 0 FILL
  7 A1 !
  2 POWER !
  CR ." Working..."
  TICKER OFF
  BEGIN
    A1*7->A1
    POWER @ 1+ POWER !
    TEST-A1
  UNTIL
  CR ." The answer is 7 ^" POWER @ .
  TYPE-A1
  .ELAPSED
;

Thanks again to Lucien for providing the code.

 

Link to comment
Share on other sites

Changing Lucien's code to take advantage of +! to increment variables, UM/MOD to get the quotient and modulus in one operation and reversing some logic to remove a 0= comparison resulted in 43 second timing.  A 48% speedup! :)

 

 

\ LUCIEN VERSION updated in 2019,
\ minor edits for ANS Forth
INCLUDE DSK1.ELAPSE

DECIMAL

180 CONSTANT SIZE

VARIABLE V1
VARIABLE V2
VARIABLE POWER

CREATE A1 SIZE CELLS ALLOT

VARIABLE LENGTH

: A1*7->A1 ( -- )
  0 V1 !
  0 V2 !
  SIZE 0 DO
    A1 V1 @ CELLS + @ DUP
    0= V1 @ LENGTH @ > AND V2 @ 0= AND IF
      DROP LEAVE
    ELSE
      7 * V2 @ + 0 10 UM/MOD V2 !   A1 V1 @ CELLS + !
      1 V1 +!
    THEN
  LOOP
  V1 @ LENGTH ! ;

: TYPE-A1 ( -- )
  0 V1 !
  FALSE V2 !
  -1 LENGTH @ 1- DO
    A1 I CELLS + @ 48 + DUP
    48 = 0= IF TRUE V2 ! THEN
    V2 @ IF
      PAD V1 @ 1+ + C!
      1 V1 +!
    ELSE
      DROP
    THEN
  -1 +LOOP
  V1 @ PAD C!
  CR PAD COUNT TYPE CR ;

: TEST-A1 ( -- f )
  0 V1 !
  FALSE V2 !
  LENGTH @ 0 DO
    A1 I CELLS + @
    7 = 
    IF   1 V1 +!
    ELSE 0 V1 !
    THEN
    V1 @ 5 > IF
      TRUE V2 !
    THEN
  LOOP
  V2 @ ;

: FASTRUN
  A1 SIZE CELLS 0 FILL
  7 A1 !
  2 POWER !
  CR ." Working..."
  TICKER OFF
  BEGIN
    A1*7->A1
    1 POWER +!
    TEST-A1
  UNTIL
  CR ." The answer is 7 ^" POWER @ .
  TYPE-A1
  .ELAPSED
;

\ Original  1:03.90
\ Minor improvements 43.41

 

 

Edited by TheBF
Fix the spoiler
Link to comment
Share on other sites

For an Apples to Apples comparison Lucien's code uses inline Forth code to compute the address of an array element.

When I do the same thing in the stack based code (using a text macro) the stack oriented code runs in 29.65 seconds.

 

I think I have exhausted the Forth discussion. Apologies :)

Link to comment
Share on other sites

OK, just one final one and then I am really finished. :)

So using every trick I have in Camel99 Forth which includes:

  • in-lining code intrinsics from the kernel for computation (loops are still forth)
  • in-lining variable fetches
  • Using 7* Assembler routine from Guillaume
  • Using arrays created with 9900 indexed addressing
  • Counting the sevens with Assembler. (Forth could not match it)
    (Good thing this is just a hobby)

 

 

\ Sevens problem re-written in a factored Style.
\ USES INLINE CODE EXPANSION FOR CRITICAL CALULATION

INCLUDE DSK1.ELAPSE
INCLUDE DSK1.ASM9900
INCLUDE DSK1.INLINE
NEEDS ()@,   FROM DSK1.CODEMACROS

DECIMAL
180 CONSTANT SIZE

VARIABLE X
VARIABLE POWER
VARIABLE LENGTH

CREATE A1  SIZE CELLS ALLOT

HEX
CODE @  C114 , NEXT, ENDCODE  ( fetch is in hispeed ram)

DECIMAL
\ fast fetch variables
CODE X@             X #, INLINE[ @ ] NEXT, ENDCODE
CODE X!             X #, INLINE[ ! ] NEXT, ENDCODE
CODE LENGTH@   LENGTH #, INLINE[ @ ] NEXT, ENDCODE

\ Arrays use indexed addressing
MACRO A1@ ( ndx -- n)   A1 ()@,  ;MACRO
MACRO A1! ( ndx -- n)   A1 ()!,  ;MACRO

\ Guilaumes's FAST 7X
CODE 7*  ( n -- n')
           TOS R1 MOV,
           TOS 3 SLA,
           R1 TOS SUB,
           NEXT,
           ENDCODE

\ BIG integer multiply by seven
CODE (A1*7)
     INLINE[ A1@ 7* ]
     INLINE[ X@  + ]
     0 #, 10 #, INLINE[ UM/MOD  X! ]
     INLINE[ OVER  A1! ]
     NEXT,
ENDCODE

: A1*7 ( -- )
      0          \ index on stack
      0 X!       \ remainder storage
      BEGIN
        BEGIN
          DUP (A1*7)
          1+
          DUP LENGTH@ >
        UNTIL
      X@ WHILE ( "while there is a remainder")
      REPEAT       ( Do it again)
      LENGTH !
;

CODE SEVENS? ( -- n)
      TOS PUSH,
      TOS CLR,             \ tos is output flag
      LENGTH @@ R2 MOV,    \ R2 is loop limit
      R2 DEC,
      R3 CLR,              \ counter for sevens
      W  A1 LI,            \ W points to array
      BEGIN,
        *W+ R1 MOV,        \ A2 @ ->R1, A2++
         R1 7 CI,          \ a 7?
         EQ IF,            \ YES!
            R3 INC,        \ count it
            R3 6 CI,       \ 5 in a row?
            EQ IF,         \ yes!
                R3 TOS MOV,  \ set flag to true
                NEXT,      \ return to Forth
            ENDIF,
         ELSE,        \ NOT a seven
            R3 CLR,   \ reset the counter
         ENDIF,
         R2 DEC,      \ dec the loop length
      EQ UNTIL,
      NEXT,
      ENDCODE

\ BIG number converion based on Forth internal method (modified)
48 CONSTANT '0'
   VARIABLE HP     \ "HOLD" pointer. Where to put DIGIT in the string

: <#    ( -- ) PAD HP ! ;
: #>    ( -- pad length ) PAD HP @ OVER - ;
: HOLD  ( char -- )  HP @ C!  HP 1+! ;  \ hold digit in pad, bump pointer
: DIGIT ( n -- char) '0' + ;
: A1>#S ( -- pad length ) 0 LENGTH@ DO   I A1@ DIGIT  HOLD    -1 +LOOP ;
: A1$   ( -- addr len ) <#  A1>#S  #>  '0' SKIP ;

: INTRO
  PAGE ." The 5 Sevens Problem in Forth"
  CR
  CR   ." Find the power of 7 with more than"
  CR   ." 5 sequential sevens"
  CR
  CR   ." Uses inline code expansion and"
  CR   ." Assembler for '7' counter"
  CR
  CR   ." Press key to start"  KEY DROP
;

: INITS ( -- )
     A1 SIZE CELLS 0 FILL
     7 A1 !    
     2 POWER !   
     1 LENGTH !
;

: CALCULATOR ( -- ) BEGIN   A1*7  POWER 1+!   SEVENS? UNTIL ;

: RUN
     INTRO
     INITS
     CR
     CR ." Working..."  
     TICKER OFF
     CALCULATOR
     CR
     CR ." The Answer is 7 ^" POWER @ 1- .
     CR A1$ TYPE
     .ELAPSED
;

 

 

Edited by TheBF
insert code
  • Like 1
Link to comment
Share on other sites

  • 2 weeks later...

Just for the fun, I did a GPL version:7's problem.g.bin

        grom    >6000
        data    >aa00,>0100,>0000
        data    menu
        data    >0000,>0000,>0000,>0000
menu    data    >0000
        data    start
        stri    '7''S PROBLEM'

        copy    "libdefs.gpl"
        copy    "libsubs.gpl"

text    stri    'SEVEN TO THE POWER OF % IS'
buf     equ     >a000
a       equ     buf+256
length  equ     a+180
power   equ     length+2
s       equ     power+2
free    equ     s+181

start
        call    initStack
        call    loadStdChars
        dst     1,@length
        dst     1,@power
        dst     180,@arg
L1      dclr    @a(@arg)
        ddect   @arg
        dcz     @arg
        br      L1
        st      7,@a
L2      call    multiplyBy7
        call    printResult
        call    sixTimesSeven
        br      L2
L3      b       L3

multiplyBy7
***********
        dclr    @arg
        clr     @arg+4                  ;carry
mul1    st      @a(@arg),@arg+2
        mul     7,@arg+2
        add     @arg+4,@arg+3
        div     10,@arg+2
        st      @arg+3,@a(@arg)
        st      @arg+2,@arg+4
        dinc    @arg
        dch     @length,@arg
        br      mul1
        cz      @arg+4
        bs      mul2
        st      @arg+4,@a(@arg)
        dst     @arg,@length
mul2    dinc    @power
        rtn

printResult
***********
        dst     text,@arg
        dst     buf,@arg+2
        dst     @power,@fac
        call    formatString
        dst     buf,@arg
        call    print
        dclr    @arg
        dst     @length,@arg+3
pr1     st      @a(@arg),@arg+2
        add     >30,@arg+2
        st      @arg+2,@s+1(@arg+3)
        dinc    @arg
        ddec    @arg+3
        dch     @length,@arg
        br      pr1
        st      @length+1,@s
        inc     @s
        dst     s,@arg
        call    print
        call    scroll
        rtn

sixTimesSeven
*************
        dclr    @arg
        clr     @arg+3
st3     st      @a(@arg),@arg+2
        ceq     7,@arg+2
        bs      st1
        clr     @arg+3
        b       st2
st1     inc     @arg+3
st2     ceq     6,@arg+3
        br      st4
        ceq     @arg,@arg
        rtnc
st4     dinc    @arg
        dch     @length,@arg
        br      st3
        rtn

        end

 

Edited by lucien2
  • Like 2
Link to comment
Share on other sites

That's interesting to see.  So I am assuming that Forth program is the original one by Lucien?

It does not do variable incrementing using the Forth increment operator ( +!)  so it is eating a lot of extra cycles that way.

 

I always wondered how GPL compared to Forth and it seems to be a touch slower. 

That makes sense because it is a byte code interpreter versus an address interpreter.

 

 

 

  • Like 1
Link to comment
Share on other sites

10 minutes ago, lucien2 said:

It's the original un-optimized version, but with only one array (Post #54).

Ok. So we know that it could be even a quite bit faster by replacing these kind of lines:

 V1 @ 1+ V1 !

With...

1 V1 +!

(In CAMEL99 Forth I took it further and use the 9900 INC,DEC.INCT and DECT instructions to increment and decrement variables directly with 1+! , 1-! , 2+! and 2-!.)

 

Thanks for this GPL comparison. I have never written a GPL program.

Edited by TheBF
typo
  • Like 1
Link to comment
Share on other sites

I wanted to compare Weiand Forth to CAMEL99 Forth so took your code from post #54 unchanged.

I put a short translation "harness" at the beginning to translate from your Weiand Forth to ANS/ISO Forth.

 

It then compiled fine and it runs in 2:34 on CAMEL99 Forth V2.51 versus 2:53 in  Weiand FigForth.

So I am pleased with that. From what I can see in the your video my VDP driver works at about the same speed which is not very fast.

I will try to get it compile on FbForth and TurboForth for direct comparisons.

 

 

 \ fig-forth to ANS Forth translation harness
: VARIABLE     CREATE  , ;
: CREATE2   CREATE ;
: CLS   PAGE ;
: ENDIF   POSTPONE THEN ; IMMEDIATE

DECIMAL

\ ===[ ORIGINAL FIG-FORTH CODE ]===
-1 CONSTANT TRUE
0 CONSTANT FALSE

180 CONSTANT SIZE
0 VARIABLE V1
0 VARIABLE V2
0 VARIABLE POWER
CREATE2 A1 SIZE CELLS ALLOT
0 VARIABLE LENGTH

: A1*7->A1 ( -- )
  0 V1 !
  0 V2 !
  SIZE 0 DO
    A1 V1 @ CELLS + @ DUP
    0= V1 @ LENGTH @ > AND V2 @ 0= AND IF
      DROP LEAVE
    ELSE
      7 * V2 @ + DUP
      10 MOD A1 V1 @ CELLS + !
      10 / V2 !
      V1 @ 1+ V1 !
    ENDIF
  LOOP
  V1 @ LENGTH ! ;

: TYPE-A1 ( -- )
  0 V1 !
  FALSE V2 !
  -1 LENGTH @ 1- DO
    A1 I CELLS + @ 48 + DUP
    48 = 0= IF TRUE V2 ! ENDIF
    V2 @ IF
      PAD V1 @ 1+ + C!
      V1 @ 1+ V1 !
    ELSE
      DROP
    ENDIF
  -1 +LOOP
  V1 @ PAD C!
  CR PAD COUNT TYPE CR ;

: TEST-A1 ( -- f )
  0 V1 !
  FALSE V2 !
  LENGTH @ 0 DO
    A1 I CELLS + @
    7 = 0= IF      
      0 V1 !
    ELSE
      V1 @ 1+ V1 !
    ENDIF
    V1 @ 5 > IF
      TRUE V2 !
    ENDIF
  LOOP
  V2 @ ;

: 7'S-PROBLEM
  CLS
  A1 SIZE CELLS 0 FILL
  7 A1 !
  2 POWER !
  BEGIN
    A1*7->A1
    CR ." SEVEN TO THE POWER OF " POWER @ . ." IS"
    POWER @ 1+ POWER !
    TYPE-A1
  TEST-A1 UNTIL ;

 

 

Edited by TheBF
  • Like 1
Link to comment
Share on other sites

With only 1 change (replace POSTPONE with [COMPILE] )  Turbo Forth runs in 1:52. 

 

FbForth compiled your code as is and came in at 3:11.

 

Minor correction for CAMEL99 Forth.

When I timed it with a stopwatch like the other two, I got 2:29.  (versus using my elapsed timer code)

 

So now we have compared four Forth's which is is 4/4 which is the whole thing. :)

 

By the way...

Just changing the definition of CELLS in your code to use shift took 7 seconds off the FbForth time.

: CELLS    1 SLA ;

 

  • Like 1
Link to comment
Share on other sites

3 hours ago, lucien2 said:

Just for the fun, I did a GPL version:7's problem.g.bin

 

  Reveal hidden contents

 



        grom    >6000
        data    >aa00,>0100,>0000
        data    menu
        data    >0000,>0000,>0000,>0000
menu    data    >0000
        data    start
        stri    '7''S PROBLEM'

        copy    "libdefs.gpl"
        copy    "libsubs.gpl"

text    stri    'SEVEN TO THE POWER OF % IS'
buf     equ     >a000
a       equ     buf+256
length  equ     a+180
power   equ     length+2
s       equ     power+2
free    equ     s+181

start
        call    initStack
        call    loadStdChars
        dst     1,@length
        dst     1,@power
        dst     180,@arg
L1      dclr    @a(@arg)
        ddect   @arg
        dcz     @arg
        br      L1
        st      7,@a
L2      call    multiplyBy7
        call    printResult
        call    sixTimesSeven
        br      L2
L3      b       L3

multiplyBy7
***********
        dclr    @arg
        clr     @arg+4                  ;carry
mul1    st      @a(@arg),@arg+2
        mul     7,@arg+2
        add     @arg+4,@arg+3
        div     10,@arg+2
        st      @arg+3,@a(@arg)
        st      @arg+2,@arg+4
        dinc    @arg
        dch     @length,@arg
        br      mul1
        cz      @arg+4
        bs      mul2
        st      @arg+4,@a(@arg)
        dst     @arg,@length
mul2    dinc    @power
        rtn

printResult
***********
        dst     text,@arg
        dst     buf,@arg+2
        dst     @power,@fac
        call    formatString
        dst     buf,@arg
        call    print
        dclr    @arg
        dst     @length,@arg+3
pr1     st      @a(@arg),@arg+2
        add     >30,@arg+2
        st      @arg+2,@s+1(@arg+3)
        dinc    @arg
        ddec    @arg+3
        dch     @length,@arg
        br      pr1
        st      @length+1,@s
        inc     @s
        dst     s,@arg
        call    print
        call    scroll
        rtn

sixTimesSeven
*************
        dclr    @arg
        clr     @arg+3
st3     st      @a(@arg),@arg+2
        ceq     7,@arg+2
        bs      st1
        clr     @arg+3
        b       st2
st1     inc     @arg+3
st2     ceq     6,@arg+3
        br      st4
        ceq     @arg,@arg
        rtnc
st4     dinc    @arg
        dch     @length,@arg
        br      st3
        rtn

        end

 

 

 

Would like to see the GPL code here, wondering how efficient it was done.

Link to comment
Share on other sites

2 hours ago, lucien2 said:

It's just a text file. Like ".c" for C language source files. In fact, ralphb used it too for the GPL exemple included with his XDT GPL assembler.

The ".GPL" extension is also used for binary GROM files for the TI994w emulator.

Ok I only use a TI99/4A and Classic99 only. 

For GPL I have always used the Ryte Data GPL Assembler as all others have goofy syntax.

 

How come there is not a TEXT file? I normally only work with them as no conversions are needed.

I take a Notepad Text file use TI Dir to turn into DV80 in Classic99 then use Ryte Data GPL Assembler to make Object files.

Then use GPL@LOADER from Ryte Data to load GRAMs into Classic99.

 

I tried the TI994w emulator but did not like the way it works with GPL at all.

 

Link to comment
Share on other sites

I finally got around to making a vanilla ANS/ISO Forth version that I am happy with.  The previous version relied on more variables than is acceptable for Forth programmers.

This version compiles on Camel99 and TurboForth. The only ANS Forth enhancement used is to use text macros for array access which is also supported by TurboForth.

 

I pushed this code onto real iron over the serial port as well. You can clearly see in the video how the screen write times affect this program's run time a great deal.

This same code running with VDP I/O  CAMEL99  1:32 , TurbForth 1:22.  VDP screen writes take a lot of time.

 

 

 

 

\ Sevens problem factored Style ANS Forth

\ Need for Turbo Forth only
: /STRING   ( c-addr1 u1 n -- c-addr2 u2 ) ROT OVER + -ROT - ;

: SKIP  ( addr len char -- addr' len')
        >R
        BEGIN
          OVER C@ R@ =
        WHILE
           1 /STRING
       REPEAT
       R> DROP  ;

\ --- PROGRAM BEGINS HERE ---
DECIMAL
180 CONSTANT SIZE

VARIABLE LENGTH

CREATE A1     SIZE CELLS ALLOT    \ allocate memory

\ array access words as ANS Forth text macros
: A1@     ( ndx-- n )  S" CELLS A1 + @" EVALUATE ; IMMEDIATE
: A1!     ( n ndx -- ) S" CELLS A1 + !" EVALUATE ; IMMEDIATE

: A1*7 ( -- length)
      0         \ index on stack
      0 >R      \ remainder on return stack
      BEGIN
        BEGIN
          DUP  A1@ 7 * R@ + 0  10 UM/MOD R> DROP >R  OVER A1!
          1+
          DUP LENGTH @ >
        UNTIL
      R> WHILE    ( "while there is a remainder")
      REPEAT       ( Do it again)
      DUP LENGTH !
 ;

: SEVENS? ( length -- ?)
        1-
        0                  \ counter on stack
        SWAP 0
        DO
           1+              \ bump counter
           I A1@ 7 =       \ test for a '7'. TRUE= -1, FALSE=0
           AND             \ AND flag with count (replaces IF)
           DUP 5 =         \ is count equal to 5?
           IF LEAVE THEN   \ if so, leave the loop, return flag
        LOOP
;

\ Convert A1[] to A1$ (text string)
48 CONSTANT '0'
   VARIABLE HP     \ "HOLD" pointer. Where to put DIGIT in the string
: <#    ( -- ) PAD HP ! ;
: #>    ( -- pad length ) PAD HP @ OVER - ;
: HOLD  ( char -- )  HP @ C! 1 HP +! ;  \ hold digit in pad, bump pointer
: A1>#S ( -- pad length ) 0 LENGTH @ DO   I A1@ '0' +  HOLD    -1 +LOOP ;
: A1$   ( -- addr len ) <#   A1>#S   #>  '0' SKIP  ;

DECIMAL
: RUN
     CR
     A1 SIZE CELLS 0 FILL
     7 A1 !
     1 LENGTH !
     2             \ intial POWER value lives on stack
     BEGIN
        A1*7
        CR ." SEVEN TO THE POWER OF " DUP . ." IS"
        CR A1$ TYPE
        CR
        1+
        SEVENS?
     UNTIL
     DROP
     CR
;

\ Turbo Forth 1:22
\ Camel Forth v2.53 1:32

 

Edited by TheBF
video link
  • Like 1
Link to comment
Share on other sites

Stop me before I code again!

 

For whatever reason this little program has captivated me. I removed the need to calculate the array addresses repeatedly by calculating them on the data stack and re-using them.  Better programmers would have got here sooner but I have to make it work and then refine.

 

Here is a summary of my findings, running four versions on CAMEL99 Forth.

All programs produce the same screen output on CLASSIC99 and I used the  same manual timing method

 

Camel Forth v2.53
Lucien's single array version    2:16
Lucien's with +! incrementing  1:55

theBF's  factored version        1:32
theBF's  with stack pointers    1:26     

Camel99 Forth DTC                1:11  Edited ? 

 

 

\ Version 3 uses pointers on the data stack

\ INCLUDE DSK1.TOOLS   debugging

DECIMAL
180 CONSTANT SIZE

VARIABLE LENGTH

CREATE A1     SIZE CELLS ALLOT    \ calculation buffer

: A1*7 ( -- length)
      0         \ index on stack
      BEGIN
       0 >R      \ remainder on return stack
       BEGIN
          DUP CELLS A1 +
          DUP @  7 * R@ + 0  10 UM/MOD R> DROP >R  SWAP !
          1+
          DUP LENGTH @ >
        UNTIL
      R> WHILE     ( "while there is a remainder")
      REPEAT       ( Do it again)
      DUP LENGTH !
;

: 5SEVENS? ( $addr len -- n|0)
        1-
        0 -ROT              \ counter on stack under args
        BOUNDS
        DO
           1+               \ bump counter
           I C@ [CHAR] 7 =  \ test for a '7'. TRUE= -1, FALSE=0
           AND              \ AND flag with count (replaces IF)
           DUP 5 =          \ is count equal to 5?
           IF LEAVE THEN    \ if so, leave the loop, return flag
        LOOP
;

\ Convert A1[] to A1$ (text string)
48 CONSTANT '0'
   VARIABLE HP     \ "HOLD" pointer. Where to put DIGIT in the string

: <#    ( -- ) PAD HP ! ;
: #>    ( -- pad length ) PAD HP @ OVER - ;
: HOLD  ( char -- )  HP @ C! 1 HP +! ;  \ hold digit in pad, bump pointer
: >#### ( $addr len -- ) CELLS BOUNDS SWAP DO  I @ '0' +  HOLD  -2 +LOOP ;
: A1$   ( -- $addr len ) A1 LENGTH @ <# >#### #>  '0' SKIP  ;

DECIMAL
: RUN
     CR
     A1 SIZE CELLS 0 FILL
     1 LENGTH !
     7 A1 !        \ initial value of 7^1
     1             \ intial POWER value lives on stack
     BEGIN
        1+
        A1*7
        CR ." SEVEN TO THE POWER OF " . ." IS"
        CR A1$  2DUP  TYPE
        CR
        5SEVENS?
     UNTIL
     DROP
     CR
;

 

 

  • Like 1
  • Haha 1
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...