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