Jump to content
IGNORED

The 7's Problem


Willsy

Recommended Posts

I have an answer to this test in Basic and know it can be done. It is an interesting test for programmers in other languages, and is certainly suitable for c99 and Pascal. Here we go...

 

If I write 7^2, that means SEVEN SQUARED, or put another way, SEVEN TO THE POWER OF TWO, also 7 * 7.

 

Equally 7^3 is SEVEN TO THE POWER OF THREE or 7 * 7 * 7.

 

Get the idea?

 

OK. Your test is to write a program, in any language, which will determine the first power of seven which has a result containing six sevens in succession-eg "777777". Clue: The result has MORE than 15 digits!

To make checking easy, your program should print the result: "SEVEN TO THE POWER OF N IS" where of course N is the first power that gives a result matching our requirements, and also of course giving the actual result.

Link to comment
Share on other sites

I like that too icon_smile.gif

 

 

Not optimized at all, it's 2AM here...

 

 

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


180 CONSTANT SIZE
0 VARIABLE V1
0 VARIABLE V2
0 VARIABLE V3
CREATE2 A1 SIZE CELLS ALLOT
CREATE2 A2 SIZE CELLS ALLOT

: A1*7->A2 ( -- )
  0 V1 !
  0 V2 !
  BEGIN
    A1 V1 @ CELLS + @ 7 * V2 @ + DUP
    10 MOD A2 V1 @ CELLS + !
    10 / V2 !
    V1 @ 1+ DUP V1 !
  SIZE < WHILE REPEAT ;

: A2->A1 ( -- )
  SIZE 0 DO A2 I CELLS + @ A1 I CELLS + ! LOOP ;

: TYPE-A2 ( -- )
  0 V1 !
  FALSE V2 !
  -1 SIZE 1- DO
    A2 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-A2 ( -- f )
  0 V1 !
  FALSE V2 !
  SIZE 0 DO
    A2 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
  A2 SIZE CELLS 0 FILL
  7 A1 !
  2 V3 !
  BEGIN
    A1*7->A2
    CR ." SEVEN TO THE POWER OF " V3 @ . ." IS"
    V3 @ 1+ V3 !
    TYPE-A2
    A2->A1
  TEST-A2 UNTIL ;

 

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

Well, since a Forth version was posted, I had to try it in TurboForth!

 

A couple of changes were needed:

 

  • It is not neccessary to define TRUE or FALSE - they already exist
  • No need to initialise VARIABLEs with 0 - it does it for you
  • Need to define ENDIF (TF uses THEN)
  • Need to define CLS (TF uses PAGE)

 

Here's a head to head video... Who do you think wins?

 

http://www.youtube.com/watch?v=bQdYmz1WbNU

Link to comment
Share on other sites

Here is the optimized one. The loops were counting each time the maximal length of digits (180). Now they are counting only the digits of the actual number.

 

I could also try the version from sometimes (7 additions instead of a multiplication).

 

 

 

: 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
CREATE2 A2 SIZE CELLS ALLOT
0 VARIABLE LENGTH

: A1*7->A2 ( -- )
  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 A2 V1 @ CELLS + !
      10 / V2 !
      V1 @ 1+ V1 !
    ENDIF
  LOOP
  V1 @ LENGTH ! ;

: A2->A1 ( -- )
  LENGTH @ 0 DO A2 I CELLS + @ A1 I CELLS + ! LOOP ;

: TYPE-A2 ( -- )
  0 V1 !
  FALSE V2 !
  -1 LENGTH @ 1- DO
    A2 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-A2 ( -- f )
  0 V1 !
  FALSE V2 !
  LENGTH @ 0 DO
    A2 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
  A2 SIZE CELLS 0 FILL
  7 A1 !
  2 POWER !
  BEGIN
    A1*7->A2
    CR ." SEVEN TO THE POWER OF " POWER @ . ." IS"
    POWER @ 1+ POWER !
    TYPE-A2
    A2->A1
  TEST-A2 UNTIL ;

 

Edited by lucien2
Link to comment
Share on other sites

Here's my BASIC solution

 

Edit here's the compiled version:

SevensCompiled.zip

Compiled it kicks Forth's butt!

 

Compiled + OD is about 15-16s

 

Could probably make this faster by treating each integer as a number larger than 10... Could probably do

9 digits per nugget.

 

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

Edited by unhuman
Link to comment
Share on other sites

Here's my "optimized" version... It is (slightly) faster running in BASIC, however when I compile it, it's (significantly) slower. Also, I uncovered another compiler bug since it pushes out bad output when compiled... Think it's due to the math (division) that I'm doing

 

Sevens "optimized" compiled:

Sevens2Compiled.zip

 

10 DIM A(256)

30 PRINT "7's Problem"

31 A(1)=7

32 WIN=0

33 POWER=1

41 NC=1

45 POWER = POWER +1

46 PRINT "7 ^"; POWER; "IS:" : :

48 CARRY = 0

49 INAROW = 0

50 FOR I=1 TO NC

60 A(I) = A(I)*7 + CARRY

70 CARRY = INT(A(I) / 1000000000)

80 A(I) = A(I) - CARRY *1000000000

90 NEXT I

100 A(I) = CARRY

101 IF CARRY = 0 THEN 103

102 NC = NC +1

103 H=3

104 FOR I=NC TO 1 STEP -1

105 NUM$ = STR$(A(I))

106 L = LEN(NUM$)

107 IF I=NC THEN 119

108 NP=48

115 FOR J=L TO 8

116 GOSUB 200

118 NEXT J

119 FOR J=1 TO L

120 NP = ASC(SEG$(NUM$,J,1))

121 GOSUB 200

122 NEXT J

130 NEXT I

131 PRINT : :

140 IF WIN <> 1 THEN 45

150 PRINT "WINNER IS 7 ^";POWER

160 END

200 CALL HCHAR(23,H,NP)

221 H=H+1

222 IF H<32 THEN 225

223 H=2

224 PRINT :

225 IF NP = 55 THEN 228

226 INAROW=0

227 GOTO 250

228 INAROW = INAROW + 1

229 IF INAROW <> 6 THEN 250

230 WIN=1

250 RETURN

Edited by unhuman
Link to comment
Share on other sites

Compiled it kicks Forth's butt!

Maybe versus Weiand's Forth:

Compiled-Basic: 1m40s

Weiand-Forth: 3m

 

 

My first version runs in 3m with TF (5m with Weiand), so the new one must run in ~1m50s (I don't have TF to test it).

 

We can't really compare, since it's not exactly the same algorithm.

 

I'm new to forth, and I'm impressed with the performance against interpreted basic. icon_smile.gif

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

Make it out put all the ongoing calculation results. I think display is probably about 1/2 the problem anyway. :)

I know, that kinda makes it nice (all the output), but it was actually not, as I read it, part of the assignment ... :)

 

To make checking easy, your program should print the result: "SEVEN TO THE POWER OF N IS" where of course N is the first power that gives a result matching our requirements, and also of course giving the actual result.

I also thought about having any number and a search string as inputs. ;)

Edited by sometimes99er
Link to comment
Share on other sites

  • 8 years later...

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.  So this:

 : A2->A1 ( -- ) SIZE 0 DO  A2 I CELLS + @ A1 I CELLS + !  LOOP ;

Should be replaced with:

: A2->A1  ( -- )  A2 A1 SIZE CELLS CMOVE ;

CAMEL99 Forth has a pretty slow screen scroll because it's Forth so the LUCIEN2 version ran in 2:42. But this seems faster than the Youtube video.

Using the CMOVE version brought it down to 2:34.

 

I was curious what else could be done.  I got good improvements by using special words in CAMEL99;  ON, OFF and 1+! and removing some surplus logic code in places.

This got it down to 2:19.

Then I created some proper arrays using machine Forth macros and that got it down to 2:11.

If I remove the screen scrolling and do direct screen writes it gets down to 1:12 but that is nowhere close to the quoted C version of 8 seconds.

 

There are a lot of speed ups that would happen if it was written for Forth, without variables using the stack, because each reference requires a fetch but that takes time.

I also see opportunity to use addresses instead of indices to do the testing, but I couldn't make it work. (?)

 

Spoiler

\ lucien2 Version of FIG Forth PORTED to CAMEL99 Forth
\ camel99 has a slow scroll written in Forth. It eats up time.

\ CAMEL99 improvements:  USE CMOVE as designed, use 1+! ,  use ON,OFF


INCLUDE DSK1.TOOLS
INCLUDE DSK1.ELAPSE

\ machine Forth macros to create fast arrays
: 2*,     ( n -- 2(n)
          0A14 , ;  \ TOS  1 SLA, shift R1 1 bit left (mult. By 2)

: ()@,   ( addr -- )
          C124 , ( addr) ,   \ addr(TOS) TOS MOV

; 

: ()!,   ( addr -- )
          C936 , ( addr) ,  \ *SP+ ARRAY (TOS) MOV,
          C136 ,            \ TOS pop
;

DECIMAL

180 CONSTANT SIZE
VARIABLE V1
VARIABLE V2
VARIABLE POWER

CREATE A1 SIZE CELLS ALLOT
CREATE A2 SIZE CELLS ALLOT
CREATE PAD  256 ALLOT        \ FIXED memory is faster than PAD

CODE ]A1@ ( ndx -- n)  2*,  A1 ()@,  NEXT, ENDCODE
CODE ]A2@ ( ndx -- n)  2*,  A2 ()@,  NEXT, ENDCODE

CODE ]A1! ( ndx -- n)  2*,  A1 ()!,  NEXT, ENDCODE
CODE ]A2! ( ndx -- n)  2*,  A2 ()!,  NEXT, ENDCODE


VARIABLE LENGTH

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

: A2->A1          A2  A1  LENGTH @ CELLS  CMOVE ;

: VTYPE    ( addr len -- ) TUCK  VPOS SWAP VWRITE DUP VCOL +! OUT +! ;

: TYPE-A2 ( -- )
  V1 OFF
  -1  LENGTH @ 1-
  DO
    I ]A2@ 48 + DUP
    48 <>
    IF
      PAD V1 @ + C!
      V1 1+!
    ELSE
      DROP
    THEN
  -1 +LOOP
  CR  PAD V1 @ VTYPE CR ;

: TEST-A2 ( -- f )
  V1 OFF
  V2 OFF
  LENGTH @ 0
  DO
    I ]A2@ 7 =
    IF    V1 1+!
    ELSE  V1 OFF
    THEN
    V1 @ 5 > IF V2 ON THEN
  LOOP
  V2 @
;

: 7'S-PROBLEM
  PAGE
  A1 SIZE CELLS 0 FILL
  A2 SIZE CELLS 0 FILL
  7 A1 !
  2 POWER !
  BEGIN
    A1*7->A2
    0 0 AT-XY S" SEVEN TO THE POWER OF " VTYPE  POWER @ . S" IS"  VTYPE CR
    POWER 1+!
    TYPE-A2
    A2->A1
    ?TERMINAL ABORT" stop!"
  TEST-A2 UNTIL 
  0 6 AT-XY ;

\ CAMEL99 FAST scrolling version:  2:11
\ with VTYPE AND NO SCROLL  1:12

 

 

 

 

 

 

 

 

 

 

 

 

 

 

sevensproblem.png

  • Like 2
Link to comment
Share on other sites

This code is based on what was here. From what I can see it actually does skip the zero values when it makes the string to print maybe as a speed-up?

I suspect that the code to make the decision takes longer than just putting the character into the string. :)

 

  I ]A2@ 48 + DUP       \ read the number, add to ascii 0
    48 <>               \ if its not ascii 0
    IF
      PAD V1 @ + C!     \ store the char at PAD(V!)
      V1 1+!            \  V1 ++
    ELSE
      DROP              \ DROP the char
    THEN                \ then do the rest of the code. :-)

 

I will work on it a bit more.

Link to comment
Share on other sites

Ok that was not too hard.  I made use of >DIGIT which is in the kernel.

I also used SKIP which skips a leading character in a string so I don't print all the leading zeros.

I also took the liberty of creating macros to read the two variables that are used a lot.

So printing in place at the top of the screen we are down to 1:04

 

New code:

Spoiler

\ lucien2 Version of FIG Forth PORTED to CAMEL99 Forth
\ camel99 has a slow scroll written in Forth. It eats up time.

\ CAMEL99 improvements:  USE CMOVE as designed, use 1+! ,  use ON,OFF

INCLUDE DSK1.TOOLS
INCLUDE DSK1.ELAPSE
INCLUDE DSK1.CODEMACROS

DECIMAL

180 CONSTANT SIZE
\ variable         fast fetchers
VARIABLE V1        MACRO V1@   V1 @, ;MACRO
VARIABLE V2        MACRO V2@   V2 @, ;MACRO
VARIABLE POWER

CREATE A1 SIZE CELLS ALLOT
CREATE A2 SIZE CELLS ALLOT
CREATE PAD  256 ALLOT        \ FIXED memory is faster than PAD

MACRO ]A1@ ( ndx -- n)   A1 ()@,  ;MACRO
MACRO ]A2@ ( ndx -- n)   A2 ()@,  ;MACRO

MACRO ]A1! ( ndx -- n)   A1 ()!,  ;MACRO
MACRO ]A2! ( ndx -- n)   A2 ()!,  ;MACRO


VARIABLE LENGTH

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

\ : A2->A1          A2  A1  LENGTH @ CELLS  CMOVE ;

: VTYPE    ( addr len -- ) TUCK  VPOS SWAP VWRITE DUP VCOL +! OUT +! ;

: TYPE-A2 ( -- )
  V1 OFF
  -1  LENGTH @ 1-
  DO
    I ]A2@ >DIGIT PAD V1@ + C!
     V1 1+!
  -1 +LOOP
  CR  PAD V1@  [CHAR] 0 SKIP VTYPE CR ;

: TEST-A2 ( -- f )
  V1 OFF
  V2 OFF
  LENGTH @ 0
  DO
    I ]A2@ 7 =
    IF    V1 1+!
    ELSE  V1 OFF
    THEN
    V1@ 5 > IF V2 ON THEN
  LOOP
  V2 @
;

: 7'S-PROBLEM
  PAGE
  A1 SIZE CELLS 0 FILL
  A2 SIZE CELLS 0 FILL
  7 A1 !
  2 POWER !
  LENGTH OFF
  BEGIN
    A1*7->A2
    0 0 AT-XY  S" SEVEN TO THE POWER OF " VTYPE  POWER @ . S" IS"  VTYPE CR
    POWER 1+!
    TYPE-A2
    A2  A1  LENGTH @ CELLS  CMOVE
  TEST-A2 UNTIL
  0 6 AT-XY ;

\ CAMEL99 FAST  2:11
\ with VTYPE AND NO SCROLL  1:12

 

 

SEVENSPROBLEM2.png

  • Like 3
Link to comment
Share on other sites

And since I'm sitting here.

Here is the optimized code result using the scrolling screen like the original program with VDP drivers compared to un-optimized code running on CAMEL99 TTY Forth on a 9600 BPS terminal.  Elapse time is off the screen at the bottom but TTY  came in at 1:09  VDP was 2:16

 

My VDP driver really sucks! ?

 

 

 

CAMEL99 VDP optimized.png

CAMEL99 Forth Terminal VT.png

Edited by TheBF
updated images
  • Like 2
Link to comment
Share on other sites

On 3/25/2011 at 7:56 AM, lucien2 said:

Maybe versus Weiand's Forth:

Compiled-Basic: 1m40s

Weiand-Forth: 3m

 

 

 

 

I kind of went down the rabbit hole on this one ? because I really didn't feel like the Forth code was using the language well.

And I couldn't let this go could I?  Compiled BASIC beating threaded Forth! :)

 

So I did some review of the Forth code and it was definitely not optimal. For example, in the computation section , division and modulo division are required. 

The original code used two operations when the 9900 does that in one instruction and Forth support that with a /MOD operation that returns both results.

 

The computation routine was wrapped in a definite loop (do/loop) but inside there are three conditions upon which the loop exits.

The outer loop was unneeded.  Replaced it with a WHILE loop.

 

The original code was also computing the array+index in high level Forth every time is was used.  This can be helped with DUPing the address but I chose to bring in proper arrays with fast fetch and store operations for them.

 

The routine to convert the integer array to string of digits was also sub-optimal as was the routine that counted the "7" digits so those have been streamlined significantly.

 

As mentioned before the was an array copy routine written in hi-level Forth but Forth has ASM routines for memory to memory movement so that was a speed up too.

 

Bottom line it now runs in CAMEL99 regular version, with scrolling at about the same speed as the compiled BASIC. 

It would be a little faster in CAMEL99 FAST but only a second or two.

 

There are a couple of "gratuitous" variables used which is not normal Forth style, but truth be told the 9900 goes faster with variables for some purposes than using the stack.

 

New code is in the spoiler.

Spoiler

\ lucien2 Version of FIG Forth PORTED to CAMEL99 Forth with re-work

NEEDS DUMP   FROM DSK1.TOOLS
NEEDS ELAPSE FROM DSK1.ELAPSE
NEEDS ()@,   FROM DSK1.CODEMACROS

DECIMAL

180 CONSTANT SIZE
\ variable         fast fetchers
VARIABLE i        MACRO i@   i @, ;MACRO
VARIABLE X        MACRO X@   X @, ;MACRO
VARIABLE POWER
VARIABLE LENGTH

CREATE A1   SIZE CELLS ALLOT
CREATE A2   SIZE CELLS ALLOT

CREATE PAD  256 ALLOT

\ Integer Arrays that is indexed addressing
MACRO ]A1@ ( ndx -- n)   A1 ()@,  ;MACRO
MACRO ]A2@ ( ndx -- n)   A2 ()@,  ;MACRO

MACRO ]A1! ( ndx -- n)   A1 ()!,  ;MACRO
MACRO ]A2! ( ndx -- n)   A2 ()!,  ;MACRO


\ Note: Used UM/MOD,  un-signed division because it's faster
: A1*7->A2 ( -- )
           i OFF
           X OFF
           BEGIN
               i@ ]A1@ DUP 0=
               i@ LENGTH @ >  AND
               X@ 0=   AND
           0= WHILE
               7 * X@ + S>D  10 UM/MOD  X !  i@ ]A2!
               i 1+!
           REPEAT
           i@ LENGTH ! ;

\ number converions helpers
: <#      ( -- ) PAD HP ! ;        \ set HP to buffer for number conversion
: #>      ( -- pad length ) PAD HP @ OVER - ;
: HOLD   ( char -- )  HP @ C!  HP 1+! ;  \ hold digit in pad, bump pointer

: A2>$   ( -- pad length )
       <#
       -1 LENGTH @ 1-
        DO
           I ]A2@ [CHAR] 0 +   HOLD
        -1 +LOOP
        #> ;                        \ compute length

: SEVENS? ( addr length -- n )
         0 -ROT                  \ tuck a flag under the string
         BOUNDS
         ?DO
             1+ I C@ [CHAR] 7 = AND  \ count the sevens
             DUP 4 > IF LEAVE THEN   \ 5 in a row, get out
         LOOP ;

: INTRO
  PAGE ." The 5 Sevens Problem"
  CR
  CR   ." Find the power of 7 with more than"
  CR   ." 5 sequential sevens"
  CR
  CR   ." Press key to start"  KEY DROP
;

: RUN
     INTRO
     A1 SIZE CELLS 0 FILL
     A2 SIZE CELLS 0 FILL
     7 A1 !    2 POWER !   LENGTH OFF
     PAGE
     TICKER OFF
     BEGIN
        CR ." 7 ^"  POWER @ . ." IS:"
        A1*7->A2
        A2 A1  LENGTH @ CELLS CMOVE   \ copy A2->A1
        POWER 1+!
        A2>$ [CHAR] 0 SKIP 2DUP CR TYPE
        SEVENS?
     UNTIL
     CR
     CR
     CR
     CR ." The Answer is 7 ^" POWER @ 1- .
     CR .ELAPSED
;

\ CAMEL99 time  1:37

 

 

 

sevens in camel99.png

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

Hi all,

 

I used my My Little Compiler to solve the problem:

It solves the problem in 14 seconds (but only 7 seconds to calculate, the first 7 seconds are used to load the compiler from disk and compile the DATA lines).

 

here is the source for the Pre-compiler:

100 CALL CLEAR
$MLC F 110 10 3000
300 CALL LINK("SEVEN",N,A$)
310 PRINT "7 TO THE POWER OF ";N; " IS"
320 PRINT A$
330 END
$SEVEN 0
	DIMTABLE F 256			; F points to the special 256 bytes buffer
	DIMTABLE G 256			; G points to 256 bytes (for returning string)
	STARTDATA
	   BYTES 0,7,4,1,8,5,2,9,6,3
           BYTES 0,0,1,2,2,3,4,4,5,6
        ENDDATA	E			; E points to this multiplication table
	LET P 1				; current power = 1
	PUTTABLE F 0 7			; current value is 7 at first byte
	LET Z 0				; current LEN-1 of number in digits
	LET X 0				; clear word for byte operations
	LET A 0				; flag for "found"
	REPEAT
		LET N 0				; max occurences of 7
		LET C 0				; current carry is zero
		FOR I 0 Z
			GETTABLE F I X		; X = digit
			GETTABLE E X Y		; multiplied by 7
			ADD Y C			; plus carry
			ADD X 10		; points to tenths
			GETTABLE E X C		; get new carry
			COMPARE Y 10		; if more than a digit
			IF>=
        	        	SUB Y 10	; then reports... 
	                	INC C		; ...one tenth on carry
	    		ENDIF
			PUTTABLE F I Y		; store new digit
			COMPARE Y 7		; a "7" found?
			IF=
				INC N		; one more
				COMPARE N 6	; six "7" found?
				IF=
					INC A	; flag for found
				ENDIF
			ELSE
				LET N 0		; not a "7", reset counter
			ENDIF
		NEXT
		COMPARE C 0			; if carry remains
		IF<>
			INC Z				; then one more digit
			PUTTABLE F Z C			; and stored
   		ENDIF
		INC P	
	COMPARE A 0
	UNTIL<>
	LET J Z
	FOR I 0 Z
		GETTABLE F I X			; one digit from F table
		ADD X 48			; in ASCII
		PUTTABLE G J X			; one character in G string
		DEC J
	NEXT
	INC Z					; correct len
	LET U 2
	PUTTABLE U 0 G				; set A$ to G string with Z characters
        PUTPARAM 1 P				; set N to the current power
$$
$END

 

This is reduced to those few lines in XB :

 

100 CALL CLEAR
110 CALL INIT::PRINT "Loading MLC Compiler..."::CALL LOAD("DSK1.NEWFLO")::CALL LINK("NEWFLO")
120 IO(1)=3000::CALL LINK("COMPIL",IO(),S$(),C$())::If IO(1) THEN PRINT "Error ";IO(1)::END
130 PRINT "Compilation OK!"
300 CALL LINK("SEVEN",N,A$)
310 PRINT "7 TO THE POWER OF ";N; " IS"
320 PRINT A$
330 END
3000 DATA P
3010 DATA SEVEN
3020 DATA "TRF256TRG256_ABAT<TH10.00070401080502090603TH10.00000102020304040506TELAT>E=P1TPF0.7=Z0=X0=A0LA=N0=C0=I0LBTGFIXTGEXY+YC+X10TGEXC"
3030 DATA "CY10_C?<C-Y10ICLCTPFIYCY7_C!=CINCN6_D!=DIALD_DBDLC=N0LDIICIZ!>BCC0_B?=BIZTPFZCLBIPCA0?=A=JZ=I0LATGFIX+X48TPGJXDJIICIZ!>AIZ=U2"
3040 DATA "TPU0GP1P"
3050 DATA ""
3060 DATA ""

 

Guillaume.

 

mlc.jpg

  • Like 2
Link to comment
Share on other sites

Hi again,

 

If you want to try the program, here is a ZIP with:

  • 7power.txt : the source code for the Pre-Compiler
  • 7power.bas : the resulting Extented Basic code
  • DISK1 : a folder with:

SEVEN : the basic program

NEWFLO/MLC1/MLC2  the compiler

 

Copy the files from DSK1 to your DSK1 folder for Classic99 and:

 

OLD DSK1.SEVEN

RUN !

That's it.

 

For more informations about MLC, you can read my page...

MLC web page

 

Guillaume.

 

seven_mlc.zip

Link to comment
Share on other sites

On 3/24/2011 at 11:37 PM, lucien2 said:

 

I could also try the version from sometimes (7 additions instead of a multiplication).

 

 

Knowing that 7 = 8 - 1, you can say that :

value * 7 =  shift-left (value,3) - value.

That can be fast in assembly. But I don't know if your FORTH version has the binary shift instructions.

 

Guillaume.

Link to comment
Share on other sites

1 hour ago, moulinaie said:

 

Knowing that 7 = 8 - 1, you can say that :

value * 7 =  shift-left (value,3) - value.

That can be fast in assembly. But I don't know if your FORTH version has the binary shift instructions.

 

Guillaume.

Merci beaucoup Guillaume.

 

Yes ANS Forth has shift instructions, but if it didn't you can write Assembler almost as simply as Forth with the Forth assembler. :)

And thanks for the code.  I will look it over with delight.

 

(J'etais en Provenance en Aout.  Mon Dieu vous avez un pays manifique)

 

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