+Lee Stewart Posted October 8, 2022 Share Posted October 8, 2022 1 hour ago, TheBF said: Very nice. I have to take off today but I will get back to this. Do you see any performance improvement? Your DEMO program did seem to run faster, but I have not checked timing. 1 hour ago, TheBF said: One little machine code word ( RDROP) might make it a bit faster and even smaller maybe. Indubitably! I almost did that, but in light of my “unembellished fbForth” comment, backed off. ...lee 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 8, 2022 Author Share Posted October 8, 2022 (edited) I took a run at making Neil's COMPARE work under Turbo Forth. This compiles and gives correct results but may have unseen bugs in the corner cases. ?? \ Neil Baud's toolbelt: COMPARE for Turbo Forth Brian Fox \ Turbo Forth to ANS/Camel99 Forth harness : UNLOOP R> DROP R> DROP R> DROP ; \ TF do/loop has 3 items on Rstack : BOUNDS OVER + SWAP ; \ Niel's code : COMPARE ( a1 n1 a2 n2 -- -1|0|1 ) \ 0 means string are the same \ -1 means string1 > string2 \ 1 means string1 < string2 ROT 2DUP - >R ( a1 a2 n2 n1)( R: n2-n1) MIN ( a1 a2 n3) BOUNDS 2DUP = IF 2DROP R> DROP EXIT THEN DO ( a1) COUNT I C@ - ( a1 diff) DUP IF NIP 0< 1 OR ( -1|1) UNLOOP R> DROP EXIT ( a1 diff) THEN DROP ( a1) LOOP DROP ( ) R> DUP IF 0> 1 OR THEN \ 2's complement arith. ; \ * TEST CODE * \ Handy word to "place" a stack string into memory : PLACE ( src n dst -- ) 2DUP C! 1+ SWAP CMOVE ; : .$ COUNT TYPE ; \ prinT COUNTED string from memory CREATE A$ 40 ALLOT CREATE B$ 40 ALLOT CREATE C$ 40 ALLOT S" THIS IS A$" A$ PLACE S" B$ is different" B$ PLACE A$ COUNT C$ PLACE \ c$ is now the same as a$ A$ .$ B$ .$ C$ .$ A$ COUNT C$ COUNT COMPARE . A$ COUNT B$ COUNT COMPARE . B$ COUNT A$ COUNT COMPARE . Edited October 8, 2022 by TheBF typo 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 8, 2022 Author Share Posted October 8, 2022 (edited) Topic shift: Local variables using 9900 indexed addressing mode Local variables are frowned upon for simple Forth words but if you are translating a complex equation, they are very handy. I have always wondered if we could use indexed addressing on the return stack for local variables the way a C or Pascal compiler would do it. When you are compiling conventional source code you have the freedom to "emit" the best code because it is an offline job. Since indexed addressing mode uses hard values in the code for the indexes it is a bit more challenging for Forth. This solution is totally non-standard. ANS standard locals would consume a crapload of memory to implement on our little machine and would be quite inefficient. You also need to manage label creation and destruction which needs string manipulation, so it gets big fast. This implementation uses 106 bytes plus the code for the number of local variables you define. Four locals plus the compilers uses 250 bytes. I took the approach of using pre-named local variables, but you have the freedom to name the locals as you see fit. The locals are pre-defined with words to compile SETTER and GETTER machine code that uses indexed addressing. (I could have made locals return their address on the return stack and use @ and ! but they would be slower) The word LOCALS builds a stack frame on the return stack for n local variables. /LOCALS collapses the stack frame. I don't know if it matters but you can even nest locals in a definition if you needed locals for another purpose. Spoiler \ cheaplocals.fth for Camel99 Forth Oct 2022 Brian Fox \ create a stack frame and use named temp variables in Forth \ NEEDS DUMP FROM DSK1.TOOLS NEEDS MOV, FROM DSK1.ASM9900 HERE DECIMAL \ build a stack frame n cells deep CODE LOCALS ( n --) RP R0 MOV, \ save current Rstack position TOS 1 SLA, \ n -> cells TOS RP SUB, \ allocate space on Rstack R0 RPUSH, \ Rpush the old Rstack position TOS POP, \ refill TOS register from memory stack NEXT, ENDCODE CODE /LOCALS ( -- ) \ collapse stack frame *RP RP MOV, NEXT, ENDCODE \ Local variable compilers : GETTER ( n --) \ create name that returns a contents of a local CODE TOS PUSH, ( n) 2* (RP) TOS MOV, NEXT, ; : SETTER ( n --) \ create name that sets contents of a local CODE TOS SWAP 2* (RP) MOV, TOS POP, NEXT, ; HERE SWAP - DECIMAL . Demo code \ make as many of these as you think you will need 1 GETTER L1 1 SETTER L1! 2 GETTER L2 2 SETTER L2! 3 GETTER L3 3 SETTER L3! 4 GETTER L4 4 SETTER L4! : TEST ( -- n) 4 LOCALS 1 L1! 2 L2! 3 L3! 4 L4! L1 L2 + L3 + L4 + /LOCALS \ clean up return stack ; : SLO-ROT ( a b c -- b c a) 3 LOCALS L3! L2! L1! L1 L2 L3 /LOCALS ; : NESTED ( -- n1 n2) \ :-) 2 LOCALS 1 L1! 1 L2! 2 LOCALS 4 L1! 4 L2! L1 L2 + ( = 8 ) /LOCALS L1 L2 + ( = 2) /LOCALS ; Edited October 8, 2022 by TheBF fixed comments 2 Quote Link to comment Share on other sites More sharing options...
GDMike Posted October 8, 2022 Share Posted October 8, 2022 Is there a general memory location for storing just simple temporary values that you use, other than the VDP screen and ASCII table RAM area.. because I use that quite a bit.. actually, I suppose I could use $EFF0....so is that ok. Well, I dunno... Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted October 9, 2022 Share Posted October 9, 2022 51 minutes ago, GDMike said: Is there a general memory location for storing just simple temporary values that you use, other than the VDP screen and ASCII table RAM area.. because I use that quite a bit.. actually, I suppose I could use $EFF0....so is that ok. Well, I dunno... The stack grows down from high RAM and the dictionary grows up from >A000, so you cannot use it willy-nilly. You can ALLOT space inline in the dictionary as long as you label it with a variable name or some such. Low RAM usage varies with which Forth you are using, but there may be space there. ...lee 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 9, 2022 Author Share Posted October 9, 2022 4 hours ago, GDMike said: Is there a general memory location for storing just simple temporary values that you use, other than the VDP screen and ASCII table RAM area.. because I use that quite a bit.. actually, I suppose I could use $EFF0....so is that ok. Well, I dunno... I see some people's Forth code where they use the end of the dictionary for things like that. It's called HERE. HERE is just a word that fetches the contents of a variable called the "dictionary pointer". (In Camel99 I called it DP. Other Forth's called something else but its just a variable) BUT... you have to know the details of your Forth system to use HERE for temp storage. The compiler uses HERE when it is adding words to the dictionary so if you are compiling it's not "free". Some systems use memory very close to HERE for converting numbers into text strings, so don't use it when you are writing numbers to the screen. However if you want to use free dictionary space and then give it back you can do it like this. (you have to promise that you will give it back ok?) The idea being you RESERVE it inside a colon definition and give it back before you hit the semi-colon. That's not a rule it's just easier to remember to give it back at that point. \ simplest no-protection memory manager. You have been warned : RESERVE ( n -- addr ) HERE SWAP ALLOT ; : RESTORE ( n -- ) NEGATE ALLOT ; \ demo code \ pointer holders 0 VALUE TEMP1 0 VALUE TEMP2 0 VALUE VAR1 100 RESERVE TO TEMP1 \ reserve 100 bytes, assign to temp1 100 RESERVE TO TEMP2 \ do it again. 2 RESERVE TO VAR1 \ etc \ the dictionary is now 202 bytes bigger, but it's yours to use \ use it just like a variable HEX 994A VAR1 ! VAR1 @ U. \ use these as temp. memory blocks or arrays or strings. TEMP1 ASCII A 100 FILL \ fill temp1 space TEMP1 TEMP2 100 CMOVE \ copy temp1 to temp2 space 100 RESTORE \ move the dictionary back 100 bytes 100 RESTORE \ do it again. 2 RESTORE \ etc \ better to do Separate restores to prevent mistakes. (and it's easy to make mistakes with this) Read through it with the comments and see if makes sense. I await your questions. (Tested on TF just now) 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 9, 2022 Author Share Posted October 9, 2022 (edited) Local Variables Version II It took me a while to remember how to use ;CODE for this application. ;CODE lets us re-use the same machine code for every local variable rather than duplicate it every time. To further simplify these locals variables return their address like normal variables so you use @ and ! to get to the contents. The whole thing is way smaller this way. Only 112 BYTES with 4 locals pre-defined! This means you can name as many as you need because they consume very little space. The downside is that they are a bit slower than using indexed addressing to get and store the contents. \ localvars.fth for Camel99 Forth Oct 2022 Brian Fox \ create a stack frame and use as named temp variables in Forth \ Each local returns the address of a cell in the stack frame NEEDS DUMP FROM DSK1.TOOLS NEEDS MOV, FROM DSK1.ASM9900 HERE DECIMAL \ build a stack frame n cells deep CODE LOCALS ( n --) RP R0 MOV, \ save current Rstack position TOS 1 SLA, \ n -> cells TOS RP SUB, \ allocate space on Rstack R0 RPUSH, \ Rpush the old Rstack position TOS POP, \ refill TOS register from memory stack NEXT, ENDCODE CODE /LOCALS ( -- ) \ collapse stack frame *RP RP MOV, NEXT, ENDCODE : LOCAL: ( n -- ) \ changed name to be clearer CREATE 2* , \ store n * 2 in the data field ;CODE TOS PUSH, RP TOS MOV, W TOS ADD, \ W holds the data field of the VAR: NEXT, ENDCODE 1 LOCAL: X1 2 LOCAL: X2 3 LOCAL: X3 4 LOCAL: X4 HERE SWAP - DECIMAL . Test code: HEX : TESTVAR 2 LOCALS DEAD X1 ! BEEF X2 ! X1 @ X2 @ /LOCALS ; Edited October 10, 2022 by TheBF updated code 3 Quote Link to comment Share on other sites More sharing options...
GDMike Posted October 10, 2022 Share Posted October 10, 2022 On 10/8/2022 at 9:21 AM, TheBF said: I took a run at making Neil's COMPARE work under Turbo Forth. This compiles and gives correct results but may have unseen bugs in the corner cases. ?? \ Neil Baud's toolbelt: COMPARE for Turbo Forth Brian Fox \ Turbo Forth to ANS/Camel99 Forth harness : UNLOOP R> DROP R> DROP R> DROP ; \ TF do/loop has 3 items on Rstack : BOUNDS OVER + SWAP ; \ Niel's code : COMPARE ( a1 n1 a2 n2 -- -1|0|1 ) \ 0 means string are the same \ -1 means string1 > string2 \ 1 means string1 < string2 ROT 2DUP - >R ( a1 a2 n2 n1)( R: n2-n1) MIN ( a1 a2 n3) BOUNDS 2DUP = IF 2DROP R> DROP EXIT THEN DO ( a1) COUNT I C@ - ( a1 diff) DUP IF NIP 0< 1 OR ( -1|1) UNLOOP R> DROP EXIT ( a1 diff) THEN DROP ( a1) LOOP DROP ( ) R> DUP IF 0> 1 OR THEN \ 2's complement arith. ; \ * TEST CODE * \ Handy word to "place" a stack string into memory : PLACE ( src n dst -- ) 2DUP C! 1+ SWAP CMOVE ; : .$ COUNT TYPE ; \ prinT COUNTED string from memory CREATE A$ 40 ALLOT CREATE B$ 40 ALLOT CREATE C$ 40 ALLOT S" THIS IS A$" A$ PLACE S" B$ is different" B$ PLACE A$ COUNT C$ PLACE \ c$ is now the same as a$ A$ .$ B$ .$ C$ .$ A$ COUNT C$ COUNT COMPARE . A$ COUNT B$ COUNT COMPARE . B$ COUNT A$ COUNT COMPARE . Was able to play with this, finally.. this is pretty neat and probably a very useful, well, I could see it having a pretty strong use. I'll be hanging this one on a line for future grabbing. I have to note that I looked again and this time I didn't find an equivalent word in TF, I don't know why I was thinking I had seen one there, but sorry for jumping the gun on my earlier comment. But this is really neat. Thx for sharing. 3 Quote Link to comment Share on other sites More sharing options...
Willsy Posted October 10, 2022 Share Posted October 10, 2022 17 hours ago, TheBF said: Local Variables Version II It took me a while to remember how to use ;CODE for this application. ;CODE lets us re-use the same machine code for every local variable rather than duplicate it every time. To further simplify these locals variables return their address like normal variables so you use @ and ! to get to the contents. The whole thing is way smaller this way. Only 112 BYTES with 4 locals pre-defined! This means you can name as many as you need because they consume very little space. The downside is that they are a bit slower than using indexed addressing to get and store the contents. \ localvars.fth for Camel99 Forth Oct 2022 Brian Fox \ create a stack frame and use as named temp variables in Forth \ Each local returns the address of a cell in the stack frame NEEDS DUMP FROM DSK1.TOOLS NEEDS MOV, FROM DSK1.ASM9900 HERE DECIMAL \ build a stack frame n cells deep CODE LOCALS ( n --) RP R0 MOV, \ save current Rstack position TOS 1 SLA, \ n -> cells TOS RP SUB, \ allocate space on Rstack R0 RPUSH, \ Rpush the old Rstack position TOS POP, \ refill TOS register from memory stack NEXT, ENDCODE CODE /LOCALS ( -- ) \ collapse stack frame *RP RP MOV, NEXT, ENDCODE : VAR: ( n -- ) CREATE , \ store n in the data field ;CODE W 1 SRA, \ W holds the data field of the VAR: TOS PUSH, RP TOS MOV, W TOS ADD, NEXT, ENDCODE 1 VAR: X1 2 VAR: X2 3 VAR: X3 4 VAR: X4 HERE SWAP - DECIMAL . Test code: HEX : TESTVAR 2 LOCALS DEAD X1 ! BEEF X2 ! X1 @ X2 @ /LOCALS ; This is nice. Local Variables is something I've played around with in TurboForth. It can make coding a LOT easier!! I have an uber complex version on github, with syntax stolen from Stephen Pelc's VFX. But I really like my Local Variables for the Common Man (*) because it is so simple! It would probably port over to Camel99 almost as is! * other genders are available 4 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 10, 2022 Author Share Posted October 10, 2022 5 hours ago, Willsy said: This is nice. Local Variables is something I've played around with in TurboForth. It can make coding a LOT easier!! I have an uber complex version on github, with syntax stolen from Stephen Pelc's VFX. But I really like my Local Variables for the Common Man (*) because it is so simple! It would probably port over to Camel99 almost as is! * other genders are available This tiny locals was a direct result of me studying your local variables code. Yours accomplishes what the standard version does but in way less space. I have wanted locals occasionally for hard problems too but in the back of my mind I kept thinking there must be a really simple way. It's just addresses after all. I had seen the code generated by compilers for a stack frame. I liked the Pascal approach where the called function cleanups after itself. So build/destroy stack-frame and get the addresses onto the stack. That's the minimum needed if you accept the pre-named variable concept rather than dynamically creating and destroying labels. I also realize now that I had one too many instructions in my runtime. The 2* should be done at compile time. That makes these locals only one instruction slower than a normal variable or using R@ Now I need to actually try to use locals in some project.. That will be a first for me. : VAR: ( n -- ) CREATE 2* , \ store n * 2 in the data field ;CODE TOS PUSH, RP TOS MOV, W TOS ADD, NEXT, ENDCODE Edit: Boy am I stupid. The original version of the code worked because the locals were being put in empty memory nowhere near the Return stack. I just tried the "improved" version above and it bombed. Here is what the new version that works looks like: : LOCAL: ( n -- ) CREATE 2* , ;CODE TOS PUSH, RP TOS MOV, *W TOS ADD, NEXT, ENDCODE 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 10, 2022 Author Share Posted October 10, 2022 (edited) I just looked a Local variables for the common man and we were thinking about the same thing. How to do this without less cruft. I have been wondering could I do the rstack frame in Forth not Assembler... 🤔 Edited October 10, 2022 by TheBF typo 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 14, 2022 Author Share Posted October 14, 2022 While watching Sam Falvo program I saw him defined a version of TYPE. It leverages that magic word /STRING which if written in 9900 ALC is only three instructions. CODE /STRING ( c-addr1 u1 n -- c-addr2 u2 ) TOS *SP SUB, TOS 2 (SP) ADD, TOS POP, NEXT, ENDCODE Here is type using /STRING : TYPE ( addr cnt --) PAUSE BEGIN DUP WHILE OVER C@ (EMIT) 1 /STRING REPEAT 2DROP ; Obvious once I see it, but it would not have occurred to me. 4 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 20, 2022 Author Share Posted October 20, 2022 I think I finally got COVID over a week ago at a large Thanksgiving gathering. Still dragging my butt a bit but I was still well enough to spend some time looking at different code bases. I was looking through the GCC code for TI-99 and saw something that should have been obvious in hindsight. Normally I define ERASE in Forth like this: : ERASE ( addr len -- ) 0 FILL ; In the GCC code I saw the use of CLR which is of course the native way erase memory. If we write ERASE in Assembler using CLR, rather than using 0 FILL it is 20% faster. If we write erase with CELLS instead of bytes, it's 2.5 time faster than using 0 FILL. CODE ERASEW ( addr cnt -- ) \ 2.5x faster than 0 FILL *SP+ R1 MOV, BEGIN, R1 *+ CLR, TOS DECT, LTE UNTIL, TOS POP, NEXT, ENDCODE Of course, 0 FILL consumes 4 bytes and ERASEW uses 10 bytes but if you really need the speed, it is the way to go. 3 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 20, 2022 Author Share Posted October 20, 2022 (edited) Another code base that I was looking at was Mecrisp Forth for the TI MSP430, a neat little machine that has similarities to the 9900. Mecrisp is a native code generating Forth compiler. Very hard to grok at a glance but I did understand the definition of MOVE. MOVE is a "CORE" ANS Forth word. Camel Forth implemented it as a secondary that conditionally called CMOVE or CMOVE. I didn't like that, so I removed it from the Camel99 Kernel. Looking a Mecrisp reminded me of my duty. I removed CMOVE and CMOVE> from my test kernel and replaced it with this version of MOVE. Things seem to be working ... 🙄 This also saved 20 10 bytes by removing the two headers and using only one. To test the memory window of (dest,dest+n) I used the same idea as is used for WITHIN. It seems like a lot of instructions in total, but I can't think of an easier way at the moment. CR .( MOVE replaces CMOVE & CMOVE> ) CODE MOVE ( src dst n -- ) \ forward character move *SP+ R0 MOV, \ pop DEST into R0 *SP+ R1 MOV, \ pop source into R1 TOS TOS MOV, NE IF, \ if n=0 we are done \ need some copies R0 R2 MOV, \ dup dest R0 R3 MOV, \ dup dest TOS R3 ADD, \ R3=dest+n \ test window: src dst dst+n WITHIN R0 R3 SUB, R1 R2 SUB, R3 R2 CMP, HI IF, \ do cmove> ... TOS W MOV, \ dup n W DEC, \ compute n-1 W R1 ADD, \ point to end of source W R0 ADD, \ point to end of destination BEGIN, *R1 *R0 MOVB, R1 DEC, \ dec source R0 DEC, \ dec dest TOS DEC, \ dec the counter in TOS (R4) EQ UNTIL, ELSE, \ do cmove ... BEGIN, *R1+ *R0+ MOVB, TOS DEC, EQ UNTIL, ENDIF, ENDIF, TOS POP, NEXT, ENDCODE Edited October 20, 2022 by TheBF Wrong comment 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 26, 2022 Author Share Posted October 26, 2022 Very Esoteric subject but I am pretty happy so here it is Forth cross-compilers are hard for mortals like me. It only took me 5 years, but I finally learned how to make my Cross-compiler work with ONLY real Forth names for all words. The problem was IMMEDIATE words that had to compile something like a string ( ." S" ) or [COMPILE]. I had renamed these words to T." and TS" and T[COMPILE] so they didn't conflict with the normal Forth names. I was reading another person's code and realized what I was missing. The last step was to make a new vocabulary called META. META contains only the names of these "compiling" words, but they do the action required by the cross-compiler version. Then the search order must be set so META is the FIRST vocabulary searched when you are compiling to the TARGET program image. This way these META words will always execute before the version in the TARGET program's memory. So here is the new METADEFS file: \ M E T A D E F I N I T I O N S \ META definitions look like Forth words but do cross-compiler actions \ META wordlist is searched first while TARGET-COMPILING, so these IMMEDIATE \ words always run first. CROSS-COMPILING ALSO META DEFINITIONS CR .( compiling META Definitions ) : ." POSTPONE T." ; IMMEDIATE : S" POSTPONE TS" ; IMMEDIATE : ['] POSTPONE t['] ; IMMEDIATE : CHAR TCHAR ; : [CHAR] ?XCOMP TCHAR POSTPONE TLITERAL ; IMMEDIATE : [COMPILE] POSTPONE T[COMPILE] ; IMMEDIATE SYNONYM IMMEDIATE XIMMEDIATE FORTH IMMEDIATE CROSS-COMPILING Here is how the search order is configured when "TARGET-COMPILING" ( generating code in the target program memory) : TARGET-COMPILING ONLY XASSEMBLER \ #4 ALSO CROSS-COMPILER \ #3 ALSO MIRROR DEFINITIONS \ search 2nd and make copy of the target word in the PC Forth ALSO META ; \ search first The MIRROR vocabulary keeps a copy of the target programs words so the PC Forth can look them up. With that addition and killing some other silly things in the cross-compiler from years ago the file below is the HI-LEVEL Forth code for Camel99 Forth. (the code primitives file and a few other includes are omitted for simplicity) Only two non-standard directives are used: CROSS-COMPILING or [CC] used when you are interpreting words TARGET-COMPILING or [TC] when you want to direct code to the target program image. I probably could have picked a better week to get into this after COVID but I and the code seem to be working. Spoiler \ CAMEL99 Forth for the TI-99 First build 11Apr2019 \ Copyright (c) 2018 Brian Fox \ KILWORTH Ontario Canada \ brian.fox@brianfox.ca \ compiles with FCC99B.EXE cross-compiler SEE: FORTHITC.MAK \ This program is free software; you can redistribute it and/or modify \ it under the terms of the GNU General Public License as published by \ the Free Software Foundation; either version 3 of the License, or \ (at your option) any later version. \ You should have received a copy of the GNU General Public License \ along with this program. If not, see <http://www.gnu.org/licenses/>. \ \ The work derived from CAMEL Forth under the GNU General Public License. \ CamelForth (c) 2009 Bradford J. Rodriguez. \ Commercial inquiries for Camel Forth should be directed to: \ Dr. Bradford J. Rodriguez \ 115 First St., #105, Collingwood, Ontario L9Y 4W3 Canada \ or via email to bj@camelforth.com \ History \ Oct 21 2019, replaced critical routines with CODE. \ 15% compile time speedup on TI-99 \ Dec 29 2019 V2.58 added VPG variable for multiple display screens \ >VPOS computes address from col,row & adds VPG \ added TOPLN code word to calc. topln of a screen \ Jan 28 2020 V2.59 Replaced ?NUMBER with NUMBER? \ Minor changes to <INTERP> Saved 34 bytes. \ Oct 2020 V.266 Added CONTEXT array and CURRENT to support wordlists \ Fixed bug in RAKE and fixed ISOLOOPS \ Jul 2021 V2.68 Corrected bug in M+ found in V2.67 \ Dec 2021 V2.68G removes JIFFS. Replaced with TICKS, hi res timer. \ Jan 2022 create FORTHITC.MAK to build the project \ Oct 2022 Added META vocabulary TARGET-COMPILING \ ====================================================================== \ S Y S T E M C O N S T A N T S [CC] HEX CR .( Constants and VARIABLEs...) TARGET-COMPILING 'SP0 CONSTANT SP0 \ ^^^ data stack, 28 cells deep, 'RP0 CONSTANT RP0 \ ^^^ Return stack 96 cells max, shares space with TIB 'TIB CONSTANT TIB \ tib grows up towards RP0. Never more that \ Utility constants 0 CONSTANT FALSE -1 CONSTANT TRUE 0 CONSTANT 0 1 CONSTANT 1 20 CONSTANT BL \ ====================================================================== \ U S E R V A R I A B L E S \ CAMEL99 uses space after workspace for user vars. [CC] HEX [TC] \ *G User VARIABLEs begin at >8320 for the primary Forth task \ ** User VARIABLE 0 .. 1F are workspace registers. 20 USER TFLAG 22 USER JOB 24 USER DP 26 USER HP 28 USER CSP 2A USER BASE 2C USER >IN 2E USER C/L 30 USER OUT 32 USER VROW 34 USER VCOL 36 USER 'KEY \ for vectored char input 38 USER 'EMIT \ for vectored char output 3A USER LP 3C USER SOURCE-ID 3E USER 'SOURCE \ 40 USER ------- \ used by 'SOURCE 46 USER TPAD \ holds offset from HERE for TASK PADs \ 7E USER VPG \ declared in TI99 VDP driver code \ ====================================================================== \ V A R I A B L E S VARIABLE STATE HASHING [IF] ( initial vocabulary with 4 threads) 4 CONSTANT #THREADS VARIABLE LATEST [CC] 4 CELLS TALLOT [TC] [ELSE] VARIABLE LATEST [THEN] \ *G These system VARIABLEs control cold starting the system VARIABLE ORGDP VARIABLE ORGLAST VARIABLE BOOT [CC] DECIMAL [TC] 0024 CONSTANT L/SCR [CC] HEX [TC] VARIABLE VMODE VARIABLE L0 [CC] 4 CELLS TALLOT [TC] VARIABLE ^PAB VARIABLE LINES VARIABLE C/SCR VARIABLE 'IV \ *G interpretor vector. Holds address of <INTERP> VARIABLE H VARIABLE VP VARIABLE CURS [CC] 205F CURS T! [TC] \ BLANK and '_' in one VARIABLE VARIABLE VTOP VARIABLE WARNINGS [CC] -1 WARNINGS T! [TC] ?stk \ ====================================================================== [CC] cr .( Hi-level FORTH Primitives...) TARGET-COMPILING SLOWER [IF] : HERE ( -- addr) DP @ ; : ALLOT ( n --) DP +! ; : , ( n -- ) HERE ! 2 ALLOT ; [ELSE] ( faster HERE speeds up the compiler) CODE HERE ( -- addr) \ : HERE ( -- addr) DP @ ; TOS PUSH, TOS STWP, 24 (TOS) TOS MOV, NEXT, ENDCODE CODE ALLOT ( n --) R1 STWP, TOS 24 (R1) ADD, TOS POP, NEXT, ENDCODE CODE , ( n --) R1 STWP, 24 (R1) R2 MOV, TOS *R2 MOV, 24 (R1) INCT, TOS POP, NEXT, ENDCODE [THEN] : C, ( n -- ) HERE C! 1 ALLOT ; : COMPILE, ( n -- ) , ; : ALIGN ( -- ) HERE ALIGNED DP ! ; : PAD ( -- addr) HERE TPAD @ + ; : COMPILE ( -- ) R> DUP 2+ >R @ , ; : IMMEDIATE ( --) 01 LATEST @ 1- C! ; : LITERAL ( n -- n|~) STATE @ IF COMPILE LIT , THEN ; IMMEDIATE : ] ( -- ) STATE ON ; : [ ( -- ) STATE OFF ; IMMEDIATE : DEPTH ( -- n ) SP0 SP@ 2+ - 2/ ; \ ** needs signed shift \ ====================================================================== \ PAB Base Address : VDPTOP ( -- n) 8370 @ 2- ; \ ====================================================================== \ S T A C K P R I M I T I V E S [CC] cr .( Stack primitives ...) [tc] : TUCK ( w1 w2 -- w2 w1 w2 ) SWAP OVER ; \ double Rstack Forth2012 CODE 2>R ( d -- ) ( r-- n n) RP -4 ADDI, \ 14 TOS 2 (RP) MOV, \ 22 *SP+ *RP MOV, \ 26 TOS POP, \ 22 NEXT, \ = 84 ENDCODE CODE 2R> ( -- d ) TOS PUSH, \ 28 SP DECT, \ 10 *SP RPOP, \ 26 TOS RPOP, \ 22 NEXT, \ = 88 ENDCODE \ *G NOT standard forth. Nice native 9900 instructions CODE 1+! ( addr -- ) *TOS INC, TOS POP, NEXT, ENDCODE CODE 1-! ( addr -- ) *TOS DEC, TOS POP, NEXT, ENDCODE \ ===================================================================== \ C O M P A R I S O N O P E R A T O R S TARGET-COMPILING : U> ( n n -- ?) SWAP U< ; : 0> ( n -- ?) 1- 0< INVERT ; : <> ( n n -- ?) = INVERT ; -1 [IF] ( Forth is bigger than CODE versions :-) : UMIN ( u1 u2 -- u ) 2DUP U> IF SWAP THEN DROP ; : UMAX ( u1 u2 -- u ) 2DUP U< IF SWAP THEN DROP ; [ELSE] CODE UMIN ( n1 n2 -- n) *SP TOS CMP, @@1 JL, SP INCT, NEXT, +CODE UMAX ( n1 n2 -- n) *SP TOS CMP, @@2 JH, SP INCT, NEXT, @@1: @@2: TOS POP, NEXT, ENDCODE [THEN] SLOWER [IF] : WITHIN ( u lo hi -- t ) OVER - -ROT - U> ; [ELSE] CODE WITHIN ( n lo hi -- flag ) *SP TOS SUB, *SP+ *SP SUB, TOS *SP+ SUB, TOS CLR, NC IF, TOS SETO, ENDIF, NEXT, ENDCODE \ 2 bytes bigger than Forth [THEN] \ ===================================================================== \ M I X E D (32BIT/16BIT) M A T H O P E R A T I O N S : */MOD ( n1 n2 n3 -- n4 n5) >R UM* R> M/MOD ; : S>D ( n -- d) DUP 0< ; : M+ ( d n -- d) S>D D+ ; \ * change from V2.67 : /MOD ( n1 n2 -- n3 n4) >R S>D R> M/MOD ; : / ( n n -- n) /MOD NIP ; : MOD ( n n -- n) /MOD DROP ; : */ ( n n n -- n) */MOD NIP ; \ ===================================================================== \ S T R I N G T H I N G S TARGET-COMPILING : PLACE ( src n dst -- ) 2DUP C! 1+ SWAP MOVE ; SLOWER [IF] : /STRING ( caddr1 u1 n - caddr2 u2 ) TUCK - >R + R> ; \ 10 bytes [ELSE] CODE /STRING ( c-addr1 u1 n -- c-addr2 u2 ) \ ~20uS!! Clks TOS *SP SUB, \ 18 TOS 2 (SP) ADD, \ 22 TOS POP, \ refill TOS 22 NEXT, \ 8 bytes 62 ~20uS ENDCODE [THEN] : S, ( c-addr u -- ) HERE OVER 1+ ALLOT PLACE ALIGN ; \ ===================================================================== \ H E A D E R N A V I G A T I O N TARGET-COMPILING \ : NFA>LFA ( nfa -- lfa) 3 - ; CODE NFA>LFA TOS -3 ADDI, NEXT, ENDCODE ( faster, same size) \ Changed 7F to 1F . 31 character max name length. Other bits for future use : NFA>CFA ( nfa -- cfa ) COUNT 1F AND + ALIGNED ; \ smudge bit control in the Camel Forth : HIDE ( -- ) LATEST @ ( nfa) DUP C@ 80 OR SWAP C! ; : REVEAL ( -- ) LATEST @ ( nfa) DUP C@ 7F AND SWAP C! ; \ ===================================================================== \ P A R S E W O R D [CC] cr .( Parsing...) TARGET-COMPILING CODE DUP>R ( n -- n) TOS RPUSH, NEXT, ENDCODE \ used 3 times : SOURCE ( -- addr len) 'SOURCE 2@ ; : PARSE ( char -- c-addr u ) \ gForth >R SOURCE >IN @ OVER MIN /STRING OVER SWAP R> SCAN >R OVER - DUP R> IF 1+ THEN >IN +! ; : PARSE-WORD ( char -- c-addr n) \ Camel/BFox common factor for WORD DUP SOURCE >IN @ /STRING ROT SKIP DROP SOURCE -ROT - MIN 0 MAX >IN ! PARSE ; : WORD ( char -- c-addr) PARSE-WORD HERE PLACE HERE BL OVER COUNT + C! \ append blank character ; \ ===================================================================== \ S T R I N G T O N U M B E R C O N V E R S I O N [CC] CR .( CAMEL FORTH Number conversion) HEX TARGET-COMPILING SLOWER [IF] : BASE@ BASE @ ; [ELSE] CODE BASE@ TOS PUSH, R1 STWP, 2A (R1) TOS MOV, NEXT, ENDCODE [THEN] SLOWER [IF] : DIGIT? ( c -- n -1) \ if c is a valid digit \ -- x 0 \ otherwise DUP 39 > 100 AND + \ silly looking DUP 140 > 107 AND - [CHAR] 0 - \ but it works! DUP BASE@ U< ; \ 48 Bytes [ELSE] CODE DIGIT? ( char -- n f ) R1 STWP, \ multi-tasking friendly for USER VARS TOS PUSH, \ dup char TOS -30 ADDI, \ convert char to number TOS 9 CMPI, HI IF, \ > 9 ? TOS -7 ADDI, TOS 9 CMPI, @@1 JL, \ less than 9, jump out ENDIF, TOS 2A (R1) CMP, \ USER var 2A (BASE) @@2 JHE, \ tos>base, jump out TOS *SP MOV, \ replace char with no. TOS SETO, \ set flag to true NEXT, ( error out here) @@1: @@2: TOS CLR, NEXT, ENDCODE \ 36 bytes, much faster [THEN] : UD* ( ud1 u2 -- ud3) DUP>R * SWAP R> UM* ROT + ; : >NUMBER ( ud adr u -- ud' adr' u' ) BEGIN DUP WHILE OVER C@ DIGIT? 0= IF DROP EXIT THEN >R 2SWAP BASE@ UD* R> M+ 2SWAP 1 /STRING REPEAT ; \ *G This is smaller than original ?NUMBER but ***FLAG LOGIC IS REVERSED*** : NUMBER? ( addr len -- n ?) \ ?=0 is good conversion ( -- addr len) \ bad conversion OVER C@ [CHAR] - = DUP>R \ save flag for later IF 1 /STRING THEN \ remove minus sign 0 0 2SWAP >NUMBER NIP NIP \ convert the number R> IF SWAP NEGATE SWAP THEN \ negate if needed ; \ ====================================================================== \ S I M P L E S O U N D I N T E R F A C E TARGET-COMPILING \ write a byte to address of TMS9919 chip : SND! ( c -- ) 8400 C! ; \ 4 bytes, 277 uS [CC] DECIMAL [TC] : MS ( n -- ) 10 / 0 ?DO 420 TICKS LOOP ; [CC] HEX [TC] : BEEP ( -- ) 80 SND! 5 SND! \ pre-calculated values for OSC1 1390Hz 91 SND! \ turn on OSC1 at -2 dB level AA MS \ Delay ~ 170 mS 9F SND! ; \ turn off OSC1 \ We use the HONK sound for ABORT like TI-BASIC does on errors : HONK ( -- ) 81 SND! 20 SND! \ pre-calculated values for OSC1 218Hz 90 SND! \ turn on OSC1 at 0 dB level AA MS \ Delay ~ 170 mS 9F SND! ; \ turn off OSC1 \ ====================================================================== \ V D P S C R E E N D R I V E R [CC] cr .( Console output) HEX [TC] : C/L! ( c/l -- ) \ pronounced "SEE-PER-ELL-STORE" DUP C/L ! \ set chars per line L/SCR * C/SCR ! ; \ calc. chars per screen : VPOS ( -- vaddr) VROW 2@ >VPOS ; : VPUT ( char -- ) VPOS VC! ; : AT-XY ( col row -- ) VROW 2! ; \ set VDP address for Fast type SLOWER [IF] : TOPLN ( -- vaddr) VPG @ VTOP @ + ; \ 10 bytes : LASTLN ( -- vaddr) VPG @ C/SCR @ + ; \ 10 bytes [ELSE] CODE TOPLN ( -- vaddr) TOS PUSH, VPG @@ TOS MOV, VTOP @@ TOS ADD, NEXT, ENDCODE \ 12 bytes CODE LASTLN ( -- vaddr) TOS PUSH, VPG @@ TOS MOV, C/SCR @@ TOS ADD, NEXT, ENDCODE \ 12 bytes [THEN] \ ===================================================================== \ *G Scrolling has been implemented in Forth using VREAD & VWRITE \ ** Uses un-allocated Dictionary as a temporary buffer to hold lines of text : SCROLL ( -- ) PAUSE VPG @ HERE 100 + DUP>R C/SCR @ VREAD R> C/L@ + VPG @ C/SCR @ C/L@ - VWRITE 0 17 AT-XY VPOS C/L@ BL VFILL ; \ ====================================================================== \ V D P T E X T O U T P U T [cc] HEX [tc] : CR ( -- ) (CR) L/SCR = IF SCROLL THEN ; : (EMIT) ( char -- ) CPUT IF CR THEN ; : PAGE ( -- ) TOPLN LASTLN OVER - BL VFILL 0 0 AT-XY ; : BS ( --) VCOL DUP @ 1- 0 MAX SWAP ! ; : EMIT ( char -- ) \ shows how to handle control characters PAUSE DUP 0D = IF DROP CR EXIT THEN DUP 08 = IF DROP BS EXIT THEN (EMIT) ; : TYPE ( addr cnt --) PAUSE 0 DO COUNT (EMIT) LOOP DROP ; : SPACE ( -- ) BL (EMIT) ; : SPACES ( n -- ) 0 MAX 0 ?DO SPACE LOOP ; \ ====================================================================== \ S T R I N G L I T E R A L S [cc] HEX [TC] \ run-time action of S" (For ITC Forth only) : (S") ( -- c-addr u) R> COUNT 2DUP + ALIGNED >R ; \ ====================================================================== CROSS-COMPILING \ *G Re-solve CROSS-COMPILER Forward reference for '(S") and 'TYPE T' (S") RESOLVES '(S") T' TYPE RESOLVES 'TYPE [cc] cr .( Character input) \ ====================================================================== \ C H A R A C T E R I N P U T \ *G Cursor flash control is now done by reading the 9901 timer. \ ** It counts down from >3FFF in 349mS. If the timer> 1FFF we show the cursor. \ ** If < 1FFF show the screen char. Flash rate is about 2 per second. TARGET-COMPILING : KEY ( -- char) BEGIN \ start the loop PAUSE \ Essential for Multi-tasking with Console CURS @ \ fetch 2 char cursor (space & _ ) TMR@ 1FFF < \ compare hardware timer to 1FFF IF >< THEN VPUT \ swap cursor bytes & write KEY? \ check the keyboard ?DUP \ DUP IF <> 0 UNTIL \ loop until a key pressed BL VPUT ; \ put the space char on screen \ High level: input/output (c) 31mar95 bjr : ACCEPT ( caddr +n -- +n') OVER + OVER \ removed 1- to accept all chars BEGIN KEY DUP 0D <> WHILE DUP EMIT DUP 8 = IF DROP 1- 3 PICK UMAX \ changed to use: 3 PICK B.F. ELSE OVER C! 1+ OVER UMIN THEN REPEAT DROP NIP SWAP - ; [cc] cr .( Number printing) \ ===================================================================== \ N U M B E R T O S T R I N G C O N V E R S I O N TARGET-COMPILING 0 [IF] : >DIGIT DUP 9 > IF 7 + THEN [CHAR] 0 + ; \ 20 BYTES :) [ELSE] CODE >DIGIT ( n -- c) \ ASM is 9 bytes, 4X faster TOS 9 CMPI, HI IF, \ if n>9 TOS 7 ADDI, \ number is not base 10, add 7 ENDIF, TOS CHAR 0 ADDI, \ add ASCII 0 to TOS create char value NEXT, ENDCODE [THEN] : <# ( --) PAD HP ! ; SLOWER [if] : HOLD ( char -- ) HP DUP 1-! @ C! ; [else] \ this took a while to get right :) CODE HOLD ( char -- ) \ *G HOLD is CODE. 4 bytes bigger, 4..9% faster number output than Forth version. R1 STWP, \ get workspace pointer 26 (R1) DEC, \ DEC address in HP user variable 26 (R1) R1 MOV, \ put the address into R1 TOS SWPB, TOS *R1 MOVB, \ store char in address in R1 TOS POP, NEXT, ENDCODE [then] : # ( u -- ud2 ) 0 BASE@ UM/MOD >R BASE@ UM/MOD SWAP >DIGIT HOLD R> ; : #S ( ud1 -- ud2) BEGIN # 2DUP OR WHILE REPEAT ; : #> ( ud1 -- c-addr u) 2DROP HP @ PAD OVER - ; : SIGN ( n -- ) 0< IF [CHAR] - HOLD THEN ; : UD. ( d -- ) <# #S #> TYPE SPACE ; : U. ( u -- ) 0 UD. ; : (.) ( n -- caddr len) DUP ABS 0 <# #S ROT SIGN #> ; : . ( n -- ) (.) TYPE SPACE ; \ ====================================================================== \ M I S C E L L A N E O U S [cc] HEX [tc] : RECURSE ( -- ) LATEST @ NFA>CFA , ; IMMEDIATE : DECIMAL ( -- ) 0A BASE ! ; : HEX ( -- ) 10 BASE ! ; \ ====================================================================== \ I N T E R P R E T E R : INTERPRET ( addr len -- ) 'IV PERFORM ; \ ====================================================================== \ Q U I T : The O U T E R I N T E R P R E T E R : QUIT ( -- ) RP0 RP! L0 LP ! SOURCE-ID OFF [COMPILE] [ BEGIN TIB DUP 52 ACCEPT SPACE ( addr len) INTERPRET STATE @ 0= IF ." ok" THEN CR AGAIN ; : EVALUATE ( c-addr u -- j*x) SOURCE-ID ON SOURCE 2>R >IN @ >R INTERPRET R> >IN ! 2R> 'SOURCE 2! SOURCE-ID OFF ; \ ====================================================================== \ E R R O R H A N D L I N G \ : ABORT ( -- ) SP0 SP! VDPTOP ^PAB ! \ set base pab pointer CR QUIT ; : ?ABORT ( f caddr u --) ROT IF CR CR ." ? " TYPE HONK SOURCE-ID @ ( if source is NOT console) 0> IF ." Line " LINES @ DECIMAL U. CR CR SOURCE TYPE THEN ABORT THEN 2DROP ; \ flag addr length : ?ERR ( ? -- ) HERE COUNT ?ABORT ; : ?EXEC ( -- ) STATE @ S" Interpret only" ?ABORT ; : ?COMP ( -- ) STATE @ 0= S" Compile only" ?ABORT ; : ?CSP ( -- ) SP@ CSP @ - S" Unfinished" ?ABORT ; : !CSP ( -- ) SP@ CSP ! ; \ ====================================================================== \ S T R I N G L I T E R A L true [IF] \ MULTI-STRING version : S" ( cccc" -- ) \ compiling action \ *G Non-standard: when interpreting S" puts the string at HERE+>IN \ ** and returns the address. ( cccc" --- addr len) \ interpreting action *NON-STANDARD* [CHAR] " PARSE STATE @ IF COMPILE (S") S, ELSE PAD >IN @ + DUP>R PLACE R> COUNT THEN ; IMMEDIATE [ELSE] : S" ( cccc" -- ) \ OLD VERSION [CHAR] " PARSE STATE @ IF COMPILE (S") S, ELSE PAD PLACE PAD COUNT THEN ; IMMEDIATE [THEN] : ABORT" ( i*x 0 -- i*x) \ R: j*x -- j*x x1=0 ?COMP [COMPILE] S" COMPILE ?ABORT ; IMMEDIATE [cc] cr .( FIND ) \ ====================================================================== \ D I C T I O N A R Y S E A R C H TARGET-COMPILING \ used to compute 4way hash of words for fast dictionary searches HASHING [IF] CODE HASH ( string wid-pfa -- thread-addr ) *SP+ R1 MOV, \ Address of the STRING R1 INC, *R1 R1 MOVB, \ fetch first character R1 8 SRA, \ switch to other side R1 03 ANDI, \ use to LSB bits R1 R1 ADD, \ 2* to make a cell offset R1 TOS ADD, \ addr to base PFA NEXT, \ 16 bytes ENDCODE [THEN] VARIABLE CONTEXT [CC] 0 T, 0 T, 0 T, 0 T, 0 T, 0 T, 0 T, 0 T, [TC] \ *G Array of Root + 8 wordlists to control search order VARIABLE CURRENT \ ** wordlist where definitions will be added : <FIND> ( caddr -- caddr 0 if not found) \ xt 1 if immediate, \ xt -1 if "normal" CONTEXT @ ( HASH) @ (FIND) ; VARIABLE 'FIND \ *G vector for the action of find : FIND 'FIND PERFORM ; : ' ( -- xt) BL WORD FIND 0= ?ERR ; : ['] ( -- <name> ) ?COMP ' [COMPILE] LITERAL ; IMMEDIATE : POSTPONE ( <name> -- ) \ *G replaces COMPILE and [COMPILE] ?COMP BL WORD FIND DUP 0= ?ERR 0< IF COMPILE COMPILE THEN COMPILE, ; IMMEDIATE \ ====================================================================== \ T E X T O U T P U T : ." ( ccc" -- ) [COMPILE] S" ( -- str len) STATE @ IF COMPILE TYPE ELSE TYPE THEN ; IMMEDIATE : .( [CHAR] ) PARSE TYPE ; IMMEDIATE [CC] cr .( Interpreter/compiler loop) \ ====================================================================== \ I N T E R P R E T E R / C O M P I L E R TARGET-COMPILING : <INTERP> ( 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 IF EXECUTE ELSE COMPILE, THEN ELSE ( it's a number) COUNT NUMBER? ?ERR [COMPILE] LITERAL THEN DEPTH 0< S" Short stack" ?ABORT REPEAT DROP ; \ ====================================================================== \ T I - 9 9 T E X T M O D E C O N T R O L TARGET-COMPILING : TEXT ( -- ) F0 DUP 83D4 C! ( -- F0) 01 VWTR 0 2 VWTR \ set VDP screen page VTOP OFF \ topline VDP offset VPG OFF \ VDP screen page offset 17 7 VWTR \ sets FG & BG color 28 C/L! 0 0 AT-XY 2 VMODE ! \ 2=ID for 40 column "TEXT" mode PAGE ; \ ====================================================================== \ TI-99 F I L E S Y S T E M I N T E R F A C E [CC] include CC9900\SRC.WIP\DSRLINKA.hsf [CC] include CC9900\SRC.WIP\filesyX2.hsf \ ====================================================================== \ D I C T I O N A R Y C R E A T I O N TARGET-COMPILING : HEADER, ( addr len --) ALIGN CURRENT @ @ , \ get last NFA & compile in this LFA field 0 C, \ compile the precedence byte (immediate flag) HERE >R \ save HERE (ie: new NFA location) S, \ compile (addr len) as counted string WARNINGS @ IF R@ FIND ( xt ?) NIP ( ?) IF SPACE R@ COUNT 1F AND TYPE ." isn't unique " THEN THEN R@ LATEST ! \ HERE now is the last word defined R> CURRENT @ ! \ Also store in the current 'WID' ; : HEADER ( <TEXT> ) BL PARSE-WORD HEADER, ; \ ======================================================= \ T A R G E T S Y S T E M D E F I N I N G W O R D S \ text runtime-action parameter \ ------- --------------- ----------- : CONSTANT ( n --) HEADER COMPILE DOCON COMPILE, ; : USER ( n --) HEADER COMPILE DOUSER COMPILE, ; : CREATE ( -- ) HEADER COMPILE DOVAR ; : VARIABLE ( -- ) CREATE 0 COMPILE, ; \ (:noname) from studying gforth. It's a nice factor. : (:NONAME) ( -- ) ['] DOCOL @ COMPILE, HIDE ] ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ =====[ CANNOT DEFINE ANY CONSTANT, VARIABLE OR USER AFTER THIS ]===== \ ////////////////////////////////////////////////////////////////////// \ ====================================================================== \ D O E S S U P P O R T : (;CODE) ( -- ) R> LATEST @ NFA>CFA ! ; \ 06A0 = BL @XXXX 0460 = B @XXXX : DOES> ( -- ) COMPILE (;CODE) 06A0 COMPILE, ['] DODOES COMPILE, \ compiles: BL @DODOES ; IMMEDIATE \ ====================================================================== \ LOOPS AND BRANCH COMPILERS FOR THE TI-99 SYSTEM [CC] include cc9900\SRC.WIP\ISOLOOPX.HSF \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ ===[ CANNOT COMPILE IF, ELSE, THEN, BEGIN UNTIL ETC. AFTER THIS ]=== \ ////////////////////////////////////////////////////////////////////// \ ====================================================================== \ COLD start. Sets Workspace, copy code to scratch pad, set stacks, run BOOT [cc] HEX TARGET-COMPILING CODE COLD WRKSP0 LWPI, R0 HSprims LI, \ source R1 HSstart LI, \ destination BEGIN, \ Copy hi-speed routines to fast RAM *R0+ *R1+ MOV, R1 HSend CMPI, EQ UNTIL, SP SP0 LI, \ data stack RP RP0 LI, \ return stack R10 NEXT2 LI, \ inner interpreter IP BOOT LI, \ load interpreter pointer with boot word *R10 B, \ run Forth NEXT (inner interpreter) ENDCODE \ *G MOVED TO DSK1.SYSTEM ** loads on Forth startup \ *G : CODE ( -- ) HEADER HERE 2+ , !CSP ; \ *G : NEXT, ( -- ) 045A , ; \ B *R10 \ *G : ENDCODE ( -- ) ?CSP ; \ *G ;CODE is moved to DSK1.SYSTEM *** \ *new* Added VER string for easy updates [CC] CODESEG 6000 = [IF] [TC] : .VER ." 2.69.25OCT22 SuperCart" ; [ELSE] [TC] : .VER ." 2.69.25OCT22" ; [THEN] [CC] \ ====================================================================== \ B O O T U P C O D E HEX TARGET-COMPILING \ *G WARM initializes variables and vectors : WARM ( -- ) 80 83C2 C! 26 TPAD ! 1000 VP ! 2000 H ! 3FFF TMR! VDPTOP ^PAB ! L0 LP ! FLOOR ON SOURCE-ID OFF ['] <INTERP> 'IV ! ['] <FIND> 'FIND ! DECIMAL ORGDP @ DP ! ORGLAST @ LATEST ! LATEST DUP CONTEXT ! CURRENT ! TEXT S" CAMEL99 Forth " TYPE .VER ; \ G* LOADSYS is the primary boot word that starts Forth and loads extensions : LOADSYS WARM S" DSK1.START" INCLUDED CR QUIT ; \ ===================================================================== \ define target comment words TARGET-COMPILING : ( [CHAR] ) PARSE 2DROP ; IMMEDIATE : \ 1 PARSE 2DROP ; IMMEDIATE [CC] \ ===================================================================== \ TARGET Colon, :NONAME and Semi-colon definitions \ X: ;X are aliases for the cross-compiler : and ; (to keep me sane) TARGET-COMPILING X: : !CSP HEADER (:NONAME) ;X X: :NONAME HERE !CSP (:NONAME) ;X X: ; [ REVEAL COMPILE EXIT ?CSP ;X IMMEDIATE [CC] \ F O R T H S Y S T E M C O D E E N D S \ /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/ cr .( Forth Kernel compiled completely") 3 Quote Link to comment Share on other sites More sharing options...
Willsy Posted October 26, 2022 Share Posted October 26, 2022 Glad you're on the mend - this Meta stuff is a bit brain melting at the best of times. I had quite bad brain fog when I got covid so I sympathise! 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 26, 2022 Author Share Posted October 26, 2022 3 hours ago, Willsy said: Glad you're on the mend - this Meta stuff is a bit brain melting at the best of times. I had quite bad brain fog when I got covid so I sympathise! Thanks. Brain-melting is a good description. I think this is why most people just use the Assembler as G_d intended. Quote Link to comment Share on other sites More sharing options...
D-Type Posted October 26, 2022 Share Posted October 26, 2022 Brad R's CamelForth 6809's Chromium Cross Compiler was the main reason I got back into Forth, it was a hobbyist version of what I'd used professionally in the 90s (MPE Z80 x-compilers). Brad's version is mostly implemented and hides all the e.g. TC. target stuff, but it doesn't easily let you use local words of the host PC forth when cross-compiling, you have to figure that out yourself. It's fuzzed my head for the past 5 years also, I had considered thinking to NOT use Forth as the language of the cross-compiler, use something else, but as I've got the hang of it, I'm liking the elegence again. Well done for getting yours working! 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 26, 2022 Author Share Posted October 26, 2022 2 hours ago, D-Type said: Brad R's CamelForth 6809's Chromium Cross Compiler was the main reason I got back into Forth, it was a hobbyist version of what I'd used professionally in the 90s (MPE Z80 x-compilers). Brad's version is mostly implemented and hides all the e.g. TC. target stuff, but it doesn't easily let you use local words of the host PC forth when cross-compiling, you have to figure that out yourself. It's fuzzed my head for the past 5 years also, I had considered thinking to NOT use Forth as the language of the cross-compiler, use something else, but as I've got the hang of it, I'm liking the elegence again. Well done for getting yours working! Thanks. Is there a repository for the Chromium cross compiler? I have never seen the code for it. Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 26, 2022 Author Share Posted October 26, 2022 2 hours ago, D-Type said: Well done for getting yours working! To be clear I had it working in 2019 but it wasn't, you know, "perfect". 1 Quote Link to comment Share on other sites More sharing options...
D-Type Posted October 26, 2022 Share Posted October 26, 2022 1 hour ago, TheBF said: Thanks. Is there a repository for the Chromium cross compiler? I have never seen the code for it. The original 1990's source is at CamelForth.com, but I suggest having a look at the below link, where the source code has been converted to run under Gforth using plain text files instead of blocks. Brad's original ran on an obscure 6809 computer, mine is running on real and emulated Vectrex video game console. (The original is also stored in the same Github repo, my commit history takes it from Brad's original to what it is today.) VecForth/include.fs at master · phillipeaton/VecForth (github.com) 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 26, 2022 Author Share Posted October 26, 2022 13 minutes ago, D-Type said: The original 1990's source is at CamelForth.com, but I suggest having a look at the below link, where the source code has been converted to run under Gforth using plain text files instead of blocks. Brad's original ran on an obscure 6809 computer, mine is running on real and emulated Vectrex video game console. (The original is also stored in the same Github repo, my commit history takes it from Brad's original to what it is today.) VecForth/include.fs at master · phillipeaton/VecForth (github.com) This is much more how I would want to see it. Thank you very much Phil. Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 27, 2022 Author Share Posted October 27, 2022 Since I was neck deep into the cross-compiler I looked at the Assembler I used to make it. It is a slightly reworked version of the TI-Forth Assembler. This lead to me to realize that I was using some Psuedo instructions that are made with two jumps. That's extra bytes and extra cycles. Remember this? (slightly modified from the original) : JUMP, CASE LT OF 2 JLT, 0 ENDOF \ psuedo instruction, 4 bytes GT OF 2 JGT, 0 ENDOF \ psuedo instruction, 4 bytes NO OF 2 JNO, 0 ENDOF \ psuedo instruction, 4 bytes OP OF 2 JOP, 0 ENDOF \ psuedo instruction, 4 bytes DUP 0< OVER 10 > ABORT" IF, BAD jump token" ENDCASE CSWAP 1000 + T, ; So as I go through the code, I am removing these. 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 28, 2022 Author Share Posted October 28, 2022 I am studying some compiler code by Matthias Koch, author of Mecrisp Forth. mch2022-firmware-ice40/nucleus-16kb-quickstore.fs at master · badgeteam/mch2022-firmware-ice40 (github.com) Here are some interesting operators that he uses a lot. OVER= ( n1 n2 -- n1 ?) 2DUPXOR ( n1 n2 -- n1 n2 ?) OVER= has caused me to recant my previous CASE statement mods. OVER= is the useful factor than (OF) and I had already coded it in my definition (OF) but locked it up. 2DUPXOR is only 3 instructions on 9900 because of indexed addressing. (PUSH is a two-instruction macro) CODE 2DUPXOR ( w w -- w w ? ) TOS PUSH, 2 (SP) TOS XOR, NEXT, ENDCODE Here is TYPE without a DO LOOP using 2DUPXOR from the web site code. (BOUNDS is OVER + SWAP as a code word) : type ( addr len --) bounds begin 2dupxor while count emit repeat 2drop ; 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 29, 2022 Author Share Posted October 29, 2022 TI-99 Forth implementation idea for discussion Consider this: Screen output on TI-99 goes to VDP RAM File output on TI-99 goes to VDP RAM File input on TI-99 comes from VDP RAM A Forth system could use VDP RAM as method to re-direct output to screen or to file simply by changing the VDP address where the output is written. If the terminal input buffer used VDP RAM, then input could also be redirected from a file by changing the VDP buffer address to a PAB buffer. Penny for your thoughts. (A Canadian penny, which actually doesn't exist anymore so you might not get paid) 2 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.