/[gxemul]/trunk/src/cpus/cpu_dyntrans.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_dyntrans.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 20 - (hide annotations)
Mon Oct 8 16:19:23 2007 UTC (16 years, 6 months ago) by dpavlin
File MIME type: text/plain
File size: 38880 byte(s)
++ trunk/HISTORY	(local)
$Id: HISTORY,v 1.1055 2005/11/25 22:48:36 debug Exp $
20051031	Adding disassembly support for more ARM instructions (clz,
		smul* etc), and adding a hack to support "new tiny" pages
		for StrongARM.
20051101	Minor documentation updates (NetBSD 2.0.2 -> 2.1, and OpenBSD
		3.7 -> 3.8, and lots of testing).
		Changing from 1-sector PIO mode 0 transfers to 128-sector PIO
		mode 3 (in dev_wdc).
		Various minor ARM dyntrans updates (pc-relative loads from
		within the same page as the instruction are now treated as
		constant "mov").
20051102	Re-enabling instruction combinations (they were accidentally
		disabled).
		Dyntrans TLB entries are now overwritten using a round-robin
		scheme instead of randomly. This increases performance.
		Fixing a typo in file.c (thanks to Chuan-Hua Chang for
		noticing it).
		Experimenting with adding ATAPI support to dev_wdc (to make
		emulated *BSD detect cdroms as cdroms, not harddisks).
20051104	Various minor updates.
20051105	Continuing on the ATAPI emulation. Seems to work well enough
		for a NetBSD/cats installation, but not OpenBSD/cats.
		Various other updates.
20051106	Modifying the -Y command line option to allow scaleup with
		certain graphic controllers (only dev_vga so far), not just
		scaledown.
		Some minor dyntrans cleanups.
20051107	Beginning a cleanup up the PCI subsystem (removing the
		read_register hack, etc).
20051108	Continuing the cleanup; splitting up some pci devices into a
		normal autodev device and some separate pci glue code.
20051109	Continuing on the PCI bus stuff; all old pci_*.c have been
		incorporated into normal devices and/or rewritten as glue code
		only, adding a dummy Intel 82371AB PIIX4 for Malta (not really
		tested yet).
		Minor pckbc fix so that Linux doesn't complain.
		Working on the DEC 21143 NIC (ethernet mac rom stuff mostly).
		Various other minor fixes.
20051110	Some more ARM dyntrans fine-tuning (e.g. some instruction
		combinations (cmps followed by conditional branch within the
		same page) and special cases for DPIs with regform when the
		shifter isn't used).
20051111	ARM dyntrans updates: O(n)->O(1) for just-mark-as-non-
		writable in the generic pc_to_pointers function, and some other
		minor hacks.
		Merging Cobalt and evbmips (Malta) ISA interrupt handling,
		and some minor fixes to allow Linux to accept harddisk irqs.
20051112	Minor device updates (pckbc, dec21143, lpt, ...), most
		importantly fixing the ALI M1543/M5229 so that harddisk irqs
		work with Linux/CATS.
20051113	Some more generalizations of the PCI subsystem.
		Finally took the time to add a hack for SCSI CDROM TOCs; this
		enables OpenBSD to use partition 'a' (as needed by the OpenBSD
		installer), and Windows NT's installer to get a bit further.
		Also fixing dev_wdc to allow Linux to detect ATAPI CDROMs.
		Continuing on the DEC 21143.
20051114	Minor ARM dyntrans tweaks; ARM cmps+branch optimization when
		comparing with 0, and generalizing the xchg instr. comb.
		Adding disassembly of ARM mrrc/mcrr and q{,d}{add,sub}.
20051115	Continuing on various PPC things (BATs, other address trans-
		lation things, various loads/stores, BeBox emulation, etc.).
		Beginning to work on PPC interrupt/exception support.
20051116	Factoring out some code which initializes legacy ISA devices
		from those machines that use them (bus_isa).
		Continuing on PPC interrupt/exception support.
20051117	Minor Malta fixes: RTC year offset = 80, disabling a speed hack
		which caused NetBSD to detect a too fast cpu, and adding a new
		hack to make Linux detect a faster cpu.
		Continuing on the Artesyn PM/PPC emulation mode.
		Adding an Algor emulation skeleton (P4032 and P5064);
		implementing some of the basics.
		Continuing on PPC emulation in general; usage of unimplemented
		SPRs is now easier to track, continuing on memory/exception
		related issues, etc.
20051118	More work on PPC emulation (tgpr0..3, exception handling,
		memory stuff, syscalls, etc.).
20051119	Changing the ARM dyntrans code to mostly use cpu->pc, and not
		necessarily use arm reg 15. Seems to work.
		Various PPC updates; continuing on the PReP emulation mode.
20051120	Adding a workaround/hack to dev_mc146818 to allow NetBSD/prep
		to detect the clock.
20051121	More cleanup of the PCI bus (memory and I/O bases, etc).
		Continuing on various PPC things (decrementer and timebase,
		WDCs on obio (on PReP) use irq 13, not 14/15).
20051122	Continuing on the CPC700 controller (interrupts etc) for PMPPC,
		and on PPC stuff in general.
		Finally! After some bug fixes to the virtual to physical addr
		translation, NetBSD/{prep,pmppc} 2.1 reach userland and are
		stable enough to be interacted with.
		More PCI updates; reverse-endian device access for PowerPC etc.
20051123	Generalizing the IEEE floating point subsystem (moving it out
		from src/cpus/cpu_mips_coproc.c into a new src/float_emul.c).
		Input via slave xterms was sometimes not really working; fixing
		this for ns16550, and a warning message is now displayed if
		multiple non-xterm consoles are active.
		Adding some PPC floating point support, etc.
		Various interrupt related updates (dev_wdc, _ns16550, _8259,
		and the isa32 common code in machine.c).
		NetBSD/prep can now be installed! :-) (Well, with some manual
		commands necessary before running sysinst.) Updating the
		documentation and various other things to reflect this.
20051124	Various minor documentation updates.
		Continuing the work on the DEC 21143 NIC.
20051125	LOTS of work on the 21143. Both OpenBSD and NetBSD work fine
		with it now, except that OpenBSD sometimes gives a time-out
		warning.
		Minor documentation updates.

==============  RELEASE 0.3.7  ==============


1 dpavlin 14 /*
2     * Copyright (C) 2005 Anders Gavare. All rights reserved.
3     *
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 20 * $Id: cpu_dyntrans.c,v 1.41 2005/11/23 22:03:31 debug Exp $
29 dpavlin 14 *
30     * Common dyntrans routines. Included from cpu_*.c.
31     */
32    
33    
34     #ifdef DYNTRANS_CPU_RUN_INSTR
35 dpavlin 18 static void gather_statistics(struct cpu *cpu)
36     {
37     uint64_t a;
38     int low_pc = ((size_t)cpu->cd.DYNTRANS_ARCH.next_ic - (size_t)
39     cpu->cd.DYNTRANS_ARCH.cur_ic_page) / sizeof(struct DYNTRANS_IC);
40     if (low_pc < 0 || low_pc >= DYNTRANS_IC_ENTRIES_PER_PAGE)
41     return;
42    
43 dpavlin 20 #if 0
44 dpavlin 18 /* Use the physical address: */
45     cpu->cd.DYNTRANS_ARCH.cur_physpage = (void *)
46     cpu->cd.DYNTRANS_ARCH.cur_ic_page;
47     a = cpu->cd.DYNTRANS_ARCH.cur_physpage->physaddr;
48     #else
49     /* Use the PC (virtual address): */
50     a = cpu->pc;
51     #endif
52    
53     a &= ~((DYNTRANS_IC_ENTRIES_PER_PAGE-1) <<
54     DYNTRANS_INSTR_ALIGNMENT_SHIFT);
55     a += low_pc << DYNTRANS_INSTR_ALIGNMENT_SHIFT;
56    
57     /*
58     * TODO: Everything below this line should be cleaned up :-)
59     */
60     a &= 0x03ffffff;
61     {
62     static long long *array = NULL;
63     static char *array_16kpage_in_use = NULL;
64     static int n = 0;
65     a >>= DYNTRANS_INSTR_ALIGNMENT_SHIFT;
66     if (array == NULL)
67     array = zeroed_alloc(sizeof(long long) * 16384*1024);
68     if (array_16kpage_in_use == NULL)
69     array_16kpage_in_use = zeroed_alloc(sizeof(char) * 1024);
70     a &= (16384*1024-1);
71     array[a] ++;
72     array_16kpage_in_use[a / 16384] = 1;
73     n++;
74     if ((n & 0x3fffffff) == 0) {
75     FILE *f = fopen("statistics.out", "w");
76     int i, j;
77     printf("Saving statistics... "); fflush(stdout);
78     for (i=0; i<1024; i++)
79     if (array_16kpage_in_use[i]) {
80     for (j=0; j<16384; j++)
81     if (array[i*16384 + j] > 0)
82     fprintf(f, "%lli\t0x%016llx\n",
83     (long long)array[i*16384+j],
84     (long long)((i*16384+j) <<
85     DYNTRANS_INSTR_ALIGNMENT_SHIFT));
86     }
87     fclose(f);
88     printf("n=0x%08x\n", n);
89     }
90     }
91     }
92    
93    
94     #define S gather_statistics(cpu)
95    
96     #ifdef DYNTRANS_VARIABLE_INSTRUCTION_LENGTH
97 dpavlin 20 #define I ic = cpu->cd.DYNTRANS_ARCH.next_ic; \
98     cpu->cd.DYNTRANS_ARCH.next_ic += ic->len; \
99     ic->f(cpu, ic);
100 dpavlin 18 #else
101     #define I ic = cpu->cd.DYNTRANS_ARCH.next_ic ++; ic->f(cpu, ic);
102     #endif
103    
104    
105 dpavlin 14 /*
106     * XXX_cpu_run_instr():
107     *
108     * Execute one or more instructions on a specific CPU, using dyntrans.
109     *
110     * Return value is the number of instructions executed during this call,
111     * 0 if no instructions were executed.
112     */
113     int DYNTRANS_CPU_RUN_INSTR(struct emul *emul, struct cpu *cpu)
114     {
115     #ifdef MODE32
116     uint32_t cached_pc;
117     #else
118     uint64_t cached_pc;
119     #endif
120     int low_pc, n_instrs;
121    
122     #ifdef DYNTRANS_DUALMODE_32
123     if (cpu->is_32bit)
124     DYNTRANS_PC_TO_POINTERS32(cpu);
125     else
126     #endif
127     DYNTRANS_PC_TO_POINTERS(cpu);
128    
129     /*
130     * Interrupt assertion? (This is _below_ the initial PC to pointer
131     * conversion; if the conversion caused an exception of some kind
132     * then interrupts are probably disabled, and the exception will get
133     * priority over device interrupts.)
134     */
135     #ifdef DYNTRANS_ARM
136     if (cpu->cd.arm.irq_asserted && !(cpu->cd.arm.cpsr & ARM_FLAG_I))
137     arm_exception(cpu, ARM_EXCEPTION_IRQ);
138     #endif
139 dpavlin 20 #ifdef DYNTRANS_PPC
140     if (cpu->cd.ppc.dec_intr_pending && cpu->cd.ppc.msr & PPC_MSR_EE) {
141     ppc_exception(cpu, PPC_EXCEPTION_DEC);
142     cpu->cd.ppc.dec_intr_pending = 0;
143     }
144     if (cpu->cd.ppc.irq_asserted && cpu->cd.ppc.msr & PPC_MSR_EE)
145     ppc_exception(cpu, PPC_EXCEPTION_EI);
146     #endif
147 dpavlin 14
148     cached_pc = cpu->pc;
149    
150     cpu->n_translated_instrs = 0;
151     cpu->running_translated = 1;
152    
153 dpavlin 18 cpu->cd.DYNTRANS_ARCH.cur_physpage = (void *)
154     cpu->cd.DYNTRANS_ARCH.cur_ic_page;
155    
156 dpavlin 14 if (single_step || cpu->machine->instruction_trace) {
157     /*
158     * Single-step:
159     */
160     struct DYNTRANS_IC *ic = cpu->cd.DYNTRANS_ARCH.next_ic
161     #ifndef DYNTRANS_VARIABLE_INSTRUCTION_LENGTH
162     ++
163     #endif
164     ;
165     if (cpu->machine->instruction_trace) {
166     #ifdef DYNTRANS_X86
167     unsigned char instr[17];
168     cpu->cd.x86.cursegment = X86_S_CS;
169     cpu->cd.x86.seg_override = 0;
170     #else
171     #ifdef DYNTRANS_M68K
172     unsigned char instr[16]; /* TODO: 16? */
173     #else
174     unsigned char instr[4]; /* General case... */
175     #endif
176     #endif
177     if (!cpu->memory_rw(cpu, cpu->mem, cached_pc, &instr[0],
178     sizeof(instr), MEM_READ, CACHE_INSTRUCTION)) {
179     fatal("XXX_cpu_run_instr(): could not read "
180     "the instruction\n");
181     } else
182     cpu_disassemble_instr(cpu->machine, cpu,
183     instr, 1, 0, 0);
184     }
185    
186     /* When single-stepping, multiple instruction calls cannot
187     be combined into one. This clears all translations: */
188     if (cpu->cd.DYNTRANS_ARCH.cur_physpage->flags & COMBINATIONS) {
189     int i;
190     for (i=0; i<DYNTRANS_IC_ENTRIES_PER_PAGE; i++)
191     cpu->cd.DYNTRANS_ARCH.cur_physpage->ics[i].f =
192     #ifdef DYNTRANS_DUALMODE_32
193     cpu->is_32bit?
194     instr32(to_be_translated) :
195     #endif
196     instr(to_be_translated);
197     fatal("[ Note: The translation of physical page 0x%llx"
198     " contained combinations of instructions; these "
199     "are now flushed because we are single-stepping."
200     " ]\n", (long long)cpu->cd.DYNTRANS_ARCH.
201     cur_physpage->physaddr);
202     cpu->cd.DYNTRANS_ARCH.cur_physpage->flags &=
203     ~(COMBINATIONS | TRANSLATIONS);
204     }
205    
206 dpavlin 18 if (show_opcode_statistics)
207     S;
208    
209 dpavlin 14 /* Execute just one instruction: */
210     ic->f(cpu, ic);
211     n_instrs = 1;
212 dpavlin 18 } else if (show_opcode_statistics) {
213     /* Gather statistics while executing multiple instructions: */
214     n_instrs = 0;
215     for (;;) {
216     struct DYNTRANS_IC *ic;
217    
218     S; I; S; I; S; I; S; I; S; I; S; I;
219     S; I; S; I; S; I; S; I; S; I; S; I;
220     S; I; S; I; S; I; S; I; S; I; S; I;
221     S; I; S; I; S; I; S; I; S; I; S; I;
222    
223     n_instrs += 24;
224    
225     if (!cpu->running_translated ||
226     n_instrs + cpu->n_translated_instrs >= 16384)
227     break;
228     }
229 dpavlin 14 } else {
230     /* Execute multiple instructions: */
231     n_instrs = 0;
232     for (;;) {
233     struct DYNTRANS_IC *ic;
234    
235     I; I; I; I; I; I; I; I; I; I;
236     I; I; I; I; I; I; I; I; I; I;
237     I; I; I; I; I; I; I; I; I; I;
238     I; I; I; I; I; I; I; I; I; I;
239     I; I; I; I; I; I; I; I; I; I;
240    
241     I; I; I; I; I; I; I; I; I; I;
242    
243 dpavlin 18 n_instrs += 60;
244 dpavlin 14
245     if (!cpu->running_translated ||
246     n_instrs + cpu->n_translated_instrs >= 16384)
247     break;
248     }
249     }
250    
251 dpavlin 20 n_instrs += cpu->n_translated_instrs;
252 dpavlin 14
253 dpavlin 20 /* Synchronize the program counter: */
254 dpavlin 14 low_pc = ((size_t)cpu->cd.DYNTRANS_ARCH.next_ic - (size_t)
255     cpu->cd.DYNTRANS_ARCH.cur_ic_page) / sizeof(struct DYNTRANS_IC);
256     if (low_pc >= 0 && low_pc < DYNTRANS_IC_ENTRIES_PER_PAGE) {
257     cpu->pc &= ~((DYNTRANS_IC_ENTRIES_PER_PAGE-1) <<
258     DYNTRANS_INSTR_ALIGNMENT_SHIFT);
259     cpu->pc += (low_pc << DYNTRANS_INSTR_ALIGNMENT_SHIFT);
260     } else if (low_pc == DYNTRANS_IC_ENTRIES_PER_PAGE) {
261     /* Switch to next page: */
262     cpu->pc &= ~((DYNTRANS_IC_ENTRIES_PER_PAGE-1) <<
263     DYNTRANS_INSTR_ALIGNMENT_SHIFT);
264     cpu->pc += (DYNTRANS_IC_ENTRIES_PER_PAGE <<
265     DYNTRANS_INSTR_ALIGNMENT_SHIFT);
266     }
267    
268 dpavlin 20 #ifdef DYNTRANS_PPC
269     /* Update the Decrementer and Time base registers: */
270     {
271     uint32_t old = cpu->cd.ppc.spr[SPR_DEC];
272     cpu->cd.ppc.spr[SPR_DEC] = (uint32_t) (old - n_instrs);
273     if ((old >> 31) == 0 && (cpu->cd.ppc.spr[SPR_DEC] >> 31) == 1)
274     cpu->cd.ppc.dec_intr_pending = 1;
275    
276     old = cpu->cd.ppc.spr[SPR_TBL];
277     cpu->cd.ppc.spr[SPR_TBL] += n_instrs;
278     if ((old >> 31) == 1 && (cpu->cd.ppc.spr[SPR_TBL] >> 31) == 0)
279     cpu->cd.ppc.spr[SPR_TBU] ++;
280     }
281     #endif
282    
283     /* Return the nr of instructions executed: */
284     return n_instrs;
285 dpavlin 14 }
286     #endif /* DYNTRANS_CPU_RUN_INSTR */
287    
288    
289    
290     #ifdef DYNTRANS_FUNCTION_TRACE
291     /*
292     * XXX_cpu_functioncall_trace():
293     *
294     * Without this function, the main trace tree function prints something
295     * like <f()> or <0x1234()> on a function call. It is up to this
296     * function to print the arguments passed.
297     */
298     void DYNTRANS_FUNCTION_TRACE(struct cpu *cpu, uint64_t f, int n_args)
299     {
300     char strbuf[50];
301     char *symbol;
302     uint64_t ot;
303     int x, print_dots = 1, n_args_to_print =
304     #ifdef DYNTRANS_ALPHA
305     6
306     #else
307     #ifdef DYNTRANS_SH
308     8
309     #else
310     4 /* Default value for most archs */
311     #endif
312     #endif
313     ;
314    
315     if (n_args >= 0 && n_args <= n_args_to_print) {
316     print_dots = 0;
317     n_args_to_print = n_args;
318     }
319    
320     /*
321     * TODO: The type of each argument should be taken from the symbol
322     * table, in some way.
323     *
324     * The code here does a kind of "heuristic guess" regarding what the
325     * argument values might mean. Sometimes the output looks weird, but
326     * usually it looks good enough.
327     *
328     * Print ".." afterwards to show that there might be more arguments
329     * than were passed in register.
330     */
331     for (x=0; x<n_args_to_print; x++) {
332     int64_t d;
333     #ifdef DYNTRANS_X86
334     d = 0; /* TODO */
335     #else
336     /* Args in registers: */
337     d = cpu->cd.DYNTRANS_ARCH.
338     #ifdef DYNTRANS_ALPHA
339     r[ALPHA_A0
340     #endif
341     #ifdef DYNTRANS_ARM
342     r[0
343     #endif
344     #ifdef DYNTRANS_AVR
345     /* TODO: 24,25 = first register, but then
346     they go downwards, ie. 22,23 and so on */
347     r[24
348     #endif
349     #ifdef DYNTRANS_HPPA
350     r[0 /* TODO */
351     #endif
352     #ifdef DYNTRANS_I960
353     r[0 /* TODO */
354     #endif
355     #ifdef DYNTRANS_IA64
356     r[0 /* TODO */
357     #endif
358     #ifdef DYNTRANS_M68K
359     d[0 /* TODO */
360     #endif
361     #ifdef DYNTRANS_MIPS
362     gpr[MIPS_GPR_A0
363     #endif
364 dpavlin 20 #ifdef DYNTRANS_NEWMIPS
365     r[0 /* TODO */
366     #endif
367 dpavlin 14 #ifdef DYNTRANS_PPC
368     gpr[3
369     #endif
370     #ifdef DYNTRANS_SH
371     r[2
372     #endif
373     #ifdef DYNTRANS_SPARC
374     r_i[0
375     #endif
376     + x];
377     #endif
378     symbol = get_symbol_name(&cpu->machine->symbol_context, d, &ot);
379    
380     if (d > -256 && d < 256)
381     fatal("%i", (int)d);
382     else if (memory_points_to_string(cpu, cpu->mem, d, 1))
383     fatal("\"%s\"", memory_conv_to_string(cpu,
384     cpu->mem, d, strbuf, sizeof(strbuf)));
385     else if (symbol != NULL && ot == 0)
386     fatal("&%s", symbol);
387     else {
388     if (cpu->is_32bit)
389     fatal("0x%x", (int)d);
390     else
391     fatal("0x%llx", (long long)d);
392     }
393    
394     if (x < n_args_to_print - 1)
395     fatal(",");
396     }
397    
398     if (print_dots)
399     fatal(",..");
400     }
401     #endif
402    
403    
404    
405     #ifdef DYNTRANS_TC_ALLOCATE_DEFAULT_PAGE
406     /* forward declaration of to_be_translated and end_of_page: */
407     static void instr(to_be_translated)(struct cpu *, struct DYNTRANS_IC *);
408     static void instr(end_of_page)(struct cpu *,struct DYNTRANS_IC *);
409     #ifdef DYNTRANS_DUALMODE_32
410     static void instr32(to_be_translated)(struct cpu *, struct DYNTRANS_IC *);
411     static void instr32(end_of_page)(struct cpu *,struct DYNTRANS_IC *);
412     #endif
413     /*
414     * XXX_tc_allocate_default_page():
415     *
416     * Create a default page (with just pointers to instr(to_be_translated)
417     * at cpu->translation_cache_cur_ofs.
418     */
419     static void DYNTRANS_TC_ALLOCATE_DEFAULT_PAGE(struct cpu *cpu,
420     uint64_t physaddr)
421     {
422     struct DYNTRANS_TC_PHYSPAGE *ppp;
423     int i;
424    
425     /* Create the physpage header: */
426     ppp = (struct DYNTRANS_TC_PHYSPAGE *)(cpu->translation_cache
427     + cpu->translation_cache_cur_ofs);
428     ppp->next_ofs = 0;
429     ppp->physaddr = physaddr;
430    
431     /* TODO: Is this faster than copying an entire template page? */
432     for (i=0; i<DYNTRANS_IC_ENTRIES_PER_PAGE; i++)
433     ppp->ics[i].f =
434     #ifdef DYNTRANS_DUALMODE_32
435     cpu->is_32bit? instr32(to_be_translated) :
436     #endif
437     instr(to_be_translated);
438    
439     ppp->ics[DYNTRANS_IC_ENTRIES_PER_PAGE].f =
440     #ifdef DYNTRANS_DUALMODE_32
441     cpu->is_32bit? instr32(end_of_page) :
442     #endif
443     instr(end_of_page);
444    
445     cpu->translation_cache_cur_ofs += sizeof(struct DYNTRANS_TC_PHYSPAGE);
446 dpavlin 18
447     cpu->translation_cache_cur_ofs --;
448     cpu->translation_cache_cur_ofs |= 63;
449     cpu->translation_cache_cur_ofs ++;
450 dpavlin 14 }
451     #endif /* DYNTRANS_TC_ALLOCATE_DEFAULT_PAGE */
452    
453    
454    
455     #ifdef DYNTRANS_PC_TO_POINTERS_FUNC
456     /*
457     * XXX_pc_to_pointers_generic():
458     *
459     * Generic case. See DYNTRANS_PC_TO_POINTERS_FUNC below.
460     */
461     void DYNTRANS_PC_TO_POINTERS_GENERIC(struct cpu *cpu)
462     {
463     #ifdef MODE32
464     uint32_t
465     #else
466     uint64_t
467     #endif
468 dpavlin 20 cached_pc, physaddr = 0;
469 dpavlin 14 uint32_t physpage_ofs;
470     int ok, pagenr, table_index;
471     uint32_t *physpage_entryp;
472     struct DYNTRANS_TC_PHYSPAGE *ppp;
473    
474     #ifdef MODE32
475     int index;
476     cached_pc = cpu->pc;
477 dpavlin 18 index = DYNTRANS_ADDR_TO_PAGENR(cached_pc);
478 dpavlin 14 #else
479     #ifdef DYNTRANS_ALPHA
480     uint32_t a, b;
481     int kernel = 0;
482     struct alpha_vph_page *vph_p;
483     cached_pc = cpu->pc;
484     a = (cached_pc >> ALPHA_LEVEL0_SHIFT) & (ALPHA_LEVEL0 - 1);
485     b = (cached_pc >> ALPHA_LEVEL1_SHIFT) & (ALPHA_LEVEL1 - 1);
486     if ((cached_pc >> ALPHA_TOPSHIFT) == ALPHA_TOP_KERNEL) {
487     vph_p = cpu->cd.alpha.vph_table0_kernel[a];
488     kernel = 1;
489     } else
490     vph_p = cpu->cd.alpha.vph_table0[a];
491     #else
492     #ifdef DYNTRANS_IA64
493     fatal("IA64 todo\n");
494     #else
495     fatal("Neither alpha, ia64, nor 32-bit? 3\n");
496     exit(1);
497     #endif
498     #endif
499     #endif
500    
501     /* Virtual to physical address translation: */
502     ok = 0;
503     #ifdef MODE32
504     if (cpu->cd.DYNTRANS_ARCH.host_load[index] != NULL) {
505     physaddr = cpu->cd.DYNTRANS_ARCH.phys_addr[index];
506     ok = 1;
507     }
508     #else
509     #ifdef DYNTRANS_ALPHA
510     if (vph_p->host_load[b] != NULL) {
511     physaddr = vph_p->phys_addr[b];
512     ok = 1;
513     }
514     #else
515     #ifdef DYNTRANS_IA64
516     fatal("IA64 todo\n");
517     #else
518     fatal("Neither alpha, ia64, nor 32-bit? 4\n");
519     exit(1);
520     #endif
521     #endif
522     #endif
523    
524     if (!ok) {
525     uint64_t paddr;
526     if (cpu->translate_address != NULL)
527     ok = cpu->translate_address(cpu, cached_pc,
528     &paddr, FLAG_INSTR);
529     else {
530     paddr = cached_pc;
531     ok = 1;
532     }
533     if (!ok) {
534 dpavlin 20 /* fatal("TODO: instruction vaddr=>paddr translation"
535 dpavlin 14 " failed. vaddr=0x%llx\n", (long long)cached_pc);
536 dpavlin 20 fatal("!! cpu->pc=0x%llx\n", (long long)cpu->pc); */
537    
538 dpavlin 14 ok = cpu->translate_address(cpu, cpu->pc, &paddr,
539     FLAG_INSTR);
540 dpavlin 20
541     /* printf("EXCEPTION HANDLER: vaddr = 0x%x ==> "
542     "paddr = 0x%x\n", (int)cpu->pc, (int)paddr);
543     fatal("!? cpu->pc=0x%llx\n", (long long)cpu->pc); */
544    
545 dpavlin 14 if (!ok) {
546     fatal("FATAL: could not find physical"
547     " address of the exception handler?");
548     exit(1);
549     }
550     }
551     cached_pc = cpu->pc;
552 dpavlin 18 #ifdef MODE32
553     index = DYNTRANS_ADDR_TO_PAGENR(cached_pc);
554     #endif
555 dpavlin 14 physaddr = paddr;
556     }
557    
558 dpavlin 18 #ifdef MODE32
559     if (cpu->cd.DYNTRANS_ARCH.host_load[index] == NULL) {
560     unsigned char *host_page = memory_paddr_to_hostaddr(cpu->mem,
561     physaddr, MEM_READ);
562     if (host_page != NULL) {
563     int q = DYNTRANS_PAGESIZE - 1;
564     host_page += (physaddr &
565     ((1 << BITS_PER_MEMBLOCK) - 1) & ~q);
566     cpu->update_translation_table(cpu, cached_pc & ~q,
567     host_page, TLB_CODE, physaddr & ~q);
568     }
569     }
570     #endif
571    
572     if (cpu->translation_cache_cur_ofs >= DYNTRANS_CACHE_SIZE) {
573 dpavlin 20 debug("[ dyntrans: resetting the translation cache ]\n");
574 dpavlin 14 cpu_create_or_reset_tc(cpu);
575 dpavlin 18 }
576 dpavlin 14
577     pagenr = DYNTRANS_ADDR_TO_PAGENR(physaddr);
578     table_index = PAGENR_TO_TABLE_INDEX(pagenr);
579    
580     physpage_entryp = &(((uint32_t *)cpu->translation_cache)[table_index]);
581     physpage_ofs = *physpage_entryp;
582     ppp = NULL;
583    
584     /* Traverse the physical page chain: */
585     while (physpage_ofs != 0) {
586     ppp = (struct DYNTRANS_TC_PHYSPAGE *)(cpu->translation_cache
587     + physpage_ofs);
588     /* If we found the page in the cache, then we're done: */
589     if (ppp->physaddr == physaddr)
590     break;
591     /* Try the next page in the chain: */
592     physpage_ofs = ppp->next_ofs;
593     }
594    
595     /* If the offset is 0 (or ppp is NULL), then we need to create a
596     new "default" empty translation page. */
597    
598     if (ppp == NULL) {
599     /* fatal("CREATING page %lli (physaddr 0x%llx), table index "
600     "%i\n", (long long)pagenr, (long long)physaddr,
601     (int)table_index); */
602     *physpage_entryp = physpage_ofs =
603     cpu->translation_cache_cur_ofs;
604    
605     /* Allocate a default page, with to_be_translated entries: */
606     DYNTRANS_TC_ALLOCATE(cpu, physaddr);
607    
608     ppp = (struct DYNTRANS_TC_PHYSPAGE *)(cpu->translation_cache
609     + physpage_ofs);
610     }
611    
612     #ifdef MODE32
613     if (cpu->cd.DYNTRANS_ARCH.host_load[index] != NULL)
614     cpu->cd.DYNTRANS_ARCH.phys_page[index] = ppp;
615     #endif
616    
617     #ifdef DYNTRANS_ALPHA
618     if (vph_p->host_load[b] != NULL)
619     vph_p->phys_page[b] = ppp;
620     #endif
621    
622 dpavlin 20 #ifdef MODE32
623     /* Small optimization: only mark the physical page as non-writable
624     if it did not contain translations. (Because if it does contain
625     translations, it is already non-writable.) */
626     if (!cpu->cd.DYNTRANS_ARCH.phystranslation[pagenr >> 5] &
627     (1 << (pagenr & 31)))
628     #endif
629 dpavlin 18 cpu->invalidate_translation_caches(cpu, physaddr,
630     JUST_MARK_AS_NON_WRITABLE | INVALIDATE_PADDR);
631 dpavlin 14
632     cpu->cd.DYNTRANS_ARCH.cur_ic_page = &ppp->ics[0];
633 dpavlin 18
634 dpavlin 14 cpu->cd.DYNTRANS_ARCH.next_ic = cpu->cd.DYNTRANS_ARCH.cur_ic_page +
635     DYNTRANS_PC_TO_IC_ENTRY(cached_pc);
636    
637     /* printf("cached_pc=0x%016llx pagenr=%lli table_index=%lli, "
638     "physpage_ofs=0x%016llx\n", (long long)cached_pc, (long long)pagenr,
639     (long long)table_index, (long long)physpage_ofs); */
640     }
641    
642    
643     /*
644     * XXX_pc_to_pointers():
645     *
646     * This function uses the current program counter (a virtual address) to
647     * find out which physical translation page to use, and then sets the current
648     * translation page pointers to that page.
649     *
650     * If there was no translation page for that physical page, then an empty
651     * one is created.
652     *
653     * NOTE: This is the quick lookup version. See
654     * DYNTRANS_PC_TO_POINTERS_GENERIC above for the generic case.
655     */
656     void DYNTRANS_PC_TO_POINTERS_FUNC(struct cpu *cpu)
657     {
658     #ifdef MODE32
659     uint32_t
660     #else
661     uint64_t
662     #endif
663     cached_pc;
664     struct DYNTRANS_TC_PHYSPAGE *ppp;
665    
666     #ifdef MODE32
667     int index;
668     cached_pc = cpu->pc;
669 dpavlin 18 index = DYNTRANS_ADDR_TO_PAGENR(cached_pc);
670 dpavlin 14 ppp = cpu->cd.DYNTRANS_ARCH.phys_page[index];
671     if (ppp != NULL)
672     goto have_it;
673     #else
674     #ifdef DYNTRANS_ALPHA
675     uint32_t a, b;
676     int kernel = 0;
677     struct alpha_vph_page *vph_p;
678     cached_pc = cpu->pc;
679     a = (cached_pc >> ALPHA_LEVEL0_SHIFT) & (ALPHA_LEVEL0 - 1);
680     b = (cached_pc >> ALPHA_LEVEL1_SHIFT) & (ALPHA_LEVEL1 - 1);
681     if ((cached_pc >> ALPHA_TOPSHIFT) == ALPHA_TOP_KERNEL) {
682     vph_p = cpu->cd.alpha.vph_table0_kernel[a];
683     kernel = 1;
684     } else
685     vph_p = cpu->cd.alpha.vph_table0[a];
686     if (vph_p != cpu->cd.alpha.vph_default_page) {
687     ppp = vph_p->phys_page[b];
688     if (ppp != NULL)
689     goto have_it;
690     }
691     #else
692 dpavlin 20 /* Temporary, to avoid a compiler warning: */
693     cached_pc = 0;
694     ppp = NULL;
695 dpavlin 14 #ifdef DYNTRANS_IA64
696     fatal("IA64 todo\n");
697     #else
698     fatal("Neither alpha, ia64, nor 32-bit? 1\n");
699     exit(1);
700     #endif
701     #endif
702     #endif
703    
704     DYNTRANS_PC_TO_POINTERS_GENERIC(cpu);
705     return;
706    
707     /* Quick return path: */
708 dpavlin 20 #if defined(MODE32) || defined(DYNTRANS_ALPHA)
709 dpavlin 14 have_it:
710     cpu->cd.DYNTRANS_ARCH.cur_ic_page = &ppp->ics[0];
711     cpu->cd.DYNTRANS_ARCH.next_ic = cpu->cd.DYNTRANS_ARCH.cur_ic_page +
712     DYNTRANS_PC_TO_IC_ENTRY(cached_pc);
713    
714     /* printf("cached_pc=0x%016llx pagenr=%lli table_index=%lli, "
715     "physpage_ofs=0x%016llx\n", (long long)cached_pc, (long long)pagenr,
716     (long long)table_index, (long long)physpage_ofs); */
717 dpavlin 20 #endif
718 dpavlin 14 }
719     #endif /* DYNTRANS_PC_TO_POINTERS_FUNC */
720    
721    
722    
723     #ifdef DYNTRANS_INVAL_ENTRY
724     /*
725     * XXX_invalidate_tlb_entry():
726     *
727     * Invalidate one translation entry (based on virtual address).
728     *
729     * If the JUST_MARK_AS_NON_WRITABLE flag is set, then the translation entry
730     * is just downgraded to non-writable (ie the host store page is set to
731     * NULL). Otherwise, the entire translation is removed.
732     */
733 dpavlin 18 static void DYNTRANS_INVALIDATE_TLB_ENTRY(struct cpu *cpu,
734 dpavlin 14 #ifdef MODE32
735     uint32_t
736     #else
737     uint64_t
738     #endif
739     vaddr_page, int flags)
740     {
741     #ifdef MODE32
742 dpavlin 18 uint32_t index = DYNTRANS_ADDR_TO_PAGENR(vaddr_page);
743 dpavlin 14
744 dpavlin 18 #ifdef DYNTRANS_ARM
745 dpavlin 20 cpu->cd.DYNTRANS_ARCH.is_userpage[index >> 5] &= ~(1 << (index & 31));
746 dpavlin 18 #endif
747    
748 dpavlin 14 if (flags & JUST_MARK_AS_NON_WRITABLE) {
749     /* printf("JUST MARKING NON-W: vaddr 0x%08x\n",
750     (int)vaddr_page); */
751     cpu->cd.DYNTRANS_ARCH.host_store[index] = NULL;
752     } else {
753     cpu->cd.DYNTRANS_ARCH.host_load[index] = NULL;
754     cpu->cd.DYNTRANS_ARCH.host_store[index] = NULL;
755     cpu->cd.DYNTRANS_ARCH.phys_addr[index] = 0;
756     cpu->cd.DYNTRANS_ARCH.phys_page[index] = NULL;
757 dpavlin 18 cpu->cd.DYNTRANS_ARCH.vaddr_to_tlbindex[index] = 0;
758 dpavlin 14 }
759     #else
760     /* 2-level: */
761     #ifdef DYNTRANS_ALPHA
762     struct alpha_vph_page *vph_p;
763     uint32_t a, b;
764     int kernel = 0;
765    
766     a = (vaddr_page >> ALPHA_LEVEL0_SHIFT) & (ALPHA_LEVEL0 - 1);
767     b = (vaddr_page >> ALPHA_LEVEL1_SHIFT) & (ALPHA_LEVEL1 - 1);
768     if ((vaddr_page >> ALPHA_TOPSHIFT) == ALPHA_TOP_KERNEL) {
769     vph_p = cpu->cd.alpha.vph_table0_kernel[a];
770     kernel = 1;
771     } else
772     vph_p = cpu->cd.alpha.vph_table0[a];
773    
774     if (vph_p == cpu->cd.alpha.vph_default_page) {
775     fatal("alpha_invalidate_tlb_entry(): huh? Problem 1.\n");
776     exit(1);
777     }
778    
779     if (flags & JUST_MARK_AS_NON_WRITABLE) {
780     vph_p->host_store[b] = NULL;
781     return;
782     }
783     vph_p->host_load[b] = NULL;
784     vph_p->host_store[b] = NULL;
785     vph_p->phys_addr[b] = 0;
786     vph_p->phys_page[b] = NULL;
787     vph_p->refcount --;
788     if (vph_p->refcount < 0) {
789     fatal("alpha_invalidate_tlb_entry(): huh? Problem 2.\n");
790     exit(1);
791     }
792     if (vph_p->refcount == 0) {
793     vph_p->next = cpu->cd.alpha.vph_next_free_page;
794     cpu->cd.alpha.vph_next_free_page = vph_p;
795     if (kernel)
796     cpu->cd.alpha.vph_table0_kernel[a] =
797     cpu->cd.alpha.vph_default_page;
798     else
799     cpu->cd.alpha.vph_table0[a] =
800     cpu->cd.alpha.vph_default_page;
801     }
802     #else /* !DYNTRANS_ALPHA */
803     #ifdef DYNTRANS_IA64
804     fatal("IA64: blah blah TODO\n");
805     #else
806     fatal("Not yet for non-1-level, non-Alpha, non-ia64\n");
807     #endif /* !DYNTRANS_IA64 */
808     #endif /* !DYNTRANS_ALPHA */
809     #endif
810     }
811     #endif
812    
813    
814 dpavlin 18 #ifdef DYNTRANS_INVALIDATE_TC
815 dpavlin 14 /*
816 dpavlin 18 * XXX_invalidate_translation_caches():
817 dpavlin 14 *
818     * Invalidate all entries matching a specific physical address, a specific
819     * virtual address, or ALL entries.
820     *
821     * flags should be one of
822     * INVALIDATE_PADDR INVALIDATE_VADDR or INVALIDATE_ALL
823     *
824     * In the case when all translations are invalidated, paddr doesn't need
825     * to be supplied.
826     *
827 dpavlin 18 * NOTE/TODO: When invalidating a virtual address, it is only cleared from
828     * the quick translation array, not from the linear
829     * vph_tlb_entry[] array. Hopefully this is enough anyway.
830 dpavlin 14 */
831 dpavlin 18 void DYNTRANS_INVALIDATE_TC(struct cpu *cpu, uint64_t paddr, int flags)
832 dpavlin 14 {
833     int r;
834     #ifdef MODE32
835     uint32_t
836     #else
837     uint64_t
838     #endif
839     addr_page = paddr & ~(DYNTRANS_PAGESIZE - 1);
840    
841 dpavlin 20 /* fatal("invalidate(): "); */
842    
843 dpavlin 18 /* Quick case for virtual addresses: see note above. */
844     if (flags & INVALIDATE_VADDR) {
845 dpavlin 20 /* fatal("vaddr 0x%08x\n", (int)addr_page); */
846 dpavlin 18 DYNTRANS_INVALIDATE_TLB_ENTRY(cpu, addr_page, flags);
847     return;
848     }
849    
850 dpavlin 20 if (flags & INVALIDATE_ALL) {
851     /* fatal("all\n"); */
852     for (r=0; r<DYNTRANS_MAX_VPH_TLB_ENTRIES; r++) {
853     if (cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r].valid) {
854     DYNTRANS_INVALIDATE_TLB_ENTRY(cpu, cpu->cd.
855     DYNTRANS_ARCH.vph_tlb_entry[r].vaddr_page,
856     0);
857     cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r].valid=0;
858     }
859     }
860     return;
861     }
862    
863     /* fatal("paddr 0x%08x\n", (int)addr_page); */
864    
865 dpavlin 14 for (r=0; r<DYNTRANS_MAX_VPH_TLB_ENTRIES; r++) {
866     if (cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r].valid && (
867     (cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r].paddr_page ==
868     addr_page && flags & INVALIDATE_PADDR) ||
869     flags & INVALIDATE_ALL) ) {
870     DYNTRANS_INVALIDATE_TLB_ENTRY(cpu,
871     cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r].vaddr_page,
872     flags);
873     if (flags & JUST_MARK_AS_NON_WRITABLE)
874     cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r]
875     .writeflag = 0;
876     else
877     cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r]
878     .valid = 0;
879     }
880     }
881     }
882 dpavlin 18 #endif /* DYNTRANS_INVALIDATE_TC */
883 dpavlin 14
884    
885    
886     #ifdef DYNTRANS_INVALIDATE_TC_CODE
887     /*
888     * XXX_invalidate_code_translation():
889     *
890     * Invalidate code translations for a specific physical address, a specific
891     * virtual address, or for all entries in the cache.
892     */
893     void DYNTRANS_INVALIDATE_TC_CODE(struct cpu *cpu, uint64_t addr, int flags)
894     {
895     int r;
896 dpavlin 18 #ifdef MODE32
897 dpavlin 14 uint32_t
898     #else
899     uint64_t
900     #endif
901     vaddr_page, paddr_page;
902    
903     addr &= ~(DYNTRANS_PAGESIZE-1);
904    
905     /* printf("DYNTRANS_INVALIDATE_TC_CODE addr=0x%08x flags=%i\n",
906     (int)addr, flags); */
907    
908     if (flags & INVALIDATE_PADDR) {
909     int pagenr, table_index;
910     uint32_t physpage_ofs, *physpage_entryp;
911 dpavlin 18 struct DYNTRANS_TC_PHYSPAGE *ppp, *prev_ppp;
912 dpavlin 14
913     pagenr = DYNTRANS_ADDR_TO_PAGENR(addr);
914 dpavlin 18
915     #ifdef MODE32
916     /* If this page isn't marked as having any translations,
917     then return immediately. */
918     if (!(cpu->cd.DYNTRANS_ARCH.phystranslation[pagenr >> 5]
919     & 1 << (pagenr & 31)))
920     return;
921     /* Remove the mark: */
922     cpu->cd.DYNTRANS_ARCH.phystranslation[pagenr >> 5] &=
923     ~ (1 << (pagenr & 31));
924     #endif
925    
926 dpavlin 14 table_index = PAGENR_TO_TABLE_INDEX(pagenr);
927    
928     physpage_entryp = &(((uint32_t *)cpu->
929     translation_cache)[table_index]);
930     physpage_ofs = *physpage_entryp;
931 dpavlin 18 prev_ppp = ppp = NULL;
932 dpavlin 14
933     /* Traverse the physical page chain: */
934     while (physpage_ofs != 0) {
935 dpavlin 18 prev_ppp = ppp;
936 dpavlin 14 ppp = (struct DYNTRANS_TC_PHYSPAGE *)
937     (cpu->translation_cache + physpage_ofs);
938     /* If we found the page in the cache,
939     then we're done: */
940     if (ppp->physaddr == addr)
941     break;
942     /* Try the next page in the chain: */
943     physpage_ofs = ppp->next_ofs;
944     }
945    
946 dpavlin 18 if (physpage_ofs == 0)
947     ppp = NULL;
948    
949     #if 1
950     /*
951     * "Bypass" the page, removing it from the code cache.
952     *
953     * NOTE/TODO: This gives _TERRIBLE_ performance with self-
954     * modifying code, or when a single page is used for both
955     * code and (writable) data.
956     */
957 dpavlin 14 if (ppp != NULL) {
958 dpavlin 18 if (prev_ppp != NULL)
959     prev_ppp->next_ofs = ppp->next_ofs;
960     else
961     *physpage_entryp = ppp->next_ofs;
962     }
963     #else
964     /*
965     * Instead of removing the page from the code cache, each
966     * entry can be set to "to_be_translated". This is slow in
967     * the general case, but in the case of self-modifying code,
968     * it might be faster since we don't risk wasting cache
969     * memory as quickly (which would force unnecessary Restarts).
970     */
971     if (ppp != NULL) {
972 dpavlin 14 /* TODO: Is this faster than copying an entire
973     template page? */
974     int i;
975     for (i=0; i<DYNTRANS_IC_ENTRIES_PER_PAGE; i++)
976     ppp->ics[i].f =
977     #ifdef DYNTRANS_DUALMODE_32
978     cpu->is_32bit? instr32(to_be_translated) :
979     #endif
980     instr(to_be_translated);
981     }
982 dpavlin 18 #endif
983 dpavlin 14 }
984    
985 dpavlin 18 /* Invalidate entries (NOTE: only code entries) in the VPH table: */
986     for (r = DYNTRANS_MAX_VPH_TLB_ENTRIES/2;
987     r < DYNTRANS_MAX_VPH_TLB_ENTRIES; r ++) {
988 dpavlin 14 if (cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r].valid) {
989     vaddr_page = cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r]
990     .vaddr_page & ~(DYNTRANS_PAGESIZE-1);
991     paddr_page = cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r]
992     .paddr_page & ~(DYNTRANS_PAGESIZE-1);
993    
994     if (flags & INVALIDATE_ALL ||
995     (flags & INVALIDATE_PADDR && paddr_page == addr) ||
996     (flags & INVALIDATE_VADDR && vaddr_page == addr)) {
997     #ifdef MODE32
998 dpavlin 18 uint32_t index =
999     DYNTRANS_ADDR_TO_PAGENR(vaddr_page);
1000 dpavlin 14 cpu->cd.DYNTRANS_ARCH.phys_page[index] = NULL;
1001 dpavlin 18 /* Remove the mark: */
1002     index = DYNTRANS_ADDR_TO_PAGENR(paddr_page);
1003     cpu->cd.DYNTRANS_ARCH.phystranslation[
1004     index >> 5] &= ~ (1 << (index & 31));
1005 dpavlin 14 #else
1006     /* 2-level: */
1007     #ifdef DYNTRANS_ALPHA
1008     struct alpha_vph_page *vph_p;
1009     uint32_t a, b;
1010     int kernel = 0;
1011    
1012     a = (vaddr_page >> ALPHA_LEVEL0_SHIFT)
1013     & (ALPHA_LEVEL0 - 1);
1014     b = (vaddr_page >> ALPHA_LEVEL1_SHIFT)
1015     & (ALPHA_LEVEL1 - 1);
1016     if ((vaddr_page >> ALPHA_TOPSHIFT) ==
1017     ALPHA_TOP_KERNEL) {
1018     vph_p = cpu->cd.alpha.
1019     vph_table0_kernel[a];
1020     kernel = 1;
1021     } else
1022     vph_p = cpu->cd.alpha.vph_table0[a];
1023     vph_p->phys_page[b] = NULL;
1024     #else /* !DYNTRANS_ALPHA */
1025     #ifdef DYNTRANS_IA64
1026     fatal("IA64: blah yo yo TODO\n");
1027     #else
1028     fatal("Not yet for non-1-level, non-Alpha, "
1029     "non-ia64\n");
1030     #endif /* !DYNTRANS_IA64 */
1031     #endif /* !DYNTRANS_ALPHA */
1032     #endif
1033     }
1034     }
1035     }
1036     }
1037     #endif /* DYNTRANS_INVALIDATE_TC_CODE */
1038    
1039    
1040    
1041     #ifdef DYNTRANS_UPDATE_TRANSLATION_TABLE
1042     /*
1043     * XXX_update_translation_table():
1044     *
1045     * Update the virtual memory translation tables.
1046     */
1047     void DYNTRANS_UPDATE_TRANSLATION_TABLE(struct cpu *cpu, uint64_t vaddr_page,
1048     unsigned char *host_page, int writeflag, uint64_t paddr_page)
1049     {
1050 dpavlin 20 #ifndef MODE32
1051 dpavlin 14 int64_t lowest, highest = -1;
1052 dpavlin 20 #endif
1053 dpavlin 18 int found, r, lowest_index, start, end, useraccess = 0;
1054 dpavlin 14
1055     #ifdef DYNTRANS_ALPHA
1056     uint32_t a, b;
1057     struct alpha_vph_page *vph_p;
1058     int kernel = 0;
1059     /* fatal("update_translation_table(): v=0x%llx, h=%p w=%i"
1060     " p=0x%llx\n", (long long)vaddr_page, host_page, writeflag,
1061     (long long)paddr_page); */
1062     #else
1063     #ifdef MODE32
1064     uint32_t index;
1065     vaddr_page &= 0xffffffffULL;
1066     paddr_page &= 0xffffffffULL;
1067     /* fatal("update_translation_table(): v=0x%x, h=%p w=%i"
1068     " p=0x%x\n", (int)vaddr_page, host_page, writeflag,
1069     (int)paddr_page); */
1070     #else /* !MODE32 */
1071     #ifdef DYNTRANS_IA64
1072     fatal("IA64 update todo\n");
1073     #else
1074     fatal("Neither 32-bit, IA64, nor Alpha? 2\n");
1075     exit(1);
1076     #endif
1077     #endif
1078     #endif
1079    
1080 dpavlin 18 if (writeflag & MEMORY_USER_ACCESS) {
1081     writeflag &= ~MEMORY_USER_ACCESS;
1082     useraccess = 1;
1083     }
1084    
1085     start = 0; end = DYNTRANS_MAX_VPH_TLB_ENTRIES / 2;
1086     #if 1
1087     /* Half of the TLB used for data, half for code: */
1088     if (writeflag & TLB_CODE) {
1089     writeflag &= ~TLB_CODE;
1090     start = end; end = DYNTRANS_MAX_VPH_TLB_ENTRIES;
1091     }
1092     #else
1093     /* Data and code entries are mixed. */
1094     end = DYNTRANS_MAX_VPH_TLB_ENTRIES;
1095     #endif
1096    
1097 dpavlin 14 /* Scan the current TLB entries: */
1098 dpavlin 20 lowest_index = start;
1099 dpavlin 18
1100     #ifdef MODE32
1101 dpavlin 20 /*
1102     * NOTE 1: vaddr_to_tlbindex is one more than the index, so that
1103     * 0 becomes -1, which means a miss.
1104     *
1105     * NOTE 2: When a miss occurs, instead of scanning the entire tlb
1106     * for the entry with the lowest time stamp, just choosing
1107     * one at random will work as well.
1108     */
1109     found = (int)cpu->cd.DYNTRANS_ARCH.vaddr_to_tlbindex[
1110 dpavlin 18 DYNTRANS_ADDR_TO_PAGENR(vaddr_page)] - 1;
1111 dpavlin 20 if (found < 0) {
1112     static unsigned int x = 0;
1113     lowest_index = (x % (end-start)) + start;
1114     x ++;
1115     }
1116     #else
1117     lowest = cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[0].timestamp;
1118     found = -1;
1119 dpavlin 18 for (r=start; r<end; r++) {
1120 dpavlin 14 if (cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r].timestamp < lowest) {
1121     lowest = cpu->cd.DYNTRANS_ARCH.
1122     vph_tlb_entry[r].timestamp;
1123     lowest_index = r;
1124     }
1125     if (cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r].timestamp > highest)
1126     highest = cpu->cd.DYNTRANS_ARCH.
1127     vph_tlb_entry[r].timestamp;
1128     if (cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r].valid &&
1129     cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r].vaddr_page ==
1130     vaddr_page) {
1131     found = r;
1132     break;
1133     }
1134     }
1135 dpavlin 20 #endif
1136 dpavlin 14
1137     if (found < 0) {
1138     /* Create the new TLB entry, overwriting the oldest one: */
1139     r = lowest_index;
1140     if (cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r].valid) {
1141     /* This one has to be invalidated first: */
1142     DYNTRANS_INVALIDATE_TLB_ENTRY(cpu,
1143     cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r].vaddr_page,
1144     0);
1145     }
1146    
1147     cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r].valid = 1;
1148     cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r].host_page = host_page;
1149     cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r].paddr_page = paddr_page;
1150     cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r].vaddr_page = vaddr_page;
1151 dpavlin 20 cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r].writeflag =
1152     writeflag & MEM_WRITE;
1153     #ifndef MODE32
1154 dpavlin 14 cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r].timestamp = highest + 1;
1155 dpavlin 20 #endif
1156 dpavlin 14
1157     /* Add the new translation to the table: */
1158     #ifdef DYNTRANS_ALPHA
1159     a = (vaddr_page >> ALPHA_LEVEL0_SHIFT) & (ALPHA_LEVEL0 - 1);
1160     b = (vaddr_page >> ALPHA_LEVEL1_SHIFT) & (ALPHA_LEVEL1 - 1);
1161     if ((vaddr_page >> ALPHA_TOPSHIFT) == ALPHA_TOP_KERNEL) {
1162     vph_p = cpu->cd.alpha.vph_table0_kernel[a];
1163     kernel = 1;
1164     } else
1165     vph_p = cpu->cd.alpha.vph_table0[a];
1166     if (vph_p == cpu->cd.alpha.vph_default_page) {
1167     if (cpu->cd.alpha.vph_next_free_page != NULL) {
1168     if (kernel)
1169     vph_p = cpu->cd.alpha.vph_table0_kernel
1170     [a] = cpu->cd.alpha.
1171     vph_next_free_page;
1172     else
1173     vph_p = cpu->cd.alpha.vph_table0[a] =
1174     cpu->cd.alpha.vph_next_free_page;
1175     cpu->cd.alpha.vph_next_free_page = vph_p->next;
1176     } else {
1177     if (kernel)
1178     vph_p = cpu->cd.alpha.vph_table0_kernel
1179     [a] = malloc(sizeof(struct
1180     alpha_vph_page));
1181     else
1182     vph_p = cpu->cd.alpha.vph_table0[a] =
1183     malloc(sizeof(struct
1184     alpha_vph_page));
1185     memset(vph_p, 0, sizeof(struct alpha_vph_page));
1186     }
1187     }
1188     vph_p->refcount ++;
1189     vph_p->host_load[b] = host_page;
1190     vph_p->host_store[b] = writeflag? host_page : NULL;
1191     vph_p->phys_addr[b] = paddr_page;
1192     vph_p->phys_page[b] = NULL;
1193     #else
1194     #ifdef MODE32
1195 dpavlin 18 index = DYNTRANS_ADDR_TO_PAGENR(vaddr_page);
1196 dpavlin 14 cpu->cd.DYNTRANS_ARCH.host_load[index] = host_page;
1197     cpu->cd.DYNTRANS_ARCH.host_store[index] =
1198     writeflag? host_page : NULL;
1199     cpu->cd.DYNTRANS_ARCH.phys_addr[index] = paddr_page;
1200     cpu->cd.DYNTRANS_ARCH.phys_page[index] = NULL;
1201 dpavlin 18 cpu->cd.DYNTRANS_ARCH.vaddr_to_tlbindex[index] = r + 1;
1202     #ifdef DYNTRANS_ARM
1203     if (useraccess)
1204 dpavlin 20 cpu->cd.DYNTRANS_ARCH.is_userpage[index >> 5]
1205     |= 1 << (index & 31);
1206 dpavlin 18 #endif
1207 dpavlin 14 #endif /* 32 */
1208     #endif /* !ALPHA */
1209     } else {
1210     /*
1211     * The translation was already in the TLB.
1212     * Writeflag = 0: Do nothing.
1213     * Writeflag = 1: Make sure the page is writable.
1214 dpavlin 20 * Writeflag = MEM_DOWNGRADE: Downgrade to readonly.
1215 dpavlin 14 */
1216 dpavlin 18 r = found;
1217 dpavlin 20 #ifndef MODE32
1218 dpavlin 18 cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r].timestamp = highest + 1;
1219 dpavlin 20 #endif
1220     if (writeflag & MEM_WRITE)
1221 dpavlin 14 cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r].writeflag = 1;
1222 dpavlin 20 if (writeflag & MEM_DOWNGRADE)
1223 dpavlin 14 cpu->cd.DYNTRANS_ARCH.vph_tlb_entry[r].writeflag = 0;
1224     #ifdef DYNTRANS_ALPHA
1225     a = (vaddr_page >> ALPHA_LEVEL0_SHIFT) & (ALPHA_LEVEL0 - 1);
1226     b = (vaddr_page >> ALPHA_LEVEL1_SHIFT) & (ALPHA_LEVEL1 - 1);
1227     if ((vaddr_page >> ALPHA_TOPSHIFT) == ALPHA_TOP_KERNEL) {
1228     vph_p = cpu->cd.alpha.vph_table0_kernel[a];
1229     kernel = 1;
1230     } else
1231     vph_p = cpu->cd.alpha.vph_table0[a];
1232     vph_p->phys_page[b] = NULL;
1233     if (vph_p->phys_addr[b] == paddr_page) {
1234 dpavlin 20 if (writeflag & MEM_WRITE)
1235 dpavlin 14 vph_p->host_store[b] = host_page;
1236 dpavlin 20 if (writeflag & MEM_DOWNGRADE)
1237 dpavlin 14 vph_p->host_store[b] = NULL;
1238     } else {
1239     /* Change the entire physical/host mapping: */
1240     vph_p->host_load[b] = host_page;
1241     vph_p->host_store[b] = writeflag? host_page : NULL;
1242     vph_p->phys_addr[b] = paddr_page;
1243     }
1244     #else
1245     #ifdef MODE32
1246 dpavlin 18 index = DYNTRANS_ADDR_TO_PAGENR(vaddr_page);
1247 dpavlin 14 cpu->cd.DYNTRANS_ARCH.phys_page[index] = NULL;
1248 dpavlin 18 #ifdef DYNTRANS_ARM
1249 dpavlin 20 cpu->cd.DYNTRANS_ARCH.is_userpage[index>>5] &= ~(1<<(index&31));
1250 dpavlin 18 if (useraccess)
1251 dpavlin 20 cpu->cd.DYNTRANS_ARCH.is_userpage[index >> 5]
1252     |= 1 << (index & 31);
1253 dpavlin 18 #endif
1254 dpavlin 14 if (cpu->cd.DYNTRANS_ARCH.phys_addr[index] == paddr_page) {
1255 dpavlin 20 if (writeflag & MEM_WRITE)
1256 dpavlin 14 cpu->cd.DYNTRANS_ARCH.host_store[index] =
1257     host_page;
1258 dpavlin 20 if (writeflag & MEM_DOWNGRADE)
1259 dpavlin 14 cpu->cd.DYNTRANS_ARCH.host_store[index] = NULL;
1260     } else {
1261     /* Change the entire physical/host mapping: */
1262     cpu->cd.DYNTRANS_ARCH.host_load[index] = host_page;
1263     cpu->cd.DYNTRANS_ARCH.host_store[index] =
1264     writeflag? host_page : NULL;
1265     cpu->cd.DYNTRANS_ARCH.phys_addr[index] = paddr_page;
1266     }
1267     #endif /* 32 */
1268     #endif /* !ALPHA */
1269     }
1270     }
1271     #endif /* DYNTRANS_UPDATE_TRANSLATION_TABLE */
1272    
1273    
1274     /*****************************************************************************/
1275    
1276    
1277     #ifdef DYNTRANS_TO_BE_TRANSLATED_HEAD
1278     /*
1279     * Check for breakpoints.
1280     */
1281     if (!single_step_breakpoint) {
1282     #ifdef MODE32
1283     uint32_t curpc = cpu->pc;
1284     #else
1285     uint64_t curpc = cpu->pc;
1286     #endif
1287     int i;
1288     for (i=0; i<cpu->machine->n_breakpoints; i++)
1289     if (curpc ==
1290     #ifdef MODE32
1291     (uint32_t)
1292     #endif
1293     cpu->machine->breakpoint_addr[i]) {
1294     if (!cpu->machine->instruction_trace) {
1295     int old_quiet_mode = quiet_mode;
1296     quiet_mode = 0;
1297     DISASSEMBLE(cpu, ib, 1, 0, 0);
1298     quiet_mode = old_quiet_mode;
1299     }
1300     fatal("BREAKPOINT: pc = 0x%llx\n(The "
1301     "instruction has not yet executed.)\n",
1302     (long long)cpu->pc);
1303     single_step_breakpoint = 1;
1304     single_step = 1;
1305     goto stop_running_translated;
1306     }
1307     }
1308     #endif /* DYNTRANS_TO_BE_TRANSLATED_HEAD */
1309    
1310    
1311     /*****************************************************************************/
1312    
1313    
1314     #ifdef DYNTRANS_TO_BE_TRANSLATED_TAIL
1315     /*
1316     * If we end up here, then an instruction was translated.
1317 dpavlin 18 * Mark the page as containing a translation.
1318     *
1319     * (Special case for 32-bit mode: set the corresponding bit in the
1320     * phystranslation[] array.)
1321 dpavlin 14 */
1322 dpavlin 18 #ifdef MODE32
1323     if (!(cpu->cd.DYNTRANS_ARCH.cur_physpage->flags & TRANSLATIONS)) {
1324     uint32_t index = DYNTRANS_ADDR_TO_PAGENR(addr);
1325     cpu->cd.DYNTRANS_ARCH.phystranslation[index >> 5] |=
1326     (1 << (index & 31));
1327     }
1328     #endif
1329     cpu->cd.DYNTRANS_ARCH.cur_physpage->flags |= TRANSLATIONS;
1330 dpavlin 14
1331 dpavlin 18
1332 dpavlin 14 /*
1333     * Now it is time to check for combinations of instructions that can
1334     * be converted into a single function call.
1335     *
1336     * Note: Single-stepping or instruction tracing doesn't work with
1337     * instruction combination.
1338     */
1339 dpavlin 18 if (!single_step && !cpu->machine->instruction_trace) {
1340 dpavlin 20 if (cpu->cd.DYNTRANS_ARCH.combination_check != NULL &&
1341 dpavlin 18 cpu->machine->speed_tricks)
1342 dpavlin 20 cpu->cd.DYNTRANS_ARCH.combination_check(cpu, ic,
1343 dpavlin 18 addr & (DYNTRANS_PAGESIZE - 1));
1344 dpavlin 20 cpu->cd.DYNTRANS_ARCH.combination_check = NULL;
1345 dpavlin 18 }
1346 dpavlin 14
1347     /* ... and finally execute the translated instruction: */
1348     if (single_step_breakpoint) {
1349     /*
1350     * Special case when single-stepping: Execute the translated
1351     * instruction, but then replace it with a "to be translated"
1352     * directly afterwards.
1353     */
1354     single_step_breakpoint = 0;
1355     ic->f(cpu, ic);
1356     ic->f =
1357     #ifdef DYNTRANS_DUALMODE_32
1358     cpu->is_32bit? instr32(to_be_translated) :
1359     #endif
1360     instr(to_be_translated);
1361     } else
1362     ic->f(cpu, ic);
1363    
1364     return;
1365    
1366    
1367     bad: /*
1368     * Nothing was translated. (Unimplemented or illegal instruction.)
1369     */
1370    
1371     quiet_mode = 0;
1372     fatal("to_be_translated(): TODO: unimplemented instruction");
1373    
1374     if (cpu->machine->instruction_trace)
1375     #ifdef MODE32
1376     fatal(" at 0x%x\n", (int)cpu->pc);
1377     #else
1378     fatal(" at 0x%llx\n", (long long)cpu->pc);
1379     #endif
1380     else {
1381     fatal(":\n");
1382     DISASSEMBLE(cpu, ib, 1, 0, 0);
1383     }
1384    
1385     cpu->running = 0;
1386     cpu->dead = 1;
1387     stop_running_translated:
1388     debugger_n_steps_left_before_interaction = 0;
1389     cpu->running_translated = 0;
1390     ic = cpu->cd.DYNTRANS_ARCH.next_ic = &nothing_call;
1391     cpu->cd.DYNTRANS_ARCH.next_ic ++;
1392    
1393     /* Execute the "nothing" instruction: */
1394     ic->f(cpu, ic);
1395     #endif /* DYNTRANS_TO_BE_TRANSLATED_TAIL */
1396    

  ViewVC Help
Powered by ViewVC 1.1.26