styling and cleanup

This commit is contained in:
2026-03-04 21:44:39 +00:00
parent b83d5400f9
commit db35d4709d
2 changed files with 111 additions and 304 deletions

View File

@@ -1,36 +0,0 @@
( PS2! c c p-addr -- Data byte A, high address byte B, port address C - OUT to port with A and B registers set
: PC2! SWAP >< OR PC! ;
( SID! c c -- Data value, register 0-31; bits 5,6 are for interrupt settings; bit 7 /CS is handled
: SID!
2DUP 128 OR 84 PC2!
2DUP 127 AND 84 PC2!
128 OR 84 PC2! ;
( Voice control register flags
: SID:CTL:GATE 1 ;
: SID:CTL:SYNC 2 ;
: SID:CTL:RING 4 ;
: SID:CTL:TEST 8 ;
: SID:CTL:TRI 16 ;
: SID:CTL:SAW 32 ;
: SID:CTL:PWM 64 ;
: SID:CTL:NOISE 128 ;
( Frequency table:
: SID:NOTE:C4 4389 ;
: SID:NOTE:C4# 4650 ;
: SID:NOTE:D4 4927 ;
: SID:NOTE:D4# 5220 ;
: SID:NOTE:E4 5530 ;
: SID:NOTE:F4 5859 ;
: SID:NOTE:F4# 6207 ;
: SID:NOTE:G4 6577 ;
: SID:NOTE:G4# 6968 ;
: SID:NOTE:A4 7382 ;
: SID:NOTE:A4# 7821 ;
: SID:NOTE:B4 8286 ;
( Octave shifts
: SID:OCT:UP 2* ;
: SID:OCT:DOWN 2/ ;
: SID:VOICE ( n -- )

379
sid.4th
View File

@@ -1,298 +1,141 @@
(--- SID chip access ---) ( --- Gforth SID chip stub --- )
: PC2! ( c c p-addr -- Data byte A, high address byte B, port address C - OUT to port with A and B registers set ) ( : SID! SWAP . . ." SID! " ; )
( : >< DUP 8 RSHIFT SWAP 8 LSHIFT 65534 AND OR ; )
( --- SID chip access --- )
: PC2! ( b b p-addr -- ) ( Data byte A, high address byte B, port address C )
SWAP >< OR PC! ; SWAP >< OR PC! ;
: SID! ( c c -- Data value, register 0-31; bits 5,6 are for interrupt settings; bit 7 /CS is handled ) : SID! ( b n0-31 -- ) ( Send byte to SID { 1data , 4?register | 2?interrupt } )
2DUP 128 OR 84 PC2! 2DUP 128 OR 84 PC2!
2DUP 127 AND 84 PC2! 2DUP 127 AND 84 PC2!
128 OR 84 PC2! ; 128 OR 84 PC2! ;
(--- SID chip control register flags ---) ( --- Voice selection --- )
: SID:CTL:GATE 1 ; CREATE VOICE-BASES 0 , 7 , 14 , ( { 3'base } )
: SID:CTL:SYNC 2 ; CREATE VOICE-CTLS 0 , 0 , 0 , ( { 3clt-reg-shadow } )
: SID:CTL:RING 4 ;
: SID:CTL:TEST 8 ;
: SID:CTL:TRI 16 ;
: SID:CTL:SAW 32 ;
: SID:CTL:PWM 64 ;
: SID:CTL:NOISE 128 ;
(--- Frequency table ---) : VOICE>BASE ( voice -- 'reg-no )
CELL * VOICE-BASES + ;
: VOICE>CTL ( voice -- 'ctl-addr )
CELL * VOICE-CTLS + ;
: SID:NOTE:C4 4389 ; CREATE >VOICE-BASE VOICE-BASES ,
: SID:NOTE:C4# 4650 ; CREATE >VOICE-CTL VOICE-CTLS ,
: SID:NOTE:D4 4927 ;
: SID:NOTE:D4# 5220 ;
: SID:NOTE:E4 5530 ;
: SID:NOTE:F4 5859 ;
: SID:NOTE:F4# 6207 ;
: SID:NOTE:G4 6577 ;
: SID:NOTE:G4# 6968 ;
: SID:NOTE:A4 7382 ;
: SID:NOTE:A4# 7821 ;
: SID:NOTE:B4 8286 ;
( Octave shifts ) : VOICE ( voice -- ) ( select SELECT voice )
: SID:OCT:UP 2* ; DUP VOICE>BASE >VOICE-BASE ! VOICE>CTL >VOICE-CTL ! ;
: SID:OCT:DOWN 2/ ;
(--- Direct access ---) ( --- SID chip control register flags --- )
( Voice 1 ) : GATE 1 ;
: SID0/1:FREQ! ( n -- Reg 0,1 - frequency voice 1 ) : SYNC 2 ;
DUP 255 AND 0 SID! >< 255 AND 1 SID! ; : RING 4 ;
: SID2/3:PWM! ( n -- Reg 2,3 - pulse wave duty cycle voice 2 ) : TEST 8 ;
DUP 255 AND 2 SID! >< 15 AND 3 SID! ; : TRI 16 ;
: SID4! ( c -- Reg 4 - control register voice 1 ) : SAW 32 ;
4 SID! ; : PWM 64 ;
: SID5:ATK/DEC! ( c -- Reg 5 - attack duration / decay duration voice 1 ) : NOISE 128 ;
15 AND SWAP 4 LSHIFT OR 5 SID! ;
: SID6:SUS/REL! ( c -- Reg 6 - sustain level / release duration voice 1 )
15 AND SWAP 4 LSHIFT OR 6 SID! ;
( Voice 2 ) ( --- Voice register operation --- )
: SID7/8:FREQ! ( n -- Reg 7,8 - frequency voice 2 )
DUP 255 AND 7 SID! >< 15 AND 8 SID! ;
: SID9/10:PWM! ( n -- Reg 9,10 - pulse wave duty cycle voice 2 )
DUP 255 AND 9 SID! >< 255 AND 10 SID! ;
: SID11! ( c -- Reg 10 - control register voice 2 )
11 SID! ;
: SID12:ATK/DEC! ( c -- Reg 12 - attack duration / decay duration voice 2 )
15 AND SWAP 4 LSHIFT OR 12 SID! ;
: SID13:SUS/REL! ( c -- Reg 13 - sustain level / release duration voice 2 )
15 AND SWAP 4 LSHIFT OR 13 SID! ;
( Voice 3 ) : VOICE! ( b n -- ) ( Store byte in selected voice register n )
: SID14/15:FREQ! ( n -- Reg 14,15 - frequency voice 3 ) >VOICE-BASE @ @ + SID! ;
DUP 255 AND 14 SID! >< 15 AND 15 SID! ;
: SID16/17:PWM! ( n -- Reg 16,17 - pulse wave duty cycle voice 3 )
DUP 255 AND 16 SID! >< 255 AND 17 SID! ;
: SID18! ( c -- Reg 18 - control register voice 18 )
18 SID! ;
: SID19:ATK/DEC! ( c -- Reg 19 - attack duration / decay duration voice 3 )
15 AND SWAP 4 LSHIFT OR 19 SID! ;
: SID20:SUS/REL! ( c -- Reg 20 - sustain level / release duration voice 3 )
15 AND SWAP 4 LSHIFT OR 20 SID! ;
( Filters ) : FREQ! ( n -- ) ( Reg 0,1 - Set frequency )
: SID21/22:CUT! ( n -- Reg 21/22 - filter cutoff frequency 0 - 2047 / 11 bits ) DUP 255 AND 0 VOICE! >< 255 AND 1 VOICE! ;
DUP 7 AND 21 SID! 3 RSHIFT 255 AND 22 SID! ; : PWM! ( n -- ) ( Reg 2,3 - Set pulse wave duty cycle )
( c -- c Reg 23 - filter resonance 0 - 15 / 4 bits, ext, voice 3, voice 2, voice 1 ) DUP 255 AND 2 VOICE! >< 15 AND 3 VOICE! ;
: SID23:RES 15 AND 4 LSHIFT ; : CTL! ( b -- ) ( Reg 4 - Set control register; write-through shadow )
: SID23:V1 1 OR ; DUP >VOICE-CTL @ ! 4 VOICE! ;
: SID23:V2 2 OR ; : ATK|DEC! ( n0-15 n0-15 -- ) ( Reg 5 - Set attack duration / decay duration )
: SID23:V3 4 OR ; 15 AND SWAP 4 LSHIFT OR 5 VOICE! ;
: SID23:EXT 8 OR ; : SUS|REL! ( n0-15 n0-15 -- ) ( Reg 6 - Set sustain level / release duration )
: SID23! ( c -- ) 15 AND SWAP 4 LSHIFT OR 6 VOICE! ;
23 SID! ;
( c -- c Reg 24 - filter mode and main volume control )
: SID24:VOL 15 AND ;
: SID24:LOWPASS 16 OR ;
: SID24:BANDPASS 32 OR ;
: SID24:HIGHPASS 64 OR ;
: SID24:MUTEVOICE3 128 OR ;
: SID24! ( c -- )
24 SID! ;
: SID:RST ( -- Put SID chip in known state ) : START ( freq -- ) ( Start note at given frequency )
4389 SID0/1:FREQ! 0 SID4! 4 2 SID5:ATK/DEC! 10 9 SID6:SUS/REL! 2048 SID2/3:PWM! FREQ!
4389 SID7/8:FREQ! 0 SID11! 4 2 SID12:ATK/DEC! 10 9 SID13:SUS/REL! 2048 SID9/10:PWM! >VOICE-CTL @ @ GATE OR 4 VOICE! ;
4389 SID14/15:FREQ! 0 SID18! 4 2 SID19:ATK/DEC! 10 9 SID20:SUS/REL! 2048 SID16/17:PWM! : STOP ( -- ) ( Stop note )
1024 SID21/22:CUT! 10 SID23:RES SID23! >VOICE-CTL @ @ GATE INVERT AND 4 VOICE! ;
15 SID24:VOL SID24! ;
( Voice contorl registers ) ( --- Other registers operation --- )
VARIABLE SID:V1:CTL
: SID:V1:CTL! ( c -- Set CTL register for voice 1 )
SID:V1:CTL ! ;
: SID:V1:NOTE:ON ( n -- Start note of given frequency )
SID0/1:FREQ! SID:V1:CTL @ SID:CTL:GATE OR SID4! ;
: SID:V1:NOTE:OFF ( -- Stop note )
SID:V1:CTL @ SID:CTL:GATE INVERT AND SID4! ;
VARIABLE SID:V2:CTL : CUTOFF! ( n0-2047 -- ) ( Reg 21/22 - { 5?- | 11?filter-cutoff-frequency } )
: SID:V2:CTL! ( c -- Set CTL register for voice 2 )
SID:V2:CTL ! ;
: SID:V2:NOTE:ON ( n -- Start note of given frequency )
SID7/8:FREQ! SID:V2:CTL @ SID:CTL:GATE OR SID11! ;
: SID:V2:NOTE:OFF ( -- Stop note )
SID:V2:CTL @ SID:CTL:GATE INVERT AND SID11! ;
VARIABLE SID:V3:CTL
: SID:V3:CTL! ( c -- Set CTL register for voice 3 )
SID:V3:CTL ! ;
: SID:V3:NOTE:ON ( n -- Start note of given frequency )
SID14/15:FREQ! SID:V3:CTL @ SID:CTL:GATE OR SID18! ;
: SID:V3:NOTE:OFF ( -- Stop note )
SID:V3:CTL @ SID:CTL:GATE INVERT AND SID18! ;
: DELAY 10000 0 DO LOOP ;
: SID:V1:TEST:NOTE
SID:CTL:TRI SID:V1:CTL!
SID:NOTE:C4 SID:V1:NOTE:ON
DELAY DELAY
SID:V1:NOTE:OFF ;
: SID:V2:TEST:NOTE
SID:CTL:SAW SID:V2:CTL!
SID:NOTE:D4 SID:OCT:UP SID:V2:NOTE:ON
DELAY DELAY
SID:V2:NOTE:OFF ;
: SID:V3:TEST:NOTE
SID:CTL:PWM SID:V3:CTL!
SID:NOTE:E4 SID:V3:NOTE:ON
DELAY DELAY
SID:V3:NOTE:OFF ;
: SID:TEST:MELODY
SID:V1:TEST:NOTE
SID:V2:TEST:NOTE
SID:V3:TEST:NOTE ;
: SID:TEST:FILTER
10 SID23:RES SID23:V1 SID23:V2 SID23:V3 SID23:EXT SID23!
15 SID24:VOL SID24:LOWPASS SID24!
SID:CTL:PWM SID:V1:CTL! SID:NOTE:D4 SID:V1:NOTE:ON
2047 0 DO I SID21/22:CUT! 1 +LOOP
SID:V1:NOTE:OFF
15 SID24:VOL SID24:BANDPASS SID24!
SID:CTL:PWM SID:V2:CTL! SID:NOTE:D4 SID:V2:NOTE:ON
2047 0 DO I SID21/22:CUT! 1 +LOOP
SID:V2:NOTE:OFF
15 SID24:VOL SID24:HIGHPASS SID24!
SID:CTL:PWM SID:V3:CTL! SID:NOTE:D4 SID:V3:NOTE:ON
2047 0 DO I SID21/22:CUT! 1 +LOOP
SID:V3:NOTE:OFF
0 SID23! ;
: SID:PLAY SID:V1:NOTE:ON DELAY SID:V1:NOTE:OFF ;
: SID:TEST:SONG
SID:CTL:TRI SID:V1:CTL!
SID:NOTE:G4 SID:PLAY
SID:NOTE:E4 SID:PLAY
SID:NOTE:E4 SID:PLAY
SID:NOTE:F4 SID:PLAY
SID:NOTE:D4 SID:PLAY
SID:NOTE:D4 SID:PLAY
SID:NOTE:C4 SID:PLAY
SID:NOTE:E4 SID:PLAY
SID:NOTE:G4 SID:PLAY
DELAY DELAY
SID:NOTE:G4 SID:PLAY
SID:NOTE:E4 SID:PLAY
SID:NOTE:E4 SID:PLAY
SID:NOTE:F4 SID:PLAY
SID:NOTE:D4 SID:PLAY
SID:NOTE:D4 SID:PLAY
SID:NOTE:C4 SID:PLAY
SID:NOTE:E4 SID:PLAY
SID:NOTE:C4 SID:PLAY ;
SID:RST
SID:TEST:MELODY
SID:TEST:FILTER
SID:TEST:SONG
(--- Voice selection ---)
CREATE SID:VOICE-BASES 0 , 7 , 14 , ( 3'base )
CREATE SID:VOICE-CTLS 0 , 0 , 0 , ( 3clt-reg-shadow )
: SID:VOICE-BASE-ADDR ( voice -- 'reg-no )
CELL * SID:VOICE-BASES + ;
: SID:VOICE-CTL-ADDR ( voice -- 'ctl-addr )
CELL * SID:VOICE-CTLS + ;
CREATE SID:VOICE-BASE-PTR SID:VOICE-BASES ,
CREATE SID:VOICE-CTL-PTR SID:VOICE-CTLS ,
: SID:SELECT-VOICE ( voice -- ) ( select SELECT voice )
DUP
SID:VOICE-BASE-ADDR SID:VOICE-BASE-PTR !
SID:VOICE-CTL-ADDR SID:VOICE-CTL-PTR ! ;
: SID:VOICE-REG-NO ( -- n ) ( Base SID register number for selected voice )
SID:VOICE-BASE-PTR @ @ ;
(--- Voice register ops ---)
: SID:VOICE! ( c n -- ) ( Store byte in selected voice register n )
SID:VOICE-REG-NO + SID! ;
: SID:VOICE-CTL ( -- a-addr ) ( Control register shadow for current voice )
SID:VOICE-CTL-PTR @ ;
: SID:VOICE-FREQ! ( n -- ) ( Reg 0,1 - Set frequency )
DUP 255 AND 0 SID:VOICE! >< 255 AND 1 SID:VOICE! ;
: SID:VOICE-PWM! ( n -- ) ( Reg 2,3 - Set pulse wave duty cycle )
DUP 255 AND 2 SID:VOICE! >< 15 AND 3 SID:VOICE! ;
: SID:VOICE-CTL! ( c -- ) ( Reg 4 - Set control register; write-through shadow )
DUP SID:VOICE-CTL ! 4 SID:VOICE! ;
: SID:VOICE-ATK/DEC! ( c -- ) ( Reg 5 - Set attack duration / decay duration )
15 AND SWAP 4 LSHIFT OR 5 SID:VOICE! ;
: SID:VOICE-SUS/REL! ( c -- ) ( Reg 6 - Set sustain level / release duration )
15 AND SWAP 4 LSHIFT OR 6 SID:VOICE! ;
: SID:VOICE-PLAY ( freq -- ) ( Start note at given frequency )
SID:VOICE-FREQ! SID:VOICE-CTL @ SID:CTL:GATE OR 4 SID:VOICE! ;
: SID:VOICE-STOP ( -- ) ( Stop note )
SID:VOICE-CTL @ SID:CTL:GATE INVERT AND 4 SID:VOICE! ;
(--- Other registers ---)
: SID:CUTOFF! ( n -- ) ( Reg 21/22 - Set filter cutoff frequency 0 - 2047 / 11 bits )
DUP 7 AND 21 SID! 3 RSHIFT 255 AND 22 SID! ; DUP 7 AND 21 SID! 3 RSHIFT 255 AND 22 SID! ;
( Reg 23 - filter resonance 0 - 15 / 4 bits, ext, voice 3, voice 2, voice 1 ) ( Reg 23 - { 4?filter-resonance [0-15] | 1?ext | 1?voice-2 | 1?voice-1 | 1?voice-0 } )
: SID:FILTER:RES 15 AND 4 LSHIFT ; : RES ( n0-15 -- b ) 15 AND 4 LSHIFT ;
: SID:FILTER:V1 1 OR ; : VOICE-FILTER ( voice -- b ) 1 SWAP LSHIFT ;
: SID:FILTER:V2 2 OR ; : EXT 8 ;
: SID:FILTER:V3 4 OR ; : RES|FILTER! ( b -- ) 23 SID! ;
: SID:EXT 8 OR ;
: SID:FILTER-RES-FLAGS!
23 SID! ;
( Reg 24 - filter mode and main volume control ) ( Reg 24 - { 1?mute-voice-3 | 1?highpass | 1?bandpass | 1?lowpass | 4?volume )
: SID:VOLUME 15 AND ; : VOLUME ( n0-15 -- b ) 15 AND ;
: SID:FILTER:LOWPASS 16 OR ; : LOWPASS 16 ;
: SID:FILTER:BANDPASS 32 OR ; : BANDPASS 32 ;
: SID:FILTER:HIGHPASS 64 OR ; : HIGHPASS 64 ;
: SID:MUTEVOICE3 128 OR ; : MUTE-VOICE3 128 ;
: SID:VOL-FILTER! : MODE|VOLUME! 24 SID! ;
24 SID! ;
(--- Reset ---) ( --- Frequency table --- )
: SID:VOICE-RST ( -- ) ( Reset selected voice state ) : C4 4389 ;
SID:NOTE:C4 SID:VOICE-FREQ! : C4# 4650 ;
2048 SID:VOICE-PWM! : D4 4927 ;
0 SID:VOICE-CTL! : D4# 5220 ;
4 2 SID:VOICE-ATK/DEC! : E4 5530 ;
10 9 SID:VOICE-SUS/REL! ; : F4 5859 ;
: F4# 6207 ;
: G4 6577 ;
: G4# 6968 ;
: A4 7382 ;
: A4# 7821 ;
: B4 8286 ;
: SID:OTHER-RST : /OCTAVE 2* ;
1024 SID:CUTOFF! : \OCTAVE 2/ ;
10 SID:FILTER:RES SID:FILTER-RES-FLAGS!
15 SID:VOLUME SID:VOL-FILTER! ;
: SID:RST ( Full SID chip reset ) ( --- Reset --- )
2 SID:SELECT-VOICE SID:VOICE-RST
1 SID:SELECT-VOICE SID:VOICE-RST
0 SID:SELECT-VOICE SID:VOICE-RST
SID:OTHER-RST ;
(--- Test ---) : VOICE-RESET C4 FREQ! 2048 PWM! 0 CTL! 4 2 ATK|DEC! 10 9 SUS|REL! ;
: OTHER-RESET 1024 CUTOFF! 10 RES RES|FILTER! 15 VOLUME MODE|VOLUME! ;
: DELAY 10000 0 DO LOOP ; : SID-RESET ( Full SID chip reset )
2 VOICE VOICE-RESET 1 VOICE VOICE-RESET 0 VOICE VOICE-RESET OTHER-RESET ;
: SID:TEST:NOTE ( --- Music --- )
SID:NOTE:C4 SID:VOICE-PLAY
DELAY DELAY
SID:VOICE-STOP ;
SID:RST CREATE TEMPO 40000 ,
: NOTE\\ ( whole note ) TEMPO @ ;
: NOTE\ ( half note ) NOTE\\ 1 RSHIFT ;
: NOTE ( quater note ) NOTE\\ 2 RSHIFT ;
: NOTE/ ( eight note ) NOTE\\ 3 RSHIFT ;
: NOTE// ( 1/16 ) NOTE\\ 3 RSHIFT ;
: NOTE/// ( 1/32 ) NOTE\\ 3 RSHIFT ;
SID:CTL:TRI SID:VOICE-CTL! ( Select triangle waveform ) : DELAY ( delay -- ) 0 DO LOOP ;
SID:TEST:NOTE : PAUSE ( delay -- ) DUP DELAY DELAY ;
: PLAY START DUP DELAY DELAY STOP ;
( --- Test --- )
: SONG
NOTE B4 PLAY NOTE/ PAUSE
NOTE A4 PLAY NOTE/ PAUSE
NOTE/ F4 PLAY NOTE/ G4 PLAY NOTE/ PAUSE
NOTE A4 PLAY NOTE/ PAUSE
NOTE/ F4 PLAY NOTE/ G4 PLAY NOTE/ PAUSE
NOTE A4 PLAY NOTE/ PAUSE
NOTE/ G4 PLAY NOTE/ F4 PLAY NOTE/ PAUSE
NOTE E4 PLAY NOTE/ PAUSE
;
SID-RESET
TRI CTL! ( Select triangle waveform )
NOTE/ C4 PLAY
SONG SONG