qemu/roms/openbios/drivers/cgthree.fs

   1 \
   2 \ Fcode payload for QEMU CG3 graphics card
   3 \
   4 \ This is the Forth source for an Fcode payload to initialise
   5 \ the QEMU CG3 graphics card.
   6 \
   7 \ (C) Copyright 2013 Mark Cave-Ayland
   8 \
   9
  10 fcode-version3
  11
  12 \
  13 \ Instead of using fixed values for the framebuffer address and the width
  14 \ and height, grab the ones passed in by QEMU/generated by OpenBIOS
  15 \
  16
  17 : (find-xt)   \ ( str len -- xt | -1 )
  18   $find if
  19     exit
  20   else
  21     2drop
  22     -1
  23   then
  24 ;
  25
  26 : (is-openbios)  \ ( -- true | false )
  27   " openbios-video-width" (find-xt) -1 <> if
  28     -1
  29   else
  30     0
  31   then
  32 ;
  33
  34 " openbios-video-width" (find-xt) cell+ value openbios-video-width-xt
  35 " openbios-video-height" (find-xt) cell+ value openbios-video-height-xt
  36 " depth-bits" (find-xt) cell+ value depth-bits-xt
  37 " line-bytes" (find-xt) cell+ value line-bytes-xt
  38 " debug-type" (find-xt) value debug-type-xt
  39
  40 : openbios-video-width
  41   (is-openbios) if
  42     openbios-video-width-xt @
  43   else
  44     h# 400
  45   then
  46 ;
  47
  48 : openbios-video-height
  49   (is-openbios) if
  50     openbios-video-height-xt @
  51   else
  52     h# 300
  53   then
  54 ;
  55
  56 : depth-bits
  57   (is-openbios) if
  58     depth-bits-xt @
  59   else
  60     h# 8
  61   then
  62 ;
  63
  64 : line-bytes
  65   (is-openbios) if
  66     line-bytes-xt @
  67   else
  68     h# 400
  69   then
  70 ;
  71
  72 : debug-type debug-type-xt execute ;
  73
  74 \
  75 \ Registers
  76 \
  77
  78 h# 400000 constant cg3-off-dac
  79 h# 20 constant /cg3-off-dac
  80
  81 h# 800000 constant cg3-off-fb
  82 h# c0000 constant /cg3-off-fb
  83
  84 : >cg3-reg-spec ( offset size -- encoded-reg )
  85   >r 0 my-address d+ my-space encode-phys r> encode-int encode+
  86 ;
  87
  88 : cg3-reg
  89   \ A real cg3 rom appears to just map the entire region with a
  90   \ single entry
  91   h# 0 h# 1000000 >cg3-reg-spec
  92   " reg" property
  93 ;
  94
  95 : do-map-in ( offset size -- virt )
  96   >r my-space r> " map-in" $call-parent
  97 ;
  98
  99 : do-map-out ( virt size )
 100   " map-out" $call-parent
 101 ;
 102
 103 \
 104 \ DAC
 105 \
 106
 107 -1 value cg3-dac
 108 -1 value fb-addr
 109
 110 : dac! ( data reg# -- )
 111   cg3-dac + c!
 112 ;
 113
 114 external
 115
 116 : color!  ( r g b c# -- )
 117   0 dac!       ( r g b )
 118   swap rot     ( b g r )
 119   4 dac!       ( b g )
 120   4 dac!       ( b )
 121   4 dac!       (  )
 122 ;
 123
 124 headerless
 125
 126 \
 127 \ Mapping
 128 \
 129
 130 : dac-map
 131   cg3-off-dac /cg3-off-dac do-map-in to cg3-dac
 132 ;
 133
 134 : fb-map
 135   cg3-off-fb h# c0000 do-map-in to fb-addr
 136 ;
 137
 138 : map-regs
 139   dac-map fb-map
 140 ;
 141
 142 \
 143 \ Installation
 144 \
 145
 146 " cgthree" device-name
 147 " display" device-type
 148 " SUNW,501-1415" model
 149
 150 : qemu-cg3-driver-install ( -- )
 151   cg3-dac -1 = if
 152     map-regs
 153
 154     \ Initial pallette taken from Sun's "Writing FCode Programs"
 155     h# ff h# ff h# ff h# 0  color!    \ Background white
 156     h# 0  h# 0  h# 0  h# ff color!    \ Foreground black
 157     h# 64 h# 41 h# b4 h# 1  color!    \ SUN-blue logo
 158
 159     fb-addr to frame-buffer-adr
 160     default-font set-font
 161
 162     frame-buffer-adr encode-int " address" property
 163
 164     openbios-video-width openbios-video-height over char-width / over char-height /
 165     fb8-install
 166   then
 167 ;
 168
 169 : qemu-cg3-driver-init
 170
 171   cg3-reg
 172
 173   openbios-video-height encode-int " height" property
 174   openbios-video-width encode-int " width" property
 175   line-bytes encode-int " linebytes" property
 176
 177   h# 39 encode-int 0 encode-int encode+ " intr" property
 178
 179   \ Monitor sense. Some searching suggests that this is
 180   \ 5 for 1024x768 and 7 for 1152x900
 181   openbios-video-width h# 480 = if
 182     h# 7
 183   else
 184     h# 5
 185   then
 186   encode-int " monitor-sense" property
 187
 188   " SUNW" encode-string " manufacturer" property
 189   " ISO8859-1" encode-string " character-set" property
 190   h# c encode-int " cursorshift" property
 191
 192   ['] qemu-cg3-driver-install is-install
 193 ;
 194
 195 qemu-cg3-driver-init
 196
 197 end0