Jump to content
Willsy

The 7's Problem

Recommended Posts

1 hour ago, TheBF said:

For whatever reason this little program has captivated me.

 

Yeah—me too! I am still not done, but I was stymied awhile by what was going on in TYPE-A1 with V2 . After sleeping on it, I finally figured out that this was handling leading zeroes.

 

I have fbForth 2.0:12 down to 1:58 and will probably get it down a little further before I hang it up, but I will not likely beat CAMEL99 Forth v2.53.

 

...lee

  • Like 1

Share this post


Link to post
Share on other sites

Thank goodness someone else is in on it!

 

I punted on the leading zeros by using SKIP, which is fair ball for you to. 

Mine is part of the system in CODE, but because it only has to scan through a small number even in Forth it's still pretty fast in this case.

 

I also realized that once I had converted to a string, I could just scan the string for ASCII 7 which meant I could use an ordinary do loop instread of stepping version.

I am working now on changing the calculation function to be 7^X ( power --) 

I can remove the length variable but I think the remainder variable will come back to keep me more sane. (less crazy? no sure which applies here) :)


: /STRING   ( c-addr1 u1 n -- c-addr2 u2 ) ROT OVER + -ROT - ;

: SKIP  ( addr len char -- addr' len')
        >R
        BEGIN
          OVER [email protected] [email protected] =
        WHILE
           1 /STRING
       REPEAT
       R> DROP ;

 

Share this post


Link to post
Share on other sites
2 hours ago, TheBF said:

I punted on the leading zeros by using SKIP, which is fair ball for you to.

Since we are only cutting 1 char off the string this is much faster in Forth.

: /SNIP     ( adde len -- addr' len' ) 1- SWAP 1+ SWAP ;

: SKIP  ( addr len char -- addr' len')
        >R
        BEGIN
          OVER [email protected] [email protected] =
        WHILE
          1- SWAP 1+ SWAP  ( /SNIP inlined )
       REPEAT
       R> DROP ;

 

Share this post


Link to post
Share on other sites

"I'm coding and I can't get up!" :)

This version is about as good as I can get it on the computation side without resorting to inlining or some Assembler assistance.

It runs on Camel99 Forth V2.53 in 1:21  and on Turbo Forth in 1:13.  This would take the time on the CAMEL99 TTY version below 1 minute.

I make use of a variable to remember the quotient in the divide operation. 

I am pretty sure that the Forth overhead would swamp the divide operation time if I did it without using divide.

It's a different story if we allow Assembler of course.

But at least in the version we traverse the array using a value on the data stack that be increment by 2 each time through.

 

 
\ Sevens problem factored Style ANS Forth

\ Need for Turbo Forth only
\ : /SNIP     ( adde len -- addr' len' ) 1- SWAP 1+ SWAP ;

: SKIP  ( addr len char -- addr' len')
        >R
        BEGIN
          OVER [email protected] [email protected] =
        WHILE
          1- SWAP 1+ SWAP  ( /SNIP inlined )
       REPEAT
       R> DROP ;

: BOUNDS  ( addr len -- addr2 addr1) OVER + SWAP ;

\ --- PROGRAM BEGINS HERE ---
\ INCLUDE DSK1.TOOLS   debugging

DECIMAL
180 CONSTANT SIZE

CREATE A1     SIZE CELLS ALLOT    \ calculation buffer

\ MACRO to remove noise in code
: 10/MOD   ( n n -- quot rem ) S" 0  10 UM/MOD" EVALUATE ; IMMEDIATE

VARIABLE QUOT       \ quotient must be retained

: 7^X ( power -- )
      BEGIN
         A1
         SWAP 0
         DO
            DUP @ 7 * QUOT @ +  10/MOD QUOT ! OVER !
            CELL+
         LOOP
         DROP
      QUOT @ WHILE
      REPEAT
;

55 CONSTANT '7'

: 5SEVENS? ( $addr len -- n|0)
        1-
        0 -ROT              \ counter on stack under args
        BOUNDS
        DO
           1+               \ bump counter
           I [email protected] '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 ! ;                    \ setup HOLD buffer
: #>     ( -- pad length ) PAD HP @ OVER - ;  \ compute length of string
: HOLD   ( char -- )  HP @ C! 1 HP +! ;       \ hold digit in pad, bump pointer

: <#..#> ( addr len -- )  \ convert (addr,len) to digits in HOLD buffer
         CELLS BOUNDS SWAP
         DO
             I @ '0' +  HOLD
         -2 +LOOP ;

: >BIG#  ( addr len -- $addr len ) 1-  <# <#..#> #>  '0' SKIP  ;

DECIMAL
: RUN
     CR
     A1 SIZE CELLS 0 FILL
     7 A1 !      \ initial value of 7^1
     2           \ intial POWER value lives on stack
     BEGIN
        CR ." SEVEN TO THE POWER OF " DUP . ." IS" DUP 7^X
        1+   ( bump the exponent)
        A1 OVER >BIG#  2DUP CR TYPE CR ( convert A1 & display)
        5SEVENS?                        ( read string for 7s)
     UNTIL
     DROP
     CR
;

\ Turbo Forth theBF's Factored   1:22
\         with 7^X               1:13

\ 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
\          with 7^X              1:21

 

 

Here's Willsy showing off. :)

 

 

 

Edited by TheBF
Code comments
  • Like 1

Share this post


Link to post
Share on other sites

I think I have gone as far as I can without resorting to Forth Assembler. I got it down to 54 seconds by the metric I was using, but it seems that metric is flawed. I timed it with a stopwatch and it seems that I lost a minute’s worth of interrupts during all the display sections! That is what I get for using the screen timeout counter. Oh, well. That means I am really at 1:54. I obviously need to implement the TMS9901 timer as Brian did. Anyway, here is the code (sorry about the missing spoiler—the editor options seem to have changed again)

\ Lee Stewart's mod of Lucien2's code for the sevens problem...

DECIMAL
: CREATE2 ( -- ) <BUILDS DOES> ;

180 CONSTANT SIZE
CREATE2 A1 SIZE ALLOT   \ A1 = inverted digit array
0 CONSTANT LENGTH    \ current number of digits in result

: A1*7->A1 ( -- )    \ perform 7 * last result
   0              \ initialize carried digit on stack
   1 ' LENGTH +!    \ assume we will increase length by 1 digit
   A1 LENGTH + A1 DO 
      I [email protected]        \ get cur digit as next higher digit
      7 *         \ cur digit * 7
      +           \ add carried digit from stack
      0 10 U/     \ make result ud..unsigned divide by 10
      SWAP I C!   \ store rem as cur digit..carry on stack
   LOOP
   DROP           \ clean up stack
   \ eliminate leading 0
   A1 LENGTH 1- + [email protected] 0=  \ highest digit = 0?
   IF
      -1 ' LENGTH +!   \ correct digit count
   THEN  ;

: TYPE-A1 ( -- )
   LENGTH PAD C!   \ store string length
   PAD               \ copy of PAD to start string storage loop
   A1 1- DUP LENGTH + DO  \ DO A1+length-1 to A1
      1+             \ next PAD location
      I [email protected]           \ get next digit
      48 +           \ convert to ASCII
      OVER C!        \ store ASCII digit in PAD
   -1 +LOOP
   DROP              \ clean up stack
   CR PAD COUNT TYPE CR ;  \ type number

: >5SEVENS? ( -- f )   \ Brian Fox's technique
   0                 \ initialize counter to no '777777'
   A1 LENGTH + A1 DO     \ DO A1 to A1 + length
      1+             \ increment counter
      I [email protected]
      7 = *          \ "AND" with counter
      DUP 5 > IF     \ more than '77777'?
         LEAVE       \ yup..we're done
      THEN
   LOOP  
   5 >  ;            \ insure actually '777777' or more

HEX
: 7'S-PROBLEM
   0 83C4 !           \ disable Forth ISR
   CLS
   A1 SIZE 0 FILL
   7 A1 C!
   1 ' LENGTH !
   2                 \ starting power
   BEGIN
      A1*7->A1
      DUP            \ dup power for display
      CR ." SEVEN TO THE POWER OF " . ." IS"
      1+             \ increment power
      TYPE-A1
   >5SEVENS? UNTIL
;
DECIMAL

You will see in the above code that I dispensed with most of the variables ( V1 V2 POWER ). I changed LENGTH to a constant, but I do not think I saved much doing that because I had already hoisted LENGTH out of the loops. I unabashedly copped Brian’s =5SEVENS? for my >5SEVENS? . I found that I needed to redo the check outside the loop to avoid a final, smaller-than-6 set of ‘7’s passing the test.

 

I also avoided checking for leading zeroes in TYPE-A1 by not allowing them in A1*7->A1 in the first place.

 

One last change I made that saved a little time and code (I think) was to make A1 a byte array instead of a cell array.

 

...lee

  • Like 1

Share this post


Link to post
Share on other sites

It's wonderful to see another solution.  Thanks!!!

(been staring at mine for too long)

Share this post


Link to post
Share on other sites
On 11/13/2019 at 8:15 PM, TheBF said:

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.

 

 

 

  Reveal hidden contents

\ 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 [email protected] [email protected] =
        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
: [email protected]     ( 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  [email protected] 7 * [email protected] + 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 [email protected] 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 [email protected] '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

 

He he! Great to see this thread come back to life - I'm really enjoying it.

 

I'd be interested to see how fast TF is with the screen scrolling switched off:

 

FALSE SSCROLL !

 

The problem with screen scrolling is we're adding the time taken to scroll the screen into the measurements. By removing it, I think you'll see the effects of your optimisations much more clearly.

 

Have fun 🙂

 

 

  • Like 1

Share this post


Link to post
Share on other sites

Also, I wonder how fast it would be with no screen I/O at all? Just output the final result? Then you're really timing your algorithm (and the underlying Forth system, of course) and removing the I/O.

Share this post


Link to post
Share on other sites
6 hours ago, Willsy said:

Also, I wonder how fast it would be with no screen I/O at all? Just output the final result? Then you're really timing your algorithm (and the underlying Forth system, of course) and removing the I/O.

Guillaume and I went down that road a while back.  He got it down in the signal digit seconds 7..9 in Assembler and his MLC language.

An earlier version that I did in CAMEL99 Forth that only printed the final result ran in the 33 second range and TF was 500mS or so faster.

I will try my new code and see what happens. For comparison the original version ran in about 1:09 seconds and simple using +! for incrementing variables got it down to 0:43  

 

At some point we decided to be Orthodox and abide by your sacred text written way back in 2011. That's how the screen I/O came back. :)

 

Good to hear from you. 

 

  • Thanks 1

Share this post


Link to post
Share on other sites
15 hours ago, Lee Stewart said:

I think I have gone as far as I can without resorting to Forth Assembler. I got it down to 54 seconds by the metric I was using, but it seems that metric is flawed. I timed it with a stopwatch and it seems that I lost a minute’s worth of interrupts during all the display sections! That is what I get for using the screen timeout counter. Oh, well. That means I am really at 1:54. I obviously need to implement the TMS9901 timer as Brian did. Anyway, here is the code (sorry about the missing spoiler—the editor options seem to have changed again)

You will see in the above code that I dispensed with most of the variables ( V1 V2 POWER ). I changed LENGTH to a constant, but I do not think I saved much doing that because I had already hoisted LENGTH out of the loops. I unabashedly copped Brian’s =5SEVENS? for my >5SEVENS? . I found that I needed to redo the check outside the loop to avoid a final, smaller-than-6 set of ‘7’s passing the test.

 

I also avoided checking for leading zeroes in TYPE-A1 by not allowing them in A1*7->A1 in the first place.

 

One last change I made that saved a little time and code (I think) was to make A1 a byte array instead of a cell array.

 

...lee

I added a short translation harness to your code and it compiled on my system.

I had to change the '*' operator to  'AND' so that the 7 detection would work on CAMEL99.

 

Your version runs on CAMEL99 V2.53 in 1:12 seconds on the stop watch versus my last version that ran in 1:21.

 

Dr. Stewart, you have done it again.

Felicitations.  A fine example of stack coding to be sure.

 

(I got it to compile on TurboForth but it didn't run. However it would be sub-one-minute time based on previous comparisons)

 

 

 

 

  • Thanks 1

Share this post


Link to post
Share on other sites

Converting CAMEL99 Forth's ELAPSE.FTH (except for ELAPSE ) to fbForth 2.0:12, the times in MM:SS format reported by .ELAPSED for differing kinds of output of 7'S-PROBLEM are:

 

  1. No modification:                            00:53.41

  2. Printing just powers until the end:         00:24.98

  3. Printing just progress dots until the end:  00:22.45

  4. Printing nothing until the end:             00:22.11

 

...lee

  • Like 2

Share this post


Link to post
Share on other sites

1:10 for the GPL version printing only the final result: 7's problem no printing.g.bin

The display of results takes a lot time because I use a C style "format" function that replaces %'s by values.

 

        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'
intro   stri    'THE GPL INTEPRETER IS RESOLVING THE 7''S PROBLEM. PLEASE WAIT.'
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
        dst     intro,@arg
        dst     buf,@arg+2
        call    formatString
        dst     buf,@arg
        call    print
L2      call    multiplyBy7
        call    sixTimesSeven
        br      L2
        call    scroll
        call    printResult
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

  • Like 3

Share this post


Link to post
Share on other sites
1 hour ago, Lee Stewart said:

Converting CAMEL99 Forth's ELAPSE.FTH (except for ELAPSE ) to fbForth 2.0:12, the times in MM:SS format reported by .ELAPSED for differing kinds of output of 7'S-PROBLEM are:

 

  1. No modification:                            00:53.41

  2. Printing just powers until the end:         00:24.98

  3. Printing just progress dots until the end:  00:22.45

  4. Printing nothing until the end:             00:22.11

 

...lee

FYI

I have been tardy in publishing my latest code. (too many distractions like this) :)

\ ELAPSE.FTH  elapsed time measurment words
\ Thanks to Tom Zimmer for the good ideas in FPC circa 1990
\ Ported to HsForth 08MAR91  Brian Fox Canada

\ Ported to CAMEL99 Nov 29 2017, 
\ Simplified with SEXTAL Dec 6 2018
\ Good for 9 minutes maximum duration

\ *** YOU CANNOT CALL KSCAN WHILE TIMING ***

HEX
83D6 CONSTANT TICKER   \ screen timeout counter increments by 2 /16mS

DECIMAL
: SEXTAL   6 BASE ! ;
: <:>     [CHAR] : HOLD ;
: <.>     [CHAR] . HOLD ;
: TIME$   ( n -- addr len) \ string output is more flexible
          BASE @ >R
          \         100ths        secs           minutes
          0 <#  DECIMAL # # <.> # SEXTAL # <:> DECIMAL #S  #>
          R> BASE ! ;

: .ELAPSED ( -- ) 
           TICKER @ 5 6 */ TIME$
           CR ." Elapsed time ="  TYPE ;

: ELAPSE   ( -- <text> ) 1 PARSE  TICKER OFF  EVALUATE .ELAPSED ;

I have significantly simplified the original version of ELAPSE after re-viewing the pages of Starting Forth.

It it simpler to understand IMHO but gives the same results and it's more accurate because it captures the time string to the data stack right away before printing.

It's yours to do with as you see fit.

 

My results with your code clearly show Camel99 needs some work on the VDP I/O TYPE routine

Using the ELAPSE timer (which is 2 seconds more than stop watch on the 1st measurement.)

  1. No modification:                            01:14.68

  2. Printing just powers until the end:         00:17.95

  3. Printing just progress dots until the end:  00:16.70

  4. Printing nothing until the end:             00:16.43

  • Like 1

Share this post


Link to post
Share on other sites

That is impressive!

 

I will post a port of most of this to fbForth in a bit.  I cannot do ELAPSE because fbForth does not have PARSE and EVALUATE to allow it to work.

 

A couple of comments:

  • You probably should manipulate the timer with unsigned operations because any value greater than 32767 is treated as negative by */ and will yield erroneous results. Something like U*/ would be nice. Barring that, there is U* and U/ that can be used. The first leaves the unsigned double number required by the second.
  • I like to use TYPE immediately after <# ... #> because I never remember what other words use PAD and might step on the output of <# ... #> (probably a minor nit).

...lee

Share this post


Link to post
Share on other sites

OK, here is the port to fbForth of most of Brian’s CAMEL99 Forth timer code:

\ Timer words for fbForth...
HEX
83D6 CONSTANT TICKER   \ screen timeout counter increments by 2 /16mS

DECIMAL
: OFF    ( addr -- )
         0 SWAP !  ;
: SEXTAL   6 BASE ! ;
: <:>     ASCII : HOLD ;
: <.>     ASCII . HOLD ;
: TIME$   ( n -- addr len) \ string output is more flexible
          BASE->R
          \         100ths        secs           minutes
          0 <#  DECIMAL # # <.> # SEXTAL # <:> DECIMAL #S  #>
          R->BASE  ;

: .ELAPSED ( -- ) 
           CR ." Elapsed time = "
           TICKER @ 5 U* 6 U/ SWAP DROP TIME$ TYPE  ;

\ need to define PARSE and EVALUATE before following will work
\ : ELAPSE   ( -- <text> ) 1 PARSE  TICKER OFF  EVALUATE .ELAPSED ;

\ Forth TMS9900 Assembler code for U*/

ASM: U*/   ( u1 u2 u3 -- uquot )
      *SP+ R1 MOV,        \ pop divisor u3 to R1
      *SP+ R2 MOV,        \ pop multiplicand u2 to R2
      *SP  R2 MPY,        \ u1*u2
       R1  R2 DIV,        \ (u1*u2)/u3
       R2 *SP MOV,        \ quotient to stack
;ASM

\ machine code of above word
CODE: U*/   ( u1 u2 u3 -- uquot )
      C079 C0B9 3899 3C81 C642 
;CODE

\ .ELAPSED with the above-defined U*/
: .ELAPSED ( -- ) 
           CR ." Elapsed time = "
           TICKER @ 5 6 U*/ TIME$ TYPE  ;

 

Usage is

TICKER OFF
   <words to execute for timing>
.ELAPSED

 

...lee

Share this post


Link to post
Share on other sites
7 hours ago, Lee Stewart said:

That is impressive!

 

I will post a port of most of this to fbForth in a bit.  I cannot do ELAPSE because fbForth does not have PARSE and EVALUATE to allow it to work.

 

A couple of comments:

  • You probably should manipulate the timer with unsigned operations because any value greater than 32767 is treated as negative by */ and will yield erroneous results. Something like U*/ would be nice. Barring that, there is U* and U/ that can be used. The first leaves the unsigned double number required by the second.
  • I like to use TYPE immediately after <# ... #> because I never remember what other words use PAD and might step on the output of <# ... #> (probably a minor nit).

...lee

 

Good Insights as always.

I think I have been saved from the overflow because I don't test really long durations. The current version can time 9 mins and my patience is low. :)

 

To be sure its risky to rely on the hold buffer for very long. It's not task friendly in the FIG Forth version.  My PAD adds an offset for each task so that there is in effect a different PAD address for each task so I am a little more cavalier.  I am not currently using interrupts for screen printing, but your concern is well founded.

 

I implemented ELAPSE based on FPC by Tom Zimmer.  I was using HsForth which was not ANS either.  This was how it was done on older systems:

 

: ELAPSE ( -- <forth word> ) TICKER OFF   INTERPRET   .ELAPSED ;

 

It should work on FIG-Forth I think.

  • Thanks 1

Share this post


Link to post
Share on other sites
26 minutes ago, TheBF said:

I implemented ELAPSE based on FPC by Tom Zimmer.  I was using HsForth which was not ANS either.  This was how it was done on older systems:

 

: ELAPSE ( -- <forth word> ) TICKER OFF   INTERPRET   .ELAPSED ;

 

It should work on FIG-Forth I think.

 

Indeed, it does! Thank you. I just did not see the (now) obvious—too myopic, I guess.

 

...lee

  • Like 1

Share this post


Link to post
Share on other sites
12 minutes ago, Lee Stewart said:

 

Indeed, it does! Thank you. I just did not see the (now) obvious—too myopic, I guess.

 

...lee

I don't think you are myopic. (or we both are) When I first saw the code I was shocked too. I had never considered using INTERPRET like that.

 

Zimmer is/was a total genius.  I read that in the '90s he was was asked to re-write a big APP that he had written for DOS using his FPC system.

It was some kind of scientific application and pretty complex. Of course the customer wanted a Windows version now.

Tom reviewed the current offerings for Forth systems for Windows and concluded that they all were not good enough.

He licensed a Forth Assembler for 32Bit Intel by Andrew McKewan(?)  and re-wrote his DOS development system including the hyper-text editor for Windows and adding Forth OOP language in a few months and then re-wrote the application for Windows in the new system... and it all worked!.

 

Win32 Forth still has a following today. His last verson (4.x) is available. New people have continued maintaining it and there is a version 6.x. 

They used Assembler code to boot into windows and the last I heard it was tripping all the virus detectors so that made a lot of problems.

Hmm... If they fixed it I should consider porting my cross-compiler to make a nice Windows version. 

 

So much code...

 

Share this post


Link to post
Share on other sites
14 minutes ago, TheBF said:

Win32 Forth still has a following today. His last verson (4.x) is available. New people have continued maintaining it and there is a version 6.x. 

They used Assembler code to boot into windows and the last I heard it was tripping all the virus detectors so that made a lot of problems.

Hmm... If they fixed it I should consider porting my cross-compiler to make a nice Windows version. 

 

That effort is part of  ForthWin-Users-Group (a FaceBook group). I am over there but very, very peripherally. Erik Olsen is also over there. If you have a FaceBook presence, I will suggest you be added to the group.

 

...lee

Share this post


Link to post
Share on other sites

I have Facebook accounts but I don't use them.  I just checked Win32Forth and it still tripped my AVG anti-virus.  I think I will pass for now, but I may ask you in future for a recommendation.


Thank you.

Share this post


Link to post
Share on other sites

Tripping the av code isn't hard, it's just a pattern that the av doesn't like because it's in it db..I'd ignore it myself..but then again, I'm also set up to throw an OS with all sw in a few mins together..

But I think that site is safe.

Share this post


Link to post
Share on other sites

I have been using Lee's version of this program to evaluate my screen I/O routines.  I found a small improvement.

We don't have to make a counted string since TYPE uses a stack string (addr,len) and we have LENGTH.

It takes a few milliseconds off. :)

 

: TYPE-A1 ( -- )
\   LENGTH PAD C!   \ store string length
   PAD               \ copy of PAD to start string storage loop
   A1 1- DUP LENGTH + DO  \ DO A1+length-1 to A1
      I [email protected]           \ get next digit
      48 +           \ convert to ASCII
      OVER C!        \ store ASCII digit in PAD
      1+             \ next PAD location
   -1 +LOOP
   DROP              \ clean up stack
   CR PAD LENGTH TYPE CR ;  \ type number

 

  • Like 2

Share this post


Link to post
Share on other sites

I noticed a SEVENS program in BASIC.  It uses HCHAR() to output numbers but it actually goes quite a bit quicker if you use PRINT CHR$(A(I)+48;

Original code:

 

10 DIM A(256)
30 PRINT "7's Problem"
31 A(1)=7
32 WIN=0
33 POWER=1
41 NUMLEN=1
45 POWER=POWER+1
46 PRINT "7 ^";POWER;"IS:"::
48 CARRY=0
49 INAROW=0
50 FOR I=1 TO NUMLEN
60 A(I)=A(I)*7+CARRY
70 CARRY=INT(A(I)/10)
80 A(I)=A(I)-CARRY*10
82 IF A(I)<>7 THEN 89
83 INAROW=INAROW+1
84 IF INAROW<>6 THEN 90
85 WIN=1
86 GOTO 90
89 INAROW=0
90 NEXT I
100 A(I)=CARRY
101 IF CARRY=0 THEN 109
102 NUMLEN=NUMLEN+1
109 H=3
110 FOR I=NUMLEN TO 1 STEP -1
120 CALL HCHAR(23,H,48+A(I))
121 H=H+1
122 IF H<32 THEN 130
123 H=2
124 PRINT :
130 NEXT I
131 PRINT ::
140 IF WIN<>1 THEN 45
150 PRINT "WINNER IS 7 ^";POWER

 

 

Faster version

 
100 DIM A(256)
110 PRINT "7's Problem"
120 A(1)=7
130 WIN=0
140 POWER=1
150 NUMLEN=1
160 POWER=POWER+1
170 PRINT "7 ^";POWER;"IS:"
180 CARRY=0
190 INAROW=0
200 FOR I=1 TO NUMLEN
210    A(I)=A(I)*7+CARRY
220    CARRY=INT(A(I)/10)
230    A(I)=A(I)-CARRY*10
240    IF A(I)<>7 THEN 290
250    INAROW=INAROW+1
260    IF INAROW<>6 THEN 300
270    WIN=1
280    GOTO 300
290    INAROW=0
300 NEXT I
310 A(I)=CARRY
320 IF CARRY=0 THEN 340
330 NUMLEN=NUMLEN+1
340 FOR I=NUMLEN TO 1 STEP -1
350     PRINT CHR$(A(I)+48);
360 NEXT I
370 PRINT ::
380 IF WIN<>1 THEN 160
390 PRINT "WINNER IS 7 ^";POWER

 

 

Edited by TheBF
Fixed spoiler
  • Like 1

Share this post


Link to post
Share on other sites
On 11/21/2019 at 5:02 PM, TheBF said:

I noticed a SEVENS program in BASIC.  It uses HCHAR() to output numbers but it actually goes quite a bit quicker if you use PRINT CHR$(A(I)+48;

Original code:

  Hide contents

10 DIM A(256)
30 PRINT "7's Problem"
31 A(1)=7
32 WIN=0
33 POWER=1
41 NUMLEN=1
45 POWER=POWER+1
46 PRINT "7 ^";POWER;"IS:"::
48 CARRY=0
49 INAROW=0
50 FOR I=1 TO NUMLEN
60 A(I)=A(I)*7+CARRY
70 CARRY=INT(A(I)/10)
80 A(I)=A(I)-CARRY*10
82 IF A(I)<>7 THEN 89
83 INAROW=INAROW+1
84 IF INAROW<>6 THEN 90
85 WIN=1
86 GOTO 90
89 INAROW=0
90 NEXT I
100 A(I)=CARRY
101 IF CARRY=0 THEN 109
102 NUMLEN=NUMLEN+1
109 H=3
110 FOR I=NUMLEN TO 1 STEP -1
120 CALL HCHAR(23,H,48+A(I))
121 H=H+1
122 IF H<32 THEN 130
123 H=2
124 PRINT :
130 NEXT I
131 PRINT ::
140 IF WIN<>1 THEN 45
150 PRINT "WINNER IS 7 ^";POWER

 

  Hide contents

100 DIM A(256)
110 PRINT "7's Problem"
120 A(1)=7
130 WIN=0
140 POWER=1
150 NUMLEN=1
160 POWER=POWER+1
170 PRINT "7 ^";POWER;"IS:"
180 CARRY=0
190 INAROW=0
200 FOR I=1 TO NUMLEN
210    A(I)=A(I)*7+CARRY
220    CARRY=INT(A(I)/10)
230    A(I)=A(I)-CARRY*10
240    IF A(I)<>7 THEN 290
250    INAROW=INAROW+1
260    IF INAROW<>6 THEN 300
270    WIN=1
280    GOTO 300
290    INAROW=0
300 NEXT I
310 A(I)=CARRY
320 IF CARRY=0 THEN 340
330 NUMLEN=NUMLEN+1
340 FOR I=NUMLEN TO 1 STEP -1
350     PRINT CHR$(A(I)+48);
360 NEXT I
370 PRINT ::
380 IF WIN<>1 THEN 160
390 PRINT "WINNER IS 7 ^";POWER

If I remember correctly, I used HCHAR b/c printing with ; puts an extra space in on the TI, unlike other basics.

  • Like 1

Share this post


Link to post
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.

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