| \ |
| \ Fcode payload for QEMU CG3 graphics card |
| \ |
| \ This is the Forth source for an Fcode payload to initialise |
| \ the QEMU CG3 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 |
| " debug-type" (find-xt) value debug-type-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 |
| ; |
| |
| : debug-type debug-type-xt execute ; |
| |
| \ |
| \ Registers |
| \ |
| |
| h# 400000 constant cg3-off-dac |
| h# 20 constant /cg3-off-dac |
| |
| h# 800000 constant cg3-off-fb |
| h# c0000 constant /cg3-off-fb |
| |
| : >cg3-reg-spec ( offset size -- encoded-reg ) |
| >r 0 my-address d+ my-space encode-phys r> encode-int encode+ |
| ; |
| |
| : cg3-reg |
| \ A real cg3 rom appears to just map the entire region with a |
| \ single entry |
| h# 0 h# 1000000 >cg3-reg-spec |
| " 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 cg3-dac |
| -1 value fb-addr |
| |
| : dac! ( data reg# -- ) |
| cg3-dac + c! |
| ; |
| |
| 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 |
| cg3-off-dac /cg3-off-dac do-map-in to cg3-dac |
| ; |
| |
| : fb-map |
| cg3-off-fb h# c0000 do-map-in to fb-addr |
| ; |
| |
| : map-regs |
| dac-map fb-map |
| ; |
| |
| \ |
| \ Installation |
| \ |
| |
| " cgthree" device-name |
| " display" device-type |
| " SUNW,501-1415" model |
| |
| : qemu-cg3-driver-install ( -- ) |
| cg3-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 |
| |
| frame-buffer-adr encode-int " address" property |
| |
| openbios-video-width openbios-video-height over char-width / over char-height / |
| fb8-install |
| then |
| ; |
| |
| : qemu-cg3-driver-init |
| |
| cg3-reg |
| |
| 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 |
| |
| \ Monitor sense. Some searching suggests that this is |
| \ 5 for 1024x768 and 7 for 1152x900 |
| openbios-video-width h# 480 = if |
| h# 7 |
| else |
| h# 5 |
| then |
| encode-int " monitor-sense" property |
| |
| " SUNW" encode-string " manufacturer" property |
| " ISO8859-1" encode-string " character-set" property |
| h# c encode-int " cursorshift" property |
| |
| ['] qemu-cg3-driver-install is-install |
| ; |
| |
| qemu-cg3-driver-init |
| |
| end0 |