diff --git a/src/mockingboard/seqplay.pla b/src/mockingboard/seqplay.pla new file mode 100755 index 0000000..4f7fd48 --- /dev/null +++ b/src/mockingboard/seqplay.pla @@ -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 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 diff --git a/src/mockingboard/seqvm.s b/src/mockingboard/seqvm.s new file mode 100755 index 0000000..604be66 --- /dev/null +++ b/src/mockingboard/seqvm.s @@ -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 + 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 +}