qemu/roms/openbios/drivers/vga.fs

   1 \
   2 \ Fcode payload for QEMU VGA graphics card
   3 \
   4 \ This is the Forth source for an Fcode payload to initialise
   5 \ the QEMU VGA graphics card.
   6 \
   7 \ (C) Copyright 2013 Mark Cave-Ayland
   8 \
   9
  10 fcode-version3
  11
  12 \
  13 \ Dictionary lookups for words that don't have an FCode
  14 \
  15
  16 : (find-xt)   \ ( str len -- xt | -1 )
  17   $find if
  18     exit
  19   else
  20     -1
  21   then
  22 ;
  23
  24 " openbios-video-width" (find-xt) cell+ value openbios-video-width-xt
  25 " openbios-video-height" (find-xt) cell+ value openbios-video-height-xt
  26 " depth-bits" (find-xt) cell+ value depth-bits-xt
  27 " line-bytes" (find-xt) cell+ value line-bytes-xt
  28
  29 : openbios-video-width openbios-video-width-xt @ ;
  30 : openbios-video-height openbios-video-height-xt @ ;
  31 : depth-bits depth-bits-xt @ ;
  32 : line-bytes line-bytes-xt @ ;
  33
  34 " fb8-fillrect" (find-xt) value fb8-fillrect-xt
  35 : fb8-fillrect fb8-fillrect-xt execute ;
  36
  37 \
  38 \ IO port words
  39 \
  40
  41 " ioc!" (find-xt) value ioc!-xt
  42 " iow!" (find-xt) value iow!-xt
  43
  44 : ioc! ioc!-xt execute ;
  45 : iow! iow!-xt execute ;
  46
  47 \
  48 \ VGA registers
  49 \
  50
  51 h# 3c0 constant vga-addr
  52 h# 3c8 constant dac-write-addr
  53 h# 3c9 constant dac-data-addr
  54
  55 : vga-color!  ( r g b index -- )
  56   \ Set the VGA colour registers
  57   dac-write-addr ioc! rot
  58   2 >> dac-data-addr ioc! swap
  59   2 >> dac-data-addr ioc!
  60   2 >> dac-data-addr ioc!
  61 ;
  62
  63 \
  64 \ VBE registers
  65 \
  66
  67 h# 0 constant VBE_DISPI_INDEX_ID
  68 h# 1 constant VBE_DISPI_INDEX_XRES
  69 h# 2 constant VBE_DISPI_INDEX_YRES
  70 h# 3 constant VBE_DISPI_INDEX_BPP
  71 h# 4 constant VBE_DISPI_INDEX_ENABLE
  72 h# 5 constant VBE_DISPI_INDEX_BANK
  73 h# 6 constant VBE_DISPI_INDEX_VIRT_WIDTH
  74 h# 7 constant VBE_DISPI_INDEX_VIRT_HEIGHT
  75 h# 8 constant VBE_DISPI_INDEX_X_OFFSET
  76 h# 9 constant VBE_DISPI_INDEX_Y_OFFSET
  77 h# a constant VBE_DISPI_INDEX_NB
  78
  79 h# 0 constant VBE_DISPI_DISABLED
  80 h# 1 constant VBE_DISPI_ENABLED
  81
  82 \
  83 \ Bochs VBE register writes
  84 \
  85
  86 : vbe-iow!  ( val addr -- )
  87   h# 1ce iow!
  88   h# 1d0 iow!
  89 ;
  90
  91 \
  92 \ Initialise Bochs VBE mode
  93 \
  94
  95 : vbe-init  ( -- )
  96   h# 0 vga-addr ioc!    \ Enable blanking
  97   VBE_DISPI_DISABLED VBE_DISPI_INDEX_ENABLE vbe-iow!
  98   h# 0 VBE_DISPI_INDEX_X_OFFSET vbe-iow!
  99   h# 0 VBE_DISPI_INDEX_Y_OFFSET vbe-iow!
 100   openbios-video-width VBE_DISPI_INDEX_XRES vbe-iow!
 101   openbios-video-height VBE_DISPI_INDEX_YRES vbe-iow!
 102   depth-bits VBE_DISPI_INDEX_BPP vbe-iow!
 103   VBE_DISPI_ENABLED VBE_DISPI_INDEX_ENABLE vbe-iow!
 104   h# 0 vga-addr ioc!
 105   h# 20 vga-addr ioc!   \ Disable blanking
 106 ;
 107
 108 \
 109 \ PCI
 110 \
 111
 112 " pci-bar>pci-region" (find-xt) value pci-bar>pci-region-xt
 113 : pci-bar>pci-region pci-bar>pci-region-xt execute ;
 114
 115 h# 10 constant cfg-bar0    \ Framebuffer BAR
 116 -1 value fb-addr
 117
 118 : map-fb ( -- )
 119   cfg-bar0 pci-bar>pci-region   \ ( pci-addr.lo pci-addr.hi size )
 120   " pci-map-in" $call-parent
 121   to fb-addr
 122 ;
 123
 124 \
 125 \ Publically visible words
 126 \
 127
 128 external
 129
 130 [IFDEF] CONFIG_MOL
 131 defer mol-color!
 132
 133 \ Hook for MOL (see packages/molvideo.c)
 134 \
 135 \ Perhaps for neatness this there should be a separate molvga.fs
 136 \ but let's leave it here for now.
 137
 138 : color!  ( r g b index -- )
 139   mol-color!
 140 ;
 141
 142 [ELSE]
 143
 144 \ Standard VGA
 145
 146 : color!  ( r g b index -- )
 147   vga-color!
 148 ;
 149
 150 [THEN]
 151
 152 : fill-rectangle  ( color_ind x y width height -- )
 153   fb8-fillrect
 154 ;
 155
 156 : dimensions  ( -- width height )
 157   openbios-video-width
 158   openbios-video-height
 159 ;
 160
 161 : set-colors  ( table start count -- )
 162   0 do
 163     over dup        \ ( table start table table )
 164     c@ swap 1+      \ ( table start r table-g )
 165     dup c@ swap 1+  \ ( table start r g table-b )
 166     c@ 3 pick       \ ( table start r g b index )
 167     color!          \ ( table start )
 168     1+
 169     swap 3 + swap   \ ( table+3 start+1 )
 170   loop
 171 ;
 172
 173 headerless
 174
 175 \
 176 \ Installation
 177 \
 178
 179 : qemu-vga-driver-install ( -- )
 180   fb-addr -1 = if
 181     map-fb fb-addr to frame-buffer-adr
 182     default-font set-font
 183
 184     frame-buffer-adr encode-int " address" property
 185
 186     openbios-video-width openbios-video-height over char-width / over char-height /
 187     fb8-install
 188   then
 189 ;
 190
 191 : qemu-vga-driver-init
 192
 193   vbe-init
 194   openbios-video-width encode-int " width" property
 195   openbios-video-height encode-int " height" property
 196   depth-bits encode-int " depth" property
 197   line-bytes encode-int " linebytes" property
 198
 199   ['] qemu-vga-driver-install is-install
 200 ;
 201
 202 qemu-vga-driver-init
 203
 204 end0