diff options
Diffstat (limited to 'qemu/roms/openbios/drivers/vga.fs')
| -rw-r--r-- | qemu/roms/openbios/drivers/vga.fs | 204 |
1 files changed, 204 insertions, 0 deletions
diff --git a/qemu/roms/openbios/drivers/vga.fs b/qemu/roms/openbios/drivers/vga.fs new file mode 100644 index 000000000..ec4c6c5f1 --- /dev/null +++ b/qemu/roms/openbios/drivers/vga.fs @@ -0,0 +1,204 @@ +\ +\ 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 ; + +\ +\ IO port words +\ + +" ioc!" (find-xt) value ioc!-xt +" iow!" (find-xt) value iow!-xt + +: ioc! ioc!-xt execute ; +: iow! iow!-xt execute ; + +\ +\ VGA registers +\ + +h# 3c0 constant vga-addr +h# 3c8 constant dac-write-addr +h# 3c9 constant dac-data-addr + +: vga-color! ( r g b index -- ) + \ Set the VGA colour registers + dac-write-addr ioc! rot + 2 >> dac-data-addr ioc! swap + 2 >> dac-data-addr ioc! + 2 >> dac-data-addr 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 +\ + +: vbe-iow! ( val addr -- ) + h# 1ce iow! + h# 1d0 iow! +; + +\ +\ Initialise Bochs VBE mode +\ + +: vbe-init ( -- ) + h# 0 vga-addr 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 ioc! + h# 20 vga-addr ioc! \ Disable blanking +; + +\ +\ PCI +\ + +" pci-bar>pci-region" (find-xt) value pci-bar>pci-region-xt +: pci-bar>pci-region pci-bar>pci-region-xt execute ; + +h# 10 constant cfg-bar0 \ Framebuffer BAR +-1 value fb-addr + +: map-fb ( -- ) + cfg-bar0 pci-bar>pci-region \ ( pci-addr.lo pci-addr.hi size ) + " pci-map-in" $call-parent + to fb-addr +; + +\ +\ 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 +; + +headerless + +\ +\ Installation +\ + +: qemu-vga-driver-install ( -- ) + 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 + + vbe-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 + + ['] qemu-vga-driver-install is-install +; + +qemu-vga-driver-init + +end0 |