~pmdj/ubuntu/trusty/qemu/2.9+applesmc+fadtv3

« back to all changes in this revision

Viewing changes to roms/openbios/drivers/cgthree.fs

  • Committer: Phil Dennis-Jordan
  • Date: 2017-07-21 08:03:43 UTC
  • mfrom: (1.1.1)
  • Revision ID: phil@philjordan.eu-20170721080343-2yr2vdj7713czahv
New upstream release 2.9.0.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
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