Jump to content
IGNORED

fbForth—TI Forth with File-based Block I/O [Post #1 UPDATED: 06/09/2023]


Lee Stewart

Recommended Posts

I think I get it now. ?OF should actually find 2 numbers on the stack, viz., the number being tested by CASE and the flag. I have not yet tested what follows, but I think it will work. The idea of the code is to toggle the flag and add it to a duplicate of the test number before presenting it to OF . A false flag will then force a mismatch, while a true flag will force a match. It must be paired with ENDOF .

 

Here it is for Camel99 Forth:

: ?OF    \ compile-time: ( 4 -- here 5 )  run-time: ( n flag -- []|n)
      \ toggling flag will force proper match/mismatch for OF
      POSTPONE 0= POSTPONE OVER POSTPONE +         \ S:n flag'+n
      POSTPONE OF  ; IMMEDIATE 

Here is the equivalent fbForth version:

: ?OF    \ compile-time: ( 4 -- here 5 )  run-time: ( n flag -- []|n)
      \ toggling flag will force proper match/mismatch for OF
      COMPILE 0= COMPILE OVER COMPILE +         \ S:n flag'+n
      [COMPILE] OF  ; IMMEDIATE 

Here is an example of its use (block #41 of FBLOCKS must be loaded to use WITHIN ):

: XX  ( n -- ) 
      CASE
         DUP 2 9 WITHIN ?OF ." In range (2,9)." ENDOF
         ELSEOF ." No match!" ENDOF
      ENDCASE  ;

...lee

 

[Edits in this color.]

Link to comment
Share on other sites

The above version of ?OF works in fbForth 2.0!

 

@TheBF’s example use of ?OF inspired the following word, which requires block #41 of FBLOCKS to be loaded for PICK , WITHIN and -ROT :

: RANGEOF   \ compile-time ( 4 -- here 5 )   run-time: ( n lo hi -- []|n )
      COMPILE 2 COMPILE PICK COMPILE -ROT       \ S:n n lo hi
      COMPILE WITHIN                            \ S:n flag
      COMPILE 0= COMPILE OVER COMPILE +         \ S:n flag'+n
      [COMPILE] OF  ; IMMEDIATE

It must be paired with ENDOF and used within a CASE ... ENDCASE construct as

: TEST  ( n -- )
    CASE
       2 9 RANGEOF ." In range." ENDOF
       ELSEOF ." No match!" ENDOF
    ENDCASE  ;

...lee

  • Like 1
Link to comment
Share on other sites

Cool! I forgot I posted this experiment. So yeah. That's what I meant. ;)

Thanks for figuring it out for me

 

I have been crunching on resurrecting the directed threaded version of CAMEL99 Forth which means fixing the cross-compiler and all the rest. I broke it a year ago, but decided to focus on one code base until I got things working better.

 

My old brain is sweating, but I am getting closer.

 

After DTC I want to take serious run at sub-routine threading with some inline primitives. It should run 3 times faster...

in theory.

Link to comment
Share on other sites

As I looked at your code, I realized that Chuck says "the dictionary is your case statement" (or something like that).
Here is my interpretation of what that means in regards to your SAVE-FONT word:

HEX
400 CONSTANT 1K \ these replace the case statement
800 CONSTANT 2K

PABS @ \ VRAM address for PAB
HERE \ RAM addres for PAB-BUF (dummy not actually used)
PDT \ VRAM address for PAB-VBUF (Pattern Descriptor Table)
FILE FONTFIL \ associate above 3 addresses with FONTFIL

: CLIP ( n min max -- n') ROT MIN MAX ; ( one of my creations)

: SAVE-FONT ( bytes -- ) \ Usage: 1K SAVE-FONT
          DUP 0 2K CLIP \ could of course use your error code
          FONTFIL SET-PAB \ set up FONTFIL
          BL WORD HERE DUP C@ 1+ PAB-ADDR @ 9 + SWAP VMBW \ filename->PAB
          SV \ save 1 or 2 KiB of binary font image to file
;
DECIMAL
Another factor that I took from modern Forth practice is the word PLACE ( addr len addr --) PLACE takes a string's address and length and puts it in memory as a counted string.
A counted string is what a PAB needs so I created VPLACE to do the job. This might be useful for SAVE-FONT:
: VPLACE   ( $addr len Vaddr -- )  \ like PLACE, but for VDP RAM
           2DUP VSBW 1+ SWAP VMBW ;

It might clarify this line and VPLACE is generally useful for any string handling in VDP RAM.

\ so this...
BL WORD HERE DUP C@ 1+ PAB-ADDR @ 9 + SWAP VMBW

\ becomes this
BL WORD COUNT PAB-ADDR 9 + VPLACE

 

 

 

My 2 cents Canadian. (about 1.44 cents USD so take it for what it's worth)

 

 

Here is my version, after some re-thinking of SAVE-FONT :

HEX
\ The following 2 words are Brian Fox’s creations
: VPLACE   ( addr len vaddr -- )  \ like PLACE, but for RAM to VRAM
      OVER OVER VSBW 1+ SWAP VMBW ;
: CLIP ( n min max -- n') ROT MIN MAX ; 

PABS @         \ VRAM address for PAB
HERE           \ RAM addres for PAB-BUF (dummy not actually used)
PDT            \ VRAM address for PAB-VBUF (Pattern Descriptor Table)
FILE FONTFIL   \ associate above 3 addresses with FONTFIL

\ SAVE-FONT forces bytes to be 1024..2048
: SAVE-FONT  \ ( bytes -- )   ( IS:<fontFileName> )
      400 800 CLIP         \ forces font file size of 1..2 KiB 
      FONTFIL SET-PAB      \ set up FONTFIL
      BL WORD HERE COUNT   \ filename-addr cnt
      PAB-ADDR @ 9 +       \ vaddr
      VPLACE               \ cnt+filename->PAB+9
      SV    \ save 1024..2048-byte binary font image to file
;  
\ Usage example: 400 SAVE-FONT DSK1.FONT0230
DECIMAL

And, here it is à la MKBFL (requires same preamble as SAVE-FONT):

HEX
: SVFFL  ( IS:<fontFileName> <bytes> )
      FONTFIL SET-PAB      \ set up FONTFIL
      BL WORD HERE COUNT   \ filename-addr cnt
      PAB-ADDR @ 9 +       \ vaddr
      VPLACE               \ cnt+filename->PAB+9
      BL WORD              \ <bytes> input string to HERE
      HERE NUMBER DROP     \ convert to 16-bit number on stack
      400 800 CLIP         \ force font file size of 1..2 KiB 
      SV    \ save 1024..2048-byte binary font image to file
;
\ Usage example: SVFFL DSK1.FONT0230 400
DECIMAL

...lee

  • Like 2
Link to comment
Share on other sites

  • 2 weeks later...

CF7+/nanoPEB Mounting Utilities—

 

Back in post #1350, about 2 years ago (I cannot believe it has been this long!) I posted utilities for mounting CF7+/nanoPEB volumes in a non-persistent manner and had indicated that a permanent solution might be a little too involved to be worth pursuing. Well, with a little help from code that Guillaume Tello (@moulinaie) had developed for Extended Basic, and with his blessing, I have written a word, CFPMOUNT , that permanently mounts volumes, i.e., they persist after a system reset because the volume#-DSK# associations are stored on the CF card. All of the CF utilities will be in the new FBLOCKS I will post later tonight. Here is that code for those who cannot wait:

 

 

\ 
\ CF utilities for checking and changing mounted volumes on a  nanoPEB or CF7+
\
HEX                                                    
: CF?  ( -- flag )   \ nanoPEB/CF7 present?           
   3FF8 VSBR SWPB 3FF9 VSBR +          \ get magic number               
   AA03 =   ;                          \ leave TRUE if nanoPEB/CF7+
: CFCHK  ( -- )   \ check for presence of CF7+/nanoPEB
   CF? 0= ABORT" No CF7+/nanoPEB!"  ;  \ if CF, continue
: DSKCHK  ( dsk# -- dsk#|[] )    \ check that dsk# 1-3
   DUP 1 <                    \ dsk# < 1?  S:dsk# flag1
   OVER 3 >                   \ dsk# > 3?  S:dsk# flag1 flag2
   OR                         \ S:flag1+flag2
   ABORT" DSK# not 1-3!"  ;   \ abort if dsk# not 1-3..else S:dsk#

: CFVOLS  ( -- volDSK1 volDSK2 volDSK3 )  \ get vol#s in DSKs    
   CFCHK                      \ if CF, continue
   SP@ 6 - 8312 !             \ reserve 3 cells on stack
   SP@ 3FFA SWAP 6 VMBR  ;    \ get vol#s to stack

: CFMOUNT  ( vol# dsk# -- )   \ mount CF vol# in DSK<dsk#>       
   CFCHK             \ if CF, continue
   DSKCHK            \ if dsk# 1-3, continue
   1-                \ decrement dsk#
   1 SLA             \ double it
   3FFB +            \ add to 3FFB  S:vol# 3FFB|3FFD|3FFF
   OVER SWPB OVER 1- \ S:vol# 3FFB|3FFD|3FFF vol#[LSB-MSB] 3FFA|3FFC|3FFE
   VSBW VSBW  ;      \ copy bytes of vol# to DSK slot in VRAM
\ 
\ CFMOUNT-PAB is XB pseudo-line: 5,M,O,U,N,T,(,200,1,dsk,179,200,4,v1,v2,v3,v4
\ We will be using it as the PAB for the DSR's subprogram MOUNT, as well.
054D VARIABLE CFMOUNT-PAB  
   DATA[ 4F55 4E54 28C8 0100 B3C8 0400 0000 0000 ]DATA DROP DROP
8342 @ VARIABLE SV8342  \ save word at >8342 before it gets trashed
\ DSRLNK 0A to subprogram MOUNT, restoring inner interpreter upon return
: DSR-MOUNT  ( -- )  
   0A 0E SYSTEM         \ execute DSR subprogram MOUNT
   SV8342 @ 8342 !  ;   \ restore >8342 in inner interpreter
: PUTDSK ( dsk# -- )  \ put dsk# as ASCII into CFMOUNT-PAB
   0 <# # #>            \ put single digit as packed string at PAD
   CFMOUNT-PAB 9 + SWAP  \ S:src dst cnt
   CMOVE  ;             \ copy ASCII dsk# to CFMOUNT-PAB+9
: PUTVOL ( vol# -- ) \ put vol# as ASCII into CFMOUNT-PAB
   0 <# # # # # #>      \ put 4 digits as packed string at PAD
   CFMOUNT-PAB 0D + SWAP   \ S:src dst cnt
   CMOVE  ;             \ copy 4 ASCII digits of vol# to CFMOUNT-PAB+13
\ copy XB pseudo-line to PABS area of VRAM and stash pointer at >832C & >8356
: CFPAB>VRAM ( -- )    
   PABS @ DUP        \ VRAM dst...2 copies
   CFMOUNT-PAB       \ RAM src
   OVER              \ VRAM dst for VMBW
   012               \ 18 bytes to copy
   VMBW              \ copy 18 bytes from RAM to VRAM
   8356 !            \ namelength pointer for DSRLNK >0A
   832C !  ;         \ save pointer that MOUNT subprogram expects

: CFPMOUNT  ( vol# dsk# -- )   \ mount CF vol# permanently in DSK<dsk#> 
   CFCHK          \ if CF, continue
   DSKCHK         \ if dsk# 1-3, continue
   PUTDSK         \ put dsk# as ASCII into CFMOUNT-PAB
   PUTVOL         \ put vol# as ASCII into CFMOUNT-PAB
   CFPAB>VRAM     \ copy CFMOUNT-PAB to PABS in VRAM
   DSR-MOUNT  ;   \ call MOUNT and restore inner interpreter
DECIMAL

 

 

 

Later, I will also explain a bit more about what is going on with CFPMOUNT .

 

...lee

  • Like 2
Link to comment
Share on other sites

I updated post #1 with all files related to fbForth 2.0:11, which includes new words,

  • BYE ( -- ) —A synonym for MON
  • SD0 ( -- addr ) —Returns the address of the bottom of the FIFO sound stack in low RAM
  • CMOVE> ( src dst cnt -- ) —Copies cnt bytes of src RAM to dst RAM in the opposite direction as CMOVE , i.e., from high RAM to low RAM. As with CMOVE and MOVE , it is not overlap safe.
  • ABORT" ( flag -- ) (IS:<message>") —If flag is nonzero, <message> is printed and ABORT is executed. See the spoiler in my last post for examples of usage in the definitions of CFCHK and DSKCHK .

Also posted is the latest FBLOCKS file, with the new word, CFPMOUNT , added to the Compact Flash Utilities. CFPMOUNT persists the mounting of volumes until the next change, i.e., it survives a system reset or removal of the CF card. You may recall that CFMOUNT actions do not survive a system reset. See post #1480 above for more detail.

 

I will update fbforth.stewkitt.com in the near future.

 

...lee

  • Like 3
Link to comment
Share on other sites

Hey Lee,

 

Since you and Willsy implement blocks as files, it is making me think about using a "BLOCK" file for virtual memory to create a text file editor.

It would work like this:

  1. Load the text file into a block file, adding blocks as needed
  2. Edit the text file in the blocks
  3. Save the file back to DV80 format when you are done editing and delete block file.

What do you think of that approach?

Link to comment
Share on other sites

You could probably do something like that. If I were to do that in fbForth, I would need to figure out how to handle lines because a block is 1024 characters with no delimiters except at the end of the block. A block is usually visualized as 16 64-character lines, but the block is filled with spaces when empty. That said, there is nothing preventing using block space in another way. We do it all the time with binary image blocks. I use blocks for program images on occasion. I did that for Walid’s plotter driver.

 

You may know, but just to be sure, TurboForth and fbForth use DF128 files for blocks. Each block is 8 records in 4 sectors. fbForth uses 4 block buffers in low RAM space (same design as TI Forth, which has 5 buffers) with a single 128-byte record buffer in VRAM, whereas, TurboForth has its block buffers in VRAM, which, IIRC, are also the record buffers. I forgot how many block buffers TurboForth has (5 or 6?). TI Forth has 5 block buffers handled the same as fbForth but TI Forth reads/writes 4 sectors at a time without regard to file I/O, using a 1024-byte VRAM buffer. TurboForth may be faster with block I/O but does not manage bitmap graphics as do the other two Forths. Sorry, I am rambling...

 

...lee

Link to comment
Share on other sites

Yes TF has 6 block buffers at power-up but you can change that with the #BUF variable. It's possible for TF to do bitmap (if the appropriate library were developed - I ran out of steam and talent!) but block operations would corrupt your screen. Likely not a major issue as most programs run from ram once they're loaded.

Link to comment
Share on other sites

Yes TF has 6 block buffers at power-up but you can change that with the #BUF variable. It's possible for TF to do bitmap (if the appropriate library were developed - I ran out of steam and talent!) but block operations would corrupt your screen. Likely not a major issue as most programs run from ram once they're loaded.

 

I believe the “time” bit but not the “talent” bit. You are a very talented programmer!

 

...lee

  • Like 2
Link to comment
Share on other sites

You could probably do something like that. If I were to do that in fbForth, I would need to figure out how to handle lines because a block is 1024 characters with no delimiters except at the end of the block. A block is usually visualized as 16 64-character lines, but the block is filled with spaces when empty. That said, there is nothing preventing using block space in another way. We do it all the time with binary image blocks. I use blocks for program images on occasion. I did that for Walid’s plotter driver.

 

You may know, but just to be sure, TurboForth and fbForth use DF128 files for blocks. Each block is 8 records in 4 sectors. fbForth uses 4 block buffers in low RAM space (same design as TI Forth, which has 5 buffers) with a single 128-byte record buffer in VRAM, whereas, TurboForth has its block buffers in VRAM, which, IIRC, are also the record buffers. I forgot how many block buffers TurboForth has (5 or 6?). TI Forth has 5 block buffers handled the same as fbForth but TI Forth reads/writes 4 sectors at a time without regard to file I/O, using a 1024-byte VRAM buffer. TurboForth may be faster with block I/O but does not manage bitmap graphics as do the other two Forths. Sorry, I am rambling...

 

...lee

 

I could probably use 128 bytes lines internally and then print them out to a text file when I save then using -TRAILING on each line. It will not be real fast to save but it would work.

But I am considering making a 40 column editor without windowing so lines fit on the screen. Kind of like the original Forth used 64 column lines because that fit on the screen at the time.

 

Is there a reason you use DF128 files and not DF256 (is 256 possible?)

Link to comment
Share on other sites

I could probably use 128 bytes lines internally and then print them out to a text file when I save then using -TRAILING on each line. It will not be real fast to save but it would work.

But I am considering making a 40 column editor without windowing so lines fit on the screen. Kind of like the original Forth used 64 column lines because that fit on the screen at the time.

 

If you have not set up block buffers à la figForth as with TI Forth, fbForth and TurboForth, there is no reason you could not devise your own, possibly more convenient scheme. You could set up block buffers that hold 16 80-character lines that use block files with 5 sectors/block. That would likely be less wasteful of RAM real estate, but, of course, require blocks files that are 5-sector (1280-byte) multiples.

 

Is there a reason you use DF128 files and not DF256 (is 256 possible?)

 

Yes. DF128 is the largest record size that uses the entire sector for data, i.e., there is no wasted space. DF256 is not possible because there is only a 1-byte space in the FDR for storing the bytes/record and storing 0 in the records/sector byte means that the file is a program file, which complicates reading the file. DF255 (I think that is possible) would only allow blocks of 1020 bytes, requiring an inconvenient line-handling algorithm. And, of course, with 64 characters per “line” and 128 as a multiple of 64, it is quite convenient.

 

...lee

  • Like 1
Link to comment
Share on other sites

While scouring my old system from the 90s I found this code that I wrote to manage block source files.

 

Some of it might have value for if you don't already have them.

I always liked the "listing" word. I would run it to the printer and put the listings in my source code folder.

And then run the .index and get a table of contents.

 

So convenient.

 

 


\ simple block editor words
: <LINE>  ( l# s# - addr #c )
        BLOCK  SWAP  C/L @ *  + 40  C/L @ ;

: .LINE   ( l# s# - )
        <LINE> -TRAILING  TYPE  #LINE 1+! ;

: LIST  ( s# - )
        CR
        DUP SCR ! ." SCR#"  U.
        10 0
         DO
             CR  I 3 .R SPACE   I SCR @ .LINE
         LOOP
         CR ;

: PP
        0 TEXT PAD 1+ SWAP   scr @ <LINE> CMOVE UPDATE ;

: PL
        0D EMIT OUT 0!
        C/L @ SPACES
        0D EMIT
        [char] ? EMIT
        0D EMIT
        DUP SCR @ <LINE> PAD 2dup C! 1+ SWAP CMOVE <IN$>
        1+ SWAP scr @ <LINE> CMOVE UPDATE ;

: .INDEX   0 SWAP .LINE ;                           \ scr -

: CLEAR ( n -- )
        BUFFER B/BUF BLANK  UPDATE ;                \ scr -

: COPY  ( n -- )
        SAVE-BUFFERS    SWAP  BLOCK  2-  !  UPDATE ;   \  from to -

: THRU  ( 1st-block last-block -- )
        1+ SWAP
        DO
            I U. I LOAD
        LOOP ;

: CR'S  ( n -- )
        0 DO
             CR #LINE 1+!
          LOOP ;

: FORM-FEED
        0C EMIT  #PAGE 1+!   #LINE 0!  ;

: .PAGE#
        #PAGE @ IF ." page:" #PAGE @ 3 .R THEN ;

: .HEADER
        CR  ACTIVE $.
        TAB  TAB  TIME@ TIME->$ $. SPACE SPACE DATE@ DATE->$ $. ;

: .FOOTER
        CR  CR
        L/PAGE #LINE @ -  CR'S
        0F CTAB ." HS/FORTH V5.0" 10 SPACES ." Intelect Systems"
        CR 40 CTAB .PAGE#
        FORM-FEED ;

: ?FORMFEED  #LINE @  L/PAGE > IF .FOOTER .HEADER  THEN ;

: INDEX    ( from,to -- )
           DECIMAL
           HIGHBLK @ 1- MIN
           OVER L/PAGE / 1+ #PAGE !      \ calculate page# for 1st blk
           #LINE 0!
           .HEADER CR CR
           1+ SWAP
           DO  CR  I 4 .R  4 SPACES  I .INDEX  ?FORMFEED  1 /LOOP
          .FOOTER ;

: 3'S    3 / 3 * ;

: TRIAD  ( scr# -- )
        DECIMAL
        #PAGE 0! .HEADER
        3'S DUP 3 + SWAP
        DO CR I LIST LOOP
        .FOOTER ;

: TRIADS  ( from,to -- )
           3'S  1+ SWAP  3'S   DO  I TRIAD  3 +LOOP ;

: LISTING  0 HIGHBLK @ 2 - TRIADS ;

 

 

  • Like 1
Link to comment
Share on other sites

  • 3 weeks later...

Space saving opportunity?

 

Hi Lee,

 

While I was looking at FBForth's block file code I found this:

: R/W   ( bufaddr block# flag --- )
    IF
       RBLK
    ELSE
       WBLK
    THEN  ;

It appears to be used only twice. Once in the READ operation in BLOCK and once in WRITE operation in BUFFER.

This appears to be a tradition in Fig Forth and I also see it in MVP Forth, by Glen Hayden, (circa 1983) which also has a form of this word controlled by a parameter on the stack.

This seems to break the axiom "the dictionary is your case statement".

 

HsForth, (circa 1990) removes the control parameter and simple puts the RBLK in the BLOCK word and the WBLK in the BUFFER word

as does FPC by Tom Zimmer (circa 1988) and ZenForth by Martin Tracy (1989)

It appears the Fig-Forth sacred tradition was removed by more contemporary authors.

 

Perhaps you could put this on your stack for future changes to save some space.

  • Like 1
Link to comment
Share on other sites

  • 1 month later...
  • 3 weeks later...

I am beginning to work on porting Walid’s (@Vorticon’s) XB Stratego game to fbForth 2.0. The first thing I am doing is writing words to convert CALL SOUND() statements to standard sound lists and one or more blocks of same to a sound table that can be played with PLAY . It is really overkill for this game because there are not so many CALL SOUND() statements that it could not be done fairly easily by hand, but I have always wanted to do it. It would certainly be useful for larger tables. I may try to port @TheBF’s Camel99 Forth sound words of a year or so ago to do the trick.

 

...lee

  • Like 1
Link to comment
Share on other sites

I am beginning to work on porting Walid’s (@Vorticon’s) XB Stratego game to fbForth 2.0. The first thing I am doing is writing words to convert CALL SOUND() statements to standard sound lists and one or more blocks of same to a sound table that can be played with PLAY . It is really overkill for this game because there are not so many CALL SOUND() statements that it could not be done fairly easily by hand, but I have always wanted to do it. It would certainly be useful for larger tables. I may try to port @TheBF’s Camel99 Forth sound words of a year or so ago to do the trick.

 

...lee

 

If there are any pieces , small routines etc that you want to parcel out just let me know. Happy to write a few screens for you.

It's a big game, but Walid's use of named routines gives a structure to begin with. I did a casual look at it and there are probably opportunities to create some custom data structures that make the Forth easier to grok. Multi-dimensional arrays are not the only way to represent some of the information from what I can see.

 

I did implement some code to use the ISRHook to run the sound time delay in the background for the 4 voices to see how that worked. It was fine for small sound statements in my "scientific" sound library (HZ DB etc.)

 

I remember thinking that I should try it with the sound player but did not get there. I will review the possibilities and get back to you.

 

IMHO if we try to write the game in translated BASIC we will end up with something rather complicated in Forth. BASIC is remarkably good at doing what BASIC does.

My experience in translating some BASIC demos here has shown me that Forth is not super at being BASIC, unless you write a BASIC in Forth first. :-)

 

The ideal strategy is to create a "stratego" language of sorts and then write the game in that.

Easier said than done for me since I don't know a thing about the game. :-)

Link to comment
Share on other sites

Here is my sound experiment using an ISR timer that counts down the time delay for each voice and then turns the voice off.

The key to this is that the VOX* words set some variables to the correct address for each voice. I will have to look at the sound lists to see how a player would do this.

 

I suppose the solution is to write the player in ALC and give it to the ISRHOOK.

Hmm...

 

 

 

\ TMS9919 SOUND CHIP DRIVER and CONTROL LEXICON     Jan 2017 BJF
\ Modified to use ISR timers to control durations   Feb 16 2019 BJF
 
 NEEDS DUMP FROM DSK1.TOOLS   \ debugging
 NEEDS MOV, FROM DSK1.ASM9900
 
\ TMS9919 is a memory mapped device on the TI-99 @ >8400
\ SND! is in the CAMEL99 Kernel as  : SND!     8400 C! ;
 
\ frequency code must be ORed with these numbers to create a sound
HEX
  8000 CONSTANT OSC1      A000 CONSTANT OSC2   ( oscillators take 2 nibbles)
  C000 CONSTANT OSC3        E0 CONSTANT OSC4   ( noise takes 1 nibble)
 
\ Attenuation values are ORed with these values to change volume
( 0= max, 15 = off)
    90 CONSTANT ATT1         B0 CONSTANT ATT2
    D0 CONSTANT ATT3         F0 CONSTANT ATT4  ( OSC4 volume adjust)
 
\ timer array:  1 for each voice
CREATE TIMERS ( -- addr)  0 , 0 , 0 , 0 ,

\ names for each timer in the array
TIMERS   CONSTANT T1
T1 CELL+ CONSTANT T2
T2 CELL+ CONSTANT T3
T3 CELL+ CONSTANT T4
\ There are no 32 bit numbers in the CAMEL99 compilerBYE
 
\ so we create a double variable with primtives
: >DOUBLE  ( addr len -- d ) 0 0 2SWAP >NUMBER 2DROP ;
 
DECIMAL
S" 111761" >DOUBLE CREATE f(clk) ( -- d)  ,  ,  \ 32 bit int.
 
\ >FCODE re-arranges freq. value nibbles (4bits) for the TMS9919
HEX
 CODE >FCODE ( 0abc -- 0cab) \ version by Farmer Potato Atariage
             0B44 , \ TOS 4  SRC,  \ C0AB
             C204 , \ TOS W  MOV,  \ DUP
             0948 , \   W 4  SRL,  \ 0C0A
             D108 , \  W TOS MOVB, \ 0CAB
            NEXT,   \ 8 BYTES, 28 uS :-)
            ENDCODE
 
\ we set the "ACTIVE CHANNEL" with these variables
 VARIABLE OSC       \ holds the active OSC value
 VARIABLE ATT       \ holds the active ATTENUATOR value
 VARIABLE T         \ hold active timer address
 
\ convert freq. to 9919 chip code
DECIMAL
: HZ>CODE  ( freq -- fcode ) f(clk) 2@ ROT UM/MOD NIP >FCODE ;
 
HEX
\ **for testing**  print sound data to screen AND make sound
\ : SND!  ( c -- )  ." >"  BASE @ >R  HEX DUP U. 8400 C! R> BASE ! ;
 
\ Set the sound "GENerator that is active by assigning
\ timer, attenuator and oscillator
: GEN! ( osc att tmr -- )  T !  ATT !  OSC !  ;
 
\ ================================================================
\ S C I E N T I F I C   S O U N D   C O N T R O L   L E X I C O N
\ sound generator selectors
: VOX1    ( -- )  OSC1  ATT1 T1 GEN! ;
: VOX2    ( -- )  OSC2  ATT2 T2 GEN! ;
: VOX3    ( -- )  OSC3  ATT3 T3 GEN! ;
: VOX4    ( -- )  OSC4  ATT4 T4 GEN! ;
 
: NOISE   ( n -- ) 0F AND VOX4  OSC @ OR  SND! ;
 
: (HZ)    ( f -- n)   HZ>CODE  OSC @ OR  ;       \ convert freq. add OSC
: (DB)    ( level -- c)  ABS 2/  0F MIN ATT @ OR ; \ DB to attenuation
 
: HZ      ( f -- ) (HZ) SPLIT SND!  SND! ;
: DB      ( level -- ) (DB)  SND! ; \ Usage: -6 DB
: TICKS   ( time  -- ) T @  ! ;     \ DURATION
 
: MUTE    ( -- )  -30 DB  0 T @ ! ;
: SILENT  ( --)  9F SND!  BF SND!  DF SND!  FF SND! ;
 
CREATE TIMER-ISR
     R1 TIMERS LI,  \ R1=timer array address
     R2 8400   LI,  \ R2=sound port address
     R3 9F00   LI,  \ R3=attenuator "off"  value
     R5 TIMERS 4 CELLS + LI,  \ compute last timer address
     R0 CLR,
     BEGIN,
       R1 ** R0 CMP,           \ timer <>0
       NE IF,
          R1 ** DEC,          \ decrement timer
          EQ IF,
             R3 R2 ** MOVB,   \ mute attenuator
          ENDIF,
       ENDIF,
       R1 INCT,         \ next timer
       R3 2000 AI,      \ next attenuator
       R1 R5 CMP,       \ last timer?
    EQ UNTIL,
    RT,
    ENDCODE
 
HEX
: INSTALL   83C4 ! ;
 
: BG-ON   TIMER-ISR INSTALL ;
: BG-OFF          0 INSTALL ;
 
\ DECIMAL
\ : TEST
\   VOX1 120 HZ 0 DB  500 TICKS
\   VOX2 241 HZ 0 DB  550 TICKS
\   VOX3 482 HZ 0 DB  600 TICKS ; 

 

 

 

Link to comment
Share on other sites

Brian...

 

I am debating on how to handle this discussion of porting Stratego to fbForth 2.0—whether to break it out into its own thread; do it in a PM thread among you, Walid and me; or just keep it here in the main thread as I have done most times in the past (could be instructive to others passing through this thread). I will add you to the PM thread between Walid and me, in any event.

 

I agree with your objections to a straight-up transliteration from Basic. At the moment, I have the initialization code and main program code in TidBit files, which Walid graciously donated. I also have programmed a quick and dirty port of the splash screen. Walid is working on a flowchart, but I do not wish to put pressure on a very busy guy so we can start with the TidBit files, which are a lot easier to work from than trying to use the TidBit-generated XB files.

 

...lee

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