+Lee Stewart Posted January 10, 2020 Share Posted January 10, 2020 2 hours ago, TheBF said: EQ UNTIL, \ jump back if no carry flag set <nit picking> Should not your comment be “\ jump back if no equal flag set”? </nit picking> ...lee Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 10, 2020 Author Share Posted January 10, 2020 38 minutes ago, Lee Stewart said: <nit picking> Should not your comment be “\ jump back if no equal flag set”? </nit picking> ...lee Yes. Comment creep. 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 16, 2020 Author Share Posted January 16, 2020 I thought I knew something about Forth but no... I was reading comp.lang.forth and read that the ANS Forth word WITHIN ( n lo hi -- ?) can be used with the lo,hi arguments reversed to reverse the logic. WITHIN ( n hi lo -- inverted-logic) I would never have tried this. Good to know. Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 22, 2020 Author Share Posted January 22, 2020 Slowly making some progress with the DV80 file editor that uses Forth virtual memory blocks. Currently it's not the fastest in the world by any means but it does have some fun features. I hated the fact that when typing in the EA editor the screen jumps to deal with the 80 column line length. So this one just slides to the left as you type. And I didn't want to be restricted to blocks of 16 lines so this one now can scroll up and down freely like a normal text editor as well. Currently it can hold 512 lines in a 64K swap file. Inserting lines will not be particularly fast but I want to get it working pretty solidly before going to something like a GAP format for dealing with inserts. It wastes space in the virtual memory because the lines internally are 128 bytes each. This gives me some room to play with inserting into a line but I have not thought that through yet. This is the "worst" form of the editor. The upgrade path is to replace the swap file with SAMS memory blocks since I have a card in my TI-99. But the swap file method means it could work on a couple of floppy drives with reasonable performance. Currently 3K of file is held in low memory at any given time so editing a local buffer is RAM. The video shows how it looks at the moment. ED99 UPDATE.mp4 4 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 29, 2020 Author Share Posted January 29, 2020 (edited) Strings and Things It was a 4 hr flight back from Dominican Republic and I found some Forth code on my laptop. It was a version of my string library that I tested on SwiftForth for OS/X. According to an old source file I wrote the first version of a set of string words for TI Forth in 1987. It was pretty crude because I was still learning Forth but I wanted to be able to the do the things I did in BASIC with Forth. I developed a "string stack" that was used to keep the intermediate results of every string operation. This meant that when you did SEG$ for example, it copied the input string onto the string stack, did the operation and then returned the address of that new temp string not the original. This meant that you could do interesting things like the BASIC code below; Pass the arguments from one string operation to another string operation. 100 A$="DSK1.TESTFILE" 110 PRINT SEG$(A$,1,POS(A$,".",1)) (This returns "DSK1.") However it always disturbed me that I was doing all that copying, especially after I learned about Forth "stack strings". These are a data pair that has the address and the length of the string on the data stack. It sounds weird, but this makes cutting strings almost instantaneous. For example to make LEFT$ you just DROP the length value (throw it away) and replace it with the one you want. No copying strings willy nilly. The other big advantage is that the results are sitting there on the Forth stack for the next string operation! Edit: I should note that when we save to string variable in this system it is saved as a byte counted string. 1st byte is the length. When we use that string it knows how to return its address and length as a stack string. (see DIM in the code) So on the flight I got the beginnings of a system that only uses stack strings. It is smaller and faster that code than I had before and it interfaces with standard Forth better because stack strings are the norm now in modern Forth. So the old 99 is moving forward. And the advantage of coding in standard Forth is that if you are careful it even runs on 32bit and 64 bit implementations as you can see in the Gforth screen capture. Here is the new library file: \ Faster/smaller "TI BASIC" string library for CAMEL99 Jan 28 2020 B Fox \ No string stack. Data stack used for intermediate results \ Uses stack strings for processing, counted string storage \ PAD buffer used for concatenation only \ "Copy on write" (COW) with store string operator. (!$) \ TI BASIC Forth \ ---------------- ------------------ \ DIM A$(100) 100 DIM A$ \ DIM B$(100) 100 DIM B$ \ A$=LEFT$(A$,5) A$ 5 LEFT$ A$ !$ ( modify, store) \ PRINT SEG$(A$,4,4) A$ 4 4 SEG$ PRINT ( process, print) \ PRINT A$&B$&C$ A$ B$ & C$ & PRINT ( concatenate, print) \ A$=B$ A$ B$ !$ ( store string) \ ---------------------------------------------------- \ INCLUDE DSK1.TOOLS HERE NEEDS -TRAILING FROM DSK1.TRAILING NEEDS COMPARE FROM DSK1.COMPARE DECIMAL 255 CONSTANT MXLEN \ 255 bytes is longest string : ?$IZE ( n -- ) MXLEN > ABORT" $ too big!" ; \ convert stack string to its counted string address : >COUNTED ( addr len -- caddr) DROP [ 1 CHARS ] LITERAL - ; \ ====[ create a named string of size n ]==== \ When a DIM string is executed it returns a stack string. : DIM ( n -- ) DUP ?$IZE CREATE 0 C, ALLOT ALIGN \ prepare a counted string DOES> COUNT ; ( -- addr len) \ returns stack string \ ==== From Wil Baden's Tool Belt [R.I.P. Wil] ==== : PLACE ( addr n dst$ -- ) 2DUP C! 1+ SWAP CMOVE ; \ : C+! ( n addr -- ) DUP >R C@ + R> C! ; \ in Kernel 2.5 : +PLACE ( addr n $ -- ) 2DUP 2>R COUNT + SWAP CMOVE 2R> C+! ; : APPEND-CHAR ( char caddr -- ) DUP >R COUNT DUP 1+ R> C! + C! ; \ ==== Replicate TI BASIC string functions ==== : LEN ( addr len -- addr len c ) DUP ; \ : LEFT$ ( addr len n -- addr len') NIP ; \ : RIGHT$ ( addr len n -- addr len) /STRING ; : SEG$ ( addr len n1 n2 -- addr len) >R /STRING R> NIP ; : POS$ ( char $ -- c) ROT SCAN NIP ; : STR$ ( n -- adr len) DUP ABS 0 <# #S ROT SIGN #> ; : ASC$ ( addr len -- c) DROP C@ ; \ : -LEADING ( addr len -- addr' len') BL SKIP ; \ trim leading spaces \ : CLEAN$ ( addr len -- addr len) -LEADING -TRAILING ; : & ( addr len addr len -- addr len ) 2SWAP PAD DUP >R PLACE R@ +PLACE R> COUNT LEN ?$IZE ; \ abort if string len >255 : ?NUMBER ( addr len -- n ?) \ convert to single, 0 flag is good conversion OVER C@ [CHAR] - = IF TRUE >R 1 /STRING ELSE FALSE >R THEN 0 0 2SWAP >NUMBER NIP NIP R> IF SWAP NEGATE SWAP THEN ; : VAL$ ( addr len -- n ) ?NUMBER ABORT" not a number" ; \ compare stack strings : =$ ( addr len addr len -- flag) COMPARE 0= ; : >$ ( addr len addr len -- flag) COMPARE 0< ; \ $1 > $2 : <$ ( addr len addr len -- flag) COMPARE 0> ; \ $1 < $2 \ *WARNING* You are protected from trying to store a 255 byte string. \ If the destination string is too small it will crash! : !$ ( addr len addr len -- ) >COUNTED OVER ?$IZE PLACE ; \ compile time string assignment : =" ( addr len -- <text> ) [CHAR] " PARSE 2SWAP !$ ; : ="" ( addr len -- ) >COUNTED OFF ; \ sets string length to zero : PRINT ( addr len -- ) CR TYPE ; \ more like BASIC'S print HERE SWAP - DECIMAL . .( Bytes) And here is the test code used in the short video: \ camel99 string test suite NEEDS ELAPSE FROM DSK1.ELAPSE DECIMAL \ string variable creation and assignment at compile time 255 DIM A$ A$ =" Now is the time " 255 DIM B$ B$ =" for all good men " 255 DIM C$ C$ =" to come to the aid of their country." 255 DIM Q$ \ string literal creation is ISO Forth : D$ S" This is a string literal. Don't change it!" ; : E$ S" *I need cleaning* " ; \ we can use ISO Forth words on DIM strings : CLEAN$ ( addr len -- addr len) BL SKIP -TRAILING ; : CONCAT1000 ( -- ) CR ." Concatenate 3 strings and store" A$ PRINT B$ PRINT C$ PRINT CR ." 1000 times..." 1000 0 DO A$ B$ & C$ & Q$ !$ LOOP CR Q$ PRINT CR ; : CLEAN1000 ( -- ) CR ." Clean string & store CR ." ->'" E$ TYPE ." '" CR ." 1000 times..." 1000 0 DO E$ CLEAN$ Q$ !$ LOOP CR CR ." ->'" Q$ TYPE ." '" CR ; : SEG1000 CR ." SEG$ test" CR ." C$ =" C$ TYPE CR ." Perform C$ 14 3 SEG$ Q$ !$" CR ." 1000 times..." 1000 0 DO C$ 14 3 SEG$ Q$ !$ LOOP Q$ PRINT ; CAMEL99 STRINGS.mp4 Edited January 29, 2020 by TheBF Added spoilers 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 29, 2020 Author Share Posted January 29, 2020 It funny how you can stare at code for along time and not see what needs improving and them bang! It's clear as vodka. Original Camel Forth "convert a counted string to a number" code: (Note: T[CHAR] is the cross-compiler version of [CHAR] , converts a letter to ascii value.) : ?SIGN ( adr n -- adr' n' ?) OVER C@ 2C - DUP ABS 1 = AND DUP IF 1+ >R 1 /STRING R> THEN ; : ?NUMBER ( c-addr -- n -1 ) \ ;Z -- c-addr 0 \ if convert error DUP 0 0 ROT COUNT OVER C@ T[CHAR] - = >R >NUMBER IF R> 2DROP 2DROP FALSE ELSE 2DROP NIP R> IF NEGATE THEN TRUE THEN ; Meanwhile I created a version that took a stack string and delivered a false flag on successful conversion: ( which I improved a little this afternoon) : NUMBER? ( addr len -- n ?) \ convert to single, 0 flag is good conversion OVER C@ T[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 ; Which means to get the same functionality as the Camel Forth code I only need: : ?NUMBER ( c-addr -- n ?) COUNT NUMBER? 0= ; Replacing the old code with NUMBER? and adding COUNT and 0= in the INTERPRET loop saves me 40 bytes in the kernel and is even a tiny bit faster. I am slowly moving away from the original Camel Forth but it makes sense for our favourite machine. 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 29, 2020 Author Share Posted January 29, 2020 In the above post I missed the fact that ?NUMBER has a different output depending on if the string converted correctly. This affects the way the Error message works when conversion fails. DRAT! ? So I have more work to do but I like the space savings just the same. Time for supper... 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 30, 2020 Author Share Posted January 30, 2020 (edited) ?NUMBER vs NUMBER? So I have netted out at 8126 bytes using ?NUMBER in the INTERPRET loop versus using a much simpler NUMBER? and adding a few extra noise words in the INTERPRET loop and reducing the kernel size to 8092, a saving of 34 bytes. It literally is four additions to the REPL. ( DUP COUNT DROP NIP ) So the interpreter/compiler looks like this. A little bit uglier in the number conversion perhaps but more efficient. AND... I don't need to create a special number converter to create VAL$ in the string package. I am happy with the comprises. : <INTERPRET> ( 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) DUP COUNT NUMBER? ( caddr n ? ) IF DROP TRUE SWAP COUNT ?ABORT ELSE NIP t[COMPILE] LITERAL THEN THEN ?STACK REPEAT DROP ; Edited January 30, 2020 by TheBF minor edit 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 30, 2020 Author Share Posted January 30, 2020 (edited) LOL! How can I stare at something all day and miss the obvious. I guess it's one of the problems of "meta-programming" where you make the language as you go. YOU GOTTA REMEMBER WHAT YOU WROTE Or maybe it an example of why Fred Brooks wrote, in his book about S/W failure, the Mythical Man Month: "It takes nine months to have a baby no matter how many women you put on the job." I have an error handler called ?FIND ... : ?FIND ( ? -- ) 0= HERE COUNT ?ABORT ; ... which I wrote to handle lookups with tick. ( ' ) : ' ( -- xt) BL WORD FIND ?FIND ; So all that stack noise goes away! And I save 6 more bytes! Kernel is now 8082 Bytes. : <INTERPRET> ( 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? ( caddr n ? ) IF FALSE ?FIND ELSE t[COMPILE] LITERAL THEN THEN ?STACK REPEAT DROP ; EDIT: But then I realized that using a "trap" (ABORT) like ?FIND means I don't need the IF statement. ?FIND protects the system from compiling a bad number. And that saves 8 more bytes so we are at 8074 bytes. Total saving: 52 bytes : <INTERPRET> ( 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? ( caddr n ? ) 0= ?FIND t[COMPILE] LITERAL THEN ?STACK REPEAT DROP ; Edited January 30, 2020 by TheBF 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 30, 2020 Author Share Posted January 30, 2020 Once you start looking... Long ago i added DEPTH to the kernel, but then I didn't use it to check for stack underflow in the the word ?STACK so that saved bytes. (I am sensing a pattern here...) Then I realized I only used ?STACK once, so that had to go and I put the error check and message inside the <INTERPRET> loop. I changed the name of ?FIND to ?ERR because it is the most fundamental error check in the system. Failed lookup of a word. : <INTERPRET> ( 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 t[COMPILE] LITERAL THEN DEPTH 0< TS" Empty stack" ?ABORT REPEAT DROP ; Then I realized I had more compile time testing in my BEGIN WHILE AGAIN REPEAT loops than I needed so that had to go. So I decided to take a few bytes back and added the fORTH 2012 word PERFORM which is like @ and EXECUTE together. This makes INTERPRET run a bit faster because I use a variable for interpret to deal with a forward reference in the compile process. ( QUIT needs INTERPRET and ABORT, but ABORT needs QUIT ) Forth doesn't do that kind of thing out of the box. And now I realize I can improve that whole thing too... All that to say I am down to a kernel of 8032 bytes. 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 31, 2020 Author Share Posted January 31, 2020 The creativity of people is amazing! I was reading Reddit today and found this. Believe it or not, this is compilable Forth code for a a couple of keyboard translation tables. ( https://github.com/davazp/eulex/blob/master/kernel/keyboard.fs#L135 ) A neat example of alternative paradigm programming IMHO. CREATE TBLSC-QWERTY ( ) ( ) 0 c, ESC c, ( ) | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 0 | - | = BACK c, ( ) TAB c, | q | w | e | r | t | y | u | i | o | p | [ | ] RET c, ( ) CTRL c, | a | s | d | f | g | h | j | k | l | ; | ' | ` ( ) SHIFT c, | \ | z | x | c | v | b | n | m | , | . | / SHIFT c, ( ) PRSCR c, ALT c, ______SPACE______ c, CAPSLOCK c, ( ) ( ) TBLSC-SPECIAL ( ) TBLSC-QWERTY END. CREATE TBLSC-QWERTY-SHIFT ( ) ( ) 0 c, ESC c, ( ) | ! | @ | # | $ | % | ^ | & | * | ( | ) | _ | + BACK c, ( ) TAB c, | Q | W | E | R | T | Y | U | I | O | P | { | } RET c, ( ) CTRL c, | A | S | D | F | G | H | J | K | L | : | " | ~ ( ) SHIFT c, | | | Z | X | C | V | B | N | M | < | > | ? SHIFT c, ( ) PRSCR c, ALT c, ______SPACE______ c, CAPSLOCK c, ( ) ( ) TBLSC-SPECIAL ( ) TBLSC-QWERTY-SHIFT END. Quote Link to comment Share on other sites More sharing options...
+TheBF Posted February 5, 2020 Author Share Posted February 5, 2020 (edited) Armed with a new "slimmer" build of Camel99 Forth, V2.59, I desperately wanted to get it ported to TTY (RS232) I/O. I much prefer using the PC and a terminal when I am playing with the real Iron at least for testing Forth things. Speaking of testing things I have come to rely on Lees' Seven's problem code as a general "will it work" program since it exercises a few key library files and screen I/O stuff. I did take the liberty of replacing the CONSTANT changing method with VALUES and I found I got a good speed-up by printing the A1 buffer directly versus loading into into Forth's PAD buffer and then printing it. I did this as a result of looking at a BASIC version that I had upgraded a while back. If it works in BASiC... So here is the code and a video of the result. It's not too shabby. This version of Camel99 /TTY Forth has vectored I/O so I should be able to re-direct output to the other RS232 port, VDP screen and even memory buffers. More work on that but the EMIT word is a vector currently holding the code routine CEMIT that outputs to RS232/1. \ Lee Stewart's mod of Lucien2's code for the sevens problem... \ for CAMEL99 /TTY V2.59 \ 1. Used VALUES \ 2. Used UM/MOD , native division \ 3. >DIGIT for digit conversion \ 4. Print A1 directly, no PAD buffer NEEDS ELAPSE FROM DSK1.ELAPSE NEEDS VALUE FROM DSK1.VALUES NEEDS MALLOC FROM DSK1.MALLOC DECIMAL \ ------------------------------------ 180 CONSTANT SIZE SIZE MALLOC CONSTANT A1 \ A1 digit array 0 VALUE LENGTH \ current number of digits in result \ HEX \ Using 7* reduces time of "RUN" & "FASTRUN" by ~1 second \ CODE 7* C044 , 0A34 , 6101 , NEXT, ENDCODE DECIMAL : A1*7->A1 ( -- ) \ perform 7 * last result 0 \ initialize carried digit on stack 1 +TO LENGTH \ assume we will increase length by 1 digit A1 LENGTH BOUNDS DO I C@ \ get cur digit as next higher digit 7 * \ cur digit * 7 + \ add carried digit from stack 0 10 UM/MOD \ make result ud..unsigned divide by 10 SWAP I C! \ store rem as cur digit..carry on stack LOOP DROP \ clean up stack \ eliminate leading 0 A1 LENGTH 1- + C@ 0= \ highest digit = 0? IF -1 +TO LENGTH \ correct digit count THEN ; : A1$ ( -- addr len) PAD DUP \ PAD & COPY for string storage A1 1- DUP LENGTH + DO I C@ >DIGIT \ fetch integer,convert to ASCII OVER C! \ store ASCII digit in PAD 1+ \ next PAD location -1 +LOOP DROP \ clean up stack ( PAD) LENGTH ; : A1$.TYPE ( -- addr len) A1 LENGTH 1- OVER + DO I C@ >DIGIT EMIT -1 +LOOP ; : 7COUNTER ( -- ? ) \ Brian Fox's technique 0 \ initialize counter A1 LENGTH BOUNDS \ DO A1 to A1 + length DO 1+ \ increment counter I C@ 7 = AND \ test char, AND with counter. DUP 6 = IF \ more than '77777'? LEAVE \ yup..we're done THEN LOOP ; : .POWER ( n -- ) ." SEVEN TO THE POWER OF " . ." IS" ; DECIMAL : RUN \ V2.58 1:26 , v2.59 1:08 PAGE A1 SIZE 0 FILL 7 A1 C! 1 TO LENGTH 2 \ starting power BEGIN A1*7->A1 DUP \ dup power for display CR .POWER 1+ \ increment power CR A1$.TYPE CR 7COUNTER 6 = UNTIL DROP ; DECIMAL : NOSCROLL PAGE A1 SIZE 0 FILL 7 A1 C! 1 TO LENGTH 2 \ starting power BEGIN A1*7->A1 DUP \ dup power for display 0 0 AT-XY .POWER 1+ \ increment power CR CR A1$ TYPE \ 39:08 7COUNTER 6 = UNTIL 0 7 AT-XY ; DECIMAL : FASTRUN ( 16.1 seconds) PAGE ." Working..." A1 SIZE 0 FILL PAD SIZE 0 FILL 7 A1 C! 1 TO LENGTH 2 \ starting power BEGIN 7COUNTER 5 < WHILE A1*7->A1 1+ \ increment power REPEAT 1- CR .POWER CR A1$ TYPE 0 7 AT-XY ; CR .( TYPE: RUN or FASTRUN ) CR DECIMAL COM1_9600bps - CAMEL99 Forth Terminal VT 2020-02-05 15-00-16.mp4 Edited February 5, 2020 by TheBF Added spoilers 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted February 7, 2020 Author Share Posted February 7, 2020 (edited) The downside of working from the PC over RS232 has been very long times to get finished programs onto the floppy drives as DV80 files. I had two options: Magic file manipulator which runs under xBasic, so that was painful since CAMEL99 runs with the E/A cartridge. Slowly send programs directly to Forth over RS232 and run them directly. The slow speed is because when sending text with Terra term I have to put a 1mS delay after each character and a 300 mS delay after each carriage return. The character delay could be much less but Terra term has a minimum of 1ms. And Forth has to interpret or compile each line after a <return> character so that takes a bit of time so we have to wait. I had started a project that loaded files into a low RAM but it had some bugs and the CAMEL99 /TTY program was not as stable as I would like. I could get the text reliably into the buffer using Forth Assembler with an idea from POLYFORTH called STRAIGHT. STRAIGHT reads the input stream into a buffer with no extras. Just slam it in and timeout when it stops, or we hit the end of the length argument. I had to strip the >0D off the end of each line to write records correctly to DV80 file. I got that working using the all powerful SCAN and /STRING. The rest was integrating it with some prompts for the user. It still took a long time working on the floppy drives. Wow I forgot how slow that it. So now I have a text-file upload utility. This means I can test code on Classic99 and then send the file over serial to floppy disk immediately. What a pleasure! The video shows it accepting it's own source code and saving it to disk. Edit: This video shows text pasted into Teraterm. It seems to go much faster when I used the SEND menu. It actually takes longer to write it to floppy disk than to send the file over RS232. \ Accept chars into a buffer with no echo \ capable of reading continuous data at 9600 bps NEEDS MARKER FROM DSK1.MARKER \ NEEDS MOV, FROM DSK1.ASM9900 NEEDS OPEN-FILE FROM DSK1.ANSFILES CR .( Compiling UPLOAD Utility ) MARKER REMOVE .( .) VARIABLE FHNDL HEX 0D CONSTANT ^M 2000 CONSTANT 8K : HEAP ( -- addr) H @ ; : ERASE ( addr len --) 0 FILL ; HEX .( .) CREATE ALLDONE \ branch here to exit readcom 020C , 1300 , 1E07 , C337 , 0300 , 0002 , C101 , NEXT, \ R12 RS232/1 LI, \ 7 SBZ, \ turn off LED \ R12 RPOP, \ 2 LIMI, \ interrupts back on \ R1 TOS MOV, \ get the char count to Forth TOS \ NEXT, HEX .( .) CODE READCOM ( addr n -- n' ) 0300 , 0000 , 0647 , C5CC , 020C , 1300 , 1D07 , C320 , B09C , C236 , A108 , 0700 , 04C1 , 1F15 , 1605 , 3638 , 1D12 , 0700 , 0581 , 1004 , 0600 , 1602 , 0460 , ALLDONE , 8108 , 16F3 , 0460 , ALLDONE , .( .) \ 0 LIMI, \ we need full attention \ R12 RPUSH, \ R12 RS232/1 LI, \ select the CARD \ 7 SBO, \ turn on LED \ PORT @@ R12 MOV, \ select the 9902 port \ *SP+ W MOV, \ addr ->W (ie: R8) \ W TOS ADD, \ calc last address ->TOS \ R0 SETO, \ set timeout register >FFFF \ R1 CLR, \ reset char counter \ BEGIN, \ 21 TB, \ test if char in uart \ EQ IF, \ *W+ 8 STCR, \ put char in buf & inc W \ 18 SBO, \ clr rcv buffer \ R0 SETO, \ reset timeout to 0FFFF \ R1 INC, \ count char \ ELSE, \ R0 DEC, \ no char, dec TIMEDOUT \ EQ IF, \ ALLDONE @@ B, \ ENDIF, \ ENDIF, \ W TOS CMP, \ end of buffer ? \ EQ UNTIL, \ ALLDONE @@ B, \ ENDCODE .( .) DECIMAL \ STRAIGHT from PolyForth. Read n chars into addr or timeout : STRAIGHT ( addr len -- n) 1 /STRING OVER 1- ( -- addr+1 len' addr) KEY SWAP C! \ WAIT for 1st Char & store READCOM ; \ extract a line from buffer delimited by ^M (0D) : /LINE ( addr len -- str1 len1 ) 2DUP ^M SCAN NIP - 0 MAX ; : NEXTLINE ( addr len -- remainder len line len ) 2DUP /LINE 2SWAP 2 PICK 1+ /STRING 2SWAP ; .( .) : SAVE-BUFFER ( buffer len -- ) LINES OFF BEGIN DUP -1 <> WHILE NEXTLINE FHNDL @ WRITE-LINE ?FILERR LINES 1+! REPEAT FHNDL DUP @ CLOSE-FILE ?FILERR OFF DROP DECIMAL CR LINES @ . ." lines saved" ; .( .) : UPLOAD ( -- addr len) 8K DUP H ! \ START of HEAP=>2000 CR ." Erasing 8K HEAP" HEAP 8K 2DUP ERASE CR ." Send TEXT file now..." STRAIGHT ( -- bytes-recd) \ get data CR ." Upload complete" DECIMAL CR DUP . ." bytes received." ; .( .) : SAVETTY ( file len -- ) \ s" dsk1.test" SAVE CR ." Opening file..." DV80 R/W CREATE-FILE ?FILERR FHNDL ! \ create the file UPLOAD ( addr len --) CR ." Saving buffer..." SAVE-BUFFER CR ." Save complete" DROP ; COM1_9600bps - CAMEL99 Forth Terminal VT 2020-02-06 20-07-17.mp4 Edited February 7, 2020 by TheBF 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted February 8, 2020 Author Share Posted February 8, 2020 So I bit the bullet I ventured into the world of YouTube Channels. I know next to nothing about it but I thought it would help save space on the Atariage servers if I maintained the videos somewhere else. So over time I will be adding videos about the system and the cross-compiler just in case there is someone in the universe who might desperately need to know this. ? I have re-worked the commands now so that UPLOAD and SAVE can be used independently and it seems to work pretty well. I am chasing one bug that seems to break my file system after I do a large upload and save. I have to restart Forth in order to load the files from disk. So two steps forward and one step back. But its pretty fast and waaay better than swapping carts and disks to use magic file utility, albeit I cannot transfer program files yet. This is making me wonder about coding an Xmodem protocol that would allow real file transfers from within Forth. Hmmm... So without further "adieu" here is the first entry on the CAMEL99 Forth channel 4 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted February 10, 2020 Author Share Posted February 10, 2020 An Alternative Way to Compile Code Apologies in advance. This is bit long but perhaps some will find it interesting. I wanted to understand this 30 years ago. As anyone who has tried to write a compiler knows, it is not a trivial project. The conventional way compilers operate can be understood as a sequence of steps that refine the original text of the source code to something the machine can run. The textbook set of steps for a modern compiler are: Lexical analyzer ( extract language tokens, remove white-space & comments) Syntax analyzer ( check if syntax is correct Semantic analyzer (extract the meaning) Intermediate code generator ( code for a virtual machine) Code Optimizer ( make it smaller, faster) Target code generation ( Make code for the target CPU) The results, in the case of C, with an assembly language program that is further processed by the assembler and the then by the linker. After all that you get a binary to run on your computer. Simple right? While away I was reading some blogs by Samuel Falvo and I found some work he did for the new RISC-V CPU. https://kestrelcomputer.github.io/kestrel/2015/03/11/why-not-machine-forth RISC-v is a pure RISC machine with a far simpler instruction set that the 9900. Samuel had ported an invention of Charles (Chuck) Moore's called "machine forth". I knew what it was in theory but I had never seen a complete implementation. He had instructions for both x86 and RISC-V and is contrasting the challenges of implementing machine Forth on this slightly more obtuse RISC-V machine. It wasn't a good fit but it made me realize the 9900 was a pretty good candidate. What is machine Forth? It was created around the time that Chuck Moore started building CPUs modelled after the Forth virtual machine. The original Forth CPUs were very simple per Chuck Moore's philosophy on computers. They typically consisted of: Program counter register (PC) Data stack register Return stack register Top of stack register (TOS) Next on stack register (NOS) 'A' register (later designs) In later research Chuck found it handy to also include a scratch register he called 'A' for caching addresses. The CPUs he designed typically had about 30 instructions or so. From what I can see, his work on CPUs influenced his thinking on Forth programs because I noticed machine Forth appears around this time and it seems to emulate those simple CPUs. So using Sam Falvo's examples I made 9900 code that adds Machine Forth to the TI-FORTH Assembler. It is just a set of macros that compile one, two or three instructions into memory for each keyword. (keywords end in a comma to prevent name conflicts with Forth words) The big difference with Machine Forth and standard Forth is that the language primitives do not automatically DROP items off the stack for you. The big one is with IF. Conventional Forth IF takes value from the top of stack and if it is 0, it jumps to a label called THEN or in this case ENDIF. Standard IF cleans that value off the stack for you. Machine Forth does not because Chuck realized that many times you want that value later in the code so you DROP if and when you need to. Full Disclosure: This is not "pure" machine Forth. I did not implement the branching and looping per the Machine Forth method. Machine Forth uses only two instructions to make branching and looping. IF branch if top of stack is <> 0 -IF branch if top of stack = 0 ( called NOT IF) I am using the TI-Forth assembler code for this purpose for convenience. I also am running this from within CAMEL99 Forth. It is possible to make a Forth interpreter in Machine Forth from the ground up. I will put the code and a short example program in the next post. 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted February 10, 2020 Author Share Posted February 10, 2020 9900 Machine Forth (with a little cheating) Here is the example Machine Forth program: M: LOOPER FFFF #, \ put a literal into TOS register BEGIN, \ mark point to jump back to 1-, \ dec TOS register 0=, UNTIL, \ loop until TOS=0 DROP, \ drop the TOS (refill from stack) ;M Here is the code that it created (thanks Tursi) with added comments \ generated code D258 0646 dect R6 ; make room on stack D25A C584 mov R4,*R6 ; push TOS reg to stack D25C 0204 li R4,>ffff ; load TOS with FFFF FFFF D260 0604 dec R4 ; dec TOS D262 16FE jne >d260 ; D264 C136 mov *R6+,R4 ; drop TOS D266 045A b *R10 ; run Forth And here is an un-tested Machine Forth for 9900 on Camel99 Forth. (TOS is alias for R4 in Camel99 Forth) \ TMS9900 machine Forth Extensions for CAMEL99 Assembler NEEDS MOV, FROM DSK1.ASM9900 \ For this demo, R13 is the 'A' register (address register) : *R13+ R13 *+ ; \ make it look like TI Assembler :) \ OPCODE # Shown for reference to original document ( 0) : [;] @@ B, ; \ 0 Jump to word ie: tail recursion ( 2) : CALL, ( label -- ) \ call a label R11 RPUSH, ( label) @@ BL, R11 RPOP, ; ( 26) : DUP, ( n -- n n) TOS PUSH, ; \ Dup TOS -or- make room for new ( 10) : #, ( n -- ) DUP, TOS SWAP LI, ; \ compile literal number ( 8) : @, ( addr -- n) #, *TOS TOS MOV, ; \ Fetch from address on stack ( 30) : DROP, ( n -- ) *SP+ TOS MOV, ; \ Discard TOS; (refills TOS) ( 9) : @+, ( -- n) DUP, *R13+ TOS MOV, ; \ Fetch address in A; A++ ( 11) : @R, ( -- n ) DUP, *RP TOS MOV, ; \ Fetch from address in R ( 29) : A!, ( addr -- ) TOS R13 MOV, ; \ Store stack into A register ( 12) : !, ( n addr -- ) \ Store to address on stack A!, \ update A register per machine Forth norm *SP+ R13 ** MOV, \ pop n into address in 'A' register DROP, ; \ refill TOS from stack memory ( 14) : !+, ( n -- ) TOS *R13+ MOV, ; \ Store to address in A; increment A ( 15) : !R, ( n -- ) TOS *RP+ MOV, ; \ Store to address in R; increment R ( 16) : 2*, ( n -- n ) TOS 1 SLA, ; \ Shift stack left ( 17) : 2/, ( n -- n) TOS 1 SRA, \ Shift stack right, propagate sign ( 18) : -, ( n -- ) TOS INV, ; \ Ones complement stack ( 19) : AND, ( n mask -- n) *SP INV, *SP+ TOS SZC, ; \ (option 1) And to # on stack ( 19b) : #AND, ( n n -- n ) TOS SWAP ANDI, ; \ (option 2 ) AND with a literal ( 21) : XOR, ( n n -- n) *SP+ TOS XOR, ; \ Exclusive-or to stack (option 1) ( 22) : +, ( n n -- n) *SP+ TOS ADD, ; \ Add to stack (option 1) ( 22b) : #+, ( n n -- ) TOS SWAP AI, ; \ (option 2) Compile n into code. ( 24) : PUSH, ( n -- ) TOS RPUSH, ; \ Push stack onto Return (DUP >R) ( 25) : A, ( -- addr) DUP, R13 TOS MOV, ; \ Put A register onto stack ( 27) : OVER, ( n1 n2 -- n1 n2 n1) DUP, 2 (SP) TOS MOV, ; ( 28) : POP, ( -- n) DUP, TOS RPOP, ; \ Pop Return onto stack (R>) ( 29) : A!, ( addr -- ) TOS R13 MOV, DROP, ; \ Store stack into A register ( 31) : NOP, ( -- ) 0 JMP, ; \ short delay for hardware ( 32) : NIP, ( n1 n2 -- n2) SP INCT, ; \ DROP 2nd stack item \ 9900 extras by BF : 1+, ( n -- n') TOS INC, ; : 2+, ( n -- n') TOS INCT, ; : 1-, ( n -- n') TOS DEC, ; : 2-, ( n -- n') TOS DECT, ; \ ================================================================ \ label creators : SUB: CREATE ; \ CREATE a sub-routine label : ;SUB RT, ; \ compile Return psuedo instruction : M: CODE ; \ create CODE routine label : ;M NEXT, ENDCODE ; \ compile code to return to Forth, check for errors \ change names of assembler comparisons : 0=, EQ ; : 0<>, NE ; : >=, GTE ; : <=, LTE ; : >, GT ; : <, LT ; 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted February 12, 2020 Author Share Posted February 12, 2020 LOL. I thought getting the TI-99 to swallow RS232 data reliably at 9600 baud would be hard. I had to work a little harder than I realized to reliably save a buffer to a DV80 file on floppy disk. It turns out the old girl really really really doesn't like it if you write a control character like a carriage return into a DISPLAY file. :) I don't have a way to handshake the PC to stop sending so I don't try do any processing. I might miss something. I just put each byte into the next byte in the buffer. When you send text from a PC to buffer in the TI-99 the lines are of random length. This can put the start of a record on the "wrong byte"... The solution for me was to cut the line of text from the big buffer and copy it to a cleared temp buffer. This gave me a clean string starting on a even address. Seems to work much better. I used the opportunity to test for empty lines and replaced them with a null string, the kind TI-99 uses in DV80 files. (A string with length=1 and the content is a binary zero) Here is the new version of the code to save the big buffer. NEXTLINE chomps through the buffer returning both the next line and leaving the remainder of the buffer on the stack for the next execution of NEXTLINE. The end user word is SAVE. \ extract a line from buffer delimited by ^M (>0D) : /LINE ( addr len -- str1 len1 ) 2DUP ^M SCAN NIP - 0 MAX ; : NEXTLINE ( addr len -- addr' len' record len ) 2DUP /LINE 2SWAP 2 PICK 1+ /STRING 2SWAP ; : MASSAGE ( addr len -- addr' len') DUP 0= IF 2DROP PAD DUP OFF 1 \ return a null string ELSE PAD 60 ERASE \ fill pad with zeros PAD PLACE \ write data to PAD, aligns string, strips ^m PAD COUNT \ return stack string THEN ; .( .) : SAVE-BUFFER ( buffer len -- ) LINES OFF BEGIN NEXTLINE MASSAGE #1 WRITE-LINE ?FILERR LINES 1+! DUP 0= \ test remaining buffer length UNTIL 2DROP DECIMAL CR LINES @ . ." lines saved" ; .( .) : SAVE ( addr len -- ) \ S" DSK1.TESTFILE" SAVE DUP ?FILE RCVD 0= ABORT" BUFFER empty. Nothing to save" CR ." Opening file..." DV80 R/W CREATE-FILE ?FILERR TO #1 CR ." Saving buffer..." COMBUFF RCVD SAVE-BUFFER CR ." Save complete" CR ." Closing file" #1 CLOSE-FILE ?FILERR 0 TO #1 BUFFSIZE MFREE 0 TO RCVD ; 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted February 14, 2020 Author Share Posted February 14, 2020 I've said it before, but dam this is humbling pass-time! I got this uploader working but had real reliability troubles. I was sidetracked into thinking it had something to do with larger files. (>2K bytes) Well... that was not the problem. The problem was that I was not making a proper "newline" in the file. Turns out that I need to write a string with "blank" as Forth calls it with length of 1. In ANS FORTH that is just: S" " (Forth the non-forther the 1st space delimits the keyword S" the next space is the payload of the string, which is ended with the double quote. It's not a mistake) So when I encounter an empty string in the buffer, I just throw it away and replace it with that string. (see -NULLS) I decided to stop the madness with using malloc and releasing memory. The program just assumes it has the Low RAM buffer for itself. And I did something I've never done before. Using a colon definition to create a kind of union on the data buffer. : RCVBUFFER ( -- addr len) 8K BUFFSIZE ; : OUTBUFFER ( -- addr len) 8K RCVD ; 8K is just a constant that is the top of LOW RAM (>2000). But for receiving the length returned is the buffer size. For sending it to disk, we use the RCVD value which holds the number of bytes we got from the PC file that was "uploaded". It reads much better and never screws up. Of course it got much simpler once I understood things properly. So with this code I can upload an 8K file in seconds and save it to disk in few more seconds and nothing seems to blow up now. ( the CODE words are machine code so the utility doesn't need the assembler to compile) \ TTY UPLOAD Utility for text files. v1.0 WORKS OK \ Accept chars into a buffer with no echo at 9600 bps, no delays, save to file \ *** THIS VERSION USES THE ENTIRE 8k LOW RAM AS BUFFER *** NEEDS DUMP FROM DSK1.TOOLS NEEDS MARKER FROM DSK1.MARKER NEEDS OPEN-FILE FROM DSK1.ANSFILES NEEDS VALUE FROM DSK1.VALUES CR .( Compiling UPLOAD Utility ) MARKER REMOVE .( .) HEX 000D CONSTANT ^M 2000 CONSTANT 8K 1FF0 CONSTANT BUFFSIZE 0 VALUE #1 0 VALUE RCVD : RCVBUFFER ( -- addr len) 8K BUFFSIZE ; : OUTBUFFER ( -- addr len) 8K RCVD ; : ERASE ( addr len --) 0 FILL ; HEX .( .) CREATE ALLDONE \ branch here to exit readcom 020C , 1300 , 1E07 , C337 , 0300 , 0002 , C101 , NEXT, .( .) HEX CODE READCOM ( addr n -- n' ) 0300 , 0000 , 0647 , C5CC , 020C , 1300 , 1D07 , C320 , PORT , C236 , A108 , 0700 , 04C1 , 1F15 , 1605 , 3638 , 1D12 , 0700 , 0581 , 1004 , 0600 , 1602 , 0460 , ALLDONE , 8108 , 16F3 , 0460 , ALLDONE , .( .) DECIMAL \ STRAIGHT from PolyForth. Read n chars into addr or timeout : STRAIGHT ( addr len -- n) 1 /STRING OVER 1- ( -- addr+1 len' addr) KEY SWAP C! \ WAIT for 1st Char & store READCOM ; .( .) : UPLOAD ( -- ) CR ." Erasing buffer" RCVBUFFER ERASE CR ." Send TEXT file now..." RCVBUFFER STRAIGHT TO RCVD DECIMAL CR ." Upload complete, " RCVD . ." bytes received." CR ." Press enter a few times to see OK" ; \ extract a line from buffer delimited by ^M (0D) : /LINE ( addr len -- str1 len1 ) 2DUP ^M SCAN NIP - 0 MAX ; : NEXTLINE ( addr len -- remainder len line len ) 2DUP /LINE 2SWAP 2 PICK 1+ /STRING 2SWAP ; : -NULLS ( addr len -- addr' len') DUP 0= IF 2DROP S" " THEN ; \ replace with a null string .( .) : WRITE-FILE ( buffer len -- ) LINES OFF BEGIN DUP -1 > WHILE NEXTLINE -NULLS #1 WRITE-LINE ?FILERR LINES 1+! REPEAT S" " #1 WRITE-LINE ?FILERR 2DROP ; .( .) : SAVE ( addr len -- ) \ S" DSK1.TESTFILE" SAVE DUP ?FILE RCVD 0= ABORT" OUTBUFFER empty" DV80 R/W CREATE-FILE ?FILERR TO #1 CR ." Saving buffer..." OUTBUFFER WRITE-FILE CR ." Save complete" DECIMAL CR LINES @ . ." lines saved" CR ." Closing file" #1 CLOSE-FILE ?FILERR 0 TO #1 ; 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted February 15, 2020 Author Share Posted February 15, 2020 (edited) There is nothing that spruces up your code like being forced to use it yourself. I been ignoring a few weird bugs in my ANS Forth file words. I was pretty sure it was in the file handle server and selection system. I had not put much effort into error prevention and detection so it was not a surprise. I believe the system is now much better due to two simple fixes. Consider any problem to be a FATAL error and reset all the ]FID array values to zero when we abort back to Forth. The ]FID array takes a handle and returns a PAB. Put error detection on ]FID and do a FATAL ABORT on an invalid handle The new word FATAL resets the file I.D.s (FIDS) and returns a TRUE flag so it can be used with ABORT" . Code is below CREATE FIDS ( -- addr) 0 , 0 , 0 , 0 , 0 , : FATAL ( -- true) FIDS #FILES @ CELLS 0 FILL TRUE ; : ?HNDL ( n -- ) #FILES @ 1+ 1 WITHIN IF FATAL ABORT" Bad handle" THEN ; : ]FID ( hndl -- PAB_addr ) DUP ?HNDL CELLS FIDS + ; I decided I needed more insight into what happened when there was a file error. This is harder to get at on real iron so I added the word DUMP] which works with the word [PAB. [PAB returns the VDP address of the PAB in use. So [PAB DUMP] gives you a report on the file in use. I needed a couple of VDP string words to make this happen. I re-wrote the ?FILERR word to incorporate these changes and so far the file system seems rock solid. (With a user base of 1) : VCOUNT ( vdp$adr -- vdpadr len ) DUP 1+ SWAP VC@ ; : .FNAME ( padaddr -- ) FNAME] VCOUNT BOUNDS DO I VC@ EMIT LOOP ; : DUMP] ( vaddr -- ) \ dump contents of a PAB DUP >R HEX CR ." PAB:" . ." FAM=" R@ FLG] VC@ 1F AND . ." Rec#=" R@ REC#] V@ . ." Fstat= " R@ STAT] VC@ . CR ." Dev: " R> .FNAME ; : ?FILERR ( ior -- ) ?DUP IF CR CR ." Err# " . ." Hndl=" LASTH @ . [PAB DUMP] FATAL ABORT" All files closed" THEN ; I might remove the dump to save space in the future. This file already compiles to over 1,300 bytes much of which is due to words used to emulate TI-BASIC file description words. For example than rather than saying all this to use a DV80 file... UPDATE DISPLAY SEQUENTIAL 50 VARI I could replace it with... HEX : DV80 14 FAM ! ; \ set file access mode for DV80 R/W text files I could write a few descriptors like this for the commonly used file types and save a lot of memory. And so it goes... Keep the Forth \ Ansfiles for Camel99 v2.1 bjf Feb 2020 HERE CR .( ANS Files V2.1 ..) HEX VARIABLE #FILES VARIABLE LASTH CREATE FIDS ( -- addr) 0 , 0 , 0 , 0 , 0 , : FATAL ( -- true) FIDS #FILES @ CELLS 0 FILL TRUE ; : ?HNDL ( n -- ) #FILES @ 1+ 1 WITHIN IF FATAL ABORT" Bad handle" THEN ; : ]FID ( hndl -- PAB_addr ) DUP ?HNDL CELLS FIDS + ; : NEWHNDL ( -- hndl) 0 BEGIN 1+ DUP ]FID @ WHILE REPEAT ; : NEWPAB ( hndl -- ) DUP PSZ * VDPTOP SWAP - ( -- addr hndl) SWAP ]FID ! ; : RELEASE ( hndl -- ) ]FID OFF ; : SELECT ( hndl -- ) DUP ]FID @ ^PAB ! LASTH ! ; : VCOUNT ( vdp$adr -- vdpadr len ) DUP 1+ SWAP VC@ ; : .FNAME ( padaddr -- ) FNAME] VCOUNT BOUNDS DO I VC@ EMIT LOOP ; : DUMP] ( vaddr -- ) \ dump contents of a PAB DUP >R HEX CR ." PAB:" . ." FAM=" R@ FLG] VC@ 1F AND . ." Rec#=" R@ REC#] V@ . ." Fstat= " R@ STAT] VC@ . CR ." Dev: " R> .FNAME ; : ?FILERR ( ior -- ) ?DUP IF CR CR ." Err# " . ." Hndl=" LASTH @ . [PAB DUMP] FATAL ABORT" All files closed" THEN ; : FILES ( n -- ) DUP 3 > ABORT" too many files" #FILES ! ; .( ..) VARIABLE FAM : AND! ( mask addr -- ) TUCK @ AND SWAP ! ; : OR! ( mask addr -- ) TUCK @ OR SWAP ! ; \ TI-99 file access mode modifiers 2 BASE ! \ *ctrl bits* : DISPLAY ( -- ) 11110111 FAM AND! ; : SEQUENTIAL ( -- ) 11111110 FAM AND! ; : RELATIVE ( -- ) 00000001 FAM OR! ; : UPDATE ( -- ) 11111001 FAM AND! ; : INPUT ( -- ) UPDATE 00000100 FAM OR! ; : OUTPUT ( -- ) UPDATE 00000010 FAM OR! ; : APPEND ( -- ) 00000110 FAM OR! ; VARIABLE B/REC : VARI ( size -- fam) B/REC ! 00010000 FAM OR! ; : FIXED ( size -- fam) B/REC ! 11101111 FAM AND! ; .( ..) HEX : R/W ( -- fam) UPDATE FAM @ ; : R/O ( -- fam) INPUT FAM @ ; : W/O ( -- fam) OUTPUT FAM @ ; \ ANS Forth BIN replaces TI-99 "INTERNAL" : BIN ( fam -- fam') 8 OR ; : DV80 ( -- ) UPDATE DISPLAY SEQUENTIAL 50 VARI ; .( ..) HEX : OPEN-FILE ( $addr len fam -- fid ior) ( fam) DUP FF00 AND OVER 0= OR ABORT" Bad file mode" -ROT DEPTH 3 < ABORT" OPEN-FILE args" NEWHNDL DUP >R DUP NEWPAB ( hndl) SELECT ( fam $adr len) INITPAB ( fam) [PAB FLG] VC! B/REC @ [PAB RECLEN] VC! B/REC OFF 0 FILEOP ( -- err#) DUP IF R> RELEASE 0 SWAP ELSE R> SWAP THEN ; .( ..) : CLOSE-FILE ( fid -- ior) DUP SELECT 1 FILEOP SWAP RELEASE ; : EOF ( fid -- c) SELECT (EOF) ; : CREATE-FILE ( caddr len fam -- fid ior ) F9 AND OPEN-FILE ; : FILE-POSITION ( fid -- rec# ior) SELECT [PAB REC#] V@ [PAB FLG] VC@ ; : REPOSITION-FILE ( rec# fid -- ior) SELECT [PAB REC#] V! 4 FILEOP ; : DELETE-FILE ( caddr len -- ior) OPEN-FILE 7 FILEOP SWAP CLOSE-FILE OR ; .( ..) : READ-LINE ( addr u1 fid -- u2 flag ior ) NIP SELECT 2 FILEOP ?DUP IF NIP 0 FALSE ROT EXIT THEN ( -- addr ) [PAB CHARS] VC@ TUCK [PAB FBUFF] V@ -ROT VREAD (EOF) 0= 0 ; : WRITE-LINE ( c-addr u fileid -- ior ) SELECT DUP [PAB CHARS] VC! [PAB FBUFF] V@ SWAP VWRITE 3 FILEOP ( -- ior) ; \ =================================== 3 FILES \ set the #FILES now DECIMAL CR .( Max files set to ) #FILES @ . CR HERE SWAP - . .( bytes used) HEX Edited February 15, 2020 by TheBF Added spoilers 2 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted February 15, 2020 Share Posted February 15, 2020 I have often thought of doing something similar to this for fbForth, but opted in favor of compatibility with TI Forth. One day I may still do it, but, more likely, as an adjunct rather than a replacement—something loadable from FBLOCKS, perhaps. ...lee Quote Link to comment Share on other sites More sharing options...
+TheBF Posted February 15, 2020 Author Share Posted February 15, 2020 (edited) Your holding to the intent of TI-Forth is a very valid specification IMHO. It still make the most sense to use blocks on these little machines. My editor project is showing me how much more involved a text file editor is than a block editor. This handle file system been a good exercise for me and of course I don't have much choice since the my system is supposed to depend on files. It gives me much deeper appreciation for what's involved in a bigger shell program but it's also cool to see how to do it with less resources. I have not attempted to access the file card sub-programs to date, but I must confess it intrigues me to try and create a DOS like file system on raw sectors. I hardly seems worth it though without a bigger drive. I really should investigate a way to get a hard drive on the old machine. Edited February 15, 2020 by TheBF typo Quote Link to comment Share on other sites More sharing options...
+TheBF Posted February 15, 2020 Author Share Posted February 15, 2020 I gotta run but I just found out I can receive 9600bps into a buffer OVER RS232 without using Assembly language. Pretty cool! Not fully tested for errors but the printed text looks correct. \ STRAIGHT in Forth : CKEY ( -- char) BEGIN CKEY? ?DUP UNTIL ; HEX : TIMEKEY ( wait-time -- 0 | c ) \ waits for a key until counter hits zero BEGIN 1- DUP WHILE CKEY? ?DUP IF NIP EXIT THEN REPEAT ; VARIABLE RCVD : STRAIGHT ( addr len -- n) RCVD OFF OVER >R 1 /STRING BOUNDS ( -- end start) R> ( -- end start addr) CKEY SWAP C! ( -- ) DO 2000 TIMEKEY DUP 0= IF LEAVE THEN I C! RCVD 1+! LOOP DROP RCVD @ ; 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted February 16, 2020 Author Share Posted February 16, 2020 I have removed the gratuitous variable RCVD and simply count the bytes on the data stack. This makes the loop even a bit quicker and saves 12 bytes too. \ STRAIGHT in Forth. Rcv bytes into buffer, no echo. bjf Feb 2020 HERE : CKEY ( -- char) BEGIN CKEY? ?DUP UNTIL ; HEX : TIMEKEY ( wait-time -- 0 | c ) \ waits for a key until counter hits zero BEGIN 1- DUP WHILE CKEY? ?DUP IF NIP EXIT THEN REPEAT ; : STRAIGHT ( addr len -- n) 0 -ROT \ char counter under address OVER >R \ save the 1st buffer location 1 /STRING BOUNDS ( -- end start) R> ( -- end start addr) CKEY SWAP C! \ wait for 1st key & store DO 2000 TIMEKEY DUP 0= IF DROP LEAVE THEN I C! 1+ LOOP ; HERE SWAP - SPACE DECIMAL . .( bytes) HEX Yesterday I partitioned this file uploader project into two files. STRAIGHT.FTH which is the rs232 reader and UPLOAD.FTH which provides the disk words UPLOAD and SAVE. I tested the Forth version of STRAIGHT by sending my ASM9900.FTH file with no delays into the TI-99. ( 6378 bytes) Then I TYPEed the buffer contents to the terminal so it was on the screen in the Teraterm buffer, I copied the terminal screen into the clipboard and pasted the text back into my editor Then pasted the resulting text back into the TTY Forth at slow speed. If any characters would have been missing there would have been compile time errors. There was not. I then UPLOADed the new STRAIGHT Forth version to ti-99 buffer and saved it to floppy disk. Then I loaded that saved file into CAMEL99 Forth with INCLUDE. It also compiled perfectly. So even without disabling interrupts I seem to be getting all the characters over the com port into the buffer. Not sure why but it works. If there was ever a problem I could write a small word to do LIMI 0 in Forth but so far it seems to work. Curiously both versions of STRAIGHT, the code version and the Forth version, compile to 132 bytes. However the Forth version does not turn on the RS232 board LED so it would be a bit bigger if I did that. Yet another attestation to the power of the 9900 instruction set. 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted February 16, 2020 Author Share Posted February 16, 2020 (edited) Adding the LED control in Forth doubles the size of the compiled code. And I cheated a bit by using machine code versions to flip the bit on and off. It is kind of neat that I can access registers in any Forth's workspace with CAMEL99 Forth as user variables. That's because these USER variables are relative to the workspace pointer (WP) in the CPU so the first 16 are the workspace registers. EDIT: The reason I am not missing characters is because CKEY? in the kernel code disables interrupts when it starts, keeps them off until it has tested for a key and stored the result in the TOS register. So in a tight loop like TIMEKEY there is very little time for an interrupt to occur. It is possible but not likely at 9600bps because a new character is received every millisecond. \ STRAIGHT in Forth. Rcv bytes into buffer, no echo. bjf Feb 2020 HERE DECIMAL 12 2* USER 'R12 \ register 12 is a user variable :) HEX CODE 7SBO 1D07 , NEXT, ENDCODE CODE 7SBZ 1E07 , NEXT, ENDCODE : LEDON 'R12 @ RS232/1 'R12 ! 7SBO 'R12 ! ; : LEDOFF 'R12 @ RS232/1 'R12 ! 7SBZ 'R12 ! ; : CKEY ( -- char) BEGIN CKEY? ?DUP UNTIL ; HEX : TIMEKEY ( wait-time -- 0 | c ) \ waits for a key until counter hits zero BEGIN 1- DUP WHILE CKEY? ?DUP IF NIP EXIT THEN REPEAT ; : STRAIGHT ( addr len -- n) LEDON 0 -ROT \ char counter under address OVER >R \ save the 1st buffer location 1 /STRING BOUNDS ( -- end start) R> ( -- end start addr) CKEY SWAP C! \ wait for 1st key & store DO 2000 TIMEKEY DUP 0= IF DROP LEAVE THEN I C! 1+ LOOP LEDOFF ; HERE SWAP - SPACE DECIMAL . .( bytes) HEX Edited February 16, 2020 by TheBF 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted February 23, 2020 Author Share Posted February 23, 2020 (edited) I think I found a faster C! for my Forth. So far it's working... Old version used a SWPB instruction. CODE: C! ( c addr -- ) *SP SWPB, *SP *TOS MOVB, SP INCT, TOS POP, NEXT, END-CODE New one just reads memory with indexed addressing CODE: C! ( c addr -- ) 1 (SP) *TOS MOVB, SP INCT, TOS POP, NEXT, END-CODE One less instruction is always good on the 9900. Edit just checked and this is how FbForth does it. No prize for me. Edited February 23, 2020 by TheBF 1 1 Quote Link to comment Share on other sites More sharing options...
Like us on Facebook
Follow us on Twitter
AtariAge on Instagram
Watch us on YouTube
Chat on Discord
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.