Jump to content
IGNORED

Camel99 Forth Information goes here


TheBF

Recommended Posts

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 ; 

 

  • Like 2
Link to comment
Share on other sites

  • 3 weeks later...
Posted (edited)

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 by TheBF
fixed comment
  • Like 2
Link to comment
Share on other sites

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 - ;

 

 

  • Like 2
Link to comment
Share on other sites

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, ]$ ;

 

 

 

  • Like 2
Link to comment
Share on other sites

  • 2 weeks later...

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

 

 

  • Like 2
Link to comment
Share on other sites

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. :)

 

 

  • Like 1
Link to comment
Share on other sites

Join the conversation

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

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

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

×   Your previous content has been restored.   Clear editor

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

Loading...
  • Recently Browsing   0 members

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