6502/PLASMA
1
0
Fork 0
mirror of https://github.com/dschmenk/PLASMA.git synced 2025-03-22 01:30:45 +00:00
Code Issues Projects Releases Wiki Activity

Add mockingboard playback test

Browse Source
This commit is contained in:
dschmenk 2017-10-22 15:56:48 -07:00
parent e59d03984a
commit 762ebd8492
4 changed files with 1534 additions and 0 deletions

35
src/mockingboard/cvtmid.py Executable file

@ -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)

28
src/mockingboard/makefile Normal file

@ -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

490
src/mockingboard/mbtest.pla Executable file

@ -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

981
src/mockingboard/mbvm.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 "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 ; 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
}