apersson850 Posted October 30, 2019 Share Posted October 30, 2019 (edited) 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 October 30, 2019 by apersson850 Quote Link to comment Share on other sites More sharing options...
+9640News Posted October 30, 2019 Share Posted October 30, 2019 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 Quote Link to comment Share on other sites More sharing options...
apersson850 Posted October 30, 2019 Share Posted October 30, 2019 The side port is slightly different compared to the bus in the PEB, but not suitable for this modification, no. Quote Link to comment Share on other sites More sharing options...
lucien2 Posted October 30, 2019 Share Posted October 30, 2019 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 version: He 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 ; Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 30, 2019 Share Posted October 30, 2019 Yes I noticed that. However using CMOVE nullifies the big time delay in the original array copy. I will incorporate your ideas into my version and see what it buys me. Thanks for reviewing the code for us. Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 30, 2019 Share Posted October 30, 2019 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. Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 31, 2019 Share Posted October 31, 2019 (edited) 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 October 31, 2019 by TheBF Fix the spoiler Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 31, 2019 Share Posted October 31, 2019 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 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 31, 2019 Share Posted October 31, 2019 (edited) 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 ; LASTSEVEN.mp4 Edited October 31, 2019 by TheBF insert code 1 Quote Link to comment Share on other sites More sharing options...
lucien2 Posted November 10, 2019 Share Posted November 10, 2019 (edited) 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 November 10, 2019 by lucien2 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 10, 2019 Share Posted November 10, 2019 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. 1 Quote Link to comment Share on other sites More sharing options...
lucien2 Posted November 10, 2019 Share Posted November 10, 2019 It's the original un-optimized version, but with only one array (Post #54). 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 10, 2019 Share Posted November 10, 2019 (edited) 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 November 10, 2019 by TheBF typo 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 10, 2019 Share Posted November 10, 2019 (edited) 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 November 10, 2019 by TheBF 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 10, 2019 Share Posted November 10, 2019 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 ; 1 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted November 10, 2019 Share Posted November 10, 2019 4 minutes ago, TheBF said: So now we have compared four Forth's which is is 4/4 which is the whole thing. Now, that is some signature! ...lee 1 Quote Link to comment Share on other sites More sharing options...
+RXB Posted November 10, 2019 Share Posted November 10, 2019 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. Quote Link to comment Share on other sites More sharing options...
lucien2 Posted November 10, 2019 Share Posted November 10, 2019 It's there, you just have to click the "reveal hidden contents" button. Here's my "library" file which includes "formatString", "print" and "scroll": lib.gpl Quote Link to comment Share on other sites More sharing options...
+RXB Posted November 11, 2019 Share Posted November 11, 2019 23 hours ago, lucien2 said: It's there, you just have to click the "reveal hidden contents" button. Here's my "library" file which includes "formatString", "print" and "scroll": lib.gpl 21.81 kB · 4 downloads OK what the hell is .gpl format? 1 Quote Link to comment Share on other sites More sharing options...
lucien2 Posted November 11, 2019 Share Posted November 11, 2019 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. Quote Link to comment Share on other sites More sharing options...
+RXB Posted November 11, 2019 Share Posted November 11, 2019 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. Quote Link to comment Share on other sites More sharing options...
lucien2 Posted November 11, 2019 Share Posted November 11, 2019 I said TI994w used also the GPL extension. I meant for another format (binary format). You really should try the XDT GPL assembler, it assembles the RXB cartridge in a few seconds. I'll see if I can easily convert my sources for the Ryte Data assembler. Quote Link to comment Share on other sites More sharing options...
lucien2 Posted November 11, 2019 Share Posted November 11, 2019 Here are the converted sources: 7's problem - TEXT files.zip I didn't find an utility to correctly convert tabs to spaces (even Notepad++ stupidly replaces all tab characters with a fix number of spaces). So I wrote one: Tab conversion.zip 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 13, 2019 Share Posted November 13, 2019 (edited) 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 November 13, 2019 by TheBF video link 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 14, 2019 Share Posted November 14, 2019 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 ; 1 1 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.