+TheBF Posted April 25, 2021 Author Share Posted April 25, 2021 I promised @HOME AUTOMATION that I would deliver something for him to play with the BRICKS demo. The attached Zip file has CAMEL267 executable and CAM267SC executable for Supercart so it works on Classic99 out of the box. To start the system from E/A cart option 5 DSK1.CAMEL267 runs the normal version that loads at >A000 DSJ1.CAM267SC runs an experimental version that loads into SuperCart RAM at >6000 There are 3 folders which are FIAD disks. DSK1.ITC Has library files that programs INCLUDE to extend the Forth systems functionality DSK2.ITC Has ED9940 editor which sits on top of Forth so there is a little room left for you to test some Forth inside ED9940 (about 3K ) DSK3.ITC Has demo programs that show how to do things with this darn thing. For the brick demo: There is DSK3.BRICKS which shows how to create a binary program BRICKEXE that you run E/A 5. Inside Forth type INCLUDE DSK3.BRICKS. Type BYE. Select Option 5 and type DSK3.BRICKSEXE. There is also DSK3.BRICKSBEEP which you INCLUDE from inside Forth and type GO to make it ... go. To restart the system and reload the font at any time type COLD ( as in COLD boot) This is all from my work-in-progress folder. It seems pretty stable for me, but I know where are the demons are. ------------ Baring My Soul In this zip file I have also zipped up the source code for the system and the compiler that can re-build it. I don't really expect anybody to be interested in re-building it but the source code is Forth written in Forth so that's fun to look at. I don't have a manual for the cross-compiler finished but there is a readme.txt file with instructions and of course I live right here if you need help. The source code is really to help anybody using the system to better understand how the innards actually work. 2.67 Differences from 2.66 Completely knew VDP driver. Up to 20% faster on some things S" Action is ANS standard for compiling strings into definitions BUT it is non-standard because it is an state smart word. Does different things for compiling and interpreting It now accepts multiple strings in interpreting mode as long they are input on the same line. Example: S" String #1" S" String#2 " S" String #3" <ENTER> returns three separate stack strings to the data stack. Some library files have been made smaller ANSFILES, GRAFIX Slightly faster number printing. Super cart executable program CAM267SC One source file can build either conventional program or supercart program using compiler switch called CARTRIDGE in CAMEL267.HSF By the way the .HSF files are my extension for Harvard Softworks Forth, a DOS Forth from 1989 to 199? by Jim Kalihan. I only spoke with him on the phone but he was a great programmer. HsForth was made to create HUGE model DOS programs and so the system is built into different DOS segments. Hellish complicated but revolutionary at the time. We lost Jim when he was only 61 a few years ago. RIP. CAMEL99.267.zip 1 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 27, 2021 Author Share Posted April 27, 2021 For people who work with ARC files here are the three disks ARCed. CAM267,ARC CAMEL2 CAMEL3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 27, 2021 Author Share Posted April 27, 2021 I was modifying my little snake game and I came across this code: : MOVE-SNAKE-TAIL 0 LENGTH @ DO I ]SNAKE-X DUP @ SWAP CELL+ ! I ]SNAKE-Y DUP @ SWAP CELL+ ! -1 +LOOP ; The core of the game came from a website that had Forth running on a browser window. I severely modified it to work on TI-99. The original author was new to Forth and so used a conventional way of moving the contents of a couple of arrays by putting them in a loop. In fact I think I had improved this already by not doing this: I ]SNAKE-X @ I 1+ ]SNAKE-X ! I is a calculation and the array is a calculation. Experienced Forth coders get the address once and DUP it and work with address. This is because Forth is not an optimizing compiler. It just does what you say. You are the optimizer. So this is better: I ]SNAKE-X DUP @ SWAP CELL+ ! But this is way better : MOVE-SNAKE-TAIL \ src addr dest addr size \ --------- --------- ------------- SNAKE-X-HEAD DUP CELL+ LENGTH @ CELLS CMOVE> SNAKE-Y-HEAD DUP CELL+ LENGTH @ CELLS CMOVE> ; CMOVE> is a CODE word that moves bytes starting and the end of a block of memory and moves the end towards the front. This way if you are copying a block of memory to an address that overlaps the destination you don't erase all that good data. Truth be told I never found a need for this word and I had to debug the first version I wrote but this one works and it makes the snake much faster. CODE CMOVE> ( src dst n -- ) \ move chars from end of string and go backwards *SP+ R2 MOV, \ pop DEST into R2 *SP+ R1 MOV, \ pop source into R1 TOS W MOV, \ dup n W DEC, \ compute n-1 W R1 ADD, \ point to end of source W R2 ADD, \ point to end of destination BEGIN, TOS DEC, \ decr the counter in TOS (R5) OC WHILE, \ carry=true until tos goes from 0 to -1 *R1 *R2 MOVB, R1 DEC, \ move the pointers back R2 DEC, REPEAT, TOS POP, NEXT, ENDCODE You can paste this game in the spoiler into Classic99 with Camel99 Forth V2.67 running. I finally gave the snake a moveable head. You control it in the code with commands LEFT FACE, RIGHT FACE, etc. Spoiler \ snake a simple game in Forth ported to CAMEL99 Forth \ DERIVED FROM: https://skilldrick.github.io/easyforth/#snake \ revised to use CAMEL99/TI-99 features CR .( \\\\\\ Version 5.1 \\\\\\\\ ) \ \\ snake sounds and mouse squeak \\\\\ INCLUDE DSK1.RANDOM INCLUDE DSK1.GRAFIX INCLUDE DSK1.CASE INCLUDE DSK1.ARRAYS MARKER /SNAKE \ remove snake, keep library code CR .( compiling Snake...) \ ======================================= \ We use direct control of the sound chip \ rather than sound lists and a player. \ noise control words : NOISE ( n -- ) E0 OR SND! ; \ n selects the noise type \ noise envelope control : NOISE-DB ( db --) F MIN F0 OR SND! ; : NOISE-OFF ( -- ) F NOISE-DB ; HEX : NOISE-UP ( speed -- ) 2 F DO I NOISE-DB DUP MS -1 +LOOP DROP ; : NOISE-DOWN ( speed -- ) F 2 DO I NOISE-DB DUP MS LOOP DROP NOISE-OFF ; \ channel 1 sound control words DECIMAL : f(clk) ( -- d) 46324 1 ; \ this is 111,860 as 32 bit int. \ >FCODE re-arranges freq. value nibbles (4bits) for the TMS9919 HEX : >FCODE ( 0abc -- 0cab) \ ASM would make this much faster DUP 0F AND SWAP ( -- 000c 0abc) 4 RSHIFT ( -- 000c 00ab) SWAP >< ( SWPB) ( -- 00ab 0c00) + ; : HZ>CODE ( freq -- fcode ) f(clk) ROT UM/MOD NIP >FCODE 8000 OR ; \ *TRICKY STUFF* \ Calculating the 9919 freq. code takes too long BUT we can convert frequency \ to 9919 chip code at compile time then compile as 16 bit literal number \ using this text MACRO : [HZ] ( freq -- fcode ) S" HZ>CODE ] LITERAL" EVALUATE ; \ sound channel #1 control words : FREQ! ( fcode -- ) SPLIT SND! SND! ; : ]HZ ( freq -- ) [HZ] POSTPONE FREQ! ; \ pre-compiled fcode version : HZ ( freq -- ) HZ>CODE SPLIT SND! SND! ; \ runtime calculation version : DB ( n -- ) 90 OR SND! ; : MUTE ( -- ) 9F SND! ; DECIMAL 500 CONSTANT MAXLENGTH \ x/y coordinate storage for the snake MAXLENGTH ARRAY ]SNAKE-X MAXLENGTH ARRAY ]SNAKE-Y : SNAKE-X-HEAD ( -- addr) [ 0 ]SNAKE-X ] LITERAL ; : SNAKE-Y-HEAD ( -- addr) [ 0 ]SNAKE-Y ] LITERAL ; .( .) VARIABLE SPEED VARIABLE PREY-X VARIABLE PREY-Y VARIABLE DIRECTION VARIABLE LENGTH \ characters used DECIMAL 136 CONSTANT SHEAD \ use different color set 42 CONSTANT SNAKE 128 CONSTANT PREY 30 CONSTANT BRICK BL CONSTANT WHITE \ Direction #s 0 CONSTANT LEFT 1 CONSTANT UP 2 CONSTANT RIGHT 3 CONSTANT DOWN HEX CREATE HEADLEFT 0C16 , 37FF , FF37 , 160C , CREATE HEADUP 1818 , 3C7E , 99FF , 7E3C , CREATE HEADRIGHT 3068 , ECFF , FFEC , 6830 , CREATE HEADDOWN 3C7E , FF99 , 7E3C , 1818 , \ array of head patterns CREATE HEADS ( n -- addr ) HEADLEFT , HEADUP , HEADRIGHT , HEADDOWN , \ set head pattern n to snake's head : ]HEADPATTERN ( n -- addr) CELLS HEADS + @ SHEAD CHARDEF ; : FACE ( direction# -- ) DUP ]HEADPATTERN DIRECTION ! ; \ shape data for PREY, brick, mouse and snake chars HEX CREATE CLAY 007E , 6A56 , 6A56 , 7E00 , CREATE VIPER 3C5E , EBF7 , EBDD , 7E3C , CREATE MOUSE 0004 , 3E7B , 7FFC , 8270 , CREATE MOUSE2 0008 , 3F7B , 7EFC , 8270 , \ mouse looking up CREATE JUMPMS 84BE , FB7F , 3C42 , 0000 , DECIMAL \ get random x or y position within playable area : RANDOM-X ( -- n ) C/L@ 2- RND 1+ ; : RANDOM-Y ( -- n ) L/SCR 2- RND 1+ ; \ text macros make drawing faster. : DRAW-WHITE ( x y -- ) S" >VPOS BL SWAP VC! " EVALUATE ; IMMEDIATE : DRAW-SNAKE ( X Y -- ) S" >VPOS SNAKE SWAP VC! " EVALUATE ; IMMEDIATE : DRAW-HEAD ( x y -- ) S" >VPOS SHEAD SWAP VC! " EVALUATE ; IMMEDIATE : DRAW-PREY ( -- ) PREY PREY-X @ PREY-Y @ >VPOS VC! ; .( .) : DRAW-WALLS 0 0 BRICK 31 HCHAR 0 1 BRICK 22 VCHAR 31 0 BRICK 24 VCHAR 0 23 BRICK 31 HCHAR ; : DRAW-SNAKE SNAKE-X-HEAD @ SNAKE-Y-HEAD @ DRAW-HEAD LENGTH @ 1 DO I ]SNAKE-X @ I ]SNAKE-Y @ DRAW-SNAKE LOOP LENGTH @ DUP ]SNAKE-X @ SWAP ]SNAKE-Y @ DRAW-WHITE ; : INITIALIZE-SNAKE 4 DUP LENGTH ! 1+ 0 DO 12 I - I ]SNAKE-X ! 12 I ]SNAKE-Y ! LOOP RIGHT FACE ; : PLACE-PREY ( y x -- ) PREY-X ! PREY-Y ! ; : MOVE-SNAKE-HEAD ( n -- ) DIRECTION @ CASE LEFT OF -1 SNAKE-X-HEAD +! ENDOF UP OF -1 SNAKE-Y-HEAD +! ENDOF RIGHT OF 1 SNAKE-X-HEAD +! ENDOF DOWN OF 1 SNAKE-Y-HEAD +! ENDOF ENDCASE ; \ move each segment of the snake forward by one DECIMAL \ : MOVE-SNAKE-TAIL \ 0 LENGTH @ \ DO \ I ]SNAKE-X DUP @ SWAP CELL+ ! \ I ]SNAKE-Y DUP @ SWAP CELL+ ! \ -1 +LOOP ; : MOVE-SNAKE-TAIL \ src addr dest addr size \ --------- --------- ------------- SNAKE-X-HEAD DUP CELL+ LENGTH @ CELLS CMOVE> SNAKE-Y-HEAD DUP CELL+ LENGTH @ CELLS CMOVE> ; : MOVE-SNAKE ( -- ) MOUSE2 PREY CHARDEF 4 NOISE 8 NOISE-DB \ soft white noise MOVE-SNAKE-TAIL 10 NOISE-DB \ ramp down noise MOVE-SNAKE-HEAD 12 NOISE-DB \ ramp down noise MOUSE PREY CHARDEF NOISE-OFF ; .( .) DECIMAL : HORIZONTAL? ( -- ?) DIRECTION @ DUP LEFT = SWAP RIGHT = OR ; : VERTICAL? ( -- ?) DIRECTION @ DUP UP = SWAP DOWN = OR ; : TURN-UP HORIZONTAL? IF UP FACE THEN ; : TURN-LEFT VERTICAL? IF LEFT FACE THEN ; : TURN-DOWN HORIZONTAL? IF DOWN FACE THEN ; : TURN-RIGHT VERTICAL? IF RIGHT FACE THEN ; ( EXIT THEN gets out of the case statement faster than ENDOF) : CHANGE-DIRECTION ( key -- ) CASE [CHAR] S OF TURN-LEFT EXIT THEN \ ENDOF [CHAR] E OF TURN-UP EXIT THEN \ ENDOF [CHAR] D OF TURN-RIGHT EXIT THEN \ ENDOF [CHAR] X OF TURN-DOWN EXIT THEN \ ENDOF ENDCASE ; DECIMAL : SWOOSH ( -- ) NOISE-OFF 5 NOISE 8 NOISE-UP 20 NOISE-DOWN ; : NEW-PREY SWOOSH PREY-X @ PREY-Y @ DRAW-WHITE RANDOM-Y RANDOM-X PLACE-PREY DRAW-PREY ; : GROW-SNAKE ( -- ) 1 LENGTH +! ; : DEAD-SNAKE ( -- ) NOISE-OFF SNAKE SET# DUP 11 1 COLOR 250 MS 2 1 COLOR SHEAD SET# 2 1 COLOR ; : HAPPY-SNAKE ( -- ) [ SNAKE SET# ] LITERAL 17 3 DO DUP I 1 COLOR I 100 * HZ 0 DB 40 MS LOOP MUTE ( -- 5) 13 1 COLOR ; .( .) DECIMAL : DECAY ( n -- ) 16 0 DO I DB DUP MS LOOP DROP ; : SQUEAK ( -- ) NOISE-OFF [ 3800 ]HZ 0 DB 45 MS \ pre-computed freq. is faster 6 DB 25 MS [ 3500 ]HZ 75 MS 8 DB 25 MS [ 1300 ]HZ 11 DB 25 MS [ 800 ]HZ MUTE ; DECIMAL : SCARED-PREY ( -- ) JUMPMS PREY CHARDEF SQUEAK [ PREY SET# ] LITERAL DUP 9 1 COLOR 2 1 COLOR MOUSE PREY CHARDEF ; : FASTER ( -- ) SPEED @ 5 - 1 MAX SPEED ! ; : CHECK-PREY ( -- ) SNAKE-X-HEAD @ PREY-X @ = SNAKE-Y-HEAD @ PREY-Y @ = AND IF SCARED-PREY HAPPY-SNAKE GROW-SNAKE FASTER NEW-PREY THEN ; : COLLISION? ( -- ? ) SNAKE-X-HEAD @ SNAKE-Y-HEAD @ >VPOS VC@ DUP BRICK = SWAP SNAKE = OR ; \ utility words for menus : WAIT-KEY BEGIN KEY? UNTIL ; : AT" POSTPONE AT-XY POSTPONE ." ; IMMEDIATE : INITIALIZE PAGE 4 SCREEN MOUSE PREY CHARDEF PREY SET# 2 1 COLOR CLAY BRICK CHARDEF BRICK SET# 9 1 COLOR VIPER SNAKE CHARDEF SNAKE SET# 13 1 COLOR SHEAD SET# 7 1 COLOR DRAW-WALLS INITIALIZE-SNAKE RANDOM-Y RANDOM-X PLACE-PREY ; .( .) HEX : PLAY ( -- ) BEGIN SPEED @ MS DRAW-SNAKE DRAW-PREY 83C8 OFF \ set continuous key reading KEY? CHANGE-DIRECTION MOVE-SNAKE CHECK-PREY COLLISION? UNTIL 0C SCREEN HONK 0B 5 AT" GAME OVER" HONK DEAD-SNAKE ; : SETLEVEL ( n --) SPEED ! ; DECIMAL : MENU PAGE 5 5 AT" Select Start Level" 5 8 AT" 1 - SNAIL" 5 9 AT" 2 - WORM" 5 10 AT" 3 - SNAKE 5 11 AT" 4 - VIPER" 3 23 AT" (It goes faster as you win) " 5 13 AT-XY BEGIN KEY CASE [CHAR] 1 OF 150 SETLEVEL EXIT THEN [CHAR] 2 OF 110 SETLEVEL EXIT THEN [CHAR] 3 OF 75 SETLEVEL EXIT THEN [CHAR] 4 OF 50 SETLEVEL EXIT THEN HONK ENDCASE AGAIN ; DECIMAL : TITLE ( -- ) GRAPHICS 5 5 AT" THE SNAKE" 5 7 AT" Use the E,S,D,X keys" 5 8 AT" to move the snake 5 9 AT" and catch the mouse." 5 12 AT" The more he eats, 5 13 AT" the faster he goes!" 5 20 AT" Press any key to begin..." WAIT-KEY ; .( .) : RUN ( -- ) TITLE MENU BEGIN INITIALIZE PLAY 500 MS KEY? DROP ( wait for key release) 2 13 AT" Your snake was " LENGTH @ . ." Ft. long" 2 15 AT" Press ENTER to play again" KEY 13 <> UNTIL NOISE-OFF 8 20 AT" SSSSSee you later!" 1500 MS GRAPHICS ; RUN SnakeSnippet.mp4 2 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted April 27, 2021 Share Posted April 27, 2021 45 minutes ago, TheBF said: CMOVE> is a CODE word that moves bytes starting and the end of a block of memory and moves the end towards the front. This way if you are copying a block of memory to an address that overlaps the destination you don't erase all that good data. I know you know this, but neophytes may be misled by the above comment. The proper direction of copy depends on the nature of the overlap. If the destination block starts at a higher address (as in this case), CMOVE> is safe when they overlap. However, if the destination block starts at a lower address, CMOVE> will clobber the source block along the overlap. For that situation, CMOVE is needed to safely copy overlapping blocks in the forward direction (low to high). ? ...lee 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 27, 2021 Author Share Posted April 27, 2021 Quite right. Forth 94 actually proposed the word MOVE which uses a test first to determine if CMOVE or CMOVE> should be used. It was in the Camel Forth but I removed it because the decision was written in Forth and so was little slowdown and it took space that I felt I could better used. : MOVE ( src dst n -- ) >R 2DUP SWAP DUP R@ + WITHIN IF R> CMOVE> ELSE R> CMOVE THEN ; From what I can understand Forth 2012 has done away with this MOVE in favour of MOVE being a native cell size data mover. I think that's was what MOVE originally did in the old days in PolyForth. "Plus ca change..." 1 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted April 27, 2021 Share Posted April 27, 2021 Must’ve been that way with figForth’s MOVE as well because TI Forth and fbForth use the unconditional, forward MOVE to copy cells. For what it’s worth, TI Forth and fbForth depend on the overlap-destructive behavior of CMOVE in the definition of FILL to copy a single byte to a block of memory. ...lee 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 27, 2021 Author Share Posted April 27, 2021 2 hours ago, Lee Stewart said: Must’ve been that way with figForth’s MOVE as well because TI Forth and fbForth use the unconditional, forward MOVE to copy cells. For what it’s worth, TI Forth and fbForth depend on the overlap-destructive behavior of CMOVE in the definition of FILL to copy a single byte to a block of memory. ...lee That's a clever space saver!. I will have to look into that. Thanks Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted April 27, 2021 Share Posted April 27, 2021 4 minutes ago, TheBF said: That's a clever space saver!. I will have to look into that. Thanks I don’t need much encouragement! : FILL ( addr count byte --- ) \ S:addr count byte SWAP >R \ S:addr byte R:count OVER \ S:addr byte addr R:count C! \ S:addr R:count DUP 1+ \ S:addr addr+1 R:count R> \ S:addr addr+1 count 1- \ S:addr addr+1 count-1 CMOVE ; ...lee 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 27, 2021 Author Share Posted April 27, 2021 You're the best! That adds 16 bytes in Forth. I am wondering if I could be smaller in ALC with that OVER and DUP and >R R> being replaced by register or stack references? I am going to try putting fill above CMOVE and doing a JMP into it. This means I could do the same thing with VFILL. 1 Quote Link to comment Share on other sites More sharing options...
speccery Posted April 27, 2021 Share Posted April 27, 2021 On 4/26/2021 at 12:49 AM, TheBF said: I promised @HOME AUTOMATION that I would deliver something for him to play with the BRICKS demo. The attached Zip file has CAMEL267 executable and CAM267SC executable for Supercart so it works on Classic99 out of the box. To start the system from E/A cart option 5 DSK1.CAMEL267 runs the normal version that loads at >A000 DSJ1.CAM267SC runs an experimental version that loads into SuperCart RAM at >6000 A simple question: what is the SuperCart? Just wondering if it is something I can build into the StrangeCart... If it is paged RAM, should be simple Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 27, 2021 Author Share Posted April 27, 2021 3 minutes ago, speccery said: A simple question: what is the SuperCart? Just wondering if it is something I can build into the StrangeCart... If it is paged RAM, should be simple It is just RAM at >6000. In mine I just stick 8K. The card sold by @arcadeshopper has place for switches to map in 4 x 8K blocks. forgot to say in the Editor assembler cart. 1 Quote Link to comment Share on other sites More sharing options...
+arcadeshopper Posted April 27, 2021 Share Posted April 27, 2021 A simple question: what is the SuperCart? Just wondering if it is something I can build into the StrangeCart... If it is paged RAM, should be simple [emoji4] http://www.mainbyte.com/ti99/supercart/supercart_4bank.htmlhttp://www.mainbyte.com/ti99/supercart/supercart.htmlI sell a pcb that does the 4 bank module designed by Jim Fetzner that makes it a lot simpler.Sent from my LM-V600 using Tapatalk 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 27, 2021 Author Share Posted April 27, 2021 Unbelievably Simple CO-Routines in any Forth (that I can think of) I was reading Reddit/Forth this morning and saw this post about work by Albert VanDerHorst's. https://home.hccnet.nl/a.w.m.van.der.../forthlectures.html How's this for a simple multi-threader for Forth: (Uses common data and return stack for all threads) ANS/ISO Forth version: : YIELD 2R> SWAP 2>R ; \ that's it! that's all it takes. And to prove how versatile it is, here is an example for FbForth: Explanation: COUNTER is a thread that just increments X in a loop CONSUMER reads X and prints it until break key is pressed This is cooperative multi-tasking without the expense of separate workspaces and separate stacks Ideal for games that need to baby-sit something while the game is being played without extra overhead Note: YIELD could be coded in ALC as a simple RSWAP and be 10X faster for almost no overhead to switch threads : YIELD R> R> SWAP >R >R ; \ that's it! that's all it takes. 0 VARIABLE X : COUNTER ( n --) X ! BEGIN 1 X +! YIELD \ yield control to the consumer AGAIN ; : CONSUMER CR 0 COUNTER \ init & start the counter thread BEGIN X @ . YIELD \ yield control to the COUNTER ?TERMINAL UNTIL ." DONE! " R> DROP ; 1 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted April 27, 2021 Share Posted April 27, 2021 4 hours ago, TheBF said: You're the best! That adds 16 bytes in Forth. I am wondering if I could be smaller in ALC with that OVER and DUP and >R R> being replaced by register or stack references? I am going to try putting fill above CMOVE and doing a JMP into it. This means I could do the same thing with VFILL. CMOVE will make VFILL very slow by setting the VDP Write Address every byte (not even sure you could use the same code). Rather, you should set the starting VRAM address and copy the byte to VRAM in a loop to take advantage of the VDP’s autoincrementing of VRAM. ...lee Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted April 27, 2021 Share Posted April 27, 2021 1 hour ago, TheBF said: Unbelievably Simple CO-Routines in any Forth (that I can think of) I was reading Reddit/Forth this morning and saw this post about work by Albert VanDerHorst's. https://home.hccnet.nl/a.w.m.van.der.../forthlectures.html How's this for a simple multi-threader for Forth: (Uses common data and return stack for all threads) . . . What happens if the return stack is used for data in one of the threads? ...lee Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 27, 2021 Author Share Posted April 27, 2021 34 minutes ago, Lee Stewart said: CMOVE will make VFILL very slow by setting the VDP Write Address every byte (not even sure you could use the same code). Rather, you should set the starting VRAM address and copy the byte to VRAM in a loop to take advantage of the VDP’s autoincrementing of VRAM. ...lee Yes and I looked into my code and saw that FILL is only 12 bytes long due to our favourite CPU's nice instruction set. So I canned that idea. Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 27, 2021 Author Share Posted April 27, 2021 32 minutes ago, Lee Stewart said: What happens if the return stack is used for data in one of the threads? ...lee Caveat emptor I guess. Patient: "Doctor it hurts when I do this" Doctor: " Well then don't do that!" 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 27, 2021 Author Share Posted April 27, 2021 55 minutes ago, Lee Stewart said: What happens if the return stack is used for data in one of the threads? ...lee Somewhere in 1G of files I have here I have a multi-tasker that uses separate stacks and that would be compatible with FbForth. I have to find that. Quote Link to comment Share on other sites More sharing options...
+TheBF Posted May 3, 2021 Author Share Posted May 3, 2021 Maybe You Should Sit Down This will come as shock but after 4 years I have a first version of a Glossary for the kernel of Camel99 Forth. It's 13 pages even in a condensed form that I am saw in MeCrisp Forth by Mathias Koch. It does answer many questions for anybody interested. It's probably good that I waited this long since I was really exploring a dozen different options for many aspects of the system until this time. Edit: Found some words that I missed. I need automation for this job. CamelForth Glossary.docx - Google Docs.pdf 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted May 3, 2021 Author Share Posted May 3, 2021 Bug fix to CAMEL267 kernel file While testing a multi-tasking demo program I found a bug in 2.67. I forgot to access the number printing buffer in a multi-task friendly way (as a user variable) This ZIP file has replacement of just the kernel file V2.67B. Please replace the CAMEL267 file in your installations. The super cart version is not repaired. It is not happy with the changes yet. Here is the demo program that blows up in 2.67 and will run in 2.67B \ ONETASK.FTH simple counter DEMO Apr 20 2021 Brian fox \ Puts a running counter on top corner of your screen NEEDS FORK FROM DSK1.MTASK99 NEEDS U.R FROM DSK1.UDOTR \ make a memory space for our task CREATE TASK1 USIZE ALLOT \ USIZE is the size of one "user area" \ FORK copies Forth's entire workspace into TASK1's workspace TASK1 FORK VARIABLE X \ A simple global variable DECIMAL \ make the compiler use decimal arithmetic : COUNTER1 ( -- ) \ A background job for the computer DECIMAL \ make this job use decimal math 200 TPAD ! \ give this task a PAD 200 bytes above Forth's PAD BEGIN X 1+! \ increment x 33 0 AT-XY \ put THIS task's cursor a column 33, row 0 \ each task has its own VROW and VCOL variables X @ 6 U.R \ fetch X and print right justified, 6 columns 100 MS \ Wait 100 milli-seconds. \ MS gives time to other tasks while it waits AGAIN ; \ jobs must always loop or do SLEEP PAUSE ' COUNTER1 TASK1 ASSIGN \ assign COUNTER1 to TASK1 CR CR .( =====================) CR .( Demo Instructions:) CR CR .( Type MULTI to enable tasking) CR .( Type TASK1 WAKE ) CR .( counter appears upper left) CR .( X OFF resets variable) CR .( TASK1 SLEEP) CR .( counter stops) CR .( SINGLE disables all tasking) CR CAMEL267B.zip 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted May 4, 2021 Author Share Posted May 4, 2021 So here is a crazy thing I was working on last week because of the amount of work it takes to make documents. The MPE company in UK has a product called DOCGEN. It's really fancy and can turn literate programming files into HTML documents. I don't want to go that far yet but it would be nice to be able to feed all my library files to a thing like that and have it produce some useful text files as a starting point for a Glossary. I have hundreds of files and probably 700+ words to document. So how would you do that? Normally if would require quite a bit of string processing and parsing but I think DOCGEN does it something like this. Make a Forth wordlist that only has the words you want to be sent to the doc file Redefine those Forth words to actually do the work of generating the output that you require Change the compiler so that it only understands the keywords and EXECUTEs those words but ignores all the rest of the text in the file. Process the file I have the beginnings of this working and I have successfully processed an entire disk of 127 files by reading the catalog into an array. I just need to get the part done that outputs a text file. I want the text output section to be a useful tool in its one right so it's taking more time. This is all happening on the TI-99 using Classic99. Example: The word VARIABLE is re-defined to simply parse the text after the word VARIABLE and type that name followed by some text. : VARIABLE PARSE&TYPE S" variable " TYPE ; Same is true for any other keyword you want to capture. DOCGEN also uses some magic codes that are buried in comments to control the output like this: (It has about 20 codes for formatting etc) I will only use two code for now until I get a better idea of what I can accomplish. Control codes embedded in comments: \ *G generate a document header and output the text that follows as the first line \ ** continuation of the text for more explanations. And the bracket comments ( -- ) in Forth, I will use to simply print out all the stack diagrams directly from the source code. That's a big saving alone. It does mean to get full benefit I have to go into the files and add the magic codes in some comments. Here are some pieces of the code. The word DOCGEN is below is the MAPACTION. It reads one string of text and processes it. MAPFILE is a higher order function that reads a file and passes each line to MAPACTION. If you pass something that is not a DV80 file to MAPACTION it just exits on the OPEN-FILE error. This way I can feed any disk catalog to it and it ignores program files and other formats. I am excited to get this working. : PARSE&TYPE CR BL PARSE-WORD TYPE SPACE ; VOCABULARY KEYWORDS ONLY FORTH ALSO KEYWORDS DEFINITIONS \ docgen tokens CHAR G CHAR * FUSE CONSTANT '*G' \ "*G" as 2 chars for faster parsing CHAR * CHAR * FUSE CONSTANT '**' \ change the meaning of special Forth words so they output information : VARIABLE PARSE&TYPE S" variable " TYPE ; : CREATE PARSE&TYPE S" create " TYPE ; : CONSTANT PARSE&TYPE S" CONSTANT " TYPE ; : USER PARSE&TYPE S" USER " TYPE ; : ARRAY PARSE&TYPE S" integer array " TYPE ; : CARRAY PARSE&TYPE S" char array " TYPE ; : VALUE PARSE&TYPE S" value " TYPE ; : CODE PARSE&TYPE S" CODE word " TYPE ; : : PARSE&TYPE S" colon def. " TYPE ; \ The line comment becomes an interpreter so that normal comments are ignored \ But tokens are read that can be interpreted \ *G is a document header. \ ** is a document line : \ 1 PARSE ( -- addr len) \ read the entire line OVER @ CASE '*G' OF CR ." >" 2 /STRING TYPE ENDOF '**' OF CR ." " 2 /STRING TYPE ENDOF 2DROP ( default is just a comment) ENDCASE ; : ( ." ( " [CHAR] ) PARSE TYPE ." ) " ; \ print stack diagram FORTH ONLY FORTH DEFINITIONS \ keyword interpret only executes KEYWORDS. Does nothing for anything else : DOCGEN ( addr len -- ) ONLY KEYWORDS 'SOURCE 2! >IN OFF BEGIN BL WORD DUP C@ ( -- Caddr len) WHILE FIND ( -- XT ?) IF ( it's a MAGIC word) EXECUTE ELSE DROP THEN REPEAT DROP ONLY FORTH ; DEFER MAPACTION ' DOCGEN IS MAPACTION 82 STRING: READBUFF : REFILL ( -- addr len) READBUFF DUP 80 INFILE READ-LINE ?FILERR DROP ; \ use: START S" DSK1.MYFILE" ' ANALYZE MAPFILE : MAPFILE ( addr len --) DV80 R/O OPEN-FILE IF EXIT THEN TO INFILE BEGIN REFILL ( -- addr len ) MAPACTION #LINES 1+! INFILE EOF UNTIL DROP INFILE CLOSE-FILE S" *** end of file ***" TYPELN CR ; 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted May 5, 2021 Author Share Posted May 5, 2021 As I mentioned I needed a way to re-direct text to an output file in order to make automatic documents. So here is something that lets me do that. It's starting to feel like a real programming system now when I can do things like this. It's not really efficient and I have not created a way to only send to the file but it will let me take a run an making a DOCGEN utility and get some kind of Glossary for my libraries to my thousands of waiting Forth fans. ? Here is an example of what I can now do. \ outfile.fth test code S" DSK6.TESTFILE" MAKE-OUTPUT ( create a new file ) S" This is record #1" TYPE CR S" and this is #2" TYPE CR S" * end of first use. " TYPE CR CLOSE-OUTPUT S" DSK6.TESTFILE" OPEN-OUTPUT ( Append an existing file ) S" This is 2nd time we used the file" TYPE CR S" I hope this works correctly." TYPE CR 994A U. CR DEAD U. CR BEEF U. CR -99 . CR S" End of 2nd use of output file" TYPE CR And here is the file that the code generated: This is record #1 and this is #2 * end of first use. This is 2nd time we used the file I hope this works correctly. 994A DEAD BEEF -99 End of 2nd use of output file A couple of interesting things at least for me. The file handle OUTH becomes the flag for whether or not we echo to file The CR does double duty in that if an output file is opened it executes a FLUSH-BUFFER and writes to disk, clears the VDP counter and clears the VDP record I use the PAB buffer in VDP RAM directly as the output buffer for the program text The PAB byte counter is used like a variable to be a pointer where text can be appended to the buffer The PAB record size in VDP RAM is used for error detection just like I would use a Forth variable As chars are put into the buffer with TYPE or EMIT the PAB byte counter is incremented. The byte counter and the PAB file-buffer field are added to make the VDP address where new text goes into the buffer If the byte counter exceeds 80 bytes we abort with a message. This method of manipulating VDP RAM directly saves Forth memory space since we have all the routines to read/write bytes, integers and strings for VDP RAM. And using the internal byte counter in VDP RAM means I don't need another variable to keep track of this. The speed penalty is not that much compared to the Forth overhead already present so why not? I have also decided to add a new non-standard word to my ANS File code to support the TI-99. The ANS Forth standard file access modes are: R/O (read only,, TI-99 INPUT) R/W (read/write, TI-99 UPDATE) W/O (write only, TI-99 OUTPUT) I will add this one to the next release: W/A (write append, TI-99 APPEND) One step closer to a big 'ole glossary. Edit: 1. I am thinking this opens a door to make file pipes of some kind... 2. Updated spoiler Spoiler \ OUTFILE.FTH echo screen output to text file May 2021 Brian Fox \ Method: Write data into pab FILE buffer, keeping track of char count \ Use the char count in the pab as Pointer into the Pab when we write \ so data is written to [PAB FBUFF] V@ [PAB CHARS] VC@ + \ Only write to disk when CR is encountered. \ No control characters allowed. Use spaces for DV80 files. NEEDS WRITE-FILE FROM DSK1.ANSFILES NEEDS VALUE FROM DSK1.VALUES HEX 0 VALUE OUTH \ output file handle : MAKE-OUTPUT ( a u -- ) \ *G creates a new output file DV80 W/O CREATE-FILE ?FILERR TO OUTH ; : W/A APPEND FAM @ ; \ Not standard Forth but needed for TI file sys. : OPEN-OUTPUT ( a u -- ) \ open output file in APPEND mode OUTH ABORT" Output file is already open" DV80 W/A OPEN-FILE ?FILERR TO OUTH ; : CLOSE-OUTPUT ( -- ) OUTH CLOSE-FILE DROP 0 TO OUTH ; : [PABCHARS]+! ( n -- ) \ bump the file buffer char count by n [PAB CHARS] VC@ + DUP [PAB RECLEN] VC@ > ABORT" Out buffer full" [PAB CHARS] VC! ; \ update the PAB : OUTBUFF ( -- Vaddr) [PAB FBUFF] V@ [PAB CHARS] VC@ + ; : WRITELN ( caddr len -- ) OUTH DUP 0= ABORT" Output file not open" SELECT TUCK ( -- len caddr len ) \ get a copy of the length OUTBUFF SWAP VWRITE \ write string to buffer ( len) [PABCHARS]+! ; \ update buffer char count : FLUSH-BUFFER ( -- ) 3 FILEOP ?FILERR \ write to disk 0 [PAB CHARS] VC! \ reset byte counter [PAB FBUFF] V@ 80 0 VFILL \ erase buffer (debugging) ; \ ========================================== \ redefine standard output words to echo to file if output handle is active : CR ( -- ) CR OUTH IF FLUSH-BUFFER THEN ; : EMIT ( c --) DUP EMIT OUTH IF PAD C! PAD 1 WRITELN EXIT THEN DROP ; : TYPE ( a u --) 2DUP TYPE OUTH IF WRITELN EXIT THEN 2DROP ; : SPACE BL EMIT ; : SPACES ( n -- ) 0 MAX 0 ?DO SPACE LOOP ; \ number output with echo : UD. ( d -- ) <# #S #> TYPE SPACE ; : U. ( u -- ) 0 UD. ; : . ( n -- ) DUP ABS 0 <# #S ROT SIGN #> TYPE SPACE ; 4 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted May 10, 2021 Author Share Posted May 10, 2021 I was getting frustrated chasing bugs in the DOCGEN project so I went away for awhile to try something that I thought would be simpler. Well that didn't work out as well as I suspected but I was so close I had to keep at this one. Forth Just-in-time Compiler (for CODE words) This is in the style of GForth-fast from what I understand. The compiler expands CODE words in a buffer one after another with not interpreter and makes a "super-instruction" as they call it. I had the code to expand code definitions into a buffer with the INLINE[] project so I thought this would be simple... My first attempts (yes that's plural) tried to make a secondary compiler loop that went into action when an inline-able word was found. This was a disaster and the complexity just grew. Doing things that way I had to replicate dealing with immediate words and numbers and all, inside the secondary loop. Totally wrong approach. The secret was to not get fancy and stay in the primary compiler/interpreter loop. This meant simply finishing any pending super instruction in both the EXECUTE branch and the COMPILER branch of the interpreter loop. This way when semi-colon came along or any loop or branching word the JIT compiler just finished off what it was doing because they hit the EXECUTE branch. I had already vectored the compiler loop through a variable so I made a new one which is plugged into the 'IV variable by the JIT command. You go back to normal compilation with the /JIT command. The one thing extra thing I needed was a way to limit which code words would be put into super-instructions. I did this by using an free bit in the IMMEDIATE field of the words I want to be JIT compiled. I only want words that are one to 5 instructions because larger code words already run fast and the calling overhead is not big percentage of the time used. So with the INLINE: command you mark any words that you want to be JIT compiled. This is a very naïve version. If you make a definition with one code word in it, it duplicates that code word in the heap memory which is stupid, but I will need more complicated logic to make that happen. I am sticking to the make it work then make it better and the logic to do this drove me crazy when I was doing it all wrong. The screen shot shows what happens in an extreme example where all the operations are JIT compiled in a loop in the code below. The example shows how this idea copes with non-JIT terms in the code. The final multiply is part of a separate super-instruction because it is following a literal number. So the 1st JIT super-instruction ends with the '+' sign. The literal number 12 is compiled normally and the * and DROP make new super-instruction. \ operator test with/without JIT HEX /JIT : OPTEST 3000 0 DO I DUP SWAP OVER ROT DROP DUP AND DUP OR DUP XOR 1+ 1- 2+ 2- 2* 2/ NEGATE ABS + 12 * DROP LOOP ; HEX JIT : OPTEST 3000 0 DO I DUP SWAP OVER ROT DROP DUP AND DUP OR DUP XOR 1+ 1- 2+ 2- 2* 2/ NEGATE ABS + 12 * DROP LOOP ; The JIT idea is in the Spoiler Spoiler \ jit.fth just in time primitive compiler May 8 2021 Brian Fox \ Method: \ Use the a bit from the Camel Forth precedence field as an INLINE flag. \ If this flag is set JIT, copies machine code from the kernel into the HEAP \ as a headless code word. \ The copying continues, creating a super-instruction until a non-inline word \ is found in the source code. NEEDS .S FROM DSK1.TOOLS NEEDS ELAPSE FROM DSK1.ELAPSE MARKER /REMOVE HERE HEX \ need NORMAL copies of words that are WEIRD in the Camel99 kernel CODE @ C114 , NEXT, ENDCODE CODE C@ D114 , 0984 , NEXT, ENDCODE CODE DROP C136 , NEXT, ENDCODE : XT>PREC ( XT -- | 0 ) \ convert XT to precedence field BEGIN 2- DUP C@ 0FC AND 0= UNTIL ; \ VARIABLE JITC \ flag that JIT compiler iS on/off : INLINE? ( xt -- ?) XT>PREC C@ 02 AND 0> ; : ?COLON ( xt --) DUP @ 2- <> ABORT" Can't inline secondary word" ; : INLINE: ( <name> ) \ mark <name> "inlineable" ie: Set inline flag. BL WORD FIND 0= ?ERR \ DUP ?COLON XT>PREC DUP C@ 02 OR \ fetch precedence field, set bit 1 SWAP C! ; \ This is a compile time action and takes no code space INLINE: ! INLINE: @ INLINE: 2! INLINE: 2@ INLINE: C! INLINE: COUNT INLINE: C@ INLINE: +! INLINE: C+! INLINE: >R INLINE: R> INLINE: R@ INLINE: DROP INLINE: NIP INLINE: DUP INLINE: SWAP INLINE: OVER INLINE: ROT INLINE: -ROT INLINE: >< INLINE: 2DROP INLINE: 2DUP INLINE: PICK INLINE: AND INLINE: OR INLINE: XOR INLINE: 1+ INLINE: 1- INLINE: 2+ INLINE: 2- INLINE: 2* INLINE: 4* INLINE: 8* INLINE: 2/ INLINE: INVERT INLINE: + INLINE: - INLINE: M+ INLINE: ABS INLINE: NEGATE INLINE: ALIGNED INLINE: UM* INLINE: * INLINE: OFF INLINE: ON INLINE: FUSE \ Heap management words : HEAP ( -- addr) H @ ; : HALLOT ( n -- ) H +! ; : HEAP, ( n -- ) HEAP ! 2 HALLOT ; 045A CONSTANT 'NEXT' : CODE, ( xt --) \ compile expanded machine code into HEAP >BODY DUP 80 CELLS + \ set a max size for any code fragment SWAP ( -- end start) BEGIN DUP @ 'NEXT' <> \ the instruction is not 'NEXT' WHILE DUP @ HEAP, \ fetch and compile the instruction CELL+ \ advance to next address 2DUP < ABORT" End of code not found" REPEAT 2DROP ; VARIABLE SUPERXT \ Holds XT of current super instruction : NEW-SUPER? ( -- ?) SUPERXT @ 0= ; \ are we starting a new super instruction : NEW-HEADER, ( -- ) \ Create headless CODE word in heap if needed HEAP ( -- XT) \ HEAP is the execution token (XT) DUP SUPERXT ! \ remember where we parked :-) 2+ HEAP, \ create the ITC header for a CODE word ; : JIT, ( xt -- ) NEW-SUPER? IF NEW-HEADER, THEN CODE, ; : ?END-SUPER ( -- ) \ complete a super intruction, compile into definition SUPERXT @ IF 'NEXT' HEAP, \ compile next to end of super-instruction SUPERXT @ COMPILE, \ compile the super-intruction into colon word SUPERXT OFF \ make ready for a new JIT word THEN ; \ new interpreter/compiler loop with JIT : <JIT> ( i*x c-addr u -- j*x ) 'SOURCE 2! >IN OFF BEGIN BL WORD DUP C@ ( -- addr len) WHILE FIND ?DUP IF ( it's a word) 1+ STATE @ 0= OR \ immediate word or interpret mode? IF ?END-SUPER \ needed because ';' is immediate : EXECUTE ELSE DUP INLINE? ( xt ?) IF JIT, \ JIT compile it ELSE ?END-SUPER \ finish pending super-instruction COMPILE, \ normal compile it THEN THEN ELSE ( it's a number) COUNT NUMBER? ?ERR POSTPONE LITERAL THEN DEPTH 0< ABORT" Short stack" REPEAT DROP ; : RESET-HEAP 2000 H ! H @ 1000 0 FILL ; \ just in time compiler control words : /JIT ( -- ) ['] <INTERP> 'IV ! ; \ 'cut' just in time : JIT ( -- ) ['] <JIT> 'IV ! ; \ just in time is the compiler HERE SWAP - SPACE DECIMAL . .( bytes) HEX CR MARKER /TASK RESET-HEAP 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted May 11, 2021 Author Share Posted May 11, 2021 JIT Update From an academic standpoint I am pretty happy with the JIT. I always wondered how it could be done and now we have a framework. Nevertheless it has some bugs and I am not sure I want to pursue them much further. At the end of the day it makes the Forth system much more complicated in exchange for less source code manipulation to get some optimization. I think a native code cross-compiler is a better way to go. This could allow interactive Forth development and then final compilation to binary program ideally with the same source code. (that might be a stretch) This mirrors the way BASIC programmers can use the Isabella compiler. I tried a couple of benchmark programs and it makes some difference but it really depends on the code. If there are not a lot of consecutive code words it makes little difference. This little BENCHIE for example went from 26 seconds to 22.6 seconds, only a 15% improvement. 5 CONSTANT FIVE 0 VALUE BVAR HEX 100 CONSTANT MASK : BENCHIE MASK 0 DO 1 BEGIN DUP SWAP DUP ROT DROP 1 AND IF FIVE + ELSE 1- THEN TO BVAR BVAR DUP MASK AND UNTIL DROP LOOP ; \ 26 secs W/JIT: 22.6 My goto benchmark, the Sevens Problem, ran correctly but never stops. I suspect due to my comparison operators which are not normal Forth words so I need to add proper versions to the JIT compiler. The 8QUEENS benchmark ran but failed to complete as well. Note: 8QUEENS benchmark was improved greatly by just using the new ;CODE based CARRAY. 7:30 FORTH CARRAY , 5:25 with ;CODE CARRAY (-38%) Manually in-lining all the code words which is what the JIT should have done, gave a time of 4:42 (-7%) so again less improvement than just optimizing array indexing. Potential enhancements: Fix the comparison operators and whatever unknown bugs are present Code word counting. This would allow the system to ignore single code word super-instructions and just compile the code word normally when ?END-SUPER runs. Reach into my work on inlining variables, constants and user variables to improve those expressions Dig deeper into my inline research and optimize branching. This would be a lot of extra complication. 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted May 11, 2021 Author Share Posted May 11, 2021 Code word counting was not hard to add. It reduces the pointless heap memory usage very nicely. It took 3 extra state variables. I added REMEMBER-HEAP RECLAIM-HEAP so they don't need comments. This will be my final version for now. Spoiler \ jit4.fth just in time primitive compiler May 8 2021 Brian Fox \ Method: \ Use the a bit from the Camel Forth precedence field as an INLINE flag. \ If this flag is set JIT, copies machine code from the kernel into the HEAP \ as a headless code word. \ The copying continues, creating a super-instruction until a non-inline word \ is found in the source code. \ May 11 *added code word counting to ignore single code words NEEDS .S FROM DSK1.TOOLS NEEDS ELAPSE FROM DSK1.ELAPSE MARKER /REMOVE HERE HEX \ need NORMAL copies of words that are WEIRD in the Camel99 kernel CODE @ C114 , NEXT, ENDCODE CODE C@ D114 , 0984 , NEXT, ENDCODE CODE DROP C136 , NEXT, ENDCODE : XT>PREC ( XT -- | 0 ) \ convert XT to precedence field BEGIN 2- DUP C@ 0FC AND 0= UNTIL ; \ VARIABLE JITC \ flag that JIT compiler iS on/off : INLINE? ( xt -- ?) XT>PREC C@ 02 AND 0> ; : ?COLON ( xt --) DUP @ 2- <> ABORT" Can't inline secondary word" ; : INLINE: ( <name> ) \ mark <name> "inlineable" ie: Set inline flag. BL WORD FIND 0= ?ERR \ DUP ?COLON XT>PREC DUP C@ 02 OR \ fetch precedence field, set bit 1 SWAP C! ; \ This is a compile time action and takes no code space INLINE: ! INLINE: @ INLINE: 2! INLINE: 2@ INLINE: C! INLINE: COUNT INLINE: C@ INLINE: +! INLINE: C+! INLINE: >R INLINE: R> INLINE: R@ INLINE: DROP INLINE: NIP INLINE: DUP INLINE: SWAP INLINE: OVER INLINE: ROT INLINE: -ROT INLINE: >< INLINE: 2DROP INLINE: 2DUP INLINE: PICK INLINE: AND INLINE: OR INLINE: XOR INLINE: 1+ INLINE: 1- INLINE: 2+ INLINE: 2- INLINE: 2* INLINE: 4* INLINE: 8* INLINE: 2/ INLINE: INVERT INLINE: + INLINE: - INLINE: M+ INLINE: ABS INLINE: NEGATE INLINE: ALIGNED INLINE: UM* INLINE: * INLINE: OFF INLINE: ON INLINE: FUSE INLINE: I INLINE: J \ Heap management words : HEAP ( -- addr) H @ ; : HALLOT ( n -- ) H +! ; : HEAP, ( n -- ) HEAP ! 2 HALLOT ; 045A CONSTANT 'NEXT' \ state variables to undo optimization for case of single code word VARIABLE #CODE \ # of code words JIT compiled VARIABLE OLDHEAP \ heap at start of JIT compilation VARIABLE CODEXT \ XT of CODE word that we are expanding : REMEMBER-HEAP ( -- ) HEAP OLDHEAP ! ; : RECLAIM-HEAP ( -- ) OLDHEAP @ H ! ; : CODE, ( xt --) \ compile expanded machine code into HEAP DUP CODEXT ! \ remember original XT >BODY DUP 80 CELLS + \ set a max size for any code fragment SWAP ( -- end start) BEGIN DUP @ 'NEXT' <> \ the instruction is not 'NEXT' WHILE DUP @ HEAP, \ fetch and compile the instruction CELL+ \ advance to next address 2DUP < ABORT" End of code not found" REPEAT 2DROP #CODE 1+! ; VARIABLE SUPERXT \ Holds XT of current super instruction : NEW-SUPER? ( -- ?) SUPERXT @ 0= ; \ are we starting a new super instruction : NEW-HEADER, ( -- ) \ Create headless CODE word in heap if needed HEAP ( -- XT) \ HEAP is the execution token (XT) DUP SUPERXT ! \ remember where we parked :-) 2+ HEAP, \ create the ITC header for a CODE word ; : JIT, ( xt -- ) REMEMBER-HEAP NEW-SUPER? IF NEW-HEADER, THEN CODE, ; : ?END-SUPER ( -- ) \ complete a super intruction, compile into definition SUPERXT @ IF #CODE @ 1 > \ test if there is more than one code word IF 'NEXT' HEAP, \ compile next to end of super-instruction SUPERXT @ COMPILE, \ compile the super-intruction into colon word ELSE CODEXT @ COMPILE, \ compile the original code word instead RECLAIM-HEAP THEN THEN #CODE OFF \ reset the word counter SUPERXT OFF \ ready for a new JIT word ; \ new interpreter/compiler loop with JIT : <JIT> ( i*x c-addr u -- j*x ) 'SOURCE 2! >IN OFF BEGIN BL WORD DUP C@ ( -- addr len) WHILE FIND ?DUP IF ( it's a word) 1+ STATE @ 0= OR \ immediate word or interpret mode? IF ?END-SUPER \ needed because ';' is immediate : EXECUTE ELSE DUP INLINE? ( xt ?) IF JIT, \ JIT compile it ELSE ?END-SUPER \ finish pending super-instruction COMPILE, \ normal compile it THEN THEN ELSE ( it's a number) COUNT NUMBER? ?ERR POSTPONE LITERAL THEN DEPTH 0< ABORT" Short stack" REPEAT DROP ; : RESET-HEAP 2000 H ! H @ 1000 0 FILL ; \ just in time compiler control words : /JIT ( -- ) ['] <INTERP> 'IV ! ; \ 'cut' just in time : JIT ( -- ) ['] <JIT> 'IV ! ; \ just in time is the compiler HERE SWAP - SPACE DECIMAL . .( bytes) HEX CR MARKER /TASK RESET-HEAP 1 Quote Link to comment Share on other sites More sharing options...
Like us on Facebook
Follow us on Twitter
AtariAge on Instagram
Watch us on YouTube
Chat on Discord
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.