Root/
| Source at commit 1406 created 12 years 10 months ago. By meklort, Revert drivers.c so that kexts are only loaded when OSBundleRequired is set and that value is not safe mode. Added some comments about it too. | |
|---|---|
| 1 | /*␊ |
| 2 | * Copyright (c) 2000 Apple Computer, Inc. All rights reserved.␊ |
| 3 | *␊ |
| 4 | * @APPLE_LICENSE_HEADER_START@␊ |
| 5 | * ␊ |
| 6 | * The contents of this file constitute Original Code as defined in and␊ |
| 7 | * are subject to the Apple Public Source License Version 1.1 (the␊ |
| 8 | * "License"). You may not use this file except in compliance with the␊ |
| 9 | * License. Please obtain a copy of the License at␊ |
| 10 | * http://www.apple.com/publicsource and read it before using this file.␊ |
| 11 | * ␊ |
| 12 | * This Original Code and all software distributed under the License are␊ |
| 13 | * distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, EITHER␊ |
| 14 | * EXPRESS OR IMPLIED, AND APPLE HEREBY DISCLAIMS ALL SUCH WARRANTIES,␊ |
| 15 | * INCLUDING WITHOUT LIMITATION, ANY WARRANTIES OF MERCHANTABILITY,␊ |
| 16 | * FITNESS FOR A PARTICULAR PURPOSE OR NON-INFRINGEMENT. Please see the␊ |
| 17 | * License for the specific language governing rights and limitations␊ |
| 18 | * under the License.␊ |
| 19 | * ␊ |
| 20 | * @APPLE_LICENSE_HEADER_END@␊ |
| 21 | */␊ |
| 22 | /*␊ |
| 23 | * Control2.c - OF replacement driver for Control.␊ |
| 24 | *␊ |
| 25 | * Copyright (c) 1998-2000 Apple Computer, Inc.␊ |
| 26 | *␊ |
| 27 | * DRI: Josh de Cesare␊ |
| 28 | */␊ |
| 29 | ␊ |
| 30 | const char *gControl2Source[] = {␊ |
| 31 | ␉"\" /chaos/control\" find-device "␊ |
| 32 | ␉"-1 value bankB? "␊ |
| 33 | ␉"-1 value REGS "␊ |
| 34 | ␉"-1 value FB-ADDRESS "␊ |
| 35 | ␉"-1 value phys-regs "␊ |
| 36 | ␉"-1 value phys-fb-address "␊ |
| 37 | ␉"0 value mono-mode? "␊ |
| 38 | ␉"0 value width "␊ |
| 39 | ␉"0 value height "␊ |
| 40 | ␉"0 value sense-code "␊ |
| 41 | ␉"0 value ext-sense "␊ |
| 42 | ␉"h# F301B000 constant RADACAL "␊ |
| 43 | ␉"h# F301B000 constant RADACAL-base "␊ |
| 44 | ␉"variable RGB-temp "␊ |
| 45 | ␉"struct "␊ |
| 46 | ␉"( 000 )␉d# 16␉field␉>C.CUR-LINE "␊ |
| 47 | ␉"( 010 )␉d# 16␉field␉>C.VFPEQ "␊ |
| 48 | ␉"( 020 )␉d# 16␉field␉>C.VFP "␊ |
| 49 | ␉"( 030 )␉d# 16␉field␉>C.VAL "␊ |
| 50 | ␉"( 040 )␉d# 16␉field␉>C.VBP "␊ |
| 51 | ␉"( 050 )␉d# 16␉field␉>C.VBPEQ "␊ |
| 52 | ␉"( 060 )␉d# 16␉field␉>C.VSYNC "␊ |
| 53 | ␉"( 070 )␉d# 16␉field␉>C.VHLINE "␊ |
| 54 | ␉"( 080 )␉d# 16␉field␉>C.PIPED "␊ |
| 55 | ␉"( 090 )␉d# 16␉field␉>C.HPIX "␊ |
| 56 | ␉"( 0A0 )␉d# 16␉field␉>C.HFP "␊ |
| 57 | ␉"( 0B0 )␉d# 16␉field␉>C.HAL "␊ |
| 58 | ␉"( 0C0 )␉d# 16␉field␉>C.HBWAY "␊ |
| 59 | ␉"( 0D0 )␉d# 16␉field␉>C.HSP "␊ |
| 60 | ␉"( 0E0 )␉d# 16␉field␉>C.HEQ "␊ |
| 61 | ␉"( 0F0 )␉d# 16␉field␉>C.HLFLN "␊ |
| 62 | ␉"( 100 )␉d# 16␉field␉>C.HSERR "␊ |
| 63 | ␉"( 110 )␉d# 16␉field␉>C.CNTTST "␊ |
| 64 | ␉"( 120 )␉d# 16␉field␉>C.TEST "␊ |
| 65 | ␉"( 130 )␉d# 16␉field␉>C.GBASE "␊ |
| 66 | ␉"( 140 )␉d# 16␉field␉>C.ROW-WORDS "␊ |
| 67 | ␉"( 150 )␉d# 16␉field␉>C.MON-SENSE "␊ |
| 68 | ␉"( 160 )␉d# 16␉field␉>C.ENABLE "␊ |
| 69 | ␉"( 170 )␉d# 16␉field␉>C.GSC-DIVIDE "␊ |
| 70 | ␉"( 180 )␉d# 16␉field␉>C.REFRESH-COUNT "␊ |
| 71 | ␉"( 190 )␉d# 16␉field␉>C.INT-ENABLE "␊ |
| 72 | ␉"( 1A0 )␉d# 16␉field␉>C.INT-STATUS "␊ |
| 73 | ␉"drop "␊ |
| 74 | ␉"struct "␊ |
| 75 | ␉"d# 16␉field␉>R.REG-ADDR "␊ |
| 76 | ␉"d# 16␉field␉>R.CRSR-PALETTE "␊ |
| 77 | ␉"d# 16␉field␉>R.REG-DATA "␊ |
| 78 | ␉"d# 16␉field␉>R.COLOR-PALETTE "␊ |
| 79 | ␉"drop "␊ |
| 80 | ␉"create k512x384@60 "␊ |
| 81 | ␉"h# 0E1B6210 L, "␊ |
| 82 | ␉"d# 811 w, d# 810 w, d# 42 w, d# 23 w, d# 4 w, d# 812 w, d# 814 w, d# 48 w, "␊ |
| 83 | ␉"d# 318 w, d# 305 w, d# 49 w, d# 15 w, d# 319 w, d# 8 w, d# 160 w, d# 304 w, "␊ |
| 84 | ␉"d# 2 w, d# 512 w, d# 384 w, "␊ |
| 85 | ␉"create k640x480@67 "␊ |
| 86 | ␉"h# 0E1B0210 L, "␊ |
| 87 | ␉"d# 1045 w, d# 1042 w, d# 82 w, d# 43 w, d# 4 w, d# 1048 w, d# 1050 w, d# 72 w, "␊ |
| 88 | ␉"d# 430 w, d# 393 w, d# 73 w, d# 31 w, d# 431 w, d# 16 w, d# 216 w, d# 400 w, "␊ |
| 89 | ␉"d# 2 w, d# 640 w, d# 480 w, "␊ |
| 90 | ␉"create k640x870@75 "␊ |
| 91 | ␉"h# 172A0310 L, "␊ |
| 92 | ␉"d# 1831 w, d# 1828 w, d# 88 w, d# 46 w, d# 4 w, d# 1834 w, d# 1836 w, d# 72 w, "␊ |
| 93 | ␉"d# 414 w, d# 393 w, d# 73 w, d# 39 w, d# 415 w, d# 20 w, d# 208 w, d# 376 w, "␊ |
| 94 | ␉"d# 2 w, d# 640 w, d# 870 w, "␊ |
| 95 | ␉"create k640x480@60VGA "␊ |
| 96 | ␉"h# 17250210 L, "␊ |
| 97 | ␉"d# 1037 w, d# 1026 w, d# 66 w, d# 34 w, d# 2 w, d# 1048 w, d# 1050 w, d# 64 w, "␊ |
| 98 | ␉"d# 398 w, d# 385 w, d# 65 w, d# 47 w, d# 399 w, d# 24 w, d# 200 w, d# 352 w, "␊ |
| 99 | ␉"d# 2 w, d# 640 w, d# 480 w, "␊ |
| 100 | ␉"create k832x624@75 "␊ |
| 101 | ␉"h# 172A0310 L, "␊ |
| 102 | ␉"d# 1331 w, d# 1330 w, d# 82 w, d# 43 w, d# 4 w, d# 1332 w, d# 1334 w, d# 136 w, "␊ |
| 103 | ␉"d# 574 w, d# 553 w, d# 137 w, d# 31 w, d# 575 w, d# 16 w, d# 288 w, d# 544 w, "␊ |
| 104 | ␉"d# 2 w, d# 832 w, d# 624 w, "␊ |
| 105 | ␉"create k1024x768@75 "␊ |
| 106 | ␉"h# 0B1C0310 L, "␊ |
| 107 | ␉"d# 1603 w, d# 1600 w, d# 64 w, d# 34 w, d# 4 w, d# 1606 w, d# 1608 w, d# 128 w, "␊ |
| 108 | ␉"d# 662 w, d# 641 w, d# 129 w, d# 47 w, d# 663 w, d# 24 w, d# 332 w, d# 616 w, "␊ |
| 109 | ␉"d# 2 w, d# 1024 w, d# 768 w, "␊ |
| 110 | ␉"create k1152x870@75 "␊ |
| 111 | ␉"h# 133D0310 L, "␊ |
| 112 | ␉"d# 1825 w, d# 1822 w, d# 82 w, d# 43 w, d# 4 w, d# 1828 w, d# 1830 w, d# 128 w, "␊ |
| 113 | ␉"d# 726 w, d# 705 w, d# 129 w, d# 63 w, d# 727 w, d# 32 w, d# 364 w, d# 664 w, "␊ |
| 114 | ␉"d# 2 w, d# 1152 w, d# 870 w, "␊ |
| 115 | ␉": SENSE! 5 ms regs >C.MON-SENSE rl! 5 ms ; "␊ |
| 116 | ␉": SENSE@ 5 ms regs >C.MON-SENSE rl@ 5 ms ; "␊ |
| 117 | ␉": MON-SENSE␉( -- ) "␊ |
| 118 | ␉"o# 70 sense! "␊ |
| 119 | ␉"sense@ 6 >> 7 and dup to sense-code "␊ |
| 120 | ␉"dup 6 < if "␊ |
| 121 | ␉"b# 1000000 or "␊ |
| 122 | ␉"else drop "␊ |
| 123 | ␉"o# 30 sense! "␊ |
| 124 | ␉"sense@ 2 >> b# 110000 and "␊ |
| 125 | ␉"o# 50 sense! "␊ |
| 126 | ␉"sense@ dup 4 >> b# 000100 and swap 5 >> b# 001000 and or or "␊ |
| 127 | ␉"o# 60 sense! sense@ 7 >> b# 000011 and or "␊ |
| 128 | ␉"to ext-sense "␊ |
| 129 | ␉"then "␊ |
| 130 | ␉"o# 70 sense! "␊ |
| 131 | ␉"; "␊ |
| 132 | ␉": get-mode ( -- mode-table mono-mode? ) "␊ |
| 133 | ␉"sense-code case "␊ |
| 134 | ␉"0 of "␊ |
| 135 | ␉"false "␊ |
| 136 | ␉"k1152x870@75 "␊ |
| 137 | ␉"endof "␊ |
| 138 | ␉"1 of "␊ |
| 139 | ␉"true "␊ |
| 140 | ␉"k640x870@75 "␊ |
| 141 | ␉"endof "␊ |
| 142 | ␉"2 of "␊ |
| 143 | ␉"false "␊ |
| 144 | ␉"k512x384@60 "␊ |
| 145 | ␉"endof "␊ |
| 146 | ␉"3 of "␊ |
| 147 | ␉"true "␊ |
| 148 | ␉"k1152x870@75 "␊ |
| 149 | ␉"endof "␊ |
| 150 | ␉"5 of "␊ |
| 151 | ␉"false "␊ |
| 152 | ␉"k640x870@75 "␊ |
| 153 | ␉"endof "␊ |
| 154 | ␉"6 of "␊ |
| 155 | ␉"ext-sense case "␊ |
| 156 | ␉"3 of "␊ |
| 157 | ␉"false "␊ |
| 158 | ␉"k832x624@75 "␊ |
| 159 | ␉"endof "␊ |
| 160 | ␉"h# 0b of "␊ |
| 161 | ␉"false "␊ |
| 162 | ␉"k1024x768@75 "␊ |
| 163 | ␉"endof "␊ |
| 164 | ␉"h# 23 of "␊ |
| 165 | ␉"false "␊ |
| 166 | ␉"k1152x870@75 "␊ |
| 167 | ␉"endof "␊ |
| 168 | ␉"drop "␊ |
| 169 | ␉"false "␊ |
| 170 | ␉"k640x480@67 "␊ |
| 171 | ␉"0 endcase "␊ |
| 172 | ␉"endof "␊ |
| 173 | ␉"7 of "␊ |
| 174 | ␉"ext-sense case "␊ |
| 175 | ␉"h# 2d of "␊ |
| 176 | ␉"false "␊ |
| 177 | ␉"k832x624@75 "␊ |
| 178 | ␉"endof "␊ |
| 179 | ␉"h# 3a of "␊ |
| 180 | ␉"false "␊ |
| 181 | ␉"k1024x768@75 "␊ |
| 182 | ␉"endof "␊ |
| 183 | ␉"h# 17 of "␊ |
| 184 | ␉"false "␊ |
| 185 | ␉"k640x480@60VGA "␊ |
| 186 | ␉"endof "␊ |
| 187 | ␉"h# 3f of "␊ |
| 188 | ␉"false "␊ |
| 189 | ␉"0 "␊ |
| 190 | ␉"endof "␊ |
| 191 | ␉"drop "␊ |
| 192 | ␉"false "␊ |
| 193 | ␉"k640x480@67 "␊ |
| 194 | ␉"0 endcase "␊ |
| 195 | ␉"endof "␊ |
| 196 | ␉"drop "␊ |
| 197 | ␉"false "␊ |
| 198 | ␉"k640x480@67 "␊ |
| 199 | ␉"0 endcase "␊ |
| 200 | ␉"; "␊ |
| 201 | ␉"HEADERLESS "␊ |
| 202 | ␉"create std-16 "␊ |
| 203 | ␉"\" \"(000000 0000AA 00AA00 00AAAA AA0000 AA00AA AA5500 AAAAAA)\" $c, "␊ |
| 204 | ␉"\" \"(555555 5555FF 55FF55 55FFFF FF5555 FF55FF FFFF55 FFFFFF)\" $c, "␊ |
| 205 | ␉"create std-gamma "␊ |
| 206 | ␉"\" \"(00 05 09 0B 0E 10 13 15 17 19 1B 1D 1E 20 22 24)\" $c, "␊ |
| 207 | ␉"\" \"(25 27 28 2A 2C 2D 2F 30 31 33 34 36 37 38 3A 3B)\" $c, "␊ |
| 208 | ␉"\" \"(3C 3E 3F 40 42 43 44 45 47 48 49 4A 4B 4D 4E 4F)\" $c, "␊ |
| 209 | ␉"\" \"(50 51 52 54 55 56 57 58 59 5A 5B 5C 5E 5F 60 61)\" $c, "␊ |
| 210 | ␉"\" \"(62 63 64 65 66 67 68 69 6A 6B 6C 6D 6E 6F 70 71)\" $c, "␊ |
| 211 | ␉"\" \"(72 73 74 75 76 77 78 79 7A 7B 7C 7D 7E 7F 80 81)\" $c, "␊ |
| 212 | ␉"\" \"(81 82 83 84 85 86 87 88 89 8A 8B 8C 8C 8D 8E 8F)\" $c, "␊ |
| 213 | ␉"\" \"(90 91 92 93 94 95 95 96 97 98 99 9A 9B 9B 9C 9D)\" $c, "␊ |
| 214 | ␉"\" \"(9E 9F A0 A1 A1 A2 A3 A4 A5 A6 A6 A7 A8 A9 AA AB)\" $c, "␊ |
| 215 | ␉"\" \"(AB AC AD AE AF B0 B0 B1 B2 B3 B4 B4 B5 B6 B7 B8)\" $c, "␊ |
| 216 | ␉"\" \"(B8 B9 BA BB BC BC BD BE BF C0 C0 C1 C2 C3 C3 C4)\" $c, "␊ |
| 217 | ␉"\" \"(C5 C6 C7 C7 C8 C9 CA CA CB CC CD CD CE CF D0 D0)\" $c, "␊ |
| 218 | ␉"\" \"(D1 D2 D3 D3 D4 D5 D6 D6 D7 D8 D9 D9 DA DB DC DC)\" $c, "␊ |
| 219 | ␉"\" \"(DD DE DF DF E0 E1 E1 E2 E3 E4 E4 E5 E6 E7 E7 E8)\" $c, "␊ |
| 220 | ␉"\" \"(E9 E9 EA EB EC EC ED EE EE EF F0 F1 F1 F2 F3 F3)\" $c, "␊ |
| 221 | ␉"\" \"(F4 F5 F5 F6 F7 F8 F8 F9 FA FA FB FC FC FD FE FF)\" $c, "␊ |
| 222 | ␉": c+␉␉( adr -- adr+1 val ) "␊ |
| 223 | ␉"dup 1+ swap c@ "␊ |
| 224 | ␉"; "␊ |
| 225 | ␉": c!+␉␉( adr val -- adr+1 ) "␊ |
| 226 | ␉"swap dup 1+ -rot c! "␊ |
| 227 | ␉"; "␊ |
| 228 | ␉": do-gamma "␊ |
| 229 | ␉"std-gamma + c@ "␊ |
| 230 | ␉"; "␊ |
| 231 | ␉": anti-gamma␉( val -- orig ) "␊ |
| 232 | ␉"h# 100 0 do "␊ |
| 233 | ␉"std-gamma i + c@ over >= if "␊ |
| 234 | ␉"drop i unloop exit "␊ |
| 235 | ␉"then "␊ |
| 236 | ␉"loop "␊ |
| 237 | ␉"drop h# ff "␊ |
| 238 | ␉"; "␊ |
| 239 | ␉": W@++␉( addr -- addr word ) "␊ |
| 240 | ␉"dup 2+ swap w@ "␊ |
| 241 | ␉"; "␊ |
| 242 | ␉": CLUT@ ( -- ) "␊ |
| 243 | ␉"3 0 do RADACAL-base >R.COLOR-PALETTE rb@ loop 2 ms "␊ |
| 244 | ␉"; "␊ |
| 245 | ␉": CLUT!␉( -- ) "␊ |
| 246 | ␉"3 0 do RADACAL-base >R.COLOR-PALETTE rb! loop 2 ms "␊ |
| 247 | ␉"; "␊ |
| 248 | ␉": RAD-REG-ADDR! "␊ |
| 249 | ␉"RADACAL-base >R.REG-ADDR rb! 2 ms "␊ |
| 250 | ␉"; "␊ |
| 251 | ␉": RAD!␉( c a -- ) "␊ |
| 252 | ␉"( a ) rad-reg-addr! "␊ |
| 253 | ␉"( c ) ␉RADACAL-base >R.REG-DATA rb! 2 ms "␊ |
| 254 | ␉"; "␊ |
| 255 | ␉": init-RADACAL ( val -- ) "␊ |
| 256 | ␉"( val ) h# 20 rad! "␊ |
| 257 | ␉"bankb? 1 and h# 21 rad! "␊ |
| 258 | ␉"0␉h# 10 rad! "␊ |
| 259 | ␉"0␉h# 11 rad! "␊ |
| 260 | ␉"; "␊ |
| 261 | ␉"h# F3016000 constant vPortB "␊ |
| 262 | ␉"h# F3016400 constant vDDRB "␊ |
| 263 | ␉"h# F3017400 constant vSHR "␊ |
| 264 | ␉"h# F3017600 constant vACR "␊ |
| 265 | ␉"h# F3017800 constant vPCR "␊ |
| 266 | ␉"h# F3017A00 constant vIFR "␊ |
| 267 | ␉"h# F3017C00 constant vIER "␊ |
| 268 | ␉"h# 0C constant kSRModeIn "␊ |
| 269 | ␉"h# 1C constant kSRModeOut "␊ |
| 270 | ␉"h# 04 constant kSRIReq "␊ |
| 271 | ␉"h# 10 constant kByteAckBit "␊ |
| 272 | ␉"h# DF constant kAssertTIP "␊ |
| 273 | ␉"h# 20 constant kNegateTIP "␊ |
| 274 | ␉"h# EF constant kAssertByteAck "␊ |
| 275 | ␉"h# 10 constant kNegateByteAck "␊ |
| 276 | ␉"h# 30 constant kTIPByteAckNeg "␊ |
| 277 | ␉"h# 08 constant kTREQBit "␊ |
| 278 | ␉": setByteAck "␊ |
| 279 | ␉"vPortB rb@ swap if "␊ |
| 280 | ␉"kAssertByteAck and "␊ |
| 281 | ␉"else "␊ |
| 282 | ␉"kNegateByteAck or "␊ |
| 283 | ␉"then "␊ |
| 284 | ␉"vPortB rb! "␊ |
| 285 | ␉"; "␊ |
| 286 | ␉": ToggleByteAck "␊ |
| 287 | ␉"vPortB rb@ kByteAckBit and setByteAck "␊ |
| 288 | ␉"; "␊ |
| 289 | ␉": setTIP "␊ |
| 290 | ␉"vPortB rb@ swap if "␊ |
| 291 | ␉"kAssertTIP and "␊ |
| 292 | ␉"else "␊ |
| 293 | ␉"kTIPByteAckNeg or "␊ |
| 294 | ␉"then "␊ |
| 295 | ␉"vPortB rb! "␊ |
| 296 | ␉"; "␊ |
| 297 | ␉": ?TREQ␉vPortB rb@ kTREQbit and 0= ; "␊ |
| 298 | ␉": WaitTREQ "␊ |
| 299 | ␉"begin "␊ |
| 300 | ␉"?TREQ until "␊ |
| 301 | ␉"; "␊ |
| 302 | ␉": WaitVIAInt "␊ |
| 303 | ␉"begin "␊ |
| 304 | ␉"vIFR rb@ kSRIReq and until "␊ |
| 305 | ␉"; "␊ |
| 306 | ␉": WaitATTN "␊ |
| 307 | ␉"WaitVIAInt "␊ |
| 308 | ␉"vSHR rb@ drop "␊ |
| 309 | ␉"; "␊ |
| 310 | ␉": get-response␉( -- ) "␊ |
| 311 | ␉"WaitATTN "␊ |
| 312 | ␉"true setTIP "␊ |
| 313 | ␉"begin "␊ |
| 314 | ␉"WaitATTN "␊ |
| 315 | ␉"?TREQ while "␊ |
| 316 | ␉"ToggleByteAck "␊ |
| 317 | ␉"repeat "␊ |
| 318 | ␉"false setTIP "␊ |
| 319 | ␉"false setByteAck "␊ |
| 320 | ␉"WaitATTN "␊ |
| 321 | ␉"; "␊ |
| 322 | ␉": start-send␉( c -- ) "␊ |
| 323 | ␉"kSRModeOut vACR rb! "␊ |
| 324 | ␉"( c ) vSHR rb! "␊ |
| 325 | ␉"true setTIP "␊ |
| 326 | ␉"; "␊ |
| 327 | ␉": cuda-write␉{ _adr _len ; _actual _data } "␊ |
| 328 | ␉"?TREQ if get-response then "␊ |
| 329 | ␉"_adr c@ start-send "␊ |
| 330 | ␉"begin "␊ |
| 331 | ␉"WaitVIAInt "␊ |
| 332 | ␉"?TREQ while "␊ |
| 333 | ␉"vSHR rb@ drop "␊ |
| 334 | ␉"false setTIP "␊ |
| 335 | ␉"get-response "␊ |
| 336 | ␉"_adr c@ start-send "␊ |
| 337 | ␉"repeat "␊ |
| 338 | ␉"1 -> _actual "␊ |
| 339 | ␉"_len 1 ?do "␊ |
| 340 | ␉"_adr i + c@ vSHR rb! "␊ |
| 341 | ␉"_actual 1+ -> _actual "␊ |
| 342 | ␉"ToggleByteAck "␊ |
| 343 | ␉"WaitVIAInt "␊ |
| 344 | ␉"loop "␊ |
| 345 | ␉"2 ms "␊ |
| 346 | ␉"kSRModeIn vACR rb! "␊ |
| 347 | ␉"vSHR rb@ drop "␊ |
| 348 | ␉"false setTIP "␊ |
| 349 | ␉"false setByteAck "␊ |
| 350 | ␉"_actual "␊ |
| 351 | ␉"; "␊ |
| 352 | ␉": cuda-read␉( _adr _len -- _actual ) "␊ |
| 353 | ␉"get-response "␊ |
| 354 | ␉"nip "␊ |
| 355 | ␉"; "␊ |
| 356 | ␉"8 buffer: athens-data␉\" \"(012250FFFF)\" athens-data swap move "␊ |
| 357 | ␉"8 buffer: athens-rsp "␊ |
| 358 | ␉": write-IIC␉( -- ) "␊ |
| 359 | ␉"athens-data 5 cuda-write drop "␊ |
| 360 | ␉"athens-rsp 3 cuda-read drop "␊ |
| 361 | ␉"; "␊ |
| 362 | ␉": init-ATHENS␉( P2Mux N2 D2 -- ) "␊ |
| 363 | ␉"4 1 do "␊ |
| 364 | ␉"i athens-data 3 + c! ( val ) athens-data 4 + c! "␊ |
| 365 | ␉"( athens-data 5 dump cr ) "␊ |
| 366 | ␉"write-IIC "␊ |
| 367 | ␉"loop "␊ |
| 368 | ␉"; "␊ |
| 369 | ␉": ping-CONTROL␉( enable-bit -- ) "␊ |
| 370 | ␉"5 ms "␊ |
| 371 | ␉"dup 8 or swap "␊ |
| 372 | ␉"dup regs >C.TEST rl! 5 ms "␊ |
| 373 | ␉"swap dup regs >C.TEST rl! 5 ms "␊ |
| 374 | ␉"swap dup regs >C.TEST rl! 5 ms "␊ |
| 375 | ␉"swap dup regs >C.TEST rl! 5 ms "␊ |
| 376 | ␉"2drop "␊ |
| 377 | ␉"; "␊ |
| 378 | ␉": reset-CONTROL "␊ |
| 379 | ␉"h# 433 ping-CONTROL "␊ |
| 380 | ␉"1 regs >C.GSC-DIVIDE rl! "␊ |
| 381 | ␉"; "␊ |
| 382 | ␉": enable-CONTROL "␊ |
| 383 | ␉"h# 033 ping-CONTROL "␊ |
| 384 | ␉"; "␊ |
| 385 | ␉": init-CONTROL␉( tbl-ptr -- ) "␊ |
| 386 | ␉"-1 to bankb? "␊ |
| 387 | ␉"phys-fb-address dup h# 1000 _I_G do-map "␊ |
| 388 | ␉"h# 31 regs >C.ENABLE rl! "␊ |
| 389 | ␉"h# 12345678 phys-fb-address rl! "␊ |
| 390 | ␉"regs >C.ENABLE rl@ drop "␊ |
| 391 | ␉"h# 12345678 phys-fb-address rl@ <> "␊ |
| 392 | ␉"phys-fb-address h# 1000 do-unmap "␊ |
| 393 | ␉"if "␊ |
| 394 | ␉"0 to bankb? "␊ |
| 395 | ␉"phys-fb-address h# 600000 or to phys-fb-address "␊ |
| 396 | ␉"then "␊ |
| 397 | ␉"dup @ ( dup .h ) lbsplit init-ATHENS init-RADACAL cell+ "␊ |
| 398 | ␉"d# 16 0 do "␊ |
| 399 | ␉"w@++ ( dup .d ) regs >C.VFPEQ i 4 << + ( dup .h cr ) rl! "␊ |
| 400 | ␉"loop "␊ |
| 401 | ␉"w@++␉regs >C.GSC-DIVIDE rl! "␊ |
| 402 | ␉"w@++ dup to width␉regs >C.ROW-WORDS rl! "␊ |
| 403 | ␉"w@ to height "␊ |
| 404 | ␉"h# 31 bankB? not 8 and or "␊ |
| 405 | ␉"little? 2 and or␉regs >C.ENABLE rl! "␊ |
| 406 | ␉"0␉␉regs >C.GBASE rl! "␊ |
| 407 | ␉"h# 01e4␉regs >C.REFRESH-COUNT rl! "␊ |
| 408 | ␉"0␉␉regs >C.INT-ENABLE rl! "␊ |
| 409 | ␉"; "␊ |
| 410 | ␉": my-open "␊ |
| 411 | ␉"\" assigned-addresses\" get-my-property "␊ |
| 412 | ␉"abort\" no REG property\"␉( prop-adr prop-len ) "␊ |
| 413 | ␉"begin "␊ |
| 414 | ␉"dup 0> while "␊ |
| 415 | ␉"decode-int h# FF and >r decode-int drop decode-int >r "␊ |
| 416 | ␉"8 - swap 8 + swap␉␉␉␉␉␉␉( prop-adr prop-len ) "␊ |
| 417 | ␉"r> r> case "␊ |
| 418 | ␉"h# 14 of "␊ |
| 419 | ␉"to phys-regs "␊ |
| 420 | ␉"endof "␊ |
| 421 | ␉"h# 18 of "␊ |
| 422 | ␉"h# 00800000 + to phys-fb-address "␊ |
| 423 | ␉"endof "␊ |
| 424 | ␉"swap drop "␊ |
| 425 | ␉"endcase "␊ |
| 426 | ␉"repeat "␊ |
| 427 | ␉"2drop "␊ |
| 428 | ␉"phys-regs 0 my-space h# 02000000 or h# 1000 \" map-in\" $call-parent to regs "␊ |
| 429 | ␉"reset-CONTROL "␊ |
| 430 | ␉"mon-sense "␊ |
| 431 | ␉"get-mode swap to mono-mode? "␊ |
| 432 | ␉"( mode-dependent-table-addr ) "␊ |
| 433 | ␉"dup 0= if "␊ |
| 434 | ␉"abort "␊ |
| 435 | ␉"then "␊ |
| 436 | ␉"( mode-dependent-table-addr ) "␊ |
| 437 | ␉"init-CONTROL "␊ |
| 438 | ␉"std-16 0 d# 16 set-colors "␊ |
| 439 | ␉"enable-CONTROL "␊ |
| 440 | ␉"phys-fb-address 0 my-space h# 02000000 or width height * \" map-in\" $call-parent to fb-address "␊ |
| 441 | ␉"fb-address width height * 7 fill "␊ |
| 442 | ␉"default-font set-font "␊ |
| 443 | ␉"width height over 20 - char-width / over 20 - char-height / fb8-install "␊ |
| 444 | ␉"width #columns char-width * - 2/ to window-left "␊ |
| 445 | ␉"height #lines char-height * - 2/ to window-top "␊ |
| 446 | ␉"fb-address to frame-buffer-adr "␊ |
| 447 | ␉"width encode-int \" width\" property "␊ |
| 448 | ␉"height encode-int \" height\" property "␊ |
| 449 | ␉"width encode-int \" linebytes\" property "␊ |
| 450 | ␉"8 encode-int \" depth\" property "␊ |
| 451 | ␉"; "␊ |
| 452 | ␉": my-close "␊ |
| 453 | ␉"fb-address height width * \" map-out\" $call-parent "␊ |
| 454 | ␉"regs h# 1000 \" map-out\" $call-parent "␊ |
| 455 | ␉"; "␊ |
| 456 | ␉"EXTERNAL "␊ |
| 457 | ␉": DIMENSIONS "␊ |
| 458 | ␉"width height "␊ |
| 459 | ␉"; "␊ |
| 460 | ␉": SET-COLORS␉( adr index #indices ) "␊ |
| 461 | ␉"swap RAD-REG-ADDR! "␊ |
| 462 | ␉"( #indices ) 0 ?do␉␉␉␉( adr ) "␊ |
| 463 | ␉"mono-mode? if "␊ |
| 464 | ␉"c+ h# 4d * >r␉␉␉␉( red adr ) "␊ |
| 465 | ␉"c+ h# 97 * >r␉␉␉␉( red green adr ) "␊ |
| 466 | ␉"c+ h# 1c * ␉␉␉␉␉( red green blue adr ) "␊ |
| 467 | ␉"r> + r> + 8 >>␉␉␉␉( luminance ) "␊ |
| 468 | ␉"do-gamma "␊ |
| 469 | ␉"dup "␊ |
| 470 | ␉"dup "␊ |
| 471 | ␉"CLUT! "␊ |
| 472 | ␉"( adr ) "␊ |
| 473 | ␉"else "␊ |
| 474 | ␉"c+ do-gamma swap␉␉␉( R adr ) "␊ |
| 475 | ␉"c+ do-gamma swap␉␉␉( R G adr ) "␊ |
| 476 | ␉"c+ do-gamma swap ␉␉␉( R G B adr ) "␊ |
| 477 | ␉">r swap rot CLUT! r>␉␉( B G R ) "␊ |
| 478 | ␉"then "␊ |
| 479 | ␉"loop␉␉␉␉␉␉( adr ) "␊ |
| 480 | ␉"drop "␊ |
| 481 | ␉"; "␊ |
| 482 | ␉": GET-COLORS␉( adr index #indices -- ) "␊ |
| 483 | ␉"swap ( index ) RAD-REG-ADDR! ( #indices ) 0 ?do "␊ |
| 484 | ␉"CLUT@ anti-gamma >r anti-gamma >r anti-gamma␉␉( R ) "␊ |
| 485 | ␉"c!+ r> c!+ r> c!+ "␊ |
| 486 | ␉"loop "␊ |
| 487 | ␉"drop "␊ |
| 488 | ␉"; "␊ |
| 489 | ␉": COLOR!␉␉( r g b index -- ) "␊ |
| 490 | ␉">r RGB-temp 2+ c! RGB-temp 1+ c! RGB-temp c! "␊ |
| 491 | ␉"RGB-temp r> 1 set-colors "␊ |
| 492 | ␉"; "␊ |
| 493 | ␉": COLOR@␉␉( index -- r g b ) "␊ |
| 494 | ␉"RGB-temp swap 1 get-colors "␊ |
| 495 | ␉"RGB-temp c+ swap c+ swap c@ "␊ |
| 496 | ␉"; "␊ |
| 497 | ␉": rect-setup␉( adr|index x y w h -- w adr|index xy-adr h ) "␊ |
| 498 | ␉">r >r width * + fb-address + r> -rot r> "␊ |
| 499 | ␉"; "␊ |
| 500 | ␉": DRAW-RECTANGLE␉( adr x y w h -- ) "␊ |
| 501 | ␉"rect-setup "␊ |
| 502 | ␉"( h ) 0 ?do␉␉␉␉␉␉␉␉( w adr xy-adr ) "␊ |
| 503 | ␉"2dup 4 pick move "␊ |
| 504 | ␉"2 pick width d+ "␊ |
| 505 | ␉"loop "␊ |
| 506 | ␉"3drop "␊ |
| 507 | ␉"; "␊ |
| 508 | ␉": FILL-RECTANGLE␉( index x y w h -- ) "␊ |
| 509 | ␉"rect-setup ␉␉␉␉␉␉␉␉( w index xy-adr h ) "␊ |
| 510 | ␉"( h ) 0 ?do␉␉␉␉␉␉␉␉( w index xy-adr ) "␊ |
| 511 | ␉"dup 3 pick 3 pick fill "␊ |
| 512 | ␉"width + "␊ |
| 513 | ␉"loop "␊ |
| 514 | ␉"3drop "␊ |
| 515 | ␉"; "␊ |
| 516 | ␉": READ-RECTANGLE␉( adr x y w h -- ) "␊ |
| 517 | ␉"rect-setup >r swap r>␉␉␉␉␉( w xy-adr adr h ) "␊ |
| 518 | ␉"( h ) 0 ?do "␊ |
| 519 | ␉"2dup 4 pick move "␊ |
| 520 | ␉"width 3 pick d+ "␊ |
| 521 | ␉"loop "␊ |
| 522 | ␉"3drop "␊ |
| 523 | ␉"; "␊ |
| 524 | ␉"['] my-open is-install "␊ |
| 525 | ␉"['] my-close is-remove "␊ |
| 526 | ,␊ |
| 527 | " device-end",0};␊ |
| 528 | |
