1\ *****************************************************************************
2\ * Copyright (c) 2004, 2008 IBM Corporation
3\ * All rights reserved.
4\ * This program and the accompanying materials
5\ * are made available under the terms of the BSD License
6\ * which accompanies this distribution, and is available at
7\ * http://www.opensource.org/licenses/bsd-license.php
8\ *
9\ * Contributors:
10\ *     IBM Corporation - initial implementation
11\ ****************************************************************************/
12
13my-space pci-class-name type
14
15my-space assign-all-device-bars
16my-space pci-device-props
17my-space pci-set-irq-line
18
197 4 config-w!
20
21\ Special notice from ATI:
22\ ATI TECHNOLOGIES INC. ("ATI") HAS NOT ASSISTED IN THE CREATION OF,
23\ AND DOES NOT ENDORSE THE USE OF, THIS SOFTWARE.  ATI WILL NOT BE
24\ RESPONSIBLE OR LIABLE FOR ANY ACTUAL OR ALLEGED DAMAGE OR LOSS
25\ CAUSED BY OR IN CONNECTION WITH THE USE OF, OR RELIANCE ON,
26\ THIS SOFTWARE.
27
28\  Description: This FCODE driver initializes the RN50 (ES1000) ATI
29\               adaptor.
30
31-1 value mem-addr
32-1 value regs-addr
33false value is_installed
34
35: reg-rl@ regs-addr + rl@-le ;
36: reg-rl! regs-addr + rl!-le ;
37: map-in   " map-in"   $call-parent ;
38: map-out  " map-out"  $call-parent ;
39: pc@ ( offset -- byte ) regs-addr + rb@ ;
40: pc! ( byte offset -- ) regs-addr + rb! ;
41
420 value phys_low
430 value phys_mid
440 value phys_high
450 value phys_len
46
47: MAP-CSR-BASE ( -- )
48  " assigned-addresses" get-my-property 0= if
49    begin dup 0> while  ( prop-addr len )
50     \ Get the phys-hi mid low and the low order 32 bits of the length
51
52      decode-phys to phys_high to phys_mid to phys_low decode-int drop decode-int to phys_len
53
54      phys_high H# FF and  \ See which BAR this refers to
55      case
56        h# 10 of phys_low phys_mid phys_high h# 1000000  map-in to mem-addr  endof
57        h# 18 of phys_low phys_mid phys_high    phys_len map-in to regs-addr endof
58      endcase
59    repeat
60    ( prop-addr 0 ) 2drop
61  then
62
63  ;
64
65: enable-card my-space 4 + dup config-b@ 3 or swap config-b! ;
66
67: EARLY-MAP ( -- )
68
69  " reg" get-my-property 0= if
70    begin dup 0> while  ( prop-addr len )
71
72   \ Get the phys-hi mid low and the low order 32 bits of the length
73
74      decode-phys to phys_high to phys_mid to phys_low decode-int drop decode-int to phys_len
75
76      phys_high H# FF and  \ See which BAR this refers to
77      case
78        h# 10 of phys_low phys_mid phys_high H# 1000000  map-in to mem-addr  endof
79        h# 18 of phys_low phys_mid phys_high h#    1000  map-in to regs-addr endof
80      endcase
81    repeat
82    ( prop-addr 0 ) 2drop
83  then
84  ;
85
86: EARLY-UNMAP ( -- )
87
88  mem-addr -1 <> if
89    mem-addr h# 1000000 map-out
90    -1 to mem-addr
91  then
92
93  regs-addr -1 <> if
94    regs-addr h# 1000   map-out
95    -1 to regs-addr
96  then
97
98  ;
99
100CREATE INIT1_ARRAY
101H# 0F8  ( CONFIG_MEMSIZE )  L,    H# 00000000 L, H# 01000000 L,
102H# 1C0  ( MPP_TB_CONFIG )   L,    H# 00FFFFFF L, H# 07000000 L,
103H# 030  ( BUS_CNTL      )   L,    H# 00000000 L, H# 5133A3B0 L,
104H# 0EC  ( RBBM_CNTL     )   L,    H# 00000000 L, h# 00004443 L,
105H# 1D0  ( DEBUG_CNTL    )   L,    H# FFFFFFFD L, H# 00000002 L,
106H# 050  ( CRTC_GEN_CNTL )   L,    H# 00000000 L, H# 04000000 L,
107H# 058  ( DAC_CNTL      )   L,    H# 00000000 L, H# FF604102 L,
108H# 168  ( PAD_CTLR_STRENGTH ) L,  H# FFFEFFFF L, H# 00001200 L,
109H# 178  ( MEM_REFRESH_CNTL  ) L,  H# 00000000 L, H# 88888888 L,
110H# 17C  ( MEM_READ_CNTL )   L,    H# 00000000 L, H# B7C20000 L,
111H# 188  ( MC_DEBUG      )   L,    H# FFFFFFFF L, H# 00000000 L,
112H# D00  ( DISP_MISC_CNTL)   L,    H# 00FFFFFF L, H# 5B000000 L,
113H# 88C  ( TV_DAC_CNTL   )   L,    H# F800FCEF L, H# 00490200 L,
114H# D04  ( DAC_MACRO_CNTL)   L,    H# 00000000 L, H# 00000905 L,
115H# 284  ( FP_GEN_CNTL   )   L,    H# FFFFFFFF L, H# 00000008 L,
116H# 030  ( BUS_CNTL      )   L,    H# FFFFFFEF L, H# 00000000 L,
117
118here  INIT1_ARRAY  - /L / CONSTANT INIT1_LENGTH
119
120
121CREATE INIT2_ARRAY
122
123H# 140  ( MEM_CNTL )           L, H#  00000000 L, H# 38001A01 L, 0 L,
124H# 158  ( MEM_SDRAM_MODE_REG ) L, H#  E0000000 L, H# 08320032 L, 0 L,
125H# 144  ( MEM_TIMING_CNTL    ) L, H#  00000000 L, H# 20123833 L, 0 L,
126H# 14C  ( MC_AGP_LOCATION    ) L, H#  00000000 L, H# 000FFFF0 L, 0 L,
127H# 148  ( MC_FB_LOCATION     ) L, H#  00000000 L, H# FFFF0000 L, 0 L,
128H# 154  ( MEM_INIT_LAT_TIMER ) L, H#  00000000 L, H# 34444444 L, 0 L,
129H# 18C  ( MC_CHP_IO_OE_CNTL  ) L, H#  00000000 L, H# 0A540002 L, 0 L,
130H# 910  ( FCP_CNTL           ) L, H#  00000000 L, H# 00000004 L, 0 L,
131H# 010  ( BIOS_0_SCRATCH     ) L, H#  FFFFFFFB L, H# 00000004 L, 0 L,
132H# D64  ( DISP_OUTPUT_CNTL   ) L, H#  FFFFFBFF L, H# 00000000 L, 0 L,
133H# 2A8  ( TMDS_PLL_CNTL      ) L, H#  00000000 L, H# 00000A1B L, 0 L,
134H# 800  ( TV_MASTER_CNTL     ) L, H#  BFFFFFFF L, H# 40000000 L, 0 L,
135H# D10  ( DISP_TEST_DBUG_CTL ) L, H#  EFFFFFFF L, H# 10000000 L, 0 L,
136H# 4DC  ( OV0_FLAG_CNTRL     ) L, H#  FFFFFEFF L, H# 00000100 L, 0 L,
137H# 034  ( BUS_CNTL1          ) L, H#  73FFFFFF L, H# 84000000 L, 0 L,
138H# 174  ( AGP_CNTL           ) L, H#  FFEFFF00 L, H# 001E0000 L, 0 L,
139H# 18C  ( MC_CHP_IO_OE_CNTL  ) L, H#  FFFFFFF9 L, H# 00000006 L, h# 000A L,
140H# 18C  ( MC_CHP_IO_OE_CNTL  ) L, H#  FFFFFFFB L, H# 00000000 L, H# 000A L,
141H# 18C  ( MC_CHP_IO_OE_CNTL  ) L, H#  FFFFFFFD L, H# 00000000 L, 0 L,
142
143here  INIT2_ARRAY  - /L / CONSTANT INIT2_LENGTH
144
145CREATE PLLINIT_ARRAY
146
147H# 0D   L, H# FFFFFFFF L, H# FFFF8000 L, 0 L,
148H# 12   L, H# FFFFFFFF L, H# 00350000 L, 0 L,
149H# 08   L, H# FFFFFFFF L, H# 00000000 L, 0 L,
150H# 2D   L, H# FFFFFFFF L, H# 00000000 L, 0 L,
151H# 1F   L, H# FFFFFFFF L, H# 0000000A L, 5 L,
152H# 03   L, H# FFFFFFFF L, H# 0000003C L, 0 L,
153H# 0A   L, H# FFFFFFFF L, H# 00252504 L, 0 L,
154H# 25   L, H# FFFFFFFF L, H# 00000005 L, 0 L,
155H# 0E   L, H# FFFFFFFF L, H# 04756400 L, 0 L,
156H# 0C   L, H# FFFFFFFF L, H# 04006401 L, 0 L,
157H# 02   L, H# FFFFFFFF L, H# 0000A703 L, 0 L,
158H# 0F   L, H# FFFFFFFF L, H# 0000051C L, 0 L,
159H# 10   L, H# FFFFFFFF L, H# 04000400 L, 5 L,
160H# 0E   L, H# FFFFFFFD L, H# 00000000 L, 5 L,
161H# 0E   L, H# FFFFFFFE L, H# 00000000 L, 5 L,
162H# 12   L, H# FFFFFFFF L, H# 00350012 L, 5 L,
163H# 0F   L, H# FFFFFFFE L, H# 00000000 L, 6 L,
164H# 10   L, H# FFFFFFFE L, H# 00000000 L, 5 L,
165H# 10   L, H# FFFEFFFF L, H# 00000000 L, 6 L,
166H# 0F   L, H# FFFFFFFD L, H# 00000000 L, 5 L,
167H# 10   L, H# FFFFFFFD L, H# 00000000 L, 5 L,
168H# 10   L, H# FFFDFFFF L, H# 00000000 L, d# 10 L,
169H# 0C   L, H# FFFFFFFE L, H# 00000000 L, 6 L,
170H# 0C   L, H# FFFFFFFD L, H# 00000000 L, 5 L,
171h# 0D   L, H# FFFFFFFF L, H# FFFF8007 L, 5 L,
172H# 08   L, H# FFFFFF3C L, H# 00000000 L, 0 L,
173H# 02   L, H# FFFFFFFF L, H# 00000003 L, 0 L,
174H# 04   L, H# FFFFFFFF L, H# 000381C0 L, 0 L,
175H# 05   L, H# FFFFFFFF L, H# 000381F7 L, 0 L,
176H# 06   L, H# FFFFFFFF L, H# 000381C0 L, 0 L,
177H# 07   L, H# FFFFFFFF L, H# 000381F7 L, 0 L,
178H# 02   L, H# FFFFFFFD L, H# 00000000 L, 6 L,
179H# 02   L, H# FFFFFFFE L, H# 00000000 L, 5 L,
180h# 08   L, H# FFFFFF3C L, H# 00000003 L, 5 L,
181H# 0B   L, H# FFFFFFFF L, H# 78000800 L, 0 L,
182H# 0B   L, H# FFFFFFFF L, H# 00004000 L, 0 L,
183h# 01   L, h# FFFFFFFF L, H# 00000010 L, 0 L,
184
185here  PLLINIT_ARRAY  - /L / CONSTANT PLLINIT_LENGTH
186
187CREATE MEMINIT_ARRAY
188h# 6FFF0000  L, H# 00004000 L, H# 6FFF0000 L, H# 80004000 L,
189h# 6FFF0000  L, H# 00000132 L, H# 6FFF0000 L, H# 80000132 L,
190h# 6FFF0000  L, H# 00000032 L, H# 6FFF0000 L, H# 80000032 L,
191h# 6FFF0000  L, H# 10000032 L,
192here MEMINIT_ARRAY - /L / CONSTANT MEMINIT_LENGTH
193: L@+ ( addr -- value addr' )
194
195dup l@ swap la1+
196;
197
1980 VALUE _len
199
200: ENCODE-ARRAY  ( array len -- )
201   dup to _len 0  do  l@+ swap encode-int rot  loop
202   drop _len 1 - 0  ?do  encode+  loop
203;
204
205: andorset  ( reg and or -- )
206   2 pick dup reg-rl@
207   3 pick AND 2 pick OR swap reg-rl! 3drop
208;
209
210: INIT1
211H# 0F8  ( CONFIG_MEMSIZE )      H# 00000000  H# 01000000 andorset \ Set 16Mb memory size
212H# 1C0  ( MPP_TB_CONFIG )       H# 00FFFFFF  H# 07000000 andorset
213H# 030  ( BUS_CNTL      )       H# 00000000  H# 5133A3B0 andorset
214H# 0EC  ( RBBM_CNTL     )       H# 00000000  h# 00004443 andorset
215H# 1D0  ( DEBUG_CNTL    )       H# FFFFFFFD  H# 00000002 andorset
216H# 050  ( CRTC_GEN_CNTL )       H# 00000000  H# 04000000 andorset
217H# 058  ( DAC_CNTL      )       H# 00000000  H# FF604102 andorset
218H# 168  ( PAD_CTLR_STRENGTH )   H# FFFEFFFF  H# 00001200 andorset
219H# 178  ( MEM_REFRESH_CNTL  )   H# 00000000  H# 88888888 andorset
220H# 17C  ( MEM_READ_CNTL )       H# 00000000  H# B7C20000 andorset
221H# 188  ( MC_DEBUG      )       H# FFFFFFFF  H# 00000000 andorset
222H# D00  ( DISP_MISC_CNTL)       H# 00FFFFFF  H# 5B000000 andorset
223H# 88C  ( TV_DAC_CNTL   )       H# F800FCEF  H# 00490200 andorset
224H# D04  ( DAC_MACRO_CNTL)       H# 00000000  H# 00000905 andorset
225H# 284  ( FP_GEN_CNTL   )       H# FFFFFFFF  H# 00000008 andorset
226H# 030  ( BUS_CNTL      )       H# FFFFFFEF  H# 00000000 andorset
227;
228
229
230: INIT2
231H# 140  ( MEM_CNTL )            H#  00000000  H# 38001A01 andorset
232H# 158  ( MEM_SDRAM_MODE_REG )  H#  E0000000  H# 08320032 andorset
233H# 144  ( MEM_TIMING_CNTL    )  H#  00000000  H# 20123833 andorset
234H# 14C  ( MC_AGP_LOCATION    )  H#  00000000  H# 000FFFF0 andorset
235H# 148  ( MC_FB_LOCATION     )  H#  00000000  H# FFFF0000 andorset
236H# 154  ( MEM_INIT_LAT_TIMER )  H#  00000000  H# 34444444 andorset
237H# 18C  ( MC_CHP_IO_OE_CNTL  )  H#  00000000  H# 0A540002 andorset
238H# 910  ( FCP_CNTL           )  H#  00000000  H# 00000004 andorset
239H# 010  ( BIOS_0_SCRATCH     )  H#  FFFFFFFB  H# 00000004 andorset
240H# D64  ( DISP_OUTPUT_CNTL   )  H#  FFFFFBFF  H# 00000000 andorset
241H# 2A8  ( TMDS_PLL_CNTL      )  H#  00000000  H# 00000A1B andorset
242H# 800  ( TV_MASTER_CNTL     )  H#  BFFFFFFF  H# 40000000 andorset
243H# D10  ( DISP_TEST_DEBUG_CTL ) H#  EFFFFFFF  H# 10000000 andorset
244H# 4DC  ( OV0_FLAG_CNTRL     )  H#  FFFFFEFF  H# 00000100 andorset
245H# 034  ( BUS_CNTL1          )  H#  73FFFFFF  H# 84000000 andorset
246H# 174  ( AGP_CNTL           )  H#  FFEFFF00  H# 001E0000 andorset
247H# 18C  ( MC_CHP_IO_OE_CNTL  )  H#  FFFFFFF9  H# 00000006 andorset h# 000A ms
248H# 18C  ( MC_CHP_IO_OE_CNTL  )  H#  FFFFFFFB  H# 00000000 andorset H# 000A ms
249H# 18C  ( MC_CHP_IO_OE_CNTL  )  H#  FFFFFFFD  H# 00000000 andorset
250;
251
252: CLK-CNTL-INDEX! 8 ( CLK_CNTL_INDEX ) reg-rl! ;
253
254: CLK-CNTL-INDEX@ 8 ( CLK_CNTL_INDEX ) reg-rl@ ;
255
256: PLLWRITEON  clk-cntl-index@ H# 80 ( PLL_WR_ENABLE ) or clk-cntl-index! ;
257
258: PLLWRITEOFF clk-cntl-index@ H# 80 ( PLL_WR_ENABLE ) not and clk-cntl-index! ; \ Remove PLL_WR_ENABLE
259
260: CLKDATA! h# 0c ( CLK_CNTL_DATA ) reg-rl! ;
261
262: CLKDATA@ h# 0c ( CLK_CNTL_DATA ) reg-rl@ ;
263
264: PLLINDEXSET clk-cntl-index@ h# FFFFFFC0 and or clk-cntl-index! ;
265
266: PLLSET swap pllindexset clkdata! ;
267
268: pllandorset  ( index and or -- )
269   2 pick pllindexset clkdata@
270   2 pick AND over OR clkdata! 3drop
271;
272
273: PLLINIT
274pllwriteon
275H# 0D   H# FFFF8000 pllset
276H# 12   H# 00350000 pllset
277H# 08   H# 00000000 pllset
278H# 2D   H# 00000000 pllset
279H# 1F   H# 0000000A pllset 5 ms
280
281H# 03   H# 0000003C pllset
282H# 0A   H# 00252504 pllset
283H# 25   H# 00000005 pllset
284H# 0E   H# 04756400 pllset
285H# 0C   H# 04006401 pllset
286H# 02   H# 0000A703 pllset
287H# 0F   H# 0000051C pllset
288H# 10   H# 04000400 pllset 5 ms
289
290H# 0E   H# FFFFFFFD 00 pllandorset 5 ms
291H# 0E   H# FFFFFFFE 00 pllandorset 5 ms
292H# 12   H# 00350012 pllset 5 ms
293H# 0F   H# FFFFFFFE 00 pllandorset 6 ms
294H# 10   H# FFFFFFFE 00 pllandorset 5 ms
295H# 10   H# FFFEFFFF 00 pllandorset 6 ms
296H# 0F   H# FFFFFFFD 00 pllandorset 5 ms
297H# 10   H# FFFFFFFD 00 pllandorset 5 ms
298H# 10   H# FFFDFFFF 00 pllandorset d# 10 ms
299H# 0C   H# FFFFFFFE 00 pllandorset 6 ms
300H# 0C   H# FFFFFFFD 00 pllandorset 5 ms
301h# 0D   h# FFFF8007      pllset 5 ms
302H# 08   H# FFFFFF3C 00   pllandorset
303H# 02   h# FFFFFFFF 03   pllandorset
304H# 04   H# 000381C0      pllset
305H# 05   H# 000381F7      pllset
306H# 06   H# 000381C0      pllset
307H# 07   H# 000381F7      pllset
308H# 02   H# FFFFFFFD 00   pllandorset 6 ms
309H# 02   h# FFFFFFFE 00   pllandorset 5 ms
310h# 08   H# FFFFFF3C 03   pllandorset 5 ms
311H# 0B   h# 78000800      pllset
312H# 0B   H# FFFFFFFF h# 4000 pllandorset
313h# 01   h# FFFFFFFF h# 0010 pllandorset
314
315pllwriteoff
316;
317
318: DYNCKE
319pllwriteon
320H# 14   H# FFFF3FFF H# 30 pllandorset
321H# 14   H# FF1FFFFF H# 00 pllandorset
322H# 01   h# FFFFFFFF h# 80 pllandorset
323H# 0D   H# 00000007       pllset 5 ms
324h# 2D   H# 0000F8C0       pllset
325h# 08   H# FFFFFFFF h# C0 pllandorset 5 ms
326pllwriteoff
327;
328
329: MEM-MODE@
330    h# 158 ( MEM_SDRAM_MODE_REG ) reg-rl@ ;
331
332: MEM-MODE!
333    h# 158 ( MEM_SDRAM_MODE_REG ) reg-rl! ;
334
335: MEM-STATUS@
336    H# 150 reg-rl@ ;
337
338: WAIT-MEM-CMPLT
339    h# 8000 0 do mem-status@ 3 and 3 = if leave then loop ;
340
341: INITMEM
342
343  mem-mode@ h# 6FFF0000 and h# 4000     or mem-mode!
344  mem-mode@ h# 6FFF0000 and h# 80004000 or mem-mode!
345  wait-mem-cmplt
346  mem-mode@ h# 6FFF0000 and h# 0132     or mem-mode!
347  mem-mode@ h# 6FFF0000 and h# 80000132 or mem-mode!
348  wait-mem-cmplt
349  mem-mode@ h# 6FFF0000 and h# 0032     or mem-mode!
350  mem-mode@ h# 6FFF0000 and h# 80000032 or mem-mode!
351  wait-mem-cmplt
352  mem-mode@ h# 6FFF0000 and h# 10000032 or mem-mode!
353;
354
355
356
357: CLR-REG ( reg -- )
358  0 swap  reg-rl!
359
360;
361: SET-PALETTE  ( -- )
362  h# 0 h# b0 pc!                \ Reset PALETTE_INDEX
363
364  d# 16 0 do
365    H# 000000 h# B4 reg-rl!     \ Write the PALETTE_DATA ( Auto increments)
366    H# aa0000 H# B4 reg-rl!
367    H# 00aa00 H# B4 reg-rl!
368    H# aa5500 H# B4 reg-rl!
369    H# 0000aa H# B4 reg-rl!
370    H# aa00aa H# B4 reg-rl!
371    H# 00aaaa H# B4 reg-rl!
372    H# aaaaaa H# B4 reg-rl!
373    H# 555555 H# B4 reg-rl!
374    H# ff5555 H# B4 reg-rl!
375    H# 55ff55 H# B4 reg-rl!
376    H# ffff55 H# B4 reg-rl!
377    H# 5555ff H# B4 reg-rl!
378    H# ff55ff H# B4 reg-rl!
379    H# 55ffff H# B4 reg-rl!
380    H# ffffff H# B4 reg-rl!
381  loop
382
383 ;
384
3850 VALUE _addr
3860 VALUE _color
387
388: DO-COLOR  ( color-addr addr color -- )
389   to _color to _addr 0 to _color
390   3 0  do  _addr i + c@ 2 i - 8 * << _color + to _color  loop
391   _color h# B4 reg-rl!
392;
393
394: SET-COLORS ( addr index #indices -- )
395
396  swap h# B0 pc!
397  ( addr #indices ) 0 ?do dup ( index ) i 3 * + DO-COLOR loop
398  ( addr ) drop ;
399
400: init-card
401
402  h# FF h# 58 3 + pc!   \
403  h# 59 pc@ h# FE and  h# 59 pc!   \
404  h# 50 reg-rl@ H# FEFFFFFF AND h# 02000200 or  \ Clear 24 set 25 and 8-11 to 2
405  h# 50 reg-rl!
406  h# 4F0063  h# 200 reg-rl!
407  H# 8C02A2  h# 204 reg-rl!
408  H# 1Df020C h# 208 reg-rl!
409  h# 8201EA  h# 20C reg-rl!
410  h# 50 reg-rl@ H# F8FFFFFF AND h# 03000000 or h# 50 reg-rl!
411  h# 50 h# 22C reg-rl!
412  set-palette
413
414  \ at this point for some reason mem-addr does not point
415  \ to the right address and therefore the following command
416  \ which should probably clean the frame buffer just
417  \ overwrites everything starting from 0 including the
418  \ exception vectors
419
420  \ mem-addr h# F0000 0 fill
421 ;
422
423: DO-INIT
424  early-map
425  enable-card
426  init1
427  pllinit
428  init2
429  initmem
430  init-card
431  h# 8020 h# 54 reg-rl!
432  early-unmap
433;
434
435d# 640 constant /scanline
436d# 480 constant #scanlines
437/scanline #scanlines * constant /fb
438
439" okay" encode-string " status" property
440
441: display-install ( -- )
442  is_installed not if
443    map-csr-base
444    enable-card
445    mem-addr to frame-buffer-adr
446    h# 8020 h# 54 reg-rl!
447    default-font set-font
448    /scanline #scanlines  d# 100 d# 40 fb8-install
449    true to is_installed
450  then
451;
452
453: display-remove  ( -- )  ;
454
455do-init                                                 \ Set up the card
456\ clear at least 640x480
45710 config-l@ 8 - F0000 0 rfill
458init1_array init1_length encode-array " ibm,init1" property
459init2_array init2_length encode-array " ibm,init2" property
460pllinit_array pllinit_length   encode-array " ibm,pllinit" property
461meminit_array meminit_length   encode-array " ibm,meminit" property
4620 0 encode-bytes " iso6429-1983-colors" property
463s" display" device-type
464/scanline  encode-int " width" property
465 #scanlines encode-int " height" property
4668 encode-int " depth" property
467/scanline  encode-int " linebytes" property
468
469' display-install is-install
470' display-remove is-remove
471
472: fill-rectangle ( index x y w h -- )
473  2swap -rot /scanline * + frame-buffer-adr + ( index w h fbadr )
474  swap 0 ?do ( index w fbadr )
475    3dup swap rot fill ( index w fbadr )
476    /scanline + ( index w fbadr' )
477  loop
478  3drop
479;
480: draw-rectangle ( addr x y w h -- )
481 2swap -rot /scanline * + frame-buffer-adr + ( addr w h fbadr )
482 swap 0 ?do ( addr w fbadr )
483   3dup swap move ( addr w fbadr )
484    >r tuck + swap r> ( addr' w fbadr )
485    /scanline + ( addr' w fbadr' )
486  loop
487  3drop
488 ;
489 : read-rectangle ( addr x y w h -- )
490  2swap -rot /scanline * + frame-buffer-adr + ( addr w h fbadr )
491  swap 0 ?do ( addr w fbadr )
492    3dup -rot move ( addr w fbadr )
493    >r tuck + swap r> ( addr' w fbadr )
494    /scanline + ( addr' w fbadr' )
495  loop
496  3drop
497 ;
498
499: dimensions  ( -- width height )  /scanline #scanlines  ;
500
501."  ( rn50 )" cr
502