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));
        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;
}

void set_write_callback(int Addr) {
        perlCallBack[Addr] == perlCallBack[Addr] & CALLBACK_READ_MASK | CALLBACK_WRITE_ALWAYS;
}

/* we fake here, since we will need to call perl at least once to get initial value... */
int disable_all_callbacks(void) {
        memset( perlCallBack, CALLBACK_READ_ONCE | CALLBACK_WRITE_ONCE, CACHE_SIZE );
        return perlCallBack[0];
}


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
disable_all_callbacks()

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	100	opCache[Addr] = Value;
133	dpavlin	195	if ( perlCallBack[Addr] & CALLBACK_WRITE_MASK == CALLBACK_WRITE_SKIP ) return;
134			if ( perlCallBack[Addr] & CALLBACK_WRITE_MASK == CALLBACK_WRITE_ONCE )
135			perlCallBack[Addr] = perlCallBack[Addr] & CALLBACK_READ_MASK \| CALLBACK_WRITE_SKIP;
136	dpavlin	89	dSP;
137			ENTER;
138			SAVETMPS;
139			PUSHMARK(SP);
140			XPUSHs( sv_2mortal( newSViv( Addr ) ) );
141			XPUSHs( sv_2mortal( newSViv( Value ) ) );
142			PUTBACK;
143			call_pv("M6502::_write", G_DISCARD );
144			FREETMPS;
145			LEAVE;
146			}
147
148			byte Op6502(register word Addr) {
149			byte Op;
150			Op = mem(Addr);
151			debugf(("Op6502(%04x,%02x) PC:%04x", Addr, Op, R->PC.W));
152			return Op;
153			}
154
155			/ Loop6502() *********************************************/
156			/ 6502 emulation calls this function periodically to /
157			/ check if the system hardware requires any interrupts. /
158			/ This function must return one of following values: /
159			/ INT_NONE, INT_IRQ, INT_NMI, or INT_QUIT to exit the /
160			/ emulation loop. /
161			/********************************** TO BE WRITTEN BY USER /
162
163			int hw_int = INT_NONE;
164
165			byte Loop6502(register M6502 *R) {
166			debugf(("Loop6502"));
167			dump_R;
168			return hw_int;
169			}
170
171			/ Patch6502() ********************************************/
172			/ Emulation calls this function when it encounters an /
173			/ unknown opcode. This can be used to patch the code to /
174			/ emulate BIOS calls, such as disk and tape access. The /
175			/ function should return 1 if the exception was handled, /
176			/ or 0 if the opcode was truly illegal. /
177			/********************************** TO BE WRITTEN BY USER /
178			byte Patch6502(register byte Op,register M6502 *R) {
179			debugf(("Patch6502(%02x)", Op));
180			dump_R;
181			hw_int = INT_QUIT;
182			return 0;
183			}
184
185			/*************************************************************/
186
187	dpavlin	84	int
188	dpavlin	82	reset (void) {
189			debugf(("M6502::reset called"));
190	dpavlin	83	if ( ! R ) {
191			debugf(("allocating space for R"));
192			R = malloc(sizeof(M6502));
193			if (!R) {
194	dpavlin	89	PerlIO_stdoutf("can't alloc %d bytes for M6502", sizeof(M6502));
195	dpavlin	83	exit(1);
196			}
197	dpavlin	195	memset( opCache, 0, CACHE_SIZE );
198			memset( perlCallBack, CALLBACK_READ_ALWAYS \| CALLBACK_WRITE_ALWAYS, CACHE_SIZE );
199	dpavlin	83	}
200	dpavlin	82	Reset6502(R);
201	dpavlin	84	debugf(("Reset6502 over"));
202	dpavlin	87	update_perl_R();
203	dpavlin	82	dump_R;
204	dpavlin	84	return 1;
205	dpavlin	82	}
206
207	dpavlin	91	int exec(int cycles) {
208	dpavlin	93	int left;
209	dpavlin	89	debugf(("exec for %d cycles", cycles));
210
211			if (!R) reset();
212
213			update_C_R();
214	dpavlin	93	left = Exec6502(R, cycles);
215	dpavlin	89	update_perl_R();
216			debugf(("end of %d cycles CPU run\n", cycles));
217	dpavlin	93	return left;
218	dpavlin	89	}
219
220	dpavlin	87	int set_debug(int state) {
221			debug = state;
222			return debug;
223			}
224	dpavlin	86
225	dpavlin	87	int get_debug(void) {
226			return debug;
227			}
228
229	dpavlin	195	/* FIXME somehow check if Addr will fit in int on current platform */
230			void set_read_callback(int Addr) {
231			perlCallBack[Addr] == perlCallBack[Addr] & CALLBACK_WRITE_MASK \| CALLBACK_READ_ALWAYS;
232			}
233
234			void set_write_callback(int Addr) {
235			perlCallBack[Addr] == perlCallBack[Addr] & CALLBACK_READ_MASK \| CALLBACK_WRITE_ALWAYS;
236			}
237
238			/* we fake here, since we will need to call perl at least once to get initial value... */
239			int disable_all_callbacks(void) {
240			memset( perlCallBack, CALLBACK_READ_ONCE \| CALLBACK_WRITE_ONCE, CACHE_SIZE );
241			return perlCallBack[0];
242			}
243
244
245	dpavlin	80	MODULE = M6502 PACKAGE = M6502
246
247			PROTOTYPES: DISABLE
248
249	dpavlin	87	int
250			set_debug(int state)
251	dpavlin	82
252	dpavlin	84	int
253	dpavlin	87	get_debug()
254
255			int
256	dpavlin	82	reset()
257	dpavlin	87
258			void
259			update_C_R()
260
261			void
262			update_perl_R()
263
264	dpavlin	91	int
265			exec(int cycles)
266	dpavlin	195
267			void
268			set_read_callback(int Addr)
269
270			void
271			set_write_callback(int Addr)
272
273			int
274			disable_all_callbacks()
275