Camel99 Forth Information goes here

+TheBF · September 8

1 hour ago, GDMike said:

Well, for starters...a windowed menu

Color code user data changes vs default setting

Unless you just want it all to be a DOS - keyword command system.

With built-in help ofptions

I wouldn't mind the latter

Well 1.0 would be a file system shell. Make it work, then make it better.

Then we need to decide is it a TI compatible file system or something totally different like the P-Code does.

+TheBF · September 8

After reading some posts about multi-color mode I went looking into TI-Forth to see how it was done.

Setting up the mode was quickly replicated but then I saw this monstrosity.

: TEXT   TEXT CHARSET PAGE ;

\ TI-FORTH HARNESS for Camel99 Forth 
: ENDIF  POSTPONE THEN ; IMMEDIATE 
: VSBW  S" VC!" EVALUATE ; IMMEDIATE 
: VSBR  S" VC@" EVALUATE ; IMMEDIATE 
: U*    S" UM*" EVALUATE ; IMMEDIATE 
: GCHAR ( c r -- c) S" >VPOS VC@" EVALUATE ; IMMEDIATE 

\ FROM TI-FORTH
VARIABLE ADR 
HEX 
: MCHAR ( COLOR C R --- ) 
    DUP >R 2 / SWAP 
    DUP >R 2 / SWAP
    DUP >R GCHAR  DUP 20 /  100 U* DROP 800 + >R 
    20 MOD  8 * R> + 
    R> 4 MOD 2 * + ADR ! 
    R> 2 MOD 
    R> 2 MOD SWAP
    IF  IF 3 ELSE 1 ENDIF  ELSE  IF 2 ELSE 0 ENDIF   ENDIF
    DUP 2 MOD 0= IF SWAP 10 * SWAP ENDIF
    CASE 0 OF ADR @ VSBR 0F ENDOF  1 OF ADR @ VSBR F0 ENDOF
    2 OF 1 ADR +! ADR @ VSBR 0F ENDOF
    3 OF 1 ADR +! ADR @ VSBR F0 ENDOF
    ENDCASE AND +   ADR @  VSBW ;

All that just to put a square pixel on the screen.

I managed to make it a bit over 2X faster by remove all the MOD instructions and replaced them with AND.

I removed the 100 UM* DROP and replaced it with a byte swap. ( >< in Camel Forth)

Swapping bytes is like 256 * or 256 / depending on which bytes you are concerned with.

Here is the version that is 2x faster .

\ optimized with some Camel99 words 
HEX 
: MCHAR2 ( COLOR C R --- ) 
    DUP>R 2/ SWAP 
    DUP>R 2/ SWAP ( -- color c' r')
    DUP>R GCHAR DUP 5 RSHIFT  ><  800 + >R 
    1F AND 8* R> +  
    R>  3 AND 2* + ADR ! 
    R>  1 AND  
    R>  1 AND SWAP
    IF  
      IF 3 ELSE 1 ENDIF  
      ELSE  
           IF 2 ELSE 0 ENDIF   
      ENDIF
      DUP 2 MOD 0= IF SWAP 10 * SWAP 
    ENDIF
    
      CASE 
      0 OF ADR @ VC@ 0F ENDOF  
      1 OF ADR @ VC@ F0 ENDOF
      2 OF 1 ADR +! ADR @ VC@ 0F ENDOF
      3 OF 1 ADR +! ADR @ VC@ F0 ENDOF
    ENDCASE 
    AND +  ADR @  VC! ;

Here is a the test I used on each version

DECIMAL
: MTEST1
   MULTICOLOR 
   16 DO 
        64 0 
        DO  
          I I J MCHAR \ MCHAR2
        LOOP 
    LOOP 
   BEGIN  KEY? UNTIL 
   TEXT ;

But there must be a better way to do this.

I have the text from the 9918 manual so I guess I can start there.

\ *equation for finding pattern table locations
\ first byte = 2 * row + name * 8
\ second byte = first byte + 1
\ row = mod4[truncate(pattern position/32)]

+Lee Stewart · September 9

Not sure if this will help, but perhaps my ALC version for fbForth 3.0 in the spoiler can offer some insight for high-level Forth:

Spoiler

;[*** MINIT ***      ( --- )
*        DATA DALL_N
* MINI_N .NAME_FIELD 5, 'MINIT'
* MINIT  DATA $+2
*        BL   @BLF2A
*        DATA _MINI->6000+BANK1

_MINI  
       BL   @__MINI
       B    @RTNEXT         ; back to bank 0 and the inner interpreter
       
*++ body of MINIT routine to allow call by other routines in this bank
__MINI MOV  @$SSTRT(U),R0   ; SCRN_START to R0
       CLR  R2              ; starting char row
MINI01 MOV  R2,R1           ; next row
       SRL  R1,2            ; insure starting with same char code every 4 rows
       SLA  R1,5            ; starting char code
       LI   R3,32           ; inner loop counter
MINI02 SWPB R1              ; put in left byte for VSBW
       BLWP @VSBW           ; write character to SIT
       SWPB R1              ; restore to right byte for INC
       INC  R1              ; next char code
       INC  R0              ; next SIT address
       DEC  R3              ; decrement inner loop counter
       JNE  MINI02          ; done?
       INC  R2              ; increment row
       CI   R2,24           ; done?
       JLT  MINI01          ; nope, do next row
       RT                   ; return to caller
;]
;[*** MCHAR ***      ( color mc mr --- )
*        DATA MINI_N
* MCHR_N .NAME_FIELD 5, 'MCHAR'
* MCHAR  DATA $+2
*        BL   @BLF2A
*        DATA _MCHR->6000+BANK1
       
_MCHR  MOV  *SP+,R0         ; pop mr to R0
       MOV  R0,R2           ; copy to r2
       MOV  *SP+,R1         ; pop mc to R1
       MOV  R1,R3           ; copy to r3
       SRL  R0,1            ; get char row
       SRL  R1,1            ; get char column
       SLA  R0,5            ; char row's byte offset from SCRN_START
       A    R1,R0           ; char's offset from SCRN_START
       A    @$SSTRT(U),R0   ; VRAM address of char
       BLWP @VSBR           ; get char code
       SRL  R1,5            ; char pattern offset (*8) into PDT and move to right byte
       MOV  R1,R0           ; prepare to get color byte
       ANDI R2,7            ; byte offset for mr's color
       A    R2,R0           ; byte offset into PDT
       A    @$PDT(U),R0     ; color byte's address
       BLWP @VSBR           ; get color byte
       MOV  *SP+,R4         ; pop new color
       SWPB R4              ; to left byte
       ANDI R4,>0F00        ; insure color is legal
       ANDI R3,1            ; left or right nybble?
       JEQ  MCHR01          ; left nybble?
       ANDI R1,>F000        ; nope, clear right nybble
       JMP  MCHR02          ; finish up
MCHR01 ANDI R1,>0F00        ; clear left nybble
       SLA  R4,4            ; shift new color to left nybble
MCHR02 A    R4,R1           ; add new color
       BLWP @VSBW           ; store new color
       B    @RTNEXT         ; back to bank 0 and the inner interpreter
;]

...lee

GDMike · September 9

Dang what a difference

+TheBF · September 9

1 hour ago, Lee Stewart said:

Not sure if this will help, but perhaps my ALC version for fbForth 3.0 in the spoiler can offer some insight for high-level Forth:

Hide contents

;[*** MINIT ***      ( --- )
*        DATA DALL_N
* MINI_N .NAME_FIELD 5, 'MINIT'
* MINIT  DATA $+2
*        BL   @BLF2A
*        DATA _MINI->6000+BANK1

_MINI  
       BL   @__MINI
       B    @RTNEXT         ; back to bank 0 and the inner interpreter
       
*++ body of MINIT routine to allow call by other routines in this bank
__MINI MOV  @$SSTRT(U),R0   ; SCRN_START to R0
       CLR  R2              ; starting char row
MINI01 MOV  R2,R1           ; next row
       SRL  R1,2            ; insure starting with same char code every 4 rows
       SLA  R1,5            ; starting char code
       LI   R3,32           ; inner loop counter
MINI02 SWPB R1              ; put in left byte for VSBW
       BLWP @VSBW           ; write character to SIT
       SWPB R1              ; restore to right byte for INC
       INC  R1              ; next char code
       INC  R0              ; next SIT address
       DEC  R3              ; decrement inner loop counter
       JNE  MINI02          ; done?
       INC  R2              ; increment row
       CI   R2,24           ; done?
       JLT  MINI01          ; nope, do next row
       RT                   ; return to caller
;]
;[*** MCHAR ***      ( color mc mr --- )
*        DATA MINI_N
* MCHR_N .NAME_FIELD 5, 'MCHAR'
* MCHAR  DATA $+2
*        BL   @BLF2A
*        DATA _MCHR->6000+BANK1
       
_MCHR  MOV  *SP+,R0         ; pop mr to R0
       MOV  R0,R2           ; copy to r2
       MOV  *SP+,R1         ; pop mc to R1
       MOV  R1,R3           ; copy to r3
       SRL  R0,1            ; get char row
       SRL  R1,1            ; get char column
       SLA  R0,5            ; char row's byte offset from SCRN_START
       A    R1,R0           ; char's offset from SCRN_START
       A    @$SSTRT(U),R0   ; VRAM address of char
       BLWP @VSBR           ; get char code
       SRL  R1,5            ; char pattern offset (*8) into PDT and move to right byte
       MOV  R1,R0           ; prepare to get color byte
       ANDI R2,7            ; byte offset for mr's color
       A    R2,R0           ; byte offset into PDT
       A    @$PDT(U),R0     ; color byte's address
       BLWP @VSBR           ; get color byte
       MOV  *SP+,R4         ; pop new color
       SWPB R4              ; to left byte
       ANDI R4,>0F00        ; insure color is legal
       ANDI R3,1            ; left or right nybble?
       JEQ  MCHR01          ; left nybble?
       ANDI R1,>F000        ; nope, clear right nybble
       JMP  MCHR02          ; finish up
MCHR01 ANDI R1,>0F00        ; clear left nybble
       SLA  R4,4            ; shift new color to left nybble
MCHR02 A    R4,R1           ; add new color
       BLWP @VSBW           ; store new color
       B    @RTNEXT         ; back to bank 0 and the inner interpreter
;]

...lee

This is really great help Lee. Thanks for all the heavy lifting.

I think this can translate into something pretty straightforward in only Forth with a few CODE words for faster shifting.

I think I have a "shift maker" word somewhere that will help with that process.

RickyDean · September 9

Today is Chuck Moore's Birthday https://en.wikipedia.org/wiki/Charles_H._Moore#:~:text=Charles Havice Moore II (born,Forth programming language in 1968.

"Charles Havice Moore II (born 9 September 1938), better known as Chuck Moore, is an American computer engineer and programmer, best known for inventing the Forth programming language in 1968."

+TheBF · September 9

45 minutes ago, RickyDean said:

Today is Chuck Moore's Birthday https://en.wikipedia.org/wiki/Charles_H._Moore#:~:text=Charles Havice Moore II (born,Forth programming language in 1968.

"Charles Havice Moore II (born 9 September 1938), better known as Chuck Moore, is an American computer engineer and programmer, best known for inventing the Forth programming language in 1968."

And I would add that Chuck gave us the 2 stack "ultra-RISC" computer architecture and a number of real chips in that form.

A few more EE grad students need to explore that further and see where it goes IMHO.

+TheBF · Friday at 07:16 PM

I have been playing with the TI-FORTH MCHAR code to see what else could be improved.

I was staring that this part:

( ? ? -- ?) 
\      SWAP 
\      IF    IF 3 ELSE 1 THEN  
\      ELSE  IF 2 ELSE 0 THEN   
\      THEN

Seemed like a lot of stuff.

I rolled it up into a word and tested it at the console.

Here is the truth table:

col row | out
--------------
0   0   | 0
0   1   | 1
1   0   | 2
1   1   | 3

Hmm, that looks familiar.

I threw it away and replace all that branching with:

   2*  +

So using better word choices from the Camel99 kernel and a thing I call a "TABLE:' I got this little benchmark down to 2.5 secs.

This is about 2.8X faster than the original's 7 second timing.

But it doesn't hold a candle to Lee's all CODE version which comes in at 1 second.

Spoiler

\ REFERENCE VERSION FROM TI-FORTH 
NEEDS MULTICOLOR  FROM DSK1.MULTIMODE 
NEEDS CASE  FROM DSK1.CASE 
\ LEVEL 1 OPTIMIZATION: Use optimizing words in Camel99 Forth 
\ LEVEL 2 OPTIMIZATION 
\ >> Replace all of this:
\ : LOGIC  ( n n -- ?) 
\      SWAP 
\      IF    IF 3 ELSE 1 THEN  
\      ELSE  IF 2 ELSE 0 THEN   
\      THEN
\ ;
\ With:   2* +  

\ LEVEL 3 OPTIMIZATION : REMOVE THE VARIABLE 

: GCHAR ( c r -- c) S" >VPOS VC@" EVALUATE ; IMMEDIATE 

NEEDS TABLE: FROM DSK1.TABLES
HEX 800 TABLE: ]PDT \ convert base address to byte array 

HEX
: MCHAR ( COLOR C R --- ) 
     DUP>R 2/ SWAP DUP>R 2/ SWAP
     DUP>R GCHAR  DUP  5 RSHIFT >< ]PDT >R 
     1F AND 8* R> + R>  3 AND 2* +  ( ADR !  removed)

     R> 1 AND  
     R> 1 AND  ( -- color Vaddr  ? ?) 
     2* +      ( -- color Vaddr n)    \ convert bits to digit   
     SWAP >R   ( -- color n)  \ save the Pattern table address 
      
     DUP 1 AND 0= IF SWAP 4 LSHIFT SWAP THEN
     
     CASE 
          0 OF R@ VC@ 0F ENDOF 
          1 OF R@ VC@ F0 ENDOF
          2 OF R> 1+ DUP>R VC@ 0F ENDOF
          3 OF R> 1+ DUP>R VC@ F0 ENDOF
     ENDCASE 
     AND +  R> VC! ;


DECIMAL 
: TEST
    MULTICOLOR 
    48 0 DO  
        15  0 I +  I MCHAR 
        1   1 I +  I MCHAR 
        2   2 I +  I MCHAR 
        3   3 I +  I MCHAR 
        4   4 I +  I MCHAR 
        5   5 I +  I MCHAR 
        6   6 I +  I MCHAR 
        7   7 I +  I MCHAR 
        8   8 I +  I MCHAR 
        9   9 I +  I MCHAR
        10 10 I +  I MCHAR
        11 11 I +  I MCHAR
        12 12 I +  I MCHAR
        13 13 I +  I MCHAR
        14 14 I +  I MCHAR
        15 15 I +  I MCHAR
   LOOP 
   BEGIN ?TERMINAL UNTIL 
   TEXT 
;

+TheBF · Saturday at 08:47 PM

It took me a while to get all the byte reversals corrected, but using Lee's excellent example code, I create three code words.

These are married together using Forth and the performance is very similar to using one large code word.

\ REFERENCE VERSION FROM TI-FORTH 

NEEDS MULTICOLOR  FROM DSK1.MULTIMODE 

\ LEVEL 5 OPTIMIZATION : Write code words using Lee's method

HEX 
CODE >NAME ( col row -- Vaddr)
      *SP+ R1 MOV, 
       R1   1 SRL,  \ 2/ 
       TOS  1 SRL,  \ 2/  
       TOS  5 SLA,  \ 32* 
       R1 TOS ADD, 
       NEXT,
ENDCODE         

CODE ]PATTERN ( row char -- Vaddr) \ address of color byte
       TOS  3 SLA,    \ char offset 8*
       TOS PDT AI,    \ add the base address 
      *SP+ R2 MOV,    \ row -> R2 
       R2  7  ANDI,   \ byte offset for row's color   
       R2  TOS ADD,           
       NEXT,
ENDCODE        

HEX 
CODE NYBBLES ( color column colorbyte -- colorbyte')   
      *SP+ R2 MOV,      \ column to R2
      *SP+ R3 MOV,      \ new color to R3 
       R3  0F ANDI,     \ insure color is legal
       R2  1  ANDI, 
       NE IF, 
            TOS F0 ANDI,  
       ELSE,
            TOS 0F ANDI,
            R3  4 SLA, 
       ENDIF, 
       R3 TOS ADD, 
       NEXT,
ENDCODE        

: MCHAR  ( color col row --)
    2DUP 
    >NAME VC@ ]PATTERN DUP>R VC@ 
    NYBBLES  R> VC! ;

Sign In

Camel99 Forth Information goes here

Recommended Posts

+TheBF

Link to comment

Share on other sites

+TheBF

Link to comment

Share on other sites

+Lee Stewart

Link to comment

Share on other sites

GDMike

Link to comment

Share on other sites

+TheBF

Link to comment

Share on other sites

RickyDean

Link to comment

Share on other sites

+TheBF

Link to comment

Share on other sites

+TheBF

Link to comment

Share on other sites

+TheBF

Link to comment

Share on other sites

Join the conversation

Recently Browsing 0 members

Apps

My Activity Streams

More