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-addr" (find-xt) value pci-bar>pci-addr-xt
 113 : pci-bar>pci-addr pci-bar>pci-addr-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-addr if   \ ( pci-addr.lo pci-addr.mid pci-addr.hi size )
 120     " pci-map-in" $call-parent
 121     to fb-addr
 122   then
 123 ;
 124
 125 \
 126 \ Publically visible words
 127 \
 128
 129 external
 130
 131 [IFDEF] CONFIG_MOL
 132 defer mol-color!
 133
 134 \ Hook for MOL (see packages/molvideo.c)
 135 \
 136 \ Perhaps for neatness this there should be a separate molvga.fs
 137 \ but let's leave it here for now.
 138
 139 : color!  ( r g b index -- )
 140   mol-color!
 141 ;
 142
 143 [ELSE]
 144
 145 \ Standard VGA
 146
 147 : color!  ( r g b index -- )
 148   vga-color!
 149 ;
 150
 151 [THEN]
 152
 153 : fill-rectangle  ( color_ind x y width height -- )
 154   fb8-fillrect
 155 ;
 156
 157 : dimensions  ( -- width height )
 158   openbios-video-width
 159   openbios-video-height
 160 ;
 161
 162 : set-colors  ( table start count -- )
 163   0 do
 164     over dup        \ ( table start table table )
 165     c@ swap 1+      \ ( table start r table-g )
 166     dup c@ swap 1+  \ ( table start r g table-b )
 167     c@ 3 pick       \ ( table start r g b index )
 168     color!          \ ( table start )
 169     1+
 170     swap 3 + swap   \ ( table+3 start+1 )
 171   loop
 172 ;
 173
 174 headerless
 175
 176 \
 177 \ Installation
 178 \
 179
 180 : qemu-vga-driver-install ( -- )
 181   fb-addr -1 = if
 182     map-fb fb-addr to frame-buffer-adr
 183     default-font set-font
 184
 185     frame-buffer-adr encode-int " address" property
 186
 187     openbios-video-width openbios-video-height over char-width / over char-height /
 188     fb8-install
 189   then
 190 ;
 191
 192 : qemu-vga-driver-init
 193
 194   vbe-init
 195   openbios-video-width encode-int " width" property
 196   openbios-video-height encode-int " height" property
 197   depth-bits encode-int " depth" property
 198   line-bytes encode-int " linebytes" property
 199
 200   ['] qemu-vga-driver-install is-install
 201 ;
 202
 203 qemu-vga-driver-init
 204
 205 end0