+TheBF Posted April 28, 2019 Author Share Posted April 28, 2019 I tried this in Classic99 from Editor/Assembler and it worked fine until I got a mouse or bit my own tail, then it just hung on the sound effect. Do I need a different runtime environment? Lee just found the same bug with the 9901 timer again in the latest CLASSiC99. It works perfectly in the earlier version that I was using, which you fixed for me a while back. Anywhere in the code that I delay, I am using the 9901. I gave Lee an Experimental build that just polls the random number seed for a change as a 1/60 timer and it works with the latest CLASS99. I am considering removing the 9901 code to make things easier in the emulator world. :-) B Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted April 28, 2019 Share Posted April 28, 2019 Lee just found the same bug with the 9901 timer again in the latest CLASSiC99. It works perfectly in the earlier version that I was using, which you fixed for me a while back. Anywhere in the code that I delay, I am using the 9901. I gave Lee an Experimental build that just polls the random number seed for a change as a 1/60 timer and it works with the latest CLASS99. I am considering removing the 9901 code to make things easier in the emulator world. :-) B CAMEL99X (latest build) appears to be working. It gets to the cyan screen and blinking cursor. Hitting ‘Enter’ returns ‘ok’. I have not had any time to go further. I will report back later. ...lee Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 28, 2019 Author Share Posted April 28, 2019 Got to My first destination so I checked in. That's good news for me. FYI the cyan screen is set in DSK1.START file with VWTR command. Make if what you like. It turns out that making a millisecond timer by reading >8379 saves 70+ bytes versus using the 9901 and ALC, so I think I will go with the small option and keep 9901 timer in a lib file. 1 Quote Link to comment Share on other sites More sharing options...
Tursi Posted April 28, 2019 Share Posted April 28, 2019 Lee just found the same bug with the 9901 timer again in the latest CLASSiC99. It works perfectly in the earlier version that I was using, which you fixed for me a while back. Anywhere in the code that I delay, I am using the 9901. I gave Lee an Experimental build that just polls the random number seed for a change as a 1/60 timer and it works with the latest CLASS99. I am considering removing the 9901 code to make things easier in the emulator world. :-) B I wouldn't remove it. It would be better if the emulators were correct. Can I see your 9901 code? (/Just/ the 9901 part please.) And it 100% definitely works on hardware? Lees code and the cassette interface seem to conflict a bit... fixing one breaks the other. But when I fixed cassette I couldn't find Lee's issue to retest that. Your code might be the tiebreaker that fixes my understanding Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 28, 2019 Author Share Posted April 28, 2019 Here is the guilty code: https://github.com/bfox9900/CAMEL99/blob/master/CCLIB/TICKTOCK.HSF TMR! loads the timer and leaves it running. TMR@ reads it TOS is R4 W is R8 That's it. It's been running fine on my TI 99 with PEB and Sams card. Quote Link to comment Share on other sites More sharing options...
+mizapf Posted April 28, 2019 Share Posted April 28, 2019 I tried this in Classic99 from Editor/Assembler and it worked fine until I got a mouse or bit my own tail, then it just hung on the sound effect. Do I need a different runtime environment? Identical effect in MAME. Quote Link to comment Share on other sites More sharing options...
+mizapf Posted April 28, 2019 Share Posted April 28, 2019 I tried some debugging, and I found that location B082 (looks like the location on TMR!) is never reached. Hence, the clock_register in the 9901 is 0. Location B0A8 (where TMR@ is located) is reached, however. Quote Link to comment Share on other sites More sharing options...
Tursi Posted April 29, 2019 Share Posted April 29, 2019 It does run on hardware, I'm in the process of working out why. I've figured out my Classic99 timer setup bug, and I'm satisfied I finally understand that. But Classic99 never sees an initialization of the timer (as Mizapf detected). I tried causing that to make the clock wrap around to 0x3fff every loop, and that works but the timing is not the same as hardware. Quote Link to comment Share on other sites More sharing options...
Tursi Posted April 29, 2019 Share Posted April 29, 2019 I wrote and ran the attached program on a console fresh from boot (I started it in Easy Bug). It displays two values - the first is the current value of the timer (same as TMR@ code above). The second is the largest timer value read. This program confirms that hardware starting from nothing counts continuously from 0x3FFF down to 0. Now whether it's counting because the reload register defaults to 0x3FFF or it's wrapping around from zero - that I can't tell with this test. But it does show that at powerup the 9901 does not get stuck at zero. AORG >A000 LIMI 0 clr r6 li r7,>2000 LP CLR R12 SBO 0 * enter timer mode stcr r5,15 * get timer plus mode srl r5,1 * ditch mode sbz 0 * timer off c r5,r6 * save the highest value jl j1 mov r5,r6 j1 clr r0 movb r0,@>8c02 movb r0,@>8c02 * VDP address 0 (increments for read) mov r5,r0 bl @dig * print current movb r7,@>8c00 * space mov r6,r0 bl @dig * print highest jmp lp * print a hex value from r0 dig mov r0,r1 srl r1,12 movb @hex(r1),@>8c00 mov r0,r1 srl r1,8 andi r1,>000f movb @hex(r1),@>8c00 mov r0,r1 srl r1,4 andi r1,>000f movb @hex(r1),@>8c00 mov r0,r1 andi r1,>000f movb @hex(r1),@>8c00 B *R11 hex TEXT '0123456789ABCDEF' END Quote Link to comment Share on other sites More sharing options...
Tursi Posted April 29, 2019 Share Posted April 29, 2019 (edited) (To get back on subject - I would propose that there's a bug in SNAKE that never sets the timer to the value you are expecting - if you ran after something else, for instance, after someone tried cassette operations, behaviour is quite different. (I tried this - it hangs even on hardware if you do an OLD CS1 first, then go load it.)) At the same time, you seem to have unveiled a bug in both our emulators. For my part, I was having trouble understanding exactly when the 9901 was supposed to be reset. I just went through all the 9901 documentation I have again, and summarized it for myself. The docs say "when any value other than 1 is written"... since we write single bit CRU, I interpreted that to mean any write of a '1' value (even though that seemed weird). But CS1 didn't work unless I reloaded the timer on exit from timer mode - which is what broke in both Forth implementations mentioned. It seems that the documentation means "when the timer reload register is non-zero after any write to it", as even zero writes need to reload the timer. Doing THAT (and changing the default from 0 to 0x3fff) made both cassette and snake work. (edit: but in the end, I went back to the default 0 values in the registers, and just rely on the wraparound to handle the count. We need to measure a real console to see what the default is, unless someone has a data sheet that explicitly says so). (Edit: Weird speedup was just a debug artifact, went away when I removed the extra debug from Classic99). Edited April 29, 2019 by Tursi Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 29, 2019 Author Share Posted April 29, 2019 Identical effect in MAME. Interesting. Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 29, 2019 Author Share Posted April 29, 2019 (edited) (To get back on subject - I would propose that there's a bug in SNAKE that never sets the timer to the value you are expecting - if you ran after something else, for instance, after someone tried cassette operations, behaviour is quite different. (I tried this - it hangs even on hardware if you do an OLD CS1 first, then go load it.)) At the same time, you seem to have unveiled a bug in both our emulators. For my part, I was having trouble understanding exactly when the 9901 was supposed to be reset. I just went through all the 9901 documentation I have again, and summarized it for myself. The docs say "when any value other than 1 is written"... since we write single bit CRU, I interpreted that to mean any write of a '1' value (even though that seemed weird). But CS1 didn't work unless I reloaded the timer on exit from timer mode - which is what broke in both Forth implementations mentioned. It seems that the documentation means "when the timer reload register is non-zero after any write to it", as even zero writes need to reload the timer. Doing THAT (and changing the default from 0 to 0x3fff) made both cassette and snake work. (edit: but in the end, I went back to the default 0 values in the registers, and just rely on the wraparound to handle the count. We need to measure a real console to see what the default is, unless someone has a data sheet that explicitly says so). (Edit: Weird speedup was just a debug artifact, went away when I removed the extra debug from Classic99). I don't know if this helps, but here is the COLD word that starts Forth and it run TMR! once. After that I just read the timer twice for a measurement and compare the difference. I only use it for short durations needless to say. I has been very handy for measuring the time of little code routines to compare what is "really" the faster way to do something right from the Forth console. The first use is in the word BEEP which hits the sound chip and then waits for 170 mS, using the TMR@ routine in the JIFFS routine. : COLD ( -- ) 80 83C2 C! \ ISR disable flags: >80 All, >40 Motion, >20 Sound, >10 Quit key ORGDP @ DP ! ORGLAST @ LATEST ! 26 TPAD ! 2000 H ! \ reset the heap LATEST CURRENT ! \ use the existing wordlist TMR! \ set 9901 timer to count continuously 2 KUNIT# C! \ keyboard #2 is the BASIC keyboard T['] <INTERPRET> 'INTERPRET ! \ set the interpreter vector HEX \ set the RADIX to hex \ VDP start screen TEXT BEEP TS" CAMEL99G FAST" TYPE VDPTOP ^PAB ! TS" DSK1.START" INCLUDED \ load the start file CR ABORT ; \ re-start the interpreter Edited April 29, 2019 by TheBF Quote Link to comment Share on other sites More sharing options...
Tursi Posted April 29, 2019 Share Posted April 29, 2019 (edited) I don't know if this helps, but here is the COLD word that starts Forth and it run TMR! once. After that I just read the timer twice for a measurement and compare the difference. I only use it for short durations needless to say. I has been very handy for measuring the time of little code routines to compare what is "really" the faster way to do something right from the Forth console. [/code] I haven't attempted to run Forth, only SNAKE. Snake never sets the timer value. Classic99 is fixed now (though I can't publish a new build yet), it behaves the same as hardware. But I can lock up SNAKE on hardware by going to TI BASIC, typing "OLD CS1", wait for it to timeout. Reset with FCTN-=, go to Editor/Assembler, and run SNAKE, and it will hang when you get something. (Edit: to explain, cassette sets the timer to roughly 15 - if your difference code expects a bigger delta than that, that's probably why it locks up. Anyway it's just good practice to always initialize any hardware you're using.) It's not cassette so much that does it, that's just an easy way to make the timer change. Any other program that sets the timer low will do similar. Anyway, it's not super important since the odds are low that anyone will do it. Edited April 29, 2019 by Tursi Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 29, 2019 Author Share Posted April 29, 2019 I owe everyone an apology. You are of course correct. I was thinking about Lee's lock up problem which does initialize the 9901 timer. I had also unleashed the snake on the world but as you discovered, when I used the Classic99 Build utility I neglected to have the program setup the timer before the game runs. It jumps right into game code and does not run the COLD routine. Duh! I gave you wrong information, but you found the truth of the matter anyway. Very sorry to have sent you down that rabbit snake hole However the timer issue on booting Camel Forth that uses a hardware timer was a valid hunting expedition. I may still revert to an "interrupt based/poll a memory location" timer for the sake of 70 bytes saved and simplicity. That way if I or anyone else uses the hardware timer from a library they more likely to think about loading it first. Thanks again Tursi and Mizapf for your diligence. (I will re-built the snake program correcting the error of my ways. and edit the earlier post I will also make an "autostart" function that will combine initializing everything and setting the boot address into one command.) Murphy's law, sub-section 5: "It's impossible to make anything idiot proof, because idiots are too ingenious" (I'm living proof) 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 29, 2019 Author Share Posted April 29, 2019 Working version of the snake built without using the 9901 timer (Built on CAMEL99X which uses >8379 as a 1/60 second time reference) TISNAKE2.ZIP 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted May 3, 2019 Author Share Posted May 3, 2019 Who knew the BL instruction was so handy? After discovering how to do direct threaded code with the help of the BL instruction I was looking at the old ITC code and I found a way to improve the CREATE DOES> structure of ITC Forth.It saves space and cycles. Using BL to jump to DODOES routine means that the R11 register automatically contains the new IP address that Forth needs to be at to continue running.Previously I had used BRANCH which meant that I needed to move the IP address manually. \ ======================================================================= \ D O E S S U P P O R T : (;CODE) R> \ pop the addr of the code word LATEST @ NFA>CFA \ get the CFA of the latest word ! ; \ store the machine code address in the Code Field : DOES> ( -- ) \ change action of latest def'n COMPILE (;CODE) 06A0 , ['] DODOES , \ compiles machine code for: BL @DODOES ; IMMEDIATE \ Using BL means R11 automatically computes the new IP (IP+4) CODE: DODOES ( -- a-addr) TOS PUSH, \ save TOS reg on data stack W TOS MOV, \ put defined word's PFA in TOS IP RPUSH, \ push old IP onto return stack R11 IP MOV, NEXT, END-CODE 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted May 5, 2019 Author Share Posted May 5, 2019 The 9900 instruction set is soooo good I am doing research on creating a native code compiler for Forth source code. Here is the x86 code for Swift Forth (commercial Forth compiler) to implement the Forth '+!' operation. ( adds n to the contents of a memory location) EBX is a cache for the top of stack value in this implementation. EBP is the Forth DATA stack pointer. ( The x86 stack is used as the return stack in this implementation) code +! 2EBF 0 [EBP] EAX MOV \ get 2nd stack item into EAX 2EC2 EAX 0 [EBX] ADD \ Add EAX to *EBX 2EC4 4 [EBP] EBX MOV \ pop the next 32bit stack value into EBX 2EC7 8 # EBP ADD \ adjust the stack pointer 2ECA RET And here is how I implemented it in 9900 Forth Assembler. (TOS is alias for R4, the top of stack cache for this implementation) CODE: +! ( n addr --) *SP+ *TOS ADD, *SP+ TOS MOV, \ refill TOS register from stack NEXT, END-CODE Granted the x86 does things much faster but 9900 code is so expressive and concise. Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted May 5, 2019 Share Posted May 5, 2019 Regarding TOS— I have undoubtedly missed something already handled in this thread, but What is the meaning of TOS when the stack is empty? Presuming n and addr are the only items on the stack in the code for +! in your post above, what happens to SP and TOS in the “refill TOS register from stack” instruction? It would appear that SP is pointing under the stack and that TOS is meaningless. ...lee Quote Link to comment Share on other sites More sharing options...
+TheBF Posted May 5, 2019 Author Share Posted May 5, 2019 This is the complexity of maintaining a TOS in a register. We always need to pop the contents of the top item of the actual stack into the cache even if it's garbage. if the SP register goes below the bottom it doesn't matter because we don't access that. We use the cache register. You would have to follow the primitives in my system to believe it works ? Quote Link to comment Share on other sites More sharing options...
+TheBF Posted May 10, 2019 Author Share Posted May 10, 2019 Using VDP Memory for Text Intensive programs I was examining a way to make text games in Forth. Oregon Trail was my inspiration to be honest.Forth takes 8K of the upper 24K leaving about 15.5K after adding a few utilities. An interesting text game can use a lot of strings and I had 10K of empty VDP memory just sitting there. Wouldn't it be great if my programming language had an easy way to print text from the VDP memory as easily as from CPU RAM.Well... you can teach Forth how to do it. Forth's text print word is called "dot-quote" and is nice and short like this: ." Print this text" So here we create V." (VDP dot quote) INCLUDE DSK1.VDPMEM \ VDP memory manager lexicon DECIMAL \ compile stack string into VDP memory : VS, ( $adr len-- ) VHERE OVER CHAR+ VALLOT VPLACE ; \ convert a VDP counted string to a stack string : VCOUNT ( vdp$adr -- vdpadr len ) DUP 1+ SWAP VC@ ; \ Print a VDP stack string : VTYPE ( vdp_addr len -- ) BOUNDS ?DO I VC@ EMIT LOOP ; \ Compile a VDP string, that types itself : V." ( -- ) VHERE \ get the next available VDP memory location [CHAR] " PARSE VS, \ compile a string to VDP mem. POSTPONE LITERAL \ compile VHERE as a literal number POSTPONE VCOUNT \ get the length and first char address POSTPONE VTYPE ; \ Type the string from VDP memory. IMMEDIATE And here is how you use V." in a program: : MENU PAGE CR V." *** Main Menu ****" CR CR V." 1. DO Nothing" CR V." 2. DO Something" CR V." 3. Change your mind" CR ; So while the code is still in CPU RAM, the text automagically goes into VDP ram as text with the first byte as the string length. 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted May 13, 2019 Author Share Posted May 13, 2019 (edited) I spent a long time playing around with creating a text game lexicon for Forth to try and make a for of Oregon Trail by Majestyx.It is way harder to make these games than I imagined but I did get some things started. This code uses about 3200 bytes of VDP memory for strings and about 15.9K bytes of CPU RAM for the Forth code. This includes 8k for Forth compiler and 900 bytes or so for the debugging tools. So the game is about 7K. Using a vector table creator It was pretty simple to make random phrase generators. By using the :NONAME word in Forth I didn't have to take up space with word names either if I didn't want to. This could be condensed into a nicer syntax with a little more work. I also liked using the %CHANCE ;CHANCE words to control the game flow. 25 %CHANCE: SHITHAPPENS ;CHANCE 15 %CHANCE: HAPPYDAYS ;CHANCE These make it very easy to modify in the game if it seems to easy or too hard. It's not done yet and I have a lot more respect for everybody who does these things. Even with Oregon Trail as an example it is challenging to make something good. The spoiler will run if run INITS first and then type GAME, but it is not a game yet. Just a test platform. Warning: CAMEL99, CAMEL99G binaries bomb on the latest CLASSIC99. I am using an old version for now. \ ORGEGON TRAIL BY majestyx on Atariage \ RE-WRITE for CAMEL99 Forth for demonstration of \ making a game specific language \ Brian Fox May 13, 2019 INCLUDE DSK1.TOOLS INCLUDE DSK1.RANDOM INCLUDE DSK1.INPUT INCLUDE DSK1.FASTCASE INCLUDE DSK1.CASE INCLUDE DSK1.ENUM INCLUDE DSK1.VDPMEM \ ==================================================== \ VDP string support \ compile stack string into VDP memory : VS, ( $adr len-- ) VHERE OVER CHAR+ VALLOT VPLACE ; \ convert a VDP counted string to a stack string (in DSK1.VDPMEM) \ : VCOUNT ( vdp$adr -- vdpadr len ) DUP 1+ SWAP VC@ ; \ Print a VDP stack string : VTYPE ( vdp_addr len -- ) BOUNDS ?DO I VC@ EMIT LOOP ; \ Compile a VDP string, that types itself : V." ( <tex> ) ?COMP \ for compiling only VHERE [CHAR] " PARSE VS, POSTPONE LITERAL POSTPONE VCOUNT POSTPONE VTYPE ; IMMEDIATE : PRINT." POSTPONE CR POSTPONE V." ; IMMEDIATE \ ========================================= \ G A M E L A N G U A G E DECIMAL : CHOICES, ( addr... addr[n] n -- ) 0 ?DO , LOOP ; \ compile addresses : 3RD ( a b c -- a b c a ) 2 PICK ; \ get a copy of 3rd item on the stack \ text game language extensions : BETWEEN ( n lo hi -- ?) 1+ WITHIN ; : %CHANCE: ( n -- ? ) S" 100 RND > IF" EVALUATE ; IMMEDIATE : ;CHANCE POSTPONE THEN ; IMMEDIATE : ENDIF POSTPONE THEN ; IMMEDIATE \ read #input into a variable and test for limits : VALID-INPUT ( variable lo hi -- n ) BEGIN 3RD DUP #INPUT @ 3RD 3RD BETWEEN \ fetch from variable, check limits UNTIL 2DROP @ ; \ drop limits, fetch variable value HEX : TOUPPER ( c -- c') 5F AND ; DECIMAL : Y/N? ( -- ?) PRINT." Y/N?" KEY TOUPPER [CHAR] Y = ; \ true if Y pressed : .R ( n width -- ) \ print n right justified >R DUP ABS 0 <# #S ROT SIGN #> R> OVER - SPACES TYPE SPACE ; : DEBIT ( n variable -- ) SWAP NEGATE SWAP +! ; : CREDIT ( n variable -- ) +! ; \ set screen color with black letters HEX : CYAN ( -- ) 17 7 VWTR ; : GREEN ( -- ) 13 7 VWTR ; : YELLOW ( -- ) 1B 7 VWTR ; DECIMAL : ROLL-DICE ( -- n ) 12 RND 1+ ; \ Random # 1..12 \ random delay with dot printing : ... ( n -- ) 9 RND CELL+ 0 ?DO [CHAR] . EMIT 250 MS LOOP ; \ ============================================== \ ============================================== \ O R E G O N C O D E S T A R T S H E R E DECIMAL \ game data 700 CONSTANT BUDGET 1847 CONSTANT YEAR VARIABLE TEMP VARIABLE ACCURACY VARIABLE TOTAL \ status variables for the traveller VARIABLE HEALTH VARIABLE OXEN ( HEALTH) VARIABLE OXEN# ( normally 2) VARIABLE FOOD VARIABLE QUALITY VARIABLE AMMO VARIABLE CLOTHES VARIABLE MISC VARIABLE CASH VARIABLE WOUNDED VARIABLE ACTION VARIABLE MILEAGE VARIABLE DAY VARIABLE MONTH 0 ENUM SUN ENUM MON ENUM TUE ENUM WED ENUM THU ENUM FRI ENUM SAT DROP 1 ENUM JAN ENUM FEB ENUM MAR ENUM APR ENUM MAY ENUM JUN ENUM JUL ENUM AUG ENUM SEP ENUM OCT ENUM NOV ENUM DEC DROP : DEBIT-TOTAL ( n -- ) TOTAL DEBIT ; : CREDIT-TOTAL ( n -- ) TOTAL CREDIT ; \ days print themselves : .MON V." Monday" ; : .TUE V." Tuesday" ; : .WED V." Wednesday" ; : .THU V." Thursday" ; : .FRI V." Friday" ; : .SAT V." Saturday" ; : .SUN V." Sunday" ; \ a table of execution addresses of days CASE: DAYS ( n -- ) | .SUN | .MON | .TUE | .WED | .THU | .FRI | .SAT ;CASE \ Months print themselves : MTH1 V." January" ; : MTH7 V." July" ; : MTH2 V." February" ; : MTH8 V." August" ; : MTH3 V." March" ; : MTH9 V." September" ; : MTH4 V." April" ; : MTH10 V." October" ; : MTH5 V." May" ; : MTH11 V." November" ; : MTH6 V." June" ; : MTH12 V." December" ; CASE: MONTHS ( n -- ) | MTH1 | MTH2 | MTH3 | MTH4 | MTH5 | MTH6 | MTH7 | MTH8 | MTH9 | MTH10 | MTH11 | MTH12 ;CASE : "," [CHAR] , EMIT ; : "-" [CHAR] - EMIT ; : .DATE ( -- ) "-" DAY @ DAYS "-" SPACE MONTH @ MONTHS SPACE DAY @ . "," SPACE YEAR . ; : >$< ( -- n ) [CHAR] $ HOLD ; : >.< ( -- n ) [CHAR] . HOLD ; : '00' [CHAR] 0 DUP HOLD HOLD ; : DOLLARS ( n -- ) DUP ABS 0 <# '00' >.< #S >$< ROT SIGN #> TYPE SPACE ; : .BALANCE PRINT." YOU HAVE " TOTAL @ DOLLARS V." left"; : GET_ACCURACY ( -- ) PRINT." How well can you shoot?" PRINT." (1) BEST" PRINT." (2) GOOD" PRINT." (3) FAIR" PRINT." (4) Not sure..." PRINT." (5) BAD" PRINT." (1..5) : " ACCURACY 1 5 VALID-INPUT 25 * ACCURACY ! ; : TEAM ( -- ) CR PRINT." How much do you want to spend" PRINT." on your team of oxen? ($200-$300)" OXEN 200 300 VALID-INPUT ; : GETFOOD ( -- ) PRINT." ON FOOD " FOOD 0 TOTAL @ VALID-INPUT ; : GETAMMO ( -- ) PRINT." ON AMMUNITION " AMMO 0 TOTAL @ VALID-INPUT ; : CLOTHING ( -- ) PRINT." ON CLOTHING " CLOTHES 0 TOTAL @ VALID-INPUT ; : GETMISC ( -- ) PRINT." ON MISC. SUPPLIES " MISC 0 TOTAL @ VALID-INPUT ; : .SUPPLIES CR PRINT." -- Supplies Report-- PRINT." FOOD : " FOOD @ DOLLARS PRINT." BULLETS : " AMMO @ DOLLARS PRINT." CLOTHING : " CLOTHES @ DOLLARS PRINT." MISC. SUPPLIES: " MISC @ DOLLARS PRINT." CASH : " CASH @ DOLLARS PRINT." Health is : " HEALTH ? CR ; : BUYSTUFF PRINT." Let's get you set you for the trip:" TEAM DEBIT-TOTAL .BALANCE GETFOOD DEBIT-TOTAL .BALANCE GETAMMO DEBIT-TOTAL .BALANCE CLOTHING DEBIT-TOTAL .BALANCE GETMISC DEBIT-TOTAL .BALANCE TOTAL @ CASH ! ; : SETUP PRINT." Your budget for the trip is: " BUDGET DOLLARS BUDGET TOTAL ! GET_ACCURACY BUYSTUFF .SUPPLIES 100 HEALTH ! WOUNDED OFF ; \ ===================================================== \ End of game message : SORRY CR PRINT." We are sorry. You didn't make it" PRINT." to the great territory of Oregon." PRINT." We will notify yer kinfolk." CR PRINT." - Sincerely" CR PRINT." The Oregon" PRINT." -Chamber of Commerce-" HEALTH OFF CR QUIT ; : CONGRATS PAGE PRINT." ************************" PRINT." President James K. Polk" PRINT." sends you his heartiest" PRINT." congratulations," CR PRINT." He wishes you a prosperous life" PRINT." at your new home." CR PRINT." Press a key to end" KEY DROP CYAN QUIT ; : ?DEAD HEALTH @ 1 < IF ... PRINT." You died." 1000 MS CR .DATE CR SORRY ENDIF ; : SEE-DOCTOR CR ... PRINT." The doc wants " 40 RND 10 + DUP DOLLARS PRINT." to patch you up." DUP CASH @ > IF PRINT." You cain't afford it partner!" 20 RND 5 + HEALTH DEBIT DROP ELSE ( rnd) CASH DEBIT PRINT." You got enough money." PRINT." He's good with the needle & thread" 10 HEALTH CREDIT ENDIF ?DEAD ; \ ==================================================== \ random sickness selector :NONAME V." Pneumonia" 30 HEALTH DEBIT ; :NONAME V." Typhoid fever" 23 HEALTH DEBIT ; :NONAME V." Swine Flu" 10 HEALTH DEBIT ; :NONAME V." Consumption" 20 HEALTH DEBIT ; :NONAME V." Scurvy" 15 HEALTH DEBIT ; :NONAME V." Infection" 20 HEALTH DEBIT ; :NONAME V." smallpox" 40 HEALTH DEBIT ; CASE: DISEASES 6 CHOICES, ;CASE : SICKNESS 6 RND DISEASES ; \ ===================================================== \ BAD luck : STARVED PRINT." You ran out of food and" PRINT." starved to death" HEALTH OFF SORRY ; : SNAKEBITE PRINT." You die of snakebite since" PRINT." you have no medicine" HEALTH OFF SORRY ; : MASSACRE PRINT." You were attacked and" PRINT." massacred by criminals" HEALTH OFF SORRY ; : TOOLONG PRINT." You have been on the trail to long --" PRINT." your family died in the first blizzard" PRINT." of winter" HEALTH OFF SORRY ; : NOMEDICINE CR PRINT." You ran out of medical supplies" PRINT." and died of " ... WOUNDED @ IF V." your injuries" ELSE SICKNESS ENDIF HEALTH OFF SORRY ; : BANDITS PRINT." Bandits Attacked!" HONK CR 30 %CHANCE: PRINT." You ran out of bullets--" PRINT." They got lots of yer cash" 50 RND CASH DEBIT AMMO OFF ;CHANCE 20 %CHANCE: PRINT." and... they took one of your oxen" 1 OXEN# DEBIT ;CHANCE 10 %CHANCE: WOUNDED ON ;CHANCE ; : VERYSICK PRINT." Partner you is looking sickly." PRINT." The DOC says you got the " SICKNESS PRINT." STOP FOR MEDICAL ATTENTION" SEE-DOCTOR CR 50 %CHANCE: PRINT." Hey you pulled through!" 10 HEALTH CREDIT ELSE PRINT." I got some bad news partner" ... HEALTH OFF ;CHANCE ?DEAD ; \ ========================================= :NONAME V." wheel" ; :NONAME V." axle" ; :NONAME V." yoke" ; :NONAME V." whipple-tree" ; :NONAME V." seat" ; CASE: PARTS 5 CHOICES, ;CASE : PART 5 RND PARTS ; : BUSTED-WAGON PRINT." Yer wagon gots a busted " PART PRINT." It's gonna take some time to fix 'er up!" ... PRINT." That'll cost ya " 5 RND 1+ DUP DOLLARS CASH DEBIT 8 MISC DEBIT ; CASE: TRAGEDY | SNAKEBITE | MASSACRE | TOOLONG | NOMEDICINE | BANDITS | VERYSICK | BUSTED-WAGON ;CASE : SHITHAPPENS CR ... PRINT." Tragegy has struck!" CR 7 RND TRAGEDY ; : ?BROKE CASH @ 0= IF PRINT." Partner, yer flat broke!" ENDIF ; :NONAME V." leg" 7 HEALTH DEBIT ; :NONAME V." arm" 5 HEALTH DEBIT ; :NONAME V." belly" 10 HEALTH DEBIT ; :NONAME V." backside :-) PRINT." (sorry, not funny)" 8 HEALTH DEBIT ; :NONAME V." head..." HEALTH OFF ?DEAD SORRY ; CASE: ANATOMY 4 CHOICES, ;CASE : BODYPART 4 RND ANATOMY ; : ?SEE-DOCTOR CR PRINT." Wanna have a doc look at you?" Y/N? IF SEE-DOCTOR 60 %CHANCE: PRINT." He patched you up!" 10 RND HEALTH CREDIT WOUNDED OFF ELSE PRINT." He fixed it but yer still hurtin'" WOUNDED OFF 10 HEALTH DEBIT ;CHANCE ENDIF ; : GOTSHOT PRINT." OUCH! You got shot in the " BODYPART 5 RND MISC DEBIT 20 RND 2+ AMMO DEBIT 45 %CHANCE: PRINT." and they took one of your oxen." 1 OXEN DEBIT ;CHANCE ?SEE-DOCTOR ?DEAD ; : ?GOTSHOT WOUNDED @ IF GOTSHOT ENDIF ; : WANNAEAT ( -- n) CR PRINT." How do you wanna eat?" PRINT." (1) POORLY" PRINT." (2) OK" PRINT." (3) WELL? " QUALITY 1 3 VALID-INPUT ; : RUNNING PRINT." You are running away" ... 67 RND 1+ MILEAGE CREDIT 10 RND HEALTH DEBIT 20 OXEN DEBIT 2 RND DAY CREDIT 1 RND MONTH CREDIT 25 %CHANCE: WOUNDED ON ;CHANCE ; : ATTACK PRINT." You are attacking " ... 55 %CHANCE: WOUNDED ON ELSE PRINT." You scared them off!" PRINT." and found their money and food" CR 60 RND 10 FOOD CREDIT 120 RND 30 CASH CREDIT 15 RND HEALTH CREDIT ;CHANCE ; : CONTINUE CR PRINT." Continuing " ... 20 RND 1+ MILEAGE CREDIT 2 RND HEALTH DEBIT 10 OXEN DEBIT 1 RND DAY CREDIT 40 %CHANCE: WOUNDED ON ;CHANCE ; : DEFEND PRINT." We circled the wagons" ... PRINT." and let 'em have it!" ... 20 RND 2+ AMMO DEBIT AMMO @ 0< IF MASSACRE ENDIF 65 %CHANCE: CR PRINT." You are a pretty good shot!" PRINT." They took off and left us alone" CR ELSE CR PRINT." We took some hits but survived" 20 RND AMMO DEBIT 10 HEALTH DEBIT 30 %CHANCE: WOUNDED ON ;CHANCE ;CHANCE ; CASE: REACTION ( n -- ) | RUNNING | ATTACK | CONTINUE | DEFEND ;CASE : HOSTILE-DECIDE ( -- ) PRINT." They look hostile!" PRINT." Whaddya reckon we should do?" PRINT." (1) RUN" PRINT." (2) ATTACK" PRINT." (3) CONTINUE" PRINT." (4) DEFEND" ACTION 1 4 VALID-INPUT DROP CR ... ACTION @ 1- REACTION ?GOTSHOT ; \ ====================================== \ random names for food :NONAME V." eatin'" ; :NONAME V." food" ; :NONAME V." viddles" ; :NONAME V." grub" ; CASE: FOODS 4 CHOICES, ;CASE : FOODSTUFF 4 RND FOODS ; \ ====================================== \ game animals :NONAME V." deer" 100 FOOD CREDIT PRINT." We got food for days!" CR ; :NONAME V." possum" 10 FOOD CREDIT PRINT." Ain't much food but better than nothin'" CR ; :NONAME V." squirrel" 5 FOOD CREDIT PRINT." We is gonna be hungry" CR ; :NONAME V." duck" 15 FOOD CREDIT PRINT." A little greasy, but fillin'" CR ; :NONAME V." turkey" 25 FOOD CREDIT PRINT." Now that's some good viddles" CR ; CASE: VARMINTS 5 CHOICES, ;CASE : ANIMAL 5 RND VARMINTS ; : HUNT PRINT." You are hunting" ... PRINT." Be vaarrwee quiet " ... PRINT." BANG!" 55 %CHANCE: PRINT." You shot a " ANIMAL 3 AMMO DEBIT ELSE PRINT." You missed." PRINT." Yer gonna be hungry tonight." ... 10 FOOD DEBIT 5 HEALTH DEBIT ;CHANCE ; 20 CASH ! : .CASH V." You have " CASH @ DOLLARS V." cash" ; : BUYFOOD PRINT." How much do you want to spend?" CR .CASH TEMP 1 CASH @ VALID-INPUT DUP CASH DEBIT FOOD CREDIT CR .CASH V." left" ; \ ================================================ \ status testers begin with a ? : ?FOOD \ test if we have enough Food points left FOOD @ 1 < IF STARVED ENDIF FOOD @ 10 < IF PRINT." You need to do some hunting or by some food!!!" PRINT." 1. Hunt" PRINT." 2. Buy Food" PRINT." Enter to go on" CR KEY CASE [CHAR] 1 OF HUNT ENDOF [CHAR] 2 OF BUYFOOD ENDOF ENDCASE ENDIF ; : ?HEALTH WOUNDED @ IF SEE-DOCTOR ENDIF HEALTH @ 10 < IF CR PRINT." You don't look so good partner." PRINT." Wanna see a doctor?" Y/N? IF SEE-DOCTOR ELSE PRINT." Ok, it's yer funeral." ENDIF ENDIF ; : ?TIMEOUT DAY @ 30 > IF TOOLONG ENDIF ; : HAPPYDAYS CR PRINT." You bumped into friendly Haida people." PRINT." They gave you fresh food" PRINT." and fed your animals!" 20 FOOD CREDIT 40 OXEN CREDIT 5 HEALTH CREDIT ; : AreWeThereYet? MILEAGE @ 300 > IF CONGRATS THEN PRINT." We travelled " MILEAGE ? V." miles."; : CONSUME \ things are used up every day 10 RND HEALTH DEBIT 40 RND 20 + OXEN DEBIT 10 RND FOOD DEBIT 10 RND CLOTHES DEBIT 10 RND MISC DEBIT ; : ?OXEN OXEN @ 10 < IF PRINT." Yer oxen are almost dead!" PRINT." Wanna stop for grazing" Y/N? IF ... 48 %CHANCE: CR PRINT." Uhoh, we got company!" HOSTILE-DECIDE ELSE ROLL-DICE 5 * OXEN CREDIT PRINT." Oxen are now worth" OXEN @ DOLLARS CR ;CHANCE ENDIF ENDIF ; : OPENING TEXT YELLOW PRINT." Oregon Trail" PRINT." The game that time forgot" CR SETUP PRINT." -- You're on the trail... -- " 12 RND 1+ MONTH ! 1 DAY ! CR .DATE ... ; : .DAY PRINT." It's day " DAY @ . ; : GAME BEGIN .DAY PRINT." Press a key to go on" KEY DROP .S ?TERMINAL ABORT" emergency stop" 1 DAY CREDIT ?TIMEOUT CONSUME ?HEALTH ?FOOD ?OXEN ?BROKE OXEN# @ 20 RND * 2+ MILEAGE CREDIT ( travel faster with 2 oxen) AreWeThereYet? 25 %CHANCE: SHITHAPPENS ;CHANCE 15 %CHANCE: HAPPYDAYS ;CHANCE ?GOTSHOT .SUPPLIES AGAIN ; : INITS 1 DAY ! 100 CASH ! 100 AMMO ! 250 OXEN ! 2 OXEN# ! 100 CLOTHES ! 100 MISC ! 100 FOOD ! 100 HEALTH ! MILEAGE OFF .SUPPLIES ; Edited May 13, 2019 by TheBF Quote Link to comment Share on other sites More sharing options...
+TheBF Posted May 13, 2019 Author Share Posted May 13, 2019 Forth VM versus TMS9900 As I begin to create some support files to make a native code generating cross compiler it is interesting to see how many instructions it takes to replicate Forth's virtual machine instructions. I this code the PUSH, macro is 2 9900 instructions and the POP, macros are only 1. I am using R4 like an accumulator which under-utilizes the 9900 register set but "make it work then make it better" is my motto. \ MACHINE FORTH PRIMITIVES \ *WARNING* ALL THESE PRIMITIVES COMPILE INLINE CODE ** \ ========================================================================== CR .( INLINE PRIMITIVES ) HEX CROSS-COMPILING \ The macros will compile inline code : ! ( n addr -- ) *SP+ *TOS MOV, TOS POP, ; : @ ( a -- w ) \ vars return an address to the compiler *TOS TOS MOV, ; : C@ ( addr -- c ) *TOS TOS MOVB, TOS 8 SRL, ; : +! ( n addr --) *SP+ *TOS ADD, TOS POP, ; \ increment/decrement a memory address that is in TOS : 1+! *TOS INC, TOS POP, ; : 2+! *TOS INCT, TOS POP, ; : 1-! *TOS DEC, TOS POP, ; : 2-! *TOS DECT, TOS POP, ; \ =================================================================== CR .( DATA STACK) : SP@ ( -- a ) TOS PUSH, SP TOS MOV, ; : SP! ( a -- ) TOS SP MOV, TOS POP, ; : DROP ( w -- ) TOS POP, ; : NIP ( n n' -- n') SP++ ; : DUP ( w -- w w ) TOS PUSH, ; : ?DUP ( x -- 0 | x x) TOS TOS MOV, 2 +$$ JNE, TOS PUSH, ; : OVER ( w1 w2 -- w1 w2 w1 ) TOS PUSH, 2 (SP) TOS MOV, ; : SWAP ( w1 w2 -- w2 w1 ) TOS W MOV, *SP TOS MOV, W *SP MOV, ; : ROT ( n1 n2 n3 -- n2 n3 n1) 2 (SP) W MOV, *SP 2 (SP) MOV, TOS *SP MOV, W TOS MOV, ; : SWPB ( n -- n ) TOS SWPB, ; : 2DROP ( n n -- ) SP INCT, TOS POP, ; \ ========================================================================== CR .( RETURN STACK inline code) : RP@ ( -- a ) TOS PUSH, RP TOS MOV, ; : RP! ( a -- ) TOS RP MOV, TOS POP, ; : >R ( w -- ) TOS RPUSH, \ 28 TOS POP, \ 22 ; : R> ( -- w ) TOS PUSH, \ 28 *RP+ TOS MOV, \ 22 ; : R@ ( -- w ) TOS PUSH, *RP TOS MOV, ; : RDROP ( -- ) RP INCT, ; \ =================================================================== CR .( Inline ARITHMETIC operations) \ simple math is 40% faster with TOS in register vs on stack : 1+ ( n -- n) TOS INC, ; : 1- ( n -- n) TOS DEC, ; : 2+ ( n -- n) TOS INCT, ; : 2- ( n -- n) TOS DECT, ; : 2* ( n -- n) TOS TOS ADD, \ MPY instruction is 52 clocks minimum ; : 2/ ( n -- n) \ DIV instruction is 52 clocks minimum TOS 1 SRA, ; : INVERT ( w w -- w) TOS INV, ; : ABS ( n -- n ) TOS ABS, ; : NEGATE ( n -- n ) TOS NEG, ; : + ( u1 u2 -- u') *SP+ TOS ADD, ; : - ( u1 u2 -- u') *SP+ TOS SUB, TOS NEG, \ sign is wrong when subtracting a register from memory ; : UM* ( n n -- d) \ 2 cells input -- 2 cells output *SP TOS MPY, R5 *SP MOV, ; : * ( n n -- n) *SP+ R3 MOV, TOS R3 MPY, ; \ =================================================================== CR .( Variable ON OFF) : ON ( adr -- ) *TOS SETO, TOS POP, ; : OFF ( adr -- ) *TOS CLR, TOS POP, ; \ ==================================================================== \ boolean operators : AND ( w w -- w ) *SP INV, *SP+ TOS SZC, ; : OR ( w w -- w ) *SP+ TOS OR, ; : XOR ( w w -- w ) *SP+ TOS XOR, ; SUB: (M+) ( d n -- d ) \ add single to double, returning a double TOS 2 (SP) ADD, OC IF, *SP INC, ENDIF, *SP+ TOS MOV, \ 12 bytes RET, END-SUB : M+ ( d n -- d ) \ NEEDS (M+) \ conditionally compile sub-routine (M+) @@ BL, ; \ 4 bytes if called more than once : BYE ( -- ) 0 LIMI, 0000 @@ BLWP, ; \ =================================================================== \ comparison is always done with TOS and NOS (next on stack) SUB: (=) ( n n -- ?) *SP+ TOS CMP, \ 10 bytes EQ IF, TOS CLR, ELSE, TOS SETO, ENDIF, RET, END-SUB SUB: (U>) ( n n -- ? ) *SP+ TOS CMP, HI IF, TOS CLR, ELSE, TOS SETO, ENDIF, RET, END-SUB SUB: (0=) ( n -- ? ) TOS TOS CMP, NE IF, TOS CLR, ELSE, TOS SET0, ENDIF, RET, END-SUB : = (=) @@ BL, ; : U> (U> @@ BL, ; : 0= (O=) @@ BL, ; Quote Link to comment Share on other sites More sharing options...
+TheBF Posted May 15, 2019 Author Share Posted May 15, 2019 (edited) Adding VALIDATE to Forth The ACCEPT statement in Extended BASIC has a very nice feature with the VALIDATE extension. ACCEPT VALIDATE("YN"): R$ In the course of trying to write an "Oregon Trail" game I need a way to VALIDATE key entries for the main menu. Many modern Forth systems have a routine called SCAN. SCAN takes a stack string (addr,len pair) and character for inputs and returns the address and len (1) of the the character in the string. As it turns out this is very handy for creating a VALIDATE function in Forth: : VALIDATE ( char addr$ len -- ?) \ returns 1 or false (0) ROT SCAN NIP ; \ NIP removes the address leaving only the count Then to create a validating KEY reader we put it all in a little loop. : MENU-KEY ( -- char) BEGIN KEY DUP S" 1234X" VALIDATE 0= WHILE \ while VALIDATE is 0 DROP \ drop the bad char REPEAT ; Edited May 15, 2019 by TheBF Quote Link to comment Share on other sites More sharing options...
+mizapf Posted May 15, 2019 Share Posted May 15, 2019 The docs say "when any value other than 1 is written"... since we write single bit CRU, I interpreted that to mean any write of a '1' value (even though that seemed weird). But CS1 didn't work unless I reloaded the timer on exit from timer mode - which is what broke in both Forth implementations mentioned. It seems that the documentation means "when the timer reload register is non-zero after any write to it", as even zero writes need to reload the timer. Doing THAT (and changing the default from 0 to 0x3fff) made both cassette and snake work. (edit: but in the end, I went back to the default 0 values in the registers, and just rely on the wraparound to handle the count. We need to measure a real console to see what the default is, unless someone has a data sheet that explicitly says so). I worked over the TMS9901 implementation in MAME, and I changed it to work as in the real machine, that is, your counter program is running in MAME now. I also read the specifications multiple times, until they worked in my mind. :-) Writing a nonzero value into the clock register then enables the clock and sets its frequency. [...] The clock functions as an interval timer by decrementing to zero, issuing an interrupt, and restarting at the programmed start value. [...] If a value other than that initially programmed is required, a new 14-bit clock start value is similarly programmed by executing a CRU write operation to the same locations. During programming the decrementer is restarted with the current start value after each start value bit is written. [...] The clock is disabled by /RST1 (power-up clear) or by writing a zero value into the clock register. Enabling the clock programs the third priority interrupt (/INT3) as the clock interrupt and disables generation of interrupts from the /INT3 input pin. Know what? There is no word that says that the clock is "stopped". It seems to me that "enable" or "disable the clock" is solely referring to the interrupt generation. This would explain the behavior of the real TMS9901. I changed the MAME emulation accordingly, and also successfully tested OLD/SAVE CS1. 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted May 15, 2019 Author Share Posted May 15, 2019 That's fantastic news. Vielen Dank I am not sure that the first snake program should really work on hardware. It does not init the timer like CAMEL99 Forth does on startup. I can try reading the timer on my TI-99 without initing it to >3FFF to see what I get. BTW my source for the code was here: http://www.unige.ch/medecine/nouspikel/ti99/tms9901.htm#Timer "Once the decrementer reaches zero, it reloads itself with the value stored in the Clock register and continues its decrementing job. At this point, it also issues a level 3 interrupt. If the corresponding mask was set to 1 (with CRU bit 3, in I/O mode), the INTREQ* line will become active to signal the interrupt to the CPU. Note that while the decrementer is working, pin INT3 cannot generate interrupts: it can still be read, but even a low level will not trigger interrupts. The decrementer will not generate any more interrupts after that one, unless re-enabled by entering and exiting timer mode. The decrementer can be stopped by simply writing a zero to the leaving register, and leaving timer mode." 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.