/[gxemul]/trunk/src/cpus/cpu_alpha.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_alpha.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: 20221 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_alpha.c,v 1.23 2006/09/19 10:50:08 debug Exp $
29 dpavlin 14 *
30     * Alpha CPU emulation.
31     *
32     * TODO: Many things.
33     *
34     * See http://www.eecs.harvard.edu/~nr/toolkit/specs/alpha.html for info
35     * on instruction formats etc.
36     */
37    
38     #include <stdio.h>
39     #include <stdlib.h>
40     #include <string.h>
41     #include <ctype.h>
42    
43     #include "cpu.h"
44     #include "machine.h"
45     #include "memory.h"
46     #include "misc.h"
47 dpavlin 32 #include "settings.h"
48 dpavlin 14 #include "symbol.h"
49    
50     #define DYNTRANS_8K
51     #define DYNTRANS_PAGESIZE 8192
52     #include "tmp_alpha_head.c"
53    
54    
55     /* Alpha symbolic register names: */
56     static char *alpha_regname[N_ALPHA_REGS] = ALPHA_REG_NAMES;
57    
58    
59     /*
60     * alpha_cpu_new():
61     *
62     * Create a new Alpha CPU object by filling the CPU struct.
63     * Return 1 on success, 0 if cpu_type_name isn't a valid Alpha processor.
64     */
65     int alpha_cpu_new(struct cpu *cpu, struct memory *mem,
66     struct machine *machine, int cpu_id, char *cpu_type_name)
67     {
68 dpavlin 24 int i = 0;
69     struct alpha_cpu_type_def cpu_type_defs[] = ALPHA_CPU_TYPE_DEFS;
70 dpavlin 14
71 dpavlin 24 /* Scan the cpu_type_defs list for this cpu type: */
72     while (cpu_type_defs[i].name != NULL) {
73     if (strcasecmp(cpu_type_defs[i].name, cpu_type_name) == 0) {
74     break;
75     }
76     i++;
77     }
78     if (cpu_type_defs[i].name == NULL)
79 dpavlin 14 return 0;
80    
81 dpavlin 32 cpu->is_32bit = 0;
82     cpu->byte_order = EMUL_LITTLE_ENDIAN;
83    
84 dpavlin 14 cpu->memory_rw = alpha_memory_rw;
85 dpavlin 28 cpu->run_instr = alpha_run_instr;
86 dpavlin 26 cpu->translate_v2p = alpha_translate_v2p;
87 dpavlin 14 cpu->update_translation_table = alpha_update_translation_table;
88 dpavlin 18 cpu->invalidate_translation_caches =
89     alpha_invalidate_translation_caches;
90 dpavlin 14 cpu->invalidate_code_translation = alpha_invalidate_code_translation;
91    
92 dpavlin 32 cpu->cd.alpha.cpu_type = cpu_type_defs[i];
93    
94 dpavlin 14 /* Only show name and caches etc for CPU nr 0: */
95     if (cpu_id == 0) {
96     debug("%s", cpu->name);
97     }
98    
99     cpu->cd.alpha.r[ALPHA_SP] = 0xfffffc000000ff00ULL;
100    
101 dpavlin 32 /* Set up dummy kentry pointers to something which crashes
102     the machine: */
103     store_32bit_word(cpu, 0x10010, 0x3fffffc);
104     for (i=0; i<N_ALPHA_KENTRY; i++)
105     cpu->cd.alpha.kentry[i] = 0x10010;
106    
107     /* Bogus initial context (will be overwritten on first
108     context switch): */
109     cpu->cd.alpha.ctx = 0x10100;
110    
111     CPU_SETTINGS_ADD_REGISTER64("pc", cpu->pc);
112     for (i=0; i<N_ALPHA_REGS; i++)
113     CPU_SETTINGS_ADD_REGISTER64(alpha_regname[i],
114     cpu->cd.alpha.r[i]);
115    
116 dpavlin 14 return 1;
117     }
118    
119    
120     /*
121     * alpha_cpu_dumpinfo():
122     */
123     void alpha_cpu_dumpinfo(struct cpu *cpu)
124     {
125     /* TODO */
126     debug("\n");
127     }
128    
129    
130     /*
131     * alpha_cpu_list_available_types():
132     *
133     * Print a list of available Alpha CPU types.
134     */
135     void alpha_cpu_list_available_types(void)
136     {
137 dpavlin 24 int i, j;
138     struct alpha_cpu_type_def tdefs[] = ALPHA_CPU_TYPE_DEFS;
139 dpavlin 14
140 dpavlin 24 i = 0;
141     while (tdefs[i].name != NULL) {
142     debug("%s", tdefs[i].name);
143 dpavlin 28 for (j=13 - strlen(tdefs[i].name); j>0; j--)
144 dpavlin 24 debug(" ");
145     i++;
146     if ((i % 4) == 0 || tdefs[i].name == NULL)
147     debug("\n");
148     }
149 dpavlin 14 }
150    
151    
152     /*
153     * alpha_cpu_register_dump():
154     *
155     * Dump cpu registers in a relatively readable format.
156     *
157     * gprs: set to non-zero to dump GPRs and some special-purpose registers.
158     * coprocs: set bit 0..3 to dump registers in coproc 0..3.
159     */
160     void alpha_cpu_register_dump(struct cpu *cpu, int gprs, int coprocs)
161     {
162     char *symbol;
163     uint64_t offset;
164     int i, x = cpu->cpu_id;
165    
166     if (gprs) {
167     symbol = get_symbol_name(&cpu->machine->symbol_context,
168     cpu->pc, &offset);
169 dpavlin 24 debug("cpu%i:\t pc = 0x%016"PRIx64, x, (uint64_t) cpu->pc);
170 dpavlin 14 debug(" <%s>\n", symbol != NULL? symbol : " no symbol ");
171     for (i=0; i<N_ALPHA_REGS; i++) {
172     int r = (i >> 1) + ((i & 1) << 4);
173     if ((i % 2) == 0)
174     debug("cpu%i:\t", x);
175     if (r != ALPHA_ZERO)
176 dpavlin 24 debug("%3s = 0x%016"PRIx64, alpha_regname[r],
177     (uint64_t) cpu->cd.alpha.r[r]);
178 dpavlin 14 debug((i % 2) == 1? "\n" : " ");
179     }
180     }
181     }
182    
183    
184     /*
185 dpavlin 24 * alpha_cpu_tlbdump():
186     *
187     * Called from the debugger to dump the TLB in a readable format.
188     * x is the cpu number to dump, or -1 to dump all CPUs.
189     *
190     * If rawflag is nonzero, then the TLB contents isn't formated nicely,
191     * just dumped.
192     */
193     void alpha_cpu_tlbdump(struct machine *m, int x, int rawflag)
194     {
195     }
196    
197    
198     static void add_response_word(struct cpu *cpu, char *r, uint64_t value,
199     size_t maxlen, int len)
200     {
201     char *format = (len == 4)? "%08"PRIx64 : "%016"PRIx64;
202     if (len == 4)
203     value &= 0xffffffffULL;
204     if (cpu->byte_order == EMUL_LITTLE_ENDIAN) {
205     if (len == 4) {
206     value = ((value & 0xff) << 24) +
207     ((value & 0xff00) << 8) +
208     ((value & 0xff0000) >> 8) +
209     ((value & 0xff000000) >> 24);
210     } else {
211     value = ((value & 0xff) << 56) +
212     ((value & 0xff00) << 40) +
213     ((value & 0xff0000) << 24) +
214     ((value & 0xff000000ULL) << 8) +
215     ((value & 0xff00000000ULL) >> 8) +
216     ((value & 0xff0000000000ULL) >> 24) +
217     ((value & 0xff000000000000ULL) >> 40) +
218     ((value & 0xff00000000000000ULL) >> 56);
219     }
220     }
221     snprintf(r + strlen(r), maxlen - strlen(r), format, (uint64_t)value);
222     }
223    
224    
225     /*
226     * alpha_cpu_gdb_stub():
227     *
228     * Execute a "remote GDB" command. Returns a newly allocated response string
229     * on success, NULL on failure.
230     */
231     char *alpha_cpu_gdb_stub(struct cpu *cpu, char *cmd)
232     {
233     if (strcmp(cmd, "g") == 0) {
234     int i;
235     char *r;
236     size_t wlen = cpu->is_32bit?
237     sizeof(uint32_t) : sizeof(uint64_t);
238     size_t len = 1 + 76 * wlen;
239     r = malloc(len);
240     if (r == NULL) {
241     fprintf(stderr, "out of memory\n");
242     exit(1);
243     }
244     r[0] = '\0';
245     for (i=0; i<128; i++)
246     add_response_word(cpu, r, i, len, wlen);
247     return r;
248     }
249    
250     if (cmd[0] == 'p') {
251     int regnr = strtol(cmd + 1, NULL, 16);
252     size_t wlen = cpu->is_32bit?
253     sizeof(uint32_t) : sizeof(uint64_t);
254     size_t len = 2 * wlen + 1;
255     char *r = malloc(len);
256     r[0] = '\0';
257     if (regnr >= 0 && regnr <= 31) {
258     add_response_word(cpu, r,
259     cpu->cd.alpha.r[regnr], len, wlen);
260     } else if (regnr >= 32 && regnr <= 62) {
261     add_response_word(cpu, r,
262     cpu->cd.alpha.f[regnr - 32], len, wlen);
263     } else if (regnr == 0x3f) {
264     add_response_word(cpu, r, cpu->cd.alpha.fpcr,
265     len, wlen);
266     } else if (regnr == 0x40) {
267     add_response_word(cpu, r, cpu->pc, len, wlen);
268     } else {
269     /* Unimplemented: */
270     add_response_word(cpu, r, 0xcc000 + regnr, len, wlen);
271     }
272     return r;
273     }
274    
275     fatal("alpha_cpu_gdb_stub(): TODO\n");
276     return NULL;
277     }
278    
279    
280     /*
281 dpavlin 14 * alpha_cpu_interrupt():
282     */
283     int alpha_cpu_interrupt(struct cpu *cpu, uint64_t irq_nr)
284     {
285     fatal("alpha_cpu_interrupt(): TODO\n");
286     return 0;
287     }
288    
289    
290     /*
291     * alpha_cpu_interrupt_ack():
292     */
293     int alpha_cpu_interrupt_ack(struct cpu *cpu, uint64_t irq_nr)
294     {
295     /* fatal("alpha_cpu_interrupt_ack(): TODO\n"); */
296     return 0;
297     }
298    
299    
300     /*
301     * alpha_print_imm16_disp():
302     *
303     * Used internally by alpha_cpu_disassemble_instr().
304     */
305     static void alpha_print_imm16_disp(int imm, int rb)
306     {
307     imm = (int16_t)imm;
308    
309     if (imm < 0) {
310     debug("-");
311     imm = -imm;
312     }
313     if (imm <= 256)
314     debug("%i", imm);
315     else
316     debug("0x%x", imm);
317     if (rb != ALPHA_ZERO)
318     debug("(%s)", alpha_regname[rb]);
319     }
320    
321    
322     /*
323     * alpha_cpu_disassemble_instr():
324     *
325     * Convert an instruction word into human readable format, for instruction
326     * tracing.
327     *
328     * If running is 1, cpu->pc should be the address of the instruction.
329     *
330     * If running is 0, things that depend on the runtime environment (eg.
331     * register contents) will not be shown, and addr will be used instead of
332     * cpu->pc for relative addresses.
333     */
334     int alpha_cpu_disassemble_instr(struct cpu *cpu, unsigned char *ib,
335 dpavlin 24 int running, uint64_t dumpaddr)
336 dpavlin 14 {
337     uint32_t iw;
338     uint64_t offset, tmp;
339     int opcode, ra, rb, func, rc, imm, floating, rbrc = 0, indir = 0;
340     char *symbol, *mnem = NULL;
341     char palcode_name[30];
342    
343     if (running)
344     dumpaddr = cpu->pc;
345    
346     symbol = get_symbol_name(&cpu->machine->symbol_context,
347     dumpaddr, &offset);
348     if (symbol != NULL && offset == 0)
349     debug("<%s>\n", symbol);
350    
351     if (cpu->machine->ncpus > 1 && running)
352     debug("cpu%i:\t", cpu->cpu_id);
353    
354 dpavlin 24 debug("%016"PRIx64": ", (uint64_t) dumpaddr);
355 dpavlin 14
356     iw = ib[0] + (ib[1]<<8) + (ib[2]<<16) + (ib[3]<<24);
357     debug("%08x\t", (int)iw);
358    
359     opcode = iw >> 26;
360     ra = (iw >> 21) & 31;
361     rb = (iw >> 16) & 31;
362     func = (iw >> 5) & 0x7ff;
363     rc = iw & 31;
364     imm = iw & 0xffff;
365    
366     switch (opcode) {
367     case 0x00:
368     alpha_palcode_name(iw & 0x3ffffff, palcode_name,
369     sizeof(palcode_name));
370     debug("call_pal %s\n", palcode_name);
371     break;
372     case 0x08:
373     case 0x09:
374     debug("lda%s\t%s,", opcode == 9? "h" : "", alpha_regname[ra]);
375     alpha_print_imm16_disp(imm, rb);
376     debug("\n");
377     break;
378     case 0x0a:
379     case 0x0b:
380     case 0x0c:
381     case 0x0d:
382     case 0x0e:
383     case 0x0f:
384     case 0x20:
385     case 0x21:
386     case 0x22:
387     case 0x23:
388     case 0x24:
389     case 0x25:
390     case 0x26:
391     case 0x27:
392     case 0x28:
393     case 0x29:
394     case 0x2a:
395     case 0x2b:
396     case 0x2c:
397     case 0x2d:
398     case 0x2e:
399     case 0x2f:
400     floating = 0;
401     switch (opcode) {
402     case 0x0a: mnem = "ldbu"; break;
403     case 0x0b: mnem = "ldq_u"; break;
404     case 0x0c: mnem = "ldwu"; break;
405     case 0x0d: mnem = "stw"; break;
406     case 0x0e: mnem = "stb"; break;
407     case 0x0f: mnem = "stq_u"; break;
408     case 0x20: mnem = "ldf"; floating = 1; break;
409     case 0x21: mnem = "ldg"; floating = 1; break;
410     case 0x22: mnem = "lds"; floating = 1; break;
411     case 0x23: mnem = "ldt"; floating = 1; break;
412     case 0x24: mnem = "stf"; floating = 1; break;
413     case 0x25: mnem = "stg"; floating = 1; break;
414     case 0x26: mnem = "sts"; floating = 1; break;
415     case 0x27: mnem = "stt"; floating = 1; break;
416     case 0x28: mnem = "ldl"; break;
417     case 0x29: mnem = "ldq"; break;
418     case 0x2a: mnem = "ldl_l"; break;
419     case 0x2b: mnem = "ldq_l"; break;
420     case 0x2c: mnem = "stl"; break;
421     case 0x2d: mnem = "stq"; break;
422     case 0x2e: mnem = "stl_c"; break;
423     case 0x2f: mnem = "stq_c"; break;
424     }
425     if (opcode == 0x0b && ra == ALPHA_ZERO) {
426     debug("unop");
427     } else {
428     debug("%s\t", mnem);
429     if (floating)
430     debug("f%i,", ra);
431     else
432     debug("%s,", alpha_regname[ra]);
433     alpha_print_imm16_disp(imm, rb);
434     }
435     debug("\n");
436     break;
437     case 0x10:
438     switch (func & 0x7f) {
439     case 0x00: mnem = "addl"; break;
440     case 0x02: mnem = "s4addl"; break;
441     case 0x09: mnem = "subl"; break;
442     case 0x0b: mnem = "s4subl"; break;
443     case 0x0f: mnem = "cmpbge"; break;
444     case 0x12: mnem = "s8addl"; break;
445     case 0x1b: mnem = "s8subl"; break;
446     case 0x1d: mnem = "cmpult"; break;
447     case 0x20: mnem = "addq"; break;
448     case 0x22: mnem = "s4addq"; break;
449     case 0x29: mnem = "subq"; break;
450     case 0x2b: mnem = "s4subq"; break;
451     case 0x2d: mnem = "cmpeq"; break;
452     case 0x32: mnem = "s8addq"; break;
453     case 0x3b: mnem = "s8subq"; break;
454     case 0x3d: mnem = "cmpule"; break;
455     case 0x40: mnem = "addl/v"; break;
456     case 0x49: mnem = "subl/v"; break;
457     case 0x4d: mnem = "cmplt"; break;
458     case 0x60: mnem = "addq/v"; break;
459     case 0x69: mnem = "subq/v"; break;
460     case 0x6d: mnem = "cmple"; break;
461     default:debug("UNIMPLEMENTED opcode 0x%x func 0x%x\n",
462     opcode, func);
463     }
464     if (mnem == NULL)
465     break;
466     if (func & 0x80)
467     debug("%s\t%s,0x%x,%s\n", mnem,
468     alpha_regname[ra], (rb << 3) + (func >> 8),
469     alpha_regname[rc]);
470     else
471     debug("%s\t%s,%s,%s\n", mnem, alpha_regname[ra],
472     alpha_regname[rb], alpha_regname[rc]);
473     break;
474     case 0x11:
475     switch (func & 0x7f) {
476     case 0x000: mnem = "and"; break;
477     case 0x008: mnem = "andnot"; break;
478     case 0x014: mnem = "cmovlbs"; break;
479     case 0x016: mnem = "cmovlbc"; break;
480     case 0x020: mnem = "or"; break;
481     case 0x024: mnem = "cmoveq"; break;
482     case 0x026: mnem = "cmovne"; break;
483     case 0x028: mnem = "ornot"; break;
484     case 0x040: mnem = "xor"; break;
485     case 0x044: mnem = "cmovlt"; break;
486     case 0x046: mnem = "cmovge"; break;
487     case 0x048: mnem = "eqv"; break;
488     case 0x061: mnem = "amask"; break;
489     case 0x064: mnem = "cmovle"; break;
490     case 0x066: mnem = "cmovgt"; break;
491 dpavlin 32 case 0x06c: mnem = "implver"; break;
492 dpavlin 14 default:debug("UNIMPLEMENTED opcode 0x%x func 0x%x\n",
493     opcode, func);
494     }
495     if (mnem == NULL)
496     break;
497     /* Special cases: "nop" etc: */
498     if (func == 0x020 && rc == ALPHA_ZERO)
499     debug("nop\n");
500     else if (func == 0x020 && (ra == ALPHA_ZERO
501     || rb == ALPHA_ZERO)) {
502     if (ra == ALPHA_ZERO && rb == ALPHA_ZERO)
503     debug("clr\t%s\n", alpha_regname[rc]);
504     else if (ra == ALPHA_ZERO)
505     debug("mov\t%s,%s\n", alpha_regname[rb],
506     alpha_regname[rc]);
507     else
508     debug("mov\t%s,%s\n", alpha_regname[ra],
509     alpha_regname[rc]);
510 dpavlin 32 } else if (func == 0x1ec) {
511     /* implver */
512     debug("%s\t%s\n", mnem, alpha_regname[rc]);
513 dpavlin 14 } else if (func & 0x80)
514     debug("%s\t%s,0x%x,%s\n", mnem,
515     alpha_regname[ra], (rb << 3) + (func >> 8),
516     alpha_regname[rc]);
517     else
518     debug("%s\t%s,%s,%s\n", mnem, alpha_regname[ra],
519     alpha_regname[rb], alpha_regname[rc]);
520     break;
521     case 0x12:
522     switch (func & 0x7f) {
523     case 0x02: mnem = "mskbl"; break;
524     case 0x06: mnem = "extbl"; break;
525     case 0x0b: mnem = "insbl"; break;
526     case 0x12: mnem = "mskwl"; break;
527     case 0x16: mnem = "extwl"; break;
528     case 0x1b: mnem = "inswl"; break;
529     case 0x22: mnem = "mskll"; break;
530     case 0x26: mnem = "extll"; break;
531     case 0x2b: mnem = "insll"; break;
532     case 0x30: mnem = "zap"; break;
533     case 0x31: mnem = "zapnot"; break;
534     case 0x32: mnem = "mskql"; break;
535     case 0x34: mnem = "srl"; break;
536     case 0x36: mnem = "extql"; break;
537     case 0x39: mnem = "sll"; break;
538     case 0x3b: mnem = "insql"; break;
539     case 0x3c: mnem = "sra"; break;
540     case 0x52: mnem = "mskwh"; break;
541     case 0x57: mnem = "inswh"; break;
542     case 0x5a: mnem = "extwh"; break;
543     case 0x62: mnem = "msklh"; break;
544     case 0x67: mnem = "inslh"; break;
545     case 0x6a: mnem = "extlh"; break;
546     case 0x72: mnem = "mskqh"; break;
547     case 0x77: mnem = "insqh"; break;
548     case 0x7a: mnem = "extqh"; break;
549     default:debug("UNIMPLEMENTED opcode 0x%x func 0x%x\n",
550     opcode, func);
551     }
552     if (mnem == NULL)
553     break;
554     if (func & 0x80)
555     debug("%s\t%s,0x%x,%s\n", mnem,
556     alpha_regname[ra], (rb << 3) + (func >> 8),
557     alpha_regname[rc]);
558     else
559     debug("%s\t%s,%s,%s\n", mnem, alpha_regname[ra],
560     alpha_regname[rb], alpha_regname[rc]);
561     break;
562     case 0x13:
563     switch (func & 0x7f) {
564     case 0x00: mnem = "mull"; break;
565     case 0x20: mnem = "mulq"; break;
566     case 0x30: mnem = "umulh"; break;
567     case 0x40: mnem = "mull/v"; break;
568     case 0x60: mnem = "mulq/v"; break;
569     default:debug("UNIMPLEMENTED opcode 0x%x func 0x%x\n",
570     opcode, func);
571     }
572     if (mnem == NULL)
573     break;
574     if (func & 0x80)
575     debug("%s\t%s,0x%x,%s\n", mnem,
576     alpha_regname[ra], (rb << 3) + (func >> 8),
577     alpha_regname[rc]);
578     else
579     debug("%s\t%s,%s,%s\n", mnem, alpha_regname[ra],
580     alpha_regname[rb], alpha_regname[rc]);
581     break;
582     case 0x16:
583     switch (func & 0x7ff) {
584 dpavlin 22 case 0x02f: mnem = "cvttq/c"; rbrc = 1; break;
585 dpavlin 14 case 0x080: mnem = "adds"; break;
586     case 0x081: mnem = "subs"; break;
587     case 0x082: mnem = "muls"; break;
588 dpavlin 22 case 0x083: mnem = "XXXx083"; break;
589 dpavlin 14 case 0x0a0: mnem = "addt"; break;
590     case 0x0a1: mnem = "subt"; break;
591     case 0x0a2: mnem = "mult"; break;
592     case 0x0a3: mnem = "divt"; break;
593 dpavlin 22 case 0x0a5: mnem = "cmpteq"; break;
594     case 0x0a6: mnem = "cmptlt"; break;
595     case 0x0a7: mnem = "cmptle"; break;
596 dpavlin 14 case 0x0be: mnem = "cvtqt"; rbrc = 1; break;
597     default:debug("UNIMPLEMENTED opcode 0x%x func 0x%x\n",
598     opcode, func);
599     }
600     if (mnem == NULL)
601     break;
602     if (rbrc)
603     debug("%s\tf%i,f%i\n", mnem, rb, rc);
604     else
605     debug("%s\tf%i,f%i,f%i\n", mnem, ra, rb, rc);
606     break;
607     case 0x17:
608     switch (func & 0x7ff) {
609     case 0x020: mnem = "fabs"; rbrc = 1; break;
610 dpavlin 22 case 0x021: mnem = "fneg"; rbrc = 1; break;
611 dpavlin 14 default:debug("UNIMPLEMENTED opcode 0x%x func 0x%x\n",
612     opcode, func);
613     }
614     if (mnem == NULL)
615     break;
616     if ((func & 0x7ff) == 0x020 && ra == 31 && rb == 31)
617     debug("fclr\tf%i\n", rc);
618     else if (rbrc)
619     debug("%s\tf%i,f%i\n", mnem, rb, rc);
620     else
621     debug("%s\tf%i,f%i,f%i\n", mnem, ra, rb, rc);
622     break;
623     case 0x18:
624     switch (iw & 0xffff) {
625     case 0x0000: mnem = "trapb"; break;
626     case 0x0400: mnem = "excb"; break;
627     case 0x4000: mnem = "mb"; break;
628     case 0x4400: mnem = "wmb"; break;
629     case 0x8000: mnem = "fetch"; indir = 1; break;
630     case 0xa000: mnem = "fetch_m"; indir = 1; break;
631     case 0xc000: mnem = "rpcc"; break;
632     case 0xe000: mnem = "rc"; break;
633     case 0xe800: mnem = "ecb"; indir = 1; break;
634     case 0xf000: mnem = "rs"; break;
635     case 0xf800: mnem = "wh64"; indir = 1; break;
636     default:debug("UNIMPLEMENTED opcode 0x%x func 0x%x\n",
637     opcode, func);
638     }
639     if (mnem == NULL)
640     break;
641     debug("%s", mnem);
642     if ((iw & 0xffff) >= 0x8000) {
643     debug("\t");
644     if (indir)
645     debug("(%s)", alpha_regname[rb]);
646     else
647     debug("%s", alpha_regname[ra]);
648     }
649     debug("\n");
650     break;
651     case 0x1a:
652     tmp = iw & 0x3fff;
653     if (tmp & 0x2000)
654     tmp |= 0xffffffffffffc000ULL;
655     tmp <<= 2;
656     tmp += dumpaddr + sizeof(uint32_t);
657     switch ((iw >> 14) & 3) {
658     case 0:
659     case 1: if (((iw >> 14) & 3) == 0)
660     debug("jmp");
661     else
662     debug("jsr");
663     debug("\t%s,", alpha_regname[ra]);
664     debug("(%s),", alpha_regname[rb]);
665 dpavlin 24 debug("0x%"PRIx64, (uint64_t) tmp);
666 dpavlin 14 symbol = get_symbol_name(&cpu->machine->symbol_context,
667     tmp, &offset);
668     if (symbol != NULL)
669     debug("\t<%s>", symbol);
670     break;
671     case 2: debug("ret");
672     break;
673     default:fatal("unimpl JSR!");
674     }
675     debug("\n");
676     break;
677     case 0x30:
678     case 0x34:
679     tmp = iw & 0x1fffff;
680     if (tmp & 0x100000)
681     tmp |= 0xffffffffffe00000ULL;
682     tmp <<= 2;
683     tmp += dumpaddr + sizeof(uint32_t);
684     debug("%s\t", opcode==0x30? "br" : "bsr");
685     if (ra != ALPHA_ZERO)
686     debug("%s,", alpha_regname[ra]);
687 dpavlin 24 debug("0x%"PRIx64, (uint64_t) tmp);
688 dpavlin 14 symbol = get_symbol_name(&cpu->machine->symbol_context,
689     tmp, &offset);
690     if (symbol != NULL)
691     debug("\t<%s>", symbol);
692     debug("\n");
693     break;
694 dpavlin 22 case 0x31:
695     case 0x35:
696 dpavlin 14 case 0x38:
697     case 0x39:
698     case 0x3a:
699     case 0x3b:
700     case 0x3c:
701     case 0x3d:
702     case 0x3e:
703     case 0x3f:
704 dpavlin 22 floating = 0;
705 dpavlin 14 switch (opcode) {
706 dpavlin 22 case 0x31: mnem = "fbeq"; floating = 1; break;
707     case 0x35: mnem = "fbne"; floating = 1; break;
708 dpavlin 14 case 0x38: mnem = "blbc"; break;
709     case 0x39: mnem = "beq"; break;
710     case 0x3a: mnem = "blt"; break;
711     case 0x3b: mnem = "ble"; break;
712     case 0x3c: mnem = "blbs"; break;
713     case 0x3d: mnem = "bne"; break;
714     case 0x3e: mnem = "bge"; break;
715     case 0x3f: mnem = "bgt"; break;
716     }
717     tmp = iw & 0x1fffff;
718     if (tmp & 0x100000)
719     tmp |= 0xffffffffffe00000ULL;
720     tmp <<= 2;
721     tmp += dumpaddr + sizeof(uint32_t);
722 dpavlin 22 debug("%s\t", mnem);
723     if (floating)
724     debug("f%i,", ra);
725     else
726     debug("%s,", alpha_regname[ra]);
727 dpavlin 24 debug("0x%"PRIx64, (uint64_t) tmp);
728 dpavlin 14 symbol = get_symbol_name(&cpu->machine->symbol_context,
729     tmp, &offset);
730     if (symbol != NULL)
731     debug("\t<%s>", symbol);
732     debug("\n");
733     break;
734     default:debug("UNIMPLEMENTED opcode 0x%x\n", opcode);
735     }
736    
737     return sizeof(uint32_t);
738     }
739    
740    
741     #define MEMORY_RW alpha_userland_memory_rw
742     #define MEM_ALPHA
743     #define MEM_USERLAND
744     #include "../memory_rw.c"
745     #undef MEM_USERLAND
746     #undef MEM_ALPHA
747     #undef MEMORY_RW
748    
749    
750     #include "tmp_alpha_tail.c"
751    

  ViewVC Help
Powered by ViewVC 1.1.26