VRac/M6502/M6502.xs

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

#include "M6502.h"
#include "config.h"

M6502 *R = NULL;
int debug = 0;

// same as memory size
#define CACHE_SIZE 0xffff
byte opCache[CACHE_SIZE];

#define CALLBACK_READ_SKIP      0x00
#define CALLBACK_READ_ONCE      0x01
#define CALLBACK_READ_ALWAYS    0x02
#define CALLBACK_READ_MASK      0x0f
#define CALLBACK_WRITE_SKIP     0x00
#define CALLBACK_WRITE_ONCE     0x10
#define CALLBACK_WRITE_ALWAYS   0x20
#define CALLBACK_WRITE_MASK     0xf0
byte perlCallBack[CACHE_SIZE];

void update_C_R(void) {
        R->A = SvIV( get_sv("M6502::A", FALSE) );
        R->P = SvIV( get_sv("M6502::P", FALSE) );
        R->X = SvIV( get_sv("M6502::X", FALSE) );
        R->Y = SvIV( get_sv("M6502::Y", FALSE) );
        R->S = SvIV( get_sv("M6502::S", FALSE) );
        R->PC.W = SvIV( get_sv("M6502::PC", FALSE) );
        R->IPeriod = SvIV( get_sv("M6502::IPeriod", FALSE) );
        R->IRequest = SvIV( get_sv("M6502::IRequest", FALSE) );
        R->IAutoReset = SvIV( get_sv("M6502::IAutoReset", FALSE) );
        R->TrapBadOps = SvIV( get_sv("M6502::TrapBadOps", FALSE) );
        R->Trap = SvIV( get_sv("M6502::Trap", FALSE) );
        R->Trace = SvIV( get_sv("M6502::Trace", FALSE) );
        debugf(("pull_R finished"));
        dump_R;
}

void update_perl_R(void) {
        debugf(("update_perl_R"));
        dSP;
        ENTER;
        SAVETMPS;
        PUSHMARK(SP);
        XPUSHs( sv_2mortal( newSViv( R->A ) ) );
        XPUSHs( sv_2mortal( newSViv( R->P ) ) );
        XPUSHs( sv_2mortal( newSViv( R->X ) ) );
        XPUSHs( sv_2mortal( newSViv( R->Y ) ) );
        XPUSHs( sv_2mortal( newSViv( R->S ) ) );
        XPUSHs( sv_2mortal( newSViv( R->PC.W ) ) );
        XPUSHs( sv_2mortal( newSViv( R->IPeriod ) ) );
        XPUSHs( sv_2mortal( newSViv( R->ICount ) ) );
        XPUSHs( sv_2mortal( newSViv( R->IRequest ) ) );
        XPUSHs( sv_2mortal( newSViv( R->IAutoReset ) ) );
        XPUSHs( sv_2mortal( newSViv( R->TrapBadOps ) ) );
        XPUSHs( sv_2mortal( newSViv( R->Trap ) ) );
        XPUSHs( sv_2mortal( newSViv( R->Trace ) ) );
        PUTBACK;
        call_pv("M6502::_update_perl_R", G_DISCARD );
        debugf(("_update_perl_R returned to C"));
        dump_R;
        FREETMPS;
        LEAVE;
}

/** Debug6502() **********************************************/

byte Debug6502(M6502 *R) {
        dump_R;
        return 1; // continue emulation
}

/** Rd6502()/Wr6502/Op6502() *********************************/
/** These functions are called when access to RAM occurs.   **/
/** They allow to control memory access. Op6502 is the same **/
/** as Rd6502, but used to read *opcodes* only, when many   **/
/** checks can be skipped to make it fast. It is only       **/
/** required if there is a #define FAST_RDOP.               **/
/************************************ TO BE WRITTEN BY USER **/

byte mem(register word Addr) {

        if ( perlCallBack[Addr] & CALLBACK_READ_MASK == CALLBACK_READ_SKIP )
                return opCache[Addr];
        if ( perlCallBack[Addr] & CALLBACK_READ_MASK == CALLBACK_READ_ONCE )
                perlCallBack[Addr] = perlCallBack[Addr] & CALLBACK_WRITE_MASK | CALLBACK_READ_SKIP;

        byte byte;
        int count;
        debugf(("mem(%04x)", Addr));
        dSP;
        ENTER;
        SAVETMPS;
        PUSHMARK(SP);
        XPUSHs( sv_2mortal( newSViv( Addr ) ) );
        PUTBACK;
        count = call_pv("M6502::_read", G_ARRAY | G_EVAL );
        debugf(("got %d values", count));
        SPAGAIN;
        if (SvTRUE(ERRSV)) {
                printf("ERROR: %s", SvPV_nolen( ERRSV ) );
                exit(1);
        }
        if ( count != 1 ) {
                printf("expect 1 return value, got %d", count);
                exit(1);
        }
        SV *sv;
        sv = POPs;
        byte = SvIV(sv);
        FREETMPS;
        LEAVE;
        debugf(("mem(%04x) = %02x", Addr, byte));
        opCache[Addr] = byte;
        return byte;
}

byte Rd6502(register word Addr) {
        byte Value;
        Value = mem(Addr);
        debugf(("Rd6502(%04x) = %02x", Addr, Value));
        return Value;
}

void Wr6502(register word Addr,register byte Value) {
        debugf(("Wr6502(%04x,%02x)", Addr, Value));
        if ( perlCallBack[Addr] & CALLBACK_WRITE_MASK == CALLBACK_WRITE_SKIP && opCache[Addr] == Value ) {
                debugf(("skipped perl callback, same value"));
                return;
        }
        opCache[Addr] = Value;
        if ( perlCallBack[Addr] & CALLBACK_WRITE_MASK == CALLBACK_WRITE_SKIP ) return;
        if ( perlCallBack[Addr] & CALLBACK_WRITE_MASK == CALLBACK_WRITE_ONCE )
                perlCallBack[Addr] = perlCallBack[Addr] & CALLBACK_READ_MASK | CALLBACK_WRITE_SKIP;
        dSP;
        ENTER;
        SAVETMPS;
        PUSHMARK(SP);
        XPUSHs( sv_2mortal( newSViv( Addr ) ) );
        XPUSHs( sv_2mortal( newSViv( Value ) ) );
        PUTBACK;
        call_pv("M6502::_write", G_DISCARD );
        FREETMPS;
        LEAVE;
}

byte Op6502(register word Addr) {
        byte Op;
        Op = mem(Addr);
        debugf(("Op6502(%04x,%02x) PC:%04x", Addr, Op, R->PC.W));
        return Op;
}

/** Loop6502() ***********************************************/
/** 6502 emulation calls this function periodically to      **/
/** check if the system hardware requires any interrupts.   **/
/** This function must return one of following values:      **/
/** INT_NONE, INT_IRQ, INT_NMI, or INT_QUIT to exit the     **/
/** emulation loop.                                         **/
/************************************ TO BE WRITTEN BY USER **/

int hw_int = INT_NONE;

byte Loop6502(register M6502 *R) {
        debugf(("Loop6502"));
        dump_R;
        return hw_int;
}

/** Patch6502() **********************************************/
/** Emulation calls this function when it encounters an     **/
/** unknown opcode. This can be used to patch the code to   **/
/** emulate BIOS calls, such as disk and tape access. The   **/
/** function should return 1 if the exception was handled,  **/
/** or 0 if the opcode was truly illegal.                   **/
/************************************ TO BE WRITTEN BY USER **/
byte Patch6502(register byte Op,register M6502 *R) {
        debugf(("Patch6502(%02x)", Op));
        dump_R;
        hw_int = INT_QUIT;
        return 0;
}

/*************************************************************/

int
reset (void) {
        debugf(("M6502::reset called"));
        if ( ! R ) {
                debugf(("allocating space for R"));
                R = malloc(sizeof(M6502));
                if (!R) {
                        PerlIO_stdoutf("can't alloc %d bytes for M6502", sizeof(M6502));
                        exit(1);
                }
                memset( opCache, 0, CACHE_SIZE );
                memset( perlCallBack, CALLBACK_READ_ALWAYS | CALLBACK_WRITE_ALWAYS, CACHE_SIZE );
        }
        Reset6502(R);
        debugf(("Reset6502 over"));
        update_perl_R();
        dump_R;
        return 1;
}

int exec(int cycles) {
        int left;
        debugf(("exec for %d cycles", cycles));

        if (!R) reset();

        update_C_R();
        left = Exec6502(R, cycles);
        update_perl_R();
        debugf(("end of %d cycles CPU run\n", cycles));
        return left;
}

int set_debug(int state) {
        debug = state;
        return debug;
}

int get_debug(void) {
        return debug;
}

/* FIXME somehow check if Addr will fit in int on current platform */
void set_read_callback(int Addr) {
        perlCallBack[Addr] == perlCallBack[Addr] & CALLBACK_WRITE_MASK | CALLBACK_READ_ALWAYS;
        debugf(("MEM: %04x read callback\n", Addr));
}

void set_write_callback(int Addr) {
        perlCallBack[Addr] == perlCallBack[Addr] & CALLBACK_READ_MASK | CALLBACK_WRITE_ALWAYS;
        debugf(("MEM: %04x write callback\n", Addr));
}

/* we fake here, since we will need to call perl at least once to get initial value... */
int set_all_callbacks(int mode) {
        memset( perlCallBack, mode, CACHE_SIZE );
        debugf(("MEM: all callbacks set to %02x\n", perlCallBack[0]));
        return perlCallBack[0];
}

int get_callback(int Addr) {
        return perlCallBack[Addr];
}


MODULE = M6502          PACKAGE = M6502

PROTOTYPES: DISABLE

int
set_debug(int state)

int
get_debug()

int
reset()

void
update_C_R()

void
update_perl_R()

int
exec(int cycles)

void
set_read_callback(int Addr)

void
set_write_callback(int Addr)

int
set_all_callbacks(int mode)

int get_callback(int Addr)
1	dpavlin	80	#include "EXTERN.h"
2			#include "perl.h"
3			#include "XSUB.h"
4
5			#include "ppport.h"
6
7	dpavlin	82	#include "M6502.h"
8			#include "config.h"
9
10	dpavlin	89	M6502 *R = NULL;
11	dpavlin	87	int debug = 0;
12	dpavlin	82
13	dpavlin	195	// same as memory size
14			#define CACHE_SIZE 0xffff
15	dpavlin	108	byte opCache[CACHE_SIZE];
16	dpavlin	100
17	dpavlin	195	#define CALLBACK_READ_SKIP 0x00
18			#define CALLBACK_READ_ONCE 0x01
19			#define CALLBACK_READ_ALWAYS 0x02
20			#define CALLBACK_READ_MASK 0x0f
21			#define CALLBACK_WRITE_SKIP 0x00
22			#define CALLBACK_WRITE_ONCE 0x10
23			#define CALLBACK_WRITE_ALWAYS 0x20
24			#define CALLBACK_WRITE_MASK 0xf0
25			byte perlCallBack[CACHE_SIZE];
26
27	dpavlin	87	void update_C_R(void) {
28			R->A = SvIV( get_sv("M6502::A", FALSE) );
29			R->P = SvIV( get_sv("M6502::P", FALSE) );
30			R->X = SvIV( get_sv("M6502::X", FALSE) );
31			R->Y = SvIV( get_sv("M6502::Y", FALSE) );
32			R->S = SvIV( get_sv("M6502::S", FALSE) );
33			R->PC.W = SvIV( get_sv("M6502::PC", FALSE) );
34			R->IPeriod = SvIV( get_sv("M6502::IPeriod", FALSE) );
35			R->IRequest = SvIV( get_sv("M6502::IRequest", FALSE) );
36			R->IAutoReset = SvIV( get_sv("M6502::IAutoReset", FALSE) );
37			R->TrapBadOps = SvIV( get_sv("M6502::TrapBadOps", FALSE) );
38			R->Trap = SvIV( get_sv("M6502::Trap", FALSE) );
39			R->Trace = SvIV( get_sv("M6502::Trace", FALSE) );
40			debugf(("pull_R finished"));
41			dump_R;
42	dpavlin	80	}
43
44	dpavlin	87	void update_perl_R(void) {
45			debugf(("update_perl_R"));
46			dSP;
47			ENTER;
48			SAVETMPS;
49			PUSHMARK(SP);
50			XPUSHs( sv_2mortal( newSViv( R->A ) ) );
51			XPUSHs( sv_2mortal( newSViv( R->P ) ) );
52			XPUSHs( sv_2mortal( newSViv( R->X ) ) );
53			XPUSHs( sv_2mortal( newSViv( R->Y ) ) );
54			XPUSHs( sv_2mortal( newSViv( R->S ) ) );
55			XPUSHs( sv_2mortal( newSViv( R->PC.W ) ) );
56			XPUSHs( sv_2mortal( newSViv( R->IPeriod ) ) );
57			XPUSHs( sv_2mortal( newSViv( R->ICount ) ) );
58			XPUSHs( sv_2mortal( newSViv( R->IRequest ) ) );
59			XPUSHs( sv_2mortal( newSViv( R->IAutoReset ) ) );
60			XPUSHs( sv_2mortal( newSViv( R->TrapBadOps ) ) );
61			XPUSHs( sv_2mortal( newSViv( R->Trap ) ) );
62			XPUSHs( sv_2mortal( newSViv( R->Trace ) ) );
63			PUTBACK;
64			call_pv("M6502::_update_perl_R", G_DISCARD );
65			debugf(("_update_perl_R returned to C"));
66			dump_R;
67			FREETMPS;
68			LEAVE;
69			}
70
71	dpavlin	89	/ Debug6502() ********************************************/
72
73			byte Debug6502(M6502 *R) {
74			dump_R;
75			return 1; // continue emulation
76			}
77
78			/ Rd6502()/Wr6502/Op6502() *******************************/
79			/ These functions are called when access to RAM occurs. /
80			/ They allow to control memory access. Op6502 is the same /
81			/** as Rd6502, but used to read opcodes only, when many **/
82			/ checks can be skipped to make it fast. It is only /
83			/ required if there is a #define FAST_RDOP. /
84			/********************************** TO BE WRITTEN BY USER /
85
86	dpavlin	195	byte mem(register word Addr) {
87
88			if ( perlCallBack[Addr] & CALLBACK_READ_MASK == CALLBACK_READ_SKIP )
89			return opCache[Addr];
90			if ( perlCallBack[Addr] & CALLBACK_READ_MASK == CALLBACK_READ_ONCE )
91			perlCallBack[Addr] = perlCallBack[Addr] & CALLBACK_WRITE_MASK \| CALLBACK_READ_SKIP;
92
93	dpavlin	89	byte byte;
94			int count;
95			debugf(("mem(%04x)", Addr));
96			dSP;
97			ENTER;
98			SAVETMPS;
99			PUSHMARK(SP);
100			XPUSHs( sv_2mortal( newSViv( Addr ) ) );
101			PUTBACK;
102			count = call_pv("M6502::_read", G_ARRAY \| G_EVAL );
103			debugf(("got %d values", count));
104			SPAGAIN;
105			if (SvTRUE(ERRSV)) {
106			printf("ERROR: %s", SvPV_nolen( ERRSV ) );
107			exit(1);
108			}
109			if ( count != 1 ) {
110			printf("expect 1 return value, got %d", count);
111			exit(1);
112			}
113			SV *sv;
114			sv = POPs;
115			byte = SvIV(sv);
116			FREETMPS;
117			LEAVE;
118			debugf(("mem(%04x) = %02x", Addr, byte));
119	dpavlin	100	opCache[Addr] = byte;
120	dpavlin	89	return byte;
121			}
122
123			byte Rd6502(register word Addr) {
124			byte Value;
125			Value = mem(Addr);
126			debugf(("Rd6502(%04x) = %02x", Addr, Value));
127			return Value;
128			}
129
130			void Wr6502(register word Addr,register byte Value) {
131			debugf(("Wr6502(%04x,%02x)", Addr, Value));
132	dpavlin	197	if ( perlCallBack[Addr] & CALLBACK_WRITE_MASK == CALLBACK_WRITE_SKIP && opCache[Addr] == Value ) {
133			debugf(("skipped perl callback, same value"));
134			return;
135			}
136	dpavlin	100	opCache[Addr] = Value;
137	dpavlin	195	if ( perlCallBack[Addr] & CALLBACK_WRITE_MASK == CALLBACK_WRITE_SKIP ) return;
138			if ( perlCallBack[Addr] & CALLBACK_WRITE_MASK == CALLBACK_WRITE_ONCE )
139			perlCallBack[Addr] = perlCallBack[Addr] & CALLBACK_READ_MASK \| CALLBACK_WRITE_SKIP;
140	dpavlin	89	dSP;
141			ENTER;
142			SAVETMPS;
143			PUSHMARK(SP);
144			XPUSHs( sv_2mortal( newSViv( Addr ) ) );
145			XPUSHs( sv_2mortal( newSViv( Value ) ) );
146			PUTBACK;
147			call_pv("M6502::_write", G_DISCARD );
148			FREETMPS;
149			LEAVE;
150			}
151
152			byte Op6502(register word Addr) {
153			byte Op;
154			Op = mem(Addr);
155			debugf(("Op6502(%04x,%02x) PC:%04x", Addr, Op, R->PC.W));
156			return Op;
157			}
158
159			/ Loop6502() *********************************************/
160			/ 6502 emulation calls this function periodically to /
161			/ check if the system hardware requires any interrupts. /
162			/ This function must return one of following values: /
163			/ INT_NONE, INT_IRQ, INT_NMI, or INT_QUIT to exit the /
164			/ emulation loop. /
165			/********************************** TO BE WRITTEN BY USER /
166
167			int hw_int = INT_NONE;
168
169			byte Loop6502(register M6502 *R) {
170			debugf(("Loop6502"));
171			dump_R;
172			return hw_int;
173			}
174
175			/ Patch6502() ********************************************/
176			/ Emulation calls this function when it encounters an /
177			/ unknown opcode. This can be used to patch the code to /
178			/ emulate BIOS calls, such as disk and tape access. The /
179			/ function should return 1 if the exception was handled, /
180			/ or 0 if the opcode was truly illegal. /
181			/********************************** TO BE WRITTEN BY USER /
182			byte Patch6502(register byte Op,register M6502 *R) {
183			debugf(("Patch6502(%02x)", Op));
184			dump_R;
185			hw_int = INT_QUIT;
186			return 0;
187			}
188
189			/*************************************************************/
190
191	dpavlin	84	int
192	dpavlin	82	reset (void) {
193			debugf(("M6502::reset called"));
194	dpavlin	83	if ( ! R ) {
195			debugf(("allocating space for R"));
196			R = malloc(sizeof(M6502));
197			if (!R) {
198	dpavlin	89	PerlIO_stdoutf("can't alloc %d bytes for M6502", sizeof(M6502));
199	dpavlin	83	exit(1);
200			}
201	dpavlin	195	memset( opCache, 0, CACHE_SIZE );
202			memset( perlCallBack, CALLBACK_READ_ALWAYS \| CALLBACK_WRITE_ALWAYS, CACHE_SIZE );
203	dpavlin	83	}
204	dpavlin	82	Reset6502(R);
205	dpavlin	84	debugf(("Reset6502 over"));
206	dpavlin	87	update_perl_R();
207	dpavlin	82	dump_R;
208	dpavlin	84	return 1;
209	dpavlin	82	}
210
211	dpavlin	91	int exec(int cycles) {
212	dpavlin	93	int left;
213	dpavlin	89	debugf(("exec for %d cycles", cycles));
214
215			if (!R) reset();
216
217			update_C_R();
218	dpavlin	93	left = Exec6502(R, cycles);
219	dpavlin	89	update_perl_R();
220			debugf(("end of %d cycles CPU run\n", cycles));
221	dpavlin	93	return left;
222	dpavlin	89	}
223
224	dpavlin	87	int set_debug(int state) {
225			debug = state;
226			return debug;
227			}
228	dpavlin	86
229	dpavlin	87	int get_debug(void) {
230			return debug;
231			}
232
233	dpavlin	195	/* FIXME somehow check if Addr will fit in int on current platform */
234			void set_read_callback(int Addr) {
235			perlCallBack[Addr] == perlCallBack[Addr] & CALLBACK_WRITE_MASK \| CALLBACK_READ_ALWAYS;
236	dpavlin	198	debugf(("MEM: %04x read callback\n", Addr));
237	dpavlin	195	}
238
239			void set_write_callback(int Addr) {
240			perlCallBack[Addr] == perlCallBack[Addr] & CALLBACK_READ_MASK \| CALLBACK_WRITE_ALWAYS;
241	dpavlin	198	debugf(("MEM: %04x write callback\n", Addr));
242	dpavlin	195	}
243
244			/* we fake here, since we will need to call perl at least once to get initial value... */
245	dpavlin	198	int set_all_callbacks(int mode) {
246			memset( perlCallBack, mode, CACHE_SIZE );
247			debugf(("MEM: all callbacks set to %02x\n", perlCallBack[0]));
248	dpavlin	195	return perlCallBack[0];
249			}
250
251	dpavlin	198	int get_callback(int Addr) {
252			return perlCallBack[Addr];
253			}
254	dpavlin	195
255	dpavlin	198
256	dpavlin	80	MODULE = M6502 PACKAGE = M6502
257
258			PROTOTYPES: DISABLE
259
260	dpavlin	87	int
261			set_debug(int state)
262	dpavlin	82
263	dpavlin	84	int
264	dpavlin	87	get_debug()
265
266			int
267	dpavlin	82	reset()
268	dpavlin	87
269			void
270			update_C_R()
271
272			void
273			update_perl_R()
274
275	dpavlin	91	int
276			exec(int cycles)
277	dpavlin	195
278			void
279			set_read_callback(int Addr)
280
281			void
282			set_write_callback(int Addr)
283
284			int
285	dpavlin	198	set_all_callbacks(int mode)
286	dpavlin	195
287	dpavlin	198	int get_callback(int Addr)