/[gxemul]/trunk/src/devices/dev_pvr.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/devices/dev_pvr.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
File MIME type: text/plain
File size: 30383 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 32 /*
2     * Copyright (C) 2006 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     * $Id: dev_pvr.c,v 1.17 2006/11/02 05:43:44 debug Exp $
29     *
30     * PowerVR CLX2 (Graphics controller used in the Dreamcast). Implemented by
31     * reading http://www.ludd.luth.se/~jlo/dc/powervr-reg.txt and
32     * http://mc.pp.se/dc/pvr.html, source code of various demos and KalistOS,
33     * and doing a lot of guessing.
34     *
35     * TODO: Almost everything
36     *
37     * x) Change resolution during runtime (PAL/NTSC/???)
38     *
39     * x) Lots of work on the 3D "Tile Accelerator" engine.
40     * Recognize commands and turn into OpenGL or similar
41     * commands on the host?
42     * Color clipping.
43     * Wire-frame when running on a host without XGL?
44     *
45     * x) Border?
46     *
47     * Multiple lists of various kinds (6?).
48     * Lists growing downwards!
49     * Pixel clip for rendering.
50     * Real Rendering, using OpenGL if possible.
51     * Tile bins... with 6 pointers for each tile (?)
52     * PVR DMA.
53     */
54    
55     #include <stdio.h>
56     #include <stdlib.h>
57     #include <string.h>
58    
59     #include "cpu.h"
60     #include "device.h"
61     #include "devices.h"
62     #include "float_emul.h"
63     #include "machine.h"
64     #include "memory.h"
65     #include "misc.h"
66     #include "timer.h"
67    
68     #include "dreamcast_pvr.h"
69     #include "dreamcast_sysasicvar.h"
70    
71    
72     #define debug fatal
73    
74     #define INTERNAL_FB_ADDR 0x300000000ULL
75     #define PVR_FB_TICK_SHIFT 19
76    
77     #define PVR_VBLANK_HZ 60.0
78    
79     struct pvr_data {
80     struct vfb_data *fb;
81     int fb_update_x1;
82     int fb_update_y1;
83     int fb_update_x2;
84     int fb_update_y2;
85    
86     struct timer *vblank_timer;
87     int vblank_interrupts_pending;
88    
89     /* PVR registers: */
90     uint32_t reg[PVRREG_REGSIZE / sizeof(uint32_t)];
91    
92     /* Calculated by pvr_geometry_updated(): */
93     int xsize, ysize;
94     int bytes_per_pixel;
95    
96     /* Cached values (from registers): */
97     /* DIWMODE: */
98     int clock_double;
99     int strip_buffer_enabled;
100     int strip_length;
101     int argb8888_threshold;
102     int extend;
103     int pixelmode;
104     int line_double;
105     int display_enabled;
106     /* SYNCCONF: */
107     int video_enabled;
108     int broadcast_standard;
109     int interlaced;
110     int h_sync_positive;
111     int v_sync_positive;
112     /* TILEBUF_SIZE: */
113     int tilebuf_xsize;
114     int tilebuf_ysize;
115    
116     /* Tile Accelerator Command: */
117     uint32_t ta[64 / sizeof(uint32_t)];
118    
119     uint8_t *vram;
120     uint8_t *vram_alt;
121     };
122    
123     struct pvr_data_alt {
124     struct pvr_data *d;
125     };
126    
127    
128     #define REG(x) (d->reg[(x)/sizeof(uint32_t)])
129     #define DEFAULT_WRITE REG(relative_addr) = idata;
130    
131    
132     /*
133     * pvr_fb_invalidate():
134     */
135     static void pvr_fb_invalidate(struct pvr_data *d, int start, int stop)
136     {
137     d->fb_update_x1 = d->fb_update_y1 = 0;
138     d->fb_update_x2 = d->xsize - 1;
139     d->fb_update_y2 = d->ysize - 1;
140     }
141    
142    
143     /*
144     * pvr_vblank_timer_tick():
145     *
146     * This function is called PVR_VBLANK_HZ times per real-world second. Its job
147     * is to fake vertical retrace interrupts.
148     */
149     static void pvr_vblank_timer_tick(struct timer *t, void *extra)
150     {
151     struct pvr_data *d = (struct pvr_data *) extra;
152     d->vblank_interrupts_pending ++;
153     }
154    
155    
156     /*
157     * pvr_geometry_updated():
158     *
159     * This function should be called every time a register is written to which
160     * affects the framebuffer geometry (size, bit-depth, starting position, etc).
161     */
162     static void pvr_geometry_updated(struct pvr_data *d)
163     {
164     d->xsize = (REG(PVRREG_DIWSIZE) >> DIWSIZE_DPL_SHIFT) & DIWSIZE_MASK;
165     d->ysize = (REG(PVRREG_DIWSIZE) >> DIWSIZE_LPF_SHIFT) & DIWSIZE_MASK;
166    
167     /* E.g. 319x479 => 320x480 */
168     d->xsize = (d->xsize + 1) * sizeof(uint32_t);
169     d->ysize ++;
170    
171     switch (d->pixelmode) {
172     case 0:
173     case 1: d->bytes_per_pixel = 2; break;
174     case 2: d->bytes_per_pixel = 3; break;
175     case 3: d->bytes_per_pixel = 4; break;
176     }
177    
178     d->xsize /= d->bytes_per_pixel;
179    
180     if (REG(PVRREG_DIWCONF) & DIWCONF_LR)
181     d->xsize /= 2;
182    
183     if (d->line_double)
184     d->ysize /= 2;
185    
186     /* Only show geometry debug message if output is enabled: */
187     if (!d->video_enabled || !d->display_enabled)
188     return;
189    
190     debug("[ pvr_geometry_updated: %i x %i, ", d->xsize, d->ysize);
191    
192     switch (d->pixelmode) {
193     case 0: debug("RGB0555 (16-bit)"); break;
194     case 1: debug("RGB565 (16-bit)"); break;
195     case 2: debug("RGB888 (24-bit)"); break;
196     case 3: debug("RGB0888 (32-bit)"); break;
197     }
198    
199     debug(" ]\n");
200     }
201    
202    
203     /* Ugly quick-hack: */
204     static void line(struct pvr_data *d, int x1, int y1, int x2, int y2)
205     {
206     int fb_base = REG(PVRREG_FB_RENDER_ADDR1);
207     int i;
208     for (i=0; i<256; i++) {
209     int px = (i * x2 + (256-i) * x1) >> 8;
210     int py = (i * y2 + (256-i) * y1) >> 8;
211     if (px > 0 && py > 0 && px < d->xsize && py < d->ysize) {
212     d->vram[fb_base + (px + py * d->xsize)*
213     d->bytes_per_pixel] = 255;
214     d->vram[fb_base + (px + py * d->xsize)*
215     d->bytes_per_pixel + 1] = 255;
216     }
217     }
218     }
219    
220    
221     /*
222     * pvr_render():
223     *
224     * Render from the Object Buffer to the framebuffer.
225     *
226     * TODO: This function is totally bogus so far, the format of the Object
227     * Buffer is just a quick made-up hack to see if it works at all.
228     */
229     static void pvr_render(struct cpu *cpu, struct pvr_data *d)
230     {
231     int ob_ofs = REG(PVRREG_OB_ADDR);
232     int fb_base = REG(PVRREG_FB_RENDER_ADDR1);
233     int wf_point_nr, texture = 0;
234     int wf_x[4], wf_y[4];
235    
236     debug("[ pvr_render: rendering to FB offset 0x%x ]\n", fb_base);
237    
238     /* Clear all pixels first: */
239     /* TODO */
240     memset(d->vram + fb_base, 0, d->xsize * d->ysize * d->bytes_per_pixel);
241    
242     wf_point_nr = 0;
243    
244     for (;;) {
245     uint8_t cmd = d->vram[ob_ofs];
246    
247     if (cmd == 0)
248     break;
249     else if (cmd == 1) {
250     int16_t px = d->vram[ob_ofs+2] + d->vram[ob_ofs+3]*256;
251     int16_t py = d->vram[ob_ofs+4] + d->vram[ob_ofs+5]*256;
252    
253     wf_x[wf_point_nr] = px;
254     wf_y[wf_point_nr] = py;
255    
256     wf_point_nr ++;
257     if (wf_point_nr == 4) {
258     #if 1
259     line(d, wf_x[0], wf_y[0], wf_x[1], wf_y[1]);
260     line(d, wf_x[0], wf_y[0], wf_x[2], wf_y[2]);
261     line(d, wf_x[1], wf_y[1], wf_x[3], wf_y[3]);
262     line(d, wf_x[2], wf_y[2], wf_x[3], wf_y[3]);
263     wf_point_nr = 0;
264     wf_x[0] = wf_x[2]; wf_y[0] = wf_y[2];
265     wf_x[1] = wf_x[3]; wf_y[1] = wf_y[3];
266     #else
267     draw_texture(d, wf_x[0], wf_y[0],
268     wf_x[1], wf_y[1],
269     wf_x[2], wf_y[2],
270     wf_x[3], wf_y[3], texture);
271     #endif
272     }
273    
274     } else if (cmd == 2) {
275     wf_point_nr = 0;
276     texture = d->vram[ob_ofs+4] + (d->vram[ob_ofs+5]
277     << 8) + (d->vram[ob_ofs+6] << 16) +
278     (d->vram[ob_ofs+7] << 24);
279     texture <<= 3;
280     texture &= 0x7fffff;
281     printf("TEXTURE = %x\n", texture);
282     } else {
283     fatal("pvr_render: internal error, unknown cmd\n");
284     }
285    
286     ob_ofs += sizeof(uint64_t);
287     }
288    
289     SYSASIC_TRIGGER_EVENT(SYSASIC_EVENT_RENDERDONE);
290     }
291    
292    
293     /*
294     * pvr_reset_ta():
295     *
296     * Reset the Tile Accelerator.
297     */
298     static void pvr_reset_ta(struct pvr_data *d)
299     {
300     REG(PVRREG_DIWCONF) = DIWCONF_MAGIC;
301     }
302    
303    
304     /*
305     * pvr_reset():
306     *
307     * Reset the PVR.
308     */
309     static void pvr_reset(struct pvr_data *d)
310     {
311     /* TODO */
312     }
313    
314    
315     /*
316     * pvr_ta_init():
317     *
318     * Initialize the Tile Accelerator. This makes the TA ready to receive
319     * commands (via address 0x10000000).
320     */
321     static void pvr_ta_init(struct cpu *cpu, struct pvr_data *d)
322     {
323     REG(PVRREG_TA_OPB_POS) = REG(PVRREG_TA_OPB_START);
324     REG(PVRREG_TA_OB_POS) = REG(PVRREG_TA_OB_START);
325     }
326    
327    
328     /*
329     * pvr_ta_command():
330     *
331     * Read a command (e.g. parts of a polygon primitive) from d->ta[], and output
332     * "compiled commands" into the Object list and Object Pointer list.
333     */
334     static void pvr_ta_command(struct cpu *cpu, struct pvr_data *d, int list_ofs)
335     {
336     int ob_ofs;
337     int16_t x, y;
338     uint32_t *ta = &d->ta[list_ofs];
339    
340     #if 0
341     /* Dump the Tile Accelerator command for debugging: */
342     {
343     int i;
344     fatal("TA cmd:");
345     for (i=0; i<8; i++)
346     fatal(" %08x", (int) ta[i]);
347     fatal("\n");
348     }
349     #endif
350    
351     /*
352     * TODO: REWRITE!!!
353     *
354     * THis is just a quick hack to see if I can get out at least
355     * the pixel coordinates.
356     */
357    
358     {
359     struct ieee_float_value fx, fy;
360     ieee_interpret_float_value(ta[1], &fx, IEEE_FMT_S);
361     ieee_interpret_float_value(ta[2], &fy, IEEE_FMT_S);
362     x = fx.f; y = fy.f;
363     }
364    
365     ob_ofs = REG(PVRREG_TA_OB_POS);
366    
367     switch (ta[0] >> 28) {
368     case 0x8:
369     d->vram[ob_ofs + 0] = 2;
370     d->vram[ob_ofs + 4] = ta[3];
371     d->vram[ob_ofs + 5] = ta[3] >> 8;
372     d->vram[ob_ofs + 6] = ta[3] >> 16;
373     d->vram[ob_ofs + 7] = ta[3] >> 24;
374     REG(PVRREG_TA_OB_POS) = ob_ofs + sizeof(uint64_t);
375     break;
376     case 0xe:
377     case 0xf:
378     /* Point. */
379     d->vram[ob_ofs + 0] = 1;
380     d->vram[ob_ofs + 2] = x & 255;
381     d->vram[ob_ofs + 3] = x >> 8;
382     d->vram[ob_ofs + 4] = y & 255;
383     d->vram[ob_ofs + 5] = y >> 8;
384     REG(PVRREG_TA_OB_POS) = ob_ofs + sizeof(uint64_t);
385     break;
386     case 0x0:
387     if (ta[1] == 0) {
388     /* End of list. */
389     uint32_t opb_cfg = REG(PVRREG_TA_OPB_CFG);
390     d->vram[ob_ofs + 0] = 0;
391     REG(PVRREG_TA_OB_POS) = ob_ofs + sizeof(uint64_t);
392     if (opb_cfg & TA_OPB_CFG_OPAQUEPOLY_MASK)
393     SYSASIC_TRIGGER_EVENT(SYSASIC_EVENT_OPAQUEDONE);
394     if (opb_cfg & TA_OPB_CFG_OPAQUEMOD_MASK)
395     SYSASIC_TRIGGER_EVENT(
396     SYSASIC_EVENT_OPAQUEMODDONE);
397     if (opb_cfg & TA_OPB_CFG_TRANSPOLY_MASK)
398     SYSASIC_TRIGGER_EVENT(SYSASIC_EVENT_TRANSDONE);
399     if (opb_cfg & TA_OPB_CFG_TRANSMOD_MASK)
400     SYSASIC_TRIGGER_EVENT(
401     SYSASIC_EVENT_TRANSMODDONE);
402     if (opb_cfg & TA_OPB_CFG_PUNCHTHROUGH_MASK)
403     SYSASIC_TRIGGER_EVENT(SYSASIC_EVENT_PVR_PTDONE);
404     }
405     break;
406     case 2: /* Ignore for now. */
407     case 3: /* Ignore for now. */
408     /* TODO */
409     break;
410     default:fatal("Unimplemented top TA nibble %i\n", ta[0] >> 28);
411     exit(1);
412     }
413     }
414    
415    
416     DEVICE_ACCESS(pvr_ta)
417     {
418     struct pvr_data *d = (struct pvr_data *) extra;
419     uint64_t idata = 0, odata = 0;
420    
421     if (writeflag == MEM_WRITE) {
422     idata = memory_readmax64(cpu, data, len);
423    
424     /* Write to the tile accelerator command buffer: */
425     d->ta[relative_addr / sizeof(uint32_t)] = idata;
426    
427     /* Execute the command, after a complete write: */
428     if (relative_addr == 0x1c)
429     pvr_ta_command(cpu, d, 0);
430     if (relative_addr == 0x3c)
431     pvr_ta_command(cpu, d, 8);
432     } else {
433     odata = d->ta[relative_addr / sizeof(uint32_t)];
434     memory_writemax64(cpu, data, len, odata);
435     }
436    
437     return 1;
438     }
439    
440    
441     DEVICE_ACCESS(pvr)
442     {
443     struct pvr_data *d = (struct pvr_data *) extra;
444     uint64_t idata = 0, odata = 0;
445    
446     if (writeflag == MEM_WRITE)
447     idata = memory_readmax64(cpu, data, len);
448    
449     /* Default read action: Read from reg[]: */
450     if (writeflag == MEM_READ)
451     odata = d->reg[relative_addr / sizeof(uint32_t)];
452    
453     /* Fog table access: */
454     if (relative_addr >= PVRREG_FOG_TABLE &&
455     relative_addr < PVRREG_FOG_TABLE + PVR_FOG_TABLE_SIZE) {
456     if (writeflag == MEM_WRITE)
457     DEFAULT_WRITE;
458     goto return_ok;
459     }
460    
461     switch (relative_addr) {
462    
463     case PVRREG_ID:
464     /* ID for Set 5.xx versions of the Dreamcast, according
465     to http://www.ludd.luth.se/~jlo/dc/powervr-reg.txt: */
466     odata = 0x17fd11db;
467     break;
468    
469     case PVRREG_REVISION:
470     /* Revision 1.1, for Dreamcast Set 5.2x. */
471     odata = 0x00000011;
472     break;
473    
474     case PVRREG_RESET:
475     if (writeflag == MEM_WRITE) {
476     debug("[ pvr: RESET ");
477     if (idata & PVR_RESET_PVR)
478     pvr_reset(d);
479     if (idata & PVR_RESET_TA)
480     pvr_reset_ta(d);
481     debug("]\n");
482     idata = 0;
483     DEFAULT_WRITE;
484     }
485     break;
486    
487     case PVRREG_STARTRENDER:
488     if (writeflag == MEM_WRITE) {
489     debug("[ pvr: STARTRENDER ]\n");
490     pvr_render(cpu, d);
491     } else {
492     fatal("[ pvr: huh? read from STARTRENDER ]\n");
493     }
494     break;
495    
496     case PVRREG_OB_ADDR:
497     if (writeflag == MEM_WRITE) {
498     debug("[ pvr: OB_ADDR set to 0x%08"PRIx32" ]\n",
499     (uint32_t)(idata & PVR_OB_ADDR_MASK));
500     /* if (idata & ~PVR_OB_ADDR_MASK) {
501     fatal("[ pvr: OB_ADDR: Fatal error: Unknown"
502     " bits set: 0x%08"PRIx32" ]\n",
503     (uint32_t)(idata & ~PVR_OB_ADDR_MASK));
504     exit(1);
505     }
506     idata &= PVR_OB_ADDR_MASK;
507     */
508     DEFAULT_WRITE;
509     }
510     break;
511    
512     case PVRREG_TILEBUF_ADDR:
513     if (writeflag == MEM_WRITE) {
514     debug("[ pvr: TILEBUF_ADDR set to 0x%08"PRIx32" ]\n",
515     (uint32_t)(idata & PVR_TILEBUF_ADDR_MASK));
516     if (idata & ~PVR_TILEBUF_ADDR_MASK)
517     fatal("[ pvr: TILEBUF_ADDR: WARNING: Unknown"
518     " bits set: 0x%08"PRIx32" ]\n",
519     (uint32_t)(idata & ~PVR_TILEBUF_ADDR_MASK));
520     idata &= PVR_TILEBUF_ADDR_MASK;
521     DEFAULT_WRITE;
522     }
523     break;
524    
525     case PVRREG_SPANSORT:
526     if (writeflag == MEM_WRITE) {
527     debug("[ pvr: SPANSORT: ");
528     if (idata & PVR_SPANSORT_SPAN0)
529     debug("SPAN0 ");
530     if (idata & PVR_SPANSORT_SPAN1)
531     debug("SPAN1 ");
532     if (idata & PVR_SPANSORT_TSP_CACHE_ENABLE)
533     debug("TSP_CACHE_ENABLE ");
534     debug("]\n");
535     DEFAULT_WRITE;
536     }
537     break;
538    
539     case PVRREG_BRDCOLR:
540     if (writeflag == MEM_WRITE) {
541     debug("[ pvr: BRDCOLR set to 0x%06"PRIx32" ]\n",
542     (int)idata);
543     DEFAULT_WRITE;
544     }
545     break;
546    
547     case PVRREG_DIWMODE:
548     if (writeflag == MEM_WRITE) {
549     d->clock_double = idata & DIWMODE_C_MASK? 1:0;
550     d->strip_buffer_enabled = idata & DIWMODE_SE_MASK? 1:0;
551     d->strip_length = (idata & DIWMODE_SL_MASK)
552     >> DIWMODE_SL_SHIFT;
553     d->argb8888_threshold = (idata & DIWMODE_TH_MASK)
554     >> DIWMODE_TH_SHIFT;
555     d->extend = (idata & DIWMODE_EX_MASK)
556     >> DIWMODE_EX_SHIFT;
557     d->pixelmode = (idata & DIWMODE_COL_MASK)
558     >> DIWMODE_COL_SHIFT;
559     d->line_double = idata & DIWMODE_SD_MASK? 1:0;
560     d->display_enabled = idata & DIWMODE_DE_MASK? 1:0;
561    
562     debug("[ pvr: DIWMODE set to: ");
563     debug("clock_double=%i, ", d->clock_double);
564     debug("strip_buffer_enabled=%i, ",
565     d->strip_buffer_enabled);
566     debug("strip_length=%i, ", d->strip_length);
567     debug("argb8888_threshold=%i, ", d->argb8888_threshold);
568     debug("extend=0x%x, ", d->extend);
569     debug("pixelmode=");
570     switch (d->pixelmode) {
571     case 0: debug("RGB0555 (16-bit)"); break;
572     case 1: debug("RGB565 (16-bit)"); break;
573     case 2: debug("RGB888 (24-bit)"); break;
574     case 3: debug("RGB0888 (32-bit)"); break;
575     }
576     debug(", line_double=%i, ", d->line_double);
577     debug("display_enabled=%i", d->display_enabled);
578     debug(" ]\n");
579    
580     DEFAULT_WRITE;
581     pvr_geometry_updated(d);
582     pvr_fb_invalidate(d, -1, -1);
583     }
584     break;
585    
586     case PVRREG_DIWSIZE:
587     if (writeflag == MEM_WRITE) {
588     debug("[ pvr: DIWSIZE set to modulo=%i, "
589     "width=%i, height=%i ]\n", (int)
590     ((idata >> DIWSIZE_MODULO_SHIFT) & DIWSIZE_MASK),
591     (int)((idata >> DIWSIZE_DPL_SHIFT) & DIWSIZE_MASK),
592     (int)((idata >> DIWSIZE_LPF_SHIFT) & DIWSIZE_MASK));
593     DEFAULT_WRITE;
594     pvr_geometry_updated(d);
595     pvr_fb_invalidate(d, -1, -1);
596     }
597     break;
598    
599     case PVRREG_FB_RENDER_ADDR1:
600     if (writeflag == MEM_WRITE) {
601     debug("[ pvr: FB_RENDER_ADDR1 set to 0x%08"PRIx32
602     " ]\n", (int) idata);
603     DEFAULT_WRITE;
604     }
605     break;
606    
607     case PVRREG_FB_RENDER_ADDR2:
608     if (writeflag == MEM_WRITE) {
609     debug("[ pvr: FB_RENDER_ADDR2 set to 0x%08"PRIx32
610     " ]\n", (int) idata);
611     DEFAULT_WRITE;
612     }
613     break;
614    
615     case PVRREG_VRAM_CFG1:
616     if (writeflag == MEM_WRITE) {
617     debug("[ pvr: VRAM_CFG1 set to 0x%08"PRIx32,
618     (int) idata);
619     if (idata != VRAM_CFG1_GOOD_REFRESH_VALUE)
620     fatal("{ VRAM_CFG1 = 0x%08"PRIx32" is not "
621     "yet implemented! }", (int) idata);
622     debug(" ]\n");
623     DEFAULT_WRITE;
624     }
625     break;
626    
627     case PVRREG_VRAM_CFG2:
628     if (writeflag == MEM_WRITE) {
629     debug("[ pvr: VRAM_CFG2 set to 0x%08"PRIx32,
630     (int) idata);
631     if (idata != VRAM_CFG2_UNKNOWN_MAGIC)
632     fatal("{ VRAM_CFG2 = 0x%08"PRIx32" is not "
633     "yet implemented! }", (int) idata);
634     debug(" ]\n");
635     DEFAULT_WRITE;
636     }
637     break;
638    
639     case PVRREG_VRAM_CFG3:
640     if (writeflag == MEM_WRITE) {
641     debug("[ pvr: VRAM_CFG3 set to 0x%08"PRIx32,
642     (int) idata);
643     if (idata != VRAM_CFG3_UNKNOWN_MAGIC)
644     fatal("{ VRAM_CFG3 = 0x%08"PRIx32" is not "
645     "yet implemented! }", (int) idata);
646     debug(" ]\n");
647     DEFAULT_WRITE;
648     }
649     break;
650    
651     case PVRREG_FOG_TABLE_COL:
652     if (writeflag == MEM_WRITE) {
653     debug("[ pvr: FOG_TABLE_COL set to 0x%08"PRIx32" ]\n",
654     (int) idata);
655     DEFAULT_WRITE;
656     }
657     break;
658    
659     case PVRREG_FOG_VERTEX_COL:
660     if (writeflag == MEM_WRITE) {
661     debug("[ pvr: FOG_VERTEX_COL set to 0x%08"PRIx32" ]\n",
662     (int) idata);
663     DEFAULT_WRITE;
664     }
665     break;
666    
667     case PVRREG_FB_RENDER_MODULO:
668     if (writeflag == MEM_WRITE) {
669     debug("[ pvr: PVRREG_FB_RENDER_MODULO set to %i ]\n",
670     (int) idata);
671     /* TODO */
672     DEFAULT_WRITE;
673     }
674     break;
675    
676     case PVRREG_DIWADDRL:
677     if (writeflag == MEM_WRITE) {
678     debug("[ pvr: DIWADDRL set to 0x%08"PRIx32" ]\n",
679     (int) idata);
680     pvr_fb_invalidate(d, -1, -1);
681     DEFAULT_WRITE;
682     }
683     break;
684    
685     case PVRREG_DIWADDRS:
686     if (writeflag == MEM_WRITE) {
687     debug("[ pvr: DIWADDRS set to 0x%08"PRIx32" ]\n",
688     (int) idata);
689     pvr_fb_invalidate(d, -1, -1);
690     DEFAULT_WRITE;
691     }
692     break;
693    
694     case PVRREG_RASEVTPOS:
695     if (writeflag == MEM_WRITE) {
696     debug("[ pvr: RASEVTPOS pos1=%i pos2=%i ]\n",
697     (int)((idata & RASEVTPOS_POS1_MASK)
698     >> RASEVTPOS_POS1_SHIFT),
699     (int)(idata & RASEVTPOS_POS2_MASK));
700     DEFAULT_WRITE;
701     }
702     break;
703    
704     case PVRREG_SYNCCONF:
705     if (writeflag == MEM_WRITE) {
706     d->video_enabled = idata & SYNCCONF_VO_MASK? 1:0;
707     d->broadcast_standard = (idata & SYNCCONF_BC_MASK)
708     >> SYNCCONF_BC_SHIFT;
709     d->interlaced = idata & SYNCCONF_I_MASK? 1:0;
710     d->h_sync_positive = idata & SYNCCONF_HP_MASK? 1:0;
711     d->v_sync_positive = idata & SYNCCONF_VP_MASK? 1:0;
712    
713     debug("[ pvr: SYNCCONF set to: ");
714     debug("video_enabled=%i, ", d->video_enabled);
715     switch (d->broadcast_standard) {
716     case SYNCCONF_BC_VGA: debug("VGA"); break;
717     case SYNCCONF_BC_NTSC: debug("NTSC"); break;
718     case SYNCCONF_BC_PAL: debug("PAL"); break;
719     default: debug("*UNKNOWN*"); break;
720     }
721     debug(", interlaced=%i, ", d->interlaced);
722     debug("hsync=%i, ", d->h_sync_positive);
723     debug("vsync=%i ]\n", d->v_sync_positive);
724    
725     DEFAULT_WRITE;
726     pvr_geometry_updated(d);
727     pvr_fb_invalidate(d, -1, -1);
728     }
729     break;
730    
731     case PVRREG_BRDHORZ:
732     if (writeflag == MEM_WRITE) {
733     debug("[ pvr: BRDHORZ start=%i stop=%i ]\n",
734     (int)((idata & BRDHORZ_START_MASK)
735     >> BRDHORZ_START_SHIFT),
736     (int)(idata & BRDHORZ_STOP_MASK));
737     DEFAULT_WRITE;
738     }
739     break;
740    
741     case PVRREG_SYNCSIZE:
742     if (writeflag == MEM_WRITE) {
743     debug("[ pvr: SYNCSIZE v=%i h=%i ]\n",
744     (int)((idata & SYNCSIZE_V_MASK)
745     >> SYNCSIZE_V_SHIFT),
746     (int)(idata & SYNCSIZE_H_MASK));
747     DEFAULT_WRITE;
748     }
749     break;
750    
751     case PVRREG_BRDVERT:
752     if (writeflag == MEM_WRITE) {
753     debug("[ pvr: BRDVERT start=%i stop=%i ]\n",
754     (int)((idata & BRDVERT_START_MASK)
755     >> BRDVERT_START_SHIFT),
756     (int)(idata & BRDVERT_STOP_MASK));
757     DEFAULT_WRITE;
758     }
759     break;
760    
761     case PVRREG_DIWCONF:
762     if (writeflag == MEM_WRITE) {
763     if ((idata & DIWCONF_MAGIC_MASK) !=
764     DIWCONF_MAGIC && (idata & DIWCONF_MAGIC_MASK)
765     != 0) {
766     fatal("PVRREG_DIWCONF magic not set to "
767     "Magic value. 0x%08x\n", (int)idata);
768     exit(1);
769     }
770     if (idata & DIWCONF_BLANK)
771     debug("[ pvr: PVRREG_DIWCONF: BLANK: TODO ]\n");
772    
773     DEFAULT_WRITE;
774     pvr_geometry_updated(d);
775     }
776     break;
777    
778     case PVRREG_DIWHSTRT:
779     if (writeflag == MEM_WRITE) {
780     debug("[ pvr: DIWHSTRT hpos=%i ]\n",
781     (int)(idata & DIWVSTRT_HPOS_MASK));
782     DEFAULT_WRITE;
783     }
784     break;
785    
786     case PVRREG_DIWVSTRT:
787     if (writeflag == MEM_WRITE) {
788     debug("[ pvr: DIWVSTRT v2=%i v1=%i ]\n",
789     (int)((idata & DIWVSTRT_V2_MASK)
790     >> DIWVSTRT_V2_SHIFT),
791     (int)(idata & DIWVSTRT_V1_MASK));
792     DEFAULT_WRITE;
793     }
794     break;
795    
796     case PVRREG_SYNC_STAT:
797     /* TODO. Ugly hack, but it works: */
798     odata = random();
799     break;
800    
801     case PVRREG_TA_OPB_START:
802     if (writeflag == MEM_WRITE) {
803     if (idata & ~TA_OPB_START_MASK) {
804     fatal("[ pvr: UNEXPECTED bits in "
805     "TA_OPB_START: 0x%08x ]\n", (int)idata);
806     exit(1);
807     }
808     idata &= TA_OPB_START_MASK;
809     debug("[ pvr: TA_OPB_START set to 0x%x ]\n",
810     (int) idata);
811     DEFAULT_WRITE;
812     }
813     break;
814    
815     case PVRREG_TA_OB_START:
816     if (writeflag == MEM_WRITE) {
817     if (idata & ~TA_OB_START_MASK) {
818     fatal("[ pvr: UNEXPECTED bits in "
819     "TA_OB_START: 0x%08x ]\n", (int)idata);
820     exit(1);
821     }
822     idata &= TA_OB_START_MASK;
823     debug("[ pvr: TA_OB_START set to 0x%x ]\n",
824     (int) idata);
825     DEFAULT_WRITE;
826     }
827     break;
828    
829     case PVRREG_TA_OPB_END:
830     if (writeflag == MEM_WRITE) {
831     idata &= TA_OPB_END_MASK;
832     debug("[ pvr: TA_OPB_END set to 0x%x ]\n",
833     (int) idata);
834     DEFAULT_WRITE;
835     }
836     break;
837    
838     case PVRREG_TA_OB_END:
839     if (writeflag == MEM_WRITE) {
840     idata &= TA_OB_END_MASK;
841     debug("[ pvr: TA_OB_END set to 0x%x ]\n",
842     (int) idata);
843     DEFAULT_WRITE;
844     }
845     break;
846    
847     case PVRREG_TA_OPB_POS:
848     if (writeflag == MEM_WRITE) {
849     idata &= TA_OPB_POS_MASK;
850     debug("[ pvr: TA_OPB_POS set to 0x%x ]\n",
851     (int) idata);
852     DEFAULT_WRITE;
853     }
854     break;
855    
856     case PVRREG_TA_OB_POS:
857     if (writeflag == MEM_WRITE) {
858     idata &= TA_OB_POS_MASK;
859     debug("[ pvr: TA_OB_POS set to 0x%x ]\n",
860     (int) idata);
861     DEFAULT_WRITE;
862     }
863     break;
864    
865     case PVRREG_TILEBUF_SIZE:
866     if (writeflag == MEM_WRITE) {
867     d->tilebuf_ysize = (idata & TILEBUF_SIZE_HEIGHT_MASK)
868     >> TILEBUF_SIZE_HEIGHT_SHIFT;
869     d->tilebuf_xsize = idata & TILEBUF_SIZE_WIDTH_MASK;
870     d->tilebuf_xsize ++; d->tilebuf_ysize ++;
871     debug("[ pvr: TILEBUF_SIZE set to %i x %i ]\n",
872     d->tilebuf_xsize, d->tilebuf_ysize);
873     DEFAULT_WRITE;
874     }
875     break;
876    
877     case PVRREG_TA_INIT:
878     if (writeflag == MEM_WRITE) {
879     debug("[ pvr: TA_INIT ]\n");
880    
881     if (idata & PVR_TA_INIT)
882     pvr_ta_init(cpu, d);
883    
884     if (idata != PVR_TA_INIT && idata != 0)
885     fatal("{ TA_INIT = 0x%08"PRIx32" is not "
886     "yet implemented! }", (int) idata);
887    
888     /* Always reset to 0. */
889     idata = 0;
890     DEFAULT_WRITE;
891     }
892     break;
893    
894     default:if (writeflag == MEM_READ) {
895     fatal("[ pvr: read from UNIMPLEMENTED addr 0x%x ]\n",
896     (int)relative_addr);
897     } else {
898     fatal("[ pvr: write to UNIMPLEMENTED addr 0x%x: 0x%x"
899     " ]\n", (int)relative_addr, (int)idata);
900     DEFAULT_WRITE;
901     }
902     }
903    
904     return_ok:
905     if (writeflag == MEM_READ)
906     memory_writemax64(cpu, data, len, odata);
907    
908     return 1;
909     }
910    
911    
912     static void extend_update_region(struct pvr_data *d, uint64_t low,
913     uint64_t high)
914     {
915     int vram_ofs = REG(PVRREG_DIWADDRL);
916     int bytes_per_line = d->xsize * d->bytes_per_pixel;
917    
918     low -= vram_ofs;
919     high -= vram_ofs;
920    
921     /* Access inside visible part of VRAM? */
922     if ((int64_t)high >= 0 && (int64_t)low <
923     bytes_per_line * d->ysize) {
924     int new_y1, new_y2;
925    
926     d->fb_update_x1 = 0;
927     d->fb_update_x2 = d->xsize - 1;
928    
929     /* Calculate which line the low and high addresses
930     correspond to: */
931     new_y1 = low / bytes_per_line;
932     new_y2 = high / bytes_per_line + 1;
933    
934     if (d->fb_update_y1 < 0 || new_y1 < d->fb_update_y1)
935     d->fb_update_y1 = new_y1;
936     if (d->fb_update_y2 < 0 || new_y2 > d->fb_update_y2)
937     d->fb_update_y2 = new_y2;
938    
939     if (d->fb_update_y2 >= d->ysize)
940     d->fb_update_y2 = d->ysize - 1;
941     }
942     }
943    
944    
945     DEVICE_TICK(pvr_fb)
946     {
947     struct pvr_data *d = extra;
948     uint64_t high, low = (uint64_t)(int64_t) -1;
949     int vram_ofs = REG(PVRREG_DIWADDRL), pixels_to_copy;
950     int y, bytes_per_line = d->xsize * d->bytes_per_pixel;
951     int fb_ofs, p;
952     uint8_t *fb = (uint8_t *) d->fb->framebuffer;
953     uint8_t *vram = (uint8_t *) d->vram;
954    
955    
956     /*
957     * Vertical retrace interrupts:
958     *
959     * TODO: Maybe it would be even more realistic to have the timer run
960     * at, say, 60*4 = 240 Hz, and have the following events:
961     *
962     * (tick & 3) == 0 SYSASIC_EVENT_VBLINT
963     * (tick & 3) == 1 SYSASIC_EVENT_PVR_SCANINT1
964     * (tick & 3) == 2 nothing
965     * (tick & 3) == 3 SYSASIC_EVENT_PVR_SCANINT2
966     */
967    
968     if (d->vblank_interrupts_pending > 0) {
969     SYSASIC_TRIGGER_EVENT(SYSASIC_EVENT_VBLINT);
970     SYSASIC_TRIGGER_EVENT(SYSASIC_EVENT_PVR_SCANINT1);
971     SYSASIC_TRIGGER_EVENT(SYSASIC_EVENT_PVR_SCANINT2);
972    
973     /* TODO: For now, I don't care about missed interrupts: */
974     d->vblank_interrupts_pending = 0;
975     }
976    
977    
978     /*
979     * Framebuffer update:
980     */
981    
982     memory_device_dyntrans_access(cpu, cpu->mem, extra, &low, &high);
983     if ((int64_t)low != -1)
984     extend_update_region(d, low, high);
985    
986     if (d->fb_update_x1 == -1)
987     return;
988    
989     /* Copy (part of) the VRAM to the framebuffer: */
990     if (d->fb_update_x2 >= d->fb->xsize)
991     d->fb_update_x2 = d->fb->xsize - 1;
992     if (d->fb_update_y2 >= d->fb->ysize)
993     d->fb_update_y2 = d->fb->ysize - 1;
994    
995     vram_ofs += d->fb_update_y1 * bytes_per_line;
996     vram_ofs += d->fb_update_x1 * d->bytes_per_pixel;
997     pixels_to_copy = (d->fb_update_x2 - d->fb_update_x1 + 1);
998     fb_ofs = d->fb_update_y1 * d->fb->bytes_per_line;
999     fb_ofs += d->fb_update_x1 * d->fb->bit_depth / 8;
1000    
1001     /* Copy the actual pixels: (Four manually inlined, for speed.) */
1002    
1003     switch (d->pixelmode) {
1004     case 0: /* RGB0555 (16-bit) */
1005     for (y=d->fb_update_y1; y<=d->fb_update_y2; y++) {
1006     int fo = fb_ofs, vo = vram_ofs;
1007     for (p=0; p<pixels_to_copy; p++) {
1008     /* 0rrrrrgg(high) gggbbbbb(low) */
1009     fb[fo] = (vram[vo+1] << 1) & 0xf8;
1010     fb[fo+1] = ((vram[vo] >> 2) & 0x38) +
1011     (vram[vo+1] << 6);
1012     fb[fo+2] = (vram[vo] & 0x1f) << 3;
1013     fo += 3; vo += 2;
1014     }
1015     vram_ofs += bytes_per_line;
1016     fb_ofs += d->fb->bytes_per_line;
1017     }
1018     break;
1019    
1020     case 1: /* RGB565 (16-bit) */
1021     for (y=d->fb_update_y1; y<=d->fb_update_y2; y++) {
1022     int fo = fb_ofs, vo = vram_ofs;
1023     for (p=0; p<pixels_to_copy; p++) {
1024     /* rrrrrggg(high) gggbbbbb(low) */
1025     fb[fo] = vram[vo+1] & 0xf8;
1026     fb[fo+1] = ((vram[vo] >> 3) & 0x1c) +
1027     (vram[vo+1] << 5);
1028     fb[fo+2] = (vram[vo] & 0x1f) << 3;
1029     fo += 3; vo += 2;
1030     }
1031     vram_ofs += bytes_per_line;
1032     fb_ofs += d->fb->bytes_per_line;
1033     }
1034     break;
1035    
1036     case 2: /* RGB888 (24-bit) */
1037     for (y=d->fb_update_y1; y<=d->fb_update_y2; y++) {
1038     /* TODO: Reverse colors, like in the 32-bit case? */
1039     memcpy(fb+fb_ofs, vram+vram_ofs, 3*pixels_to_copy);
1040     vram_ofs += bytes_per_line;
1041     fb_ofs += d->fb->bytes_per_line;
1042     }
1043     break;
1044    
1045     case 3: /* RGB0888 (32-bit) */
1046     for (y=d->fb_update_y1; y<=d->fb_update_y2; y++) {
1047     int fo = fb_ofs, vo = vram_ofs;
1048     for (p=0; p<pixels_to_copy; p++) {
1049     fb[fo] = vram[vo+2];
1050     fb[fo+1] = vram[vo+1];
1051     fb[fo+2] = vram[vo+0];
1052     fo += 3; vo += 4;
1053     }
1054     vram_ofs += bytes_per_line;
1055     fb_ofs += d->fb->bytes_per_line;
1056     }
1057     break;
1058     }
1059    
1060     /*
1061     * Extend the real framebuffer to encompass the area
1062     * just written to:
1063     */
1064    
1065     if (d->fb_update_x1 < d->fb->update_x1 || d->fb->update_x1 < 0)
1066     d->fb->update_x1 = d->fb_update_x1;
1067     if (d->fb_update_x2 > d->fb->update_x2 || d->fb->update_x2 < 0)
1068     d->fb->update_x2 = d->fb_update_x2;
1069     if (d->fb_update_y1 < d->fb->update_y1 || d->fb->update_y1 < 0)
1070     d->fb->update_y1 = d->fb_update_y1;
1071     if (d->fb_update_y2 > d->fb->update_y2 || d->fb->update_y2 < 0)
1072     d->fb->update_y2 = d->fb_update_y2;
1073    
1074     /* Clear the PVR's update region: */
1075     d->fb_update_x1 = d->fb_update_x2 =
1076     d->fb_update_y1 = d->fb_update_y2 = -1;
1077     }
1078    
1079    
1080     DEVICE_ACCESS(pvr_vram_alt)
1081     {
1082     struct pvr_data_alt *d_alt = extra;
1083     struct pvr_data *d = d_alt->d;
1084     int i;
1085    
1086     if (writeflag == MEM_READ) {
1087     /* Copy from real vram: */
1088     for (i=0; i<len; i++) {
1089     int addr = relative_addr + i;
1090     addr = ((addr & 4) << 20) | (addr & 3)
1091     | ((addr & 0x7ffff8) >> 1);
1092     data[i] = d->vram[addr];
1093     }
1094     return 1;
1095     }
1096    
1097     /*
1098     * Convert writes to alternative VRAM, into normal writes:
1099     */
1100    
1101     for (i=0; i<len; i++) {
1102     int addr = relative_addr + i;
1103     addr = ((addr & 4) << 20) | (addr & 3)
1104     | ((addr & 0x7ffff8) >> 1);
1105     d->vram[addr] = data[i];
1106     }
1107    
1108     return 1;
1109     }
1110    
1111    
1112     DEVICE_ACCESS(pvr_vram)
1113     {
1114     struct pvr_data *d = extra;
1115    
1116     if (writeflag == MEM_READ) {
1117     memcpy(data, d->vram + relative_addr, len);
1118     return 1;
1119     }
1120    
1121     /*
1122     * Write to VRAM:
1123     *
1124     * Calculate which part of the framebuffer this write corresponds to,
1125     * if any, and increase the update region to encompass the written
1126     * memory range.
1127     */
1128    
1129     memcpy(d->vram + relative_addr, data, len);
1130     extend_update_region(d, relative_addr, relative_addr + len - 1);
1131    
1132     return 1;
1133     }
1134    
1135    
1136     DEVINIT(pvr)
1137     {
1138     struct machine *machine = devinit->machine;
1139     struct pvr_data *d = malloc(sizeof(struct pvr_data));
1140     struct pvr_data_alt *d_alt = malloc(sizeof(struct pvr_data_alt));
1141     if (d == NULL) {
1142     fprintf(stderr, "out of memory\n");
1143     exit(1);
1144     }
1145     memset(d, 0, sizeof(struct pvr_data));
1146     memset(d_alt, 0, sizeof(struct pvr_data_alt));
1147    
1148     d_alt->d = d;
1149    
1150     memory_device_register(machine->memory, devinit->name,
1151     PVRREG_REGSTART, PVRREG_REGSIZE, dev_pvr_access, d,
1152     DM_DEFAULT, NULL);
1153    
1154     /* 8 MB video RAM: */
1155     d->vram = zeroed_alloc(8 * 1048576);
1156     memory_device_register(machine->memory, "pvr_vram", 0x05000000,
1157     8 * 1048576, dev_pvr_vram_access, (void *)d,
1158     DM_DYNTRANS_OK | DM_DYNTRANS_WRITE_OK
1159     | DM_READS_HAVE_NO_SIDE_EFFECTS, d->vram);
1160    
1161     /* 8 MB video RAM, when accessed at 0xa4000000: */
1162     d->vram_alt = zeroed_alloc(8 * 1048576);
1163     memory_device_register(machine->memory, "pvr_alt_vram", 0x04000000,
1164     8 * 1048576, dev_pvr_vram_alt_access, (void *)d_alt,
1165     DM_DEFAULT, NULL);
1166    
1167     memory_device_register(machine->memory, "pvr_ta",
1168     0x10000000, sizeof(d->ta), dev_pvr_ta_access, d, DM_DEFAULT, NULL);
1169    
1170     d->xsize = 640;
1171     d->ysize = 480;
1172     d->pixelmode = 1; /* RGB565 */
1173     d->bytes_per_pixel = 2;
1174    
1175     d->fb = dev_fb_init(machine, machine->memory, INTERNAL_FB_ADDR,
1176     VFB_GENERIC, 640,480, 640,480, 24, "Dreamcast PVR");
1177    
1178     d->vblank_timer = timer_add(PVR_VBLANK_HZ, pvr_vblank_timer_tick, d);
1179    
1180     pvr_reset(d);
1181     pvr_reset_ta(d);
1182    
1183     machine_add_tickfunction(machine, dev_pvr_fb_tick, d,
1184     PVR_FB_TICK_SHIFT, 0.0);
1185    
1186     return 1;
1187     }
1188    

  ViewVC Help
Powered by ViewVC 1.1.26