/[gxemul]/trunk/src/devices/dev_vga.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_vga.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6 - (hide annotations)
Mon Oct 8 16:18:11 2007 UTC (16 years, 5 months ago) by dpavlin
File MIME type: text/plain
File size: 32281 byte(s)
++ trunk/HISTORY	(local)
$Id: HISTORY,v 1.772 2005/06/04 12:02:16 debug Exp $
20050428	Disabling the "-fmove-all-movables" option in the configure
		script, because it causes the compile to fail on OpenBSD/sgi.
20050502	Minor updates.
20050503	Removing the WRT54G mode (it was bogus anyway), and adding a
		comment about Windows NT for MIPS in doc/experiments.html.
		Minor updates to the x86 instruction decoding.
20050504	Adding some more x86 instructions.
		Adding support for reading files from ISO9660 CDROMs (including
		gzipped files). It's an ugly hack, but it seems to work.
		Various other minor updates (dev_vga.c, pc_bios.c etc).
20050505	Some more x86-related updates.
		Beginning (what I hope will be) a major code cleanup phase.
		"bootris" (an x86 bootsector) runs :-)
20050506	Adding some more x86 instructions.
20050507	tmpnam => mkstemp.
		Working on a hack to allow VGA charcells to be shown even when
		not running with X11.
		Adding more x86 instructions.
20050508	x86 32-bit SIB addressing fix, and more instructions.
20050509	Adding more x86 instructions.
20050510	Minor documentation updates, and other updates (x86 stuff etc.)
20050511	More x86-related updates.
20050513	Various updates, mostly x86-related. (Trying to fix flag 
		calculation, factoring out the ugly shift/rotate code, and
		some other things.)
20050514	Adding support for loading some old i386 a.out executables.
		Finally beginning the cleanup of machine/PROM/bios dependant
		info.
		Some minor documentation updates.
		Trying to clean up ARCBIOS stuff a little.
20050515	Trying to make it possible to actually use more than one disk
		type per machine (floppy, ide, scsi).
		Trying to clean up the kbd vs PROM console stuff. (For PC and
		ARC emulation modes, mostly.)
		Beginning to add an 8259 interrupt controller, and connecting
		it to the x86 emulation.
20050516	The first x86 interrupts seem to work (keyboard stuff).
		Adding a 8253/8254 programmable interval timer skeleton.
		FreeDOS now reaches a command prompt and can be interacted
		with.
20050517	After some bugfixes, MS-DOS also (sometimes) reaches a
		command prompt now.
		Trying to fix the pckbc to work with MS-DOS' keyb.com, but no
		success yet.
20050518	Adding a simple 32-bit x86 MMU skeleton.
20050519	Some more work on the x86 stuff. (Beginning the work on paging,
		and various other fixes).
20050520	More updates. Working on dev_vga (4-bit graphics modes), adding
		40 columns support to the PC bios emulation.
		Trying to add support for resizing windows when switching
		between graphics modes.
20050521	Many more x86-related updates.
20050522	Correcting the initial stack pointer's sign-extension for
		ARCBIOS emulation (thanks to Alec Voropay for noticing the
		error).
		Continuing on the cleanup (ARCBIOS etc).
		dev_vga updates.
20050523	More x86 updates: trying to add some support for protected mode
		interrupts (via gate descriptors) and many other fixes.
		More ARCBIOS cleanup.
		Adding a device flag which indicates that reads cause no
		side-effects. (Useful for the "dump" command in the debugger,
		and other things.)
		Adding support for directly starting up x86 ELFs, skipping the
		bootloader stage. (Most ELFs, however, are not suitable for
		this.)
20050524	Adding simple 32-bit x86 TSS task switching, but no privilege
		level support yet.
		More work on dev_vga. A small "Copper bars" demo works. :-)
		Adding support for Trap Flag (single-step exceptions), at least
		in real mode, and various other x86-related fixes.
20050525	Adding a new disk image prefix (gH;S;) which can be used to
		override the default nr of heads and sectors per track.
20050527	Various bug fixes, more work on the x86 mode (stack change on
		interrupts between different priv.levels), and some minor
		documentation updates.
20050528	Various fixes (x86 stuff).
20050529	More x86 fixes. An OpenBSD/i386 bootfloppy reaches userland
		and can be interacted with (although there are problems with
		key repetition). NetBSD/i386 triggers a serious CISC-related
		problem: instruction fetches across page boundaries, where
		the later part isn't actually part of the instruction.
20050530	Various minor updates. (Documentation updates, etc.)
20050531	Adding some experimental code (experiments/new_test_*) which
		could be useful for dynamic (but not binary) translation in
		the future.
20050602	Adding a dummy ARM skeleton.
		Fixing the pckbc key repetition problem (by adding release
		scancodes for all keypresses).
20050603	Minor updates for the next release.
20050604	Release testing. Minor updates.

==============  RELEASE 0.3.3  ==============

20050604	There'll probably be a 0.3.3.1 release soon, with some very
		very tiny updates.


1 dpavlin 4 /*
2     * Copyright (C) 2004-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 6 * $Id: dev_vga.c,v 1.74 2005/05/29 16:04:28 debug Exp $
29 dpavlin 4 *
30 dpavlin 6 * VGA charcell and graphics device.
31 dpavlin 4 *
32 dpavlin 6 * It should work with 80x25 and 40x25 text modes, and with a few graphics
33     * modes as long as no fancy VGA features are used.
34 dpavlin 4 */
35    
36     #include <stdio.h>
37     #include <stdlib.h>
38     #include <string.h>
39    
40 dpavlin 6 #include "console.h"
41 dpavlin 4 #include "cpu.h"
42     #include "devices.h"
43     #include "machine.h"
44     #include "memory.h"
45     #include "misc.h"
46    
47 dpavlin 6 #include "vga.h"
48    
49 dpavlin 4 /* These are generated from binary font files: */
50     #include "fonts/font8x8.c"
51     #include "fonts/font8x10.c"
52     #include "fonts/font8x16.c"
53    
54    
55     /* For bintranslated videomem -> framebuffer updates: */
56 dpavlin 6 #define VGA_TICK_SHIFT 16
57 dpavlin 4
58 dpavlin 6 #define MAX_RETRACE_SCANLINES 420
59     #define N_IS1_READ_THRESHOLD 50
60    
61 dpavlin 4 #define VGA_MEM_MAXY 60
62 dpavlin 6 #define VGA_MEM_ALLOCY 60
63     #define GFX_ADDR_WINDOW 0x18000
64 dpavlin 4
65 dpavlin 6 #define VGA_FB_ADDR 0x1c00000000ULL
66 dpavlin 4
67 dpavlin 6 #define MODE_CHARCELL 1
68     #define MODE_GRAPHICS 2
69 dpavlin 4
70 dpavlin 6 #define GRAPHICS_MODE_8BIT 1
71     #define GRAPHICS_MODE_4BIT 2
72    
73 dpavlin 4 struct vga_data {
74     uint64_t videomem_base;
75     uint64_t control_base;
76    
77     struct vfb_data *fb;
78 dpavlin 6 size_t fb_size;
79 dpavlin 4
80 dpavlin 6 int fb_max_x; /* pixels */
81     int fb_max_y; /* pixels */
82     int max_x; /* charcells or pixels */
83     int max_y; /* charcells or pixels */
84    
85     /* Selects charcell mode or graphics mode: */
86     int cur_mode;
87    
88     /* Common for text and graphics modes: */
89     int pixel_repx, pixel_repy;
90    
91     /* Textmode: */
92     int font_width;
93     int font_height;
94 dpavlin 4 unsigned char *font;
95 dpavlin 6 size_t charcells_size;
96     unsigned char *charcells; /* 2 bytes per char */
97     unsigned char *charcells_outputed;
98 dpavlin 4
99 dpavlin 6 /* Graphics: */
100     int graphics_mode;
101     int bits_per_pixel;
102     unsigned char *gfx_mem;
103     size_t gfx_mem_size;
104 dpavlin 4
105 dpavlin 6 /* Registers: */
106     int attribute_state; /* 0 or 1 */
107     unsigned char attribute_reg_select;
108     unsigned char attribute_reg[256];
109 dpavlin 4
110 dpavlin 6 unsigned char misc_output_reg;
111 dpavlin 4
112 dpavlin 6 unsigned char sequencer_reg_select;
113     unsigned char sequencer_reg[256];
114    
115     unsigned char graphcontr_reg_select;
116     unsigned char graphcontr_reg[256];
117    
118     unsigned char crtc_reg_select;
119     unsigned char crtc_reg[256];
120    
121     unsigned char palette_read_index;
122     char palette_read_subindex;
123     unsigned char palette_write_index;
124     char palette_write_subindex;
125    
126     int current_retrace_line;
127     int input_status_1;
128    
129     /* Palette per scanline during retrace: */
130     unsigned char *retrace_palette;
131     int use_palette_per_line;
132     int64_t n_is1_reads;
133    
134     /* Misc.: */
135     int console_handle;
136    
137 dpavlin 4 int cursor_x;
138     int cursor_y;
139    
140     int modified;
141     int update_x1;
142     int update_y1;
143     int update_x2;
144     int update_y2;
145     };
146    
147    
148     /*
149 dpavlin 6 * register_reset():
150 dpavlin 4 *
151 dpavlin 6 * Resets many registers to sane values.
152     */
153     static void register_reset(struct vga_data *d)
154     {
155     /* Home cursor: */
156     d->cursor_x = d->cursor_y = 0;
157     d->crtc_reg[VGA_CRTC_CURSOR_LOCATION_HIGH] =
158     d->crtc_reg[VGA_CRTC_CURSOR_LOCATION_LOW] = 0;
159    
160     d->crtc_reg[VGA_CRTC_START_ADDR_HIGH] =
161     d->crtc_reg[VGA_CRTC_START_ADDR_LOW] = 0;
162    
163     /* Reset cursor scanline stuff: */
164     d->crtc_reg[VGA_CRTC_CURSOR_SCANLINE_START] = d->font_height - 4;
165     d->crtc_reg[VGA_CRTC_CURSOR_SCANLINE_END] = d->font_height - 2;
166    
167     d->sequencer_reg[VGA_SEQ_MAP_MASK] = 0x0f;
168     d->graphcontr_reg[VGA_GRAPHCONTR_MASK] = 0xff;
169    
170     d->misc_output_reg = VGA_MISC_OUTPUT_IOAS;
171     d->n_is1_reads = 0;
172     }
173    
174    
175     static void c_putstr(struct vga_data *d, char *s)
176     {
177     while (*s)
178     console_putchar(d->console_handle, *s++);
179     }
180    
181    
182     /*
183     * reset_palette():
184     */
185     static void reset_palette(struct vga_data *d, int grayscale)
186     {
187     int i, r, g, b;
188    
189     /* TODO: default values for entry 16..255? */
190     for (i=16; i<256; i++)
191     d->fb->rgb_palette[i*3 + 0] = d->fb->rgb_palette[i*3 + 1] =
192     d->fb->rgb_palette[i*3 + 2] = (i & 15) * 4;
193    
194     i = 0;
195    
196     if (grayscale) {
197     for (r=0; r<2; r++)
198     for (g=0; g<2; g++)
199     for (b=0; b<2; b++) {
200     d->fb->rgb_palette[i + 0] =
201     d->fb->rgb_palette[i + 1] =
202     d->fb->rgb_palette[i + 2] =
203     (r+g+b) * 0xaa / 3;
204     d->fb->rgb_palette[i + 8*3 + 0] =
205     d->fb->rgb_palette[i + 8*3 + 1] =
206     d->fb->rgb_palette[i + 8*3 + 2] =
207     (r+g+b) * 0xaa / 3 + 0x55;
208     i+=3;
209     }
210     return;
211     }
212    
213     for (r=0; r<2; r++)
214     for (g=0; g<2; g++)
215     for (b=0; b<2; b++) {
216     d->fb->rgb_palette[i + 0] = r * 0xaa;
217     d->fb->rgb_palette[i + 1] = g * 0xaa;
218     d->fb->rgb_palette[i + 2] = b * 0xaa;
219     i+=3;
220     }
221     for (r=0; r<2; r++)
222     for (g=0; g<2; g++)
223     for (b=0; b<2; b++) {
224     d->fb->rgb_palette[i + 0] = r * 0xaa + 0x55;
225     d->fb->rgb_palette[i + 1] = g * 0xaa + 0x55;
226     d->fb->rgb_palette[i + 2] = b * 0xaa + 0x55;
227     i+=3;
228     }
229     }
230    
231    
232     /*
233     * vga_update_textmode():
234     *
235     * Called from vga_update() when use_x11 is false. This causes modified
236     * character cells to be "simulated" by outputing ANSI escape sequences
237     * that draw the characters in a terminal window instead.
238     */
239     static void vga_update_textmode(struct machine *machine,
240     struct vga_data *d, int base, int start, int end)
241     {
242     char s[50];
243     int i, oldcolor = -1, printed_last = 0;
244    
245     for (i=start; i<=end; i+=2) {
246     unsigned char ch = d->charcells[base+i];
247     int fg = d->charcells[base+i+1] & 15;
248     int bg = (d->charcells[base+i+1] >> 4) & 15;
249     /* top bit of bg = blink */
250     int x = (i/2) % d->max_x;
251     int y = (i/2) / d->max_x;
252    
253     if (d->charcells[base+i] == d->charcells_outputed[i] &&
254     d->charcells[base+i+1] == d->charcells_outputed[i+1]) {
255     printed_last = 0;
256     continue;
257     }
258    
259     d->charcells_outputed[i] = d->charcells[base+i];
260     d->charcells_outputed[i+1] = d->charcells[base+i+1];
261    
262     if (!printed_last || x == 0) {
263     sprintf(s, "\033[%i;%iH", y + 1, x + 1);
264     c_putstr(d, s);
265     }
266     if (oldcolor < 0 || (bg<<4)+fg != oldcolor || !printed_last) {
267     sprintf(s, "\033[0;"); c_putstr(d, s);
268    
269     switch (fg & 7) {
270     case 0: c_putstr(d, "30"); break;
271     case 1: c_putstr(d, "34"); break;
272     case 2: c_putstr(d, "32"); break;
273     case 3: c_putstr(d, "36"); break;
274     case 4: c_putstr(d, "31"); break;
275     case 5: c_putstr(d, "35"); break;
276     case 6: c_putstr(d, "33"); break;
277     case 7: c_putstr(d, "37"); break;
278     }
279     if (fg & 8)
280     c_putstr(d, ";1");
281     c_putstr(d, ";");
282     switch (bg & 7) {
283     case 0: c_putstr(d, "40"); break;
284     case 1: c_putstr(d, "44"); break;
285     case 2: c_putstr(d, "42"); break;
286     case 3: c_putstr(d, "46"); break;
287     case 4: c_putstr(d, "41"); break;
288     case 5: c_putstr(d, "45"); break;
289     case 6: c_putstr(d, "43"); break;
290     case 7: c_putstr(d, "47"); break;
291     }
292     /* TODO: blink */
293     c_putstr(d, "m");
294     }
295    
296     if (ch >= 0x20 && ch != 127)
297     console_putchar(d->console_handle, ch);
298    
299     oldcolor = (bg << 4) + fg;
300     printed_last = 1;
301     }
302    
303     /* Restore the terminal's cursor position: */
304     sprintf(s, "\033[%i;%iH", d->cursor_y + 1, d->cursor_x + 1);
305     c_putstr(d, s);
306     }
307    
308    
309     /*
310     * vga_update_graphics():
311     *
312     * This function should be called whenever any part of d->gfx_mem[] has
313     * been written to. It will redraw all pixels within the range x1,y1
314     * .. x2,y2 using the right palette.
315     */
316     static void vga_update_graphics(struct machine *machine, struct vga_data *d,
317     int x1, int y1, int x2, int y2)
318     {
319     int x, y, ix, iy, c, rx = d->pixel_repx, ry = d->pixel_repy;
320     unsigned char pixel[3];
321    
322     for (y=y1; y<=y2; y++)
323     for (x=x1; x<=x2; x++) {
324     /* addr is where to read from VGA memory, addr2 is
325     where to write on the 24-bit framebuffer device */
326     int addr = (y * d->max_x + x) * d->bits_per_pixel;
327     switch (d->bits_per_pixel) {
328     case 8: addr >>= 3;
329     c = d->gfx_mem[addr];
330     pixel[0] = d->fb->rgb_palette[c*3+0];
331     pixel[1] = d->fb->rgb_palette[c*3+1];
332     pixel[2] = d->fb->rgb_palette[c*3+2];
333     break;
334     case 4: addr >>= 2;
335     if (addr & 1)
336     c = d->gfx_mem[addr >> 1] >> 4;
337     else
338     c = d->gfx_mem[addr >> 1] & 0xf;
339     pixel[0] = d->fb->rgb_palette[c*3+0];
340     pixel[1] = d->fb->rgb_palette[c*3+1];
341     pixel[2] = d->fb->rgb_palette[c*3+2];
342     break;
343     }
344     for (iy=y*ry; iy<(y+1)*ry; iy++)
345     for (ix=x*rx; ix<(x+1)*rx; ix++) {
346     int addr2 = (d->fb_max_x * iy + ix) * 3;
347     if (addr2 < d->fb_size)
348     dev_fb_access(machine->cpus[0],
349     machine->memory, addr2,
350     pixel, sizeof(pixel),
351     MEM_WRITE, d->fb);
352     }
353     }
354     }
355    
356    
357     /*
358     * vga_update_text():
359     *
360     * This function should be called whenever any part of d->charcells[] has
361 dpavlin 4 * been written to. It will redraw all characters within the range x1,y1
362     * .. x2,y2 using the right palette.
363     */
364 dpavlin 6 static void vga_update_text(struct machine *machine, struct vga_data *d,
365 dpavlin 4 int x1, int y1, int x2, int y2)
366     {
367 dpavlin 6 int fg, bg, i, x,y, subx, line, start, end, base;
368     int font_size = d->font_height;
369     int font_width = d->font_width;
370     unsigned char *pal = d->fb->rgb_palette;
371 dpavlin 4
372     /* Hm... I'm still using the old start..end code: */
373     start = (d->max_x * y1 + x1) * 2;
374     end = (d->max_x * y2 + x2) * 2;
375    
376     start &= ~1;
377     end |= 1;
378    
379 dpavlin 6 if (end >= d->charcells_size)
380     end = d->charcells_size - 1;
381 dpavlin 4
382 dpavlin 6 base = ((d->crtc_reg[VGA_CRTC_START_ADDR_HIGH] << 8)
383     + d->crtc_reg[VGA_CRTC_START_ADDR_LOW]) * 2;
384    
385     if (!machine->use_x11)
386     vga_update_textmode(machine, d, base, start, end);
387    
388 dpavlin 4 for (i=start; i<=end; i+=2) {
389 dpavlin 6 unsigned char ch = d->charcells[i + base];
390     fg = d->charcells[i+base + 1] & 15;
391     bg = (d->charcells[i+base + 1] >> 4) & 7;
392 dpavlin 4
393     /* Blink is hard to do :-), but inversion might be ok too: */
394 dpavlin 6 if (d->charcells[i+base + 1] & 128) {
395 dpavlin 4 int tmp = fg; fg = bg; bg = tmp;
396     }
397    
398 dpavlin 6 x = (i/2) % d->max_x; x *= font_width;
399     y = (i/2) / d->max_x; y *= font_size;
400 dpavlin 4
401 dpavlin 6 /* Draw the character: */
402     for (line = 0; line < font_size; line++) {
403     for (subx = 0; subx < font_width; subx++) {
404     int ix, iy, color_index;
405 dpavlin 4
406 dpavlin 6 if (d->use_palette_per_line) {
407     int sline = d->pixel_repy * (line+y);
408     if (sline < MAX_RETRACE_SCANLINES)
409     pal = d->retrace_palette
410     + sline * 256*3;
411     else
412     pal = d->fb->rgb_palette;
413 dpavlin 4 }
414    
415 dpavlin 6 if (d->font[ch * font_size + line] &
416     (128 >> subx))
417     color_index = fg;
418     else
419     color_index = bg;
420 dpavlin 4
421 dpavlin 6 for (iy=0; iy<d->pixel_repy; iy++)
422     for (ix=0; ix<d->pixel_repx; ix++) {
423     int addr = (d->fb_max_x* (d->pixel_repy
424     * (line+y) + iy) + (x+subx) *
425     d->pixel_repx + ix) * 3;
426 dpavlin 4
427 dpavlin 6 if (addr >= d->fb_size)
428     continue;
429 dpavlin 4 dev_fb_access(machine->cpus[0],
430 dpavlin 6 machine->memory, addr,
431     &pal[color_index * 3], 3,
432     MEM_WRITE, d->fb);
433     }
434 dpavlin 4 }
435     }
436     }
437     }
438    
439    
440     /*
441     * vga_update_cursor():
442     */
443 dpavlin 6 static void vga_update_cursor(struct machine *machine, struct vga_data *d)
444 dpavlin 4 {
445 dpavlin 6 int onoff = 1, height = d->crtc_reg[VGA_CRTC_CURSOR_SCANLINE_END]
446     - d->crtc_reg[VGA_CRTC_CURSOR_SCANLINE_START] + 1;
447    
448     if (d->cur_mode != MODE_CHARCELL)
449     onoff = 0;
450    
451     if (d->crtc_reg[VGA_CRTC_CURSOR_SCANLINE_START] >
452     d->crtc_reg[VGA_CRTC_CURSOR_SCANLINE_END]) {
453     onoff = 0;
454     height = 1;
455     }
456    
457     if (d->crtc_reg[VGA_CRTC_CURSOR_SCANLINE_START] >= d->font_height)
458     onoff = 0;
459    
460 dpavlin 4 dev_fb_setcursor(d->fb,
461 dpavlin 6 d->cursor_x * d->font_width * d->pixel_repx, (d->cursor_y *
462     d->font_height + d->crtc_reg[VGA_CRTC_CURSOR_SCANLINE_START]) *
463     d->pixel_repy, onoff, d->font_width * d->pixel_repx, height *
464     d->pixel_repy);
465 dpavlin 4 }
466    
467    
468     /*
469     * dev_vga_tick():
470     */
471     void dev_vga_tick(struct cpu *cpu, void *extra)
472     {
473     struct vga_data *d = extra;
474     uint64_t low = (uint64_t)-1, high;
475    
476 dpavlin 6 vga_update_cursor(cpu->machine, d);
477    
478     /* TODO: text vs graphics tick? */
479 dpavlin 4 memory_device_bintrans_access(cpu, cpu->mem, extra, &low, &high);
480    
481     if ((int64_t)low != -1) {
482     debug("[ dev_vga_tick: bintrans access, %llx .. %llx ]\n",
483     (long long)low, (long long)high);
484     d->update_x1 = 0;
485     d->update_x2 = d->max_x - 1;
486     d->update_y1 = (low/2) / d->max_x;
487     d->update_y2 = ((high/2) / d->max_x) + 1;
488     if (d->update_y2 >= d->max_y)
489     d->update_y2 = d->max_y - 1;
490     d->modified = 1;
491     }
492    
493 dpavlin 6 if (d->n_is1_reads > N_IS1_READ_THRESHOLD &&
494     d->retrace_palette != NULL) {
495     d->use_palette_per_line = 1;
496     d->update_x1 = 0;
497     d->update_x2 = d->max_x - 1;
498     d->update_y1 = 0;
499     d->update_y2 = d->max_y - 1;
500     d->modified = 1;
501     } else {
502     if (d->use_palette_per_line) {
503     d->use_palette_per_line = 0;
504     d->update_x1 = 0;
505     d->update_x2 = d->max_x - 1;
506     d->update_y1 = 0;
507     d->update_y2 = d->max_y - 1;
508     d->modified = 1;
509     }
510     }
511    
512     if (!cpu->machine->use_x11) {
513     /* NOTE: 2 > 0, so this only updates the cursor, no
514     character cells. */
515     vga_update_textmode(cpu->machine, d, 0, 2, 0);
516     }
517    
518 dpavlin 4 if (d->modified) {
519 dpavlin 6 if (d->cur_mode == MODE_CHARCELL)
520     vga_update_text(cpu->machine, d, d->update_x1,
521     d->update_y1, d->update_x2, d->update_y2);
522     else
523     vga_update_graphics(cpu->machine, d, d->update_x1,
524     d->update_y1, d->update_x2, d->update_y2);
525 dpavlin 4
526     d->modified = 0;
527     d->update_x1 = 999999;
528     d->update_x2 = -1;
529     d->update_y1 = 999999;
530     d->update_y2 = -1;
531     }
532 dpavlin 6
533     if (d->n_is1_reads > N_IS1_READ_THRESHOLD)
534     d->n_is1_reads = 0;
535 dpavlin 4 }
536    
537    
538     /*
539 dpavlin 6 * vga_graphics_access():
540     *
541     * Reads and writes to the VGA video memory (pixels).
542     */
543     int dev_vga_graphics_access(struct cpu *cpu, struct memory *mem,
544     uint64_t relative_addr, unsigned char *data, size_t len,
545     int writeflag, void *extra)
546     {
547     struct vga_data *d = extra;
548     int i,j, x=0, y=0, x2=0, y2=0, modified = 0;
549    
550     if (relative_addr + len >= GFX_ADDR_WINDOW)
551     return 0;
552    
553     if (d->cur_mode != MODE_GRAPHICS)
554     return 1;
555    
556     switch (d->graphics_mode) {
557     case GRAPHICS_MODE_8BIT:
558     y = relative_addr / d->max_x;
559     x = relative_addr % d->max_x;
560     y2 = (relative_addr+len-1) / d->max_x;
561     x2 = (relative_addr+len-1) % d->max_x;
562    
563     if (writeflag == MEM_WRITE) {
564     memcpy(d->gfx_mem + relative_addr, data, len);
565     modified = 1;
566     } else
567     memcpy(data, d->gfx_mem + relative_addr, len);
568     break;
569     case GRAPHICS_MODE_4BIT:
570     y = relative_addr * 8 / d->max_x;
571     x = relative_addr * 8 % d->max_x;
572     y2 = ((relative_addr+len)*8-1) / d->max_x;
573     x2 = ((relative_addr+len)*8-1) % d->max_x;
574     /* TODO: color stuff */
575    
576     /* Read/write d->gfx_mem in 4-bit color: */
577     if (writeflag == MEM_WRITE) {
578     /* i is byte index to write, j is bit index */
579     for (i=0; i<len; i++)
580     for (j=0; j<8; j++) {
581     int pixelmask = 1 << (7-j);
582     int b = data[i] & pixelmask;
583     int m = d->sequencer_reg[
584     VGA_SEQ_MAP_MASK] & 0x0f;
585     int addr = (y * d->max_x + x + i*8 + j)
586     * d->bits_per_pixel / 8;
587     unsigned char byte;
588     if (!(d->graphcontr_reg[
589     VGA_GRAPHCONTR_MASK] & pixelmask))
590     continue;
591     if (addr >= d->gfx_mem_size)
592     continue;
593     byte = d->gfx_mem[addr];
594     if (b && j&1)
595     byte |= m << 4;
596     if (b && !(j&1))
597     byte |= m;
598     if (!b && j&1)
599     byte &= ~(m << 4);
600     if (!b && !(j&1))
601     byte &= ~m;
602     d->gfx_mem[addr] = byte;
603     }
604     modified = 1;
605     } else {
606     fatal("TODO: 4 bit graphics read, mask=0x%02x\n",
607     d->sequencer_reg[VGA_SEQ_MAP_MASK]);
608     for (i=0; i<len; i++)
609     data[i] = random();
610     }
611     break;
612     default:fatal("dev_vga: Unimplemented graphics mode %i\n",
613     d->graphics_mode);
614     cpu->running = 0;
615     }
616    
617     if (modified) {
618     d->modified = 1;
619     if (x < d->update_x1) d->update_x1 = x;
620     if (x > d->update_x2) d->update_x2 = x;
621     if (y < d->update_y1) d->update_y1 = y;
622     if (y > d->update_y2) d->update_y2 = y;
623     if (x2 < d->update_x1) d->update_x1 = x2;
624     if (x2 > d->update_x2) d->update_x2 = x2;
625     if (y2 < d->update_y1) d->update_y1 = y2;
626     if (y2 > d->update_y2) d->update_y2 = y2;
627     if (y != y2) {
628     d->update_x1 = 0;
629     d->update_x2 = d->max_x - 1;
630     }
631     }
632     return 1;
633     }
634    
635    
636     /*
637 dpavlin 4 * dev_vga_access():
638     *
639 dpavlin 6 * Reads and writes to the VGA video memory (charcells).
640 dpavlin 4 */
641     int dev_vga_access(struct cpu *cpu, struct memory *mem, uint64_t relative_addr,
642     unsigned char *data, size_t len, int writeflag, void *extra)
643     {
644     struct vga_data *d = extra;
645     uint64_t idata = 0, odata = 0;
646 dpavlin 6 int i, x, y, x2, y2, r, base;
647 dpavlin 4
648     idata = memory_readmax64(cpu, data, len);
649    
650 dpavlin 6 base = ((d->crtc_reg[VGA_CRTC_START_ADDR_HIGH] << 8)
651     + d->crtc_reg[VGA_CRTC_START_ADDR_LOW]) * 2;
652     r = relative_addr - base;
653     y = r / (d->max_x * 2);
654     x = (r/2) % d->max_x;
655     y2 = (r+len-1) / (d->max_x * 2);
656     x2 = ((r+len-1)/2) % d->max_x;
657 dpavlin 4
658 dpavlin 6 if (relative_addr < d->charcells_size) {
659 dpavlin 4 if (writeflag == MEM_WRITE) {
660     for (i=0; i<len; i++) {
661 dpavlin 6 int old = d->charcells[relative_addr + i];
662 dpavlin 4 if (old != data[i]) {
663 dpavlin 6 d->charcells[relative_addr + i] =
664 dpavlin 4 data[i];
665     d->modified = 1;
666     }
667     }
668    
669     if (d->modified) {
670     if (x < d->update_x1) d->update_x1 = x;
671     if (x > d->update_x2) d->update_x2 = x;
672     if (y < d->update_y1) d->update_y1 = y;
673     if (y > d->update_y2) d->update_y2 = y;
674     if (x2 < d->update_x1) d->update_x1 = x2;
675     if (x2 > d->update_x2) d->update_x2 = x2;
676     if (y2 < d->update_y1) d->update_y1 = y2;
677     if (y2 > d->update_y2) d->update_y2 = y2;
678 dpavlin 6
679     if (y != y2) {
680     d->update_x1 = 0;
681     d->update_x2 = d->max_x - 1;
682     }
683 dpavlin 4 }
684     } else
685 dpavlin 6 memcpy(data, d->charcells + relative_addr, len);
686 dpavlin 4 return 1;
687     }
688    
689     switch (relative_addr) {
690     default:
691     if (writeflag==MEM_READ) {
692     debug("[ vga: read from 0x%08lx ]\n",
693     (long)relative_addr);
694     } else {
695     debug("[ vga: write to 0x%08lx: 0x%08x ]\n",
696     (long)relative_addr, idata);
697     }
698     }
699    
700     if (writeflag == MEM_READ)
701     memory_writemax64(cpu, data, len, odata);
702    
703     return 1;
704     }
705    
706    
707     /*
708 dpavlin 6 * vga_crtc_reg_write():
709 dpavlin 4 *
710 dpavlin 6 * Writes to VGA CRTC registers.
711 dpavlin 4 */
712 dpavlin 6 static void vga_crtc_reg_write(struct machine *machine, struct vga_data *d,
713     int regnr, int idata)
714 dpavlin 4 {
715 dpavlin 6 int ofs, grayscale;
716 dpavlin 4
717     switch (regnr) {
718 dpavlin 6 case VGA_CRTC_CURSOR_SCANLINE_START: /* 0x0a */
719     case VGA_CRTC_CURSOR_SCANLINE_END: /* 0x0b */
720     break;
721     case VGA_CRTC_START_ADDR_HIGH: /* 0x0c */
722     case VGA_CRTC_START_ADDR_LOW: /* 0x0d */
723     d->update_x1 = 0;
724     d->update_x2 = d->max_x - 1;
725     d->update_y1 = 0;
726     d->update_y2 = d->max_y - 1;
727     d->modified = 1;
728     break;
729     case VGA_CRTC_CURSOR_LOCATION_HIGH: /* 0x0e */
730     case VGA_CRTC_CURSOR_LOCATION_LOW: /* 0x0f */
731     ofs = d->crtc_reg[VGA_CRTC_CURSOR_LOCATION_HIGH] * 256 +
732     d->crtc_reg[VGA_CRTC_CURSOR_LOCATION_LOW];
733 dpavlin 4 d->cursor_x = ofs % d->max_x;
734     d->cursor_y = ofs / d->max_x;
735     break;
736 dpavlin 6 case 0xff:
737     grayscale = 0;
738     switch (d->crtc_reg[0xff]) {
739     case 0x00:
740     grayscale = 1;
741     case 0x01:
742     d->cur_mode = MODE_CHARCELL;
743     d->max_x = 40; d->max_y = 25;
744     d->pixel_repx = 2; d->pixel_repy = 1;
745     d->font_width = 8;
746     d->font_height = 16;
747     d->font = font8x16;
748     break;
749     case 0x02:
750     grayscale = 1;
751     case 0x03:
752     d->cur_mode = MODE_CHARCELL;
753     d->max_x = 80; d->max_y = 25;
754     d->pixel_repx = d->pixel_repy = 1;
755     d->font_width = 8;
756     d->font_height = 16;
757     d->font = font8x16;
758     break;
759     case 0x08:
760     d->cur_mode = MODE_GRAPHICS;
761     d->max_x = 160; d->max_y = 200;
762     d->graphics_mode = GRAPHICS_MODE_4BIT;
763     d->bits_per_pixel = 4;
764     d->pixel_repx = 4;
765     d->pixel_repy = 2;
766     break;
767     case 0x09:
768     case 0x0d:
769     d->cur_mode = MODE_GRAPHICS;
770     d->max_x = 320; d->max_y = 200;
771     d->graphics_mode = GRAPHICS_MODE_4BIT;
772     d->bits_per_pixel = 4;
773     d->pixel_repx = d->pixel_repy = 2;
774     break;
775     case 0x0e:
776     d->cur_mode = MODE_GRAPHICS;
777     d->max_x = 640; d->max_y = 200;
778     d->graphics_mode = GRAPHICS_MODE_4BIT;
779     d->bits_per_pixel = 4;
780     d->pixel_repx = 1;
781     d->pixel_repy = 2;
782     break;
783     case 0x10:
784     d->cur_mode = MODE_GRAPHICS;
785     d->max_x = 640; d->max_y = 350;
786     d->graphics_mode = GRAPHICS_MODE_4BIT;
787     d->bits_per_pixel = 4;
788     d->pixel_repx = d->pixel_repy = 1;
789     break;
790     case 0x12:
791     d->cur_mode = MODE_GRAPHICS;
792     d->max_x = 640; d->max_y = 480;
793     d->graphics_mode = GRAPHICS_MODE_4BIT;
794     d->bits_per_pixel = 4;
795     d->pixel_repx = d->pixel_repy = 1;
796     break;
797     case 0x13:
798     d->cur_mode = MODE_GRAPHICS;
799     d->max_x = 320; d->max_y = 200;
800     d->graphics_mode = GRAPHICS_MODE_8BIT;
801     d->bits_per_pixel = 8;
802     d->pixel_repx = d->pixel_repy = 2;
803     break;
804     default:
805     fatal("TODO! video mode change hack (mode 0x%02x)\n",
806     d->crtc_reg[0xff]);
807     exit(1);
808     }
809    
810     if (d->cur_mode == MODE_CHARCELL) {
811     dev_fb_resize(d->fb, d->max_x * d->font_width *
812     d->pixel_repx, d->max_y * d->font_height *
813     d->pixel_repy);
814     d->fb_size = d->max_x * d->pixel_repx * d->font_width *
815     d->max_y * d->pixel_repy * d->font_height * 3;
816     } else {
817     dev_fb_resize(d->fb, d->max_x * d->pixel_repx,
818     d->max_y * d->pixel_repy);
819     d->fb_size = d->max_x * d->pixel_repx *
820     d->max_y * d->pixel_repy * 3;
821     }
822    
823     if (d->gfx_mem != NULL)
824     free(d->gfx_mem);
825     d->gfx_mem_size = 1;
826     if (d->cur_mode == MODE_GRAPHICS)
827     d->gfx_mem_size = d->max_x * d->max_y /
828     (d->graphics_mode == GRAPHICS_MODE_8BIT? 1 : 2);
829     d->gfx_mem = malloc(d->gfx_mem_size);
830    
831     /* Clear screen and reset the palette: */
832     memset(d->charcells_outputed, 0, d->charcells_size);
833     memset(d->gfx_mem, 0, d->gfx_mem_size);
834     d->update_x1 = 0;
835     d->update_x2 = d->max_x - 1;
836     d->update_y1 = 0;
837     d->update_y2 = d->max_y - 1;
838     d->modified = 1;
839     reset_palette(d, grayscale);
840     register_reset(d);
841     break;
842     default:fatal("[ vga_crtc_reg_write: regnr=0x%02x idata=0x%02x ]\n",
843 dpavlin 4 regnr, idata);
844     }
845     }
846    
847    
848     /*
849 dpavlin 6 * vga_sequencer_reg_write():
850     *
851     * Writes to VGA Sequencer registers.
852     */
853     static void vga_sequencer_reg_write(struct machine *machine, struct vga_data *d,
854     int regnr, int idata)
855     {
856     switch (regnr) {
857     case VGA_SEQ_MAP_MASK: /* 0x02 */
858     break;
859     default:fatal("[ vga_sequencer_reg_write: select %i ]\n", regnr);
860     /* cpu->running = 0; */
861     }
862     }
863    
864    
865     /*
866     * vga_graphcontr_reg_write():
867     *
868     * Writes to VGA Graphics Controller registers.
869     */
870     static void vga_graphcontr_reg_write(struct machine *machine,
871     struct vga_data *d, int regnr, int idata)
872     {
873     switch (regnr) {
874     case VGA_GRAPHCONTR_MASK: /* 0x08 */
875     break;
876     default:fatal("[ vga_graphcontr_reg_write: select %i ]\n", regnr);
877     /* cpu->running = 0; */
878     }
879     }
880    
881    
882     /*
883     * vga_attribute_reg_write():
884     *
885     * Writes to VGA Attribute registers.
886     */
887     static void vga_attribute_reg_write(struct machine *machine, struct vga_data *d,
888     int regnr, int idata)
889     {
890     switch (regnr) {
891     default:fatal("[ vga_attribute_reg_write: select %i ]\n", regnr);
892     /* cpu->running = 0; */
893     }
894     }
895    
896    
897     /*
898 dpavlin 4 * dev_vga_ctrl_access():
899     *
900     * Reads and writes of the VGA control registers.
901     */
902     int dev_vga_ctrl_access(struct cpu *cpu, struct memory *mem,
903     uint64_t relative_addr, unsigned char *data, size_t len,
904     int writeflag, void *extra)
905     {
906     struct vga_data *d = extra;
907 dpavlin 6 int i;
908 dpavlin 4 uint64_t idata = 0, odata = 0;
909    
910 dpavlin 6 for (i=0; i<len; i++) {
911     idata = data[i];
912 dpavlin 4
913 dpavlin 6 /* 0x3C0 + relative_addr... */
914    
915     switch (relative_addr) {
916    
917     case VGA_ATTRIBUTE_ADDR: /* 0x00 */
918     switch (d->attribute_state) {
919     case 0: if (writeflag == MEM_READ)
920     odata = d->attribute_reg_select;
921     else {
922     d->attribute_reg_select = 1;
923     d->attribute_state = 1;
924     }
925 dpavlin 4 break;
926 dpavlin 6 case 1: d->attribute_state = 0;
927     d->attribute_reg[d->attribute_reg_select] =
928     idata;
929     vga_attribute_reg_write(cpu->machine, d,
930     d->attribute_reg_select, idata);
931 dpavlin 4 break;
932     }
933 dpavlin 6 break;
934     case VGA_ATTRIBUTE_DATA_READ: /* 0x01 */
935     if (writeflag == MEM_WRITE)
936     fatal("[ dev_vga: WARNING: Write to "
937     "VGA_ATTRIBUTE_DATA_READ? ]\n");
938     else {
939     if (d->attribute_state == 0)
940     fatal("[ dev_vga: WARNING: Read from "
941     "VGA_ATTRIBUTE_DATA_READ, but no"
942     " register selected? ]\n");
943     else
944     odata = d->attribute_reg[
945     d->attribute_reg_select];
946     }
947     break;
948    
949     case VGA_MISC_OUTPUT_W: /* 0x02 */
950     if (writeflag == MEM_WRITE)
951     d->misc_output_reg = idata;
952     else {
953     /* Reads: Input Status 0 */
954     odata = 0x00;
955     }
956     break;
957    
958     case VGA_SEQUENCER_ADDR: /* 0x04 */
959     if (writeflag == MEM_READ)
960     odata = d->sequencer_reg_select;
961     else
962     d->sequencer_reg_select = idata;
963     break;
964     case VGA_SEQUENCER_DATA: /* 0x05 */
965     if (writeflag == MEM_READ)
966     odata = d->sequencer_reg[
967     d->sequencer_reg_select];
968     else {
969     d->sequencer_reg[d->
970     sequencer_reg_select] = idata;
971     vga_sequencer_reg_write(cpu->machine, d,
972     d->sequencer_reg_select, idata);
973     }
974     break;
975    
976     case VGA_DAC_ADDR_READ: /* 0x07 */
977     if (writeflag == MEM_WRITE) {
978     d->palette_read_index = idata;
979     d->palette_read_subindex = 0;
980     } else {
981     fatal("[ dev_vga: WARNING: Read from "
982     "VGA_DAC_ADDR_READ? TODO ]\n");
983     /* TODO */
984     }
985     break;
986     case VGA_DAC_ADDR_WRITE: /* 0x08 */
987     if (writeflag == MEM_WRITE) {
988     d->palette_write_index = idata;
989     d->palette_write_subindex = 0;
990    
991     /* TODO: Is this correct? */
992     d->palette_read_index = idata;
993     d->palette_read_subindex = 0;
994     } else {
995     fatal("[ dev_vga: WARNING: Read from "
996     "VGA_DAC_ADDR_WRITE? ]\n");
997     odata = d->palette_write_index;
998     }
999     break;
1000     case VGA_DAC_DATA: /* 0x09 */
1001     if (writeflag == MEM_WRITE) {
1002     int new = (idata & 63) << 2;
1003     int old = d->fb->rgb_palette[d->
1004     palette_write_index*3+d->
1005     palette_write_subindex];
1006     d->fb->rgb_palette[d->palette_write_index * 3 +
1007     d->palette_write_subindex] = new;
1008     /* Redraw whole screen, if the
1009     palette changed: */
1010     if (new != old) {
1011     d->modified = 1;
1012     d->update_x1 = d->update_y1 = 0;
1013     d->update_x2 = d->max_x - 1;
1014     d->update_y2 = d->max_y - 1;
1015     }
1016     d->palette_write_subindex ++;
1017     if (d->palette_write_subindex == 3) {
1018     d->palette_write_index ++;
1019     d->palette_write_subindex = 0;
1020     }
1021     } else {
1022     odata = (d->fb->rgb_palette[d->
1023     palette_read_index * 3 +
1024     d->palette_read_subindex] >> 2) & 63;
1025     d->palette_read_subindex ++;
1026     if (d->palette_read_subindex == 3) {
1027     d->palette_read_index ++;
1028     d->palette_read_subindex = 0;
1029     }
1030     }
1031     break;
1032    
1033     case VGA_MISC_OUTPUT_R:
1034     odata = d->misc_output_reg;
1035     break;
1036    
1037     case VGA_GRAPHCONTR_ADDR: /* 0x0e */
1038     if (writeflag == MEM_READ)
1039     odata = d->graphcontr_reg_select;
1040     else
1041     d->graphcontr_reg_select = idata;
1042     break;
1043     case VGA_GRAPHCONTR_DATA: /* 0x0f */
1044     if (writeflag == MEM_READ)
1045     odata = d->graphcontr_reg[
1046     d->graphcontr_reg_select];
1047     else {
1048     d->graphcontr_reg[d->
1049     graphcontr_reg_select] = idata;
1050     vga_graphcontr_reg_write(cpu->machine, d,
1051     d->graphcontr_reg_select, idata);
1052     }
1053     break;
1054    
1055     case VGA_CRTC_ADDR: /* 0x14 */
1056     if (writeflag == MEM_READ)
1057     odata = d->crtc_reg_select;
1058     else
1059     d->crtc_reg_select = idata;
1060     break;
1061     case VGA_CRTC_DATA: /* 0x15 */
1062     if (writeflag == MEM_READ)
1063     odata = d->crtc_reg[d->crtc_reg_select];
1064     else {
1065     d->crtc_reg[d->crtc_reg_select] = idata;
1066     vga_crtc_reg_write(cpu->machine, d,
1067     d->crtc_reg_select, idata);
1068     }
1069     break;
1070    
1071     case VGA_INPUT_STATUS_1: /* 0x1A */
1072     odata = 0;
1073     d->n_is1_reads ++;
1074     d->current_retrace_line ++;
1075     d->current_retrace_line %= (MAX_RETRACE_SCANLINES * 8);
1076     /* Whenever we are "inside" a scan line, copy the
1077     current palette into retrace_palette[][]: */
1078     if ((d->current_retrace_line & 7) == 7) {
1079     if (d->retrace_palette == NULL &&
1080     d->n_is1_reads > N_IS1_READ_THRESHOLD) {
1081     d->retrace_palette = malloc(
1082     MAX_RETRACE_SCANLINES * 256*3);
1083     if (d->retrace_palette == NULL) {
1084     fatal("out of memory\n");
1085     exit(1);
1086     }
1087     }
1088     if (d->retrace_palette != NULL)
1089     memcpy(d->retrace_palette + (d->
1090     current_retrace_line >> 3) * 256*3,
1091     d->fb->rgb_palette, d->cur_mode ==
1092     MODE_CHARCELL? (16*3) : (256*3));
1093     }
1094     /* These need to go on and off, to fake the
1095     real vertical and horizontal retrace info. */
1096     if (d->current_retrace_line < 20*8)
1097     odata |= VGA_IS1_DISPLAY_VRETRACE;
1098     else {
1099     if ((d->current_retrace_line & 7) == 0)
1100     odata = VGA_IS1_DISPLAY_DISPLAY_DISABLE;
1101     }
1102     break;
1103    
1104     default:
1105     if (writeflag==MEM_READ) {
1106     fatal("[ vga_ctrl: read from 0x%08lx ]\n",
1107     (long)relative_addr);
1108     } else {
1109     fatal("[ vga_ctrl: write to 0x%08lx: 0x%08x"
1110     " ]\n", (long)relative_addr, (int)idata);
1111     }
1112 dpavlin 4 }
1113 dpavlin 6
1114     if (writeflag == MEM_READ)
1115     data[i] = odata;
1116    
1117     /* For multi-byte accesses: */
1118     relative_addr ++;
1119 dpavlin 4 }
1120    
1121     return 1;
1122     }
1123    
1124    
1125     /*
1126     * dev_vga_init():
1127     *
1128     * Register a VGA text console device. max_x and max_y could be something
1129     * like 80 and 25, respectively.
1130     */
1131     void dev_vga_init(struct machine *machine, struct memory *mem,
1132 dpavlin 6 uint64_t videomem_base, uint64_t control_base, char *name)
1133 dpavlin 4 {
1134     struct vga_data *d;
1135 dpavlin 6 int i, x,y, tmpi;
1136 dpavlin 4 size_t allocsize;
1137    
1138     d = malloc(sizeof(struct vga_data));
1139     if (d == NULL) {
1140     fprintf(stderr, "out of memory\n");
1141     exit(1);
1142     }
1143     memset(d, 0, sizeof(struct vga_data));
1144    
1145 dpavlin 6 d->console_handle = console_start_slave(machine, name);
1146 dpavlin 4
1147 dpavlin 6 d->videomem_base = videomem_base;
1148     d->control_base = control_base;
1149     d->max_x = 80;
1150     d->max_y = 25;
1151     d->pixel_repx = 1;
1152     d->pixel_repy = 1;
1153     d->cur_mode = MODE_CHARCELL;
1154     d->crtc_reg[0xff] = 0x03;
1155     d->charcells_size = d->max_x * VGA_MEM_MAXY * 2;
1156     d->gfx_mem_size = 1; /* Nothing, as we start in text mode */
1157    
1158 dpavlin 4 /* Allocate in 4KB pages, to make it possible to use bintrans: */
1159 dpavlin 6 allocsize = ((d->charcells_size - 1) | 0xfff) + 1;
1160     d->charcells = malloc(d->charcells_size);
1161     d->charcells_outputed = malloc(d->charcells_size);
1162     d->gfx_mem = malloc(d->gfx_mem_size);
1163     if (d->charcells == NULL || d->charcells_outputed == NULL ||
1164     d->gfx_mem == NULL) {
1165 dpavlin 4 fprintf(stderr, "out of memory in dev_vga_init()\n");
1166     exit(1);
1167     }
1168    
1169     for (y=0; y<VGA_MEM_MAXY; y++) {
1170 dpavlin 6 for (x=0; x<d->max_x; x++) {
1171 dpavlin 4 char ch = ' ';
1172 dpavlin 6 i = (x + d->max_x * y) * 2;
1173     d->charcells[i] = ch;
1174     d->charcells[i+1] = 0x07; /* Default color */
1175 dpavlin 4 }
1176     }
1177    
1178 dpavlin 6 memset(d->charcells_outputed, 0, d->charcells_size);
1179     memset(d->gfx_mem, 0, d->gfx_mem_size);
1180    
1181 dpavlin 4 d->font = font8x16;
1182 dpavlin 6 d->font_width = 8;
1183     d->font_height = 16;
1184 dpavlin 4
1185 dpavlin 6 d->fb_max_x = d->pixel_repx * d->max_x;
1186     d->fb_max_y = d->pixel_repy * d->max_y;
1187     if (d->cur_mode == MODE_CHARCELL) {
1188     d->fb_max_x *= d->font_width;
1189     d->fb_max_y *= d->font_height;
1190     }
1191    
1192 dpavlin 4 d->fb = dev_fb_init(machine, mem, VGA_FB_ADDR, VFB_GENERIC,
1193 dpavlin 6 d->fb_max_x, d->fb_max_y, d->fb_max_x, d->fb_max_y, 24, "VGA", 0);
1194     d->fb_size = d->fb_max_x * d->fb_max_y * 3;
1195 dpavlin 4
1196 dpavlin 6 reset_palette(d, 0);
1197 dpavlin 4
1198 dpavlin 6 /* MEM_BINTRANS_WRITE_OK <-- This works with OpenBSD/arc, but not
1199     with Windows NT yet. Why? */
1200     memory_device_register(mem, "vga_charcells", videomem_base + 0x18000,
1201     allocsize, dev_vga_access, d, MEM_BINTRANS_OK |
1202     MEM_READING_HAS_NO_SIDE_EFFECTS, d->charcells);
1203     memory_device_register(mem, "vga_gfx", videomem_base, GFX_ADDR_WINDOW,
1204     dev_vga_graphics_access, d, MEM_DEFAULT |
1205     MEM_READING_HAS_NO_SIDE_EFFECTS, d->gfx_mem);
1206 dpavlin 4 memory_device_register(mem, "vga_ctrl", control_base,
1207     32, dev_vga_ctrl_access, d, MEM_DEFAULT, NULL);
1208    
1209 dpavlin 6 /* This will force an initial redraw/resynch: */
1210     d->update_x1 = 0;
1211     d->update_x2 = d->max_x - 1;
1212     d->update_y1 = 0;
1213     d->update_y2 = d->max_y - 1;
1214     d->modified = 1;
1215 dpavlin 4
1216     machine_add_tickfunction(machine, dev_vga_tick, d, VGA_TICK_SHIFT);
1217    
1218 dpavlin 6 vga_update_cursor(machine, d);
1219    
1220     tmpi = d->cursor_y * d->max_x + d->cursor_x;
1221    
1222     register_reset(d);
1223 dpavlin 4 }
1224    

  ViewVC Help
Powered by ViewVC 1.1.26