commit 84ff354f52bf35c9bbf3a3ac46e110ed4f8c6148 Author: tomcw Date: Fri Apr 21 21:56:00 2017 +0100 Commit of v5 code diff --git a/Common/AppleDefs.a b/Common/AppleDefs.a new file mode 100644 index 0000000..9228bb3 --- /dev/null +++ b/Common/AppleDefs.a @@ -0,0 +1,13 @@ +IRQL = $3FE +IRQH = $3FF + +;-------------------------------------- + +SW_SLOTXROM_ENA = $C006 +SW_SLOTXROM_DIS = $C007 +SW_SLOTXROM_R = $C015 ; Active low + +SW_SLOT3ROM_DIS = $C00A +SW_SLOT3ROM_ENA = $C00B +SW_SLOT3ROM_R = $C017 ; Active high + diff --git a/Common/MB-Macros.a b/Common/MB-Macros.a new file mode 100644 index 0000000..8a65147 --- /dev/null +++ b/Common/MB-Macros.a @@ -0,0 +1,440 @@ + +SPECTRUM128_STEREO = 1 ; L = A+Bx0.5, R = C'+B'x0.5 +DUAL_MONO = 0 ; L = A+B+C, R=A'+B'+C' + + +!macro MB_Init1 .RegSongNum { +; Pre: A = Song# [0..NUM_SONGS-1] +; Post: .RegSongNum = Song# +; + + jmp .skip_data + +nSongNum: !byte 0 ; Song# +nFrameNum: !byte 0,0,0 ; Minute:Second:FrameNum (@ 50Hz) +; +nMaskA: !byte 0 ; Voice-A mask (0=enable) +nMaskB: !byte 0 ; Voice-B mask (0=enable) +nMaskC: !byte 0 ; Voice-C mask (0=enable) +; +nAttA: !byte 0 ; Attenuation of Voice-A +nAttB: !byte 1 ; Attenuation of Voice-B : B Volume / 2 (logarithmic, so: if (A) A--) +nAttC: !byte 0 ; Attenuation of Voice-C +; +pAYRegValues: !word AYRegValues ; For VU-meter + + ; + +.skip_data: + lda nSongNum + cmp #NUM_SONGS + bcc SongNumOK + lda #255 ; Uninit + sta nSongNum +SongNumOK: + + ; + + lda nMBBaseHi + beq FindMB + + ; Need to disable Timer1 IRQ before: + ; . Scanning for MB card + ; . Saving ZPBlock + + lda #1<<6 +MB0: sta CARD_BASE+SY6522_IER ; Disable Timer1 IRQ + +FindMB: + + ;---------------------------------- + + +SaveRegs ZPBlock + + jsr SF_GetMBSlot + bne GotMBSlot + + ; MB not found! + jmp InitExit2 + +GotMBSlot: + ; Setup correct address in IRQ handler code: + +!if SPECTRUM128_STEREO { + stx MBx1+2 + stx MBx2+2 + stx MBx3+2 + stx MBx4+2 +} + +!if DUAL_MONO { + stx MB1+2 + stx MB1b+2 + stx MB2+2 + stx MB2b+2 + stx MB3+2 + stx MB3b+2 + stx MB4+2 + stx MB4b+2 + stx MB5+2 + stx MB5b+2 + stx MB6+2 + stx MB6b+2 +} + + stx MB0+2 + stx MB7+2 + + stx nMBBaseHi + + ; + + lda #$07 + ldy #SY6522_DDRB + sta (MBBase),y + ldy #SY6522_DDRB+$80 + sta (MBBase),y + + lda #$ff + ldy #SY6522_DDRA + sta (MBBase),y + ldy #SY6522_DDRA+$80 + sta (MBBase),y + + lda #AY_RESET + ldy #SY6522_ORB + sta (MBBase),y + ldy #SY6522_ORB+$80 + sta (MBBase),y + + ldx nSongNum + cpx #255 + bne NotFini + + jmp InitExit + +NotFini: + lda SongTbl,x + sta .RegSongNum +} + +;-------------------------------------- + +!macro MB_Init2 { + lda #0 + sta nFrameNum+0 + sta nFrameNum+1 + sta nFrameNum+2 + + ; Setup Timer1 IRQ to trigger at 50Hz + ; Apple CLK = 1.022727 MHz, so set Timer1=0x4fe7 + + sei + + lda #$e7 + ldy #SY6522_TIMER1L_COUNTER + sta (MBBase),y + lda #$4f + ldy #SY6522_TIMER1H_COUNTER + sta (MBBase),y + + lda #1<<6 + ldy #SY6522_ACR + sta (MBBase),y ; Free running timer + + lda #1<<7 | 1<<6 + ldy #SY6522_IER + sta (MBBase),y ; Enable Timer1 IRQ + + lda #Interrupt ; ADDR_H + sta IRQH + +InitExit: + cli + + +SaveRegs Z80Block + +InitExit2: + +RestoreRegs ZPBlock +} + +;-------------------------------------- + +!macro SF_UpdateAY { + +; Skyfox's routine to update AY regs: + +SF_SelectReg: +MBx1: sta CARD_BASE+SY6522_ORA,x + lda #AY_LATCH + bne .l675e + +SF_WriteReg: +MBx2: sta CARD_BASE+SY6522_ORA,x + lda #AY_WRITE + bne .l675e + +SF_ChipReset: + lda #AY_RESET + +.l675e: +MBx3: sta CARD_BASE+SY6522_ORB,x + lda #AY_INACTIVE +MBx4: sta CARD_BASE+SY6522_ORB,x + rts +} + +;-------------------------------------- + +!if SPECTRUM128_STEREO { +; L = A+Bx0.5, R = C'+B'x0.5 +; + +!macro MB_WriteAYRegs .ay_regs_base { + ; Enable SLOTXROM while accessing MB regs + lda SW_SLOTXROM_R + pha + bpl .ay_init ; branch if b7=0 (enabled) + sta SW_SLOTXROM_ENA + +.ay_init: + ldy #$0D + +.ay_loop: + lda .ay_regs_base,y + + cpy #AY_ENABLE + bne .ay_cont + + tax ; Save AY_ENABLE + ora #AY_DIS_C + sta .ay0_regs,y + + txa ; Restore AY_ENABLE + ora #AY_DIS_A + sta .ay1_regs,y + + dey + bpl .ay_loop ; branch always taken + + ; + +.ay_cont: + sta .ay0_regs,y + sta .ay1_regs,y + dey + bpl .ay_loop + + ; + + ; Post processing +AYPostProc: + lda #0 + sta .ay1_regs+AY_AVOL + sta .ay0_regs+AY_CVOL + + ; + ; Attenuate AVOL + + lda .ay_regs_base+AY_AVOL + sec + sbc nAttA + bpl .ay_set_a_vol + lda #0 +.ay_set_a_vol + sta .ay0_regs+AY_AVOL + + ; + ; Attenuate BVOL + + lda .ay_regs_base+AY_BVOL + sec + sbc nAttB + bpl .ay_set_b_vol + lda #0 +.ay_set_b_vol + sta .ay0_regs+AY_BVOL + sta .ay1_regs+AY_BVOL + + ; + ; Attenuate CVOL + + lda .ay_regs_base+AY_CVOL + sec + sbc nAttC + bpl .ay_set_c_vol + lda #0 +.ay_set_c_vol + sta .ay1_regs+AY_CVOL + + ; + ; User disable A/B/C + +.ay_chk_maska: + lda nMaskA + beq .ay_chk_maskb + lda #0 + sta .ay0_regs+AY_AVOL + + lda .ay0_regs+AY_ENABLE + ora #AY_DIS_A + sta .ay0_regs+AY_ENABLE + +.ay_chk_maskb: + lda nMaskB + beq .ay_chk_maskc + lda #0 + sta .ay0_regs+AY_BVOL + sta .ay1_regs+AY_BVOL + + lda .ay0_regs+AY_ENABLE + ora #AY_DIS_B + sta .ay0_regs+AY_ENABLE + + lda .ay1_regs+AY_ENABLE + ora #AY_DIS_B + sta .ay1_regs+AY_ENABLE + +.ay_chk_maskc: + lda nMaskC + beq .ay_chk_mask_done + lda #0 + sta .ay1_regs+AY_CVOL + + lda .ay1_regs+AY_ENABLE + ora #AY_DIS_C + sta .ay1_regs+AY_ENABLE + +.ay_chk_mask_done: + + ; + + ldx #0 + ldy #$0D +.sf_loop0: tya + jsr SF_SelectReg + lda .ay0_regs,y + jsr SF_WriteReg + dey + bpl .sf_loop0 + + ; + + ldx #$80 + ldy #$0D +.sf_loop1: tya + jsr SF_SelectReg + lda .ay1_regs,y + jsr SF_WriteReg + dey + bpl .sf_loop1 + + ; Disable SLOTXROM if necessary + pla + bpl .ay_done ; branch if b7=0 (enabled) + sta SW_SLOTXROM_DIS + bmi .ay_done ; branch always taken + + ;-------------- + +.ay0_regs: !fill 14,0 +.ay1_regs: !fill 14,0 + + +SF_UpdateAY + + ;-------------- + +.ay_done: + +} +} ; !if SPECTRUM128_STEREO + +;------------------ + +!if DUAL_MONO { +; L = A+B+C, R=A'+B'+C' +; + +!macro MB_WriteAYRegs .ay_regs_base { + ; Enable SLOTXROM while accessing MB regs + lda SW_SLOTXROM_R + pha + bpl .ay_init ; branch if b7=0 (enabled) + sta SW_SLOTXROM_ENA + +.ay_init: + ldy #$0D + lda #<.ay_regs_base + sta TmpL + lda #>.ay_regs_base + sta TmpH + +.ay_loop: + ; Select AY reg +MB1: sty CARD_BASE+SY6522_ORA +MB1b: sty CARD_BASE+SY6522_ORA+$80 + lda #$07 ; LATCH +MB2: sta CARD_BASE+SY6522_ORB +MB2b: sta CARD_BASE+SY6522_ORB+$80 + lda #$04 ; INACTIVE +MB3: sta CARD_BASE+SY6522_ORB +MB3b: sta CARD_BASE+SY6522_ORB+$80 + + ; Write AY reg + lda (TmpL),y +MB4: sta CARD_BASE+SY6522_ORA +MB4b: sta CARD_BASE+SY6522_ORA+$80 + lda #$06 ; WRITE +MB5: sta CARD_BASE+SY6522_ORB +MB5b: sta CARD_BASE+SY6522_ORB+$80 + lda #$04 ; INACTIVE +MB6: sta CARD_BASE+SY6522_ORB +MB6b: sta CARD_BASE+SY6522_ORB+$80 + + dey + bpl .ay_loop + + ; Disable SLOTXROM if necessary + pla + bpl .ay_done ; branch if b7=0 (enabled) + sta SW_SLOTXROM_DIS + +.ay_done: +} +} ; !if DUAL_MONO + +;-------------------------------------- + +!macro MB_ISR .isr_main { +; Pre: +; 6502 has pushed P +; Apple ROM has stored A to $45 (not Apple //e ROM!) +; + + txa + pha + tya + pha + + +SaveRegs ZPBlock + +RestoreRegs Z80Block + + jsr .isr_main + + +SaveRegs Z80Block + +RestoreRegs ZPBlock + + lda #1<<6 +MB7: + sta CARD_BASE+SY6522_IFR ; Clear Timer1 IRQ flag + + pla + tay + pla + tax + + lda $45 + rti +} diff --git a/Common/MockingboardDefs.a b/Common/MockingboardDefs.a new file mode 100644 index 0000000..e1f6408 --- /dev/null +++ b/Common/MockingboardDefs.a @@ -0,0 +1,45 @@ +; Mockingboard defines: + +CARD_BASE = $C100 + +SY6522_ORB = 0 +SY6522_ORA = 1 +SY6522_DDRB = 2 +SY6522_DDRA = 3 +SY6522_TIMER1L_COUNTER = 4 +SY6522_TIMER1H_COUNTER = 5 +SY6522_TIMER2L_COUNTER = 8 +SY6522_TIMER2H_COUNTER = 9 +SY6522_ACR = $B +SY6522_IFR = $D +SY6522_IER = $E + +AY_AFINE = 0 +AY_ACOARSE = 1 +AY_BFINE = 2 +AY_BCOARSE = 3 +AY_CFINE = 4 +AY_CCOARSE = 5 +AY_NOISEPER = 6 +AY_ENABLE = 7 +AY_AVOL = 8 +AY_BVOL = 9 +AY_CVOL = 10 +AY_EFINE = 11 +AY_ECOARSE = 12 +AY_ESHAPE = 13 + +AY_ENA_A = %110110 ; Enable A (Noise & Tone) +AY_ENA_B = %101101 ; Enable B (Noise & Tone) +AY_ENA_C = %011011 ; Enable C (Noise & Tone) + +AY_DIS_A = %001001 ; Disable A (Noise & Tone) +AY_DIS_B = %010010 ; Disable B (Noise & Tone) +AY_DIS_C = %100100 ; Disable C (Noise & Tone) + +; AY inputs on BDIR|BC2|BC1: +AY_RESET = 0 +AY_INACTIVE = 4 +AY_READ = 5 +AY_WRITE = 6 +AY_LATCH = 7 \ No newline at end of file diff --git a/Common/Z80-Macros.a b/Common/Z80-Macros.a new file mode 100644 index 0000000..569c808 --- /dev/null +++ b/Common/Z80-Macros.a @@ -0,0 +1,260 @@ +; 6502 -> Z80 macros +; + +; C flag differences: +; +; A=1, A=2, A=3, +; CMP #2: CMP #2: CMP #2: +; SCZ SCZ SCZ +; 6502: 100 011 010 +; Z80: 110 001 000 +; +; So 6502_C = !(Z80_C) +; + +; ld c,a +!macro LD .dst, .reg { + lda .reg + sta .dst +} + +; ld c,80h +!macro LD_REG_IMM .dst, .src { + lda #.src + sta .dst +} + +; ld ix,lf214 +; ld hl,0008h +!macro LDW .dst, .const { + lda #<.const ; LSB + sta .dst + lda #>.const ; MSB + sta .dst + 1 +} + +; ld a,(hl) +!macro LD_REG_INDIRECT .dst, .reg16 { + ldx #0 + lda (.reg16,x) + sta .dst +} + +; ld (0f1fch),a +!macro LD_INDIRECT_ABS .dst, .reg { + lda .reg + sta .dst +} + +; ld a,(0f1fdh) +!macro LD_REG_INDIRECT_ABS .reg, .dst { + lda .dst + sta .reg +} + +; ld (ix+19h),a +!macro LD_INDIRECT_OFFSET .reg16, .offset, .src { + ldy #.offset + lda .src + sta (.reg16),y +} + +; ld (ix+19h),01h +!macro LD_INDIRECT_OFFSET_IMM .reg16, .offset, .src { + ldy #.offset + lda #.src + sta (.reg16),y +} + +; ld h,(ix+15h) +!macro LD_REG_INDIRECT_OFFSET .dst, .reg16, .offset { + ldy #.offset + lda (.reg16),y + sta .dst +} + +; ld (hl),a +!macro LD_INDIRECT .reg16, .src { + ldx #0 + lda .src + sta (.reg16,x) +} + +; ld (hl),00h +!macro LD_INDIRECT_IMM .reg16, .src { + ldx #0 + lda #.src + sta (.reg16,x) +} + +; ld hl,(0f1f6h) +; ld (0f1f6h),hl +!macro LDW_INDIRECT .dst, .src { + lda .src + sta .dst + lda .src+1 + sta .dst+1 +} + +; inc hl +!macro INCW .reg16 { + inc .reg16 + bne .j + inc .reg16 + 1 +.j +} + +; inc (hl) +!macro INC_INDIRECT .reg16 { + ldx #0 + lda (.reg16,x) + tay ; No inca for 6502! (65C02 only) + iny + tya + sta (.reg16,x) +} + +; dec hl +!macro DECW .reg16 { + dec .reg16 + lda .reg16 + cmp #$ff + bne .j + dec .reg16 + 1 +.j +} + +; dec (ix+11h) +!macro DEC_INDIRECT_OFFSET .reg, .offset { + ldy #.offset + lda (.reg),y + tax ; No deca for 6502! (65C02 only) + dex + txa + sta (.reg),y +} + +!macro JP_Z .label { + bne .j + jmp .label +.j +} + +!macro JP_NZ .label { + beq .j + jmp .label +.j +} + +!macro JP_C .label { + bcs .j ; bcs, as C flag is inverted + jmp .label +.j +} + +!macro JP_NC .label { + bcc .j ; bcc, as C flag is inverted + jmp .label +.j +} + +!macro RET_Z { + bne .j + rts +.j +} + +!macro RET_NZ { + beq .j + rts +.j +} + +!macro RET_C { + bcs .j ; bcs, as C flag is inverted + rts +.j +} + +!macro RET_NC { + bcc .j ; bcc, as C flag is inverted + rts +.j +} + +!macro PUSH16 .reg16 { + lda .reg16 + pha + lda .reg16+1 + pha +} + +!macro POP16 .reg16 { + pla + sta .reg16+1 + pla + sta .reg16 +} + +!macro ADDW .dst, .src { + clc + lda .dst + adc .src + sta .dst + lda .dst+1 + adc .src+1 + sta .dst+1 +} + +!macro INVERT_CARRY { + php + pla + eor #$01 ; Invert C + pha + plp +} + +; Pre: Ensure that CARRY is setup correctly +!macro SBCW .dst, .src { + lda .dst + sbc .src + sta .dst + lda .dst+1 + sbc .src+1 + sta .dst+1 +} + +; sub (hl) +!macro SUB_INDIRECT .reg16 { + ldx #0 + sec + sbc (.reg16,x) + sta RegA +} + +; ldi +; . (de++) <- (hl++) +; . bc-- +!macro LDI { + ldx #0 + lda (RegHL,x) + sta (RegDE,x) + inc RegL + bne .a + inc RegH +.a + inc RegE + bne .b + inc RegD +.b + dec RegBC + bne .j + dec RegBC+1 +.j +} + +; cp (ix+10h) +!macro CP_INDIRECT_OFFSET .reg, .offset { + ldy #.offset + cmp (.reg),y +} diff --git a/Common/ZP-Macros.a b/Common/ZP-Macros.a new file mode 100644 index 0000000..6d469fe --- /dev/null +++ b/Common/ZP-Macros.a @@ -0,0 +1,43 @@ +RegA = $F0 +RegF = RegA+1 ; Not used +RegBC = RegA+2 ; WORD +RegC = RegA+2 +RegB = RegA+3 +RegDE = RegA+4 ; WORD +RegE = RegA+4 +RegD = RegA+5 +RegHL = RegA+6 ; WORD +RegL = RegA+6 +RegH = RegA+7 +RegIX = RegA+8 ; WORD + +TmpHL = RegA+10 +TmpL = TmpHL +TmpH = TmpHL+1 + +MBBase = TmpHL+2 ; Mockingboard base (only used in INIT - not in INTERRUPT) +MBBaseL = MBBase +MBBaseH = MBBase+1 + +ZPSize = MBBaseH - RegA + 1 + +;-------------------------------------- + +!macro SaveRegs .block { + !set ZP = RegA + !do while ZP <= TmpH { + lda ZP + sta .block + ZP - RegA + !set ZP = ZP + 1 + } +} + +!macro RestoreRegs .block { + !set ZP = RegA + !do while ZP <= TmpH { + lda .block + ZP - RegA + sta ZP + !set ZP = ZP + 1 + } +} + diff --git a/ConvertZ80/ConvertZ80.py b/ConvertZ80/ConvertZ80.py new file mode 100644 index 0000000..73c9b2f --- /dev/null +++ b/ConvertZ80/ConvertZ80.py @@ -0,0 +1,594 @@ +import os +import re +import sys + +Z80Regs8 = ('a','b','c','d','e','f','h','l') +Z80Regs16 = ('af', 'bc', 'de', 'hl', 'ix') + +#============================================================================== + +def GetLine(f): + szLine = f.readline() + while szLine != '': + if szLine[0] != ';': + return szLine + szLine = f.readline() + return '' + +#------------------------------------------------------------------------------ + +def GetConst(S): + const = S + if re.match('\d', const): # 1st char is [0..9] + if const[len(const)-1] == 'h': + const = const[:len(const)-1] # Strip last char + + if len(const) > 4 and const[0] == '0': + const = const[1:] # Strip leading zero + + if len(const) > 2 and const[0] == '0': + const = const[1:] # Strip leading zero + + const = '$' + const + + return const + +#-------------------------------------- + +# S = 0008h -> $0008 +# S = label -> label +# S = labeh -> labeh +def GetAddr16(S): + return GetConst(S) + +#-------------------------------------- + +# S = (0008h) -> $0008 +# S = (label) -> label +# S = (labeh) -> labeh +def GetIndirectAddr16(S): + res = S[:len(S)-1] # Strip last char + res = res[1:] # Strip 1st char + return GetConst(res) + +#-------------------------------------- + +def GetRegOffset(S): + reg = S[1:3] # Middle 2 chars + if reg not in Z80Regs16: + print 'Illegal Z80 reg: ' + reg + return ('', '') + + offset = S[4:] # Strip 1st 4 chars: '(ix+' + offset = offset[:len(offset)-1] # Strip last char: ')' + + if offset[len(offset)-1] == 'h': + offset = offset[:len(offset)-1] # Strip last char: 'h' + offset = '$' + offset + + return reg, offset + +#============================================================================== + +def adc(S): + + if S[2] in Z80Regs8 and S[3] not in Z80Regs8: + const = GetConst(S[3]) + print '\tlda\t' + 'Reg' + S[2].upper() + print '\tadc\t' + '#' + const + print '\tsta\t' + 'Reg' + S[2].upper() + + else: + print 'ADC error: unsupported addressing mode: ' + S[2], S[3] + +#------------------------------------------------------------------------------ + +def add(S): + + ind2 = S[3][0] == '(' # S[3] is indirect + + m2plus = re.search('\+', S[3]) + + if S[2] in Z80Regs8 and S[3] in Z80Regs8: + # add a,a + if S[2] == S[3]: + print '\tlda\t' + 'Reg' + S[2].upper() + print '\tasl\t' + print '\tsta\t' + 'Reg' + S[2].upper() + else: + print '\tclc\t' + print '\tlda\t' + 'Reg' + S[2].upper() + print '\tadc\t' + 'Reg' + S[3].upper() + print '\tsta\t' + 'Reg' + S[2].upper() + + elif S[2] in Z80Regs8 and ind2 and m2plus: + # add a,(ix+18h) + reg, offset = GetRegOffset(S[3]) + print '\tclc\t' + '\t; CARRY possibly wrong' + print '\tldy\t' + '#' + offset + print '\tlda\t' + 'Reg' + S[2].upper() + print '\tadc\t' + '(Reg' + reg.upper() + '),y' + print '\tsta\t' + 'Reg' + S[2].upper() + + elif S[2] in Z80Regs8: + # add a,05h + const = GetConst(S[3]) + print '\tclc\t' + '\t; CARRY possibly wrong' + print '\tlda\t' + 'Reg' + S[2].upper() + print '\tadc\t' + '#' + const + print '\tsta\t' + 'Reg' + S[2].upper() + + elif S[2] in Z80Regs16 and S[3] in Z80Regs16: + # add hl,bc + print '\t+ADDW\t' + 'Reg' + S[2].upper() + ', ' + 'Reg' + S[3].upper() + + else: + print 'ADD error: unsupported addressing mode: ' + S[2], S[3] + +#------------------------------------------------------------------------------ + +def _and(S): + + ind2 = S[2][0] == '(' # S[2] is indirect + + m2plus = re.search('\+', S[2]) + + if S[2] in Z80Regs8: + # and e + print '\tand\t' + 'Reg' + S[2].upper() + + elif ind2 and m2plus: + # and (ix+1bh) + reg, offset = GetRegOffset(S[2]) + print '\tldy\t' + '#' + offset + print '\tand\t' + '(Reg' + reg.upper() + '),y' + + else: + # and 3fh + const = GetConst(S[2]) + print '\tand\t' + '#' + const + +#------------------------------------------------------------------------------ + +def cp(S): + + ind2 = S[2][0] == '(' # S[2] is indirect + + m2plus = re.search('\+', S[2]) + + if ind2 and m2plus: + # cp (ix+10h) + reg, offset = GetRegOffset(S[2]) + print '\t+CP_INDIRECT_OFFSET\t' + 'Reg' + reg.upper() + ', ' + offset + + elif not ind2: + const = GetConst(S[2]) + print '\tcmp\t' + '#' + const + + else: + print 'CP error: unsupported addressing mode: ' + S[2] + +#------------------------------------------------------------------------------ + +def dec(S): + + ind2 = S[2][0] == '(' # S[2] is indirect + + m2plus = re.search('\+', S[2]) + + if S[2] in Z80Regs8: + print '\tdec\t' + 'Reg' + S[2].upper() + + elif S[2] in Z80Regs16: + # dec hl + reg = GetAddr16(S[2]) + print '\t+DECW\t' + 'Reg' + reg.upper() + + elif ind2 and m2plus: + # dec (ix+11h) + reg, offset = GetRegOffset(S[2]) + if reg == '': + return + print '\t+DEC_INDIRECT_OFFSET\t' + 'Reg' + reg.upper() + ', ' + offset + + else: + print ';DEC error: unsupported addressing mode: ' + S[2] + +#------------------------------------------------------------------------------ + +def inc(S): + + ind2 = S[2][0] == '(' # S[2] is indirect + + if S[2] in Z80Regs8: + print '\tinc\t' + 'Reg' + S[2].upper() + return + + # + + if ind2: + # inc (hl) + reg = GetIndirectAddr16(S[2]) + + else: + # inc hl + reg = GetAddr16(S[2]) + + if reg not in Z80Regs16: + print 'INC error: Illegal Z80 reg: ' + reg + elif ind2: + print '\t+INC_INDIRECT\t' + 'Reg' + reg.upper() + else: + print '\t+INCW\t' + 'Reg' + reg.upper() + +#------------------------------------------------------------------------------ + +def jp(S): + + if S[3] == '': + print '\tjmp\t' + S[2] + return + + if S[2] == 'z': + print '\t+JP_Z\t' + S[3] + elif S[2] == 'nz': + print '\t+JP_NZ\t' + S[3] + elif S[2] == 'c': + print '\t+JP_C\t' + S[3] + elif S[2] == 'nc': + print '\t+JP_NC\t' + S[3] + else: + print ';JP error: unsupported cc: ' + S[2] + +#------------------------------------------------------------------------------ + +def jr(S): + + if S[3] == '': + print '\tjmp\t' + S[2] + return + + if S[2] == 'z': + print '\tbeq\t' + S[3] + elif S[2] == 'nz': + print '\tbne\t' + S[3] + elif S[2] == 'c': + print '\tbcc\t' + S[3] # C inverted + elif S[2] == 'nc': + print '\tbcs\t' + S[3] # C inverted + else: + print 'JR error: unsupported cc: ' + S[2] + +#------------------------------------------------------------------------------ + +def ld(S): + + m2 = S[2] in Z80Regs8 + m3 = S[3] in Z80Regs8 + + m2plus = re.search('\+', S[2]) + m3plus = re.search('\+', S[3]) + + len2 = len(S[2]) + len3 = len(S[3]) + + ind2 = S[2][0] == '(' # S[2] is indirect + ind3 = S[3][0] == '(' # S[3] is indirect + + if m2 and m3: + # ld c,a + print '\t+LD\t' + 'Reg' + S[2].upper() + ', ' + 'Reg' + S[3].upper() + return + + elif m2 and not ind3: + # ld c,80h + const = GetConst(S[3]) + print '\t+LD_REG_IMM\t' + 'Reg' + S[2].upper() + ', ' + const + return + + elif m2 and ind3 and len3 == len('(xx)'): + # ld a,(hl) + reg = S[3][1:3] # Middle 2 chars + if reg not in Z80Regs16: + print 'Illegal Z80 reg: ' + reg + return + print '\t+LD_REG_INDIRECT\t' + 'Reg' + S[2].upper() + ', ' + 'Reg' + reg.upper() + return + + elif m2 and ind3 and m3plus: + # ld h,(ix+15h) + reg, offset = GetRegOffset(S[3]) + if reg == '': + return + print '\t+LD_REG_INDIRECT_OFFSET\t' + 'Reg' + S[2].upper() + ', ' + 'Reg' + reg.upper() + ', ' + offset + return + + elif m2 and ind3: + # ld a,(0f1fdh) + # ld a,(lf1fd) + abs = GetIndirectAddr16(S[3]) + print '\t+LD_REG_INDIRECT_ABS\t' + 'Reg' + S[2].upper() + ', ' + abs + return + + elif S[2] in Z80Regs16 and ind3: + # ld hl,(lf1f6) + # ld hl,(0f1f6h) + src = GetIndirectAddr16(S[3]) + print '\t+LDW_INDIRECT\t' + 'Reg' + S[2].upper() + ', ' + src + return + + elif S[2] in Z80Regs16: + # ld ix,lf214 + # ld hl,0008h + const = GetAddr16(S[3]) + print '\t+LDW\t' + 'Reg' + S[2].upper() + ', ' + const + return + + elif ind2 and m2plus and m3: + # ld (ix+19h),a + reg, offset = GetRegOffset(S[2]) + if reg == '': + return + print '\t+LD_INDIRECT_OFFSET\t' + 'Reg' + reg.upper() + ', ' + offset + ', ' + 'Reg' + S[3].upper() + return + + elif ind2 and m2plus and not m3: + # ld (ix+19h),01h + reg, offset = GetRegOffset(S[2]) + if reg == '': + return + const = GetConst(S[3]) + print '\t+LD_INDIRECT_OFFSET_IMM\t' + 'Reg' + reg.upper() + ', ' + offset + ', ' + const + return + + elif ind2 and m3: + # ld (hl),a + # ld (0f1fch),a + # ld (lf1fc),a + Addr16 = GetIndirectAddr16(S[2]) + if Addr16 in Z80Regs16: + print '\t+LD_INDIRECT\t' + 'Reg' + Addr16.upper() + ', ' + 'Reg' + S[3].upper() + else: + print '\t+LD_INDIRECT_ABS\t' + Addr16 + ', ' + 'Reg' + S[3].upper() + return + + elif ind2 and not m3: + # ld (hl),00h + # ld (0f1f6h),hl + # ld (lf1f6h),hl + Addr16 = GetIndirectAddr16(S[2]) + const = GetConst(S[3]) + if Addr16 in Z80Regs16: + print '\t+LD_INDIRECT_IMM\t' + 'Reg' + Addr16.upper() + ', ' + const + elif const in Z80Regs16: + print '\t+LDW_INDIRECT\t' + Addr16 + ', ' + 'Reg' + const.upper() + else: + print 'Illegal Z80 reg: ' + Addr16 + return + + # + + print 'LD error: No match for ' + S[2], S[3] + +#------------------------------------------------------------------------------ + +def orr(S): + + if S[2] in Z80Regs8: + # or l + print '\tora\t' + 'Reg' + S[2].upper() + else: + # or 38h + const = GetConst(S[2]) + print '\tora\t' + '#' + const + +#------------------------------------------------------------------------------ + +def pop(S): + + if S[2] in Z80Regs16: + # pop de + print '\t+POP16\t' + 'Reg' + S[2].upper() + else: + print 'POP error: unsupported addressing mode' + +#------------------------------------------------------------------------------ + +def push(S): + + if S[2] in Z80Regs16: + # push de + print '\t+PUSH16\t' + 'Reg' + S[2].upper() + else: + print 'PUSH error: unsupported addressing mode' + +#------------------------------------------------------------------------------ + +def sbc(S): + + if S[2] in Z80Regs16 and S[3] in Z80Regs16: + # sbc hl,bc + print '\t+SBCW\t' + 'Reg' + S[2].upper() + ', ' + 'Reg' + S[3].upper() + else: + print 'SBC error: unsupported addressing mode' + +#------------------------------------------------------------------------------ + +def sub(S): + + ind2 = S[2][0] == '(' # S[2] is indirect + + if S[2] in Z80Regs8: + # sub l + print '\tsbc\t' + 'Reg' + S[2].upper() + '\t; CARRY possibly wrong' + + elif ind2: + # sub (hl) + reg = GetIndirectAddr16(S[2]) + if reg not in Z80Regs16: + print 'DEC error: Illegal Z80 reg: ' + Addr16 + return + print '\t+SUB_INDIRECT\t' + 'Reg' + reg.upper() + + else: + # sub 80h + const = GetConst(S[2]) + print '\tsec\t' + '\t; CARRY possibly wrong' + print '\tsbc\t' + '#' + const + +#------------------------------------------------------------------------------ + +def ret(S): + + if S[2] == '': + print '\trts' + elif S[2] == 'z': + print '\t+RET_Z\t' + S[3] + elif S[2] == 'nz': + print '\t+RET_NZ\t' + S[3] + elif S[2] == 'c': + print '\t+RET_C\t' + S[3] + elif S[2] == 'nc': + print '\t+RET_NC\t' + S[3] + else: + print ';RET error: unsupported cc: ' + S[2] + + print '' + +#------------------------------------------------------------------------------ + +def xor(S): + + ind2 = S[2][0] == '(' # S[2] is indirect + + if S[2] in Z80Regs8: + print '\t+LD_REG_IMM\t' + 'Reg' + S[2].upper() + ', 0' + '\t; xor ' + S[2] +# elif ind2: +# reg = GetIndirectAddr16(S[2]) + else: + print 'XOR error: unsupported addressing mode' + +#============================================================================== + +def Process(S): + if S[0] != '': + print S[0] + + if S[1] == '': + return 1 # No opcode + elif S[1] == 'nop': + return 0 # Assume this is data section + + elif S[1] == 'adc': + adc(S) + elif S[1] == 'add': + add(S) + elif S[1] == 'and': + _and(S) + elif S[1] == 'call': + print '\tjsr\t' + S[2] + elif S[1] == 'dec': + dec(S) + elif S[1] == 'cp': + cp(S) + elif S[1] == 'inc': + inc(S) + elif S[1] == 'jp': + jp(S) + elif S[1] == 'jr': + jr(S) + elif S[1] == 'ld': + ld(S) + elif S[1] == 'ldi': + print '\t+LDI' + elif S[1] == 'or': + orr(S) + elif S[1] == 'pop': + pop(S) + elif S[1] == 'push': + push(S) + elif S[1] == 'ret': + ret(S) + elif S[1] == 'sbc': + sbc(S) + elif S[1] == 'sub': + sub(S) + elif S[1] == 'xor': + xor(S) + else: + s = ';\t' + for i in range(len(S)): + s = s + S[i] + s = s + '\t; ** Unknown opcode **' + print s + + return 1 + +#------------------------------------------------------------------------------ + +def hdr_code(): + print ';ACME 0.85' + print '' + print '!cpu 6502 ; Compatible with all Apple2\'s' + print '!to \"TEST\", plain' + print '!sl \"TEST.labels\"' + print '*=$6000' + print '' + print '!source \"..\\Common\\Z80-Macros.a\"' + print '!source \"..\\Common\\ZP-Macros.a\"' + print '!source \"..\\Common\\AppleDefs.a\"' + print '!source \"..\\Common\\MockingboardDefs.a\"' + print '' + print ';------------------------------------------------------------------------------' + print '' + print '!zone code' + print '' + +#------------------------------------------------------------------------------ + +def hdr_data(): + print '' + print ';------------------------------------------------------------------------------' + print '' + print '!zone data' + print '' + +#------------------------------------------------------------------------------ + +def help(): + print 'ConvertZ80 v1.0.0' + print '' + print 'Usage: ConvertZ80.py ' + +#------------------------------------------------------------------------------ + +def main(): + if len(sys.argv) < 2: + help() + return + + hFileIn = open(sys.argv[1], 'r') + + #if len(sys.argv) >= 3: + # hFileOut = open(sys.argv[2], 'w') + + hdr_code() + + n = 0 + while n < 1000: + szLine = GetLine(hFileIn) + if szLine == '': + break + Split = re.split('\s+|,', szLine) + if Process(Split) == 0: + break + n = n + 1 + + hdr_data() + + hFileIn.close() + #hFileOut.close() + +#------------------------------------------------------------------------------ + +main() diff --git a/Cybernoid/Cybernoid.a b/Cybernoid/Cybernoid.a new file mode 100644 index 0000000..f0a73e8 --- /dev/null +++ b/Cybernoid/Cybernoid.a @@ -0,0 +1,1450 @@ +;ACME 0.85 + +!cpu 6502 ; Compatible with all Apple2's +!to "Cybernoid", plain +!sl "Cybernoid.labels" +*=$6000 + +;------------------------------------------------------------------------------ + +!source "..\Common\Z80-Macros.a" +!source "..\Common\ZP-Macros.a" +!source "..\Common\AppleDefs.a" +!source "..\Common\MockingboardDefs.a" +!source "..\Common\MB-Macros.a" + +;------------------------------------------------------------------------------ + +!zone code + +;-------------------------------------- + +NUM_SONGS = 16 + +INIT: +; Pre: A = Song# [0..NUM_SONGS-1] +; + + +MB_Init1 RegE + + +PUSH16 RegDE + jsr lef93 + +POP16 RegDE + jsr lef42 + + +MB_Init2 + rts + +;-------------------------------------- + +lef42: ; Called by INIT & Cmd_09 + +LD RegC, RegA + jsr lefc1 ; Pre: RegE, Post: RegHL + + +LD_REG_INDIRECT RegA, RegHL ; ld a,(hl) + cmp #9 + +JP_NC lef4e ; jp nc,0ef4eh + + +LD RegC, RegA + +INCW RegHL ; inc hl + +lef4e: + +LD RegA, RegC + + +LDW RegIX, lf214 + dec RegA + beq lef63 ; jp z,0ef63h + + +LDW RegIX, lf237 + dec RegA + beq lef63 ; jp z,0ef63h + + +LDW RegIX, lf25a + +lef63: + +LD_REG_INDIRECT RegA, RegHL ; ld a,(hl) + cmp #$f4 + php + +LD_REG_IMM RegA, $0A ; ld a,0ah + plp + bne lef6e ; jp z,0ef6eh + +INCW RegHL + +LD_REG_INDIRECT RegA, RegHL ; ld a,(hl) + +INCW RegHL + +lef6e: + +CP_INDIRECT_OFFSET RegIX, $10 + +RET_C + + ; + + lda RegA + sta (RegIX),y ; ld (ix+10h),a + + lda #$01 + iny ; y=$11 + sta (RegIX),y ; ld (ix+11h),01h + + lda RegL + iny ; y=$12 + sta (RegIX),y ; ld (ix+12h),l + ldy #$14 + sta (RegIX),y ; ld (ix+14h),l + ldy #$16 + sta (RegIX),y ; ld (ix+16h),l + + lda RegH + ldy #$13 + sta (RegIX),y ; ld (ix+13h),h + ldy #$15 + sta (RegIX),y ; ld (ix+15h),h + ldy #$17 + sta (RegIX),y ; ld (ix+17h),h + + +LD_REG_IMM RegA, 0 ; xor a + iny ; y=$18 + sta (RegIX),y ; ld (ix+18h),a + ldy #$20 + sta (RegIX),y ; ld (ix+20h),a + rts + +;-------------------------------------- + +; Called by INIT + +lef93: + +LD_REG_IMM RegA, 0 ; xor a + sta lf224 + sta lf247 + sta lf26a + sta lf1fe ; A volume + sta lf1ff ; B volume + sta lf200 ; C volume + + +LD_REG_IMM RegA, $3f ; Enable = $3F (all disabled) + sta lf1fd + + ; + +; Called by Interrupt0 + +lefab: + ; Copy [lf203..lf1f6] -> AY registers + +MB_WriteAYRegs lf1f6 + + rts + +;-------------------------------------- + +; Refs tables at f3a6 & f28e + +lefc1: +; Pre: +; RegE +; . Assume 2*RegE < 0xFF (OK since table at lf3a6 is only 43 (50?) words) +; Post: +; RegHL = 0xF28E + *(IWORD*)(0xF3A6 + 2*RegE) + + lda RegE + cmp #43 + bcc .lt1 + brk +.lt1 + + lda #lf3a6 + sta TmpHL+1 ; MSB + + +LD RegA, RegE + asl ; =lsl + tay + + clc + lda (TmpHL),y ; LSB + adc #lf28e + sta RegH + + rts + +;-------------------------------------- + +lefd2: +; Pre: +; RegE +; . Assume 2*RegE < 0xFF (OK since table at lf356 is only 40 words) +; Post: +; RegBC = 0xF28E + *(IWORD*)(0xF356 + 2*RegE) + + lda RegE + cmp #40 + bcc .lt2 + brk +.lt2 + + lda #lf356 + sta TmpHL+1 ; MSB + + +LD RegA, RegE + asl ; =lsl + tay + + clc + lda (TmpHL),y ; LSB + adc #lf28e + sta RegB + + rts + +;-------------------------------------- + +Interrupt: + +MB_ISR lefe5 + +;-------------------------------------- + +lefe5: + inc nFrameNum+2 + lda nFrameNum+2 + cmp #50 + bne .fnum_ok + lda #0 + sta nFrameNum+2 + inc nFrameNum+1 + lda nFrameNum+1 + cmp #60 + bne .fnum_ok + lda #0 + sta nFrameNum+1 + inc nFrameNum+0 +.fnum_ok: + + ; + + jsr lefab + + +LDW RegIX, lf214 + +LDW_INDIRECT RegHL, lf1f6 ; HL = A-freq + jsr lf01b + +LDW_INDIRECT RegHL, lf204 + +LDW_INDIRECT lf1f6, RegHL ; A-freq = HL + + +LDW_INDIRECT RegHL, lf1f8 ; HL = B-freq + +LDW RegIX, lf237 + jsr lf01b + +LDW_INDIRECT RegHL, lf204 + +LDW_INDIRECT lf1f8, RegHL ; B-freq = HL + + +LDW_INDIRECT RegHL, lf1fa ; HL = C-freq + +LDW RegIX, lf25a + jsr lf01b + +LDW_INDIRECT RegHL, lf204 + +LDW_INDIRECT lf1fa, RegHL ; C-freq = HL + + jmp lf1b1 + +;-------------------------------------- + +lf01b: + +LDW_INDIRECT lf204, RegHL + ldy #$10 + lda (RegIX),y + sta RegA + +RET_Z + + +DEC_INDIRECT_OFFSET RegIX, $11 + +JP_NZ lf162 + + lda #$14 + ldy #$1e + sta (RegIX),y ; ld (ix+1eh),14h + +lf02d: + ldy #$13 + lda (RegIX),y + sta RegH ; ld h,(ix+13h) + dey + lda (RegIX),y ; ld l,(ix+12h) + sta RegL + +lf033: + ldx #0 + lda (RegHL,x) + sta RegA ; ld a,(hl) - Cmd + +INCW RegHL + lda (RegHL,x) + sta RegE ; ld e,(hl) - Parameter + +INCW RegHL + + ldy #$13 + lda RegH + sta (RegIX),y ; ld (ix+13h),h + dey + lda RegL + sta (RegIX),y ; ld (ix+12h),l + + +DEC_INDIRECT_OFFSET RegIX, $1e + +RET_Z + + lda RegA + +JP_Z lf116 + + cmp #$09 + +JP_C lf089 ; jp if a = {1..8} + cmp #$65 + +JP_C lf113 ; jp if a = {0Ah..64h} + + cmp #$e4 + +JP_Z lf093 ; Cmd: Noise + cmp #$e3 + +JP_Z lf111 + cmp #$e1 + +JP_Z lf0e6 + cmp #$e9 + +JP_Z lf0a4 + cmp #$e8 + +JP_Z lf0b0 + cmp #$ea + +JP_Z lf0bc + cmp #$e2 + +JP_Z lf0f9 + cmp #$e5 + +JP_Z lf0c6 + cmp #$e6 + +JP_Z lf09e + cmp #$f0 + +JP_Z lf0f3 + cmp #$ff + +JP_Z lf0d2 + jmp lf033 + +;-------------------------------------- + +lf089: ; Cmd_01..08 + +PUSH16 RegIX + jsr lef42 ; Re-init + +POP16 RegIX + jmp lf02d + +;-------------------------------------- + +lf093: ; Cmd_E4 + +LD RegA, RegE + +LD_INDIRECT_ABS lf1fc, RegA + +LD_INDIRECT_OFFSET_IMM RegIX, $19, $01 + jmp lf033 + +;-------------------------------------- + +lf09e: ; Cmd_E6 + +LD_INDIRECT_OFFSET RegIX, $18, RegE + jmp lf033 + +;-------------------------------------- + +lf0a4: ; Cmd_E9 + jsr lefd2 ; Post: bc + +LD_INDIRECT_OFFSET RegIX, $0e, RegC + +LD_INDIRECT_OFFSET RegIX, $0f, RegB + jmp lf033 + +;-------------------------------------- + +lf0b0: ; Cmd_E8 + jsr lefd2 ; Post: bc + +LD_INDIRECT_OFFSET RegIX, $0c, RegC + +LD_INDIRECT_OFFSET RegIX, $0d, RegB + jmp lf033 + +;-------------------------------------- + +lf0bc: ; Cmd_EA + jsr lefd2 ; Post: bc + +LDW_INDIRECT lf212, RegBC + jmp lf033 + +;-------------------------------------- + +lf0c6: ; Cmd_E5 + +LD_INDIRECT_OFFSET RegIX, $15, RegH + +LD_INDIRECT_OFFSET RegIX, $14, RegL + jsr lefc1 ; Post: hl + jmp lf033 + +;-------------------------------------- + +lf0d2: ; Cmd_FF + +LD_REG_INDIRECT_OFFSET RegH, RegIX, $15 + +LD_REG_INDIRECT_OFFSET RegL, RegIX, $14 + +LD_REG_INDIRECT RegA, RegHL + tax + inx + txa + sta RegA + +JP_NZ lf033 + + +LD_REG_INDIRECT_OFFSET RegH, RegIX, $17 + +LD_REG_INDIRECT_OFFSET RegL, RegIX, $16 + jmp lf033 + +;-------------------------------------- + +lf0e6: ; Cmd_E1 + + +LD_INDIRECT_OFFSET_IMM RegIX, $10, $00 ; ld (ix+10h),00h + +LD_REG_INDIRECT_OFFSET RegH, RegIX, $1d ; ld h,(ix+1dh) + +LD_REG_INDIRECT_OFFSET RegL, RegIX, $1c ; ld l,(ix+1ch) + +LD_INDIRECT_IMM RegHL, $00 ; ld (hl),00h + rts + +;-------------------------------------- + +lf0f3: ; Cmd_F0 + +LD_INDIRECT_OFFSET RegIX, $20, RegE + jmp lf033 + +;-------------------------------------- + +lf492 = lf40a + ($f492-$f40a) + +lf0f9: ; Cmd_E2 +; Pseudo random number generator +; . Pre: RegE = mask +; . Post: lf111_SMC+1 = value (Cmd_E3) +; + +lf0f9_SMC_l: + lda #lf492 ; MSB + sta RegH + + +LD RegC, RegL + +LD RegB, RegH + + +ADDW RegHL, RegHL ; x2 + +ADDW RegHL, RegHL ; x4 + +ADDW RegHL, RegBC ; x5 + +ADDW RegHL, RegHL ; x10 + +ADDW RegHL, RegHL ; x20 + +ADDW RegHL, RegHL ; x40 + +ADDW RegHL, RegBC ; x41 + + lda RegL + sta lf0f9_SMC_l+1 ; Self modifying code + lda RegH + sta lf0f9_SMC_h+1 ; Self modifying code + + ; ld a,h + and RegE + sta RegA + inc RegA + lda RegA + sta lf111_SMC+1 ; Self modifying code + jmp lf02d + +;-------------------------------------- + +lf111: ; Cmd_E3 + +lf111_SMC: + lda #$05 + sta RegA + +;-------------------------------------- + +lf113: ; Cmd_0A..64 + + ldy #$18 + lda (RegIX),y + clc + adc RegA + sta RegA + +;-------------------------------------- + +lf116: ; Cmd_00 + + ; ld (ix+11h),e + +LD_INDIRECT_OFFSET RegIX, $11, RegE + + ; ld (ix+21h),a + +LD_INDIRECT_OFFSET RegIX, $21, RegA + + ; call lf1a1 + jsr lf1a1 + + ; ld h,(ix+1dh) + +LD_REG_INDIRECT_OFFSET RegH, RegIX, $1d + + ; ld l,(ix+1ch) + +LD_REG_INDIRECT_OFFSET RegL, RegIX, $1c + + ; ld (hl),00h + +LD_INDIRECT_IMM RegHL, $00 ; Set Voice's volume = 0 + + ; push ix + +PUSH16 RegIX + + ; pop de + +POP16 RegDE + + ; ld hl,0008h + +LDW RegHL, $0008 + + ; add hl,de + +ADDW RegHL, RegDE + + ; ldi + +LDI + + ; ldi + +LDI + + ; ldi + +LDI + + ; ldi + +LDI + + ; ldi + +LDI + + ; ldi + +LDI + + ; ldi + +LDI + + ; ldi + +LDI + + ; dec (ix+19h) + +DEC_INDIRECT_OFFSET RegIX, $19 + php + + ; ld (ix+19h),00h + +LD_INDIRECT_OFFSET_IMM RegIX, $19, $00 ; flags not affected + + ; ld l,(ix+1ah) + +LD_REG_INDIRECT_OFFSET RegL, RegIX, $1A ; flags not affected + + plp + ; jr nz,0f156h + bne lf156 + + ; ld hl,(0f212h) + +LDW_INDIRECT RegHL, lf1f6 ; HL = A-freq + + ; ld (0f20ah),hl + +LDW_INDIRECT lf20a, RegHL + + ; ld hl,0000h + +LDW RegHL, $0000 + + ; ld (0f206h),hl + +LDW_INDIRECT lf206, RegHL + +lf156: + ; ld a,(0f1fdh) + +LD_REG_INDIRECT_ABS RegA, lf1fd ; a = AY_Data[Enable] + + ; and (ix+1bh) + ldy #$1b + and (RegIX),y + + ; or l + ora RegL + + ; and 3fh + and #$3f + sta RegA + + ; ld (0f1fdh),a + +LD_INDIRECT_ABS lf1fd, RegA ; Set AY_Data[Enable] + +lf162: + ; call lf1c9 + jsr lf1c9 + + ; ld h,(ix+1dh) + +LD_REG_INDIRECT_OFFSET RegH, RegIX, $1d + + ; ld l,(ix+1ch) + +LD_REG_INDIRECT_OFFSET RegL, RegIX, $1c + + ; ld a,(hl) + +LD_REG_INDIRECT RegA, RegHL + + ; add a,c + clc + adc RegC + + ; sub 80h + sec + sbc #$80 + sta RegA + + ; ld (hl),a + +LD_INDIRECT RegHL, RegA + + ; ld hl,(0f204h) + +LDW_INDIRECT RegHL, lf204 + + ; ld a,h + +LD RegA, RegH + + ; or l + ora RegL + + ; ret z + +RET_Z + + ; + + ; ld a,(ix+20h) + +LD_REG_INDIRECT_OFFSET RegA, RegIX, $20 + + ; or a +; ora RegA ; Previous 6502 LDA sets flags + + ; jp nz,lf192 + +JP_NZ lf192 + + ; inc ix + +INCW RegIX + + ; inc ix + +INCW RegIX + + ; call lf1c9 + jsr lf1c9 + +Portamento: + ; ld hl,(0f204h) + +LDW_INDIRECT RegHL, lf204 + + ; ld b,00h + +LD_REG_IMM RegB, $00 + + ; add hl,bc + +ADDW RegHL, RegBC + + ; ld c,80h + +LD_REG_IMM RegC, $80 + + ; sbc hl,bc + +INVERT_CARRY + +SBCW RegHL, RegBC + + ; ld (0f204h),hl + +LDW_INDIRECT lf204, RegHL + + ; ret + rts + +;-------------------------------------- + +lf192: + ; dec (ix+22h) + +DEC_INDIRECT_OFFSET RegIX, $22 + php + + ; ld a,(ix+21h) + +LD_REG_INDIRECT_OFFSET RegA, RegIX, $21 + + ; jr z,lf1a1 + plp + beq lf1a1 + + ; add a,(ix+20h) + ldy #$20 + clc + adc (RegIX),y + sta RegA + + ; ld (ix+22h),01h + +LD_INDIRECT_OFFSET_IMM RegIX, $22, $01 + +lf1a1: + ; RegHL = 0xF28E + 2*RegA + ; . Assume 2*RegA < 0xFF (OK since table at lf28e is only 100 words) + + lda RegA + cmp #100 + bcc .lt3 + brk +.lt3 + + lda RegA + asl ; A = 2*RegA + clc + adc #lf28e ; MSB + sta RegH ; LDI src: RegHL + +; lda RegA +; clc +; adc #lf28e ; MSB +; sta RegH +; +; lda RegA +; clc +; adc RegL ; LSB +; sta RegL +; lda #0 +; adc RegH ; MSB +; sta RegH ; LDI src: RegHL + + ; ld de,0f204h + +LDW RegDE, lf204 ; LDI dst: RegDE + + ; ldi + +LDI + + ; ldi + +LDI + + ; ret + rts + +;-------------------------------------- + +lf1b1: + ; ld ix,0f206h + +LDW RegIX, lf206 + + ; call lf1c9 + jsr lf1c9 + + ; ld hl,0f1fch + +LDW RegHL, lf1fc + + ; ld a,(hl) + +LD_REG_INDIRECT RegA, RegHL + + ; add a,c + clc + adc RegC + + ; sub 80h + sec + sbc #$80 + sta RegA + + ; ld (hl),a + +LD_INDIRECT RegHL, RegA + + ; cp 11h + cmp #$11 + + ; ret c + +RET_C + + ; inc hl + +INCW RegHL + + ; ld a,(hl) + +LD_REG_INDIRECT RegA, RegHL + + ; or 38h + ora #$38 + sta RegA + + ; ld (hl),a + +LD_INDIRECT RegHL, RegA + + ; ret + rts + +;-------------------------------------- + +lf1c9: + ; push ix + +PUSH16 RegIX + + ; pop hl + +POP16 RegHL + + ; ld d,(ix+05h) + +LD_REG_INDIRECT_OFFSET RegD, RegIX, $05 + + ; ld e,(ix+04h) + +LD_REG_INDIRECT_OFFSET RegE, RegIX, $04 + + ; inc (hl) + +INC_INDIRECT RegHL + + ; ld a,(de) + +LD_REG_INDIRECT RegA, RegDE + + ; sub (hl) + +SUB_INDIRECT RegHL + php + + ; ld c,80h + +LD_REG_IMM RegC, $80 + + ; ret nz + plp + +RET_NZ + + ; + + ; ld (hl),a + +LD_INDIRECT RegHL, RegA + + ; inc de + +INCW RegDE + + ; ld a,(de) + +LD_REG_INDIRECT RegA, RegDE + + ; ld c,a + +LD RegC, RegA + + ; inc de + +INCW RegDE + + ; inc hl + +INCW RegHL + + ; inc (hl) + +INC_INDIRECT RegHL + + ; ld a,(de) + +LD_REG_INDIRECT RegA, RegDE + + ; sub (hl) + +SUB_INDIRECT RegHL + + ; ret nz + +RET_NZ + + ; + + ; ld (hl),a + +LD_INDIRECT RegHL, RegA + + ; inc de + +INCW RegDE + + ; ld a,(de) + +LD_REG_INDIRECT RegA, RegDE + + ; inc a + inc RegA + + ; jp nz,lf1ef + +JP_NZ lf1ef + + ; ld d,(ix+0dh) + +LD_REG_INDIRECT_OFFSET RegD, RegIX, $0D + + ; ld e,(ix+0ch) + +LD_REG_INDIRECT_OFFSET RegE, RegIX, $0C + +lf1ef: + ; ld (ix+05h),d + +LD_INDIRECT_OFFSET RegIX, $05, RegD + + ; ld (ix+04h),e + +LD_INDIRECT_OFFSET RegIX, $04, RegE + + ; ret + rts + +;------------------------------------------------------------------------------ + +; Skyfox MB detection routine: + +SF_GetMBSlot: +; Pre: +; Post: +; Z = 0 (NE) : MB detected +; X = HI(MB base address) +; (MBBase) = MB slot address +; + + jsr SF_Detect + +.Loop: stx TmpL + jsr SF_Detect + cpx TmpL + bne .Loop + + cpx #$C8 + rts + +;-------------------------------------- + +SF_Detect: + lda #0 + sta MBBaseL + lda #$c1 + sta MBBaseH + ldx #7 + +.SlotNext: + ldy #$00+SY6522_TIMER1L_COUNTER + jsr SF_GetTimerL + bne .SlotLoop + + ldy #$80+SY6522_TIMER1L_COUNTER + jsr SF_GetTimerL + beq .SlotDone + +.SlotLoop: + inc MBBaseH + dex + bne .SlotNext + +.SlotDone: + ldx MBBaseH + rts + +;-------------------------------------- + + +SF_GetTimerL: + lda (MBBase),y + cmp MBBaseL + sbc (MBBase),y + cmp #$08 + rts + +;------------------------------------------------------------------------------ + +!zone data + +ZPBlock: !fill ZPSize,0 +Z80Block: !fill ZPSize,0 +nMBBaseHi: !byte 0 + +;-------------------------------------- + +; Song Hi/Lo reg values: +SongTbl: !byte 01 ; 0: (AY: Title/In-game) + !byte 34 ; 1: (AY: Game over) + !byte 40 ; 2: (AY: Hall of fame) + !byte 00 ; 3: (Beeper: Title) + !byte 22 ; 4: (AY: SFX 01) + !byte 23 ; 5: (AY: SFX 02) + !byte 24 ; 6: (AY: SFX 03) + !byte 25 ; 7: (AY: SFX 04) + !byte 26 ; 8: (AY: SFX 05) + !byte 27 ; 9: (AY: SFX 06) + !byte 28 ; 10: (AY: SFX 07) + !byte 29 ; 11: (AY: SFX 08) + !byte 30 ; 12: (AY: SFX 09) + !byte 31 ; 13: (AY: SFX 10) + !byte 32 ; 14: (AY: SFX 11) + !byte 33 ; 15: (AY: SFX 12) + +;-------------------------------------- + +; AY regs [0..$D] +AYRegValues: +lf1f6: !word 0 ; A period +lf1f8: !word 0 ; B period +lf1fa: !word 0 ; C period +lf1fc: !byte 0 ; Noise period +lf1fd: !byte 0 ; Enable +lf1fe: !byte 0 ; A volume +lf1ff: !byte 0 ; B volume +lf200: !byte 0 ; C volume +lf201: !word 0 ; Envelope period +lf203: !byte 0 ; Envelope shape + +;-------------------------------------- + +lf204: !word 0 ; Tone period +lf206: !word 0 + !word 0 + +;-------------------------------------- + +lf20a: !word 0 + !word 0 + !word 0 + !word 0 + +lf212: !word 0 + +;-------------------------------------- + +; Voice-A struct + +lf214: !byte 0 + !byte 0 + !byte 0 + !byte 0 + !word 0 + !word 0 + !byte 0 + !byte 0 + !byte 0 + !byte 0 + !word 0 + !word 0 +lf224: !byte 0 + !byte 0 + !word 0 + !word 0 + !word 0 + !byte 0 + !byte 0 + !byte $08 ; 001000 - Disable A (Noise) + !byte $36 ; 110110 - Enable A (Noise & Tone) + !word lf1fe ; &VolA + !byte 0 + !byte 0 + !byte 0 + !byte 0 + !byte 0 + +;-------------------------------------- + +; Voice-B struct + +lf237: !byte 0 + !byte 0 + !byte 0 + !byte 0 + !word 0 + !word 0 + !byte 0 + !byte 0 + !byte 0 + !byte 0 + !word 0 + !word 0 +lf247: !byte 0 + !byte 0 + !word 0 + !word 0 + !word 0 + !byte 0 + !byte 0 + !byte $10 ; 010000 - Disable B (Noise) + !byte $2d ; 101101 - Enable B (Noise & Tone) + !word lf1ff ; &VolB + !byte 0 + !byte 0 + !byte 0 + !byte 0 + !byte 0 + +;-------------------------------------- + +; Voice-C struct + +lf25a: !byte 0 + !byte 0 + !byte 0 + !byte 0 + !word 0 + !word 0 + !byte 0 + !byte 0 + !byte 0 + !byte 0 + !word 0 + !word 0 +lf26a: !byte 0 + !byte 0 + !word 0 + !word 0 + !word 0 + !byte 0 + !byte 0 + !byte $20 ; 100000 - Disable C (Noise) + !byte $1b ; 011011 - Enable C (Noise & Tone) + !word lf200 ; &VolC + !byte 0 + !byte 0 + !byte 0 + !byte 0 + !byte 0 + +;-------------------------------------- + +;lf27d: + !fill 17,0 ; ? + +;-------------------------------------- + +; Ref'ed by func @ f1a1 +; Ref'ed by func @ efc1 (only table's base addr) +; Ref'ed by func @ efd2 (only table's base addr) + +lf28e: +; Table size = WORD[100] +; . Period for each note +; . ZX Spectrum's CLK for AY8912 = 1.77345MHz +; . Envelopes are not used, so no E-Periods to convert + +!macro ZX2MB .period { + !word .period*10227/17734 +} + + +ZX2MB $0000 + +ZX2MB $2a17 + +ZX2MB $27ba + +ZX2MB $2580 + +ZX2MB $2365 + +ZX2MB $2168 + +ZX2MB $1f88 + +ZX2MB $1dc3 + +ZX2MB $1c18 + +ZX2MB $1a84 + +ZX2MB $1907 + +ZX2MB $179f + +ZX2MB $164c + +ZX2MB $150c + +ZX2MB $13dd + +ZX2MB $12c0 + +ZX2MB $11b2 + +ZX2MB $10b4 + +ZX2MB $0fc4 + +ZX2MB $0ee2 + +ZX2MB $0e0c + +ZX2MB $0d42 + +ZX2MB $0c84 + +ZX2MB $0bd0 + +ZX2MB $0b26 + +ZX2MB $0a86 + +ZX2MB $09ef + +ZX2MB $0960 + +ZX2MB $08d9 + +ZX2MB $085a + +ZX2MB $07e2 + +ZX2MB $0771 + +ZX2MB $0706 + +ZX2MB $06a1 + +ZX2MB $0642 + +ZX2MB $05e8 + +ZX2MB $0593 + +ZX2MB $0543 + +ZX2MB $04f7 + +ZX2MB $04b0 + +ZX2MB $046d + +ZX2MB $042d + +ZX2MB $03f1 + +ZX2MB $03b8 + +ZX2MB $0383 + +ZX2MB $0350 + +ZX2MB $0321 + +ZX2MB $02f4 + +ZX2MB $02ca + +ZX2MB $02a1 + +ZX2MB $027c + +ZX2MB $0258 + +ZX2MB $0236 + +ZX2MB $0217 + +ZX2MB $01f9 + +ZX2MB $01dc + +ZX2MB $01c1 + +ZX2MB $01a8 + +ZX2MB $0190 + +ZX2MB $017a + +ZX2MB $0165 + +ZX2MB $0151 + +ZX2MB $013e + +ZX2MB $012c + +ZX2MB $011b + +ZX2MB $010b + +ZX2MB $00fc + +ZX2MB $00ee + +ZX2MB $00e1 + +ZX2MB $00d4 + +ZX2MB $00c8 + +ZX2MB $00bd + +ZX2MB $00b2 + +ZX2MB $00a8 + +ZX2MB $009f + +ZX2MB $0096 + +ZX2MB $008e + +ZX2MB $0086 + +ZX2MB $007e + +ZX2MB $0077 + +ZX2MB $0070 + +ZX2MB $006a + +ZX2MB $0064 + +ZX2MB $005e + +ZX2MB $0059 + +ZX2MB $0054 + +ZX2MB $004f + +ZX2MB $004b + +ZX2MB $0047 + +ZX2MB $0043 + +ZX2MB $003f + +ZX2MB $003c + +ZX2MB $0038 + +ZX2MB $0035 + +ZX2MB $0032 + +ZX2MB $002f + +ZX2MB $002d + +ZX2MB $002a + +ZX2MB $0028 + +ZX2MB $0000 + +;-------------------------------------- + +; Ref'ed by func @ efd2 + +lf356: +; Table size = WORD[40] + + !word $017c ; lf28e + $17c = lf40a (addr of music data) + !word $0180 + !word $018a + !word $0194 + !word $0195 + !word $019c + !word $01a9 + !word $01b6 + !word $01c3 + !word $01cd + !word $01ce + !word $01cf + !word $01d9 + !word $01e3 + !word $01ed + !word $01f7 + !word $0201 + !word $020b + !word $0212 + !word $0228 + !word $022c + !word $0230 + !word $023a + !word $0247 + !word $0248 + !word $0258 + !word $025f + !word $0266 + !word $0267 + !word $026b + !word $0278 + !word $027f + !word $0280 + !word $0281 + !word $0282 + !word $028c + !word $02a5 + !word $02be + !word $02ce + !word $0000 + +;-------------------------------------- + +; Ref'ed by func @ efc1 + +lf3a6: +; Table size = WORD[43] + + !word $02da + !word $02e0 + !word $039c + !word $03a5 + !word $03b0 + !word $03e5 + !word $046e + !word $04f1 + !word $0518 + !word $053f + !word $056c + !word $0577 + !word $057c + !word $0597 + !word $061a + !word $061d + !word $0632 + !word $06c3 + !word $06e0 + !word $06f9 + !word $0714 + !word $0787 + !word $078c + !word $0796 + !word $07a4 + !word $07ae + !word $07b8 + !word $07c8 + !word $07d8 + !word $07e2 + !word $07f0 + !word $07fe + !word $0808 + !word $0818 + !word $082a + !word $0838 + !word $083b + !word $0848 + !word $085b + !word $0894 + !word $08a7 + !word $08c5 + !word $08e2 ; lf28e + $8e2 = lfb70 (near end of music data) + +;-------------------------------------- + +;lf3fc: +; Table size = WORD[7] +; . ? + + !word $1a4a + !word $1a58 + !word $1a62 + !word $1aae + !word $1aca + !word $1ae5 + !word $0000 + +;-------------------------------------- + +; Music data + +lf40a: +; Table size = BYTE[1916] + + !byte $C8,$80,$C8,$FF,$01,$81,$0D,$09,$7F,$09,$C8,$80,$C8,$FF,$01,$8D + !byte $01,$01,$7F,$04,$01,$77,$01,$FF,$FF,$01,$87,$01,$C8,$80,$C8,$FF + !byte $01,$8C,$01,$0A,$7F,$08,$14,$7F,$04,$C8,$80,$C8,$FF,$01,$8D,$01 + !byte $02,$7F,$07,$0C,$7F,$06,$C8,$80,$C8,$FF,$01,$8D,$01,$01,$7F,$0B + !byte $09,$7F,$02,$C8,$80,$C8,$FF,$01,$88,$01,$01,$82,$01,$C8,$80,$C8 + !byte $FF,$FF,$FF,$01,$77,$01,$01,$83,$03,$C8,$80,$C8,$FF,$02,$81,$02 + !byte $02,$7F,$03,$02,$81,$01,$FF,$01,$81,$02,$01,$7F,$04,$01,$81,$02 + !byte $FF,$01,$89,$01,$01,$79,$01,$C8,$80,$C8,$FF,$01,$82,$02,$01,$7E + !byte $04,$01,$82,$02,$FF,$01,$87,$03,$01,$79,$06,$01,$87,$03,$FF,$01 + !byte $88,$0A,$01,$96,$C8,$FF,$01,$93,$01,$01,$6D,$01,$01,$7F,$02,$01 + !byte $81,$04,$01,$7F,$04,$01,$81,$02,$C8,$80,$C8,$FF,$02,$81,$C8,$FF + !byte $02,$7F,$C8,$FF,$01,$80,$01,$01,$B4,$01,$C8,$80,$C8,$FF,$01,$80 + !byte $01,$01,$8B,$01,$01,$B4,$01,$C8,$80,$C8,$FF,$FF,$01,$85,$03,$01 + !byte $71,$01,$01,$80,$01,$01,$8F,$01,$01,$7B,$03,$FF,$01,$85,$03,$01 + !byte $71,$01,$FF,$01,$96,$01,$02,$79,$02,$FF,$FF,$01,$A1,$C8,$FF,$01 + !byte $85,$03,$09,$7D,$04,$0E,$7F,$03,$C8,$80,$C8,$FF,$01,$84,$01,$01 + !byte $7F,$01,$FF,$FF,$FF,$FF,$02,$8D,$01,$02,$67,$01,$C8,$80,$C8,$FF + !byte $01,$8F,$01,$08,$80,$01,$02,$7F,$01,$04,$7F,$01,$07,$7F,$02,$0C + !byte $7F,$04,$16,$7F,$07,$C8,$80,$C8,$FF,$01,$79,$01,$01,$8B,$01,$01 + !byte $6F,$01,$01,$9B,$01,$01,$5B,$01,$01,$AF,$01,$01,$47,$01,$01,$C3 + !byte $01,$FF,$01,$8F,$01,$01,$7A,$01,$01,$86,$01,$01,$7F,$09,$08,$7F + !byte $06,$FF,$01,$99,$03,$01,$79,$07,$0A,$7E,$C8,$FF,$01,$9B,$E1,$FF + !byte $FF,$FF,$FF,$AF,$01,$E8,$00,$00,$30,$E5,$04,$02,$02,$E5,$04,$02 + !byte $03,$E5,$04,$02,$08,$00,$54,$02,$04,$E5,$05,$02,$04,$E5,$06,$02 + !byte $04,$E5,$05,$02,$04,$E5,$06,$02,$00,$E4,$06,$00,$06,$E4,$06,$00 + !byte $06,$E5,$0D,$E5,$10,$E5,$0D,$E5,$10,$E5,$08,$E5,$08,$E5,$08,$E5 + !byte $0C,$02,$04,$E5,$05,$02,$04,$E5,$06,$02,$04,$E5,$05,$02,$04,$E5 + !byte $06,$02,$00,$F0,$00,$E4,$06,$3A,$06,$E4,$06,$39,$06,$E5,$0D,$E5 + !byte $10,$E5,$0D,$E5,$10,$02,$25,$E5,$26,$E4,$06,$00,$06,$E4,$06,$00 + !byte $06,$E5,$09,$E5,$07,$E5,$09,$E5,$08,$E6,$13,$02,$13,$E5,$14,$E4 + !byte $01,$00,$0C,$02,$13,$E5,$14,$E4,$01,$00,$0C,$E6,$15,$02,$15,$E5 + !byte $14,$E4,$01,$00,$0C,$02,$15,$E5,$14,$02,$0F,$E5,$05,$02,$0F,$E5 + !byte $05,$02,$0F,$E5,$05,$02,$0F,$E5,$05,$E4,$06,$00,$06,$E4,$06,$00 + !byte $06,$E5,$0D,$E5,$0D,$E5,$10,$02,$25,$E5,$26,$E5,$07,$E5,$0B,$FF + !byte $E8,$00,$00,$60,$E5,$07,$E5,$07,$FF,$E5,$09,$E8,$00,$00,$30,$E5 + !byte $07,$E5,$07,$FF,$E6,$07,$E8,$02,$E9,$0D,$F0,$00,$1F,$0C,$1F,$0C + !byte $22,$0C,$24,$0C,$26,$0C,$F0,$0F,$26,$0C,$F0,$0E,$26,$0C,$26,$0C + !byte $F0,$10,$22,$0C,$F0,$00,$22,$0C,$16,$0C,$22,$0C,$16,$0C,$F0,$10 + !byte $24,$0C,$F0,$00,$18,$0C,$24,$0C,$FF,$E6,$07,$E8,$06,$F0,$18,$03 + !byte $27,$EA,$16,$E4,$01,$30,$06,$E4,$01,$31,$06,$E4,$01,$32,$06,$E4 + !byte $01,$30,$06,$E4,$01,$32,$06,$E4,$01,$35,$06,$EA,$00,$E4,$06,$3A + !byte $0C,$EA,$16,$E4,$01,$3C,$06,$E4,$01,$39,$06,$E4,$01,$00,$06,$E4 + !byte $01,$00,$06,$E4,$01,$00,$06,$E4,$01,$00,$06,$EA,$00,$E4,$06,$00 + !byte $0C,$EA,$16,$E4,$01,$00,$06,$E4,$01,$00,$06,$E4,$01,$00,$06,$E4 + !byte $01,$00,$06,$E4,$01,$2E,$06,$E4,$01,$00,$06,$EA,$00,$E4,$06,$30 + !byte $0C,$EA,$16,$E4,$01,$32,$06,$E4,$01,$30,$06,$E4,$01,$00,$06,$E4 + !byte $01,$00,$06,$E4,$01,$00,$06,$E4,$01,$00,$06,$EA,$00,$E4,$06,$00 + !byte $0C,$FF,$03,$27,$EA,$16,$E4,$01,$30,$06,$E4,$01,$31,$06,$E4,$01 + !byte $32,$06,$E4,$01,$30,$06,$E4,$01,$32,$06,$E4,$01,$35,$06,$EA,$00 + !byte $E4,$06,$3A,$0C,$EA,$16,$E4,$01,$3C,$06,$E4,$01,$39,$06,$E4,$01 + !byte $00,$06,$E4,$01,$00,$06,$E4,$01,$00,$06,$E4,$01,$00,$06,$EA,$00 + !byte $E4,$06,$39,$0C,$EA,$16,$E4,$01,$35,$06,$E4,$01,$00,$06,$E4,$01 + !byte $00,$06,$E4,$01,$00,$06,$E4,$01,$00,$06,$E4,$01,$00,$06,$EA,$00 + !byte $E4,$06,$37,$0C,$EA,$16,$E4,$01,$34,$06,$E4,$01,$00,$06,$E4,$01 + !byte $00,$06,$E4,$01,$00,$06,$E4,$01,$00,$06,$E4,$01,$00,$06,$EA,$00 + !byte $E4,$06,$00,$0C,$FF,$E8,$07,$EA,$15,$03,$00,$E4,$01,$00,$06,$E4 + !byte $01,$00,$06,$E4,$01,$00,$06,$E4,$01,$00,$06,$EA,$00,$E4,$06,$00 + !byte $0C,$EA,$15,$E4,$01,$00,$06,$E4,$01,$00,$06,$FF,$E8,$07,$EA,$16 + !byte $03,$00,$E4,$01,$00,$06,$E4,$01,$00,$06,$E4,$01,$00,$06,$E4,$01 + !byte $00,$06,$EA,$00,$E4,$06,$00,$0C,$EA,$16,$E4,$01,$00,$06,$E4,$01 + !byte $00,$06,$FF,$E6,$13,$E8,$07,$EA,$00,$E9,$00,$03,$00,$EA,$16,$E4 + !byte $01,$43,$06,$E4,$01,$41,$06,$E4,$0E,$3C,$06,$E4,$01,$3E,$06,$EA + !byte $00,$E4,$06,$00,$0C,$EA,$16,$E4,$06,$00,$06,$E4,$06,$00,$06,$FF + !byte $E6,$13,$E8,$04,$E9,$10,$00,$0C,$48,$A8,$E1,$00,$F0,$00,$F0,$FF + !byte $E8,$07,$EA,$16,$E4,$01,$00,$06,$E4,$01,$00,$06,$E4,$01,$00,$06 + !byte $E4,$01,$00,$06,$EA,$00,$E4,$06,$00,$0C,$FF,$E6,$07,$E8,$06,$E9 + !byte $0F,$F0,$18,$1F,$06,$F0,$00,$1F,$06,$F0,$18,$1F,$06,$F0,$00,$1F + !byte $06,$EA,$14,$E4,$06,$00,$06,$1F,$06,$F0,$18,$1F,$06,$F0,$00,$1F + !byte $06,$F0,$1B,$1E,$06,$F0,$00,$1E,$06,$F0,$1B,$1E,$06,$F0,$00,$1E + !byte $06,$E4,$06,$00,$06,$1E,$06,$F0,$1B,$1E,$06,$F0,$00,$1E,$06,$F0 + !byte $1B,$1F,$06,$F0,$00,$1F,$06,$F0,$1B,$1F,$06,$F0,$00,$1F,$06,$EA + !byte $14,$E4,$06,$00,$06,$1F,$06,$F0,$1B,$1F,$06,$F0,$00,$1F,$06,$F0 + !byte $1D,$21,$06,$F0,$00,$21,$06,$F0,$1D,$21,$06,$F0,$00,$21,$06,$E4 + !byte $06,$21,$06,$21,$06,$F0,$1B,$21,$06,$F0,$00,$21,$06,$FF,$00,$06 + !byte $FF,$E4,$06,$00,$06,$E4,$06,$00,$06,$E5,$0D,$E8,$04,$3C,$30,$48 + !byte $90,$3C,$30,$48,$90,$FF,$02,$11,$F0,$18,$22,$06,$F0,$00,$22,$06 + !byte $F0,$18,$22,$06,$F0,$00,$22,$06,$EA,$01,$E4,$06,$00,$06,$22,$06 + !byte $F0,$18,$22,$06,$F0,$00,$22,$06,$F0,$28,$1D,$06,$F0,$00,$1D,$06 + !byte $F0,$28,$1D,$06,$F0,$00,$1D,$06,$E4,$06,$00,$06,$1D,$06,$F0,$29 + !byte $E4,$06,$1D,$06,$F0,$00,$1D,$06,$02,$12,$EA,$01,$F0,$21,$E4,$01 + !byte $24,$06,$F0,$00,$E4,$01,$24,$06,$F0,$1F,$E4,$01,$24,$06,$F0,$00 + !byte $E4,$01,$24,$06,$F0,$1F,$E4,$06,$24,$06,$F0,$00,$24,$06,$24,$06 + !byte $24,$06,$F0,$1F,$E4,$0E,$24,$06,$E4,$0A,$24,$06,$E4,$07,$24,$06 + !byte $E4,$04,$24,$06,$F0,$00,$E4,$01,$24,$06,$E4,$04,$24,$06,$E4,$0A + !byte $29,$06,$E4,$0E,$2B,$06,$FF,$E6,$1F,$E8,$08,$E9,$0C,$00,$0C,$22 + !byte $0C,$24,$0C,$26,$0C,$2D,$06,$00,$06,$2D,$06,$00,$06,$2D,$0C,$2E + !byte $0C,$00,$30,$E1,$E6,$1F,$E8,$08,$E9,$0C,$2D,$0C,$2B,$06,$00,$06 + !byte $2B,$06,$00,$06,$2B,$24,$E9,$11,$37,$24,$00,$60,$E1,$E8,$02,$E9 + !byte $0D,$24,$18,$27,$18,$2B,$18,$2E,$18,$27,$24,$28,$0C,$29,$18,$2D + !byte $0C,$2E,$06,$30,$06,$00,$60,$E1,$E8,$05,$F0,$00,$E9,$0C,$03,$27 + !byte $EA,$16,$E4,$01,$30,$06,$2E,$06,$E4,$01,$2C,$06,$29,$06,$EA,$00 + !byte $E4,$06,$27,$06,$24,$06,$E4,$01,$22,$06,$24,$06,$EA,$16,$E4,$01 + !byte $27,$06,$00,$06,$E4,$01,$24,$06,$00,$06,$EA,$00,$E4,$06,$2B,$06 + !byte $00,$06,$E4,$01,$27,$06,$27,$06,$EA,$16,$E4,$01,$00,$06,$00,$06 + !byte $E4,$01,$00,$06,$00,$06,$EA,$00,$E4,$06,$29,$06,$00,$06,$E4,$01 + !byte $26,$06,$26,$06,$EA,$16,$E4,$01,$00,$06,$00,$06,$E4,$01,$00,$06 + !byte $00,$06,$EA,$00,$E4,$06,$00,$06,$00,$06,$FF,$E6,$02,$E5,$13,$FF + !byte $02,$F4,$0F,$E8,$19,$E9,$18,$5D,$48,$E1,$02,$F4,$0F,$E8,$01,$F0 + !byte $3C,$EA,$05,$E4,$02,$24,$48,$E1,$02,$F4,$0F,$E8,$1D,$E9,$1E,$4F + !byte $4D,$E1,$03,$F4,$0F,$E8,$06,$E9,$19,$53,$0F,$E1,$03,$F4,$0F,$E8 + !byte $07,$E9,$01,$EA,$01,$E4,$07,$5E,$10,$EA,$16,$E1,$03,$F4,$0F,$E8 + !byte $05,$E9,$1C,$EA,$27,$E4,$03,$4F,$14,$EA,$16,$E1,$02,$F4,$0F,$E8 + !byte $15,$E9,$10,$43,$14,$E1,$03,$F4,$0F,$E2,$0F,$E8,$25,$E9,$26,$E6 + !byte $3E,$E3,$19,$E1,$02,$F4,$0F,$E8,$23,$E9,$24,$EA,$00,$E4,$0E,$56 + !byte $63,$E1,$03,$F4,$0F,$E8,$12,$E9,$24,$61,$20,$E1,$02,$F4,$0F,$E8 + !byte $1D,$E9,$1A,$EA,$0B,$E4,$0C,$39,$40,$E9,$0C,$E1,$03,$F4,$0F,$E8 + !byte $06,$E9,$22,$EA,$00,$E4,$0E,$5E,$02,$5E,$10,$EA,$16,$E1,$01,$F4 + !byte $0F,$02,$24,$00,$12,$03,$24,$00,$12,$E5,$24,$E1,$00,$03,$E1,$F4 + !byte $0F,$E8,$02,$E9,$1A,$EA,$15,$E4,$07,$5E,$5A,$E1,$E6,$07,$E8,$02 + !byte $E9,$0F,$20,$48,$22,$18,$23,$48,$E8,$05,$25,$78,$E5,$0A,$E1,$E6 + !byte $07,$E8,$07,$F0,$0C,$37,$06,$37,$06,$35,$0C,$EA,$16,$E4,$04,$33 + !byte $0C,$30,$18,$32,$0C,$E4,$04,$33,$0C,$E4,$04,$35,$0C,$36,$06,$36 + !byte $06,$35,$0C,$E4,$04,$33,$0C,$2F,$18,$31,$0C,$EA,$14,$E4,$06,$33 + !byte $0C,$E8,$05,$35,$60,$F0,$00,$FF,$E6,$37,$E8,$0E,$E9,$00,$E2,$1F + !byte $E3,$06,$13,$06,$E3,$06,$1F,$06,$E3,$06,$FF,$01,$F4,$0F,$E8,$08 + !byte $E9,$0F,$E2,$0E,$EA,$13,$02,$2A,$03,$29,$E6,$1E,$E3,$18,$E4,$01 + !byte $00,$18,$E3,$18,$E4,$01,$00,$18,$FF,$F4,$0F,$E8,$08,$E9,$0C,$E6 + !byte $31,$E3,$06,$E6,$36,$E3,$06,$E6,$38,$E3,$06,$E6,$3A,$E3,$06,$E6 + !byte $38,$E3,$2A,$00,$0C,$FF,$F4,$0F,$E8,$08,$E9,$0C,$E6,$1E,$E3,$18 + !byte $E3,$18,$E3,$18,$E3,$18,$FF,$E6,$34,$1A,$00,$00 + +;lfb86: + diff --git a/Cybernoid/build.bat b/Cybernoid/build.bat new file mode 100644 index 0000000..f5e6f4d --- /dev/null +++ b/Cybernoid/build.bat @@ -0,0 +1,4 @@ +D:\Apple][\acme085\acme.exe cybernoid.a +D:\Apple][\InsertBIN2AWS\debug\InsertBIN2AWS.exe cybernoid 6000 cybernoid.aws +java -jar "D:\Apple][\Apple Commander\ac\AppleCommander-1.3.3.9-ac.jar" -d cybernoid ..\ReleaseDSK\Cybernoid.dsk +cat cybernoid | java -jar "D:\Apple][\Apple Commander\ac\AppleCommander-1.3.3.9-ac.jar" -p Cybernoid bin 24576 ..\ReleaseDSK\Cybernoid.dsk \ No newline at end of file diff --git a/Cybernoid2/Cybernoid2.a b/Cybernoid2/Cybernoid2.a new file mode 100644 index 0000000..88deece --- /dev/null +++ b/Cybernoid2/Cybernoid2.a @@ -0,0 +1,1261 @@ +;ACME 0.85 + +!cpu 6502 ; Compatible with all Apple2's +!to "Cybernoid2", plain +!sl "Cybernoid2.labels" +*=$6000 + +;------------------------------------------------------------------------------ + +!source "..\Common\Z80-Macros.a" +!source "..\Common\ZP-Macros.a" +!source "..\Common\AppleDefs.a" +!source "..\Common\MockingboardDefs.a" +!source "..\Common\MB-Macros.a" + +;------------------------------------------------------------------------------ + +!zone code + +;-------------------------------------- + +NUM_SONGS = 16 + +INIT: +; Pre: A = Song# [0..NUM_SONGS-1] +; + + +MB_Init1 RegA + + +PUSH16 RegA ;RegAF + jsr lf3fa + +POP16 RegA ;RegAF + jsr lf398 + + +MB_Init2 + rts + +;-------------------------------------- + +lf398: ; Called by INIT + +LD RegE, RegA + +lf399: ; Re-init: Called by Cmd_01..08 + +LD RegC, RegA + jsr lf415 + + +LD_REG_INDIRECT RegA, RegHL + cmp #$09 + bcs lf3a5 + +LD RegC, RegA + +INCW RegHL + +LD_REG_INDIRECT RegA, RegHL + +lf3a5: + cmp #$f4 + php ; New + +LD_REG_IMM RegB, $0a + plp ; New + bne lf3ae + + +INCW RegHL + +LD_REG_INDIRECT RegB, RegHL + +INCW RegHL + +lf3ae: + +LDW RegIX, lf690 + dec RegC + beq lf3d1 + + +LDW RegIX, lf6b3 + dec RegC + beq lf3d1 + + +LDW RegIX, lf6d6 + dec RegC + beq lf3d1 + + +LD_REG_INDIRECT_ABS RegA, lf6a0 +; ora RegA ; Superfluous + +LDW RegIX, lf690 + beq lf3d1 + +LDW RegIX, lf6b3 + +lf3d1: + +LD RegA, RegB + +CP_INDIRECT_OFFSET RegIX, $10 + +RET_C + + +LD_REG_IMM RegA, 0 ; xor a + +LD_INDIRECT_OFFSET RegIX, $10, RegA + +LD_INDIRECT_OFFSET RegIX, $12, RegL + +LD_INDIRECT_OFFSET RegIX, $13, RegH + +LD_INDIRECT_OFFSET RegIX, $14, RegL + +LD_INDIRECT_OFFSET RegIX, $15, RegH + +LD_INDIRECT_OFFSET RegIX, $16, RegL + +LD_INDIRECT_OFFSET RegIX, $17, RegH + +LD_INDIRECT_OFFSET_IMM RegIX, $11, $01 + +LD_INDIRECT_OFFSET RegIX, $18, RegA + +LD_INDIRECT_OFFSET RegIX, $20, RegA + +LD_INDIRECT_OFFSET RegIX, $10, RegB + rts + +lf3fa: + +LD_REG_IMM RegA, 0 ; xor a + +LD_INDIRECT_ABS lf6a0, RegA + +LD_INDIRECT_ABS lf6c3, RegA + +LD_INDIRECT_ABS lf6e6, RegA + +LD_INDIRECT_ABS lf67a, RegA + +LD_INDIRECT_ABS lf67b, RegA + +LD_INDIRECT_ABS lf67c, RegA + +LD_REG_IMM RegA, $3f + +LD_INDIRECT_ABS lf679, RegA + jmp lf46c + +;-------------------------------------- + +lf415: + +; +LD RegA, RegE +; lda RegA +; asl +; sta RegA +; +; clc ; CARRY OK +; lda RegA +; adc #$lf818 +; sta RegA +; +; sbc RegL ; CARRY possibly wrong +; +LD RegH, RegA +; +LD_REG_INDIRECT RegE, RegHL +; +INCW RegHL +; +LD_REG_INDIRECT RegD, RegHL +; +LDW RegHL, lf700 +; +ADDW RegHL, RegDE + + lda RegE + cmp #58 + bcc .lt1 + brk +.lt1 + + lda #lf818 + sta TmpHL+1 ; MSB + + +LD RegA, RegE + asl ; =lsl + tay + + clc + lda (TmpHL),y ; LSB + adc #lf700 + sta RegH + + rts + +;-------------------------------------- + +lf426: + +; +LD RegA, RegE +; lda RegA +; asl +; sta RegA +; +; clc ; CARRY OK +; lda RegA +; adc #$c8 +; sta RegA +; +LD RegE, RegA +; lda RegA +; adc #$f7 +; sta RegA +; +; sbc RegE ; CARRY possibly wrong +; +LD RegD, RegA +; +LD_REG_INDIRECT RegA, RegDE +; clc ; CARRY possibly wrong +; lda RegA +; adc #$00 +; sta RegA +; +LD RegC, RegA +; +INCW RegDE +; +LD_REG_INDIRECT RegA, RegDE +; lda RegA +; adc #$f7 +; sta RegA +; +LD RegB, RegA + + lda RegE + cmp #40 + bcc .lt2 + brk +.lt2 + + lda #lf7c8 + sta TmpHL+1 ; MSB + + +LD RegA, RegE + asl ; =lsl + tay + + clc + lda (TmpHL),y ; LSB + adc #lf700 + sta RegB + + rts + +;-------------------------------------- + +Interrupt: + +MB_ISR lf439 + +;-------------------------------------- + +lf439: + inc nFrameNum+2 + lda nFrameNum+2 + cmp #50 + bne .fnum_ok + lda #0 + sta nFrameNum+2 + inc nFrameNum+1 + lda nFrameNum+1 + cmp #60 + bne .fnum_ok + lda #0 + sta nFrameNum+1 + inc nFrameNum+0 +.fnum_ok: + + ; + + +LDW RegIX, lf690 ; IX = &VoiceA + +LDW_INDIRECT RegHL, lf672 ; HL = AYREGS.PeriodA + jsr lf483 + +LDW_INDIRECT RegHL, lf680 + +LDW_INDIRECT lf672, RegHL ; AYREGS.PeriodA = (lf680) + + +LDW_INDIRECT RegHL, lf674 ; HL = AYREGS.PeriodB + +LDW RegIX, lf6b3 ; IX = &VoiceB + jsr lf483 + +LDW_INDIRECT RegHL, lf680 + +LDW_INDIRECT lf674, RegHL ; AYREGS.PeriodB = (lf680) + + +LDW_INDIRECT RegHL, lf676 ; HL = AYREGS.PeriodC + +LDW RegIX, lf6d6 ; IX = &VoiceC + jsr lf483 + +LDW_INDIRECT RegHL, lf680 + +LDW_INDIRECT lf676, RegHL ; AYREGS.PeriodC = (lf680) + + jsr lf62e + + ; + +lf46c: + ; Copy [lf67f..lf672] -> AY registers + +MB_WriteAYRegs lf672 + + rts + +;-------------------------------------- + +lf483: + +LDW_INDIRECT lf680, RegHL ; Init 'Tone period' + +LD_REG_INDIRECT_OFFSET RegA, RegIX, $10 +; ora RegA ; Superfluous + +RET_Z + + +DEC_INDIRECT_OFFSET RegIX, $11 + +JP_NZ lf5dd + + +LD_REG_IMM RegA, $14 + +LD_INDIRECT_ABS lf49d_SMC+1, RegA ; Self mod'ing code + + +LD_REG_INDIRECT_OFFSET RegH, RegIX, $13 + +LD_REG_INDIRECT_OFFSET RegL, RegIX, $12 + +lf49c: +; +LD_REG_IMM RegA, $12 ; SMC-target +lf49d_SMC: + lda #$12 + sta RegA + ; + dec RegA + +LD_INDIRECT_ABS lf49d_SMC+1, RegA ; Self mod'ing code + +RET_Z + + +LD_REG_INDIRECT RegA, RegHL ; Cmd + +INCW RegHL + +LD_REG_INDIRECT RegE, RegHL ; Param + +INCW RegHL + + lda RegA + +JP_Z lf588 + + cmp #$09 + +JP_C lf4f9 ; jp if a = {1..8} + cmp #$65 + +JP_C lf583 ; jp if a = {09h..64h} + cmp #$7f + +JP_C lf504 ; jp if a = {65h..7Eh} (Diff) + cmp #$df + +JP_C lf578 ; jp if a = {7Fh..DEh} (Diff) + + cmp #$e3 + +JP_Z lf581 + cmp #$e1 + +JP_Z lf4ec + cmp #$e9 + +JP_Z lf517 + cmp #$e8 + +JP_Z lf523 + cmp #$ea + +JP_Z lf52f + cmp #$e2 + +JP_Z lf55e + cmp #$e5 + +JP_Z lf539 + cmp #$e6 + +JP_Z lf511 + cmp #$f0 + +JP_Z lf558 + cmp #$ff + +JP_Z lf545 + jmp lf49c + +;-------------------------------------- + +lf4ec: ; Cmd_E1 + +LD_INDIRECT_OFFSET_IMM RegIX, $10, $00 + +LD_REG_INDIRECT_OFFSET RegH, RegIX, $1d ; HL = &AYREGS[VolX] + +LD_REG_INDIRECT_OFFSET RegL, RegIX, $1c + +LD_INDIRECT_IMM RegHL, $00 + rts + +;-------------------------------------- + +lf4f9: ; Cmd_01..08 + +PUSH16 RegHL ; Diff + +PUSH16 RegIX + jsr lf399 ; Re-init + +POP16 RegIX ; Diff + +POP16 RegHL + jmp lf49c + +;-------------------------------------- + +lf504: ; Cmd_66..7F (Diff) + sec ; CARRY OK + sbc #$66 ; A = [0..$19] + sta RegA ; New + +LD_INDIRECT_ABS lf678, RegA ; Noise + +LD_INDIRECT_OFFSET_IMM RegIX, $19, $01 + +DECW RegHL + jmp lf49c + +;-------------------------------------- + +lf511: ; Cmd_E6 + +LD_INDIRECT_OFFSET RegIX, $18, RegE + jmp lf49c + +;-------------------------------------- + +lf517: ; Cmd_E9 + jsr lf426 + +LD_INDIRECT_OFFSET RegIX, $0e, RegC + +LD_INDIRECT_OFFSET RegIX, $0f, RegB + jmp lf49c + +;-------------------------------------- + +lf523: ; Cmd_E8 + jsr lf426 + +LD_INDIRECT_OFFSET RegIX, $0c, RegC + +LD_INDIRECT_OFFSET RegIX, $0d, RegB + jmp lf49c + +;-------------------------------------- + +lf52f: ; Cmd_EA + jsr lf426 + +LDW_INDIRECT lf68e, RegBC + jmp lf49c + +;-------------------------------------- + +lf539: ; Cmd_E5 + +LD_INDIRECT_OFFSET RegIX, $15, RegH + +LD_INDIRECT_OFFSET RegIX, $14, RegL + jsr lf415 + jmp lf49c + +;-------------------------------------- + +lf545: ; Cmd_FF + +LD_REG_INDIRECT_OFFSET RegH, RegIX, $15 + +LD_REG_INDIRECT_OFFSET RegL, RegIX, $14 + +LD_REG_INDIRECT RegA, RegHL + inc RegA + bne lf555 + +LD_REG_INDIRECT_OFFSET RegH, RegIX, $17 + +LD_REG_INDIRECT_OFFSET RegL, RegIX, $16 + +lf555: + jmp lf49c + +;-------------------------------------- + +lf558: ; Cmd_F0 + +LD_INDIRECT_OFFSET RegIX, $20, RegE + jmp lf49c + +;-------------------------------------- + +lf55e: ; Cmd_E2 +; Pseudo random number generator + + +PUSH16 RegHL + +; +LDW RegHL, $da52 ; SMC-target +lf560_SMC_l: + lda #<$da52 ; LSB + sta RegL +lf560_SMC_h: + lda #>$da52 ; MSB + sta RegH + + +LD RegC, RegL + +LD RegB, RegH + +ADDW RegHL, RegHL + +ADDW RegHL, RegHL + +ADDW RegHL, RegBC + +ADDW RegHL, RegHL + +ADDW RegHL, RegHL + +ADDW RegHL, RegHL + +ADDW RegHL, RegBC + +; +LDW_INDIRECT lf560, RegHL ; Self modifying code + lda RegL + sta lf560_SMC_l+1 ; Self modifying code + lda RegH + sta lf560_SMC_h+1 ; Self modifying code + ; + +LD RegA, RegH + + and RegE + sta RegA ; New + inc RegA + +; +LD_INDIRECT_ABS lf582, RegA ; Self modifying code + lda RegA + sta lf582_SMC+1 ; Self modifying code + + +POP16 RegHL + jmp lf49c + +;-------------------------------------- + +lf578: ; Cmd_80..DF (Diff) + + and #$7f ; A = [0..$5f] + sta RegA ; New + +DECW RegHL + +LD_REG_INDIRECT_OFFSET RegE, RegIX, $1f + jmp lf583 + +;-------------------------------------- + +lf581: ; Cmd_E3 + +; +LD_REG_IMM RegA, $1b ; SMC-target +lf582_SMC: + lda #$1b + sta RegA + +;-------------------------------------- + +lf583: ; Cmd_09..64 + + clc ; CARRY OK + ldy #$18 + lda RegA ; Req'd: lf578 jmp's with A=RegE + adc (RegIX),y + sta RegA ; Superfluous + + sec ; CARRY possibly wrong ; Diff + sbc #$0c ; Diff + sta RegA ; New ; Diff + +;-------------------------------------- + +lf588: ; Cmd_00 + + +LD_INDIRECT_OFFSET RegIX, $11, RegE + +LD_INDIRECT_OFFSET RegIX, $21, RegA + +LD_INDIRECT_OFFSET RegIX, $1f, RegE ; Diff + +LD_INDIRECT_OFFSET RegIX, $13, RegH ; Diff + +LD_INDIRECT_OFFSET RegIX, $12, RegL ; Diff + jsr lf61e + +LD_REG_INDIRECT_OFFSET RegH, RegIX, $1d ; HL = &AYREGS[VolX] + +LD_REG_INDIRECT_OFFSET RegL, RegIX, $1c + +LD_INDIRECT_IMM RegHL, $00 ; AYREGS[VolX] = $00 + +PUSH16 RegIX + +POP16 RegDE ; DE = &VoiceX[0] + +LDW RegHL, $008 + +ADDW RegHL, RegDE ; HL = &VoiceX[8] + +LDI + +LDI + +LDI + +LDI + +LDI + +LDI + +LDI + +LDI ; memcpy(&VoiceX[0], &VoiceX[8], 8) + + +DEC_INDIRECT_OFFSET RegIX, $19 + php ; New: Save flags + +LD_INDIRECT_OFFSET_IMM RegIX, $19, $00 + +LD_REG_INDIRECT_OFFSET RegL, RegIX, $1a + plp ; New: Restore flags + bne lf5d1 + +LDW_INDIRECT RegHL, $f68e + +LDW_INDIRECT lf686, RegHL + +LDW RegHL, $0000 + +LDW_INDIRECT lf682, RegHL + +lf5d1: + +LD_REG_INDIRECT_ABS RegA, lf679 ; Enable + ldy #$1b + and (RegIX),y + ora RegL + and #$3f + sta RegA ; New + +LD_INDIRECT_ABS lf679, RegA ; Enable + +lf5dd: + jsr lf646 + +LD_REG_INDIRECT_OFFSET RegH, RegIX, $1d + +LD_REG_INDIRECT_OFFSET RegL, RegIX, $1c + +LD_REG_INDIRECT RegA, RegHL + clc + lda RegA ; Superfluous + adc RegC + sta RegA ; Superfluous + sec ; CARRY OK + sbc #$80 + sta RegA ; New + +LD_INDIRECT RegHL, RegA + +LDW_INDIRECT RegHL, lf680 + +LD RegA, RegH + ora RegL + sta RegA ; New + +RET_Z + + ; + + +LD_REG_INDIRECT_OFFSET RegA, RegIX, $20 +; ora RegA ; Superfluous + bne lf60f + +INCW RegIX + +INCW RegIX + jsr lf646 + +Portamento: + +LDW_INDIRECT RegHL, lf680 ; HL = TonePeriod + +LD_REG_IMM RegB, $00 + +ADDW RegHL, RegBC + +ADDW RegHL, RegBC ; Diff ; HL += 2*RegC + +LD_REG_IMM RegC, $80 + +INVERT_CARRY + +SBCW RegHL, RegBC + +SBCW RegHL, RegBC ; Diff ; HL -= ($100 + C) + +LDW_INDIRECT lf680, RegHL ; TonePeriod = HL + rts + +;-------------------------------------- + +lf60f: + +DEC_INDIRECT_OFFSET RegIX, $22 + php ; New: Save flags + +LD_REG_INDIRECT_OFFSET RegA, RegIX, $21 + plp ; New: Restore flags + beq lf61e + clc ; CARRY OK + ldy #$20 + lda RegA ; Superfluous + adc (RegIX),y + sta RegA + +LD_INDIRECT_OFFSET_IMM RegIX, $22, $01 + +lf61e: + + lda RegA + cmp #101 ; Tune#2 uses value of 100(!) + bcc .lt3 + brk +.lt3 + +; lda RegA +; asl +; sta RegA ; Superfluous +; clc ; CARRY OK +; lda RegA +; adc #$00 +; sta RegA +; +LD RegL, RegA +; lda RegA +; adc #$f7 +; sta RegA +; sbc RegL ; CARRY possibly wrong +; +LD RegH, RegA + + lda RegA + asl ; A = 2*RegA + clc + adc #lf700 ; MSB + sta RegH ; LDI src: RegHL + + +LDW RegDE, lf680 + +LDI + +LDI ; memcpy(&lf680, HL, 2) : Set new TonePeriod + rts + +;-------------------------------------- + +lf62e: + +LDW RegIX, lf682 + jsr lf646 + +LDW RegHL, lf678 ; &(Noise period) + +LD_REG_INDIRECT RegA, RegHL + clc + lda RegA ; Superfluous + adc RegC + sta RegA ; Superfluous + sec ; CARRY OK + sbc #$80 + sta RegA ; New + +LD_INDIRECT RegHL, RegA + cmp #$11 + +RET_C + + +INCW RegHL + +LD_REG_INDIRECT RegA, RegHL + ora #$38 + sta RegA ; New + +LD_INDIRECT RegHL, RegA + rts + +;-------------------------------------- + +lf646: + +PUSH16 RegIX + +POP16 RegHL + +LD_REG_INDIRECT_OFFSET RegD, RegIX, $05 + +LD_REG_INDIRECT_OFFSET RegE, RegIX, $04 + +INC_INDIRECT RegHL + +LD_REG_INDIRECT RegA, RegDE + +SUB_INDIRECT RegHL ; RegA -= (HL) + php ; New + +LD_REG_IMM RegC, $80 + plp ; New + +RET_NZ + + +LD_INDIRECT RegHL, RegA + +INCW RegDE + +LD_REG_INDIRECT RegA, RegDE + +LD RegC, RegA + +INCW RegDE + +INCW RegHL + +INC_INDIRECT RegHL + +LD_REG_INDIRECT RegA, RegDE + +SUB_INDIRECT RegHL + +RET_NZ + + +LD_INDIRECT RegHL, RegA + +INCW RegDE + +LD_REG_INDIRECT RegA, RegDE + inc RegA + bne lf66b + +LD_REG_INDIRECT_OFFSET RegD, RegIX, $0d + +LD_REG_INDIRECT_OFFSET RegE, RegIX, $0c + +lf66b: + +LD_INDIRECT_OFFSET RegIX, $05, RegD + +LD_INDIRECT_OFFSET RegIX, $04, RegE + rts + +;------------------------------------------------------------------------------ + +; Skyfox MB detection routine: + +SF_GetMBSlot: +; Pre: +; Post: +; Z = 0 (NE) : MB detected +; X = HI(MB base address) +; (MBBase) = MB slot address +; + + jsr SF_Detect + +.Loop: stx TmpL + jsr SF_Detect + cpx TmpL + bne .Loop + + cpx #$C8 + rts + +;-------------------------------------- + +SF_Detect: + lda #0 + sta MBBaseL + lda #$c1 + sta MBBaseH + ldx #7 + +.SlotNext: + ldy #$00+SY6522_TIMER1L_COUNTER + jsr SF_GetTimerL + bne .SlotLoop + + ldy #$80+SY6522_TIMER1L_COUNTER + jsr SF_GetTimerL + beq .SlotDone + +.SlotLoop: + inc MBBaseH + dex + bne .SlotNext + +.SlotDone: + ldx MBBaseH + rts + +;-------------------------------------- + + +SF_GetTimerL: + lda (MBBase),y + cmp MBBaseL + sbc (MBBase),y + cmp #$08 + rts + +;------------------------------------------------------------------------------ + +!zone data + +ZPBlock: !fill ZPSize,0 +Z80Block: !fill ZPSize,0 +nMBBaseHi: !byte 0 + +;-------------------------------------- + +; Song Hi/Lo reg values: +SongTbl: !byte 01 ; 0: (AY: Title/In-game) + !byte 34 ; 1: (AY: Game over) + !byte 40 ; 2: (AY: Hall of fame) + !byte 00 ; 3: (Beeper: Title) + !byte 32 ; 4: (AY: SFX 01) + !byte 33 ; 5: (AY: SFX 02) + !byte 26 ; 6: (AY: SFX 03) + !byte 24 ; 7: (AY: SFX 04) + !byte 31 ; 8: (AY: SFX 05) + !byte 22 ; 9: (AY: SFX 06) + !byte 28 ; 10: (AY: SFX 07) + !byte 29 ; 11: (AY: SFX 08) + !byte 23 ; 12: (AY: SFX 09) + !byte 27 ; 13: (AY: SFX 10) + !byte 37 ; 14: (AY: SFX 11) + !byte 25 ; 15: (AY: SFX 12) + +;-------------------------------------- + +; AY regs [0..$D] +AYRegValues: +lf672: !word 0 ; A period +lf674: !word 0 ; B period +lf676: !word 0 ; C period +lf678: !byte 0 ; Noise period +lf679: !byte 0 ; Enable +lf67a: !byte 0 ; A volume +lf67b: !byte 0 ; B volume +lf67c: !byte 0 ; C volume +lf67d: !word 0 ; Envelope period +lf67f: !byte 0 ; Envelope shape + +;-------------------------------------- + +lf680: !word 0 ; Tone period +lf682: !word 0 + !word 0 + +;-------------------------------------- + +lf686: !word 0 + + !word 0 + !word 0 + !word 0 + +lf68e: !word 0 ; Cmd_EA: Set to RegBC + +;-------------------------------------- + +; Voice-A struct + +lf690: !byte 0 ; $00 + !byte 0 ; $01 + !byte 0 ; $02 + !byte 0 ; $03 + !word 0 ; $04/05 + !word 0 ; $06/07 + + !byte 0 ; $08 + !byte 0 ; $09 + !byte 0 ; $0a + !byte 0 ; $0b + !word 0 ; $0c/0d : Cmd_E8: Set to RegC/B + !word 0 ; $0e/0f : Cmd_E9: Set to RegC/B + +lf6a0: !byte 0 ; $10 : Cmd_E1: Set to $00 : $00 = Tune complete + !byte 0 ; $11 : Cmd_00: Set to RegE + !word 0 ; $12/13 : Cmd_00: Set to RegL/H : Next Cmd & Param + !word 0 ; $14/15 : Cmd_E5: Set to RegL/H + !word 0 ; $16/17 + !byte 0 ; $18 : Cmd_E6: Set to RegE + !byte 0 ; $19 : Cmd_66: Set to $01 + !byte $08 ; $1a - 001000 - Disable A (Noise) + !byte $36 ; $1b - 110110 - Enable A (Noise & Tone) + !word lf67a ; $1c/1d - &VolA + !byte 0 ; $1e + !byte 0 ; $1f : Cmd_00: Set to RegE + !byte 0 ; $20 : Cmd_F0: Set to RegE + !byte 0 ; $21 : Cmd_00: Set to RegA + !byte 0 ; $22 + +;-------------------------------------- + +; Voice-B struct + +lf6b3: !byte 0 + !byte 0 + !byte 0 + !byte 0 + !word 0 + !word 0 + !byte 0 + !byte 0 + !byte 0 + !byte 0 + !word 0 + !word 0 +lf6c3: !byte 0 + !byte 0 + !word 0 + !word 0 + !word 0 + !byte 0 + !byte 0 + !byte $10 ; 010000 - Disable B (Noise) + !byte $2d ; 101101 - Enable B (Noise & Tone) + !word lf67b ; &VolB + !byte 0 + !byte 0 + !byte 0 + !byte 0 + !byte 0 + +;-------------------------------------- + +; Voice-C struct + +lf6d6: !byte 0 + !byte 0 + !byte 0 + !byte 0 + !word 0 + !word 0 + !byte 0 + !byte 0 + !byte 0 + !byte 0 + !word 0 + !word 0 +lf6e6: !byte 0 + !byte 0 + !word 0 + !word 0 + !word 0 + !byte 0 + !byte 0 + !byte $20 ; 100000 - Disable C (Noise) + !byte $1b ; 011011 - Enable C (Noise & Tone) + !word lf67c ; &VolC + !byte 0 + !byte 0 + !byte 0 + !byte 0 + !byte 0 + +;-------------------------------------- + +;lf6f9: + !byte $2A,$00,$00,$00,$00,$00,$00 ; Padding + +;-------------------------------------- + +lf700: +; Table size = WORD[100] +; . Period for each note +; . ZX Spectrum's CLK for AY8912 = 1.77345MHz +; . Envelopes are not used, so no E-Periods to convert + +!macro ZX2MB .period { + !word .period*10227/17734 +} + + +ZX2MB $0000 + +ZX2MB $150C + +ZX2MB $13DD + +ZX2MB $12C0 + +ZX2MB $11B2 + +ZX2MB $10B4 + +ZX2MB $0FC4 + +ZX2MB $0EE2 + +ZX2MB $0E0C + +ZX2MB $0D42 + +ZX2MB $0C84 + +ZX2MB $0BD0 + +ZX2MB $0B26 + +ZX2MB $0A86 + +ZX2MB $09EF + +ZX2MB $0960 + +ZX2MB $08D9 + +ZX2MB $085A + +ZX2MB $07E2 + +ZX2MB $0771 + +ZX2MB $0706 + +ZX2MB $06A1 + +ZX2MB $0642 + +ZX2MB $05E8 + +ZX2MB $0593 + +ZX2MB $0543 + +ZX2MB $04F7 + +ZX2MB $04B0 + +ZX2MB $046D + +ZX2MB $042D + +ZX2MB $03F1 + +ZX2MB $03B8 + +ZX2MB $0383 + +ZX2MB $0350 + +ZX2MB $0321 + +ZX2MB $02F4 + +ZX2MB $02CA + +ZX2MB $02A1 + +ZX2MB $027C + +ZX2MB $0258 + +ZX2MB $0236 + +ZX2MB $0217 + +ZX2MB $01F9 + +ZX2MB $01DC + +ZX2MB $01C1 + +ZX2MB $01A8 + +ZX2MB $0190 + +ZX2MB $017A + +ZX2MB $0165 + +ZX2MB $0151 + +ZX2MB $013E + +ZX2MB $012C + +ZX2MB $011B + +ZX2MB $010B + +ZX2MB $00FC + +ZX2MB $00EE + +ZX2MB $00E1 + +ZX2MB $00D4 + +ZX2MB $00C8 + +ZX2MB $00BD + +ZX2MB $00B2 + +ZX2MB $00A8 + +ZX2MB $009F + +ZX2MB $0096 + +ZX2MB $008E + +ZX2MB $0086 + +ZX2MB $007E + +ZX2MB $0077 + +ZX2MB $0070 + +ZX2MB $006A + +ZX2MB $0064 + +ZX2MB $005E + +ZX2MB $0059 + +ZX2MB $0054 + +ZX2MB $004F + +ZX2MB $004B + +ZX2MB $0047 + +ZX2MB $0043 + +ZX2MB $003F + +ZX2MB $003C + +ZX2MB $0038 + +ZX2MB $0035 + +ZX2MB $0032 + +ZX2MB $002F + +ZX2MB $002D + +ZX2MB $002A + +ZX2MB $0028 + +ZX2MB $0025 + +ZX2MB $0023 + +ZX2MB $0021 + +ZX2MB $0020 + +ZX2MB $001E + +ZX2MB $001C + +ZX2MB $001B + +ZX2MB $0019 + +ZX2MB $0018 + +ZX2MB $0016 + +ZX2MB $0015 + +ZX2MB $0014 + +ZX2MB $0000 + +;-------------------------------------- + +; Ref'ed by func @ f426 + +lf7c8: +; Table size = WORD[40] + + !word $018C ; lf700 + $18c = lf88c (addr of music data) + !word $0190 + !word $019A + !word $01A4 + !word $01B4 + !word $01BE + !word $01CB + !word $01D8 + !word $01E5 + !word $01F5 + !word $01FF + !word $0209 + !word $0213 + !word $021D + !word $021E + !word $021F + !word $0220 + !word $022A + !word $022B + !word $0241 + !word $0242 + !word $0246 + !word $0250 + !word $025D + !word $026A + !word $027A + !word $0281 + !word $0288 + !word $0295 + !word $0299 + !word $02A6 + !word $02AD + !word $02BA + !word $02C1 + !word $02C2 + !word $02CC + !word $02E5 + !word $02FE + !word $030E + !word $0000 + +;-------------------------------------- + +; Ref'ed by func @ f415 + +lf818: +; Table size = WORD[58] + + !word $031A + !word $0439 + !word $04E5 + !word $04E8 + !word $04F3 + !word $0541 + !word $0553 + !word $0563 + !word $05A5 + !word $05E7 + !word $05F2 + !word $0613 + !word $0628 + !word $062D + !word $0643 + !word $0662 + !word $0662 + !word $0686 + !word $0687 + !word $0000 + +;lf840: + !word $0000 + +;lf842: + !word $0000 + !word $031F + !word $032B + !word $033A + !word $0346 + !word $0352 + !word $0361 + !word $0370 + !word $037C + !word $038C + !word $039B + !word $03A7 + !word $03B8 + !word $03C9 + !word $03D7 + !word $03E2 + !word $03E2 + !word $03F1 + !word $03FF + !word $0403 + !word $0415 + !word $0420 + !word $0000 + +;lf870: + !word $0000 + !word $0000 + !word $0000 + !word $0000 + +;lf878: + !word $0000 + !word $0686 + !word $068F + !word $069C + !word $06A7 + !word $06B2 + !word $06BF + !word $06C8 + !word $06D3 + !word $06DC + +;-------------------------------------- + +; Music data + +;lf88c: +; Table size = BYTE[1385] + + !byte $C8,$80,$C8,$FF,$01,$81,$0D,$09,$7F,$09,$C8,$80,$C8,$FF,$01,$8D + !byte $01,$01,$7F,$04,$01,$77,$01,$FF,$01,$8A,$01,$02,$82,$01,$02,$7F + !byte $07,$0C,$7F,$06,$C8,$80,$C8,$FF,$01,$81,$0A,$09,$7F,$06,$C8,$80 + !byte $C8,$FF,$01,$8C,$01,$0A,$7F,$08,$14,$7F,$04,$C8,$80,$C8,$FF,$01 + !byte $8D,$01,$02,$7F,$07,$0C,$7F,$06,$C8,$80,$C8,$FF,$01,$8D,$01,$01 + !byte $7F,$0B,$09,$7F,$02,$C8,$80,$C8,$FF,$01,$8B,$01,$08,$7F,$01,$02 + !byte $7F,$01,$07,$7F,$03,$16,$7F,$07,$FF,$01,$83,$03,$11,$7F,$05,$C8 + !byte $80,$C8,$FF,$01,$89,$01,$01,$7D,$03,$C8,$80,$C8,$FF,$01,$77,$01 + !byte $01,$83,$03,$C8,$80,$C8,$FF,$01,$81,$02,$02,$7F,$03,$03,$81,$01 + !byte $FF,$FF,$FF,$FF,$01,$87,$03,$01,$79,$06,$01,$87,$03,$FF,$FF,$01 + !byte $93,$01,$01,$6D,$01,$01,$7F,$02,$01,$81,$04,$01,$7F,$04,$01,$81 + !byte $02,$C8,$80,$C8,$FF,$FF,$02,$7F,$C8,$FF,$01,$80,$01,$01,$B4,$01 + !byte $C8,$80,$C8,$FF,$01,$80,$01,$01,$7E,$01,$02,$E3,$01,$C8,$80,$C8 + !byte $FF,$01,$8A,$01,$01,$7E,$01,$02,$7F,$03,$C8,$80,$C8,$FF,$01,$85 + !byte $03,$01,$71,$01,$01,$80,$01,$01,$8F,$01,$01,$7B,$03,$FF,$01,$85 + !byte $03,$01,$71,$01,$FF,$01,$96,$01,$02,$79,$02,$FF,$01,$86,$01,$01 + !byte $85,$01,$01,$7F,$03,$C8,$80,$C8,$FF,$01,$A1,$C8,$FF,$01,$85,$03 + !byte $09,$7D,$04,$0E,$7F,$03,$C8,$80,$C8,$FF,$01,$84,$01,$01,$7F,$01 + !byte $FF,$01,$8B,$01,$01,$7E,$01,$02,$7F,$03,$C8,$80,$C8,$FF,$01,$83 + !byte $05,$01,$71,$01,$FF,$FF,$02,$8D,$01,$02,$67,$01,$C8,$80,$C8,$FF + !byte $01,$8F,$01,$08,$80,$01,$02,$7F,$01,$04,$7F,$01,$07,$7F,$02,$0C + !byte $7F,$04,$16,$7F,$07,$C8,$80,$C8,$FF,$01,$79,$01,$01,$8B,$01,$01 + !byte $6F,$01,$01,$9B,$01,$01,$5B,$01,$01,$AF,$01,$01,$47,$01,$01,$C3 + !byte $01,$FF,$01,$8F,$01,$01,$7A,$01,$01,$86,$01,$01,$7F,$09,$08,$7F + !byte $06,$FF,$01,$99,$03,$01,$79,$07,$0A,$7E,$C8,$FF,$00,$00,$F4,$63 + !byte $E1,$FF,$FF,$04,$F4,$0F,$E8,$19,$E9,$18,$5D,$48,$EA,$16,$E1,$04 + !byte $F4,$0F,$E8,$01,$F0,$3C,$EA,$05,$67,$24,$4F,$EA,$16,$E1,$04,$F4 + !byte $0F,$E8,$1D,$E9,$1E,$4F,$4D,$EA,$16,$E1,$03,$F4,$0F,$E8,$06,$E9 + !byte $19,$53,$0F,$EA,$16,$E1,$03,$F4,$0F,$E8,$07,$E9,$01,$EA,$01,$6C + !byte $5E,$10,$EA,$16,$E1,$03,$F4,$0F,$E8,$05,$E9,$1C,$EA,$27,$68,$4F + !byte $14,$EA,$16,$E1,$03,$F4,$0F,$E8,$15,$E9,$10,$43,$14,$EA,$16,$E1 + !byte $03,$F4,$0F,$E2,$0F,$E8,$25,$E9,$26,$E6,$3E,$E3,$19,$EA,$16,$E1 + !byte $04,$F4,$0F,$E8,$23,$E9,$24,$EA,$00,$73,$56,$63,$EA,$16,$E1,$03 + !byte $F4,$0F,$E8,$12,$E9,$24,$61,$12,$EA,$16,$E1,$03,$F4,$0F,$E8,$1D + !byte $E9,$1A,$EA,$0B,$71,$39,$40,$E9,$0C,$EA,$16,$E1,$03,$F4,$0F,$E8 + !byte $06,$E9,$22,$EA,$00,$73,$5E,$02,$5E,$10,$EA,$16,$E1,$01,$F4,$0F + !byte $02,$23,$00,$0C,$03,$23,$00,$12,$E5,$23,$E1,$F4,$0F,$E8,$01,$E9 + !byte $1A,$5B,$12,$4F,$69,$E1,$04,$F4,$0F,$E8,$01,$E9,$20,$EA,$14,$70 + !byte $49,$2A,$EA,$16,$E1,$04,$F4,$0F,$E8,$02,$E9,$1C,$58,$16,$D8,$D8 + !byte $EA,$16,$E1,$E1,$00,$00,$00,$01,$F4,$0F,$02,$29,$03,$2A,$E8,$00 + !byte $00,$32,$E5,$2A,$00,$6E,$E5,$2A,$FF,$E6,$30,$E8,$1E,$E9,$00,$E2 + !byte $3F,$E3,$03,$FF,$E9,$14,$E6,$30,$E8,$04,$EA,$01,$E3,$1E,$EA,$00 + !byte $E8,$08,$73,$E3,$46,$E8,$04,$EA,$01,$66,$E3,$3C,$FF,$01,$F4,$0F + !byte $03,$00,$02,$03,$E6,$00,$F0,$00,$E9,$0C,$E8,$03,$E5,$05,$E5,$05 + !byte $E5,$05,$E5,$05,$03,$03,$02,$31,$E5,$04,$E5,$05,$03,$03,$02,$33 + !byte $E5,$04,$E5,$06,$02,$0D,$03,$09,$E5,$07,$02,$0E,$E5,$08,$02,$34 + !byte $03,$03,$E5,$04,$E6,$0A,$E5,$05,$03,$0C,$02,$35,$E6,$05,$E5,$04 + !byte $E5,$05,$02,$00,$E5,$05,$02,$37,$E5,$06,$E5,$04,$03,$09,$02,$0D + !byte $E6,$00,$E5,$07,$02,$0E,$E5,$08,$03,$03,$02,$38,$E5,$04,$02,$32 + !byte $E5,$05,$02,$34,$03,$03,$E5,$04,$02,$39,$E5,$05,$E5,$05,$E5,$05 + !byte $02,$34,$E5,$05,$02,$39,$E5,$05,$E5,$05,$E5,$05,$02,$34,$E5,$05 + !byte $03,$00,$E6,$09,$F0,$13,$E8,$1F,$02,$00,$E5,$05,$E5,$05,$E5,$06 + !byte $E5,$06,$E5,$05,$E5,$05,$E5,$06,$E5,$06,$E6,$0E,$02,$36,$E5,$05 + !byte $E5,$05,$E5,$05,$02,$00,$E5,$02,$FF,$00,$38,$FF,$E6,$1F,$E8,$17 + !byte $F0,$0C,$E5,$04,$E5,$05,$FF,$EA,$16,$E9,$12,$66,$21,$07,$A1,$66 + !byte $AD,$A1,$6B,$AB,$66,$9F,$66,$9F,$66,$AB,$66,$9D,$9D,$66,$A9,$9D + !byte $6B,$B5,$66,$9D,$66,$9C,$66,$A9,$66,$9D,$9D,$66,$A9,$9D,$6B,$A8 + !byte $66,$9C,$66,$9C,$66,$A8,$66,$9A,$66,$9A,$66,$A6,$66,$9A,$6B,$B2 + !byte $66,$9A,$66,$98,$66,$A6,$66,$9F,$9F,$66,$AB,$9F,$6B,$B7,$66,$9F + !byte $66,$9F,$66,$AB,$FF,$66,$15,$07,$66,$A1,$66,$AB,$66,$AD,$6B,$AD + !byte $66,$A1,$66,$9F,$66,$A1,$FF,$66,$1E,$07,$AA,$66,$9E,$A8,$6B,$B6 + !byte $66,$AA,$66,$A8,$66,$AA,$FF,$66,$1F,$07,$66,$9F,$66,$AB,$66,$AB + !byte $6A,$AF,$66,$AF,$66,$A3,$66,$AF,$66,$A4,$66,$A4,$66,$9C,$66,$9F + !byte $6A,$B0,$66,$A4,$66,$9C,$66,$9F,$66,$A4,$66,$98,$66,$9C,$66,$9F + !byte $6A,$B0,$66,$A4,$66,$9C,$66,$9F,$66,$A3,$66,$A3,$66,$A8,$66,$AA + !byte $6A,$AF,$66,$A3,$66,$A8,$66,$AA,$FF,$66,$23,$07,$66,$A3,$66,$A7 + !byte $66,$AF,$6A,$AD,$66,$AD,$66,$A1,$66,$AD,$66,$9C,$66,$9C,$66,$A8 + !byte $66,$A8,$6A,$B4,$66,$A8,$66,$9C,$66,$A8,$66,$9A,$66,$9A,$66,$A6 + !byte $66,$9A,$6A,$B2,$66,$9A,$66,$A6,$66,$9A,$66,$A5,$66,$A5,$66,$B1 + !byte $66,$A5,$6A,$A3,$66,$A3,$66,$AF,$66,$A3,$FF,$E6,$1F,$E8,$17,$E9 + !byte $00,$E5,$07,$E5,$08,$FF,$00,$07,$A1,$9C,$A4,$A6,$A8,$A6,$A4,$A3 + !byte $21,$23,$15,$07,$97,$15,$0E,$1F,$07,$A1,$1F,$0E,$1D,$07,$9F,$1D + !byte $2A,$1C,$07,$9B,$1C,$1C,$FF,$00,$0E,$48,$07,$CA,$C8,$C5,$C0,$C7 + !byte $45,$54,$43,$1C,$41,$2A,$40,$07,$BF,$40,$1C,$FF,$E8,$17,$E5,$04 + !byte $FF,$E6,$18,$E8,$1B,$F0,$0C,$00,$0E,$23,$07,$A4,$A6,$A3,$A4,$A6 + !byte $28,$54,$28,$1C,$28,$38,$FF,$E6,$18,$E8,$1B,$F0,$0C,$27,$0E,$27 + !byte $07,$A8,$AA,$A7,$A8,$AA,$2C,$2A,$1C,$07,$9E,$20,$0E,$28,$07,$AA + !byte $2C,$0E,$AF,$2D,$38,$FF,$21,$0E,$A4,$A3,$A6,$24,$07,$A6,$A8,$A9 + !byte $A8,$A6,$A4,$A3,$21,$0E,$95,$A3,$1F,$07,$21,$23,$1A,$07,$9D,$9C + !byte $95,$9A,$9D,$9C,$95,$9F,$9D,$9C,$95,$FF,$E8,$09,$E9,$0C,$E5,$0B + !byte $E5,$32,$E1,$E6,$24,$E8,$09,$E9,$0A,$23,$0E,$E9,$0C,$21,$46,$E1 + !byte $E6,$24,$E8,$09,$E9,$0C,$E5,$0A,$E5,$32,$E1,$E6,$24,$E8,$1B,$F0 + !byte $18,$E5,$0A,$23,$1C,$E1,$E6,$1D,$E8,$1F,$F0,$0C,$E5,$10,$E5,$05 + !byte $E5,$05,$FF,$E6,$1D,$E8,$1F,$F0,$0C,$E5,$05,$FF,$E6,$1D,$E8,$09 + !byte $F0,$0C,$E5,$10,$1A,$38,$E1,$E8,$1B,$F0,$18,$E5,$0B,$E5,$32,$E1 + !byte $E8,$1F,$F0,$18,$00,$0E,$3C,$07,$BB,$BC,$00,$07,$B9,$00,$07,$FF + !byte $00,$1A,$18,$00,$0E,$3C,$07,$BB,$BC + +;lfdf5: \ No newline at end of file diff --git a/Cybernoid2/build.bat b/Cybernoid2/build.bat new file mode 100644 index 0000000..14b23fb --- /dev/null +++ b/Cybernoid2/build.bat @@ -0,0 +1,4 @@ +D:\Apple][\acme085\acme.exe cybernoid2.a +D:\Apple][\InsertBIN2AWS\debug\InsertBIN2AWS.exe cybernoid2 6000 cybernoid2.aws +java -jar "D:\Apple][\Apple Commander\ac\AppleCommander-1.3.3.9-ac.jar" -d cybernoid2 ..\ReleaseDSK\Cybernoid.dsk +cat cybernoid2 | java -jar "D:\Apple][\Apple Commander\ac\AppleCommander-1.3.3.9-ac.jar" -p Cybernoid2 bin 24576 ..\ReleaseDSK\Cybernoid.dsk \ No newline at end of file diff --git a/README.md b/README.md new file mode 100644 index 0000000..1245466 --- /dev/null +++ b/README.md @@ -0,0 +1 @@ +# Cybernoid diff --git a/ReleaseDSK/Cybernoid-relnote.txt b/ReleaseDSK/Cybernoid-relnote.txt new file mode 100644 index 0000000..995a512 --- /dev/null +++ b/ReleaseDSK/Cybernoid-relnote.txt @@ -0,0 +1,45 @@ +My motivation was to really push the MAME AY8910 emu code, as the Apple +Mockingboard music (Skyfox, Ultima) wasn't really exercising it that +hard. + +So as a little R&D proj, I thought I'd convert Dave Rogers' Spectrum +128 Cybernoid routine (written in 1988). + +Here's a summary of how I did it: +. I got cybernoid.ay from +http://www.worldofspectrum.org/projectay/gdmusic.htm +. Split it into bin's with AYSplitR +. Disassembled with Inkland's dz80w (www.inkland.org) +. I wrote 6502 macros to replace the z80 opcodes +. For cybernoid, I hand converted the z80 code to 6502 (using the +macros) +. I added a few extension to AppleWin's debugger to help debug the 6502 +code (ACME symbol loading & ZP pointer support). + +I use Skyfox's MB detection routine. + +The Z80 regs are emulated with zero-page memory locations $F0..$F8 +The playback routine is very inefficient, as it: +. saves the ZP memory +. restores the Z80 regs +. runs the IRQ handler +. saves the Z80 regs +. restores the ZP memory + +This allows playback to work simultaneously with Applesoft & ProDOS. If +DOS3.3 doesn't disable IRQs around disk I/O, then it won't work on a +real Apple (under DOS3.3), but it'll still work on an emulator :-) + +I profiled the IRQ handler and IIRC, it takes about 20% of the frame on +average. This is poor, but the code can easily be optimised. Remember +this was really just a proof of concept. + +After this, I wrote a python script to do the Z80->6502, and quickly +converted Cybernoid-II. + +Currently playback on real h/w produces noisy renditions of the tunes. I +have replaced my AY-register update routine with the slower one used by Skyfox +which gives better but not perfect results. + +Tom +25 March 2006 \ No newline at end of file diff --git a/ReleaseDSK/Versions.txt b/ReleaseDSK/Versions.txt new file mode 100644 index 0000000..0e34f0f --- /dev/null +++ b/ReleaseDSK/Versions.txt @@ -0,0 +1,6 @@ +v5: 02/04/2006 - Z80 Emu: Fixed SBCW bug that affected portamento + UI: Added timer (M:S:F) & control over enable & volume +v4: 18/03/2006 - Disable Timer1 at INIT entrypoint +v3: 04/03/2006 - Use Skyfox's routine to update AY regs +v2: 21/02/2006 - Spectrum stereo (L=A+B/2, R=C'+B'/2) +v1: 13/02/2006 - Dual mono (L=A+B+C, R=A'+B'+C')