/[gxemul]/upstream/0.4.4/src/memory_rw.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 /upstream/0.4.4/src/memory_rw.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 32 - (hide annotations)
Mon Oct 8 16:20:58 2007 UTC (16 years, 7 months ago) by dpavlin
Original Path: trunk/src/memory_rw.c
File MIME type: text/plain
File size: 15262 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 2 /*
2 dpavlin 22 * Copyright (C) 2003-2006 Anders Gavare. All rights reserved.
3 dpavlin 2 *
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: memory_rw.c,v 1.97 2006/09/07 11:44:01 debug Exp $
29 dpavlin 2 *
30     * Generic memory_rw(), with special hacks for specific CPU families.
31     *
32     * Example for inclusion from memory_mips.c:
33     *
34     * MEMORY_RW should be mips_memory_rw
35     * MEM_MIPS should be defined
36     */
37    
38    
39     /*
40     * memory_rw():
41     *
42     * Read or write data from/to memory.
43     *
44     * cpu the cpu doing the read/write
45     * mem the memory object to use
46     * vaddr the virtual address
47     * data a pointer to the data to be written to memory, or
48     * a placeholder for data when reading from memory
49     * len the length of the 'data' buffer
50     * writeflag set to MEM_READ or MEM_WRITE
51 dpavlin 20 * misc_flags CACHE_{NONE,DATA,INSTRUCTION} | other flags
52 dpavlin 2 *
53     * If the address indicates access to a memory mapped device, that device'
54     * read/write access function is called.
55     *
56     * This function should not be called with cpu == NULL.
57     *
58     * Returns one of the following:
59     * MEMORY_ACCESS_FAILED
60     * MEMORY_ACCESS_OK
61     *
62     * (MEMORY_ACCESS_FAILED is 0.)
63     */
64     int MEMORY_RW(struct cpu *cpu, struct memory *mem, uint64_t vaddr,
65 dpavlin 20 unsigned char *data, size_t len, int writeflag, int misc_flags)
66 dpavlin 2 {
67 dpavlin 12 #ifdef MEM_ALPHA
68     const int offset_mask = 0x1fff;
69     #else
70     const int offset_mask = 0xfff;
71     #endif
72    
73 dpavlin 2 #ifndef MEM_USERLAND
74     int ok = 1;
75     #endif
76     uint64_t paddr;
77     int cache, no_exceptions, offset;
78     unsigned char *memblock;
79 dpavlin 22 int dyntrans_device_danger = 0;
80 dpavlin 12
81 dpavlin 20 no_exceptions = misc_flags & NO_EXCEPTIONS;
82     cache = misc_flags & CACHE_FLAGS_MASK;
83 dpavlin 2
84 dpavlin 4 #ifdef MEM_X86
85 dpavlin 6 /* Real-mode wrap-around: */
86 dpavlin 20 if (REAL_MODE && !(misc_flags & PHYSICAL)) {
87 dpavlin 6 if ((vaddr & 0xffff) + len > 0x10000) {
88     /* Do one byte at a time: */
89 dpavlin 22 int res = 0;
90     size_t i;
91 dpavlin 6 for (i=0; i<len; i++)
92     res = MEMORY_RW(cpu, mem, vaddr+i, &data[i], 1,
93 dpavlin 20 writeflag, misc_flags);
94 dpavlin 6 return res;
95     }
96     }
97 dpavlin 4
98 dpavlin 6 /* Crossing a page boundary? Then do one byte at a time: */
99 dpavlin 20 if ((vaddr & 0xfff) + len > 0x1000 && !(misc_flags & PHYSICAL)
100 dpavlin 6 && cpu->cd.x86.cr[0] & X86_CR0_PG) {
101 dpavlin 32 /*
102     * For WRITES: Read ALL BYTES FIRST and write them back!!!
103     * Then do a write of all the new bytes. This is to make sure
104     * than both pages around the boundary are writable so that
105     * there is no "partial write" performed.
106     */
107 dpavlin 22 int res = 0;
108     size_t i;
109 dpavlin 6 if (writeflag == MEM_WRITE) {
110     unsigned char tmp;
111     for (i=0; i<len; i++) {
112     res = MEMORY_RW(cpu, mem, vaddr+i, &tmp, 1,
113 dpavlin 20 MEM_READ, misc_flags);
114 dpavlin 6 if (!res)
115 dpavlin 4 return 0;
116 dpavlin 6 res = MEMORY_RW(cpu, mem, vaddr+i, &tmp, 1,
117 dpavlin 20 MEM_WRITE, misc_flags);
118 dpavlin 6 if (!res)
119     return 0;
120     }
121     for (i=0; i<len; i++) {
122     res = MEMORY_RW(cpu, mem, vaddr+i, &data[i], 1,
123 dpavlin 20 MEM_WRITE, misc_flags);
124 dpavlin 6 if (!res)
125     return 0;
126     }
127     } else {
128     for (i=0; i<len; i++) {
129     /* Do one byte at a time: */
130     res = MEMORY_RW(cpu, mem, vaddr+i, &data[i], 1,
131 dpavlin 20 writeflag, misc_flags);
132 dpavlin 6 if (!res) {
133     if (cache == CACHE_INSTRUCTION) {
134     fatal("FAILED instruction "
135     "fetch across page boundar"
136     "y: todo. vaddr=0x%08x\n",
137     (int)vaddr);
138     cpu->running = 0;
139     }
140     return 0;
141 dpavlin 4 }
142     }
143     }
144 dpavlin 6 return res;
145 dpavlin 4 }
146 dpavlin 6 #endif /* X86 */
147 dpavlin 4
148 dpavlin 2
149     #ifdef MEM_USERLAND
150 dpavlin 12 #ifdef MEM_ALPHA
151     paddr = vaddr;
152     #else
153 dpavlin 2 paddr = vaddr & 0x7fffffff;
154 dpavlin 12 #endif
155 dpavlin 24 #else /* !MEM_USERLAND */
156 dpavlin 26 if (misc_flags & PHYSICAL || cpu->translate_v2p == NULL) {
157 dpavlin 2 paddr = vaddr;
158     } else {
159 dpavlin 26 ok = cpu->translate_v2p(cpu, vaddr, &paddr,
160 dpavlin 2 (writeflag? FLAG_WRITEFLAG : 0) +
161     (no_exceptions? FLAG_NOEXCEPTIONS : 0)
162 dpavlin 6 #ifdef MEM_X86
163 dpavlin 20 + (misc_flags & NO_SEGMENTATION)
164 dpavlin 6 #endif
165 dpavlin 14 #ifdef MEM_ARM
166 dpavlin 20 + (misc_flags & MEMORY_USER_ACCESS)
167 dpavlin 14 #endif
168 dpavlin 2 + (cache==CACHE_INSTRUCTION? FLAG_INSTR : 0));
169 dpavlin 32
170     /*
171     * If the translation caused an exception, or was invalid in
172     * some way, then simply return without doing the memory
173     * access:
174     */
175 dpavlin 2 if (!ok)
176     return MEMORY_ACCESS_FAILED;
177     }
178    
179    
180 dpavlin 6 #ifdef MEM_X86
181     /* DOS debugging :-) */
182 dpavlin 20 if (!quiet_mode && !(misc_flags & PHYSICAL)) {
183 dpavlin 6 if (paddr >= 0x400 && paddr <= 0x4ff)
184     debug("{ PC BIOS DATA AREA: %s 0x%x }\n", writeflag ==
185     MEM_WRITE? "writing to" : "reading from",
186     (int)paddr);
187     #if 0
188     if (paddr >= 0xf0000 && paddr <= 0xfffff)
189     debug("{ BIOS ACCESS: %s 0x%x }\n",
190     writeflag == MEM_WRITE? "writing to" :
191     "reading from", (int)paddr);
192     #endif
193     }
194     #endif
195 dpavlin 24 #endif /* !MEM_USERLAND */
196 dpavlin 6
197 dpavlin 2
198     #ifndef MEM_USERLAND
199     /*
200     * Memory mapped device?
201     *
202 dpavlin 22 * TODO: if paddr < base, but len enough, then the device should
203     * still be written to!
204 dpavlin 2 */
205     if (paddr >= mem->mmap_dev_minaddr && paddr < mem->mmap_dev_maxaddr) {
206     uint64_t orig_paddr = paddr;
207 dpavlin 22 int i, start, end, res;
208 dpavlin 4
209     /*
210     * Really really slow, but unfortunately necessary. This is
211     * to avoid the folowing scenario:
212     *
213     * a) offsets 0x000..0x123 are normal memory
214     * b) offsets 0x124..0x777 are a device
215     *
216     * 1) a read is done from offset 0x100. the page is
217 dpavlin 22 * added to the dyntrans system as a "RAM" page
218     * 2) a dyntranslated read is done from offset 0x200,
219 dpavlin 4 * which should access the device, but since the
220     * entire page is added, it will access non-existant
221     * RAM instead, without warning.
222     *
223 dpavlin 22 * Setting dyntrans_device_danger = 1 on accesses which are
224 dpavlin 4 * on _any_ offset on pages that are device mapped avoids
225     * this problem, but it is probably not very fast.
226 dpavlin 22 *
227     * TODO: Convert this into a quick (multi-level, 64-bit)
228     * address space lookup, to find dangerous pages.
229 dpavlin 4 */
230 dpavlin 22 #if 1
231 dpavlin 12 for (i=0; i<mem->n_mmapped_devices; i++)
232 dpavlin 32 if (paddr >= (mem->devices[i].baseaddr & ~offset_mask)&&
233     paddr <= ((mem->devices[i].endaddr-1)|offset_mask)){
234 dpavlin 22 dyntrans_device_danger = 1;
235 dpavlin 12 break;
236     }
237 dpavlin 22 #endif
238 dpavlin 4
239 dpavlin 22 start = 0; end = mem->n_mmapped_devices - 1;
240     i = mem->last_accessed_device;
241 dpavlin 2
242     /* Scan through all devices: */
243     do {
244 dpavlin 32 if (paddr >= mem->devices[i].baseaddr &&
245     paddr < mem->devices[i].endaddr) {
246 dpavlin 2 /* Found a device, let's access it: */
247     mem->last_accessed_device = i;
248    
249 dpavlin 32 paddr -= mem->devices[i].baseaddr;
250     if (paddr + len > mem->devices[i].length)
251     len = mem->devices[i].length - paddr;
252 dpavlin 2
253 dpavlin 12 if (cpu->update_translation_table != NULL &&
254 dpavlin 20 !(ok & MEMORY_NOT_FULL_PAGE) &&
255 dpavlin 32 mem->devices[i].flags & DM_DYNTRANS_OK) {
256 dpavlin 2 int wf = writeflag == MEM_WRITE? 1 : 0;
257 dpavlin 18 unsigned char *host_addr;
258 dpavlin 2
259 dpavlin 32 if (!(mem->devices[i].flags &
260 dpavlin 20 DM_DYNTRANS_WRITE_OK))
261 dpavlin 18 wf = 0;
262    
263     if (writeflag && wf) {
264 dpavlin 32 if (paddr < mem->devices[i].
265     dyntrans_write_low)
266     mem->devices[i].
267     dyntrans_write_low =
268     paddr &~offset_mask;
269     if (paddr >= mem->devices[i].
270     dyntrans_write_high)
271     mem->devices[i].
272     dyntrans_write_high =
273     paddr | offset_mask;
274 dpavlin 2 }
275    
276 dpavlin 32 if (mem->devices[i].flags &
277 dpavlin 20 DM_EMULATED_RAM) {
278 dpavlin 18 /* MEM_WRITE to force the page
279     to be allocated, if it
280     wasn't already */
281 dpavlin 32 uint64_t *pp = (uint64_t *)mem->
282     devices[i].dyntrans_data;
283 dpavlin 18 uint64_t p = orig_paddr - *pp;
284     host_addr =
285     memory_paddr_to_hostaddr(
286 dpavlin 28 mem, p & ~offset_mask,
287     MEM_WRITE);
288 dpavlin 18 } else {
289 dpavlin 32 host_addr = mem->devices[i].
290     dyntrans_data +
291 dpavlin 18 (paddr & ~offset_mask);
292     }
293 dpavlin 28
294 dpavlin 12 cpu->update_translation_table(cpu,
295 dpavlin 18 vaddr & ~offset_mask, host_addr,
296 dpavlin 12 wf, orig_paddr & ~offset_mask);
297 dpavlin 2 }
298    
299 dpavlin 6 res = 0;
300 dpavlin 32 if (!no_exceptions || (mem->devices[i].flags &
301 dpavlin 20 DM_READS_HAVE_NO_SIDE_EFFECTS))
302 dpavlin 32 res = mem->devices[i].f(cpu, mem, paddr,
303 dpavlin 6 data, len, writeflag,
304 dpavlin 32 mem->devices[i].extra);
305 dpavlin 2
306     if (res == 0)
307     res = -1;
308    
309 dpavlin 6 #ifndef MEM_X86
310 dpavlin 2 /*
311     * If accessing the memory mapped device
312     * failed, then return with a DBE exception.
313     */
314 dpavlin 6 if (res <= 0 && !no_exceptions) {
315 dpavlin 2 debug("%s device '%s' addr %08lx "
316     "failed\n", writeflag?
317     "writing to" : "reading from",
318 dpavlin 32 mem->devices[i].name, (long)paddr);
319 dpavlin 2 #ifdef MEM_MIPS
320     mips_cpu_exception(cpu, EXCEPTION_DBE,
321     0, vaddr, 0, 0, 0, 0);
322     #endif
323     return MEMORY_ACCESS_FAILED;
324     }
325 dpavlin 6 #endif
326 dpavlin 2 goto do_return_ok;
327     }
328    
329 dpavlin 32 if (paddr < mem->devices[i].baseaddr)
330 dpavlin 22 end = i - 1;
331 dpavlin 32 if (paddr >= mem->devices[i].endaddr)
332 dpavlin 22 start = i + 1;
333     i = (start + end) >> 1;
334     } while (start <= end);
335 dpavlin 2 }
336    
337    
338     #ifdef MEM_MIPS
339     /*
340     * Data and instruction cache emulation:
341     */
342    
343     switch (cpu->cd.mips.cpu_type.mmu_model) {
344     case MMU3K:
345     /* if not uncached addess (TODO: generalize this) */
346 dpavlin 20 if (!(misc_flags & PHYSICAL) && cache != CACHE_NONE &&
347 dpavlin 2 !((vaddr & 0xffffffffULL) >= 0xa0000000ULL &&
348     (vaddr & 0xffffffffULL) <= 0xbfffffffULL)) {
349     if (memory_cache_R3000(cpu, cache, paddr,
350     writeflag, len, data))
351     goto do_return_ok;
352     }
353     break;
354     default:
355     /* R4000 etc */
356     /* TODO */
357     ;
358     }
359     #endif /* MEM_MIPS */
360    
361    
362     /* Outside of physical RAM? */
363     if (paddr >= mem->physical_max) {
364 dpavlin 6 #ifdef MEM_MIPS
365     if ((paddr & 0xffffc00000ULL) == 0x1fc00000) {
366 dpavlin 2 /* Ok, this is PROM stuff */
367     } else if ((paddr & 0xfffff00000ULL) == 0x1ff00000) {
368     /* Sprite reads from this area of memory... */
369     /* TODO: is this still correct? */
370     if (writeflag == MEM_READ)
371     memset(data, 0, len);
372     goto do_return_ok;
373 dpavlin 6 } else
374     #endif /* MIPS */
375     {
376     if (paddr >= mem->physical_max) {
377 dpavlin 24 uint64_t offset, old_pc = cpu->pc;
378 dpavlin 2 char *symbol;
379 dpavlin 12
380 dpavlin 6 /* This allows for example OS kernels to probe
381     memory a few KBs past the end of memory,
382     without giving too many warnings. */
383 dpavlin 12 if (!quiet_mode && !no_exceptions && paddr >=
384 dpavlin 6 mem->physical_max + 0x40000) {
385 dpavlin 2 fatal("[ memory_rw(): writeflag=%i ",
386     writeflag);
387     if (writeflag) {
388     unsigned int i;
389     debug("data={", writeflag);
390     if (len > 16) {
391     int start2 = len-16;
392     for (i=0; i<16; i++)
393     debug("%s%02x",
394     i?",":"",
395     data[i]);
396     debug(" .. ");
397     if (start2 < 16)
398     start2 = 16;
399     for (i=start2; i<len;
400     i++)
401     debug("%s%02x",
402     i?",":"",
403     data[i]);
404     } else
405     for (i=0; i<len; i++)
406     debug("%s%02x",
407     i?",":"",
408     data[i]);
409     debug("}");
410     }
411 dpavlin 12
412     fatal(" paddr=0x%llx >= physical_max"
413     "; pc=", (long long)paddr);
414     if (cpu->is_32bit)
415     fatal("0x%08x",(int)old_pc);
416     else
417     fatal("0x%016llx",
418     (long long)old_pc);
419 dpavlin 2 symbol = get_symbol_name(
420     &cpu->machine->symbol_context,
421 dpavlin 12 old_pc, &offset);
422     fatal(" <%s> ]\n",
423     symbol? symbol : " no symbol ");
424 dpavlin 2 }
425     }
426    
427     if (writeflag == MEM_READ) {
428 dpavlin 6 #ifdef MEM_X86
429     /* Reading non-existant memory on x86: */
430     memset(data, 0xff, len);
431     #else
432 dpavlin 2 /* Return all zeroes? (Or 0xff? TODO) */
433     memset(data, 0, len);
434 dpavlin 6 #endif
435 dpavlin 2
436     #ifdef MEM_MIPS
437     /*
438     * For real data/instruction accesses, cause
439     * an exceptions on an illegal read:
440     */
441     if (cache != CACHE_NONE && cpu->machine->
442 dpavlin 6 dbe_on_nonexistant_memaccess &&
443     !no_exceptions) {
444 dpavlin 2 if (paddr >= mem->physical_max &&
445     paddr < mem->physical_max+1048576)
446     mips_cpu_exception(cpu,
447     EXCEPTION_DBE, 0, vaddr, 0,
448     0, 0, 0);
449     }
450     #endif /* MEM_MIPS */
451     }
452    
453     /* Hm? Shouldn't there be a DBE exception for
454     invalid writes as well? TODO */
455    
456     goto do_return_ok;
457     }
458     }
459    
460     #endif /* ifndef MEM_USERLAND */
461    
462    
463     /*
464     * Uncached access:
465 dpavlin 18 *
466     * 1) Translate the physical address to a host address.
467     *
468     * 2) Insert this virtual->physical->host translation into the
469     * fast translation arrays (using update_translation_table()).
470     *
471     * 3) If this was a Write, then invalidate any code translations
472     * in that page.
473 dpavlin 2 */
474 dpavlin 28 memblock = memory_paddr_to_hostaddr(mem, paddr & ~offset_mask,
475     writeflag);
476 dpavlin 2 if (memblock == NULL) {
477     if (writeflag == MEM_READ)
478     memset(data, 0, len);
479     goto do_return_ok;
480     }
481    
482 dpavlin 28 offset = paddr & offset_mask;
483 dpavlin 2
484 dpavlin 22 if (cpu->update_translation_table != NULL && !dyntrans_device_danger
485 dpavlin 26 #ifdef MEM_MIPS
486     /* Ugly hack for R2000/R3000 caches: */
487     && (cpu->cd.mips.cpu_type.mmu_model != MMU3K ||
488     !(cpu->cd.mips.coproc[0]->reg[COP0_STATUS] & MIPS1_ISOL_CACHES))
489     #endif
490 dpavlin 18 #ifndef MEM_MIPS
491 dpavlin 20 /* && !(misc_flags & MEMORY_USER_ACCESS) */
492 dpavlin 18 #ifndef MEM_USERLAND
493     && !(ok & MEMORY_NOT_FULL_PAGE)
494     #endif
495     #endif
496 dpavlin 16 && !no_exceptions)
497 dpavlin 12 cpu->update_translation_table(cpu, vaddr & ~offset_mask,
498 dpavlin 28 memblock, (misc_flags & MEMORY_USER_ACCESS) |
499 dpavlin 20 #if !defined(MEM_MIPS) && !defined(MEM_USERLAND)
500 dpavlin 18 (cache == CACHE_INSTRUCTION?
501 dpavlin 20 (writeflag == MEM_WRITE? 1 : 0) : ok - 1),
502 dpavlin 2 #else
503 dpavlin 18 (writeflag == MEM_WRITE? 1 : 0),
504 dpavlin 2 #endif
505 dpavlin 12 paddr & ~offset_mask);
506 dpavlin 2
507 dpavlin 32 /*
508     * If writing, then invalidate code translations for the (physical)
509     * page address:
510     */
511 dpavlin 20 if (writeflag == MEM_WRITE && cpu->invalidate_code_translation != NULL)
512 dpavlin 14 cpu->invalidate_code_translation(cpu, paddr, INVALIDATE_PADDR);
513    
514 dpavlin 28 if ((paddr&((1<<BITS_PER_MEMBLOCK)-1)) + len > (1<<BITS_PER_MEMBLOCK)) {
515     printf("Write over memblock boundary?\n");
516     exit(1);
517     }
518    
519 dpavlin 2 if (writeflag == MEM_WRITE) {
520 dpavlin 12 /* Ugly optimization, but it works: */
521     if (len == sizeof(uint32_t) && (offset & 3)==0
522     && ((size_t)data&3)==0)
523 dpavlin 2 *(uint32_t *)(memblock + offset) = *(uint32_t *)data;
524     else if (len == sizeof(uint8_t))
525     *(uint8_t *)(memblock + offset) = *(uint8_t *)data;
526     else
527     memcpy(memblock + offset, data, len);
528     } else {
529 dpavlin 12 /* Ugly optimization, but it works: */
530     if (len == sizeof(uint32_t) && (offset & 3)==0
531     && ((size_t)data&3)==0)
532 dpavlin 2 *(uint32_t *)data = *(uint32_t *)(memblock + offset);
533     else if (len == sizeof(uint8_t))
534     *(uint8_t *)data = *(uint8_t *)(memblock + offset);
535     else
536     memcpy(data, memblock + offset, len);
537     }
538    
539    
540     do_return_ok:
541     return MEMORY_ACCESS_OK;
542     }
543    

  ViewVC Help
Powered by ViewVC 1.1.26