![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ciface.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / system|
Return to ciface.fs CVS log | Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / system |
1.1 ! root 1: ! 2: 0 value ciface-ph ! 3: ! 4: dev /openprom/ ! 5: new-device ! 6: " client-services" device-name ! 7: ! 8: active-package to ciface-ph ! 9: ! 10: \ ------------------------------------------------------------- ! 11: \ private stuff ! 12: \ ------------------------------------------------------------- ! 13: ! 14: private ! 15: ! 16: variable callback-function ! 17: ! 18: : ?phandle ( phandle -- phandle ) ! 19: dup 0= if ." NULL phandle" -1 throw then ! 20: ; ! 21: : ?ihandle ( ihandle -- ihandle ) ! 22: dup 0= if ." NULL ihandle" -2 throw then ! 23: ; ! 24: ! 25: \ copy and null terminate return string ! 26: : ci-strcpy ( buf buflen str len -- len ) ! 27: >r -rot dup ! 28: ( str buf buflen buflen R: len ) ! 29: r@ min swap ! 30: ( str buf n buflen R: len ) ! 31: over > if ! 32: ( str buf n ) ! 33: 2dup + 0 swap c! ! 34: then ! 35: move r> ! 36: ; ! 37: ! 38: 0 value memory-ih ! 39: 0 value mmu-ih ! 40: ! 41: :noname ( -- ) ! 42: " /chosen" find-device ! 43: ! 44: " mmu" active-package get-package-property 0= if ! 45: decode-int nip nip to mmu-ih ! 46: then ! 47: ! 48: " memory" active-package get-package-property 0= if ! 49: decode-int nip nip to memory-ih ! 50: then ! 51: device-end ! 52: ; SYSTEM-initializer ! 53: ! 54: : safetype ! 55: ." <" dup cstrlen dup 20 < if type else 2drop ." BAD" then ." >" ! 56: ; ! 57: ! 58: \ ------------------------------------------------------------- ! 59: \ public interface ! 60: \ ------------------------------------------------------------- ! 61: ! 62: external ! 63: ! 64: \ ------------------------------------------------------------- ! 65: \ 6.3.2.1 Client interface ! 66: \ ------------------------------------------------------------- ! 67: ! 68: \ returns -1 if missing ! 69: : test ( name -- 0|-1 ) ! 70: dup cstrlen ciface-ph find-method ! 71: if drop 0 else -1 then ! 72: ; ! 73: ! 74: \ ------------------------------------------------------------- ! 75: \ 6.3.2.2 Device tree ! 76: \ ------------------------------------------------------------- ! 77: ! 78: : peer peer ; ! 79: : child child ; ! 80: : parent parent ; ! 81: ! 82: : getproplen ( name phandle -- len|-1 ) ! 83: over cstrlen swap ! 84: ?phandle get-package-property ! 85: if -1 else nip then ! 86: ; ! 87: ! 88: : getprop ( buflen buf name phandle -- size|-1 ) ! 89: \ detect phandle == -1 ! 90: dup -1 = if ! 91: 2drop 2drop -1 exit ! 92: then ! 93: ! 94: \ return -1 if phandle is 0 (MacOS actually does this) ! 95: ?dup 0= if drop 2drop -1 exit then ! 96: ! 97: over cstrlen swap ! 98: ?phandle get-package-property if 2drop -1 exit then ! 99: ( buflen buf prop proplen ) ! 100: >r swap rot r> ! 101: ( prop buf buflen proplen ) ! 102: dup >r min move r> ! 103: ; ! 104: ! 105: \ 1 OK, 0 no more prop, -1 prev invalid ! 106: : nextprop ( buf prev phandle -- 1|0|-1 ) ! 107: >r ! 108: dup 0= if 0 else dup cstrlen then ! 109: ! 110: ( buf prev prev_len ) ! 111: 0 3 pick c! ! 112: ! 113: \ verify that prev exists (overkill...) ! 114: dup if ! 115: 2dup r@ get-package-property if ! 116: r> 2drop 2drop -1 exit ! 117: else ! 118: 2drop ! 119: then ! 120: then ! 121: ! 122: ( buf prev prev_len ) ! 123: ! 124: r> next-property if ! 125: ( buf name name_len ) ! 126: dup 1+ -rot ci-strcpy drop 1 ! 127: else ! 128: ( buf ) ! 129: drop 0 ! 130: then ! 131: ; ! 132: ! 133: : setprop ( len buf name phandle -- size ) ! 134: 3 pick >r ! 135: >r >r swap encode-bytes \ ( prop-addr prop-len R: phandle name ) ! 136: r> dup cstrlen r> ! 137: (property) ! 138: r> ! 139: ; ! 140: ! 141: : finddevice ( dev_spec -- phandle|-1 ) ! 142: dup cstrlen ! 143: \ ." FIND-DEVICE " 2dup type ! 144: find-dev 0= if -1 then ! 145: \ ." -- " dup . cr ! 146: ; ! 147: ! 148: : instance-to-package ( ihandle -- phandle ) ! 149: ?ihandle ihandle>phandle ! 150: ; ! 151: ! 152: : package-to-path ( buflen buf phandle -- length ) ! 153: \ XXX improve error checking ! 154: dup 0= if 3drop -1 exit then ! 155: >r swap r> ! 156: get-package-path ! 157: ( buf buflen str len ) ! 158: ci-strcpy ! 159: ; ! 160: ! 161: : canon ( buflen buf dev_specifier -- len ) ! 162: dup cstrlen find-dev if ! 163: ( buflen buf phandle ) ! 164: package-to-path ! 165: else ! 166: 2drop -1 ! 167: then ! 168: ; ! 169: ! 170: : instance-to-path ( buflen buf ihandle -- length ) ! 171: \ XXX improve error checking ! 172: dup 0= if 3drop -1 exit then ! 173: >r swap r> ! 174: get-instance-path ! 175: \ ." INSTANCE: " 2dup type cr dup . ! 176: ( buf buflen str len ) ! 177: ci-strcpy ! 178: ; ! 179: ! 180: : instance-to-interposed-path ( buflen buf ihandle -- length ) ! 181: \ XXX improve error checking ! 182: dup 0= if 3drop -1 exit then ! 183: >r swap r> ! 184: get-instance-interposed-path ! 185: ( buf buflen str len ) ! 186: ci-strcpy ! 187: ; ! 188: ! 189: : call-method ( ihandle method -- xxxx catch-result ) ! 190: dup 0= if ." call of null method" -1 exit then ! 191: dup >r ! 192: dup cstrlen ! 193: \ ." call-method " 2dup type cr ! 194: rot ?ihandle ['] $call-method catch dup if ! 195: \ not necessary an error but very useful for debugging... ! 196: ." call-method " r@ dup cstrlen type ." : exception " dup . cr ! 197: then ! 198: r> drop ! 199: ; ! 200: ! 201: ! 202: \ ------------------------------------------------------------- ! 203: \ 6.3.2.3 Device I/O ! 204: \ ------------------------------------------------------------- ! 205: ! 206: : open ( dev_spec -- ihandle|0 ) ! 207: dup cstrlen open-dev ! 208: ; ! 209: ! 210: : close ( ihandle -- ) ! 211: close-dev ! 212: ; ! 213: ! 214: : read ( len addr ihandle -- actual ) ! 215: >r swap r> ! 216: dup ihandle>phandle " read" rot find-method ! 217: if swap call-package else 3drop -1 then ! 218: ; ! 219: ! 220: : write ( len addr ihandle -- actual ) ! 221: >r swap r> ! 222: dup ihandle>phandle " write" rot find-method ! 223: if swap call-package else 3drop -1 then ! 224: ; ! 225: ! 226: : seek ( pos_lo pos_hi ihandle -- status ) ! 227: dup ihandle>phandle " seek" rot find-method ! 228: if swap call-package else 3drop -1 then ! 229: ; ! 230: ! 231: ! 232: \ ------------------------------------------------------------- ! 233: \ 6.3.2.4 Memory ! 234: \ ------------------------------------------------------------- ! 235: ! 236: : claim ( align size virt -- baseaddr|-1 ) ! 237: -rot swap ! 238: ciface-ph " cif-claim" rot find-method ! 239: if execute else 3drop -1 then ! 240: ; ! 241: ! 242: : release ( size virt -- ) ! 243: swap ! 244: ciface-ph " cif-release" rot find-method ! 245: if execute else 2drop -1 then ! 246: ; ! 247: ! 248: \ ------------------------------------------------------------- ! 249: \ 6.3.2.5 Control transfer ! 250: \ ------------------------------------------------------------- ! 251: ! 252: : boot ( bootspec -- ) ! 253: ." BOOT" ! 254: ; ! 255: ! 256: : enter ( -- ) ! 257: ." ENTER" ! 258: ; ! 259: ! 260: \ exit ( -- ) is defined later (clashes with builtin exit) ! 261: ! 262: : chain ( virt size entry args len -- ) ! 263: ." CHAIN" ! 264: ; ! 265: ! 266: \ ------------------------------------------------------------- ! 267: \ 6.3.2.6 User interface ! 268: \ ------------------------------------------------------------- ! 269: ! 270: : interpret ( xxx cmdstring -- ??? catch-reult ) ! 271: dup cstrlen ! 272: \ ." INTERPRETE: --- " 2dup type ! 273: ['] evaluate catch dup if ! 274: \ this is not necessary an error... ! 275: ." interpret: exception " dup . ." caught" cr ! 276: ! 277: \ Force back to interpret state on error, otherwise the next call to ! 278: \ interpret gets confused if the error occurred in compile mode ! 279: 0 state ! ! 280: then ! 281: \ ." --- " cr ! 282: ; ! 283: ! 284: : set-callback ( newfunc -- oldfunc ) ! 285: callback-function @ ! 286: swap ! 287: callback-function ! ! 288: ; ! 289: ! 290: \ : set-symbol-lookup ( sym-to-value -- value-to-sym ) ; ! 291: ! 292: ! 293: \ ------------------------------------------------------------- ! 294: \ 6.3.2.7 Time ! 295: \ ------------------------------------------------------------- ! 296: ! 297: \ : milliseconds ( -- ms ) ; ! 298: ! 299: ! 300: \ ------------------------------------------------------------- ! 301: \ arch? ! 302: \ ------------------------------------------------------------- ! 303: ! 304: : start-cpu ( xxx xxx xxx --- ) ! 305: ." Start CPU unimplemented" cr ! 306: 3drop ! 307: ; ! 308: ! 309: \ ------------------------------------------------------------- ! 310: \ special ! 311: \ ------------------------------------------------------------- ! 312: ! 313: : exit ( -- ) ! 314: ." EXIT" ! 315: outer-interpreter ! 316: ; ! 317: ! 318: [IFDEF] CONFIG_PPC ! 319: \ PowerPC Microprocessor CHRP binding ! 320: \ 10.5.2. Client Interface ! 321: ! 322: ( cstring-method phandle -- missing ) ! 323: ! 324: : test-method ! 325: swap dup cstrlen rot ! 326: find-method 0= if -1 else drop 0 then ! 327: ; ! 328: [THEN] ! 329: ! 330: finish-device ! 331: device-end ! 332: ! 333: ! 334: \ ------------------------------------------------------------- ! 335: \ entry point ! 336: \ ------------------------------------------------------------- ! 337: ! 338: : client-iface ( [args] name len -- [args] -1 | [rets] 0 ) ! 339: ciface-ph find-method 0= if -1 exit then ! 340: catch ?dup if ! 341: cr ." Unexpected client interface exception: " . -2 cr exit ! 342: then ! 343: 0 ! 344: ; ! 345: ! 346: : client-call-iface ( [args] name len -- [args] -1 | [rets] 0 ) ! 347: ciface-ph find-method 0= if -1 exit then ! 348: execute ! 349: 0 ! 350: ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.