diff options
Diffstat (limited to 'qemu/roms/openbios/drivers/tcx.fs')
| -rw-r--r-- | qemu/roms/openbios/drivers/tcx.fs | 280 |
1 files changed, 0 insertions, 280 deletions
diff --git a/qemu/roms/openbios/drivers/tcx.fs b/qemu/roms/openbios/drivers/tcx.fs deleted file mode 100644 index af8991fd0..000000000 --- a/qemu/roms/openbios/drivers/tcx.fs +++ /dev/null @@ -1,280 +0,0 @@ -\ -\ Fcode payload for QEMU TCX graphics card -\ -\ This is the Forth source for an Fcode payload to initialise -\ the QEMU TCX graphics card. -\ -\ (C) Copyright 2013 Mark Cave-Ayland -\ - -fcode-version3 - -\ -\ Instead of using fixed values for the framebuffer address and the width -\ and height, grab the ones passed in by QEMU/generated by OpenBIOS -\ - -: (find-xt) \ ( str len -- xt | -1 ) - $find if - exit - else - 2drop - -1 - then -; - -: (is-openbios) \ ( -- true | false ) - " openbios-video-width" (find-xt) -1 <> if - -1 - else - 0 - then -; - -" openbios-video-width" (find-xt) cell+ value openbios-video-width-xt -" openbios-video-height" (find-xt) cell+ value openbios-video-height-xt -" depth-bits" (find-xt) cell+ value depth-bits-xt -" line-bytes" (find-xt) cell+ value line-bytes-xt - -: openbios-video-width - (is-openbios) if - openbios-video-width-xt @ - else - h# 400 - then -; - -: openbios-video-height - (is-openbios) if - openbios-video-height-xt @ - else - h# 300 - then -; - -: depth-bits - (is-openbios) if - depth-bits-xt @ - else - h# 8 - then -; - -: line-bytes - (is-openbios) if - line-bytes-xt @ - else - h# 400 - then -; - -\ -\ Registers -\ - -h# 0 constant tcx-off-rom -h# 10000 constant /tcx-off-rom - -h# 200000 constant tcx-off-cmap -h# 4000 constant /tcx-off-cmap-24 -h# 4 constant /tcx-off-cmap-8 - -h# 240000 constant tcx-off-dhc -h# 4000 constant /tcx-off-dhc-24 -h# 4 constant /tcx-off-dhc-8 - -h# 280000 constant tcx-off-alt -h# 8000 constant /tcx-off-alt-24 -h# 1 constant /tcx-off-alt-8 - -h# 301000 constant tcx-off-thc-24 -h# 300000 constant tcx-off-thc-8 -h# 1000 constant /tcx-off-thc-24 -h# 81c constant /tcx-off-thc-8 - -h# 701000 constant tcx-off-tec -h# 1000 constant /tcx-off-tec - -h# 800000 constant tcx-off-dfb8 -h# 100000 constant /tcx-off-dfb8 - -h# 2000000 constant tcx-off-dfb24 -h# 400000 constant /tcx-off-dfb24-24 -h# 1 constant /tcx-off-dfb24-8 - -h# 4000000 constant tcx-off-stip -h# 800000 constant /tcx-off-stip - -h# 6000000 constant tcx-off-blit -h# 800000 constant /tcx-off-blit - -h# a000000 constant tcx-off-rdfb32 -h# 400000 constant /tcx-off-rdfb32-24 -h# 1 constant /tcx-off-rdfb32-8 - -h# c000000 constant tcx-off-rstip -h# 800000 constant /tcx-off-rstip-24 -h# 1 constant /tcx-off-rstip-8 - -h# e000000 constant tcx-off-rblit -h# 800000 constant /tcx-off-rblit-24 -h# 1 constant /tcx-off-rblit-8 - -: >tcx-reg-spec ( offset size -- encoded-reg ) - >r 0 my-address d+ my-space encode-phys r> encode-int encode+ -; - -: tcx-8bit-reg - \ WARNING: order is important (at least to Solaris) - tcx-off-dfb8 /tcx-off-dfb8 >tcx-reg-spec - tcx-off-dfb24 /tcx-off-dfb24-8 >tcx-reg-spec encode+ - tcx-off-stip /tcx-off-stip >tcx-reg-spec encode+ - tcx-off-blit /tcx-off-blit >tcx-reg-spec encode+ - tcx-off-rdfb32 /tcx-off-rdfb32-8 >tcx-reg-spec encode+ - tcx-off-rstip /tcx-off-rstip-8 >tcx-reg-spec encode+ - tcx-off-rblit /tcx-off-rblit-8 >tcx-reg-spec encode+ - tcx-off-tec /tcx-off-tec >tcx-reg-spec encode+ - tcx-off-cmap /tcx-off-cmap-8 >tcx-reg-spec encode+ - tcx-off-thc-8 /tcx-off-thc-8 >tcx-reg-spec encode+ - tcx-off-rom /tcx-off-rom >tcx-reg-spec encode+ - tcx-off-dhc /tcx-off-dhc-8 >tcx-reg-spec encode+ - tcx-off-alt /tcx-off-alt-8 >tcx-reg-spec encode+ - " reg" property -; - -: tcx-24bit-reg - \ WARNING: order is important (at least to Solaris) - tcx-off-dfb8 /tcx-off-dfb8 >tcx-reg-spec - tcx-off-dfb24 /tcx-off-dfb24-24 >tcx-reg-spec encode+ - tcx-off-stip /tcx-off-stip >tcx-reg-spec encode+ - tcx-off-blit /tcx-off-blit >tcx-reg-spec encode+ - tcx-off-rdfb32 /tcx-off-rdfb32-24 >tcx-reg-spec encode+ - tcx-off-rstip /tcx-off-rstip-24 >tcx-reg-spec encode+ - tcx-off-rblit /tcx-off-rblit-24 >tcx-reg-spec encode+ - tcx-off-tec /tcx-off-tec >tcx-reg-spec encode+ - tcx-off-cmap /tcx-off-cmap-24 >tcx-reg-spec encode+ - tcx-off-thc-24 /tcx-off-thc-24 >tcx-reg-spec encode+ - tcx-off-rom /tcx-off-rom >tcx-reg-spec encode+ - tcx-off-dhc /tcx-off-dhc-24 >tcx-reg-spec encode+ - tcx-off-alt /tcx-off-alt-24 >tcx-reg-spec encode+ - " reg" property -; - -: do-map-in ( offset size -- virt ) - >r my-space r> " map-in" $call-parent -; - -: do-map-out ( virt size ) - " map-out" $call-parent -; - -\ -\ DAC -\ - --1 value tcx-dac --1 value /tcx-dac --1 value fb-addr - -: dac! ( data reg# -- ) - >r dup 2dup bljoin r> tcx-dac + l! -; - -external - -: color! ( r g b c# -- ) - 0 dac! ( r g b ) - swap rot ( b g r ) - 4 dac! ( b g ) - 4 dac! ( b ) - 4 dac! ( ) -; - -headerless - -\ -\ Mapping -\ - -: dac-map - tcx-off-cmap /tcx-dac do-map-in to tcx-dac -; - -: fb-map - tcx-off-dfb8 h# c0000 do-map-in to fb-addr -; - -: map-regs - dac-map fb-map -; - -\ -\ Installation -\ - -" SUNW,tcx" device-name -" display" device-type - -: qemu-tcx-driver-install ( -- ) - tcx-dac -1 = if - map-regs - - \ Initial pallette taken from Sun's "Writing FCode Programs" - h# ff h# ff h# ff h# 0 color! \ Background white - h# 0 h# 0 h# 0 h# ff color! \ Foreground black - h# 64 h# 41 h# b4 h# 1 color! \ SUN-blue logo - - fb-addr to frame-buffer-adr - default-font set-font - - \ Sun TCX adapters don't have an address property, but it is useful for - \ OpenBIOS developers. Unfortunately NetBSD SPARC32 has a bug that causes - \ it to fail initialising TCX if the address property is present; so work - \ around this by adding an underscore prefix - frame-buffer-adr encode-int " _address" property - - openbios-video-width openbios-video-height over char-width / over char-height / - fb8-install - then -; - -: qemu-tcx-driver-init - - \ Handle differences between 8-bit/24-bit mode - depth-bits 8 = if - tcx-8bit-reg - /tcx-off-cmap-8 to /tcx-dac - " true" encode-string " tcx-8-bit" property - else - tcx-24bit-reg - /tcx-off-cmap-24 to /tcx-dac - - \ Even with a 24-bit enabled TCX card, the control plane is - \ used in 8-bit mode. So force the video subsystem into 8-bit - \ mode before initialisation. - 8 depth-bits-xt ! - openbios-video-width line-bytes-xt ! - then - - h# 1d encode-int " vbporch" property - h# a0 encode-int " hbporch" property - h# 06 encode-int " vsync" property - h# 88 encode-int " hsync" property - h# 03 encode-int " vfporch" property - h# 18 encode-int " hfporch" property - h# 03dfd240 encode-int " pixfreq" property - h# 3c encode-int " vfreq" property - - openbios-video-height encode-int " height" property - openbios-video-width encode-int " width" property - line-bytes encode-int " linebytes" property - - h# 39 encode-int 0 encode-int encode+ " intr" property - 5 encode-int " interrupts" property - - ['] qemu-tcx-driver-install is-install -; - -qemu-tcx-driver-init - -end0 |