Return to pci-device_1002_515e.fs CVS log

Up to [Qemu by Fabrice Bellard] / qemu / roms / SLOF / board-js2x / slof

Annotation of qemu/roms/SLOF/board-js2x/slof/pci-device_1002_515e.fs, revision 1.1

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

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.