version1 [03] checksum=774a len=00002544
offset16
" cgsix" xdrstring " name" attribute " SUNW,501-2325" model " display"
device-type
: copyright \ 08 00
   " Copyright (c) 1991 by Sun Microsystems, Inc. "
;
: sccsid \ 08 01
   " @(#)turbo1m.fth 1.8 94/07/15"
;
variable legosc-address \ 08 02
: map-slot \ 08 03
   swap legosc-address @ + swap map-sbus
;
1 constant dblbuf? \ 08 04
1 constant /vmsize \ 08 05
a1 constant bdrev \ 08 06
4 value ppc \ 08 07
d3250 value strap-value \ 08 08
1f600 value delay-value \ 08 09
4 constant lengthloc \ 08 0a
10 constant /dac \ 08 0b
8000 constant /prom \ 08 0c
58a28d4 constant mainosc \ 08 0d
-1 value dac-adr \ 08 0e
-1 value prom-adr \ 08 0f
-1 value alt-adr \ 08 10
-1 value ptr \ 08 11
-1 value logo \ 08 12
-1 value fhc \ 08 13
-1 value thc \ 08 14
-1 value fbc-adr \ 08 15
-1 value fb-addr \ 08 16
-1 value tec \ 08 17
-1 value tmp-len \ 08 18
-1 value tmp-addr \ 08 19
-1 value tmp-flag \ 08 1a
-1 value selftest-map \ 08 1b
0 value my-reset \ 08 1c
0 value mapped? \ 08 1d
0 value alt-mapped? \ 08 1e
100000 value /frame \ 08 1f
100 alloc-mem constant data-space \ 08 20
0 EXTERNAL value display-width \ 08 21
0 EXTERNAL value display-height \ 08 22
-1 EXTERNAL value acceleration \ 08 23
0 value lego-status \ 08 24
0 value sense-id-value \ 08 25
0 value chip-rev \ 08 26
defer (set-fbconfiguration \ 08 27
defer (confused? \ 08 28
: my-attribute \ 08 29
   fcode-version 2000 < if
      2drop 2drop
   else
      my-reset 0 = if
         attribute
      else
         2drop 2drop
      then
   then
;
: my-xdrint \ 08 2a
   my-reset 0= if
      xdrint
   else
      0
   then
;
: my-xdrstring \ 08 2b
   my-reset 0= if
      xdrstring
   then
;
: length@ \ 08 2c
   prom-adr lengthloc + l@
;
: logo-data \ 08 2d
   prom-adr length@ + begin
      dup 3 and
   while
      1 +
   repeat
;
: fbc! \ 08 2e
   fbc-adr + l!
;
: fbc@ \ 08 2f
   fbc-adr + l@
;
: fhc! \ 08 30
   fhc + l!
;
: fhc@ \ 08 31
   fhc + l@
;
: tec! \ 08 32
   tec + l!
;
: thc! \ 08 33
   thc + l!
;
: thc@ \ 08 34
   thc + l@
;
: dac! \ 08 35
   dac-adr + l!
;
: dac@ \ 08 36
   dac-adr + l@
;
: alt! \ 08 37
   alt-adr + l!
;
: fbc-busy-wait \ 08 38
   begin
      10 fbc@ 10000000 and 0=
   until
;
: fbc-draw-wait \ 08 39
   begin
      14 fbc@ 20000000 and 0=
   until
;
: fbc-blit-wait \ 08 3a
   begin
      18 fbc@ 20000000 and 0=
   until
;
: background-color \ 08 3b
   inverse-screen? if
      ff
   else
      0
   then
;
: rect-fill \ 08 3c
   fbc-busy-wait 100 fbc! 2swap 904 fbc! 900 fbc! 904 fbc! 900 fbc!
   fbc-draw-wait fbc-busy-wait ff 100 fbc!
;
: >pixel \ 08 3d
   swap char-width * window-left + swap char-height * window-top +
;
: char-fill \ 08 3e
   2swap >pixel 2swap >pixel background-color rect-fill
;
: init-blit-reg \ 08 3f
   fbc-busy-wait ffffffff 10 fbc! 0 4 tec! 0 8 fbc! 0 c0 fbc! 0 c4 fbc! 0
   d0 fbc! 0 d4 fbc! 0 e0 fbc! 0 e4 fbc! ff 100 fbc! 0 104 fbc! a9806c60
   108 fbc! ff 10c fbc! ffffffff 110 fbc! 0 11c fbc! ffffffff 120 fbc!
   ffffffff 124 fbc! ffffffff 128 fbc! ffffffff 12c fbc! ffffffff 130
   fbc! ffffffff 134 fbc! ffffffff 138 fbc! ffffffff 13c fbc! 229540 4
   fbc! display-width 1 - f0 fbc! display-height 1 - f4 fbc!
   display-width
   400 of ffffe3ff 0 fhc@ and 0 fhc! endof
   480 of ffffe3ff 0 fhc@ and 800 or 0 fhc! endof
   500 of ffffe3ff 0 fhc@ and 1000 or 0 fhc! endof
   640 of ffffe3ff 0 fhc@ and 1800 or 0 fhc! endof
   780 of ffffe3ff 0 fhc@ and 400 or 0 fhc! endof
   endcase
;
: cg6-save \ 08 40
   fbc-busy-wait c0 fbc@ c4 fbc@ d0 fbc@ d4 fbc@ e0 fbc@ e4 fbc@ 8 fbc@
   100 fbc@ 104 fbc@ 108 fbc@ 10c fbc@ 110 fbc@ 4 fbc@ f0 fbc@ f4 fbc@ 80
   fbc@ 84 fbc@ 90 fbc@ 94 fbc@ a0 fbc@ a4 fbc@ b0 fbc@ b4 fbc@
   init-blit-reg
;
: cg6-restore \ 08 41
   fbc-busy-wait b4 fbc! b0 fbc! a4 fbc! a0 fbc! 94 fbc! 90 fbc! 84 fbc!
   80 fbc! f4 fbc! f0 fbc! 40 or 4 fbc! 110 fbc! 10c fbc! 108 fbc! 104
   fbc! 100 fbc! 8 fbc! e4 fbc! e0 fbc! d4 fbc! d0 fbc! c4 fbc! c0 fbc!
;
variable tmp-blit \ 08 42
: lego-blit \ 08 43
   fbc-busy-wait >pixel 1 - b4 fbc! 1 - b0 fbc! >pixel a4 fbc! a0 fbc!
   >pixel 1 - 94 fbc! 1 - 90 fbc! >pixel 84 fbc! 80 fbc! fbc-blit-wait
   fbc-busy-wait
;
: lego-delete-lines \ 08 44
   dup #lines < if
      tmp-blit ! cg6-save tmp-blit @ >r 0 line# r@ + #columns #lines 0
      line# #columns #lines r@ - line# r@ + #lines < if
         lego-blit
      else
         2drop 2drop 2drop 2drop
      then 0 #lines r> - #columns #lines char-fill cg6-restore
   else
      tmp-blit ! cg6-save tmp-blit @ 0 swap #lines swap - #columns #lines
      char-fill cg6-restore
   then
;
: lego-insert-lines \ 08 45
   dup #lines < if
      tmp-blit ! cg6-save tmp-blit @ >r 0 line# #columns #lines r@ - 0
      line# r@ + #columns #lines lego-blit 0 line# #columns line# r> +
      char-fill cg6-restore
   else
      tmp-blit ! cg6-save tmp-blit @ 0 swap line# swap #columns swap
      line# swap + char-fill cg6-restore
   then
;
: lego-erase-screen \ 08 46
   cg6-save 0 0 screen-width screen-height background-color rect-fill
   cg6-restore
;
: lego-video-on \ 08 47
   818 thc@ 400 or 818 thc!
;
: lego-video-off \ 08 48
   818 thc@ fffffbff and 1000 or 818 thc!
;
: lego-sync-on \ 08 49
   818 thc@ 80 or 818 thc!
;
: lego-sync-off \ 08 4a
   818 thc@ ffffff7f and 818 thc!
;
: delay-100 \ 08 4b
   1000 ms
;
: lego-sync-reset \ 08 4c
   818 thc@ 1000 or 818 thc!
;
: prom-map \ 08 4d
   0 /prom map-slot (is) prom-adr
;
: prom-unmap \ 08 4e
   prom-adr /prom free-virtual -1 (is) prom-adr
;
: dac-map \ 08 4f
   200000 /dac map-slot (is) dac-adr
;
: dac-unmap \ 08 50
   dac-adr /dac free-virtual -1 (is) dac-adr
;
: fhc-thc-map \ 08 51
   300000 2000 map-slot (is) fhc fhc 1000 + (is) thc
;
: fhc-thc-unmap \ 08 52
   fhc 2000 free-virtual -1 (is) fhc -1 (is) thc
;
: ?fhc-thc-map \ 08 53
   fhc -1 = if
      -1 (is) mapped? fhc-thc-map
   else
      0 (is) mapped?
   then
;
: ?fhc-thc-unmap \ 08 54
   mapped? if
      fhc-thc-unmap 0 (is) mapped?
   then
;
: fb-map \ 08 55
   800000 /frame map-slot (is) fb-addr
;
: fb-unmap \ 08 56
   fb-addr /frame free-virtual -1 (is) fb-addr
;
: fbc-map \ 08 57
   700000 2000 map-slot (is) fbc-adr fbc-adr 1000 + (is) tec
;
: fbc-unmap \ 08 58
   fbc-adr 2000 free-virtual -1 (is) fbc-adr
;
: alt-map \ 08 59
   280000 2000 map-slot (is) alt-adr
;
: alt-unmap \ 08 5a
   alt-adr 2000 free-virtual -1 (is) alt-adr
;
: ?alt-map \ 08 5b
   alt-adr -1 = if
      -1 (is) alt-mapped? alt-map
   else
      0 (is) alt-mapped?
   then
;
: ?alt-unmap \ 08 5c
   alt-mapped? if
      alt-unmap 0 (is) alt-mapped?
   then
;
: color \ 08 5d
   dup rot + swap 0 dac-adr l! do
      i c@ dup 18 << + dac-adr 4 + l!
   loop
;
: 3color! \ 08 5e
   dac-adr l! swap rot 3 0 do
      dac-adr 4 + l!
   loop
;
: color! \ 08 5f
   swap 0 dac! 2dup dac! 2dup dac! dac!
;
: lego-init-dac \ 08 60
   dac-map 4000000 0 dac! ff000000 8 dac! 5000000 0 dac! 0 8 dac! 6000000
   0 dac! 43000000 8 dac! 7000000 0 dac! 0 8 dac! 9000000 0 dac! 6000000
   8 dac! ff000000 0 4 color! 0 ff000000 4 color! ff000000 1000000 c
   color! 0 2000000 c color! 0 3000000 c color! 64000000 41000000
   b4000000 1000000 3color! dac-unmap
;
EXTERNAL : r1024x768x60 \ 08 61
   " 64125000,48286,60,24,136,160,1024,3,6,29,768,COLOR"
;
EXTERNAL : r1024x768x70 \ 08 62
   " 74250000,56593,70,16,136,136,1024,2,6,32,768,COLOR"
;
EXTERNAL : r1024x768x77 \ 08 63
   " 84375000,62040,77,32,128,176,1024,2,4,31,768,COLOR,0OFFSET"
;
EXTERNAL : r1024x800x74 \ 08 64
   " 84375000,62040,74,32,128,176,1024,2,4,31,800,COLOR,0OFFSET"
;
EXTERNAL : r1024x800x85 \ 08 65
   " 94500000,71590,85,16,128,152,1024,2,4,31,800,COLOR,0OFFSET"
;
EXTERNAL : r1152x900x66 \ 08 66
   " 94500000,61845,66,40,128,208,1152,2,4,31,900,COLOR"
;
EXTERNAL : r1152x900x76 \ 08 67
   " 108000000,71808,76,32,128,192,1152,2,8,33,900,COLOR,0OFFSET"
;
: sense-code \ 08 68
   sense-id-value
   7 of r1152x900x66 endof
   6 of r1152x900x76 endof
   5 of r1024x768x60 endof
   4 of r1152x900x76 endof
   3 of r1152x900x66 endof
   2 of r1152x900x66 endof
   1 of r1152x900x66 endof
   0 of r1024x768x77 endof
   drop r1152x900x66 0
   endcase
;
: ics-write \ 08 69
   dup 1c << 8000000 or 0 alt! 1c << 0 alt! dup 1c << 0 alt! 1c <<
   8000000 or 0 alt!
;
: ics47 \ 08 6a
   0 1 0 a c f f f 8 2 0 0 5
;
: ics54 \ 08 6b
   0 1 0 a c f f f 8 2 2 0 4
;
: ics64 \ 08 6c
   0 8 0 a c f f f 0 2 1 0 3
;
: ics74 \ 08 6d
   0 1 0 a d f f f 8 4 3 0 5
;
: ics81 \ 08 6e
   0 1 0 a d f f f 8 5 0 0 6
;
: ics84 \ 08 6f
   0 8 0 a c f f f 0 3 1 0 3
;
: ics94 \ 08 70
   0 8 0 a c f f f 0 1 0 0 1
;
: ics108 \ 08 71
   0 8 0 a d f f f 0 4 2 0 3
;
: ics117 \ 08 72
   0 1 0 a d f f f 8 3 2 0 2
;
: ics135 \ 08 73
   0 1 0 a e f f f 8 5 4 0 3
;
: ics189 \ 08 74
   0 0 0 a d f f f 8 2 0 0 2
;
: ics216 \ 08 75
   0 0 0 a d f f f 8 4 2 0 3
;
: oscillators \ 08 76
   50775d8 4d3f640 46cf710 3d27848 cdfe600 b43e940 80befc0 6f94740
   66ff300 5a1f4a0 337f980 2d0fa50 c
;
: setup-oscillator-sam \ 08 77
   ?alt-map
   0 of a8000000 0 alt! endof
   1 of d0000000 0 alt! endof
   2 of 38000000 0 alt! endof
   3 of 81000000 0 alt! endof
   a8000000 0 alt!
   endcase
   94 thc@ 40 or dup 94 thc! (is) strap-value 1 ms ?alt-unmap
;
: setup-oscillator-ad \ 08 78
   ?alt-map ff000000 0 alt!
   0 of 0 0 alt! endof
   1 of 11000000 0 alt! endof
   2 of 22000000 0 alt! endof
   3 of 33000000 0 alt! endof
   4 of 44000000 0 alt! endof
   5 of 55000000 0 alt! endof
   6 of 66000000 0 alt! endof
   7 of 77000000 0 alt! endof
   8 of 88000000 0 alt! endof
   9 of 99000000 0 alt! endof
   a of aa000000 0 alt! endof
   22000000 0 alt!
   endcase
   94 thc@ 40 or dup 94 thc! (is) strap-value 1 ms ?alt-unmap
;
: setup-oscillator \ 08 79
   ?alt-map
   0 of ics47 endof
   1 of ics54 endof
   2 of ics94 endof
   3 of ics108 endof
   4 of ics117 endof
   5 of ics135 endof
   6 of ics189 endof
   7 of ics216 endof
   8 of ics64 endof
   9 of ics74 endof
   a of ics81 endof
   b of ics84 endof
   drop ics94 0
   endcase
   0 d ics-write d 0 do
      i ics-write
   loop 0 f ics-write 20 0 do
      0 d ics-write
   loop 94 thc@ 40 or dup 94 thc! (is) strap-value 1 ms ?alt-unmap
;
variable dpl \ 08 7a
: upper \ 08 7b
   bounds ?do
      i dup c@ upc swap c!
   loop
;
: compare-strings \ 08 7c
   rot tuck < if
      drop 2drop 0
   else
      comp 0=
   then
;
: long? \ 08 7d
   dpl @ 1 + 0<>
;
: convert \ 08 7e
   begin
      1 + dup >r c@ a digit
   while
      >r a * r> + long? if
         1 dpl +!
      then r>
   repeat drop r>
;
: number? \ 08 7f
   >r 0 r@ dup 1 + c@ 2d = dup >r - -1 dpl ! begin
      convert dup c@ 2e =
   while
      0 dpl !
   repeat r> if
      swap negate swap
   then r> count + =
;
: number \ 08 80
   number? drop
;
: /string \ 08 81
   over min >r swap r@ + swap r> -
;
: +string \ 08 82
   1 +
;
: -string \ 08 83
   swap 1 + swap 1 -
;
: left-parse-string \ 08 84
   >r over 0 2swap begin
      dup
   while
      over c@ r@ = if
         r> drop -string 2swap exit
      then 2swap +string 2swap -string
   repeat 2swap r> drop
;
: left-parse-string' \ 08 85
   left-parse-string 2 pick 0= if
      2swap
   then
;
variable cal-tmp \ 08 86
variable osc-tmp \ 08 87
variable confused? \ 08 88
100 alloc-mem constant tmp-monitor-string \ 08 89
100 alloc-mem constant tmp-pack-string \ 08 8a
variable tmp-monitor-len \ 08 8b
EXTERNAL : monitor-string \ 08 8c
   tmp-monitor-string tmp-monitor-len @
;
: flag-strings \ 08 8d
   " STEREO" " 0OFFSET" " OVERSCAN" " GRAY" 4
;
: mainosc? \ 08 8e
   -1 confused? ! 3e8 / osc-tmp ! oscillators 0 do
      3e8 / osc-tmp @ = if
         i setup-oscillator 0 confused? !
      then
   loop
;
: parse-string \ 08 8f
   (is) tmp-len (is) tmp-addr (is) tmp-flag flag-strings 0 do
      tmp-addr tmp-len 2swap compare-strings if
         1 i << tmp-flag + (is) tmp-flag
      then
   loop tmp-flag
;
: parse-flags \ 08 90
   0 >r begin
      2c left-parse-string r> -rot parse-string >r dup 0=
   until 2drop r>
;
: parse-line \ 08 91
   b 0 do
      2c left-parse-string tmp-pack-string pack dup number swap drop -rot
      dup 0= if
         (leave)
      then
   loop dup 0<> if
      parse-flags
   else
      2drop 0
   then
;
: cycles-per-tran \ 08 92
   1add30 ppc * /mod swap 0<> if
      1 +
   then 4 - dup f > if
      drop f
   then
;
: vert \ 08 93
   (is) display-height rot dup my-xdrint " vfporch" my-attribute 1 - dup
   c0 thc! rot dup my-xdrint " vsync" my-attribute + dup c4 thc! swap dup
   my-xdrint " vbporch" my-attribute + dup c8 thc! display-height + cc
   thc!
;
: horz \ 08 94
   (is) display-width rot dup my-xdrint " hfporch" my-attribute dup ppc /
   1 - dup a0 thc! 3 pick dup my-xdrint " hsync" my-attribute ppc / + dup
   a4 thc! rot dup my-xdrint " hbporch" my-attribute ppc / + dup a8 thc!
   display-width ppc / + dup b0 thc! -rot - ppc / - ac thc!
;
: fbc-res \ 08 95
   display-width 400 < if
      94 thc@ 800000 or 94 thc! display-width 2 *
   else
      94 thc@ 800000 not and 94 thc! display-width
   then
   400 of ffffe3ff 0 fhc@ and 0 fhc! endof
   480 of ffffe3ff 0 fhc@ and 800 or 0 fhc! endof
   500 of ffffe3ff 0 fhc@ and 1000 or 0 fhc! endof
   800 of ffffe3ff 0 fhc@ and 1400 or 0 fhc! endof
   640 of ffffe3ff 0 fhc@ and 1800 or 0 fhc! endof
   780 of ffffe3ff 0 fhc@ and 400 or 0 fhc! endof
   0 (is) acceleration
   endcase
   cal-tmp @ 4 and 0<> if
      94 thc@ 80 or 94 thc!
   else
      94 thc@ 80 not and 94 thc!
   then
;
: cal-tim \ 08 96
   cal-tmp ! vert horz my-xdrint " vfreq" my-attribute my-xdrint " hfreq"
   my-attribute dup my-xdrint " pixfreq" my-attribute dup mainosc?
   cycles-per-tran 818 thc@ fffffff0 and or 818 thc! 0 (is) dblbuf? 94
   thc@ 2000000 not and display-width display-height * 2 * /vmsize 100000
   * <= if
      2000000 or 1 (is) dblbuf?
   then 94 thc! fbc-res bdrev my-xdrint " boardrev" my-attribute cal-tmp
   @ my-xdrint " montype" my-attribute acceleration if
      " cgsix"
   else
      " cgthree+"
   then my-xdrstring " emulation" my-attribute
;
EXTERNAL : update-string \ 08 97
   2dup tmp-monitor-string swap move dup tmp-monitor-len !
;
: set-fbconfiguration \ 08 98
   update-string parse-line cal-tim
;
['] set-fbconfiguration (is) (set-fbconfiguration ['] confused? (is)
(confused?
: enable-disables \ 08 99
;
: disable-disables \ 08 9a
;
: lego-init-hc \ 08 9b
   ?fhc-thc-map 8000 0 fhc! 1ff 0 fhc! chip-rev
   5 of enable-disables 0 fhc@ 10000 or 0 fhc! disable-disables endof
   6 of enable-disables 0 fhc@ 10000 or 0 fhc! disable-disables endof
   7 of enable-disables 0 fhc@ 10000 or 0 fhc! disable-disables endof
   8 of enable-disables 0 fhc@ 10000 or 0 fhc! disable-disables endof
   enable-disables 0 fhc@ 10000 or 0 fhc! disable-disables
   endcase
   ffe0ffe0 8fc thc! ?fhc-thc-unmap
;
: logo@ \ 08 9c
   0 swap 4 0 do
      dup c@ rot 8 << + swap 1 +
   loop drop
;
: cg6-move-line \ 08 9d
   2 pick 2 pick 2 pick rot move
;
: move-image-to-fb \ 08 9e
   rot 0 do
      cg6-move-line display-width + swap 2 pick + swap
   loop drop 2drop
;
: lego-draw-logo \ 08 9f
   2 pick 92 + logo@ bfdfdfe7 <> if
      fb8-draw-logo
   else
      prom-map dac-map 100 3 * logo-data 4 + color dac-unmap drop 2drop
      logo-data 2 + c@ logo-data 3 + c@ rot logo-data 100 3 * + 4 + swap
      char-height * window-top + display-width * window-left + fb-addr +
      move-image-to-fb prom-unmap
   then
;
: diagnostic-type \ 08 a0
   diagnostic-mode? if
      type cr
   else
      2drop
   then
;
: ?lego-error \ 08 a1
   2swap <> if
      2 (is) lego-status diagnostic-type "  r/w failed"
   else
      2drop
   then
;
: lego-register-test \ 08 a2
   selftest-map if
      fb-map
   then 8 fbc@ 35 100 fbc! ca 104 fbc! 12345678 110 fbc! 96969696 84 fbc!
   69696969 80 fbc! 3c3c3c3c 90 fbc! a980cccc 108 fbc! ff 10c fbc! 0 e0
   fbc! 0 e4 fbc! display-width 1 - f0 fbc! display-height 1 - f4 fbc!
   14aac0 4 fbc! 0 8 fbc! 0 4 tec! "  FBC register test" diagnostic-type
   100 fbc@ 35 " FBC_FCOLOR" ?lego-error 104 fbc@ ca " FBC_BCOLOR"
   ?lego-error 110 fbc@ 12345678 " FBC_PIXELMASK" ?lego-error 84 fbc@
   96969696 " FBC_Y0" ?lego-error 80 fbc@ 69696969 " FBC_X0" ?lego-error
   90 fbc@ 3c3c3c3c " FBC_RASTEROP" ?lego-error ff 110 fbc! 0 84 fbc! 0
   80 fbc! 1f 90 fbc! 55555555 1c fbc! 8 fbc! selftest-map if
      fb-unmap
   then
;
: lego-fbc-test \ 08 a3
   selftest-map if
      fb-map
   then "  Font test" diagnostic-type 8 0 do
      i 4 * fb-addr + @ ff00ff <> if
         1 (is) lego-status " Fonting to DFB error" diagnostic-type
      then
   loop selftest-map if
      fb-unmap
   then
;
: lego-fb-test \ 08 a4
   selftest-map if
      fb-map
   then ffffffff mask ! 0 group-code ! fb-addr /frame memory-test-suite
   if
      1 (is) lego-status
   then selftest-map if
      fb-unmap
   then
;
: lego-selftest \ 08 a5
   fb-addr -1 = if
      -1 (is) selftest-map
   else
      0 (is) selftest-map
   then " Testing cgsix" diagnostic-type lego-register-test lego-fbc-test
   lego-fb-test lego-status
;
: lego-blink-screen \ 08 a6
   lego-video-off 20 ms lego-video-on
;
EXTERNAL : set-resolution \ 08 a7
   $find if
      execute
   then lego-init-hc (set-fbconfiguration (confused? @ if
      sense-code (set-fbconfiguration
   then lego-sync-reset lego-sync-on my-reset 0 = if
      display-width dup dup xdrint " width" attribute xdrint " linebytes"
      attribute xdrint " awidth" attribute display-height xdrint
      " height" attribute 8 xdrint " depth" attribute /vmsize xdrint
      " vmsize" attribute dblbuf? xdrint " dblbuf" attribute
   then
;
EXTERNAL : set-resolution-ext \ 08 a8
   $find if
      execute
   then -1 (is) my-reset lego-init-hc (set-fbconfiguration (confused? @
   if
      sense-code (set-fbconfiguration
   then lego-sync-reset lego-sync-on 0 (is) my-reset display-width
   data-space l! display-height data-space 4 + l! 8 data-space 8 + l!
   display-width data-space c + l! acceleration data-space 10 + l!
;
EXTERNAL : override \ 08 a9
   sense-id-value = if
      set-resolution
   else
      2drop
   then
;
: lego-reset-screen \ 08 aa
   -1 (is) my-reset fcode-version 2000 >= if
      strap-value 94 thc! delay-value 90 thc! monitor-string
      set-resolution
   then lego-video-on 0 (is) my-reset
;
: lego-draw-char \ 08 ab
   fbc-busy-wait fb8-draw-character
;
: lego-toggle-cursor \ 08 ac
   fbc-busy-wait fb8-toggle-cursor
;
: lego-invert-screen \ 08 ad
   fbc-busy-wait fb8-invert-screen
;
: lego-insert-characters \ 08 ae
   fbc-busy-wait fb8-insert-characters
;
: lego-delete-characters \ 08 af
   fbc-busy-wait fb8-delete-characters
;
: dfb-delete-lines \ 08 b0
   fbc-busy-wait fb8-delete-lines
;
: dfb-insert-lines \ 08 b1
   fbc-busy-wait fb8-insert-lines
;
: dfb-erase-screen \ 08 b2
   fbc-busy-wait fb8-erase-screen
;
EXTERNAL : reinstall-console \ 08 b3
   display-width display-height over char-width / over char-height /
   fb8-install ['] lego-draw-logo (is) draw-logo ['] lego-blink-screen
   (is) blink-screen ['] lego-reset-screen (is) reset-screen acceleration
   if
      ['] lego-delete-lines (is) delete-lines ['] lego-insert-lines (is)
      insert-lines ['] lego-erase-screen (is) erase-screen
   then
;
: lego-install \ 08 b4
   fb-map init-blit-reg default-font set-font fb-addr (is)
   frame-buffer-adr fb-addr xdrint " address" attribute my-args dup 0<>
   if
      set-resolution
   else
      2drop
   then reinstall-console lego-video-on
;
: lego-remove \ 08 b5
   lego-video-off fb-unmap -1 (is) frame-buffer-adr
;
: legoqs-probe \ 08 b6
   my-address legosc-address ! fhc-thc-map fbc-map alt-map strap-value 94
   thc! 100 ms delay-value 90 thc! fhc @ dup 18 >> f and 7 swap - (is)
   sense-id-value 14 >> f and dup xdrint " chiprev" my-attribute (is)
   chip-rev lego-sync-reset lego-sync-on
   " 84375000,64125000,108000000,94500000" xdrstring " oscillators"
   my-attribute data-space xdrint " global-data" attribute /frame xdrint
   " fbmapped" attribute strap-value 8 and dup (is) ppc 0= if
      4 (is) ppc
   then sense-code set-resolution lego-init-dac my-address my-space
   1000000 reg 5 0 intr ['] lego-install is-install ['] lego-remove
   is-remove ['] lego-selftest is-selftest
;
legoqs-probe

end0