From 762ebd84921fd8fb4169feccb56727f49a0e9f4e Mon Sep 17 00:00:00 2001 From: dschmenk Date: Sun, 22 Oct 2017 15:56:48 -0700 Subject: [PATCH] Add mockingboard playback test --- src/mockingboard/cvtmid.py | 35 ++ src/mockingboard/makefile | 28 + src/mockingboard/mbtest.pla | 490 ++++++++++++++++++ src/mockingboard/mbvm.s | 981 ++++++++++++++++++++++++++++++++++++ 4 files changed, 1534 insertions(+) create mode 100755 src/mockingboard/cvtmid.py create mode 100644 src/mockingboard/makefile create mode 100755 src/mockingboard/mbtest.pla create mode 100755 src/mockingboard/mbvm.s diff --git a/src/mockingboard/cvtmid.py b/src/mockingboard/cvtmid.py new file mode 100755 index 0000000..850164d --- /dev/null +++ b/src/mockingboard/cvtmid.py @@ -0,0 +1,35 @@ +#!/usr/bin/python + +import sys +#from mido import MidiFile +import mido + +mid = mido.MidiFile(sys.argv[1]) +totaltime = 0 +for msg in mid: + if msg.type == 'note_on' or msg.type == 'note_off': + deltatime = int(msg.time * 16 + 0.5) + octave = int(msg.note / 12 - 1) + onote = int(msg.note % 12) + lrchan = int(msg.channel & 1) + vol = int(msg.velocity >> 3) + if msg.velocity > 0 and vol == 0: + vol = 1 + if msg.type == 'note_off': + vol = 0 + if octave < 0: + octave = 0 + totaltime += deltatime + if msg.channel == 9: + # + # Percussion + # + if vol > 0 and deltatime > 0: + print 'byte = ${0:02X}, ${1:02X}, ${2:02X}'.format(deltatime, msg.note >> 3, 2) + else: + # + # Note + # + print 'byte = ${0:02X}, ${1:02X}, ${2:02X}'.format(deltatime, 0x80 | (octave << 4) | onote, (lrchan << 7) | vol) +print '// MIDI length in seconds: {0:f}'.format(mid.length) +print '// Sequence length in seconds*16: {0:d}'.format(totaltime) diff --git a/src/mockingboard/makefile b/src/mockingboard/makefile new file mode 100644 index 0000000..2986242 --- /dev/null +++ b/src/mockingboard/makefile @@ -0,0 +1,28 @@ +.SUFFIXES = +AFLAGS = -o $@ +MBTEST = mbtest.bin +PLASM = ../plasm +# +# Image filetypes for Virtual ][ +# +PLATYPE = .\$$ED +BINTYPE = .BIN +SYSTYPE = .SYS +TXTTYPE = .TXT +# +# Image filetypes for CiderPress +# +#RELTYPE = \#FE1000 +#INTERPTYPE = \#050000 +#BINTYPE = \#060000 +#SYSTYPE = \#FF2000 +#TXTTYPE = \#040000 + +all: $(MBTEST) + +clean: + -rm *.o *~ *.a *.bin + +$(MBTEST): test.seq mbtest.pla mbvm.s $(PLASM) + $(PLASM) -AO < mbtest.pla > mbtest.a + acme -o $(MBTEST) mbvm.s diff --git a/src/mockingboard/mbtest.pla b/src/mockingboard/mbtest.pla new file mode 100755 index 0000000..fbccbe8 --- /dev/null +++ b/src/mockingboard/mbtest.pla @@ -0,0 +1,490 @@ +const inbuff = $200 +const freemem = $0002 +const iobuffer = $1C00 +const NMACROS = 7 +const FALSE = 0 +const TRUE = !FALSE +const LSB = 0 +const MSB = 1 +const ARPEGGIO = 4 // In 16ths of a second +const MAX_CHAN_NOTES = 9 +// +// 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 +// +// Tone test sequence +// +byte[] toneTrack +include "test.seq" +byte = $00 // Stop +byte = $00, 00 +// +// Octave Basis Frequencies (starting at MIDI note #12) +// Notes will be encoded as basis note (LSNibble) and octave (MSNibble)) +// +word[12] mbOctave0 = 3900, 3681, 3474, 3279, 3095, 2922, 2758, 2603, 2457, 2319, 2189, 2066 +// +// System variables. +// +word heap +// +// MockingBoard data. +// +word[] mbVIAs // Treat this as an array of VIA ptrs +word mbVIA1, mbVIA2 +// +// Write PSG 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 +// +// Utility routines +// +asm putc#0 + LDA ESTKL,X + INX + ORA #$80 + JMP $FDED +end +def putln#0 + putc($0D) +end + +def puts(str)#0 + byte i + + for i = 1 to ^str + putc(^(str+i)) + next +end +def puti(i)#0 + byte numstr[7] + byte place, sign + + place = 6 + if i < 0 + sign = 1 + i = -i + else + sign = 0 + fin + while i >= 10 + numstr[place] = i % 10 + '0' + i = i / 10 + place-- + loop + numstr[place] = i + '0' + place-- + if sign + numstr[place] = '-' + place-- + fin + numstr[place] = 6 - place + puts(@numstr[place]) +end +// +// Read PSG Register +// +//def mbReadP(pVIA, reg) +// byte val +// +// pVIA->IORA = reg +// pVIA->IORB = $07 +// pVIA->IORB = $04 +// pVIA->DDRA = $00 +// pVIA->IORB = $05 +// val = pVIA->IORA +// pVIA->IORB = $04 +// pVIA->DDRA = $FF +// return val +//end +// +// Search slots for MockingBoard +// +def mbTicklePSG(pVIA) + pVIA->IER = $00 + pVIA->DDRB = $FF + 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 TRUE + //fin + fin + fin + return FALSE +end +def mbSearch + byte slot + + puts("\nSearching for MockingBoard..\n") + for slot = 1 to 7 + if slot == 3 or slot == 6 + continue + fin + mbVIA1 = $C000 + (slot << 8) + if mbTicklePSG(mbVIA1) + puts("Slot "); puti(slot); puts(" looks interesting. ") + mbVIA2 = mbVIA1 + $80 + if mbTicklePSG(mbVIA2) + puts("Two PSGs found.\n") + else + mbVIA2 = 0 + puts("One PSG found.\n") + fin + return slot + fin + next + putln + return 0 +end +def psgSetup(pVIA) + // + // Set up the VIA1 (enulators only support Timer1 on first 6522) + // + if pVIA == mbVIA1 + pVIA->IER = $7F // Mask all interrupts + pVIA=>T1L = $F9C2 // 16 Ints/sec + pVIA=>T1C = $F9C2 // 16 Ints/sec + pVIA->ACR = $40 // Continuos T1 interrupts + pVIA->IFR = $40 // Clear interrupt + fin + psgWrite(pVIA, MIXER, $00) // 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 +def mbSequence(track)#0 + word seqEvent, seqTime, eventTime, updateTime, period, n + byte numNotes, note, volume, channel, i, overflow + byte indexA[2], indexB[2], indexC[2] + byte noteA[2], noteB[2], noteC[2] + word notes1[MAX_CHAN_NOTES], notes2[MAX_CHAN_NOTES] + word notes[2] + word periods1[MAX_CHAN_NOTES], periods2[MAX_CHAN_NOTES] + word periods[2] + + // + // Get the PSGs ready + // + psgSetup(mbVIA1) + if mbVIA2; psgSetup(mbVIA2); fin + // + // Zero out active notes + // + 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 + for i = 0 to MAX_CHAN_NOTES-1; notes1[i] = 0; notes2[i] = 0; next + notes[0] = @notes1 + notes[1] = @notes2 + for i = 0 to MAX_CHAN_NOTES-1; periods1[i] = 0; periods2[i] = 0; next + periods[0] = @periods1 + periods[1] = @periods2 + // + // Start sequencing + // + seqTime = 0 + seqEvent = track + eventTime = seqTime + seqEvent->deltatime + updateTime = ARPEGGIO + numNotes = 0 + overflow = 0 + repeat + //puts("seqTime = "); puti(seqTime); puts(" eventTime = "); puti(eventTime); putln + 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_CHAN_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_CHAN_NOTES + i = overflow + overflow = (overflow + 1) % MAX_CHAN_NOTES + //puts("Full note table on channel: "); puti(channel); putln + else + numNotes++ + fin + notes[channel, i] = note | (volume << 8) + periods[channel, i] = mbOctave0[note & $0F] >> ((note >> 4) & $07) + //puts("Insert note ");puti((note>>4)&$7);putc(':');puti(note&$0F) + //puts(" in table[");puti(channel);putc(',');puti(i);puts("]\n") + else + // + // Note off + // + for i = 0 to MAX_CHAN_NOTES-1 + // + // Remove from active note table + // + if notes[channel, i].LSB == note + notes[channel, i] = 0 + break + fin + next + numNotes-- + //puts("Remove note ");puti((note>>4)&$7);putc(':');puti(note&$0F) + //puts(" from table[");puti(channel);putc(',');puti(i);puts("]\n") + 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 + eventTime = -1 + break + fin + fin + // + // Next event + // + seqEvent = seqEvent + t_event + eventTime = seqTime + seqEvent->deltatime + 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_CHAN_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 + //puts("Start A note: ");puti(channel);putc(',');puti(i);putln + fin + // + // Multiplex oscillator B + // + i = indexB[channel] + repeat + i = (i + 3) % MAX_CHAN_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 + //puts("Start B note: ");puti(channel);putc(',');puti(i);putln + fin + // + // Multiplex oscillator C + // + i = indexC[channel] + repeat + i = (i + 3) % MAX_CHAN_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 + //puts("Start C note: ");puti(channel);putc(',');puti(i);putln + fin + next + updateTime = seqTime + ARPEGGIO - (numNotes >> 2) + fin + // + // Increment time tick + // + seqTime++ + if updateTime < seqTime; updateTime = seqTime; fin + while !(mbVIA1->IFR & $40) // Wait for T1 interrupt + if ^$C000 > 127; eventTime = -1; ^$C010; break; fin + loop + mbVIA1->IFR = $40 // Clear interrupt + until eventTime < 0 + psgWrite(mbVIA1, MIXER, $FF) // Turn everything off + psgWrite(mbVIA1, CENVAMP, $00) + if mbVIA2 + psgWrite(mbVIA2, MIXER, $FF) + psgWrite(mbVIA2, CENVAMP, $00) + fin +end +heap = *freemem +if mbSearch + mbSequence(@toneTrack) +fin +done diff --git a/src/mockingboard/mbvm.s b/src/mockingboard/mbvm.s new file mode 100755 index 0000000..e4ca814 --- /dev/null +++ b/src/mockingboard/mbvm.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 "mbtest.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 +}