Jump to content
IGNORED

Camel99 Forth Information goes here


TheBF
 Share

Recommended Posts

When you turn over stones you always find a few bugs. :)

 

Your re-working of the TI-Forth document is still to be commended as it exists in professional form for people to review forever now.

The original is more like shards of the dead sea scrolls. 

 

It never ceases to amaze me how difficult software is as a human occupation. 

 

I have been in correspondence with ED over the last couple of days. He got involved because of concern that perhaps his code was not "endian" proofed.

In making Camel99 I had followed the TI MSP430 CPU version as it was the most similar to 9900.

In that kernel Brad has M+ as a code word because MSP430 has an ADDC (add with carry) instruction. This meant M+ was only three instructions.

I naively tried to follow that template.

 

Yesterday I realized that D+ is a better primitive and later, after I did it that way, Ed wrote and confirmed to me that he thought D+ with S>D as code word would be a better fit. 

So that was a good confirmation.

 

I looked at your D+ which I cannot do with TOS in a register but based on it I came up with this which is much smaller than I had before.

 
CODE D+   ( lo hi lo' hi' -- d)
     *SP+    R0  MOV, 
     *SP+    TOS ADD, 
      R0     *SP ADD,  
      OC IF, 
         TOS INC,  
      ENDIF,
      NEXT,  
ENDCODE
 

All in all another validation of the "more eyes are better" approach when it comes to reviewing text.

 

In the complexity breeds complexity file:

 

Ed wrote this morning to tell me that my github change fixed the source code files but now the pdf files are corrupted. 

LOL.  Amazing...

 

  • Like 3
Link to comment
Share on other sites

Kernel 2.68

 

Fixes error in M+.  

Puts D+ in the kernel

Changes S>D to a code word and uses it to make M+.

 

: M+   ( d n -- d)  S>D M+ ;

 

This kernel has been running here for a week and seems stable in all my activities.

 

Please  put the CAMEL99  program file, in the attached ZIP file, into your DSK1.  -and-  replace DSK1.SYSTEM with this new version as well.

 

DSK1.SYSTEM has been simplified a bit and INCLUDE not longer tampers with the BASE variable. (stupid idea by me) 

In DSK1.SYSTEM there is a small definition for the word ALIAS.  It allows you create small synonyms for a CODE word  that are minimal in size.

ALIAS is not a standard word and my version was not like others.  I have changed mine to be more like other Forth systems that I become aware of like this: 

 

' 2+  ALIAS CELL+   

 

I am confident enough with this version to call the program CAMEL99 so use that name to start this version.

 

The test program that uncovered the M+ error is in the spoiler. 

Load it and type 20 PI  ( or the number of digits you want)  

100 digits takes 7.6 seconds.  (1000 takes longer than the simple elapsed timer can do)

 

Spoiler

\ PI.FTH from DxForth 
\
\ Revised 2015-02-09  es
\
\ Compute Pi to an arbitrary precision. Uses Machin's
\ formula:  pi/4 = 4 arctan(1/5) - arctan(1/239)
\
\ Compile with 16-bit DX-Forth: FORTH - INCLUDE PI.F BYE
\ Compile with CAMEL99 Forth: INCLUDE DSK*.PI  ( where * is your drive no.)
\
\ This 16-bit implementation allows up to 45,808 digits
\ to be computed before arithmetic overflow occurs.
\
\ The code can be used on 32-bit targets with appropriate
\ changes:
\
\   16-bit             32-bit
\
\   10000 Multiply     100000000 Multiply
\   <# # # # # #>      <# # # # # # # # # #>
\   4 +loop            8 +loop
\   525 um/mod         1050 um/mod
\                      remove 'digits > 45808' warning
\
\ Acknowledgements:
\
\   Roy Williams, Feb 1994
\   J. W. Stumpel, May 1991
\   E. Ford, Aug 2009
\   R. Bishop, Aug 1978
\
\ This code is PUBLIC DOMAIN. Use at your own risk.

\ Modified for Camel99 Forth  Mar 2021 Fox
NEEDS D.	  FROM DSK1.DOUBLE
NEEDS DUMP  FROM DSK1.TOOLS
NEEDS VALUE FROM DSK1.VALUES
NEEDS .R    FROM DSK1.UDOTR
NEEDS ELAPSE FROM DSK1.ELAPSE

DECIMAL
0 VALUE POWER  ( adr)
0 VALUE TERM   ( adr)
0 VALUE RESULT ( adr)
0 VALUE SIZE   ( n)

VARIABLE CARRY

: ADD ( -- )
  0 CARRY !
  RESULT
  0 SIZE 1- DO
    I CELLS OVER + ( res) DUP @ 0
    I CELLS TERM + @ 0  D+  CARRY @ M+
    ( hi) CARRY !  ( lo) SWAP ( res) !
  -1 +LOOP  DROP ;

: SUBTRACT ( -- )
  0 CARRY !
  RESULT
  0 SIZE 1- DO
    I CELLS OVER + ( RES) DUP @ 0
    I CELLS TERM + @ 0  D-  CARRY @ M+
    ( HI) CARRY !  ( LO) SWAP ( RES) !
  -1 +LOOP  DROP ;

0 VALUE FACTOR

\ scan forward for cell containing non-zero
: +INDEX ( ADR -- ADR INDEX )
    -1
    BEGIN 1+ DUP SIZE -
    WHILE
       2DUP CELLS + @
    UNTIL
    THEN ;

: (DIVIDE)
  ?DO
     I CELLS OVER + ( res)
     DUP @  CARRY @  FACTOR  UM/MOD
    ( quot) ROT ( res) !  ( rem) CARRY !
  LOOP ;

: DIVIDE ( ADR FACTOR -- )
  TO FACTOR   0 CARRY !  +INDEX
  ( adr index )  SIZE SWAP
  (DIVIDE)
  DROP ;

\ scan backward for cell containing non-zero
: -INDEX ( adr -- adr index )
    SIZE
    BEGIN 1- DUP
    WHILE
       2DUP CELLS + @
    UNTIL
    THEN ;

: MULTIPLY ( adr factor -- )
  TO FACTOR   0 CARRY !  -INDEX
  ( adr index )  0 SWAP
  DO
    I CELLS OVER + ( res)
    DUP @  FACTOR  UM*  CARRY @ M+
    ( hi) CARRY !  ( lo) SWAP ( res) !
  -1 +LOOP
  DROP ;

: COPY ( -- ) POWER TERM SIZE CELLS CMOVE ; \ changed CMOVE to MOVE

: ZERO? ( result -- f )  +INDEX NIP SIZE = ;

0 VALUE PASS
VARIABLE EXP
VARIABLE SIGN

: DIVISOR ( -- N )
  PASS 1 = IF  5  ELSE  239  THEN ;

: ERASE  0 FILL ;

: INITIALIZE ( -- )
  POWER SIZE CELLS ERASE
  TERM  SIZE CELLS ERASE
  PASS 1 = IF  RESULT SIZE CELLS ERASE  THEN
  16  PASS DUP * / POWER !
  POWER  DIVISOR  DIVIDE
  1 EXP !  PASS 1- SIGN ! ;

0 VALUE NDIGIT

: CalcPi ( -- )
  NDIGIT 45800 U> IF
    ." Warning: digits > 45808 will be in error " CR
  THEN

  2 1+ 1
  DO
    I TO PASS
    INITIALIZE
    BEGIN
      COPY
      TERM  EXP @ DIVIDE
      SIGN @  DUP IF  SUBTRACT  ELSE  ADD  THEN
      0= SIGN !  2 EXP +!
      POWER  DIVISOR DUP *  DIVIDE
      POWER ZERO?
    UNTIL
  LOOP ;

\ Camel99 has OUT but I don't use in the Video driver
\ : CR  CR  OUT OFF ;
\ : #   #   OUT 1+! ;

DECIMAL
: (PRINT)
   ?DO
    0 OVER !
    DUP 10000 MULTIPLY
    DUP @  0 <# # # # # #> TYPE SPACE
    VCOL @ 3 + C/L @ > IF CR THEN
  4  +LOOP ;

: PRINT ( -- )
  CR
  RESULT  DUP @ 0 .R  [CHAR] . EMIT SPACE
  NDIGIT 0 (PRINT)
  DROP  CR ;

\ : GetNumber ( -- n )
\  CR ." How many digits do you want? "
\  PAD DUP 20 ACCEPT NUMBER? ABORT" Invalid" CR ;

: PI ( n -- )
( GetNumber ) DUP TO NDIGIT

  \ array size = ceil(ndigit / log10(2^16))
  109 UM* 525 UM/MOD SWAP ( rem) IF  1+  THEN
  2+  TO SIZE    ( extra for accurate last digits)

  50 ALLOT  ( expand the HOLD buffer space)

  HERE TO POWER   SIZE CELLS ALLOT
  HERE TO TERM    SIZE CELLS ALLOT
  HERE TO RESULT  SIZE CELLS ALLOT

  TICKER OFF
  CalcPi
  .ELAPSED
  PRINT
;
CR .( Usage:  20 PI )

 

 

 

 

 

 

 

CAMEL268.ZIP

  • Like 4
Link to comment
Share on other sites

Is there a better way?

 

I have been reviewing all my demo programs and saw that my coincidence code was written in Forth and it would benefit from some coding.

This is the common code code in Forth that is used by COINC and COINCXY.

: (COINC) ( x1 y1 x2 y2 tol -- ? )
         >R
          ROT - ABS R@ <
         -ROT - ABS R> <
          AND ; 

 

Came up with this which is kind of literal translation and it works but it seems like a lot of code.

Are there any clever code tricks that I don't know about that would speed this up?

Perhaps we are limited because Forth needs the flag on the top of stack versus using the status register?

 

The CODE version is only about 2X faster than the Forth version in this case.

That's why I am thinking that it could be sub-optimal.

CODE (COINC) ( x1 y1 x2 y2 tol -- ? )
          TOS  R0 MOV,
          *SP+ R1 MOV,
          *SP+ R2 MOV,

          *SP+ R1 SUB,
          R1 ABS,
          R1 R0 CMP,
          LO IF,  TOS SETO,
          ELSE,   TOS CLR,
          ENDIF,

         *SP+ R2 SUB,
          R2 ABS,
          R2 R0 CMP,
          LO IF, R3 CLR,  \ invert logic for SZC later
          ELSE,  R3 SETO,
          ENDIF,

          R3 TOS SZC,
          NEXT,
ENDCODE  

 

For reference here is how this fits into the final code.


: COINCXY   ( dx dy sp# tol -- ? ) SWAP POSITION ROT (COINC) ;

: COINC ( spr#1 spr#2 tol -- ?)
        COINCALL
        IF >R
          POSITION ROT POSITION ( -- x1 y1 x2  y2 )
          R> (COINC)
          EXIT          \ get out
        THEN            \ if coincall=true then do this
        2DROP DROP      \ drop parameters
        FALSE           \ return false flag
 ;

 

  • Like 3
Link to comment
Share on other sites

The flicker demo experiments over on the GEM topic got me wondering how I might do that in Forth.

It seemed like a great use of the multi-tasker. :) 

 

I took one my test programs and added a FLICKER task.

This one flashes the sprite color white and then returns to the previous color at random intervals.

 

One thing worth mentioning is that after Tursi schooled me on the improper use of keeping interrupts running while you talk to the VDP chip, I can now run the interpeter with sprites flying just fine.  This is very handy when testing sprite code.

 

Spoiler

CR
CR .( For use with CAMEL99 V2)
CR
CR

NEEDS LOCATE FROM DSK1.DIRSPRIT
NEEDS RND    FROM DSK1.RANDOM
NEEDS MOTION FROM DSK1.AUTOMOTION
NEEDS FORK   FROM DSK1.MTASK99
NEEDS RND    FROM DSK1.RANDOM

\ ========================================
\ demo code
DECIMAL
: MAKE-SPRITES
\ chr  col  Y   X   Sp#
\ -------------------------
   42  16   0  0    0 SPRITE \ *
   65   2   0  5    1 SPRITE \ A
   66   3   0  10   2 SPRITE
   67   4   0  15   3 SPRITE
   68   5   0  20   4 SPRITE
   69  11   0  25   5 SPRITE
   70  11   0  25   6 SPRITE
   71   6   0  30   7 SPRITE
   72   7   0  35   8 SPRITE
   73   5   0  40   9 SPRITE
   74   9   0  45  10 SPRITE
   75  11   0  50  11 SPRITE
   76  12   0  55  12 SPRITE
   77  13   0  60  13 SPRITE
   78  14   0  65  14 SPRITE
   79  15   0  70  15 SPRITE
   80  16   0  75  16 SPRITE
   81   1   0  80  17 SPRITE
   82   2   0  85  18 SPRITE
   83   3   0  90  19 SPRITE
   84   4   0  95  20 SPRITE
   85   5   0 100  21 SPRITE
   86   6   0 105  22 SPRITE
   87   7   0 110  23 SPRITE  \ W
   88   5   0 115  24 SPRITE  \ X
   89   9   0 120  25 SPRITE
   90  10   0 125  26 SPRITE
   48  11   0 130  27 SPRITE  \ 0
   49  12   0 140  28 SPRITE  \ 1
   50  13   0 150  29 SPRITE  \ 2
   51  14   0 160  30 SPRITE  \ 3
   52  16   0 170  31 SPRITE  \ 4
;

: RNDI  ( -- n ) 4 RND 2- ;

: RNDYX ( -- y x ) RNDI  RNDI ;  \ RNDI RNDI ;

\ you can make any sprite move any way with this table
: MY-MOTIONS ( -- )
       \ dX dY   spr#
       \ ----------------------
         0 10      0 MOTION       \ only sprite 0 moves this way.
         16  1 DO  0  5 I MOTION  LOOP
         31 16 DO  0 -5 I MOTION  LOOP
         0 -15    31 MOTION
;

CREATE FLICKER   USIZE ALLOT    FLICKER FORK

: SPARKLE
        BEGIN
            PAUSE
            32 RND               ( -- spr# )
            DUP SP.COLR VC@      ( -- spr# color)
            OVER 15 SWAP         ( -- spr# color 15 spr#)
            SP.COLR VC!
                                 ( -- spr# color)
            30 RND 15 +   MS     \ randomize delay
            SWAP SP.COLR VC!
        AGAIN
;

: RUN
         CLEAR  15 SCREEN
         ." 32 sprites moving in Forth"
         CR    ." Using ROM base automotion"
         CR    ." Sprite 0 is 2X faster"
         CR    ." Sprite 31 is 3X faster"
         CR
         CR    ." Type STOPMOTION to stop sprites"
         CR    ." Type AUTOMOTION to move sprites"
         CR    ." Type FLICKER WAKE to sparkle"         

         DELALL  MAKE-SPRITES
         250 MS
         0 MAGNIFY
         MY-MOTIONS
         SPR# @ MOVING
         AUTOMOTION
;

' SPARKLE FLICKER ASSIGN
MULTI
CLEAR
CR ." TYPE RUN to start"

 

 

  • Like 3
Link to comment
Share on other sites

While sitting with my coffee this morning I wondered if there was a way to make faster nestable sub-routines on the old 9900.

I did not succeed. 

In the process of trying, I wrote some code that might be interesting to anyone who would want to use Camel99 Forth to make Assembly language code with lots of sub-routines.

 

The SUB: word lets you create named sub-routines that automagically take care of saving R11.

Since Forth already has a return stack we just save it there.

 

At the end of a sub-routine we use a special "return" macro call ;SUB  

It pops the old R11 from the return stack and then Branches to the address in R11.

 

The demo code shows how to use them.  Load the code and type MAIN. It loops until you press FCTN 4.

 

Of note is the BL to BREAK? which is in ROM and lets us break out of an Assembly language loop and return to Forth like it was BASIC.

 

The weird character you see when do BREAK is the key code for FCTN 4 going to the screen. That character is part of the TI-Logo in the Camel99 font.

It is harmless (but ugly)

EMIT does not filter any characters in Camel99 except CR, LF and Backspace mostly to save space. 

If anybody really objects to EMIT acting like this I can change it. 

 

Spoiler

\ Nestable "native" sub-routines in Camel99 Forth

NEEDS MOV,  FROM DSK1.ASM9900

MARKER REMOVE

HEX
VARIABLE X

: SUB: ( <name> )
       CREATE         \ create a name in the dictionary
       R11 RPUSH,  ;  \ compile entry code (save R11 on return stack)

: ;SUB  ( -- )     \ nestable return macro must be used with SUB:
       R11 RPOP,
       *R11 B, ;

\        ** DEMO CODE **
SUB: FOO
       X @@ INC,    \ bump X variable
;SUB

SUB: BAR
        FOO @@ BL, \ call FOO
        X @@ INC,   \ bump X variable
;SUB

SUB: ZUG
      BAR @@ BL,   \ call BAR
       X @@ INC,    \ bump X variable
;SUB

0020 CONSTANT BREAK?  \ address of ROM break key detector

CODE MAIN ( n -- n' )
      TOS X @@ MOV,  \ initialize X from top of DATA stack
      BEGIN,
        ZUG @@ BL,     \ call ZUG
        BREAK? @@ BL,  \ BREAK sub-routine in TI-99 ROM
      EQ UNTIL,
      X @@ TOS MOV,    \ fetch the new X value to top of DATA stack
      NEXT,
      ENDCODE

\ Usage:  1 MAIN

 

 

  • Like 3
Link to comment
Share on other sites

Can Camel99 Re-build Itself?

(I think so)

 

I am beginning to trust my little homemade kernel much more after the last go 'round with PI generation. For some reason on Tuesday I thought that maybe I should look into the possibility of making a "meta-compiler" for Camel99 Forth.  Meta-compiler is a Forth community term for the code that you add to Forth to let it make a new version of itself. It's really a cross-compiler. :) 

 

This is only possible because of the library code that has been added over the last two years. I didn't really understand a lot of internals when I started this exercise but the veil is beginning to lift, as I have tried to build the extensions for the micro-kernel.

 

So now Camel99 has a cross-assembler which is the essential foundation to re-build the system.

The cross-assembler can handle labels and structured code which makes the job a little easier. (I really like the DxForth style numbered labels)

Camel99's WORDLIST library allows us to have separate namespaces with search order control. This is how modern Forth cross-compilers operate.

 

The name spaces are:

  1. Assembler:  Forth style Assembler that emits code to the Target memory
  2. Compiler  :  Forth words that do compiling stuff but put code in the Target memory 
  3. Target      : The namespace for the new Forth system that you are building. These words are mirrored in the TARGET wordlist in the HOST Forth so the compiler can find them.
  4. Host         : Only the host Forth words (Camel99) are exposed for utilities mostly. (DUMP .S etc)

The names space search order is controlled by commands. This lets the system have different modes for different jobs.

 

I must have learned something because building this one was much easier than the first one. I think my coding style is better too.

With the code in the spoilers I have succeeded in cross compiling all the Forth primitives in Camel Forth and the VDP and KSCAN code as well.

 

I only have about 8K left in the dictionary so I will probably have to use VDP memory for the target code in the final version so that I have room for the rest of the system.

I need to add some bootstrap code to teach the compiler how to do Forth branches and loops. These words don't go into the target but compile branches and loops INTO the target.

Finally I will build the colon compiler for Forth words and then I should be able to compile the rest of the system. 

 

The whole thing is like building a card house on top of a card house. :) 

 

It's never easy but I am more optimistic.  

 

Spoiler

\ metacompiler.fth to re-build CAMEL99 Forth         Jul 29 2021 Brian Fox

INCLUDE DSK2.ASSEMBLER  \ this is a cross-assembler with labels

MARKER /META

NEEDS WORDLIST FROM DSK1.WORDLISTS

ONLY FORTH  DEFINITIONS
NEEDS DUMP  FROM DSK1.TOOLS
NEEDS CASE  FROM DSK1.CASE
NEEDS VALUE FROM DSK1.VALUES
NEEDS COMPARE FROM DSK1.COMPARE

VOCABULARY TARGET
VOCABULARY COMPILER

: 2OVER    ( a b c d -- a b c d a b) 3 PICK  3 PICK ;

\ SEARCH ORDER CONTROL COMMAMDS
\ [CC]  "cross-compiler" Interpreted words for the compiler
\ [TC]  "target-compiler" Words that compile into target memory
\ HOST  Normal Camel99 Forth dictionary

\ Search Order: last ------------------> first              {New words}
: [CC]   ONLY FORTH ALSO ASSEMBLER ALSO COMPILER              DEFINITIONS ;
: [TC]   ONLY FORTH  ALSO ASSEMBLER  ALSO COMPILER ALSO TARGET DEFINITIONS ;
: HOST   ONLY FORTH DEFINITIONS ;

[CC] HEX

VARIABLE XLATEST
: NEW.    ORIGIN @ DUP 0= ABORT" ORG is not set"
          ( org) 2000 FF FILL
          0000 T,         \ TI-99 multi-file flag
          0000 T,         \ program size
          0000 T,         \ load address
          THERE XLATEST !
          0000 T,         \ compile an EMPTY NFA
;

\ **cross-compile a string into target**
: TS,  ( c-addr u -- ) THERE OVER 1+ TALLOT PLACE  TALIGN ;

: EQU  ( <text> )  CONSTANT ;
: equ  ( <text> )  EQU ;
: L:   ( <text> )  TDP @  CONSTANT ;

[CC]
: THEADER, ( addr len --)
      TALIGN
      XLATEST @ T,     \ fetch the NFA & compile in the LFA field
      0 TC,            \ compile the precedence byte (immediate flag)
      THERE XLATEST !  \ HERE is now a new NFA, store NFA in LATEST
      TS, ;            \ compile the (addr len) string as the name.

: LASTWORD  ( -- nfa) LATEST @ COUNT 1F AND ;

\ TCREATE is a double entry word creator: name in Forth & in Target
: TCREATE    CREATE    LASTWORD THEADER, ;

\ TARGET dictionary search will go into compiler loop
: FIND-NAME ( addr len -- nfa ) \ nfa is "name field address"
           XLATEST @  ( -- NFA )
           BEGIN
              DUP
           WHILE \ len(nfa)<>0
              DUP 1+ 2OVER S=  \ compare NFA to stack string
           WHILE \ compare<>0
              NFA>LFA @        \ follow link to next name
           REPEAT
           THEN NIP NIP ;

: NFA>XT ( addr -- XT -1|0|1)
          DUP 1- C@  IF 1  ELSE -1 THEN
          SWAP NFA>CFA SWAP ;

: T'      ( -- XT|0 )
          PARSE-NAME FIND-NAME
          DUP 0= ABORT" Not in TARGET"
          NFA>CFA
;

: TWORDS   ( --)
\ Tests the integrity of the TARGET dictionary links
          BASE @ >R
          DECIMAL
          0 >R       \ word counter
          XLATEST @  ( NFA )
          CR
          BEGIN
             DUP
          WHILE
             DUP .ID SPACE
             R> 1+ >R
             VCOL @ C/L @ 4 - >
             IF  CR  THEN SPACEBAR
             NFA>LFA @  ( -- NFA NFA')
          REPEAT
          DROP
          CR R>  1- . ." TARGET words"
          R> BASE ! ;

\ compiler forward references. (Resolved in Forth source code)
0 VALUE 'EXIT
0 VALUE 'DOCOL
0 VALUE 'DOVAR
0 VALUE 'LIT
0 VALUE 'DLIT
0 VALUE 'DOCON
0 VALUE 'DODOES
0 VALUE 'DOUSER
0 VALUE '(S")
0 VALUE 'TYPE

\ cross compiler versions of these words are in the COMPILER vocabulary
: +CODE     ( -- )
            TCREATE
                  THERE 2+ T, !CSP
            DOES> DROP -1 ABORT" Can't run TARGET CODE" ;

: CODE      NEWLABELS   +CODE ;

: NEXT,     ( -- ) *R10 B,  ;

[CC]  \ cross compiler data creators
: CREATE
        TCREATE THERE ,     \ remember the target cfa
                'DOVAR  T,  \ compile executor code
        DOES> @ >BODY  ;   ( -- addr)

: VARIABLE
        TCREATE THERE ,    \ remember target CFA
              'DOVAR T,   \ compile executor code
                   0 T,        \ init the data field to zero
        DOES> @  >BODY  ;  ( -- addr)

: CONSTANT  ( n -- )
        TCREATE  THERE ,
               'DOCON T,
                 ( n) T,
        DOES> @ >BODY  @  ; ( -- n)

: USER ( n -- )
        TCREATE  THERE  ,   \ remember the pfa in HOST "FORTH"
              'DOUSER  T,  \ target compile executor code
                ( n)   T,  \ target compile offset
        DOES> @ @ 8300 +  ;  ( -- addr) \ assumes wksp=>8300

: LASTXT    ( -- xt) XLATEST @ NFA>CFA  ;
: IMMEDIATE ( -- )  01 XLATEST @ 1- C! ;

PAGE ." Forth Meta-compiler V1.0"
.FREE
CR ." Ready"

 

 

Assembler

Spoiler

\ CROSS ASSEMBLER  with full TI register syntax       July 28 2021

NEEDS FORTH FROM DSK1.WORDLISTS
NEEDS DEFER FROM DSK1.DEFER

ONLY FORTH

VOCABULARY ASSEMBLER

ALSO ASSEMBLER DEFINITIONS

HERE
VARIABLE ORIGIN  \ holds ORG address

HEX
\ *******************************************************
\ Change these words to compile to VDP RAM or DISK blocks
VARIABLE TDP ( -- variable)  ( Low RAM heap is target memory)
DEFER ORG    ( addr --) :NONAME DUP ORIGIN ! TDP ! ; IS ORG
.( .)
\ Target versions of HERE and ALLOT
DEFER THERE  ( -- addr) :NONAME  TDP @  ;  IS THERE
DEFER TALLOT ( n -- )   :NONAME  TDP +! ;  IS TALLOT
\ integer and byte "Target" compilers
DEFER T,     ( n -- )  :NONAME THERE !  2 TALLOT ; IS T,
DEFER TC,    ( c -- )  :NONAME THERE C! 1 TALLOT ; IS TC,
DEFER TALIGN ( -- )    :NONAME  THERE ALIGNED TDP ! ;  IS TALIGN
DEFER TC! ( not needed so far)
DEFER T!
\ *********************************************************
CR .( TI-99 Cross Assembler V 0.1 ...)

CR .( Loading at) DP @ HEX U.
ASSEMBLER DEFINITIONS
DECIMAL
 0 CONSTANT  R0    1 CONSTANT  R1
 2 CONSTANT  R2    3 CONSTANT  R3
 4 CONSTANT  R4    5 CONSTANT  R5
 6 CONSTANT  R6    7 CONSTANT  R7
 8 CONSTANT  R8    9 CONSTANT  R9
10 CONSTANT R10   11 CONSTANT R11
12 CONSTANT R12   13 CONSTANT R13
14 CONSTANT R14   15 CONSTANT R15

HEX
: ADDRESS? ( n -- ?) DUP 1F > SWAP 30 < AND ;

: GOP'     OVER ADDRESS?        \ address or register?
           IF   + T, T,         \ compile instruction & address
           ELSE + T,            \ compile register
           THEN ;

: GOP      CREATE , DOES> @ GOP' ;

0440 GOP B,     0680 GOP BL,    0400 GOP BLWP,
04C0 GOP CLR,   0700 GOP SETO,  0540 GOP INV,
0500 GOP NEG,   0740 GOP ABS,   06C0 GOP SWPB,
0580 GOP INC,   05C0 GOP INCT,  0600 GOP DEC,
0640 GOP DECT,  0480 GOP X,
.( .)
: GROP     CREATE , DOES> @ SWAP 40 * + GOP' ;

2000 GROP COC,  2400 GROP CZC,  2800 GROP XOR,
3800 GROP MPY,  3C00 GROP DIV,  2C00 GROP XOP,

: GGOP     CREATE ,
           DOES> @ SWAP DUP ADDRESS?
                 IF   40 * + SWAP >R GOP' R> T,
                 ELSE 40 * + GOP'  THEN ;
HEX
A000 GGOP ADD,  B000 GGOP ADDB, 8000 GGOP CMP, 9000 GGOP CMPB,
6000 GGOP SUB,  7000 GGOP SUBB, E000 GGOP SOC, F000 GGOP SOCB,
4000 GGOP SZC,  5000 GGOP SZCB, C000 GGOP MOV, D000 GGOP MOVB,

: 0OP     CREATE ,  DOES> @ T, ;

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

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

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

: RIOP    CREATE , DOES> @ ROT + T, T, ;
0220 RIOP AI,
0240 RIOP ANDI,
0280 RIOP CI,
0200 RIOP LI,
0260 RIOP ORI,

: RCOP    CREATE , DOES> @ SWAP 10 * + + T, ;
0A00 RCOP SLA,
0800 RCOP SRA,
0B00 RCOP SRC,
0900 RCOP SRL,

CR .( jump instructions)
: DOP     CREATE ,   DOES> @ SWAP 00FF AND OR T, ;
1300 DOP JEQ,  1500 DOP JGT,  1B00 DOP JH,   1400 DOP JHE,
1A00 DOP JL,   1200 DOP JLE,  1100 DOP JLT,  1000 DOP JMP,
1700 DOP JNC,  1600 DOP JNE,  1900 DOP JNO,  1800 DOP JOC,
1C00 DOP JOP,

\ CRU bit operations
1D00 DOP SBO,  1E00 DOP SBZ,  1F00 DOP TB,

: GCOP    CREATE , DOES> @ SWAP 000F AND 40 * + GOP' ;

3000 GCOP LDCR,
3400 GCOP STCR,
HEX
\ Wycove assembler register syntax:
: @@        020    ;  \ symbolic addressing
: **        010 +  ;  \ indirect addressing
: *+        030 +  ;  \ indirect addressinin auto-increment
: ()        20  +  ;  \ indexed addressing

CR .( Jump tokens) \ for use with CJMP
HEX
 1 CONSTANT GTE     \ GT OR EQUAL
 2 CONSTANT HI      \ JMP IF HI
 3 CONSTANT NE      \ NOT equal
 4 CONSTANT LO      \ jmp if low
 5 CONSTANT LTE     \ jmp if less than or equal
 6 CONSTANT EQ      \ jmp if equal
 7 CONSTANT OC      \ jmp on carry flag set
 8 CONSTANT NC      \ jmp if no carry flag set
 9 CONSTANT OO      \ jmp on overflow
 A CONSTANT HE      \ jmp high or equal
 B CONSTANT LE      \ jmp if low or equal
 C CONSTANT NP      \ jmp if no parity

CR .( Simplified branching and looping)
: AJUMP,  ( token --) >< 1000 + T, ; \ hex 1000 is JMP 0 instruction
: RESOLVE ( addr offset --)  2- 2/ SWAP 1+ C! ;
: <BACK   ( addr addr' -- ) TUCK -  RESOLVE ;

: IF,     ( token -- addr) THERE SWAP AJUMP, ;
: ENDIF,  ( addr --)  THERE OVER -  RESOLVE ;
: ELSE,   ( -- addr ) THERE 0 JMP, SWAP ENDIF, ;

: BEGIN,  ( -- addr)  THERE ;
: WHILE,  ( token -- *while *begin) IF, SWAP ;
: AGAIN,  ( *begin --)  THERE  0 JMP, <BACK ;
: UNTIL,  ( *begin token --) THERE SWAP AJUMP, <BACK ;
: REPEAT, ( *while *begin -- ) AGAIN, ENDIF, ;

\ ===================================
\ INDIRECT ADDRESSING
: *R0    ( -- n) R0 ** ;
: *R1    ( -- n) R1 ** ;
: *R2    ( -- n) R2 ** ;
: *R3    ( -- n) R3 ** ;
: *R4    ( -- n) R4 ** ;
: *R5    ( -- n) R5 ** ;
: *R6    ( -- n) R6 ** ;
: *R7    ( -- n) R7 ** ;
: *R8    ( -- n) R8 ** ;
: *R9    ( -- n) R9 ** ;
: *R10   ( -- n) R10 ** ;
: *R11   ( -- n) R11 ** ;
: *R12   ( -- n) R12 ** ;
: *R13   ( -- n) R13 ** ;
: *R14   ( -- n) R14 ** ;
: *R15   ( -- n) R15 ** ;

\ ====================================
\ INDIRECT ADDRESSING, AUTO-INCREMENT
: *R0+   ( -- n) R0 *+ ;
: *R1+   ( -- n) R1 *+ ;
: *R2+   ( -- n) R2 *+ ;
: *R3+   ( -- n) R3 *+ ;
: *R4+   ( -- n) R4 *+ ;
: *R5+   ( -- n) R5 *+ ;
: *R6+   ( -- n) R6 *+ ;
: *R7+   ( -- n) R7 *+ ;
: *R8+   ( -- n) R8 *+ ;
: *R9+   ( -- n) R9 *+ ;
: *R10+  ( -- n) R10 *+ ;
: *R11+  ( -- n) R11 *+ ;
: *R12+  ( -- n) R12 *+ ;
: *R13+  ( -- n) R13 *+ ;
: *R14+  ( -- n) R14 *+ ;
: *R15+  ( -- n) R15 *+ ;

\ =========================
\ INDEXED MEMORY ADDRESSING
: (R0)    TRUE ABORT" Can't index R0" ;
: (R1)    R1 () ;
: (R2)    R2 () ;
: (R3)    R3 () ;
: (R4)    R4 () ;
: (R5)    R5 () ;
: (R6)    R6 () ;
: (R7)    R7 () ;
: (R8)    R8 () ;
: (R9)    R9 () ;
: (R10)  R10 () ;
: (R11)  R11 () ;
: (R12)  R12 () ;
: (R13)  R13 () ;
: (R14)  R14 () ;
: (R15)  R15 () ;

CR .( CAMEL99 special registers)
4 CONSTANT TOS
: (TOS)  (R4) ;   : *TOS  *R4 ;     : *TOS+  *R4+ ;

6 CONSTANT SP
: (SP)   (R6) ;   : *SP    *R6 ;   : *SP+   *R6+ ;

7 CONSTANT RP
: (RP)   (R7) ;   : *RP    *R7 ;    : *RP+   *R7+ ;

8 CONSTANT W
: (W)    (R8) ;   : *W     *R8  ;   : *W+   *R8+ ;

9 CONSTANT IP
: (IP)   (R9) ;   : *IP    *R9 ;    : *IP+  *R9+ ;

\ PUSH & POP for both stacks
: PUSH,         ( src -- )  SP DECT,  *SP  MOV, ;    \ 10+18 = 28  cycles
: POP,          ( dst -- )  *SP+      SWAP MOV, ;    \ 22 cycles

: RPUSH,        ( src -- ) RP DECT,  *RP   MOV, ;
: RPOP,         ( dst -- ) *RP+      SWAP  MOV, ;

CR .( Pseudo instructions)
: RT,     ( -- )  *R11  B, ;
: NOP,    ( -- )  0 JMP, ;
: NEXT,   ( -- )  *R10  B, ;  \ CAMEL99 NEXT resides in R10

CR .( Enumerated labels)
DECIMAL
25 CONSTANT #FWD
20 CONSTANT #LABELS

\ Make a stack to handle jumps
CREATE FS0    #FWD 2* CELLS ALLOT
FS0 CREATE FSP ,   \ fwd stack pointer, initialzed to FS0

: FSDEPTH ( -- n) FS0 FSP @ -  2/ ;
: >FS     ( addr --) 2 FSP +!   FSP @ ! ;
: FS>     ( -- addr)
          FSP @  DUP FS0 = ABORT" Label stack empty"
          @  -2 FSP +!  ;

CREATE LABELS   #LABELS CELLS ALLOT
: ]LBL  ( n -- addr) CELLS LABELS + ;  \ array of label addresses

: NEWLABELS  ( -- )
    LABELS  #LABELS CELLS 0 FILL  \ clear label array
    FS0 FSP !   \ reset fwd stack pointer to base address
;

: $:  ( n -- )  THERE SWAP ]LBL !   ;
: $   ( n -- 0) THERE >FS  >FS   0  ;  \ push address and index. Return zero

: ?LABEL  ( addr -- addr) DUP 0= ABORT" Un-resolved forward jump" ;

: RESOLVER ( -- )
       BEGIN FSDEPTH
       WHILE
           FS> ]LBL @ ?LABEL ( lbladdress )
           FS> TUCK - ( jmpaddr offset) RESOLVE
       REPEAT ;

: +CODE   ( <name> ) CODE ;       \ used to jump across CODE words
: CODE    ( <name> ) NEWLABELS CODE  ;
: ENDCODE ( -- ) ?CSP RESOLVER  ;

: L:   ( <text> )  TDP @  CONSTANT ; \ assembler label

CR CR .( Cross Assembler loaded)
CR HERE SWAP - DECIMAL . .( bytes)
HEX

 

 

Forth Primitives that compile on this system

Spoiler

\ T I - 9 9   C A M E L   F O R T H   P R I M I T I V E S
\ Cross-compile with the CAMEL99 META-COMPILER

\ ** R0      general purpose register
\ ** R1      general purpose register
\ ** R2      general purpose register
\ ** R3      general purpose register
\ ** R4      TOP of stack cache
\ ** R5      Temp for NEXT, overflow for '*' and '/',  general purpose
\ ** R6      parameter stack pointer
\ ** R7      return stack pointer
\ ** R8      Forth 'W' register OR general purpose in a system CODE word
\ ** R9      Forth VM IP (Instruction pointer)
\ ** R10     Forth's "NEXT" routine cache
\ ** R11     9900 sub-routine return register  - OR - general purpose
\ ** R12     9900 CRU register                 - OR - general purpose
\ ** R13     Multi-tasker LINK to next task
\ ** R14     Multi-tasker Program counter
\ ** R15     Multi-tasker task Status register

\ ==============================================================
\ XASM99 TI-99 CROSS-ASSEMBLER DIRECTIVES
CR ." Assembling Forth Primitives"

[CC]  HEX   2000 ORG
            NEW.
[TC]
CODE EXIT
           IP RPOP,
           *IP+ W  MOV,  \ NEXT begins here
           *W+  R5 MOV,
           *R5  B,

T' EXIT >BODY  EQU 'NEXT   \ 'NEXT goes to R10 on Forth start

CODE ?BRANCH
            TOS DEC,
            TOS POP,
            NC IF,
               IP INCT,
               NEXT,
            ENDIF,
            *IP IP ADD,
            NEXT,
            ENDCODE

CODE BRANCH
           *IP IP ADD,
            NEXT,
            ENDCODE

CODE DOCON   ( -- n )
            TOS PUSH,
           *W TOS MOV,
            NEXT,
            ENDCODE  LASTXT TO 'DOCON

CODE DOVAR  ( -- addr)
           TOS PUSH,
           W TOS MOV,
           NEXT,
           ENDCODE    LASTXT TO 'DOVAR

CODE DOCOL
            IP RPUSH,
            W IP MOV,
            NEXT,
            ENDCODE   LASTXT TO 'DOCOL

\ 99 CONSTANT TEST

\ In CAMEL99 the 9900 Workspace register (WP) doubles as USER pointer
CODE DOUSER ( -- addr)
            TOS PUSH,
            TOS STWP,
           *W TOS ADD,
            NEXT,
            ENDCODE  LASTXT TO 'DOUSER

CODE LIT
            TOS     PUSH,
            *IP+ TOS MOV,
            NEXT,
            ENDCODE  LASTXT TO 'LIT

\ =================================================================
\ DODOES is the code action of a DOES> clause.
\ For ITC Forth:
\ defined word:  CFA: doescode
\                PFA: parameter field
\
\ Note: In V2.5 implementation we use BL @DODOES. (branch and link)
\ DODOES is entered with W=PFA (parameter field address)
\ DODOES moves register W to the TOP of Stack register. (R4 is TOS)
\ So the high-level Forth code begins with the address of the parameter
\ field on top of stack.
\ Using BL automatically computes the new parameter field into R11
\ which is exactly what we need to be the IP so we just do one MOV.
 CODE DODOES  ( -- a-addr)
              TOS PUSH,       \ save TOS reg on data stack      28
              W TOS MOV,      \ put defined word's PFA in TOS   14
              IP RPUSH,       \ push old IP onto return stack   28
              R11 IP MOV,     \ R11 has the new PFA -> IP       14
              NEXT,                                       \     84
              ENDCODE

CODE EXECUTE ( xt -- )
              TOS W MOV,
              1 $ JMP,
+CODE PERFORM ( 'xt -- )
             *TOS W MOV,
1 $:          TOS POP,
             *W+ R5 MOV,
             *R5 B,
              ENDCODE

CR .( MEMORY FETCH & STORE)

CODE !      ( n addr -- )
             *SP+ *TOS MOV,
              TOS POP,
              NEXT,
              ENDCODE

CODE @      ( a -- w )
              *TOS TOS MOV,
              NEXT,
              ENDCODE

\ Aug 4 2018: fixed order of data to be ANS compliant
CODE 2!     ( d addr -- )
             *SP+ *TOS  MOV,    \ the top # of D is stored at the lower adrs
             *SP+ 2 (TOS) MOV,  \ next # stored 1 cell higher (addr+2)
              TOS POP,
              NEXT,
              ENDCODE

\ Aug 4 2018: fixed order of data to be ANS compliant
CODE 2@     ( addr -- d)  \ the lower address will appear on top of stack
              2 (TOS) PUSH,
             *TOS TOS MOV,
              NEXT,
              ENDCODE

CODE C!     ( c addr -- )
              1 (SP) *TOS MOVB,
              SP INCT,
              TOS POP,
              NEXT,
              ENDCODE

CODE COUNT  ( addr -- addr' u)
              TOS PUSH,
             *SP INC,
              1 $ JMP,
+CODE C@     ( addr -- c)
1 $:         *TOS TOS MOVB, \ put C@ inline to save space
              TOS 8 SRL,
              NEXT,
              ENDCODE

CODE +!     ( n addr --)
             *SP+ *TOS ADD,
              TOS POP,
              NEXT,
              ENDCODE

CODE C+!     ( c addr -- ) \ 8 bytes versus 12 bytes in Forth
             1 (SP) *TOS ADDB,
              SP INCT,
              TOS POP,
              NEXT,
              ENDCODE

\ ==================================================================
CR .( RETURN STACK)

CODE RP@     ( -- a )
              TOS PUSH,
              RP TOS MOV,
              NEXT,
              ENDCODE

CODE RP!     ( a -- )
              TOS RP MOV,
              TOS POP,
              NEXT,
              ENDCODE

CODE >R      ( w -- )
              TOS RPUSH,
              TOS POP,
              NEXT,
              ENDCODE

CODE R>      ( -- w )
              TOS PUSH,
              TOS RPOP,
              NEXT,
              ENDCODE

CODE R@      ( -- w )
              TOS PUSH,
             *RP TOS MOV,
              NEXT,
              ENDCODE

\ ==================================================================
CR .( DATA STACK)

CODE SP@     ( -- a )
              TOS PUSH,
              SP TOS MOV,
              NEXT,
              ENDCODE

CODE SP!     ( a -- )
              TOS SP MOV,
              TOS POP,
              NEXT,
              ENDCODE

CODE DROP    ( w -- )
              TOS POP,
              NEXT,
              ENDCODE

CODE NIP     ( n n' -- n')
              SP INCT,
              NEXT,
              ENDCODE

CODE ?DUP    ( x -- 0 | x x)
              TOS TOS MOV,
              NE IF,
                   TOS PUSH,
              ENDIF,
              NEXT,
              ENDCODE

CODE DUP    ( w -- w w )
              TOS PUSH,
              NEXT,
              ENDCODE

CODE SWAP    ( w1 w2 -- w2 w1 )
              TOS   W MOV,
             *SP  TOS MOV,
              W   *SP MOV,
              NEXT,
              ENDCODE

CODE OVER   ( w1 w2 -- w1 w2 w1 )
              TOS PUSH,
              2 (SP) TOS MOV,
              NEXT,
              ENDCODE

CODE ROT    ( n1 n2 n3 --  n2 n3 n1)
              2 (SP)    W MOV,
             *SP   2 (SP) MOV,
              TOS     *SP MOV,
              W       TOS MOV,
              NEXT,
              ENDCODE

CODE -ROT    ( n1 n2 n3 --  n2 n3 n1)
              TOS       W MOV,
             *SP      TOS MOV,
              2 (SP)  *SP MOV,
              W    2 (SP) MOV,
              NEXT,
              ENDCODE

\ byte/word conversions
CODE ><      ( n -- n )
              TOS SWPB,
              NEXT,
              ENDCODE

\ used in number conversion. Same size as DROP DROP 3X faster
CODE 2DROP   ( n n -- )
              SP INCT,
              TOS POP,
              NEXT,
              ENDCODE

 CODE 2DUP   ( n1 n2 -- n1 n2 n1 n2 )
              SP -4 AI,
              4 (SP) *SP MOV,
              TOS  2 (SP) MOV,
              NEXT,
              ENDCODE

CODE 2SWAP   ( n1 n2 n3 n4-- n3 n4 n1 n2)
              TOS       R0 MOV,
             *SP        R1 MOV,
              2 (SP)   TOS MOV,
              4 (SP)   *SP MOV,
              R0    2 (SP) MOV,
              R1    4 (SP) MOV,
              NEXT,
              ENDCODE

CODE PICK   ( n -- n)  \ GForth ITC takes 8 intel instructions for PICK
              TOS TOS ADD,
              SP TOS ADD,
             *TOS TOS MOV,
              NEXT,
              ENDCODE

\ ==================================================================
CR .( LOGICAL OPERATIONS)

CODE AND     ( w w -- w )
             *SP INV,
             *SP+ TOS SZC,
              NEXT,
              ENDCODE

CODE OR      ( w w -- w )
             *SP+ TOS SOC,
              NEXT,
              ENDCODE

CODE XOR     ( w w -- w )
             *SP+ TOS XOR,
              NEXT,
              ENDCODE

\ ==================================================================
CR .( ARITHMETIC)
\ simple math is about 40% faster with TOS in register
CODE 1+     ( n -- n')
              TOS INC,
              NEXT,
              ENDCODE

CODE 1-      ( n -- n')
              TOS DEC,
              NEXT,
              ENDCODE

CODE 2+     ( n -- n)
              TOS INCT,
              NEXT,
              ENDCODE

CODE 2-     ( n -- n)
              TOS DECT,
              NEXT,
              ENDCODE

CODE 2*      ( n -- n)
              TOS 1 SLA,
              NEXT,
              ENDCODE

CODE 4*      ( n -- nx4)
              TOS 2 SLA,
              NEXT,
              ENDCODE

CODE 8*      ( n -- nx8)
              TOS 3 SLA,
              NEXT,
              ENDCODE

CODE 2/      ( n -- n)
              TOS 1 SRA,
              NEXT,
              ENDCODE

\ =================================================================
CR .( ANS Shift operations)

CODE RSHIFT  ( n bits -- n')  \ shift right logical. ANS/ISO Forth requirement
              TOS R0 MOV,      \ the shift bits MUST be in R0 to do this
              TOS POP,
              R0 R0 MOV,       \ ANS:  1 0 LSHIFT -> 1
              NE IF,           \       so skip the shift if R0=1
                 TOS R0 SRL,
              ENDIF,
              NEXT,
              ENDCODE

CODE LSHIFT  ( n bits -- n') \ shift left arithmetic
              TOS R0  MOV,    \ the shift bits MUST be in R0 to do this
              TOS POP,
              R0 R0 MOV,
              NE IF,
                 TOS R0 SLA,
              ENDIF,
              NEXT,
              ENDCODE

CODE SRA   ( n bits -- n')  \ shift right arithmetic
              TOS R0  MOV,  \ the shift bits MUST be in R0 to do this
              TOS POP,
              TOS R0 SRA,
              NEXT,
              ENDCODE

CODE INVERT  ( u -- w)
              TOS INV,
              NEXT,
              ENDCODE

\ : +   ( u1 u2 -- u ) UM+ DROP ;  original Camel Forth code is bigger
CODE +       ( u1 u2 -- u )
             *SP+ TOS ADD,
              NEXT,
              ENDCODE

CODE -       ( u1 u2 -- u )
             *SP+ TOS SUB,
              TOS NEG,
              NEXT,
              ENDCODE

\ D+ is a better primitive for 9900 CPU
CODE D+   ( lo hi lo' hi' -- d)
             *SP+    R0  MOV,
             *SP+    TOS ADD,   \ add hi #s
              R0     *SP ADD,   \ add lo #s
              OC IF,            \ carry set?
                TOS INC,        \ incr hi
              ENDIF,
              NEXT,
              ENDCODE

CODE ABS    ( n -- n )
              TOS ABS,
              NEXT,
              ENDCODE

CODE NEGATE ( n -- n )
              TOS NEG,
              NEXT,
              ENDCODE

CODE ALIGNED ( n -- n)
              TOS INC,
              TOS FFFE ANDI,
              NEXT,
              ENDCODE

\ ==================================================================
CR .( MULTIPLY AND DIVIDE)

CODE UM*     ( n n -- d)     \ 2 cells in -- 2 cells out
             *SP  TOS MPY,
              R5  *SP MOV,
              NEXT,
              ENDCODE

CODE *      ( n n -- n)      \ same size as  : *  UM* DROP ; but faster
             *SP+ R3 MOV,
              TOS R3 MPY,
              NEXT,
              ENDCODE

CODE UM/MOD ( ud u1 -- u2 u3 ) \ numerator(32bits), divisor -- rem,quot
              TOS  R0 MOV,
             *SP+ TOS MOV,
             *SP   R5 MOV,
              R0  TOS DIV,
              R5  *SP MOV,
              NEXT,
              ENDCODE

\ ===========================================================
\ Signed divide using either Floored or Symmetric Integer Division.
\ Adapted with permission, from FBForth by Lee Stewart
\ This routine first does Symmetric Integer Division, then checks FLOOR
\ for whether we are doing Floored Integer Division.
\
\ Divides a 32 bit value in R1 and R2 by a 16 bit value in R0
\ Inputs:
\   TOS  denominator (divisor)
\   R1   MSB of numerator (dividend)
\   R2   LSB of numerator

\   TEMP   R3 sign of denominator
\   TEMP   W  sign of numerator
\   TEMP   R5 copy of numerator

\ VARIABLE
\    floor =floored/symmetric division flag passed by caller
\     0 = symmetric division
\    -1 = floored division

\ Outputs:
\   TOS=16-bit quotient (quot)
\   R2=16-bit remainder (rem)
\   set flags to reflect signs of operands, and force operands positive...


\ cross-compiler creates a variable to control floored or symmetrical division
VARIABLE FLOOR

CODE M/MOD  ( lsb msb n3 -- rem quot)
       TOS R3 MOV,             \ DUP for sign of denominator
       R1     POP,             \ POP the high word of ud to r1
       R1  W  MOV,             \ DUP for sign of numerator
       R1  R5 MOV,             \ DUP 2nd copy symmetric sign
      *SP  R2 MOV,             \ move low word of ud to r2 (keep stack pos.)

          TOS ABS,             \ force denominator positive
       R1  0 CI,               \ check sign of numerator
       LO IF,                  \ if numerator<0
           R1 INV,             \ DABS: invert numerator MSB and..
           R2 NEG,             \ ..negate numerator LSB
           OC IF,              \ if carry=TRUE
               R1 INC,         \ increment numerator MSB
           ENDIF,
       ENDIF,
       TOS R1 DIV,             \ perform the division. R1=quot, R2=rem

\ * Test for negative quotient
       R3 W  XOR,              \ compare signs of den and num
       LO IF,                  \ if different
           R1  NEG,            \ negate quotient
       ENDIF,
\ * check for remainder
       R2 0 CI,
       NE IF,                  \ if <>0
           R5  8000 ANDI,      \ test for negative numerator
           NE IF,              \ if signbit<>0
               R2 NEG,         \ rem. takes sign of num(symmetric)
           ENDIF,
\ * Handle floored division, if enabled
           FLOOR @@ R0 MOV,    \ symmetric or floored division?
           NE IF,              \ if <>0, do flooring
               W  8000 ANDI,   \ use XOR result to check num and den signs
               NE IF,
                   R1 DEC,     \ signs different, so floor quot
                   R3 R2 ADD,  \ rem = den + rem
               ENDIF,
           ENDIF,
       ENDIF,
       R1 TOS MOV,     \ quotient to tos
       R2 *SP MOV,     \ put remainder on open stack location
       NEXT,           \ we're outta here!
       ENDCODE         \ 72 bytes

\ ==================================================================
CR .( COMPARISON)

CODE 0=  ( n -- ?)         \ used 6X in kernel
            TOS NEG,
            NE IF,
                TOS SETO,
            ENDIF,
            TOS INV,
            NEXT,
            ENDCODE

CODE =     ( n n -- ?)     \ Used 4X in Kernel
             *SP+ TOS CMP,
              TOS CLR,
              EQ IF,
1 $:             TOS SETO,      \ Common TRUE stack setter
              ENDIF,
              NEXT,
              ENDCODE

\ stack setter routines are the smallest way to do this on 9900
\ +CODE allows these routines to jump inside CODE .. ENDCODE
+CODE 0<     ( n -- flag )
              TOS TOS  MOV,
              1 $ JLT,
2 $:          TOS CLR,
              NEXT,

+CODE U<    ( n1 n2 -- flag)
             *SP+ TOS CMP,
              1 $ JL,
              2 $ JHE,

+CODE >     ( n1 n2 -- flag)
             *SP+ TOS CMP,
              1 $ JGT,
              2 $ JMP,

+CODE <     ( n1 n2 -- flag)
             *SP+ TOS CMP,
              1 $ JLT,
              2 $ JMP,
ENDCODE

\ ====================================================
CR .( MIN & MAX )
CODE MIN     ( n1 n2 -- n)
             *SP TOS CMP,
              1 $ JLT,
              SP INCT,
              NEXT,
+CODE MAX   ( n1 n2 -- n)
             *SP  TOS CMP,
              1 $ JGT,
              SP INCT,
              NEXT,
1 $:          TOS POP,
              NEXT,
              ENDCODE

CR .( CMOVE CMOVE>  FILL )
CODE CMOVE  ( src dst n -- )
            *SP+ R0 MOV,
            *SP+ R1 MOV,
             BEGIN,
                TOS DEC,
             OC WHILE,
               *R1+ *R0+ MOVB,
             REPEAT,
             TOS POP,
             NEXT,
             ENDCODE

CODE CMOVE>  ( src dst n -- )
            *SP+ R2 MOV,
            *SP+ R1 MOV,
             TOS W  MOV,
             W DEC,
             W R1 ADD,
             W R2 ADD,
             BEGIN,
                TOS DEC,
             OC WHILE,
                 *R1 *R2  MOVB,
                  R1 DEC,
                  R2 DEC,
             REPEAT,
             TOS POP,
             NEXT,
             ENDCODE

CODE FILL   ( addr cnt char -- )
            *SP+ R0 MOV,
            *SP+ R1 MOV,
             TOS SWPB,
             BEGIN,
                TOS *R1+ MOVB,
                R0 DEC,
             EQ UNTIL,
             TOS POP,
             NEXT,
             ENDCODE

CR .( ANS Forth DO/LOOP )
\ conventional do loops use 2 cells on the RSTACK
CR .( Rstack based DO/LOOP )

CODE <?DO> ( limit ndx -- )
             *SP TOS CMP,
              1 $ JNE,
              SP INCT,
              TOS POP,
              IP RPOP,
              NEXT,

+CODE <DO> ( limit indx -- )
1 $:          R0  8000 LI,
             *SP+ R0  SUB,
              R0  TOS ADD,
              R0  RPUSH,
              TOS RPUSH,
              TOS POP,
              NEXT,
              ENDCODE

CODE <+LOOP>
              TOS *RP ADD,
              TOS POP,
              2 $ JMP,
+CODE <LOOP>
             *RP INC,
2 $:          3 $ JNO,
             *IP IP ADD,
              NEXT,

3 $:          IP INCT,
              RP  4 AI,
              NEXT,
              ENDCODE

CODE UNLOOP
              RP  4 AI,
              NEXT,
              ENDCODE

CODE I       ( -- n)
              TOS PUSH,
             *RP     TOS MOV,
              2 (RP) TOS SUB,
              NEXT,
              ENDCODE

CODE J       ( -- n)
              TOS PUSH,
              4 (RP) TOS MOV,   \ outer loop index is on the rstack
              6 (RP) TOS SUB,   \ index = loopindex - fudge
              NEXT,
              ENDCODE

CODE BOUNDS ( adr len -- adr2 adr1)  \ same size as Forth: OVER + SWAP
             *SP R1 MOV,
              TOS *SP ADD,
              R1 TOS MOV,
              NEXT,
              ENDCODE

\ ===========================================================
CR .( VARIABLE ON OFF)

CODE ON      ( adr -- )
             *TOS SETO,
              TOS POP,
              NEXT,
              ENDCODE

CODE OFF     ( adr -- )
             *TOS CLR,
              TOS POP,
              NEXT,
              ENDCODE

\ ===========================================================
CR .( SKIP SCAN )
CODE SKIP  ( c-addr u char -- c-addr' u')
              TOS SWPB,
              2 (SP) W MOV,
             *SP+ R1 MOV,
              NE IF,
                  BEGIN,
                    TOS *W+ CMPB,
                    1 $ JNE,
                    R1 DEC,
                  EQ UNTIL,
1 $:              W DEC,
              ENDIF,
              W *SP  MOV,
              R1 TOS MOV,
              NEXT,
              ENDCODE

CODE SCAN   ( adr len char -- adr' len' )
              TOS SWPB,
              2 (SP) W MOV,
             *SP+ R1 MOV,
              NE IF,
                  BEGIN,
                    TOS *W CMPB,
                     1 $ JEQ,
                     W INC,
                     R1 DEC,
                  EQ UNTIL,
              ENDIF,
1 $:          W *SP  MOV,
              R1 TOS MOV,
              NEXT,
             ENDCODE

\ ===========================================================
\ D I C T I O N A R Y   S E A R C H
\ We found the Camel Forth dictionary search to be a little slow on TI-99.
\ Creating (FIND) in assembler is smaller and about 5X faster than using
CODE (FIND) ( Caddr NFA -- XT ? )
      TOS R3 MOV,
      TOS CLR,
     *SP R8 MOV,
      NE IF,
        \ get the length byte of Caddr
         *R8 R5 MOVB,             \ R5 is string length
          R5  8 SRL,
             R5 INC,              \ skip length byte
          BEGIN,
               \ load char compare registers
                 R5 R0 MOV,           \ length of caddr string
                 R8 R1 MOV,           \ caddr string address
                 R3 R2 MOV,           \ NFA to compare
               \ inner character comparator loop
                 BEGIN,
                   *R1+ *R2+ CMPB,
                    1 $ JNE,
                    R0 DEC, EQ
                 UNTIL,
                 \ we found the word !!!
                 \ convert NFA in R3 to CFA -> R2
                  R3 R2 MOV,
                 *R3 R0 MOVB,
                  R0 SWPB,
                  R0 R2 ADD,
                  R2 INCT,
                  R2 -2 ANDI,

                \ test for immediate or normal word -> TOS
                  TOS SETO,
                 -1 (R3) R0 MOVB, \  R3-1 is Immediate field

                  R0 0100 ANDI,
                  NE IF,
                       TOS NEG,
                  ENDIF,
                  R2 *SP MOV,
                  NEXT,

                \ traverse link list to next NFA
1 $:            -3 (R3) R3 MOV, EQ
          UNTIL,
      ENDIF,
      NEXT,
      ENDCODE

CR .( CAMEL99 custom primitives)
\ multi-tasking support
CODE PAUSE   ( -- )  NEXT,  ENDCODE

CODE SPLIT  ( AABB --  BB AA )
              TOS W MOV,
              TOS 8 SRL,
              W FF ANDI,
              W PUSH,
              NEXT,
              ENDCODE

CODE FUSE   ( BB  AA -- AABB )
              TOS SWPB,
             *SP+ TOS ADD,
              NEXT,
              ENDCODE

[CC] THERE H !  \ align heap pointer so system knows
CR .( Code primitives complete)

 

 

METACOMP-SCREEN.png

  • Like 3
  • Thanks 1
Link to comment
Share on other sites

Meta Compiler Update

 

Late last night, early this morning, I got the Meta-compiler compiling the CAMEL268 kernel code up to the DSRLINK file.

I had to edit the DSRCODE to use the new  numeric labels so I stopped there as I might need some debugging.

 

It has been fascinating to write this in a system that I had direct control over versus HsForth for DOS where I am a user not the author.

So many things are much clearer in Camel99.

 

I decided to load all the tools, assembler and utilities into Super Cart RAM. This allowed me to compile Forth into low RAM.

It is just simpler for now than changing everything to use VDP RAM.

I will do that eventually which will let me make programs larger than 8K.

 

The one hurdle I will have to over come is relocation.  In DOS I just allocated and entire 64K segment to represent the TI99. If I want code for the TI99 to load at >A000 I simply compile code at <seg>:A000 and it's done.

I have figured out a relocation scheme for machine Forth so I will consult that code to see if it will work.

 

As always it is harder than I thought it might be but my first goal is to build a kernel that loads and runs from >2000.

Make it work then make it better. :)

 

  • Like 2
Link to comment
Share on other sites

ALTERNATE Images of Camel99 Forth

 

I finally figured out how dumb I am.

In all the changes I was making to the core image I forgot that if you put Forth in some other memory location the dictionary still has to start at >A000 when you run the interpreter. :dunce:

 

The attached ZIP file has two alternate Forth images.

CAM268SC loads into Super Cart ram at >6000

 

CAM268LR loads into Low RAM at >2000. 

This image will show you that there is only 46 bytes of low ram free. Essentially off limits.

 

These may be useful if you wanted to load Assembly Language programs into high RAM.

The code image would need to load above the Forth dictionary which can be found by typing 

HEX HERE U. 

It sits at >A1AC  after the SYSTEM file loads a few extensions.

If you load the LOADER utility it will be higher. 

 

 

EDIT:   These only worked on Classic99 and not well. Sorry. Should have tested them on real iron  first.

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

Further to the above images:

The problem is not in the kernel program but in my definition of the MARKER.

 

In the START file I got fancy.

I set a MARKER , load a program to load a font, load the new font and then reclaim the memory.

 

This does not work when the program image is does not start at >A000.  Need to dig into this.

 

I will replace the images above when I figure this out.

In the mean time I am happy that my understanding of the compiled images in other memory locations is intact. :)

 

  • Like 3
Link to comment
Share on other sites

EA3 Object File Loader

 

I didn't study much about the guts of the Object file format when I was using TI Assembler. 

After looking at the Willy's version I thought it could be done with /STRING  and an extension I call CHOP that uses /STRING.

This is just a different way to manage the parser than using a pointer variable.

The idea is to read a line and return it as stack string. ( addr,length pair on the data stack)

Next make a copy of the stack string and cut the leading characters that you need to read the tagged data.

Each operation leaves behind the rest of the string on the data stack as just two integers so it's pretty efficient.

 

This code seems to load the object file in the next spoiler successfully.

Spoiler

.( EA3 object file loader Aug 7 2021 Fox)
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

DECIMAL
0 VALUE #1  \ a file handle

\ 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 HEAP!  HEAP 2000 FF FILL ;

\ string utilities
: CHOP   ( addr len n --  addr' len' addr2 len2 )
          >R                  \ Rpush n
          2DUP DROP R@        \ 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 off character

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

: CONST ( addr len -- )
        PARSE# >R         ( -- addr' len')
        /TAG 6 CHOP -TRAILING  ( -- addr' len' ) \ name of DEF or REF
        HEADER,  COMPILE DOCON R> ,              \ make a Forth Constant
;

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 ;

: ParseLine ( add len -- )
      BEGIN
        DUP ( len<>0)
      WHILE
        OVER C@ ( 1stChar)
        CASE
          [CHAR] 0 OF  PROG-ID                ENDOF
          [CHAR] 6 OF  CONST                  ENDOF
          [CHAR] 7 OF  DROP 0                 ENDOF
          [CHAR] 9 OF  PARSE# HEAP! HEAP OFF  ENDOF
          [CHAR] B OF  PARSE# HEAP,           ENDOF
          [CHAR] : OF  .TOOLVER               ENDOF
        ENDCASE
        1 /STRING 0 MAX   \ advance to next char
     REPEAT
     2DROP ;

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

DECIMAL
: EA3LOAD ( "DSKx.FILE" -- )
      ?PATH DV80 R/O OPEN-FILE ?FILERR  TO #1
      NEW.
      BEGIN
         #1 EOF
      0= WHILE
         PAD DUP 80 #1 READ-LINE ( pad len ? ior) ?FILERR  DROP
       ( pad len ) ParseLine
      REPEAT
      #1 CLOSE-FILE ABORT" CLOSE error"
;

.( Usage: S" DSKx.FILENAME" EA3LOAD)

 

 

Test object file

Spoiler

00000        92000920029200492006B2008B04C0B04C6B020CB0024B30C07F366F       0001
92012B020CB0006B3606B04C1B0200B0100B0202B0008B020CB0024B30C07F333F          0002
92028B020CB0006B3601B0281BFF00B163DB0220B0100B0222B0008B02807F317F          0003
9203EB0600B16F0B0201B0100B2581B1603B0200B003DB100CB0A11B25817F30FF          0004
92054B1603B0200B0020B1012B0A11B2581B1623B0200B000DB100CB02017F341F          0005
9206AB1000B2581B1603B0200B0005B1005B0A11B2581B1602B0200B002B7F337F          0006
92080B8800B2004B1603B0720B2002B1004B0201B0001BC801B2002BC8007F33FF          0007
92096B2004B0644BC500BC820B2000B83D6B020CB8326B045CB0700B04C17F2D6F          0008
920ACB10F1B0200B0100B2440B1303B0A10B0582B10FBB0201B20FCB02007F2EEF          0009
920C2B1000B2580B1305B05C1B0A10B0280B8000B16F9BC051BA081BD0127F2DDF          0010
920D8B0980B0281B2134B13D0B0280B0061B11CDB0280B007AB15CAB04CC7F2AEF          0011
920EEB1E15B1F07B1D15B13C5B0220BFFE0B10C2B2164B2134B2194B21047F294F          0012
92104B3D20B0D00B0000B0000B2E6CB6F39B3273B7778B2C6BB6938B33647F2ABF          0013
9211AB6563B6D6AB7537B3466B7276B6E68B7936B3567B7462B2F3BB70307F280F          0014
92130B3161B717AB2B20B0DFFBFFFFBFFFFB3E4CB4F28B4053B5758B3C4B7F1DFF          0015
92146B492AB2344B4543B4D4AB5526B2446B5256B4E48B595EB2547B54427F2A1F          0016
9215CB2D3AB5029B2141B515AB3D20B0D00B0000B0000BB9C2B270FB04087F2B9F          0017
92172B7E0ABB8C1B3F06B0709B0B60BC3C0B5F01B027BB5B7FBC4BFBC60C7F20DF          0018
92188B0E7DB5DBEBBABDB22BCB037CBC55CB1D20B0DFFBFFFFBFFFFB1B0C7F14BF          0019
9219EB0F1FB1813B1718B000BB091EB1904B0503B0D0AB151DB1A06B12167F2A5F          0020
921B4B0E08B191CB1B07B1402B1B1CB1016B1701B111A7F5FFF                         0021
62006KSCAN 62000VBLANK62002KSTAT 7F7E4F                                     0022
:Asm994a TMS99000 Assembler - v3.010                                        0023

 

 

  • Like 2
Link to comment
Share on other sites

On 8/6/2021 at 9:15 AM, TheBF said:

EDIT:   These only worked on Classic99 and not well. Sorry. Should have tested them on real iron  first.

If you can tell me why they only worked on Classic99, I'd like to know if there is something I can fix.

 

  • Like 1
Link to comment
Share on other sites

7 hours ago, Tursi said:

If you can tell me why they only worked on Classic99, I'd like to know if there is something I can fix.

 

As it turned out they didn't run on Classic99 properly either but they did start up and loaded the start-up file.

This is usually a good sign but they died after a couple of enter keys were struck.

 

On real iron they just blew up or went to the title screen.

 

This looks like something I am missing in the system initialization when the image starts at a different ORG.

I will have to get to the root of that and then maybe I will be able to tell you a difference.

Wish I had more for you. 

And as always thanks. Classic99 is probably the only thing that lets me do this activity.

My patience with the old hardware dev times would have worn thin long ago.

 

  • Like 1
Link to comment
Share on other sites

If it's disk related, remember that the Classic99 DSR is not the TI Disk Controller -- but you can enable the TI Disk Controller for a more accurate test. If it then fails the same way, you will have the debugger available to work out why.

 

  • Like 3
Link to comment
Share on other sites

1 hour ago, Tursi said:

If it's disk related, remember that the Classic99 DSR is not the TI Disk Controller -- but you can enable the TI Disk Controller for a more accurate test. If it then fails the same way, you will have the debugger available to work out why.

 

Yes. It's definitely not Classic99's fault if I can't figure it out.

It's all there for me to see. 

  • Like 1
Link to comment
Share on other sites

Ok maybe I'm a little obsessed but it's fun to learn something new.

 

I found some VDP routines in @mathew180  's  Assembly training posts.

 

With just an expanded DEF statement I made them expose the routines and AORG to >2000

Assembled and loaded into Forth low RAM with the EA3 loader.

Spoiler

* VDP code that interfaces to CAMEL99 Forth
* Original Code by mathew180  @atariage.com

* R0,R1,R2,R3 and R5 and R8 are free to use

* R4 is RESERVED as the top of stack cache register
* DATA stack is maintained in R6
* DATA stack parameters can be popped into registers with:
\   MOV *R6+,Rx

* Return stack is maintained by R7
*********************************************************************
        AORG >2000

* declare sub-routines for external use
        DEF  VSBW,VSMW,VMBW,VMBR,VSBR,VMBR,VWTR

* 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             * Forth's Workspace
R0LB   EQU  WRKSP+1           * R0 low byte req'd for VDP routines

*********************************************************************
*
* VDP Single Byte Write
*
* R0   Write address in VDP RAM
* R1   MSB of R1 sent to VDP RAM
*
* R0 is modified, but can be restored with: ANDI R0,>3FFF
*
VSBW  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
      MOVB R1,@VDPWD         * Write byte to VDP RAM
      B    *R11
*// VSBW

*********************************************************************
*
* VDP Single Byte Multiple Write
*
* R0   Starting write address in VDP RAM
* R1   MSB of R1 sent to VDP RAM
* R2   Number of times to write the MSB byte of R1 to VDP RAM
*
* R0 is modified, but can be restored with: ANDI R0,>3FFF
*
VSMW   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
VSMWLP MOVB R1,@VDPWD         * Write byte to VDP RAM
       DEC  R2                * Byte counter
       JNE  VSMWLP            * Check if done
       B    *R11
*// VSMW

*********************************************************************
*
* VDP Multiple Byte Write
*
* R0   Starting write address in VDP RAM
* R1   Starting read address in CPU RAM
* R2   Number of bytes to send to the VDP RAM
*
* R0 is modified, but can be restored with: ANDI R0,>3FFF
*
VMBW   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
VMBWLP MOVB *R1+,@VDPWD       * Write byte to VDP RAM
        DEC  R2                * Byte counter
        JNE  VMBWLP            * Check if done
        B    *R11
*// VMBW

*********************************************************************
*
* VDP Single Byte Read
*
* R0   Read address in VDP RAM
* R1   MSB of R1 set to byte from VDP RAM
*
VSBR   MOVB @R0LB,@VDPWA      * Send low byte of VDP RAM write address
      MOVB R0,@VDPWA         * Send high byte of VDP RAM write address
      MOVB @VDPRD,R1         * Read byte from VDP RAM
      B    *R11
*// VSBR

*********************************************************************
*
* VDP Multiple Byte Read
*
* R0   Starting read address in VDP RAM
* R1   Starting write address in CPU RAM
* R2   Number of bytes to read from VDP RAM
*
VMBR   MOVB @R0LB,@VDPWA      * Send low byte of VDP RAM write address
      MOVB R0,@VDPWA         * Send high byte of VDP RAM write address
VMBRLP MOVB @VDPRD,*R1+       * Read byte from VDP RAM
      DEC  R2                * Byte counter
      JNE  VMBRLP            * Check if finished
      B    *R11
*// VMBR

*********************************************************************
*
* VDP Write To Register
*
* R0 MSB    VDP register to write to
* R0 LSB    Value to write
*
VWTR  MOVB @R0LB,@VDPWA      * Send low byte (value) to write to VDP register
      ORI  R0,>8000          * Set up a VDP register write operation (10)
      MOVB R0,@VDPWA         * Send high byte (address) of VDP register
      B    *R11
*// VWTR

      END

 

 

These could work with Forth "as is" by passing parameters from the Forth data stack to the specified registers in the wrappers below.

Alternatively one could write the Assembler code in Forth friendly fashion.

 

An important thing in the example wrappers is that the DEFS name space has to be searched first so we don't try and run Forth words with the same name as the DEFs when we assemble the wrapper code.

(Many of those DEF names are valid Forth words in CAMEL99. It didn't go well the first time) :) 

 

All in all this was a great exercise for me to learn more about conventional Assembler programming.

\ Wrappers for VDP object code

ONLY FORTH ALSO ASSEMBLER ALSO FORTH DEFINITIONS

ALSO DEFS  \ gotta have DEFS wordlist searched first

CODE _VWTR   VWTR @@ BL,  NEXT, ENDCODE
CODE _VSBR   VSBR @@ BL,  NEXT, ENDCODE
CODE _VMBR   VMBR @@ BL,  NEXT, ENDCODE
CODE _VMBW   VMBW @@ BL,  NEXT, ENDCODE
CODE _VSMW   VSMW @@ BL,  NEXT, ENDCODE
CODE _VSBW   VSBW @@ BL,  NEXT, ENDCODE

 

EXTERNAL DEFS.png

  • Like 3
Link to comment
Share on other sites

@TheBF thank you, thank you for chasing this rabbit! I'm looking forward to using it to do things in the future.

 

I made this sample program to demonstrate DEF in one file, REF in another file, with subroutines in each.

Attached are the source files and a DSK image.

 

To test in E/A:

 

Load EA3:

 

DSK1.THING1

DSK1.THWACK

 

Run: LOOP

 

To test otherwise:

somehow get the two object files linked into memory, THING1 first, then THWACK.

 

BLWP @THINK        increments variable THING1

or

BL   @THINKL

Followed by:

BLWP @THWACK    draws THING1 chars on the screen.

Also

 

B @LOOP repeats THINK/THWACK with no return.

 

Of note:

 

thwack.mk is a command line Makefile. It demonstrates using @ralphb's XDT99 to assemble, create list files, and make a DSK image for js99er.net or Classic99.  I use this with Cygwin on Windows, and on MacOS.

 

So to build everything:

make -f thwack.mk

 

 

 

 

 

 

thwack.dsk thwack.lst thwack.obj thing1.lst thing1.obj thing1.a99 thwack.a99

thwack.mk

Edited by FarmerPotato
changed thwack.mk so source files go into dsk
  • Like 4
Link to comment
Share on other sites

So I guess we will have to define what acceptable restrictions are for code that is loading into a Forth system. 

Forth has all the upper memory so object code must be AORG >2000

Of course that limits you to 8K of total space.

 

I made a new version this morning that has more protections so it trapped these files quite nicely.

 

Here is what happens when I try to load your relocatable object files. :)

TAG A is for a relocatable address which I can't deal with at this time.

 

 

 

 

thwack-test.png

  • Like 1
Link to comment
Share on other sites

@FarmerPotato

 

It would probably be a good thing to know what your final usage/expectations are?

Is this for testing code interactively on the TI-99? Maybe it's for your new machine?

 

This is making me wonder if I should just make a prefix assembler for you that matches TI ASM syntax as close as possible  :) 

 

  • Like 1
Link to comment
Share on other sites

3 hours ago, FarmerPotato said:

These source and object files really let me see how the different tags work.  I think I can handle a limited amount of relocation after I get done today.

  • Like 1
Link to comment
Share on other sites

@TheBF

here is what I imagine for requirements:

 

1. ability to load object code (one or more relocatable files) with DEFs but no REFs. Forth loads it into next available space. E/A would use its pointers First Free Address in Low Memory, Last free, High Memory etc. Finally, create Forth words out of the DEFs, make them work like CONSTANT, so they can be found. User  Then does,like you said, :ASM THINK @@ BLWP, ;ASM.
but a DEF could point to entry points, or data. 

 

this is good for interactive 99/4A development, reusing optimized assembly routines. 
 

2. REFs. I have this in mind for Geneve2020 where it could be useful.

 

There are definitely libraries implemented in assembly. Rather than be part of the ROM, they might be loaded just after boot, by the Forth kernel. 
 

another idea I want to do is DSR ROM in a card, for plug-and-play. Avoid the need for DSR support built in to the BIOS or installed from a different media. 
 

Said DSR can’t be absolute address code, and it must link with standard libraries through REFs. DSR can be supplied as relocatable object code, or else Forth source (which is easier.)

 

DSR as object code is read like a file. But actually stored on a cheap 8-pin serial SPI flash. Said flash might be used to store more than one file for the BIOS to find (eg a 8K ROM for use in GPL mode) 

 

  • Like 1
Link to comment
Share on other sites

2 minutes ago, FarmerPotato said:

@TheBF

here is what I imagine for requirements:

 

  1. ability to load object code (one or more relocatable files) with DEFs but no REFs.   REFS might be ready today (I think)
  2. Forth loads it into next available space. currently loads to >2000. Dictionary is tight on the old girl
  3. E/A would use its pointers First Free Address in Low Memory, Last free, High Memory etc. E/A is out of the picture. ?  Forth is running. 
  4. Finally, create Forth words out of the DEFs, make them work like CONSTANT, so they can be found.  WORKING in the current code. DEFs are in their own vocabulary as Forth constants
  5. User  Then does,like you said, :ASM THINK @@ BLWP, ;ASM. but a DEF could point to entry points, or data.  Done.

 

this is good for interactive 99/4A development, reusing optimized assembly routines. 
 

  1. REFs. I have this in mind for Geneve2020 where it could be useful. I think I get how to do REFs now by looking up DEFs in the dictionary and filling in the REF address.
  2. There are definitely libraries implemented in assembly. Rather than be part of the ROM, they might be loaded just after boot, by the Forth kernel. remember low ram is the limit. 
  3. another idea I want to do is DSR ROM in a card, for plug-and-play. Avoid the need for DSR support built in to the BIOS or installed from a different media. 
    1. Said DSR can’t be absolute address code, and it must link with standard libraries through REFs. DSR can be supplied as relocatable object code, or else Forth source (which is easier.)
      If you have Forth running then it is far simpler to load Forth source into that RAM space and just run it.
    2. DSR as object code is read like a file. But actually stored on a cheap 8-pin serial SPI flash. Said flash might be used to store more than one file for the BIOS to find (eg a 8K ROM for use in GPL mode) above my pay grade maybe. :) 

It is not completely clear to me who is running the machine in your scenario above.

The current code assumes Forth as O/S.

 

  • Like 1
Link to comment
Share on other sites

2 hours ago, TheBF said:

It is not completely clear to me who is running the machine in your scenario above.

The current code assumes Forth as O/S.

 

The top part is relevant to your environment on a 99/4A. Low Ram should probably hold all my old 4A code that I had in mind. Then further development is all Forth.  Would be neat though, if the loader just allocated a chunk of dictionary space. 
 

the bottom part was for future Geneve2020 bios. where run-time loadable drivers have REFs that hook into the ROM. I assume I’ll do any work to adapt to this environment. 


 

The part about flash is totally mine—bios would just slurp the file into RAM for processing. 

 

  • Like 2
Link to comment
Share on other sites

OK got it.

 

I could allocate space in the dictionary but then you are missing space for Forth. It's a tiny machine. :)

Low ram is completely free in Camel99 so it's the best place to start for the 99.

 

I can now accept all the relocatable tags in your code but the REFs don't work correctly yet.

10X more complication compared to a Forth Assembler. Wow!

 

I suspect there will some rules of engagement you will have to live with.

I could turn DEFs into words in the dictionary that call themselves and return to Forth. ? Let me know if that's better.

Now they are just a constant that returns an address and you have to make wrappers manually

 

If you can abide Forth's register usage you can also use the stack to pass parameters to your code. It's not difficult.

 

Since this actually a linker, making a full function linker is probably more than I want to invest or am even capable of since I just starting learning how the darn thing works. :)

But with a limited requirement spec it can still be useful.

 

 

 

 

 

  • Like 1
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.

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

  • Recently Browsing   0 members

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