CGSIX PROM INFORMATION: This file contains: * a dump of the word list from the PROM * the .attributes output * the results of doing 'see foo' for each word, with comments added, and generally tidied up. The data was all taken from the onboard graphics of an IPX. What I was actually aiming for was to get the thing to talk to a non-Sun fixed-frequency monitor, for which you use the following incantation: : vsetup " 105561000,69000,72,40,128,208,1152,2,8,48,900,COLOR" ; vsetup 3 " /sbus/cgsix" " override" execute-device-method drop screen output where the magic string is: " osc,hfrq,vfrq,hfporch,hsyncw,hbporch,hdisp,vfporch,vsyncw,vbporch,vdisp,flags" Result: somewhat mangled but OK prompt clearly visible. Need to (a) put in terminators and (b) fix mode line above. -- PMM ========================= Wordlist, in no particular order (constants, variables, code all mixed together...): selftest close remove restore draw-logo write open install legoh-probe lego-remove lego-install dfb-erase-screen dfb-insert-lines dfb-delete-lines lego-delete-characters lego-insert-characters lego-invert-screen lego-toggle-cursor lego-draw-char lego-reset-screen override set-resolution lego-blink-screen lego-selftest lego-fb-test lego-fbc-test lego-register-test ?lego-error diagnostic-type lego-draw-logo move-image-to-fb cg6-move-line logo@ lego-init-hc disable-disables enable-disables set-fbconfiguration update-string cal-tim fbc-res horz vert cycles-per-tran parse-line parse-flags parse-string mainosc? flag-strings monitor-string tmp-monitor-len tmp-monitor-string confused? osc-tmp cal-tmp right-parse-string cindex left-parse-string' left-parse-string -string +string /string number number? convert long? compare-strings upper dpl setup-oscillator oscillators sense-code r1600x1280x76m r1280x1024x76m r1600x1280x76 r1280x1024x76 r1024x1024x61 r1024x800x85 r1152x900x76 r1152x900x66 r1920x1080x72 r1280x1024x67 r1280x1024x60 r1024x768x66 lego-init-dac color! 3color! color fbc-unmap fbc-map fb-unmap fb-map ?fhc-thc-unmap ?fhc-thc-map fhc-thc-unmap fhc-thc-map dac-unmap dac-map prom-unmap prom-map lego-sync-reset delay-100 lego-sync-off lego-sync-on lego-video-off lego-video-on lego-erase-screen lego-insert-lines lego-delete-lines lego-blit tmp-blit cg6-restore cg6-save init-blit-reg char-fill >pixel rect-fill background-color fbc-blit-wait fbc-draw-wait fbc-busy-wait dac! thc@ thc! tec! fhc@ fhc! fbc@ fbc! logo-data length@ hobbes-prom my-attribute fbprom (confused? (set-fbconfiguration acceleration chip-rev sense-id-value lego-rez-height lego-rez-width lego-status /frame strap-value ppc my-reset mapped? selftest-map tmp-flag tmp-addr tmp-len tec fbc-adr thc fhc logo ptr prom-adr dac-adr mainosc /prom /dac lengthloc bdrev /vmsize dblbuf? map-slot legosc-address sccsid copyright \ The following is a dump of the attributes: intr 00 00 00 07 00 00 00 00 reg 00 00 00 03 00 00 00 00 01 00 00 00 dblbuf 00 00 00 00 vmsize 00 00 00 01 depth 00 00 00 08 height 00 00 03 84 awidth 00 00 04 80 linebytes 00 00 04 80 width 00 00 04 80 emulation cgsix montype 00 00 00 00 boardrev 00 00 00 08 pixfreq 05 8a 28 d4 hfreq 00 00 f1 63 vfreq 00 00 00 42 hbporch 00 00 00 c0 hsync 00 00 00 80 hfporch 00 00 00 20 vbporch 00 00 00 1f vsync 00 00 00 04 vfporch 00 00 00 02 oscillators 92940500 105561000 chiprev 00 00 00 06 device_type display model SUNW,501-1672 name cgsix \ ================================================ \ Here we go with the main listing... \ Display device driver for cgsix. \ Commented disassembly from Sun IPX builtin fb ROM \ Questions/suggestions to Peter Maydell : sccsid " @(#)cg6.fth 3.4 91/01/08" ; : copyright " Copyright (c) 1990 by Sun Microsystems, Inc. " ; \ Nobody uses these variables (huh?) value logo ( Parameter field: 9bc988c ) value ptr ( Parameter field: 9b89889 ) \ =============================================================== \ simple utility routines for accessing bits of the cgsix \ Sizes of bits of the cgsix 10 constant /dac 8000 constant /prom \ This one's not constant: it's set to (xres * yres) on initialisation value /frame ( Parameter field: 9f098bd ) \ Virtual addresses of where things are mapped. -1 means 'not mapped' -1 value dac-adr ( Parameter field: 9b09881 ) -1 value prom-adr ( Parameter field: 9b49885 ) -1 value fbc-adr ( Parameter field: 9c89895 ) -1 value frame-buffer-adr \ I guessed this one, was missing from disassembly output... -1 value tec ( Parameter field: 9cc9899 ) -1 value thc ( Parameter field: 9c49892 ) -1 value fhc ( Parameter field: 9c0988f ) \ Map a region of the cgsix into the virtual address space. : map-slot ( offset size -- viraddr ) swap legosc-address + swap map-sbus ; \ Routines to map and unmap various bits of the cgsix : dac-map ( -- ) 200000 /dac map-slot (is) dac-adr ; : dac-unmap ( -- ) dac-adr /dac free-virtual -1 (is) dac-adr ; : prom-map ( -- ) 0 /prom map-slot (is) prom-adr ; : prom-unmap ( -- ) prom-adr /prom free-virtual -1 (is) prom-adr ; : fbc-map ( -- ) 700000 2000 map-slot (is) fbc-adr ; : fbc-unmap ( -- ) fbc-adr 2000 free-virtual -1 (is) fbc-adr ; : fb-map ( -- ) 800000 /frame map-slot (is) frame-buffer-adr ; : fb-unmap ( -- ) frame-buffer-adr /frame free-virtual -1 (is) frame-buffer-adr ; \ The FHC and THC are mapped and unmapped as one block : fhc-thc-map ( -- ) 300000 2000 map-slot (is) fhc fhc 1000 + (is) thc ; : fhc-thc-unmap ( -- ) fhc 2000 free-virtual -1 (is) fhc -1 (is) thc ; \ This pair of routines is used to ensure the FHC/THC are mapped \ and to return them to the previous state (whether mapped or unmapped) \ Usage: ?fhc-thc-map do-something-with-thc ?fhc-thc-unmap value mapped? \ used only by these routines, to store previous mapping state ( Parameter field: 9e098ad ) : ?fhc-thc-map ( -- ) fhc -1 = if \ Not already mapped, so map them and record the fact -1 (is) mapped? fhc-thc-map else \ already mapped 0 (is) mapped? then ; : ?fhc-thc-unmap mapped? if \ if we had to map, we must unmap fhc-thc-unmap 0 (is) mapped? then ; \ Brooktree DAC interface section \ The Brooktree DAC has an internal address register which helps to \ select the internal register which is to be accessed. \ First, the address is written to register 0, then the data is written \ to one of the other registers. \ Ibis has 3 separate DAC chips which appear as the three least-significant \ bytes of a longword. All three chips may be simultaneously updated \ with a single longword write. \ The IPX's cgsix code seems to be rather simpler, presumably because it \ knows which of these it is (Brooktree). : dac! ( data reg# -- ) dac-adr + l! ; \ color!, 3color! set an overlay color register. \ In order to be able to use either the Brooktree 457 or 458 dacs, we \ set the address once, then store the color 3 times. The chip internally \ cycles each time the color register is written, selecting in turn the \ red color, the green color, and the blue color. \ The chip is used in "RGB mode". \ For both of these cases the colour byte is in the most significant \ byte of a long word. \ This sets R, G and B to the same value. You can specify the dacreg, not \ sure why (for 3color! it's hardcoded to 4.) : color! ( colour colour# dacreg ) swap 0 dac! ( r b ) \ store colour# to DAC 0 2dup ( r b r b ) dac! ( r b ) \ store r to DAC b 2dup ( r b r b ) dac! dac! ( ) \ store r to DAC b, twice ; \ This is an RGB-version : 3color! ( r g b colour# -- ) dac-adr l! ( r g b ) \ colour number to DAC 0 swap rot ( b g r ) 3 0 do dac-adr 4 + l! \ store each colour to DAC 4 loop ; \ This one sets the palette (starting at colour 0) \ by reading the byte-count bytes of data starting at \ palette-addr [which are expected to be RGBRGBRGB...] \ It's only used by lego-draw-logo. : color ( palette-addr byte-count -- ) dup rot ( count count addr ) + swap ( addr+count count ) 0 dac-adr l! \ write 0 to DAC 0: start at colour 0 do \ loop through the d bytes starting at c i c@ \ read byte from that address dup 18 << + \ byte + (byte << 0x18) dac-adr 4 + l! \ write to DAC 4 loop ; \ Routines for writing and reading various bits of the cgsix : fbc! ( value offset -- ) fbc-adr + l! ; : fbc@ ( offset -- value ) fbc-adr + l@ ; : thc! ( value offset -- ) thc + l! ; : thc@ ( offset -- value ) thc + l@ ; : fhc! ( value offset -- ) fhc + l! ; : fhc@ ( offset -- value ) fhc + l@ ; : tec! ( value offset -- ) tec + l! ; \ No tec@ -- we evidently never need to read from it... \ =============================================================== \ Self test code value selftest-map \ Do self tests need to map things in? ( Parameter field: 9dc98a8 ) value lego-status \ Have any tests failed? ( Parameter field: 9f498c1 ) \ Self test code. This is the main entry point. : lego-selftest ( -- ) \ Make sure /frame is correctly set, since we might not have inited yet. lego-rez-width lego-rez-height * (is) /frame \ Make a note of whether the FBC is actually mapped yet fbc-adr -1 = if -1 (is) selftest-map \ Not else 0 (is) selftest-map \ Is mapped then " Testing cgsix" diagnostic-type \ Perform various tests lego-register-test lego-fbc-test lego-fb-test lego-status \ Return test status (1 if any test failed) ; \ Output message if diag-switch? is set, otherwise forget it. : diagnostic-type ( stringadr len -- ) diag-switch? if type cr \ Output string and a trailing newline else 2drop \ Forget it. then ; : lego-register-test \ Map the fb and fbc if we need to selftest-map if fb-map fbc-map then 8 fbc@ \ Save this setting, we'll restore on exit \ Store various values into various FBC registers 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! lego-rez-width 1 - f0 fbc! lego-rez-height 1 - f4 fbc! 14aac0 4 fbc! 0 8 fbc! 0 4 tec! " FBC register test" diagnostic-type \ Read (some of) them back and check they're what we read 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 \ Restore to sane settings (??) ff 110 fbc! 0 84 fbc! 0 80 fbc! 1f 90 fbc! 55555555 1c fbc! 8 fbc! \ Restore FBC 8 to saved value \ Unmap what we mapped selftest-map if fb-unmap fbc-unmap then ; : ?lego-error ( actual-value expected-value regnamestr regnamestrlen -- ) 2swap <> if \ If actual value is not expected value \ Test failed 2 (is) lego-status diagnostic-type " r/w failed" else 2drop then ; \ Framebuffer test : lego-fb-test \ If selftests have to map things, then map the framebuffer: selftest-map if fb-map then \ Just use stock memory tests, I think ffffffff mask ! 0 group-code ! frame-buffer-adr /frame memory-test-suite if \ if failed, record the fact 1 (is) lego-status then \ Unmap if we mapped anything selftest-map if fb-unmap then ; : lego-fbc-test \ Map the framebuffer if we must selftest-map if fb-map then " Font test" diagnostic-type 8 0 do \ I think this is reading fonts from a bit of ROM in the fb memory? i 4 * frame-buffer-adr + @ ff00ff <> if \ Test failed 1 (is) lego-status " Fonting to DFB error" diagnostic-type then loop \ Unmap what we mapped selftest-map if fb-unmap then ; \ =============================================================== \ Hardware probing and install value strap-value ( Parameter field: 9ec98b8 ) value chip-rev \ cgsix chip revision, some old ones have bugs ( Parameter field: a0498d8 ) value ppc \ pixels per clock ( Parameter field: 9e898b5 ) value acceleration \ 1 if we use accelerated draw routines (cgsix) ( Parameter field: a0898dc ) value sense-id-value \ ID the monitor is advertising itself as ( Parameter field: a0098d2 ) value lego-rez-height \ height of screen in pixels ( Parameter field: 9fc98cc ) value lego-rez-width \ width of screen in pixels ( Parameter field: 9f898c6 ) value confused? \ are timing settings mangled? [bad dotclock] ( Parameter field: a249e1a ) \ Probe for lego and install : legoh-probe fhc-thc-map strap-value 94 thc! \ Pull miscellaeous information out of FHC 0 (it's assorted stuff all \ jammed into a 32 bit field) fhc @ ( fhc0 ) dup 18 >> f and ( fhc0 ((fhc0 >> 0x18) & f) ) 7 swap - \ sense-id-value == 7 - ((fhc0 >> 0x18) & 0xf) (is) sense-id-value 14 >> f and \ chip rev is ((fhc0 >> 0x14) & 0xf) \ Save it as the chiprev attribute and in a variable dup xdrint " chiprev" my-attribute (is) chip-rev fhc-thc-unmap \ We know what oscillators are available: " 92940500 105561000" xdrstring " oscillators" my-attribute \ (strap-value & 0x8) is a bit flag: if set, 8 pixels per clock, \ otherwise 4 pixels per clock. strap-value 8 and dup (is) ppc 0= if 4 (is) ppc then sense-code set-resolution \ Set resolution for this monitor lego-init-dac my-address my-space 1000000 reg \ Declare location and size of registers 5 0 intr \ Declare interrupt level and vector ; Tell OpenBoot about our public interface: ['] lego-install is-install ['] lego-remove is-remove ['] lego-selftest is-selftest ; \ Initialise the DAC and set up the palette : lego-init-dac ( -- ) \ Note the pattern with DAC access here. We do \ 0 dac! dac! \ where only uses the ms byte. dac-map 6000000 0 dac! 43000000 8 dac! \ Control reg: 5000000 0 dac! 0 8 dac! \ Blinking off 4000000 0 dac! ff000000 8 dac! \ Read mask set to all ones \ Set up colour palette ff000000 0 4 color! \ Background is white 0 ff000000 4 color! \ Foreground is black ff000000 1000000 c color! 0 2000000 c color! 0 3000000 c color! 64000000 41000000 b4000000 1000000 3color! \ set colour 1 to SUN-blue for logo dac-unmap ; \ Install proper : lego-install \ Set size in bytes of frame buffer lego-rez-width lego-rez-height * (is) /frame \ Map things in fb-map fhc-thc-map fbc-map init-blit-reg default-font set-font frame-buffer-adr xdrint " address" attribute lego-rez-width lego-rez-height over ( width height width ) char-width / ( width height width-in-chars ) over ( width height width-in-chars height ) char-height / ( width height width-in-chars height-in-chars ) fb8-install ; Register more of our public interface with OpenBoot: ['] lego-draw-logo (is) draw-logo ['] lego-blink-screen (is) blink-screen ['] lego-reset-screen (is) reset-screen ['] lego-draw-char (is) draw-character ['] lego-toggle-cursor (is) toggle-cursor ['] lego-invert-screen (is) invert-screen ['] lego-insert-characters (is) insert-characters ['] lego-delete-characters (is) delete-characters acceleration if \ Accelerated routines ['] lego-delete-lines (is) delete-lines ['] lego-insert-lines (is) insert-lines ['] lego-erase-screen (is) erase-screen else \ Dumb frame buffer... ['] dfb-delete-lines (is) delete-lines ['] dfb-insert-lines (is) insert-lines ['] dfb-erase-screen (is) erase-screen then \ ...so let's go! lego-video-on ; \ This is -1 if we are currently doing a reset. This suppresses \ the setting of attributes. value my-reset ( Parameter field: 9e498b1 ) \ Reset routine. : lego-reset-screen -1 (is) my-reset \ Note that we are resetting strap-value 94 thc! \ Reset timing parameters using the saved copy of the specification string monitor-string set-resolution lego-video-on 0 (is) my-reset \ Reset complete. ; \ Declare an attribute with the given value. Works on all \ OpenBoot versions. Just drops request if we're doing a reset. : my-attribute ( xdr-adr xdr-len name-adr name-len -- ) fcode-version 2000 < if \ Ancient OpenBoot version -- doesn't support attributes... 2drop 2drop else my-reset 0 = if attribute else \ Currently doing a reset, ignore request 2drop 2drop then then ; \ Return a string for the default resolution for the monitor sense ID : sense-code ( -- stradr strlen ) sense-id-value 7 of r1152x900x66 endof 6 of r1152x900x76 endof 5 of r1152x900x66 endof 4 of r1152x900x76 endof 3 of r1152x900x66 endof 2 of r1280x1024x76m endof 1 of r1600x1280x76m endof 0 of r1152x900x66 endof drop r1152x900x66 0 endcase ; \ A set of words which give timing strings for various resolutions. The format is: \ w h vfrq " osc,hfrq,vfrq,hfporch,hsyncw,hbporch,hdisp,vfporch,vsyncw,vbporch,vdisp,flags" \ Note that not all of these use osc. values which the card supports! : r1600x1280x76m " 105561000,101339,76,8,32,264,744,2,8,42,1273,COLOR" ; : r1280x1024x76m " 105561000,81128,76,24,48,232,1000,2,8,32,1022,COLOR" ; : r1600x1280x76 " 227000000,101339,76,8,64,568,1600,2,8,42,1280,COLOR" ; : r1280x1024x76 " 135000000,81128,76,32,64,288,1280,2,8,32,1024,COLOR" ; : r1024x1024x61 " 92940500,65267,61,32,128,240,1024,2,4,33,1024,COLOR" ; : r1024x800x85 " 92940500,71717,85,16,64,192,1024,2,8,33,800,GRAY" ; : r1152x900x76 " 105561000,71717,76,16,96,208,1152,2,8,33,900,COLOR,0OFFSET" ; : r1152x900x66 " 92940500,61795,66,32,128,192,1152,2,4,31,900,COLOR" ; : r1920x1080x72 " 188568000,81000,72,40,88,408,1920,5,5,35,1080,COLOR" ; : r1280x1024x67 " 117000000,71691,67,16,112,224,1280,2,8,33,1024,COLOR" ; : r1280x1024x60 " 105561000,63438,60,32,96,256,1280,3,4,25,1024,COLOR" ; : r1024x768x66 " 704000000,53658,66,4,124,160,1024,1,5,39,768,COLOR" ; \ ================================================================== \ Initialisation of video timing \ Override video timing parameters for given sensecode. \ stringaddr,stringlen define a text string giving the video timing. : override ( stringaddr stringlen sensecode -- ) \ If the sense-code matches the monitor currently connected, \ then set the resolution. Otherwise, just ignore it. sense-id-value = if set-resolution else 2drop then ; ; These are deferred...not totally sure why defer (confused? is value confused? ( Parameter field: a249e1a ) defer (set-fbconfiguration is set-fbconfiguration defer fbprom \ hobbes-prom sets this one ; These are deferred, but refer to lego-reset-screen, lego-draw-logo defer reset-screen defer draw-logo \ Constants only used in set-resolution: 1 constant /vmsize 0 constant dblbuf? \ Set the video timings according to the given parameter string. : set-resolution ( parmstring, parmstringlen -- ) lego-init-hc \ reset the FHC and THC (set-fbconfiguration \ set config as per parametrs (confused? if \ If those were broken, fall back on defaults sense-code (set-fbconfiguration \ for this monitor sense ID then \ If this isn't being done as part of a reset-screen operation, \ set some attributes my-reset 0 = if \ width, linebytes and awidth all equal to lego-rez-width on this fb. lego-rez-width dup dup xdrint " width" attribute xdrint " linebytes" attribute xdrint " awidth" attribute lego-rez-height xdrint " height" attribute \ These are actually all constant for this fb. 8 xdrint " depth" attribute /vmsize xdrint " vmsize" attribute dblbuf? xdrint " dblbuf" attribute then ; \ Initialise THC and FHC : lego-init-hc ?fhc-thc-map 8000 0 fhc! \ write FHC_RESET to FHC... 3bb 0 fhc! \ write initial FHC setup \ I think this is avoiding bugs in revisions earlier than 5. The \ bit we're setting in the FHC is FHC_DST_DISABLE. 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! \ Turn off cursor by writing magic number to THC cursxy register lego-sync-reset \ Reset THC (only resets sync?) lego-sync-on \ ..and and turn on sync ?fhc-thc-unmap ; \ Clear bit 0x800 in THC reg 94 (not sure what this does...) : disable-disables 94 thc@ 800 not and 94 thc! ; \ Set bit 0x800 in THC reg 94 : enable-disables 94 thc@ 800 or 94 thc! ; \ Delay 100 microseconds : delay-100 1 ms ; \ Set THC_MISC_RESET bit in the thc_misc register (818) : lego-sync-reset 818 thc@ 1000 or 818 thc! delay-100 ; \ clear THC_MISC_SYNC_ENAB : lego-sync-off 818 thc@ ffffff7f and 818 thc! ; \ set THC_MISC_SYNC_ENAB : lego-sync-on 818 thc@ 80 or 818 thc! ; \ clear THC_MISC_VIDEO, set THC_MISC_RESET : lego-video-off 818 thc@ fffffbff and 1000 or 818 thc! ; \ We seem to have mislaid lego-video-on but I don't suppose it's very exciting... \ Set video timing as per the given config string : set-fbconfiguration ( parmstring parmstringlen -- ) \ Save string, so we can use it to reset the timings in lego-reset-screen update-string parse-line \ work out what it's on about ( osc hfrq vfrq hfporch hsyncw hbporch hdisp vfporch vsyncw vbporch vdisp flags ) \ Recalculate timings (needs FHC/THC to be mapped) ?fhc-thc-map cal-tim ?fhc-thc-unmap ; \ Address where we can save a copy of a string temporarily ffefb168 constant tmp-monitor-string value tmp-monitor-len \ length of tmp-monitor-string ( Parameter field: a289e26 ) \ Return current value of tmp-monitor-string in standard ( adr len ) format : monitor-string ( -- adr len ) tmp-monitor-string tmp-monitor-len ; \ Save string and length in tmp-monitor-string, tmp-monitor-len : update-string ( parmstring parmstringlen -- parmstring parmstringlen ) 2dup tmp-monitor-string swap ( parmstring parmstringlen parmstring tmp-monitor-string parmstringlen ) move \ copy string into tmp-monitor-string dup (is) tmp-monitor-len \ and save length of string ; 8 constant bdrev \ only used in cal-tim value cal-tmp \ used in cal-tim and fbc-res ( Parameter field: a1c9e12 ) \\ Set THC registers according to required video timing \\ Also sets a bunch of attributes : cal-tim ( osc hfrq vfrq hfporch hsyncw hbporch hdisp vfporch vsyncw vbporch vdisp flags -- ) (is) cal-tmp \ save flags word vert ( osc hfrq vfrq hfporch hbporch hsyncw hdisp ) horz ( osc hfrq vfrq ) \ Our only care for the hfrq/vfrq is to set the attributes! xdrint " vfreq" my-attribute xdrint " hfreq" my-attribute dup xdrint " pixfreq" my-attribute ( osc ) dup mainosc? \ Set up the oscillator, assuming we recognise it cycles-per-tran ( cycs-per-tran ) \ Set lower 4 bits in THC_MISC register to cycles-per-tran 818 thc@ fffffff0 and or 818 thc! \ Set FHC h.width bits and handle 0OFFSET flag. fbc-res \ Just set boardrev, montype and emulation attributes bdrev xdrint " boardrev" my-attribute cal-tmp xdrint " montype" my-attribute acceleration if " cgsix" else " cgthree+" then xdrstring " emulation" my-attribute ; \ Set the vertical timing registers and the attributes "vfporch", "vbporch" and "vsync", \ also the variable lego-rez-height. : vert ( vfporch vsyncw vbporch vdisp -- ) (is) lego-rez-height rot dup ( vsyncw vbporch vfporch vfporch ) xdrint " vfporch" my-attribute \ Store (vfporch-1) to THC reg C0 1 - dup c0 thc! ( vsyncw vbporch vfporch-1 ) rot dup ( vbporch vfporch-1 vsyncw vsyncw ) xdrint " vsync" my-attribute \ Store (vsyncw+vfporch-1) to THC reg C4 + dup c4 thc! ( vbporch vsyncw+vfporch-1 ) swap dup xdrint " vbporch" my-attribute ( vsyncw+vfporch-1 vbporch ) \ Store vsyncw+vfporch+vbporch-1 to THC reg C8 + dup c8 thc! ( vsyncw+vfporch+vbporch-1 ) \ Store (vsyncw+vfporch+vbporch+vdisp-1) to THC reg CC lego-rez-height + cc thc! ; \ Set the horizontal timing regs, also attributes "hfporch", "hbporch", "hysnc" and \ the lego-rez-width variable. : horz ( hfporch hsyncw hbporch hdisp -- ) (is) lego-rez-width rot dup xdrint " hfporch" my-attribute ( hsyncw hbporch hfporch ) dup ppc / 1 - dup 1 + ( hsyncw hbporch hfporch (hfporch/ppc - 1) (hfporch/ppc) ) \ Store (hfporch/ppc) to THC reg A0 a0 thc! 3 pick dup xdrint " hsync" my-attribute ( hsyncw hbporch hfporch (hfporch/ppc - 1) hsyncw ) ppc / + ( hsyncw hbporch hfporch ((hfporch+hsyncw)/ppc - 1) ) \ Store (hfporch+hsyncw)/ppc to THC reg A4 dup 1 + a4 thc! rot dup xdrint " hbporch" my-attribute ( hsyncw hfporch ((hfporch+hsyncw)/ppc - 1) hbporch ) ppc / + ( hsyncw hfporch ((hfporch+hsyncw+hbporch)/ppc - 1) ) \ Store ((hfporch+hsyncw+hbporch)/ppc - 1) to THC reg A8 dup a8 thc! lego-rez-width ppc / + ( hsyncw hfporch ((hfporch+hsyncw+hbporch+hwidth)/ppc - 1) ) \ Store ((hfporch+hsyncw+hbporch+hwidth)/ppc - 1) to THC reg B0 dup b0 thc! -rot - ( ((hfporch+hsyncw+hbporch+hwidth)/ppc - 1) (hsyncw - hfporch) ) ppc / - 1 + ( ((hfporch+hfporch+hbporch+hwidth)/ppc) ) \ Store (hfporch+hfporch+hbporch+hwidth)/ppc to THC reg AC ac thc! ; \ Set the FHC register according to the horz width, and take account of 0OFFSET flag. : fbc-res ( -- ) lego-rez-width 400 of ffffe3ff 0 fhc@ and 0 fhc! endof \ set CG6_FHC_1024 480 of ffffe3ff 0 fhc@ and 800 or 0 fhc! endof \ set CG6_FHC_1152 500 of ffffe3ff 0 fhc@ and 1000 or 0 fhc! endof \ set CG6_FHC_1280 640 of ffffe3ff 0 fhc@ and 1800 or 0 fhc! endof \ set CG6_FHC_1600 780 of ffffe3ff 0 fhc@ and 400 or 0 fhc! endof \ ??? 1920, I assume 0 (is) acceleration \ bizarre resolution, turn off acceleration endcase cal-tmp 4 and 0<> if \ If flags bit 4 is set (0OFFSET) then set appropriate bit in THC reg 0x94 94 thc@ 80 or 94 thc! else 94 thc@ 80 not and 94 thc! \ ...otherwise clear it then ; \ Given the dotclock, calculate cycles-per-tran, whatever that is : cycles-per-tran ( osc -- cyc-per-tran ) 1bb160 ppc * /mod swap ( quotient remainder ) 0<> if 1 + \ Round up if not an exact division then 4 - dup f > if drop f \ If greater than 0xF, limit it at that value then ; value osc-tmp \ only used in mainosc? ( Parameter field: a209e16 ) \ Set up oscillator, with sanity check that the dotclock is acceptable : mainosc? ( osc -- ) -1 (is) confused? \ assume bad dotclock until proven otherwise 3e8 / (is) osc-tmp \ Check all known oscillators oscillators 0 do 3e8 / osc-tmp = if i setup-oscillator \ acceptable oscillator, go for it 0 (is) confused? \ we're OK with this config then loop ; \ List of oscillators we are happy with, plus length of list : oscillators ( -- osc osc .. osc #oscs ) b3d51c0 4323800 58a28d4 64abba8 6f94740 80befc0 d87bec0 7 ; \ How to set up for each oscillator. My guess is that any cgsix board actually \ has at most two oscillators, and we simply set a bit to say whether we are using \ the main oscillator or not. : setup-oscillator 0 of 94 thc@ 40 or 94 thc! endof 1 of 94 thc@ 40 or 94 thc! endof 2 of 94 thc@ 40 or 94 thc! endof 3 of 94 thc@ 40 or 94 thc! endof 4 of 94 thc@ 40 not and 94 thc! endof 5 of 94 thc@ 40 or 94 thc! endof 6 of 94 thc@ 40 or 94 thc! endof endcase ; \ Main oscillator for this particular cgsix, I presume. [we never actually use this] 58a28d4 constant mainosc \ Not sure what this is... \ see dpl ffef0a30 (ffe9fd8c) dpl value = ffffffff \ ...or this... value legosc-address ( Parameter field: 9ac9854 ) \ =================================================================== \ Parse a monitor setting string (parse-line and its subroutines) \ Parse a string specifying monitor timings. Format: \ "osc,hfrq,vfrq,hfporch,hsyncw,hbporch,hdisp,vfporch,vsyncw,vbporch,vdisp,flags" : parse-line ( str-adr str-len -- osc hfrq vfrq ... vdisp flagsword ) \ For each numeric parameter in the comma-separated string... b 0 do \ 0x2C is the 'comma' character... 2c left-parse-string ( right-adr right-len left-adr left-len ) \ Create a 'packed string' in fresh memory dup 1 + alloc-mem pack ( right-adr right-len left-as-packed-string ) dup number swap ( right-adr right-len left-as-number left-as-packed-string ) \ Free the packed string memory (uses fact that first byte in packed str is length) dup c@ 1 + free-mem -rot ( left-as-number right-adr right-len ) dup 0= if \ If we have no left part left, stop now (leave) \ (shouldn't happen unless parameter string is invalid) then loop ( osc hfrq ... vdisp right-adr right-len ) dup 0<> if \ If we have any string left, parse flags parse-flags else 2drop 0 \ Nope, drop adr/len and return a zero flags word then ; : parse-flags ( adr len -- flagsword ) 0 >r \ we keep flag word we're building up on the return stack begin \ Search for the comma 2c left-parse-string ( right-adr right-len left-adr left-len ) r> -rot ( radr rlen flags ladr llen ) parse-string >r \ Put flags word back on return stack \ Keep going until remainder-length is zero (no more string) dup 0= until 2drop r> \ Lose the adr and len, and return flagsword ; \ Used only by parse-string... value tmp-flag ( Parameter field: 9d898a4 ) value tmp-addr ( Parameter field: 9d498a0 ) value tmp-len ( Parameter field: 9d0989c ) \ Parse a string consisting of a single flag specifier, and update the flags word. : parse-string ( flags adr len -- newflags ) \ Store all our arguments in temporary variables (this isn't very forth-like :->) (is) tmp-len (is) tmp-addr (is) tmp-flag \ For each known flag word flag-strings 0 do tmp-addr tmp-len 2swap compare-strings if \ Match: add (1 << i) to the flags word 1 i << tmp-flag + (is) tmp-flag then loop tmp-flag \ Return new flags value ; \ List of possible flags and the number of flags in the list : flag-strings " STEREO" " 0OFFSET" " OVERSCAN" " GRAY" 4 ; \ Compare two strings and return a true value if they match (case-sensitive) : compare-strings ( adr1 len1 adr2 len2 -- match) rot tuck ( adr1 adr2 len1 len2 len1 ) < if \ If lengths differ, can't be a match drop 2drop 0 \ so return false else \ Have to use 'comp' builtin word to check both strings ( adr1 adr2 len ) comp 0= \ if comp returns 0, we have a match then ; \ Parse a string from the left looking for the given character. \ Returns the strings which were to left and right of the delimiter. \ [this is actually a builtin for Fcode V2, but we hand-code it so \ we work with ancient OpenBoot ROMs.] : left-parse-string ( str-adr str-len char -- right-adr right-len left-adr left-len ) >r \ save delimiter char onto the return stack over 0 2swap ( adr 0 adr len ) \ The stack currently defines two strings, the left-part and the right-part. \ We run along the string adjusting both these adr,len pairs as we go. begin dup while \ Loop until no chars left to process \ Read next char, compare with delimiter over c@ ( startadr 0 curadr charsleft thischar ) r@ = if r> drop \ clean delimiter off the return stack -string \ right-part should not include the delimiter character 2swap \ put in right order for return... exit \ All done, exit then \ Move the left-part right-part boundary along one 2swap +string 2swap \ Enlarge the left-part -string \ and reduce the right-part repeat \ Hit end of string without finding anything (will return an empty right-part) 2swap \ put in right order for return r> drop \ Clean delimiter off return stack ; \ Move right along a string by incrementing the address and decrementing the length : -string ( adr len -- adr len ) swap 1 + swap 1 - ; \ Increment length of a string : +string ( adr len -- adr len ) 1 + ; \\ Number parsing routines... haven't bothered to figure these out yet... \ Take a packed string and convert it to an integer : number ( packed-string -- integer ) number? drop ; : number? >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 + = ; : convert begin 1 + dup >r c@ a digit while >r a * r> + long? if 1 dpl +! then r> repeat drop r> ; : long? dpl @ 1 + 0<> ; \ ==================================================================== \\ The routines /string, cindex, left-parse-string', right-parse-string and upper \\ are not used! Looks like somebody just did "#include " :-> : /string over min >r swap r@ + swap r> - ; : cindex 0 swap 2swap bounds ?do dup i c@ = if nip i -1 rot (leave) then loop drop ; : left-parse-string' left-parse-string 2 pick 0= if 2swap then ; : right-parse-string >r 2dup + 0 begin 2 pick while over 1 - c@ r@ = if r> drop rot 1 - -rot exit then 2swap 1 - 2swap swap 1 - swap 1 + repeat r> drop ; : upper bounds ?do i dup c@ upc swap c! loop ; \ =========================================================== \ Logo-drawing routines... \ Draw the logo : lego-draw-logo ( lineno logoaddr logowidth logoheight -- ) 2 pick 92 + logo@ \ read magic number from logoaddr + 92 bfdfdfe7 <> if fb8-draw-logo \ bad magic, hand off to generic routine (??) else \ We can handle this ourselves dac-map \ Set the palette with RGB values stored in the 0x300 bytes \ commencing at logo-data+4. 100 3 * logo-data 4 + color dac-unmap \ This bit is fairly obviously pulling size and so on from the \ logo-data and then calling move-image-to-fb to just blat the \ graphics onto the framebuffer. drop 2drop ( lineno ) logo-data 2 + c@ logo-data 3 + c@ rot \ Source addr is logo-data + 0x304 logo-data 100 3 * + 4 + swap ( ? ? srcaddr lineno ) \ Convert lineno to destination address char-height * window-top + lego-rez-width * window-left + frame-buffer-adr + move-image-to-fb then ; : move-image-to-fb ( width height srcaddr destaddr -- ) rot 0 do \ for each line in the logo... ( width src dest ) cg6-move-line \ move height bytes from srcaddr to destaddr lego-rez-width + \ add the screen width to destaddr swap 2 pick + swap \ and add the width to srcaddr loop drop 2drop \ clear up the stack ; \ Copy a single line (as a simple memory-to-memory copy). Doesn't alter stack. : cg6-move-line ( bytecount srcaddr destaddr -- bytecount srcaddr destaddr ) 2 pick 2 pick 2 pick rot ( bytecount srcaddr destaddr srcaddr destaddr bytecount ) move ; \ Read 4 bytes from addr..addr+3 and form an integer \ from them (byte from addr is msbyte). Only used by lego-draw-logo. : logo@ ( addr -- word ) 0 swap ( z x ) \ z == 0 initially 4 0 do dup c@ rot ( x y z ) \ y = byte at x 8 << + ( x y+(z<<8) ) swap 1 + ( y+(z<<8) x+1) loop drop ; \ The logo is stored in the main PROM immediately after the Fcode program. \ This routine just returns its starting address. : logo-data ( -- logo-data-address ) hobbes-prom length@ + ( end-of-prom ) \ Round up to a word boundary, by incrementing until (addr & 3) == 0 begin dup 3 and while 1 + repeat ; \ Get the PROM address, by asking OpenBoot about it. : hobbes-prom " fb-prom" $find drop (is) fbprom fbprom ; \ Pull the fcode length out of the PROM 4 constant lengthloc \ only used in length@ : length@ hobbes-prom lengthloc + l@ ; \ ================================================================ \ Routines we have to provide \ Not sure what this is about... \ see remove : (ffeb26f8) " remove" $call-self ; \ see write : (ffeb2724) tuck ansi-type ; \ see open : (ffeb2708) " install" $call-self 0 old-code ! install-terminal-emulator true ; \ Remove the driver; very easy. Just turn off video and unmap everything. : lego-remove fbc-unmap lego-video-off fhc-thc-unmap fb-unmap ; \ Very simple, just turn off the video for 20ms... : lego-blink-screen lego-video-off 20 ms lego-video-on ; \ Routines we always use the generic code for : lego-delete-characters fbc-busy-wait fb8-delete-characters ; : lego-insert-characters fbc-busy-wait fb8-insert-characters ; : lego-invert-screen fbc-busy-wait fb8-invert-screen ; : lego-toggle-cursor fbc-busy-wait fb8-toggle-cursor ; : lego-draw-char fbc-busy-wait fb8-draw-character ; \ Dumb frame buffer routines. Wait for FBC to be ready and use the generic routines. : dfb-erase-screen fbc-busy-wait fb8-erase-screen ; : dfb-insert-lines fbc-busy-wait fb8-insert-lines ; : dfb-delete-lines fbc-busy-wait fb8-delete-lines ; \ Accelerated cgsix routines... All these have to have bracketing \ cg6-save/cg6-restore calls. [Is this related to the window system \ trashing them, as mentioned in the Fcode/sample cgsix driver docs?] \ This puts lots of stuff on the Forth stack, so you have to save all \ parameters somewhere before the cg6-save... \ Clear the screen with an accelerated rectangle fill. : lego-erase-screen ( -- ) cg6-save 0 0 screen-width screen-height background-color rect-fill cg6-restore ; \ Insert lines blank lines just before current line. Lower lines are scrolled. : lego-insert-lines ( lines -- ) dup #lines < if \ Adding less lines than number of lines on screen tmp-blit ! \ Save number of lines in tmp-blit cg6-save tmp-blit @ >r \ Retrieve number of lines, and stash it on the return-stack. \ Blit the right area of the screen to move the scrolled lines down. 0 line# #columns #lines r@ - ( 0 line# #columns (#lines-lines) ) 0 line# r@ + #columns #lines ( 0 line# #columns (#lines-lines) 0 (#line+lines) #columns #lines ) lego-blit \ Now clear the necessary section of the screen 0 line# #columns line# r> + ( 0 line# #columns (lines+line#) ) char-fill cg6-restore else \ Need only clear the necessary part of the screen tmp-blit ! cg6-save tmp-blit @ 0 swap ( 0 lines ) line# swap #columns swap ( 0 line# #columns lines ) line# swap + ( 0 line# #columns (lines+line#) ) char-fill cg6-restore then ; \ Similar stuff for delete lines : lego-delete-lines ( lines -- ) dup #lines < if tmp-blit ! cg6-save tmp-blit @ >r 0 line# r@ + #columns #lines 0 line# #columns #lines r@ - \ If (line# + lines) >= #lines we're actually deleting to end of screen, \ so need not blit. Couldn't we have done this test earlier?? line# r@ + #lines < if lego-blit else 2drop 2drop 2drop 2drop then 0 #lines r> - #columns #lines char-fill cg6-restore else \ Need only clear a section of screen tmp-blit ! cg6-save tmp-blit @ 0 swap #lines swap - #columns #lines char-fill cg6-restore then ; \ Blit a region of the screen. Takes 8 params, not sure what they are exactly... \ They'll be four (col,row) pairs specifying the blit region, though. : lego-blit fbc-busy-wait \ Convert each col,row pair to x,y pixel coords and write to the FBC registers >pixel 1 - b4 fbc! 1 - b0 fbc! >pixel a4 fbc! a0 fbc! >pixel 1 - 94 fbc! 1 - 90 fbc! >pixel 84 fbc! 80 fbc! \ Wait for it to finish... fbc-blit-wait fbc-busy-wait ; \ tmp-blit is a variable used by the accelerated routines... ffef0a2c (ffe9fd8c) tmp-blit value = 0 \ Save the cgsix's state onto the Forth stack, for later use by cg6-restore : cg6-save ( -- lots-o-stuff ) 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 ; \ Restore everything saved by cg6-save. : cg6-restore ( lots-o-stuff -- ) 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! ; \ Initialise cgsix for doing blits... : init-blit-reg 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! lego-rez-width 1 - f0 fbc! lego-rez-height 1 - f4 fbc! \ Set the CG6_FHC_1024/1152/1280/1600 bits to tell FHC what the width is. \ fbc-res does this too; it would have been cleaner to use a common routine. lego-rez-width 400 of ffffe3ff 0 fhc@ and 0 fh c! 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 ; \ Fill an area specified in character positions to the background colour : char-fill ( col1 row1 col2 row2 ) 2swap >pixel 2swap >pixel ( x1 y1 x2 y2 ) background-color rect-fill ; \ Convert a character row/col into an x,y pixel position \ x == col * char-width + window-left, y == row * char-height + window-top. : >pixel ( col row -- x y ) swap char-width * window-left + swap ( x row ) char-height * window-top + ( x y ) ; : rect-fill ( x1 y1 x2 y2 colour ) fbc-busy-wait 100 fbc! \ write colour to FBC 2swap 904 fbc! 900 fbc! 904 fbc! 900 fbc! \ write coords in correct order fbc-draw-wait \ await completion fbc-busy-wait ff 100 fbc! \ return to default foreground colour ; \ Return the background colour (white, or black if inverse-screen? set) : background-color ( -- colour ) inverse-screen? if ff else 0 then ; \ Busy wait until relevant bit of FBC blit register is set : fbc-blit-wait begin 18 fbc@ 20000000 and 0= until ; \ Ditto, for FBC draw register : fbc-draw-wait begin 14 fbc@ 20000000 and 0= until ; \ Ditto, for FBC s (status?) register : fbc-busy-wait begin 10 fbc@ 10000000 and 0= until ; \ End of Listing \ ==================================================