+TheBF Posted December 14, 2018 Author Share Posted December 14, 2018 Phwoar! This is really cool. I never got a chance to look at serial. Do you mind if I use this this code (with attribution, of course) for TurboForth? Would you mind posting some example outputs from BAUD (i.e the value that gets written into BPS) for some example baud rates? I need to check UM/MOD implementation in TF :-) Also, can you post your code for MS if you don't mind? :-) It'll give me something to look at over Christmas (along with Lee's recent work of CF7 and variants) now that uni has stopped until January. Thanks Mark Of course you can use it, as long as I can re-used the fixes you find. :-) Actually I am working on it on real iron and there is a bug with the baud rate setting for lower rates. 9600 and 19200 worked ok. I found a table in an old TI book and it looked linear down to 600 Baud. I am not sure if I can get handshaking correct for the receive side. I don't have an rs232 breakout box so it's painful. Without interrupts of course you drop characters easily but for a console port TTYKEY is fast enough for human fingers. A few machine code words would make it quicker. The MS code is here in my cross-compiler Forth. https://github.com/bfox9900/CAMEL99-V2/blob/master/SRC/CCLIB/TICKTOCK.HSF My little ticker is strange because it has to accommodate 1. My compiler can only build 8K images 2. I need to support cooperative multitasking But it seems to work well on real hardware giving a consistent time. I have a constant in the code that compensates for Forth overhead and it might be better to be a variable that could be calibrated to a machine. It could be much finer grained as a CODE word that stops the system, or I suppose it could trigger an interrupt. Lots of ways to make it better. The TMR! word starts the 9901 running continuously which broke Classic99 but Tursi fixed it for me. (Thanks Tursi) Merry Christmas! :-) Quote Link to comment Share on other sites More sharing options...
+TheBF Posted December 14, 2018 Author Share Posted December 14, 2018 Would you mind posting some example outputs from BAUD (i.e the value that gets written into BPS) for some example baud rates? I need to check UM/MOD implementation in TF :-) These numbers concur with "Software Development, Geoff Vincent, Jim Gill, TI Oct 1981. Quote Link to comment Share on other sites More sharing options...
+FarmerPotato Posted December 14, 2018 Share Posted December 14, 2018 These numbers concur with "Software Development, Geoff Vincent, Jim Gill, TI Oct 1981. I see you're rounding down, in favor of going faster. Correct? I looked at source code and found that TE3 had >1A1 for 1200 baud - rounding 1E6/1200/2 = 416.7 = 1A1 = 1199.04 bps. At some point I corrected this to 1A0 for TI-Net BBS which is 1201.92 bps. Quote Link to comment Share on other sites More sharing options...
+TheBF Posted December 14, 2018 Author Share Posted December 14, 2018 I have that old book here that listed 1A0 as the correct value for 1200 Baud with 3MHz clock. It references the TM990/100 or 101 board. If yours works better I will use it instead. :-) Quote Link to comment Share on other sites More sharing options...
+TheBF Posted December 31, 2018 Author Share Posted December 31, 2018 HAPPY NEW YEAR 99ERS The guests have not arrived yet so I thought I would give my best wishes to all the people here for 2019. It has a been good year for CAMEL99 Forth. I have learned a lot about the old system that I didn't know 35 years ago. Most of that due to the extraordinary talent of the people who frequent this forum. Based on my recent discussions with Lee I have added BLOCK files to the system. It was pretty simple to add them as a layer on top of the ANS Forth file word-set but I still had a round of bug killing during the Christmas holidays. For the curious here is the code to give CAMEL99 Forth style virtual memory blocks. \ blocks.fth for CAMEL99 Forth Dec 17 2018 BJFox \ Based on ideas from HsForth by Jim Kalihan (RIP) NEEDS .S FROM DSK1.TOOLS NEEDS OPEN-FILE FROM DSK1.ANSFILES NEEDS .R FROM DSK1.UDOTR HEX 2 CONSTANT #BUFF \ # of active buffers 400 CONSTANT B/BUF B/BUF 2 CELLS + CONSTANT B/REC \ block-record has a 4 byte header 7FFF CONSTANT $7FFF 3FFF 1- CONSTANT LIMIT \ end of buffer memory LIMIT B/REC #BUFF * - CONSTANT FIRST \ first buffer record address DECIMAL 128 CONSTANT B/SEC \ bytes per sector on TI disk VARIABLE BLK VARIABLE PREV FIRST PREV ! VARIABLE USE FIRST USE ! VARIABLE LOWBLK VARIABLE HIGHBLK 79 HIGHBLK ! \ set the highest block VARIABLE BHNDL \ block file handle HEX : CELL- S" 2- " EVALUATE ; IMMEDIATE DECIMAL CREATE ACTIVE 20 ALLOT \ block file name : ACTIVE$! ( f$ len - f$) ACTIVE PLACE ; : ACTIVE$ ( -- addr len) ACTIVE COUNT ; : ERASE ( addr len -- ) 0 FILL ; : BLANKS ( addr len -- ) BL FILL ; \ =================================================== \ interface to ANS File system HEX : ?BLOCKS ( -- ) BHNDL @ 0= ABORT" No open BLOCK file" ; \ move file pointer to start of block : SEEK ( blk# -- ) ?BLOCKS DUP BLK ! 8* ( blk# x 8 = sector) BHNDL @ REPOSITION-FILE ABORT" SEEK err" ; \ READ/WRITE TI records for 1 block : RBLK ( adr blk# -- adr) SEEK DUP B/BUF BOUNDS ( end-addr,start-addr) DO I B/SEC BHNDL @ READ-LINE ?FILERR 2DROP B/SEC +LOOP ; : WBLK ( adr blk# -- ) SEEK B/BUF BOUNDS ( end-addr,start-addr) DO I B/SEC BHNDL @ WRITE-LINE ?FILERR B/SEC +LOOP ; \ =================================================== HEX : UPDATE ( -- ) PREV @ @ 8000 OR PREV @ ! ; : +BUF ( addr1-- addr2) B/REC + DUP LIMIT = IF DROP FIRST THEN ; : BUFFER ( n -- addr ) USE @ DUP >R \ get current buffer record & Rpush @ 0< \ has it been updated? IF \ if true ... R@ CELL+ \ get buffer address R@ @ \ get the block number $7FFF AND WBLK \ write data to disk THEN R@ ! \ store this in USE record R@ PREV ! \ set it as previous record R@ +BUF USE ! \ advance to next buffer, make the USE R> CELL+ ; \ return the buffer address : BLOCK ( block# --- addr ) ?BLOCKS >R PREV @ DUP @ R@ - $7FFF AND IF BEGIN +BUF DUP PREV @ = IF DROP R@ BUFFER R@ RBLK CELL- THEN DUP @ R@ - $7FFF AND 0= UNTIL DUP PREV ! DUP USE @ = IF DUP +BUF USE ! THEN THEN R> DROP CELL+ ; HEX : FLUSH ( -- ) ?BLOCKS FIRST \ start at 1st block record #BUFF 0 DO DUP @ 0< \ is block updated? IF \ yes, write to disk DUP @ $7FFF AND OVER 2DUP ! CELL+ SWAP WBLK THEN +BUF \ then goto next block record LOOP DROP ; : EMPTY-BUFFERS ( -- ) FIRST LIMIT OVER - ERASE #BUFF 0 DO $7FFF B/REC I * FIRST + ! LOOP ; DECIMAL : DF128 DISPLAY RELATIVE B/SEC FIXED ; : OPEN-BLOCKS ( file$ len -- ) 2DUP ACTIVE$! EMPTY-BUFFERS DF128 R/W OPEN-FILE ?FILERR BHNDL ! ; HEX : CLOSE-BLOCKS ( -- ) BHNDL @ ?DUP IF CLOSE-FILE ?FILERR BHNDL OFF THEN ; \ Usage: 45 S" DSK1.MYBLOCKS" MAKE-BLOCKS : MAKE-BLOCKS ( n file len -- ) OPEN-BLOCKS FIRST CELL+ B/BUF BLANKS DUP HIGHBLK ! 1+ 1 DO FIRST CELL+ I WBLK LOOP CLOSE-BLOCKS ; 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 7, 2019 Author Share Posted January 7, 2019 (edited) PAGED MEMORY OPERATIONS I have scratching my head on how to use the SAMS memory to implement an editor that can handle large files (64K) I have something that works. It's not blazing fast on writing individual bytes, but it will handle typing speeds. For block string operations to paged memory one will have to always prevent reading or writing across page boundaries but that's not a big hardship. The design criteria were as follows: simplify the computation by standardizing on one 4K page in low memory at >3000. (no need to compute the register address) Only map in a new page when needed (this improved speed by 50%) Limit direct access to 64K range because that's the simplest to index use a segment variable to allow selecting other 64K segments The PAGED word will be combined with standard fetch and store operators to create the final APi I did it first completely in Forth: (it was a little slow but it worked) The UM/MOD operation takes an address and a segment number as a 32bit integer and divides it by 4K to give an offset into the page and the bank# : PAGED ( addr -- addr') SEG @ 4K UM/MOD ( -- offset bank#) DUP BANK# @ = \ are we using the same PAGE IF DROP \ Yes! Drop bank# and get out ELSE DUP FF00 AND ABORT" SAMS Err!" DUP BANK# ! \ update bank# variable >< \ swap bytes, bank# must be in left byte 1E00 CRU! 0SBO \ enable SAMS card ( bank#) 4006 ! \ store bank in 3K SAMS register 0SBZ \ disable SAMS card THEN PMEM + \ then add offset to paged mem block ; \ paged memory fetch and store : C@P ( addr -- n) PAGED C@ ; \ fetch a byte : C!P ( n addr -- ) PAGED C! ; \ store a byte : @P ( addr -- n) PAGED @ ; \ fetch an int : !P ( n addr -- ) PAGED ! ; \ store an int Then I replaced the conditional part with a CODE word and this sped things up by 40% or so. CODE ?MAP ( offset bank# -- ) TOS BANK# @@ CMP, EQ IF, TOS POP, \ no need to switch ELSE, ( *THE MAPPER* ) TOS BANK# @@ MOV, \ record the NEW bank# TOS SWPB, \ bank# needs to be in left byte R12 1E00 LI, \ cru address of SAMS CARD 0 SBO, \ enable SAMS card TOS 4006 @@ MOV, \ load the >3000 sams register 0 SBZ, \ disable sams card TOS POP, \ drop the bank# ENDIF, TOS PMEM AI, \ add offset to paged mem block NEXT, ENDCODE : PAGED ( addr -- addr') SEG @ 4K UM/MOD ?MAP ; Further speed improvements need to remove the divide operation with another code word. Doing it in Forth was the same speed as using UM/MOD. Edited January 7, 2019 by TheBF 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 7, 2019 Author Share Posted January 7, 2019 (edited) PAGED Memory performance in Forth vs CPU RAM Operations Threaded Forth imposes a 3 to 4 times speed penalty on primitive operations when compared to native code instructions.Adding paged memory to writing one byte, the worst case, seems to incur another 3 times speed penalty using the code in the previous post. (with ?MAP)Block memory writes however can run at processor speed and in the best case, filling one entire 4K page, the penalty of switching banks disappears.(Note: FILL , used in BLANKS, is written in Forth Assembler) Results are below: \ testing read write speeds to SAMS memory NEEDS DUMP FROM DSK1.TOOLS NEEDS ELAPSE FROM DSK1.ELAPSE HEX 7FFF CONSTANT 32K FFFF CONSTANT 64K 1000 CONSTANT 4K : ERASE 0 FILL ; : BLANKS BL FILL ; \ 64k single byte writes to paged memory : 64KBYTES 64K 0 DO I I C!P LOOP ; ( 46 secs) \ 64K single byte writes to single address : 64KBTEST 64K 0 DO I 3000 C! LOOP ; ( 14.9 secs) \ 32K word writes to paged memory : 32KWORDS 64K 0 DO I I !P 2 +LOOP ; ( 25.5 secs) \ 32K word writes to single address : 32KTEST 64K 0 DO I 3000 ! 2 +LOOP ; ( 9.6 secs) \ 4K block fill to paged memory : 64KBLANKS 64K 0 DO I PAGED 4K BLANKS 4K +LOOP ; ( 1.5 secs) \ 4K block fill to CPU memory : 64KTEST 64K 0 DO 3000 4K BLANKS 4K +LOOP ; ( 1.5 secs) EDIT: Be careful what you wish for All the memory is great but out of curiosity I wondered how long it takes for Forth to erase fifteen 64K segments (983,040 bytes) : 64KERASE 64K 0 DO I PAGED 4K ERASE 4K +LOOP ; : ERASEALL 10 1 DO I SEG ! 64KERASE LOOP ; ( 20.7 secs) Wow! Edited January 7, 2019 by TheBF 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 10, 2019 Author Share Posted January 10, 2019 After trying SAMS code on real iron and failing, I went back to the Micropendium article by Bruce Harrison whereupon I noticed I did not write an Initialization routine. Duh! In Forth that looked like this: \ * SAMSINI sets card to "power-up" condition : SAMSINI 1E00 CRU! 0SBO \ turn on card 0 \ 1st value 4000 20 \ register address, #regs BOUNDS DO DUP I ! \ I is reg. address 0101 + \ next value 2 +LOOP 0SBZ \ turn off card DROP ; Note: Something that I have noticed is that the semantic power of 9900 assembler is actually about the same as Forth. What this means is that for primitive (low level) routines, Assembler code is smaller than Forth "most" of the time. This is not true for less powerful CPUs. I have to get a native code Forth compiler running. Here is Bruce's AMSINI routine in Forth Assembler: ( I simplified it slightly by starting with 0 in R1 and changing the instruction order in the loop) CODE SAMSINI R12 1E00 LI, 0 SBO, \ turn on Sams card R1 CLR, R0 4000 LI, \ start of memory BEGIN, R1 R0 *+ MOV, \ move 2 bytes to mem-mapper R1 0101 AI, \ add 1 page R0 4020 CI, \ all done? EQ UNTIL, \ no, init more 0 SBZ, \ turn off SAMS card NEXT, \ return ENDCODE I took the step of creating Bruce's article as a PDF file and adding the Forth code and example for anyone who is interested. SAMS CARD ACCESS and MAPPING.pdf 4 Quote Link to comment Share on other sites More sharing options...
Willsy Posted January 10, 2019 Share Posted January 10, 2019 You're probably too far down the track now, but some of the SAMS code in TF may be help/interest. Check out http://turboforth.net/source/Bank1/1-04-Memory.html (the word >MAP i.e "to mapper") ; ; >MAP ( bank address -- ) ; If a SAMS card is present, maps memory bank "bank" to address "address" _sams mov r12,r11 ; save address of NEXT mov *stack+,r1 ; get address andi r1,>f000 ; set to 4k boundary srl r1,11 ; divide by 2048 ai r1,>4000 ; convert to SAMS register address mov *stack+,r2 ; get bank andi r2,>ff ; mask off any crap mov r2,r0 ; keep a copy sla r2,8 ; move to high byte xor r0,r2 ; combine r0 & r2. Hi & lo bytes are now identical li r12,>1e00 ; cru address of SAMS sbo 0 ; enable SAMS registers mov r2,*r1 ; poke sams register sbz 0 ; disable sams registers mov r11,r12 ; restore address of NEXT b @retB0 ; return to caller Also, the SAMS initialisation code in http://turboforth.net/source/Bank1/1-16-Initialise.html ; initialise SAMS card if fitted li r12,>1e00 ; sams CRU base sbo 0 ; enable access to mapper registers sbz 1 ; disable mapping while we set it up li r0,>4004 ; register for >2000 li r1,>f8f8 ; map bank >f8 into >2000 mov r1,*r0+ ; do it li r1,>f9f9 ; map bank >f9... mov r1,*r0+ ; ...into >3000 ; now set up the banks for high memory... li r0,>4014 ; register address li r1,>fafa ; register value li r2,6 ; loop count sams mov r1,*r0+ ; write to the register ai r1,>0101 ; next register value dec r2 ; finished? jne sams ; loop if not sbo 1 ; enable mapping sbz 0 ; lock the mapper registers 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 10, 2019 Author Share Posted January 10, 2019 (edited) Thanks Mark, I looked at your "bible" when I first started trying to figure this out. :-) It is always invaluable and such tidy code. I have tested my Forth version which uses a single page at >3000 and it seems to work OK. I also opted to put my block buffers there since I use >2000 upwards as a tiny heap stack for screen scrolls and temp strings. I did up the assembler version and the subbed in the machine code so I don't need the assembler when running on real iron. It is about 60..70% faster than the Forth version when accessing byte or word at a time. I tried re-coding the DIV operation as binary masks etc. but the number of instructions that it took meant it was over 140 cycles versus 204 or so for the DIV version, so I just optimized the DIV version. :-) The code version looks like this now. \ SAMS CARD support. 64K segmented memory fetch and store \ NEEDS DUMP FROM DSK1.TOOLS \ debugging only HERE HEX VARIABLE BANK# \ current mapped bank 1000 CONSTANT 4K \ bytes per bank = 4K 3000 CONSTANT PMEM \ paged memory block location VARIABLE SEG \ holds current 64K segment \ safely set the 64K segment that you want to use : SEGMENT ( 1..F -- ) \ don't allow segment 0 DUP 01 10 WITHIN 0= ABORT" BAD segment selected" SEG ! ; 1 SEGMENT \ using machine code so we don't need the CRU library CODE SAMS-OFF ( --) \ disable mapped memory 020C , 1E00 , \ R12 1E00 LI, 1E01 , \ 1 SBZ, NEXT, ENDCODE CODE SAMS-ON ( -- ) \ enable mapped memory 020C , 1E00 , \ R12 1E00 LI, 1D01 , \ 1 SBO, NEXT, ENDCODE \ * AMSINI sets ams card to "power-up" condition CODE SAMSINI 020C , 1E00 , \ R12 1E00 LI, 1D00 , \ 0 SBO, ( turn on Sams card ) 04C1 , \ R1 CLR, 0200 , 4000 , \ R0 4000 LI, ( start of memory) \ BEGIN, CC01 , \ R1 R0 *+ MOV, ( move to mem-mapper) 0221 , 0101 , \ R1 0101 AI, ( add 1 page) 0280 , 4020 , \ R0 4020 CI, ( all done? ) 16FA , \ EQ UNTIL, ( no, init more) 1E00 , \ 0 SBZ, ( turn off SAMS card) NEXT, \ return ENDCODE CODE >BANK ( addr -- offset bank# ) 0200 , 4K , \ R0 4K LI, \ 4K divisor ->R0 14 C144 , \ TOS R5 MOV, \ address to r5 18 C120 , SEG , \ SEG @@ TOS MOV, \ segment to TOS 22 3D00 , \ R0 TOS DIV, \ unsigned division 124 0646 , C585 , \ R5 PUSH, \ 28 NEXT, \ 16 BYTES 204 ENDCODE CODE ?MAP ( offset bank# -- ) 8804 , CD90 , \ TOS BANK# @@ CMP, 1602 , \ EQ IF, C136 , \ TOS POP, 100A , \ ELSE, ( *THE MAPPER* ) C804 , CD90 , \ TOS BANK# @@ MOV, 06C4 , \ TOS SWPB, 020C , 1E00 , \ R12 1E00 LI, 1D00 , \ 0 SBO, C804 , 4006 , \ TOS 4006 @@ MOV, 1E00 , \ 0 SBZ, C136 , \ TOS POP, \ ENDIF, 0224 , PMEM , \ TOS PMEM AI, NEXT, ENDCODE : PAGED ( addr -- addr') >BANK ?MAP ; \ paged memory fetch and store : C@P ( addr -- n) PAGED C@ ; \ fetch a byte : C!P ( n 32addr -- ) PAGED C! ; \ store a byte : @P ( 32addr -- n) PAGED @ ; \ fetch an int : !P ( n 32addr -- ) PAGED ! ; \ store an int SAMSINI CR HERE SWAP - DECIMAL . .( bytes) HEX Edited January 10, 2019 by TheBF 2 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted January 11, 2019 Share Posted January 11, 2019 I was going to show you how I did SAMS for fbForth 2.0 when I had a chance to grab a few minutes, but I am happy to see that @Willsy beat me to it, seeing as how I got the code from him in the first place! ...lee 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 11, 2019 Author Share Posted January 11, 2019 (edited) I was going to show you how I did SAMS for fbForth 2.0 when I had a chance to grab a few minutes, but I am happy to see that @Willsy beat me to it, seeing as how I got the code from him in the first place! ...lee We are a supportive lot aren't we? (When I looked at the BLOCK code in HsForth I could see that he "reviewed" Fig-Forth or perhaps MVP Forth and changed it up a little so getting external inspiration is a noble tradition) My objective was a lot simpler than Willsy's code. I just wanted one window into the SAMS memory rather than the general solution of allowing mapping of anything to anywhere. Topic Shift While reviewing my own sacred texts from the '80s I found this little "line editor" that I had put in a block for times when I just wanted to make a fast change. I added to it here to make it a little more functional and so in 446 bytes I got a little editor that works surprisingly well. It can PUT a line in a block, Delete a line, Copy a line and Move a line. It can advance to the next block or previous block. It was also very simple to deal with the 40 column screen and allow seeing the Right or Left side of the block using the R and L commands Combined with direct to VDP RAM writes it's also pretty fast. And it salvages "EVALUATE" to do a line by line LOAD. The video shows it in action. It am shocked how useful it is albeit not fancy. VARIABLE SCR VARIABLE SOL VARIABLE SWID C/L@ 4 - SWID ! DECIMAL 64 CONSTANT LWIDTH : (LINE) ( lin# -- addr) SCR @ BLOCK SWAP LWIDTH * + ; \ : .LINE ( lin# --) (LINE) SOL @ + SWID @ TYPE ; ( slow version) : .LINE ( lin# - ) (LINE) SOL @ + VPOS SWID @ VWRITE ; : (CP) ( L1 L2 -- ) (LINE) SWAP (LINE) SWAP LWIDTH CMOVE ; \ Line editor commands : LIST ( s# - ) PAGE DUP SCR ! ." SCR# " 3 U.R 16 0 DO CR I 2 .R I .LINE LOOP CR QUIT ; : ED ( -- ) SCR @ LIST ; : >> ( -- ) 1 SCR +! ED ; : << ( -- ) SCR @ 1- 0 MAX SCR ! ED ; : P ( line# -- ) 0 PARSE ROT (LINE) SWAP CMOVE UPDATE ED ; : D ( line# -- ) (LINE) LWIDTH BLANKS UPDATE ED ; : CP ( L1 L2 -- ) (CP) UPDATE ED ; : M ( L1 L2 -- ) OVER >R (CP) R> D ; : R ( -- ) 28 SOL ! ED ; \ list right side of block : L ( -- ) SOL OFF ED ; \ list left side of block : LOAD ( n -- ) SCR ! 16 0 ( edit: EVALUATE changes SOURCE-ID) DO I LINES ! I (LINE) LWIDTH EVALUATE LOOP ; : --> ( n -- ) SCR @ 1+ LOAD ; LINEDITOR.mp4 Edited January 11, 2019 by TheBF Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 20, 2019 Author Share Posted January 20, 2019 (edited) A Simple Shell Progam How amazing is CLASSIC99. I started exploring the "MAKE" menu option. This allows you to save the current running program as an E/A5 program that can span multiple 8K sections.I had created a set of separate file utilities for my own use and finally integrated them into one file. I realized this might be useful to others. But how do I distribute it to the users here? My own cross-compiler can only create programs of 8K or less in size. CLASSIC99 to the RescueAfter compiling the new shell code into CAMEL99 Forth I saved it as an E/A5 program. I had to create a new startup word to re-init a few details to replace the default COLD routine that does the job in forth but that was pretty simple. CAMEL99 has a BOOT variable that holds the pointer of the first Forth word that will run on startup so that made it easy as well. So if you need a simple set of commands to view a disk that you can call up from E/A Cartridge this may be useful when you are working on real hardware. It's kind of big because it contains the entire Forth kernel (8K) + the SHELL CODE. The attached ZIP file has the two binary images needed to run the shell. Known BUGS:1. The disk usage number is wrong. I will find out why.2. MORE only works for DV80 files Future Enhancements"1. Some kind of REGEX to allow viewing selective directories2. Add a file HEX dump for any type of file. 3. Tell me what you need. I might be able to code it! For the curious the spoiler has the source code. EDIT: Updated to Version 0.2 \ CAMEL99 Forth shell for disk file management \ NEEDS DUMP FROM DSK1.TOOLS NEEDS OPEN-FILE FROM DSK1.ANSFILES NEEDS VALUE FROM DSK1.VALUES NEEDS CASE FROM DSK1.CASE NEEDS BUFFER: FROM DSK1.BUFFER HERE \ simple spinner to show activity VARIABLE S CREATE SPNR CHAR | C, CHAR / C, CHAR - C, CHAR \ C, : SPNR[S] ( -- addr) SPNR S @ + ; : S++ ( -- ) S @ 1+ 3 AND S ! ; : SPIN ( -- ) SPNR[S] C@ EMIT BS S++ ; \ BS is backspace \ use for file handles as needed HEX 0 VALUE #1 0 VALUE #2 0 VALUE #3 \ CR if near end of screen DECIMAL : ?CR OUT @ 10 + C/L@ > IF CR THEN ; HEX \ print unsigned int, right justified : U.R ( u n --) >R 0 <# #S #> ( adr len) R> OVER - SPACES TYPE ; \ string helpers 10 BUFFER: SRC$ 10 BUFFER: DST$ : LEN ( $addr -- c ) C@ ; : ARG$ ( -- addr len ) BL PARSE-WORD DUP ?FILE ; : $. ( $addr -- ) COUNT TYPE ; : $.LEFT ( $ width -- ) OVER LEN - >R $. R> SPACES ; : NEXT$ ( addr len -- addr' len') + COUNT ; : +PLACE ( addr n $ -- ) 2DUP 2>R COUNT + SWAP CMOVE 2R> C+! ; \ file path cutter : /. ( caddr len -- caddr' len' ) [CHAR] . SCAN ; : DEV./ ( caddr len -- dev. len' ) 2DUP /. NIP - 1+ ; : /FILENAME ( caddr len -- filename len') /. 1 /STRING ; : POS$ ( $1 $2 -- n ) \ return "position" $1 in $2 TUCK SWAP OVER ( -- $2 $2 $1 $2) COUNT BOUNDS ( -- $2 $2 $1 end start) DO I OVER COUNT S= \ I steps thru $2 byte by byte 0= IF NIP I SWAP LEAVE THEN LOOP DROP - ABS ; \ ============================================= \ screen control : SPACEBAR ( -- ) KEY? IF BEGIN KEY? UNTIL THEN ; : ?BREAK-FILE ( hndl -- ) ?TERMINAL IF CLOSE-FILE CR CR ." *BREAK*" ABORT ELSE DROP THEN ; \ frequently used phrases : OPEN ( addr len -- ior ) OPEN-FILE ?FILERR ; : CLOSE ( hndl -- ) CLOSE-FILE ?FILERR ; : READH ( hndl -- ) READ-LINE ?FILERR 2DROP ; : OPEN-CATFILE ( adr len -- hndl) RELATIVE 100 FIXED R/O BIN OPEN ; \ 3 DIGIT BCD to int convertor. Limited to 999 HEX : F>INT ( addr len -- addr len n) OVER LEN ( -- mantissa) CASE 0 OF 0 ENDOF 40 OF OVER 1+ C@ ENDOF 41 OF OVER 1+ C@ 64 * >R OVER 2+ C@ R> + ENDOF ( default) -1 \ bad # indicator ENDCASE ; DECIMAL : DIR.TYPE ( addr -- ) F>INT CASE 1 OF ." Txt/Fix" ENDOF 2 OF ." Txt/Var" ENDOF 3 OF ." Bin/Fix" ENDOF 4 OF ." Bin/Var" ENDOF 5 OF ." Program" ENDOF ." ????" ENDCASE ; : HEAD.REC ( addr -- ) DECIMAL DUP 7 $.LEFT SPACE COUNT ( addr len) NEXT$ ." Size " NEXT$ F>INT 5 U.R ." Used " NEXT$ F>INT 5 U.R 2DROP ; : DIR.REC ( addr -- ) DUP 11 $.LEFT SPACE COUNT ( addr len) NEXT$ DIR.TYPE NEXT$ F>INT 7 U.R NEXT$ F>INT 7 U.R 2DROP ; : .FILE# ( n -- ) DUP . ." File" 1 <> IF ." s" THEN ; \ ======================================== \ * \ * User commands: CAT DIR MORE DEL COPY \ * : CAT ( <DSK?.> ) \ needs the '.' ONLY shows file name BASE @ >R DECIMAL ARG$ 2DUP DEV./ OPEN-CATFILE >R \ store file handle /FILENAME SRC$ PLACE PAD 80 R@ READH CR PAD HEAD.REC CR 13 SPACES ." -type- -sect- -b/rec-" LINES OFF BEGIN PAD DUP 80 R@ READH ( PAD) LEN \ while len > 0 WHILE SRC$ PAD POS$ IF CR PAD DIR.REC 1 LINES +! THEN SPACEBAR R@ ?BREAK-FILE REPEAT R> CLOSE CR LINES @ .FILE# CR R> BASE ! ; HEX : DIR ( <DSK?.> ) ARG$ 2DUP DEV./ OPEN-CATFILE >R \ push handle /FILENAME SRC$ PLACE PAD 50 R@ READH CR PAD HEAD.REC CR LINES OFF BEGIN PAD DUP 80 R@ READH ( PAD) LEN \ while len > 0 WHILE SRC$ PAD POS$ IF PAD 0C $.LEFT ?CR 1 LINES +! THEN SPACEBAR R@ ?BREAK-FILE REPEAT R> CLOSE DECIMAL CR LINES @ .FILE# CR HEX ; : MORE ( <filename>) ARG$ DV80 R/O OPEN >R BEGIN PAD DUP 50 R@ READ-LINE ?FILERR ( adr len flag) WHILE CR TYPE 1 LINES +! SPACEBAR R@ ?BREAK-FILE REPEAT R> CLOSE 2DROP BASE @ >R DECIMAL CR LINES @ . ." Lines" CR R> BASE ! ; : DEL ( <filename>) ARG$ DELETE-FILE ?FILERR ; : COPY-FILE ( addr len addr len -- ) DV80 W/O OPEN TO #2 DV80 R/O OPEN TO #1 52 DUP MALLOC >R LINES OFF SPACE BEGIN R@ 50 #1 READ-LINE ?FILERR ( -- #bytes eof?) WHILE R@ SWAP #2 WRITE-LINE ?FILERR LINES 1+! SPIN REPEAT R> DROP \ DROP buffer address from rstack ( 52) MFREE \ release the buffer memory #2 CLOSE #1 CLOSE BASE @ >R DECIMAL CR ." Copy complete. " LINES @ . ." records" R> BASE ! ; : COPY ( <file1> <file2> ) ARG$ ARG$ DST$ PLACE SRC$ PLACE DST$ COUNT /FILENAME NIP 0= IF SRC$ COUNT /FILENAME DST$ +PLACE THEN SRC$ COUNT DST$ COUNT COPY-FILE ; : CLOSE-ALL ( -- ior ) 0 \ place holder for error codes #FILES @ 1+ 1 DO I ]FID @ IF I CLOSE-FILE OR \ or the errors together THEN LOOP ?FILERR ; : CLS PAGE ; : HELP CR CR ." Commands" CR ." --------------------" CR ." DIR <DSK?.> show file names" CR ." CAT <DSK?.> show files and types" CR ." MORE <path> show contents of DV80 file" CR ." DEL <path> delete file at path" CR ." COPY <path1> <space> <path2> " CR ." Copy file at path1 to path2" CR ." CLS Clear screen" CR ." BYE Return to E/A Menu" CR ." HELP Show command list" CR CR ." Any key will stop scrolling" CR ." FNCT 4 halts operation" ; : SHELL L0 LP ! \ init LEAVE stack pointer LP RP0 RP! \ reset rstack RSTPAB CLOSE-ALL \ reset PAB stack in VDP RAM POSTPONE [ \ STATE = 0 (Interpreting mode) BEGIN CR ." >" TIB DUP TIB# ACCEPT SPACE ( -- adr len) \ accept input to TIB, maxlen=TIB# INTERPRET \ interpret reads the stack string STATE @ 0= IF ." ok" THEN \ if we are not compiling print OK AGAIN ; : START 80 83C2 C! ORGDP @ DP ! ORGLAST @ LATEST ! 26 TPAD ! 2000 H ! \ reset the heap TMR! \ set 9901 timer to count continously 2 KUNIT# C! \ keyboard #2 is the BASIC keyboard ['] <INTERPRET> 'INTERPRET ! DECIMAL TEXT ." Forth Shell V0.2" HELP SHELL ; \ patch shell as main interpreter, set dictionary pointers ' SHELL ' ABORT 6 CELLS + ! ' START BOOT ! DP @ ORGDP ! LATEST @ ORGLAST ! Binary files are here now: https://github.com/bfox9900/CAMEL99-V2/tree/master/DSK3 SHELL99.zip Edited January 22, 2019 by TheBF 4 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 22, 2019 Author Share Posted January 22, 2019 (edited) Shell Update Well... adding REGEX is kind of a big deal if you have ever tried to write one however how about simple string matching? From the CAMEL99 string package there is a routine called POS$. Sounds familiar to a TI BASIC programmer. So used POS$ to allow file name matching for the CAT and DIR commands. Something interesting (to me) was creating path-name cutters with the Forth word SCAN. Scan takes an address, a length in bytes and an ASCII character. It will give you a new address and len (ie a new string) cut at that location of the character. It's like LEFT$ and POS$ together. The reciprocal word in Forth is /STRING which cuts a stack string address/length pair but the a number you give it on the stack. It's like RIGHT$ in BASIC. Using Scan it was pretty simple to create a word to cut the device and word to cut the filename. \ file path cutters : /. ( caddr len -- caddr' len' ) [CHAR] . SCAN ; \ cut at '.' Common factor : DEV./ ( caddr len -- dev. len' ) 2DUP /. NIP - 1+ ; : /FILENAME ( caddr len -- filename len') /. 1 /STRING ; Using these words it was pretty simple to add filename smarts to CAT and DIR. I also changed COPY so that if you say: COPY DSK1.MYFILE DSK2. it will make a new file on DSK2. called MYFILE. If you give a new filename for DSK2. it will use that new file name. (I need to add protection from copying the same filename to the same disk!) Here is Version 0.2 in operation. I will replace the binary file in the earlier post. https://www.youtube.com/watch?v=9JCWTxiSRWw&feature=youtu.be Edited January 22, 2019 by TheBF 4 Quote Link to comment Share on other sites More sharing options...
+RXB Posted January 22, 2019 Share Posted January 22, 2019 (edited) Speaking of SAMS I have now the ability to change any 4K section including entire 32K from XB. The trick is done from GPL that does not need 32K and my BATCH file program CALL USER("device.filename") ! DV80 File As CALL USER runs from VDP buffer (>03C0) and GPL it does not care what RAM is swapped out or changed. USER loads a single line into VDP buffer and runs that line without needing any other instructions. This one is going to be tough to beat for innovation of changing RAM with no access need for RAM. Edited January 22, 2019 by RXB Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 22, 2019 Author Share Posted January 22, 2019 Speaking of SAMS I have now the ability to change any 4K section including entire 32K from XB. The trick is done from GPL that does not need 32K and my BATCH file program CALL USER("device.filename") ! DV80 File As CALL USER runs from VDP buffer (>03C0) and GPL it does not care what RAM is swapped out or changed. USER loads a single line into VDP buffer and runs that line without needing any other instructions. This one is going to be tough to beat for innovation of changing RAM with no access need for RAM. I think it's impossible with anything but GPL unless you replace GPL with a different interpreter. I don't think I will miss the lower section of SAMS. It takes Forth 20 secs to erase the leftover that I can use. That's like an I/O device rather than memory! But I think I can use it to built an editor capable of editing large files. BTW how long does it take GPL to erase the SAMS card? (Well most of it: 1M-64K was my test) Quote Link to comment Share on other sites More sharing options...
+RXB Posted January 22, 2019 Share Posted January 22, 2019 I think it's impossible with anything but GPL unless you replace GPL with a different interpreter. I don't think I will miss the lower section of SAMS. It takes Forth 20 secs to erase the leftover that I can use. That's like an I/O device rather than memory! But I think I can use it to built an editor capable of editing large files. BTW how long does it take GPL to erase the SAMS card? (Well most of it: 1M-64K was my test) Hmm why would you need to ERASE the card ? I mean how often does that need to be done? I just overwrite what is there but with 1 Meg of space, not like anyone has ever filled the card with 1 Meg yet? My INTHE DARK game in RXB used more of the SAMS then anyone previously ever did at 480K. Can you name anyone that wrote anything using over 400K of SAMS RAM memory? Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 23, 2019 Author Share Posted January 23, 2019 Hmm why would you need to ERASE the card ? I mean how often does that need to be done? It was a way to see how fast I could write to the card. It's just a benchmark. 1 Quote Link to comment Share on other sites More sharing options...
+RXB Posted January 23, 2019 Share Posted January 23, 2019 It was a way to see how fast I could write to the card. It's just a benchmark. Oh, well GPL is not really doing the work I have a imbedded Assembly routine that does the work. GPL CODE: ***************************************************** * SAMS replaced AMSPASS, AMSMAP, AMSOFF, AMSON * * CALL SAMS("PASS",...) * * CALL SAMS("MAP",...) * * CALL SAMS("OFF",...) * * CALL SAMS("ON",...) * ***************************************************** * SAMS replaced AMSBANK full RAM memory management * ***************************************************** * CALL SAMS(2,page,3,page,A,page,B,page,C,page, * * D,page,E,page,F,page,...) * * * * Numbers 2 is >2000, 3 is >3000 * * Letters A is >A000, B is >B000, C is >C000 * * Letter D is >D000, E is >D000, F is >F000 * * page now is SAMS 4K pages from 0 to 255 * ***************************************************** * LINK replaced EXECUTE so LINK will use address * ***************************************************** * BSAVE and BLOAD replaced with full memory address * * 4K RAM boundries same as SAMS addressing RAM * ***************************************************** SAMS DATA CHRALL STRI 'SAMS' DATA $+2 CALL COMB * ( ? ************************************************** * Get stirng or token or numeric * * String is for PASS,MAP,OFF, ON * * 2 and 3 are numeric as no token exist for them * * thus need a numeric interpetation for 2 and 3 * * A, B, C, D, E, F are tokenized already for use * ************************************************** SAMS2 XML PGMCHR * Skip ( OR COMMA CEQ >C7,@CHAT * STRING? BR SAMSPS * Must be a TOKEN? SAMSTR CALL STRPAR * GET STRING? CEQ >65,@FAC2 * STRING? BR ERRBV * ERROR BAD VALUE DCZ @FAC6 * 0 Length? BS ERRBA * ERROR BAD ARGUMENT DCEQ >5041,V*FAC4 * PA? PASS MODE BR AMSMAP * SAMS MAP * CALL AMSPASS ************** CALL PASAMS * SAMS PASS BR SAMS3 * CHECK FOR COMMA AMSMAP DCEQ >4D41,V*FAC4 * MA? MAP MODE BR AMSOFF *SAMS OFF * CALL AMSMAP *************** CALL MAPAMS * SAMS MAP BR SAMS3 * CHECK FOR COMMA AMSOFF DCEQ >4F46,V*FAC4 * OF? SAMS OFF BR AMSON * SAMS ON * CALL AMSOFF *************** CALL OFFAMS * AMS OFF BR SAMS3 * CHECK FOR COMMA AMSON DCEQ >4F4E,V*FAC4 * ON? SAMS ON BR ERRBA * ERROR BAD ARGUMENT * CALL AMSON **************** CALL ONAMS * AMS ON BR SAMS3 * CHECK FOR COMMA ****************************************************** * Moves 12 bytes ASSEMBLY into >8300 Scratch Pad RAM * * Executes address at >8300 BLWP FAC & ARG workspace * ****************************************************** PASAMS CALL AMSSUB * AMS PASS SUBROUTINE DST >1E01,@STORE * LOAD PASS VALUE BR SAMSUB * EXECUTE IT ONAMS CALL AMSSUB * AMS ON SUBROUTINE DST >1D00,@STORE * LOAD ON VALUE BR SAMSUB * EXECUTE IT OFFAMS CALL AMSSUB * AMS OFF SUBROUTINE DST >1E00,@STORE * LOAD OFF VALUE BR SAMSUB * EXECUTE IT MAPAMS CALL AMSSUB * AMS MAP SUBROUTINE DST >1D01,@STORE * LOAD MAP VALUE SAMSUB XML >F0 * EXECUTE ASSEMBLY RTN * RETURN ********************************************************** * MOVES CPU PROGRAM TO SCRATCH PAD * AMSSUB MOVE 18,G@AMSCRU,@>8300 * GET ASSEMBLY FROM GROM * RTN * RETURN * ********************************************************** * SAMS PAGE CHANGE ****************************************************** * SAMS PAGES 2,3,A,B,C,D,E,F TOKENS * * PAGES range from 0 to 255 now instead of 16 to 255 * * Also now all SAMS RAM range not just lower 8K * ****************************************************** SAMSPS CALL SAMS4A * ADDRESS IN TEMP & PUSHED CEQ COMMAZ,@CHAT * COMMA? BR ERRSYN * ERROR SYNTAX XML PGMCHR * Skip COMMA CALL STRPAR XML CFI * PAGE Convert to integer CALL MAPAMS * AMS MAP CALL ONAMS * AMS ON * TEMP has RAM address >A000 up to >F000 * Shift address to be 2* value for SAMS register * i.e. >F0 would be >1E so >401E would be register SRL 3,@TEMP * MOVE TO LOWER NIBBLE EX @TEMP+1,@TEMP * SWAP byte locations ST @FAC1,@4000(@TEMP) * SET PAGE CALL OFFAMS * AMS OFF SAMS3 CEQ COMMAZ,@CHAT * COMMA? BS SAMS2 SAMS4 CEQ RPARZ,@CHAT * )? BR ERRSYN * SYNTAX ERROR XML PGMCHR * Skip ")" CALL RETURN * RETURN TO CALLER **************************************************** * SAMS PAGES 2,3,A,B,C,D,E,F * * Get 2 and 3 numeric or A to F tokens * * input in CHAT is >C8 is numeric or must be token * * output TEMP has RAM ADDRESS of 4K page to save * **************************************************** SAMS4A CEQ >C8,@CHAT * NUMBER? BR SAMSAL * No must be 2 or 3 or A to F CALL STRPAR * Get number XML CFI * Convert to integer CHE 4,@FAC1 * 1 or higher BS ERRBV * ERROR BAD VALUE DST >2000,@TEMP * Defualt address CEQ 2,@FAC1 * 2? BS SAMSP3 * Ok so exit CHE 4,@FAC1 * 4 or higher? BS ERRBV * ERROR BAD VALUE ADD >10,@TEMP * Get address SAMSP3 RTN * RETURN * 24K ADDRESS PAGES SAMSAL CHE >47,@CHAT * G OR HIGHER BS ERRBA * ERROR BAD ARGUMENT CHE >41,@CHAT * A OR HIGHER? BR ERRBV * ERROR BAD VALUE ST @CHAT,@ARG * Save TOKEN SUB >41,@ARG * 0 TO 5 DST >A000,@TEMP * Default value SAMSLP CZ @ARG * 0? BS SAMSD * RETURN ADD >10,@TEMP * >B000 TO >F000 DEC @ARG * 5 TO 1 B SAMSLP * LOOP FOREVER SAMSD XML PGMCHR * SKIP TOKEN RTN * RETURN ********************************************************** Assembly code: *********************************************************** * CPU PROGRAM FOR >8300 SCATCH PAD SUBROUTINE AMSCRU * *********************************************************** * * AORG >8300 AMSCRU DATA >8302 * AMSCRU DATA >8302 * First address. DATA >C04C * MOV R12,R1 * Save R12 DATA >020C * LI R12,>1E00 * Load CRU bits DATA >1E00 * DATA >1D00 * SBO 0 * Set bits ones DATA >C301 * MOV R1,R12 * Restore R12 DATA >04E0 * CLR @>837C * Clear for GPL DATA >837C * DATA >045B * RT * Return to GPL. * END *********************************************************** * CPU PROGRAM FOR >8300 SCRATCH PAD CPU ISR HOOK ON * *********************************************************** * * AORG >8300 GISRON DATA >8302 * DATA >8302 DATA >C820 * MOV @>834A,@>83C4 DATA >834A * DATA >83C4 * DATA >04E0 * EXIT CLR @>837C DATA >837C * DATA >045B * RT * * END *********************************************************** * CPU PROGRAM FOR >8300 SCRATCH PAD CPU ISR HOOK OFF * *********************************************************** * AORG >8300 GISROF DATA >8302 * DATA >8302 DATA >C820 * ISROFF MOV @>83C4,@>83C4 DATA >83C4 * DATA >83C4 * DATA >1305 * JEQ NHOOK DATA >C820 * MOV @>83C4,@>834A DATA >83C4 * DATA >834A * DATA >04E0 * NHOOK CLR @>83C4 DATA >83C4 * DATA >04E0 * CLR @>837C DATA >837C * DATA >045B * RT * * END *********************************************************** * CPU PROGRAM FOR >8300 SCATCH PAD SUBROUTINE EXECUTE * *********************************************************** * AORG >8300 CPUPGM DATA >8302 * CPUPGM DATA >8302 First address. * DATA >0420 * BLWP @>834A Switch contex * DATA >834A * FAC not used * DATA >04E0 * CLR @>837C Clear for GPL * DATA >837C * * DATA >045B * RT Return to GPL. * * END * *********************************************************** Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 23, 2019 Author Share Posted January 23, 2019 Ah yes. I see some familar ASM code there. I have never tried GPL, but I see that, like Forth, you use machine code to insert the Assembler output into the code. in Forth I have to load the assembler, assemble the ASM code, then use DUMP to see the machine code. Then I have to manually type the machine code data back into my source file. That's not to hard on a windows machine, but would be a total PITA on real hardware. I have a project on the stack that will let you output the machine code for any "code" word to a file, in source code format, so you can insert the file into the editor. I can already do the output to the screen, I just need to get some vectored I/O working to send output to a file. So much code, so little time. 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 23, 2019 Author Share Posted January 23, 2019 (edited) Rich, you got me thinking. I was spinning on adding i/o re-direction to CAMEL99 Forth which would mean changing the kernel quite a bit. Then I realized that what I wanted was a way to get the text from the screen into a file. The VDP screen is just a big text buffer! So why not just capture the screen to a file. In real hardware save it to disk. In CLASSIC99 save it to CLIP and paste into your code. Now that this little system has a healthy bunch of widgets it took very little to make a screen capture utility \ ti-99 screen capture utility for CAMEL99 Forth BJF Jan 2019 NEEDS WRITE-LINE FROM DSK1.ANSFILES VARIABLE HNDL \ holds file handle : (CAPTURE) ( -- ) VROW 2@ 2>R \ save screen xy L/SCR 0 \ capture all lines DO 0 I AT-XY VPOS PAD C/L@ VREAD PAD C/L@ HNDL @ WRITE-LINE ?FILERR LOOP HNDL @ CLOSE-FILE ?FILERR 2R> AT-XY ; \ restore screen xy : CAPTURE ( <PATH> ) BL PARSE-WORD ( -- $addr len ) DV80 W/O OPEN-FILE ?FILERR HNDL ! (CAPTURE) ; Edited January 23, 2019 by TheBF 3 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted January 23, 2019 Share Posted January 23, 2019 Ah yes. I see some familar ASM code there. I have never tried GPL, but I see that, like Forth, you use machine code to insert the Assembler output into the code. in Forth I have to load the assembler, assemble the ASM code, then use DUMP to see the machine code. Then I have to manually type the machine code data back into my source file. That's not to hard on a windows machine, but would be a total PITA on real hardware. I have a project on the stack that will let you output the machine code for any "code" word to a file, in source code format, so you can insert the file into the editor. I can already do the output to the screen, I just need to get some vectored I/O working to send output to a file. So much code, so little time. fbForth has ASM>CODE (ported from TurboForth’s word of the same name), which might guide your composing such a word in Camel99 Forth. It starts in block #39 of FBLOCKS and is described on page 182 in the glossary of the manual. ...lee 1 Quote Link to comment Share on other sites More sharing options...
+RXB Posted January 23, 2019 Share Posted January 23, 2019 TheBF Well the most bytes I put into Scratch RAM for SAMS is 18 bytes. (No assembler needed for that few bytes) And I use FAC & ARG as Assemlby WorkSpace thus FAC (>834A) contains the value passed to or from XB in Register 0. Value from XB is converted first with CFI and from Assembly to XB is CIF. Which by convenience sake is in FAC for both. Works out very little code is needed to do alot. Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 23, 2019 Author Share Posted January 23, 2019 fbForth has ASM>CODE (ported from TurboForth’s word of the same name), which might guide | your composing such a word in Camel99 Forth. It starts in block #39 of FBLOCKS and is described on page 182 in the glossary of the manual. ...lee Thanks Lee. I will take a look at it. I have something working, but's always good to compare notes. Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 23, 2019 Author Share Posted January 23, 2019 There is a sacred commandment in Forth that goes: "Thou shalt never ROLL". ROLL is a word that re-organizes the stack arguments in a circular fashion. ( 1 2 3 4 3 ROLL becomes 2 3 4 1 It's typically very slow and indicates that you didn't plan your code well if you are delivering arguments in messed up order to your routines. However … While reading through FBForth's block source code I found this GEM and the cleverness of it deserves a mention. (Recursive code always make me quiver a little) I modified it just slightly to be ANS Forth and added comments to pacify my aching brain a little. ( The source for ROLL was Marshall Linker via George Smyth's Forth Forum) : ROLL ( [n]..[0] +n -- [n-1]..[0][n] ) ?DUP \ DUP TOS if <> 0 (TOS = top of stack) IF \ if that's true... 1- SWAP >R \ decrement TOS , push to Return stack RECURSE \ call ROLL R> SWAP \ POP the return stack and SWAP with TOS THEN ; To learn the definition of RECURSE, see RECURSE 2 Quote Link to comment Share on other sites More sharing options...
Like us on Facebook
Follow us on Twitter
AtariAge on Instagram
Watch us on YouTube
Chat on Discord
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.