/[gxemul]/trunk/src/cpus/cpu_sh_instr.c
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /trunk/src/cpus/cpu_sh_instr.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 32 - (hide annotations)
Mon Oct 8 16:20:58 2007 UTC (16 years, 6 months ago) by dpavlin
File MIME type: text/plain
File size: 91164 byte(s)
++ trunk/HISTORY	(local)
$Id: HISTORY,v 1.1421 2006/11/06 05:32:37 debug Exp $
20060816	Adding a framework for emulated/virtual timers (src/timer.c),
		using only setitimer().
		Rewriting the mc146818 to use the new timer framework.
20060817	Adding a call to gettimeofday() every now and then (once every
		second, at the moment) to resynch the timer if it drifts.
		Beginning to convert the ISA timer interrupt mechanism (8253
		and 8259) to use the new timer framework.
		Removing the -I command line option.
20060819	Adding the -I command line option again, with new semantics.
		Working on Footbridge timer interrupts; NetBSD/NetWinder and
		NetBSD/CATS now run at correct speed, but unfortunately with
		HUGE delays during bootup.
20060821	Some minor m68k updates. Adding the first instruction: nop. :)
		Minor Alpha emulation updates.
20060822	Adding a FreeBSD development specific YAMON environment
		variable ("khz") (as suggested by Bruce M. Simpson).
		Moving YAMON environment variable initialization from
		machine_evbmips.c into promemul/yamon.c, and adding some more
		variables.
		Continuing on the LCA PCI bus controller (for Alpha machines).
20060823	Continuing on the timer stuff: experimenting with MIPS count/
		compare interrupts connected to the timer framework.
20060825	Adding bogus SCSI commands 0x51 (SCSICDROM_READ_DISCINFO) and
		0x52 (SCSICDROM_READ_TRACKINFO) to the SCSI emulation layer,
		to allow NetBSD/pmax 4.0_BETA to be installed from CDROM.
		Minor updates to the LCA PCI controller.
20060827	Implementing a CHIP8 cpu mode, and a corresponding CHIP8
		machine, for fun. Disassembly support for all instructions,
		and most of the common instructions have been implemented: mvi,
		mov_imm, add_imm, jmp, rand, cls, sprite, skeq_imm, jsr,
		skne_imm, bcd, rts, ldr, str, mov, or, and, xor, add, sub,
		font, ssound, sdelay, gdelay, bogus skup/skpr, skeq, skne.
20060828	Beginning to convert the CHIP8 cpu in the CHIP8 machine to a
		(more correct) RCA 180x cpu. (Disassembly for all 1802
		instructions has been implemented, but no execution yet, and
		no 1805 extended instructions.)
20060829	Minor Alpha emulation updates.
20060830	Beginning to experiment a little with PCI IDE for SGI O2.
		Fixing the cursor key mappings for MobilePro 770 emulation.
		Fixing the LK201 warning caused by recent NetBSD/pmax.
		The MIPS R41xx standby, suspend, and hibernate instructions now
		behave like the RM52xx/MIPS32/MIPS64 wait instruction.
		Fixing dev_wdc so it calculates correct (64-bit) offsets before
		giving them to diskimage_access().
20060831	Continuing on Alpha emulation (OSF1 PALcode).
20060901	Minor Alpha updates; beginning on virtual memory pagetables.
		Removed the limit for max nr of devices (in preparation for
		allowing devices' base addresses to be changed during runtime).
		Adding a hack for MIPS [d]mfc0 select 0 (except the count
		register), so that the coproc register is simply copied.
		The MIPS suspend instruction now exits the emulator, instead
		of being treated as a wait instruction (this causes NetBSD/
		hpcmips to get correct 'halt' behavior).
		The VR41xx RTC now returns correct time.
		Connecting the VR41xx timer to the timer framework (fixed at
		128 Hz, for now).
		Continuing on SPARC emulation, adding more instructions:
		restore, ba_xcc, ble. The rectangle drawing demo works :)
		Removing the last traces of the old ENABLE_CACHE_EMULATION
		MIPS stuff (not usable with dyntrans anyway).
20060902	Splitting up src/net.c into several smaller files in its own
		subdirectory (src/net/).
20060903	Cleanup of the files in src/net/, to make them less ugly.
20060904	Continuing on the 'settings' subsystem.
		Minor progress on the SPARC emulation mode.
20060905	Cleanup of various things, and connecting the settings
		infrastructure to various subsystems (emul, machine, cpu, etc).
		Changing the lk201 mouse update routine to not rely on any
		emulated hardware framebuffer cursor coordinates, but instead
		always do (semi-usable) relative movements.
20060906	Continuing on the lk201 mouse stuff. Mouse behaviour with
		multiple framebuffers (which was working in Ultrix) is now
		semi-broken (but it still works, in a way).
		Moving the documentation about networking into its own file
		(networking.html), and refreshing it a bit. Adding an example
		of how to use ethernet frame direct-access (udp_snoop).
20060907	Continuing on the settings infrastructure.
20060908	Minor updates to SH emulation: for 32-bit emulation: delay
		slots and the 'jsr @Rn' instruction. I'm putting 64-bit SH5 on
		ice, for now.
20060909-10	Implementing some more 32-bit SH instructions. Removing the
		64-bit mode completely. Enough has now been implemented to run
		the rectangle drawing demo. :-)
20060912	Adding more SH instructions.
20060916	Continuing on SH emulation (some more instructions: div0u,
		div1, rotcl/rotcr, more mov instructions, dt, braf, sets, sett,
		tst_imm, dmuls.l, subc, ldc_rm_vbr, movt, clrt, clrs, clrmac).
		Continuing on the settings subsystem (beginning on reading/
		writing settings, removing bugs, and connecting more cpus to
		the framework).
20060919	More work on SH emulation; adding an ldc banked instruction,
		and attaching a 640x480 framebuffer to the Dreamcast machine
		mode (NetBSD/dreamcast prints the NetBSD copyright banner :-),
		and then panics).
20060920	Continuing on the settings subsystem.
20060921	Fixing the Footbridge timer stuff so that NetBSD/cats and
		NetBSD/netwinder boot up without the delays.
20060922	Temporarily hardcoding MIPS timer interrupt to 100 Hz. With
		'wait' support disabled, NetBSD/malta and Linux/malta run at
		correct speed.
20060923	Connecting dev_gt to the timer framework, so that NetBSD/cobalt
		runs at correct speed.
		Moving SH4-specific memory mapped registers into its own
		device (dev_sh4.c).
		Running with -N now prints "idling" instead of bogus nr of
		instrs/second (which isn't valid anyway) while idling.
20060924	Algor emulation should now run at correct speed.
		Adding disassembly support for some MIPS64 revision 2
		instructions: ext, dext, dextm, dextu.
20060926	The timer framework now works also when the MIPS wait
		instruction is used.
20060928	Re-implementing checks for coprocessor availability for MIPS
		cop0 instructions. (Thanks to Carl van Schaik for noticing the
		lack of cop0 availability checks.)
20060929	Implementing an instruction combination hack which treats
		NetBSD/pmax' idle loop as a wait-like instruction.
20060930	The ENTRYHI_R_MASK was missing in (at least) memory_mips_v2p.c,
		causing TLB lookups to sometimes succeed when they should have
		failed. (A big thank you to Juli Mallett for noticing the
		problem.)
		Adding disassembly support for more MIPS64 revision 2 opcodes
		(seb, seh, wsbh, jalr.hb, jr.hb, synci, ins, dins, dinsu,
		dinsm, dsbh, dshd, ror, dror, rorv, drorv, dror32). Also
		implementing seb, seh, dsbh, dshd, and wsbh.
		Implementing an instruction combination hack for Linux/pmax'
		idle loop, similar to the NetBSD/pmax case.
20061001	Changing the NetBSD/sgimips install instructions to extract
		files from an iso image, instead of downloading them via ftp.
20061002	More-than-31-bit userland addresses in memory_mips_v2p.c were
		not actually working; applying a fix from Carl van Schaik to
		enable them to work + making some other updates (adding kuseg
		support).
		Fixing hpcmips (vr41xx) timer initialization.
		Experimenting with O(n)->O(1) reduction in the MIPS TLB lookup
		loop. Seems to work both for R3000 and non-R3000.
20061003	Continuing a little on SH emulation (adding more control
		registers; mini-cleanup of memory_sh.c).
20061004	Beginning on a dev_rtc, a clock/timer device for the test
		machines; also adding a demo, and some documentation.
		Fixing a bug in SH "mov.w @(disp,pc),Rn" (the result wasn't
		sign-extended), and adding the addc and ldtlb instructions.
20061005	Contining on SH emulation: virtual to physical address
		translation, and a skeleton exception mechanism.
20061006	Adding more SH instructions (various loads and stores, rte,
		negc, muls.w, various privileged register-move instructions).
20061007	More SH instructions: various move instructions, trapa, div0s,
		float, fdiv, ftrc.
		Continuing on dev_rtc; removing the rtc demo.
20061008	Adding a dummy Dreamcast PROM module. (Homebrew Dreamcast
		programs using KOS libs need this.)
		Adding more SH instructions: "stc vbr,rn", rotl, rotr, fsca,
		fmul, fadd, various floating-point moves, etc. A 256-byte
		demo for Dreamcast runs :-)
20061012	Adding the SH "lds Rm,pr" and bsr instructions.
20061013	More SH instructions: "sts fpscr,rn", tas.b, and some more
		floating point instructions, cmp/str, and more moves.
		Adding a dummy dev_pvr (Dreamcast graphics controller).
20061014	Generalizing the expression evaluator (used in the built-in
		debugger) to support parentheses and +-*/%^&|.
20061015	Removing the experimental tlb index hint code in
		mips_memory_v2p.c, since it didn't really have any effect.
20061017	Minor SH updates; adding the "sts pr,Rn", fcmp/gt, fneg,
		frchg, and some other instructions. Fixing missing sign-
		extension in an 8-bit load instruction.
20061019	Adding a simple dev_dreamcast_rtc.
		Implementing memory-mapped access to the SH ITLB/UTLB arrays.
20061021	Continuing on various SH and Dreamcast things: sh4 timers,
		debug messages for dev_pvr, fixing some virtual address
		translation bugs, adding the bsrf instruction.
		The NetBSD/dreamcast GENERIC_MD kernel now reaches userland :)
		Adding a dummy dev_dreamcast_asic.c (not really useful yet).
		Implementing simple support for Store Queues.
		Beginning on the PVR Tile Accelerator.
20061022	Generalizing the PVR framebuffer to support off-screen drawing,
		multiple bit-depths, etc. (A small speed penalty, but most
		likely worth it.)
		Adding more SH instructions (mulu.w, fcmp/eq, fsub, fmac,
		fschg, and some more); correcting bugs in "fsca" and "float".
20061024	Adding the SH ftrv (matrix * vector) instruction. Marcus
		Comstedt's "tatest" example runs :) (wireframe only).
		Correcting disassembly for SH floating point instructions that
		use the xd* registers.
		Adding the SH fsts instruction.
		In memory_device_dyntrans_access(), only the currently used
		range is now invalidated, and not the entire device range.
20061025	Adding a dummy AVR32 cpu mode skeleton.
20061026	Various Dreamcast updates; beginning on a Maple bus controller.
20061027	Continuing on the Maple bus. A bogus Controller, Keyboard, and
		Mouse can now be detected by NetBSD and KOS homebrew programs.
		Cleaning up the SH4 Timer Management Unit, and beginning on
		SH4 interrupts.
		Implementing the Dreamcast SYSASIC.
20061028	Continuing on the SYSASIC.
		Adding the SH fsqrt instruction.
		memory_sh.c now actually scans the ITLB.
		Fixing a bug in dev_sh4.c, related to associative writes into
		the memory-mapped UTLB array. NetBSD/dreamcast now reaches
		userland stably, and prints the "Terminal type?" message :-]
		Implementing enough of the Dreamcast keyboard to make NetBSD
		accept it for input.
		Enabling SuperH for stable (non-development) builds.
		Adding NetBSD/dreamcast to the documentation, although it
		doesn't support root-on-nfs yet.
20061029	Changing usleep(1) calls in the debugger to to usleep(10000)
		(according to Brian Foley, this makes GXemul run better on
		MacOS X).
		Making the Maple "Controller" do something (enough to barely
		interact with dcircus.elf).
20061030-31	Some progress on the PVR. More test programs start running (but
		with strange output).
		Various other SH4-related updates.
20061102	Various Dreamcast and SH4 updates; more KOS demos run now.
20061104	Adding a skeleton dev_mb8696x.c (the Dreamcast's LAN adapter).
20061105	Continuing on the MB8696x; NetBSD/dreamcast detects it as mbe0.
		Testing for the release.

==============  RELEASE 0.4.3  ==============


1 dpavlin 14 /*
2 dpavlin 22 * Copyright (C) 2005-2006 Anders Gavare. All rights reserved.
3 dpavlin 14 *
4     * Redistribution and use in source and binary forms, with or without
5     * modification, are permitted provided that the following conditions are met:
6     *
7     * 1. Redistributions of source code must retain the above copyright
8     * notice, this list of conditions and the following disclaimer.
9     * 2. Redistributions in binary form must reproduce the above copyright
10     * notice, this list of conditions and the following disclaimer in the
11     * documentation and/or other materials provided with the distribution.
12     * 3. The name of the author may not be used to endorse or promote products
13     * derived from this software without specific prior written permission.
14     *
15     * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
16     * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
17     * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
18     * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
19     * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
20     * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
21     * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
22     * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
23     * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
24     * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
25     * SUCH DAMAGE.
26     *
27     *
28 dpavlin 32 * $Id: cpu_sh_instr.c,v 1.44 2006/11/02 05:43:43 debug Exp $
29 dpavlin 14 *
30     * SH instructions.
31     *
32     * Individual functions should keep track of cpu->n_translated_instrs.
33     * (If no instruction was executed, then it should be decreased. If, say, 4
34     * instructions were combined into one function and executed, then it should
35     * be increased by 3.)
36     */
37    
38    
39 dpavlin 32 #define SYNCH_PC { \
40     int low_pc = ((size_t)ic - (size_t)cpu->cd.sh.cur_ic_page) \
41     / sizeof(struct sh_instr_call); \
42     cpu->pc &= ~((SH_IC_ENTRIES_PER_PAGE-1) \
43     << SH_INSTR_ALIGNMENT_SHIFT); \
44     cpu->pc += (low_pc << SH_INSTR_ALIGNMENT_SHIFT); \
45     }
46    
47     #define RES_INST_IF_NOT_MD \
48     if (!(cpu->cd.sh.sr & SH_SR_MD)) { \
49     SYNCH_PC; \
50     sh_exception(cpu, EXPEVT_RES_INST, 0, 0); \
51     return; \
52     }
53    
54     #define FLOATING_POINT_AVAILABLE_CHECK \
55     if (cpu->cd.sh.sr & SH_SR_FD) { \
56     /* FPU disabled: Cause exception. */ \
57     SYNCH_PC; \
58     if (cpu->delay_slot) \
59     sh_exception(cpu, EXPEVT_FPU_SLOT_DISABLE, 0, 0);\
60     else \
61     sh_exception(cpu, EXPEVT_FPU_DISABLE, 0, 0); \
62     return; \
63     }
64    
65    
66 dpavlin 14 /*
67 dpavlin 30 * nop: Nothing
68 dpavlin 14 */
69     X(nop)
70     {
71     }
72    
73    
74 dpavlin 30 /*
75 dpavlin 32 * sleep: Wait for interrupt
76     */
77     X(sleep)
78     {
79     RES_INST_IF_NOT_MD;
80    
81     /*
82     * If there is an interrupt, then just return. Otherwise
83     * re-run the sleep instruction (after a delay).
84     */
85     if (cpu->cd.sh.int_to_assert > 0 && !(cpu->cd.sh.sr & SH_SR_BL)
86     && ((cpu->cd.sh.sr & SH_SR_IMASK) >> SH_SR_IMASK_SHIFT)
87     < cpu->cd.sh.int_level)
88     return;
89    
90     cpu->cd.sh.next_ic = ic;
91     cpu->is_halted = 1;
92     cpu->has_been_idling = 1;
93    
94     /*
95     * There was no interrupt. Let the host sleep for a while.
96     *
97     * TODO:
98     *
99     * Think about how to actually implement this usleep stuff,
100     * in an SMP and/or timing accurate environment.
101     */
102    
103     if (cpu->machine->ncpus == 1) {
104     static int x = 0;
105     if ((++x) == 600) {
106     usleep(10);
107     x = 0;
108     }
109     cpu->n_translated_instrs += N_SAFE_DYNTRANS_LIMIT / 6;
110     }
111     }
112    
113    
114     /*
115     * sett: t = 1
116     * sets: s = 1
117     * clrt: t = 1
118     * clrs: s = 1
119     * movt_rn: rn = t
120     * clrmac: mach = macl = 0
121 dpavlin 30 *
122 dpavlin 32 * arg[1] = ptr to rn
123     */
124     X(sett) { cpu->cd.sh.sr |= SH_SR_T; }
125     X(sets) { cpu->cd.sh.sr |= SH_SR_S; }
126     X(clrt) { cpu->cd.sh.sr &= ~SH_SR_T; }
127     X(clrs) { cpu->cd.sh.sr &= ~SH_SR_S; }
128     X(movt_rn) { reg(ic->arg[1]) = cpu->cd.sh.sr & SH_SR_T? 1 : 0; }
129     X(clrmac) { cpu->cd.sh.macl = cpu->cd.sh.mach = 0; }
130    
131    
132     /*
133     * mov_rm_rn: rn = rm
134     * neg_rm_rn: rn = -rm
135     * negc_rm_rn: rn = -rm - t, t = borrow
136     * not_rm_rn: rn = ~rm
137     * swap_b_rm_rn: rn = rm with lowest 2 bytes swapped
138     * swap_w_rm_rn: rn = rm with high and low 16-bit words swapped
139     * exts_b_rm_rn: rn = (int8_t) rm
140     * extu_b_rm_rn: rn = (uint8_t) rm
141     * exts_w_rm_rn: rn = (int16_t) rm
142     * extu_w_rm_rn: rn = (uint16_t) rm
143     *
144 dpavlin 30 * arg[0] = ptr to rm
145     * arg[1] = ptr to rn
146     */
147 dpavlin 32 X(mov_rm_rn) { reg(ic->arg[1]) = reg(ic->arg[0]); }
148     X(not_rm_rn) { reg(ic->arg[1]) = ~reg(ic->arg[0]); }
149     X(neg_rm_rn) { reg(ic->arg[1]) = -reg(ic->arg[0]); }
150     X(negc_rm_rn)
151 dpavlin 30 {
152 dpavlin 32 uint64_t res = 0;
153     res -= (uint64_t) reg(ic->arg[0]);
154     if (cpu->cd.sh.sr & SH_SR_T)
155     res --;
156     if ((res >> 32) & 1)
157     cpu->cd.sh.sr |= SH_SR_T;
158     else
159     cpu->cd.sh.sr &= ~SH_SR_T;
160     reg(ic->arg[1]) = (uint32_t) res;
161 dpavlin 30 }
162 dpavlin 32 X(swap_b_rm_rn)
163     {
164     uint32_t r = reg(ic->arg[0]);
165     reg(ic->arg[1]) = (r & 0xffff0000) | ((r >> 8)&0xff) | ((r&0xff) << 8);
166     }
167     X(swap_w_rm_rn)
168     {
169     uint32_t r = reg(ic->arg[0]);
170     reg(ic->arg[1]) = (r >> 16) | (r << 16);
171     }
172     X(exts_b_rm_rn) { reg(ic->arg[1]) = (int8_t)reg(ic->arg[0]); }
173     X(extu_b_rm_rn) { reg(ic->arg[1]) = (uint8_t)reg(ic->arg[0]); }
174     X(exts_w_rm_rn) { reg(ic->arg[1]) = (int16_t)reg(ic->arg[0]); }
175     X(extu_w_rm_rn) { reg(ic->arg[1]) = (uint16_t)reg(ic->arg[0]); }
176 dpavlin 30
177    
178     /*
179 dpavlin 32 * and_imm_r0: r0 &= imm
180     * xor_imm_r0: r0 ^= imm
181     * tst_imm_r0: t = (r0 & imm) == 0
182     * or_imm_r0: r0 |= imm
183 dpavlin 30 *
184 dpavlin 32 * arg[0] = imm
185     */
186     X(and_imm_r0) { cpu->cd.sh.r[0] &= ic->arg[0]; }
187     X(xor_imm_r0) { cpu->cd.sh.r[0] ^= ic->arg[0]; }
188     X(or_imm_r0) { cpu->cd.sh.r[0] |= ic->arg[0]; }
189     X(tst_imm_r0)
190     {
191     if (cpu->cd.sh.r[0] & ic->arg[0])
192     cpu->cd.sh.sr &= ~SH_SR_T;
193     else
194     cpu->cd.sh.sr |= SH_SR_T;
195     }
196    
197    
198     /*
199     * mov_imm_rn: Set rn to a signed 8-bit value
200     * add_imm_rn: Add a signed 8-bit value to Rn
201     *
202 dpavlin 30 * arg[0] = int8_t imm, extended to at least int32_t
203     * arg[1] = ptr to rn
204     */
205 dpavlin 32 X(mov_imm_rn) { reg(ic->arg[1]) = (int32_t)ic->arg[0]; }
206     X(add_imm_rn) { reg(ic->arg[1]) += (int32_t)ic->arg[0]; }
207    
208    
209     /*
210     * mov_b_rm_predec_rn: mov.b reg,@-Rn
211     * mov_w_rm_predec_rn: mov.w reg,@-Rn
212     * mov_l_rm_predec_rn: mov.l reg,@-Rn
213     * stc_l_rm_predec_rn: mov.l reg,@-Rn, with MD status bit check
214     *
215     * arg[0] = ptr to rm (or other register)
216     * arg[1] = ptr to rn
217     */
218     X(mov_b_rm_predec_rn)
219 dpavlin 30 {
220 dpavlin 32 uint32_t addr = reg(ic->arg[1]) - sizeof(uint8_t);
221     int8_t *p = (int8_t *) cpu->cd.sh.host_store[addr >> 12];
222     int8_t data = reg(ic->arg[0]);
223     if (p != NULL) {
224     p[addr & 0xfff] = data;
225     reg(ic->arg[1]) = addr;
226     } else {
227     SYNCH_PC;
228     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
229     sizeof(data), MEM_WRITE, CACHE_DATA)) {
230     /* Exception. */
231     return;
232     }
233     /* The store was ok: */
234     reg(ic->arg[1]) = addr;
235     }
236 dpavlin 30 }
237 dpavlin 32 X(mov_w_rm_predec_rn)
238     {
239     uint32_t addr = reg(ic->arg[1]) - sizeof(uint16_t);
240     uint16_t *p = (uint16_t *) cpu->cd.sh.host_store[addr >> 12];
241     uint16_t data = reg(ic->arg[0]);
242 dpavlin 30
243 dpavlin 32 if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
244     data = LE16_TO_HOST(data);
245     else
246     data = BE16_TO_HOST(data);
247 dpavlin 30
248 dpavlin 32 if (p != NULL) {
249     p[(addr & 0xfff) >> 1] = data;
250     reg(ic->arg[1]) = addr;
251     } else {
252     SYNCH_PC;
253     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
254     sizeof(data), MEM_WRITE, CACHE_DATA)) {
255     /* Exception. */
256     return;
257     }
258     /* The store was ok: */
259     reg(ic->arg[1]) = addr;
260     }
261     }
262     X(mov_l_rm_predec_rn)
263     {
264     uint32_t addr = reg(ic->arg[1]) - sizeof(uint32_t);
265     uint32_t *p = (uint32_t *) cpu->cd.sh.host_store[addr >> 12];
266     uint32_t data = reg(ic->arg[0]);
267    
268     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
269     data = LE32_TO_HOST(data);
270     else
271     data = BE32_TO_HOST(data);
272    
273     if (p != NULL) {
274     p[(addr & 0xfff) >> 2] = data;
275     reg(ic->arg[1]) = addr;
276     } else {
277     SYNCH_PC;
278     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
279     sizeof(data), MEM_WRITE, CACHE_DATA)) {
280     /* Exception. */
281     return;
282     }
283     /* The store was ok: */
284     reg(ic->arg[1]) = addr;
285     }
286     }
287     X(stc_l_rm_predec_rn)
288     {
289     uint32_t addr = reg(ic->arg[1]) - sizeof(uint32_t);
290     uint32_t *p = (uint32_t *) cpu->cd.sh.host_store[addr >> 12];
291     uint32_t data = reg(ic->arg[0]);
292    
293     RES_INST_IF_NOT_MD;
294    
295     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
296     data = LE32_TO_HOST(data);
297     else
298     data = BE32_TO_HOST(data);
299    
300     if (p != NULL) {
301     p[(addr & 0xfff) >> 2] = data;
302     reg(ic->arg[1]) = addr;
303     } else {
304     SYNCH_PC;
305     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
306     sizeof(data), MEM_WRITE, CACHE_DATA)) {
307     /* Exception. */
308     return;
309     }
310     /* The store was ok: */
311     reg(ic->arg[1]) = addr;
312     }
313     }
314    
315    
316 dpavlin 30 /*
317 dpavlin 32 * mov_l_disp_pc_rn: Load a 32-bit value into a register,
318     * from an immediate address relative to the pc.
319 dpavlin 30 *
320     * arg[0] = offset from beginning of the current pc's page
321     * arg[1] = ptr to rn
322     */
323     X(mov_l_disp_pc_rn)
324     {
325 dpavlin 32 uint32_t addr = ic->arg[0] + (cpu->pc &
326 dpavlin 30 ~((SH_IC_ENTRIES_PER_PAGE-1) << SH_INSTR_ALIGNMENT_SHIFT));
327 dpavlin 32 uint32_t *p = (uint32_t *) cpu->cd.sh.host_load[addr >> 12];
328     uint32_t data;
329    
330     if (p != NULL) {
331     data = p[(addr & 0xfff) >> 2];
332     } else {
333     SYNCH_PC;
334     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
335     sizeof(data), MEM_READ, CACHE_DATA)) {
336     /* Exception. */
337     return;
338     }
339     }
340     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
341     data = LE32_TO_HOST(data);
342     else
343     data = BE32_TO_HOST(data);
344     reg(ic->arg[1]) = data;
345 dpavlin 30 }
346    
347    
348     /*
349 dpavlin 32 * mova_r0: Set r0 to an address close to the program counter.
350 dpavlin 30 *
351 dpavlin 32 * arg[0] = relative offset from beginning of the current pc's page
352     */
353     X(mova_r0)
354     {
355     cpu->cd.sh.r[0] = ic->arg[0] + (cpu->pc &
356     ~((SH_IC_ENTRIES_PER_PAGE-1) << SH_INSTR_ALIGNMENT_SHIFT));
357     }
358    
359    
360     /*
361     * mov_w_disp_pc_rn: Load a 16-bit value into a register,
362     * from an immediate address relative to the pc.
363     *
364     * arg[0] = offset from beginning of the current pc's page
365     * arg[1] = ptr to rn
366     */
367     X(mov_w_disp_pc_rn)
368     {
369     uint32_t addr = ic->arg[0] + (cpu->pc &
370     ~((SH_IC_ENTRIES_PER_PAGE-1) << SH_INSTR_ALIGNMENT_SHIFT));
371     uint16_t *p = (uint16_t *) cpu->cd.sh.host_load[addr >> 12];
372     uint16_t data;
373    
374     if (p != NULL) {
375     data = p[(addr & 0xfff) >> 1];
376     } else {
377     SYNCH_PC;
378     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
379     sizeof(data), MEM_READ, CACHE_DATA)) {
380     /* Exception. */
381     return;
382     }
383     }
384    
385     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
386     data = LE16_TO_HOST(data);
387     else
388     data = BE16_TO_HOST(data);
389    
390     reg(ic->arg[1]) = (int16_t)data;
391     }
392    
393    
394     /*
395     * load_b_rm_rn: Load an int8_t value into Rn from address Rm.
396     * load_w_rm_rn: Load an int16_t value into Rn from address Rm.
397     * load_l_rm_rn: Load a 32-bit value into Rn from address Rm.
398     * fmov_rm_frn: Load a floating point value into FRn from address Rm.
399     * fmov_r0_rm_frn: Load a floating point value into FRn from address R0+Rm.
400     * fmov_rm_postinc_frn: Load a floating point value into FRn from address Rm.
401     * mov_b_r0_rm_rn: Load an int8_t value into Rn from address Rm + R0.
402     * mov_w_r0_rm_rn: Load an int16_t value into Rn from address Rm + R0.
403     * mov_l_r0_rm_rn: Load a 32-bit value into Rn from address Rm + R0.
404     * mov_l_disp_rm_rn: Load a 32-bit value into Rn from address Rm + disp.
405     * mov_b_disp_rn_r0: Load an int8_t from Rn+disp into R0.
406     * mov_w_disp_rn_r0: Load an int16_t from Rn+disp into R0.
407     * mov_b_disp_gbr_r0: Load an int8_t from GBR+disp into R0.
408     * mov_w_disp_gbr_r0: Load an int16_t from GBR+disp into R0.
409     * mov_l_disp_gbr_r0: Load an int32_t from GBR+disp into R0.
410     * mov_b_arg1_postinc_to_arg0:
411     * mov_w_arg1_postinc_to_arg0:
412     * mov_l_arg1_postinc_to_arg0:
413     * mov_l_arg1_postinc_to_arg0_md: With MD (privilege level) check.
414     * mov_l_arg1_postinc_to_arg0_fp: With FP check.
415     *
416     * arg[0] = ptr to rm (or rm + (lo4 << 4) for disp)
417     * arg[1] = ptr to rn
418     */
419     X(load_b_rm_rn)
420     {
421     uint32_t addr = reg(ic->arg[0]);
422     uint8_t *p = (uint8_t *) cpu->cd.sh.host_load[addr >> 12];
423     uint8_t data;
424    
425     if (p != NULL) {
426     data = p[addr & 0xfff];
427     } else {
428     SYNCH_PC;
429     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
430     sizeof(data), MEM_READ, CACHE_DATA)) {
431     /* Exception. */
432     return;
433     }
434     }
435     reg(ic->arg[1]) = (int8_t) data;
436     }
437     X(load_w_rm_rn)
438     {
439     uint32_t addr = reg(ic->arg[0]);
440     int16_t *p = (int16_t *) cpu->cd.sh.host_load[addr >> 12];
441     int16_t data;
442    
443     if (p != NULL) {
444     data = p[(addr & 0xfff) >> 1];
445     } else {
446     SYNCH_PC;
447     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
448     sizeof(data), MEM_READ, CACHE_DATA)) {
449     /* Exception. */
450     return;
451     }
452     }
453     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
454     data = LE16_TO_HOST(data);
455     else
456     data = BE16_TO_HOST(data);
457     reg(ic->arg[1]) = data;
458     }
459     X(load_l_rm_rn)
460     {
461     uint32_t addr = reg(ic->arg[0]);
462     uint32_t *p = (uint32_t *) cpu->cd.sh.host_load[addr >> 12];
463     uint32_t data;
464    
465     if (p != NULL) {
466     data = p[(addr & 0xfff) >> 2];
467     } else {
468     SYNCH_PC;
469     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
470     sizeof(data), MEM_READ, CACHE_DATA)) {
471     /* Exception. */
472     return;
473     }
474     }
475    
476     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
477     data = LE32_TO_HOST(data);
478     else
479     data = BE32_TO_HOST(data);
480     reg(ic->arg[1]) = data;
481     }
482     X(fmov_rm_frn)
483     {
484     uint32_t addr = reg(ic->arg[0]);
485     uint32_t *p = (uint32_t *) cpu->cd.sh.host_load[addr >> 12];
486     uint32_t data;
487    
488     FLOATING_POINT_AVAILABLE_CHECK;
489    
490     if (cpu->cd.sh.fpscr & SH_FPSCR_SZ) {
491     fatal("fmov_rm_frn: sz=1 (register pair): TODO\n");
492     exit(1);
493     }
494    
495     if (p != NULL) {
496     data = p[(addr & 0xfff) >> 2];
497     } else {
498     SYNCH_PC;
499     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
500     sizeof(data), MEM_READ, CACHE_DATA)) {
501     /* Exception. */
502     return;
503     }
504     }
505    
506     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
507     data = LE32_TO_HOST(data);
508     else
509     data = BE32_TO_HOST(data);
510    
511     reg(ic->arg[1]) = data;
512     }
513     X(fmov_r0_rm_frn)
514     {
515     uint32_t data, addr = reg(ic->arg[0]) + cpu->cd.sh.r[0];
516     uint32_t *p = (uint32_t *) cpu->cd.sh.host_load[addr >> 12];
517    
518     FLOATING_POINT_AVAILABLE_CHECK;
519    
520     if (cpu->cd.sh.fpscr & SH_FPSCR_SZ) {
521     fatal("fmov_rm_frn: sz=1 (register pair): TODO\n");
522     exit(1);
523     }
524    
525     if (p != NULL) {
526     data = p[(addr & 0xfff) >> 2];
527     } else {
528     SYNCH_PC;
529     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
530     sizeof(data), MEM_READ, CACHE_DATA)) {
531     /* Exception. */
532     return;
533     }
534     }
535    
536     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
537     data = LE32_TO_HOST(data);
538     else
539     data = BE32_TO_HOST(data);
540    
541     reg(ic->arg[1]) = data;
542     }
543     X(fmov_rm_postinc_frn)
544     {
545     int d = cpu->cd.sh.fpscr & SH_FPSCR_SZ;
546     uint32_t data, data2, addr = reg(ic->arg[0]);
547     uint32_t *p = (uint32_t *) cpu->cd.sh.host_load[addr >> 12];
548     size_t r1 = ic->arg[1];
549    
550     if (d) {
551     /* xd instead of dr? */
552     int ofs = (r1 - (size_t)&cpu->cd.sh.fr[0]) / sizeof(uint32_t);
553     if (ofs & 1)
554     r1 = (size_t)&cpu->cd.sh.xf[ofs & ~1];
555     }
556    
557     FLOATING_POINT_AVAILABLE_CHECK;
558    
559     if (p != NULL) {
560     data = p[(addr & 0xfff) >> 2];
561     } else {
562     SYNCH_PC;
563     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
564     sizeof(data), MEM_READ, CACHE_DATA)) {
565     /* Exception. */
566     return;
567     }
568     }
569    
570     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
571     data = LE32_TO_HOST(data);
572     else
573     data = BE32_TO_HOST(data);
574    
575     if (d) {
576     /* Double-precision load: */
577     addr += 4;
578     SYNCH_PC;
579     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned
580     char *)&data2, sizeof(data2), MEM_READ, CACHE_DATA))
581     return;
582    
583     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
584     data2 = LE32_TO_HOST(data2);
585     else
586     data2 = BE32_TO_HOST(data2);
587     reg(r1 + 4) = data2;
588     }
589    
590     reg(r1) = data;
591     reg(ic->arg[0]) = addr + sizeof(uint32_t);
592     }
593     X(mov_b_disp_gbr_r0)
594     {
595     uint32_t addr = cpu->cd.sh.gbr + ic->arg[1];
596     int8_t *p = (int8_t *) cpu->cd.sh.host_load[addr >> 12];
597     int8_t data;
598     if (p != NULL) {
599     data = p[addr & 0xfff];
600     } else {
601     SYNCH_PC;
602     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
603     sizeof(data), MEM_READ, CACHE_DATA)) {
604     /* Exception. */
605     return;
606     }
607     }
608     cpu->cd.sh.r[0] = data;
609     }
610     X(mov_w_disp_gbr_r0)
611     {
612     uint32_t addr = cpu->cd.sh.gbr + ic->arg[1];
613     int16_t *p = (int16_t *) cpu->cd.sh.host_load[addr >> 12];
614     int16_t data;
615     if (p != NULL) {
616     data = p[(addr & 0xfff) >> 1];
617     } else {
618     SYNCH_PC;
619     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
620     sizeof(data), MEM_READ, CACHE_DATA)) {
621     /* Exception. */
622     return;
623     }
624     }
625     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
626     data = LE16_TO_HOST(data);
627     else
628     data = BE16_TO_HOST(data);
629     cpu->cd.sh.r[0] = data;
630     }
631     X(mov_l_disp_gbr_r0)
632     {
633     uint32_t addr = cpu->cd.sh.gbr + ic->arg[1];
634     uint32_t *p = (uint32_t *) cpu->cd.sh.host_load[addr >> 12];
635     uint32_t data;
636     if (p != NULL) {
637     data = p[(addr & 0xfff) >> 2];
638     } else {
639     SYNCH_PC;
640     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
641     sizeof(data), MEM_READ, CACHE_DATA)) {
642     /* Exception. */
643     return;
644     }
645     }
646     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
647     data = LE32_TO_HOST(data);
648     else
649     data = BE32_TO_HOST(data);
650     cpu->cd.sh.r[0] = data;
651     }
652     X(mov_b_arg1_postinc_to_arg0)
653     {
654     uint32_t addr = reg(ic->arg[1]);
655     int8_t *p = (int8_t *) cpu->cd.sh.host_load[addr >> 12];
656     int8_t data;
657     if (p != NULL) {
658     data = p[addr & 0xfff];
659     } else {
660     SYNCH_PC;
661     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
662     sizeof(data), MEM_READ, CACHE_DATA)) {
663     /* Exception. */
664     return;
665     }
666     }
667     /* The load was ok: */
668     reg(ic->arg[1]) = addr + sizeof(int8_t);
669     reg(ic->arg[0]) = data;
670     }
671     X(mov_w_arg1_postinc_to_arg0)
672     {
673     uint32_t addr = reg(ic->arg[1]);
674     uint16_t *p = (uint16_t *) cpu->cd.sh.host_load[addr >> 12];
675     uint16_t data;
676    
677     if (p != NULL) {
678     data = p[(addr & 0xfff) >> 1];
679     } else {
680     SYNCH_PC;
681     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
682     sizeof(data), MEM_READ, CACHE_DATA)) {
683     /* Exception. */
684     return;
685     }
686     }
687    
688     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
689     data = LE16_TO_HOST(data);
690     else
691     data = BE16_TO_HOST(data);
692     reg(ic->arg[1]) = addr + sizeof(data);
693     reg(ic->arg[0]) = (int16_t)data;
694     }
695     X(mov_l_arg1_postinc_to_arg0)
696     {
697     uint32_t addr = reg(ic->arg[1]);
698     uint32_t *p = (uint32_t *) cpu->cd.sh.host_load[addr >> 12];
699     uint32_t data;
700    
701     if (p != NULL) {
702     data = p[(addr & 0xfff) >> 2];
703     } else {
704     SYNCH_PC;
705     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
706     sizeof(data), MEM_READ, CACHE_DATA)) {
707     /* Exception. */
708     return;
709     }
710     }
711     /* The load was ok: */
712     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
713     data = LE32_TO_HOST(data);
714     else
715     data = BE32_TO_HOST(data);
716     reg(ic->arg[1]) = addr + sizeof(data);
717     reg(ic->arg[0]) = data;
718     }
719     X(mov_l_arg1_postinc_to_arg0_md)
720     {
721     uint32_t addr = reg(ic->arg[1]);
722     uint32_t *p = (uint32_t *) cpu->cd.sh.host_load[addr >> 12];
723     uint32_t data;
724    
725     RES_INST_IF_NOT_MD;
726    
727     if (p != NULL) {
728     data = p[(addr & 0xfff) >> 2];
729     } else {
730     SYNCH_PC;
731     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
732     sizeof(data), MEM_READ, CACHE_DATA)) {
733     /* Exception. */
734     return;
735     }
736     }
737     /* The load was ok: */
738     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
739     data = LE32_TO_HOST(data);
740     else
741     data = BE32_TO_HOST(data);
742     reg(ic->arg[1]) = addr + sizeof(data);
743     reg(ic->arg[0]) = data;
744     }
745     X(mov_l_arg1_postinc_to_arg0_fp)
746     {
747     uint32_t addr = reg(ic->arg[1]);
748     uint32_t *p = (uint32_t *) cpu->cd.sh.host_load[addr >> 12];
749     uint32_t data;
750    
751     FLOATING_POINT_AVAILABLE_CHECK;
752    
753     if (p != NULL) {
754     data = p[(addr & 0xfff) >> 2];
755     } else {
756     SYNCH_PC;
757     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
758     sizeof(data), MEM_READ, CACHE_DATA)) {
759     /* Exception. */
760     return;
761     }
762     }
763     /* The load was ok: */
764     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
765     data = LE32_TO_HOST(data);
766     else
767     data = BE32_TO_HOST(data);
768     reg(ic->arg[1]) = addr + sizeof(data);
769    
770     if (ic->arg[0] == (size_t)cpu->cd.sh.fpscr)
771     sh_update_fpscr(cpu, data);
772     else
773     reg(ic->arg[0]) = data;
774     }
775     X(mov_b_r0_rm_rn)
776     {
777     uint32_t addr = reg(ic->arg[0]) + cpu->cd.sh.r[0];
778     int8_t *p = (int8_t *) cpu->cd.sh.host_load[addr >> 12];
779     int8_t data;
780    
781     if (p != NULL) {
782     data = p[addr & 0xfff];
783     } else {
784     SYNCH_PC;
785     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
786     sizeof(data), MEM_READ, CACHE_DATA)) {
787     /* Exception. */
788     return;
789     }
790     }
791    
792     reg(ic->arg[1]) = data;
793     }
794     X(mov_w_r0_rm_rn)
795     {
796     uint32_t addr = reg(ic->arg[0]) + cpu->cd.sh.r[0];
797     int16_t *p = (int16_t *) cpu->cd.sh.host_load[addr >> 12];
798     int16_t data;
799    
800     if (p != NULL) {
801     data = p[(addr & 0xfff) >> 1];
802     } else {
803     SYNCH_PC;
804     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
805     sizeof(data), MEM_READ, CACHE_DATA)) {
806     /* Exception. */
807     return;
808     }
809     }
810    
811     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
812     data = LE16_TO_HOST(data);
813     else
814     data = BE16_TO_HOST(data);
815     reg(ic->arg[1]) = data;
816     }
817     X(mov_l_r0_rm_rn)
818     {
819     uint32_t addr = reg(ic->arg[0]) + cpu->cd.sh.r[0];
820     uint32_t *p = (uint32_t *) cpu->cd.sh.host_load[addr >> 12];
821     uint32_t data;
822    
823     if (p != NULL) {
824     data = p[(addr & 0xfff) >> 2];
825     } else {
826     SYNCH_PC;
827     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
828     sizeof(data), MEM_READ, CACHE_DATA)) {
829     /* Exception. */
830     return;
831     }
832     }
833    
834     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
835     data = LE32_TO_HOST(data);
836     else
837     data = BE32_TO_HOST(data);
838     reg(ic->arg[1]) = data;
839     }
840     X(mov_l_disp_rm_rn)
841     {
842     uint32_t addr = cpu->cd.sh.r[ic->arg[0] & 0xf] +
843     ((ic->arg[0] >> 4) << 2);
844     uint32_t *p = (uint32_t *) cpu->cd.sh.host_load[addr >> 12];
845     uint32_t data;
846    
847     if (p != NULL) {
848     data = p[(addr & 0xfff) >> 2];
849     } else {
850     SYNCH_PC;
851     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
852     sizeof(data), MEM_READ, CACHE_DATA)) {
853     /* Exception. */
854     return;
855     }
856     }
857    
858     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
859     data = LE32_TO_HOST(data);
860     else
861     data = BE32_TO_HOST(data);
862     reg(ic->arg[1]) = data;
863     }
864     X(mov_b_disp_rn_r0)
865     {
866     uint32_t addr = reg(ic->arg[0]) + ic->arg[1];
867     uint8_t *p = (uint8_t *) cpu->cd.sh.host_load[addr >> 12];
868     uint8_t data;
869    
870     if (p != NULL) {
871     data = p[addr & 0xfff];
872     } else {
873     SYNCH_PC;
874     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
875     sizeof(data), MEM_READ, CACHE_DATA)) {
876     /* Exception. */
877     return;
878     }
879     }
880    
881     cpu->cd.sh.r[0] = (int8_t) data;
882     }
883     X(mov_w_disp_rn_r0)
884     {
885     uint32_t addr = reg(ic->arg[0]) + ic->arg[1];
886     uint16_t *p = (uint16_t *) cpu->cd.sh.host_load[addr >> 12];
887     uint16_t data;
888    
889     if (p != NULL) {
890     data = p[(addr & 0xfff) >> 1];
891     } else {
892     SYNCH_PC;
893     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
894     sizeof(data), MEM_READ, CACHE_DATA)) {
895     /* Exception. */
896     return;
897     }
898     }
899    
900     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
901     data = LE16_TO_HOST(data);
902     else
903     data = BE16_TO_HOST(data);
904     cpu->cd.sh.r[0] = (int16_t) data;
905     }
906    
907    
908     /*
909     * mov_b_store_rm_rn: Store Rm to address Rn (8-bit).
910     * mov_w_store_rm_rn: Store Rm to address Rn (16-bit).
911     * mov_l_store_rm_rn: Store Rm to address Rn (32-bit).
912     * fmov_frm_rn: Store FRm to address Rn.
913     * fmov_frm_r0_rn: Store FRm to address R0 + Rn.
914     * fmov_frm_predec_rn: Store FRm to address Rn - 4 (or 8), update Rn.
915     * mov_b_rm_r0_rn: Store Rm to address Rn + R0 (8-bit).
916     * mov_w_rm_r0_rn: Store Rm to address Rn + R0 (16-bit).
917     * mov_l_rm_r0_rn: Store Rm to address Rn + R0 (32-bit).
918     * mov_b_r0_disp_gbr: Store R0 to address disp + GBR (8-bit).
919     * mov_w_r0_disp_gbr: Store R0 to address disp + GBR (16-bit).
920     * mov_l_r0_disp_gbr: Store R0 to address disp + GBR (32-bit).
921     * mov_l_rm_disp_rn: Store Rm to address disp + Rn.
922     * mov_b_r0_disp_rn: Store R0 to address disp + Rn (8-bit).
923     * mov_w_r0_disp_rn: Store R0 to address disp + Rn (16-bit).
924     *
925 dpavlin 30 * arg[0] = ptr to rm
926 dpavlin 32 * arg[1] = ptr to rn (or Rn+(disp<<4) for mov_l_rm_disp_rn)
927     * (or disp for mov_*_r0_disp_gbr)
928     */
929     X(mov_b_store_rm_rn)
930     {
931     uint32_t addr = reg(ic->arg[1]);
932     uint8_t *p = (uint8_t *) cpu->cd.sh.host_store[addr >> 12];
933     uint8_t data = reg(ic->arg[0]);
934    
935     if (p != NULL) {
936     p[addr & 0xfff] = data;
937     } else {
938     SYNCH_PC;
939     if (!cpu->memory_rw(cpu, cpu->mem, addr, &data,
940     sizeof(data), MEM_WRITE, CACHE_DATA)) {
941     /* Exception. */
942     return;
943     }
944     }
945     }
946     X(mov_w_store_rm_rn)
947     {
948     uint32_t addr = reg(ic->arg[1]);
949     uint16_t *p = (uint16_t *) cpu->cd.sh.host_store[addr >> 12];
950     uint16_t data = reg(ic->arg[0]);
951    
952     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
953     data = LE16_TO_HOST(data);
954     else
955     data = BE16_TO_HOST(data);
956    
957     if (p != NULL) {
958     p[(addr & 0xfff) >> 1] = data;
959     } else {
960     SYNCH_PC;
961     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
962     sizeof(data), MEM_WRITE, CACHE_DATA)) {
963     /* Exception. */
964     return;
965     }
966     }
967     }
968     X(mov_l_store_rm_rn)
969     {
970     uint32_t addr = reg(ic->arg[1]);
971     uint32_t *p = (uint32_t *) cpu->cd.sh.host_store[addr >> 12];
972     uint32_t data = reg(ic->arg[0]);
973    
974     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
975     data = LE32_TO_HOST(data);
976     else
977     data = BE32_TO_HOST(data);
978    
979     if (p != NULL) {
980     p[(addr & 0xfff) >> 2] = data;
981     } else {
982     SYNCH_PC;
983     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
984     sizeof(data), MEM_WRITE, CACHE_DATA)) {
985     /* Exception. */
986     return;
987     }
988     }
989     }
990     X(fmov_frm_rn)
991     {
992     uint32_t addr = reg(ic->arg[1]);
993     uint32_t *p = (uint32_t *) cpu->cd.sh.host_store[addr >> 12];
994     uint32_t data = reg(ic->arg[0]);
995    
996     FLOATING_POINT_AVAILABLE_CHECK;
997    
998     if (cpu->cd.sh.fpscr & SH_FPSCR_SZ) {
999     fatal("fmov_frm_rn: sz=1 (register pair): TODO\n");
1000     exit(1);
1001     }
1002    
1003     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
1004     data = LE32_TO_HOST(data);
1005     else
1006     data = BE32_TO_HOST(data);
1007    
1008     if (p != NULL) {
1009     p[(addr & 0xfff) >> 2] = data;
1010     } else {
1011     SYNCH_PC;
1012     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
1013     sizeof(data), MEM_WRITE, CACHE_DATA)) {
1014     /* Exception. */
1015     return;
1016     }
1017     }
1018     }
1019     X(fmov_frm_r0_rn)
1020     {
1021     uint32_t addr = reg(ic->arg[1]) + cpu->cd.sh.r[0];
1022     uint32_t *p = (uint32_t *) cpu->cd.sh.host_store[addr >> 12];
1023     uint32_t data = reg(ic->arg[0]);
1024    
1025     FLOATING_POINT_AVAILABLE_CHECK;
1026    
1027     if (cpu->cd.sh.fpscr & SH_FPSCR_SZ) {
1028     fatal("fmov_frm_r0_rn: sz=1 (register pair): TODO\n");
1029     exit(1);
1030     }
1031    
1032     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
1033     data = LE32_TO_HOST(data);
1034     else
1035     data = BE32_TO_HOST(data);
1036    
1037     if (p != NULL) {
1038     p[(addr & 0xfff) >> 2] = data;
1039     } else {
1040     SYNCH_PC;
1041     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
1042     sizeof(data), MEM_WRITE, CACHE_DATA)) {
1043     /* Exception. */
1044     return;
1045     }
1046     }
1047     }
1048     X(fmov_frm_predec_rn)
1049     {
1050     int d = cpu->cd.sh.fpscr & SH_FPSCR_SZ? 1 : 0;
1051     uint32_t data, addr = reg(ic->arg[1]) - (d? 8 : 4);
1052     uint32_t *p = (uint32_t *) cpu->cd.sh.host_store[addr >> 12];
1053     size_t r0 = ic->arg[0];
1054    
1055     if (d) {
1056     /* xd instead of dr? */
1057     int ofs0 = (r0 - (size_t)&cpu->cd.sh.fr[0]) / sizeof(uint32_t);
1058     if (ofs0 & 1)
1059     r0 = (size_t)&cpu->cd.sh.xf[ofs0 & ~1];
1060     }
1061    
1062     data = reg(r0);
1063    
1064     FLOATING_POINT_AVAILABLE_CHECK;
1065    
1066     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
1067     data = LE32_TO_HOST(data);
1068     else
1069     data = BE32_TO_HOST(data);
1070    
1071     if (p != NULL) {
1072     p[(addr & 0xfff) >> 2] = data;
1073     } else {
1074     SYNCH_PC;
1075     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
1076     sizeof(data), MEM_WRITE, CACHE_DATA)) {
1077     /* Exception. */
1078     return;
1079     }
1080     }
1081    
1082     if (d) {
1083     /* Store second single-precision floating point word: */
1084     data = reg(r0 + 4);
1085     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
1086     data = LE32_TO_HOST(data);
1087     else
1088     data = BE32_TO_HOST(data);
1089     SYNCH_PC;
1090     if (!cpu->memory_rw(cpu, cpu->mem, addr + 4, (unsigned
1091     char *)&data, sizeof(data), MEM_WRITE, CACHE_DATA))
1092     return;
1093     }
1094    
1095     reg(ic->arg[1]) = addr;
1096     }
1097     X(mov_b_rm_r0_rn)
1098     {
1099     uint32_t addr = reg(ic->arg[1]) + cpu->cd.sh.r[0];
1100     int8_t *p = (int8_t *) cpu->cd.sh.host_store[addr >> 12];
1101     int8_t data = reg(ic->arg[0]);
1102     if (p != NULL) {
1103     p[addr & 0xfff] = data;
1104     } else {
1105     SYNCH_PC;
1106     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
1107     sizeof(data), MEM_WRITE, CACHE_DATA)) {
1108     /* Exception. */
1109     return;
1110     }
1111     }
1112     }
1113     X(mov_w_rm_r0_rn)
1114     {
1115     uint32_t addr = reg(ic->arg[1]) + cpu->cd.sh.r[0];
1116     uint16_t *p = (uint16_t *) cpu->cd.sh.host_store[addr >> 12];
1117     uint16_t data = reg(ic->arg[0]);
1118    
1119     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
1120     data = LE16_TO_HOST(data);
1121     else
1122     data = BE16_TO_HOST(data);
1123    
1124     if (p != NULL) {
1125     p[(addr & 0xfff) >> 1] = data;
1126     } else {
1127     SYNCH_PC;
1128     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
1129     sizeof(data), MEM_WRITE, CACHE_DATA)) {
1130     /* Exception. */
1131     return;
1132     }
1133     }
1134     }
1135     X(mov_l_rm_r0_rn)
1136     {
1137     uint32_t addr = reg(ic->arg[1]) + cpu->cd.sh.r[0];
1138     uint32_t *p = (uint32_t *) cpu->cd.sh.host_store[addr >> 12];
1139     uint32_t data = reg(ic->arg[0]);
1140    
1141     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
1142     data = LE32_TO_HOST(data);
1143     else
1144     data = BE32_TO_HOST(data);
1145    
1146     if (p != NULL) {
1147     p[(addr & 0xfff) >> 2] = data;
1148     } else {
1149     SYNCH_PC;
1150     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
1151     sizeof(data), MEM_WRITE, CACHE_DATA)) {
1152     /* Exception. */
1153     return;
1154     }
1155     }
1156     }
1157     X(mov_b_r0_disp_gbr)
1158     {
1159     uint32_t addr = cpu->cd.sh.gbr + ic->arg[1];
1160     uint8_t *p = (uint8_t *) cpu->cd.sh.host_store[addr >> 12];
1161     uint8_t data = cpu->cd.sh.r[0];
1162     if (p != NULL) {
1163     p[addr & 0xfff] = data;
1164     } else {
1165     SYNCH_PC;
1166     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
1167     sizeof(data), MEM_WRITE, CACHE_DATA)) {
1168     /* Exception. */
1169     return;
1170     }
1171     }
1172     }
1173     X(mov_w_r0_disp_gbr)
1174     {
1175     uint32_t addr = cpu->cd.sh.gbr + ic->arg[1];
1176     uint16_t *p = (uint16_t *) cpu->cd.sh.host_store[addr >> 12];
1177     uint16_t data = cpu->cd.sh.r[0];
1178    
1179     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
1180     data = LE16_TO_HOST(data);
1181     else
1182     data = BE16_TO_HOST(data);
1183    
1184     if (p != NULL) {
1185     p[(addr & 0xfff) >> 1] = data;
1186     } else {
1187     SYNCH_PC;
1188     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
1189     sizeof(data), MEM_WRITE, CACHE_DATA)) {
1190     /* Exception. */
1191     return;
1192     }
1193     }
1194     }
1195     X(mov_l_r0_disp_gbr)
1196     {
1197     uint32_t addr = cpu->cd.sh.gbr + ic->arg[1];
1198     uint32_t *p = (uint32_t *) cpu->cd.sh.host_store[addr >> 12];
1199     uint32_t data = cpu->cd.sh.r[0];
1200    
1201     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
1202     data = LE32_TO_HOST(data);
1203     else
1204     data = BE32_TO_HOST(data);
1205    
1206     if (p != NULL) {
1207     p[(addr & 0xfff) >> 2] = data;
1208     } else {
1209     SYNCH_PC;
1210     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
1211     sizeof(data), MEM_WRITE, CACHE_DATA)) {
1212     /* Exception. */
1213     return;
1214     }
1215     }
1216     }
1217     X(mov_l_rm_disp_rn)
1218     {
1219     uint32_t addr = cpu->cd.sh.r[ic->arg[1] & 0xf] +
1220     ((ic->arg[1] >> 4) << 2);
1221     uint32_t *p = (uint32_t *) cpu->cd.sh.host_store[addr >> 12];
1222     uint32_t data = reg(ic->arg[0]);
1223    
1224     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
1225     data = LE32_TO_HOST(data);
1226     else
1227     data = BE32_TO_HOST(data);
1228    
1229     if (p != NULL) {
1230     p[(addr & 0xfff) >> 2] = data;
1231     } else {
1232     SYNCH_PC;
1233     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
1234     sizeof(data), MEM_WRITE, CACHE_DATA)) {
1235     /* Exception. */
1236     return;
1237     }
1238     }
1239     }
1240     X(mov_b_r0_disp_rn)
1241     {
1242     uint32_t addr = reg(ic->arg[0]) + ic->arg[1];
1243     uint8_t *p = (uint8_t *) cpu->cd.sh.host_store[addr >> 12];
1244     uint8_t data = cpu->cd.sh.r[0];
1245    
1246     if (p != NULL) {
1247     p[addr & 0xfff] = data;
1248     } else {
1249     SYNCH_PC;
1250     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
1251     sizeof(data), MEM_WRITE, CACHE_DATA)) {
1252     /* Exception. */
1253     return;
1254     }
1255     }
1256     }
1257     X(mov_w_r0_disp_rn)
1258     {
1259     uint32_t addr = reg(ic->arg[0]) + ic->arg[1];
1260     uint16_t *p = (uint16_t *) cpu->cd.sh.host_store[addr >> 12];
1261     uint16_t data = cpu->cd.sh.r[0];
1262    
1263     if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
1264     data = LE16_TO_HOST(data);
1265     else
1266     data = BE16_TO_HOST(data);
1267    
1268     if (p != NULL) {
1269     p[(addr & 0xfff) >> 1] = data;
1270     } else {
1271     SYNCH_PC;
1272     if (!cpu->memory_rw(cpu, cpu->mem, addr, (unsigned char *)&data,
1273     sizeof(data), MEM_WRITE, CACHE_DATA)) {
1274     /* Exception. */
1275     return;
1276     }
1277     }
1278     }
1279    
1280    
1281     /*
1282     * add_rm_rn: rn = rn + rm
1283     * addc_rm_rn: rn = rn + rm + t
1284     * and_rm_rn: rn = rn & rm
1285     * xor_rm_rn: rn = rn ^ rm
1286     * or_rm_rn: rn = rn | rm
1287     * sub_rm_rn: rn = rn - rm
1288     * subc_rm_rn: rn = rn - rm - t; t = borrow
1289     * tst_rm_rn: t = ((rm & rn) == 0)
1290     * xtrct_rm_rn: rn = (rn >> 16) | (rm << 16)
1291     *
1292     * arg[0] = ptr to rm
1293 dpavlin 30 * arg[1] = ptr to rn
1294     */
1295 dpavlin 32 X(add_rm_rn) { reg(ic->arg[1]) += reg(ic->arg[0]); }
1296     X(addc_rm_rn)
1297 dpavlin 30 {
1298 dpavlin 32 uint64_t res = reg(ic->arg[1]);
1299     res += (uint64_t) reg(ic->arg[0]);
1300     if (cpu->cd.sh.sr & SH_SR_T)
1301     res ++;
1302     if ((res >> 32) & 1)
1303     cpu->cd.sh.sr |= SH_SR_T;
1304     else
1305     cpu->cd.sh.sr &= ~SH_SR_T;
1306     reg(ic->arg[1]) = (uint32_t) res;
1307 dpavlin 30 }
1308 dpavlin 32 X(and_rm_rn) { reg(ic->arg[1]) &= reg(ic->arg[0]); }
1309     X(xor_rm_rn) { reg(ic->arg[1]) ^= reg(ic->arg[0]); }
1310     X(or_rm_rn) { reg(ic->arg[1]) |= reg(ic->arg[0]); }
1311     X(sub_rm_rn) { reg(ic->arg[1]) -= reg(ic->arg[0]); }
1312     X(subc_rm_rn)
1313     {
1314     uint64_t res = reg(ic->arg[1]);
1315     res -= (uint64_t) reg(ic->arg[0]);
1316     if (cpu->cd.sh.sr & SH_SR_T)
1317     res --;
1318     if ((res >> 32) & 1)
1319     cpu->cd.sh.sr |= SH_SR_T;
1320     else
1321     cpu->cd.sh.sr &= ~SH_SR_T;
1322     reg(ic->arg[1]) = (uint32_t) res;
1323     }
1324     X(tst_rm_rn)
1325     {
1326     if (reg(ic->arg[1]) & reg(ic->arg[0]))
1327     cpu->cd.sh.sr &= ~SH_SR_T;
1328     else
1329     cpu->cd.sh.sr |= SH_SR_T;
1330     }
1331     X(xtrct_rm_rn)
1332     {
1333     uint32_t rn = reg(ic->arg[1]), rm = reg(ic->arg[0]);
1334     reg(ic->arg[1]) = (rn >> 16) | (rm << 16);
1335     }
1336 dpavlin 30
1337    
1338     /*
1339 dpavlin 32 * div0u: Division step 0; prepare for unsigned division.
1340     * div0s_rm_rn: Division step 0; prepare for signed division.
1341     * div1_rm_rn: Division step 1.
1342 dpavlin 30 *
1343 dpavlin 32 * arg[0] = ptr to rm
1344     * arg[1] = ptr to rn
1345 dpavlin 30 */
1346 dpavlin 32 X(div0u)
1347     {
1348     cpu->cd.sh.sr &= ~(SH_SR_Q | SH_SR_M | SH_SR_T);
1349     }
1350     X(div0s_rm_rn)
1351     {
1352     int q = reg(ic->arg[1]) >> 31, m = reg(ic->arg[0]) >> 31;
1353     cpu->cd.sh.sr &= ~(SH_SR_Q | SH_SR_M | SH_SR_T);
1354     if (q)
1355     cpu->cd.sh.sr |= SH_SR_Q;
1356     if (m)
1357     cpu->cd.sh.sr |= SH_SR_M;
1358     if (m ^ q)
1359     cpu->cd.sh.sr |= SH_SR_T;
1360     }
1361     X(div1_rm_rn)
1362     {
1363     uint32_t q, old_q = (cpu->cd.sh.sr & SH_SR_Q)? 1 : 0;
1364     uint32_t m = (cpu->cd.sh.sr & SH_SR_M)? 1 : 0;
1365     uint32_t t = (cpu->cd.sh.sr & SH_SR_T)? 1 : 0;
1366     uint32_t op1 = reg(ic->arg[0]), op2 = reg(ic->arg[1]);
1367     uint64_t op2_64;
1368    
1369     q = op2 >> 31;
1370     op2_64 = (uint32_t) ((op2 << 1) + t);
1371     if (old_q == m)
1372     op2_64 -= (uint64_t)op1;
1373     else
1374     op2_64 += (uint64_t)op1;
1375     q ^= m ^ ((op2_64 >> 32) & 1);
1376     t = 1 - (q ^ m);
1377     cpu->cd.sh.sr &= ~(SH_SR_Q | SH_SR_T);
1378     if (q)
1379     cpu->cd.sh.sr |= SH_SR_Q;
1380     if (t)
1381     cpu->cd.sh.sr |= SH_SR_T;
1382     reg(ic->arg[1]) = (uint32_t) op2_64;
1383     }
1384    
1385    
1386     /*
1387     * mul_l_rm_rn: MACL = Rm * Rn (32-bit)
1388     * muls_w_rm_rn: MACL = Rm * Rn (signed 16-bit * 16-bit ==> 32-bit)
1389     * mulu_w_rm_rn: MACL = Rm * Rn (unsigned 16-bit * 16-bit ==> 32-bit)
1390     * dmuls_l_rm_rn: MACH:MACL = Rm * Rn (signed, 64-bit result)
1391     * dmulu_l_rm_rn: MACH:MACL = Rm * Rn (unsigned, 64-bit result)
1392     *
1393     * arg[0] = ptr to rm
1394     * arg[1] = ptr to rn
1395     */
1396     X(mul_l_rm_rn)
1397     {
1398     cpu->cd.sh.macl = reg(ic->arg[0]) * reg(ic->arg[1]);
1399     }
1400     X(muls_w_rm_rn)
1401     {
1402     cpu->cd.sh.macl = (int32_t)(int16_t)reg(ic->arg[0]) *
1403     (int32_t)(int16_t)reg(ic->arg[1]);
1404     }
1405     X(mulu_w_rm_rn)
1406     {
1407     cpu->cd.sh.macl = (int32_t)(uint16_t)reg(ic->arg[0]) *
1408     (int32_t)(uint16_t)reg(ic->arg[1]);
1409     }
1410     X(dmuls_l_rm_rn)
1411     {
1412     uint64_t rm = (int32_t)reg(ic->arg[0]), rn = (int32_t)reg(ic->arg[1]);
1413     uint64_t res = rm * rn;
1414     cpu->cd.sh.mach = (uint32_t) (res >> 32);
1415     cpu->cd.sh.macl = (uint32_t) res;
1416     }
1417     X(dmulu_l_rm_rn)
1418     {
1419     uint64_t rm = reg(ic->arg[0]), rn = reg(ic->arg[1]), res;
1420     res = rm * rn;
1421     cpu->cd.sh.mach = (uint32_t) (res >> 32);
1422     cpu->cd.sh.macl = (uint32_t) res;
1423     }
1424    
1425    
1426     /*
1427     * cmpeq_imm_r0: rn == int8_t immediate
1428     * cmpeq_rm_rn: rn == rm
1429     * cmphs_rm_rn: rn >= rm, unsigned
1430     * cmpge_rm_rn: rn >= rm, signed
1431     * cmphi_rm_rn: rn > rm, unsigned
1432     * cmpgt_rm_rn: rn > rm, signed
1433     * cmppz_rn: rn >= 0, signed
1434     * cmppl_rn: rn > 0, signed
1435     * cmp_str_rm_rn: t=1 if any bytes in rm and rn match, 0 otherwise
1436     *
1437     * arg[0] = ptr to rm (or imm, for cmpeq_imm_r0)
1438     * arg[1] = ptr to rn
1439     */
1440     X(cmpeq_imm_r0)
1441     {
1442     if (cpu->cd.sh.r[0] == (uint32_t)ic->arg[0])
1443     cpu->cd.sh.sr |= SH_SR_T;
1444     else
1445     cpu->cd.sh.sr &= ~SH_SR_T;
1446     }
1447     X(cmpeq_rm_rn)
1448     {
1449     if (reg(ic->arg[1]) == reg(ic->arg[0]))
1450     cpu->cd.sh.sr |= SH_SR_T;
1451     else
1452     cpu->cd.sh.sr &= ~SH_SR_T;
1453     }
1454     X(cmphs_rm_rn)
1455     {
1456     if (reg(ic->arg[1]) >= reg(ic->arg[0]))
1457     cpu->cd.sh.sr |= SH_SR_T;
1458     else
1459     cpu->cd.sh.sr &= ~SH_SR_T;
1460     }
1461     X(cmpge_rm_rn)
1462     {
1463     if ((int32_t)reg(ic->arg[1]) >= (int32_t)reg(ic->arg[0]))
1464     cpu->cd.sh.sr |= SH_SR_T;
1465     else
1466     cpu->cd.sh.sr &= ~SH_SR_T;
1467     }
1468     X(cmphi_rm_rn)
1469     {
1470     if (reg(ic->arg[1]) > reg(ic->arg[0]))
1471     cpu->cd.sh.sr |= SH_SR_T;
1472     else
1473     cpu->cd.sh.sr &= ~SH_SR_T;
1474     }
1475     X(cmpgt_rm_rn)
1476     {
1477     if ((int32_t)reg(ic->arg[1]) > (int32_t)reg(ic->arg[0]))
1478     cpu->cd.sh.sr |= SH_SR_T;
1479     else
1480     cpu->cd.sh.sr &= ~SH_SR_T;
1481     }
1482     X(cmppz_rn)
1483     {
1484     if ((int32_t)reg(ic->arg[1]) >= 0)
1485     cpu->cd.sh.sr |= SH_SR_T;
1486     else
1487     cpu->cd.sh.sr &= ~SH_SR_T;
1488     }
1489     X(cmppl_rn)
1490     {
1491     if ((int32_t)reg(ic->arg[1]) > 0)
1492     cpu->cd.sh.sr |= SH_SR_T;
1493     else
1494     cpu->cd.sh.sr &= ~SH_SR_T;
1495     }
1496     X(cmp_str_rm_rn)
1497     {
1498     uint32_t r0 = reg(ic->arg[0]), r1 = reg(ic->arg[1]);
1499     int t = 0;
1500     if ((r0 & 0xff000000) == (r1 & 0xff000000))
1501     t = 1;
1502     else if ((r0 & 0xff0000) == (r1 & 0xff0000))
1503     t = 1;
1504     else if ((r0 & 0xff00) == (r1 & 0xff00))
1505     t = 1;
1506     else if ((r0 & 0xff) == (r1 & 0xff))
1507     t = 1;
1508     if (t)
1509     cpu->cd.sh.sr |= SH_SR_T;
1510     else
1511     cpu->cd.sh.sr &= ~SH_SR_T;
1512     }
1513    
1514    
1515     /*
1516     * shll_rn: Shift rn left by 1 (t = bit that was shifted out)
1517     * shlr_rn: Shift rn right by 1 (t = bit that was shifted out)
1518     * rotl_rn: Shift rn left by 1 (t = bit that was shifted out)
1519     * rotr_rn: Shift rn right by 1 (t = bit that was shifted out)
1520     * shar_rn: Shift rn right arithmetically by 1 (t = bit that was shifted out)
1521     * shllX_rn: Shift rn left logically by X bits
1522     * shlrX_rn: Shift rn right logically by X bits
1523     * rotcl_rn: Rotate rn left via the t bit
1524     * rotcr_rn: Rotate rn right via the t bit
1525     * dt_rn: Decrease rn; t = (rn == 0)
1526     *
1527     * arg[1] = ptr to rn
1528     */
1529 dpavlin 30 X(shll_rn)
1530     {
1531 dpavlin 32 uint32_t rn = reg(ic->arg[1]);
1532 dpavlin 30 if (rn >> 31)
1533     cpu->cd.sh.sr |= SH_SR_T;
1534     else
1535     cpu->cd.sh.sr &= ~SH_SR_T;
1536 dpavlin 32 reg(ic->arg[1]) = rn << 1;
1537 dpavlin 30 }
1538 dpavlin 32 X(shlr_rn)
1539     {
1540     uint32_t rn = reg(ic->arg[1]);
1541     if (rn & 1)
1542     cpu->cd.sh.sr |= SH_SR_T;
1543     else
1544     cpu->cd.sh.sr &= ~SH_SR_T;
1545     reg(ic->arg[1]) = rn >> 1;
1546     }
1547     X(rotl_rn)
1548     {
1549     uint32_t rn = reg(ic->arg[1]);
1550     if (rn >> 31)
1551     cpu->cd.sh.sr |= SH_SR_T;
1552     else
1553     cpu->cd.sh.sr &= ~SH_SR_T;
1554     reg(ic->arg[1]) = (rn << 1) | (rn >> 31);
1555     }
1556     X(rotr_rn)
1557     {
1558     uint32_t rn = reg(ic->arg[1]);
1559     if (rn & 1)
1560     cpu->cd.sh.sr |= SH_SR_T;
1561     else
1562     cpu->cd.sh.sr &= ~SH_SR_T;
1563     reg(ic->arg[1]) = (rn >> 1) | (rn << 31);
1564     }
1565     X(shar_rn)
1566     {
1567     int32_t rn = reg(ic->arg[1]);
1568     if (rn & 1)
1569     cpu->cd.sh.sr |= SH_SR_T;
1570     else
1571     cpu->cd.sh.sr &= ~SH_SR_T;
1572     reg(ic->arg[1]) = rn >> 1;
1573     }
1574     X(rotcl_rn)
1575     {
1576     uint32_t rn = reg(ic->arg[1]), top;
1577     top = rn & 0x80000000;
1578     rn <<= 1;
1579     if (cpu->cd.sh.sr & SH_SR_T)
1580     rn ++;
1581     if (top)
1582     cpu->cd.sh.sr |= SH_SR_T;
1583     else
1584     cpu->cd.sh.sr &= ~SH_SR_T;
1585     reg(ic->arg[1]) = rn;
1586     }
1587     X(rotcr_rn)
1588     {
1589     uint32_t rn = reg(ic->arg[1]), bottom;
1590     bottom = rn & 1;
1591     rn >>= 1;
1592     if (cpu->cd.sh.sr & SH_SR_T)
1593     rn |= 0x80000000;
1594     if (bottom)
1595     cpu->cd.sh.sr |= SH_SR_T;
1596     else
1597     cpu->cd.sh.sr &= ~SH_SR_T;
1598     reg(ic->arg[1]) = rn;
1599     }
1600     X(dt_rn)
1601     {
1602     uint32_t rn = reg(ic->arg[1]) - 1;
1603     if (rn == 0)
1604     cpu->cd.sh.sr |= SH_SR_T;
1605     else
1606     cpu->cd.sh.sr &= ~SH_SR_T;
1607     reg(ic->arg[1]) = rn;
1608     }
1609     X(shll2_rn) { reg(ic->arg[1]) <<= 2; }
1610     X(shll8_rn) { reg(ic->arg[1]) <<= 8; }
1611     X(shll16_rn) { reg(ic->arg[1]) <<= 16; }
1612     X(shlr2_rn) { reg(ic->arg[1]) >>= 2; }
1613     X(shlr8_rn) { reg(ic->arg[1]) >>= 8; }
1614     X(shlr16_rn) { reg(ic->arg[1]) >>= 16; }
1615 dpavlin 30
1616    
1617     /*
1618 dpavlin 32 * shad: Shift Rn arithmetic left/right, as indicated by Rm. Result in Rn.
1619     * shld: Shift Rn logically left/right, as indicated by Rm. Result in Rn.
1620 dpavlin 30 *
1621 dpavlin 32 * arg[0] = ptr to rm
1622     * arg[1] = ptr to rn
1623 dpavlin 30 */
1624 dpavlin 32 X(shad)
1625 dpavlin 30 {
1626 dpavlin 32 int32_t rn = reg(ic->arg[1]);
1627     int32_t rm = reg(ic->arg[0]);
1628     int sa = rm & 0x1f;
1629    
1630     if (rm >= 0)
1631     rn <<= sa;
1632     else if (sa != 0)
1633     rn >>= (32 - sa);
1634     else if (rn < 0)
1635     rn = -1;
1636     else
1637     rn = 0;
1638    
1639     reg(ic->arg[1]) = rn;
1640     }
1641     X(shld)
1642     {
1643     uint32_t rn = reg(ic->arg[1]);
1644     int32_t rm = reg(ic->arg[0]);
1645     int sa = rm & 0x1f;
1646    
1647     if (rm >= 0)
1648     rn <<= sa;
1649     else if (sa != 0)
1650     rn >>= (32 - sa);
1651     else
1652     rn = 0;
1653    
1654     reg(ic->arg[1]) = rn;
1655     }
1656    
1657    
1658     /*
1659     * bra: Branch using PC relative immediace displacement (with delay-slot)
1660     * bsr: Like bra, but also sets PR to the return address
1661     * braf: Like bra, but using a register instead of an immediate
1662     * bsrf: Like braf, but also sets PR to the return address
1663     *
1664     * arg[0] = immediate offset relative to start of page
1665     * arg[1] = ptr to Rn (for braf/bsrf)
1666     */
1667     X(bra)
1668     {
1669     MODE_int_t target = cpu->pc & ~((SH_IC_ENTRIES_PER_PAGE-1) <<
1670     SH_INSTR_ALIGNMENT_SHIFT);
1671     target += ic->arg[0];
1672     cpu->delay_slot = TO_BE_DELAYED;
1673     ic[1].f(cpu, ic+1);
1674     cpu->n_translated_instrs ++;
1675     if (!(cpu->delay_slot & EXCEPTION_IN_DELAY_SLOT)) {
1676     cpu->pc = target;
1677     cpu->delay_slot = NOT_DELAYED;
1678     quick_pc_to_pointers(cpu);
1679     } else
1680     cpu->delay_slot = NOT_DELAYED;
1681     }
1682     X(bsr)
1683     {
1684     MODE_int_t target = cpu->pc & ~((SH_IC_ENTRIES_PER_PAGE-1) <<
1685     SH_INSTR_ALIGNMENT_SHIFT);
1686     uint32_t old_pc;
1687     SYNCH_PC;
1688     old_pc = cpu->pc;
1689     target += ic->arg[0];
1690     cpu->delay_slot = TO_BE_DELAYED;
1691     ic[1].f(cpu, ic+1);
1692     cpu->n_translated_instrs ++;
1693     if (!(cpu->delay_slot & EXCEPTION_IN_DELAY_SLOT)) {
1694     cpu->cd.sh.pr = old_pc + 4;
1695     cpu->pc = target;
1696     cpu->delay_slot = NOT_DELAYED;
1697     quick_pc_to_pointers(cpu);
1698     } else
1699     cpu->delay_slot = NOT_DELAYED;
1700     }
1701     X(braf_rn)
1702     {
1703     MODE_int_t target = cpu->pc & ~((SH_IC_ENTRIES_PER_PAGE-1) <<
1704     SH_INSTR_ALIGNMENT_SHIFT);
1705     target += ic->arg[0] + reg(ic->arg[1]);
1706     cpu->delay_slot = TO_BE_DELAYED;
1707     ic[1].f(cpu, ic+1);
1708     cpu->n_translated_instrs ++;
1709     if (!(cpu->delay_slot & EXCEPTION_IN_DELAY_SLOT)) {
1710     cpu->pc = target;
1711     cpu->delay_slot = NOT_DELAYED;
1712     quick_pc_to_pointers(cpu);
1713     } else
1714     cpu->delay_slot = NOT_DELAYED;
1715     }
1716     X(bsrf_rn)
1717     {
1718     MODE_int_t target = cpu->pc & ~((SH_IC_ENTRIES_PER_PAGE-1) <<
1719     SH_INSTR_ALIGNMENT_SHIFT);
1720     uint32_t old_pc;
1721     SYNCH_PC;
1722     old_pc = cpu->pc;
1723     target += ic->arg[0] + reg(ic->arg[1]);
1724     cpu->delay_slot = TO_BE_DELAYED;
1725     ic[1].f(cpu, ic+1);
1726     cpu->n_translated_instrs ++;
1727     if (!(cpu->delay_slot & EXCEPTION_IN_DELAY_SLOT)) {
1728     cpu->cd.sh.pr = old_pc + 4;
1729     cpu->pc = target;
1730     cpu->delay_slot = NOT_DELAYED;
1731     quick_pc_to_pointers(cpu);
1732     } else
1733     cpu->delay_slot = NOT_DELAYED;
1734     }
1735    
1736    
1737     /*
1738     * bt: Branch if true
1739     * bf: Branch if false
1740     * bt/s: Branch if true (with delay-slot)
1741     * bf/s: Branch if false (with delay-slot)
1742     *
1743     * arg[0] = immediate offset relative to start of page
1744     */
1745     X(bt)
1746     {
1747     if (cpu->cd.sh.sr & SH_SR_T) {
1748     cpu->pc &= ~((SH_IC_ENTRIES_PER_PAGE-1) <<
1749     SH_INSTR_ALIGNMENT_SHIFT);
1750     cpu->pc += ic->arg[0];
1751     quick_pc_to_pointers(cpu);
1752 dpavlin 30 }
1753 dpavlin 32 }
1754     X(bf)
1755     {
1756     if (!(cpu->cd.sh.sr & SH_SR_T)) {
1757     cpu->pc &= ~((SH_IC_ENTRIES_PER_PAGE-1) <<
1758     SH_INSTR_ALIGNMENT_SHIFT);
1759     cpu->pc += ic->arg[0];
1760     quick_pc_to_pointers(cpu);
1761     }
1762     }
1763     X(bt_s)
1764     {
1765     MODE_int_t target = cpu->pc & ~((SH_IC_ENTRIES_PER_PAGE-1) <<
1766     SH_INSTR_ALIGNMENT_SHIFT);
1767     int cond = cpu->cd.sh.sr & SH_SR_T;
1768     target += ic->arg[0];
1769     cpu->delay_slot = TO_BE_DELAYED;
1770     ic[1].f(cpu, ic+1);
1771     cpu->n_translated_instrs ++;
1772     if (!(cpu->delay_slot & EXCEPTION_IN_DELAY_SLOT)) {
1773     cpu->delay_slot = NOT_DELAYED;
1774     if (cond) {
1775     cpu->pc = target;
1776     quick_pc_to_pointers(cpu);
1777     } else
1778     cpu->cd.sh.next_ic ++;
1779     } else
1780     cpu->delay_slot = NOT_DELAYED;
1781     }
1782     X(bf_s)
1783     {
1784     MODE_int_t target = cpu->pc & ~((SH_IC_ENTRIES_PER_PAGE-1) <<
1785     SH_INSTR_ALIGNMENT_SHIFT);
1786     int cond = !(cpu->cd.sh.sr & SH_SR_T);
1787     target += ic->arg[0];
1788     cpu->delay_slot = TO_BE_DELAYED;
1789     ic[1].f(cpu, ic+1);
1790     cpu->n_translated_instrs ++;
1791     if (!(cpu->delay_slot & EXCEPTION_IN_DELAY_SLOT)) {
1792     cpu->delay_slot = NOT_DELAYED;
1793     if (cond) {
1794     cpu->pc = target;
1795     quick_pc_to_pointers(cpu);
1796     } else
1797     cpu->cd.sh.next_ic ++;
1798     } else
1799     cpu->delay_slot = NOT_DELAYED;
1800     }
1801 dpavlin 30
1802 dpavlin 32
1803     /*
1804     * jmp_rn: Jump to Rn
1805     * jsr_rn: Jump to Rn, store return address in PR.
1806     *
1807     * arg[0] = ptr to rn
1808     */
1809     X(jmp_rn)
1810     {
1811     MODE_int_t target = reg(ic->arg[0]);
1812     cpu->delay_slot = TO_BE_DELAYED;
1813     ic[1].f(cpu, ic+1);
1814     cpu->n_translated_instrs ++;
1815     if (!(cpu->delay_slot & EXCEPTION_IN_DELAY_SLOT)) {
1816     cpu->pc = target;
1817     cpu->delay_slot = NOT_DELAYED;
1818     quick_pc_to_pointers(cpu);
1819     } else
1820     cpu->delay_slot = NOT_DELAYED;
1821 dpavlin 30 }
1822 dpavlin 32 X(jmp_rn_trace)
1823     {
1824     MODE_int_t target = reg(ic->arg[0]);
1825     cpu->delay_slot = TO_BE_DELAYED;
1826     ic[1].f(cpu, ic+1);
1827     cpu->n_translated_instrs ++;
1828     if (!(cpu->delay_slot & EXCEPTION_IN_DELAY_SLOT)) {
1829     cpu->pc = target;
1830     #if 0
1831     /* NOTE: Jmp works like both a return, and a subroutine
1832     call. */
1833     cpu_functioncall_trace_return(cpu);
1834     cpu_functioncall_trace(cpu, cpu->pc);
1835     #endif
1836     cpu->delay_slot = NOT_DELAYED;
1837     quick_pc_to_pointers(cpu);
1838     } else
1839     cpu->delay_slot = NOT_DELAYED;
1840     }
1841     X(jsr_rn)
1842     {
1843     MODE_int_t target = reg(ic->arg[0]), retaddr;
1844     cpu->delay_slot = TO_BE_DELAYED;
1845     retaddr = cpu->pc & ~((SH_IC_ENTRIES_PER_PAGE-1) <<
1846     SH_INSTR_ALIGNMENT_SHIFT);
1847     ic[1].f(cpu, ic+1);
1848     cpu->n_translated_instrs ++;
1849     cpu->cd.sh.pr = retaddr + (int32_t)ic->arg[1];
1850     if (!(cpu->delay_slot & EXCEPTION_IN_DELAY_SLOT)) {
1851     cpu->pc = target;
1852     cpu->delay_slot = NOT_DELAYED;
1853     quick_pc_to_pointers(cpu);
1854     } else
1855     cpu->delay_slot = NOT_DELAYED;
1856     }
1857     X(jsr_rn_trace)
1858     {
1859     MODE_int_t target = reg(ic->arg[0]), retaddr;
1860     cpu->delay_slot = TO_BE_DELAYED;
1861     retaddr = cpu->pc & ~((SH_IC_ENTRIES_PER_PAGE-1) <<
1862     SH_INSTR_ALIGNMENT_SHIFT);
1863     ic[1].f(cpu, ic+1);
1864     cpu->n_translated_instrs ++;
1865     cpu->cd.sh.pr = retaddr + (int32_t)ic->arg[1];
1866     if (!(cpu->delay_slot & EXCEPTION_IN_DELAY_SLOT)) {
1867     cpu->pc = target;
1868     cpu_functioncall_trace(cpu, cpu->pc);
1869     cpu->delay_slot = NOT_DELAYED;
1870     quick_pc_to_pointers(cpu);
1871     } else
1872     cpu->delay_slot = NOT_DELAYED;
1873     }
1874 dpavlin 30
1875    
1876     /*
1877 dpavlin 32 * rts: Jump to PR.
1878     */
1879     X(rts)
1880     {
1881     MODE_int_t target = cpu->cd.sh.pr;
1882     cpu->delay_slot = TO_BE_DELAYED;
1883     ic[1].f(cpu, ic+1);
1884     cpu->n_translated_instrs ++;
1885     if (!(cpu->delay_slot & EXCEPTION_IN_DELAY_SLOT)) {
1886     cpu->pc = target;
1887     cpu->delay_slot = NOT_DELAYED;
1888     quick_pc_to_pointers(cpu);
1889     } else
1890     cpu->delay_slot = NOT_DELAYED;
1891     }
1892     X(rts_trace)
1893     {
1894     MODE_int_t target = cpu->cd.sh.pr;
1895     cpu->delay_slot = TO_BE_DELAYED;
1896     ic[1].f(cpu, ic+1);
1897     cpu->n_translated_instrs ++;
1898     if (!(cpu->delay_slot & EXCEPTION_IN_DELAY_SLOT)) {
1899     cpu->pc = target;
1900     cpu_functioncall_trace_return(cpu);
1901     cpu->delay_slot = NOT_DELAYED;
1902     quick_pc_to_pointers(cpu);
1903     } else
1904     cpu->delay_slot = NOT_DELAYED;
1905     }
1906    
1907    
1908     /*
1909     * sts_mach_rn: Store MACH into Rn
1910     * sts_macl_rn: Store MACL into Rn
1911     * sts_pr_rn: Store PR into Rn
1912 dpavlin 30 *
1913 dpavlin 32 * arg[1] = ptr to rn
1914 dpavlin 30 */
1915 dpavlin 32 X(sts_mach_rn) { reg(ic->arg[1]) = cpu->cd.sh.mach; }
1916     X(sts_macl_rn) { reg(ic->arg[1]) = cpu->cd.sh.macl; }
1917     X(sts_pr_rn) { reg(ic->arg[1]) = cpu->cd.sh.pr; }
1918    
1919    
1920     /*
1921     * rte: Return from exception.
1922     */
1923     X(rte)
1924     {
1925     RES_INST_IF_NOT_MD;
1926    
1927     cpu->delay_slot = TO_BE_DELAYED;
1928     ic[1].f(cpu, ic+1);
1929     cpu->n_translated_instrs ++;
1930     if (!(cpu->delay_slot & EXCEPTION_IN_DELAY_SLOT)) {
1931     cpu->pc = cpu->cd.sh.spc;
1932     cpu->delay_slot = NOT_DELAYED;
1933     sh_update_sr(cpu, cpu->cd.sh.ssr);
1934     quick_pc_to_pointers(cpu);
1935     } else
1936     cpu->delay_slot = NOT_DELAYED;
1937     }
1938    
1939    
1940     /*
1941     * ldtlb: Load UTLB entry.
1942     */
1943     X(ldtlb)
1944     {
1945     uint32_t old_hi, old_lo;
1946     int urc = (cpu->cd.sh.mmucr & SH4_MMUCR_URC_MASK)
1947     >> SH4_MMUCR_URC_SHIFT;
1948    
1949     RES_INST_IF_NOT_MD;
1950    
1951     old_hi = cpu->cd.sh.utlb_hi[urc];
1952     old_lo = cpu->cd.sh.utlb_lo[urc];
1953    
1954     cpu->cd.sh.utlb_hi[urc] = cpu->cd.sh.pteh;
1955     cpu->cd.sh.utlb_lo[urc] = cpu->cd.sh.ptel;
1956    
1957     if ((old_lo & SH4_PTEL_SZ_MASK) == SH4_PTEL_SZ_4K)
1958     cpu->invalidate_translation_caches(cpu,
1959     old_hi & 0xfffff000, INVALIDATE_VADDR);
1960     else
1961     cpu->invalidate_translation_caches(cpu,
1962     old_hi & 0xfffff000, INVALIDATE_ALL);
1963     }
1964    
1965    
1966     /*
1967     * copy_privileged_register: Copy normal into privileged register, or vice
1968     * versa, after checking the MD status bit.
1969     *
1970     * arg[0] = ptr to source register
1971     * arg[1] = ptr to destination register
1972     */
1973     X(copy_privileged_register)
1974     {
1975     RES_INST_IF_NOT_MD;
1976     reg(ic->arg[1]) = reg(ic->arg[0]);
1977     }
1978    
1979    
1980     /*
1981     * ldc_rm_sr: Copy Rm into SR, after checking the MD status bit.
1982     *
1983     * arg[1] = ptr to rm
1984     */
1985 dpavlin 30 X(ldc_rm_sr)
1986     {
1987 dpavlin 32 RES_INST_IF_NOT_MD;
1988     sh_update_sr(cpu, reg(ic->arg[1]));
1989     }
1990    
1991    
1992     /*
1993     * trapa: Immediate trap.
1994     *
1995     * arg[0] = imm << 2
1996     */
1997     X(trapa)
1998     {
1999     SYNCH_PC;
2000    
2001     if (cpu->delay_slot) {
2002     sh_exception(cpu, EXPEVT_SLOT_INST, 0, 0);
2003     return;
2004     }
2005    
2006     cpu->cd.sh.tra = ic->arg[0];
2007     sh_exception(cpu, EXPEVT_TRAPA, 0, 0);
2008     }
2009    
2010    
2011     /*
2012     * copy_fp_register: Copy a register into another, with FP avail check.
2013     * lds_rm_fpscr: Copy Rm into FPSCR.
2014     *
2015     * arg[0] = ptr to source
2016     * arg[1] = ptr to destination
2017     */
2018     X(copy_fp_register)
2019     {
2020     FLOATING_POINT_AVAILABLE_CHECK;
2021     reg(ic->arg[1]) = reg(ic->arg[0]);
2022     }
2023     X(lds_rm_fpscr)
2024     {
2025     FLOATING_POINT_AVAILABLE_CHECK;
2026     sh_update_fpscr(cpu, reg(ic->arg[1]));
2027     }
2028    
2029    
2030     /*
2031     * fmov_frm_frn: Copy one floating-point register (or pair) to another.
2032     *
2033     * arg[0] = ptr to source float register or pair
2034     * arg[1] = ptr to destination float register or pair
2035     */
2036     X(fmov_frm_frn)
2037     {
2038     size_t r0, r1;
2039     int ofs0, ofs1;
2040    
2041     FLOATING_POINT_AVAILABLE_CHECK;
2042    
2043     /* Simplest case, single-precision: */
2044     if (!(cpu->cd.sh.fpscr & SH_FPSCR_SZ)) {
2045     reg(ic->arg[1]) = reg(ic->arg[0]);
2046     return;
2047     }
2048    
2049     /* Double-precision: */
2050     r0 = ic->arg[0]; r1 = ic->arg[1];
2051     ofs0 = (r0 - (size_t)&cpu->cd.sh.fr[0]) / sizeof(uint32_t);
2052     ofs1 = (r1 - (size_t)&cpu->cd.sh.fr[0]) / sizeof(uint32_t);
2053     if (ofs0 & 1)
2054     r0 = (size_t)&cpu->cd.sh.xf[ofs0 & ~1];
2055     if (ofs1 & 1)
2056     r1 = (size_t)&cpu->cd.sh.xf[ofs1 & ~1];
2057    
2058     reg(r1) = reg(r0);
2059     reg(r1 + 4) = reg(r0 + 4);
2060     }
2061    
2062    
2063     /*
2064     * float_fpul_frn: Load FPUL into float register.
2065     *
2066     * arg[0] = ptr to float register, or float register pair
2067     */
2068     X(float_fpul_frn)
2069     {
2070     int32_t fpul = cpu->cd.sh.fpul;
2071    
2072     FLOATING_POINT_AVAILABLE_CHECK;
2073    
2074     if (cpu->cd.sh.fpscr & SH_FPSCR_PR) {
2075     /* Double-precision, using a pair of registers: */
2076     uint64_t ieee = ieee_store_float_value(fpul, IEEE_FMT_D, 0);
2077     reg(ic->arg[0]) = (uint32_t) (ieee >> 32);
2078     reg(ic->arg[0] + sizeof(uint32_t)) = (uint32_t) ieee;
2079     } else {
2080     /* Single-precision: */
2081     uint32_t ieee = ieee_store_float_value(fpul, IEEE_FMT_S, 0);
2082     reg(ic->arg[0]) = (uint32_t) ieee;
2083     }
2084     }
2085    
2086    
2087     /*
2088     * ftrc_frm_fpul: Truncate a float register into FPUL.
2089     *
2090     * arg[0] = ptr to float register, or float register pair
2091     */
2092     X(ftrc_frm_fpul)
2093     {
2094     struct ieee_float_value op1;
2095    
2096     FLOATING_POINT_AVAILABLE_CHECK;
2097    
2098     if (cpu->cd.sh.fpscr & SH_FPSCR_PR) {
2099     /* Double-precision, using a pair of registers: */
2100     int64_t r1 = ((uint64_t)reg(ic->arg[0]) << 32) +
2101     reg(ic->arg[0] + sizeof(uint32_t));
2102     ieee_interpret_float_value(r1, &op1, IEEE_FMT_D);
2103     cpu->cd.sh.fpul = (int32_t) op1.f;
2104     } else {
2105     /* Single-precision: */
2106     ieee_interpret_float_value(reg(ic->arg[0]), &op1, IEEE_FMT_S);
2107     cpu->cd.sh.fpul = (int32_t) op1.f;
2108     }
2109     }
2110    
2111    
2112     /*
2113     * fsca_fpul_drn: Sinus/cosinus approximation.
2114     *
2115     * Note: This is an interesting instruction. It is not included in the SH4
2116     * manual. Some googling indicated that this might be an SH4X instruction.
2117     * On the other hand, it is used by Dreamcast code (and the Dreamcast has an
2118     * SH4), and a cvs comment for gdb said that this is an SH4 instruction, not
2119     * an SH4A instruction. Well well...
2120     *
2121     * arg[0] = ptr to single-precision float register pair
2122     */
2123     X(fsca_fpul_drn)
2124     {
2125     double fpul = ((double) (int32_t)cpu->cd.sh.fpul) / 32768.0;
2126    
2127     FLOATING_POINT_AVAILABLE_CHECK;
2128    
2129     reg(ic->arg[0]) = ieee_store_float_value(sin(fpul), IEEE_FMT_S, 0);
2130     reg(ic->arg[0] + sizeof(uint32_t)) =
2131     ieee_store_float_value(cos(fpul), IEEE_FMT_S, 0);
2132     }
2133    
2134    
2135     /*
2136     * ftrv_xmtrx_fvn: Matrix * vector ==> vector
2137     *
2138     * arg[0] = ptr to FVn
2139     */
2140     X(ftrv_xmtrx_fvn)
2141     {
2142     int i;
2143     struct ieee_float_value xmtrx[16], frn[4];
2144     double frnp0 = 0.0, frnp1 = 0.0, frnp2 = 0.0, frnp3 = 0.0;
2145    
2146     ieee_interpret_float_value(reg(ic->arg[0] + 0), &frn[0], IEEE_FMT_S);
2147     ieee_interpret_float_value(reg(ic->arg[0] + 4), &frn[1], IEEE_FMT_S);
2148     ieee_interpret_float_value(reg(ic->arg[0] + 8), &frn[2], IEEE_FMT_S);
2149     ieee_interpret_float_value(reg(ic->arg[0] + 12), &frn[3], IEEE_FMT_S);
2150    
2151     for (i=0; i<16; i++)
2152     ieee_interpret_float_value(cpu->cd.sh.xf[i],
2153     &xmtrx[i], IEEE_FMT_S);
2154    
2155     for (i=0; i<4; i++)
2156     frnp0 += xmtrx[i*4].f * frn[i].f;
2157    
2158     for (i=0; i<4; i++)
2159     frnp1 += xmtrx[i*4 + 1].f * frn[i].f;
2160    
2161     for (i=0; i<4; i++)
2162     frnp2 += xmtrx[i*4 + 2].f * frn[i].f;
2163    
2164     for (i=0; i<4; i++)
2165     frnp3 += xmtrx[i*4 + 3].f * frn[i].f;
2166    
2167     reg(ic->arg[0] + 0) = ieee_store_float_value(frnp0, IEEE_FMT_S, 0);
2168     reg(ic->arg[0] + 4) = ieee_store_float_value(frnp1, IEEE_FMT_S, 0);
2169     reg(ic->arg[0] + 8) = ieee_store_float_value(frnp2, IEEE_FMT_S, 0);
2170     reg(ic->arg[0] + 12) = ieee_store_float_value(frnp3, IEEE_FMT_S, 0);
2171     }
2172    
2173    
2174     /*
2175     * fldi: Load immediate (0.0 or 1.0) into floating point register.
2176     * fneg: Negate a floating point register
2177     * fabs: Get the absolute value of a floating point register
2178     * fsqrt: Calculate square root
2179     *
2180     * arg[0] = ptr to fp register
2181     * arg[1] = (uint32_t) immediate value (for fldi)
2182     */
2183     X(fldi_frn)
2184     {
2185     FLOATING_POINT_AVAILABLE_CHECK;
2186     reg(ic->arg[0]) = ic->arg[1];
2187     }
2188     X(fneg_frn)
2189     {
2190     FLOATING_POINT_AVAILABLE_CHECK;
2191     /* Note: This also works for double-precision. */
2192     reg(ic->arg[0]) ^= 0x80000000;
2193     }
2194     X(fabs_frn)
2195     {
2196     FLOATING_POINT_AVAILABLE_CHECK;
2197     /* Note: This also works for double-precision. */
2198     reg(ic->arg[0]) &= 0x7fffffff;
2199     }
2200     X(fsqrt_frn)
2201     {
2202     struct ieee_float_value op1;
2203    
2204     FLOATING_POINT_AVAILABLE_CHECK;
2205    
2206     if (cpu->cd.sh.fpscr & SH_FPSCR_PR) {
2207     /* Double-precision: */
2208     int64_t r1, ieee;
2209     r1 = reg(ic->arg[0] + sizeof(uint32_t)) +
2210     ((uint64_t)reg(ic->arg[0]) << 32);
2211     ieee_interpret_float_value(r1, &op1, IEEE_FMT_D);
2212     ieee = ieee_store_float_value(sqrt(op1.f), IEEE_FMT_D, 0);
2213     reg(ic->arg[0]) = (uint32_t) (ieee >> 32);
2214     reg(ic->arg[0] + sizeof(uint32_t)) = (uint32_t) ieee;
2215     } else {
2216     /* Single-precision: */
2217     int32_t ieee, r1 = reg(ic->arg[0]);
2218     ieee_interpret_float_value(r1, &op1, IEEE_FMT_S);
2219     ieee = ieee_store_float_value(sqrt(op1.f), IEEE_FMT_S, 0);
2220     reg(ic->arg[0]) = ieee;
2221     }
2222     }
2223    
2224    
2225     /*
2226     * fadd_frm_frn: Floating point addition.
2227     * fsub_frm_frn: Floating point subtraction.
2228     * fmul_frm_frn: Floating point multiplication.
2229     * fdiv_frm_frn: Floating point division.
2230     * fmac_fr0_frm_frn: Multiply-and-accumulate.
2231     * fcmp_eq_frm_frn: Floating point greater-than comparison.
2232     * fcmp_gt_frm_frn: Floating point greater-than comparison.
2233     *
2234     * arg[0] = ptr to float register FRm
2235     * arg[1] = ptr to float register FRn
2236     */
2237     X(fadd_frm_frn)
2238     {
2239     struct ieee_float_value op1, op2;
2240    
2241     FLOATING_POINT_AVAILABLE_CHECK;
2242    
2243     if (cpu->cd.sh.fpscr & SH_FPSCR_PR) {
2244     /* Double-precision, using a pair of registers: */
2245     int64_t r1, r2, ieee;
2246     double result;
2247    
2248     r1 = reg(ic->arg[0] + sizeof(uint32_t)) +
2249     ((uint64_t)reg(ic->arg[0]) << 32);
2250     r2 = reg(ic->arg[1] + sizeof(uint32_t)) +
2251     ((uint64_t)reg(ic->arg[1]) << 32);
2252     ieee_interpret_float_value(r1, &op1, IEEE_FMT_D);
2253     ieee_interpret_float_value(r2, &op2, IEEE_FMT_D);
2254    
2255     result = op2.f + op1.f;
2256     ieee = ieee_store_float_value(result, IEEE_FMT_D, 0);
2257     reg(ic->arg[1]) = (uint32_t) (ieee >> 32);
2258     reg(ic->arg[1] + sizeof(uint32_t)) = (uint32_t) ieee;
2259     } else {
2260     /* Single-precision: */
2261     uint32_t r1, r2, ieee;
2262     double result;
2263    
2264     r1 = reg(ic->arg[0]);
2265     r2 = reg(ic->arg[1]);
2266     ieee_interpret_float_value(r1, &op1, IEEE_FMT_S);
2267     ieee_interpret_float_value(r2, &op2, IEEE_FMT_S);
2268    
2269     result = op2.f + op1.f;
2270     ieee = ieee_store_float_value(result, IEEE_FMT_S, 0);
2271     reg(ic->arg[1]) = (uint32_t) ieee;
2272     }
2273     }
2274     X(fsub_frm_frn)
2275     {
2276     struct ieee_float_value op1, op2;
2277    
2278     FLOATING_POINT_AVAILABLE_CHECK;
2279    
2280     if (cpu->cd.sh.fpscr & SH_FPSCR_PR) {
2281     /* Double-precision, using a pair of registers: */
2282     int64_t r1, r2, ieee;
2283     double result;
2284     r1 = reg(ic->arg[0] + sizeof(uint32_t)) +
2285     ((uint64_t)reg(ic->arg[0]) << 32);
2286     r2 = reg(ic->arg[1] + sizeof(uint32_t)) +
2287     ((uint64_t)reg(ic->arg[1]) << 32);
2288     ieee_interpret_float_value(r1, &op1, IEEE_FMT_D);
2289     ieee_interpret_float_value(r2, &op2, IEEE_FMT_D);
2290     result = op2.f - op1.f;
2291     ieee = ieee_store_float_value(result, IEEE_FMT_D, 0);
2292     reg(ic->arg[1]) = (uint32_t) (ieee >> 32);
2293     reg(ic->arg[1] + sizeof(uint32_t)) = (uint32_t) ieee;
2294     } else {
2295     /* Single-precision: */
2296     uint32_t r1, r2, ieee;
2297     double result;
2298     r1 = reg(ic->arg[0]);
2299     r2 = reg(ic->arg[1]);
2300     ieee_interpret_float_value(r1, &op1, IEEE_FMT_S);
2301     ieee_interpret_float_value(r2, &op2, IEEE_FMT_S);
2302     result = op2.f - op1.f;
2303     ieee = ieee_store_float_value(result, IEEE_FMT_S, 0);
2304     reg(ic->arg[1]) = (uint32_t) ieee;
2305     }
2306     }
2307     X(fmul_frm_frn)
2308     {
2309     struct ieee_float_value op1, op2;
2310    
2311     FLOATING_POINT_AVAILABLE_CHECK;
2312    
2313     if (cpu->cd.sh.fpscr & SH_FPSCR_PR) {
2314     /* Double-precision, using a pair of registers: */
2315     int64_t r1, r2, ieee;
2316     double result;
2317    
2318     r1 = reg(ic->arg[0] + sizeof(uint32_t)) +
2319     ((uint64_t)reg(ic->arg[0]) << 32);
2320     r2 = reg(ic->arg[1] + sizeof(uint32_t)) +
2321     ((uint64_t)reg(ic->arg[1]) << 32);
2322     ieee_interpret_float_value(r1, &op1, IEEE_FMT_D);
2323     ieee_interpret_float_value(r2, &op2, IEEE_FMT_D);
2324    
2325     result = op2.f * op1.f;
2326     ieee = ieee_store_float_value(result, IEEE_FMT_D, 0);
2327     reg(ic->arg[1]) = (uint32_t) (ieee >> 32);
2328     reg(ic->arg[1] + sizeof(uint32_t)) = (uint32_t) ieee;
2329     } else {
2330     /* Single-precision: */
2331     uint32_t r1, r2, ieee;
2332     double result;
2333    
2334     r1 = reg(ic->arg[0]);
2335     r2 = reg(ic->arg[1]);
2336     ieee_interpret_float_value(r1, &op1, IEEE_FMT_S);
2337     ieee_interpret_float_value(r2, &op2, IEEE_FMT_S);
2338    
2339     result = op2.f * op1.f;
2340     ieee = ieee_store_float_value(result, IEEE_FMT_S, 0);
2341     reg(ic->arg[1]) = (uint32_t) ieee;
2342     }
2343     }
2344     X(fdiv_frm_frn)
2345     {
2346     struct ieee_float_value op1, op2;
2347    
2348     FLOATING_POINT_AVAILABLE_CHECK;
2349    
2350     if (cpu->cd.sh.fpscr & SH_FPSCR_PR) {
2351     /* Double-precision, using a pair of registers: */
2352     int64_t r1, r2, ieee;
2353     double result;
2354    
2355     r1 = reg(ic->arg[0] + sizeof(uint32_t)) +
2356     ((uint64_t)reg(ic->arg[0]) << 32);
2357     r2 = reg(ic->arg[1] + sizeof(uint32_t)) +
2358     ((uint64_t)reg(ic->arg[1]) << 32);
2359     ieee_interpret_float_value(r1, &op1, IEEE_FMT_D);
2360     ieee_interpret_float_value(r2, &op2, IEEE_FMT_D);
2361    
2362     if (op1.f != 0.0)
2363     result = op2.f / op1.f;
2364     else
2365     result = 0.0;
2366    
2367     ieee = ieee_store_float_value(result, IEEE_FMT_D, 0);
2368    
2369     reg(ic->arg[1]) = (uint32_t) (ieee >> 32);
2370     reg(ic->arg[1] + sizeof(uint32_t)) = (uint32_t) ieee;
2371     } else {
2372     /* Single-precision: */
2373     uint32_t r1, r2, ieee;
2374     double result;
2375    
2376     r1 = reg(ic->arg[0]);
2377     r2 = reg(ic->arg[1]);
2378     ieee_interpret_float_value(r1, &op1, IEEE_FMT_S);
2379     ieee_interpret_float_value(r2, &op2, IEEE_FMT_S);
2380    
2381     if (op1.f != 0.0)
2382     result = op2.f / op1.f;
2383     else
2384     result = 0.0;
2385    
2386     ieee = ieee_store_float_value(result, IEEE_FMT_S, 0);
2387    
2388     reg(ic->arg[1]) = (uint32_t) ieee;
2389     }
2390     }
2391     X(fmac_fr0_frm_frn)
2392     {
2393     struct ieee_float_value op1, op2, op0;
2394     int32_t r1, r2, fr0 = cpu->cd.sh.fr[0], ieee;
2395    
2396     FLOATING_POINT_AVAILABLE_CHECK;
2397    
2398     r1 = reg(ic->arg[0]), r2 = reg(ic->arg[1]);
2399     ieee_interpret_float_value(fr0, &op0, IEEE_FMT_S);
2400     ieee_interpret_float_value(r1, &op1, IEEE_FMT_S);
2401     ieee_interpret_float_value(r2, &op2, IEEE_FMT_S);
2402     ieee = ieee_store_float_value(op0.f * op1.f + op2.f, IEEE_FMT_S, 0);
2403     reg(ic->arg[1]) = ieee;
2404     }
2405     X(fcmp_eq_frm_frn)
2406     {
2407     struct ieee_float_value op1, op2;
2408    
2409     FLOATING_POINT_AVAILABLE_CHECK;
2410    
2411     if (cpu->cd.sh.fpscr & SH_FPSCR_PR) {
2412     /* Double-precision, using a pair of registers: */
2413     int64_t r1, r2;
2414     r1 = reg(ic->arg[0] + sizeof(uint32_t)) +
2415     ((uint64_t)reg(ic->arg[0]) << 32);
2416     r2 = reg(ic->arg[1] + sizeof(uint32_t)) +
2417     ((uint64_t)reg(ic->arg[1]) << 32);
2418     ieee_interpret_float_value(r1, &op1, IEEE_FMT_D);
2419     ieee_interpret_float_value(r2, &op2, IEEE_FMT_D);
2420     } else {
2421     /* Single-precision: */
2422     uint32_t r1 = reg(ic->arg[0]), r2 = reg(ic->arg[1]);
2423     ieee_interpret_float_value(r1, &op1, IEEE_FMT_S);
2424     ieee_interpret_float_value(r2, &op2, IEEE_FMT_S);
2425     }
2426    
2427     if (op2.f == op1.f)
2428     cpu->cd.sh.sr |= SH_SR_T;
2429     else
2430     cpu->cd.sh.sr &= ~SH_SR_T;
2431     }
2432     X(fcmp_gt_frm_frn)
2433     {
2434     struct ieee_float_value op1, op2;
2435    
2436     FLOATING_POINT_AVAILABLE_CHECK;
2437    
2438     if (cpu->cd.sh.fpscr & SH_FPSCR_PR) {
2439     /* Double-precision, using a pair of registers: */
2440     int64_t r1, r2;
2441     r1 = reg(ic->arg[0] + sizeof(uint32_t)) +
2442     ((uint64_t)reg(ic->arg[0]) << 32);
2443     r2 = reg(ic->arg[1] + sizeof(uint32_t)) +
2444     ((uint64_t)reg(ic->arg[1]) << 32);
2445     ieee_interpret_float_value(r1, &op1, IEEE_FMT_D);
2446     ieee_interpret_float_value(r2, &op2, IEEE_FMT_D);
2447     } else {
2448     /* Single-precision: */
2449     uint32_t r1 = reg(ic->arg[0]), r2 = reg(ic->arg[1]);
2450     ieee_interpret_float_value(r1, &op1, IEEE_FMT_S);
2451     ieee_interpret_float_value(r2, &op2, IEEE_FMT_S);
2452     }
2453    
2454     if (op2.f > op1.f)
2455     cpu->cd.sh.sr |= SH_SR_T;
2456     else
2457     cpu->cd.sh.sr &= ~SH_SR_T;
2458     }
2459    
2460    
2461     /*
2462     * frchg: Change floating-point register banks.
2463     * fschg: Change floating-point register size.
2464     */
2465     X(frchg)
2466     {
2467     FLOATING_POINT_AVAILABLE_CHECK;
2468     sh_update_fpscr(cpu, cpu->cd.sh.fpscr ^ SH_FPSCR_FR);
2469     }
2470     X(fschg)
2471     {
2472     FLOATING_POINT_AVAILABLE_CHECK;
2473     sh_update_fpscr(cpu, cpu->cd.sh.fpscr ^ SH_FPSCR_SZ);
2474     }
2475    
2476    
2477     /*
2478     * pref_rn: Prefetch.
2479     *
2480     * arg[1] = ptr to Rn
2481     */
2482     X(pref_rn)
2483     {
2484     uint32_t addr = reg(ic->arg[1]), extaddr;
2485     int sq_nr, ofs;
2486    
2487     if (addr < 0xe0000000 || addr >= 0xe4000000)
2488     return;
2489    
2490     /* Send Store Queue contents to external memory: */
2491     extaddr = addr & 0x03ffffe0;
2492     sq_nr = addr & 0x20? 1 : 0;
2493    
2494     if (cpu->cd.sh.mmucr & SH4_MMUCR_AT) {
2495     fatal("Store Queue to external memory, when "
2496     "MMU enabled: TODO\n");
2497 dpavlin 30 exit(1);
2498     }
2499    
2500 dpavlin 32 if (sq_nr == 0)
2501     extaddr |= (((cpu->cd.sh.qacr0 >> 2) & 7) << 26);
2502     else
2503     extaddr |= (((cpu->cd.sh.qacr1 >> 2) & 7) << 26);
2504    
2505     /* fatal("extaddr = 0x%08x\n", extaddr); */
2506    
2507     SYNCH_PC;
2508     for (ofs = 0; ofs < 32; ofs += sizeof(uint32_t)) {
2509     uint32_t word;
2510     cpu->memory_rw(cpu, cpu->mem, 0xe0000000 + ofs
2511     + sq_nr * 0x20, (unsigned char *)
2512     &word, sizeof(word), MEM_READ, PHYSICAL);
2513     cpu->memory_rw(cpu, cpu->mem, extaddr+ofs, (unsigned char *)
2514     &word, sizeof(word), MEM_WRITE, PHYSICAL);
2515     }
2516 dpavlin 30 }
2517    
2518    
2519 dpavlin 32 /*
2520     * tas_b_rn: Test-and-Set.
2521     *
2522     * arg[1] = ptr to Rn
2523     */
2524     X(tas_b_rn)
2525     {
2526     uint32_t addr = reg(ic->arg[1]);
2527     uint8_t byte, newbyte;
2528    
2529     SYNCH_PC;
2530    
2531     if (!cpu->memory_rw(cpu, cpu->mem, addr, &byte, 1, MEM_READ,
2532     CACHE_DATA)) {
2533     /* Exception. */
2534     return;
2535     }
2536    
2537     newbyte = byte | 0x80;
2538    
2539     if (!cpu->memory_rw(cpu, cpu->mem, addr, &newbyte, 1, MEM_WRITE,
2540     CACHE_DATA)) {
2541     /* Exception. */
2542     return;
2543     }
2544    
2545     if (byte == 0)
2546     cpu->cd.sh.sr |= SH_SR_T;
2547     else
2548     cpu->cd.sh.sr &= ~SH_SR_T;
2549     }
2550    
2551    
2552     /*
2553     * prom_emul_dreamcast:
2554     */
2555     X(prom_emul_dreamcast)
2556     {
2557     uint32_t old_pc;
2558     SYNCH_PC;
2559     old_pc = cpu->pc;
2560    
2561     dreamcast_emul(cpu);
2562    
2563     if (!cpu->running) {
2564     cpu->n_translated_instrs --;
2565     cpu->cd.sh.next_ic = &nothing_call;
2566     } else if ((uint32_t)cpu->pc != old_pc) {
2567     /* The PC value was changed by the PROM call. */
2568     quick_pc_to_pointers(cpu);
2569     }
2570     }
2571    
2572    
2573 dpavlin 14 /*****************************************************************************/
2574    
2575    
2576     X(end_of_page)
2577     {
2578     /* Update the PC: (offset 0, but on the next page) */
2579     cpu->pc &= ~((SH_IC_ENTRIES_PER_PAGE-1) <<
2580     SH_INSTR_ALIGNMENT_SHIFT);
2581 dpavlin 32 cpu->pc += (SH_IC_ENTRIES_PER_PAGE << SH_INSTR_ALIGNMENT_SHIFT);
2582 dpavlin 14
2583     /* end_of_page doesn't count as an executed instruction: */
2584     cpu->n_translated_instrs --;
2585 dpavlin 32
2586     /*
2587     * Find the new physpage and update translation pointers.
2588     *
2589     * Note: This may cause an exception, if e.g. the new page is
2590     * not accessible.
2591     */
2592     quick_pc_to_pointers(cpu);
2593    
2594     /* Simple jump to the next page (if we are lucky): */
2595     if (cpu->delay_slot == NOT_DELAYED)
2596     return;
2597    
2598     /*
2599     * If we were in a delay slot, and we got an exception while doing
2600     * quick_pc_to_pointers, then return. The function which called
2601     * end_of_page should handle this case.
2602     */
2603     if (cpu->delay_slot == EXCEPTION_IN_DELAY_SLOT)
2604     return;
2605    
2606     /*
2607     * Tricky situation; the delay slot is on the next virtual page.
2608     * Calling to_be_translated will translate one instruction manually,
2609     * execute it, and then discard it.
2610     */
2611     /* fatal("[ end_of_page: delay slot across page boundary! ]\n"); */
2612    
2613     instr(to_be_translated)(cpu, cpu->cd.sh.next_ic);
2614    
2615     /* The instruction in the delay slot has now executed. */
2616     /* fatal("[ end_of_page: back from executing the delay slot, %i ]\n",
2617     cpu->delay_slot); */
2618    
2619     /* Find the physpage etc of the instruction in the delay slot
2620     (or, if there was an exception, the exception handler): */
2621     quick_pc_to_pointers(cpu);
2622 dpavlin 14 }
2623    
2624    
2625 dpavlin 32 X(end_of_page2)
2626     {
2627     /* Synchronize PC on the _second_ instruction on the next page: */
2628     int low_pc = ((size_t)ic - (size_t)cpu->cd.sh.cur_ic_page)
2629     / sizeof(struct sh_instr_call);
2630     cpu->pc &= ~((SH_IC_ENTRIES_PER_PAGE-1)
2631     << SH_INSTR_ALIGNMENT_SHIFT);
2632     cpu->pc += (low_pc << SH_INSTR_ALIGNMENT_SHIFT);
2633    
2634     /* This doesn't count as an executed instruction. */
2635     cpu->n_translated_instrs --;
2636    
2637     quick_pc_to_pointers(cpu);
2638    
2639     if (cpu->delay_slot == NOT_DELAYED)
2640     return;
2641    
2642     fatal("end_of_page2: fatal error, we're in a delay slot\n");
2643     exit(1);
2644     }
2645    
2646    
2647 dpavlin 14 /*****************************************************************************/
2648    
2649    
2650     /*
2651     * sh_instr_to_be_translated():
2652     *
2653     * Translate an instruction word into an sh_instr_call. ic is filled in with
2654     * valid data for the translated instruction, or a "nothing" instruction if
2655     * there was a translation failure. The newly translated instruction is then
2656     * executed.
2657     */
2658     X(to_be_translated)
2659     {
2660 dpavlin 20 uint64_t addr, low_pc;
2661 dpavlin 14 uint32_t iword;
2662     unsigned char *page;
2663     unsigned char ib[4];
2664 dpavlin 30 int main_opcode, isize = cpu->cd.sh.compact? 2 : sizeof(ib);
2665     int in_crosspage_delayslot = 0, r8, r4, lo4, lo8;
2666     /* void (*samepage_function)(struct cpu *, struct sh_instr_call *); */
2667 dpavlin 14
2668     /* Figure out the (virtual) address of the instruction: */
2669 dpavlin 30 low_pc = ((size_t)ic - (size_t)cpu->cd.sh.cur_ic_page)
2670     / sizeof(struct sh_instr_call);
2671    
2672     /* Special case for branch with delayslot on the next page: */
2673     if (cpu->delay_slot == TO_BE_DELAYED && low_pc == 0) {
2674     /* fatal("[ delay-slot translation across page "
2675     "boundary ]\n"); */
2676     in_crosspage_delayslot = 1;
2677 dpavlin 14 }
2678    
2679 dpavlin 30 addr = cpu->pc & ~((SH_IC_ENTRIES_PER_PAGE-1)
2680     << SH_INSTR_ALIGNMENT_SHIFT);
2681     addr += (low_pc << SH_INSTR_ALIGNMENT_SHIFT);
2682     cpu->pc = (MODE_int_t)addr;
2683     addr &= ~((1 << SH_INSTR_ALIGNMENT_SHIFT) - 1);
2684    
2685 dpavlin 14 /* Read the instruction word from memory: */
2686 dpavlin 30 #ifdef MODE32
2687     page = cpu->cd.sh.host_load[(uint32_t)addr >> 12];
2688     #else
2689     {
2690     const uint32_t mask1 = (1 << DYNTRANS_L1N) - 1;
2691     const uint32_t mask2 = (1 << DYNTRANS_L2N) - 1;
2692     const uint32_t mask3 = (1 << DYNTRANS_L3N) - 1;
2693     uint32_t x1 = (addr >> (64-DYNTRANS_L1N)) & mask1;
2694     uint32_t x2 = (addr >> (64-DYNTRANS_L1N-DYNTRANS_L2N)) & mask2;
2695     uint32_t x3 = (addr >> (64-DYNTRANS_L1N-DYNTRANS_L2N-
2696     DYNTRANS_L3N)) & mask3;
2697     struct DYNTRANS_L2_64_TABLE *l2 = cpu->cd.sh.l1_64[x1];
2698     struct DYNTRANS_L3_64_TABLE *l3 = l2->l3[x2];
2699     page = l3->host_load[x3];
2700     }
2701     #endif
2702 dpavlin 14
2703     if (page != NULL) {
2704     /* fatal("TRANSLATION HIT!\n"); */
2705 dpavlin 30 memcpy(ib, page + (addr & 0xfff), isize);
2706 dpavlin 14 } else {
2707     /* fatal("TRANSLATION MISS!\n"); */
2708     if (!cpu->memory_rw(cpu, cpu->mem, addr, ib,
2709 dpavlin 30 isize, MEM_READ, CACHE_INSTRUCTION)) {
2710     fatal("to_be_translated(): read failed: TODO\n");
2711 dpavlin 14 goto bad;
2712     }
2713     }
2714    
2715 dpavlin 30 if (cpu->cd.sh.compact) {
2716 dpavlin 32 iword = *((uint16_t *)&ib[0]);
2717 dpavlin 30 if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
2718     iword = LE16_TO_HOST(iword);
2719     else
2720     iword = BE16_TO_HOST(iword);
2721     main_opcode = iword >> 12;
2722     r8 = (iword >> 8) & 0xf;
2723     r4 = (iword >> 4) & 0xf;
2724     lo8 = iword & 0xff;
2725     lo4 = iword & 0xf;
2726     } else {
2727 dpavlin 32 iword = *((uint32_t *)&ib[0]);
2728 dpavlin 30 if (cpu->byte_order == EMUL_LITTLE_ENDIAN)
2729     iword = LE32_TO_HOST(iword);
2730     else
2731     iword = BE32_TO_HOST(iword);
2732     main_opcode = -1; /* TODO */
2733     fatal("SH5/SH64 isn't implemented yet. Sorry.\n");
2734     goto bad;
2735     }
2736 dpavlin 14
2737    
2738     #define DYNTRANS_TO_BE_TRANSLATED_HEAD
2739     #include "cpu_dyntrans.c"
2740     #undef DYNTRANS_TO_BE_TRANSLATED_HEAD
2741    
2742    
2743     /*
2744     * Translate the instruction:
2745     */
2746    
2747 dpavlin 32 /* Default args. for many instructions: */
2748     ic->arg[0] = (size_t)&cpu->cd.sh.r[r4]; /* m */
2749     ic->arg[1] = (size_t)&cpu->cd.sh.r[r8]; /* n */
2750    
2751 dpavlin 14 switch (main_opcode) {
2752    
2753 dpavlin 30 case 0x0:
2754 dpavlin 32 if (lo4 == 0x4) {
2755     /* MOV.B Rm,@(R0,Rn) */
2756     ic->f = instr(mov_b_rm_r0_rn);
2757     } else if (lo4 == 0x5) {
2758     /* MOV.W Rm,@(R0,Rn) */
2759     ic->f = instr(mov_w_rm_r0_rn);
2760     } else if (lo4 == 0x6) {
2761     /* MOV.L Rm,@(R0,Rn) */
2762     ic->f = instr(mov_l_rm_r0_rn);
2763     } else if (lo4 == 0x7) {
2764     /* MUL.L Rm,Rn */
2765     ic->f = instr(mul_l_rm_rn);
2766     } else if (iword == 0x000b) {
2767     if (cpu->machine->show_trace_tree)
2768     ic->f = instr(rts_trace);
2769     else
2770     ic->f = instr(rts);
2771     } else if (lo4 == 0xc) {
2772     /* MOV.B @(R0,Rm),Rn */
2773     ic->f = instr(mov_b_r0_rm_rn);
2774     } else if (lo4 == 0xd) {
2775     /* MOV.W @(R0,Rm),Rn */
2776     ic->f = instr(mov_w_r0_rm_rn);
2777     } else if (lo4 == 0xe) {
2778     /* MOV.L @(R0,Rm),Rn */
2779     ic->f = instr(mov_l_r0_rm_rn);
2780     } else if (iword == 0x0008) {
2781     /* CLRT */
2782     ic->f = instr(clrt);
2783     } else if (iword == 0x0018) {
2784     /* SETT */
2785     ic->f = instr(sett);
2786     } else if (iword == 0x0019) {
2787     /* DIV0U */
2788     ic->f = instr(div0u);
2789     } else if (iword == 0x001b) {
2790     /* SLEEP */
2791     ic->f = instr(sleep);
2792     } else if (iword == 0x0028) {
2793     /* CLRMAC */
2794     ic->f = instr(clrmac);
2795     } else if (iword == 0x002b) {
2796     /* RTE */
2797     ic->f = instr(rte);
2798     } else if (iword == 0x0038) {
2799     /* LDTLB */
2800     ic->f = instr(ldtlb);
2801     } else if (iword == 0x0048) {
2802     /* CLRS */
2803     ic->f = instr(clrs);
2804     } else if (iword == 0x0058) {
2805     /* SETS */
2806     ic->f = instr(sets);
2807     } else if ((lo8 & 0x8f) == 0x82) {
2808     /* STC Rm_BANK, Rn */
2809     ic->f = instr(copy_privileged_register);
2810     ic->arg[0] = (size_t)&cpu->cd.sh.r_bank[(lo8 >> 4) & 7];
2811     } else if (iword == 0x00ff) {
2812     /* PROM emulation specifically for Dreamcast */
2813     ic->f = instr(prom_emul_dreamcast);
2814     } else {
2815     switch (lo8) {
2816     case 0x02: /* STC SR,Rn */
2817     ic->f = instr(copy_privileged_register);
2818     ic->arg[0] = (size_t)&cpu->cd.sh.sr;
2819     break;
2820     case 0x03: /* BSRF Rn */
2821     ic->f = instr(bsrf_rn);
2822     ic->arg[0] = (int32_t) (addr &
2823     ((SH_IC_ENTRIES_PER_PAGE-1)
2824     << SH_INSTR_ALIGNMENT_SHIFT) & ~1) + 4;
2825     /* arg[1] is Rn */
2826     break;
2827     case 0x09: /* NOP */
2828     ic->f = instr(nop);
2829     if (iword & 0x0f00) {
2830     fatal("Unimplemented NOP variant?\n");
2831     goto bad;
2832     }
2833     break;
2834     case 0x0a: /* STS MACH,Rn */
2835     ic->f = instr(sts_mach_rn);
2836     break;
2837     case 0x12: /* STC GBR,Rn */
2838     ic->f = instr(mov_rm_rn);
2839     ic->arg[0] = (size_t)&cpu->cd.sh.gbr;
2840     break;
2841     case 0x1a: /* STS MACL,Rn */
2842     ic->f = instr(sts_macl_rn);
2843     break;
2844     case 0x22: /* STC VBR,Rn */
2845     ic->f = instr(copy_privileged_register);
2846     ic->arg[0] = (size_t)&cpu->cd.sh.vbr;
2847     break;
2848     case 0x23: /* BRAF Rn */
2849     ic->f = instr(braf_rn);
2850     ic->arg[0] = (int32_t) (addr &
2851     ((SH_IC_ENTRIES_PER_PAGE-1)
2852     << SH_INSTR_ALIGNMENT_SHIFT) & ~1) + 4;
2853     /* arg[1] is Rn */
2854     break;
2855     case 0x29: /* MOVT Rn */
2856     ic->f = instr(movt_rn);
2857     break;
2858     case 0x2a: /* STS PR,Rn */
2859     ic->f = instr(sts_pr_rn);
2860     break;
2861     case 0x32: /* STC SSR,Rn */
2862     ic->f = instr(copy_privileged_register);
2863     ic->arg[0] = (size_t)&cpu->cd.sh.ssr;
2864     break;
2865     case 0x42: /* STC SPC,Rn */
2866     ic->f = instr(copy_privileged_register);
2867     ic->arg[0] = (size_t)&cpu->cd.sh.spc;
2868     break;
2869     case 0x5a: /* STS FPUL,Rn */
2870     ic->f = instr(copy_fp_register);
2871     ic->arg[0] = (size_t)&cpu->cd.sh.fpul;
2872     ic->arg[1] = (size_t)&cpu->cd.sh.r[r8];
2873     break;
2874     case 0x6a: /* STS FPSCR,Rn */
2875     ic->f = instr(copy_fp_register);
2876     ic->arg[0] = (size_t)&cpu->cd.sh.fpscr;
2877     ic->arg[1] = (size_t)&cpu->cd.sh.r[r8];
2878     break;
2879     case 0x83: /* PREF @Rn */
2880     ic->f = instr(pref_rn);
2881     break;
2882     case 0x93: /* OCBI @Rn */
2883     /* Treat as nop for now: */
2884     /* TODO: Implement this. */
2885     ic->f = instr(nop);
2886     break;
2887     case 0xa3: /* OCBP @Rn */
2888     /* Treat as nop for now: */
2889     /* TODO: Implement this. */
2890     ic->f = instr(nop);
2891     break;
2892     case 0xb3: /* OCBWB @Rn */
2893     /* Treat as nop for now: */
2894     /* TODO: Implement this. */
2895     ic->f = instr(nop);
2896     break;
2897     case 0xc3: /* MOVCA.L R0,@Rn */
2898     /* Treat as nop for now: */
2899     /* TODO: Implement this. */
2900     ic->f = instr(nop);
2901     break;
2902     case 0xfa: /* STC DBR,Rn */
2903     ic->f = instr(copy_privileged_register);
2904     ic->arg[0] = (size_t)&cpu->cd.sh.dbr;
2905     ic->arg[1] = (size_t)&cpu->cd.sh.r[r8];
2906     break;
2907     default:fatal("Unimplemented opcode 0x%x,0x%03x\n",
2908     main_opcode, iword & 0xfff);
2909 dpavlin 30 goto bad;
2910     }
2911     }
2912     break;
2913    
2914 dpavlin 32 case 0x1:
2915     ic->f = instr(mov_l_rm_disp_rn);
2916     ic->arg[1] = r8 + (lo4 << 4);
2917     break;
2918    
2919 dpavlin 30 case 0x2:
2920     switch (lo4) {
2921 dpavlin 32 case 0x0: /* MOV.B Rm,@Rn */
2922     ic->f = instr(mov_b_store_rm_rn);
2923     break;
2924     case 0x1: /* MOV.W Rm,@Rn */
2925     ic->f = instr(mov_w_store_rm_rn);
2926     break;
2927     case 0x2: /* MOV.L Rm,@Rn */
2928     ic->f = instr(mov_l_store_rm_rn);
2929     break;
2930     case 0x4: /* MOV.B Rm,@-Rn */
2931     ic->f = instr(mov_b_rm_predec_rn);
2932     break;
2933     case 0x5: /* MOV.W Rm,@-Rn */
2934     ic->f = instr(mov_w_rm_predec_rn);
2935     break;
2936     case 0x6: /* MOV.L Rm,@-Rn */
2937     ic->f = instr(mov_l_rm_predec_rn);
2938     break;
2939     case 0x7: /* DIV0S Rm,Rn */
2940     ic->f = instr(div0s_rm_rn);
2941     break;
2942     case 0x8: /* TST Rm,Rn */
2943     ic->f = instr(tst_rm_rn);
2944     break;
2945     case 0x9: /* AND Rm,Rn */
2946     ic->f = instr(and_rm_rn);
2947     break;
2948     case 0xa: /* XOR Rm,Rn */
2949     ic->f = instr(xor_rm_rn);
2950     break;
2951 dpavlin 30 case 0xb: /* OR Rm,Rn */
2952     ic->f = instr(or_rm_rn);
2953     break;
2954 dpavlin 32 case 0xc: /* CMP/STR Rm,Rn */
2955     ic->f = instr(cmp_str_rm_rn);
2956     break;
2957     case 0xd: /* XTRCT Rm,Rn */
2958     ic->f = instr(xtrct_rm_rn);
2959     break;
2960     case 0xe: /* MULU.W Rm,Rn */
2961     ic->f = instr(mulu_w_rm_rn);
2962     break;
2963     case 0xf: /* MULS.W Rm,Rn */
2964     ic->f = instr(muls_w_rm_rn);
2965     break;
2966 dpavlin 30 default:fatal("Unimplemented opcode 0x%x,0x%x\n",
2967     main_opcode, lo4);
2968     goto bad;
2969     }
2970     break;
2971    
2972 dpavlin 32 case 0x3:
2973     switch (lo4) {
2974     case 0x0: /* CMP/EQ Rm,Rn */
2975     ic->f = instr(cmpeq_rm_rn);
2976 dpavlin 30 break;
2977 dpavlin 32 case 0x2: /* CMP/HS Rm,Rn */
2978     ic->f = instr(cmphs_rm_rn);
2979 dpavlin 30 break;
2980 dpavlin 32 case 0x3: /* CMP/GE Rm,Rn */
2981     ic->f = instr(cmpge_rm_rn);
2982     break;
2983     case 0x4: /* DIV1 Rm,Rn */
2984     ic->f = instr(div1_rm_rn);
2985     break;
2986     case 0x5: /* DMULU.L Rm,Rn */
2987     ic->f = instr(dmulu_l_rm_rn);
2988     break;
2989     case 0x6: /* CMP/HI Rm,Rn */
2990     ic->f = instr(cmphi_rm_rn);
2991     break;
2992     case 0x7: /* CMP/GT Rm,Rn */
2993     ic->f = instr(cmpgt_rm_rn);
2994     break;
2995     case 0x8: /* SUB Rm,Rn */
2996     ic->f = instr(sub_rm_rn);
2997     break;
2998     case 0xa: /* SUBC Rm,Rn */
2999     ic->f = instr(subc_rm_rn);
3000     break;
3001     case 0xc: /* ADD Rm,Rn */
3002     ic->f = instr(add_rm_rn);
3003     break;
3004     case 0xd: /* DMULS.L Rm,Rn */
3005     ic->f = instr(dmuls_l_rm_rn);
3006     break;
3007     case 0xe: /* ADDC Rm,Rn */
3008     ic->f = instr(addc_rm_rn);
3009     break;
3010     default:fatal("Unimplemented opcode 0x%x,0x%x\n",
3011     main_opcode, lo4);
3012 dpavlin 30 goto bad;
3013     }
3014     break;
3015    
3016 dpavlin 32 case 0x4:
3017     if (lo4 == 0xc) {
3018     ic->f = instr(shad);
3019     } else if (lo4 == 0xd) {
3020     ic->f = instr(shld);
3021     } else if ((lo8 & 0x8f) == 0x83) {
3022     /* STC.L Rm_BANK,@-Rn */
3023     ic->f = instr(stc_l_rm_predec_rn);
3024     ic->arg[0] = (size_t)&cpu->cd.sh.r_bank[
3025     (lo8 >> 4) & 7]; /* m */
3026     } else if ((lo8 & 0x8f) == 0x87) {
3027     /* LDC.L @Rm+,Rn_BANK */
3028     ic->f = instr(mov_l_arg1_postinc_to_arg0_md);
3029     ic->arg[0] = (size_t)&cpu->cd.sh.r_bank[(lo8 >> 4) & 7];
3030     } else if ((lo8 & 0x8f) == 0x8e) {
3031     /* LDC Rm, Rn_BANK */
3032     ic->f = instr(copy_privileged_register);
3033     ic->arg[0] = (size_t)&cpu->cd.sh.r[r8];
3034     ic->arg[1] = (size_t)&cpu->cd.sh.r_bank[(lo8 >> 4) & 7];
3035     } else {
3036     switch (lo8) {
3037     case 0x00: /* SHLL Rn */
3038     ic->f = instr(shll_rn);
3039     break;
3040     case 0x01: /* SHLR Rn */
3041     ic->f = instr(shlr_rn);
3042     break;
3043     case 0x02: /* STS.L MACH,@-Rn */
3044     ic->f = instr(mov_l_rm_predec_rn);
3045     ic->arg[0] = (size_t)&cpu->cd.sh.mach;
3046     break;
3047     case 0x03: /* STC.L SR,@-Rn */
3048     ic->f = instr(stc_l_rm_predec_rn);
3049     ic->arg[0] = (size_t)&cpu->cd.sh.sr;
3050     break;
3051     case 0x04: /* ROTL Rn */
3052     ic->f = instr(rotl_rn);
3053     break;
3054     case 0x05: /* ROTR Rn */
3055     ic->f = instr(rotr_rn);
3056     break;
3057     case 0x06: /* LDS.L @Rm+,MACH */
3058     ic->f = instr(mov_l_arg1_postinc_to_arg0);
3059     ic->arg[0] = (size_t)&cpu->cd.sh.mach;
3060     break;
3061     case 0x07: /* LDC.L @Rm+,SR */
3062     ic->f = instr(mov_l_arg1_postinc_to_arg0_md);
3063     ic->arg[0] = (size_t)&cpu->cd.sh.sr;
3064     break;
3065     case 0x08: /* SHLL2 Rn */
3066     ic->f = instr(shll2_rn);
3067     break;
3068     case 0x09: /* SHLR2 Rn */
3069     ic->f = instr(shlr2_rn);
3070     break;
3071     case 0x0b: /* JSR @Rn */
3072     if (cpu->machine->show_trace_tree)
3073     ic->f = instr(jsr_rn_trace);
3074     else
3075     ic->f = instr(jsr_rn);
3076     ic->arg[0] = (size_t)&cpu->cd.sh.r[r8]; /* n */
3077     ic->arg[1] = (addr & 0xffe) + 4;
3078     break;
3079     case 0x0e: /* LDC Rm,SR */
3080     ic->f = instr(ldc_rm_sr);
3081     break;
3082     case 0x10: /* DT Rn */
3083     ic->f = instr(dt_rn);
3084     break;
3085     case 0x11: /* CMP/PZ Rn */
3086     ic->f = instr(cmppz_rn);
3087     break;
3088     case 0x12: /* STS.L MACL,@-Rn */
3089     ic->f = instr(mov_l_rm_predec_rn);
3090     ic->arg[0] = (size_t)&cpu->cd.sh.macl;
3091     break;
3092     case 0x13: /* STC.L GBR,@-Rn */
3093     ic->f = instr(stc_l_rm_predec_rn);
3094     ic->arg[0] = (size_t)&cpu->cd.sh.gbr;
3095     break;
3096     case 0x15: /* CMP/PL Rn */
3097     ic->f = instr(cmppl_rn);
3098     break;
3099     case 0x16: /* LDS.L @Rm+,MACL */
3100     ic->f = instr(mov_l_arg1_postinc_to_arg0);
3101     ic->arg[0] = (size_t)&cpu->cd.sh.macl;
3102     break;
3103     case 0x17: /* LDC.L @Rm+,GBR */
3104     ic->f = instr(mov_l_arg1_postinc_to_arg0_md);
3105     ic->arg[0] = (size_t)&cpu->cd.sh.gbr;
3106     break;
3107     case 0x18: /* SHLL8 Rn */
3108     ic->f = instr(shll8_rn);
3109     break;
3110     case 0x19: /* SHLR8 Rn */
3111     ic->f = instr(shlr8_rn);
3112     break;
3113     case 0x1b: /* TAS.B @Rn */
3114     ic->f = instr(tas_b_rn);
3115     break;
3116     case 0x20: /* SHAL Rn */
3117     ic->f = instr(shll_rn); /* NOTE: shll */
3118     break;
3119     case 0x21: /* SHAR Rn */
3120     ic->f = instr(shar_rn);
3121     break;
3122     case 0x22: /* STS.L PR,@-Rn */
3123     ic->f = instr(mov_l_rm_predec_rn);
3124     ic->arg[0] = (size_t)&cpu->cd.sh.pr; /* m */
3125     ic->arg[1] = (size_t)&cpu->cd.sh.r[r8]; /* n */
3126     break;
3127     case 0x23: /* STC.L VBR,@-Rn */
3128     ic->f = instr(stc_l_rm_predec_rn);
3129     ic->arg[0] = (size_t)&cpu->cd.sh.vbr;
3130     break;
3131     case 0x24: /* ROTCL Rn */
3132     ic->f = instr(rotcl_rn);
3133     break;
3134     case 0x25: /* ROTCR Rn */
3135     ic->f = instr(rotcr_rn);
3136     break;
3137     case 0x26: /* LDS.L @Rm+,PR */
3138     ic->f = instr(mov_l_arg1_postinc_to_arg0);
3139     ic->arg[0] = (size_t)&cpu->cd.sh.pr;
3140     break;
3141     case 0x27: /* LDC.L @Rm+,VBR */
3142     ic->f = instr(mov_l_arg1_postinc_to_arg0_md);
3143     ic->arg[0] = (size_t)&cpu->cd.sh.vbr;
3144     break;
3145     case 0x28: /* SHLL16 Rn */
3146     ic->f = instr(shll16_rn);
3147     break;
3148     case 0x29: /* SHLR16 Rn */
3149     ic->f = instr(shlr16_rn);
3150     break;
3151     case 0x2a: /* LDS Rm,PR */
3152     ic->f = instr(mov_rm_rn);
3153     ic->arg[0] = (size_t)&cpu->cd.sh.r[r8]; /* m */
3154     ic->arg[1] = (size_t)&cpu->cd.sh.pr;
3155     break;
3156     case 0x2b: /* JMP @Rn */
3157     if (cpu->machine->show_trace_tree)
3158     ic->f = instr(jmp_rn_trace);
3159     else
3160     ic->f = instr(jmp_rn);
3161     ic->arg[0] = (size_t)&cpu->cd.sh.r[r8]; /* n */
3162     ic->arg[1] = (addr & 0xffe) + 4;
3163     break;
3164     case 0x2e: /* LDC Rm,VBR */
3165     ic->f = instr(copy_privileged_register);
3166     ic->arg[0] = (size_t)&cpu->cd.sh.r[r8]; /* m */
3167     ic->arg[1] = (size_t)&cpu->cd.sh.vbr;
3168     break;
3169     case 0x33: /* STC.L SSR,@-Rn */
3170     ic->f = instr(stc_l_rm_predec_rn);
3171     ic->arg[0] = (size_t)&cpu->cd.sh.ssr;
3172     break;
3173     case 0x37: /* LDC.L @Rm+,SSR */
3174     ic->f = instr(mov_l_arg1_postinc_to_arg0_md);
3175     ic->arg[0] = (size_t)&cpu->cd.sh.ssr;
3176     break;
3177     case 0x3e: /* LDC rm,SSR */
3178     ic->f = instr(copy_privileged_register);
3179     ic->arg[0] = (size_t)&cpu->cd.sh.r[r8]; /* m */
3180     ic->arg[1] = (size_t)&cpu->cd.sh.ssr;
3181     break;
3182     case 0x43: /* STC.L SPC,@-Rn */
3183     ic->f = instr(stc_l_rm_predec_rn);
3184     ic->arg[0] = (size_t)&cpu->cd.sh.spc;
3185     break;
3186     case 0x47: /* LDC.L @Rm+,SPC */
3187     ic->f = instr(mov_l_arg1_postinc_to_arg0_md);
3188     ic->arg[0] = (size_t)&cpu->cd.sh.spc;
3189     break;
3190     case 0x4e: /* LDC rm,SPC */
3191     ic->f = instr(copy_privileged_register);
3192     ic->arg[0] = (size_t)&cpu->cd.sh.r[r8]; /* m */
3193     ic->arg[1] = (size_t)&cpu->cd.sh.spc;
3194     break;
3195     case 0x52: /* STS.L FPUL,@-Rn */
3196     ic->f = instr(mov_l_rm_predec_rn);
3197     ic->arg[0] = (size_t)&cpu->cd.sh.fpul;
3198     ic->arg[1] = (size_t)&cpu->cd.sh.r[r8]; /* n */
3199     break;
3200     case 0x56: /* LDS.L @Rm+,FPUL */
3201     ic->f = instr(mov_l_arg1_postinc_to_arg0_fp);
3202     ic->arg[0] = (size_t)&cpu->cd.sh.fpul;
3203     break;
3204     case 0x5a: /* LDS Rm,FPUL */
3205     ic->f = instr(copy_fp_register);
3206     ic->arg[0] = (size_t)&cpu->cd.sh.r[r8]; /* m */
3207     ic->arg[1] = (size_t)&cpu->cd.sh.fpul;
3208     break;
3209     case 0x62: /* STS.L FPSCR,@-Rn */
3210     ic->f = instr(mov_l_rm_predec_rn);
3211     ic->arg[0] = (size_t)&cpu->cd.sh.fpscr;
3212     ic->arg[1] = (size_t)&cpu->cd.sh.r[r8]; /* n */
3213     break;
3214     case 0x66: /* LDS.L @Rm+,FPSCR */
3215     ic->f = instr(mov_l_arg1_postinc_to_arg0_fp);
3216     ic->arg[0] = (size_t)&cpu->cd.sh.fpscr;
3217     break;
3218     case 0x6a: /* LDS Rm,FPSCR */
3219     ic->f = instr(lds_rm_fpscr);
3220     /* arg 1 = R8 = Rm */
3221     break;
3222     case 0xfa: /* LDC Rm,DBR */
3223     ic->f = instr(copy_privileged_register);
3224     ic->arg[0] = (size_t)&cpu->cd.sh.r[r8];
3225     ic->arg[1] = (size_t)&cpu->cd.sh.dbr;
3226     break;
3227     default:fatal("Unimplemented opcode 0x%x,0x%02x\n",
3228     main_opcode, lo8);
3229     goto bad;
3230     }
3231     }
3232     break;
3233    
3234     case 0x5:
3235     ic->f = instr(mov_l_disp_rm_rn);
3236     ic->arg[0] = r4 + (lo4 << 4);
3237     break;
3238    
3239 dpavlin 30 case 0x6:
3240     switch (lo4) {
3241 dpavlin 32 case 0x0: /* MOV.B @Rm,Rn */
3242     ic->f = instr(load_b_rm_rn);
3243     break;
3244     case 0x1: /* MOV.W @Rm,Rn */
3245     ic->f = instr(load_w_rm_rn);
3246     break;
3247     case 0x2: /* MOV.L @Rm,Rn */
3248     ic->f = instr(load_l_rm_rn);
3249     break;
3250 dpavlin 30 case 0x3: /* MOV Rm,Rn */
3251     ic->f = instr(mov_rm_rn);
3252     break;
3253 dpavlin 32 case 0x4: /* MOV.B @Rm+,Rn */
3254     ic->f = instr(mov_b_arg1_postinc_to_arg0);
3255     /* Note: Order */
3256     ic->arg[1] = (size_t)&cpu->cd.sh.r[r4]; /* m */
3257     ic->arg[0] = (size_t)&cpu->cd.sh.r[r8]; /* n */
3258     break;
3259     case 0x5: /* MOV.W @Rm+,Rn */
3260     ic->f = instr(mov_w_arg1_postinc_to_arg0);
3261     /* Note: Order */
3262     ic->arg[1] = (size_t)&cpu->cd.sh.r[r4]; /* m */
3263     ic->arg[0] = (size_t)&cpu->cd.sh.r[r8]; /* n */
3264     break;
3265     case 0x6: /* MOV.L @Rm+,Rn */
3266     ic->f = instr(mov_l_arg1_postinc_to_arg0);
3267     /* Note: Order */
3268     ic->arg[1] = (size_t)&cpu->cd.sh.r[r4]; /* m */
3269     ic->arg[0] = (size_t)&cpu->cd.sh.r[r8]; /* n */
3270     break;
3271     case 0x7: /* NOT Rm,Rn */
3272     ic->f = instr(not_rm_rn);
3273     break;
3274     case 0x8: /* SWAP.B Rm,Rn */
3275     ic->f = instr(swap_b_rm_rn);
3276     break;
3277     case 0x9: /* SWAP.W Rm,Rn */
3278     ic->f = instr(swap_w_rm_rn);
3279     break;
3280     case 0xa: /* NEGC Rm,Rn */
3281     ic->f = instr(negc_rm_rn);
3282     break;
3283     case 0xb: /* NEG Rm,Rn */
3284     ic->f = instr(neg_rm_rn);
3285     break;
3286     case 0xc: /* EXTU.B Rm,Rn */
3287     ic->f = instr(extu_b_rm_rn);
3288     break;
3289     case 0xd: /* EXTU.W Rm,Rn */
3290     ic->f = instr(extu_w_rm_rn);
3291     break;
3292     case 0xe: /* EXTS.B Rm,Rn */
3293     ic->f = instr(exts_b_rm_rn);
3294     break;
3295     case 0xf: /* EXTS.W Rm,Rn */
3296     ic->f = instr(exts_w_rm_rn);
3297     break;
3298 dpavlin 30 default:fatal("Unimplemented opcode 0x%x,0x%x\n",
3299     main_opcode, lo4);
3300     goto bad;
3301     }
3302     break;
3303    
3304 dpavlin 32 case 0x7: /* ADD #imm,Rn */
3305     ic->f = instr(add_imm_rn);
3306     ic->arg[0] = (int8_t)lo8;
3307     ic->arg[1] = (size_t)&cpu->cd.sh.r[r8]; /* n */
3308     break;
3309    
3310     case 0x8:
3311     /* Displacement from beginning of page = default arg 0. */
3312     ic->arg[0] = (int8_t)lo8 * 2 +
3313     (addr & ((SH_IC_ENTRIES_PER_PAGE-1)
3314     << SH_INSTR_ALIGNMENT_SHIFT) & ~1) + 4;
3315     switch (r8) {
3316     case 0x0: /* MOV.B R0,@(disp,Rn) */
3317     ic->f = instr(mov_b_r0_disp_rn);
3318     ic->arg[0] = (size_t)&cpu->cd.sh.r[r4]; /* n */
3319     ic->arg[1] = lo4;
3320     break;
3321     case 0x1: /* MOV.W R0,@(disp,Rn) */
3322     ic->f = instr(mov_w_r0_disp_rn);
3323     ic->arg[0] = (size_t)&cpu->cd.sh.r[r4]; /* n */
3324     ic->arg[1] = lo4 * 2;
3325     break;
3326     case 0x4: /* MOV.B @(disp,Rn),R0 */
3327     ic->f = instr(mov_b_disp_rn_r0);
3328     ic->arg[0] = (size_t)&cpu->cd.sh.r[r4]; /* n */
3329     ic->arg[1] = lo4;
3330     break;
3331     case 0x5: /* MOV.W @(disp,Rn),R0 */
3332     ic->f = instr(mov_w_disp_rn_r0);
3333     ic->arg[0] = (size_t)&cpu->cd.sh.r[r4]; /* n */
3334     ic->arg[1] = lo4 * 2;
3335     break;
3336     case 0x8: /* CMP/EQ #imm,R0 */
3337     ic->f = instr(cmpeq_imm_r0);
3338     ic->arg[0] = (int8_t)lo8;
3339     break;
3340     case 0x9: /* BT (disp,PC) */
3341     ic->f = instr(bt);
3342     break;
3343     case 0xb: /* BF (disp,PC) */
3344     ic->f = instr(bf);
3345     break;
3346     case 0xd: /* BT/S (disp,PC) */
3347     ic->f = instr(bt_s);
3348     break;
3349     case 0xf: /* BF/S (disp,PC) */
3350     ic->f = instr(bf_s);
3351     break;
3352     default:fatal("Unimplemented opcode 0x%x,0x%x\n",
3353     main_opcode, r8);
3354     goto bad;
3355     }
3356     break;
3357    
3358     case 0x9: /* MOV.W @(disp,PC),Rn */
3359     ic->f = instr(mov_w_disp_pc_rn);
3360     ic->arg[0] = lo8 * 2 + (addr & ((SH_IC_ENTRIES_PER_PAGE-1)
3361     << SH_INSTR_ALIGNMENT_SHIFT) & ~1) + 4;
3362     ic->arg[1] = (size_t)&cpu->cd.sh.r[r8]; /* n */
3363     break;
3364    
3365     case 0xa: /* BRA disp */
3366     case 0xb: /* BSR disp */
3367     ic->f = main_opcode == 0xa? instr(bra) : instr(bsr);
3368     ic->arg[0] = (int32_t) ( (addr & ((SH_IC_ENTRIES_PER_PAGE-1)
3369     << SH_INSTR_ALIGNMENT_SHIFT) & ~1) + 4 +
3370     (((int32_t)(int16_t)((iword & 0xfff) << 4)) >> 3) );
3371     break;
3372    
3373     case 0xc:
3374     switch (r8) {
3375     case 0x0:
3376     ic->f = instr(mov_b_r0_disp_gbr);
3377     ic->arg[1] = lo8;
3378     break;
3379     case 0x1:
3380     ic->f = instr(mov_w_r0_disp_gbr);
3381     ic->arg[1] = lo8 << 1;
3382     break;
3383     case 0x2:
3384     ic->f = instr(mov_l_r0_disp_gbr);
3385     ic->arg[1] = lo8 << 2;
3386     break;
3387     case 0x3:
3388     ic->f = instr(trapa);
3389     ic->arg[0] = lo8 << 2;
3390     break;
3391     case 0x4:
3392     ic->f = instr(mov_b_disp_gbr_r0);
3393     ic->arg[1] = lo8;
3394     break;
3395     case 0x5:
3396     ic->f = instr(mov_w_disp_gbr_r0);
3397     ic->arg[1] = lo8 << 1;
3398     break;
3399     case 0x6:
3400     ic->f = instr(mov_l_disp_gbr_r0);
3401     ic->arg[1] = lo8 << 2;
3402     break;
3403     case 0x7: /* MOVA @(disp,pc),R0 */
3404     ic->f = instr(mova_r0);
3405     ic->arg[0] = lo8 * 4 + (addr &
3406     ((SH_IC_ENTRIES_PER_PAGE-1)
3407     << SH_INSTR_ALIGNMENT_SHIFT) & ~3) + 4;
3408     break;
3409     case 0x8: /* TST #imm,R0 */
3410     ic->f = instr(tst_imm_r0);
3411     ic->arg[0] = lo8;
3412     break;
3413     case 0x9: /* AND #imm,R0 */
3414     ic->f = instr(and_imm_r0);
3415     ic->arg[0] = lo8;
3416     break;
3417     case 0xa: /* XOR #imm,R0 */
3418     ic->f = instr(xor_imm_r0);
3419     ic->arg[0] = lo8;
3420     break;
3421     case 0xb: /* OR #imm,R0 */
3422     ic->f = instr(or_imm_r0);
3423     ic->arg[0] = lo8;
3424     break;
3425     default:fatal("Unimplemented opcode 0x%x,0x%x\n",
3426     main_opcode, r8);
3427     goto bad;
3428     }
3429     break;
3430    
3431 dpavlin 30 case 0xd: /* MOV.L @(disp,PC),Rn */
3432     ic->f = instr(mov_l_disp_pc_rn);
3433     ic->arg[0] = lo8 * 4 + (addr & ((SH_IC_ENTRIES_PER_PAGE-1)
3434     << SH_INSTR_ALIGNMENT_SHIFT) & ~3) + 4;
3435     break;
3436    
3437     case 0xe: /* MOV #imm,Rn */
3438     ic->f = instr(mov_imm_rn);
3439     ic->arg[0] = (int8_t)lo8;
3440     ic->arg[1] = (size_t)&cpu->cd.sh.r[r8]; /* n */
3441     break;
3442    
3443 dpavlin 32 case 0xf:
3444     if (lo4 == 0x0) {
3445     /* FADD FRm,FRn */
3446     ic->f = instr(fadd_frm_frn);
3447     ic->arg[0] = (size_t)&cpu->cd.sh.fr[r4];
3448     ic->arg[1] = (size_t)&cpu->cd.sh.fr[r8];
3449     } else if (lo4 == 0x1) {
3450     /* FSUB FRm,FRn */
3451     ic->f = instr(fsub_frm_frn);
3452     ic->arg[0] = (size_t)&cpu->cd.sh.fr[r4];
3453     ic->arg[1] = (size_t)&cpu->cd.sh.fr[r8];
3454     } else if (lo4 == 0x2) {
3455     /* FMUL FRm,FRn */
3456     ic->f = instr(fmul_frm_frn);
3457     ic->arg[0] = (size_t)&cpu->cd.sh.fr[r4];
3458     ic->arg[1] = (size_t)&cpu->cd.sh.fr[r8];
3459     } else if (lo4 == 0x3) {
3460     /* FDIV FRm,FRn */
3461     ic->f = instr(fdiv_frm_frn);
3462     ic->arg[0] = (size_t)&cpu->cd.sh.fr[r4];
3463     ic->arg[1] = (size_t)&cpu->cd.sh.fr[r8];
3464     } else if (lo4 == 0x4) {
3465     /* FCMP/EQ FRm,FRn */
3466     ic->f = instr(fcmp_eq_frm_frn);
3467     ic->arg[0] = (size_t)&cpu->cd.sh.fr[r4];
3468     ic->arg[1] = (size_t)&cpu->cd.sh.fr[r8];
3469     } else if (lo4 == 0x5) {
3470     /* FCMP/GT FRm,FRn */
3471     ic->f = instr(fcmp_gt_frm_frn);
3472     ic->arg[0] = (size_t)&cpu->cd.sh.fr[r4];
3473     ic->arg[1] = (size_t)&cpu->cd.sh.fr[r8];
3474     } else if (lo4 == 0x6) {
3475     /* FMOV @(R0,Rm),FRn */
3476     ic->f = instr(fmov_r0_rm_frn);
3477     ic->arg[0] = (size_t)&cpu->cd.sh.r[r4]; /* m */
3478     ic->arg[1] = (size_t)&cpu->cd.sh.fr[r8];
3479     } else if (lo4 == 0x7) {
3480     /* FMOV FRm,@(R0,Rn) */
3481     ic->f = instr(fmov_frm_r0_rn);
3482     ic->arg[0] = (size_t)&cpu->cd.sh.fr[r4]; /* m */
3483     ic->arg[1] = (size_t)&cpu->cd.sh.r[r8];
3484     } else if (lo4 == 0x8) {
3485     /* FMOV @Rm,FRn */
3486     ic->f = instr(fmov_rm_frn);
3487     ic->arg[0] = (size_t)&cpu->cd.sh.r[r4]; /* m */
3488     ic->arg[1] = (size_t)&cpu->cd.sh.fr[r8];
3489     } else if (lo4 == 0x9) {
3490     /* FMOV @Rm+,FRn */
3491     ic->f = instr(fmov_rm_postinc_frn);
3492     ic->arg[0] = (size_t)&cpu->cd.sh.r[r4]; /* m */
3493     ic->arg[1] = (size_t)&cpu->cd.sh.fr[r8];
3494     } else if (lo4 == 0xa) {
3495     /* FMOV FRm,@Rn */
3496     ic->f = instr(fmov_frm_rn);
3497     ic->arg[0] = (size_t)&cpu->cd.sh.fr[r4]; /* m */
3498     ic->arg[1] = (size_t)&cpu->cd.sh.r[r8];
3499     } else if (lo4 == 0xb) {
3500     /* FMOV FRm,@-Rn */
3501     ic->f = instr(fmov_frm_predec_rn);
3502     ic->arg[0] = (size_t)&cpu->cd.sh.fr[r4]; /* m */
3503     ic->arg[1] = (size_t)&cpu->cd.sh.r[r8];
3504     } else if (lo4 == 0xc) {
3505     /* FMOV FRm,FRn */
3506     ic->f = instr(fmov_frm_frn);
3507     ic->arg[0] = (size_t)&cpu->cd.sh.fr[r4];
3508     ic->arg[1] = (size_t)&cpu->cd.sh.fr[r8];
3509     } else if (lo8 == 0x0d) {
3510     /* FSTS FPUL,FRn */
3511     ic->f = instr(copy_fp_register);
3512     ic->arg[0] = (size_t)&cpu->cd.sh.fpul;
3513     ic->arg[1] = (size_t)&cpu->cd.sh.fr[r8];
3514     } else if (lo8 == 0x1d) {
3515     /* FLDS FRn,FPUL */
3516     ic->f = instr(copy_fp_register);
3517     ic->arg[0] = (size_t)&cpu->cd.sh.fr[r8];
3518     ic->arg[1] = (size_t)&cpu->cd.sh.fpul;
3519     } else if (lo8 == 0x2d) {
3520     /* FLOAT FPUL,FRn */
3521     ic->f = instr(float_fpul_frn);
3522     ic->arg[0] = (size_t)&cpu->cd.sh.fr[r8];
3523     } else if (lo8 == 0x3d) {
3524     /* FTRC FRm,FPUL */
3525     ic->f = instr(ftrc_frm_fpul);
3526     ic->arg[0] = (size_t)&cpu->cd.sh.fr[r8];
3527     } else if (lo8 == 0x4d) {
3528     /* FNEG FRn */
3529     ic->f = instr(fneg_frn);
3530     ic->arg[0] = (size_t)&cpu->cd.sh.fr[r8];
3531     } else if (lo8 == 0x5d) {
3532     /* FABS FRn */
3533     ic->f = instr(fabs_frn);
3534     ic->arg[0] = (size_t)&cpu->cd.sh.fr[r8];
3535     } else if (lo8 == 0x6d) {
3536     /* FSQRT FRn */
3537     ic->f = instr(fsqrt_frn);
3538     ic->arg[0] = (size_t)&cpu->cd.sh.fr[r8];
3539     } else if (lo8 == 0x8d) {
3540     /* FLDI0 FRn */
3541     ic->f = instr(fldi_frn);
3542     ic->arg[0] = (size_t)&cpu->cd.sh.fr[r8];
3543     ic->arg[1] = 0x00000000;
3544     } else if (lo8 == 0x9d) {
3545     /* FLDI1 FRn */
3546     ic->f = instr(fldi_frn);
3547     ic->arg[0] = (size_t)&cpu->cd.sh.fr[r8];
3548     ic->arg[1] = 0x3f800000;
3549     } else if ((iword & 0x01ff) == 0x00fd) {
3550     /* FSCA FPUL,DRn */
3551     ic->f = instr(fsca_fpul_drn);
3552     ic->arg[0] = (size_t)&cpu->cd.sh.fr[r8];
3553     } else if (iword == 0xf3fd) {
3554     /* FSCHG */
3555     ic->f = instr(fschg);
3556     } else if (iword == 0xfbfd) {
3557     /* FRCHG */
3558     ic->f = instr(frchg);
3559     } else if ((iword & 0xf3ff) == 0xf1fd) {
3560     /* FTRV XMTRX, FVn */
3561     ic->f = instr(ftrv_xmtrx_fvn);
3562     ic->arg[0] = (size_t)&cpu->cd.sh.fr[r8 & 0xc];
3563     } else if (lo4 == 0xe) {
3564     /* FMAC FR0,FRm,FRn */
3565     ic->f = instr(fmac_fr0_frm_frn);
3566     ic->arg[0] = (size_t)&cpu->cd.sh.fr[r4];
3567     ic->arg[1] = (size_t)&cpu->cd.sh.fr[r8];
3568     } else {
3569     fatal("Unimplemented opcode 0x%x,0x%02x\n",
3570     main_opcode, lo8);
3571     goto bad;
3572     }
3573     break;
3574    
3575 dpavlin 30 default:fatal("Unimplemented main opcode 0x%x\n", main_opcode);
3576     goto bad;
3577 dpavlin 14 }
3578    
3579 dpavlin 30
3580 dpavlin 14 #define DYNTRANS_TO_BE_TRANSLATED_TAIL
3581     #include "cpu_dyntrans.c"
3582     #undef DYNTRANS_TO_BE_TRANSLATED_TAIL
3583     }
3584    

  ViewVC Help
Powered by ViewVC 1.1.26