Jump to content
IGNORED

Camel99 Forth Information goes here


TheBF

Recommended Posts

After playing with this code I realized that MAP was a general purpose routine.

\ Forth translation of same word in TurboForth
: MAP  ( bank addr -- ) \ ASM converted to Forth
         F000 AND  0B RSHIFT 4000 +
         SWAP 00FF AND  DUP >< OR   \ Hi & lo bytes are now identical
         SWAP ( -- bank address)
         1E00 CRU! SBO              \ enable SAMS card
         !                          \ store bank in SAMS register
         SBZ ;                      \ disable SAMS card

I didn't need general purpose for the following reasons:

  1. I didn't need to protect from mapping to a non-4k boundary. I use a constant (MBLOCK)
  2. I don't need to re-calculate the SAMS register every time cuz I always use >2000
  3. The bank# is computed will not exceed >FF
  4. I could remove ' >< OR' because CAMEL99 has 'FUSE' which "fuses" 2 bytes into an integer

 

So with all that considered I could remove MAP entirely and just put the remaining code in >BANK.

 

One very Forthy thing I did was moving the calculation of the correct SAMS register to compile time.

This register is calculated based on the constant MBLOCK at compile time but kept in the code as one literal number.

 

So >BANK now becomes this and saves about 36 bytes!

HEX
: >BANK  ( 32bit -- addr)           \ must have 32bit address!!
         B/BANK UM/MOD  1STBANK +   ( -- offset bank#+1STBANK)
         BANK# @ OVER <>            \ do we need to change banks?
         IF   DUP BANK# !           \ update bank#
              DUP FUSE              \ Hi & lo bytes are now identical

         \ compute SAMS register for address=MBLOCK at compile time
            [ MBLOCK 0B RSHIFT 4000 + ] LITERAL

              1E00 CRU! SBO        \ enable SAMS card
            ( bank# register) !    \ store bank in SAMS register
              SBZ                  \ disable SAMS card

         ELSE DROP                 \ not needed. Drop the bank#

         THEN MBLOCK OR            \ return the address in mapped block
;
Link to comment
Share on other sites

  • 2 weeks later...

Super Simple ENUMERATORs in Forth

 

​Many high level languages have a way to create a set of named values that are sequential.

​Forth does not have such a thing out of the box but it is a one-liner to add 'ENUM' to the language

​thanks to the mind of the late Neil Baud, an innovative Forth developer.

\ ENUM  made with CONSTANT  from Neil Baud's Toolbox

: ENUM  ( 0 <text> -- n) DUP CONSTANT  1+ ;

Now to make a set of enumerated values in our program we simply do:

0 ENUM Q
  ENUM R
  ENUM S
  ENUM T
  ENUM U
  ENUM V
  ENUM W
  ENUM X
  ENUM Y
  ENUM Z
  DROP

We now have a set of named numbers from 0 to 9.

Edited by TheBF
  • Like 1
Link to comment
Share on other sites

Creating a Fast Text Driver that Supports Multi-tasking

 

I had been spinning for some time on creating a small but fast set of words to emit text to the screen.

I have played with a number of ways to do it which all work but also were not optimal for speed.

 

I found the screen display of Turbo Forth to be quite enviable. :-)

 

My problem was that I wanted my scroll routine to be in Forth for instructional purposes and it's painful to call Forth from an Assembler word. (not impossible but just kind of silly) I also needed to interact with the Forth word PAUSE which switches tasks. So the final routines had to be Forth. But writing it all in Forth was 25% ..30% slower than the benchmark.

 

I think I have finally realized how to do it. I created two primitives in Assembler. One that does a newline (carriage return in Forth parlance) and one to "emit" a character to the screen.

 

The difference was to have both primitives return a true/false flag. With that all the hard stuff is in Assembler and the flag lets me know if I have to SCROLL or CR.

 

The whole thing got so simple by adding the output flag and it's now about as FAST as TF. (about 90% for text, number conversion is still in Forth...)

: CR          ( -- )                        \ Forth's "newline"
              (CR) ( -- ?)                  \ (CR) returns TRUE if we have to scroll
              IF  SCROLL  THEN ;

: EMIT        ( char -- )
             (EMIT)  ( -- ?)                \ write char, return true if we need to CR
              IF  CR THEN PAUSE ;

Here are the ASM words.

CODE: (CR)    ( -- ? )  \ return true if we need to SCROLL
              TOS PUSH,
              TOS CLR,
             _OUT  @@ CLR,
             _VCOL @@ CLR,
             _VROW @@ INC,
              W  _L/SCR LI,
             _VROW @@ W CMP,
              EQ IF,
                  TOS SETO,
              ENDIF,
              NEXT,
              END-CODE

 CODE: (EMIT) ( char -- ?)  \ (emit) returns true if we need to CR
             _VROW @@ R1 MOV,
             _C/L  @@ R1 MPY,
             _VCOL @@ R2 ADD,           \ fetch _VCOL and add to R0
              R2 R0 MOV,
              WMODE @@ BL,              \ call: setup VDP address in "write mode"
              TOS SWPB,
              TOS VDPWD @@ MOVB,        \ write char to vdp data port
             _OUT  @@ INC,              \ count chars since last Carriage return
             _VCOL @@ INC,              \ advance the column variable

              TOS CLR,                  \ clear TOS. It' the output flag
             _C/L  @@ _VCOL @@ CMP,     \ compare column variable to chars per line var
              EQ IF,
                  TOS SETO,             \ set TOS to true, we need a new line
              ENDIF,
              NEXT,
              END-CODE
Edited by TheBF
  • Like 1
Link to comment
Share on other sites

I am sure I asked @Willsy this same question about TurboForth years ago: What about BEL, BS, CR and LF as characters for EMIT ? On the face of it, it is not particularly important except that I pretty much have no choice in fbForth but to process them as inherited from TI Forth, which is to say, BEL (ASCII 7) does nothing but ring the bell (TI GPL “beep”), BS (ASCII 8 ) must backspace over (thus erasing) the last-typed character, LF (ASCII 10) goes to the same position in the next line, scrolling if it is past the end of the screen, and CR (ASCII 13) goes back to the beginning of the current line. Any other ASCII characters are assumed to be printable. I did think seriously about doing it the way it seems you and @Willsy are doing it, but decided it might break TI Forth code it did not need to break.

 

In fbForth, EMIT calls a low-level ALC routine that includes scrolling. There is also EMIT8 to allow printing/displaying of 8-bit codes (ASCII 128 – 255).

 

Anyway, thought I would put it out there. :)

 

...lee

Link to comment
Share on other sites

I am sure I asked @Willsy this same question about TurboForth years ago: What about BEL, BS, CR and LF as characters for EMIT ? On the face of it, it is not particularly important except that I pretty much have no choice in fbForth but to process them as inherited from TI Forth, which is to say, BEL (ASCII 7) does nothing but ring the bell (TI GPL “beep”), BS (ASCII 8 ) must backspace over (thus erasing) the last-typed character, LF (ASCII 10) goes to the same position in the next line, scrolling if it is past the end of the screen, and CR (ASCII 13) goes back to the beginning of the current line. Any other ASCII characters are assumed to be printable. I did think seriously about doing it the way it seems you and @Willsy are doing it, but decided it might break TI Forth code it did not need to break.

 

In fbForth, EMIT calls a low-level ALC routine that includes scrolling. There is also EMIT8 to allow printing/displaying of 8-bit codes (ASCII 128 – 255).

 

Anyway, thought I would put it out there. :)

 

...lee

 

Yes I studied TI-Forth Emit code and saw that. I handle the backspace char in ACCEPT but that's the only control character that I handle.

It seemed a little pointless on the VDP to deal with these where we are talking to a memory mapped device.

I suppose I could deal with ^G to beep and ^J and ^M to CR/LF.

 

Does the TI file system have a EOL delimiter? I have not seen one. In the 1970's this may not have been very normal.

 

If I ever wake up the real iron here then I would have to write a different version to talk over RS232. I would probably use vector I/O for that. That's what I have done in the past.

So just vector in a 232-EMIT and 232-KEY and call it a day.

 

In Forth 2012 EMIT gives you quite a bit of freedom. TI-Forth's interpretation is valid ... as is TF and CAMEL99. :)

EMIT
( x -- ) 
If x is a graphic character in the implementation-defined character set, display x. The effect of EMIT for all other values of x is implementation-defined. 
When passed a character whose character-defining bits have a value between hex 20 and 7E inclusive, the corresponding standard character, 
specified by 3.1.2.1 Graphic characters, is displayed. Because different output devices can respond differently to control characters, 
programs that use control characters to perform specific functions have an environmental dependency. 
Each EMIT deals with only one character. 

Thanks for keeping me honest.

Link to comment
Share on other sites

...

Does the TI file system have a EOL delimiter? I have not seen one. In the 1970's this may not have been very normal.

...

 

Usually, DV files store packed (or counted) strings, i.e., a string-length byte followed by the string. Specific programs might do their own thing. TI Writer comes to mind.

 

...lee

Link to comment
Share on other sites

Version 1.99 Update.

 

I found some ways to save 100 bytes in the final binary which let me compile GRAFIX and CRU word sets.

 

A lot of things were changed as I continue to beat up this little system.

 

 

=============================================================
Feb 3 2018 Version 1.99
Looking for space savings and efficiency:
KEY operation
Replaced (KEY?) CODE word with a smaller version called KEY?
Now WARM sets the correct value for KUNIT# on startup. (I read the fine print on the matter)
Default value is now 2 (BASIC keyboard)
You can change the keyboard by setting byte variable KUNIT# TO 0,1 OR 2
\ example: 1 KUNIT# C!
Change to screen driver
------------------------
Kernel Changes:
Removed VEMIT and <CR>
Replaced with (EMIT) and (CR)
Both of these words return a flag if we need to CR or SCROLL respectively.
Forth words CR and EMIT are greatly simplified now.
NEW word: WARM
COLD does a cold boot and CALLs WARM.
- WARM keeps the dictionary intact.

Simplified ." (dot-quote) using ideas from Neil Baud. Allowed the removal of ,"
Comma-quote has been moved to the \lib folder if you need it.
Dot quote now works in IMMEDIATE mode as well as compiling.
It is an evil state smart word now.
Per above change I removed the talking comment .( from the kernel and put it in \lib folder.
This is allowed under Forth 2012 but not allowed under Forth 94.
Changed machine code in DOES> to BRANCH to DODOES rather than BRANCH&LINK.
This was an error that didn't seem to create a bug for me but it would use R11 needlessly
and is a hair slower.
----------------------------
GRAFIX2.HSF
Added 1+ to COLORS word so that the colorset range you select works as expected.
----------------------------
CRU.HSF
I now include a CRU wordset in the kernel.
This allows implementation of SAMS 1Mbyte memory card words.
See \CCLIB\CRU.HSF
------------------
SAMS card support
See \DEMO\BANK.FTH for examples of how to use SAMS card to create large arrays.
-----------------
SPRITES.FTH
Removed motion table support. I tend to use direct control of sprites and I needed I would use
the multi-tasker. Added new words that directly control SPRITES in the VDP memory space.
But retained the first system of keeping a mirror in CRU RAM that is updated all at once.
SP.WRITE now replaces SP.SHOW to write the CPU ram table into VDP ram for all created sprites.
See the source file for the new words.
-----------------
XFC99 CROSS-COMPILER CHANGES:
Fixed problem with HEADLESS word so it works now.
Used HEADLESS to remove ADR>IN word from searchable dictionary.
It is used by PARSE AND PARSE-NAME but is not useful by itself.
Edited by TheBF
  • Like 1
Link to comment
Share on other sites

  • 3 weeks later...

CAMEL99 Version 2 Update Mar 18 2012

 

I made a focused effort over the past week to get a functioning device service routine working.

 

I chose to write it in Forth with only a few lines of Assembler to call the system.

I plan to document what I learned in the DSR Tutorial thread for any others that might want to write one in some other language.

 

With Version 2 CAMEL99 Forth leaves childhood behind and becomes an adult.

By stripping back a few thing in the KERNEL and creating the file access words CAMEL99 can now extend itself with ordinary TI-99 DV80 files.

 

The magic ANS Forth word is called 'INCLUDED' and it is built into the V2 kernel.

INCLUDED takes a "stack string" as an input parameter which is the address of the text and the length on the Forth data stack.

 

I have settled on using DISPLAY VARIABLE 80 files for the source code with the file extension '.F'

 

When the Version 2 kernel starts it runs:

 

S" DSK1.INI.F" INCLUDED

 

which adds 2 new words to the system.

Its a pretty fast startup because this is all it contains at the moment:

: INCLUDE    BL PARSE-NAME INCLUDED ;

: .FREE      CR ." Free Mem"
             3F20 H @  - CR ." Low Heap : " U.
             FF00 HERE - CR ." Upper mem: " U.  ;
DECIMAL
CR .FREE
HEX

After INI.F compiles you can say:

 

INCLUDE DSK2.TOOLS.F

INCLUDE DSK1.GRAFIX.F

 

At this time INCLUDEs cannot be nested inside other includes because I have only 1 peripheral access block.

 

I will be moving to a "handle" based file system which is a better fit to ANS/ISO Forth and then files will be able to INCLUDE other files to a depth set by the "FILES" word.

 

Currently using the E/A Editor I can make programs as text files, save them by name, and compile them into CAMEL99 Forth.

So it is actually a development system now like the EDITOR/Assembler combination.

 

Using variable files means no space is wasted at the end of lines in the text so this should make it pretty efficient.

The compiler looks like it compiles about 20 lines per second in preliminary testing, but I will compile something big as see how that goes.

​Edit: Looks like it's more like 14 lines/sec or 840 lines/minute. Not too shabby for a TI-99.

 

I have created a large set of library files that I used to test the prototype system V1.99

I am converting those files to DV80 format so the system will have an ASSEMBLER, SPRITES, GRAFIX, TOOLS etc. and lots of DEMO programs.

 

This is a personal milestone as I dreamt about building a Forth cross-compiler that could build a TI-99 Forth system 10 years ago but corporate life prevented much progress.

A "wee dram" of whisky might be in order tonight! :-)

 

Of course the ultimate goal is to make a system than can re-build itself... but I better not get ahead of myself.

 

There's a new bottle of Crown Royal Northern Harvest (whisky of the year) with my name on it... bye for now.

 

B

post-50750-0-18382400-1521427175.jpg

Edited by TheBF
  • Like 2
Link to comment
Share on other sites

I spent a lot of time this week refining and re-factoring file access code so I can extend it with a handle based file system.

I am getting there. I looks like I can implement some a partial working ANS/ISO Forth file wordset in about 1.5K on top of the kernel.

It's big for this little system but the design was made for desktop machines so I may have to make an smaller alternative.

 

I look forward to being able to list directories, copy files and have a MORE utility for TI files.

 

Here is the final DSR code written in XFC99 cross-compiler Forth

By way of explanation [CC] is a short form for CROSS-COMPILING which lets you do thing with PC Forth interpreter when you need to.

[TC] is short for TARGET-COMPILING which engages the TMS9900 compiler and so you can't run that code on the PC, you can only compile.

 

The DSR code adds 299 bytes to the system which is bigger than ASM but about 130 bytes is labels and linked list headers.

​I could strip some of that our with [PUBLIC] [PRIVATE] directives but I won't do that until I have tried making some new device access code.

TARGET-COMPILING

2000 VALUE: DSRWKSP \ workspace in LOW RAM

\ ========================================================
               [CC] [PUBLIC] [TC]

\ This is the code used to CALL the DSR ROM code
CODE: CALLDSR ( -- )         \ *called with Forth word BLWP
             83E0 LWPI,      \ change to GPL workspace
            *R9 BL,          \ GPL R9 already has the entry address
             0BF0 DATA,      \ This normally has DATA 8 in it. :-)
             DSRWKSP LWPI,   \ back to the dummy workspace
             RTWP,           \ Return to Forth
             NEXT,
END-CODE


\ Create the VECTOR that we call with BLWP.
\               workspace    compile program address
\               ---------    -----------------------
CREATE: DSKLNK   DSRWKSP T,  T' CALLDSR [CC] >BODY T, [TC]


\ ========================================================

\                [CC] [PRIVATE] [TC]
 \ Define PAB constants
[CC] HEX [TC]
 1100 CONSTANT: DSKCARD   \ No need to scan for the Floppy DISK CARD. It's here
 4000 CONSTANT: 'ID       \ DSR ROM header addresses
 4008 CONSTANT: 'DSRLIST

\ Create the DSR card scanner
[CC] HEX [TC]

CREATE: DEV$   [CC] 08 TALLOT  [TC]  \ holds the device name: RS232 DSK3

: /DOT    ( caddr len -- caddr len')  \ cut string at the dot
           2DUP T[CHAR] . SCAN NIP -  ;

\ : >DSR$   ( link -- $) 4 +  ;     \ add 4 to the link gets to the DSR$

: =$ ( $1 $2 -- flag) OVER C@ 1+ S= 0= ; \ compare 2 counted strings

\ DSRFIND searches for a matching device NAME in the DSR ROM
\ It returns the link-address. Link-address+2 = runnable code address
: DSRFIND ( addr len -- link_addr)
           /DOT DEV$ PLACE
           'DSRLIST                    \ 1st LINK in ROM linked list
           BEGIN
              @                        \ fetch the next link
              DUP 0=                   \ test for end of list
              SWAP DEV$ OVER 4 +  =$   \ test string match in ROM
              ROT OR                   \ if either is true we're done.
           UNTIL ;

\               [CC] [PUBLIC] [TC]

\ card control lexicon
: Enable   ( CRU -- )
           CRU@ OVER <>               \ is this a different card?
           IF   0SBZ                  \ if so, turn it off
           THEN CRU! 0SBO ;           \ then turn on the requested card

: Disable  ( CRU -- )  CRU! 0SBZ ;

\ hi level commands
: DiskON  ( -- ) DSKCARD  DUP 83D0 ! Enable ;  \ 99-4A needs CRU copied to 83D0 (magic)
: DiskOFF ( -- ) DSKCARD  Disable ;

The Spoiler contains the kernel file access section. It's not beautiful but it works and so I will lock it down for while.

 

The secret to extending it is the word PAB which returns the value of a pointer ^PAB. This pointer will be changed by a file handle issued by the system.

The top of VDP memory will be a "stack" of PABs. (what else would it be. It's Forth :-) )

I will need a corresponding set of CPU buffers that will keep in LOW RAM.

That's the theory anyway.

 

 

 

[CC] HEX  [TC]

\ PAB location and size
 3EDF CONSTANT: PAB0    \ 1ST peripheral access block at top of VDP RAM
   20 CONSTANT: PSIZE     \ size of a PAB in CAMEL99 Forth 32 bytes

VARIABLE: ^PAB   [CC] PAB0  ^PAB T!
VARIABLE: HNDL            \ file handle most recently issued

[TC]
\ fast fetch of pab pointer
CODE: PAB   ( -- adr) TOS PUSH,  ^PAB @@ TOS MOV,  NEXT, END-CODE

\  RAM<->VDP string transfers
: VPLACE   ( $addr len Vaddr -- ) 2DUP VC! 1+ SWAP VWRITE ;
: VGET     ( Vaddr len $addr -- ) 2DUP C!  1+ SWAP  VREAD ;

\ PAB fields:
\ these are 8 bytes smaller than Forth code & ASM is faster
CODE: _FAM    ( addr -- addr') CODE[ 1+ ]  NEXT, END-CODE \ FAM -> "file access mode"
CODE: _FBUFF  ( addr -- addr') CODE[ 2+ ]  NEXT, END-CODE
CODE: _RECLEN ( addr -- addr') TOS 4 ADDI, NEXT, END-CODE
CODE: _CHARS  ( addr -- addr') TOS 5 ADDI, NEXT, END-CODE
CODE: _REC#   ( addr -- addr') TOS 6 ADDI, NEXT, END-CODE
CODE: _FNAME  ( addr -- addr') TOS 9 ADDI, NEXT, END-CODE

[CC] HEX [TC]
\ PAB FLAGS/STATUS field access words
: PAB_FLG!    ( c-- ) PAB _FAM VC! ;
: PAB_FLG@    ( -- c) PAB _FAM VC@ ;

: ERR@    ( -- n)  \ wrong comment removed
          PAB_FLG@ 5 RSHIFT ;    \ shift error bits down

: FILEOP  ( opcode -- err)         \ TI99 O/S call
          PAB VC!                  \ write opcode byte to VDP PAB
          PAB_FLG@ 1F AND PAB_FLG! \ clear err code bits
          0 GPLSTAT C!             \ clear GPL status register
          DISKON
          DSKLNK BLWP ERR@
          DISKOFF  ;

\ DSR error handlers
: ?CARDID  ( -- )      'ID C@ AA <> TS" CARD not found" ?ABORT ;
: ?DEVERR  ( link -- )  0= TS" Device not found" ?ABORT ;
\ generic file error handler
: ?FILERR  ( ior -- ) ?DUP IF T."  File Err " .  ABORT THEN ;

\ MAKEPAB writes PAB directly to VDP ram 1 field at a time.
\ Returns address of filename at the first '.'  ex: .TEST
: MAKEPAB  ( addr len -- real-PAB-addr)
             PAB PSIZE 0 VFILL             \ erase the VDP PAB to be safe.
             PAB 20 +  PAB _FBUFF V!       \ set FBUFF 32 bytes past PAB
             14   PAB _FAM    VC!          \ default to: DISPLAY,VARIABLE
             50   PAB _RECLEN VC!          \ 80 bytes/record
             2DUP PAB _FNAME VPLACE        \ dup & write string to PAB
             /DOT NIP 1+ ( -- n)           \ compute offset upto '.' in string
             PAB _FNAME + ;                \ add offset to PAB _FNAME
                                           \ *this is the PAB address for the ROM code

\ : CELLS  2* ;
\ : CELL+  2+ ;

\ address navigation helpers.
: REG#    ( workspace R# -- addr)  2* + ;      \ COMPUTE address of R# in workspace
: >ENTRY  ( DSRlink -- entry_addr) 2+ @ ;      \ convert a LINK in ROM to code entry
 
: NEWFILE ( $addr len readpab -- ) \  *STACK PICTURE*
         -ROT            ( -- realpab $addr len )
         DiskON ?CARDID                           \ abort if card is not 'AA'
         DSRFIND         ( -- realpab link)
         DUP ?DEVERR                              \ ABORT if link=0
         DUP 4 +         ( -- link $)             \ link+4=DSR$ ie: the name of the DSR
             C@ 8355 C!                           \ len(DSR$) -> hex8355
                         ( -- link)
         >ENTRY  83E0 9 REG# !                    \  DSR code entry into GPL.R9
        ( -- realpab ) 8356 !                     \ the "REAL" PAB file name stored here
;

\ return VDP buffer and characters read as a Forth stack string
: VDATA    ( -- vaddr len) PAB _FBUFF V@  PAB _CHARS VC@ ;

0 VALUE: FBUFFER       \ File buffer is in HEAP. Needs MALLOC at startup

: REFILL  ( -- flag )  \ flag=true if there is more data
           2 FileOp DUP
           0= IF  VDATA FBUFFER VGET
              THEN 5 <> ;  \ ERROR #5 is READ past EOF

\ VARIABLE: LINES \ moved to main program

\ load file primitive
: (LD)  ( -- )
            LINES OFF
            BEGIN
                REFILL
            WHILE
                FBUFFER COUNT INTERPRET       \ interpret the new string
                1 LINES +!
            REPEAT ;

: .LOC ( -- ) LINES @ . T." lines" ;   \ print lines of code compiled

\ this word bootstraps the system at by "FLOADing" a file on startup.
\ typically DSK1.START
: INCLUDED  ( caddr len -- )
           CR T." Loading: " 2DUP TYPE
           SOURCE 2>R  >IN @ >R         \ save input
           2DUP MAKEPAB ( -- $addr len realpab)
           NEWFILE   0 FILEOP ?FILERR   \ open file
           1 SOURCE-ID !                \ indicate input is file
            (LD)                        \ read file
             1 FILEOP ?FILERR           \ close file
           R> >IN !  2R> 'SOURCE 2!     \ restore input
           SOURCE-ID OFF                \ indicate we are on console
           CR .LOC
           CR QUIT ;

 

 

Edited by TheBF
  • Like 3
Link to comment
Share on other sites

CAMEL99 FORTH Version 2.1 is available on GitHub

 

I put up the preliminary binary of CAMEL99 V2 with some TI Format source code files; just utiltiies and examples mostly.

 

https://github.com/bfox9900/CAMEL99-V2

 

It's pretty fun to play with now. I need to make a more integrate editor and then it would be a proper development system.

I have problems still with nested INCLUDEs so I am working through that.

 

The little movie shows you how it operates.

To my knowledge this is the first TI-Forth that only uses files for source code. So we have moved the state of the art all the way up to 1994! :-)

 

 

 

 

CAMEL2.mp4

  • Like 3
Link to comment
Share on other sites

CAMEL99 FORTH Version 2.1 is available on GitHub

 

I put up the preliminary binary of CAMEL99 V2 with some TI Format source code files; just utiltiies and examples mostly.

 

https://github.com/bfox9900/CAMEL99-V2

 

It's pretty fun to play with now. I need to make a more integrate editor and then it would be a proper development system.

I have problems still with nested INCLUDEs so I am working through that.

 

The little movie shows you how it operates.

To my knowledge this is the first TI-Forth that only uses files for source code. So we have moved the state of the art all the way up to 1994! :-)

 

You are welcome to use/modify the fbForth 2.0 editor, but it is all in ALC and requires block files in DF128 format, which could certainly be modified for your purposes. It is more or less based on the TI Forth editor, which is written in TI Forth.

 

BTW, both TurboForth and fbForth use files for source code. For normal Forth block I/O, they must be DF128 format and you load/write specific 1024-byte blocks, not whole files as you are doing. TurboForth (not fbForth, yet), however, does handle interpreting strings with EVALUATE and TI text files (DV80) using INCLUDE .

 

...lee

Link to comment
Share on other sites

 

You are welcome to use/modify the fbForth 2.0 editor, but it is all in ALC and requires block files in DF128 format, which could certainly be modified for your purposes. It is more or less based on the TI Forth editor, which is written in TI Forth.

 

BTW, both TurboForth and fbForth use files for source code. For normal Forth block I/O, they must be DF128 format and you load/write specific 1024-byte blocks, not whole files as you are doing. TurboForth (not fbForth, yet), however, does handle interpreting strings with EVALUATE and TI text files (DV80) using INCLUDE .

 

...lee

 

That's a good idea. I will take a look at it.

I also found another Forth editor that is kind of a minimalist approach. I might see what happens if I wake that up for a starter.

 

I still very old source code for my own block editor that I wrote for MVP Forth in the 1980s and ported to HsForth in the 1990s.

Having the Ti-Forth editor gives me a good cross section of techniques. I have a dim memory of changing a few things on the 64 column editor for TI-Forth that improved the key response. I have know idea what I did, but I remember the emotion of having it work when I was new to Forth. :-)

 

I knew you had switched to blocks in files. I was trying to get at the "whole files" phrase that you used. That's a better way to say it. I didn't know that TF had a file evaluator. I have not really explored Willsy's system in detail. I have looked inside some of the tricky bits primitives to see about some things I did not get about the TMS9900. Willsy is a crack Assembler coder.

 

BTW a while back we were speaking about end of line delimiters in TI-99 text files. From what I can see it looks like they use >20>01. One space seems the minimum line length ending with a 01. And the end of files terminator looks like >FF.

 

I have not really figured out how best to find the end of file except to read until I see error 5.

As I read in the E/A manual however that closes the file as well. If you know of a better way to detect EOF before reading past the end I am all ears.

 

B

Link to comment
Share on other sites

I have not really figured out how best to find the end of file except to read until I see error 5.

As I read in the E/A manual however that closes the file as well. If you know of a better way to detect EOF before reading past the end I am all ears.

 

B

 

You should be able to test the status byte at PAB+8 (often termed “screen offset”) for a set bit at bit 7 (LSb) when the last record has been read. When bit 7 is set, you are at the EOF and reading the next record will throw the error you speak of.

 

...lee

Link to comment
Share on other sites

 

You should be able to test the status byte at PAB+8 (often termed “screen offset”) for a set bit at bit 7 (LSb) when the last record has been read. When bit 7 is set, you are at the EOF and reading the next record will throw the error you speak of.

 

...lee

 

That's fantastic. Thanks!

Link to comment
Share on other sites

 

You should be able to test the status byte at PAB+8 (often termed “screen offset”) for a set bit at bit 7 (LSb) when the last record has been read. When bit 7 is set, you are at the EOF and reading the next record will throw the error you speak of.

 

...lee

 

 

I may have misspoken. You might need to run the STATUS DSR routine (opcode = 9) to get PAB+8 to contain the correct information. I will check it out and get back to you.

 

...lee

 

LOL. I was just writing you back with that when your message came in.

So that was all it took and it all works great now. This lets me build a proper version of the ANS word REFILL.

: FSTAT ( -- c) 9 FILEOP DROP PAB _STAT VC@ ; \ see E/A Manual page 298 for meaning

: EOF   ( -- ?) FSTAT 1 AND ;

\ READ until EOF
: REFILL  ( -- flag )  \ flag=true if there is more data
           2 FileOp ?FILERR
           EOF 0= ;

And the LD primitive now is this:

\ load file primitive. NOT re-entrant
: LD  ( -- ior)
            OPN ( -- realpab)             \ realpab left on stack for CLS
            LINES OFF
            BEGIN
              REFILL ( -- ? )
            WHILE
              VDATA LDBUFF @ VGET       \ transfer VDP data to CPU RAM
              LDBUFF @ COUNT INTERPRET  \ interpret the new string
              1 LINES +!
            REPEAT
            CLS ;

Link to comment
Share on other sites

I may have misspoken. You might need to run the STATUS DSR routine (opcode = 9) to get PAB+8 to contain the correct information. I will check it out and get back to you.

 

...lee

 

LOL. I was just writing you back with that when your message came in.

So that was all it took and it all works great now. This lets me build a proper version of the ANS word REFILL.

 

Well then, never mind. :)

 

...lee

Link to comment
Share on other sites

Sometimes the simplest things give me grief. I was struggling with getting the INCLUDE function to be able to handle nested includes meaning including new files while you were inside INCLUDE.

 

It seems to be working now and the real secret was to treat the contents of >8356, called DSRNAM in the E/A manual, as a file handle. I had forgotten to save it before opening a new file in the word INCLUDE. Duh!

 

In order to deal with opening multiple files on demand use something I call PAB-BLOCK. That is a PAB of >20 bytes plus a >100 byte buffer right after the PAB. The ^PAB variable is initialized to >3FFF the end of VDP RAM. To make a new PAB-BLOCK you just have to subtract >120 from ^PAB and there is new PAB-BLOCK to use.

 

The OPN primitive does this and the CLS primitive add >120 to ^PAB so we get dynamic allocation of PABs for files.

 

For CPU buffers I used my ultra-simple (oversimple?) MALLOC/MFREE functions.

 

The new code and binary V2.0.2 is up on github now but here is the business end of the word INCLUDE

\ load file primitive.
: LD     ( addr len --) \ Edit: stack comment fixed
           SOURCE 2>R                      \ save interpreter input source
           >IN @ >R                        \ save input string pointer
           DSRNAM @ >R                     \ save current DSR name

           1 SOURCE-ID !                   \ source ID is file (1)
           OPN                             \ open new file (sets new DSRNAM)
           50 MALLOC LDBUFF !              \ get a buffer           
           BEGIN
             REFILL
           WHILE
             VDATA  LDBUFF @ VGET          \ transfer VDP data to buffer
             LDBUFF @ COUNT INTERPRET      \ interpret the new string
             1 LINES +!
           REPEAT
           50 MFREE                        \ release the buffer using size on stack
           CLS                             \ close currently open file
\ restore everything from Rstack
           R> DSRNAM !                     \ restore old file ID
           R> >IN !
           2R> 'SOURCE 2!                  \ restore input
           SOURCE-ID OFF                   \ SOURCE-ID is conole (0)
;

Edited by TheBF
  • Like 1
Link to comment
Share on other sites

Nicely done!

 

I wrote an INCLUDE word for fbForth, but I am not allowing nested INCLUDEs because I would need to rewrite too many core words to accommodate it, I am afraid. It is in the following spoiler. I will post it later in the fbForth 2.0 thread (see my signature area below) with more details.

 

 

 

\ INCLUDE interprets the DV80 file in the input stream
DECIMAL
0 VARIABLE INCFLG                \ track INCLUDE file open/close
0 VARIABLE IN+BLK 2 ALLOT        \ buffer to save IN & BLK
0 VARIABLE TIBBUF 78 ALLOT       \ buffer to save TIB
PABS @ 100 + CONSTANT INCPAB     \ PAB for INCLUDE file
HEX
1400 CONSTANT INCVBUF            \ VRAM record buffer
DECIMAL

\ TIB will be RAM record buffer for RD
INCPAB TIB @ INCVBUF FILE INCFL     \ INCLUDE file handle

\ Save input stream state
: IS_SAV  ( -- )     
   IN @ IN+BLK !           \ save INTERPRET pointer
   BLK @ IN+BLK 2+ !  ;    \ save INTERPRET block #

\ Restore input stream state
: IS_RST  ( -- )     
   IN+BLK @ IN !           \ restore INTERPRET pointer
   IN+BLK 2+ @ BLK !  ;    \ restore INTERPRET block #

\ TIB save/restore
: TIBSR  ( flag -- )    
   BLK @ IF             \ not TIB?
      DROP              \ yes..drop flag
   ELSE                 \ no..save|restore TIB
      >R                \ flag to ret stk
      TIB @ TIBBUF      \ set up for save
      R> IF             \ pop flag..restore?
         SWAP           \ yes..set up for restore
      THEN
      80 CMOVE          \ copy 80 chars
   THEN   ;

\ End of file?
: EOF?  ( -- flag)
   STAT 1 AND  ;     \ end of file?

\ Is n a non-text char?
: NOTEXT? ( n -- true|false )  
   32 - 95 U<              \ n-32 uns< 95, i.e., 32 <= n <127
   0=  ;                   \ n < 32 or n > 126

\ Filename to PAB
: FNAM>PAB  ( -- )  ( IS:<filename> )  
   BL WORD                 \ parse INCLUDEd filename to HERE
   HERE DUP C@ 1+          \ stk[source count]
   INCPAB 9 + SWAP         \ stk[source dest count]
   VMBW  ;                 \ copy filename to PAB

\ Open INCLUDEd file for input
: INCOPEN  ( -- )  ( IS:<filename> )   
   INCFL  SET-PAB          \ declare file handle & set up PAB
   FNAM>PAB                \ get filename from IS to PAB
   VRBL  80 REC-LEN        \ expect DV80 file
   INPT  OPN  ;            \ open for input

\ Spaces for non-printable chars in TIB + 2 terminal nulls
: TIBCLEAN  ( bytes_read -- )   
   TIB @                   \ get TIB address
   SWAP 0 DO               \ iterate over chars read
      DUP                  \ dup current char's address in TIB
      C@ NOTEXT?           \ is it not a text char?
      IF
         BL OVER C!        \ not a text char, so replace with space
      THEN
      1+                   \ next char position in TIB
   LOOP
   2 ERASE  ;              \ add 2 terminal nulls

\ INCFLG set?
: INCFLG?   ( -- )
   INCFLG @ IF       \ check for already-open INCLUDE file
      0 INCFLG !     \ reset INCFLG
      CR ." Cannot nest INCLUDEs!"  \ issue error msg
      ABORT          \ abort
   THEN  ;

\ Interpret INCLUDEd file 
: INCLUDE  ( -- )  ( IS:<filename> )   
   INCFLG?           \ check INCFLG
   INCOPEN           \ open INCLUDEd file for input
   IS_SAV            \ save input stream state
   0 TIBSR           \ save contents of TIB if current
   0 BLK !           \ we're using the TIB
   -1 INCFLG !       \ now safe to set INCFLG
   BEGIN             \ loop..
      EOF? 0=        \ ..while not EOF
   WHILE
      RD             \ read next record into TIB
      TIBCLEAN       \ replace non-printable chars in TIB with spaces
      0 IN !         \ start interpreting at 1st char of TIB
      INTERPRET      \ do it!
   REPEAT
   CLSE              \ close INCLUDEd file
   0 INCFLG !        \ reset INCFLG
   IS_RST            \ restore input stream state
   1 TIBSR  ;        \ restore TIB if needed 

 

 

 

Example: INCLUDE DSK2.TEST

 

Like you, I am requiring DV80 files.

 

...lee

Link to comment
Share on other sites

Nicely done!

 

I wrote an INCLUDE word for fbForth, but I am not allowing nested INCLUDEs because I would need to rewrite too many core words to accommodate it, I am afraid. It is in the following spoiler. I will post it later in the fbForth 2.0 thread (see my signature area below) with more details.

 

 

 

\ INCLUDE interprets the DV80 file in the input stream
DECIMAL
0 VARIABLE INCFLG                \ track INCLUDE file open/close
0 VARIABLE IN+BLK 2 ALLOT        \ buffer to save IN & BLK
0 VARIABLE TIBBUF 78 ALLOT       \ buffer to save TIB
PABS @ 100 + CONSTANT INCPAB     \ PAB for INCLUDE file
HEX
1400 CONSTANT INCVBUF            \ VRAM record buffer
DECIMAL

\ TIB will be RAM record buffer for RD
INCPAB TIB @ INCVBUF FILE INCFL     \ INCLUDE file handle

\ Save input stream state
: IS_SAV  ( -- )     
   IN @ IN+BLK !           \ save INTERPRET pointer
   BLK @ IN+BLK 2+ !  ;    \ save INTERPRET block #

\ Restore input stream state
: IS_RST  ( -- )     
   IN+BLK @ IN !           \ restore INTERPRET pointer
   IN+BLK 2+ @ BLK !  ;    \ restore INTERPRET block #

\ TIB save/restore
: TIBSR  ( flag -- )    
   BLK @ IF             \ not TIB?
      DROP              \ yes..drop flag
   ELSE                 \ no..save|restore TIB
      >R                \ flag to ret stk
      TIB @ TIBBUF      \ set up for save
      R> IF             \ pop flag..restore?
         SWAP           \ yes..set up for restore
      THEN
      80 CMOVE          \ copy 80 chars
   THEN   ;

\ End of file?
: EOF?  ( -- flag)
   STAT 1 AND  ;     \ end of file?

\ Is n a non-text char?
: NOTEXT? ( n -- true|false )  
   32 - 95 U<              \ n-32 uns< 95, i.e., 32 <= n <127
   0=  ;                   \ n < 32 or n > 126

\ Filename to PAB
: FNAM>PAB  ( -- )  ( IS:<filename> )  
   BL WORD                 \ parse INCLUDEd filename to HERE
   HERE DUP C@ 1+          \ stk[source count]
   INCPAB 9 + SWAP         \ stk[source dest count]
   VMBW  ;                 \ copy filename to PAB

\ Open INCLUDEd file for input
: INCOPEN  ( -- )  ( IS:<filename> )   
   INCFL  SET-PAB          \ declare file handle & set up PAB
   FNAM>PAB                \ get filename from IS to PAB
   VRBL  80 REC-LEN        \ expect DV80 file
   INPT  OPN  ;            \ open for input

\ Spaces for non-printable chars in TIB + 2 terminal nulls
: TIBCLEAN  ( bytes_read -- )   
   TIB @                   \ get TIB address
   SWAP 0 DO               \ iterate over chars read
      DUP                  \ dup current char's address in TIB
      C@ NOTEXT?           \ is it not a text char?
      IF
         BL OVER C!        \ not a text char, so replace with space
      THEN
      1+                   \ next char position in TIB
   LOOP
   2 ERASE  ;              \ add 2 terminal nulls

\ INCFLG set?
: INCFLG?   ( -- )
   INCFLG @ IF       \ check for already-open INCLUDE file
      0 INCFLG !     \ reset INCFLG
      CR ." Cannot nest INCLUDEs!"  \ issue error msg
      ABORT          \ abort
   THEN  ;

\ Interpret INCLUDEd file 
: INCLUDE  ( -- )  ( IS:<filename> )   
   INCFLG?           \ check INCFLG
   INCOPEN           \ open INCLUDEd file for input
   IS_SAV            \ save input stream state
   0 TIBSR           \ save contents of TIB if current
   0 BLK !           \ we're using the TIB
   -1 INCFLG !       \ now safe to set INCFLG
   BEGIN             \ loop..
      EOF? 0=        \ ..while not EOF
   WHILE
      RD             \ read next record into TIB
      TIBCLEAN       \ replace non-printable chars in TIB with spaces
      0 IN !         \ start interpreting at 1st char of TIB
      INTERPRET      \ do it!
   REPEAT
   CLSE              \ close INCLUDEd file
   0 INCFLG !        \ reset INCFLG
   IS_RST            \ restore input stream state
   1 TIBSR  ;        \ restore TIB if needed 

 

 

 

Example: INCLUDE DSK2.TEST

 

Like you, I am requiring DV80 files.

 

...lee

 

Very nice. That's nice how you prevent nested includes. I had been "kvetching" over this thing for so long that I just had to make mine nestable. :-)

 

I have been waiting for the day this startup screen ran for quite a while.

 

Topic shift:

I am working on the ANS File word set and made a couple words that might save you some space in future revisions.

 

AND! and OR! apply a mask to the contents of a variable.

VARIABLE FAM  \ build the file access mode here

\ and/or the contents of a variable with mask
 : 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      ( -- ) 00000100 FAM OR! ;
 : OUTPUT     ( -- ) 00000010 FAM OR! ;
 : APPEND     ( -- ) 00000110 FAM OR! ;

VARIABLE B/REC    \ bytes per record
 : VARI  ( size -- fam) B/REC ! 00010000 FAM  OR! ;
 : FIXED ( size -- fam) B/REC ! 11101111 FAM AND! ;

The ANS words assume you will pass a "file access mode" on the stack with the file name so I build up the bits in the FAM variable. The standard uses file access mode words R/W, R/O and W/O so all they need to do is configure the FAM and fetch the value to the stack. And ANS files use the word BIN as a modifier to the file access mode on the stack so that was simple. It replaces INTERNAL in TI-99 speak.

 : R/W   ( -- fam)  UPDATE  FAM @ ;
 : R/O   ( -- fam)  INPUT   FAM @ ;
 : W/O   ( -- fam)  OUTPUT  FAM @ ;

 \ ANS Forth word replaces INTERNAL
 : BIN   ( fam -- fam') 8 OR ;  \ modify FAM on stack

It's actually working out pretty well to map ANS Forth files to the old TI-99.

 

​And of course it's simple to make nice descriptors like this:

 : DV80  ( -- ) INPUT DISPLAY 80 VARI SEQUENTIAL ;

post-50750-0-30289300-1522286644.jpg

Link to comment
Share on other sites

Good work, as usual. :thumbsup:

 

I have watched with some envy how you set up PABs and VRAM record buffers automatically. I have actually thought of doing this for fbForth 2.0, but I have been reluctant to take that responsibility from the Forth programmer. Part of the problem for me is that VRAM space is a moving target with the possible modes. There is little space in Bitmap mode, so the programmer is on their own there. All is constant with Text, Graphics and Multicolor modes, however. The kicker is Text80 mode, which moves the space pointed to by the contents of PABS . This is not really a big problem, though. After all, I know where the bodies are buried. :grin: H-m-m-m-m...

 

...lee

Link to comment
Share on other sites

Good work, as usual. :thumbsup:

 

I have watched with some envy how you set up PABs and VRAM record buffers automatically. I have actually thought of doing this for fbForth 2.0, but I have been reluctant to take that responsibility from the Forth programmer. Part of the problem for me is that VRAM space is a moving target with the possible modes. There is little space in Bitmap mode, so the programmer is on their own there. All is constant with Text, Graphics and Multicolor modes, however. The kicker is Text80 mode, which moves the space pointed to by the contents of PABS . This is not really a big problem, though. After all, I know where the bodies are buried. :grin: H-m-m-m-m...

 

...lee

 

 

Although I am not finished yet, the plan is to use the 'FILES' word to limit how deep this stack of PAB blocks goes down into VDP RAM. So in theory the phrase 1 FILES will limit the VDP to >120 bytes at the top of VDP RAM.

 

Would this solve your problem?

 

Bug found:

I just discovered that my DRSFIND corrupts the dictionary if it errors out.

I think I need to set the DSR name in the PAB before I go searching but that is just conjecture at the moment.

Link to comment
Share on other sites

Although I am not finished yet, the plan is to use the 'FILES' word to limit how deep this stack of PAB blocks goes down into VDP RAM. So in theory the phrase 1 FILES will limit the VDP to >120 bytes at the top of VDP RAM.

 

Would this solve your problem?

 

For INCLUDE , certainly—because the VRAM buffer is limited to 80 bytes. I could generalize it to handle up to the maximum record size of 256 bytes, I suppose. I do have to keep 1 DSR file buffer ( 1 FILES ) for blocks and screen-font files, which have there own PABs and VRAM buffers already set in stone.

 

Bitmap mode is out of the question because the Sprite Descriptor Table (SDT) is right up against the DSR file buffers, even at 1 DSR file buffer! The maximum is 2 files—otherwise, there is no room for the SDT at all and the Bitmap Pattern Descriptor Table gets stepped on. I would need to test for Bitmap mode with any automated file allocation system and error out of any user attempt to use it.

 

I would think that the maximum of 16 DSR file buffers is unlikely, but, if the user set up that many, there would be only 3128 bytes of VRAM left—not enough for 16 files with 256-byte records. INCLUDE , with its 80-byte records, would work, however. I will stop rambling now...

 

...lee

Link to comment
Share on other sites

Update: Camel99 V2.0.4

 

BUG: DRSFIND corrupted the dictionary if device not found. Killed.

BUG: INCLUDED crashed when given a null string. Killed.

 

Change to ?ABORT so that all error messages have a CR ." * " <message>

Looks a little like TI-BASIC and it HONKS too.

 

New files on GitHub.

  • Like 2
Link to comment
Share on other sites

ANS/ISO Forth Files Word Set for CAMEL99 Forth V2

http://forth-standard.org/standard/file

 

 

Although the ANS Forth files word set seem to be designed for UNIX type operating systems it was possible to get them working on the old TI-99.

 

This version is a sub-set of the total requirements, but it allows you to read and write files using file handles.

A handle is just a number assigned by the O/S that selects the correct device to operate on. This implementation creates a table in memory for 8 handles. (Handle 0 is reserved for the Forth console)

PABs are still used per TI-99 file requirements so when a file is created the PAB address is placed in the PABS table. When a file is closed the PABS table entry is reset to zero.

 

The ANS file operations take the handle and use the SELECT word to set the current PAB. The system uses the word PAB to get the VDP address of the "Selected" PAB.

 

Using these new additions to the system I created MORE, a little program to view a DV80 text file and pause the display or escape the file as a demonstration.

\ more utility is a file viewer
\ default is DV80 files

HEX
: MORE    ( <filename>)
          BL PARSE-NAME
          R/O OPEN-FILE ?FILERR
          >R                    \ push handle onto Return stack
          BEGIN
             PAD DUP 50 R@ READ-LINE ?FILERR
          WHILE
             CR TYPE              \ print the line we read  
             KEY?                 \ test for key press  
             IF CR ." ..."        \ we got one
                KEY 0F =          \ wait for a KEY, test for escape key
                IF R> CLOSE-FILE  \ if detected we're done here
                   2DROP
                   CR CR ." >>Esc<<" ABORT
                THEN
             THEN
          REPEAT
          R> CLOSE-FILE
          2DROP DROP ;

The ANS files sub-set adds 1,184 bytes to system dictionary.

 

The spoiler contains the source code for the curious. I will get these files up on GITHUB today if I don't find any big bugs.

 

 

 

CR .( ANSFILES  FOR CAMEL99 V2 BJF 30MAR2018)

\ Requires CAMEL99 V2 with DISKDSR4 and FILESYSB

\ A subset of ANS Forth files wordset with TI-99 specific words

\ Dependancy:
\ TI-99 file system is record oriented not byte oriented
\ Some accomodation is required

\ ANS/ISO Forth Definitions used in this code:
\         fid -  file identifier (a file handle)
\         ior -  input/output response (the error number)
\         fam -  file access mode. see code for details

\ primitive file sys. commands for reference
\ : OPEN    ( -- ior)  0 FILEOP ;
\ : CLOSE   ( -- ior)  1 FILEOP ;
\ : READ    ( -- ior)  2 FILEOP ;
\ : WRITE   ( -- ior)  3 FILEOP ;
\ : REWIND  ( -- ior)  4 FILEOP ;
\ : LOAD    ( -- ior)  5 FILEOP ;
\ : SAVE    ( -- ior)  6 FILEOP ;
\ : DELETE  ( -- ior)  7 FILEOP ;
\ : SCRATCH ( -- ior)  8 FILEOP ;

\ ==================================
\ File handle server
HEX
VARIABLE #FILES

CREATE PABS ( -- addr)   \ table for 8 potential PABs
             0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,

\ PTAB exposes PABS as an array
: ]PTAB   ( n -- addr )  2* PABS + ;

\ compute the VDP address for any PAB(n)
: PAB[N]  ( n -- VDPadr) 120 * 3FFF SWAP - ;

: ?FILES  ( n -- )  #FILES @ > ABORT" No more files" ;

: NEWHNDL ( -- hndl) \ returns first free handle
         0           \ start at handle=0
         BEGIN
           1+  
           DUP ?FILES    \ have we exceeded #files allowed
           DUP ]PTAB @   \ fetch pab table contents
         0= UNTIL ;      \ loop until we find an empty location

\ the file handle selects the active PAB
: SELECT  ( hndl -- )
           ]PTAB @ DUP 0= ABORT" PAB not assigned"
           ^PAB ! ;

: ASSIGN  ( hndl -- ) \ assign a new handle and SELECT it.
          DUP  DUP PAB[N] SWAP ]PTAB !
          SELECT ;

: RELEASE ( hndl -- ) ]PTAB OFF  ^PAB OFF ;

\ user level command.
: FILES   ( n -- )   \ fill the PABS table with computed PABs
          DUP 8 > ABORT" too many files"
          #FILES ! ;

\ ===================================
\ file access mode configuration

VARIABLE FAM  \ we build the file access mode in a variable

\ and/or the contents of a variable with mask
 : 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      ( -- ) 00000100 FAM OR! ;
 : OUTPUT     ( -- ) 00000010 FAM OR! ;
 : APPEND     ( -- ) 00000110 FAM OR! ;

VARIABLE B/REC    \ bytes per record
 : VARI  ( size -- fam) B/REC ! 00010000 FAM  OR! ;
 : FIXED ( size -- fam) B/REC ! 11101111 FAM AND! ;

\ set fam on stack to default file format 
\ (in case the op forgets to set it up)

 HEX
\ These ANS word adjust and return the FAM variable
 : R/W   ( -- fam)  UPDATE  FAM @ ;
 : R/O   ( -- fam)  INPUT   FAM @ ;
 : W/O   ( -- fam)  OUTPUT  FAM @ ;


\ ANS Forth word replaces INTERNAL
 : BIN   ( fam -- fam') 8 OR ;  \ modify FAM on stack

\ needed to test for file args on stack
: DEPTH   ( -- n ) SP0 SP@ 2+ - 2/ ;

\ these work on the SELECTed file (no handle needed)
: EOF   ( -- ? )  FSTAT 1 AND ;

: ?EXISTS  ( -- )
             FSTAT 8 AND
             IF DISKOFF TRUE ABORT" No such file"
             THEN ;

DECIMAL
: DV80      DISPLAY VARI 80 SEQUENTIAL ;

HEX
\ build the PAB from all the pieces, error checking
: OPEN-FILE ( $addr len fam -- fid ior)
             DEPTH 3 < ABORT" file args"
             NEWHNDL DUP >R ASSIGN    \ copy handle & assign PAB

             >R                       \ rpush FAM for later
             2DUP MAKEPAB ( -- fam $addr len)
             R> PAB _FLG VC!          \ write file access mode

             B/REC @ ?DUP             \ test for new record length
             IF PAB _RECLEN VC!       \ yes, over-write the default
             THEN B/REC OFF
             NEWFILE                  \ setup new file
             ?EXISTS                  \ test if it exists
             0 FILEOP ( -- err#)      \ call O/S OPEN
             R> SWAP ;

: CLOSE-FILE  ( fid -- ?)
               DUP SELECT
               1 FILEOP
               SWAP RELEASE ;

: READ-LINE ( c-addr u1 fid -- u2 flag ior )
            SELECT
            2 FILEOP DUP >R               \ read operation, rpush error#
            IF                            \ if err#<>0
               0 FSTAT R>                 \ fatal error, don't read data
            ELSE
               ( -- adr u1)
               PAB _CHARS VC@             \ get no. chars read
               MIN  >R                    \ MIN(u1,chars)= u2, rpush
               PAB _FBUFF V@ SWAP R@  VREAD   \ move VDP fbuff to c-addr
               R>                         \ get u2 (chars actually read)
               EOF 0=                     \ test  EOF = 0
               R>                         \ bring back error#
            THEN ;

: WRITE-LINE ( c-addr u fileid -- ior )
             SELECT
             DUP PAB _CHARS VC!         \ # chars to write ->PAB
             PAB _FBUFF V@ SWAP VWRITE  \ write CPU RAM to VDP file buffer
             3 FILEOP                   \ call write operation
             FSTAT 2 AND FUSE           \ fuse EOF and general file errors
;

: CREATE-FILE ( caddr len fam -- fid ior )
\ OUTPUT mode forces new file creation in TI-99 O/S
               2 OR                     \ modify 'fam' bits to OUTPUT mode
               OPEN-FILE ;

: FILE-POSITION   ( fid -- n)   SELECT  PAB _REC# V@ ;

: REPOSITION-FILE ( fid -- ior) SELECT  PAB _REC# V!  4 FILEOP ;

\ ===================================
8 FILES             \ set the #FILES now
DV80                \ set default file format now

DECIMAL
CR .( Max files set to ) #FILES @ .
HEX

 

 

Edited by TheBF
Link to comment
Share on other sites

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.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...