Camel99 Forth Information goes here

[+TheBF]

Well this is fun.  We can extend the range down more than an octave using the bass trick with the noise generator driven by channel 3. 

 

\    ==================[ BASS VOICE ]==================
\ Bass voice uses the TENOR oscillator and the noise channel
\ It also has a lower volume so you have to reduce volume of
\ the other channels if used in combination 

: PLAY.BASS  ( fcode -- )
        OSC3 OR  SPLIT  SND! SND!  \ send frequency data on channel 3
            31 ATT3 OR  SND!       \ but chan 3 is silent 

           -5 OSC4 OR SND!          \ select noise channel for output 
     VOLUME @ ATT4 OR SND!          \ send volume 
                                    \ BASS Note is now playing...    

            ON_TIME  @ DELAY   \ set the ISR timer, which auto mutes   
            OFF_TIME @ DELAY   \ time between notes 
;

DECIMAL 
: BASS: ( freq -- )
    CREATE  15 * HZ>CODE ,  \ calibrate freq. & pre-calculate the code 
    DOES> @ PLAY.BASS ;
        
\ FREQ  NATURAL    FREQ  ACCIDENTAL    EN-HARMONIC
    41 BASS: E1 \ Lowest note of Bass guitar 
    44 BASS: F1    46 BASS: F#1         : Gb0  F#1 ;
    49 BASS: G1	   52 BASS: G#1         : Ab   G#1 ;
    55 BASS: A1	   58 BASS: A#1         : Bb   A#1 ;	
    62 BASS: B1 	 	 	 	 
    65 BASS: C2	   69 BASS: C#2         : Db1  C#2 ;	 
    73 BASS: D2    78 BASS: D#2         : Eb1  D#2 ;	 
    82 BASS: E2 \ Lowest Note of Guitar
    87 BASS: F2	   93 BASS: F#2         : Gb1  F#2 ;	 
    98 BASS: G2	  104 BASS: G#2         : Ab1  G#2 ; 

 

[+TheBF]

I have had too many interruptions to my coding time over the last while so the most I can do is cleanup.

The conductor of of the community orchestra I joined decided it would great for us to play the Telemann concerto for two Violas. I started playing the darned thing only a year ago!

This old guy needed to do a lot of practicing. 

Also, the homeschool coop is doing a play version of the Greatest Showman and my daughter, who I can't refuse, ask me to be in the band.  

 

Anyway during my cleanup time I reviewed my rendition of @Reciprocating Bill 's  Asm sieve converted to ASMForth.

If we re-name registers, they look like variables in Forth code.

This code gets much more readable IMHO. 

 

This model of "machine Forth" fits much better with 9900 than Chuck Moore's machine Forth for the same reason Chuck's machine Forth

was mostly one to one with his instruction set. ASMForth is mostly one to  one with 9900 except for loops, sub-routines and whatever high level Forth words you wish to create.

 

 

Spoiler

\ SIEVE in ASMFORTH V.81 for Camel99 Forth    Aug 2023 Brian Fox
\ based on code by @Reciprocating Bill atariage.com 

\ Minor mods for Version 0.8 

\ Original notes by BIll.
\ * SIEVE OF ERATOSTHENES ------------------------------------------
\ * WSM 4/2022
\ * TMS9900 assembly adapted from BYTE magazine 9/81 and 1/83 issues
\ * 10 iterations 6.4 seconds on 16-bit console
\ * ~10 seconds on stock console

\ * ASMForth II version runs in 9.5 seconds 
HOST 
NEEDS ELAPSE FROM DSK1.ELAPSE  \ for timing 

ASMFORTH  

DECIMAL 8190 CONSTANT SIZE
HEX     2000 CONSTANT FLAGS   \ array in Low RAM 

\ ** note: FILLW is an ASMFORTH colon definition. 
\ It is a native code subroutine that CANNOT be invoked by Forth,
\ only by another ASMFORTH colon word or by a CODE word. 

: FILLW ( addr size U --)  
                   \ u is in the top of stack cache register (TOS)
    NOS^ R0 !      \ POP "next on stack" into R0 (size) (MOV *SP+,RO)
    NOS^ R1 !      \ POP address into R1
    R0 FOR         \ FOR takes the R0 argument into loop index register
       TOS *R1+ !  \ write U to addr, bump addr by 2
    NEXT2          \ *NEW* counts down by 2 
    DROP           \ drop U which refills the TOS register
;                 

\ make register "variables" for code clarity 
R0 CONSTANT #0   \ numerical zero 
R1 CONSTANT X    \ temp register variable 
R2 CONSTANT K    \ inner loop register variable 
R3 CONSTANT i    \ outer LOOP index
R5 CONSTANT MEM  \ array base address 

\ (K) is defined in the HOST Forth namespace so it's a normal Forth word.
HOST  
: (K)   (R2) ;  \ use register K as indexed addresser 

ASMFORTH 
\ we use CODE here because it makes a word that can be called 
\ from Forth by name. ie: a regular "code" word.
CODE DO-PRIME ( -- n)  
  FLAGS # SIZE # 0101 # FILLW

\ inits 
  R0 OFF               \ 0 constant held in Register 0 
  i  OFF               \ clear I register
  FLAGS MEM #!         \ array base address 
  
  0 #                  \ prime # counter on Forth stack (ie: in R4)

  SIZE #FOR            \ load a constant directly to R8 loop counter 
    MEM @+ #0 CMPB     \ FLAGS byte-compared to 0, auto inc MEM
    <> IF              \ not equal to zero ? 
      i X !            \ I -> x
      X 2*  
      3 X #+!          \ this is the AI (Add immediate) instruction
      i K !            \ MOV R3,R2 
      X K +            \ A   R1,R2  
      BEGIN  
        K SIZE #CMP    \ K SIZE compare ie: CI instruction
      < WHILE  
        #0 FLAGS (K) C! \ reset byte FLAGS(R2)
        X K +          \ PRIME K +! 
      REPEAT 
      TOS 1+           \ increment count of primes
    THEN 
    i 1+               \ bump LOOP index register
  NEXT 
;CODE

HOST   ( Switch back to Host Forth )
DECIMAL 
: PRIMES ( -- )
  PAGE ."  10 Iterations"
  10 0 
  DO   
    DO-PRIME  CR . ." primes"  
  LOOP
  CR ." Done!"
;

 

 

And here is the resulting code from Classic99 Dissassembler with some comments 

Spoiler

FILLW 
   DFAE  0647  dect R7       ( enter sub-routine) 
   DFB0  C5CB  mov  R11,*R7 
   
   DFB2  C036  mov  *R6+,R0 ( data to fill)
   DFB4  C076  mov  *R6+,R1 ( set start address) 
   
   DFB6  0647  dect R7           ( start FOR loop) 
   DFB8  C5C8  mov  R8,*R7
   DFBA  C200  mov  R0,R8
   
   DFBC  CC44  mov  R4,*R1+      ( fill memory cell) 
   
   DFBE  0648  dect R8           ( NEXT ) 
   DFC0  18FD  joc  >dfbc

   DFC2  C237  mov  *R7+,R8      ( pop previous loop index from return stack)         
   DFC4  C136  mov  *R6+,R4      ( DROP)             
   
   DFC6  C2F7  mov  *R7+,R11     ( return from sub-routine)         
   DFC8  045B  b    *R11      

DO-PRIME 
   E036  04C0  clr  R0 
   E038  04C3  clr  R3 
   E03A  0205  li   R5,>2000
   
   E03E  0646  dect R6             ( push literal # onto data stack) 
   E040  C584  mov  R4,*R6
   E042  0204  li   R4,>0000 
   
   E046  0647  dect R7              ( Start FOR loop )
   E048  C5C8  mov  R8,*R7      
   E04A  0208  li   R8,>1ffe 

   E04E  9035  cb   *R5+,R0 
   E050  130E  jeq  >e06e 
   E052  C043  mov  R3,R1 
   E054  0A11  sla  R1,1   
   E056  0221  ai   R1,>0003  
   E05A  C083  mov  R3,R2  
>  E05C  A081  a    R1,R2                 
   E05E  0282  ci   R2,>1ffe              
   E062  1504  jgt  >e06c                 
   E064  D880  movb R0,@>2000(R2)         
   E068  A081  a    R1,R2                 
   E06A  10F9  jmp  >e05e                 
   E06C  0584  inc  R4                    
   E06E  0583  inc  R3  
   
   E070  0608  dec  R8              ( NEXT )
   E072  18ED  joc  >e04e                 
   E074  C237  mov  *R7+,R8        ( pop previous loop index from return stack)
   
   E076  045A  b    *R10           ( return to Forth) 
 

 

 

Edited May 7 by TheBF
fixed comment

[+TheBF]

A while back I went chasing the goal of making my VDP driver faster. 

I made it faster at the expense of about 100 extra bytes from what I can see. 

I have decided 100 bytes could be used for better things. 

 

I simplified my scroll code by a few bytes. It is about 50 bytes to scroll the screen in chunks versus about 100 bytes in Assembler, but quite a bit slower.

The speed can be tweeked by using multi-line buffers. 4 lines is about the optimum compromise. 

The smallest scroll is fast and only 34 bytes, but uses a full screen sized buffer which eats into code space when memory near full. 

 

In the process of trying a lot of different options to reduce the size of the code I found one little word that is 6 bytes in Forth but only 4 bytes in Assembler and I used it twice.

The word lets you increment a variable and return the new value.

This is used as you bump the column and row values when you write a character or go to a new line. 

\ : ++@   ( addr -- n)  DUP 1+! @ ; 
CODE ++@ ( addr -- n) *TOS INC,  *TOS TOS MOV,  NEXT, ENDCODE 

 

I went down the rabbit hole to trying to make an EMIT word that operates the way we do in things Assembler, using auto incrementing indirect addressing and VDPs auto incrementing.

In theory this should be faster but in Forth the extra setup required, the slower loops and Forth tests for scrolling, bought me very little improvement on the SEVENS benchmark. 

Here is how TYPE looked using that idea. 

*Notice how many Forth words are in the name DUPC@EMIT and it is one instruction in the 9900 instruction set. Wow.

CODE VDPWA! ( Vaddr --)
    WMODE @@ BL,
    TOS POP,
    NEXT,
ENDCODE      

CODE DUPC@EMIT  ( addr -- addr') 
    *TOS+ 8C00 @@ MOVB, 
    NEXT, 
ENDCODE 

: TYPE   ( addr cnt --)  
    PAUSE 
    VPOS VDPWA!     \ set vdp address to cursor position
    0 DO  
       DUPC@EMIT    \ read byte and write to screen 
       VCOL ++@     \ update video column and return new value
       C/L@ =       \ compare to columns per line 
       IF CR THEN   \ CR if needed
    LOOP 
    DROP ;

 

 But the idea is still pretty cool for writing fast to VDP from Forth. In theory I could use it to make VWRITE (VMBW)  in Forth and save more bytes at the expense of speed. 

: VMBW ( addr Vaddr len -- )  SWAP VDPWA!  0 DO   DUPC@EMIT  LOOP  DROP  ;  \ 14 bytes

\ versus 30 bytes
CODE VWRITE  ( RAM-addr VDP-addr cnt -- ) 
         TOS R0 MOV,         \ cnt in R0
         TOS POP,            \ vaddr to TOS
         R2 POP,             \ cpu addr to R2
         WMODE @@ BL,
         R3 VDPWD LI,        \ vdp addr. in a reg. makes this 12.9% faster
         BEGIN,
              R0 DEC,
         OC WHILE,      
             *R2+ *R3 MOVB, \ write byte to vdp write port
         REPEAT,
         2 LIMI,
         TOS POP,            \ refill top of stack cache register
         NEXT,               \ return to Forth
         ENDCODE

 

 

So in the end the spoiler has the console driver I will commit to in the next release.  It's fast enough for most purposes.

and if you really need fast typing there is a VTYPE library file that just blasts text to the screen with VWRITE and only updates the column variable. It doesn't scroll.

Spoiler

\ console.fth provides I/O for the TI-99 console    May 2024  Brian Fox 
\ Changed to reduce size by using more Forth code

[CC] cr .( Console output)

HEX 

[TC]
: C/L!  ( c/l -- )  \ pronounced "SEE-PER-ELL-STORE"
        DUP C/L !           \ set chars per line
        L/SCR *  C/SCR !    \ calc. chars per screen
;

: >VPOS  ( x y -- Vaddr) C/L@ * + ; 
: VPOS    ( -- Vaddr) VROW 2@ >VPOS ; 
: AT-XY   ( col row -- ) VROW 2! ; 
: TOPLN   ( -- vaddr)  VPG @ VTOP @ + ; 

\ =====================================================================
\ *G Scrolling has been implemented in Forth using VREAD & VWRITE
\ ** Uses un-allocated Dictionary as a temporary buffer to hold lines of text
[CC] DECIMAL [TC]

-1 [IF]
\ compromise for speed/buffer_size 
\                Sevens benchmark   
\                ----------------  
\  1 line buffer:     1:28.4
\  2 line buffer:     1:20.7 
\  4 line buffer:     1:16.3 
\  8 line buffer:     1:14.0
\ 12 line buffer:     1:13.4
\ 24 line buffer:     0:58.4      

: SCROLL ( -- )
   HERE 80 +  TOPLN   ( -- buffer screen)
   6 0 DO
      2DUP 2DUP  C/L@ +   
      SWAP  C/L@ 4* DUP>R VREAD  R@ VWRITE  R> +         
   LOOP
   2DROP ( 50 bytes )

   0 23 2DUP >VPOS C/L@ BL VFILL  AT-XY 
;

[ELSE]

\ full screen buffer, smallest and fastest 
:  SCROLL ( -- )
   HERE 80 +  TOPLN   ( -- buffer screen)
   2DUP C/L@ + SWAP  C/SCR @ C/L@ - DUP>R VREAD  R> VWRITE
   0 23 2DUP >VPOS C/L@ BL VFILL  AT-XY 
 ;

[THEN]


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

[cc] HEX [tc]

: PAGE   ( -- ) TOPLN  C/SCR @  BL VFILL   0 0 AT-XY ;

\ : ++@   ( addr -- n)  DUP 1+! @ ; 
CODE ++@ ( addr -- n) *TOS INC,  *TOS TOS MOV,  NEXT, ENDCODE 

: CR     (  -- ) VCOL OFF  VROW ++@  L/SCR = IF SCROLL THEN ;

\ this word expands VPOS for speed. 
: (EMIT) ( char -- ) VROW 2@ >VPOS  VC!  VCOL ++@ C/L@ = IF CR THEN ;

: BS     ( -- )   VCOL DUP @ 1- 0 MAX  SWAP ! ;

: EMIT   ( char -- )  \ handles some control characters
        PAUSE
        0D OVER= IF  DROP CR     EXIT THEN
        08 OVER= IF  DROP BS     EXIT THEN
        (EMIT) ;

: TYPE   ( addr cnt --) PAUSE BOUNDS ?DO  I C@ (EMIT)  LOOP ;
T' TYPE  RESOLVES 'TYPE

: SPACE  ( -- )   BL (EMIT) ; 
: SPACES ( n -- ) 0 MAX  0 ?DO  SPACE  LOOP ;

[cc] cr .( Console input)
\ ======================================================================
\ C H A R A C T E R   I N P U T
\ *G Cursor flash control is done by reading the 9901 timer.
\ ** It counts down from >3FFF in 349mS. If the timer > 1FFF we show the cursor.
\ ** If < 1FFF show the screen char. Flash rate is about 3 per second.

TARGET-COMPILING
: KEY    ( -- char)
      CURS @  
      VPOS VC@ DUP CURS C!  \ combine screen char with cursor 
      BEGIN                 \ start the loop
        PAUSE               \ Essential for Multi-tasking with Console
        CURS @              \ fetch 2 char cursor (space & _ )
        TMR@ 1FFF <         \ compare hardware timer to 1FFF
        IF >< THEN VPOS VC!   \ swap cursor bytes & write
        KEY?                \ check the keyboard
        ?DUP                \ DUP IF <> 0
      UNTIL                 \ loop until a key pressed
      -ROT
      VPOS VC!              \ put the char on screen
      CURS !                \ Restore the cursor 
;

\ High level: input/output          (c) 31mar95 bjr
: ACCEPT     ( caddr +n -- +n')
        OVER + OVER         \ removed 1-  to accept all chars
        BEGIN
            KEY DUP 0D <>
        WHILE
            DUP EMIT
            DUP 8 =
            IF   DROP 1-  3 PICK  UMAX  \ changed to use: 3 PICK   B.F.
            ELSE OVER C!  1+ OVER UMIN
            THEN
        REPEAT
        DROP NIP SWAP - ;

 

 

[+TheBF]

It's funny how coming back to code after a time let's you see stuff you couldn't see before. 

 

Here is a better syntax IMHO for the sound "Assembler" that I made some time back. 

The sound lists compile into VDP and memory allocation is automatic like Forth with the word VC,  .

So you can make as many lists as you need. 

For some reason I had tied these lists to a background player that ran with the multi-tasker.

The ISR player is way simpler so I changed it. 

 

For comparison here is the Parsec explosion in raw hex format

\ HEX
 VCREATE EXPLODE
      VBYTE 7,9F,BF,DF,E7,F0,C0,07,5
      VBYTE 1,F1,6
      VBYTE 1,F2,7
      VBYTE 1,F3,8
      VBYTE 1,F4,9
      VBYTE 1,F5,10
      VBYTE 1,F6,11
      VBYTE 1,F7,12
      VBYTE 1,F8,13
      VBYTE 1,F9,14
      VBYTE 1,FA,15
      VBYTE 1,FB,16
      VBYTE 1,FC,17
      VBYTE 1,FD,18
      VBYTE 1,FE,30
      VBYTE 1,FF,0
 /VEND

 

Versus the same sound list written with the sound assembler words 

DECIMAL
SOUND: EXPLODE
\ GEN3 controls Noise Generator Frequency
   GEN3
   $[ SILENT,  7 NOISE, 0 DB,   999 HZ,  80 MS] 
   GEN4 \ select noise generator for volume fade
   $[  -2 DB,  96 MS]
   $[  -4 DB, 112 MS]
   $[  -6 DB, 128 MS]
   $[  -8 DB, 144 MS]
   $[ -10 DB, 256 MS]
   $[ -12 DB, 272 MS]
   $[ -14 DB, 288 MS]
   $[ -16 DB, 304 MS]
   $[ -18 DB, 320 MS]
   $[ -20 DB, 336 MS]
   $[ -22 DB, 352 MS]
   $[ -24 DB, 368 MS]
   $[ -26 DB, 384 MS]
   $[ -28 DB, 768 MS]
   [MUTE] 
;SOUND

 

Here is how it was done. 

Spoiler

CR .( TI Sound List Assembler.  B Fox  Update May 2024)
\ Assembles TI sound lists in VDP that automatically play with ISR player

NEEDS DUMP  FROM DSK1.TOOLS
NEEDS ISRPLAY FROM DSK1.ISRSOUND 
NEEDS (HZ)  FROM DSK1.SOUND

\ sound byte "assembler" commands compile values for the
\ currently selected generator. (GEN1 GEN2 GEN3 GEN4)
DECIMAL
: HZ,     ( f -- )     (HZ) SPLIT VC, VC,   ;
: DB,     ( level -- ) (DB) VC,  ;
: MUTE,   ( -- )       -30 DB,   ;
: MS,     ( n -- )     4 RSHIFT  VC, ;  \ ms/16 = 1/60

\ compile bytes to turn all sound off
HEX
: SILENT, ( -- )  9F VC,  BF VC,  DF VC,  FF VC, ;

\ noise channel selects generator 4 by default
: NOISE,  ( n -- )  0F AND  GEN4 OSC @ OR  VC,  ;

DECIMAL
\ create a named sound list in VDP RAM that plays when executed 
: SOUND: ( <text> -- ) 
  CREATE  VHERE ,   !CSP     
  DOES> @ ISRPLAY ;

\ start a VDP byte string. Leaves VDP address on stack of ]$
: $[     ( -- vaddr)   VHERE 0 VC, ;

\ end vdp bytes string, compute string length & back-fill into vaddr
: ]$     ( vaddr -- )  VHERE OVER - 1- SWAP VC! ;

\ end a sound string with a duration. Stores duration at end 
: MS]     ( vaddr dur -- ) SWAP ]$   MS, ;

\ mark end of sound list, check for clean stack
: ;SOUND ( -- )  0 VC,  ?CSP ;

: [MUTE]      $[ MUTE, ]$ ;

 

 

 

[+TheBF]

It suddenly occurred to me that after removing the fast screen I/O to save 100 bytes in the kernel, there is no reason I can't put the old code in a library file.

If I really need faster screen writes and faster scrolling I can load DSK1.FASTCONSOL and it replaces the existing words with the new ones. DUH!.

 

Here is the code:

Spoiler

\ FASTCONSOL.FTH
\ rewrite the console I/O to use a full screen scroll buffer
\ and an emit primitive written in Assembler 

NEEDS MOV,  FROM DSK1.ASM9900

DECIMAL 
:  SCROLL ( -- )
   HERE 80 +  TOPLN   ( -- buffer screen)
   2DUP C/L@ + SWAP  C/SCR @ C/L@ - DUP>R VREAD  R> VWRITE
   0 23 2DUP >VPOS C/L@ BL VFILL  AT-XY 
;

: CR     (  -- ) VCOL OFF  VROW ++@  L/SCR = IF SCROLL THEN ;

\ get the entry address of a native sub-routine in the kernel 
' VC! @ CELL+ @ CONSTANT WMODE 

HEX 
CODE <EMIT> ( char --  ?) \ write to screen, return TRUE if end of line 
                  R1  STWP,    \ workspace is USER area base address
         9 R1 ()  R2  MOVB,    \ save char in R2

 \ compute cursor screen address using user variables          
         32 R1 () R3  MOV,     \ vrow->r3
         2E R1 () R3  MPY,     \ vrow*c/l->R4
         34 R1 () TOS ADD,     \ add vcol
         7E R1 () TOS ADD,     \ add video page# VPG. tos=vdp cursor address 
         WMODE @@ BL,          \ set video address 

         R2 8C00 @@ MOVB,       \ write r2 to screen
         34 R1 () INC,          \ bump VCOL
         34 R1 () 2E R1 () CMP, \ compare VCOL = C/L
         TOS CLR, 
         EQ IF,
            TOS SETO,           \ set true flag
         ENDIF,
         2 LIMI,
         NEXT,
ENDCODE

DECIMAL 
: (EMIT) ( char -- ) <EMIT> IF CR THEN ;

: BS     ( -- )   VCOL DUP @ 1- 0 MAX  SWAP ! ;

: EMIT   ( char -- )  \ handles some control characters
      PAUSE
      13 OVER= IF  DROP CR     EXIT THEN
      08 OVER= IF  DROP BS     EXIT THEN
      (EMIT) ;

: TYPE   ( addr cnt --) PAUSE BOUNDS ?DO  I C@ (EMIT) LOOP ;
: SPACE  ( -- )   BL (EMIT) ; 
: SPACES ( n -- ) 0 MAX  0 ?DO  SPACE  LOOP ;

 

 

How much difference does it make?  Well to see that, I used A "Forthy" version of the translation of the sevens program.

\                                    Min:sec   
\ Literal  translation                 1:32    
\ Forthish rework                      1:21
\ Using FASTCONSOL driver              1:10  *edit: Interrupt timing is wrong with fast I/O (LIMI 0) 

\ compiled BASIC                       1:40

 

Here is the reworked version which has only a few optimizing changes and it also factors the code out into separate words.

 

Spoiler

INCLUDE DSK1.ELAPSE
INCLUDE DSK1.ARRAYS 

DECIMAL 
: ?BREAK   ?TERMINAL ABORT" *BREAK*" ; 

\ must define all data before use
\ VARIABLE WIN
VARIABLE POWER 
VARIABLE NUMLEN
VARIABLE CARRY 
VARIABLE INAROW 
VARIABLE NDX   ( transfers loop index out of DO LOOP )

 256 CARRAY ]A                  \  100 DIM A(256)

: INITS 
  0 ]A 256 0 FILL               \ init ]A to zero
  7 0 ]A C!                     \ 120 A(1)=7
 \  WIN OFF                     \ 130 WIN=0
  1 POWER !                     \ 140 POWER=1
  NUMLEN OFF                    \ 150 NUMLEN=1
;

: PRINT-ARRAY ( -- )
    CR                          \ replaces PRINT
\ * Changed to use addresses as loop index
\ Used >digit function 
    0 ]A NUMLEN @  OVER +       \ 340 FOR I=NUMLEN TO 1 
    DO   
      I C@ >DIGIT (EMIT)        \ 350 PRINT CHR$(A(I)+48);
    -1 +LOOP                    \ 360 NEXT I ( STEP -1)
    CR CR                       \ 370 PRINT ::
;

FLOOR OFF 
: COMPUTATIONS ( -- ?)
    CARRY OFF                   \ 180 CARRY=0
    INAROW OFF                  \ 190 INAROW=0
    FALSE        \ WIN is now on the data stack
    NUMLEN @ 1+ 0               \ 200 FOR I=1 TO NUMLEN
    DO
        I NDX !                 \ copy I for later
        I ]A C@ 7 *  CARRY @ +  \ 210 A(I)=A(I)*7+CARRY
\ We avoid some math with divide & mod function
        0 10 UM/MOD  CARRY !    \ 220 CARRY=INT(A(I)/10)
        I ]A C!                 \ 230 A(I)=A(I)-CARRY*10
        I ]A C@ 7 =             \ 240 IF A(I)<>7 THEN 290
        IF
            INAROW DUP 1+! @   \ 250 INAROW=INAROW+1
            6 =                \ 260 IF INAROW<>6 THEN 300
            IF                
              DROP  TRUE 
              LEAVE
            THEN
        ELSE                    \ 280 GOTO 300
            INAROW OFF          \ 290 INAROW=0
        THEN
    LOOP                        \ 300 NEXT I
;

: ADD-CARRY ( ndx )
    CARRY @ DUP NDX @ 1+ ]A C!  \ 310 A(I)=CARRY
    IF                          \ 320 IF CARRY=0 THEN 340
      NUMLEN 1+!                \ 330 NUMLEN=NUMLEN+1
    THEN
;

: RUN 
  CR ." 7's Problem "           \ 110 PRINT "7's Problem"
  INITS 
  BEGIN 
    POWER 1+!                   \ 160 POWER=POWER+1
    ." 7 ^" POWER @ . ." IS:"   \ 170 PRINT "7 ^";POWER;"IS:"
    COMPUTATIONS ( flag)
    ADD-CARRY 
    PRINT-ARRAY 
    ( flag)                     \ 380 IF WIN<>1
  UNTIL                         \     THEN 160
  ." Winner is 7 ^" POWER @ .   \ 390 PRINT "WINNER IS 7 ^";POWER
;                               \ 420 END

 

 

[+TheBF]

I  added a feature to the Just-in-Time compiler file DSK1.JIT and while retiming the Sevens test using the JIT,  I got 48.2 seconds. Wow!

Sounds good but then I re-timed with a stop watch and got 1:01.  

 

I edited the previous table to reflect timings using a stopwatch.  

Timer doesn't work so well when you keep turning the interrupts off.

 

 

[+TheBF]

Sometimes the obvious takes time for me to discover. 

 

I was noodling on the KIBBIT program to make it run in Camel99 Forth. 

I had never used sprites in bit map mode so I had to dig into those details. 

While looking at KIBIT I noticed that the TI-FORTH SPRITE word had the arguments reversed to mine. 

 

I checked in my old TI-Forth file and found this monster:

    : SPRITE ( DX DY COL CH # ---  ) ( SPRITES NUMBERED 0 - 31 )
      DUP 4 * SATR + >R 
      DUP >R SPRPAT R SPRCOL R> SPRPUT R> 4 +
      SATR DO 
           I VSBR D0 = 
          IF 
             C001 SP@ I 2 VMBW DROP
          ENDIF 
      4 +LOOP ;

 

And my version was not much better really. I had tried to use BASIC's argument order and mine used other hi-level words

: SPRITE  ( char colr x y sp# -- )
    ?NDX
    DUP>R LOCATE
    R@    SP.COLOR
    R@    PATTERN
    R> SPR# @ MAX  SPR# ! ;

 

Then it hit me.  Sprites are just 4 bytes, written to VDP RAM. The bytes are all adjacent to each other.

 

If we add this little CODE word, which stores a byte from the top of stack, writes to VDP RAM and let's the hardware increment the address...

HEX 
CODE VC!++  ( char -- ) 
    06C4 ,        \ TOS SWPB,  
    D804 , 8C00 , \ TOS 8C00 @@ MOVB,  
    C136 ,        \ TOS POP, (refills TOS cache register) 
    NEXT, 
ENDCODE 

 

Then SPRITE becomes this: 

: SPRITE ( colr char x y spr# -- )
  SP.Y VC!  VC!++ VC!++ VC!++ ; 

Where VC! sets the VDP address for for first byte stored, ie: the Y coordinate address 

 

And SP.Y gives us the VDP address of the first byte in the sprite record, in the "sprite attribute table" (SAT) 

: SP.Y     ( spr# -- Vaddr) 4* SAT + ; 

 

The word LOCATE becomes:

: LOCATE ( x y spr# --) SP.Y VC!  VC!++ ;

 

I think I need to make an alternative smaller SPRITE library that also can deal with graphics 1 or graphics 2 mode. 

 

 

 

 

[+TheBF]

While looking at my Graphics2 mode code I wondered if there was a way to speed up my first version which was all Forth.

The Forth only version took 13 seconds on this little test and is now 9.6 seconds  

For reference the ALC heavy version took 5.6 seconds

 

Here is what I did:

1. Used the CARRAY library byte array instead of a Forth based array for the bit lookup table.

2. Changed 4DUP from a series of 3 PICK words to the ALC version 4TH, and made 4DUP text macro

3. made 2ROT into a text macro 

4. replaced UM/MOD, used twice in the pixel address computation, with a 4 instruction ALC word called 8/MOD 

5. placed all the computation in the PLOT word to avoid extra calls when drawing lines. 

6. Removed surplus stack manipulation in the PLOT word. 

 

So not complicated but it made a 35% improvement. 

 

The biggest slowdown now is Dr. Ting's recursive line drawing code.

That would benefit greatly from ALC.

 

Edit:

Updated GRAPHICS2 to the one I will put in the system.  It uses Forth for demonstration purposes and is about 1/2 speed to a version with lots of Forth Assembler words. 

 

Spoiler

\ Graphics2 Mode Driver for Camel99 Forth May 31 2024 Brian Fox
CR .( This version uses only Forth )
\ Referenced TI-FORTH: ( CONVERT TO GRAPHICS2 MODE CONFIG 14SEP82 LAO)

\  ** VANILLA FORTH VERSION, LIBRARY CODE ONLY ** 

\ COMPILES under ITC and DTC systems
CR .( Two colour bit map mode )  
 
NEEDS DUMP        FROM DSK1.TOOLS  
NEEDS VALUE       FROM DSK1.VALUES 
NEEDS CHARSET     FROM DSK1.CHARSET 
NEEDS DEFER       FROM DSK1.DEFER 
NEEDS 4TH         FROM DSK1.3RD4TH 

HERE 
\ 
\ TEXT mode so we can return to the Forth console properly 
\ KERNEL version does not init all registers 
\
HEX 
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 -- )
      COUNT 
      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     \ image table 
 1B00 VALUE SAT     \ sprite attribute table
 3800 VALUE SPT     \ Sprite pattern table

\ this is a complete change to TEXT mode.
: TEXT  ( -- )
      40COL VREGS
      800 TO PDT
      380 TO CTAB
      VTOP OFF 
      2 VMODE ! 
      28 C/L!   
      CHARSET    \ restore charset from GROM. VDP memory is mangled
      PAGE ;     

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

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

\ setup BITMAP MODE ...
HEX 
: INIT-IMAGE ( -- ) 0 IMG 300 BOUNDS DO   DUP I VC! 1+  LOOP  DROP ;

\ VDP register reference 
\ VR0   >02 Bitmap mode on
\ VR1   more bits to set mode
\ VR2   Screen image = VR2 * >400 = 1800
\ VR3   set Color table at >0000
\ VR4   PATTERN table= VR4*>800 = 2000 
\ VR5   sprite attribute table: VR5 * $80  = >1B00 
\ VR6   sprite pattern table:   VR6 * $800 = >3800 
\ VR7   screen background colour white on transparent 
CREATE GRAPH2 
\    CNT     0     1     2     3     4     5     6     7
      08 C, 02 C, E0 C, 06 C, 7F C, 7 C, 36 C,  7 C, F1 C, 00 C, 

: GRAPHICS2  
    0000 TO CTAB    \ color table
    1800 TO IMG     \ "name" table (TI nomenclature)
    2000 TO PDT     \ pattern descriptor table 
    36 80 * TO SAT 

    CLEAR 
    F 0 COLOR       \ white on transparent 
    SAT [ 32 4* ] LITERAL 0 VFILL 
    INIT-IMAGE 
    E0 VDPR1 C!     \ copy mode into GPL register
    GRAPH2 VREGS
    
    4 VMODE !  
    0 837A C!  ;    \ highest sprite in auto-motion 

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

\ PLOT computes offset into pattern table per: 
\ TI Video Display Processors, Programmer's Guide
\ -----------------------------------------------
\ BYTE_ADDRESS = 8(INT(X/8)) + 256(INT(Y/8)) + (Y MOD 8)
\ Remainder X mod 8 = is index to array of bit values ;

DEFER STYLUS  ( mask Vaddr --) 

 : PLOT ( x y -- ) 
           0 8 UM/MOD >< +       \ compute Y offset into VDP memory 
      SWAP 0 8 UM/MOD 8* ( r q)  \ compute X offset & remainder
      SWAP BITS + C@             \ convert remainder to bit mask 
     -ROT +                      \ add Y to X offset 
      PDT +                      \ add offset to PDT base address  
     ( mask Vaddr) STYLUS ;      \ do stylus code 

\ drawing operations 
HEX
: VAND    ( c Vaddr -- ) DUP>R VC@  AND  R> VC! ; 

\ "execution tokens" to plug into STYLUS 
\ Usage:  
\ PENCIL IS STYLUS   ERASER IS STYLUS   BRUSH IS STYLUS 
:NONAME  ( c Vaddr -- ) DUP>R VC@  OR   R> VC! ; CONSTANT PENCIL 
:NONAME  ( c Vaddr -- ) SWAP INVERT SWAP VAND ;  CONSTANT ERASER 
:NONAME  ( c Vaddr -- ) DUP>R VC@  XOR  R> VC! ; CONSTANT BRUSH 
                                        ' 2DROP  CONSTANT PENUP 

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

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

    4DUP ROT 
    + 1+ 2/ >R    \ compute mid points 
    + 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 ; 

HERE SWAP - DECIMAL . .( bytes)

 

 

 

 

Edited June 1 by TheBF
Updated code

[+TheBF]

I have always wanted to make better use of VDP RAM for data storage.  I did a version of Oregon Trail where all the ."  strings were compiled to VDP RAM.

That saves a huge amount of dictionary space if your project has a lot of text data. 

 

I had a system to create compact strings in Low RAM that is used by VI99, but there is about 9.3K of  free VDP RAM sitting empty when the Forth kernel is running. 

 

So I took some time to re-work the CPU RAM version to function in VDP ram and it's very useable.

I needed to make a fast way to move VDP-to-VDP so I do that with a copy into RAM and then back to VDP.

 

One interesting thing is reading a file into VDP ram is simpler with the TI99 system. You simply set the File buffer in the PAB to the VDP RAM where you want the record to go.

 

I think with this I can make a simple file editor that would allow Camel99 Forth to have a lot of free RAM for projects as well as the file being edited.

 

Here is the VDPMEM library file so you can make sense of the rest. It gives you words for VDP RAM that work just like the equivalent Forth words that manage CPU memory. 

\ 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

 

Spoiler

\ vdp RAM compact string storage    June 2024 Fox 

NEEDS .S        FROM DSK1.TOOLS
NEEDS OPEN-FILE FROM DSK1.ANSFILES
NEEDS VHERE     FROM DSK1.VDPMEM    \ VHERE VALLOT VC, V, VCOUNT VCREATE 
NEEDS CASE      FROM DSK1.CASE 
NEEDS RKEY      FROM DSK1.RKEY      \ repeating key 

HERE 
HEX
1000 CONSTANT VDPBUFF     \ Free VDP ram after pattern table
2450 CONSTANT MEM-SIZE    \ 9296 bytes is largest file

     VARIABLE #LINES      \ no. of lines in file
     VARIABLE #BYTES      \ no. of bytes in file (with delimiters)

HEX
: FSIZE ( -- ) VHERE VDPBUFF - 1- ; \ 1st string is always null 

: NULL$,  0 VC, ;

: NEXT$ ( V$ -- V$')  VCOUNT + ;
: NTH   ( Vaddr n --) 0 ?DO  NEXT$  LOOP ;

: LEN  ( vdp$ -- c) POSTPONE VC@ ; IMMEDIATE  \ for code clarity 

: TEMPBUFF ( -- addr)  HERE 100 + ;

: PURGE-HEAP  ( -- )
    VDPBUFF DUP  
    MEM-SIZE 0 VFILL       \ erase VRAM
    VP !                   \ reset vdp pointer to base address 
    NULL$,                 \ compile 1st string (0 nth) as a null 
; 

\ *different* PAB buffer is set to a VDP address for each file read or write
: FREAD    ( Vaddr -- ior)     [PAB FBUFF] V!    2 FILEOP ;
: FWRITELN ( Vaddr len -- ior) [PAB CHARS] VC!  [PAB FBUFF] V!  3 FILEOP ; 

: READLN ( -- ior)  
    VHERE NULL$,            \ compile the count byte, keep Vaddress 
    VHERE FREAD ( va ? --)  \ read string into VDP ram at next address
    SWAP                    \ put ior on the bottom  
    [PAB CHARS] VC@         \ get the #chars read by the file operation
    DUP  VALLOT             \ allocate vdp space
    SWAP VC! ;              \ store the length in 1st byte of Vaddress 

: READ-FILE  ( $addr len -- ior)
    PURGE-HEAP
    #LINES OFF
    #BYTES OFF
    DV80 R/O OPEN-FILE ?FILERR >R
    BEGIN
      READLN ( -- ior)  
    0= WHILE
      #LINES 1+!
    REPEAT
    DROP 
    -1 VALLOT     \ remove last length byte from READLN
    NULL$,        \ null$ marks end of used memory 
    R> CLOSE-FILE
;

\ usage:  S" DSK1.MYFILE" WRITE-FILE
: WRITE-FILE ( addr len -- )
    DV80 W/O  OPEN-FILE ?FILERR >R
    VDPBUFF NEXT$ ( caddr )
    BEGIN
      DUP LEN
    WHILE
      DUP VCOUNT FWRITELN ?FILERR
      NEXT$
    REPEAT
    DROP
    R> CLOSE-FILE DROP ;

\ seek to the address of the LINE#, return a VDP counted string address
: SEEKLN  ( line# -- V$addr) VDPBUFF SWAP NTH ;

\ VDP to VDP CMOVE using  temporary buffer 
: VCMOVE  ( Vaddr1 Vaddr2 n -- ) 
  ROT OVER TEMPBUFF SWAP VREAD   \ read src to TEMPBUFF 
  TEMPBUFF -ROT VWRITE          \ write TEMPBUFF back to destination  
;

\ open space for a string in vdp ram, return the VDP address
: MAKEROOM ( len line# -- Vaddr)
  OVER 1+ VALLOT   \ expand size of VHERE  
  SEEKLN DUP>R     ( len $ )   ( r: $addr)
  OVER R@ + 1+     ( len $ $+len+1 )
  VHERE R@ - 0 MAX  ( len $ $' size )
  VCMOVE R> ;

: DELETE$ ( v$addr-- len )
  DUP NEXT$ SWAP  ( $2 $1)
  DUP LEN 1+ DUP>R ( $2 $1 len)
  FSIZE SWAP -  VCMOVE R> ;

: DEALLOT ( n -- )
  VHERE OVER -  OVER 0 VFILL 
  VHERE SWAP -  VDPBUFF MAX VP ! ;

\ API for normal use
: INSERTLN   ( addr len line# --) MAKEROOM VPLACE ; 
: DELETELN   ( line# --) SEEKLN DELETE$ DEALLOT ;
: REPLACELN  ( addr len line# --) DUP DELETELN  INSERTLN ;

 

 

Edited June 15 by TheBF
typo

[GDMike]

It's always bugged me, saving VDP RAM as a file.

I understand the concept but what I don't understand is using VDP RAM for the file attributes and building that into VDP ram,

And not having it getting in the way of the file.

I guess I just can't think that far ahead,  unless it doesn't even matter if that info  gets created as part of the file or not..

 

What I thought was cool, at least taught me on a different similar subject, was if you want to use editor assembler console routines and may I have to make sure that I copy >2000 through enough routines that I need maybe 4K or so, and I was able to save that out to One of my 8K of 32K super cart and push it back to low memory when I needed it.. which allows my editor assembler and all the routines to be accessible again.

I know this could have been better said by someone with more experience but I hope I get the point across.. and that is you got to save a copy of low RAM once the editor assembler library is placed there..

 

Which allows me to introduce my next question. 

Is there any benefit in forth that does something similar, some library that needs to be restored that can be saved to a super cart and restored? Or is it just better with the file system.

And what is the access time difference between the two, console >6000 RAM and file system access times?

Edited June 15 by GDMike

[+Lee Stewart]

10 hours ago, GDMike said:

Is there any benefit in forth that does something similar, some library that needs to be restored that can be saved to a super cart and restored? Or is it just better with the file system.

 

If you have a loadable Forth library, it is in Forth blocks (TI Forth, TurboForth, fbForth, ...) or Forth text files (CAMEL99Forth)—so, file system.

 

...lee

[+TheBF]

1 hour ago, GDMike said:

It's always bugged me, saving VDP RAM as a file I understand that but what I don't understand is using VDP RAM for the file constraints and not having it getting away of the file I guess I just can't think that far ahead,  unless it doesn't even matter if that file data gets copied to file or not..

What I thought was called at least taught me on a different similar subject was if you want to use editor assembler console routines and may I have to make sure that I copy >2000 through enough routines that I need maybe 4K or so, and I was able to save that out to One of my 8K of 32K super cart and push it back to low memory when I needed it.. which allows my editor assembler and all the routines to be accessible again.

I know this could have been better said by someone with more experience but I hope I get the point across.. and that is you got to save a copy of low RAM once the editor assembler library is placed there..

 

Which allows me to introduce my next question. 

Is there any benefit in forth that does something similar, some library that needs to be restored that can be saved to a super cart and restored? Or is it just better with the file system.

And what is the access time difference between the two, console >6000 RAM and file system access times?

I am just taking off but as Lee said, in Forth it's all about text either in blocks or files which are compiled as you need them.

And in FbForth you can save the entire system as binary data in group of blocks with BSAVE/BLOAD

 

In Camel99 you can load the SAVESYS file and save the system as a group of binary program files.

 

And one last thing. All the VDP routines that live in low RAM  for the E/A file loader system are part of the Forth kernels so we don't need them in low RAM

 

And to move a chunk of memory to HEX 6000  use CMOVE or MOVE and it goes there.

 

 

[GDMike]

2 hours ago, TheBF said:

And one last thing. All the VDP routines that live in low RAM  for the E/A file loader system are part of the Forth kernels so we don't need them in low RAM

This part I did not know about Forth until you just brought it up, I suppose it's got to sit somewhere. 

 

Btw:

I corrected a lot of grammar errors on my original post I'm so sorry you guys had to wiggle your way see what I was trying to say and I promise you I'm not drunk I'm not drinking I don't do drugs lol... And I read through it but when I hit save on my phone somehow it changed... 😂 

Last year I learned a lot about assembly

And the year before that I learned a lot about Turboforth. 

And reading through the SID  vocabulary, I learned a lot about the sound card. 

I can do practically anything in VDP now(except bitmap)..

And anything having to do with keyboard input 

I learned a lot about timers created from the do loop... Whether it works forward or backward, stepped or not , doesn't matter I got it down I think. 

I pretty much understand moving blocks of data to and from RAM, ie; Sam's card, Supercart..

I played a little bit with Sprite movement I don't have a use for sprites though at this time of my life, turbo forth makes it easy to use SPGET speech synthesizer data.. I know how to use that.

 

I know nothing about the serial data and the RS/232..

And I know very little about file management like reading writing creating disk directories but I think I understand that there are 5 modes,(levels), of disk operation, but that's about all I know if that's even true..

I think I would like to try to learn file management this upcoming season if I ever get my computer room cleaned back up..

I'd like to make a disk manager in forth of course, I want to use the F-18A and I want to use color. Haha.

But before I do any of that I assume It would have to be some kind of saved file that I would have to call off a disk.. what I'm saying is I don't think I can have the forth os system and my disk manager all on the same file boot up altogether in one lump boot..

Is that why camel forth has so many files that it loads to do different things and when a certain task is needed a file has to be loaded and then when that task is done another task could be started by loading it off a disk again..

 

I guess I also need to see what the difference is between Bsave and CSave and what their functions are... And can there be   d e f g h saves...

I really have to figure out what that means so yeah I think file.io in forth is due.

I know how to create a file and read/write from it as an assembly program so at least I have something to kind of echo against. 

Oh would you look at that it's pizza hour... Okay I'll check back on this later..

 

Edited June 15 by GDMike

[+TheBF]

yes You did a lot of good work on Forth in the last year.
 

 I am typing on my phone and I hate it but here goes.

 

good question on Camel Forth.  This system is my play ground.  When I started I didn’t know what I wanted so I punted. So where Lee and Mark made complete systems in 32k cartridge Roms,  I make a bare minimum Forth system that has only the “Core” words for the standard language. It fits in 8K. i did not commit to anything beyond the core.  
 

Forth is extendable so when I want some feature I put it in a file and compile it and it becomes part of the language. 

Over time those become libraries of features that I can use when I need them.  Just as important,  I don’t load them if I don’t need them. Why waste the memory.
This way I don’t compile graphics code when I make text editor.  Or I don’t load sprite code if I only need simple graphics.  I don’t load the ANS Forth file words if I don’t need them and so on. It’s all for flexibility and space saving.

Now you know.

[+FarmerPotato]

At VCFSW, the vendor Arcade Components  had some single-board 8031s(?) with a CamelForth expansion ROM. 
 

I demonstrated some Forth programming to persuade an onlooker to learn Forth! 
 

I didn’t buy one ($50 ish) because I already have tiny boards that run Forth.  The Launchpad is a nice one for MSP Forth (MSP430FR2355G2 kit)

 

 

[+Lee Stewart]

6 hours ago, GDMike said:

I guess I also need to see what the difference is between Bsave and CSave and what their functions are... And can there be   d e f g h saves...

 

There is only BSAVE . It means Binary Save. It saves the system state and a snapshot of the memory of the selected part of the dictionary. It is loaded with BLOAD (for Binary Load) to restore the saved system.

 

...lee

[+TheBF]

Over on comp.lang.forth Anton Ertl reviewed the byte sieve using modern Forth compilers to see how "optimizations" reacted to modern CPU branch predictions.

novaBBS - comp.lang.forth - Revisiting Gilbreath's sieve

 

There I found the Sieve of Eratosthenes coded by an experienced Forth coder. (Anton thinks it was Bernd Paysan)

 

The results are impressive.  

On Camel99 Forth the byte magazine version run 10 iterations in 120 seconds. 

The recoded version runs in 78 seconds.

 

And since Camel99 Forth has 2+ as an intrinsic word I used it instead of "2 +" 

That small changed reduced the time to 74 seconds. 

That's as fast as using inline code optimization on the original version!

 

Improvements that I see.

1. Setting up the do/loop with two addresses (EFLAGS FLAGS)  rather than 0 to size. This removes the need to compute the array byte in the loop and is idiomatic Forth for traversing an array using 'I'.
2. Using DO +LOOP for the inner loop so that the jumps are computed faster.

 

\ sieve.fs distributed with Gforth:
DECIMAL
CREATE FLAGS 8190 ALLOT
FLAGS 8190 + CONSTANT EFLAG

: DO-PRIME  ( -- n )  
    FLAGS 8190 1 FILL  
    0 3  
    EFLAG FLAGS
    DO  I C@
        IF  DUP I + DUP EFLAG <
            IF  EFLAG SWAP
                DO  0 I C! DUP  +LOOP
           ELSE  DROP  
           THEN  SWAP 1+ SWAP
           THEN  2+  ( changed from 2 + ) 
    LOOP  
    DROP ;

: PRIMES ( -- )
   PAGE ."  10 Iterations"
   10 0 DO  DO-PRIME  CR SPACE . ." Primes"  LOOP
   CR ." Done!"

 

Results shown after running on real iron.

 

[+TheBF]

This is not about TI-99 but it shows the state of the art in Forth compilers for anyone interested. 

 

A while back I went looking for a "reference implementation" of the Forth 2012 word SEARCH. It's a bit of pig and I had spent time on numerous versions of my own. 

The one I found on the web site used locals variables.

That's kosher in modern Forth but I thought there has to be a reasonable way to do it with the stack.

I kept at it and I put up this version as a counter to the local variable version.  

: SEARCH  ( caddr1 u1 caddr2 u2 -- caddr3 u3 flag)
   BEGIN 
     DUP
   WHILE 
     2OVER  3 PICK  OVER  COMPARE 
   WHILE 
     1 /STRING  
   REPEAT
   2NIP  TRUE EXIT
   THEN
   2DROP FALSE ; 

 

 

Just now I wondered how that would be translated to intel 64 bit code under VFX Forth. 

Here is what it did.  I am impressed.

see search 
SEARCH 
( 00594610    4885DB )                TEST    RBX, RBX
( 00594613    0F845C000000 )          JZ/E    00594675
( 00594619    488D6DE0 )              LEA     RBP, [RBP+-20]
( 0059461D    488B5520 )              MOV     RDX, [RBP+20]
( 00594621    48895500 )              MOV     [RBP], RDX
( 00594625    488B5528 )              MOV     RDX, [RBP+28]
( 00594629    48895508 )              MOV     [RBP+08], RDX
( 0059462D    488B5530 )              MOV     RDX, [RBP+30]
( 00594631    48895510 )              MOV     [RBP+10], RDX
( 00594635    48895D18 )              MOV     [RBP+18], RBX
( 00594639    488B5D28 )              MOV     RBX, [RBP+28]
( 0059463D    E82E1CE9FF )            CALL    00426270  COMPARE
( 00594642    4885DB )                TEST    RBX, RBX
( 00594645    488B5D00 )              MOV     RBX, [RBP]
( 00594649    488D6D08 )              LEA     RBP, [RBP+08]
( 0059464D    0F8412000000 )          JZ/E    00594665
( 00594653    BA01000000 )            MOV     EDX, # 00000001
( 00594658    482BDA )                SUB     RBX, RDX
( 0059465B    48035500 )              ADD     RDX, [RBP]
( 0059465F    48895500 )              MOV     [RBP], RDX
( 00594663    EBAB )                  JMP     00594610  SEARCH
( 00594665    48895D08 )              MOV     [RBP+08], RBX
( 00594669    48C7C3FFFFFFFF )        MOV     RBX, # FFFFFFFF
( 00594670    488D6D08 )              LEA     RBP, [RBP+08]
( 00594674    C3 )                    RET/NEXT
( 00594675    BB00000000 )            MOV     EBX, # 00000000
( 0059467A    488D6D08 )              LEA     RBP, [RBP+08]
( 0059467E    C3 )                    RET/NEXT
( 111 bytes, 28 instructions )

 

[+TheBF]

Inspired by @Vorticon 's leadership I used his code to grok the ide clock.

It was easy to experiment reading the registers at the Forth console with @Vorticon 's insight about bit 3.

I didn't see any problems with reading the time without locking the registers so I didn't bother.

Don't know what side effects I should expect. ??

 

I save/restore R12 when entering/exiting the routine to avoid possible conflict with the serial I/O on this Forth kernel.

 

Here is what I came up with. 

\ ideclock.fth    V 0.1   Brian Fox 2024

HEX 
1000 CONSTANT IDECARD 

4020 CONSTANT secs
4024 CONSTANT mins 
4028 CONSTANT hrs 

DECIMAL
12 2* USER CRU   \ address of R12 in any Camel99 Forth workspace 

\ Machine code CRU words
HEX
CODE 0SBO  ( -- ) 1D00 ,  NEXT, ENDCODE
CODE 0SBZ  ( -- ) 1E00 ,  NEXT, ENDCODE

CODE 1SBO  ( -- ) 1D01 ,  NEXT, ENDCODE
CODE 3SBO  ( -- ) 1D03 ,  NEXT, ENDCODE

DECIMAL 
: TIME@ ( -- secs min hrs)
        CRU @ >R 

        IDECARD CRU !  
        0SBO            
        1SBO            \ enable mapping of >4000 - >40ff space
        3SBO            \ fixed page at >4000 - >40ff
        secs C@  mins C@  hrs C@ 
        0SBZ            \ card off 

        R> CRU !   
;     

\ --------------------  
\ formatted output 
: ':'   [CHAR] : EMIT ;

: .##   0 <#  # #  #> TYPE ;

: .TIME  ( -- ) 
    BASE @ >R  
    HEX TIME@ .## ':' .## ':' .## 
    R> BASE ! ;         

 

[+TheBF]

Once you have the time figured out, date is just a few fetches away. 

 

Here is the expanded version. 

\ IDECLOCK.FTH     

\ INCLUDE DSK1.TOOLS 

HEX 
1000 CONSTANT IDECARD 

\ clock registers in memory 
4020 CONSTANT secs
4024 CONSTANT mins 
4028 CONSTANT hrs 
402C CONSTANT day 
4032 CONSTANT month 
4034 CONSTANT year 

DECIMAL
12 2* USER CRU   \ address of R12 in any Forth workspace 

\ Machine code CRU words
HEX
CODE 0SBO  ( -- ) 1D00 ,  NEXT, ENDCODE
CODE 0SBZ  ( -- ) 1E00 ,  NEXT, ENDCODE

CODE 1SBO  ( -- ) 1D01 ,  NEXT, ENDCODE
CODE 3SBO  ( -- ) 1D03 ,  NEXT, ENDCODE

DECIMAL 
: CLOCK-ON 
        IDECARD CRU !  
        0SBO            
        1SBO            \ enable mapping of >4000 - >40ff space
        3SBO            \ fixed page at >4000 - >40ff
;

: TIME@ ( -- secs min hrs)
        CLOCK-ON 
        secs C@  mins C@  hrs C@ 
        0SBZ            \ card off 
;     

: DATE@ ( -- day month yr )
    CLOCK-ON 
    day C@ month C@ year C@ 
    0SBO
;
  
\ formatted output 
: ':'   [CHAR] : EMIT ;

: .##   0 <#  # #  #> TYPE ;

: .TIME  ( -- ) 
    BASE @ >R  
    HEX TIME@ .## ':' .## ':' .## 
    R> BASE ! ;         

: .DATE  
   BASE @ >R HEX 
   DATE@ .## ." /"  .## ." /" .## 
   R> BASE !  
;

: .DATE&TIME   .DATE  SPACE .TIME  ;

 

[+Vorticon]

Cool! How are you converting BCD to Hex? I don't see a specific code for this.

[+TheBF]

1 minute ago, Vorticon said:

Cool! How are you converting BCD to Hex? I don't see a specific code for this.

Just using HEX conversion does it. The reason is , BCD uses 4 bits for the digits from 0 to 9.  HEX uses the same 4 bits but counts  past 9 up to 'F'. 

 

I went down the road 30 years ago of making BCD conversions for a clock chip. 

I figured it out about 5 years ago that I wasted my time.  

 

[+Vorticon]

1 hour ago, TheBF said:

I didn't see any problems with reading the time without locking the registers so I didn't bother.

Don't know what side effects I should expect. ??

If you are doing multiple successive reads you might miss a transition in the minutes or hours. For example, if you read the seconds first, by the time you then read the minutes, the latter would have possibly incremented. So say your clock is at 1:30:59, if you read the seconds first, you will get 59, but by the time you read the minutes to would be at 31, so your returned time will be 1:31:59 which is incorrect.

[+Vorticon]

4 minutes ago, TheBF said:

Just using HEX conversion does it. The reason is , BCD uses 4 bits for the digits from 0 to 9.  HEX uses the same 4 bits but counts  past 9 up to 'F'. 

 

I went down the road 30 years ago of making BCD conversions for a clock chip. 

I figured it out about 5 years ago that I wasted my time.  

 

Well nuts. This is what I did:

bcd2hex mov     r4,r5           ;isolate low digit
        andi    r5,000fh
        mov     r4,r6           ;isolate high digit
        andi    r6,00f0h
        srl     r6,4
        mov     r6,r4           ;save original value
        sla     r6,3            ;multiply by 8
        sla     r4,1            ;multiply original value by 2
        a       r4,r6           ;high value has now been multiplied by 10
        a       r5,r6           ;add low and high numbers. r6 now has hex value
        b       *r11

 

[+TheBF]

4 minutes ago, Vorticon said:

If you are doing multiple successive reads you might miss a transition in the minutes or hours. For example, if you read the seconds first, by the time you then read the minutes, the latter would have possibly incremented. So say your clock is at 1:30:59, if you read the seconds first, you will get 59, but by the time you read the minutes to would be at 31, so your returned time will be 1:31:59 which is incorrect.

Makes sense. I just didn't see it when I let it run in a loop on the screen.