Files
rc2014-sid/sid.4th
2026-03-13 20:34:02 +00:00

151 lines
3.8 KiB
Forth

( --- Gforth SID chip stub --- )
( : PC! DUP 255 AND . 8 RSHIFT . . CR ; )
( : >< DUP 8 RSHIFT SWAP 8 LSHIFT 65534 AND OR ; )
( --- Library --- )
: PC2! ( b b p-addr -- ) ( Data byte A, high address byte B, port address C )
SWAP >< OR PC! ;
: BIT ( n -- ) ( define bit flag )
1 SWAP LSHIFT CONSTANT ;
: BIT+ ( n -- n+1 ) ( define bit flag and next )
DUP 1+ SWAP BIT ;
( --- SID chip access --- )
: SID! ( b n0-31 -- ) ( Send byte to SID { 1data , 4?register | 2?interrupt } )
2DUP 128 OR 84 PC2!
2DUP 127 AND 84 PC2!
128 OR 84 PC2! ;
( --- Voice selection --- )
CREATE VOICE-BASES 0 , 7 , 14 , ( { 3'base } )
CREATE VOICE-CTLS 0 , 0 , 0 , ( { 3clt-reg-shadow } )
: VOICE>BASE ( voice -- 'reg-no )
CELL * VOICE-BASES + ;
: VOICE>CTL ( voice -- 'ctl-addr )
CELL * VOICE-CTLS + ;
CREATE >VOICE-BASE VOICE-BASES ,
CREATE >VOICE-CTL VOICE-CTLS ,
: VOICE ( voice -- ) ( select SELECT voice )
DUP VOICE>BASE >VOICE-BASE ! VOICE>CTL >VOICE-CTL ! ;
( --- SID chip control register flags --- )
0 BIT+ GATE
BIT+ SYNC
BIT+ RING
BIT+ TEST
BIT+ TRI
BIT+ SAW
BIT+ PWM
BIT+ NOISE
DROP
( --- Voice register operation --- )
: VOICE! ( b n -- ) ( Store byte in selected voice register n )
>VOICE-BASE @ @ + SID! ;
: FREQ! ( n -- ) ( Reg 0,1 - Set frequency )
DUP 255 AND 0 VOICE! >< 255 AND 1 VOICE! ;
: PWM! ( n -- ) ( Reg 2,3 - Set pulse wave duty cycle )
DUP 255 AND 2 VOICE! >< 15 AND 3 VOICE! ;
: CTL! ( b -- ) ( Reg 4 - Set control register; write-through shadow )
DUP >VOICE-CTL @ ! 4 VOICE! ;
: ATK|DEC! ( n0-15 n0-15 -- ) ( Reg 5 - Set attack duration / decay duration )
15 AND SWAP 4 LSHIFT OR 5 VOICE! ;
: SUS|REL! ( n0-15 n0-15 -- ) ( Reg 6 - Set sustain level / release duration )
15 AND SWAP 4 LSHIFT OR 6 VOICE! ;
: START ( freq -- ) ( Start note at given frequency )
FREQ!
>VOICE-CTL @ @ GATE OR 4 VOICE! ;
: STOP ( -- ) ( Stop note )
>VOICE-CTL @ @ GATE INVERT AND 4 VOICE! ;
( --- Other registers operation --- )
: CUTOFF! ( n0-2047 -- ) ( Reg 21/22 - { 5?- | 11?filter-cutoff-frequency } )
DUP 7 AND 21 SID! 3 RSHIFT 255 AND 22 SID! ;
( Reg 23 - { 4?filter-resonance [0-15] | 1?ext | 1?voice-2 | 1?voice-1 | 1?voice-0 } )
: RES ( n0-15 -- b ) 15 AND 4 LSHIFT ;
: VOICE-FILTER ( voice -- b ) 1 SWAP LSHIFT ;
3 BIT EXT-FILTER
: RES|FILTER! ( b -- ) 23 SID! ;
( Reg 24 - { 1?mute-voice-3 | 1?highpass | 1?bandpass | 1?lowpass | 4?volume )
: VOLUME ( n0-15 -- b ) 15 AND ;
4 BIT+ LOWPASS
BIT+ BANDPASS
BIT+ HIGHPASS
BIT+ MUTE-VOICE3
DROP
: MODE|VOLUME! 24 SID! ;
( --- Frequency table --- )
: C4 4389 ;
: C4# 4650 ;
: D4 4927 ;
: D4# 5220 ;
: E4 5530 ;
: F4 5859 ;
: F4# 6207 ;
: G4 6577 ;
: G4# 6968 ;
: A4 7382 ;
: A4# 7821 ;
: B4 8286 ;
: /OCTAVE 2* ;
: \OCTAVE 2/ ;
( --- Reset --- )
: 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! ;
: SID-RESET ( Full SID chip reset )
2 VOICE VOICE-RESET 1 VOICE VOICE-RESET 0 VOICE VOICE-RESET OTHER-RESET ;
( --- Music --- )
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 ;
: DELAY ( delay -- ) 0 DO LOOP ;
: PAUSE ( delay -- ) DUP DELAY DELAY ;
: PLAY START DUP PAUSE 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