2
\ Fcode payload for QEMU CG3 graphics card
4
\ This is the Forth source for an Fcode payload to initialise
5
\ the QEMU CG3 graphics card.
7
\ (C) Copyright 2013 Mark Cave-Ayland
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
17
: (find-xt) \ ( str len -- xt | -1 )
26
: (is-openbios) \ ( -- true | false )
27
" openbios-video-width" (find-xt) -1 <> if
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
40
: openbios-video-width
42
openbios-video-width-xt @
48
: openbios-video-height
50
openbios-video-height-xt @
72
: debug-type debug-type-xt execute ;
78
h# 400000 constant cg3-off-dac
79
h# 20 constant /cg3-off-dac
81
h# 800000 constant cg3-off-fb
82
h# c0000 constant /cg3-off-fb
84
: >cg3-reg-spec ( offset size -- encoded-reg )
85
>r 0 my-address d+ my-space encode-phys r> encode-int encode+
89
\ A real cg3 rom appears to just map the entire region with a
91
h# 0 h# 1000000 >cg3-reg-spec
95
: do-map-in ( offset size -- virt )
96
>r my-space r> " map-in" $call-parent
99
: do-map-out ( virt size )
100
" map-out" $call-parent
110
: dac! ( data reg# -- )
116
: color! ( r g b c# -- )
131
cg3-off-dac /cg3-off-dac do-map-in to cg3-dac
135
cg3-off-fb h# c0000 do-map-in to fb-addr
146
" cgthree" device-name
147
" display" device-type
148
" SUNW,501-1415" model
150
: qemu-cg3-driver-install ( -- )
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
159
fb-addr to frame-buffer-adr
160
default-font set-font
162
frame-buffer-adr encode-int " address" property
164
openbios-video-width openbios-video-height over char-width / over char-height /
169
: qemu-cg3-driver-init
173
openbios-video-height encode-int " height" property
174
openbios-video-width encode-int " width" property
175
line-bytes encode-int " linebytes" property
177
h# 39 encode-int 0 encode-int encode+ " intr" property
179
\ Monitor sense. Some searching suggests that this is
180
\ 5 for 1024x768 and 7 for 1152x900
181
openbios-video-width h# 480 = if
186
encode-int " monitor-sense" property
188
" SUNW" encode-string " manufacturer" property
189
" ISO8859-1" encode-string " character-set" property
190
h# c encode-int " cursorshift" property
192
['] qemu-cg3-driver-install is-install