+TheBF Posted August 10, 2021 Author Share Posted August 10, 2021 Burning some brain cells Here is the object code loaded by E/A option 3. A000: 00 20 A0 06 A0 26 00 00 . ...&.. A008: 00 00 00 00 00 00 00 00 ........ A010: 00 00 00 00 00 00 00 00 ........ A018: 00 00 00 00 00 00 00 00 ........ A020: 00 00 00 00 00 00 05 A0 ........ A028: A0 00 03 80 05 A0 A0 00 ........ A030: 04 5B A0 36 A0 56 41 40 .[.6.VA@ A038: 00 00 00 00 00 00 A0 00 ........ A040: 01 40 88 00 88 02 8C 00 .@...... A048: 8C 02 00 00 00 00 00 00 ........ A050: 00 00 00 00 00 00 06 A0 ........ A058: A0 68 C0 85 D0 64 00 01 .h...d.. A060: D6 01 06 02 16 FD 03 80 ........ A068: 06 C0 D6 40 06 C0 D6 40 ...@...@ A070: 04 5B 04 20 A0 02 04 20 .[. ... A078: A0 32 10 FB 00 00 00 00 .2...... A080: 00 00 00 00 00 00 00 00 ........ Here is the same Object coded loaded with OLOAD linking loader relocated to >2000. (I init the memory map to >FF so I can see things clearer) I think I am pretty close. 2000: 00 20 20 06 20 26 FF FF . . &.. 2008: FF FF FF FF FF FF FF FF ........ 2010: FF FF FF FF FF FF FF FF ........ 2018: FF FF FF FF FF FF FF FF ........ 2020: FF FF FF FF FF FF 05 A0 ........ 2028: 20 00 03 80 05 A0 20 00 ..... . 2030: 04 5B 20 36 20 56 41 40 .[ 6 VA@ 2038: 00 00 00 00 00 00 20 00 ...... . 2040: 01 40 88 00 88 02 8C 00 .@...... 2048: 8C 02 FF FF FF FF FF FF ........ 2050: FF FF FF FF FF FF 06 A0 ........ 2058: 20 68 C0 85 D0 64 00 01 h...d.. 2060: D6 01 06 02 16 FD 03 80 ........ 2068: 06 C0 D6 40 06 C0 D6 40 ...@...@ 2070: 04 5B 04 20 20 02 04 20 .[. .. 2078: 20 32 10 FB FF FF FF FF 2...... The code got a bit more involved The cool thing was to resolve the REFs I pass the name in the object code to EVALUATE. Because: DEFs create a Forth CONSTANT in the DEFS vocabulary. REFs have the name of a DEF in their object code. EVALUATE searches the DEFS vocabulary for that name and interprets it. Since the DEFs are constants I get the address from the interpreter. Here is the code up to now. I need to take a break. Edit: removed an obsolete word Spoiler CR .( EA3 object file loader Aug 9 2021 Fox) NEEDS WORDLIST FROM DSK1.WORDLISTS VOCABULARY DEFS ONLY FORTH DEFINITIONS \ NEEDS .S FROM DSK1.TOOLS NEEDS +TO FROM DSK1.VALUES NEEDS CASE FROM DSK1.CASE NEEDS -TRAILING FROM DSK1.TRAILING NEEDS READ-FILE FROM DSK1.ANSFILES NEEDS S= FROM DSK1.COMPARE NEEDS ELAPSE FROM DSK1.ELAPSE ONLY FORTH DEFINITIONS DECIMAL 0 VALUE #1 \ a file handle HEX 2000 CONSTANT $2000 $2000 VALUE BASE-MEM \ where we load OBJECT files : ?BREAK ( -- ) ?TERMINAL ABORT" *BREAK*" ; : SPACEBAR ( -- ) KEY? BL = IF KEY DROP THEN ; \ add words so we don't need to include tools HEX : .ID ( NFAaddr --) COUNT 1F AND TYPE ; DECIMAL .( ..) : WORDS ( -- ) 0 >R ( word counter on stack) CONTEXT @ DUP CR .WID CR @ BEGIN DUP WHILE ?BREAK SPACEBAR DUP ( -- nfa) .ID SPACE R> 1+ >R NFA>LFA @ REPEAT DROP CR R> BASE @ >R DECIMAL . SPACE ." words" R> BASE ! ; \ heap memory management : HEAP! ( addr -- ) H ! ; \ set heap pointer : HEAP ( -- addr) H @ ; \ current heap pointer HEX : HALLOT ( n -- ) H +! ; \ move heap pointer : HEAP, ( n -- ) HEAP ! 2 HALLOT ; \ compile n into heap HEX : NEW. $2000 HEAP! HEAP $2000 FF FILL \ erase low ram HEAP TO BASE-MEM ['] DEFS >BODY OFF ; \ remove all DEFS words \ string utilities : CHOP ( addr len n -- addr' len' addr2 len2 ) >R \ Rpush n 2DUP DROP R@ \ dup $, do left$ 2SWAP \ put original $ on top R> 1- /STRING \ cut remainder string, leave tag at front 2SWAP \ put chopped string (output) on top ; : /TAG ( addr len -- addr' len') 1 /STRING ; \ cut tag character : PARSE# ( addr len -- n ) BASE @ >R HEX /TAG 4 CHOP NUMBER? ABORT" Bad number" R> BASE ! ; : GETLABEL ( addr len -- addr' len' label len) /TAG 6 CHOP -TRAILING ; : DODEF ( addr len n -- ) >R ( -- addr' len') ( r: -- ref_addr) GETLABEL ( addr' len' label len) DEFS DEFINITIONS HEADER, COMPILE DOCON R> , \ make a Forth Constant FORTH DEFINITIONS ; VARIABLE PROGLENGTH CREATE PROGNAME 10 ALLOT : PROG-ID ( addr len -- addr len) PARSE# PROGLENGTH ! 8 CHOP PROGNAME PLACE ; : .TOOLVER ( addr len -- addr 0) /TAG 40 CHOP -TRAILING CR TYPE DROP 0 ; : ?TAG CR ." Unknown TAG -> " EMIT ABORT ; : ParseLine ( add len -- ) BEGIN DUP ( len<>0) WHILE OVER C@ ( 1stChar) CASE [CHAR] 0 OF PROG-ID ENDOF [CHAR] 1 OF [CHAR] 1 ?TAG ENDOF [CHAR] 2 OF [CHAR] 2 ?TAG ENDOF [CHAR] 3 OF PARSE# BASE-MEM + ( ref-address) >R GETLABEL DEFS EVALUATE ( def-address) R> ! ENDOF \ REF: relocatable addr. of chain [CHAR] 4 OF PARSE# ( ref-address) >R GETLABEL DEFS EVALUATE ( def-address) R> ! ENDOF \ REF: Absolute addr. of chain [CHAR] 5 OF PARSE# BASE-MEM + DODEF ENDOF \ DEF: relocatable address [CHAR] 6 OF PARSE# DODEF ENDOF \ DEF: absolute address [CHAR] 7 OF PARSE# DROP ENDOF \ checksum [CHAR] 8 OF PARSE# DROP ENDOF \ checksum ignored [CHAR] 9 OF PARSE# HEAP! ENDOF \ set absolute address [CHAR] A OF PARSE# BASE-MEM + HEAP! ENDOF \ set relocatable address [CHAR] B OF PARSE# HEAP, ENDOF \ compile literal value [CHAR] C OF PARSE# BASE-MEM + HEAP, ENDOF \ compile relocatable address [CHAR] D OF [CHAR] D ?TAG ENDOF [CHAR] E OF [CHAR] E ?TAG ENDOF [CHAR] F OF DROP 0 ENDOF \ end of record [CHAR] : OF .TOOLVER ENDOF ENDCASE 1 /STRING 0 MAX \ advance to next char REPEAT 2DROP ; \ remove what's left of the input string : ?PATH ( addr len -- addr len) 2DUP [CHAR] . SCAN NIP 0= ABORT" Path expected" ; DECIMAL : .DEFS ALSO DEFS WORDS PREVIOUS ; : DIS/FIX DISPLAY SEQUENTIAL 80 FIXED ; \ TI ASM object file format : EA3LOAD ( "DSKx.FILE" -- ) ?PATH DIS/FIX R/O OPEN-FILE ?FILERR TO #1 TICKER OFF BEGIN #1 EOF 0= WHILE PAD DUP 80 #1 READ-LINE ( pad len ? ior) NIP ?FILERR ( pad len ) ParseLine REPEAT #1 CLOSE-FILE ?FILERR .ELAPSED ; : OLOAD ( <PATH> ) ONLY FORTH ALSO DEFS PARSE-NAME EA3LOAD HEAP TO BASE-MEM CR .DEFS ; .( Usage: NEW. OLOAD DSK?.FILENAME ) 2 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted August 10, 2021 Share Posted August 10, 2021 3 hours ago, TheBF said: : CHOP ( addr len n -- addr' len' addr2 len2 ) >R \ Rpush n 2DUP DROP R@ \ dup $, do left$ 2SWAP \ put original $ on top R> 1- /STRING \ cut remainder string, leave tag at front 2SWAP \ put chopped string (output) on top ; I hate to bring this up because it has little to do with your excellent work on this project (and you may have answered this before ISTR), but isn’t OVER better than 2DUP DROP ...lee 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted August 10, 2021 Author Share Posted August 10, 2021 Yes indeed. I am thinking in addr,len pairs and needed a copy. That's going into the final version. Thanks! 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted August 10, 2021 Author Share Posted August 10, 2021 This missing piece for using Object linking and loading in Forth. I took @mathew180 's demo clear screen code, turned it into a sub-routine by adding RT and assembled it generating DSK4.CLS-OBJ Spoiler * Demonstration program by @mathew180 * modified to be sub-routine for CAMEL99 EA3LOADER 2021 FOX DEF CLS * Clear the screen in 40 column mode. * VDP Memory Map * VDPRD EQU >8800 * VDP read data VDPSTA EQU >8802 * VDP status VDPWD EQU >8C00 * VDP write data VDPWA EQU >8C02 * VDP set read/write address * Workspace WRKSP EQU >8300 * Workspace is shared with Forth R0LB EQU WRKSP+1 * R0 low byte req'd for VDP routines * Program execution starts here CLS LIMI 0 * LWPI WRKSP CLR R0 * Set the VDP address to zero MOVB @R0LB,@VDPWA * Send low byte of VDP RAM write address ORI R0,>4000 * Set read/write bits 14 and 15 to write (01) MOVB R0,@VDPWA * Send high byte of VDP RAM write address LI R1,>2000 * Set high byte to 32 (>20) LI R2,>3C0 * bytes in the 40 column screen LOOP1 MOVB R1,@VDPWD * Write byte to VDP RAM DEC R2 JNE LOOP1 RT * return to caller END With this script below and the word EXTERN: we can create external routines that can be called from Forth. Note: *W register returns the Forth DATA field address where we stored the DEF address. We must fetch the value in that address to get the actual DEF sub-routine address that was recorded in the EXTERN: declaration. \ EXTERN.FTH CALL a DEF sub-routine from Forth \ Command Sequence to use this: INCLUDE DSK4.EA3LOADER NEW. OLOAD DSK4.CLS-OBJ FORTH DEFINITIONS HEX : EXTERN: ( addr -- ) \ create a word the does BL @addr CREATE , \ compile DEF addr into the word \ runtime BL to the addr in FORTH's working register ;CODE C218 , \ *W W MOV, \ Fetch DEF address from Forth 0698 , \ *W BL, \ call external code NEXT, ENDCODE DEFS CLS FORTH EXTERN: CLS The video shows the process in action and then clearing the screen with mathew180 's code. I will also make an EXTERN-PROG: that takes a BLWP vector DEF and call this from Forth and return, if the program ends with RTWP. With a little better organization we can compile the loader, load our object files and then remove the ea3loader from Forth so we have space for our program. EXTERN-DEMO.mp4 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted August 11, 2021 Author Share Posted August 11, 2021 Escape from GROM? I saw this cool piece of code Then I did a little reading and did this: \ run grom code INCLUDE DSK1.ASM9900 INCLUDE DSK1.GRAFIX \ sets up 32 column mode HEX \ >216F Start TI-BASIC \ >4D7C Prints "Bad Value". \ >4D81 Prints "String-number mismatch". \ >566C Prints "Can't do that". \ >56CD Scrolls up. CODE RUNGROM TOS R1 MOV, TOS POP, R1 9C02 @@ MOVB, R1 SWPB, R1 9C02 @@ MOVB, 83E0 LWPI, 0070 @@ B, ENDCODE Is there a way to get back home to Forth after entering the GPL interpreter? RUNGPL.mp4 2 Quote Link to comment Share on other sites More sharing options...
HOME AUTOMATION Posted August 11, 2021 Share Posted August 11, 2021 (edited) Short of using the LOAD interrupt, Strangcart or hijacking another device's DSR. See... (Local)..\classic99\Contributors\Harry_Wilhelm\Playground.? Edited August 11, 2021 by HOME AUTOMATION punct. 1 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted August 30, 2021 Author Share Posted August 30, 2021 I have been absent for a while. I took some vacation and had to continue working on a my contract job. Another reason that I have not posted is that after getting the linking loader working I took on the challenge of how make a direct-threaded code (DTC) kernel of the V2.68 code base. It has been frustrating. I can make a direct threaded kernel, add a little program to it and it runs perfectly and quickly too. When I try and start the interpreter it crashes. I have narrowed it down to the ACCEPT word in the QUIT loop but it is the same source code that compiles in the indirect threaded kernel. My home-made cross-compiler is probably at fault. My next test will have to thoroughly check out IF/THEN for correct operation since I use a different source file for DTC operation. The DTC kernel is really a curiosity since I don't like how it consumes more memory but it is about 10% faster overall and it bugs me that it doesn't work. Obsession is a bitch. 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted August 30, 2021 Author Share Posted August 30, 2021 Machine Code vs CREATE ;CODE I decided to revisit how to connect Assembly language DEF statements to Forth words that do something. My knee-jerk reaction was to use CREATE ;CODE which forced me to use an extra instruction to fetch the DEF address from Forth before acting on it. Example: : EXTERN: ( addr -- ) \ create a word the does BL @addr CREATE , \ compile DEF addr into the word \ runtime BL to the addr in FORTH's working register ;CODE C218 , \ *W W MOV, \ Fetch DEF address from Forth 0698 , \ *W BL, \ call external code NEXT, ENDCODE Machine code to the rescue: \ Linkage to Forth HEX : EXTERN: ( def --) CODE 0460 , ( addr) , NEXT, ; \ B @def : EXT-SUB: ( def --) CODE 06A0 , ( addr) , NEXT, ; \ BL @def : EXT-PROG: ( def --) CODE 0420 , ( vector) , NEXT, ; \ BLWP @def : EXT-DATA: CONSTANT ; Way smaller and a direct connection to the Assembler language code. So connecting to @farmerpotato's code we just do this: NEW. OLOAD DSK4.THING1 OLOAD DSK4.THWACK FORTH DEFINITIONS DEFS THING1 EXT-DATA: VAR1 \ delares a Forth constant THINK EXT-PROG: PROG1 \ BLWP to THINK THWACK EXT-PROG: PROG2 \ BLWP to THWACK LOOP EXTERN: RUN \ jump into code never come back I also found some code by Vorticon for his plotter that would have benefited from this linker if I had it 2018. Each of the words on the screen are normal sub-routines so we would link them to Forth with EXT-SUB: The only changes needed were to change some registers to avoid stepping on Forth's dedicated registers. Alternatively we could use a new workspace for these sub-routines or even change them to simple pop arguments from the Forth stack. Now I need to document this thing. It actually works. Future: 1. Make a way to load the loader, link some object files and remove the loader while leaving the DEF declarations in the dictionary. 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 4, 2021 Author Share Posted September 4, 2021 Some discussion came up around using Forth Assembler for a project. I thought I would try and draw some comparisons between TI Assembly language and Forth style assembers created by Chuck Moore. For completeness let's document the normal Assembler process (jump in anyone and fill in my oversights) Assembler 1. With the editor write the program source code. a) Write any extra source code for external modules that you need. 2. Save the file(s) 3. Process the source files with the assembler giving object code files 4. Link the object files of the program and all needed modules giving an executable program (TI does this with a linking loader) 5. Load the executable file to run the program. (other systems) Forth Assembler: (with Assembler already loaded into the system) 1. With the editor write the code for your new "code" word 2. Save the file or block 3. Include the file or load the block with the new routine you just saved 4. Type the name to run the new Assembly language word. Compare Assembler was built assuming that the entire program would be written in Assembler. Forth Assembler assumes you will use the Assembler for extra speed or to access special CPU or hardware functions. Assembler object code is not runnable and must be linked first Forth Assembler compiles directly to memory and so can be run when assembly is done. The Assembler and linker/loader are external programs. Forth is the Assembler and the linker and the loader. Assembler requires you to design everything about the internal register usage of your program and how parameters will be passed back and forth. Forth gives you a skeleton system with 2 stacks in place. One for DATA and one return stack which Forth assembly language can use pretty freely. This provides a "protocol" for passing parameters to your code that is convenient but require that you adapt to it. It also allow nested sub-routines to be used very easily if you need that. The linking process lets you connect different pieces of code into one program. Forth's colon definition lets you connect your assembly language routines together as a finished program. The interpreter lets you test each module and how they inter-operate as bigger components. Conclusion: You can write an entire program in Forth Assembler on a regular Forth system but it would be un-natural. The natural way with Forth is to write many small efficient assembler words , test as you go and then connect them together as a final colon definition. Then save the entire thing as binary executable. The alternative if you insisted on all assembly language, would be to write in a Forth Cross-assembler that takes source code and makes a binary image. Save the image and run the program. 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 5, 2021 Author Share Posted September 5, 2021 To follow up on using a Forth Assembler with labels, here is the only example I have of significant piece of code translated from regular Assembler to Forth Assembler and using both text and numerical labels. When I did the translation I chose to use structured loops where I could to help me grok the code, but there was some spaghetti in there that was too much trouble to remove so labels to the rescue. L: <NAME> is a label for long branches or where the entire address is used. 1 $: sets a label for JMP and the family of short jump instructions 1 $ is used with the JMP instructions to goto a $: location. You can see that to do math in the assembler it is RPN which takes a moment to get use to. The EQU directive works backwards per normal Forth. <value> EQU <label> One thing I forgot to mention is that Forth's colon definitions provide a very versatile MACRO maker as you can see in VDPWA, below. Give it a register name and it will set up the VDP to write Also notice that the BLWP vector DLNK must be created after the code label is declared as forward references are not normal in Forth. (you can do it but it's not automatic) \ DSRLNKA.FTH for METACOMP cross-compiler for CAMEL99 Forth Aug 2, 2021 Fox \ Source: \ posted by InsaneMultitasker via Thierry Nouspikel \ PASSES error code back to Forth workspace, TOS register ONLY FORTH ALSO ASSEMBLER DEFINITIONS HEX \ MACRO to simplify the VDP code : VDPWA, ( reg -- ) DUP SWPB, \ setup VDP address DUP VDPWA @@ MOVB, \ write 1st byte of address to VDP chip DUP SWPB, VDPWA @@ MOVB, \ write 2nd byte of address to VDP chip ; : [TOS] 8 (R13) ; \ gives access to Forth top of stack register L: HEX20 20 TC, L: HEXAA AA TC, L: PERIOD 2E TC, \ '.' TALIGN L: H2000 2000 T, L: CYC1 0000 T, L: H1300 1300 T, \ use memory below Forth RETURN stack for workspace & name buffer RP0 80 - EQU DREGS 4 2* DREGS + EQU DREG(4) \ address of dsr wksp R4 5 2* DREGS + EQU DREG(5) \ compute address of DREGS register 5 DREGS 8 - EQU NAMBUF \ small buffer to parse the device name \ === DSR ENTRY POINT === \ ** HEADLESS CODE TO SAVE SPACE ** NEWLABELS \ init labels. NEEDS resolver at end of CODE L: DSR1 \ label is in CC wordlist not in TARGET dictionary *R14+ R5 MOV, \ fetch '8' from program ->R5, inc PC for return HEX20 @@ R15 SZCB, \ >20 eq flag=0 8356 @@ R0 MOV, \ [PAB FNAME] to R0 R0 R9 MOV, \ dup R0 to R9 R9 -8 AI, \ R9-8 = [PAB FLG] R0 VDPWA, \ set the VDP address to use VDPRD @@ R1 MOVB, \ read length of FNAME -> R1 \ setup to copy VDP FNAME ->namebuf to '.' character R1 R3 MOVB, \ DUP length byte to R3 R3 08 SRL, \ swap the byte to other side R2 NAMBUF LI, \ R2 is ^namebuf R4 SETO, \ length counter, R4 = -1 BEGIN, R0 INC, \ point to next fname VDP address R4 INC, \ counter starts at -1 R4 R3 CMP, \ is counter = fnamelength 1 $ JEQ, \ if true goto @@1: R0 VDPWA, \ set VDP address VDPRD @@ R1 MOVB, \ read next VDP char from fname R1 *R2+ MOVB, \ copy to namebuf & inc pointer R1 PERIOD @@ CMPB, \ is it a '.' EQ UNTIL, \ until '.' found 34 bytes!!! 1 $: R4 R4 MOV, \ test R4(device name length)=0 6 $ JEQ, \ if so, goto ERROR6 R4 07 CI, \ is dev name length>7 6 $ JGT, \ if so, goto 6$ (ERROR6) \ -------- ENTRY POINT SHOULD BE HERE ------------- 83D0 @@ CLR, \ erase magic CRU addr. holder R4 8354 @@ MOV, \ put length in magic address R4 INC, \ +1 points to '.' character R4 8356 @@ ADD, \ add offset to PAB address (makes "real PAB") \ ==== GPL WORKSPACE ==== 83E0 LWPI, \ SROM (search ROM device list) R1 CLR, \ MAGIC GPL REG. 1 to call DSR, returns error R2 4000 LI, \ ROM start addr -> R2 H2000 @@ CYC1 @@ MOV, \ init the CYC1 variable ?? R12 0F00 LI, \ init CRU base to 0F00 0A $ JMP, 9 $: \ scan for I/O cards R12 1000 LI, \ init CRU address H1300 @@ CYC1 @@ MOV, BEGIN, 0A $: R12 R12 MOV, NE IF, \ if card address<>0 00 SBZ, \ turn off card ENDIF, R12 0100 AI, \ advance CRU to next card 83D0 @@ CLR, \ erase magic addres R12 2000 CI, 9 $ JEQ, \ Scan ROM R12 CYC1 @@ CMP, 5 $ JEQ, \ no more cards. goto ERROR5 \ card activation... R12 83D0 @@ MOV, \ save card CRU in magic address 00 SBO, \ turn on the card *R2 HEXAA @@ CMPB, \ test for card present EQ UNTIL, \ loop until card is found DREG(5) @@ R2 ADD, \ add '8'+4000= >4008 DSR ROM list 0B $ JMP, 3 $: \ scan ROM linked list for code address BEGIN, BEGIN, 83D2 @@ R2 MOV, \ start of ROM device list -> R2 00 SBO, \ turn card on 0B $: *R2 R2 MOV, \ Fetch next link 0A $ JEQ, \ if link=0 goto @@A (NEXT CARD) R2 83D2 @@ MOV, \ save link address in magic address R2 INCT, \ R2 = code pointer *R2+ R9 MOV, \ fetch code address ->R9 8355 @@ R5 MOVB, \ dev length->R5 4 $ JEQ, \ if 0 we have a string match R5 *R2+ CMPB, EQ UNTIL, \ find dev string match R5 08 SRL, \ shift length byte R6 NAMBUF LI, \ R6 hold ^nambuf BEGIN, *R6+ *R2+ CMPB, \ compare namebuf to ROM string 3 $ JNE, \ if mismatch goto @@3 R5 DEC, \ dec the counter register EQ UNTIL, 4 $: \ run DSR code R1 INC, \ count entries into the DSR ? *R9 BL, \ call the DSR code AGAIN, \ try next card \ -- DSR returns here if we are done -- 00 SBZ, \ Turn off the card DREGS LWPI, \ ==== DSR Workspace ==== R9 VDPWA, \ set vdp address VDPRD @@ R1 MOVB, \ read error value to DREGS R1 R1 0D SRL, \ shift error to correct range 7 $ JNE, \ if error<>0 goto @@7 RTWP, \ else return to Forth workspace \ error condition handlers 5 $: DREGS LWPI, \ we came from GPL workspace, restore DREGS \ device name length errors 6 $: R1 SETO, \ error code in R1. *THIS SEEMS TO MATTER* \ device not found error 7 $: R1 [TOS] MOV, \ Move error code to Forth TOS \ GPL error test GPLSTAT @@ R0 MOVB, \ get gpl status byte R0 SWPB, R0 0020 ANDI, \ mask to get GPL error bit R0 [TOS] SOC, \ "OR" GPL & DSR error codes HEX20 @@ R15 SOCB, \ set Forth's workspace 'EQ' flag to 1 RTWP, \ return to Forth RESOLVER \ resolve jumps cuz we didn't use CODE/ENDCODE \ ====== DSR LINK ENDS====== \ /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/ \ create the vector for BLWP in target memory L: DLNK DREGS T, DSR1 T, \ words that appear in the dictionary TARGET-COMPILER CODE DSRLNK ( [pab_fname] -- ior) TOS 8356 @@ MOV, TOS CLR, 0 LIMI, \ disable interrupts here TOS GPLSTAT @@ MOVB, \ clear GPL status register DLNK @@ BLWP, 8 T, \ Offset to DSR linked list in card ROM 2 LIMI, NEXT, ENDCODE 1 Quote Link to comment Share on other sites More sharing options...
GDMike Posted September 5, 2021 Share Posted September 5, 2021 9 hours ago, TheBF said: The natural way with Forth is to write many small efficient assembler words , test as you go and then connect them together as a final colon definition. This is how I understood it to be at an advantage and to make Sense in documentation. I can't wait to get dirty... 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 5, 2021 Author Share Posted September 5, 2021 Camel99 Linker Update I have made some changes to the EA3 LOADER and now call the it a LINKER. It now works well. You can write scripts that link all your files and INCLUDE those scripts to automate the linking. You are limited to 8K of total code space but that is quite a bit of assembly code if it's just for testing. I have started the docs but have a bunch of writing yet to complete it. The video link shows it all in action with @FarmerPotato 's example programs linked and tested at the Forth command line. Does this have any value as a test platform for Assembly Language programmers? I don't know what's out there for real iron. (11) Camel99 Linker - YouTube Source Code Spoiler CR .( EA3 object file LINKER, Aug 10 2021 Fox) NEEDS WORDLIST FROM DSK1.WORDLISTS ONLY FORTH DEFINITIONS \ NEEDS .S FROM DSK1.TOOLS NEEDS +TO FROM DSK1.VALUES NEEDS CASE FROM DSK1.CASE NEEDS -TRAILING FROM DSK1.TRAILING NEEDS ELAPSE FROM DSK1.ELAPSE HERE VOCABULARY DEFS MARKER /LINKER \ remove LINKER ONLY FORTH DEFINITIONS DECIMAL 0 VALUE #1 \ a file handle HEX 2000 CONSTANT $2000 $2000 VALUE BASE-MEM \ where we load OBJECT files : ?BREAK ( -- ) ?TERMINAL ABORT" *BREAK*" ; : SPACEBAR ( -- ) KEY? BL = IF KEY DROP THEN ; \ add words so we don't need to include tools HEX : .ID ( NFAaddr --) COUNT 1F AND TYPE ; DECIMAL .( ..) : WORDS ( -- ) 0 >R ( word counter on Rstack) CONTEXT @ DUP CR .WID CR @ BEGIN DUP WHILE ?BREAK SPACEBAR DUP ( -- nfa) .ID SPACE R> 1+ >R NFA>LFA @ REPEAT DROP CR R> BASE @ >R DECIMAL . SPACE ." words" R> BASE ! ; \ heap memory management \ : HEAP! ( addr -- ) H ! ; \ set heap pointer : HEAP ( -- addr) H @ ; \ current heap pointer : HALLOT ( n -- ) H +! ; \ move heap pointer : HEAP, ( n -- ) HEAP ! 2 HALLOT ; \ compile n into heap HEX : NEW. $2000 H ! HEAP $2000 FF FILL \ erase low ram HEAP TO BASE-MEM ['] DEFS >BODY OFF ; \ remove all DEFS words \ string utilities : CHOP ( addr len n -- addr' len' addr2 len2 ) >R \ Rpush n OVER R@ \ dup $, do left$ 2SWAP \ put original $ on top R> 1- /STRING \ cut remainder string, leave tag at front 2SWAP \ put chopped string (output) on top ; : /TAG ( addr len -- addr' len') 1 /STRING ; \ cut tag character : PARSE# ( addr len -- n ) BASE @ >R HEX /TAG 4 CHOP NUMBER? ABORT" Bad number" R> BASE ! ; : GETLABEL ( addr len -- addr' len' label len) /TAG 6 CHOP -TRAILING ; : DODEF ( addr len n -- ) >R ( -- addr' len') ( r: -- ref_addr) GETLABEL ( addr' len' label len) DEFS DEFINITIONS HEADER, COMPILE DOCON R> , \ make a Forth Constant FORTH DEFINITIONS ; VARIABLE PROGLENGTH CREATE PROGNAME 10 ALLOT : PROG-ID ( addr len -- addr len) PARSE# PROGLENGTH ! 8 CHOP PROGNAME PLACE ; : .TOOLVER ( addr len -- addr 0) /TAG 40 CHOP -TRAILING CR TYPE DROP 0 ; : ?TAG CR ." Unknown TAG -> " EMIT ABORT ; \ See E/A manual page 309 for meanings of object file tags. : ParseObject ( add len -- ) BEGIN DUP ( len<>0) WHILE OVER C@ ( tag) CASE [CHAR] 0 OF PROG-ID ENDOF [CHAR] 1 OF [CHAR] 1 ?TAG ENDOF [CHAR] 2 OF [CHAR] 2 ?TAG ENDOF [CHAR] 3 OF PARSE# BASE-MEM + ( ref-address) >R GETLABEL DEFS EVALUATE ( def-address) R> ( -- def ref) ! ENDOF [CHAR] 4 OF PARSE# ( ref-address) >R GETLABEL DEFS EVALUATE ( def-address) R> ( -- def ref) ! ENDOF [CHAR] 5 OF PARSE# BASE-MEM + DODEF ENDOF [CHAR] 6 OF PARSE# DODEF ENDOF [CHAR] 7 OF PARSE# DROP ENDOF [CHAR] 8 OF PARSE# DROP ENDOF [CHAR] 9 OF PARSE# H ! ENDOF [CHAR] A OF PARSE# BASE-MEM + H ! ENDOF [CHAR] B OF PARSE# HEAP, ENDOF [CHAR] C OF PARSE# BASE-MEM + HEAP, ENDOF [CHAR] D OF [CHAR] D ?TAG ENDOF [CHAR] E OF [CHAR] E ?TAG ENDOF [CHAR] F OF DROP 0 ENDOF \ end of record [CHAR] : OF .TOOLVER ENDOF ENDCASE 1 /STRING 0 MAX \ advance to next char REPEAT 2DROP ; \ remove what's left of the input string : ?PATH ( addr len -- addr len) 2DUP [CHAR] . SCAN NIP 0= ABORT" Path expected" ; DECIMAL : .DEFS ALSO DEFS WORDS PREVIOUS ; : EA3LOAD ( caddr len -- ) ?FILE CR ." Linking " 2DUP TYPE SOURCE-ID @ >IN @ 2>R \ save source-ID, input pointer PSZ NEGATE ^PAB +! \ make new PAB, on pab stack ( $ len ) 80 04 FOPEN ?FILERR \ OPEN as DISPLAY FIXED 80 INPUT SOURCE-ID 1+! \ incr. source ID (1st file is 1) LINES OFF \ reset the line counter BEGIN 2 FILEOP 0= \ file read operation WHILE HERE 200 + DUP FGET ( addr n) \ read line to temp mem buffer ParseObject \ interpret line of object code LINES 1+! \ count the line REPEAT PSZ ^PAB +! \ remove PAB from pab stack 2R> >IN ! SOURCE-ID ! \ restore >IN, SOURCE-ID ; : LINK ( <PATH> ) TICKER OFF PARSE-NAME EA3LOAD HEAP TO BASE-MEM CR .DEFS .ELAPSED ; \ Linkage to Forth HEX CODE RUN ( def --) 0454 , C136 , NEXT, ENDCODE \ B *TOS DROP CODE CALL ( def --) 0694 , C136 , NEXT, ENDCODE \ BL *TOS DROP CODE BLWP ( def --) 0414 , C136 , NEXT, ENDCODE \ BLWP *TOS DROP : EXTERN: ( def --) CODE 0460 , ( addr) , NEXT, ; \ B @def : EXT-SUB: ( def --) CODE 06A0 , ( addr) , NEXT, ; \ BL @def : EXT-PROG: ( def --) CODE 0420 , ( vector) , NEXT, ; \ BLWP @def PAGE .( Camel99 Linker Sept 2021) CR CR .( Usage: ) CR .( NEW. clear low ram for code) CR .( LINK DSK?.FILENAME load object) CR .( Commands:) CR .( <def> RUN branch to def) CR .( <def> CALL BL to def) CR .( <def> BLWP blwp to def) CR CR .( Declare DEFs as Forth code: ) CR .( <def> EXTERN: <name> branches to DEF) CR .( <def> EXT-SUB: <name> BL to DEF) CR .( <def> EXT-PROG: <name> BLWP to DEF) CR .( <def> EXT-DATA: <name> def ->Forth constant) CR NEW. CR .( Low RAM initialized) CR HERE SWAP - DECIMAL . .( bytes) 5 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 12, 2021 Author Share Posted September 12, 2021 To CREATE/DOES> or not to CREATE/DOES>, that might be the question After embedding myself in Machine Forth I started wondering about an idea I had some time back which was: Can I replace the 9900 Assembler mnemonics with equivalent Forth names and make a "machine forth" Assembler. The answer so far is "I think so". (whether anybody cares is another matter) However in the course of looking at the existing Assembler that we inherited from TI-Forth I see some needless complexity. It might just be young engineers saying "Look how cool my code is!" The CREATE DOES> or <BUILDS DOES> idea is really neat but it adds run-time overhead and takes up extra space in the system so its use should be reserved for those times when it really solves the problem. Compare these two ways to make the simpler instructions for TMS9900 Original: : 0OP CREATE , DOES> @ , ; 0340 0OP IDLE, 0360 0OP RSET, 03C0 0OP CKOF, 03A0 0OP CKON, 03E0 0OP LREX, 0380 0OP RTWP, : ROP CREATE , DOES> @ + , ; 02C0 ROP STST, 02A0 ROP STWP, : IOP CREATE , DOES> @ , , ; 02E0 IOP LWPI, 0300 IOP LIMI, Versus: HEX \ : IDLE, ( -- ) 0340 , ; \ "Should not be used on the HOME Computer" \ : RSET, ( -- ) 0360 , ; \ : CKOF, ( -- ) 03C0 , ; \ : CKON, ( -- ) 03A0 , ; \ : LREX, ( -- ) 03E0 , ; : RTWP ( -- ) 0380 , ; : STST ( reg -- ) 02C0 + , ; : STWP ( reg -- ) 02A0 + , ; : LWPI ( addr --) 02E0 , , ; : LIMI ( n -- ) 0300 , , ; Which one is easier to understand? Which one is compiles to less bytes? Which one will Assemble code faster? Edit: Corrected instruction CKOF mistake IDLE REST CKON CKOFF "...should not be used on the Home Computer..." E/A Manual. So they will be removed from the Camel99 Assembler to save space. 2 Quote Link to comment Share on other sites More sharing options...
GDMike Posted September 12, 2021 Share Posted September 12, 2021 3 hours ago, TheBF said: HEX \ : IDLE, ( -- ) 0340 , ; \ "Should not be used on the HOME Computer" \ : RSET, ( -- ) 0360 , ; \ : CKOF, ( -- ) 03C0 , ; \ : CKON, ( -- ) 03A0 , ; \ : LREX, ( -- ) 03E0 , ; : RTWP ( -- ) 0380 , ; : STST ( reg -- ) 02C0 + , ; : STWP ( reg -- ) 02A0 + , ; : LWPI ( addr --) 02E0 , , ; : LIMI ( n -- ) 0300 , , ; This to me is easier to understand, even though my copy/paste sucks on a phone. But anyway.. 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 13, 2021 Author Share Posted September 13, 2021 Replacing the Assembler with Machine Forth I am finally doing some experiments to see how this will work. My conclusion so far is that it is best to allow naming the registers to fit with the architecture of the 9900. However the register names will be Forth names. In the case of CAMEL99 they would be: \ R0 temp \ R1 temp \ R2 temp \ R3 AREG \ address register \ TOS R4 is top of stack cache (you need to manage it) :-) \ SP data stack pointer \ RP return stack pointer : NOS *SP ; \ Next on Stack : 3RD 2 (SP) ; : 4TH 3 (SP) ; : 5TH 4 (SP) ; TOS (top of stack) and NOS (next on stack) are register names from the F21 Forth CPU. So this is consistent with Chuck Moore's work. I have not decided if some machine Forth instructions should use the TOS NOS pair implicitly sometimes, so it is more like Forth or mandate that registers be explicitly used to make it more Assembler like. I am starting with explicit registers because that is the best fit to the 9900 architecture. I renamed the Assembler jump tokens to make the code look more Forth-like. (not sure they are all correct) HEX \ Action if TRUE 01 CONSTANT > \ JLT to ENDIF, *signed 02 CONSTANT U> \ JLE to ENDIF, 03 CONSTANT 0<> \ JEQ to ENDIF, 04 CONSTANT U< \ JHE to ENDIF, 05 CONSTANT <= \ JGT to ENDIF, *signed 06 CONSTANT 0= \ JNE to ENDIF, 07 CONSTANT OC \ JNC to ENDIF, 08 CONSTANT NC \ JOC to ENDIF, 09 CONSTANT OO \ JNO to ENDIF, 0A CONSTANT U< \ JLO to ENDIF, 0B CONSTANT U>= \ JH to ENDIF, 0C CONSTANT NP \ JOP to ENDIF, The concept works at least at the simple level. Here are two programs that generate the same machine code: HEX \ Code in Forth Assembler ASSEMBLER CODE ASM1 TOS FFFF LI, BEGIN, TOS DEC, EQ UNTIL, NEXT, ENDCODE \ Same code in MForth Assembler. \ NOTE: Registers must be explictly referenced MFORTH CODE MFORTH1 FFFF TOS !# BEGIN TOS 1- 0= UNTIL NEXT, ENDCODE I have added the '->' operator to compile memory to memory MOV instructions. (I suppose I will need C-> or something like that for byte moves) Here is a test program that works \ using variables/addresses MFORTH CODE MFORTH2 FFFF TOS !# BEGIN TOS 1- TOS X ! X -> Y \ mem2mem X->X assignment Y -> Z \ Y -> X 0= UNTIL NEXT, ENDCODE So yes it is a new notation to learn but it does make something of a universal Assembler that could in theory allow machine code to be generated on other machines quite easily. Here is the code generated by MFORTH2 DADE 0204 li R4,>ffff DAE2 0604 dec R4 DAE4 C804 mov R4,@>da8e DAE8 C820 mov @>da8e,@>da98 DAEE C820 mov @>da98,@>daa2 DAF4 16F6 jne >dae2 DAF6 045A b *R10 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 22, 2021 Author Share Posted September 22, 2021 Update on the Forth Syntax Assembler I have been fighting some other battles but my thoughts on this idea are that it has merit but will probably still require some native looking mnemonics to fully use the 9900 instruction set since it has to fully support the register nature of the 9900. I am not sure how far to pursue it at this time but we have a beginning. ? At the moment I have a Camel99 Forth issue with understanding why saving a binary image with wordlists is not stable. I am missing something simple (I hope) but it has eluded me so far. 3 Quote Link to comment Share on other sites More sharing options...
GDMike Posted September 22, 2021 Share Posted September 22, 2021 (edited) Cool beans Edited September 22, 2021 by GDMike Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 25, 2021 Author Share Posted September 25, 2021 FOXSHELL built on Latest Sources Doing a some maintenance and I have a new version of the FoxShell. I have corrected some oversights in the Kernel so they are in here now. The ANS file support is smaller now so that is reflected. Also I have not included DSK1.TOOLS in this version. Since this is just a Forth system under the hood you can INCLUDE DSK1.TOOLS from the Camel99 Forth DSK1 if you need it. This shell is actually a nice system to use for program development since you have all the disk utilities at your finger tips and it reboots immediately. The COLD command now resets the FoxShell to the default dictionary so can load Forth code and play around and just type COLD to remove it and get a clean system. Please report bugs and/or any features you wish it had. EDIT: Made Lee's changes to the source code. Zip file is also new. Changed MORE so you can see the contents of a DF128 file. (Not fully tested) Usage: DF128 MORE DSK2.MY128FILE COLD resets the file access mode to DV80. Source: Spoiler \ FOXSHELL.FTH CAMEL99 shell for disk file management \ Oct 2020: built with SAVESYS to create stand alone program \ Feb 8 2021, Built V1.2 with CAMEL99 V2.66 and libraries \ Sep 23 2021, V1.4, Build on Camel99 2.68F \ need new Ansfiles with W/A (write append) \ Fixed MORE giving error on end of file. How'd I miss that? :-\ \ NEEDS DUMP FROM DSK1.TOOLS NEEDS OPEN-FILE FROM DSK1.ANSFILES NEEDS VALUE FROM DSK1.VALUES NEEDS CASE FROM DSK1.CASE NEEDS BUFFER: FROM DSK1.BUFFER NEEDS MALLOC FROM DSK1.MALLOC NEEDS COMPARE FROM DSK1.COMPARE NEEDS U.R FROM DSK1.UDOTR \ right justified printing CR .( Compiling FOXSHELL ) VARIABLE WARNINGS WARNINGS ON CREATE #BYTES 0 , 0 , \ 32bit variable for big files : #BYTES+! ( n -- ) #BYTES 2@ ROT M+ #BYTES 2! ; \ add n, keep 32bit sum \ busy spinner to show activity VARIABLE SPIN# CREATE SCHARS CHAR | C, CHAR / C, CHAR - C, CHAR \ C, : GETXY ( -- col row) VROW 2@ ; : SPINCHAR ( -- char ) SPIN# @ 1+ 3 AND DUP SPIN# ! SCHARS + C@ ; : SPINNER ( -- ) SPINCHAR GETXY >VPOS VC! ; \ simplified file language \ Usage example: S" DSK2.MYFILE" R/W OPEN TO #1 HEX .( .) 0 VALUE #1 0 VALUE #2 0 VALUE #3 : OPEN ( addr len -- hndl ) OPEN-FILE ?FILERR ; : CLOSE ( hndl -- ) CLOSE-FILE ?FILERR ; : READH ( hndl -- ) READ-LINE ?FILERR 2DROP ; DECIMAL \ CR if near end of screen : ?CR ( n -- ) LINES @ 3 MOD 0= IF CR THEN ; .( .) HEX \ string helpers : ?PATH ( addr len -- ) 2DUP [CHAR] . SCAN NIP 0= IF CR TYPE TRUE ABORT" Path expected" THEN ; : ?FAM FAM @ 0= ABORT" Set file mode:DV80 DF128" ; : ARG$ ( -- addr len ) BL PARSE-WORD ?PATH ; : $. ( $addr -- ) COUNT TYPE ; : $.LEFT ( $ width -- ) OVER C@ - >R $. R> SPACES ; : NEXT$ ( addr len -- addr' len') + COUNT ; \ : +PLACE ( addr n $ -- ) 2DUP 2>R COUNT + SWAP CMOVE 2R> C+! ; DECIMAL 80 VALUE BUFFSIZE : DF128 ( -- ) 128 TO BUFFSIZE DISPLAY RELATIVE BUFFSIZE FIXED ; : DV80 ( -- ) 80 TO BUFFSIZE DISPLAY SEQUENTIAL BUFFSIZE VARI ; .( .) HEX : CLOSE-ALL ( --) 4 1 DO I ]FID @ IF I CLOSE-FILE DROP THEN LOOP ; \ ?break closes all open files. : ?BREAK ( ? -- ) IF CLOSE-ALL TRUE ABORT" *BREAK*" THEN ; \ Modify key to allow it to break and close files : FKEY ( -- char) VPOS VC@ >R BEGIN \ start the loop CURS @ \ fetch 2 char cursor (space & _ ) TMR@ 1FFF < \ compare hardware timer to 1FFF IF DROP R@ THEN VPUT \ swap cursor for screen char, write ?TERMINAL ?BREAK \ test for Break key KEY? \ check the keyboard ?DUP \ DUP IF <> 0 UNTIL \ loop until a key pressed R> VPUT ; \ put the space char on screen \ screen control : SPACE? ( -- ?) KEY? BL = ; : SPACEBAR ( -- ) SPACE? IF FKEY DROP THEN ; .( .) : OPEN-CATFILE ( adr len -- hndl) RELATIVE 100 FIXED R/O BIN OPEN ; \ 4 DIGIT BCD to int convertor. Limited to 9999 (Lee's correction) HEX : F>INT ( addr len -- addr len n) OVER C@ ( -- mantissa) CASE 0 OF 0 ENDOF 40 OF OVER 1+ C@ ENDOF 41 OF OVER 1+ C@ 64 * >R OVER 2+ C@ R> + ENDOF ( default) SWAP -1 \ bad # indicator ENDCASE ; DECIMAL : DIR.TYPE ( addr -- ) F>INT CASE 1 OF ." Txt/Fix" ENDOF 2 OF ." Txt/Var" ENDOF 3 OF ." Bin/Fix" ENDOF 4 OF ." Bin/Var" ENDOF 5 OF ." Program" ENDOF ." ????" ENDCASE ; .( .) : HEAD.REC ( addr -- ) DECIMAL DUP 7 $.LEFT SPACE COUNT ( addr len) NEXT$ ." Size " NEXT$ F>INT 5 U.R ." Used " NEXT$ F>INT 5 U.R 2DROP ; : DIR.REC ( addr -- ) DUP 11 $.LEFT SPACE COUNT ( addr len) NEXT$ DIR.TYPE NEXT$ F>INT 7 U.R NEXT$ F>INT 7 U.R 2DROP ; : FILE.REPORT BASE @ >R DECIMAL CR LINES @ . ." lines, " #BYTES 2@ UD. ." bytes" R> BASE ! ; \ ======================================== \ * \ * User commands: CAT DIR MORE DEL COPY \ * : CAT ( <DSK?.> ) \ needs the '.' ONLY shows file name BASE @ >R DECIMAL ARG$ OPEN-CATFILE >R \ store file handle PAD 80 R@ READH CR PAD HEAD.REC CR 13 SPACES ." -type- -sect- -b/rec-" LINES OFF BEGIN PAD DUP 80 R@ READH ( PAD) C@ \ do while length > 0 WHILE CR PAD DIR.REC 1 LINES +! SPACEBAR ?TERMINAL ?BREAK REPEAT R> CLOSE CR LINES @ . ." files" CR R> BASE ! ; .( .) HEX : DIR ( <DSK?.> ) ARG$ OPEN-CATFILE >R \ push handle PAD 50 R@ READH CR PAD HEAD.REC CR LINES OFF BEGIN PAD DUP 80 R@ READH ( PAD) C@ \ do while length <> 0 WHILE PAD 0D $.LEFT ?CR 1 LINES +! SPACEBAR ?TERMINAL ?BREAK REPEAT R> CLOSE DECIMAL CR LINES @ . ." files" CR HEX ; .( .) : MORE ( <filename>) BL PARSE-WORD ?FILE ( DV80) R/O OPEN-FILE ?FILERR >R 0 0 #BYTES 2! LINES OFF BEGIN PAD DUP 50 R@ READ-LINE ?FILERR DROP ( Caddr len --) LINES 1+! DUP #BYTES+! CR TYPE KEY? BL = IF KEY DROP ELSE ?TERMINAL IF R> CLOSE-FILE 2DROP CR ." ^C" ABORT THEN THEN R@ EOF UNTIL DROP R> CLOSE-FILE FILE.REPORT ; HEX : TOUPPER ( char -- upperchar ) 5F AND ; : SURE? ( -- ?) WARNINGS @ IF CR ." Are you sure? (Y/N)" ( ) KEY TOUPPER [CHAR] Y = THEN ; : .CANCEL CR ." Cancelled" CR ; : DEL ( <filename>) ?FAM ARG$ 2DUP R/W OPEN-FILE ?FILERR CR ." Delete " TYPE SURE? IF 7 FILEOP ?FILERR CLOSE-FILE 2DROP CR ." Done" ELSE DROP .CANCEL THEN ; DECIMAL : MOVE-FILE ( buff-size -- buff-size) ?FAM 0 0 #BYTES 2! DUP MALLOC >R LINES OFF SPACE BEGIN \ 256 is used to accomodate the largest possible record size R@ BUFFSIZE #1 READ-LINE ?FILERR ( -- #bytes eof?) DROP DUP #BYTES+! R@ SWAP #2 WRITE-LINE ?FILERR LINES 1+! SPINNER #1 EOF UNTIL R> DROP \ DROP buffer address from rstack MFREE ; .( .) DECIMAL : COPY ( <file1> <file2> ) ?FAM ARG$ ARG$ SURE? IF W/O OPEN TO #2 R/O OPEN TO #1 BUFFSIZE MOVE-FILE #2 CLOSE #1 CLOSE CR ." Copy complete. " FILE.REPORT ELSE 2DROP 2DROP .CANCEL THEN ; HEX : APND ( <file1> <file2> ) ?FAM ARG$ ARG$ W/A OPEN TO #2 \ *new* W/A, open destination in Append mode R/O OPEN TO #1 BUFFSIZE MOVE-FILE #2 CLOSE #1 CLOSE CR ." Append complete" FILE.REPORT ; : CLS PAGE ; : HELP CR CR ." Commands" CR ." --------------------" CR ." HELP Show this list" CR ." DIR <DSK?.> show file names" CR ." CAT <DSK?.> show files and types" CR ." MORE <path> show contents of DV80 file" CR ." DEL <path> delete file at path" CR ." COPY <path1> <space> <path2> " CR ." Copy file at path1 to path2" CR ." APND <path1> <space> <path2" CR ." Append file1 to file2" CR ." WAITFOR <path> Paste to Classic99" CR ." CLS Clear screen" CR ." COLD reboots FoxShell" CR ." BYE Return to Home screen" CR ." WARNINGS OFF Disables 'Are you sure?'" CR ." ------------------" CR ." SPACE bar will stop scrolling" CR ." FNCT 4 halts operations" ; \ re-write accept to use new KEY. ( could patch it but this is clearer) : FACCEPT ( c-addr +n -- +n') OVER + OVER BEGIN FKEY 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 - ; .( .) : RCV ( caddr len -- ) DV80 W/O OPEN TO #1 BEGIN PAD DUP 50 FACCEPT ( addr len) #1 WRITE-LINE ?FILERR AGAIN ; \ USED WITH Classic99. Pastes text into DV80 FILE : WAITFOR ( <PATH> ) ARG$ CR ." Waiting for file " 2DUP TYPE CR ." Press FCTN 4 to halt & SAVE" CR RCV ; : COLD \ replace COLD so we always reboot correctly WARM 201E CURS ! DV80 PAGE ." Fox Shell V1.4 Brian Fox 2021" DECIMAL HELP WARNINGS ON ABORT ; \ Remember this dictionary status for WARM boot DP @ ORGDP ! LATEST @ ORGLAST ! CR .( Save as EA5 binary files) INCLUDE DSK1.SAVESYS ' COLD SAVESYS DSK2.FOXSHELL FOXSHELL1.4.ZIP 6 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted September 25, 2021 Share Posted September 25, 2021 3 hours ago, TheBF said: Please report bugs and/or any features you wish it had. HEX \ 3 DIGIT BCD to int convertor. Limited to 999 : F>INT ( addr len -- addr len n) OVER C@ ( -- mantissa) CASE 0 OF 0 ENDOF 40 OF OVER 1+ C@ ENDOF 41 OF OVER 1+ C@ 64 * >R OVER 2+ C@ R> + ENDOF ( default) -1 \ bad # indicator ENDCASE ; DECIMAL Not to put too fine a point on it, but the floating point numbers are BCC (Binary Coded Centimal—radix 100) rather than BCD (Binary Coded Decimal—radix 10), which limits F>INT to 9999 rather than 999. There is also a bug in the default case. The bad # indicator (-1) needs to be swapped with the leftover byte so that ENDCASE does not consume the indicator: HEX \ 4 DIGIT BCC to int convertor. Limited to 9999 : F>INT ( addr len -- addr len n) OVER C@ ( -- mantissa) CASE 0 OF 0 ENDOF 40 OF OVER 1+ C@ ENDOF 41 OF OVER 1+ C@ 64 * >R OVER 2+ C@ R> + ENDOF ( default) -1 \ bad # indicator SWAP \ get byte for ENDCASE where it belongs ENDCASE ; DECIMAL ...lee 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 25, 2021 Author Share Posted September 25, 2021 Thank you. I will implement your changes. 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 1, 2021 Author Share Posted October 1, 2021 Look another shiny object (I should be on Ritalin) I made the mistake of looking at Mark's code for compiling code into SAMS pages. It's a pretty neat hack. I would not have thought of doing it quite like this. I was able to translate it but it didn't work. Hmmm... Why? Well, TF branches to literal addresses internally. Camel Forth branches to an +/- offsets Where Mark compiles BRANCH that doesn't work in Camel Forth so I created a new Forth word: GOTO ? CODE GOTO ( addr -- ) *IP IP MOV, NEXT, ENDCODE Once I discovered the magic word I started trimming it down. I have removed some of the sugar because I have less space, not using a cartridge. Colon/semi-colon is not overloaded. If you want to compile a word in SAMS use FAR: / ;FAR This is consistent with the Chuck's rule "Let the dictionary be your case statement" SETBANK is much simpler because it just tests for range and sets the _BANK value. The Bank stack has been re-written using ideas I got from Camel Forth internals. It's a little less code than using VALUEs. CMAP is narrow focused for this job and so is quite a bit smaller and faster than >MAP Todo: I think I can remove the HERE array but using the last CELL of each block to hold the dictionary pointer of the block we map in. Settle on the actual range of SAMS pages I want to use for CODE and fix the limits. Make the headers and footers in FAR: and ;FAR smaller by factoring out the existing code into a few words (some CODE would speed this up too) Use the return stack instead of _NHERE to save the Forth dictionary pointer on entry to a new word. Here is the code for CAMEL99 Forth Spoiler \ Code in SAMS memory based on TurboForth by Mark Wills \ Translation to Camel99 Forth Sept 30 2021 Fox INCLUDE DSK1.MARKER INCLUDE DSK1.VALUES INCLUDE DSK1.TOOLS INCLUDE DSK1.ASM9900 \ ARRAY creates a fast cell size array HEX : ARRAY ( n -- ) CREATE CELLS ALLOT \ compile time ;CODE ( n -- addr) \ RUN time 0A14 , \ R4 1 SLA, \ 2* ie: CELLS A108 , \ W R4 ADD, \ base-address+tos=address' NEXT, ENDCODE DECIMAL 32 ARRAY ]HERE \ array of dictionary pointers for each page \ SAMS memory management for code HEX 3000 CONSTANT CSEG \ code seg in CPU RAM 4000 CSEG 0B RSHIFT + CONSTANT CREG \ compute CSEG SAMS register CSEG 0C RSHIFT CONSTANT PASSTHRU \ default page for CSEG \ CMAP brings pages of code into the window called CSEG \ The SAMS register is pre-calculated as constant CREG CODE CMAP ( bank# -- ) TOS SWPB, R12 1E00 LI, 0 SBO, \ turn on the card TOS CREG @@ MOV, \ store bank# in SAMS register 0 SBZ, \ turn off card TOS POP, \ refill top of stack register NEXT, ENDCODE -1 VALUE _BANK \ current bank 0 VALUE _MAXBANK 0 VALUE _NHERE \ _____________________________________________ \ Stack to handle pages DECIMAL CREATE BS0 20 CELLS ALLOT CREATE BSP BS0 , \ stack pointer, initialzed to BS0 \ : BSDEPTH ( -- n) BSP @ BS0 - 2/ ; : >BS ( bank# --) DUP 2 BSP +! BSP @ ! CMAP ; : BS> ( -- bank#) BSP @ DUP BS0 = ABORT" Bank stack underflow" \ remove line for speed @ CMAP -2 BSP +! ; HEX F9 >BS \ force first entry on bank stack to SAMS page 0 HEX : BANKS ( n -- ) \ reserve space for here pointers for n banks DUP TO _MAXBANK DUP 1+ 0 DO CSEG I ]HERE ! LOOP \ init "here" for each bank CR 4 * . ." K of SAMS reserved." CR ; \ TF uses address branching. Camel Forth uses Offset branching. \ GOTO lets us do a direct branch to a literal address in the Forth code CODE GOTO ( addr -- ) *IP IP MOV, NEXT, ENDCODE : FAR: ( -- ) : \ Run-time action POSTPONE LIT _BANK , \ compile my bank# POSTPONE >BS \ push my bank# and MAP POSTPONE GOTO _BANK ]HERE @ DUP , \ compile jump to here for this bank \ compile-time action HERE TO _NHERE \ save "normal here" DP ! \ set dp to _bank's "here" _BANK CMAP \ map in the appropriate bank ; : ;FAR ( -- ) \ end banked compilation POSTPONE GOTO _NHERE , HERE _BANK ]HERE ! \ update here for bank _NHERE DP ! \ restore dp to "normal" memory POSTPONE BS> POSTPONE ; ; IMMEDIATE : SETBANK ( bank -- ) DUP _MAXBANK 0 WITHIN ABORT" Bad bank number" TO _BANK ; HEX : _BFREE ( -- n) 4000 _BANK ]HERE @ - ; : .BFREE ( -- ) DECIMAL _BFREE . ." FAR page bytes free." CR ; 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 1, 2021 Author Share Posted October 1, 2021 Why make a new stack when you already have two? : FAR: ( -- ) : \ compile header in CPU RAM \ Run-time action POSTPONE _BANK \ compile my bank# POSTPONE DUP>R POSTPONE CMAP \ push & MAP the bank into RAM POSTPONE GOTO _BANK ]HERE @ DUP , \ compile jump to here for this bank \ compile-time action HERE TO _NHERE \ save "normal here" DP ! \ set dp to _bank's "here" _BANK CMAP \ map in the appropriate bank ; : ;FAR ( -- ) \ end banked compilation POSTPONE GOTO _NHERE , HERE _BANK ]HERE ! \ update here for bank _NHERE DP ! \ restore dp to "normal" memory POSTPONE R> POSTPONE CMAP POSTPONE ; ; IMMEDIATE I can now confirm that the code above works reliably using the return stack for SAMS pages but I think I have exhausted the possibilities of this method to put CODE into SAMS. Lee made mention of it in the Foxit thread regarding the large headers created in the Forth dictionary. I vectored the function of : and ; to be FAR: and FAR; and then compiled the following list of files into a single 4K SAMS page. INCLUDE DSK1.ANSFILES INCLUDE DSK1.CATALOG INCLUDE DSK1.DIR INCLUDE DSK1.MORE INCLUDE DSK1.GRAFIX INCLUDE DSK1.DIRSPRIT INCLUDE DSK1.COOLSPRITE Before I loaded the file I had 13,518 bytes remaining in my CPU RAM. (Forth kernel+SAMS code stuff+Tools) After loading the files here are the numbers: SAMS Page: 698 bytes free, so 3,398 bytes used CPU Free: 9514 free, so 4004 bytes used >> just for the headers<< So I will take this learning and incorporate some of it into my next work. 3 Quote Link to comment Share on other sites More sharing options...
GDMike Posted October 1, 2021 Share Posted October 1, 2021 From the last time I spoke with Mark he said he was getting back into his TF project since his master degree chase was about caught up. But I haven't heard from him since the virus outbreak. Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 1, 2021 Author Share Posted October 1, 2021 31 minutes ago, GDMike said: From the last time I spoke with Mark he said he was getting back into his TF project since his master degree chase was about caught up. But I haven't heard from him since the virus outbreak. It would be great to have him hanging around here again. BTW I may have discovered why Mark used a separate stack for his SAMS pages. I think you need that default page# on the bottom that he has. More experiments needed. 2 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 7, 2021 Author Share Posted October 7, 2021 When I regained consciousness... I found that I finally had a working version of FAR: / ;FAR That reduced the overhead in the Dictionary. Using the original Turbo Forth method translated to Camel99 Forth this empty definition: FAR: TEST ;FAR Took 26 dictionary bytes and 4 SAMS bytes With the work I did this week, the same definition consumes 16 Dictionary bytes and 4 SAMS bytes. I did this by making a proper colon definition for FAR: that has it's own run-time code. This replaces all the "compiled" words in the TF code and it should be faster as well. I use two data fields: Bank# and SAMS dictionary pointer. The code word FARCOL uses the IP register to read these sequential bytes into their appropriate places. It's still not giving me as much efficiency as I would like but it reduces the Forth dictionary consumption by about 40% when I load my ANS Files library. I have tested the calling overhead yet. Bugs: 1. There is a SAMS memory bug somewhere because I cannot squeeze as many files into a 4K block as I can with more direct translation of TF version that I did earlier. ?? I think I am advancing an extra cell after each definition. More sleuthing needed... 2. Changing Banks is not reliable yet. This has been way harder than I wanted it to be but thanks to Mark paving the way I had a place to begin. Here is the current state of the code: Spoiler \ Code in SAMS memory based on code in TurboForth by Mark Wills \ Translation to Camel99 Forth Oct 6, 2021 \ Changes from original: \ Remove bank stack. Used return stack for bank# storage \ Removed BANKS. Changed to preset DP array \ CMAP is a fast sub-routine for mapping SAMS pages F0..FF \ Coded is limited to one 64K segment at top of SAMS \ Changed to compile a far "colon" definition. INCLUDE DSK1.MARKER INCLUDE DSK1.VALUES INCLUDE DSK1.LOWTOOLS \ INCLUDE DSK1.TOOLS \ INCLUDE DSK1.ASM9900 HERE \ SAMS memory management for code HEX 3000 CONSTANT CSEG \ code seg in CPU RAM 4000 CSEG 0B RSHIFT + CONSTANT CREG \ compute CSEG SAMS register CSEG 0C RSHIFT CONSTANT PASSTHRU \ default page for CSEG DECIMAL CREATE []DP \ DP for 0 .. 15 pages of SAMS CSEG , CSEG , CSEG , CSEG , CSEG , CSEG , CSEG , CSEG , CSEG , CSEG , CSEG , CSEG , CSEG , CSEG , CSEG , CSEG , HEX CODE ]HERE ( ndx -- addr ) A104 , \ TOS TOS ADD, 0224 , []DP , \ TOS SAT AI, NEXT, ENDCODE F0 VALUE _1STBANK FF VALUE _MAXBANK VARIABLE SAVHERE \ temp holder for RAM Dictionary pointer VARIABLE BANK# \ active SAMS bank# HEX \ MAPPER always adds the _1STBANK offset. CREATE MAPPER ( R1: 0 .. 16 ) \ !! SUB-ROUTINE !! R1 _1STBANK AI, \ add the offset R1 SWPB, \ swap bytes R12 1E00 LI, \ DO CMAP 0 SBO, \ turn on the card R1 CREG @@ MOV, \ restore bank# from return stack 0 SBZ, \ turn off card RT, CODE CMAP ( bank# --) \ Forth word to map SAMS pages TOS R1 MOV, MAPPER @@ BL, TOS POP, NEXT, ENDCODE CODE GOTO ( addr -- ) C259 , ( *IP IP MOV,) NEXT, ENDCODE CREATE FARCOL \ run time executor for SAMS colon words. IP RPUSH, W IP MOV, *IP+ R2 MOV, \ fetch bank# from DATA FIELD -> R2 R2 RPUSH, \ push the bank# R2 R1 MOV, \ dup R2 to R1 MAPPER @@ BL, \ pull in the SAMS page *IP IP MOV, \ get SAMS DP & set IP NEXT, \ FAR word data structure: \ CELL: link \ BYTE: immediate field \ BYTE: name length \ BYTES: <....> \ CELL: code field \ CELL: DATA field #1 , bank# \ CELL: DATA field #2 , SAMS code field address : FAR: ( -- ) \ special colon for words in FAR memory !CSP HEADER \ compile Forth header FARCOL , \ compile the new executor as CFA BANK# @ DUP>R , \ compile bank# as the DATA field R@ ]HERE @ , \ compile this word's location in SAMS HERE SAVHERE ! \ save "normal here" R@ CMAP \ map in the appropriate bank R> ]HERE @ DP ! \ set dp to CSEG. Compiling goes here now HIDE ] \ turn on the compiler ; HEX CODE FAREXIT R1 RPOP, MAPPER @@ BL, IP RPOP, NEXT, ENDCODE : FARSEMIS POSTPONE FAREXIT POSTPONE [ REVEAL ?CSP ; IMMEDIATE : ;FAR ( -- ) \ end banked compilation POSTPONE GOTO SAVHERE @ , HERE BANK# @ ]HERE ! \ update here for bank SAVHERE @ DP ! \ restore dp to "normal" memory POSTPONE FARSEMIS ; IMMEDIATE : SETBANK ( bank# -- ) \ 0..15 are valid args DUP 100 0 WITHIN ABORT" Bad bank number" BANK# ! ; HEX : _BFREE ( -- n) 4000 BANK# @ ]HERE @ - ; : .BFREE ( -- ) DECIMAL CR ." Bank# " BANK# @ . ." , " _BFREE . ." bytes free." CR ; HERE SWAP - DECIMAL CR . .( bytes) \ free 11,566 REMOVE-TOOLS Now if you want to load existing code need to alias FAR: ;FAR to : /; The easiest way is to use a vocabulary I think. I have not tried this but it should work. VOCABULARY SAMS ONLY FORTH ALSO SAMS DEFINITIONS \ rename normal : ; so we don't over-ride them and can still use them : H: : ; : ;H POSTPONE ; ; IMMEDIATE H: : FAR: ;H H: ; ;FAR ;H IMMEDIATE There are other ways to this that don't need vocabularies. Adding vocabulary/wordlists to my system uses 550ish valuable bytes. 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.