Jump to content
Have You Played Atari Today?
2600|5200|7800|Lynx|Jaguar|Forums|Store
IGNORED

Camel99 Forth Information goes here

TheBF

By TheBF
in TI-99/4A Development

 Share

Recommended Posts

TheBF River Patroller

+TheBF

Posted
  • Author
Posted

Tursi's Death Star got me spinning on the fact that I never added bit mapped graphics to Camel99.

So... I had to obsess over that for the past 2 days. 🙂 

 

I dug into the code in TI-Forth code and while it gave me a way to setup the VDP, BUT the code to plot a pixel used a CASE statement. (yuk) 

Very bad form. Bad form indeed.  :) 

 

There was also a lot of machine code and I didn't want to re-write that.

Fortunately the TI Programmer's Guide for TMS9918 had an excellent description of how to compute the offset and byte to get at a pixel so with that I was off to the races.

I avoided a lot of complexity by using the native divide instruction. UM/MOD gets a lot done with no effort. 

 

I already had some preliminary words for doing logical functions on (OR, AND, XOR) VDP memory so that was handy.

This is by no means finished but it draws lines which I have never done before on a TI-99.

One of the reasons that it draws lines is because ~35 years ago the late Dr. C. H. Ting wrote a recursive line algorithm that was published in Forth Dimensions

I have kept a copy of that thing all this time because I thought was so cool. It's not the fastest method but it's pretty compact.

 

I did not write a line of Assembler to get this going, however I did pull in library code that is written in Assembler so there is that.

Like most things Forth it's not the fastest but it's not really slow either.

 

Here is what I have so far.

(with a TRIG table I might be able to draw a death star one day...) 

 

Quote 
\ CONVERT TO GRAPHICS2 MODE CONFIG 14SEP82 LAO
\ converted to Camel99 Forth Dec 2022 BJF 
  
INCLUDE DSK1.TOOLS  
INCLUDE DSK1.VALUES 
INCLUDE DSK1.CHARSET 

HEX 
\ 
\ text mode so we can return to the Forth console 
\ KERNEL version does not init all registers 
\
83D4 CONSTANT VDPR1
CREATE 40COL
\    CNT     0     1     2     3     4     5     6     7
      08 C, 00 C, F0 C, 00 C, 0E C, 01 C, 06 C, 02 C, 17 C, 00 C,

: VREGS  ( addr len -- )
         OVER 1+ C@ VDPR1 C! \ store the R1 value from the table
         0 DO  COUNT I VWTR  LOOP DROP
; 

HEX 
 0000 VALUE CTAB    \ color table
 2000 VALUE PDT     \ pattern descriptor table 

: TEXT  ( -- )
      40COL COUNT VREGS
      800 TO PDT
      380 TO CTAB
      VTOP OFF 
      2 VMODE ! 
      28 C/L!   
      CHARSET    \ restore charset because VDP memory is mangled
      PAGE ;     


\ : SCREEN-OFF  ( -- )  0B0 1 VWTR ;            \ blank the screen  
: CLEAR       ( -- )  PDT  1800  0 VFILL ;    \ ERASE pattern table
: COLOR       ( C --) CTAB 1800  ROT VFILL ;  \ init color table

: INIT-IMAGE ( -- ) -1 1B00 VTOP @ DO  1+ DUP 0FF AND I VC!  LOOP  DROP ;

\ setup code ...
: GRAPHICS2  
    0A0 1 VWTR      \ VR1 >A0 16K, screen on
    1800 VTOP !
    INIT-IMAGE 
 
    F0 COLOR 
    CLEAR 

    20 C/L! 
    300 C/SCR ! 
    2 0 VWTR          \ VR0 >02 Bitmap mode on
    6 2 VWTR          \ Screen image = 6*>400 = 1800

    07F 3 VWTR        \ Color table at >0000
    0 TO CTAB         \ full size table: 3 x >800 bytes
                    
    7 4 VWTR          \ PATTERN table= VR4*>800 = 2000 
    2000 TO PDT 
   
    70 5 VWTR         \ sprite attribute table: VR5*>80  = >3800 
     7 6 VWTR         \ sprite pattern table: VR6 * >800 = >3800 
    0F1 7 VWTR        \ screen background colour white on transparent 
    0E0 DUP VDPR1 C! 1 VWTR   \ set mode, copy into memory for system  
    0 0 AT-XY
    4 VMODE !  
    0 837A C!  ;  \ highest sprite in auto-motion 


\ drawing code ...
HEX
: VOR     ( c Vaddr -- ) DUP>R VC@  OR  R> VC! ;
: VXOR    ( c Vaddr -- ) DUP>R VC@ XOR  R> VC! ;
: VAND    ( c Vaddr -- ) DUP>R VC@ AND  R> VC! ;
: VERASE  ( c Vaddr -- ) SWAP FF XOR SWAP VAND ;

INCLUDE DSK1.ARRAYS 

8 CARRAY BITS 
HERE         \ remember dictionary pointer   

0 BITS DP !  \ set dictionary pointer to start of array 
HEX 80 C, 40 C, 20 C, 10 C, 8 C, 4 C, 2 C, 1 C, 

HERE DP !    \ restore dictionary pointer 

: PIXEL  ( n -- n') S" BITS C@" EVALUATE ; IMMEDIATE 

\ Compute offset into pattern table per: TI Video Display Processors Programmer's Guide
: X-OFF  ( x -- bitmask HorOffset  ) 0 8 UM/MOD ( rem quot) 8* SWAP PIXEL SWAP ; 
: Y-OFF  ( y -- VertOffset)  0 8 UM/MOD ( rem quot) >< + ;  \ swap byte performs >100 *
: PIXPOS ( x y -- bit Index) >R X-OFF  R> Y-OFF + ;
: PLOT   ( x y -- ) PIXPOS PDT +  VOR ;
: UNPLOT ( x y -- ) PIXPOS PDT +  VERASE ;

DECIMAL 

INCLUDE DSK1.3RD4TH   \ fast access to deep stack items 

: 2ROT   ( d1 d2 d3 -- d2 d3 d1) 2>R 2SWAP 2R> 2SWAP ;
: 2OVER  ( d1 d2 -- d1 d2 d1) 4TH 4TH ;

: LINE ( X1 Y1 X2 Y2 -- )
\ ANS version of Dr. Ting's recursive line R.I.P.
    2OVER 2OVER  ROT - ABS >R  - ABS 
    R> MAX 2 <
    IF  2DROP PLOT EXIT THEN
    2OVER 2OVER  ROT + 1+ 2/ >R ( Y3)
    + 1+ 2/ ( X3) R>
    2DUP 2ROT
    RECURSE RECURSE ;

: TRIANGLE 
      0   4  250   4 LINE   
      0   4  225 192 LINE 
    225 191  250   4 LINE 
;
 
: DIAGONALS   
    192 0 DO  I    I PLOT  LOOP 
    192 0 DO  I 2/ I PLOT  LOOP 
    192 0 DO  I 3 / I PLOT LOOP 
    192 0 DO  I 2/ 2/ I PLOT  LOOP 
    192 0 DO  I 5 /   I PLOT LOOP 
    192 0 DO  I 2/ 2/ 2/  I PLOT LOOP 
; 
   
: WAITKEY   BEGIN  KEY? UNTIL ; \ NO CURSOR ALLOWED 

HEX 
30 CONSTANT GREEN 
90 CONSTANT RED 

DECIMAL 
: TEST  
     GRAPHICS2 
     DIAGONALS 1000 MS 
     CLEAR 
     RED COLOR DIAGONALS 1000 MS 
     CLEAR 
     GREEN COLOR TRIANGLE 
  
     WAITKEY 
     TEXT 
;

 

 

  • Like 2
  • Thanks 2
Link to comment
Share on other sites
TheBF River Patroller

+TheBF

Posted
  • Author
Posted
58 minutes ago, GDMike said:

I can read most of this. I'm glad you added the modes.

Is it fast? Compared to the lines program for minimem? It looks about as fast to me.

That's pretty cool that you can read this.

 

That's good to know. I have never seen the minimem version so I don't know. 

The DIAGONALS test is actually cheating because I am just plotting pixels with a DO LOOP.

The LINE code is slower but I could make it ~2x faster with some optimizations I'm sure. 

 

I have some Turtle graphics in Forth lying around here somewhere, so I want to give that a try.

There is a bug with my VDP setup because it only works when I compile after a COLD reset of Forth.

So I need to track that down first. 

  • Like 2
Link to comment
Share on other sites
GDMike Quadrunner

GDMike

Posted
Posted (edited)
12 hours ago, TheBF said:

Hey @GDMike is there somewhere I could find the source code for that demo.

I can't get the code I have to improve by more than 15%. I need to go to CODE words. 

 

 

It's a cassette file Loaded through, (classic 99 has tape load), or TI using mini-memory module debug "L" option, then to run it I just reset, soft, and option 2 run "lines".

I don't know how to get a source list from mini-mem, but I bet Mr. @HomeAutomation  does.

Edited by GDMike
  • Like 1
  • Thanks 2
Link to comment
Share on other sites
TheBF River Patroller

+TheBF

Posted
  • Author
Posted

As usual it's harder to speed this thing up than one might think.

Making judicious use of the Assembler and text macros, I improved the first benchmark by 40%. 

One strange thing was that using JIT optimizer did not help as much as expected in this application.

 

I did something I have never done before. I reach into the kernel to get access to the nameless VDP address setter in the kernel.

(That's how desperate I was) :) 

 

My little tail-call optimizer improves the recursive LINE function by only 1.5% but I'll take it. 

 

This is still only a two colour plotter. I will add writing to the colour table next.

 

Here is the new code and a video of the same test.

Quote 
\ Graphics2 Mode for Camel99 Forth Dec 2022 BJF 
\ Referenced TI-FORTH: ( CONVERT TO GRAPHICS2 MODE CONFIG 14SEP82 LAO)

\ COMPILES under ITC and DTC systems
CR .( Two colour bit map mode )  

NEEDS DUMP      FROM DSK1.TOOLS  
NEEDS MOV,      FROM DSK1.ASM9900 
NEEDS VALUE     FROM DSK1.VALUES 
NEEDS CHARSET   FROM DSK1.CHARSET 
NEEDS ARRAY     FROM DSK1.ARRAYS 
NEEDS 4TH       FROM DSK1.3RD4TH   \ fast access to deep stack items 
NEEDS DEFER     FROM DSK1.DEFER 

HEX 
\ 
\ text mode so we can return to the Forth console 
\ KERNEL version does not init all registers 
\
83D4 CONSTANT VDPR1
CREATE 40COL
\    CNT     0     1     2     3     4     5     6     7
      08 C, 00 C, F0 C, 00 C, 0E C, 01 C, 06 C, 02 C, 17 C, 00 C,

: VREGS  ( addr len -- )
         OVER 1+ C@ VDPR1 C! \ store the R1 value from the table
         0 DO  COUNT I VWTR  LOOP DROP ; 

HEX 
 0000 VALUE CTAB    \ color table
 2000 VALUE PDT     \ pattern descriptor table 
 1800 VALUE IMG

: TEXT  ( -- )
      40COL COUNT VREGS
      800 TO PDT
      380 TO CTAB
      VTOP OFF 
      2 VMODE ! 
      28 C/L!   
      CHARSET    \ restore charset because VDP memory is mangled
      PAGE ;     

: CLEAR   ( -- )  PDT  1800  0 VFILL ; \ ERASE pattern table

: COLOR   ( fg bg --)     
      SWAP 4 LSHIFT SWAP +    \ merge colors into a byte 
      CTAB 1800  ROT VFILL ;  \ init color table

: INIT-IMAGE ( -- ) 
    -1 IMG 300 BOUNDS DO  1+ DUP 0FF AND I VC!  LOOP  DROP ;

\ replacing text macro with code words 
HEX
' VC! 2 CELLS + @ CONSTANT VWMODE  \ Access VDP write address sub-routine
' VC@ 2 CELLS + @ CONSTANT VRMODE  \ Access VDP read address sub-routine 

8800 CONSTANT VDPRD        \ vdp ram read data port 
8C00 CONSTANT VDPWD        \ vdp ram write data port

\ : VOR   ( c Vaddr -- ) DUP>R VC@  OR  R> VC! ;  
CODE VOR ( c Vaddr -- )
        VRMODE @@ BL,    \ set read address 
        W CLR,
        VDPRD @@ W MOVB, \ read screen data to W
        W SWPB, 
        *SP+ W SOC,      \ OR C on stack with screen data 
        W SWPB,
        VWMODE @@ BL,    \ set the address for writing 
        W  VDPWD @@ MOVB, \ write back to screen 
        2 LIMI, 
        TOS POP, 
        NEXT,
ENDCODE            


\ : VAND  ( c Vaddr -- ) S" DUP>R VC@ AND  R> VC!" EVALUATE ; IMMEDIATE 
\ : VERASE  ( c Vaddr -- ) >R INVERT R> VAND ; 

CODE VERASE ( c Vaddr -- )
     \   *SP  INV,       \ Don't need to invert c because of SZC instruction :)
        VRMODE @@ BL,    \ set read address 
        W CLR,
        VDPRD @@ W MOVB, \ read screen data to W
        W SWPB, 
        *SP+ W SZC,      \ AND C on stack with screen data 
        W SWPB,
        VWMODE @@ BL,    \ set the address for writing 
        W  VDPWD @@ MOVB, \ write back to screen 
        2 LIMI, 
        TOS POP, 
        NEXT,
ENDCODE 

\ PENCIL and ERASER are "execution tokens"
' VOR CONSTANT PENCIL
' VERASE CONSTANT ERASER 

DEFER STYLUS   \ usage:  PENCIL IS STYLUS    ERASER IS STYLUS 

\ setup code ...
: GRAPHICS2  
    0000 TO CTAB    \ color table
    1800 TO IMG     \ "name" table (TI nomenclature)
    2000 TO PDT     \ pattern descriptor table 

    0A0 1 VWTR      \ VR1 >A0 16K, screen on
    INIT-IMAGE 
    F 0 COLOR       \ white on transparent 
    CLEAR 
    20 C/L! 300 C/SCR ! 
    2 0 VWTR          \ VR0 >02 Bitmap mode on
    6 2 VWTR          \ Screen image = 6*>400 = 1800
    07F 3 VWTR        \ Color table at >0000
    7 4 VWTR          \ PATTERN table= VR4*>800 = 2000 
    70 5 VWTR         \ sprite attribute table: VR5*>80  = >3800 
     7 6 VWTR         \ sprite pattern table: VR6 * >800 = >3800 
    F1 7 VWTR        \ screen background colour white on transparent 
    0E0 DUP VDPR1 C! 1 VWTR   \ set mode, copy into memory for system  
    4 VMODE !  
    0 837A C!  ;      \ highest sprite in auto-motion 

\ Compute offset into pattern table per: 
\ TI Video Display Processors, Programmer's Guide

CREATE BITS ( -- addr) 80 , 40 , 20 , 10 , 8 , 4 , 2 , 1 , 

\ code words make LINE  10% faster than Forth versions 
CODE  X-OFFSET  ( x -- bit Vaddr) \ 8/MOD 8* 
    TOS  PUSH,      \ DUP X
    TOS  W MOV,     \ copy x to W 
    TOS  3 SRA,     \ divide by 8 
    TOS  3 SLA,     \ mult quot by 8 
    TOS  W SUB,     \ sub-tract result -> w = remainder
    W    1 SLA,     \ W 2* 
    BITS (W) *SP MOV, \ lookup bit value 
    NEXT,
ENDCODE 

CODE Y-OFFSET ( xoffset y -- yoffset) \ 8/MOD >< + 
         TOS PUSH,    
    TOS    3 SRA,     \ divide by 8 
    TOS   R2 MOV,     \ dup quotient result  
    R2     3 SLA,     \ mult quot by 8 
    R2   *SP SUB,     \ sub-tract result = remainder    
         TOS SWPB,    \ 256 * 
    *SP+ TOS ADD,     \ addr remainder to quotient 
    NEXT,
ENDCODE        

: PIXPOS ( x y -- bit Vaddr)  
       >R X-OFFSET            \ compute X offset into VDP memory
       R> Y-OFFSET +          \ compute Y offset + x offset  
       PDT + ;                \ add all offsets to PDT base address  

: PLOT   ( x y -- ) S" PIXPOS STYLUS" EVALUATE ; IMMEDIATE 

DECIMAL 
: 2ROT ( d1 d2 d3 -- d2 d3 d1) S" 2>R 2SWAP 2R> 2SWAP" EVALUATE ; IMMEDIATE
: 4DUP ( d1 d2 -- d1 d2 d1)    S" 4TH 4TH 4TH 4TH" EVALUATE ; IMMEDIATE 

HEX
\ manual tail call optimizer. Improves LINE by 1.5% 
CODE GOTO   C259 ,  ( *IP IP MOV,)  NEXT, ENDCODE
: -;  ( -- ) 
      HERE 2- @ >BODY       \ get previous XT, compute data field
      -2 ALLOT              \ erase the previous XT
      POSTPONE GOTO  ,      \ compile the address for GOTO
      POSTPONE [            \ turn off compiler
      REVEAL
      ?CSP
; IMMEDIATE


\ easier to manage stored coordinates 
0 VALUE X 
0 VALUE Y 

: (X,Y)! ( x y -- ) TO Y   TO X ;

: LINE ( x1 y1 x2 y2 -- )
\ ANS version of Dr. Ting's recursive line R.I.P.
    4DUP  ROT - ABS >R - ABS R> 
    MAX 2 <
    IF  2DROP PLOT  EXIT THEN

    4DUP  ROT + 1+ 2/ >R 
    + 1+ 2/ R>
    2DUP 2ROT 
    RECURSE RECURSE -;

\ no safety net !! 
: HLINE ( x y len ) >R (X,Y)! R>  0 DO  X I +  Y  PLOT  LOOP  ; 
: VLINE ( x y len ) >R (X,Y)! R>  0 DO  Y  X I +  PLOT  LOOP ;

 

 

Link to comment
Share on other sites
TheBF River Patroller

+TheBF

Posted
  • Author
Posted (edited)

So it's only been just over 35 years since I bought my first TI-99 and I finally got around to doing some form of bitmapped graphics. :) 

 

I managed to marry some Turtle graphics code from a Fignition demo onto my bitmapped system.

The key to making it work was to write  a LINETO  function that extends a line from the current x,y to another x,y.  (Not true)

Took me awhile to remember that's what other graphics systems have.

 

The integration between the two code bases is kind of a Kludge at the moment but it helped me find a bug. 

 

Turtle graphics system and DEMO code

Spoiler
Spoiler 
\ FLOGO   CAMEL99 FORTH LOGO to test GRAPHICS2  Mode  Dec 2022 Brian Fox 
( Based on fignition LOGO.  http://bit.ly/figlogo )
\ Expanded names from single letter commands for clarity

NEEDS LINETO   FROM DSK1.GRAPHICS2

\ ===============================================
\ named colors
DECIMAL 
 \ named colors for Graphics programs
: ENUM  ( 0 <text> -- n) DUP CONSTANT  1+ ;

0 ENUM TRANS
  ENUM BLACK
  ENUM MEDGRN
  ENUM LTGRN
  ENUM BLUE
  ENUM LTBLU
  ENUM RED
  ENUM CYAN
  ENUM MEDRED
  ENUM LTRED
  ENUM YELLOW 
  ENUM LTYEL
  ENUM GREEN
  ENUM MAGENTA
  ENUM GRAY
  ENUM WHITE
DROP

: HUE ( fg -- ) 0 COLOR ; 

\ ===============================================
\ screen coordinates
255 CONSTANT XMAX
192 CONSTANT YMAX

XMAX 2/ CONSTANT XCNTR
YMAX 2/ CONSTANT YCNTR

\ state variables
 VARIABLE X      \ turtle x position
 VARIABLE Y      \ turtle y position
 VARIABLE ANGL   \ angle of direction
 VARIABLE Q      \ quadrature?
 VARIABLE W      \ Radian ?

\ ===============================================
\ direction table 
DECIMAL
CREATE SINTAB
  000 , 027 , 053 , 079 ,
  104 , 127 , 150 , 171 ,
  190 , 206 , 221 , 233 ,
  243 , 249 , 254 , 255 ,
  000 ,  ( 9900 needs final byte)

\ expose the table as a byte array. Use text macro for speed
\ : ]N@ ( ndx -- n) S" N + C@" EVALUATE ; IMMEDIATE

\ FAST array with machine Forth compilers
HEX
: 2*,   ( n -- 2(n)  A104 , ;             \ A R4,R4
: []@,   ( addr -- ) C124 , ( addr) , ;   \ MOV addr@(R4),R4
DECIMAL


CODE ]N@ ( ndx -- addr)  2*, SINTAB []@,  NEXT, ENDCODE

: >DIR ( angle -- coord)
       DUP>R  ABS >R
       R@ 15 MOD
       R@ 30 MOD 14 >
       IF 15 SWAP -
       THEN ]N@

       R@ 60 MOD 30 >
       IF NEGATE
       THEN 2R> 2DROP ;

\ =======================================
\ coordinate scaling

HEX 
: BYTE   00FF AND ;

DECIMAL 
: 256*    ( --c) 8 LSHIFT  BYTE ;
: 256/    ( --c) 8 RSHIFT  BYTE ;

\ returns scaled,centred X,Y values
: XSCALE  ( --c) 256/ XCNTR + BYTE ;
: YSCALE  ( --c) 256/ YCNTR + BYTE ;

DECIMAL 
: [X,Y]  ( -- x y) X @ XSCALE Y @ YSCALE ;

\ =======================================
\ plotter control  ( place holders)

: PEN-UP          ['] 2DROP IS STYLUS ; \ noop, consumes args 
: PEN-DOWN           PENCIL IS STYLUS ;

: MOVE-PEN ( x y --) 2DUP Y ! X ! MOVETO ; ( raw plotter x,y position)

\ =======================================
\ FLOGO COMMANDS
: DRAW   ( -- )     PEN-DOWN  [X,Y] PLOT ;

: HEAD   ( angle -- ) DUP DUP ANGL !  >DIR Q !
                      45 + 60 MOD     >DIR W ! ;

: GOTO   ( x y -- )   PEN-UP  256* Y !  256* X ! [X,Y] MOVE-PEN ;
: HOME   ( -- )       PEN-UP   0 0 GOTO  0 HEAD ;
: MOV    ( n -- )     DUP Q @ * X +!   W @ * Y +!  DRAW ;

: TURN   ( angle -- ) ANGL +!  ANGL @ HEAD ;

: FWD  ( n -- )
         1 ?DO
             W @ Y +!
             Q @ X +!
            DRAW 
         LOOP ;

: BGN    ( -- )  CLEAR  HOME PEN-DOWN  ;
: END    ( -- )  PEN-UP  BEEP  BEGIN KEY? UNTIL  TEXT ;
: WAIT   PEN-UP  500 MS  ;

DECIMAL
\ primitives 
: WALK  ( turns moves loops -- )
  0 ?DO  2DUP FWD TURN   LOOP 2DROP PEN-UP ;

: CIRCLE  ( -- ) 1 4 60 WALK ;

\ =======================================
\ DEMO Programs
: SPIRAL  ( -- ) BGN 15 0 DO  CIRCLE  4 TURN  LOOP              WAIT ;

: SINE    ( X -- ) BGN  255  0 DO  I  I >DIR 4 / 80 + PLOT  LOOP  WAIT ;

: SQUARE  ( -- ) BGN 4 0 DO 50 FWD 15 TURN   LOOP               WAIT ;
: BURST   ( -- ) BGN 60 0 DO 0 0 GOTO  I HEAD  110 FWD  LOOP    WAIT ;

: STAR    ( -- ) 24 80 5 WALK ;
: STARS   ( -- ) BGN 3 0 DO   STAR 20 TURN   LOOP               WAIT ;

: SQUIRAL ( -- ) BGN -50 50 GOTO  20 0 DO 100 FWD 21 TURN LOOP  WAIT ;
: ROSE    ( -- ) BGN 0 50 0 DO 2+ DUP FWD  14 TURN  LOOP        WAIT ;

\ primitives for flower 
: HP      ( -- ) 1 5 15 WALK    -1 2 15 WALK ;
: PETAL   ( -- ) HP 30 TURN  HP 30 TURN      ;

: FLOWER  ( -- ) BGN 15 0 DO   PETAL 4 TURN  LOOP               WAIT ;

: DEMO     
  GRAPHICS2 

    WHITE HUE SINE  
    MAGENTA HUE BURST  
    GREEN HUE SQUIRAL  
    BLUE HUE SPIRAL  
    YELLOW HUE STARS  
    RED HUE ROSE  
    LTRED HUE FLOWER  
    16 2 DO  I HUE LOOP 
    RED HUE 
  END ;

 

 

 

 

Here is the latest cut of the GRAPHICS2 code.  By smashing together the x offset computation and the y offset computation and adding them together in one CODE word and writing the VDP OR and VDP erase code in Assembler,  the speed of this system in my simple speed test increased by about 52%. 

It is still not lightning fast. I suspect the recursive LINE code is now the limiting factor but it is still rewarding to see it work. 

 

Spoiler 
\ Graphics2 Mode V2.7 for Camel99 Forth Dec 2022 BJF 
\ Referenced TI-FORTH: ( CONVERT TO GRAPHICS2 MODE CONFIG 14SEP82 LAO)

\ Test results using simple program
\ V2.1  Forth with text macros                    8.33 seconds 
\ 2.7   critical words as CODE and text macros    5.47 (-52%)

\ COMPILES under ITC and DTC systems
CR .( Two colour bit map mode )  

NEEDS DUMP      FROM DSK1.TOOLS  
NEEDS MOV,      FROM DSK1.ASM9900 
NEEDS VALUE     FROM DSK1.VALUES 
NEEDS CHARSET   FROM DSK1.CHARSET 
NEEDS ARRAY     FROM DSK1.ARRAYS 
NEEDS 4TH       FROM DSK1.3RD4TH   \ fast access to deep stack items 
NEEDS DEFER     FROM DSK1.DEFER 

HEX 
\ 
\ text mode so we can return to the Forth console 
\ KERNEL version does not init all registers 
\
83D4 CONSTANT VDPR1
CREATE 40COL
\    CNT     0     1     2     3     4     5     6     7
      08 C, 00 C, F0 C, 00 C, 0E C, 01 C, 06 C, 02 C, 17 C, 00 C,

: VREGS  ( addr len -- )
         OVER 1+ C@ VDPR1 C! \ store the R1 value from the table
         0 DO  COUNT I VWTR  LOOP DROP ; 

HEX 
 0000 VALUE CTAB    \ color table
 2000 VALUE PDT     \ pattern descriptor table 
 1800 VALUE IMG

: TEXT  ( -- )
      40COL COUNT VREGS
      800 TO PDT
      380 TO CTAB
      VTOP OFF 
      2 VMODE ! 
      28 C/L!   
      CHARSET    \ restore charset because VDP memory is mangled
      PAGE ;     

: CLEAR   ( -- )  PDT  1800  0 VFILL ; \ ERASE pattern table

: COLOR   ( fg bg --)     
      SWAP 4 LSHIFT SWAP +    \ merge colors into a byte 
      CTAB 1800  ROT VFILL ;  \ init color table

: INIT-IMAGE ( -- ) 
    -1 IMG 300 BOUNDS DO  1+ DUP 0FF AND I VC!  LOOP  DROP ;

\ replacing text macro with code words 
HEX
' VC! 2 CELLS + @ CONSTANT VWMODE  \ Access VDP write address sub-routine
' VC@ 2 CELLS + @ CONSTANT VRMODE  \ Access VDP read address sub-routine 

8800 CONSTANT VDPRD        \ vdp ram read data port 
8C00 CONSTANT VDPWD        \ vdp ram write data port

\ : VOR   ( c Vaddr -- ) DUP>R VC@  OR  R> VC! ;  
CODE VOR ( c Vaddr -- )
        VRMODE @@ BL,    \ set read address 
        W CLR,
        VDPRD @@ W MOVB, \ read screen data to W
        W SWPB, 
        *SP+ W SOC,      \ OR C on stack with screen data 
        W SWPB,
        VWMODE @@ BL,    \ set the address for writing 
        W  VDPWD @@ MOVB, \ write back to screen 
        2 LIMI, 
        TOS POP, 
        NEXT,
ENDCODE            

\ : VAND  ( c Vaddr -- ) S" DUP>R VC@ AND  R> VC!" EVALUATE ; IMMEDIATE 
\ : VERASE  ( c Vaddr -- ) >R INVERT R> VAND ; 

CODE VERASE ( c Vaddr -- )
     \   *SP  INV,       \ Don't need to invert c because of SZC instruction :)
        VRMODE @@ BL,    \ set read address 
        W CLR,
        VDPRD @@ W MOVB, \ read screen data to W
        W SWPB, 
        *SP+ W SZC,      \ AND C on stack with screen data 
        W SWPB,
        VWMODE @@ BL,    \ set the address for writing 
        W  VDPWD @@ MOVB, \ write back to screen 
        2 LIMI, 
        TOS POP, 
        NEXT,
ENDCODE 

\ PENCIL and ERASER are "execution tokens"
' VOR    CONSTANT PENCIL
' VERASE CONSTANT ERASER 

DEFER STYLUS   \ usage:  PENCIL IS STYLUS    ERASER IS STYLUS 

\ setup code ...
: GRAPHICS2  
    0000 TO CTAB    \ color table
    1800 TO IMG     \ "name" table (TI nomenclature)
    2000 TO PDT     \ pattern descriptor table 

    0A0 1 VWTR      \ VR1 >A0 16K, screen on
    INIT-IMAGE 
    F 0 COLOR       \ white on transparent 
    CLEAR 
    20 C/L! 300 C/SCR ! 
    2 0 VWTR          \ VR0 >02 Bitmap mode on
    6 2 VWTR          \ Screen image = 6*>400 = 1800
    07F 3 VWTR        \ Color table at >0000
    7 4 VWTR          \ PATTERN table= VR4*>800 = 2000 
    70 5 VWTR         \ sprite attribute table: VR5*>80  = >3800 
     7 6 VWTR         \ sprite pattern table: VR6 * >800 = >3800 
    F1 7 VWTR        \ screen background colour white on transparent 
    0E0 DUP VDPR1 C! 1 VWTR   \ set mode, copy into memory for system  
    4 VMODE !  
    0 837A C!  ;      \ highest sprite in auto-motion 


\ Compute offset into pattern table per: 
\ TI Video Display Processors, Programmer's Guide

CREATE BITS ( -- addr) 80 , 40 , 20 , 10 , 8 , 4 , 2 , 1 , 

\ code words make LINE  10% faster than Forth versions 
CODE XY-OFFSET  ( x y -- bit Vaddr) \ 8/MOD 8* 
    TOS R3 MOV,     \ save Y in R3
\ calc X offset
   *SP TOS MOV,     \ DUP X into TOS 
    TOS  W MOV,     \ copy x to W 
    TOS  3 SRA,     \ divide by 8 
    TOS  3 SLA,     \ mult quot by 8 
    TOS  W SUB,     \ sub-tract result -> w = remainder

\ convert remainder to bit mask 
    W    1 SLA,     \ W 2* 
    BITS (W) *SP MOV, \ lookup bit value 

\ SAVE X offset & make room in TOS 
    TOS PUSH,    

    R3  TOS MOV,    \ get Y value to TOS 
    TOS PUSH,       \ DUP Y for subtraction later  
    TOS    3 SRA,   \ divide by 8 
    TOS   R2 MOV,   \ dup quotient result  
    R2     3 SLA,   \ mult quot by 8 
    R2   *SP SUB,   \ sub-tract result = remainder    
         TOS SWPB,  \ TOS 256* 
    *SP+ TOS ADD,   \ add remainder to quotient 
    *SP+ TOS ADD,   \ add X offset to Y offset 
    NEXT,
ENDCODE        

: PIXPOS ( x y -- bit Vaddr)  
       XY-OFFSET         \ compute pixel VDP address
       PDT + ;           \ add offset to PDT base address  

: PLOT   ( x y -- ) S" PIXPOS STYLUS" EVALUATE ; IMMEDIATE 

DECIMAL 
: 2ROT ( d1 d2 d3 -- d2 d3 d1) S" 2>R 2SWAP 2R> 2SWAP" EVALUATE ; IMMEDIATE
: 4DUP ( d1 d2 -- d1 d2 d1)    S" 4TH 4TH 4TH 4TH" EVALUATE ; IMMEDIATE 

HEX
\ manual tail call optimizer. Improves LINE by 1.5% 
CODE GOTO   C259 ,  ( *IP IP MOV,)  NEXT, ENDCODE
: -;  ( -- ) 
      HERE 2- @ >BODY       \ get previous XT, compute data field
      -2 ALLOT              \ erase the previous XT
      POSTPONE GOTO  ,      \ compile the address for GOTO
      POSTPONE [            \ turn off compiler
      REVEAL
      ?CSP
; IMMEDIATE

: LINE ( x1 y1 x2 y2 -- )
\ ANS version of Dr. Ting's recursive line R.I.P.
    4DUP  ROT - ABS >R - ABS R> 
    MAX 2 <
    IF  2DROP PLOT  EXIT THEN
    4DUP  ROT + 1+ 2/ >R 
    + 1+ 2/ R>
    2DUP 2ROT 
    RECURSE RECURSE -;
 
0 VALUE x
0 VALUE y 

: MOVETO ( x y -- ) TO y   TO x ;
: LINETO  ( x y -- ) 2DUP x y LINE MOVETO ;

\ no safety net !! 
: HLINE ( x y len ) >R MOVETO R>  0 DO  x I +  y  PLOT  LOOP  ; 
: VLINE ( x y len ) >R MOVETO R>  0 DO  y  x I +  PLOT  LOOP ;

 

 

 

 

 

Edited by TheBF
Updated text
  • Like 4
  • Thanks 1
Link to comment
Share on other sites
TheBF River Patroller

+TheBF

Posted
  • Author
Posted

After all that work coding assembler to speed this FLOGO demo up I tried an all "vanilla" Forth version of the Graphics2 code and the FLOGO programs, on the DTC version of Camel99 and it runs 2 seconds faster than my "souped-up" version. :) LOL. 

 

I have just discovered also that AshleyF ( GitHub - AshleyF/FIGTurtle: Turtle graphics implantation for the Fignition )

has an improved version of this code that he says ran 15X faster after a Forth friend looked his code over. 

 

I will port it and see what happens. 

 

  • Like 2
Link to comment
Share on other sites
  • 2 weeks later...
TheBF River Patroller

+TheBF

Posted
  • Author
Posted (edited)

I was looking at TI LOGO and I noticed that it had very fast line drawing in turtle graphics.

That was embarrassing so I bit the bullet and re-wrote the pattern table computation in Assembler and have pixel write and pixel erase code in Assembler.

This made a BIG difference in the speed of the FLOGO demo. 

I replaced the DEFER word STYLUS with a simple variable and used PERFORM (fast  @ EXECUTE).  Not as cool but a bit faster. 

 

I also replaced variables in the FLOGO demo with VALUEs which I recently optimized so that speeds things up a bit too. 

 

Spoiler 
\ Graphics2 Mode V2.8 for Camel99 Forth Dec 2022 BJF 
\ Referenced TI-FORTH: 
( CONVERT TO GRAPHICS2 MODE CONFIG 14SEP82 LAO)

\ Test results using simple program
\ V2.1  Forth with text macros   
\ 2.7   critical VOR VERASE and XY-offset as CODE
\ 2.8   PIXPOS re-coded in ASM

\ COMPILES under ITC ONLY
CR .( Two colour bit map mode )  

NEEDS DUMP      FROM DSK1.TOOLS  
NEEDS MOV,      FROM DSK1.ASM9900 
NEEDS VALUE     FROM DSK1.VALUES 
NEEDS CHARSET   FROM DSK1.CHARSET 
NEEDS ARRAY     FROM DSK1.ARRAYS 
NEEDS 4TH       FROM DSK1.3RD4TH   \ fast access to deep stack items 

HEX 
\ 
\ text mode so we can return to the Forth console 
\ KERNEL version does not init all registers 
\
83D4 CONSTANT VDPR1
CREATE 40COL
\    CNT     0     1     2     3     4     5     6     7
      08 C, 00 C, F0 C, 00 C, 0E C, 01 C, 06 C, 02 C, 17 C, 00 C,

: VREGS  ( addr len -- )
         OVER 1+ C@ VDPR1 C! \ store the R1 value from the table
         0 DO  COUNT I VWTR  LOOP DROP ; 

HEX 
 0000 VALUE CTAB    \ color table
 2000 VALUE PDT     \ pattern descriptor table 
 1800 VALUE IMG

: TEXT  ( -- )
      40COL COUNT VREGS
      800 TO PDT
      380 TO CTAB
      VTOP OFF 
      2 VMODE ! 
      28 C/L!   
      CHARSET    \ restore charset because VDP memory is mangled
      PAGE ;     

: CLEAR   ( -- )  PDT  1800  0 VFILL ; \ ERASE pattern table

: COLOR   ( fg bg --)     
      SWAP 4 LSHIFT SWAP +    \ merge colors into a byte 
      CTAB 1800  ROT VFILL ;  \ init color table

: INIT-IMAGE ( -- ) 
    -1 IMG 300 BOUNDS DO  1+ DUP 0FF AND I VC!  LOOP  DROP ;

\ replacing text macro with code words 
HEX
' VC! 2 CELLS + @ CONSTANT VWMODE  \ Access VDP write address sub-routine
' VC@ 2 CELLS + @ CONSTANT VRMODE  \ Access VDP read address sub-routine 

8800 CONSTANT VDPRD        \ vdp ram read data port 
8C00 CONSTANT VDPWD        \ vdp ram write data port

\ : VOR   ( c Vaddr -- ) DUP>R VC@  OR  R> VC! ;  
CODE VOR ( c Vaddr -- )
        VRMODE @@ BL,     \ set read address, disables Interrupts 
        W CLR,
        VDPRD @@ W MOVB,  \ read screen data to W
        W SWPB, 
        *SP+ W SOC,       \ OR C on stack with screen data 
        W SWPB,
        VWMODE @@ BL,     \ set the address for writing 
        W  VDPWD @@ MOVB, \ write back to screen 
        TOS POP, 
        2 LIMI, 
        NEXT,
ENDCODE            


\ : VAND  ( c Vaddr -- ) DUP>R VC@ AND  R> VC! ;
\ : VERASE  ( c Vaddr -- ) >R INVERT R> VAND ; 

CODE VERASE ( c Vaddr -- )
        VRMODE @@ BL,    \ set read address 
        W CLR,
        VDPRD @@ W MOVB, \ read screen data to W
        W SWPB, 
        *SP+ W SZC,      \ AND C on stack with screen data 
        W SWPB,
        VWMODE @@ BL,    \ set the address for writing 
        W  VDPWD @@ MOVB, \ write back to screen 
        2 LIMI, 
        TOS POP, 
        NEXT,
ENDCODE 

\ PENCIL and ERASER are "execution tokens"
' VOR    CONSTANT PENCIL
' VERASE CONSTANT ERASER 

VARIABLE STYLUS   \ usage:  PENCIL STYLUS !   ERASER STYLUS !

\ setup VDP code ...
: GRAPHICS2  
    0000 TO CTAB        \ color table
    1800 TO IMG         \ "name" table (TI nomenclature)
    2000 TO PDT         \ pattern descriptor table 

    0A0 1 VWTR          \ VR1 >A0 16K, screen on
    INIT-IMAGE 
    F 0 COLOR           \ white on transparent 
    CLEAR 
    20 C/L! 300 C/SCR ! 
    2 0 VWTR            \ VR0 >02 Bitmap mode on
    6 2 VWTR            \ Screen image = 6*>400 = 1800
    07F 3 VWTR          \ Color table at >0000
    7 4 VWTR            \ PATTERN table= VR4*>800 = 2000 
    70 5 VWTR           \ sprite attribute table: VR5*>80  = >3800 
     7 6 VWTR           \ sprite pattern table: VR6 * >800 = >3800 
    F1 7 VWTR           \ screen background colour white on transparent 
    0E0 DUP VDPR1 C! 1 VWTR   \ set mode, copy into memory for system  
    4 VMODE !  
    0 837A C!  ;        \ highest sprite in auto-motion 


\ Compute offset into pattern table per: 
\ TI Video Display Processors, Programmer's Guide

CREATE BITS ( -- addr) 80 , 40 , 20 , 10 , 8 , 4 , 2 , 1 , 

\ =============================================
\ PIXPOS Register usage
\ R0  X offset 
\ R1  dup of Y coordinate
\ R2  Temp Y quotient 
\ R3  Y coordinate 
\ R4  Forth Accumulator, outputs PDT address
\ R8  = W = X division remainder 

CODE PIXPOS  ( x y -- bit Vaddr) \ 8/MOD 8* 
\ mask x,y to 8 bit values
    TOS 00FF ANDI, 
    *SP R0 MOV,     \ get X into R0, leave stack position available  
    R0 00FF ANDI, 

\ calc X offset
    R0  W MOV,     \ copy x to W 
    R0  3 SRA,     \ divide by 8 
    R0  3 SLA,     \ mult quot by 8.  R0 = X offset 
    R0  W SUB,     \ sub-tract result -> W = remainder

\ convert remainder to bit mask 
    W    1 SLA,       \ W 2* 
    BITS (W) *SP MOV, \ lookup bit value leave as 2nd on stack 

\ calc Y offset 
    TOS R1  MOV,    \ DUP Y for subtraction later  
    TOS   3 SRA,    \ divide by 8 = Y quotient 
    TOS  R2 MOV,    \ dup quotient result  
    R2    3 SLA,    \ mult quot by 8 
    R2   R1 SUB,    \ sub-tract result = remainder    
        TOS SWPB,   \ Y quotient 256* 

\ compute pattern table address          
    R1   TOS ADD,   \ add remainder to quotient 
    R0   TOS ADD,   \ add X offset to Y offset 
    TOS  PDT AI,    \ add index to pattern table base address 
    NEXT,
ENDCODE        

\ TEXT macro for speed 
: PLOT   ( x y -- ) S" PIXPOS STYLUS PERFORM " EVALUATE ; IMMEDIATE

 

 

FLOGO demo

Spoiler 
\ FLOGO   CAMEL99 FORTH LOGO to test GRAPHICS2  Mode  Dec 2022 Brian Fox 
\ Based on fignition LOGO https://github.com/AshleyF/FIGTurtle
\ Expanded names from single letter commands for clarity

\ MIT License

\ Copyright (c) 2021 Ashley Feniello

\ Permission is hereby granted, free of charge, to any person obtaining a copy
\ of this software and associated documentation files (the "Software"), to deal
\ in the Software without restriction, including without limitation the rights
\ to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
\ copies of the Software, and to permit persons to whom the Software is
\ furnished to do so, subject to the following conditions:

\ The above copyright notice and this permission notice shall be included in all
\ copies or substantial portions of the Software.


NEEDS PLOT  FROM DSK1.GRAPHICS2

\ ===============================================
\ named colors
DECIMAL 
 \ named colors for Graphics programs
: ENUM  ( 0 <text> -- n) DUP CONSTANT  1+ ;

0 ENUM TRANS
  ENUM BLACK
  ENUM MEDGRN
  ENUM LTGRN
  ENUM BLUE
  ENUM LTBLU
  ENUM RED
  ENUM CYAN
  ENUM MEDRED
  ENUM LTRED
  ENUM YELLOW 
  ENUM LTYEL
  ENUM GREEN
  ENUM MAGENTA
  ENUM GRAY
  ENUM WHITE
DROP

: HUE ( fg -- ) 0 COLOR ; 

\ ===============================================
\ screen coordinates
255 CONSTANT XMAX
192 CONSTANT YMAX

XMAX 2/ CONSTANT XCNTR
YMAX 2/ CONSTANT YCNTR

\ values are slightly faster than variables 
 0 VALUE X      \ turtle x position
 0 VALUE Y      \ turtle y position
 0 VALUE ANGL   \ angle of direction
 0 VALUE DX     \ x vector 
 0 VALUE DY     \ y vector 

\ ===============================================
\ direction table 
DECIMAL
CREATE SINTAB
  000 , 027 , 053 , 079 ,
  104 , 127 , 150 , 171 ,
  190 , 206 , 221 , 233 ,
  243 , 249 , 254 , 255 ,
  000 , 

\ expose the table as a byte array. Use text macro for speed
\ : ]N@ ( ndx -- n) S" N + C@" EVALUATE ; IMMEDIATE

\ FAST array with machine Forth compilers
HEX
: 2*,   ( n -- 2(n)  A104 , ;             \ A R4,R4
: []@,   ( addr -- ) C124 , ( addr) , ;   \ MOV addr@(R4),R4
DECIMAL

CODE SIN ( n -- sin(n) )  2*, SINTAB []@,  NEXT, ENDCODE

: >DIR ( angle -- coord)
       DUP>R  ABS >R
       R@ 15 MOD
       R@ 30 MOD 14 > IF 15 SWAP - THEN SIN
       R@ 60 MOD 30 > IF NEGATE    THEN 2R> 2DROP ;

\ =======================================
\ coordinate scaling
\ A little machine code makes a difference 
HEX 
\ : BYTE   00FF AND ;
\ : 256*     ( --c) ><  BYTE ; \ swap byte is 256 * :-) 
\ : 256/    ( --c) 8 RSHIFT  BYTE ;

0244 CONSTANT ANDI  \ ANDI R4,nnnn
CODE 256*   06C4 , NEXT, ENDCODE  \ TOS 3 SLA,
CODE 256/   0984 , NEXT, ENDCODE  \ TOS 3 SRL, 

DECIMAL 
\ returns scaled,centred X,Y values
: XSCALE  ( --c) 256/ XCNTR +  ;
: YSCALE  ( --c) 256/ YCNTR +  ;

DECIMAL 
: [X,Y]  ( -- x y) S" X XSCALE  Y YSCALE" EVALUATE ; IMMEDIATE 

\ =======================================
\ plotter control  
: PEN-UP          ['] 2DROP STYLUS ! ; \ noop, consumes args 
: PEN-DOWN           PENCIL STYLUS ! ;

\ =======================================
\ FLOGO COMMANDS
: DRAW   ( -- )  S" [X,Y] PLOT" EVALUATE ; IMMEDIATE 

: (HEAD)  ( -- ) 
    DUP >DIR TO DX          
    45 + 60 MOD >DIR TO DY ;

: HEAD   ( angle -- )  DUP TO ANGL  (HEAD) ;
: GOTO   ( x y -- )   256* TO Y   256* TO X ;
: HOME   ( -- )       0 0 GOTO  0 HEAD ;
: MOV    ( n -- )     DUP DX * +TO X   DY * +TO Y  DRAW ;

: TURN   ( angle -- ) +TO ANGL  ANGL (HEAD) ;

: FWD  ( n -- )
         1 ?DO
             DY +TO Y
             DX +TO X
            DRAW 
         LOOP ;

: CLS   ( -- )  CLEAR  HOME ;

DECIMAL
\ =======================================
\ DEMO Programs
: CIRCLE  60 0 DO  4 FWD  1 TURN  LOOP ; 
: SPIRAL  ( -- )  15 0 DO  CIRCLE  4 TURN  LOOP ;

: SINE    ( X -- )   255  0 DO  I  I >DIR 2/ 2/  80 + PLOT  LOOP ;

: SQUARE  ( -- )  4 0 DO 50 FWD 15 TURN   LOOP ;
: BURST   ( -- )  60 0 DO 0 0 GOTO  I HEAD  110 FWD  LOOP ;

: STAR     5 0 DO  80 FWD  24 TURN  LOOP ; 
: STARS   ( -- )  3 0 DO   STAR 20 TURN   LOOP ;

: SQUIRAL ( -- )  -50 50 GOTO  20 0 DO 100 FWD 21 TURN LOOP  ;
: ROSE    ( -- )  0 50 0 DO 2+ DUP FWD  14 TURN  LOOP  ;

\ primitives for flower 
: HP  15 0 DO 5 FWD  1 TURN  LOOP  
      15 0 DO 2 FWD -1 TURN  LOOP ; 

: PETAL   ( -- ) HP 30 TURN  HP 30 TURN ;

: FLOWER  ( -- )  15 0 DO   PETAL 4 TURN  LOOP  ;

: DEMO     
  GRAPHICS2 
  PEN-DOWN 
  CLS  WHITE HUE    SINE  
  CLS  MAGENTA HUE  BURST  
  CLS  GREEN HUE    SQUIRAL  
  CLS  BLUE HUE     SPIRAL  
  CLS  YELLOW HUE   STARS  
  CLS  RED HUE      ROSE  
  CLS  LTRED HUE    FLOWER  
  TEXT ;

 

 

 

Edited by TheBF
Wrong comment
  • Like 5
Link to comment
Share on other sites
TheBF River Patroller

+TheBF

Posted
  • Author
Posted (edited)

Looks like I now have comparable writing speed to TI-LOGO ][.

Logo is much faster if you use HIDETURTLE, so the sprite does not need to be updated. 

  

TO CIRCLE  
     REPEAT 24 [ FORWARD 4  RIGHT 15]  
END 

TO SPIRAL 
  HIDETURTLE
  REPEAT 15 [ CIRCLE  RIGHT 60 ]
END

 

Edited by TheBF
Updated code
  • Like 2
Link to comment
Share on other sites
TheBF River Patroller

+TheBF

Posted
  • Author
Posted

I have been toiling on how to create a more accurate VI command interpreter in Forth that is a more like the real thing for VI99 but not complicated.

I think I finally simplified it by using some Forth thinking.  The solution was to make a new KEY word. 

 

The challenge is that each key can be a command , IF and only if,  it is a letter key. 

Numeric keys must be collected and turned into an integer. This makes for a complex state machine when I was thinking about it at first. 

Each time you press a key you need to enter a different state with its own set of cases and in some cases you are collecting numbers as well. 

 

As an example the command  'd' enters a delete state.

If a 'd' follows  (so typing dd) it deletes the entire line.

If a 'w' follows  ( typing dw) it deletes a word.

If a number key follows you need to collect it to make an integer for use later. 

 

So this is a valid set of command keys: 

3dd  ( delete 3 lines)

 

But so is this... !!! 

d3w   

It means delete 3 words 

 

My solution, which is working so far is to make a new KEY word that reads the keyboard and handles numbers in this special way.

This simplified dealing which replicating this functionality over and over each time we needed to deal with commands keys and numbers. 

  

: VIKEY ( -- char ) \ accumulate numbers or return key stroke 
  KEY DUP 0..9? 0= IF END     \ NOT a number key, so just return key value 
  CLRARG ARG$+                \ it was a number so start a new arg string 
  BEGIN 
    KEY DUP 0..9?             \ get next key, test for digit 
  WHILE                       \ while it is a digit 
    ARG$+                     \ append to ARG$ 
  REPEAT ;                    \ end loop and return last key value

 

Here is the support code and number accumulation code  

: END
  POSTPONE EXIT
  POSTPONE THEN ; IMMEDIATE

  

: BETWEEN  1+ WITHIN ;
: 0..9?    ( char -- ?) [CHAR] 0 [CHAR] 9  BETWEEN ;

  

: +PLACE  ( addr n $ -- ) \ append addr,n to counted string $
  2DUP 2>R  COUNT +  SWAP MOVE 2R> C+! ;

  

\ number argument collector uses a counted string to hold digits
DECIMAL 
CREATE ArgBUFF 6 ALLOT    ArgBUFF 6 0 FILL 

: ARG$+   ( char -- ) HERE C!  HERE 1 ArgBUFF +PLACE ; \ append char to buffer 
: CLRARG  ( -- ) 0 ArgBUFF C! ;

: ARG#    ( -- n) \ n always 1 or more 
  ArgBUFF COUNT NUMBER? ( n ?) \ ?=0 means valid conversion
  IF   DROP HONK CLRARG 1  
  ELSE 1 MAX 
  THEN ;

ARG# can then be used to return the integer generated by collecting the numeric keys in VIKEY.

 

So far it seems to work and has allowed the addition of more vi commands to the vi99 editor.

 

  • Like 2
Link to comment
Share on other sites
TheBF River Patroller

+TheBF

Posted
  • Author
Posted

I have read in places over the years that Forth can't do strings. ;) 

 

I just added this command to my vi99 code so that you don't need to use the DSK?. all the time for pulling a directory selecting a file to edit. 

\ append missing path to a filename 
: +PATH ( addr len -- addr' len') \ add disk path if missing from filename 
  2DUP [CHAR] . SCAN NIP 0=       \ scan for '.' char 
  IF                              \ if '.' not found  
     HOME$ COUNT PAD PLACE         \ place the current drive string in PAD 
   ( addr len ) PAD +PLACE        \ append the given string argument 
    PAD COUNT                     \ return the full path as stack string pair
  THEN                                 
;

 

HOME$ holds the drive that vi99 was booted from. 

You change the default drive now with what else? The cd command  

: cd     PARSE-NAME ?DOT TOUPPER  HOME$ PLACE ;

 

  • Like 3
Link to comment
Share on other sites
TheBF River Patroller

+TheBF

Posted
  • Author
Posted

One the challenges with the VI99 editor is that the text strings exist as end-to-end byte-count strings in the low 8K RAM.

This is an efficient way to hold the file data but how do you make a clipboard that is just as space efficient?

 

The clipboard can be thought of like a stack of strings.

Normally I would make the string stack out of fixed sized chunks, in this case 80 bytes long, to hold a full line of text from the string.

But if we do that we can store a maximum of  112 lines in the clipboard. The counted strings in low RAM can easily be over 200 lines of typical code. 

 

This solution divides the functions into two parts:

  1. Place counted strings at VDP >1000 that grow upwards ( I think I can steal more VDP RAM and start at VDP >0C00) 
  2. Make a stack of pointers in high VDP RAM that grows downwards and keeps track of each string added or removed 
\ VDP Memory Usage in Camel99 Forth when this file is loaded
\ |  VDP screen   |  VDP >0000 >078F (80 column mode)
\ + --------------|
\ |   RESERVED    |    sprites, patterns color tables
\ |---------------|
\ |  >460..7FF    |  *FREE 928 bytes in TEXT mode only*
\ |---------------|
\ |  >800..       |  *Pattern descriptor table*
\ +---------------+  HEX 1000, VDP HEAP start
\ |compact strings|  moves upwards
\ |     8K        |
\ |      .        |
\ |      .        |
\ |      .        |
\ |      .        |
\ |      .        |
\ |      .        |
\ |      .        |
\ | ^^^^^^^^^^^   |
\ | pointer stack |
\ |---------------| 
\ |   ^^^^^^^     |  move downwards
\ |  PAB stack    |  PABs start here
\ +---------------+ <-- VDPTOP returns this address
\ | 99 O/S space  |
\ |---------------| VDP >3FFF

 

It's a little more complicated this way, but it gives me a full 8K of VDP memory for compact strings that can also be accessed like a stack of strings. 

It might even work! :)

 

Uses this simple VDP memory manager (VDPMEM) 

Spoiler 
\ VARIABLE VP    ( moved to kernel for V2.55 )

HEX 1000 VP !   \ "VDP pointer" start of free VDP RAM
: VHERE   ( -- addr) VP @ ;   \ FETCH the value in VDP pointer
: VALLOT  ( n -- )   VP +! ;  \ add n to the value in VDP pointer
: VC,     ( n -- )   VHERE VC!  1 VALLOT ;
: V,      ( n -- )   VHERE V!   2 VALLOT ;
: VCOUNT  ( vdp$adr -- vdpadr len ) DUP 1+ SWAP VC@ ;
: VCREATE ( <text> -- ) VHERE CONSTANT  ; \ address when <text> invoked

 

 

Here is the string stack code. Comments and suggestions are welcome.

 

Spoiler 
\ vdp-string-stack.fth       2023  Brian Fox 
\ Problem: create a stack structure of end-to-end counted strings

\ This system creates a stack of pointers in high VDP RAM growing down.
\ The stack pointers point to byte-counted strings that grow upwards in VDP RAM. 

\ NEEDS DUMP  FROM DSK1.TOOLS 
NEEDS VHERE FROM DSK1.VDPMEM 

HEX 
VDPTOP 390 - CONSTANT VSTACK    \ vdp integer stack base address 
VARIABLE VSP                    \ Stack pointer for VDP stack  

\ integer stack in VDP RAM
: ?VSTACK   VSP @ VSTACK > ABORT" VDP stack underflow" ;
: >VSTK  ( n -- ) -2 VSP +!   VSP @ V! ;
: VSTK@  ( -- n)  VSP @  V@ ;
: VSTK>  ( -- n)  VSTK@  2 VSP +! ?VSTACK ;

\ compile CPU string into VDP memory, return the address 
: V$,   ( addr len -- Vaddr) VHERE DUP>R  OVER 1+ VALLOT  VPLACE  R> ;

: V$@ ( Vaddr len addr -- )  2DUP C! 1+ SWAP VREAD ;

\ -----------------------------------------------------------------
\ API 
: V$PUSH ( addr len ) V$, >VSTK ;

: V$POP  ( --  addr len ) 
    VSTK> VCOUNT PAD V$@        \ read the string to PAD 
    PAD COUNT                   \ convert to addr,len 
    DUP 1+ NEGATE VALLOT  ;     \ de-allocated the string & count byte from VDP memory 

HEX 
: INIT-VSTACK   VSTACK VSP !   1000 VP ! ;

INIT-VSTACK

 

 

  • Like 3
Link to comment
Share on other sites
TheBF River Patroller

+TheBF

Posted
  • Author
Posted

VDP String Stack Update:

 

It worked as designed and didn't seem any slower than what I had before.

However with all that cutting an pasting I found an error in my CPU memory allocating/deallocating when I cut and paste a string on the editor side.

Two steps forward, one step back. :)

 

Link to comment
Share on other sites
TheBF River Patroller

+TheBF

Posted
  • Author
Posted (edited)

Could resist working on the FLOGO demonstration armed with the new code @Asmusr provided from the E/A manual.

 

I also wrote a code word to pull the X and Y values and scale them in Assembler. 

Very nice speedup with those changes. 

 

Question:

 

Is there a faster way to get  X 8 MOD in Assembler than this? 

\ compute R0 8 MOD  
    R0  W MOV,     \ copy x to W 
    R0  3 SRA,     \ divide by 8 
    R0  3 SLA,     \ mult quot by 8.  R0 = X offset 
    R0  W SUB,     \ sub-tract result -> W = remainder

 

Inquiring minds want to know. :)

 

 

 

GRAPHICS2 alpha version 

Spoiler 
\ Graphics2 Mode V2.8 for Camel99 Forth Dec 2022 BJF 
\ Referenced TI-FORTH: 
( CONVERT TO GRAPHICS2 MODE CONFIG 14SEP82 LAO)

\ Test results using simple program
\ V2.1  Forth with text macros   
\ 2.7   critical VOR VERASE and XY-offset as CODE
\ 2.8   PIXPOS re-coded in ASM
\ 2.9   PIXPOS Re-coded with less instructions

\ COMPILES under ITC ONLY
CR .( Two colour bit map mode )  

NEEDS DUMP      FROM DSK1.TOOLS  
NEEDS MOV,      FROM DSK1.ASM9900 
NEEDS VALUE     FROM DSK1.VALUES 
NEEDS CHARSET   FROM DSK1.CHARSET 
NEEDS ARRAY     FROM DSK1.ARRAYS 
NEEDS 4TH       FROM DSK1.3RD4TH \ fast access to deep stack items 

HEX 
\ 
\ text mode so we can return to the Forth console 
\ KERNEL version does not init all registers 
\
83D4 CONSTANT VDPR1
CREATE 40COL
\    CNT     0     1     2     3     4     5     6     7
      08 C, 00 C, F0 C, 00 C, 0E C, 01 C, 06 C, 02 C, 17 C, 00 C,

: VREGS  ( addr len -- )
         OVER 1+ C@ VDPR1 C! \ store the R1 value from the table
         0 DO  COUNT I VWTR  LOOP DROP ; 

HEX 
 0000 VALUE CTAB    \ color table
 2000 VALUE PDT     \ pattern descriptor table 
 1800 VALUE IMG

: TEXT  ( -- )
      40COL COUNT VREGS
      800 TO PDT
      380 TO CTAB
      VTOP OFF 
      2 VMODE ! 
      28 C/L!   
      CHARSET    \ restore charset because VDP memory is mangled
      PAGE ;     

: CLEAR   ( -- )  PDT  1800  0 VFILL ; \ ERASE pattern table

: COLOR   ( fg bg --)     
      SWAP 4 LSHIFT SWAP +    \ merge colors into a byte 
      CTAB 1800  ROT VFILL ;  \ init color table

: INIT-IMAGE ( -- ) 
    -1 IMG 300 BOUNDS DO  1+ DUP 0FF AND I VC!  LOOP  DROP ;

\ replacing text macro with code words 
HEX
' VC! 2 CELLS + @ CONSTANT VWMODE  \ Access VDP write address sub-routine
' VC@ 2 CELLS + @ CONSTANT VRMODE  \ Access VDP read address sub-routine 

8800 CONSTANT VDPRD        \ vdp ram read data port 
8C00 CONSTANT VDPWD        \ vdp ram write data port

\ : VOR   ( c Vaddr -- ) DUP>R VC@  OR  R> VC! ;  
CODE VOR ( c Vaddr -- )
        VRMODE @@ BL,     \ set read address, disables Interrupts 
        W CLR,
        VDPRD @@ W MOVB,  \ read screen data to W
        W SWPB, 
        *SP+ W SOC,       \ OR C on stack with screen data 
        W SWPB,
        VWMODE @@ BL,     \ set the address for writing 
        W  VDPWD @@ MOVB, \ write back to screen 
        TOS POP, 
        2 LIMI, 
        NEXT,
ENDCODE            


\ : VAND  ( c Vaddr -- ) S" DUP>R VC@ AND  R> VC!" EVALUATE ; IMMEDIATE 
\ : VERASE  ( c Vaddr -- ) >R INVERT R> VAND ; 

CODE VERASE ( c Vaddr -- )
        VRMODE @@ BL,    \ set read address 
        W CLR,
        VDPRD @@ W MOVB, \ read screen data to W
        W SWPB, 
        *SP+ W SZC,      \ AND C on stack with screen data 
        W SWPB,
        VWMODE @@ BL,    \ set the address for writing 
        W  VDPWD @@ MOVB, \ write back to screen 
        2 LIMI, 
        TOS POP, 
        NEXT,
ENDCODE 

\ PENCIL and ERASER are "execution tokens"
' VOR    CONSTANT PENCIL
' VERASE CONSTANT ERASER 

VARIABLE STYLUS   \ usage:  PENCIL STYLUS !   ERASER STYLUS !

\ setup VDP code ...
: GRAPHICS2  
    0000 TO CTAB        \ color table
    1800 TO IMG         \ "name" table (TI nomenclature)
    2000 TO PDT         \ pattern descriptor table 

    0A0 1 VWTR          \ VR1 >A0 16K, screen on
    INIT-IMAGE 
    F 0 COLOR           \ white on transparent 
    CLEAR 
    20 C/L! 300 C/SCR ! 
    2 0 VWTR            \ VR0 >02 Bitmap mode on
    6 2 VWTR            \ Screen image = 6*>400 = 1800
    07F 3 VWTR          \ Color table at >0000
    7 4 VWTR            \ PATTERN table= VR4*>800 = 2000 
    70 5 VWTR           \ sprite attribute table: VR5*>80  = >3800 
     7 6 VWTR           \ sprite pattern table: VR6 * >800 = >3800 
    F1 7 VWTR           \ screen background colour white on transparent 
    0E0 DUP VDPR1 C! 1 VWTR   \ set mode, copy into memory for system  
    4 VMODE !  
    0 837A C!  ;        \ highest sprite in auto-motion 


\ Compute offset into pattern table per: 
\ TI Video Display Processors, Programmer's Guide

CREATE BITS ( -- addr) 80 , 40 , 20 , 10 , 8 , 4 , 2 , 1 , 

\ =======================================================
\ First section courtesy @ASMUSR via E/A manual page 336
CODE PIXPOS  ( x y -- bit Vaddr) \ 8/MOD 8* 
   *SP R0 MOV,    \ X TO R0 
    R4  R1 MOV,    
    R4  5  SLA,    
    R1  R4 SOC,    
    R4 FF07 ANDI,  

    R0  W MOV,    
    W   7 ANDI,   
    NOP, 
    R0  R4 ADD,    
    W   R4 SUB,    
    R4  PDT AI,   \ add index to VDP PDT base address 

\ convert remainder to bit mask 
    R0  W MOV,     \ copy x to W 
    R0  3 SRA,     \ divide by 8 
    R0  3 SLA,     \ mult quot by 8.  R0 = X offset 
    R0  W SUB,     \ sub-tract result -> W = remainder
    W    1 SLA,       \ W 2* 
    BITS (W) *SP MOV, \ lookup bit value leave as 2nd on stack 

    NEXT,
ENDCODE        

\ TEXT macro for speed 
: PLOT   ( x y -- ) S" PIXPOS STYLUS PERFORM " EVALUATE ; IMMEDIATE

 

 

FLOGO Demo with hand coded [X,Y] 

Spoiler 
\ FLOGO   CAMEL99 FORTH LOGO to test GRAPHICS2  Mode  Dec 2022 Brian Fox 
\ Based on fignition LOGO https://github.com/AshleyF/FIGTurtle
\ Expanded names from single letter commands for clarity

\ MIT License

\ Copyright (c) 2021 Ashley Feniello

\ Permission is hereby granted, free of charge, to any person obtaining a copy
\ of this software and associated documentation files (the "Software"), to deal
\ in the Software without restriction, including without limitation the rights
\ to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
\ copies of the Software, and to permit persons to whom the Software is
\ furnished to do so, subject to the following conditions:

\ The above copyright notice and this permission notice shall be included in all
\ copies or substantial portions of the Software.

\ Jan 2023 Handed code [X,Y] coordinate word gave big speed-up 


NEEDS PLOT  FROM DSK1.GRAPHICS2

\ ===============================================
\ named colors
DECIMAL 
 \ named colors for Graphics programs
: ENUM  ( 0 <text> -- n) DUP CONSTANT  1+ ;

0 ENUM TRANS
  ENUM BLACK
  ENUM MEDGRN
  ENUM LTGRN
  ENUM BLUE
  ENUM LTBLU
  ENUM RED
  ENUM CYAN
  ENUM MEDRED
  ENUM LTRED
  ENUM YELLOW 
  ENUM LTYEL
  ENUM GREEN
  ENUM MAGENTA
  ENUM GRAY
  ENUM WHITE
DROP

: HUE ( fg -- ) 0 COLOR ; 

\ ===============================================
\ screen coordinates
255 CONSTANT XMAX
192 CONSTANT YMAX

XMAX 2/ CONSTANT XCNTR
YMAX 2/ CONSTANT YCNTR

\ values are slightly faster than variables 
 0 VALUE X      \ turtle x position
 0 VALUE Y      \ turtle y position
 0 VALUE ANGL   \ angle of direction
 0 VALUE DX     \ x vector 
 0 VALUE DY     \ y vector 

\ ===============================================
\ direction table 
DECIMAL
CREATE SINTAB
  000 , 027 , 053 , 079 ,
  104 , 127 , 150 , 171 ,
  190 , 206 , 221 , 233 ,
  243 , 249 , 254 , 255 ,
  000 , 

\ expose the table as a byte array. Use text macro for speed
\ : ]N@ ( ndx -- n) S" N + C@" EVALUATE ; IMMEDIATE

\ FAST array with machine Forth compilers
HEX
: 2*,   ( n -- 2(n)  A104 , ;             \ A R4,R4
: []@,   ( addr -- ) C124 , ( addr) , ;   \ MOV addr@(R4),R4
DECIMAL

CODE SIN ( ndx -- addr)  2*, SINTAB []@,  NEXT, ENDCODE

: >DIR ( angle -- coord)
       DUP>R  ABS >R
       R@ 15 MOD
       R@ 30 MOD 14 > IF 15 SWAP - THEN SIN
       R@ 60 MOD 30 > IF NEGATE    THEN 2R> 2DROP ;

\ =======================================
\ coordinate scaling
\ A little machine code makes a difference 
HEX 
\ Old Forth version 
\ : BYTE   00FF AND ;
\ : 256/    ( --c) 8 RSHIFT  BYTE ;
\ returns scaled,centred X,Y values
\ : XSCALE  ( c -- c) 256/ XCNTR + BYTE ;
\ : YSCALE  ( c -- c) 256/ YCNTR + BYTE ;

\ : [X,Y]  ( -- x y) S" X XSCALE   Y YSCALE" EVALUATE ; IMMEDIATE 
 CODE [X,Y] ( -- x y) \ return coordinates scaled for 255x192
    TOS PUSH, 
  ' Y >BODY @@ TOS MOV, 
    TOS SWPB, 
    TOS YCNTR AI,  \ add centering offset 
    TOS 0FF ANDI,  \ mask to byte value 

  ' X >BODY @@ W MOV, 
    W SWPB, 
    W XCNTR AI,  \ add centering offset 
    W 0FF ANDI,  \ mask to byte value  
    W PUSH,
    NEXT, 
 ENDCODE 

      
DECIMAL 
\ =======================================
\ plotter control  
: PEN-UP          ['] 2DROP STYLUS ! ; \ noop, consumes args 
: PEN-DOWN           PENCIL STYLUS ! ;

\ =======================================
\ FLOGO COMMANDS
: DRAW   ( -- )  S" [X,Y] PLOT" EVALUATE ; IMMEDIATE 

: (HEAD)  ( -- ) 
    DUP >DIR TO DX          
    45 + 60 MOD >DIR TO DY ;

: HEAD   ( angle -- )  DUP TO ANGL  (HEAD) ;
: GOTO   ( x y -- )   8* TO Y   8* TO X ;
: HOME   ( -- )       0 0 GOTO  0 HEAD ;
: MOV    ( n -- )     DUP DX * +TO X   DY * +TO Y  DRAW ;

: TURN   ( angle -- ) +TO ANGL  ANGL (HEAD) ;

: FWD  ( n -- )
         1 ?DO
             DY +TO Y
             DX +TO X
            DRAW 
         LOOP ;

: CLS   ( -- )  CLEAR  HOME ;

DECIMAL
\ =======================================
\ DEMO Programs
: CIRCLE  60 0 DO  4 FWD  1 TURN  LOOP ; 
: SPIRAL  ( -- )  15 0 DO  CIRCLE  4 TURN  LOOP ;

: SINE    ( X -- )   255  0 DO  I  I >DIR 2/ 2/  80 + PLOT  LOOP ;

: SQUARE  ( -- )  4 0 DO 50 FWD 15 TURN   LOOP ;
: BURST   ( -- )  60 0 DO 0 0 GOTO  I HEAD  110 FWD  LOOP ;

: STAR     5 0 DO  80 FWD  24 TURN  LOOP ; 
: STARS   ( -- )  3 0 DO   STAR 20 TURN   LOOP ;

: SQUIRAL ( -- )  -50 50 GOTO  20 0 DO 100 FWD 21 TURN LOOP  ;
: ROSE    ( -- )  0 50 0 DO 2+ DUP FWD  14 TURN  LOOP  ;

\ primitives for flower 
: HP  15 0 DO 5 FWD  1 TURN  LOOP  
      15 0 DO 2 FWD -1 TURN  LOOP ; 

: PETAL   ( -- ) HP 30 TURN  HP 30 TURN ;

: FLOWER  ( -- )  15 0 DO   PETAL 4 TURN  LOOP  ;

: DEMO     
  GRAPHICS2 
  PEN-DOWN 
  CLS  WHITE HUE    SINE  
  CLS  MAGENTA HUE  BURST  
  CLS  GREEN HUE    SQUIRAL  
  CLS  BLUE HUE     SPIRAL  
  CLS  YELLOW HUE   STARS  
  CLS  RED HUE      ROSE  
  CLS  LTRED HUE    FLOWER  
  TEXT ;

 

 

Edited by TheBF
Wrong comment
  • Thanks 1
Link to comment
Share on other sites
TheBF River Patroller

+TheBF

Posted
  • Author
Posted
1 hour ago, TheBF said:

Question:

 

Is there a faster way to get  X 8 MOD in Assembler than this? 

\ compute R0 8 MOD  
    R0  W MOV,     \ copy x to W 
    R0  3 SRA,     \ divide by 8 
    R0  3 SLA,     \ mult quot by 8.  R0 = X offset 
    R0  W SUB,     \ sub-tract result -> W = remainder

 

Inquiring minds want to know. :)

 

 

DUH! 

 I think it's just  X  8 MOD   is the same as  7 AND. 

OK That will remove 3 more instructions. 

  • Like 1
Link to comment
Share on other sites
TheBF River Patroller

+TheBF

Posted
  • Author
Posted (edited)

Ok things got smaller really fast once I understood that.

I was already doing what I needed in the E/A manual code. 

 

So this code  

CODE PIXPOS  ( x y -- bit Vaddr) 
   *SP R0 MOV,    \ X TO R0 
    R4  R1 MOV,    
    R4  5  SLA,    
    R1  R4 SOC,    
    R4 FF07 ANDI,  

    R0  W MOV,    
    W   7 ANDI,   
    NOP, 
    R0  R4 ADD,    
    W   R4 SUB,    
    R4  PDT AI,   \ add index to VDP PDT base address 

\ convert remainder to bit mask 
    R0  W MOV,     \ copy x to W 
    R0  3 SRA,     \ divide by 8 
    R0  3 SLA,     \ mult quot by 8.  R0 = X offset 
    R0  W SUB,     \ sub-tract result -> W = remainder
    W    1 SLA,       \ W 2* 
    BITS (W) *SP MOV, \ lookup bit value leave as 2nd on stack 

    NEXT,
ENDCODE

 

Became 

CODE PIXPOS  ( x y -- bit Vaddr) \ 8/MOD 8* 
    R4  R1 MOV,    
    R4  5  SLA,    
    R1  R4 SOC,    
    R4 FF07 ANDI,  
   *SP  W MOV,        \ dup X  
    W   7 ANDI,       \ X 8 MOD -> W
   *SP  R4 ADD,    
    W   R4 SUB,    
    R4  PDT AI,       \ add index to VDP PDT base address 
    
\ convert remainder to bit mask 
    W    1 SLA,       \ W 2* 
    BITS (W) *SP MOV, \ lookup bit value leave as 2nd on stack 

    NEXT,
ENDCODE

 

I am slowly learning the rule of "don't move memory to a register unless you will use it a lot.

Pulling *SP twice is not a crime and indirect addressing costs 3X less than one MOV. 

 

 

 

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

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

×   Your previous content has been restored.   Clear editor

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

Loading...
×
 Share
Go to topic listing

  • Recently Browsing   0 members

    • No registered users viewing this page.
AtariAge
Forums
Store
General
Follow AtariAge

Copyright ©1998-2023 AtariAge

×
×
  • Create New...