Jump to content
TheBF

Camel99 Forth Information goes here

Recommended Posts

Burning some brain cells :) 

Here is the object code loaded by E/A option 3.

A000: 00 20 A0 06 A0 26 00 00 . ...&..
A008: 00 00 00 00 00 00 00 00 ........
A010: 00 00 00 00 00 00 00 00 ........
A018: 00 00 00 00 00 00 00 00 ........
A020: 00 00 00 00 00 00 05 A0 ........
A028: A0 00 03 80 05 A0 A0 00 ........
A030: 04 5B A0 36 A0 56 41 40 .[[email protected]
A038: 00 00 00 00 00 00 A0 00 ........
A040: 01 40 88 00 88 02 8C 00 [email protected]
A048: 8C 02 00 00 00 00 00 00 ........
A050: 00 00 00 00 00 00 06 A0 ........
A058: A0 68 C0 85 D0 64 00 01 .h...d..
A060: D6 01 06 02 16 FD 03 80 ........
A068: 06 C0 D6 40 06 C0 D6 40 [email protected]@
A070: 04 5B 04 20 A0 02 04 20 .[. ...
A078: A0 32 10 FB 00 00 00 00 .2......
A080: 00 00 00 00 00 00 00 00 ........

Here is the same Object coded loaded with OLOAD linking loader relocated to >2000.

(I init the memory map to >FF so I can see things clearer)

I think I am pretty close.

2000: 00 20 20 06 20 26 FF FF .  . &..
2008: FF FF FF FF FF FF FF FF ........
2010: FF FF FF FF FF FF FF FF ........
2018: FF FF FF FF FF FF FF FF ........
2020: FF FF FF FF FF FF 05 A0 ........
2028: 20 00 03 80 05 A0 20 00  ..... .
2030: 04 5B 20 36 20 56 41 40 .[ 6 [email protected]
2038: 00 00 00 00 00 00 20 00 ...... .
2040: 01 40 88 00 88 02 8C 00 [email protected]
2048: 8C 02 FF FF FF FF FF FF ........
2050: FF FF FF FF FF FF 06 A0 ........
2058: 20 68 C0 85 D0 64 00 01  h...d..
2060: D6 01 06 02 16 FD 03 80 ........
2068: 06 C0 D6 40 06 C0 D6 40 [email protected]@
2070: 04 5B 04 20 20 02 04 20 .[.  ..
2078: 20 32 10 FB FF FF FF FF  2......

The code got a bit more involved 

The cool thing was to resolve the REFs I pass the name in the object code to EVALUATE. 

Because:

  • DEFs create a Forth CONSTANT in the DEFS vocabulary.
  • REFs have the name of a DEF in their object code.
  • EVALUATE searches the DEFS vocabulary for that name and interprets it. 
  • Since the DEFs are constants I get the address from the interpreter. :) 

Here is the code up to now.  I need to take a break.

 

Edit: removed an obsolete word

 

Spoiler
CR .( EA3 object file loader Aug 9 2021 Fox)

NEEDS WORDLIST FROM DSK1.WORDLISTS

VOCABULARY DEFS

ONLY FORTH DEFINITIONS
\ NEEDS .S        FROM DSK1.TOOLS
NEEDS +TO       FROM DSK1.VALUES
NEEDS CASE      FROM DSK1.CASE
NEEDS -TRAILING FROM DSK1.TRAILING
NEEDS READ-FILE FROM DSK1.ANSFILES
NEEDS S=        FROM DSK1.COMPARE
NEEDS ELAPSE    FROM DSK1.ELAPSE

ONLY FORTH DEFINITIONS
DECIMAL
0 VALUE #1  \ a file handle

HEX
 2000 CONSTANT $2000
$2000 VALUE BASE-MEM  \ where we load OBJECT files

: ?BREAK  ( -- ) ?TERMINAL ABORT" *BREAK*" ;
: SPACEBAR ( -- ) KEY? BL = IF  KEY DROP  THEN ;

\ add words so we don't need to include tools
HEX
: .ID     ( NFAaddr --) COUNT 1F AND TYPE ;
DECIMAL
.( ..)
: WORDS   ( -- )
           0 >R        ( word counter on stack)
           CONTEXT @ DUP CR .WID CR
           @
           BEGIN DUP
           WHILE
              ?BREAK  SPACEBAR
              DUP ( -- nfa) .ID SPACE
              R> 1+ >R
              NFA>LFA @
           REPEAT
           DROP
           CR R>
           BASE @ >R
           DECIMAL . SPACE ." words"
           R> BASE ! ;

\ heap memory management
: HEAP! ( addr -- ) H ! ;  \ set heap pointer
: HEAP   ( -- addr) H @ ;  \ current heap pointer

HEX
: HALLOT ( n -- )  H +! ;  \ move heap pointer
: HEAP,  ( n -- )  HEAP ! 2 HALLOT ; \ compile n into heap

HEX
: NEW.
          $2000 HEAP!
          HEAP $2000 FF FILL  \ erase low ram
          HEAP TO BASE-MEM
          ['] DEFS  >BODY OFF  ;         \ remove all DEFS words

\ string utilities
: CHOP   ( addr len n --  addr' len' addr2 len2 )
          >R                  \ Rpush n
          2DUP DROP [email protected]        \ dup $, do left$
          2SWAP               \ put original $ on top
          R> 1- /STRING       \ cut remainder string, leave tag at front
          2SWAP               \ put chopped string (output) on top
;

: /TAG     ( addr len -- addr' len') 1 /STRING ; \ cut tag character

: PARSE# ( addr len -- n )
        BASE @ >R
        HEX  /TAG  4 CHOP NUMBER? ABORT" Bad number"
        R> BASE ! ;

: GETLABEL  ( addr len -- addr' len' label len)
        /TAG 6 CHOP  -TRAILING ;

: DODEF ( addr len n -- )
        >R         ( -- addr' len') ( r: -- ref_addr)
        GETLABEL ( addr' len'  label len)
        DEFS DEFINITIONS
        HEADER,  COMPILE DOCON  R>   ,  \ make a Forth Constant
        FORTH DEFINITIONS ;

VARIABLE PROGLENGTH
CREATE PROGNAME  10 ALLOT

: PROG-ID  ( addr len -- addr len)
          PARSE# PROGLENGTH !
          8 CHOP  PROGNAME PLACE ;

: .TOOLVER  ( addr len -- addr 0)
          /TAG  40 CHOP -TRAILING CR TYPE  DROP 0 ;

: ?TAG    CR ." Unknown TAG -> "  EMIT ABORT ;

: ParseLine ( add len -- )
      BEGIN
        DUP ( len<>0)
      WHILE
        OVER [email protected] ( 1stChar)
        CASE
          [CHAR] 0 OF  PROG-ID        ENDOF

          [CHAR] 1 OF  [CHAR] 1 ?TAG  ENDOF
          [CHAR] 2 OF  [CHAR] 2 ?TAG  ENDOF

          [CHAR] 3 OF  PARSE# BASE-MEM + ( ref-address) >R
                       GETLABEL DEFS EVALUATE  ( def-address)
                       R> !           ENDOF \ REF: relocatable addr. of chain

          [CHAR] 4 OF  PARSE# ( ref-address) >R
                       GETLABEL DEFS EVALUATE  ( def-address)
                       R> !           ENDOF \ REF: Absolute addr. of chain

          [CHAR] 5 OF  PARSE# BASE-MEM + DODEF  ENDOF \ DEF: relocatable address
          [CHAR] 6 OF  PARSE# DODEF   ENDOF \ DEF: absolute address

          [CHAR] 7 OF  PARSE# DROP    ENDOF \ checksum
          [CHAR] 8 OF  PARSE# DROP    ENDOF \ checksum ignored

          [CHAR] 9 OF  PARSE# HEAP!   ENDOF  \ set absolute address
          [CHAR] A OF  PARSE# BASE-MEM + HEAP!  ENDOF \ set relocatable address

          [CHAR] B OF  PARSE# HEAP,   ENDOF           \ compile literal value
          [CHAR] C OF  PARSE# BASE-MEM + HEAP,  ENDOF \ compile relocatable address

          [CHAR] D OF  [CHAR] D ?TAG  ENDOF
          [CHAR] E OF  [CHAR] E ?TAG  ENDOF

          [CHAR] F OF  DROP 0         ENDOF \ end of record
          [CHAR] : OF  .TOOLVER       ENDOF
        ENDCASE
        1 /STRING 0 MAX  \ advance to next char
     REPEAT
     2DROP ;  \ remove what's left of the input string

: ?PATH ( addr len -- addr len)
       2DUP [CHAR] . SCAN NIP 0= ABORT" Path expected" ;

DECIMAL
: .DEFS      ALSO DEFS  WORDS  PREVIOUS ;
: DIS/FIX    DISPLAY SEQUENTIAL 80 FIXED ; \ TI ASM object file format

: EA3LOAD ( "DSKx.FILE" -- )
      ?PATH DIS/FIX  R/O OPEN-FILE ?FILERR  TO #1
      TICKER OFF
      BEGIN
         #1 EOF
      0= WHILE
         PAD DUP 80 #1 READ-LINE ( pad len ? ior) NIP ?FILERR
       ( pad len ) ParseLine
      REPEAT
      #1 CLOSE-FILE ?FILERR
      .ELAPSED
;

: OLOAD ( <PATH> )
       ONLY FORTH ALSO DEFS
       PARSE-NAME  EA3LOAD
       HEAP TO BASE-MEM
       CR .DEFS ;

.( Usage: NEW.  OLOAD DSK?.FILENAME )

 

 

OLOAD-REAL-CODE.png

  • Like 2

Share this post


Link to post
Share on other sites
3 hours ago, TheBF said:
: CHOP ( addr len n -- addr' len' addr2 len2 ) 
      >R               \ Rpush n 
      2DUP DROP [email protected]     \ dup $, do left$
      2SWAP            \ put original $ on top 
      R> 1- /STRING    \ cut remainder string, leave tag at front 
      2SWAP            \ put chopped string (output) on top
;

 

 

I hate to bring this up because it has little to do with your excellent work on this project (and you may have answered this before ISTR), but isn’t

OVER

better than

2DUP DROP

...lee

  • Like 1

Share this post


Link to post
Share on other sites

Yes indeed.

I am thinking in addr,len pairs and needed a copy.

That's going into the final version. 

Thanks!

  • Like 1

Share this post


Link to post
Share on other sites

This missing piece for using Object linking and loading in Forth.

 

I took @mathew180 's demo clear screen code, turned it into a sub-routine by adding RT and assembled it generating DSK4.CLS-OBJ

 

Spoiler
* Demonstration program by @mathew180
* modified to be sub-routine for CAMEL99 EA3LOADER  2021 FOX

        DEF  CLS         * Clear the screen in 40 column mode.

* VDP Memory Map
*
VDPRD   EQU  >8800       * VDP read data
VDPSTA  EQU  >8802       * VDP status
VDPWD   EQU  >8C00       * VDP write data
VDPWA   EQU  >8C02       * VDP set read/write address

* Workspace
WRKSP   EQU  >8300       * Workspace is shared with Forth
R0LB    EQU  WRKSP+1     * R0 low byte req'd for VDP routines

* Program execution starts here
CLS     LIMI 0
*       LWPI WRKSP
        CLR  R0                * Set the VDP address to zero
        MOVB @R0LB,@VDPWA      * Send low byte of VDP RAM write address
        ORI  R0,>4000          * Set read/write bits 14 and 15 to write (01)
        MOVB R0,@VDPWA         * Send high byte of VDP RAM write address

        LI   R1,>2000          * Set high byte to 32 (>20)
        LI   R2,>3C0           * bytes in the 40 column screen
LOOP1   MOVB R1,@VDPWD         * Write byte to VDP RAM
        DEC  R2
        JNE  LOOP1
        RT                     * return to caller 
        END

 

 

With this script below and the word EXTERN:  we can create external routines that can be called from Forth. :)

 

Note:
  *W register returns the Forth DATA field address where we stored the DEF address.
   We must fetch the value in that address to get the actual DEF sub-routine address that was recorded in the EXTERN: declaration.

 

\ EXTERN.FTH  CALL a DEF sub-routine from Forth

\ Command Sequence to use this:
 INCLUDE DSK4.EA3LOADER
 
 NEW.
 OLOAD DSK4.CLS-OBJ

FORTH DEFINITIONS
HEX
: EXTERN: ( addr -- ) \ create a word the does BL @addr
      CREATE      ,   \ compile DEF addr into the word
\ runtime BL to the addr in FORTH's working register
      ;CODE C218 , \ *W W MOV,  \ Fetch DEF address from Forth
            0698 , \ *W BL,     \ call external code
            NEXT,
      ENDCODE

DEFS CLS FORTH EXTERN: CLS

The video shows the process in action and then clearing the screen with mathew180 's code.

 

I will also make an EXTERN-PROG:  that takes a BLWP vector DEF and call this from Forth and return, if the program ends with RTWP.

 

With a little better organization we can compile the loader, load our object files and then remove the ea3loader from Forth so we have space for our program.

 

  • Like 2

Share this post


Link to post
Share on other sites

Escape from GROM?

 

I saw this cool piece of code 

 

 

Then I did a little reading and did this:

\ run grom code

INCLUDE DSK1.ASM9900
INCLUDE DSK1.GRAFIX  \ sets up 32 column mode

HEX
\ >216F Start TI-BASIC
\ >4D7C	Prints "Bad Value".
\ >4D81	Prints "String-number mismatch".
\ >566C	Prints "Can't do that".
\ >56CD	Scrolls up.
CODE RUNGROM
    TOS R1 MOV,
    TOS POP,
    R1 9C02 @@ MOVB,
    R1 SWPB,
    R1 9C02 @@ MOVB,
    83E0 LWPI,
    0070 @@ B,
ENDCODE

Is there a way to get back home to Forth after entering the GPL interpreter?

 

 

  • Like 2

Share this post


Link to post
Share on other sites

Short of using the LOAD interrupt, Strangcart or hijacking another device's DSR.

 

See...

(Local)..\classic99\Contributors\Harry_Wilhelm\Playground.🛴

:)

Edited by HOME AUTOMATION
punct.
  • Like 1
  • Thanks 1

Share this post


Link to post
Share on other sites

I have been absent for a while.  I took some vacation and had to continue working on a my contract job.

 

Another reason that I have not posted is that after getting the linking loader working I took on the challenge of how make a direct-threaded code (DTC) kernel of the V2.68 code base.

It has been frustrating.  I can make a direct threaded kernel, add a little program to it and it runs perfectly and quickly too.

When I try and start the interpreter it crashes.  I have narrowed it down to the ACCEPT word in the QUIT loop but it is the same source code that compiles in the indirect threaded kernel.

My home-made cross-compiler is probably at fault. My next test will have to thoroughly check out IF/THEN for correct operation since I use a different source file for DTC operation.

 

The DTC kernel is really a curiosity since I don't like how it consumes more memory but it is about 10% faster overall and it bugs me that it doesn't work.

Obsession is a bitch. :)

 

 

 

 

  • Like 3

Share this post


Link to post
Share on other sites

Machine Code vs CREATE ;CODE 

 

I decided to revisit how to connect Assembly language DEF statements to Forth words that do something.

 

My knee-jerk reaction was to use CREATE ;CODE which forced me to use an extra instruction to fetch the DEF address from Forth before acting on it.

Example:

: EXTERN: ( addr -- ) \ create a word the does BL @addr
      CREATE      ,   \ compile DEF addr into the word
\ runtime BL to the addr in FORTH's working register
      ;CODE C218 , \ *W W MOV,  \ Fetch DEF address from Forth
            0698 , \ *W BL,     \ call external code
            NEXT,
      ENDCODE

 

Machine code to the rescue:

\ Linkage to Forth
HEX
: EXTERN:   ( def --)  CODE  0460 , ( addr) ,  NEXT,  ;   \ B @def
: EXT-SUB:  ( def --)  CODE  06A0 , ( addr)  ,  NEXT,  ;  \ BL @def
: EXT-PROG: ( def --)  CODE  0420 , ( vector) ,  NEXT,  ; \ BLWP @def
: EXT-DATA:  CONSTANT ;

Way smaller and a direct connection to the Assembler language code.

 

So connecting to @farmerpotato's code we just do this:

NEW.
OLOAD DSK4.THING1
OLOAD DSK4.THWACK

FORTH DEFINITIONS
DEFS
THING1 EXT-DATA: VAR1  \ delares a Forth constant 
THINK  EXT-PROG: PROG1 \ BLWP to THINK
THWACK EXT-PROG: PROG2 \ BLWP to THWACK
LOOP   EXTERN: RUN     \ jump into code never come back

I also found some code by Vorticon for his plotter that would have benefited from this linker if I had it 2018.

Each of the words on the screen are normal sub-routines so we would link them to Forth with EXT-SUB: 

The only changes needed were to change some registers to avoid stepping on Forth's dedicated registers.

Alternatively we could use a new workspace for these sub-routines or even change them to simple pop arguments from the Forth stack.

 

Now I need to document this thing. It actually works. :)

 

Future:

1.  Make a way to load the loader, link some object files and remove the loader while leaving the DEF declarations in the dictionary.

 

 

vorticon_plotter.png

  • Like 2

Share this post


Link to post
Share on other sites

 

Some discussion came up around using Forth Assembler for a project. 

I thought I would try and draw some comparisons between TI Assembly language and Forth style assembers created by Chuck Moore.

 

For completeness let's document the normal Assembler process (jump in anyone and fill in my oversights)

 

Assembler

1. With the editor write the program source code.

    a) Write any extra source code for external modules that you need.

2. Save the file(s)

3. Process the source files with the assembler giving object code files

4. Link the object files of the program and all needed modules giving an executable program (TI does this with a linking loader)

5. Load the executable file to run the program. (other systems)

 

Forth Assembler: (with Assembler already loaded into the system)

1. With the editor write the code for your new "code" word 

2. Save the file or block

3. Include the file or load the block with the new routine you just saved

4. Type the name to run the new Assembly language word.

 

Compare

Assembler was built assuming that the entire program would be written in Assembler.

Forth Assembler assumes you will use the Assembler for extra speed or to access special CPU or hardware functions.

 

Assembler object code is not runnable and must be linked first

Forth Assembler compiles directly to memory and so can be run when assembly is done.

 

The Assembler and linker/loader are external programs. 

Forth is the Assembler and the linker and the loader.

 

Assembler requires you to design everything about the internal register usage of your program and how parameters will be passed back and forth.

Forth gives you a skeleton system with 2 stacks in place. One for DATA and one return stack which Forth assembly language can use pretty freely.

This provides a "protocol" for passing parameters to your code that is convenient but require that you adapt to it.

It also allow nested sub-routines to be used very easily if you need that.

 

The linking process lets you connect different pieces of code into one program.

Forth's colon definition lets you connect your assembly language routines together as a finished program.

The interpreter lets you test each module and how they inter-operate as bigger components.

 

Conclusion:

You can write an entire program in Forth Assembler on a  regular Forth system but it would be un-natural. 

The natural way with Forth is to write many small efficient assembler words , test as you go and then connect them together as a final colon definition.

Then save the entire thing as binary executable.

 

The alternative if you insisted on all assembly language, would be to write in a Forth Cross-assembler that takes source code and makes a binary image.

Save the image and run the program. 

 

 

 

 

 

 

 

 

 

 

 

 

 

  • Like 2

Share this post


Link to post
Share on other sites

To follow up on using a Forth Assembler with labels, here is the only example I have of significant piece of code translated from regular Assembler to Forth Assembler and using both text and numerical labels.

When I did the translation I chose to use structured loops where I could to help me grok the code, but there was some spaghetti in there that was too much trouble to remove so labels to the rescue.

 

L:  <NAME>   is a label for long branches or where the entire address is used.

 

1 $:     sets a label for JMP and the family of short jump instructions

1 $      is used with the JMP instructions to goto a  $: location. 

 

You can see that to do math in the assembler it is RPN which takes a moment to get use to. :) 

The EQU directive works backwards per normal Forth.   <value> EQU <label> 

One thing I forgot to mention is that Forth's colon definitions provide a very versatile MACRO maker as you can see in VDPWA,  below. 

Give it a register name and it will set up the VDP to write

 

Also notice that the BLWP vector DLNK  must be created after the code label is declared as forward references are not normal in Forth.

(you can do it but it's not automatic)

 

 

\ DSRLNKA.FTH for METACOMP cross-compiler for CAMEL99 Forth  Aug 2, 2021 Fox
\ Source:
\ posted by InsaneMultitasker via Thierry Nouspikel

\ PASSES error code back to Forth workspace, TOS register
ONLY FORTH ALSO ASSEMBLER DEFINITIONS
HEX
\ MACRO to simplify the VDP code
: VDPWA, ( reg -- )
       DUP           SWPB,   \ setup VDP address
       DUP VDPWA @@  MOVB,   \ write 1st byte of address to VDP chip
       DUP           SWPB,
           VDPWA @@  MOVB,   \ write 2nd byte of address to VDP chip
;

: [TOS]      8 (R13)  ;  \ gives access to Forth top of stack register

L: HEX20   20 TC,
L: HEXAA   AA TC,
L: PERIOD  2E TC,      \ '.'
        TALIGN

L: H2000   2000 T,
L: CYC1    0000 T,
L: H1300   1300 T,

\ use memory below Forth RETURN stack for workspace & name buffer
 RP0 80 -      EQU DREGS
 4 2* DREGS +  EQU DREG(4)  \ address of dsr wksp R4
 5 2* DREGS +  EQU DREG(5)  \ compute address of DREGS register 5
 DREGS 8 -     EQU NAMBUF   \ small buffer to parse the device name

\ === DSR ENTRY POINT ===
\ ** HEADLESS CODE TO SAVE SPACE **
NEWLABELS                   \ init labels. NEEDS resolver at end of CODE
L: DSR1                     \ label is in CC wordlist not in TARGET dictionary
      *R14+     R5  MOV,    \ fetch '8' from program ->R5, inc PC for return
       HEX20 @@ R15 SZCB,   \ >20 eq flag=0
       8356 @@  R0  MOV,    \ [PAB FNAME] to R0
       R0       R9  MOV,    \ dup R0 to R9
       R9       -8  AI,     \ R9-8 = [PAB FLG]
       R0          VDPWA,   \ set the VDP address to use
       VDPRD @@ R1  MOVB,   \ read length of FNAME -> R1

\ setup to copy VDP FNAME ->namebuf to '.' character
       R1       R3  MOVB,   \ DUP length byte to R3
       R3       08  SRL,    \ swap the byte to other side
       R2   NAMBUF  LI,     \ R2 is ^namebuf
       R4           SETO,   \ length counter, R4 = -1
       BEGIN,
         R0            INC,    \ point to next fname VDP address
         R4            INC,    \ counter starts at -1
         R4       R3   CMP,    \ is counter = fnamelength
         1 $           JEQ,    \ if true goto @@1:
         R0          VDPWA,    \ set VDP address
         VDPRD @@ R1  MOVB,    \ read next VDP char from fname
         R1      *R2+ MOVB,    \ copy to namebuf & inc pointer
         R1 PERIOD @@ CMPB,    \ is it a '.'
       EQ UNTIL,               \ until '.' found  34 bytes!!!

1 $:   R4        R4  MOV,    \ test R4(device name length)=0
                6 $  JEQ,    \ if so, goto ERROR6
       R4       07   CI,     \ is dev name length>7
                6 $  JGT,    \ if so, goto 6$ (ERROR6)
\ -------- ENTRY POINT SHOULD BE HERE -------------
       83D0 @@       CLR,    \ erase magic CRU addr. holder
       R4   8354 @@  MOV,    \ put length in magic address
       R4            INC,    \ +1 points to '.' character
       R4   8356 @@  ADD,    \ add offset to PAB address (makes "real PAB")

\ ==== GPL WORKSPACE ====
       83E0         LWPI,    \ SROM (search ROM device list)
       R1           CLR,     \ MAGIC GPL REG. 1 to call DSR, returns error
       R2   4000    LI,    \ ROM start addr -> R2
       H2000 @@ CYC1 @@ MOV, \ init the CYC1 variable ??
       R12     0F00 LI,      \ init CRU base to 0F00
       0A $ JMP,

9 $:    \ scan for I/O cards
       R12   1000   LI,      \ init CRU address
       H1300 @@ CYC1 @@ MOV,
      BEGIN,
0A $:    R12   R12   MOV,
         NE IF,              \ if card address<>0
              00 SBZ,        \ turn off card
         ENDIF,
         R12    0100  AI,  \ advance CRU to next card
         83D0 @@      CLR,   \ erase magic addres
         R12    2000  CI,
         9 $         JEQ,   \ Scan ROM
         R12  CYC1 @@ CMP,
         5 $         JEQ,   \ no more cards. goto ERROR5
\ card activation...
         R12  83D0 @@ MOV,   \ save card CRU in magic address
         00           SBO,   \ turn on the card
        *R2  HEXAA @@ CMPB,  \ test for card present
       EQ UNTIL,             \ loop until card is found
       DREG(5) @@ R2 ADD,    \ add '8'+4000= >4008 DSR ROM list
       0B $          JMP,

3 $:  \ scan ROM linked list for code address
      BEGIN,
         BEGIN,
           83D2 @@   R2 MOV,   \ start of ROM device list -> R2
           00           SBO,   \ turn card on
0B $:      *R2       R2  MOV,   \ Fetch next link
           0A $          JEQ,   \ if link=0 goto @@A (NEXT CARD)
           R2  83D2 @@  MOV,   \ save link address in magic address
           R2           INCT,  \ R2 = code pointer
          *R2+      R9  MOV,   \ fetch code address ->R9
           8355 @@  R5  MOVB,  \ dev length->R5
           4 $          JEQ,   \ if 0 we have a string match
           R5      *R2+ CMPB,
         EQ UNTIL,

         \ find dev string match
         R5       08  SRL,     \ shift length byte
         R6   NAMBUF  LI,      \ R6 hold ^nambuf
         BEGIN,
           *R6+   *R2+ CMPB,   \ compare namebuf to ROM string
            3 $        JNE,    \ if mismatch goto @@3
            R5         DEC,    \ dec the counter register
         EQ UNTIL,
4 $:    \ run DSR code
         R1        INC,        \ count entries into the DSR ?
        *R9         BL,        \ call the DSR code
      AGAIN,                   \ try next card

\   -- DSR returns here if we are done --
       00            SBZ,  \ Turn off the card
       DREGS         LWPI, \ ==== DSR Workspace ====
       R9           VDPWA, \ set vdp address
       VDPRD @@  R1  MOVB, \ read error value to DREGS R1
       R1 0D         SRL,  \ shift error to correct range
       7 $           JNE,  \ if error<>0 goto @@7
                     RTWP, \ else return to Forth workspace

\ error condition handlers
5 $:   DREGS         LWPI, \ we came from GPL workspace, restore DREGS

\ device name length errors
6 $:  R1            SETO, \  error code in R1. *THIS SEEMS TO MATTER*

\ device not found error
7 $:  R1      [TOS] MOV,  \ Move error code to Forth TOS

\ GPL error test
      GPLSTAT @@  R0 MOVB, \ get gpl status byte
                 R0 SWPB,
      R0       0020 ANDI,  \ mask to get GPL error bit
      R0      [TOS] SOC,   \ "OR" GPL & DSR error codes
      HEX20 @@ R15  SOCB,  \ set Forth's workspace 'EQ' flag to 1
                    RTWP,  \ return to Forth
                    RESOLVER  \ resolve jumps cuz we didn't use CODE/ENDCODE

\    ====== DSR LINK ENDS======
\ /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/

\ create the vector for BLWP in target memory
L: DLNK      DREGS T,  DSR1  T,

\ words that appear in the dictionary
TARGET-COMPILER
CODE DSRLNK  ( [pab_fname] -- ior)
      TOS  8356 @@ MOV,
               TOS CLR,
                 0 LIMI,    \ disable interrupts here
     TOS GPLSTAT @@ MOVB,   \ clear GPL status register
           DLNK @@ BLWP,
                   8 T,     \ Offset to DSR linked list in card ROM
                 2 LIMI,
                   NEXT,
ENDCODE

 

 

  • Like 1

Share this post


Link to post
Share on other sites
9 hours ago, TheBF said:

The natural way with Forth is to write many small efficient assembler words , test as you go and then connect them together as a final colon definition.

This is how I understood it to be at an advantage and to make Sense in documentation. I can't wait to get dirty...

  • Like 1

Share this post


Link to post
Share on other sites

Camel99 Linker Update

 

I have made some changes to the EA3 LOADER and now call the it a LINKER.

 

It now works well. You can write scripts that link all your files and INCLUDE those scripts to automate the linking.

You are limited to 8K of total code space but that is quite a bit of assembly code if it's just for testing.

 

I have started the docs but have a bunch of writing yet to complete it. 

 

The video link shows it all in action with @FarmerPotato 's   example programs linked and tested at the Forth command line.

Does this have any value as a test platform for Assembly Language programmers?  I don't know what's out there for real iron.

 

(11) Camel99 Linker - YouTube

 

 

Source Code

Spoiler
CR .( EA3 object file LINKER, Aug 10 2021 Fox)

NEEDS WORDLIST FROM DSK1.WORDLISTS
ONLY FORTH DEFINITIONS

\ NEEDS .S        FROM DSK1.TOOLS
NEEDS +TO       FROM DSK1.VALUES
NEEDS CASE      FROM DSK1.CASE
NEEDS -TRAILING FROM DSK1.TRAILING
NEEDS ELAPSE    FROM DSK1.ELAPSE

HERE
VOCABULARY DEFS

MARKER /LINKER  \ remove LINKER

ONLY FORTH DEFINITIONS
DECIMAL
0 VALUE #1  \ a file handle

HEX
 2000 CONSTANT $2000
$2000 VALUE BASE-MEM  \ where we load OBJECT files

: ?BREAK  ( -- ) ?TERMINAL ABORT" *BREAK*" ;
: SPACEBAR ( -- ) KEY? BL = IF  KEY DROP  THEN ;

\ add words so we don't need to include tools
HEX
: .ID     ( NFAaddr --) COUNT 1F AND TYPE ;
DECIMAL
.( ..)
: WORDS   ( -- )
           0 >R  ( word counter on Rstack)
           CONTEXT @ DUP CR .WID CR
           @
           BEGIN DUP
           WHILE
              ?BREAK  SPACEBAR
              DUP ( -- nfa) .ID SPACE
              R> 1+ >R
              NFA>LFA @
           REPEAT
           DROP
           CR R>
           BASE @ >R
           DECIMAL . SPACE ." words"
           R> BASE ! ;

\ heap memory management
\ : HEAP! ( addr -- ) H ! ;  \ set heap pointer
: HEAP   ( -- addr) H @ ;  \ current heap pointer
: HALLOT ( n -- )  H +! ;  \ move heap pointer
: HEAP,  ( n -- )  HEAP ! 2 HALLOT ; \ compile n into heap

HEX
: NEW.
          $2000 H !
          HEAP $2000 FF FILL  \ erase low ram
          HEAP TO BASE-MEM
          ['] DEFS  >BODY OFF  ;         \ remove all DEFS words

\ string utilities
: CHOP   ( addr len n --  addr' len' addr2 len2 )
          >R                  \ Rpush n
          OVER [email protected]             \ dup $, do left$
          2SWAP               \ put original $ on top
          R> 1- /STRING       \ cut remainder string, leave tag at front
          2SWAP               \ put chopped string (output) on top
;

: /TAG     ( addr len -- addr' len') 1 /STRING ; \ cut tag character

: PARSE# ( addr len -- n )
        BASE @ >R
        HEX  /TAG  4 CHOP NUMBER? ABORT" Bad number"
        R> BASE ! ;

: GETLABEL  ( addr len -- addr' len' label len)
        /TAG 6 CHOP  -TRAILING ;

: DODEF ( addr len n -- )
        >R         ( -- addr' len') ( r: -- ref_addr)
        GETLABEL ( addr' len'  label len)
        DEFS DEFINITIONS
        HEADER,  COMPILE DOCON  R>   ,  \ make a Forth Constant
        FORTH DEFINITIONS ;

VARIABLE PROGLENGTH
CREATE PROGNAME  10 ALLOT

: PROG-ID  ( addr len -- addr len)
          PARSE# PROGLENGTH !
          8 CHOP  PROGNAME PLACE ;

: .TOOLVER  ( addr len -- addr 0)
          /TAG  40 CHOP -TRAILING CR TYPE  DROP 0 ;

: ?TAG    CR ." Unknown TAG -> "  EMIT ABORT ;

\ See E/A manual page 309 for meanings of object file tags.
: ParseObject ( add len -- )
      BEGIN
        DUP ( len<>0)
      WHILE
        OVER [email protected] ( tag)
        CASE
          [CHAR] 0 OF  PROG-ID           ENDOF

          [CHAR] 1 OF  [CHAR] 1 ?TAG     ENDOF
          [CHAR] 2 OF  [CHAR] 2 ?TAG     ENDOF

          [CHAR] 3 OF  PARSE# BASE-MEM + ( ref-address) >R
                       GETLABEL DEFS EVALUATE ( def-address)
                       R> ( -- def ref) ! ENDOF

          [CHAR] 4 OF  PARSE# ( ref-address) >R
                       GETLABEL DEFS EVALUATE ( def-address)
                       R> ( -- def ref) ! ENDOF

          [CHAR] 5 OF  PARSE# BASE-MEM + DODEF  ENDOF
          [CHAR] 6 OF  PARSE# DODEF      ENDOF

          [CHAR] 7 OF  PARSE# DROP       ENDOF
          [CHAR] 8 OF  PARSE# DROP       ENDOF

          [CHAR] 9 OF  PARSE# H !        ENDOF
          [CHAR] A OF  PARSE# BASE-MEM + H !  ENDOF

          [CHAR] B OF  PARSE# HEAP,      ENDOF
          [CHAR] C OF  PARSE# BASE-MEM + HEAP,  ENDOF

          [CHAR] D OF  [CHAR] D ?TAG     ENDOF
          [CHAR] E OF  [CHAR] E ?TAG     ENDOF

          [CHAR] F OF  DROP 0            ENDOF \ end of record
          [CHAR] : OF  .TOOLVER          ENDOF
        ENDCASE
        1 /STRING 0 MAX  \ advance to next char
     REPEAT
     2DROP ;  \ remove what's left of the input string

: ?PATH ( addr len -- addr len)
       2DUP [CHAR] . SCAN NIP 0= ABORT" Path expected" ;

DECIMAL
: .DEFS      ALSO DEFS  WORDS  PREVIOUS ;

: EA3LOAD ( caddr len -- )
           ?FILE
           CR ." Linking " 2DUP TYPE
           SOURCE-ID @ >IN @ 2>R           \ save source-ID, input pointer
           PSZ NEGATE ^PAB +!              \ make new PAB, on pab stack
           ( $ len ) 80 04 FOPEN ?FILERR   \ OPEN as DISPLAY FIXED 80 INPUT
           SOURCE-ID 1+!                   \ incr. source ID (1st file is 1)
           LINES OFF                       \ reset the line counter
           BEGIN
             2 FILEOP 0=                   \ file read operation
           WHILE
             HERE 200 + DUP FGET ( addr n) \ read line to temp mem buffer
             ParseObject                   \ interpret line of object code
             LINES 1+!                     \ count the line
           REPEAT
           PSZ ^PAB +!                     \ remove PAB from pab stack
           2R> >IN !  SOURCE-ID !          \ restore >IN, SOURCE-ID
;

: LINK ( <PATH> )
       TICKER OFF
       PARSE-NAME EA3LOAD
       HEAP TO BASE-MEM
       CR .DEFS
       .ELAPSED ;

\ Linkage to Forth
HEX
CODE RUN  ( def --)  0454 ,  C136 , NEXT, ENDCODE  \ B  *TOS    DROP
CODE CALL ( def --)  0694 ,  C136 , NEXT, ENDCODE  \ BL *TOS    DROP
CODE BLWP ( def --)  0414 ,  C136 , NEXT, ENDCODE  \ BLWP *TOS  DROP

: EXTERN:   ( def --)  CODE  0460 , ( addr) ,  NEXT,  ;   \ B @def
: EXT-SUB:  ( def --)  CODE  06A0 , ( addr)  ,  NEXT,  ;  \ BL @def
: EXT-PROG: ( def --)  CODE  0420 , ( vector) ,  NEXT,  ; \ BLWP @def

PAGE .( Camel99 Linker  Sept 2021)
CR
CR .( Usage: )
CR .( NEW.  clear low ram for code)
CR .( LINK DSK?.FILENAME   load object)
CR .( Commands:)
CR .( <def> RUN     branch to def)
CR .( <def> CALL    BL to def)
CR .( <def> BLWP    blwp to def)
CR
CR .( Declare DEFs as Forth code: )
CR .( <def> EXTERN: <name>  branches to DEF)
CR .( <def> EXT-SUB: <name> BL to DEF)
CR .( <def> EXT-PROG: <name> BLWP to DEF)
CR .( <def> EXT-DATA: <name> def ->Forth constant)
CR
NEW.
CR .( Low RAM initialized)
CR HERE SWAP - DECIMAL . .( bytes)

 

 

  • Like 5

Share this post


Link to post
Share on other sites

To CREATE/DOES> or not to CREATE/DOES>,  that might be the question

 

After embedding myself in Machine Forth I started wondering about an idea I had some time back which was:

Can I replace the 9900 Assembler mnemonics with equivalent Forth names and make a "machine forth" Assembler. 

 

The answer so far is "I think so". (whether anybody cares is another matter) 

 

However in the course of looking at the existing Assembler that we inherited from TI-Forth I see some needless complexity.

It might just be young engineers saying "Look how cool my code is!" :)

 

The CREATE DOES> or   <BUILDS DOES>  idea is really neat but it adds run-time overhead and takes up extra space in the system so its use should be reserved for those times when it really solves the problem.

 

Compare these two ways to make the simpler instructions for TMS9900

 

Original:

: 0OP     CREATE ,  DOES> @ , ;

0340 0OP IDLE,   0360 0OP RSET,  03C0 0OP CKOF,
03A0 0OP CKON,   03E0 0OP LREX,  0380 0OP RTWP,

: ROP     CREATE , DOES> @ + , ;
02C0 ROP STST,
02A0 ROP STWP,

: IOP     CREATE , DOES> @ , , ;
02E0 IOP LWPI,
0300 IOP LIMI,

Versus:

HEX
\ : IDLE, ( -- ) 0340 , ; \ "Should not be used on the HOME Computer"
\ : RSET, ( -- ) 0360 , ;
\ : CKOF, ( -- ) 03C0 , ;
\ : CKON, ( -- ) 03A0 , ;
\ : LREX, ( -- ) 03E0 , ;
: RTWP  ( -- ) 0380 , ;

: STST ( reg -- ) 02C0 +  , ;
: STWP ( reg -- ) 02A0 +  , ;

: LWPI ( addr --) 02E0 ,   ,  ;
: LIMI ( n -- )   0300 ,   ,  ;

 

Which one is easier to understand?

Which one is compiles to less bytes?

Which one will Assemble code faster?

:)

 

Edit: Corrected instruction CKOF mistake

IDLE REST CKON CKOFF  "...should not be used on the Home Computer..." E/A Manual.

So they will be removed from the Camel99 Assembler to save space.

  • Like 2

Share this post


Link to post
Share on other sites
3 hours ago, TheBF said:

HEX \ : IDLE, ( -- ) 0340 , ; \ "Should not be used on the HOME Computer" \ : RSET, ( -- ) 0360 , ; \ : CKOF, ( -- ) 03C0 , ; \ : CKON, ( -- ) 03A0 , ; \ : LREX, ( -- ) 03E0 , ; : RTWP ( -- ) 0380 , ; : STST ( reg -- ) 02C0 + , ; : STWP ( reg -- ) 02A0 + , ; : LWPI ( addr --) 02E0 , , ; : LIMI ( n -- ) 0300 , , ;

This to me is easier to understand, even though my copy/paste sucks on a phone. But anyway..

  • Like 2

Share this post


Link to post
Share on other sites

Replacing the Assembler with Machine Forth 

 

I am finally doing some experiments to see how this will work.

My conclusion so far is that it is best to allow naming the registers to fit with the architecture of the 9900.

However the register names will be Forth names. In the case of CAMEL99 they would be:

\ R0   temp
\ R1   temp
\ R2   temp
\ R3   AREG  \ address register
\ TOS  R4 is top of stack cache (you need to manage it) :-)
\ SP     data stack pointer
\ RP     return stack pointer
: NOS   *SP  ;    \ Next on Stack
: 3RD   2 (SP)  ;
: 4TH   3 (SP)  ;
: 5TH   4 (SP)  ;

TOS (top of stack) and NOS (next on stack) are register names from the F21 Forth CPU.  So this is consistent with Chuck Moore's work.

 

I have not decided if some machine Forth instructions should use the TOS NOS pair implicitly sometimes, so it is more like Forth or mandate that registers be explicitly used to make it more Assembler like. 

I am starting with explicit registers because that is the best fit to the 9900 architecture.

 

I renamed the Assembler jump tokens to make the code look more Forth-like. (not sure they are all correct) :)

HEX                  \ Action if TRUE
 01 CONSTANT >       \ JLT to ENDIF, *signed
 02 CONSTANT U>      \ JLE to ENDIF,
 03 CONSTANT 0<>     \ JEQ to ENDIF,
 04 CONSTANT U<      \ JHE to ENDIF,
 05 CONSTANT <=      \ JGT to ENDIF, *signed
 06 CONSTANT 0=      \ JNE to ENDIF,
 07 CONSTANT OC      \ JNC to ENDIF,
 08 CONSTANT NC      \ JOC to ENDIF,
 09 CONSTANT OO      \ JNO to ENDIF,
 0A CONSTANT U<      \ JLO to ENDIF,
 0B CONSTANT U>=     \ JH  to ENDIF,
 0C CONSTANT NP      \ JOP to ENDIF,

The concept works at least at the simple level. 

Here are two programs that generate the same machine code:

HEX
\ Code in Forth Assembler
ASSEMBLER CODE ASM1
       TOS FFFF LI,
       BEGIN,
         TOS DEC,
      EQ UNTIL,
      NEXT,
ENDCODE

\ Same code in MForth Assembler.
\ NOTE: Registers must be explictly referenced
MFORTH CODE MFORTH1
       FFFF TOS !#
       BEGIN
         TOS 1-
       0= UNTIL
       NEXT,
ENDCODE

I have added the '->'  operator to compile memory to memory MOV instructions.

(I suppose I will need  C->  or something like that for byte moves)

Here is a test program that works

\ using variables/addresses
MFORTH CODE MFORTH2
       FFFF TOS !#
       BEGIN
         TOS 1-
         TOS X !
         X -> Y    \ mem2mem  X->X assignment
         Y -> Z    \ Y -> X
       0= UNTIL
       NEXT,
ENDCODE

 

So yes it is a new notation to learn but it does make something of a universal Assembler that could in theory allow machine code to be generated on other machines quite easily.

 

Here is the code generated by MFORTH2

DADE  0204  li   R4,>ffff
DAE2  0604  dec  R4
DAE4  C804  mov  R4,@>da8e
DAE8  C820  mov  @>da8e,@>da98
DAEE  C820  mov  @>da98,@>daa2
DAF4  16F6  jne  >dae2                 
DAF6  045A  b    *R10     

 

 

 

 

 

  • Like 3

Share this post


Link to post
Share on other sites

Update on the Forth Syntax Assembler

 

I have been fighting some other battles but my thoughts on this idea are that it has merit but will probably still require some native looking mnemonics to fully use the 9900 instruction set since it has to fully support the register nature of the 9900. 

 

I am not sure how far to pursue it at this time but we have a beginning. 🙂

 

At the moment I have a Camel99 Forth issue with understanding why saving a binary image with wordlists is not stable.

I am missing something simple (I hope) but it has eluded me so far.

 

 

 

  • Like 3

Share this post


Link to post
Share on other sites

FOXSHELL built on Latest Sources

 

Doing a some maintenance and I have a new version of the FoxShell.  I have corrected some oversights in the Kernel so they are in here now.

The ANS file support is smaller now so that is reflected.

Also I have not included DSK1.TOOLS in this version. Since this is just a Forth system under the hood you can INCLUDE DSK1.TOOLS from the Camel99 Forth DSK1 if you need it.

 

This shell is actually a nice system to use for program development since you have all the disk utilities at your finger tips and it reboots immediately.

The COLD command now resets the FoxShell to the default dictionary so can load Forth code and play around and just type COLD to remove it and get a clean system.

 

Please report bugs and/or any features you wish it had.

 

EDIT: Made Lee's changes to the source code. Zip file is also new.

         Changed MORE so you can see the contents of a DF128 file. (Not fully tested) 

         Usage: DF128 MORE DSK2.MY128FILE 

         COLD resets the file access mode to DV80. 

Source:

Spoiler
\ FOXSHELL.FTH   CAMEL99 shell for disk file management
\ Oct 2020:  built with SAVESYS to create stand alone program
\ Feb 8 2021, Built V1.2 with CAMEL99 V2.66 and libraries
\ Sep 23 2021, V1.4, Build on Camel99 2.68F
\             need new Ansfiles with W/A (write append)
\             Fixed MORE giving error on end of file. How'd I miss that? :-\

\ NEEDS DUMP       FROM DSK1.TOOLS
NEEDS OPEN-FILE  FROM DSK1.ANSFILES
NEEDS VALUE      FROM DSK1.VALUES
NEEDS CASE       FROM DSK1.CASE
NEEDS BUFFER:    FROM DSK1.BUFFER
NEEDS MALLOC     FROM DSK1.MALLOC
NEEDS COMPARE    FROM DSK1.COMPARE
NEEDS U.R        FROM DSK1.UDOTR   \ right justified printing

CR .( Compiling FOXSHELL )

VARIABLE WARNINGS   WARNINGS ON
CREATE #BYTES  0 , 0 ,     \  32bit variable for big files

: #BYTES+! ( n -- ) #BYTES [email protected] ROT M+ #BYTES 2! ; \ add n, keep 32bit sum

\ busy spinner to show activity
VARIABLE SPIN#
CREATE SCHARS   CHAR | C, CHAR / C, CHAR - C, CHAR \ C,
: GETXY    ( -- col row) VROW [email protected] ;
: SPINCHAR ( -- char ) SPIN# @ 1+ 3 AND DUP SPIN# ! SCHARS + [email protected]  ;
: SPINNER  ( -- )      SPINCHAR GETXY >VPOS VC! ;

\ simplified file language
\ Usage example:  S" DSK2.MYFILE" R/W OPEN TO #1
HEX .( .)
0 VALUE #1   0 VALUE #2   0 VALUE #3

: OPEN  ( addr len -- hndl ) OPEN-FILE ?FILERR ;
: CLOSE ( hndl -- )         CLOSE-FILE ?FILERR ;
: READH ( hndl -- )         READ-LINE ?FILERR 2DROP ;

DECIMAL
\ CR if near end of screen
: ?CR     ( n -- ) LINES @ 3 MOD 0= IF CR THEN ;
.( .)
HEX
\ string helpers
 : ?PATH    ( addr len -- )
            2DUP [CHAR] . SCAN NIP
            0= IF CR TYPE TRUE ABORT" Path expected" THEN ;

 : ?FAM     FAM @ 0= ABORT" Set file mode:DV80 DF128" ;
 : ARG$     ( -- addr len ) BL PARSE-WORD ?PATH ;
 : $.       ( $addr -- ) COUNT TYPE ;
 : $.LEFT   ( $ width -- ) OVER [email protected] - >R $.  R> SPACES ;
 : NEXT$    ( addr len -- addr' len') + COUNT ;
\  : +PLACE  ( addr n $ -- ) 2DUP 2>R  COUNT +  SWAP CMOVE 2R> C+! ;

DECIMAL
80 VALUE BUFFSIZE

: DF128  ( -- )
     128 TO BUFFSIZE
     DISPLAY RELATIVE   BUFFSIZE FIXED ;

: DV80  ( -- )
     80 TO BUFFSIZE
     DISPLAY SEQUENTIAL BUFFSIZE VARI ;

.( .)
HEX
: CLOSE-ALL ( --)  4 1 DO  I ]FID @ IF  I CLOSE-FILE DROP THEN   LOOP ;

\ ?break closes all open files.
: ?BREAK ( ? -- ) IF  CLOSE-ALL   TRUE ABORT" *BREAK*"   THEN ;

\ Modify key to allow it to break and close files
: FKEY    ( -- char)
           VPOS [email protected] >R
           BEGIN                  \ start the loop
              CURS @              \ fetch 2 char cursor (space & _ )
              [email protected] 1FFF <         \ compare hardware timer to 1FFF
              IF DROP [email protected] THEN VPUT   \ swap cursor for screen char, write
              ?TERMINAL ?BREAK    \ test for Break key
              KEY?                \ check the keyboard
              ?DUP                \ DUP IF <> 0
            UNTIL                 \ loop until a key pressed
            R>  VPUT ;            \ put the space char on screen

\ screen control
: SPACE?   ( -- ?) KEY? BL = ;
: SPACEBAR ( -- ) SPACE? IF    FKEY DROP    THEN ;

.( .)
: OPEN-CATFILE ( adr len -- hndl) RELATIVE 100 FIXED R/O BIN OPEN ;

\ 4 DIGIT BCD to int convertor. Limited to 9999 (Lee's correction)
HEX
: F>INT   ( addr len -- addr len n)
          OVER [email protected]  ( -- mantissa)
          CASE
            0 OF  0                    ENDOF
           40 OF  OVER 1+ [email protected]           ENDOF
           41 OF  OVER 1+ [email protected] 64 * >R
                  OVER 2+ [email protected]  R> +     ENDOF
           ( default)
                  SWAP -1  \ bad # indicator
           ENDCASE ;

DECIMAL
: DIR.TYPE  ( addr -- )
          F>INT
          CASE
             1 OF ." Txt/Fix"  ENDOF
             2 OF ." Txt/Var"  ENDOF
             3 OF ." Bin/Fix"  ENDOF
             4 OF ." Bin/Var"  ENDOF
             5 OF ." Program"  ENDOF
             ." ????"
          ENDCASE ;
.( .)
: HEAD.REC ( addr -- )
          DECIMAL
          DUP  7 $.LEFT SPACE COUNT ( addr len)
          NEXT$
          ."  Size " NEXT$ F>INT 5 U.R   ."  Used " NEXT$ F>INT 5 U.R
          2DROP ;

: DIR.REC ( addr -- )
          DUP  11 $.LEFT SPACE COUNT ( addr len)
          NEXT$ DIR.TYPE
          NEXT$ F>INT 7 U.R
          NEXT$ F>INT 7 U.R
          2DROP ;

: FILE.REPORT
          BASE @ >R
          DECIMAL
          CR LINES @ . ." lines, " #BYTES [email protected] UD. ." bytes"
          R> BASE ! ;

\ ========================================
\ *
\ * User commands: CAT DIR MORE DEL COPY
\ *

: CAT  ( <DSK?.> )   \  needs the '.' ONLY shows file name
          BASE @ >R DECIMAL
          ARG$ OPEN-CATFILE >R  \ store file handle

          PAD 80 [email protected] READH
          CR PAD HEAD.REC
          CR 13 SPACES  ." -type-  -sect- -b/rec-"

          LINES OFF
          BEGIN
             PAD DUP 80 [email protected] READH
           ( PAD)  [email protected]   \ do while length > 0
          WHILE
             CR PAD DIR.REC
             1 LINES +!
             SPACEBAR
             ?TERMINAL ?BREAK
          REPEAT
          R> CLOSE
          CR LINES @ . ." files" CR
          R> BASE ! ;
.( .)
HEX
: DIR  ( <DSK?.> )
          ARG$
          OPEN-CATFILE >R  \ push handle
          PAD 50 [email protected] READH
          CR PAD HEAD.REC
          CR

          LINES OFF
          BEGIN
            PAD DUP 80 [email protected] READH
          ( PAD) [email protected]   \ do while length <> 0
          WHILE
             PAD 0D $.LEFT ?CR
             1 LINES +!
             SPACEBAR
            ?TERMINAL ?BREAK
          REPEAT
          R> CLOSE
          DECIMAL
          CR LINES @ . ." files" CR
          HEX ;

.( .)

: MORE ( <filename>)
    BL PARSE-WORD ?FILE
  ( DV80) R/O OPEN-FILE ?FILERR >R
    0 0 #BYTES 2!
    LINES OFF
    BEGIN
      PAD DUP 50 [email protected] READ-LINE ?FILERR DROP ( Caddr len --)
      LINES 1+!
      DUP #BYTES+!
      CR TYPE
      KEY? BL =
      IF KEY DROP
      ELSE
         ?TERMINAL
         IF  R> CLOSE-FILE  2DROP CR ." ^C" ABORT
         THEN
      THEN
      [email protected] EOF
    UNTIL
    DROP
    R> CLOSE-FILE
    FILE.REPORT
;

HEX
: TOUPPER ( char -- upperchar ) 5F AND ;

: SURE?  ( -- ?)
         WARNINGS @
         IF
           CR ." Are you sure? (Y/N)"   ( )
           KEY TOUPPER [CHAR] Y =
         THEN ;

: .CANCEL  CR ." Cancelled" CR ;

: DEL   ( <filename>)
         ?FAM
         ARG$ 2DUP R/W OPEN-FILE ?FILERR
         CR ." Delete " TYPE
         SURE?
         IF  7 FILEOP ?FILERR
              CLOSE-FILE 2DROP
              CR ." Done"
         ELSE
            DROP  .CANCEL
         THEN ;
DECIMAL
: MOVE-FILE ( buff-size -- buff-size)
        ?FAM
        0 0 #BYTES 2!
        DUP MALLOC >R
        LINES OFF
        SPACE
        BEGIN
\ 256 is used to accomodate the largest possible record size
          [email protected]  BUFFSIZE #1 READ-LINE ?FILERR ( -- #bytes eof?) DROP
          DUP #BYTES+!
          [email protected] SWAP #2 WRITE-LINE ?FILERR
          LINES 1+!
          SPINNER
          #1 EOF
        UNTIL
        R> DROP                 \ DROP buffer address from rstack
        MFREE
;
.( .)
DECIMAL
: COPY  ( <file1> <file2> )
        ?FAM
        ARG$ ARG$
        SURE?
        IF
          W/O OPEN TO #2
          R/O OPEN TO #1
          BUFFSIZE MOVE-FILE
          #2 CLOSE
          #1 CLOSE
          CR ." Copy complete. "
          FILE.REPORT
        ELSE
           2DROP 2DROP  .CANCEL
        THEN
;

HEX
: APND  ( <file1> <file2> )
        ?FAM
        ARG$  ARG$
        W/A  OPEN TO #2  \ *new* W/A, open destination in Append mode
        R/O  OPEN TO #1
        BUFFSIZE MOVE-FILE
        #2 CLOSE
        #1 CLOSE
        CR ." Append complete"
        FILE.REPORT
;

: CLS   PAGE ;

: HELP  CR
        CR ." Commands"
        CR ." --------------------"
        CR ." HELP Show this list"
        CR ." DIR  <DSK?.> show file names"
        CR ." CAT  <DSK?.> show files and types"
        CR ." MORE <path>  show contents of DV80 file"
        CR ." DEL  <path>  delete file at path"
        CR ." COPY <path1> <space> <path2> "
        CR ."      Copy file at path1 to path2"
        CR ." APND <path1> <space> <path2"
        CR ."      Append file1 to file2"
        CR ." WAITFOR <path> Paste to Classic99"
        CR ." CLS  Clear screen"
        CR ." COLD  reboots FoxShell"
        CR ." BYE  Return to Home screen"
        CR ." WARNINGS OFF   Disables 'Are you sure?'"
        CR ." ------------------"
        CR ." SPACE bar will stop scrolling"
        CR ." FNCT 4 halts operations"
;


\ re-write accept to use new KEY. ( could patch it but this is clearer)
: FACCEPT     ( c-addr +n -- +n')
             OVER + OVER
             BEGIN
               FKEY DUP 0D <>
             WHILE
                DUP EMIT
                DUP 8 =
                IF   DROP 1-  3 PICK  UMAX  \ changed to use: 3 PICK   B.F.
                ELSE OVER C!  1+ OVER UMIN
                THEN
             REPEAT
             DROP NIP SWAP - ;
.( .)
: RCV  ( caddr len --  )
      DV80 W/O OPEN TO #1
      BEGIN
        PAD DUP 50 FACCEPT ( addr len) #1 WRITE-LINE ?FILERR
      AGAIN ;

\ USED WITH Classic99. Pastes text into DV80 FILE
: WAITFOR  ( <PATH> )
        ARG$
        CR ." Waiting for file " 2DUP TYPE
        CR ." Press FCTN 4 to halt & SAVE"
        CR RCV ;

: COLD           \ replace COLD so we always reboot correctly
       WARM
       201E CURS !
       DV80
       PAGE ." Fox Shell V1.4      Brian Fox 2021"
       DECIMAL
       HELP
       WARNINGS ON
       ABORT ;

\ Remember this dictionary status for WARM boot
DP @         ORGDP !
LATEST @   ORGLAST !

CR .( Save as EA5 binary files)
INCLUDE DSK1.SAVESYS
 ' COLD  SAVESYS DSK2.FOXSHELL

 

 

 

FOXSHELL1.4.ZIP

  • Like 6

Share this post


Link to post
Share on other sites
3 hours ago, TheBF said:

Please report bugs and/or any features you wish it had.

 

HEX
\ 3 DIGIT BCD to int convertor. Limited to 999
: F>INT   ( addr len -- addr len n)
          OVER [email protected]  ( -- mantissa)
          CASE
            0 OF  0                    ENDOF
           40 OF  OVER 1+ [email protected]           ENDOF
           41 OF  OVER 1+ [email protected] 64 * >R
                  OVER 2+ [email protected]  R> +     ENDOF
           ( default)  -1  \ bad # indicator
           ENDCASE ;
DECIMAL

Not to put too fine a point on it, but the floating point numbers are BCC (Binary Coded Centimal—radix 100) rather than BCD (Binary Coded Decimal—radix 10), which limits F>INT to 9999 rather than 999.

 

There is also a bug in the default case. The bad # indicator (-1) needs to be swapped with the leftover byte so that ENDCASE does not consume the indicator:

HEX
\ 4 DIGIT BCC to int convertor. Limited to 9999
: F>INT   ( addr len -- addr len n)
          OVER [email protected]  ( -- mantissa)
          CASE
            0 OF  0                    ENDOF
           40 OF  OVER 1+ [email protected]           ENDOF
           41 OF  OVER 1+ [email protected] 64 * >R
                  OVER 2+ [email protected]  R> +     ENDOF
           ( default)  -1  \ bad # indicator
                  SWAP     \ get byte for ENDCASE where it belongs
           ENDCASE ;
DECIMAL

...lee

  • Like 1

Share this post


Link to post
Share on other sites

Look another shiny object  :)

(I should be on Ritalin) 

 

I made the mistake of looking at Mark's code for compiling code into SAMS pages.

It's a pretty neat hack.  I would not have thought of doing it quite like this.

 

I was able to translate it but it didn't work.  Hmmm...

 

Why?  Well, TF  branches to literal addresses internally.  Camel Forth branches to an +/- offsets

Where Mark compiles BRANCH that doesn't work in Camel Forth so I created a new Forth word:  

 

GOTO  🤣

CODE GOTO  ( addr -- )  *IP IP MOV,  NEXT, ENDCODE

Once I discovered the magic word I started trimming it down. I have removed some of the sugar because I have less space, not using a cartridge. 

  • Colon/semi-colon is not overloaded. If you want to compile a word in SAMS use FAR: / ;FAR  This is consistent with the Chuck's rule "Let the dictionary be your case statement" 
  • SETBANK is  much simpler because it just tests for range and sets the _BANK value.
  • The Bank stack has been re-written using ideas I got from Camel Forth internals. It's a little less code than using VALUEs. 
  • CMAP is narrow focused for this job and so is quite a bit smaller and faster than >MAP 

Todo:

  • I think I can remove the HERE array but using the last CELL of each block to hold the dictionary pointer of the block we map in. 
  • Settle on the actual range of SAMS pages I want to use for CODE and fix the limits. 
  • Make the headers and footers in FAR: and ;FAR smaller by factoring out the existing code into a few words (some CODE would speed this up too) 
  • Use the return stack instead of _NHERE to save the Forth dictionary pointer on entry to a new word. 
     

Here is the code for CAMEL99 Forth

Spoiler
\ Code in SAMS memory based on TurboForth by Mark Wills
\ Translation to Camel99 Forth  Sept 30 2021  Fox

INCLUDE DSK1.MARKER
INCLUDE DSK1.VALUES
INCLUDE DSK1.TOOLS
INCLUDE DSK1.ASM9900

\ ARRAY  creates a fast cell size array
HEX
: ARRAY ( n -- )
      CREATE      CELLS ALLOT      \ compile time
;CODE ( n -- addr)             \ RUN time
       0A14 ,   \  R4 1 SLA,   \ 2*  ie: CELLS
       A108 ,   \  W  R4 ADD,  \ base-address+tos=address'
       NEXT,
       ENDCODE

DECIMAL
  32 ARRAY ]HERE   \ array of dictionary pointers for each page

\ SAMS memory management for code
HEX              3000 CONSTANT CSEG      \ code seg in CPU RAM
4000 CSEG 0B RSHIFT + CONSTANT CREG      \ compute CSEG SAMS register
CSEG 0C RSHIFT        CONSTANT PASSTHRU  \ default page for CSEG

\ CMAP brings pages of code into the window called CSEG
\ The SAMS register is pre-calculated as constant CREG
CODE CMAP ( bank# -- )
     TOS SWPB,
     R12 1E00 LI,
     0 SBO,             \ turn on the card
     TOS CREG @@ MOV,   \ store bank# in SAMS register
     0 SBZ,             \ turn off card
     TOS POP,           \ refill top of stack register
     NEXT,
ENDCODE

-1 VALUE _BANK                 \ current bank
 0 VALUE _MAXBANK
 0 VALUE _NHERE
\ _____________________________________________
\ Stack to handle pages
DECIMAL
CREATE BS0     20 CELLS ALLOT
CREATE BSP  BS0 ,    \ stack pointer, initialzed to BS0

\ : BSDEPTH ( -- n) BSP @   BS0 -  2/ ;

: >BS     ( bank# --) DUP  2 BSP +!   BSP @ !  CMAP  ;
: BS>     ( -- bank#)
      BSP @  DUP BS0 = ABORT" Bank stack underflow"  \ remove line for speed
      @  CMAP
      -2 BSP +!  ;

HEX  F9 >BS   \ force first entry on bank stack to SAMS page 0

HEX
: BANKS ( n -- )  \ reserve space for here pointers for n banks
  DUP TO _MAXBANK
  DUP 1+ 0 DO  CSEG I ]HERE !  LOOP  \ init "here" for each bank
  CR 4 * .  ." K of SAMS reserved." CR ;

\ TF uses address branching. Camel Forth uses Offset branching.
\ GOTO lets us do a direct branch to a literal address in the Forth code
CODE GOTO  ( addr -- )  *IP IP MOV,  NEXT, ENDCODE

: FAR: ( -- )
    :
\ Run-time action
    POSTPONE LIT _BANK ,  \ compile my bank#
    POSTPONE >BS          \ push my bank# and MAP
    POSTPONE GOTO _BANK ]HERE @ DUP ,  \ compile jump to here for this bank

\ compile-time action
    HERE TO _NHERE       \ save "normal here"
     DP !                \ set dp to _bank's "here"
    _BANK CMAP           \ map in the appropriate bank
;

: ;FAR ( -- ) \ end banked compilation
      POSTPONE GOTO  _NHERE ,
      HERE  _BANK ]HERE !           \ update here for bank
      _NHERE DP !                   \ restore dp to "normal" memory
      POSTPONE BS>
      POSTPONE ;
; IMMEDIATE

: SETBANK ( bank -- )
   DUP _MAXBANK 0 WITHIN ABORT"  Bad bank number"
   TO _BANK
;

HEX
: _BFREE ( -- n) 4000  _BANK ]HERE @ - ;
: .BFREE ( -- )  DECIMAL _BFREE  .  ." FAR page bytes free." CR ;

 

 

  • Like 3

Share this post


Link to post
Share on other sites

Why make a new stack when you already have two?

: FAR: ( -- )
    :                     \ compile header in CPU RAM
\ Run-time action
    POSTPONE _BANK                     \ compile my bank#
    POSTPONE DUP>R  POSTPONE CMAP      \ push & MAP the bank into RAM
    POSTPONE GOTO _BANK ]HERE @ DUP ,  \ compile jump to here for this bank

\ compile-time action
    HERE TO _NHERE       \ save "normal here"
     DP !                \ set dp to _bank's "here"
    _BANK CMAP           \ map in the appropriate bank
;

: ;FAR ( -- ) \ end banked compilation
      POSTPONE GOTO  _NHERE ,
      HERE  _BANK ]HERE !           \ update here for bank
      _NHERE DP !                   \ restore dp to "normal" memory
      POSTPONE R> POSTPONE CMAP
      POSTPONE ;
; IMMEDIATE

I can now confirm that the code above works reliably using the return stack for SAMS pages but I think I have exhausted the possibilities of this method to put CODE into SAMS. Lee made mention of it in the Foxit thread regarding the large headers created in the Forth dictionary.

 

I vectored the function of : and ; to be FAR: and FAR; and then compiled the following list of files into a single 4K SAMS page.

INCLUDE DSK1.ANSFILES
INCLUDE DSK1.CATALOG
INCLUDE DSK1.DIR
INCLUDE DSK1.MORE
INCLUDE DSK1.GRAFIX
INCLUDE DSK1.DIRSPRIT
INCLUDE DSK1.COOLSPRITE

Before I loaded the file I had 13,518 bytes remaining in my CPU RAM. (Forth kernel+SAMS code stuff+Tools) 

After loading the files here are the numbers:

SAMS Page:  698 bytes free, so 3,398 bytes used 

CPU Free: 9514 free,  so 4004 bytes used >> just for the headers<<  :) 

 

So I will take this learning and incorporate some of it into my next work.

 

  • Like 3

Share this post


Link to post
Share on other sites

From the last time I spoke with Mark he said he was getting back into his TF project since his master degree chase was about caught up. But I haven't heard from him since the virus outbreak.

Share this post


Link to post
Share on other sites
31 minutes ago, GDMike said:

From the last time I spoke with Mark he said he was getting back into his TF project since his master degree chase was about caught up. But I haven't heard from him since the virus outbreak.

It would be great to have him hanging around  here again. 

 

BTW I may have discovered why Mark used a separate stack for his SAMS pages.  I think you need that default page# on the bottom that he has.

More experiments needed.

  • Like 2
  • Thanks 1

Share this post


Link to post
Share on other sites

When I regained consciousness...

 

I found that I finally had a working version of FAR: / ;FAR  That reduced the overhead in the Dictionary.

Using the original Turbo Forth method translated to Camel99 Forth this empty definition:

FAR: TEST  ;FAR 

Took  26 dictionary bytes and  4 SAMS bytes 

 

With the work I did this week, the same definition consumes 16 Dictionary bytes and 4 SAMS bytes.

 

I did this by making a proper colon definition for FAR: that has it's own run-time code.  This replaces all the "compiled" words in the TF code and it should be faster as well. 

I  use two data fields:  Bank# and SAMS dictionary pointer.  The code word FARCOL  uses the IP register to read these sequential bytes into their appropriate places.

 

It's still not giving me as much efficiency as I would like but it reduces the Forth dictionary consumption by about 40% when I load my ANS Files library.

I have tested the calling overhead yet.  

Bugs:

1. There is a SAMS memory bug somewhere because I cannot squeeze as many files into a 4K block as I can with more direct translation of TF version that I did earlier. ??

    I think I am advancing an extra cell after each definition. More sleuthing needed...

2. Changing Banks is not reliable yet.

 

 

This has been way harder than I wanted it to be but thanks to Mark paving the way I had a place to begin.

 

Here is the current state of the code:

 

Spoiler
\ Code in SAMS memory based on code in TurboForth by Mark Wills
\ Translation to Camel99 Forth  Oct 6, 2021

\ Changes from original:
\ Remove bank stack.  Used return stack for bank# storage
\ Removed BANKS. Changed to preset DP array
\ CMAP is a fast sub-routine for mapping SAMS pages F0..FF
\ Coded is limited to one 64K segment at top of SAMS
\ Changed to compile a far "colon" definition.

INCLUDE DSK1.MARKER
INCLUDE DSK1.VALUES
INCLUDE DSK1.LOWTOOLS
\ INCLUDE DSK1.TOOLS
\ INCLUDE DSK1.ASM9900

HERE

\ SAMS memory management for code
HEX              3000 CONSTANT CSEG      \ code seg in CPU RAM
4000 CSEG 0B RSHIFT + CONSTANT CREG      \ compute CSEG SAMS register
CSEG 0C RSHIFT        CONSTANT PASSTHRU  \ default page for CSEG

DECIMAL
CREATE []DP  \ DP for 0 .. 15 pages of SAMS
  CSEG , CSEG , CSEG , CSEG  ,
  CSEG , CSEG , CSEG , CSEG  ,
  CSEG , CSEG , CSEG , CSEG  ,
  CSEG , CSEG , CSEG , CSEG  ,

HEX
CODE ]HERE ( ndx -- addr )
     A104 ,           \ TOS TOS ADD,
     0224 , []DP ,   \  TOS SAT AI,
     NEXT,
ENDCODE

F0 VALUE _1STBANK
FF VALUE _MAXBANK

 VARIABLE  SAVHERE   \ temp holder for RAM Dictionary pointer
 VARIABLE  BANK#    \ active SAMS bank#

HEX
\  MAPPER always adds the _1STBANK offset.
CREATE MAPPER ( R1: 0 .. 16 )  \ !! SUB-ROUTINE !!
      R1 _1STBANK AI, \ add the offset
      R1 SWPB,          \ swap bytes
      R12 1E00 LI,      \ DO CMAP
      0 SBO,            \ turn on the card
      R1 CREG @@ MOV,   \ restore bank# from return stack
      0 SBZ,            \ turn off card
      RT,

CODE CMAP  ( bank# --) \ Forth word to map SAMS pages
      TOS R1 MOV,
      MAPPER @@ BL,
      TOS POP,
      NEXT,
      ENDCODE

CODE GOTO  ( addr -- )  C259 , ( *IP IP MOV,)  NEXT, ENDCODE

CREATE FARCOL   \ run time executor for SAMS colon words.
     IP RPUSH,
     W IP MOV,
     *IP+ R2 MOV,         \ fetch bank# from DATA FIELD -> R2
     R2 RPUSH,            \ push the bank#
     R2 R1 MOV,           \ dup R2 to R1
     MAPPER @@ BL,        \ pull in the SAMS page
     *IP IP MOV,         \ get SAMS DP & set IP
     NEXT,

\ FAR word data structure:
\   CELL: link
\   BYTE: immediate field
\   BYTE: name length
\   BYTES: <....>
\   CELL:  code field
\   CELL:  DATA field #1 , bank#
\   CELL:  DATA field #2 , SAMS code field address

: FAR: ( -- ) \ special colon for words in FAR memory
     !CSP
     HEADER               \ compile Forth header
     FARCOL ,             \ compile the new executor as CFA
     BANK# @ DUP>R ,      \ compile bank# as the DATA field
     [email protected] ]HERE @ ,         \ compile this word's location in SAMS

     HERE SAVHERE !       \ save "normal here"
     [email protected]  CMAP \ map in the appropriate bank
     R> ]HERE @ DP !     \ set dp to CSEG. Compiling goes here now
     HIDE

     ]                    \ turn on the compiler
;

HEX
CODE FAREXIT
     R1 RPOP,
     MAPPER @@ BL,
     IP RPOP,
     NEXT,
ENDCODE

: FARSEMIS
      POSTPONE FAREXIT POSTPONE [ REVEAL ?CSP ; IMMEDIATE

: ;FAR ( -- ) \ end banked compilation
      POSTPONE GOTO  SAVHERE @ ,
      HERE  BANK# @ ]HERE !    \ update here for bank
      SAVHERE @ DP !           \ restore dp to "normal" memory
      POSTPONE FARSEMIS
; IMMEDIATE

: SETBANK ( bank# -- ) \  0..15 are valid args
     DUP 100 0 WITHIN ABORT"  Bad bank number"
     BANK# !
;

HEX
: _BFREE ( -- n) 4000  BANK# @ ]HERE @ - ;
: .BFREE ( -- ) DECIMAL
    CR ." Bank# " BANK# @  . ." , "  _BFREE  .  ." bytes free." CR ;

HERE SWAP -
DECIMAL CR . .( bytes)  \ free 11,566

REMOVE-TOOLS

 

 

Now if you want to load existing code need to alias FAR:  ;FAR  to : /; 

The easiest way is to use a vocabulary I think.  I have not tried this but it should work.

VOCABULARY SAMS
ONLY FORTH ALSO SAMS DEFINITIONS
\ rename normal : ;  so we don't over-ride them and can still use them
:  H:   :   ;
:  ;H   POSTPONE ;  ;  IMMEDIATE

H: :   FAR:   ;H
H: ;   ;FAR   ;H  IMMEDIATE 

There are other ways to this that don't need vocabularies.  Adding vocabulary/wordlists to my system uses 550ish valuable bytes.

 

 

 

 

 

 

 

 

 

  • Like 2

Share this post


Link to post
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...