Jump to content
IGNORED

DSRLINK Code Tutorial


TheBF

Recommended Posts

Code has been Compiled!

 

So the basic concepts are in place. I actually made a Forth program file for testing with BASIC. :-)

100 CALL CLEAR
110 PRINT "Create a Forth"
120 PRINT "Program with BASIC"
130 OPEN #1:"DSK1.HELLO",OUTPUT,VARIABLE 128
140 PRINT "  :-) "
150 PRINT
160 PRINT "Writing file..."
170 PRINT #1:"\ generated with TI BASIC"
180 PRINT #1:" "
190 PRINT #1:": HELLO"
200 PRINT #1:"  CR ";CHR$(46);CHR$(34);" Hello CAMEL99 Forth!";CHR$(34)
210 PRINT #1:";"
220 PRINT "Closing file..."
230 CLOSE #1
240 END

Then after killing a few bugs... ok a lot of bugs I was able do what's on the screen capture.

 

The next challenge is to see if I can shoe-horn enough file support into the kernel to allow the 8K image to load up stuff when it boots.

 

 

 

post-50750-0-81441000-1521311325.jpg

  • Like 2
Link to comment
Share on other sites

TIImageTool: Edit->Import files (filter: all files), import mode: DIS/VAR 80, then right-click on the new file, Save as TIFILES, or drag it out, drop into a file explorer.

 

Thanks Mizapf. That's a very nice tool.

Link to comment
Share on other sites

What I learned about calling a DSR.

 

For the uber-gurus (German/Sanskrit... interesting) :) all of this will be old news but I am happy I went through the process.

So for all those crazy people who might want to write a DSR interface system in some other language here goes.

 

First of all here is all the assembly language that I use to call the system ROMS. I use a DSR workspace but all it does is allow to me to get back to my Forth workspace. So it wastes 13 of the registers but it's a very convenient way to switch out the Forth workspace and get back.

( I could move the top of the workspace into Console ROM space and keep the bottom 3 registers in RAM I think, but I have not tried it yet)

\ This is the only 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

I made decisions that others might frown upon but I did it anyway.

 

1. I know where there disk card is in CRU space and I don't want to access any other system calls with this code so I use the address >1100 as a constant.

2. I know that card has an ID byte at the beginning >4000 so that is a constant called 'ID (Forth speak: the address of ID)

3. I know the link list of DSR names & routines is starts at address 4800 >4008 so that is a constant called 'DSRLIST. ( ​* Master Lee found my typo. I am gonna get a 'C' on this paper I bet)

 

You need a way to create a TMS9900 vector.

(Assembler equivalent: DISKLINK DATA DSRWKSP,CALLDSR

And you need to be able to BLWP to that vector. I created a new Forth word in ALC for this. It was just 2 instructions so no biggy.

 

You need a way to cut a string like: "DSK1.MYFILE" into "DSK1" which is the device name.

 

You need a way to search the linked list of Device names in the ROM, searching for the string you cut above.

My code called DSRFIND takes the full filename and extracts the device name into a temp string variable.

It searches via the links until it finds the device or hits the zero at the end of the list.

I found it easier to just return the link address (in the ROM) at the end of the search. I convert that link to the code address later.

If the device is not found DSRFIND returns zero.

 

Card Control

You need to have basic CRU control. CAMEL99 Forth has CRU! that puts a value into R12 and CRU@ which reads R12.

And 0SBO and 0SBZ which do one ALC instruction each. ( SBO 0 and SBZ 0 )

 

With CRU control you need smart Card control word that checks if R12 has and address in it and if so turn if off, then change the address and turn on the new address. I called that ENABLE. DISABLE simply loads R12 and turns off that address.

 

*MAGIC*

When you enable the Disk controller card you need to store that CRU address in >83D0 also. I don't know why.

Edit: Not needed. This is seems to be a variable used by the console DSR. Your DSR can use it as such, but does not need to.

 

*MORE MAGIC*

I will use some Forth code to help me remember/ explain what happens next.

: NEWFILE ( $addr len -- ) 
         2DUP MAKEPAB   ( -- $addr len realpab)
         -ROT            ( -- realpab $addr len )
         DiskON ?CARDID                           
         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
;

1. MAKEPAB creates a PAB in VDP memory with the full string (DSK1.MYFILE), the file mode byte, the buffer address, and the record size

BUT... it also does something *magic*.

 

You must get the address in your newly created VDP PAB at the dot character in the full filename.

So remember this is the VDP address of the dot character in the filename field of the PAB.

Put that somewhere safe in your chosen language you will need it shortly. I call it the "realpab"

 

2. Turn on the Disk card at CRU >1100 . Check the Card ID >AA is now present at address >4000

 

3. Run DSRFIND to find your DEV string that you extracted

 

4. Test your result: If it's zero error out. (my code just aborts to Forth console with a message)

If you found a good link, add 4 to it, that's the address of the string in the ROM.

Read a byte at that address and store the byte in >8355. ( It's length of the device string in ROM).

 

5. Take the LINK you found and increment by 2 to get to the code-address field.

Read the contents of that field and you have code-entry-address (runnable code)

Stuff that code-entry-address into R9 of the GPL workspace. (you can only do that in the 9900 family) :-D

 

6. Remember that "realpab"? Put that address into memory at >8356.

 

Wasn't that fun? Not my idea of a nice API to a file system. :_(

 

The FINAL CALL

 

I call this FILEOP and it does the following:

  1. Put the file operation byte into PAB[0]
  2. Fetch the flag at PAB[1], mask off the upper 3 bits and put it back to clear err bits.
  3. Clear the GPL status byte
  4. Turn the disk (which must copy the CRU address to >83DO (REMEMBER?)
  5. BLWP to the VECTOR
  6. Read the error byte at PAB[1] , (shift 5 bits to the right to see them correctly)
  7. Read the GPL byte and check for errors
  8. Turn the disk card off
: FILEOP  ( c -- n)
          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  ;

What a weird OS. But we love it Is that a problem...? :twisted:

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

Very nice! :) See my comments in this color interspersed in your post below:

 

What I learned about calling a DSR.

 

For the uber-gurus (German/Sanskit... interesting) :) all of this will be old news but I am happy I went through the process.

So for all those crazy people who might want to write a DSR interface system in some other language here goes.

 

First of all here is all the assembly language that I use to call the system ROMS. I use a DSR workspace but all it does is allow to me to get back to my Forth workspace. So it wastes 13 of the registers but it's a very convenient way to switch out the Forth workspace and get back.

( I could move the top of the workspace into Console ROM space and keep the bottom 3 registers in RAM I think, but I have not tried it yet) [LES note: Well, that would mean the 6 bytes for R13 – R15 would be in slow RAM at >2000. If truly no other register but the last 3 is used, you could use a faster, 6-byte block of available space in scratchpad RAM, offset at least 26 bytes from >8300]

<snip>

3. I know the link list of DSR names & routines is starts at address 4800 so that is a constant called 'DSRLIST. [LES note: The linked list of DSRs starts at >4008.]

<snip>

*MAGIC*

When you enable the Disk controller card you need to store that CRU address in >83D0 also. I don't know why. [LES note: The E/A Manual, on p. 406, says of >83D0, “Search pointers for GROM and ROM search. Four bytes.”]

<snip>

What a weird OS. But we love it Is that a problem...? :twisted:

 

...lee

  • Like 2
Link to comment
Share on other sites

Thanks for the review Lee. I will correct the >4800 typo in my post.

That E/A manual is full of good stuff. I will have to pay more attention. (not my strong suit)

 

I might look around the scratchpad for a place to put those 6 bytes, but it's kind of crowed in there and my DSRWKSP is really a flow through to GPL workspace.

Compared to the hit we take running the thread interpreter it probably would not speed things up very much.

 

I tested calling the OPEN opcode and dropping the error message and it takes about 14mS in this current iteration. So not too bad.

And if you are waiting for the FLOPPY drives to wake up it's going to be a lot more. :-)

 

Thanks again for checking over the details.

 

B

Edited by TheBF
Link to comment
Share on other sites

Thanks for the review Lee. I will correct the >4800 typo in my post.

That E/A manual is full of good stuff. I will have to pay more attention. (not my strong suit)

 

I might look around the scratchpad for a place to put those 6 bytes, but it's kind of crowed in there and my DSRWKSP is really a flow through to GPL workspace.

Compared to the hit we take running the thread interpreter it probably would not speed things up very much.

 

I tested calling the OPEN opcode and dropping the error message and it takes about 14mS in this current iteration. So not too bad.

And if you are waiting for the FLOPPY drives to wake up it's going to be a lot more. :-)

 

Thanks again for checking over the details.

 

B

 

No prob. :)

 

Re where you place your workspace. Again, if it truly does not use any of the first 26 bytes of the workspace and you do not care about using RAM on the 8-bit bus, why not do something like the following:

VARIABLE MYWS_R13R15 4 ALLOT
MYWS_R13R15 26 - CONSTANT MYWS 

or, however you would do that in CAMEL99 Forth.

 

Or—even better:

HERE 6 ALLOT
26 - CONSTANT MYWS

...lee

Link to comment
Share on other sites

HERE 6 ALLOT
26 - CONSTANT MYWS

I like this idea. Very clever.

I am working on getting a file handle system right now so this is an optimization I can come back to.

On another note I discovered I have been running my return stack on non-aligned address boundaries.

Not sure if it made a difference but it feels better to know it's on even boundaries now.

Link to comment
Share on other sites

  • 2 weeks later...

Very nice! :) See my comments in this color interspersed in your post below:

*MAGIC*

When you enable the Disk controller card you need to store that CRU address in >83D0 also. I don't know why.

[LES note: The E/A Manual, on p. 406, says of >83D0, “Search pointers for GROM and ROM search. Four bytes.”]

<snip>

 

 

...lee

 

So being the crazy man I am I wondered, "Do I really need to put the CRU address into >83D0 or is that what the TI-99 DSR code needs?"

 

So I commented out the place where I do the deed and guess what? It still works!

So one more magic incantation has been removed.

: DiskON  ( -- ) DSKCARD ( DUP 83D0 !) Enable ;  \ 99-4A needs CRU copied to 83D0 (magic)
Link to comment
Share on other sites

 

 

So being the crazy man I am I wondered, "Do I really need to put the CRU address into >83D0 or is that what the TI-99 DSR code needs?"

 

So I commented out the place where I do the deed and guess what? It still works!

So one more magic incantation has been removed.

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

 

I would be willing to bet that the GPL DSRLNK needs them, which would mean fbForth needs them because I am using the GPL DSRLNK.

Link to comment
Share on other sites

For more information re: 83D0 and 83D2, see "Interface Standard & Design Guide" by Tony Lewis, section J: DSR Access.

 

I recall scanning and uploading a copy to AtariAge once upon a time, though it doesn't seem to be attached to the pinned development resources thread. There were a few pages missing so there should be a second and/or corrected upload. I was not able to locate the file, maybe someone else will have better luck. (edit: attached a copy for reference)

 

Anyway, the entire guide is a "must read" for DSR and peripheral design. It explains and ties together many of the earlier written TI specifications.

interface-standard-design-guide-complete ti99.pdf

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

For more information re: 83D0 and 83D2, see "Interface Standard & Design Guide" by Tony Lewis, section J: DSR Access.

 

I recall scanning and uploading a copy to AtariAge once upon a time, though it doesn't seem to be attached to the pinned development resources thread. There were a few pages missing so there should be a second and/or corrected upload. I was not able to locate the file, maybe someone else will have better luck. (edit: attached a copy for reference)

 

Anyway, the entire guide is a "must read" for DSR and peripheral design. It explains and ties together many of the earlier written TI specifications.

 

 

Ah... yes from this it is quite clear that these addresses are for the internal DSRLNK. Therefore I don't need them in my code because I don't use the console ROM.

Link to comment
Share on other sites

For more information re: 83D0 and 83D2, see "Interface Standard & Design Guide" by Tony Lewis, section J: DSR Access.

 

I recall scanning and uploading a copy to AtariAge once upon a time, though it doesn't seem to be attached to the pinned development resources thread. There were a few pages missing so there should be a second and/or corrected upload. I was not able to locate the file, maybe someone else will have better luck. (edit: attached a copy for reference)

 

Anyway, the entire guide is a "must read" for DSR and peripheral design. It explains and ties together many of the earlier written TI specifications.

 

 

Thank you for uploading! Fascinating stuff. Anyone know if the accompanied disk is available somewhere?

 

The document says "a 5-14' single sided, single density diskette containing utility programs is provided with the manual to assist the peripheral developer in creating DSRs and application programs. The purpose of including these programs with the manual is to provide in (the author's opinion) the "best" utility programs available to the developer such that DSRs may be quickly written, debugged and released."

Edited by retroclouds
Link to comment
Share on other sites

  • 5 months later...
  • 4 weeks later...

FYI to any who cares to know, my DSR Link which works fine under Classic99 does not work on a real TI-99.

I been making some changes to try and find out why, but it is very slow going from the PC to the 99. I use Forth as a debugger, meaning I can call each routine from the console and even type them in command by command and then examine CPU and VDP ram, but I have not found the problem yet. I notice that everything in the PAB looks correct and I even put data in 83D0 again, in case that was the problem.

 

My next test will involve saving R11 in the GPL workspace before calling the ROM code and then restoring R11 when the rom code returns. That could be a problem since Forth is calling the keyboard routine in GPL space all the time and I can see a relevant Forth address in R11 when I look at Classic99's debugger.

 

More tests to come.

Link to comment
Share on other sites

Are interrupts disabled during disk access? TI Forth and fbForth do that.

 

Also, what is your latest code? I would like to dig into it.

 

...lee

 

OK I will try that as well. Thanks.

 

I am working with an interim version here that cobbles together a kernel with tools but I remove if/else/then and loops to keep it under 8K.

 

Here are the relevant files. in spoilers.

( I will put the 0 limi, instruction in the version I put here)

 

DSKDSR6.HSF

 

 

\ DISK only DSRLINK   VERSION 2                BJF MAR 20 2018

\ Aug 2018 replaced literal $20 with CONSTANT BL to save space

\ Overview:
\ This file provides a way to CALL code in the DSR ROM.
\ R9 of the GPL workspace is loaded directly with the entry address
\ for the DSR code that you are calling.
\ USAGE:   DSKLNK BLWP  **notice DSK LNK not  DSR LNK**

\ Warning: DSRLNK functions should store the DSR address of the device name entry at >83D2! (Got >4800)

TARGET-COMPILING
\ Steal top address of the data stack and use for DSRWSP.
\ We in fact only use 6 bytes.
\ This workspace is only needed to isolate the Forth 
\ workspace from the DSR workspace.
[CC] SP0 100 - [TC] VALUE: DSRWKSP


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

\ Sept 7, 2018 simplified this by incorporating vector with code
\ This is the ONLY code used to CALL the DSR ROM code

l: R11SAV  0 DATA,

\ Create the VECTOR that we call with BLWP.
\               workspace    compile program address
\               ---------    -----------------------
 CREATE: DSKLNK  DSRWKSP T,  [cc] THERE TCELL + T, [tc]
            0 LIMI,
            83E0 LWPI,      \ change to GPL workspace
            R11 R11SAV @@ MOV,
           *R9 BL,          \ GPL R9 already has the entry address
            NOP,            \ The DSR expects an 8 here
            R11SAV @@ R11 MOV,
            DSRWKSP LWPI,   \ back to the dummy workspace
            2 LIMI,
            RTWP,           \ Return to Forth Workspace
            NEXT,           \ Return to Forth interpreter

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

\                 [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]
                [CC] [PUBLIC] [TC]

: /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 starting at ROMLIST
\ It returns the link-address. (Link-address+2 = runnable code address)
: DSRFIND ( addr len ROMLIST -- link_addr)
           -ROT                        \ save the ROM list for later
     ( $20) BL MALLOC >R               \ get a temp$ buffer >20 bytes
           /DOT  R@ PLACE              \ cut filename at dot, place in temp$
           BEGIN
              @                        \ fetch the next link
              DUP 0=                   \ test for end of list
              SWAP  R@ OVER 4 +  =$    \ match TEMP$ to $ in ROM
              ROT OR                   \ if either is true we're done.
           UNTIL
           BL MFREE                    \ release 20 bytes to heap
           R> DROP ;                   \ free the heap

\ card control lexicon
: Enable   ( CRU -- )
           CRU@ OVER <>                \ is this a different card?
           IF   0SBZ                   \ if so, turn it off
           THEN DUP CRU!               \ set CRU base address
                0SBO                   \ then turn on the requested card
                83D0 !                 \ store for O/S
;

: Disable  ( CRU -- ) CRU! 0SBZ  ( 83D0 OFF) ;

 

 

 

FILESYSF.HSF is a very small system to allow Forth to bootstrap itself with more source code.

 

 

\ filesys is a minimal single PAB file mechanism  BJF 17MAR2018
\ It is used only by INCLUDE to bootstrap the system.

\  *** NEEDS DISKDSR4.HSF

\ Apr 2, 2018  -re-factored for smaller size and small speed-up.
\              -better use of stack for LD/Interpret loop.

\ June 21, 2018 - REMOVED EOF to save space, MOVED to ANSFILES

\ Sept 7, 2018 filesyeE.hsf
\ - NEWFILE changed to OPENDEV
\ - OPENDEV takes 3 params now: (-- filename len card-CRU-address)
\ - added 1 CELL field after filename field to PAB
\   - holds the calulated "REALPAB" that goes into DSRNAM

\ ============================
[CC] HEX  [TC]
\ Define some LITERAL numbers in the cross-compiler to help explain things.
\ By using the cross-compiling ':' the numbers just go onto the Forth stack
\ and the cross-compiler converts them to TARGET system literals
\ This saves TARGET dictionary space for numbers used less than 4 times or so.

\ *for reference only*
\ 83E0 EQU: GPL.WKSP     \ GPL (TI O/S) workspace (CPU Registers)
\ 83F2 EQU: GPL.R9       \ address of GPL Register 9
\ 8355 EQU: LEN(DSRNAM)

TARGET-COMPILING
  8356 CONSTANT: DSRNAM     \ protected address in TI-99 O/S

[CC] 100 0A + 20 + 2+ [TC] CONSTANT: PSZ \ "PAB SIZE" = buffer+PAB+file$+DSRNAM

\ VARIABLE: ^PAB            \ *moved to CAMEL2.HSF

\ fast fetch of pab base pointer. (*This is also the OPCODE field)
CODE: [PAB   ( -- adr) TOS PUSH,  ^PAB @@ TOS MOV,  NEXT, END-CODE

\ PAB field words calculate offset from PAB base
\ square bracket trailing to indicate they are used with [PAB
\ Example:  [PAB FBUFF] V@

CODE: FLG]    ( vaddr -- vaddr') TOS INC,         NEXT, END-CODE
CODE: FBUFF]  ( vaddr -- vaddr') TOS INCT,        NEXT, END-CODE
CODE: RECLEN] ( vaddr -- vaddr') *TOS+ *TOS+ MOV, NEXT, END-CODE \ inc. by 4 trick
CODE: CHARS]  ( vaddr -- vaddr') TOS  5 ADDI,     NEXT, END-CODE
CODE: REC#]   ( vaddr -- vaddr') TOS  6 ADDI,     NEXT, END-CODE
CODE: STAT]   ( vaddr -- vaddr') TOS  8 ADDI,     NEXT, END-CODE
CODE: FNAME]  ( vaddr -- vaddr') TOS  9 ADDI,     NEXT, END-CODE
\ dsrnam field allows for 32 bytes for fname]
CODE: DSRNAM] ( vaddr -- vaddr') TOS 20 ADDI,     NEXT, END-CODE

[CC] HEX [TC]
\ TI-99 File error Code Meaninq
\ ------------------------------
\ 0  Bad device name.
\ 1  Device is write protected.
\ 2  Bad open attribute such as incorrect file type, incorrect record length,
\    incorrect I/O mode, or no records in a relative record file.
\ 3  Illegal operation; i.e., an operation not supported on the peripheral or a
\    conflict with the OPEN attributes.
\ 4  Out of table or buffer space on the device.
\ 5  Attempt to read past the end of file. When this error occurs, the file is
\    closed. Also given for non-extant records in a relative record file.
\ 6  Device error. Covers all hard device errors such as parity and bad medium errors.
\ 7  File error such as program/data file mismatch, non-existing file opened in
\    INPUT mode, etc.

: ERR@    ( -- n)
          [PAB FLG] VC@ 5 RSHIFT ;          \ read err code from PAB & shift bits

: FILEOP  ( opcode -- err)                   \ TI99 O/S call
          [PAB VC!                           \ write opcode byte to VDP PAB
          [PAB FLG] DUP VC@ 1F AND SWAP VC!  \ clear err code bits
          0 GPLSTAT C!                       \ clear GPL status register
          DSKCARD ENABLE                     \ turn on the dsk card
          DSKLNK BLWP ERR@                   \ call DSR code, read error code
          DSKCARD DISABLE ;                  \ turn off the dsk card

\ Error handlers
: ?CARDID  ( -- ) 
           'ID C@ AA <> TS" CARD not found" ?ABORT ;
           
: PAB1     ( -- ) 8370 @ 2- ^PAB !  ;        \ GET end of VDP mem from O/S, set 1st PAB pointer

: ?DEVERR  ( link -- )
           0= IF
                DSKCARD DISABLE \ turn off the Disk card
                PAB1            \ reset the PAB pointer
                CR T." * Device not found" ABORT
           THEN ;

\ generic file error handler
: ?FILERR  ( ior -- ) 
           ?DUP IF CR T." * File Err " .  ABORT THEN ;

: VPLACE   ( $addr len Vaddr -- ) \ like PLACE, but for VDP RAM
           2DUP VC! 1+ SWAP VWRITE ;

\ MAKEPAB fills in buffer address, filename, computes what I call the "realpab"
\ The realpab is the address in the PAB of the file name from the
\ location of the 1st '.' character. It is essentially a "file ID" for the TI-99 O/S.
\ The realpab VDP address is put into DRSNAM (>8356) to select the active file.
: MAKEPAB  ( addr len -- )
         [PAB BL 0 VFILL                 \ erase the VDP PAB to be safe.
         [PAB DSRNAM] 2+ [PAB FBUFF] V!  \ set FBUFF 2 bytes past DSRNAM]
         2DUP [PAB FNAME] VPLACE     \ dup & write string to PAB
         /DOT NIP 1+ ( -- n)         \ compute offset upto '.' in string
         [PAB FNAME] +               \ offset + PAB_FNAME = "REALPAB"
         DUP [PAB DSRNAM] V!         \ store REALPAB to new PAB field
         14   [PAB FLG]    VC!       \ Default: INPUT,DISPLAY,VARIABLE
         50   [PAB RECLEN] VC!       \ Default: 80 bytes/record
         DSRNAM ! ;                  \ also write to OS field

: OPENDEV ( $addr len card -- )      \ turn card on, set DSR
          ENABLE
         ?CARDID                     \ abort if card is not 'AA'
         'DSRLIST
         DSRFIND ( -- link)
         DUP ?DEVERR                 \ abort if link=0
         DUP 83D2 !         \ store link in O/S variable
         DUP 4 +        ( -- link $) \ link+4=DSR$ ie: Name of the DSR in CARD ROM
             C@ 8355 C! ( -- link)   \ length byte of DSRNAM -> 8355
           2+ @                      \ link+2=DSR CODE entry ADDR in the ROM
           83F2 !                    \ entry address -> GPL.R9
;

\ ** HI LEVEL FUNCTIONS **
: FSTAT ( -- c) 9 FILEOP DROP [PAB STAT] VC@ ; \ see E/A Manual page 298 for meaning

\ primitive file words to bootstrap the system on startup
: OPN    ( addr len -- ior )
            PSZ NEGATE ^PAB +!             \ get a new PAB on PAB stack
            2DUP MAKEPAB ( -- $addr len)
            DSKCARD OPENDEV
            0 FILEOP ;                     \ perform OPEN opcode

\ VARIABLE: LINES \ moved to CAMEL2.HSF

: ?FILE    ( n -- ) 0= TS" Filename" ?ABORT ;

CODE: 1+!  ( addr -- ) 
           *TOS INC,
            TOS POP, 
            NEXT, 
            END-CODE

\ This word bootstraps the system on startup.
\ FILESYS8..E are nestable. Allocates a new PAB and RAM buffer
\ Usage:   TS" DSK1.START" INCLUDED
: INCLUDED  ( caddr len -- )
           DUP ?FILE
           CR T." Loading: " 2DUP TYPE
           LINES OFF
           SOURCE-ID @ >R                  \ save source-ID
           SOURCE 2>R                      \ save interpreter input source
           >IN @ >R                        \ save input string pointer
           DSRNAM @ >R                     \ save current DSR name

           OPN  ?FILERR                    \ open new file (sets new DSRNAM)
           SOURCE-ID 1+!                   \ incr. source ID (1st file is 1 etc.)

           52 DUP MALLOC >R                \ get a buffer pointer & RPUSH
          
           BEGIN
             FSTAT 3 AND 0=                \ test EOF=0, (uses low level words)
           WHILE
             2 FileOp ?FILERR              \ read record into VDP RAM, test for error
             [PAB CHARS] VC@ DUP           \ get the #chars read
             [PAB FBUFF] V@  R@ ROT VREAD  \ transfer VDP fbuff to malloc buffer
             R@  SWAP ( addr #chars)       \ this makes a stack string
             INTERPRET                     \ interpret the string
             LINES 1+!                     \ count the line
           REPEAT
           R> DROP                         \ drop buffer address from rstack
         ( 52 ) MFREE                      \ release the buffer memory

           1 FILEOP ?FILERR                \ close currently open file
           PSZ ^PAB +!                     \ pop back 1 pab on the pabstack
           R> DSRNAM !                     \ restore old file ID
           R> >IN !                        \ restore >IN
           2R> 'SOURCE 2!                  \ restore interpreter SOURCE
           R> SOURCE-ID !                  \ restore SOURCE-ID
           HEX ;

 

 

Link to comment
Share on other sites

Here is the source code for CAMEL3.HSF which creates the Forth system hi-level words.

I uses the newly arranged USER variable area but that did not seem to be the problem.

 

The biggest difference with this dbug verison is:

  • the COLD word does not try to include DSK1.START

It's important to note that cross-compiler is not standard Forth exactly. There are some special words to make it work.

They are documented at the top of this file.

That was by design so my feeble mind could know what was ti-99 code and was cross-compiler code. ;-)

 

EDIT: Here a source code file for version of the hi-level system.

With the changes I made to the user variable and the DSKLNK word, it now enables the disk card on the 99 and stops.

It does not blow up the VDP screen like it used to, so a little closer.

 

 

 

\   ____    _    __  __ _____ _    ___   ___
\  / ___|  / \  |  \/  | ____| |  / _ \ / _ \
\ | |     / _ \ | |\/| |  _| | | | (_) | (_) |
\ | |___ / ___ \| |  | | |___| |__\__, |\__, |
\  \____/_/   \_|_|  |_|_____|_____|/_/   /_/
\
\
\ __      __           _               ___
\ \ \    / /          (_)             |__ \
\  \ \  / /__ _ __ ___ _  ___  _ __      ) |
\   \ \/ / _ \ '__/ __| |/ _ \| '_ \    / /
\    \  /  __/ |  \__ \ | (_) | | | |  / /_
\     \/ \___|_|  |___/_|\___/|_| |_| |____|
\

\ Copyright (c) 2018 Brian Fox
\ KILWORTH Ontario Canada
\ brian.fox@foxaudioresearch.ca
\ This program is free software; you can redistribute it and/or modify
\ it under the terms of the GNU General Public License as published by
\ the Free Software Foundation; either version 3 of the License, or
\ (at your option) any later version.
\ You should have received a copy of the GNU General Public License
\ along with this program.  If not, see <http://www.gnu.org/licenses/>.
\
\ The work derived from CAMEL Forth under the GNU General Public License.
\ CamelForth (c) 2009 Bradford J. Rodriguez.
\ Commercial inquiries for Camel Forth should be directed to:
\ 115 First St., #105, Collingwood, Ontario L9Y 4W3 Canada
\ or via email to bj@camelforth.com


\ History
\ Originally this was a cross-compiled as a 16 bit Camel Forth System for DOS
\ Started Sept 14, 2015      Version 1.0 completed Mar 23, 2016

\ Nov 29,2016  - Ported CAMEL FORTH V .1 to TI-99

\ Mar 30,2018  - First release of Version 2 with file access

\ Aug 9,2018   V2.0.21
\              - EMIT now uses USER variables. Each task has separate VROW/VCOL
\              - Re-introduced >VPOS Code word to calculate V-addr from col,row
\              - Fixed 2@ and @! to be compliant with ANS Forth
\                This meant numerous system tweaks to make everything work
\ Aug 22, 2018
\              - Added MOVE to kernel for ANS compliance with PLACE
\              - EMIT reads VROW VCOL user variables. Now task-friendly. 
\ Sept 1, 2018
\              - changed (CR) (EMIT) C/L@ to use proper USER var addressess
\              - added TPAD user variable to provide offsets for PAD in tasks
\              - Changed HOLD back to Forth for proper multi-task no. printing

\ Sept 7, 2018 - Changed to use FILESYSE.HSF. Adds DSRNAM field to file PAB

\ Sep 24, 2018 - v2.1
\              - uses cross-compiler to create aliases for CHAR+ CELL+ CELLS
\              - adds 1+! 1-! to kernel for compiler speedup
\              - START file now loads NEEDS/FROM conditional compiling words

\ Requirements: XFC99.EXE, Cross-Compiler/Assembler  by Brian Fox

\ Credit where it's due:
\          Lessons from HSFORTH METACOMP program, by the late Jim Kalihan
\          Lessons on dictionary structure and number conversion from Camel Forth,
\          by Brad Rodriguez.
\          Many lessons from Mark Wills and Lee Stewart on the TI-99 internals
\          Cross compiler by Brian Fox Canada

\ ========================================================================
\ O B J E C T I V E

\ This Forth Cross-compiler and Forth system were created for education.
\ The hope is that with the many comments included and some online
\ reference material a person can fully understand how a threaded Forth
\ cross-compiler works from the ground up.

\ ========================================================================
\ C A M E L   F O R T H   H E A D E R    S T R U C T U R E
\ by Brad Rodriguez  Ph.D.


\     D7           D0
\     +---------------+
\     |               |   byte 1      \ LINK FLD contains NFA of previous word
\     |-    link     -|
\     |               |   byte 2
\     +-------------+-+
\     |      0      |P|   byte 3     \ P - Precedence bit, equals 1 for an IMMEDIATE word
\     +-+-----------+-+
\     |S|   length    |   byte 4     \ S - Smudge bit, used to prevent FIND from finding this word.
\     +-+-------------+
\     |               |   byte 5
\     |-    name     -|
\     |               |   ... to byte N
\     ~~~~~~~~~~~~~~~~~
\     |               |   byte n+1
\     |-  code field -|
\     |               |
\     +---------------+
\
\ CamelForth header has 1 byte extra but gives clean access to fields.
\ Link - in CamelForth, points to the previous word's name field (length)

\ ========================================================================
\ B  F O X   C R O S S   C O M P I L E R  (XFC99) G O T C H A S

\ I had never written a cross-compiler and so this one has it's own way of operating.
\ In a nutshell all IMMEDIATE words and/or words that PARSE the input stream
\ during compile time start with the letter 'T'. I also added a COLON to 
\ the end of DEFINING words to help me remember that I am cross-compiling
\
\ This made it much simpler to make it all work because there can never
\ be a word collision between the HOST, the COMPILER or the TARGET vocabularies.

\ Here is the list of 'T' prefixed words you need to use instead of the 
\ standard Forth words in order to compile code with XFC99:

\ XFC99               Standard Forth
\ -----------       ----------------
\ TCHAR                CHAR
\ T[CHAR]              [CHAR]
\ TCOMPILE             COMPILE
\ T[COMPILE]          [COMPILE]
\ TLITERAL             LITERAL
\ TS"                   S"
\ T."                  ."
\ T,"                  ,"
\ T[   ]T              [  ]

\ CONSTANT:            CONSTANT
\ VARIABLE:            VARIABLE
\ CREATE:              CREATE
\ USER:                USER

\ AND... one weird one is XIMMEDIATE is used for the IMMEDIATE TARGET
\ Forth words. (I just didn't like the look of TIMMEDIATE)

\ test for the cross-assembler
HEX
[undefined] XASSEMBLER  [if] cr ." TI-99 Cross Assembler not loaded" ABORT [then]

\ ========================================================================
\ M E M O R Y  C O N F I G U R A T I O N

\ In XFC99 we can use equates like we do in the XFC99 assembler with EQU.
\ Equates are replaced in the final code with a literal number and have
\ the advantage that the names are NOT included in the Forth dictionary.
\ This saves considerable space when building the Camel Forth kernel.

CROSS-COMPILING
HEX

       0FFF0   EQU EMEM    \ EMEM = "end of memory"
   EMEM 00F0 - EQU 'TIB    \ ADDRESS OF default Terminal Input Buffer
   EMEM 'TIB - EQU TIBSIZE

\ ========================================================================
\ Create FORTH stacks at upper end of TI-99 low memory block
HEX
       3EFE     EQU SP0      \ FORTH parameter stack base address.
      SP0 100 + EQU RP0      \ FORTH return stack base address (CHANGED TO EVEN ADDRESS)

\ ========================================================================
\       CAMEL99 memory map
\     +--------------------+ $FFFF end of memory
\     |          TIB       | $FF02
\     +--------------------+ $FF00
\     |                    |
\     |                    |
\     |                    |
\     |                    |
\     |                    |
\     |                    |
\     |                    |
\     |                    |
\     |    USER PROGRAM    |   24K program space
\     |                    |
\     +--------------------+
\     |                    |
\     |       CAMEL99      |
\     |       KERNEL       |
\     +--------------------+  $A000 (hi-RAM) Forth Dictionary begins here
\     |  MEM mapped device |
\     +--------------------+ $83FF
\     |  CPU hi-speed RAM  |
\     +--------------------+ $8300  Camel99 workspace registers and user variables
\     |      Cartridge     |
\     |      GROM/ROM      |
\     +--------------------+ $6000
\     |     Peripheral     |
\     |        ROMS        |
\     +--------------------+ $4000             --------
\     +vvvvvvvvvvvvvvvvvvvv+ $3FFE RP0            .
\     | return stack       |                      .
\     +vvvvvvvvvvvvvvvvvvvv+ $3F80 SP0            .
\     | parameter stack    |                      .
\     |                    |                      .
\     |                    |                      .
\     |                    |
\     |    HEAP MEMORY     |
\     |   ^^^^^^^^^^^^^    |                      .
\     |  (SCROLL BUFFER)   |                      .
\     |--------------------| $2100         8K low mem block
\     |   TI O/S USAGE     |
\     +--------------------+ $2000             --------
\     |                    |
\     |   CONSOLE ROMS     |
\     +--------------------+ $0000

\ ========================================================================
\ C O D E   P R I M I T I V E S
\ [CC] is short form for CROSS-COMPILING. (disables TARGET-COMPILING [TC] )

[CC] cr .( Compile Forth Assembler primitives ...)  \ This is a talking comment.
                                                    \ It reports what's happending
                                                    \ during compilation
 INCLUDE CC9900\9900NEW.HSF

\ ========================================================================
\ RESOLVE CODE WORD FORWARD REFERENCES FOR CROSS-COMPILER

\ The words beginning with ' are place holders used by the cross-compiler.
\ At compile time these words compile their value into the TARGET code.
\ Below we give them the execution token (XT) of their respective ASM WORDS.
[CC]
 T' EXIT   RESOLVES 'EXIT
     ENTR  RESOLVES 'DOCOL
 T' DOVAR  RESOLVES 'DOVAR

 T' LIT    RESOLVES 'LIT
 T' DOCON  RESOLVES 'DOCON
 T' DOUSER RESOLVES 'DOUSER
 T' DODOES RESOLVES 'DODOES
\ T' DLIT    RESOLVES 'DLIT

\ ========================================================================
\ T A R G E T   D E - C O M P I L E R
\ "TSEE" lets you de-compile Target words from within the HOST Forth
\ Great to confirm the compiler is making correct code.

CROSS-COMPILING
-1 [IF]
       INCLUDE CC9900\CCLIB\TSEE.HSF
[THEN]

\ ========================================================================
\ T A R G E T  S T A T E

TARGET-COMPILING

   VARIABLE: STATE       \ Create the variable in target space. We will use it as the Cross-compiler's state variable
                         \ TARGET variables function in the HOST Forth!

   STATE [CC] TO XSTATE  \ Now we take that address from the stack and store it in CROSS-COMPILER value called XSTATE
                         \ Now when we use XSTATE we will be toggling the value of STATE in the target memory
                         \ Why? When I did this I didn't know how best to make a cross-compiler


\ ========================================================================
\ C R O S S   C O M P I L E R   B O O T - S T R A P P I N G

\ The words in this file "bootstrap" the compiler.
\ They allow the compiler to do things before they are defined in the
\ Target system.  IF,ELSE,THEN, BEGIN,WHILE,REPEAT,UNTIL ':'  ';'
\ are all defined in the BOOTSTRP,HSF file.

CROSS-COMPILING

INCLUDE CC9900\BOOTSTRP.HSF    \ it was simpler to keep this in a separate file


\                  ***  P R E -  A M B L E   E N D S   ***
\ /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\


\           T A R G E T   F O R T H   S Y S T E M   B E G I N S
\

\ ========================================================================
\ S Y S T E M   C O N S T A N T S

CROSS-COMPILING HEX
cr .( Constants and Variables...)

TARGET-COMPILING
\ Memory constants for CAMEL99

\ ASM/Equate       Forth Name
\ -----------      ------------
 'TIB     constant: TIB            \ address of terminal input buffer (TIB) in high memory
 SP0      constant: SP0            \ Parameter stack base address
 RP0      constant: RP0            \ Return stack base address
 TIBSIZE  constant: TIB#           \ size of terminal input buffer
\ 83C2    constant: AMSQ           \ disables misc. ISRs.  see TI-Tech pages on internet

\ Utility constants
\ in Forth, literal numbers need 4 bytes, constants use only 2 bytes
        0 constant: FALSE
       -1 constant: TRUE
        0 constant: 0
        1 constant: 1
        2 constant: 2
        3 constant: 3
       20 constant: BL             \ blank character

\ ========================================================================
\ U S E R   V A R I A B L E S
\ CAMEL99 uses space after workspace for user vars.
\ User variables begin at >8320 for the primary Forth task
[CC] HEX [TC]

\ USER 0..1F are CPU workspace registers
\       0 USER: 'R0
\       2 USER: 'R1
\       4 USER: 'R2
\       6 USER: 'R3
\       8 USER: 'R4
\       A USER: 'R5
\       C USER: 'R6
\       E USER: 'R7
\      10 USER: 'R8
\      12 USER: 'R9
\      14 USER: 'R10
\      16 USER: 'R11
\      18 USER: 'R12
\      1A USER: 'R13
\      1C USER: 'R14
\      1E USER: 'R15
\ ( *not all USER vars are named to save KERNEL space* )
      20 USER: TFLAG             \ TASK flag awake/asleep status
      22 USER: JOB               \ Forth word that runs in a task
      24 USER: DP                \ dictionary pointer
      26 USER: HP                \ hold pointer, for text->number convertion
      28 USER: CSP
      2A USER: BASE
      2C USER: >IN
      2E USER: OUT               \ counts chars since last CR (newline)
      30 USER: VROW              \ current VDP column (in fast RAM)
      32 USER: VCOL              \ current VDP row (in fast RAM)
      34 USER: C/L               \ Chars per line (32 or 40 depending on VDP mode)
      36 USER: C/SCR             \ chars per screen >300 or 3C0
      38 USER: 'INTERPRET        \ Vector for the interpreter
      3A USER: LP                \ LEAVE stack pointer.
      3C USER: SOURCE-ID         \ 0 for console,  -1 for EVALUATE, 1 for include
      3E USER: 'SOURCE           \ WATCH OUT! This is 2variable, occupies 3E and 40
\      40 USER: -------          \ used by 'SOURCE
\      42 USER: CURRENT
\      44 USER: CONTEXT
\      46 USER: LH               \ local TASK HEAP pointer if needed
      48 USER: OUT               \ counts chars since last CR (newline)
\      4A USER: ----             \ O/S use *PROTECTED IN ROOT TASK, Free for other tasks
\      4C USER: ----             \ O/S use *PROTECTED IN ROOT TASK, Free for other tasks
\      4E USER: ----             \ O/S use *PROTECTED IN ROOT TASK, Free for other tasks
\      50 USER: ----             \ O/S use *PROTECTED IN ROOT TASK, Free for other tasks
\      52 USER: ----             \ O/S use *PROTECTED IN ROOT TASK, Free for other tasks
\      54 USER: ---  1+ DSRSIZ   \ O/S use *PROTECTED IN ROOT TASK, Free for other tasks
\      56 USER: ---  DSRNAM      \ O/S use *PROTECTED IN ROOT TASK, Free for other tasks
\      58 USER: ---              \ O/S use *PROTECTED IN ROOT TASK, Free for other tasks
\      5A USER: ----             \ O/S use *PROTECTED IN ROOT TASK, Free for other tasks
\      5C USER: ----             \ O/S use *PROTECTED IN ROOT TASK, Free for other tasks
\      5E USER: ----             \ O/S use *PROTECTED IN ROOT TASK, Free for other tasks
\      60 USER: ----             \ O/S use *PROTECTED IN ROOT TASK, Free for other tasks                  \ Free user variable
\      62 USER: ----             \ O/S use *PROTECTED IN ROOT TASK, Free for other tasks
\      64 USER: ----             \ O/S use *PROTECTED IN ROOT TASK, Free for other tasks
\      66 USER: ----             \ O/S use *PROTECTED IN ROOT TASK, Free for other tasks
\      68 USER: ----             \ O/S use *PROTECTED IN ROOT TASK, Free for other tasks
\      6A USER: ----             \ O/S use *PROTECTED IN ROOT TASK, Free for other tasks
\      6C USER: ----             \ O/S use *PROTECTED IN ROOT TASK, Free for other tasks
       6E USER: TPAD              \ offset used so each task has a separate PAD


\ Other HIgh speed RAM locations
\ *these constants define memory locations so they are actually VARIABLES :-)
 _CURSR constant: CURS            \ holds CURSOR character for KEY
   8346 constant: H               \ MASTER HEAP POINTER can also be a user variable
   8375 constant: KVAL            \ GPL KSCAN outputs ascii value here. >FF if no key pressed
   83D4 constant: KTP             \ copy of VDP R1. TI-99 system stores the keyboard type here
   83C6 constant: KUNIT#          \ keyboard unit# (CAMEL99 uses MODE 5, BASIC MODE)
   837C constant: GPLSTAT         \ System status byte. (GPL status regiser)


\ These system variables control cold starting the system
variable: LATEST                  \ LATEST returns the NFA of last word defined
variable: ORGDP                   \ restore DP to this on COLD boot
variable: ORGLAST                 \ restore LATEST to this on COLD boot
variable: BOOT                    \ ADDRESS OF THE FIRST Forth word to run

[CC] DECIMAL [TC]
   0024 constant: L/SCR           \ 24 lines per screen on a TI-99

[CC] HEX [TC]
variable: VMODE                   \ keeps track of the video mode we are in
variable: VTOP                    \ top of video screen memory. defaults to 0
variable: L0    3 TCELLS TALLOT   \ LEAVE stack used to resolve nested LEAVEs (4 LEAVEs max)
variable: ^PAB                    \ pointer to current open file PAB
variable: LINES                   \ track lines compiled in a file

?stk
\ ==============================================
\ F O R T H   M E M O R Y   A L L O C A T I O N
[CC] cr .( Hi-level FORTH Primitives...)

TARGET-COMPILING

: ALLOT    ( n --)  DP +!  ;      \ allocate dictionary space

\ : HERE   DP @ ;
\ By making HERE faster the system goes faster because HERE is used a lot
CODE: HERE   ( -- addr) TOS PUSH,  DP @@ TOS MOV,  NEXT, END-CODE

: ALIGN     ( -- )     HERE ALIGNED DP ! ;
: ,         ( n --)    HERE !   2 ALLOT ;
: C,        ( c --)    HERE C!  1 ALLOT ;
: PAD       ( -- addr) HERE TPAD @ + ;  \ MULT-TASK friendly using TPAD

\ : COMPILE,  ( n --)  ,  ;  \ for ITC Forth this is the same as , (comma compiler)

: COMPILE   ( -- )  R> DUP 2+ >R @ , ;  \ append inline execution token

\ set the precedence BIT in the last word defined
: IMMEDIATE ( --)  01 LATEST @ 1- ( -- imm-fld) C! ;
: LITERAL   ( n -- n|~) STATE @ IF  COMPILE LIT ,  THEN ; XIMMEDIATE

: ]         ( -- ) STATE ON  ;  XIMMEDIATE \ turn on the compiler
: [         ( -- ) STATE OFF ;  XIMMEDIATE \ turn off the compiler

\ ========================================================================
\ MINIMALIST HEAP MEMORY MANAGER
\ Used within a colon defintion these words provide simple dynamic
\ memory management.
\ Used with constants, values or variables, you can create static data types
\ in TI-99 low memory

\ Usage Examples

\  : COPYSTRING  ( addr len -- addr)
\                100 MALLOC DUP >R PLACE
\                R@ ( rstack holds the memory pointer)
\                < more code...>

\                R> DROP
\                100 MFREE ;

\ HEX 400 MALLOC CONSTANT MYBUFFER

: MALLOC     ( n -- addr ) H @  SWAP H +! ;   \ allocate heap and return pointer
: MFREE      ( n -- ) NEGATE H +! ;           \ free n bytes of heap memory

[CC] cr .( Stack primitives ...)  [tc]
\ ========================================================================
\ S T A C K   P R I M I T I V E S
\ most stack primitives have been implemented in ASSEMBLER for speed

: TUCK  ( w1 w2 --  w2 w1 w2 ) SWAP OVER ;

0 [if] \ these don't work ???

     : 2>R ( w w --)  >R >R ;
     : 2R> ( -- w w)  R> R> ;

 [else]

 \ these make compiling 1% faster but are 14 bytes bigger
 CODE: 2>R    ( d -- ) ( r-- n n)
              RP -4 ADDI,          \ 14
              TOS 2 (RP) MOV,      \ 22
             *SP+   *RP MOV,       \ 26
              TOS POP,             \ 22
              NEXT,              \ = 84
              END-CODE

 CODE: 2R>     ( -- d )
              TOS PUSH,            \ 28
              SP DECT,             \ 10
             *SP  RPOP,            \ 26
              TOS RPOP,            \ 22
              NEXT,              \ = 88
              END-CODE
[then]

\ ========================================================================
\ C O M P A R I S O N   O P E R A T O R S

[cc] cr .( Comparison)

TARGET-COMPILING

\ U< is 6 bytes in ASSEMBLER, 20 bytes in Forth
\ : U<  ( u u -- ? ) 2DUP XOR 0< IF  NIP 0< EXIT THEN - 0< ;

\ : MAX   ( n n -- n ) 2DUP < IF SWAP THEN DROP ;
\ : MIN   ( n n -- n ) 2DUP > IF SWAP THEN DROP ;

: UMIN ( u1 u2 -- u )  2DUP U> IF SWAP THEN DROP ;
: UMAX ( u1 u2 -- u )  2DUP U< IF SWAP THEN DROP ;

: WITHIN ( u lo hi -- t ) OVER - -ROT - U> ;  \ -ROT is faster on 9900

\ ========================================================================
\ M I X E D  (32BIT/16BIT)   M A T H   O P E R A T I O N S
\ Some double-precision arithmetic operators are needed to implement
\ ANSI numeric conversion in CAMEL Forth.
0 [if]

  \ *** THIS DOES NOT FIT IF YOU NEED FILE SYSTEM ***
[CC] include cc9900\cclib\floored.hsf  

[else]
\ === SMALLER FASTER NON-ANS COMPLIANT ===
\ Removed signed multiplication and division operators to save space.
\ Substituted TMS9900 machine multiplication and division.
\ You can load CAMEL Forth floored division above from the
\ /cclib folder for compatability with ANS/ISO Forth as needed.
\ I also replaced M* with UM* in the kernel to save space.
\ This all improves the speed of the kernel but...

\ *SOME CODE WILL NOT WORK PER ANS REQUIREMENTS*
\                      *****
: */MOD       ( n1 n2 n3 -- n4 n5)  >R UM* R> UM/MOD ;   \ n1*n2/n3, rem&quot
: /MOD        ( n1 n2 -- n3 n4)  0 SWAP UM/MOD ;        \  divide/remainder
: /           ( n n -- n)   /MOD NIP  ; \ these are smaller than CODE words. (4 bytes each)
: MOD         ( n n -- n)   /MOD DROP ;
: */          ( n n n -- n) */MOD NIP ;
\ : *  ( n n -- n)  UM* DROP ;          \ same size in ASM, 2x faster

[then]

\ ========================================================================
\ S T R I N G   T H I N G S

TARGET-COMPILING
: MOVE    ( src dst n -- )  \ determines if we are over-writing memory
          >R  2DUP SWAP DUP R@ +  \ -- src dst dst src src+n
          WITHIN
          IF    R> CMOVE>         \ src <= dst < src+n
          ELSE  R> CMOVE
          THEN ;

\ CAMEL Forth calls this ">COUNTED"
: PLACE       ( src n dst -- ) 2DUP C! 1+ SWAP MOVE ;

\ After seeing the VFX intel code for /STRING i realized it's WAY better
\ as a code word.  6 bytes vs 10 bytes and 10X faster
\ Speeds up WORD and PARSE for faster compiling
\ : /STRING   ( c-addr1 u1 n -- c-addr2 u2 ) ROT OVER + -ROT - ; \ ~ 290uS

CODE: /STRING ( c-addr1 u1 n -- c-addr2 u2 ) \ ~20uS!!       Clks
              TOS *SP SUB,                                  \ 18
              TOS 2 (SP) ADD,                               \ 22
              TOS POP,                         \ refill TOS   22
              NEXT,                            \ 8 bytes      62
              END-CODE

\ compile a stack string into memory with the count (Gforth)
: S,         ( c-addr u -- ) HERE OVER 1+ ALLOT PLACE  ALIGN ;

\ ========================================================================
\ H E A D E R   N A V I G A T I O N

TARGET-COMPILING
: NFA>LFA       ( nfa -- lfa)  3 - ;
: NFA>CFA       ( nfa -- cfa ) COUNT  7F AND + ALIGNED ;

\ smudge bit control in the Camel Forth
: HIDE          ( -- )  LATEST @ ( nfa) DUP C@ 80 OR  SWAP C! ;
: REVEAL        ( -- )  LATEST @ ( nfa) DUP C@ 7F AND SWAP C! ;

[CC] cr .( Parsing...)
\ ========================================================================
\ P A R S E   W O R D

\ courtesy Brad Rodriguez,  My favourite FORTH Canadian
TARGET-COMPILING

: SOURCE      ( -- adr n) 'SOURCE 2@ ;    \ Common factor, saves space

                    [CC] [PRIVATE] [TC]   \ only needed by the parser
: ADR>IN      ( c-addr' --  )             \ set >IN to offset to given adr
              SOURCE                      \ -- Cadr' adr n
              -ROT -                      \ -- n adr'-adr
              MIN  0 MAX                  \ -- n'
              >IN ! ;

                    [CC] [PUBLIC] [TC]
: PARSE       ( char -- c-addr n)         \ word delim'd by char
              SOURCE >IN @ /STRING        \ -- c adr n
              OVER >R ROT SCAN
              OVER SWAP
              IF 1+ THEN                  \ skip trailing delim. if any
              ADR>IN                      \ advance >IN   -- adr"
              R> TUCK - ;

: PARSE-WORD  ( char -- c-addr n)         \ Non-standard. gForth word. Nice factor
              DUP SOURCE >IN @ /STRING    \ -- c c adr n
              ROT SKIP                    \ -- c adr' n'
              DROP ADR>IN PARSE ;         \ -- adr" n"

: WORD        ( char -- c-addr)           \ word delim'd by char
              PARSE-WORD HERE PLACE
              HERE BL OVER COUNT + C! ;  \ append trailing blank

[CC] cr .( CAMEL FORTH Number conversion)
\ ========================================================================
\ S T R I N G  T O  N U M B E R   C O N V E R S I O N

[CC] HEX

TARGET-COMPILING
: DIGIT?     ( char -- n -1)                \ if char is a valid digit
\            (      -- x  0 )               \ if char is not valid
              DUP 39 > 100 AND +            \ silly looking
              DUP 140 > 107 AND -
              T[CHAR] 0 -                   \ but it works!
              DUP BASE @ U< ;               \ 36 bytes

: ?SIGN      ( adr n -- adr' n') \ advance adr/n if sign; return NZ if negative
              OVER C@                       \ -- adr n c
              2C - DUP ABS 1 = AND          \ -- +=-1, -=+1, else 0
              DUP IF 1+                     \ -- +=0, -=+2
                     >R 1 /STRING R>        \ -- adr' n' f
              THEN ;

: UD*        ( ud1 u2 -- ud3)              \ 32*16->32 multiply
              DUP >R * SWAP R> UM* ROT + ;  \ simplified with * BF.

: >NUMBER    ( ud adr u -- ud' adr' u' )   \ ( 0 0 str len --) convert string to number
              BEGIN  DUP
              WHILE
                  OVER C@ DIGIT? 0=
                  IF   DROP EXIT
                  THEN
                  >R 2SWAP BASE @ UD*
                  R> M+ 2SWAP 1 /STRING
              REPEAT ;

: ?NUMBER    ( c-addr -- n -1 )            \ string->number
\ ;Z                   -- c-addr 0          \ if convert error
              DUP  0 0 ROT COUNT            \ -- ca ud adr n
              ?SIGN >R                      \ R: -- ?
              >NUMBER                       \ -- ca ud adr' n'
              IF    R> 2DROP 2DROP FALSE    \ -- ca 0   (error)
              ELSE  2DROP NIP R>
                 IF NEGATE THEN TRUE        \ -- n -1   (ok)
              THEN ;

\ ========================================================================
\ V D P  S C R E E N   D R I V E R
[CC] cr .( Console output)

\ Most of the video driver is in Forth to demonstrate how it can be done.
\ In a flat out race it's not as fast as Assembler, but it is simpler
\ to understand IMHO.

TARGET-COMPILING
\ pronounced "SEE-PER-ELL-STORE"
: C/L!       ( c/l -- )         \ "chars per line store"
             DUP C/L !          \ copy chars per line in C/L variable
             L/SCR *  C/SCR ! ; \ multiply by lines/scr, and record in C/SCR

[cc] HEX [tc]

\ : GETXY   ( -- col row ) VROW 2@  ;   \ returns column & row
: AT-XY   ( col row -- ) VROW 2! ;      \ VCOL,VROW are adjacent in memory so we can 2!
: VPOS    ( -- vaddr)    VROW 2@ >VPOS ;
: CLRLN   ( col row -- ) AT-XY VPOS C/L@ BL VFILL ;  \ clear line on screen

\ -----------------------------------------------------------------------
\ Scrolling has been implemented in Forth to show how factoring out key
\ routines called VREAD & VWRITE, written in Assembler can deliver excellent
\ speed without needing to write everything in Assembler.

\ : C/CUT   ( -- n)  C/L@ 4* ;              \ Chars per cut buffer

: SCROLL   ( -- )
            C/L@ 2* DUP                    \ get chars per cut buffer and dup
            MALLOC ( -- c/s heap)          \ allocate chars per scroll in heap

            C/SCR @     C/L@  VTOP @ +     \ loops from 2nd line, to last line
            DO
               PAUSE
               I  ( -- c/s heap scr-addr)
               OVER 2DUP     C/L@ 2* VREAD   \ read chars/scroll to heap
               SWAP C/L@ -   C/L@ 2* VWRITE  \ write HEAP to line above
               C/L@ 2*
            +LOOP                          \ advance loop by chars per scroll
           0 17  CLRLN                     \ clear last line
           DROP                            \ drop heap pointer
           MFREE ;                         \ de-allocate heap memory

[cc] DECIMAL [tc]
\ ========================================================================
\ VDP text driver uses ASM words (CR) (EMIT) C/L@ and VFILL

: PAGE       ( -- )
              VTOP @
              DUP C/SCR @ OVER -           \ computer bytes in active screen.
              BL VFILL                     \ fill VDP memory from address 0 with blanks
              0 SWAP C/L@ / AT-XY ;        \ home the cursor to VTOP

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

\ new version works properly in multi-tasking
: EMIT       ( char -- ) 
             VPOS (EMIT)  \ (EMIT) takes VDP address arg
                          \ returns TRUE if we have to CR
             IF CR THEN PAUSE ;

: TYPE       ( adr cnt --) BOUNDS ?DO  I C@ EMIT  LOOP  ;
: SPACE      ( -- )   BL EMIT ;            \ EMIT a blank char (hex 20)
: SPACES     ( n -- ) 0 MAX  0 ?DO SPACE LOOP ;

: VPUT       ( c -- ) VPOS VC! ; \ put c at current col,row (that's all)

\ ========================================================================
\ S T R I N G   L I T E R A L S
[cc] HEX [tc]
\ run-time action of S"   (For ITC Forth only)
: (S")       ( -- c-addr u)
             R>              \ string we entered is on rstack
             COUNT           \ compute addr & len
             2DUP + ALIGNED  \ 2dup and add to get end of string addr
             >R ;            \ rpush the address,
                             \ IP will now skip past text on return

\ ========================================================================
\ Re-solve CROSS-COMPILER Forward reference for '(S") and 'TYPE
CROSS-COMPILING

T' (S")  RESOLVES '(S")
T' TYPE  RESOLVES 'TYPE

[cc] cr .( Character input)
\ ========================================================================
\ C H A R A C T E R   I N P U T

TARGET-COMPILING

: KEY        ( -- char)                      \ simple non-repeating KEY
              BEGIN
                CURS@ VPUT                   \ show the flashing cursor
                PAUSE                        \ multi-tasking switch
                KEY?
              UNTIL                          \ wait for key press
              KVAL C@                        \ fetch char from KSCAN buffer
              PAUSE                          \ multi-tasking switch
              BL VPUT ;                      \ erase cursor character

: BS  ( n --) VCOL @ SWAP -  0 MAX
              DUP VCOL !  OUT ! ;            \ do 'n' backspaces.

\ High level: input/output                     (c) 31mar95 bjr
: ACCEPT      ( c-addr +n -- +n')            \ get line from terminal
              OVER + 1- OVER
              BEGIN  KEY DUP 0D <>           \ test for enter (hex D)
              WHILE
                DUP EMIT
                DUP 8 =                      \ test for back-space character
                IF   DROP 1-  >R OVER R> UMAX  \ move the buffer pointer back
                     2 BS  BL VPUT           \ BF mod: erase char on the Video screen
                ELSE OVER C!  1+ OVER UMIN
                THEN
              REPEAT
              DROP NIP SWAP -  ;

[cc] cr .( Number printing)
\ ======================================================================
\ N U M B E R   T O   S T R I N G   C O N V E R S I O N

\ Forth number conversion shows the elegance of Charles Moore's
\ way of thinking.  At a glance it is hard to understand how
\ these words work. But read the comments and the code in the order
\ shown to see how they build on each other.
\ With these simple words you can create arbitrary number formatting in 114 bytes!
\ Numeric conversion is done least significant digit first, so
\ the output buffer is built backwards in memory from PAD.


TARGET-COMPILING
: UD/MOD ( ud1 u2 -- u3 ud4)
         >R 0 R@ UM/MOD -ROT R> UM/MOD ROT ;   \ 32/16->32 divide


\ ====================================================
\ Build 25 Sept 21 2018, added 1-! for faster HOLD

TRUE [if]

CODE: 1-!  ( addr -- ) *TOS DEC,  TOS POP,  NEXT, END-CODE

( only about 1% faster in numeric output speed)
  : HOLD   ( char -- ) HP 1-!  HP @ C! ;   \ decr. HP, Store char at the address contained in HP

[else]

  : HOLD   ( char -- ) -1 HP +! HP @ C! ;

[then]

\ HOLD and >DIGIT are in the inner loop so ASM speed-ups
\ makes a real difference in number printing speed
\ AND we save 6 bytes using ASM >DIGIT

\ : >DIGIT ( n -- c) DUP 9 > 7 AND + 30 + ; \ convert n to ascii digit c
 CODE: >DIGIT  ( n -- c)        \ ASM is 9 bytes smaller 4X faster
            TOS 9 CMPI,
            HI IF,              \ if n>9
               TOS 7 ADDI,      \ number is not base 10, add 7
            ENDIF,
            TOS  TCHAR 0 ADDI,  \ add ASCII 0 to TOS create char value
            NEXT,
            END-CODE

: <#     ( --)          PAD HP ! ;                          \ initialize Hold Pointer to end of the number buffer (#pad)
: #      ( ud1 -- ud2)  BASE @ UD/MOD ROT  >DIGIT  HOLD  ;  \ convert 1 digit in ud1, place in HOLD buffer
: #S     ( ud1 -- ud2)  BEGIN   # 2DUP OR    0= UNTIL ;     \ convert all digits in ud1. ud2 will be 0 (the remainder)
: #>     ( ud1 -- c-addr u) 2DROP HP @ PAD OVER - ;         \ return a stack string (address, length)  of the converted number
: SIGN   ( n -- ) 0< IF T[CHAR] -  HOLD THEN ;              \ if 'n'<0  add '-' char  string created in #PAD
: U.     ( u -- ) 0  <#  #S  #>  TYPE SPACE ;   \ print 'u' as an un-signed integer (the '0' converts u to a double(32bit) int)
: .      ( n -- ) DUP ABS 0  <# #S ROT SIGN #> TYPE SPACE ; \ print n as signed insteger

\ ========================================================================
\ M I S C E L L A N E O U S
\
TARGET-COMPILING
: RECURSE     ( -- ) LATEST @ NFA>CFA ,  ; XIMMEDIATE

: DECIMAL     ( -- ) 0A BASE ! ;
: HEX         ( -- ) 10 BASE ! ;

\ ========================================================================
\ I N T E R P R E T E R   F O R W A R D   R E F E R E N C E
\ Standard Forth does not allow us to use a word that is not already defined.
\ BUT we need the word INTERPRET to be defined so we can define "QUIT" below.
\ This is a simple way to do a forward reference.

\ In the USER variable list we created 'INTERPRET.
\ This is a container for the execution token (XT) of <INTERPRET>
\ When CAMEL99 Starts (see: COLD) we just plug the XT of <INTERPRET>
\ into the variable 'INTERPRET.

\ With this definition the Forth compiler will be happy to define QUIT below.
\ All QUIT needs is a word called INTERPRET. It does not care that it is not ready to work yet.

: INTERPRET    ( addr len -- )  'INTERPRET @ EXECUTE ;  \ fetch the XT, pass to execute

\ **later in the code we MUST store an XT in 'INTERPRET or the system will crash

\ ========================================================================
\ Q U I T :  The  O U T E R   I N T E R P R E T E R

\ QUIT is the Forth REPL (read,evaluate,print loop)
: QUIT         ( -- )
               L0 LP !                     \ init LEAVE stack pointer LP
               RP0 RP!                     \ reset rstack
               t[COMPILE] [                \ STATE = 0 (Interpreting mode)
               BEGIN
                  TIB DUP TIB# ACCEPT SPACE ( -- adr len) \ accept input to TIB, maxlen=TIB#
                  INTERPRET                               \ interpret reads the stack string
                  STATE @ 0= IF  T."  ok" cr THEN         \ if we are not compiling print OK
               AGAIN ;

: EVALUATE     ( c-addr u -- j*x)          \ interpret a stack string
               SOURCE-ID ON                \ ANS standard says SOURCE-ID = true
               SOURCE 2>R                  \ save the source
               >IN @ >R                    \ save >IN on the return stack
               INTERPRET                   \ interpret the new string
               R> >IN !                    \ restore >IN
               2R> 'SOURCE 2!              \ restore source 
               SOURCE-ID OFF ;

\ ========================================================================
\ S I M P L E   S O U N D  I N T E R F A C E

[CC] include cc9900\cclib\ticktock.hsf     \ load the hardware milli-second timer

TARGET-COMPILING

: SND!       ( c -- ) 8400 C!  ;  \ write a byte to address of TMS9919 chip

: BEEP       ( -- )
             80 SND! 5 SND!                 \ precalulated values for OSC1 1328Hz
             91 SND!                        \ turn on OSC1 at -2 dB level
             AA MS                          \ Delay ~ 170 mS
             9F SND! ;                      \ turn off OSC1

\ We use the HONK sound for ABORT like TI-BASIC does on errors
: HONK       ( -- )
             81 SND! 20 SND!                \ precalculated values for OSC1 218Hz
             90 SND!                        \ turn on OSC1 at 0 dB level
             AA MS                          \ Delay ~ 170 mS
             9F SND! ;                      \ turn off OSC1

\ ========================================================================
\ E R R O R   H A N D L I N G
\
: ABORT       ( -- )
              HONK
              SP0 SP!
              SOURCE-ID OFF
              CR QUIT ;


: ?ABORT  ( f c-addr u --)
           ROT IF  CR CR T." * " TYPE  T."  ? "
                   SOURCE-ID @ 0>
                   IF  T."  Line " LINES @ U.
                       CR CR SOURCE TYPE
                   THEN ABORT
           THEN 2DROP ;

: ?FIND       ( ? -- )       0=    HERE COUNT ?ABORT ;
: ?PAIRS      ( n1 n2 --)     -    TS" Unpaired"       ?ABORT ;
: ?COMP       ( -- ) STATE @ 0=    TS" Compile only"   ?ABORT ;
: ?EXEC       ( -- ) STATE @       TS" Interpret only" ?ABORT ;
: ?CSP        ( -- ) SP@ CSP @ -   TS" Unfinished"     ?ABORT ;
: ?STACK      ( -- ) SP0 2- SP@ U< TS" Empty stack"    ?ABORT ;

: !CSP        ( -- ) SP@ CSP ! ;  \ record stack position in CSP variable

\ ========================================================================
\ S T R I N G   L I T E R A L
\ ISO Forth 94 version compiles literal string.
\ *WARNING* when interpreting S" puts the string in PAD

: S"           ( -- )
               T[CHAR] " PARSE
               STATE @
               IF  COMPILE (S")  S,
               ELSE PAD PLACE PAD COUNT
               THEN  ; XIMMEDIATE

: ABORT"      ( i*x 0  -- i*x)    \ R: j*x -- j*x  x1=0
              ?COMP
             T[COMPILE] S"
              COMPILE ?ABORT ; XIMMEDIATE


[cc] cr .( FIND )
\ ========================================================================
\ F I N D   A   F O R T H   W O R D
\ CAMEL99 uses a fast code word called (FIND) to search the dictionary
\ it over 4 times faster than using S= and hilevel Forth words

TARGET-COMPILING
: FIND  \  c-addr --  caddr  0  if not found
\                     xt  1  if immediate,
\                     xt -1  if "normal"
                      LATEST @ (FIND) ; \ start search with the last word defined


\ ========================================================================
\ D I C T I O N A R Y   S E A R C H

TARGET-COMPILING

: '           ( -- xt) BL WORD FIND ?FIND ;
: [']         ( -- <name> ) ?COMP  '  T[COMPILE] LITERAL ; XIMMEDIATE

\ : [COMPILE]   ( -- ) ?COMP  '   ,   ;  XIMMEDIATE  ( 2012: word is Obsolete)

: POSTPONE      ( <name> -- )      \ replaces COMPILE and [COMPILE]
                ?COMP
                BL WORD FIND DUP ?FIND    \ abort if not found in dictionary
                0< IF   COMPILE COMPILE   \ 0< means non-immediate word. need COMPILE
                   THEN  , ; XIMMEDIATE   \ compile the CFA into the definition


\ ========================================================================
\ I / O   R E - D I R E C T I O N

\ : CONSOLE     ( -- )  ['] <emit> 'EMIT ! ;

\ ========================================================================
\ T E X T   O U T P U T

: ."    ( "ccc<single-quote>" -- )  \ Thanks Niel Baud R.I.P.
        t[COMPILE] S"                ( -- str len)
        STATE @ IF   COMPILE TYPE
                ELSE TYPE
                THEN ; XIMMEDIATE

: .(     T[CHAR] ) PARSE TYPE ;     \ "talking" comment


[CC] cr ." Interpreter/compiler loop"
\ ========================================================================
\ I N T E R P R E T E R  /  C O M P I L E R

TARGET-COMPILING

\ : ?UNIQUE     FIND NIP IF SOURCE TYPE T." isn't unique" THEN ;

: <INTERPRET>  ( i*x c-addr u -- j*x )    \ ; ref. dpANS-6, 3.4 The Forth Text Interpreter
               'SOURCE 2!  >IN OFF
               BEGIN
                  BL WORD DUP C@
               WHILE            \ -- caddr
                  FIND                           \ -- xt 0/1/-1
                  ?DUP IF ( it's a word)         \ -- xt 1/-1
                       1+ STATE @ 0= OR          \ test for IMMEDIATE or interpreting
                       IF   EXECUTE              \ execute it
                       ELSE  ,                   \ otherwise compile it
                       THEN

                  ELSE  ( it's a number)         \ -- textadr
                       ?NUMBER
                       IF  t[COMPILE] LITERAL    \ converted ok so compile as a literal
                       ELSE COUNT ?ABORT         \ ERROR: print the bad word & ABORT
                       THEN
                  THEN
                  ?STACK                         \ test for stack underflow
               REPEAT
               DROP ;

\ ======================================================================
\ R E S O L V E   F O R W A R D   R E F E R E N C E
\ remember how we fooled the compiler by creating 'INTERPRETER' ?
\ Here is how we finish off the process.

\ To find the XT of a word in the TARGET Forth we use the cross-compiler word T'
\ which finds the execution token (an address) of a word in the TARGET dictionary.
\ We use T! to store that XT number in the TARGET system variable.

CROSS-COMPILING
 T' <INTERPRET>  'INTERPRET ( -- addr variable) T!

\ ======================================================================
\ T I - 9 9   T E X T   M O D E   C O N T R O L
TARGET-COMPILING

: TEXT      ( -- )
             F0 DUP KTP C!        \ TI KSCAN re-writes VReg1 with whatever is in this byte.
       ( -- F0) 01 VWTR           \ VDP register 1: bit3 = 1 sets the TEXT Mode
              0 06 VWTR           \ no sprite descriptor table is set for TEXT mode
             20 07 VWTR           \ VDP register 7. color: med. green on transparent screen
             2 VMODE !            \ record the mode we are in
             28 C/L!              \ Set 40 chars/line, which also re-calcs the screen variables
             PAGE ;               \ "CALL CLEAR" 

\ ========================================================================
\ D I C T I O N A R Y   C R E A T I O N
\ Header creates a text string in memory that is linked back to the
\ last word that was defined in the Forth dictionary.

: HEADER
            LATEST @ ,            \ record the LATEST NFA as the LINK in this new word
            0 C,                  \ create the immediate field (1 BYTE)
            HERE LATEST !         \ update the LATEST variable to this new definition's NFA
            BL PARSE-WORD S, ;    \ parse input and compile NAME string into dictionary


\ ========================================================================
\ T A R G E T   S Y S T E M   D E F I N I N G   W O R D S
\ Believe it or not this is now all it takes to make Forth data types

\                    text    runtime-action   parameter
\ -------------------------  --------------- -----------
: CONSTANT  ( n --)  HEADER  COMPILE DOCON     , ; \ the comma compiles 'n' into the constant
: USER      ( n --)  HEADER  COMPILE DOUSER    , ; \ n is the BYTE offset from workspace pointer

\ something is weird with DOVAR, ?? but using literal address fixes it.
: CREATE    ( -- )   HEADER  COMPILE DOVAR       ; \ create does not have a parameter by default
: VARIABLE  ( -- )   CREATE                  0 , ; \ variables are set to zero when created

\ (:noname) came from studying gforth. It's a nice factor.
\ had to use the literal address of ENTR ($839E) to make this work.
: (:NONAME) ( -- )  839E ,  HIDE  ]  ;   \ common to ':' and ':NONAME'

\ =======================================================================
\ D O E S   S U P P O R T
: (;CODE)
         R>                        \ pops the adrs of the machine code
          LATEST @ NFA>CFA         \ gets the CFA of the latest word
         !  ;                      \ stores the machine code address in the Code Field

: DOES>  ( -- )                    \ change action of latest def'n
        COMPILE (;CODE)
        0460 , T['] DODOES ,       \ compiles machine code for:  B @DODOES
       ; XIMMEDIATE

\ =======================================================================
\ ADD-ONS
\ ** commment out everything to build the smallest kernel  **
 [CC] include CC9900\cclib\crusmall.hsf
 [CC] include CC9900\cclib\diskdsr6.hsf
 [CC] include CC9900\cclib\filesysF.hsf

\ =======================================================================
\ T E S T   C O D E   G O E S   H E R E
\ if you want to add any other code it must go before target branch compilers



\ =======================================================================
\ LOOPS AND BRANCH COMPILERS FOR THE TI-99 SYSTEM
 [CC] CR .( TARGET forth BRANCHING and LOOPING ...)

      include cc9900\cclib\targloop.hsf  \ these compile code on the TARGET system


\ =======================================================================
\ Init functions
\ 1. CREATE the FORTH VIRTUAL MACHINE when CAMEL99 starts
\ 2. copy code from HSPRIMS to HSTART($8388)
\ 3. Set the Forth IP to address of BOOT variable

CROSS-ASSEMBLING

CODE: INIT
              WRKSP0 LWPI,      \ set Forth workspace (>8300)
              R0 HSprims LI,    \ R0 is beginning of fast primitives
              R1 HSstart LI,    \ R1 is where we move them to
              BEGIN,
               *R0+ *R1+ MOV,   \ move cells
                R1 HSend CMPI,  \ compare dest. to the HSend address
              EQ UNTIL,         \ until the two are equal

              SP  SP0  LI,      \ set data stack address
              RP  RP0  LI,      \ set return stack address
              R10 NEXT2 LI,     \ set Forth interpreter into R10
              IP  BOOT  LI,     \ set Forth instruction pointer to BOOT
             *R10 B,            \ run NEXT, ie enter Forth
              END-CODE

[CC] HEX
\ ======================================================================
\ B O O T   U P   C O D E
TARGET-COMPILING
: COLD       ( -- )
              80 83C2 C!   \ ISR disable flags: >80 All, >40 Motion, >20 Sound, >10 Quit key
              ORGDP @ DP !
              ORGLAST @ LATEST !
              2000 H !                       \ inits HEAP to >2000
              26 TPAD !                      \ PAD=HERE+>26, room for HOLD buffer
              TMR!                           \ set 9901 timer to count continously
              2 KUNIT# C!                    \ keyboard #2 is the BASIC keyboard
              8370 @ 2- ^PAB !               \ GET end of VDP mem from O/S, set PAB pointer
              T['] <INTERPRET> 'INTERPRET !  \ set the interpreter vector
              SOURCE-ID OFF                  \ source-id=0 is console input
              TIB 0 'SOURCE 2!  >IN OFF      \ init interpret to TIB
              HEX                            \ set the RADIX to hex

            \ VDP start screen
              TEXT  BEEP
              TS" CAMEL99 2.1.T" TYPE
\              TS" DSK1.START" INCLUDED       \ load the start file
              RP0 RP!                        \ reset return stack pointer
              SP0 SP!                        \ reset the data stack pointer
              CR QUIT ;                      \ start the interpreter

\ ======================================================================
\ define comment words
TARGET-COMPILING
: (         T[CHAR] ) PARSE 2DROP ; XIMMEDIATE
: \                 1 PARSE 2DROP ; XIMMEDIATE

[CC]
\ ******************************************************************
\ ***    FROM HERE ON WE CANNOT PUT COMMENTS INLINE WITH CODE    ***
\ ******************************************************************
\ ======================================================================
\ C O L O N   C O M P I L E R

\ These are the last definitions but they allow us to extend the TARGET
\ Forth system with Source code


\ To avoid name conflicts we use X: & ;X to create the TARGET system ':' and ';'
TARGET-COMPILING
 X: :         !CSP  HEADER (:NONAME)  ;X

 X: :NONAME   HERE  !CSP   (:NONAME)  ;X

 X: ;        [  REVEAL COMPILE EXIT ?CSP ;X  XIMMEDIATE

[CC]
\           F O R T H   S Y S T E M   C O D E   E N D S
\ /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
cr ." Forth Kernel compiled completely"


\ ======================================================================
\  P A T C H   T H E   T A R G E T  S Y S T E M   V A R I A B L E S

\ Set the target system's LATEST variable to the last WORD compiled
\ AND copy it into ORGLAST, which is used during COLD re-starts.
[CC]
         XLATEST @ DUP LATEST T!
                       ORGLAST T!

[CC]
\ set TARGET Forth's DP variable to the same address as the cross-compiler (THERE)
\ also copy it into the ORGDP variable used for cold re-starts

         THERE DUP DP T!
                   ORGDP T!
[CC]
\ ======================================================================
\ P A T C H   T A R G E T   I M A G E

\ Update the filename, boot-address and BOOT word in the TARGET MEMORY IMAGE

         FILENAME: CAMEL99
         T' INIT 2+  BOOT-ADDRESS T!
         T' COLD     BOOT T!

         END.
[CC]
\ ======================================================================
\ S A V E   B I N A R Y  I M A G E   F I L E

         FILENAME$ $SAVE-EA5.            \ FILENAME$ was set by FILENAME:

\ ======================================================================
\  C O P Y   T O   T I - 9 9   V I R T U A L   D I S K
.( copying binary file to TI-99 Emulator DSK1.)

( //  shells out to the DOS shell in HSF2012)

      // copy CAMEL99 cc9900\clssic99\dsk1\

CROSS-COMPILING

 CR ." === COMPILE ENDED PROPERLY ==="

 \ BYE          \ exit the cross compiler or stay in to debug

 

 

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

Regarding DSKLNK , I cannot see that it is necessary to save/restore R11 around “ *R9 BL, ” unless you know something I do not (entirely possible).


NOP, is not at the place where the DSR expects an 8. The DSR does not expect an 8. It is the traditional DSRLNK that expects an 8 (or >A) after the BLWP that calls it. Rather, the location of the NOP, may be used by the DSR as an error return. It is the following address where the DSR normally returns, so you do at least need the place-holder you have provided.


I know you are trying to keep all of the ALC to just DSKLNK , but I am thinking you will need interrupts disabled before the card is turned on and not re-enabled until the card is turned off because both ISR workspace (>83C0 – >83DF) and GPL workspace (>83E0 – >83FF) are subject to change while interrupts are enabled.


...lee

Link to comment
Share on other sites

 

Regarding DSKLNK , I cannot see that it is necessary to save/restore R11 around “ *R9 BL, ” unless you know something I do not (entirely possible).
NOP, is not at the place where the DSR expects an 8. The DSR does not expect an 8. It is the traditional DSRLNK that expects an 8 (or >A) after the BLWP that calls it. Rather, the location of the NOP, may be used by the DSR as an error return. It is the following address where the DSR normally returns, so you do at least need the place-holder you have provided.
I know you are trying to keep all of the ALC to just DSKLNK , but I am thinking you will need interrupts disabled before the card is turned on and not re-enabled until the card is turned off because both ISR workspace (>83C0 – >83DF) and GPL workspace (>83E0 – >83FF) are subject to change while interrupts are enabled.
...lee

 

 

Wow, you stayed up late. ;-)

 

No I have no extra information. I was guessing that there might be a problem with changing R11 in the GPL workspace.

 

Thanks for the insights, I will make those changes and see if results change. I will replace the NOP with a data cell.

 

"I am thinking you will need interrupts disabled before the card is turned on and not re-enabled until the card is turned off because both ISR workspace (>83C0 – >83DF) and GPL workspace (>83E0 – >83FF) are subject to change while interrupts are enabled."

 

This sounds like a big one. I never thought of this being a problem. For all it's good features, the little 99 O/S is pretty weird in some ways.

 

I have yet to get Classic99 working the way Tursi suggested using TYPE 2 or TYPE 3 disk drives, which should cause the emulator to run real ROM code. That would be the ideal way to find this by single stepping the code in the debug window.

 

I think I should make that happen as a first priority. It would definitely improve the [edit, compile, load, crash] cycle time. :)

 

Thanks for your help Lee.

Link to comment
Share on other sites

Wow, you stayed up late. ;-)

 

Yeah...When I get focused on something like this, I will often run it down no matter the TOD—probably, not the most efficient process late at night. :sleep:

 

I will replace the NOP with a data cell.

 

The NOP is probably better—just in case the DSR actually returns there. The E/A cartridge’s and Paolo Bagneresi’s DSRLNKs actually install a jump back to search for another match in the linked list of device/subprogram names. If you really wanted to handle that (in my opinion, unlikely) event, you should probably error out with the “bad device name” error or some such since, with your setup, it would be inconvenient to revert back to searching the DSR’s device list.

 

I have yet to get Classic99 working the way Tursi suggested using TYPE 2 or TYPE 3 disk drives, which should cause the emulator to run real ROM code. That would be the ideal way to find this by single stepping the code in the debug window.

 

You definitely need TYPE 3 to insure actual use of the TI DSR code (TYPE 2 is simulated). Because you cannot set up TYPE 3 within Classic99 (though @Tursi implements it, he discourages its use and does not support it), I would first set up (in Classic99) whichever disk you are using as a DSK image, close Classic99, edit classic99.ini to change “Type=2” to “Type=3” in the proper “[Diskn]” section, close classic99.ini and restart Classic99.

 

...lee

Link to comment
Share on other sites

Ok thanks. Just as a final test I re-wrote Enable and Disable in code to turn off interrupts and turn on interrupts respectively.

This did not change the operation on the real TI-99 but stills works perfectly on the emulator. :(

 

So I will setup classic99 for real ROM operation and see where that leads.

CODE: Enable ( CRU -- )
              0 LIMI,
              TOS R12 CMP,
              NE IF,
                   0 SBZ,
              ENDIF,
              TOS R12 MOV,
              TOS 83D0 @@ MOV,
              0 SBO,
              TOS POP,
              NEXT,
              END-CODE

CODE: Disable  ( CRU -- )
               TOS R12 MOV,
               0 SBZ,
               TOS POP,
               2 LIMI,
               NEXT,
               END-CODE
Link to comment
Share on other sites

Here is a dumb question.

 

What's the best way to make a TI disk image?

 

I have been playing with Windows for this entire process.

 

EDIT: Found a menu option in TIDIR. I might be able to figure this out.

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...