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 0x10000
byte memory[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) {
        debugf(("mem(%04x) callback %02x", Addr, perlCallBack[Addr]));

        debugf(("### SKIP? %02x == %02x", perlCallBack[Addr] & CALLBACK_READ_MASK, CALLBACK_READ_SKIP));
        if ( ( perlCallBack[Addr] & CALLBACK_READ_MASK ) == CALLBACK_READ_SKIP ) {
                debugf(("MEM: read callback skipped"));
                return memory[Addr];
        }
        if ( ( perlCallBack[Addr] & CALLBACK_READ_MASK ) == CALLBACK_READ_ONCE ) {
                debugf(("MEM: read callback disabled"));
                perlCallBack[Addr] = perlCallBack[Addr] & CALLBACK_WRITE_MASK | CALLBACK_READ_SKIP;
        }

        byte byte;
        int count;
        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));
        memory[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));
        memory[Addr] = Value;
        if ( ( perlCallBack[Addr] & CALLBACK_WRITE_MASK ) == CALLBACK_WRITE_SKIP ) {
                debugf(("MEM: write callback skipped"));
                return;
        }
        if ( ( perlCallBack[Addr] & CALLBACK_WRITE_MASK ) == CALLBACK_WRITE_ONCE ) {
                perlCallBack[Addr] = perlCallBack[Addr] & CALLBACK_READ_MASK | CALLBACK_WRITE_SKIP;
                debugf(("MEM: write callback skipped"));
        }
        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( memory, 0xff, 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 to %02x\n", Addr, perlCallBack[Addr]));
}

void set_write_callback(int Addr) {
        perlCallBack[Addr] = perlCallBack[Addr] & CALLBACK_READ_MASK | CALLBACK_WRITE_ALWAYS;
        debugf(("MEM: %04x write callback to %02x\n", Addr, perlCallBack[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];
}

void mem_poke(int Addr, int byte) {
        memory[Addr] = byte;
}

int mem_peek(int Addr) {
        return memory[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)

void mem_poke(int Addr, int byte)

int mem_peek(int Addr)

SV*
mem_peek_region(int from, int to)
CODE:   
        RETVAL = newSVpvn(memory+from,to-from+1);
OUTPUT:
        RETVAL

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	dpavlin	202	#define CACHE_SIZE 0x10000
15	dpavlin	205	byte memory[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	dpavlin	200	debugf(("mem(%04x) callback %02x", Addr, perlCallBack[Addr]));
88	dpavlin	195
89	dpavlin	200	debugf(("### SKIP? %02x == %02x", perlCallBack[Addr] & CALLBACK_READ_MASK, CALLBACK_READ_SKIP));
90			if ( ( perlCallBack[Addr] & CALLBACK_READ_MASK ) == CALLBACK_READ_SKIP ) {
91			debugf(("MEM: read callback skipped"));
92	dpavlin	205	return memory[Addr];
93	dpavlin	200	}
94			if ( ( perlCallBack[Addr] & CALLBACK_READ_MASK ) == CALLBACK_READ_ONCE ) {
95			debugf(("MEM: read callback disabled"));
96	dpavlin	195	perlCallBack[Addr] = perlCallBack[Addr] & CALLBACK_WRITE_MASK \| CALLBACK_READ_SKIP;
97	dpavlin	200	}
98	dpavlin	195
99	dpavlin	89	byte byte;
100			int count;
101			dSP;
102			ENTER;
103			SAVETMPS;
104			PUSHMARK(SP);
105			XPUSHs( sv_2mortal( newSViv( Addr ) ) );
106			PUTBACK;
107			count = call_pv("M6502::_read", G_ARRAY \| G_EVAL );
108			debugf(("got %d values", count));
109			SPAGAIN;
110			if (SvTRUE(ERRSV)) {
111			printf("ERROR: %s", SvPV_nolen( ERRSV ) );
112			exit(1);
113			}
114			if ( count != 1 ) {
115			printf("expect 1 return value, got %d", count);
116			exit(1);
117			}
118			SV *sv;
119			sv = POPs;
120			byte = SvIV(sv);
121			FREETMPS;
122			LEAVE;
123			debugf(("mem(%04x) = %02x", Addr, byte));
124	dpavlin	205	memory[Addr] = byte;
125	dpavlin	89	return byte;
126			}
127
128			byte Rd6502(register word Addr) {
129			byte Value;
130			Value = mem(Addr);
131			debugf(("Rd6502(%04x) = %02x", Addr, Value));
132			return Value;
133			}
134
135			void Wr6502(register word Addr,register byte Value) {
136			debugf(("Wr6502(%04x,%02x)", Addr, Value));
137	dpavlin	205	memory[Addr] = Value;
138	dpavlin	200	if ( ( perlCallBack[Addr] & CALLBACK_WRITE_MASK ) == CALLBACK_WRITE_SKIP ) {
139			debugf(("MEM: write callback skipped"));
140	dpavlin	197	return;
141			}
142	dpavlin	200	if ( ( perlCallBack[Addr] & CALLBACK_WRITE_MASK ) == CALLBACK_WRITE_ONCE ) {
143	dpavlin	195	perlCallBack[Addr] = perlCallBack[Addr] & CALLBACK_READ_MASK \| CALLBACK_WRITE_SKIP;
144	dpavlin	200	debugf(("MEM: write callback skipped"));
145			}
146	dpavlin	89	dSP;
147			ENTER;
148			SAVETMPS;
149			PUSHMARK(SP);
150			XPUSHs( sv_2mortal( newSViv( Addr ) ) );
151			XPUSHs( sv_2mortal( newSViv( Value ) ) );
152			PUTBACK;
153			call_pv("M6502::_write", G_DISCARD );
154			FREETMPS;
155			LEAVE;
156			}
157
158			byte Op6502(register word Addr) {
159			byte Op;
160			Op = mem(Addr);
161			debugf(("Op6502(%04x,%02x) PC:%04x", Addr, Op, R->PC.W));
162			return Op;
163			}
164
165			/ Loop6502() *********************************************/
166			/ 6502 emulation calls this function periodically to /
167			/ check if the system hardware requires any interrupts. /
168			/ This function must return one of following values: /
169			/ INT_NONE, INT_IRQ, INT_NMI, or INT_QUIT to exit the /
170			/ emulation loop. /
171			/********************************** TO BE WRITTEN BY USER /
172
173			int hw_int = INT_NONE;
174
175			byte Loop6502(register M6502 *R) {
176			debugf(("Loop6502"));
177			dump_R;
178			return hw_int;
179			}
180
181			/ Patch6502() ********************************************/
182			/ Emulation calls this function when it encounters an /
183			/ unknown opcode. This can be used to patch the code to /
184			/ emulate BIOS calls, such as disk and tape access. The /
185			/ function should return 1 if the exception was handled, /
186			/ or 0 if the opcode was truly illegal. /
187			/********************************** TO BE WRITTEN BY USER /
188			byte Patch6502(register byte Op,register M6502 *R) {
189			debugf(("Patch6502(%02x)", Op));
190			dump_R;
191			hw_int = INT_QUIT;
192			return 0;
193			}
194
195			/*************************************************************/
196
197	dpavlin	84	int
198	dpavlin	82	reset (void) {
199			debugf(("M6502::reset called"));
200	dpavlin	83	if ( ! R ) {
201			debugf(("allocating space for R"));
202			R = malloc(sizeof(M6502));
203			if (!R) {
204	dpavlin	89	PerlIO_stdoutf("can't alloc %d bytes for M6502", sizeof(M6502));
205	dpavlin	83	exit(1);
206			}
207	dpavlin	205	memset( memory, 0xff, CACHE_SIZE );
208	dpavlin	83	}
209	dpavlin	202	memset( perlCallBack, ( CALLBACK_READ_ALWAYS \| CALLBACK_WRITE_ALWAYS ), CACHE_SIZE );
210	dpavlin	82	Reset6502(R);
211	dpavlin	84	debugf(("Reset6502 over"));
212	dpavlin	87	update_perl_R();
213	dpavlin	82	dump_R;
214	dpavlin	84	return 1;
215	dpavlin	82	}
216
217	dpavlin	91	int exec(int cycles) {
218	dpavlin	93	int left;
219	dpavlin	89	debugf(("exec for %d cycles", cycles));
220
221			if (!R) reset();
222
223			update_C_R();
224	dpavlin	93	left = Exec6502(R, cycles);
225	dpavlin	89	update_perl_R();
226			debugf(("end of %d cycles CPU run\n", cycles));
227	dpavlin	93	return left;
228	dpavlin	89	}
229
230	dpavlin	87	int set_debug(int state) {
231			debug = state;
232			return debug;
233			}
234	dpavlin	86
235	dpavlin	87	int get_debug(void) {
236			return debug;
237			}
238
239	dpavlin	195	/* FIXME somehow check if Addr will fit in int on current platform */
240			void set_read_callback(int Addr) {
241	dpavlin	202	perlCallBack[Addr] = perlCallBack[Addr] & CALLBACK_WRITE_MASK \| CALLBACK_READ_ALWAYS;
242			debugf(("MEM: %04x read callback to %02x\n", Addr, perlCallBack[Addr]));
243	dpavlin	195	}
244
245			void set_write_callback(int Addr) {
246	dpavlin	202	perlCallBack[Addr] = perlCallBack[Addr] & CALLBACK_READ_MASK \| CALLBACK_WRITE_ALWAYS;
247			debugf(("MEM: %04x write callback to %02x\n", Addr, perlCallBack[Addr]));
248	dpavlin	195	}
249
250			/* we fake here, since we will need to call perl at least once to get initial value... */
251	dpavlin	198	int set_all_callbacks(int mode) {
252			memset( perlCallBack, mode, CACHE_SIZE );
253			debugf(("MEM: all callbacks set to %02x\n", perlCallBack[0]));
254	dpavlin	195	return perlCallBack[0];
255			}
256
257	dpavlin	198	int get_callback(int Addr) {
258			return perlCallBack[Addr];
259			}
260	dpavlin	195
261	dpavlin	203	void mem_poke(int Addr, int byte) {
262	dpavlin	205	memory[Addr] = byte;
263	dpavlin	203	}
264	dpavlin	198
265	dpavlin	203	int mem_peek(int Addr) {
266	dpavlin	205	return memory[Addr];
267	dpavlin	203	}
268
269	dpavlin	208
270	dpavlin	80	MODULE = M6502 PACKAGE = M6502
271
272			PROTOTYPES: DISABLE
273
274	dpavlin	203	int set_debug(int state)
275	dpavlin	82
276	dpavlin	203	int get_debug()
277	dpavlin	87
278	dpavlin	203	int reset()
279	dpavlin	87
280	dpavlin	203	void update_C_R()
281	dpavlin	87
282	dpavlin	203	void update_perl_R()
283	dpavlin	87
284	dpavlin	203	int exec(int cycles)
285	dpavlin	195
286	dpavlin	203	void set_read_callback(int Addr)
287	dpavlin	195
288	dpavlin	203	void set_write_callback(int Addr)
289	dpavlin	195
290	dpavlin	203	int set_all_callbacks(int mode)
291	dpavlin	195
292	dpavlin	198	int get_callback(int Addr)
293	dpavlin	203
294			void mem_poke(int Addr, int byte)
295
296			int mem_peek(int Addr)
297	dpavlin	208
298			SV*
299			mem_peek_region(int from, int to)
300			CODE:
301			RETVAL = newSVpvn(memory+from,to-from+1);
302			OUTPUT:
303			RETVAL
304