mirror of
https://github.com/dschmenk/PLASMA.git
synced 2024-06-10 02:29:30 +00:00
Add combined music player
This commit is contained in:
David Schmenk
parent
aa6224c140
commit
20fe2ca140
874
src/mockingboard/seqplay.pla
Executable file
874
src/mockingboard/seqplay.pla
Executable file
|
|
@ -0,0 +1,874 @@
|
|||
//
|
||||
// Usage is documented following the source in this file...
|
||||
//
|
||||
const rndseed = $004E
|
||||
const FALSE = 0
|
||||
const TRUE = !FALSE
|
||||
const LSB = 0
|
||||
const MSB = 1
|
||||
const MB_ARPEGGIO = 4 // In 16ths of a second
|
||||
const MAX_MBCH_NOTES = 9
|
||||
const SPKR_ARPEGGIO = 2 // In 16ths of a second
|
||||
const DUR16TH = 8
|
||||
const MAX_SPKR_NOTES = 4
|
||||
const NOTEDIV = 4
|
||||
//
|
||||
// 6522 VIA registers
|
||||
//
|
||||
struc t_VIA
|
||||
byte IORB // I/O Register B
|
||||
byte IORA // I/O Register A
|
||||
byte DDRB // Data Direction Register B
|
||||
byte DDRA // Data Direction Register A
|
||||
word T1C // Timer 1 Count
|
||||
word T1L // Timer 1 Latch
|
||||
word T2C // Timer 2 Count
|
||||
byte SR // Shift Register
|
||||
byte ACR // Aux Control Register
|
||||
byte PCR // Peripheral Control Register
|
||||
byte IFR // Interrupt Flag Register
|
||||
byte IER // Interrupt Enable Register
|
||||
byte IOA_noHS // I/O Register A - no HandShake
|
||||
end
|
||||
const T1CH = T1C+1
|
||||
//
|
||||
// AY-3-8910 PSG registers
|
||||
//
|
||||
struc t_PSG
|
||||
word AFREQ // A Frequency Period
|
||||
word BFREQ // B Frequency Period
|
||||
word CFREQ // C Frequency Period
|
||||
byte NGFREQ // Noise Generator Frequency Period
|
||||
byte MIXER // Enable=0/Disable=1 NG C(5) B(4) A(3) Tone C(2) B(1) A(0)
|
||||
byte AENVAMP // A Envelope/Amplitude
|
||||
byte BENVAMP // B Envelope/Amplitude
|
||||
byte CENVAMP // C Envelope/Amplitude
|
||||
word ENVPERIOD // Envelope Period
|
||||
byte ENVSHAPE // Envelope Shape
|
||||
end
|
||||
//
|
||||
// Sequence event
|
||||
//
|
||||
struc t_event
|
||||
byte deltatime // Event delta time in 4.4 seconds
|
||||
byte percnote // Percussion:7==0 ? Pitch:4-0 : Octave:6-4,Note:3-0
|
||||
byte perchanvol // Percussion ? EnvDur:7-0 : Channel:7,Volume:3-0
|
||||
end
|
||||
//
|
||||
// Predef routines
|
||||
//
|
||||
predef musicPlay(track, rept)#0
|
||||
predef musicStop#0
|
||||
predef backgroundProc#0
|
||||
//
|
||||
// Static sequencer values
|
||||
//
|
||||
word seqTrack, seqEvent, seqTime, eventTime, updateTime, musicSequence
|
||||
byte numNotes, seqRepeat
|
||||
byte indexA[2], indexB[2], indexC[2]
|
||||
byte noteA[2], noteB[2], noteC[2]
|
||||
word notes1[MAX_MBCH_NOTES], notes2[MAX_MBCH_NOTES]
|
||||
word notes[2] = @notes1, @notes2
|
||||
word periods1[MAX_MBCH_NOTES], periods2[MAX_MBCH_NOTES]
|
||||
word periods[2] = @periods1, @periods2
|
||||
//
|
||||
// MockingBoard data.
|
||||
//
|
||||
word[] mbVIAs // Treat this as an array of VIA ptrs
|
||||
word mbVIA1 = -1 // Init to "discover MockingBoard flag" value
|
||||
word mbVIA2 = 0
|
||||
//
|
||||
// Octave basis frequency periods (starting at MIDI note #12)
|
||||
// Notes will be encoded as basis note (LSNibble) and octave (MSNibble))
|
||||
//
|
||||
word[] spkrOctave0 // Overlay and scale mbOctave0 for speaker version
|
||||
word[12] mbOctave0 = 3900, 3681, 3474, 3279, 3095, 2922, 2758, 2603, 2457, 2319, 2189, 2066
|
||||
word[5] arpeggioDuration = DUR16TH, DUR16TH, DUR16TH/2, DUR16TH/3, DUR16TH/4
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
//
|
||||
// These are utility sequences/routines needed to test the music sequencer code.
|
||||
//
|
||||
asm toneTrack
|
||||
include "ultima3.seq"
|
||||
end
|
||||
asm putc(ch)#0
|
||||
LDA ESTKL,X
|
||||
INX
|
||||
ORA #$80
|
||||
JMP $FDED
|
||||
end
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
//
|
||||
// Emulators are broken - they only activate the MockingBoard's 6522 Timer1
|
||||
// functionality when interrupts are enabled. This music sequencer is run
|
||||
// in polling mode without the use of MockingBoard interrupts. To work around
|
||||
// the emulators, MockingBoard interrupts are enabled, but the 6502 IRQs are
|
||||
// disabled. NO INTERRUPTS ARE HANDLED WHEN PLAYING MUSIC! The previous state
|
||||
// is restored between playing sequences.
|
||||
//
|
||||
asm getStatusReg#1
|
||||
PHP
|
||||
PLA
|
||||
DEX
|
||||
STA ESTKL,X
|
||||
LDA #$00
|
||||
STA ESTKH,X
|
||||
RTS
|
||||
end
|
||||
asm setStatusReg(stat)#0
|
||||
LDA ESTKL,X
|
||||
INX
|
||||
PHA
|
||||
PLP
|
||||
RTS
|
||||
end
|
||||
asm disableInts#0
|
||||
SEI
|
||||
RTS
|
||||
end
|
||||
asm enableInts#0
|
||||
CLI
|
||||
RTS
|
||||
end
|
||||
//
|
||||
// Write Programmable Sound Generator Registers
|
||||
//
|
||||
asm psgWriteTone(pVIA, reg, freq, vol)#0
|
||||
LDA ESTKL+3,X
|
||||
STA TMPL
|
||||
LDA ESTKH+3,X
|
||||
STA TMPH
|
||||
LDY #$01
|
||||
LDA ESTKL+2,X
|
||||
LSR
|
||||
ADC #$08
|
||||
STA (TMP),Y
|
||||
DEY
|
||||
LDA #$07
|
||||
STA (TMP),Y
|
||||
LDA #$04
|
||||
STA (TMP),Y
|
||||
LDA ESTKL,X
|
||||
INY
|
||||
STA (TMP),Y
|
||||
DEY
|
||||
LDA #$06
|
||||
STA (TMP),Y
|
||||
LDA #$04
|
||||
STA (TMP),Y
|
||||
INX
|
||||
BNE +
|
||||
end
|
||||
asm psgWriteWord(pVIA, reg, val)#0
|
||||
LDA ESTKL+2,X
|
||||
STA TMPL
|
||||
LDA ESTKH+2,X
|
||||
STA TMPH
|
||||
+ LDY #$01
|
||||
TYA
|
||||
CLC
|
||||
ADC ESTKL+1,X
|
||||
STA (TMP),Y
|
||||
DEY
|
||||
LDA #$07
|
||||
STA (TMP),Y
|
||||
LDA #$04
|
||||
STA (TMP),Y
|
||||
LDA ESTKH,X
|
||||
INY
|
||||
STA (TMP),Y
|
||||
DEY
|
||||
LDA #$06
|
||||
STA (TMP),Y
|
||||
LDA #$04
|
||||
STA (TMP),Y
|
||||
BNE +
|
||||
end
|
||||
asm psgWrite(pVIA, reg, val)#0
|
||||
LDA ESTKL+2,X
|
||||
STA TMPL
|
||||
LDA ESTKH+2,X
|
||||
STA TMPH
|
||||
+ LDY #$01
|
||||
LDA ESTKL+1,X
|
||||
STA (TMP),Y
|
||||
DEY
|
||||
LDA #$07
|
||||
STA (TMP),Y
|
||||
LDA #$04
|
||||
STA (TMP),Y
|
||||
LDA ESTKL,X
|
||||
INY
|
||||
STA (TMP),Y
|
||||
DEY
|
||||
LDA #$06
|
||||
STA (TMP),Y
|
||||
LDA #$04
|
||||
STA (TMP),Y
|
||||
INX
|
||||
INX
|
||||
INX
|
||||
RTS
|
||||
end
|
||||
//
|
||||
// Apple II speaker tone generator routines
|
||||
//
|
||||
export asm spkrTone(pitch, duration)#0
|
||||
STX ESP
|
||||
LDY ESTKH,X
|
||||
LDA ESTKL,X
|
||||
BEQ +
|
||||
INY
|
||||
+ STA DSTL
|
||||
STY DSTH
|
||||
LDY ESTKH+1,X
|
||||
LDA ESTKL+1,X
|
||||
BEQ +
|
||||
INY
|
||||
+ STA TMPL
|
||||
STY TMPH
|
||||
TAX
|
||||
LDA #$FF
|
||||
PHP
|
||||
SEI
|
||||
;
|
||||
; Total loop count is 32 cycles, regardless of path taken
|
||||
;
|
||||
- NOP ; 2
|
||||
NOP ; 2
|
||||
BCS + ; 3
|
||||
;---
|
||||
;+7 = 12 (from BCS below)
|
||||
+
|
||||
-- SEC ; 2
|
||||
DEX ; 2
|
||||
BNE ++ ; 2/3
|
||||
;----
|
||||
; 6/7
|
||||
|
||||
DEY ; 2
|
||||
BNE +++ ; 2/3
|
||||
;----
|
||||
;+4/5 = 10/11
|
||||
|
||||
BIT $C030 ; 4
|
||||
LDX TMPL ; 3
|
||||
LDY TMPH ; 3
|
||||
;---
|
||||
;+10 = 20
|
||||
|
||||
TONELP SBC #$01 ; 2
|
||||
BCS - ; 2/3
|
||||
;----
|
||||
; 4/5
|
||||
|
||||
DEC DSTL ; 5
|
||||
BNE -- ; 3
|
||||
;----
|
||||
;+8 = 12
|
||||
|
||||
DEC DSTH ; This sequence isn't accounted for
|
||||
BNE -- ; since it is taken only in extreme cases
|
||||
BEQ TONEXIT
|
||||
|
||||
++ NOP ; 2
|
||||
NOP ; 2
|
||||
;---
|
||||
;+4 = 11 (from BNE above)
|
||||
|
||||
+++ BIT $C000 ; 4
|
||||
BMI TONEXIT ; 2
|
||||
BPL TONELP ; 3
|
||||
;---
|
||||
;+9 = 20
|
||||
TONEXIT PLP
|
||||
LDX ESP
|
||||
INX
|
||||
INX
|
||||
RTS
|
||||
end
|
||||
export asm spkrPWM(sample, speed, len)#0
|
||||
STX ESP
|
||||
LDY ESTKH,X
|
||||
LDA ESTKL,X
|
||||
BEQ +
|
||||
INY
|
||||
+ STY DSTH
|
||||
STA DSTL
|
||||
LDA ESTKL+2,X
|
||||
STA SRCL
|
||||
LDA ESTKH+2,X
|
||||
STA SRCH
|
||||
LDY ESTKL+1,X
|
||||
INY
|
||||
STY TMPL
|
||||
LDY #$00
|
||||
PHP
|
||||
SEI
|
||||
- LDA (SRC),Y
|
||||
SEC
|
||||
-- LDX TMPL
|
||||
--- DEX
|
||||
BNE ---
|
||||
SBC #$01
|
||||
BCS --
|
||||
BIT $C030
|
||||
INY
|
||||
BNE +
|
||||
INC SRCH
|
||||
+ DEC DSTL
|
||||
BNE -
|
||||
DEC DSTH
|
||||
BNE -
|
||||
PLP
|
||||
LDX ESP
|
||||
INX
|
||||
INX
|
||||
INX
|
||||
RTS
|
||||
end
|
||||
//
|
||||
// Search slots for MockingBoard
|
||||
//
|
||||
def mbTicklePSG(pVIA)
|
||||
pVIA->IER = $7F // Mask all interrupts
|
||||
pVIA->ACR = $00 // Stop T1 countdown
|
||||
pVIA->DDRB = $FF // Output enable port A and B
|
||||
pVIA->DDRA = $FF
|
||||
pVIA->IORA = $00 // Reset MockingBoard
|
||||
if pVIA->IORA == $00
|
||||
pVIA->IORA = $04 // Inactive MockingBoard control lines
|
||||
if pVIA->IORA == $04
|
||||
//
|
||||
// At least we know we have some sort of R/W in the ROM
|
||||
// address space. Most likely a MockingBoard or John Bell
|
||||
// 6522 board. We will assume its a MockingBoard because
|
||||
// emulators fail the following PSG read test.
|
||||
//
|
||||
//psgWriteWord(pVIA, 2, $DA7E)
|
||||
//if mbReadP(pVIA, 2) == $7E and mbReadP(pVIA, 3) == $0A
|
||||
return pVIA
|
||||
//fin
|
||||
fin
|
||||
fin
|
||||
return 0
|
||||
end
|
||||
def mbSearch(slot)
|
||||
if slot
|
||||
mbVIA1 = mbTicklePSG($C000 + (slot << 8))
|
||||
if mbVIA1
|
||||
mbVIA2 = mbTicklePSG(mbVIA1 + $80)
|
||||
return slot
|
||||
fin
|
||||
else
|
||||
for slot = 1 to 7
|
||||
if slot == 3 or slot == 6
|
||||
continue
|
||||
fin
|
||||
mbVIA1 = mbTicklePSG($C000 + (slot << 8))
|
||||
if mbVIA1
|
||||
mbVIA2 = mbTicklePSG(mbVIA1 + $80)
|
||||
return slot
|
||||
fin
|
||||
next
|
||||
fin
|
||||
return 0
|
||||
end
|
||||
def psgSetup(pVIA)#0
|
||||
psgWrite(pVIA, MIXER, $3F) // Turn everything off
|
||||
psgWrite(pVIA, AENVAMP, $00)
|
||||
psgWrite(pVIA, BENVAMP, $00)
|
||||
psgWrite(pVIA, CENVAMP, $10)
|
||||
psgWrite(pVIA, NGFREQ, $01)
|
||||
psgWriteWord(pVIA, ENVPERIOD, $0001)
|
||||
psgWrite(pVIA, ENVSHAPE, $00) // Single decay
|
||||
psgWriteWord(pVIA, AFREQ, $0000) // Fast response to update
|
||||
psgWriteWord(pVIA, BFREQ, $0000)
|
||||
psgWriteWord(pVIA, CFREQ, $0000)
|
||||
psgWrite(pVIA, MIXER, $38) // Tone on C, B, A
|
||||
end
|
||||
//
|
||||
// Sequence notes through MockingBoard
|
||||
//
|
||||
def mbSequence(yield, func)#0
|
||||
word period, n, yieldTime
|
||||
byte note, volume, channel, i, overflow, status, quit
|
||||
|
||||
//
|
||||
// Reset oscillator table
|
||||
//
|
||||
indexA[0] = 0; indexA[1] = 0
|
||||
indexB[0] = 1; indexB[1] = 1
|
||||
indexC[0] = 2; indexC[1] = 2
|
||||
noteA[0] = 0; noteA[1] = 0
|
||||
noteB[0] = 0; noteB[1] = 0
|
||||
noteC[0] = 0; noteC[1] = 0
|
||||
//
|
||||
// Get the PSGs ready
|
||||
//
|
||||
status = getStatusReg
|
||||
disableInts
|
||||
mbVIA1->ACR = $40 // Continuous T1 interrupts
|
||||
mbVIA1=>T1L = $F9C2 // 16 Ints/sec
|
||||
mbVIA1=>T1C = $F9C2 // 16 Ints/sec
|
||||
mbVIA1->IFR = $40 // Clear interrupt
|
||||
mbVIA1->IER = $C0 // Enable Timer1 interrupt
|
||||
psgSetup(mbVIA1)
|
||||
if mbVIA2; psgSetup(mbVIA2); fin
|
||||
overflow = 0
|
||||
if yield and func
|
||||
yieldTime = seqTime + yield
|
||||
else
|
||||
yieldTime = $7FFF
|
||||
fin
|
||||
updateTime = seqTime
|
||||
quit = FALSE
|
||||
repeat
|
||||
while eventTime == seqTime
|
||||
note = seqEvent->percnote
|
||||
if note & $80
|
||||
//
|
||||
// Note event
|
||||
//
|
||||
volume = seqEvent->perchanvol
|
||||
channel = (volume & mbVIA2.LSB) >> 7 // Clever - mbVIA2.0 will be $80 if it exists
|
||||
if volume & $0F
|
||||
//
|
||||
// Note on
|
||||
//
|
||||
for i = 0 to MAX_MBCH_NOTES-1
|
||||
//
|
||||
// Look for available slot in active note table
|
||||
//
|
||||
if !notes[channel, i].LSB //or notes[channel, i] == note
|
||||
break
|
||||
fin
|
||||
next
|
||||
//
|
||||
// Full note table, kick one out
|
||||
//
|
||||
if i == MAX_MBCH_NOTES
|
||||
i = overflow
|
||||
overflow = (overflow + 1) % MAX_MBCH_NOTES
|
||||
else
|
||||
numNotes++
|
||||
fin
|
||||
notes[channel, i] = note | (volume << 8)
|
||||
periods[channel, i] = mbOctave0[note & $0F] >> ((note >> 4) & $07)
|
||||
else
|
||||
//
|
||||
// Note off
|
||||
//
|
||||
for i = 0 to MAX_MBCH_NOTES-1
|
||||
//
|
||||
// Remove from active note table
|
||||
//
|
||||
if notes[channel, i].LSB == note
|
||||
notes[channel, i] = 0
|
||||
numNotes--
|
||||
break
|
||||
fin
|
||||
next
|
||||
fin
|
||||
updateTime = seqTime
|
||||
else
|
||||
//
|
||||
// Percussion event
|
||||
//
|
||||
period = seqEvent->perchanvol
|
||||
if period
|
||||
psgWrite(mbVIA1, MIXER, $1C) // NG on C, Tone on B, A
|
||||
psgWrite(mbVIA1, CENVAMP, $10)
|
||||
psgWrite(mbVIA1, NGFREQ, note)
|
||||
psgWrite(mbVIA1, ENVPERIOD+1, period)
|
||||
psgWrite(mbVIA1, ENVSHAPE, $00) // Single decay
|
||||
if mbVIA2
|
||||
psgWrite(mbVIA2, MIXER, $1C) // NG on C, Tone on B, A
|
||||
psgWrite(mbVIA2, CENVAMP, $10)
|
||||
psgWrite(mbVIA2, NGFREQ, note)
|
||||
psgWrite(mbVIA2, ENVPERIOD+1, period)
|
||||
psgWrite(mbVIA2, ENVSHAPE, $00) // Single decay
|
||||
fin
|
||||
else
|
||||
if seqRepeat
|
||||
//
|
||||
// Reset sequence
|
||||
//
|
||||
musicPlay(seqTrack, TRUE)
|
||||
seqTime = -1 // Offset seqTime++ later
|
||||
else
|
||||
musicStop
|
||||
fin
|
||||
quit = TRUE // Exit out
|
||||
break
|
||||
fin
|
||||
fin
|
||||
//
|
||||
// Next event
|
||||
//
|
||||
seqEvent = seqEvent + t_event
|
||||
eventTime = seqEvent->deltatime + eventTime
|
||||
loop
|
||||
if updateTime <= seqTime
|
||||
//
|
||||
// Time slice active note tables (arpeggio)
|
||||
//
|
||||
for channel = 0 to 1
|
||||
//
|
||||
// Multiplex oscillator A
|
||||
//
|
||||
i = indexA[channel]
|
||||
repeat
|
||||
i = (i + 3) % MAX_MBCH_NOTES
|
||||
n = notes[channel, i]
|
||||
if n // Non-zero volume
|
||||
break
|
||||
fin
|
||||
until i == indexA[channel]
|
||||
if n.LSB <> noteA[channel]
|
||||
psgWriteTone(mbVIAs[channel], AFREQ, periods[channel, i], n.MSB)
|
||||
noteA[channel] = n.LSB
|
||||
indexA[channel] = i
|
||||
fin
|
||||
//
|
||||
// Multiplex oscillator B
|
||||
//
|
||||
i = indexB[channel]
|
||||
repeat
|
||||
i = (i + 3) % MAX_MBCH_NOTES
|
||||
n = notes[channel, i]
|
||||
if n // Non-zero volume
|
||||
break
|
||||
fin
|
||||
until i == indexB[channel]
|
||||
if n.LSB <> noteB[channel]
|
||||
psgWriteTone(mbVIAs[channel], BFREQ, periods[channel, i], n.MSB)
|
||||
noteB[channel] = n.LSB
|
||||
indexB[channel] = i
|
||||
fin
|
||||
//
|
||||
// Multiplex oscillator C
|
||||
//
|
||||
i = indexC[channel]
|
||||
repeat
|
||||
i = (i + 3) % MAX_MBCH_NOTES
|
||||
n = notes[channel, i]
|
||||
if n // Non-zero volume
|
||||
break
|
||||
fin
|
||||
until i == indexC[channel]
|
||||
if n.LSB <> noteC[channel]
|
||||
psgWrite(mbVIAs[channel], MIXER, $38) // Tone on C, B, A
|
||||
psgWriteTone(mbVIAs[channel], CFREQ, periods[channel, i], n.MSB)
|
||||
noteC[channel] = n.LSB
|
||||
indexC[channel] = i
|
||||
fin
|
||||
next
|
||||
updateTime = seqTime + MB_ARPEGGIO - (numNotes >> 2)
|
||||
fin
|
||||
//
|
||||
// Increment time tick
|
||||
//
|
||||
seqTime++
|
||||
while !(mbVIA1->IFR & $40) // Wait for T1 interrupt
|
||||
if ^$C000 > 127; quit = TRUE; break; fin
|
||||
*rndseed++
|
||||
loop
|
||||
mbVIA1->IFR = $40 // Clear interrupt
|
||||
if yieldTime <= seqTime; func()#0; yieldTime = seqTime + yield; fin
|
||||
until quit
|
||||
psgWrite(mbVIA1, MIXER, $FF) // Turn everything off
|
||||
psgWrite(mbVIA1, AENVAMP, $00)
|
||||
psgWrite(mbVIA1, BENVAMP, $00)
|
||||
psgWrite(mbVIA1, CENVAMP, $00)
|
||||
if mbVIA2
|
||||
psgWrite(mbVIA2, MIXER, $FF)
|
||||
psgWrite(mbVIA2, AENVAMP, $00)
|
||||
psgWrite(mbVIA2, BENVAMP, $00)
|
||||
psgWrite(mbVIA2, CENVAMP, $00)
|
||||
fin
|
||||
mbVIA1->ACR = $00 // Stop T1 countdown
|
||||
mbVIA1->IER = $7F // Mask all interrupts
|
||||
mbVIA1->IFR = $40 // Clear interrupt
|
||||
setStatusReg(status))
|
||||
end
|
||||
//
|
||||
// Sequence notes through Apple II speaker
|
||||
//
|
||||
def spkrSequence(yield, func)#0
|
||||
word period, duration, yieldTime
|
||||
byte note, i, n, overflow
|
||||
|
||||
//
|
||||
// Start sequencing
|
||||
//
|
||||
overflow = 0
|
||||
if yield and func
|
||||
yieldTime = seqTime + yield
|
||||
else
|
||||
yieldTime = $7FFF
|
||||
fin
|
||||
updateTime = seqTime
|
||||
repeat
|
||||
while eventTime == seqTime
|
||||
note = seqEvent->percnote
|
||||
if note & $80
|
||||
//
|
||||
// Note event
|
||||
//
|
||||
if seqEvent->perchanvol & $0F
|
||||
//
|
||||
// Note on
|
||||
//
|
||||
for i = 0 to MAX_SPKR_NOTES-1
|
||||
//
|
||||
// Look for available slot in active note table
|
||||
//
|
||||
if !notes1[i] or note == notes1[i]
|
||||
break
|
||||
fin
|
||||
next
|
||||
if i == MAX_SPKR_NOTES
|
||||
//
|
||||
// Full note table, kick one out
|
||||
//
|
||||
overflow = (overflow + 1) & (MAX_SPKR_NOTES-1)
|
||||
i = overflow
|
||||
elsif !notes1[i]
|
||||
//
|
||||
// Add new note
|
||||
//
|
||||
numNotes++
|
||||
fin
|
||||
notes1[i] = note
|
||||
periods1[i] = spkrOctave0[note & $0F] >> ((note >> 4) & $07)
|
||||
else
|
||||
//
|
||||
// Note off
|
||||
//
|
||||
for i = 0 to MAX_SPKR_NOTES-1
|
||||
//
|
||||
// Remove from active note table
|
||||
//
|
||||
if notes1[i] == note
|
||||
notes1[i] = 0
|
||||
numNotes--
|
||||
break
|
||||
fin
|
||||
next
|
||||
fin
|
||||
else
|
||||
//
|
||||
// Percussion event
|
||||
//
|
||||
if seqEvent->perchanvol
|
||||
spkrPWM($D000, 0, 64) // Play some random sample as percussion
|
||||
else
|
||||
if seqRepeat
|
||||
musicPlay(seqTrack, TRUE)
|
||||
else
|
||||
musicStop
|
||||
fin
|
||||
return
|
||||
fin
|
||||
fin
|
||||
//
|
||||
// Next event
|
||||
//
|
||||
seqEvent = seqEvent + t_event
|
||||
eventTime = eventTime + seqEvent->deltatime
|
||||
loop
|
||||
if numNotes > 1
|
||||
for i = 0 to MAX_SPKR_NOTES-1
|
||||
if notes1[i]
|
||||
spkrTone(periods1[i], arpeggioDuration[numNotes])
|
||||
fin
|
||||
*rndseed++
|
||||
next
|
||||
seqTime++
|
||||
else
|
||||
period = 0
|
||||
for i = 0 to MAX_SPKR_NOTES-1
|
||||
if notes1[i]
|
||||
period = periods1[i]
|
||||
break;
|
||||
fin
|
||||
*rndseed++
|
||||
next
|
||||
duration = eventTime - seqTime
|
||||
seqTime = duration + seqTime
|
||||
spkrTone(period, DUR16TH * duration)
|
||||
fin
|
||||
if ^$C000 > 127; return; fin
|
||||
if yieldTime <= seqTime; func()#0; yieldTime = seqTime + yield; fin
|
||||
until FALSE
|
||||
end
|
||||
//
|
||||
// No sequence, just waste time and yield
|
||||
//
|
||||
def noSequence(yield, func)#0
|
||||
//
|
||||
// Start wasting time
|
||||
//
|
||||
if !yield or !func
|
||||
yield = 0
|
||||
fin
|
||||
seqTime = 0
|
||||
repeat
|
||||
seqTime++
|
||||
if seqTime < 0; seqTime = 1; fin // Capture wrap-around
|
||||
*rndseed++
|
||||
spkrTone(0, DUR16TH) // Waste 16th of a second playing silence
|
||||
if ^$C000 > 127; return; fin
|
||||
if yield == seqTime; func()#0; seqTime = 0; fin
|
||||
until FALSE
|
||||
end
|
||||
//
|
||||
// Start sequencing music track
|
||||
//
|
||||
export def musicPlay(track, rept)#0
|
||||
byte i
|
||||
|
||||
//
|
||||
// First time search for MockingBoard
|
||||
//
|
||||
if mbVIA1 == -1
|
||||
if !mbSearch(0)
|
||||
//
|
||||
// No MockingBoard - scale octave0 for speaker
|
||||
//
|
||||
for i = 0 to 11
|
||||
spkrOctave0[i] = mbOctave0[i]/NOTEDIV
|
||||
next
|
||||
fin
|
||||
fin
|
||||
//
|
||||
// Zero out active notes
|
||||
//
|
||||
for i = 0 to MAX_MBCH_NOTES-1; notes1[i] = 0; notes2[i] = 0; next
|
||||
for i = 0 to MAX_MBCH_NOTES-1; periods1[i] = 0; periods2[i] = 0; next
|
||||
//
|
||||
// Start sequencing
|
||||
//
|
||||
seqRepeat = rept
|
||||
seqTrack = track
|
||||
seqEvent = seqTrack
|
||||
seqTime = 0
|
||||
eventTime = seqEvent->deltatime
|
||||
numNotes = 0
|
||||
//
|
||||
// Select proper sequencer based on hardware
|
||||
//
|
||||
if mbVIA1
|
||||
musicSequence = @mbSequence
|
||||
else
|
||||
musicSequence = @spkrSequence
|
||||
fin
|
||||
end
|
||||
//
|
||||
// Stop sequencing music track
|
||||
//
|
||||
export def musicStop#0
|
||||
musicSequence = @noSequence
|
||||
end
|
||||
//
|
||||
// Get a keystroke and convert it to upper case
|
||||
//
|
||||
export def getUpperKey#1
|
||||
byte key
|
||||
|
||||
while ^$C000 < 128
|
||||
musicSequence($08, @backgroundProc)#0 // Call background proc every half second
|
||||
loop
|
||||
key = ^$C000 & $7F
|
||||
^$C010
|
||||
if key >= 'a' and key <= 'z'
|
||||
key = key - $20
|
||||
fin
|
||||
return key
|
||||
end
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
//
|
||||
// More utility routines to test the getUpperKey routine
|
||||
//
|
||||
def putln#0
|
||||
putc($0D)
|
||||
end
|
||||
def puts(str)#0
|
||||
byte i
|
||||
|
||||
for i = 1 to ^str
|
||||
putc(^(str+i))
|
||||
next
|
||||
end
|
||||
//
|
||||
// Sample background process
|
||||
//
|
||||
def backgroundProc#0
|
||||
^$0400++
|
||||
end
|
||||
//
|
||||
// Test functionality
|
||||
//
|
||||
def test#0
|
||||
byte key
|
||||
|
||||
puts("Press <RETURN> to exit:")
|
||||
while TRUE
|
||||
key = getUpperKey
|
||||
when key
|
||||
is $0D
|
||||
return
|
||||
is 'P'
|
||||
musicPlay(@toneTrack, TRUE)
|
||||
break
|
||||
is 'S'
|
||||
musicStop
|
||||
break
|
||||
otherwise
|
||||
putc(key)
|
||||
wend
|
||||
loop
|
||||
end
|
||||
|
||||
musicPlay(@toneTrack, TRUE)
|
||||
test
|
||||
musicStop
|
||||
done
|
||||
////////////////////////////////////////////////////////////////////////////////
|
||||
|
||||
There are three main externally callable routines in this module:
|
||||
|
||||
musicPlay(trackPtr, trackRepeat)
|
||||
Start playing a track sequence in the getUpperKey routine
|
||||
Params:
|
||||
Pointer to a track sequence created from the cvtmidi.py tool
|
||||
Repeat flag - TRUE or FALSE.
|
||||
|
||||
musicStop()
|
||||
Stop playing a track sequence in the getUpperKey routine
|
||||
The getUpperKey routine will call a dummy sequence routine that will
|
||||
keep the correct timing for any background processing
|
||||
|
||||
getUpperKey()
|
||||
Wait for a keypress and return the upper case character
|
||||
While waiting for the keypress, the track sequence will be played though
|
||||
either the MockingBoard (if present) or the internal speaker. Optionally,
|
||||
a background function can be called periodically based on the sequencer
|
||||
timing, so its pretty accurate.
|
||||
|
||||
The low level internal speaker routines used to generate tones and waveforms
|
||||
can be called for warnings, sound effects, etc:
|
||||
|
||||
spkrTone(period, duration)
|
||||
Play a tone
|
||||
Params:
|
||||
(1020000 / 64 / period) Hz
|
||||
(duration * 32 * 256 / 1020000) seconds
|
||||
|
||||
spkrPWM(samples, speed, len)
|
||||
Play a Pulse Width Modulated waveform
|
||||
Params:
|
||||
Pointer to 8 bit pulse width samples
|
||||
Speed to play through samples
|
||||
Length of sample
|
||||
981
src/mockingboard/seqvm.s
Executable file
981
src/mockingboard/seqvm.s
Executable file
|
|
@ -0,0 +1,981 @@
|
|||
;**********************************************************
|
||||
;*
|
||||
;* STAND-ALONE PLASMA INTERPETER
|
||||
;*
|
||||
;* SYSTEM ROUTINES AND LOCATIONS
|
||||
;*
|
||||
;**********************************************************
|
||||
;*
|
||||
;* VM ZERO PAGE LOCATIONS
|
||||
;*
|
||||
SRC = $02
|
||||
SRCL = SRC
|
||||
SRCH = SRC+1
|
||||
DST = SRC+2
|
||||
DSTL = DST
|
||||
DSTH = DST+1
|
||||
ESTKSZ = $20
|
||||
ESTK = $C0
|
||||
ESTKL = ESTK
|
||||
ESTKH = ESTK+ESTKSZ/2
|
||||
VMZP = ESTK+ESTKSZ
|
||||
ESP = VMZP
|
||||
DVSIGN = VMZP
|
||||
IFP = ESP+1
|
||||
IFPL = IFP
|
||||
IFPH = IFP+1
|
||||
PP = IFP+2
|
||||
PPL = PP
|
||||
PPH = PP+1
|
||||
IPY = PP+2
|
||||
TMP = IPY+1
|
||||
TMPL = TMP
|
||||
TMPH = TMP+1
|
||||
NPARMS = TMPL
|
||||
FRMSZ = TMPH
|
||||
DROP = $EF
|
||||
NEXTOP = $F0
|
||||
FETCHOP = NEXTOP+3
|
||||
IP = FETCHOP+1
|
||||
IPL = IP
|
||||
IPH = IPL+1
|
||||
OPIDX = FETCHOP+6
|
||||
OPPAGE = OPIDX+1
|
||||
;*
|
||||
;* BASIC.SYSTEM ZERO PAGE LOCATIONS
|
||||
;*
|
||||
HIMEM = $73
|
||||
;*
|
||||
;* INTERPRETER INSTRUCTION POINTER INCREMENT MACRO
|
||||
;*
|
||||
!MACRO INC_IP {
|
||||
INY
|
||||
BNE *+4
|
||||
INC IPH
|
||||
}
|
||||
;*
|
||||
;* INTERPRETER HEADER+INITIALIZATION
|
||||
;*
|
||||
*= $1000
|
||||
LDX #$00
|
||||
- LDA $00,X
|
||||
STA $0900,X
|
||||
INX
|
||||
BNE -
|
||||
JSR VMINIT
|
||||
LDX #$00
|
||||
- LDA $0900,X
|
||||
STA $00,X
|
||||
INX
|
||||
BNE -
|
||||
RTS
|
||||
; LDX #$FE
|
||||
; TXS
|
||||
; JSR VMINIT
|
||||
; JSR $BF00
|
||||
; !BYTE $65
|
||||
; !WORD EXITTBL
|
||||
;EXITTBL:
|
||||
; !BYTE 4
|
||||
; !BYTE 0
|
||||
;*
|
||||
;* SYSTEM INTERPRETER ENTRYPOINT
|
||||
;*
|
||||
INTERP PLA
|
||||
CLC
|
||||
ADC #$01
|
||||
STA IPL
|
||||
PLA
|
||||
ADC #$00
|
||||
STA IPH
|
||||
LDY #$00
|
||||
JMP FETCHOP
|
||||
;*
|
||||
;* ENTER INTO USER BYTECODE INTERPRETER
|
||||
;*
|
||||
IINTERP PLA
|
||||
STA TMPL
|
||||
PLA
|
||||
STA TMPH
|
||||
LDY #$02
|
||||
LDA (TMP),Y
|
||||
STA IPH
|
||||
DEY
|
||||
LDA (TMP),Y
|
||||
STA IPL
|
||||
DEY
|
||||
JMP FETCHOP
|
||||
;*
|
||||
;* MUL TOS-1 BY TOS
|
||||
;*
|
||||
MUL STY IPY
|
||||
LDY #$10
|
||||
LDA ESTKL+1,X
|
||||
EOR #$FF
|
||||
STA TMPL
|
||||
LDA ESTKH+1,X
|
||||
EOR #$FF
|
||||
STA TMPH
|
||||
LDA #$00
|
||||
STA ESTKL+1,X ; PRODL
|
||||
; STA ESTKH+1,X ; PRODH
|
||||
MULLP LSR TMPH ; MULTPLRH
|
||||
ROR TMPL ; MULTPLRL
|
||||
BCS +
|
||||
STA ESTKH+1,X ; PRODH
|
||||
LDA ESTKL,X ; MULTPLNDL
|
||||
ADC ESTKL+1,X ; PRODL
|
||||
STA ESTKL+1,X
|
||||
LDA ESTKH,X ; MULTPLNDH
|
||||
ADC ESTKH+1,X ; PRODH
|
||||
+ ASL ESTKL,X ; MULTPLNDL
|
||||
ROL ESTKH,X ; MULTPLNDH
|
||||
DEY
|
||||
BNE MULLP
|
||||
STA ESTKH+1,X ; PRODH
|
||||
LDY IPY
|
||||
; INX
|
||||
; JMP NEXTOP
|
||||
JMP DROP
|
||||
;*
|
||||
;* INCREMENT TOS
|
||||
;*
|
||||
INCR INC ESTKL,X
|
||||
BNE INCR1
|
||||
INC ESTKH,X
|
||||
INCR1 JMP NEXTOP
|
||||
;*
|
||||
;* DECREMENT TOS
|
||||
;*
|
||||
DECR LDA ESTKL,X
|
||||
BNE DECR1
|
||||
DEC ESTKH,X
|
||||
DECR1 DEC ESTKL,X
|
||||
JMP NEXTOP
|
||||
;*
|
||||
;* BITWISE COMPLIMENT TOS
|
||||
;*
|
||||
COMP LDA #$FF
|
||||
EOR ESTKL,X
|
||||
STA ESTKL,X
|
||||
LDA #$FF
|
||||
EOR ESTKH,X
|
||||
STA ESTKH,X
|
||||
JMP NEXTOP
|
||||
;*
|
||||
;* DIV TOS-1 BY TOS
|
||||
;*
|
||||
DIV JSR _DIV
|
||||
LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
|
||||
BCS NEG
|
||||
JMP NEXTOP
|
||||
;*
|
||||
;* MOD TOS-1 BY TOS
|
||||
;*
|
||||
MOD JSR _DIV
|
||||
LDA TMPL ; REMNDRL
|
||||
STA ESTKL,X
|
||||
LDA TMPH ; REMNDRH
|
||||
STA ESTKH,X
|
||||
LDA DVSIGN ; REMAINDER IS SIGN OF DIVIDEND
|
||||
BMI NEG
|
||||
JMP NEXTOP
|
||||
;*
|
||||
;* NEGATE TOS
|
||||
;*
|
||||
NEG LDA #$00
|
||||
SEC
|
||||
SBC ESTKL,X
|
||||
STA ESTKL,X
|
||||
LDA #$00
|
||||
SBC ESTKH,X
|
||||
STA ESTKH,X
|
||||
JMP NEXTOP
|
||||
;*
|
||||
;* INTERNAL DIVIDE ALGORITHM
|
||||
;*
|
||||
_NEG LDA #$00
|
||||
SEC
|
||||
SBC ESTKL,X
|
||||
STA ESTKL,X
|
||||
LDA #$00
|
||||
SBC ESTKH,X
|
||||
STA ESTKH,X
|
||||
RTS
|
||||
_DIV STY IPY
|
||||
LDY #$11 ; #BITS+1
|
||||
LDA #$00
|
||||
STA TMPL ; REMNDRL
|
||||
STA TMPH ; REMNDRH
|
||||
LDA ESTKH,X
|
||||
AND #$80
|
||||
STA DVSIGN
|
||||
BPL +
|
||||
JSR _NEG
|
||||
INC DVSIGN
|
||||
+ LDA ESTKH+1,X
|
||||
BPL +
|
||||
INX
|
||||
JSR _NEG
|
||||
DEX
|
||||
INC DVSIGN
|
||||
BNE _DIV1
|
||||
+ ORA ESTKL+1,X ; DVDNDL
|
||||
BEQ _DIVEX
|
||||
_DIV1 ASL ESTKL+1,X ; DVDNDL
|
||||
ROL ESTKH+1,X ; DVDNDH
|
||||
DEY
|
||||
BCC _DIV1
|
||||
_DIVLP ROL TMPL ; REMNDRL
|
||||
ROL TMPH ; REMNDRH
|
||||
LDA TMPL ; REMNDRL
|
||||
CMP ESTKL,X ; DVSRL
|
||||
LDA TMPH ; REMNDRH
|
||||
SBC ESTKH,X ; DVSRH
|
||||
BCC +
|
||||
STA TMPH ; REMNDRH
|
||||
LDA TMPL ; REMNDRL
|
||||
SBC ESTKL,X ; DVSRL
|
||||
STA TMPL ; REMNDRL
|
||||
SEC
|
||||
+ ROL ESTKL+1,X ; DVDNDL
|
||||
ROL ESTKH+1,X ; DVDNDH
|
||||
DEY
|
||||
BNE _DIVLP
|
||||
_DIVEX INX
|
||||
LDY IPY
|
||||
RTS
|
||||
;*
|
||||
;* ADD TOS TO TOS-1
|
||||
;*
|
||||
ADD LDA ESTKL,X
|
||||
CLC
|
||||
ADC ESTKL+1,X
|
||||
STA ESTKL+1,X
|
||||
LDA ESTKH,X
|
||||
ADC ESTKH+1,X
|
||||
STA ESTKH+1,X
|
||||
; INX
|
||||
; JMP NEXTOP
|
||||
JMP DROP
|
||||
;*
|
||||
;* SUB TOS FROM TOS-1
|
||||
;*
|
||||
SUB LDA ESTKL+1,X
|
||||
SEC
|
||||
SBC ESTKL,X
|
||||
STA ESTKL+1,X
|
||||
LDA ESTKH+1,X
|
||||
SBC ESTKH,X
|
||||
STA ESTKH+1,X
|
||||
; INX
|
||||
; JMP NEXTOP
|
||||
JMP DROP
|
||||
;
|
||||
;*
|
||||
;* SHIFT TOS LEFT BY 1, ADD TO TOS-1
|
||||
;*
|
||||
IDXW LDA ESTKL,X
|
||||
ASL
|
||||
ROL ESTKH,X
|
||||
CLC
|
||||
ADC ESTKL+1,X
|
||||
STA ESTKL+1,X
|
||||
LDA ESTKH,X
|
||||
ADC ESTKH+1,X
|
||||
STA ESTKH+1,X
|
||||
; INX
|
||||
; JMP NEXTOP
|
||||
JMP DROP
|
||||
;*
|
||||
;* BITWISE AND TOS TO TOS-1
|
||||
;*
|
||||
BAND LDA ESTKL+1,X
|
||||
AND ESTKL,X
|
||||
STA ESTKL+1,X
|
||||
LDA ESTKH+1,X
|
||||
AND ESTKH,X
|
||||
STA ESTKH+1,X
|
||||
; INX
|
||||
; JMP NEXTOP
|
||||
JMP DROP
|
||||
;*
|
||||
;* INCLUSIVE OR TOS TO TOS-1
|
||||
;*
|
||||
IOR LDA ESTKL+1,X
|
||||
ORA ESTKL,X
|
||||
STA ESTKL+1,X
|
||||
LDA ESTKH+1,X
|
||||
ORA ESTKH,X
|
||||
STA ESTKH+1,X
|
||||
; INX
|
||||
; JMP NEXTOP
|
||||
JMP DROP
|
||||
;*
|
||||
;* EXLUSIVE OR TOS TO TOS-1
|
||||
;*
|
||||
XOR LDA ESTKL+1,X
|
||||
EOR ESTKL,X
|
||||
STA ESTKL+1,X
|
||||
LDA ESTKH+1,X
|
||||
EOR ESTKH,X
|
||||
STA ESTKH+1,X
|
||||
; INX
|
||||
; JMP NEXTOP
|
||||
JMP DROP
|
||||
;*
|
||||
;* SHIFT TOS-1 LEFT BY TOS
|
||||
;*
|
||||
SHL STY IPY
|
||||
LDA ESTKL,X
|
||||
CMP #$08
|
||||
BCC SHL1
|
||||
LDY ESTKL+1,X
|
||||
STY ESTKH+1,X
|
||||
LDY #$00
|
||||
STY ESTKL+1,X
|
||||
SBC #$08
|
||||
SHL1 TAY
|
||||
BEQ SHL3
|
||||
SHL2 ASL ESTKL+1,X
|
||||
ROL ESTKH+1,X
|
||||
DEY
|
||||
BNE SHL2
|
||||
SHL3 LDY IPY
|
||||
; INX
|
||||
; JMP NEXTOP
|
||||
JMP DROP
|
||||
;*
|
||||
;* SHIFT TOS-1 RIGHT BY TOS
|
||||
;*
|
||||
SHR STY IPY
|
||||
LDA ESTKL,X
|
||||
CMP #$08
|
||||
BCC SHR2
|
||||
LDY ESTKH+1,X
|
||||
STY ESTKL+1,X
|
||||
CPY #$80
|
||||
LDY #$00
|
||||
BCC SHR1
|
||||
DEY
|
||||
SHR1 STY ESTKH+1,X
|
||||
SEC
|
||||
SBC #$08
|
||||
SHR2 TAY
|
||||
BEQ SHR4
|
||||
LDA ESTKH+1,X
|
||||
SHR3 CMP #$80
|
||||
ROR
|
||||
ROR ESTKL+1,X
|
||||
DEY
|
||||
BNE SHR3
|
||||
STA ESTKH+1,X
|
||||
SHR4 LDY IPY
|
||||
; INX
|
||||
; JMP NEXTOP
|
||||
JMP DROP
|
||||
;*
|
||||
;* LOGICAL NOT
|
||||
;*
|
||||
LNOT LDA ESTKL,X
|
||||
ORA ESTKH,X
|
||||
BEQ LNOT1
|
||||
LDA #$FF
|
||||
LNOT1 EOR #$FF
|
||||
STA ESTKL,X
|
||||
STA ESTKH,X
|
||||
JMP NEXTOP
|
||||
;*
|
||||
;* LOGICAL AND
|
||||
;*
|
||||
LAND LDA ESTKL+1,X
|
||||
ORA ESTKH+1,X
|
||||
BEQ LAND2
|
||||
LDA ESTKL,X
|
||||
ORA ESTKH,X
|
||||
BEQ LAND1
|
||||
LDA #$FF
|
||||
LAND1 STA ESTKL+1,X
|
||||
STA ESTKH+1,X
|
||||
;LAND2 INX
|
||||
; JMP NEXTOP
|
||||
LAND2 JMP DROP
|
||||
;*
|
||||
;* LOGICAL OR
|
||||
;*
|
||||
LOR LDA ESTKL,X
|
||||
ORA ESTKH,X
|
||||
ORA ESTKL+1,X
|
||||
ORA ESTKH+1,X
|
||||
BEQ LOR1
|
||||
LDA #$FF
|
||||
STA ESTKL+1,X
|
||||
STA ESTKH+1,X
|
||||
;LOR1 INX
|
||||
; JMP NEXTOP
|
||||
LOR1 JMP DROP
|
||||
;*
|
||||
;* DUPLICATE TOS
|
||||
;*
|
||||
DUP DEX
|
||||
LDA ESTKL+1,X
|
||||
STA ESTKL,X
|
||||
LDA ESTKH+1,X
|
||||
STA ESTKH,X
|
||||
JMP NEXTOP
|
||||
;*
|
||||
;* PUSH EVAL STACK POINTER TO CALL STACK
|
||||
;*
|
||||
PUSHEP TXA
|
||||
PHA
|
||||
JMP NEXTOP
|
||||
;*
|
||||
;* PULL EVAL STACK POINTER FROM CALL STACK
|
||||
;*
|
||||
PULLEP PLA
|
||||
TAX
|
||||
JMP NEXTOP
|
||||
;*
|
||||
;* CONSTANT
|
||||
;*
|
||||
ZERO DEX
|
||||
LDA #$00
|
||||
STA ESTKL,X
|
||||
STA ESTKH,X
|
||||
JMP NEXTOP
|
||||
CFFB LDA #$FF
|
||||
!BYTE $2C ; BIT $00A9 - effectively skips LDA #$00, no harm in reading this address
|
||||
CB LDA #$00
|
||||
DEX
|
||||
STA ESTKH,X
|
||||
+INC_IP
|
||||
LDA (IP),Y
|
||||
STA ESTKL,X
|
||||
JMP NEXTOP
|
||||
;*
|
||||
;* LOAD ADDRESS & LOAD CONSTANT WORD (SAME THING, WITH OR WITHOUT FIXUP)
|
||||
;*
|
||||
LA = *
|
||||
CW DEX
|
||||
+INC_IP
|
||||
LDA (IP),Y
|
||||
STA ESTKL,X
|
||||
+INC_IP
|
||||
LDA (IP),Y
|
||||
STA ESTKH,X
|
||||
JMP NEXTOP
|
||||
;*
|
||||
;* CONSTANT STRING
|
||||
;*
|
||||
CS DEX
|
||||
+INC_IP
|
||||
TYA ; NORMALIZE IP AND SAVE STRING ADDR ON ESTK
|
||||
CLC
|
||||
ADC IPL
|
||||
STA IPL
|
||||
STA ESTKL,X
|
||||
LDA #$00
|
||||
TAY
|
||||
ADC IPH
|
||||
STA IPH
|
||||
STA ESTKH,X
|
||||
LDA (IP),Y
|
||||
TAY
|
||||
JMP NEXTOP
|
||||
;*
|
||||
;* LOAD VALUE FROM ADDRESS TAG
|
||||
;*
|
||||
LB LDA ESTKL,X
|
||||
STA LBLDA+1
|
||||
LDA ESTKH,X
|
||||
STA LBLDA+2
|
||||
LBLDA LDA $FFFF
|
||||
STA ESTKL,X
|
||||
LDA #$00
|
||||
STA ESTKH,X
|
||||
JMP NEXTOP
|
||||
LW LDA ESTKL,X
|
||||
STA TMPL
|
||||
LDA ESTKH,X
|
||||
STA TMPH
|
||||
STY IPY
|
||||
LDY #$00
|
||||
LDA (TMP),Y
|
||||
STA ESTKL,X
|
||||
INY
|
||||
LDA (TMP),Y
|
||||
STA ESTKH,X
|
||||
LDY IPY
|
||||
JMP NEXTOP
|
||||
;*
|
||||
;* LOAD ADDRESS OF LOCAL FRAME OFFSET
|
||||
;*
|
||||
LLA +INC_IP
|
||||
LDA (IP),Y
|
||||
DEX
|
||||
CLC
|
||||
ADC IFPL
|
||||
STA ESTKL,X
|
||||
LDA #$00
|
||||
ADC IFPH
|
||||
STA ESTKH,X
|
||||
JMP NEXTOP
|
||||
;*
|
||||
;* LOAD VALUE FROM LOCAL FRAME OFFSET
|
||||
;*
|
||||
LLB +INC_IP
|
||||
LDA (IP),Y
|
||||
STY IPY
|
||||
TAY
|
||||
DEX
|
||||
LDA (IFP),Y
|
||||
STA ESTKL,X
|
||||
LDA #$00
|
||||
STA ESTKH,X
|
||||
LDY IPY
|
||||
JMP NEXTOP
|
||||
LLW +INC_IP
|
||||
LDA (IP),Y
|
||||
STY IPY
|
||||
TAY
|
||||
DEX
|
||||
LDA (IFP),Y
|
||||
STA ESTKL,X
|
||||
INY
|
||||
LDA (IFP),Y
|
||||
STA ESTKH,X
|
||||
LDY IPY
|
||||
JMP NEXTOP
|
||||
;*
|
||||
;* LOAD VALUE FROM ABSOLUTE ADDRESS
|
||||
;*
|
||||
LAB +INC_IP
|
||||
LDA (IP),Y
|
||||
STA LABLDA+1
|
||||
+INC_IP
|
||||
LDA (IP),Y
|
||||
STA LABLDA+2
|
||||
LABLDA LDA $FFFF
|
||||
DEX
|
||||
STA ESTKL,X
|
||||
LDA #$00
|
||||
STA ESTKH,X
|
||||
JMP NEXTOP
|
||||
LAW +INC_IP
|
||||
LDA (IP),Y
|
||||
STA TMPL
|
||||
+INC_IP
|
||||
LDA (IP),Y
|
||||
STA TMPH
|
||||
STY IPY
|
||||
LDY #$00
|
||||
LDA (TMP),Y
|
||||
DEX
|
||||
STA ESTKL,X
|
||||
INY
|
||||
LDA (TMP),Y
|
||||
STA ESTKH,X
|
||||
LDY IPY
|
||||
JMP NEXTOP
|
||||
;*
|
||||
;* STORE VALUE TO ADDRESS
|
||||
;*
|
||||
SB LDA ESTKL,X
|
||||
STA SBSTA+1
|
||||
LDA ESTKH,X
|
||||
STA SBSTA+2
|
||||
LDA ESTKL+1,X
|
||||
SBSTA STA $FFFF
|
||||
INX
|
||||
; INX
|
||||
; JMP NEXTOP
|
||||
JMP DROP
|
||||
SW LDA ESTKL,X
|
||||
STA TMPL
|
||||
LDA ESTKH,X
|
||||
STA TMPH
|
||||
STY IPY
|
||||
LDY #$00
|
||||
LDA ESTKL+1,X
|
||||
STA (TMP),Y
|
||||
INY
|
||||
LDA ESTKH+1,X
|
||||
STA (TMP),Y
|
||||
LDY IPY
|
||||
INX
|
||||
; INX
|
||||
; JMP NEXTOP
|
||||
JMP DROP
|
||||
;*
|
||||
;* STORE VALUE TO LOCAL FRAME OFFSET
|
||||
;*
|
||||
SLB +INC_IP
|
||||
LDA (IP),Y
|
||||
STY IPY
|
||||
TAY
|
||||
LDA ESTKL,X
|
||||
STA (IFP),Y
|
||||
LDY IPY
|
||||
; INX
|
||||
; JMP NEXTOP
|
||||
JMP DROP
|
||||
SLW +INC_IP
|
||||
LDA (IP),Y
|
||||
STY IPY
|
||||
TAY
|
||||
LDA ESTKL,X
|
||||
STA (IFP),Y
|
||||
INY
|
||||
LDA ESTKH,X
|
||||
STA (IFP),Y
|
||||
LDY IPY
|
||||
; INX
|
||||
; JMP NEXTOP
|
||||
JMP DROP
|
||||
;*
|
||||
;* STORE VALUE TO LOCAL FRAME OFFSET WITHOUT POPPING STACK
|
||||
;*
|
||||
DLB +INC_IP
|
||||
LDA (IP),Y
|
||||
STY IPY
|
||||
TAY
|
||||
LDA ESTKL,X
|
||||
STA (IFP),Y
|
||||
LDY IPY
|
||||
JMP NEXTOP
|
||||
DLW +INC_IP
|
||||
LDA (IP),Y
|
||||
STY IPY
|
||||
TAY
|
||||
LDA ESTKL,X
|
||||
STA (IFP),Y
|
||||
INY
|
||||
LDA ESTKH,X
|
||||
STA (IFP),Y
|
||||
LDY IPY
|
||||
JMP NEXTOP
|
||||
;*
|
||||
;* STORE VALUE TO ABSOLUTE ADDRESS
|
||||
;*
|
||||
SAB +INC_IP
|
||||
LDA (IP),Y
|
||||
STA SABSTA+1
|
||||
+INC_IP
|
||||
LDA (IP),Y
|
||||
STA SABSTA+2
|
||||
LDA ESTKL,X
|
||||
SABSTA STA $FFFF
|
||||
; INX
|
||||
; JMP NEXTOP
|
||||
JMP DROP
|
||||
SAW +INC_IP
|
||||
LDA (IP),Y
|
||||
STA TMPL
|
||||
+INC_IP
|
||||
LDA (IP),Y
|
||||
STA TMPH
|
||||
STY IPY
|
||||
LDY #$00
|
||||
LDA ESTKL,X
|
||||
STA (TMP),Y
|
||||
INY
|
||||
LDA ESTKH,X
|
||||
STA (TMP),Y
|
||||
LDY IPY
|
||||
; INX
|
||||
; JMP NEXTOP
|
||||
JMP DROP
|
||||
;*
|
||||
;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK
|
||||
;*
|
||||
DAB +INC_IP
|
||||
LDA (IP),Y
|
||||
STA DABSTA+1
|
||||
+INC_IP
|
||||
LDA (IP),Y
|
||||
STA DABSTA+2
|
||||
LDA ESTKL,X
|
||||
DABSTA STA $FFFF
|
||||
JMP NEXTOP
|
||||
DAW +INC_IP
|
||||
LDA (IP),Y
|
||||
STA TMPL
|
||||
+INC_IP
|
||||
LDA (IP),Y
|
||||
STA TMPH
|
||||
STY IPY
|
||||
LDY #$00
|
||||
LDA ESTKL,X
|
||||
STA (TMP),Y
|
||||
INY
|
||||
LDA ESTKH,X
|
||||
STA (TMP),Y
|
||||
LDY IPY
|
||||
JMP NEXTOP
|
||||
;*
|
||||
;* COMPARES
|
||||
;*
|
||||
ISEQ LDA ESTKL,X
|
||||
CMP ESTKL+1,X
|
||||
BNE ISFLS
|
||||
LDA ESTKH,X
|
||||
CMP ESTKH+1,X
|
||||
BNE ISFLS
|
||||
ISTRU LDA #$FF
|
||||
STA ESTKL+1,X
|
||||
STA ESTKH+1,X
|
||||
; INX
|
||||
; JMP NEXTOP
|
||||
JMP DROP
|
||||
;
|
||||
ISNE LDA ESTKL,X
|
||||
CMP ESTKL+1,X
|
||||
BNE ISTRU
|
||||
LDA ESTKH,X
|
||||
CMP ESTKH+1,X
|
||||
BNE ISTRU
|
||||
ISFLS LDA #$00
|
||||
STA ESTKL+1,X
|
||||
STA ESTKH+1,X
|
||||
; INX
|
||||
; JMP NEXTOP
|
||||
JMP DROP
|
||||
;
|
||||
ISGE LDA ESTKL+1,X
|
||||
CMP ESTKL,X
|
||||
LDA ESTKH+1,X
|
||||
SBC ESTKH,X
|
||||
BVC ISGE1
|
||||
EOR #$80
|
||||
ISGE1 BPL ISTRU
|
||||
BMI ISFLS
|
||||
;
|
||||
ISGT LDA ESTKL,X
|
||||
CMP ESTKL+1,X
|
||||
LDA ESTKH,X
|
||||
SBC ESTKH+1,X
|
||||
BVC ISGT1
|
||||
EOR #$80
|
||||
ISGT1 BMI ISTRU
|
||||
BPL ISFLS
|
||||
;
|
||||
ISLE LDA ESTKL,X
|
||||
CMP ESTKL+1,X
|
||||
LDA ESTKH,X
|
||||
SBC ESTKH+1,X
|
||||
BVC ISLE1
|
||||
EOR #$80
|
||||
ISLE1 BPL ISTRU
|
||||
BMI ISFLS
|
||||
;
|
||||
ISLT LDA ESTKL+1,X
|
||||
CMP ESTKL,X
|
||||
LDA ESTKH+1,X
|
||||
SBC ESTKH,X
|
||||
BVC ISLT1
|
||||
EOR #$80
|
||||
ISLT1 BMI ISTRU
|
||||
BPL ISFLS
|
||||
;*
|
||||
;* BRANCHES
|
||||
;*
|
||||
BRTRU INX
|
||||
LDA ESTKH-1,X
|
||||
ORA ESTKL-1,X
|
||||
BNE BRNCH
|
||||
NOBRNCH +INC_IP
|
||||
+INC_IP
|
||||
JMP NEXTOP
|
||||
BRFLS INX
|
||||
LDA ESTKH-1,X
|
||||
ORA ESTKL-1,X
|
||||
BNE NOBRNCH
|
||||
BRNCH LDA IPH
|
||||
STA TMPH
|
||||
LDA IPL
|
||||
+INC_IP
|
||||
CLC
|
||||
ADC (IP),Y
|
||||
STA TMPL
|
||||
LDA TMPH
|
||||
+INC_IP
|
||||
ADC (IP),Y
|
||||
STA IPH
|
||||
LDA TMPL
|
||||
STA IPL
|
||||
DEY
|
||||
DEY
|
||||
JMP NEXTOP
|
||||
BREQ INX
|
||||
LDA ESTKL-1,X
|
||||
CMP ESTKL,X
|
||||
BNE NOBRNCH
|
||||
LDA ESTKH-1,X
|
||||
CMP ESTKH,X
|
||||
BEQ BRNCH
|
||||
BNE NOBRNCH
|
||||
BRNE INX
|
||||
LDA ESTKL-1,X
|
||||
CMP ESTKL,X
|
||||
BNE BRNCH
|
||||
LDA ESTKH-1,X
|
||||
CMP ESTKH,X
|
||||
BEQ NOBRNCH
|
||||
BNE BRNCH
|
||||
BRGT INX
|
||||
LDA ESTKL-1,X
|
||||
CMP ESTKL,X
|
||||
LDA ESTKH-1,X
|
||||
SBC ESTKH,X
|
||||
BMI BRNCH
|
||||
BPL NOBRNCH
|
||||
BRLT INX
|
||||
LDA ESTKL,X
|
||||
CMP ESTKL-1,X
|
||||
LDA ESTKH,X
|
||||
SBC ESTKH-1,X
|
||||
BMI BRNCH
|
||||
BPL NOBRNCH
|
||||
IBRNCH LDA IPL
|
||||
CLC
|
||||
ADC ESTKL,X
|
||||
STA IPL
|
||||
LDA IPH
|
||||
ADC ESTKH,X
|
||||
STA IPH
|
||||
; INX
|
||||
; JMP NEXTOP
|
||||
JMP DROP
|
||||
;*
|
||||
;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE)
|
||||
;*
|
||||
CALL +INC_IP
|
||||
LDA (IP),Y
|
||||
STA CALLADR+1
|
||||
+INC_IP
|
||||
LDA (IP),Y
|
||||
STA CALLADR+2
|
||||
LDA IPH
|
||||
PHA
|
||||
LDA IPL
|
||||
PHA
|
||||
TYA
|
||||
PHA
|
||||
CALLADR JSR $FFFF
|
||||
PLA
|
||||
TAY
|
||||
PLA
|
||||
STA IPL
|
||||
PLA
|
||||
STA IPH
|
||||
JMP NEXTOP
|
||||
;*
|
||||
;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
|
||||
;*
|
||||
ICAL LDA ESTKL,X
|
||||
STA ICALADR+1
|
||||
LDA ESTKH,X
|
||||
STA ICALADR+2
|
||||
INX
|
||||
LDA IPH
|
||||
PHA
|
||||
LDA IPL
|
||||
PHA
|
||||
TYA
|
||||
PHA
|
||||
ICALADR JSR $FFFF
|
||||
PLA
|
||||
TAY
|
||||
PLA
|
||||
STA IPL
|
||||
PLA
|
||||
STA IPH
|
||||
JMP NEXTOP
|
||||
;*
|
||||
;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT
|
||||
;*
|
||||
ENTER INY
|
||||
LDA (IP),Y
|
||||
PHA ; SAVE ON STACK FOR LEAVE
|
||||
EOR #$FF
|
||||
SEC
|
||||
ADC IFPL
|
||||
STA IFPL
|
||||
BCS +
|
||||
DEC IFPH
|
||||
+ INY
|
||||
LDA (IP),Y
|
||||
ASL
|
||||
TAY
|
||||
BEQ +
|
||||
- LDA ESTKH,X
|
||||
DEY
|
||||
STA (IFP),Y
|
||||
LDA ESTKL,X
|
||||
INX
|
||||
DEY
|
||||
STA (IFP),Y
|
||||
BNE -
|
||||
+ LDY #$02
|
||||
JMP NEXTOP
|
||||
;*
|
||||
;* LEAVE FUNCTION
|
||||
;*
|
||||
LEAVE PLA
|
||||
CLC
|
||||
ADC IFPL
|
||||
STA IFPL
|
||||
BCS LIFPH
|
||||
RTS
|
||||
LIFPH INC IFPH
|
||||
RET RTS
|
||||
;*
|
||||
;* OPCODE TABLE
|
||||
;*
|
||||
!ALIGN 255,0
|
||||
OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E
|
||||
!WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E
|
||||
!WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E
|
||||
!WORD DROP,DUP,PUSHEP,PULLEP,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E
|
||||
!WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E
|
||||
!WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E
|
||||
!WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E
|
||||
!WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E
|
||||
;*
|
||||
;*SAVED ZERO PAGE
|
||||
;*
|
||||
ZPSAVE !FILL 256
|
||||
;*
|
||||
;* SOURCE PLASMA PROGRAM
|
||||
;*
|
||||
START !SOURCE "seqplay.a"
|
||||
SEGEND = *
|
||||
VMINIT LDY #$10 ; INSTALL PAGE 0 FETCHOP ROUTINE
|
||||
- LDA PAGE0-1,Y
|
||||
STA DROP-1,Y
|
||||
DEY
|
||||
BNE -
|
||||
LDA HIMEM
|
||||
STA IFPL ; INIT FRAME POINTER
|
||||
LDA HIMEM+1
|
||||
STA IFPH
|
||||
LDA #<SEGEND ; SAVE HEAP START
|
||||
STA SRCL
|
||||
LDA #>SEGEND
|
||||
STA SRCH
|
||||
LDA #$4C
|
||||
JMP START
|
||||
PAGE0 = *
|
||||
!PSEUDOPC $00EF {
|
||||
;*
|
||||
;* INTERP BYTECODE INNER LOOP
|
||||
;*
|
||||
INX ; DROP
|
||||
INY ; NEXTOP
|
||||
BEQ NEXTOPH
|
||||
LDA $FFFF,Y ; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4
|
||||
STA OPIDX
|
||||
JMP (OPTBL)
|
||||
NEXTOPH INC IPH
|
||||
BNE FETCHOP
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user