283 lines
5.8 KiB
Forth
283 lines
5.8 KiB
Forth
\
|
|
\ Fcode payload for QEMU VGA graphics card
|
|
\
|
|
\ This is the Forth source for an Fcode payload to initialise
|
|
\ the QEMU VGA graphics card.
|
|
\
|
|
\ (C) Copyright 2013 Mark Cave-Ayland
|
|
\
|
|
|
|
fcode-version3
|
|
|
|
\
|
|
\ Dictionary lookups for words that don't have an FCode
|
|
\
|
|
|
|
: (find-xt) \ ( str len -- xt | -1 )
|
|
$find if
|
|
exit
|
|
else
|
|
-1
|
|
then
|
|
;
|
|
|
|
" openbios-video-width" (find-xt) cell+ value openbios-video-width-xt
|
|
" openbios-video-height" (find-xt) cell+ value openbios-video-height-xt
|
|
" depth-bits" (find-xt) cell+ value depth-bits-xt
|
|
" line-bytes" (find-xt) cell+ value line-bytes-xt
|
|
|
|
: openbios-video-width openbios-video-width-xt @ ;
|
|
: openbios-video-height openbios-video-height-xt @ ;
|
|
: depth-bits depth-bits-xt @ ;
|
|
: line-bytes line-bytes-xt @ ;
|
|
|
|
" fb8-fillrect" (find-xt) value fb8-fillrect-xt
|
|
: fb8-fillrect fb8-fillrect-xt execute ;
|
|
|
|
" fw-cfg-read-file" (find-xt) value fw-cfg-read-file-xt
|
|
: fw-cfg-read-file fw-cfg-read-file-xt execute ;
|
|
|
|
\
|
|
\ IO port words
|
|
\
|
|
|
|
" ioc!" (find-xt) value ioc!-xt
|
|
" iow!" (find-xt) value iow!-xt
|
|
|
|
: ioc! ioc!-xt execute ;
|
|
: iow! iow!-xt execute ;
|
|
|
|
" le-w!" (find-xt) value le-w!-xt
|
|
|
|
: le-w! le-w!-xt execute ;
|
|
|
|
\
|
|
\ PCI
|
|
\
|
|
|
|
" pci-bar>pci-addr" (find-xt) value pci-bar>pci-addr-xt
|
|
: pci-bar>pci-addr pci-bar>pci-addr-xt execute ;
|
|
|
|
h# 10 constant cfg-bar0 \ Framebuffer BAR
|
|
h# 18 constant cfg-bar2 \ QEMU MMIO ioport BAR
|
|
-1 value fb-addr
|
|
-1 value mmio-addr
|
|
|
|
\
|
|
\ VGA registers
|
|
\
|
|
|
|
h# 3c0 constant vga-addr
|
|
h# 3c8 constant dac-write-addr
|
|
h# 3c9 constant dac-data-addr
|
|
|
|
defer vga-ioc!
|
|
|
|
: vga-legacy-ioc! ( val addr )
|
|
ioc!
|
|
;
|
|
|
|
: vga-mmio-ioc! ( val addr )
|
|
h# 3c0 - h# 400 + mmio-addr + c!
|
|
;
|
|
|
|
: vga-color! ( r g b index -- )
|
|
\ Set the VGA colour registers
|
|
dac-write-addr vga-ioc! rot
|
|
2 >> dac-data-addr vga-ioc! swap
|
|
2 >> dac-data-addr vga-ioc!
|
|
2 >> dac-data-addr vga-ioc!
|
|
;
|
|
|
|
\
|
|
\ VBE registers
|
|
\
|
|
|
|
h# 0 constant VBE_DISPI_INDEX_ID
|
|
h# 1 constant VBE_DISPI_INDEX_XRES
|
|
h# 2 constant VBE_DISPI_INDEX_YRES
|
|
h# 3 constant VBE_DISPI_INDEX_BPP
|
|
h# 4 constant VBE_DISPI_INDEX_ENABLE
|
|
h# 5 constant VBE_DISPI_INDEX_BANK
|
|
h# 6 constant VBE_DISPI_INDEX_VIRT_WIDTH
|
|
h# 7 constant VBE_DISPI_INDEX_VIRT_HEIGHT
|
|
h# 8 constant VBE_DISPI_INDEX_X_OFFSET
|
|
h# 9 constant VBE_DISPI_INDEX_Y_OFFSET
|
|
h# a constant VBE_DISPI_INDEX_NB
|
|
|
|
h# 0 constant VBE_DISPI_DISABLED
|
|
h# 1 constant VBE_DISPI_ENABLED
|
|
|
|
\
|
|
\ Bochs VBE register writes
|
|
\
|
|
|
|
defer vbe-iow!
|
|
|
|
: vbe-legacy-iow! ( val addr -- )
|
|
h# 1ce iow!
|
|
h# 1d0 iow!
|
|
;
|
|
|
|
: vbe-mmio-iow! ( val addr -- )
|
|
1 lshift h# 500 + mmio-addr + cr .s cr le-w!
|
|
;
|
|
|
|
\
|
|
\ Initialise Bochs VBE mode
|
|
\
|
|
|
|
: vbe-init ( -- )
|
|
h# 0 vga-addr vga-ioc! \ Enable blanking
|
|
VBE_DISPI_DISABLED VBE_DISPI_INDEX_ENABLE vbe-iow!
|
|
h# 0 VBE_DISPI_INDEX_X_OFFSET vbe-iow!
|
|
h# 0 VBE_DISPI_INDEX_Y_OFFSET vbe-iow!
|
|
openbios-video-width VBE_DISPI_INDEX_XRES vbe-iow!
|
|
openbios-video-height VBE_DISPI_INDEX_YRES vbe-iow!
|
|
depth-bits VBE_DISPI_INDEX_BPP vbe-iow!
|
|
VBE_DISPI_ENABLED VBE_DISPI_INDEX_ENABLE vbe-iow!
|
|
h# 0 vga-addr vga-ioc!
|
|
h# 20 vga-addr vga-ioc! \ Disable blanking
|
|
;
|
|
|
|
\
|
|
\ PCI BAR mapping
|
|
\
|
|
|
|
: map-fb ( -- )
|
|
cfg-bar0 pci-bar>pci-addr if \ ( pci-addr.lo pci-addr.mid pci-addr.hi size )
|
|
" pci-map-in" $call-parent
|
|
to fb-addr
|
|
then
|
|
;
|
|
|
|
: map-mmio ( -- )
|
|
cfg-bar2 pci-bar>pci-addr if \ ( pci-addr.lo pci-addr.mid pci-addr.hi size )
|
|
" pci-map-in" $call-parent
|
|
to mmio-addr
|
|
then
|
|
;
|
|
|
|
\
|
|
\ Legacy IO port or QEMU MMIO accesses
|
|
\
|
|
\ legacy: use standard VGA ioport registers
|
|
\ MMIO: use QEMU PCI MMIO VGA registers
|
|
\
|
|
\ If building for QEMU, default to MMIO access since it allows
|
|
\ programming of the VGA card regardless of its position in the
|
|
\ PCI topology
|
|
\
|
|
|
|
[IFDEF] CONFIG_QEMU
|
|
['] vga-mmio-ioc! to vga-ioc!
|
|
['] vbe-mmio-iow! to vbe-iow!
|
|
[ELSE]
|
|
['] vga-legacy-ioc! to vga-ioc!
|
|
['] vbe-legacy-iow! to vbe-iow!
|
|
[THEN]
|
|
|
|
\
|
|
\ Publically visible words
|
|
\
|
|
|
|
external
|
|
|
|
[IFDEF] CONFIG_MOL
|
|
defer mol-color!
|
|
|
|
\ Hook for MOL (see packages/molvideo.c)
|
|
\
|
|
\ Perhaps for neatness this there should be a separate molvga.fs
|
|
\ but let's leave it here for now.
|
|
|
|
: color! ( r g b index -- )
|
|
mol-color!
|
|
;
|
|
|
|
[ELSE]
|
|
|
|
\ Standard VGA
|
|
|
|
: color! ( r g b index -- )
|
|
vga-color!
|
|
;
|
|
|
|
[THEN]
|
|
|
|
: fill-rectangle ( color_ind x y width height -- )
|
|
fb8-fillrect
|
|
;
|
|
|
|
: dimensions ( -- width height )
|
|
openbios-video-width
|
|
openbios-video-height
|
|
;
|
|
|
|
: set-colors ( table start count -- )
|
|
0 do
|
|
over dup \ ( table start table table )
|
|
c@ swap 1+ \ ( table start r table-g )
|
|
dup c@ swap 1+ \ ( table start r g table-b )
|
|
c@ 3 pick \ ( table start r g b index )
|
|
color! \ ( table start )
|
|
1+
|
|
swap 3 + swap \ ( table+3 start+1 )
|
|
loop
|
|
;
|
|
|
|
\
|
|
\ Cancel Bochs VBE mode
|
|
\
|
|
|
|
: vbe-deinit ( -- )
|
|
\ Switching VBE on and off clears the framebuffer
|
|
VBE_DISPI_DISABLED VBE_DISPI_INDEX_ENABLE vbe-iow!
|
|
VBE_DISPI_ENABLED VBE_DISPI_INDEX_ENABLE vbe-iow!
|
|
VBE_DISPI_DISABLED VBE_DISPI_INDEX_ENABLE vbe-iow!
|
|
;
|
|
|
|
headerless
|
|
|
|
\
|
|
\ Installation
|
|
\
|
|
|
|
: qemu-vga-driver-install ( -- )
|
|
mmio-addr -1 = if
|
|
map-mmio vbe-init
|
|
then
|
|
fb-addr -1 = if
|
|
map-fb fb-addr to frame-buffer-adr
|
|
default-font set-font
|
|
|
|
frame-buffer-adr encode-int " address" property
|
|
|
|
openbios-video-width openbios-video-height over char-width / over char-height /
|
|
fb8-install
|
|
then
|
|
;
|
|
|
|
: qemu-vga-driver-init
|
|
openbios-video-width encode-int " width" property
|
|
openbios-video-height encode-int " height" property
|
|
depth-bits encode-int " depth" property
|
|
line-bytes encode-int " linebytes" property
|
|
|
|
\ Is the VGA NDRV driver enabled? (PPC only)
|
|
" /options" find-package drop s" vga-ndrv?" rot get-package-property not if
|
|
decode-string 2swap 2drop \ ( addr len )
|
|
s" true" drop -rot comp 0= if
|
|
\ Embed NDRV driver via fw-cfg if it exists
|
|
" ndrv/qemu_vga.ndrv" fw-cfg-read-file if
|
|
encode-string " driver,AAPL,MacOS,PowerPC" property
|
|
then
|
|
then
|
|
then
|
|
|
|
['] qemu-vga-driver-install is-install
|
|
;
|
|
|
|
qemu-vga-driver-init
|
|
|
|
end0
|