1\ qemu specific initialization code 2\ 3\ Copyright (C) 2005 Stefan Reinauer 4\ 5\ This program is free software; you can redistribute it and/or 6\ modify it under the terms of the GNU General Public License 7\ as published by the Free Software Foundation 8\ 9 10 11\ ------------------------------------------------------------------------- 12\ initialization 13\ ------------------------------------------------------------------------- 14 15: make-openable ( path ) 16 find-dev if 17 begin ?dup while 18 \ install trivial open and close methods 19 dup active-package! is-open 20 parent 21 repeat 22 then 23; 24 25: preopen ( chosen-str node-path ) 26 2dup make-openable 27 28 " /chosen" find-device 29 open-dev ?dup if 30 encode-int 2swap property 31 else 32 2drop 33 then 34; 35 36\ preopen device nodes (and store the ihandles under /chosen) 37:noname 38 " rtc" " rtc" preopen 39 " memory" " /memory" preopen 40; SYSTEM-initializer 41 42 43\ use the tty interface if available 44: activate-tty-interface 45 " /packages/terminal-emulator" find-dev if drop 46 then 47; 48 49variable keyboard-phandle 0 keyboard-phandle ! 50 51: (find-keyboard-device) ( phandle -- ) 52 recursive 53 keyboard-phandle @ 0= if \ Return first match 54 >dn.child @ 55 begin ?dup while 56 dup dup " device_type" rot get-package-property 0= if 57 drop dup cstrlen 58 " keyboard" strcmp 0= if 59 dup to keyboard-phandle 60 then 61 then 62 (find-keyboard-device) 63 >dn.peer @ 64 repeat 65 else 66 drop 67 then 68; 69 70\ create the keyboard devalias 71:noname 72 device-tree @ (find-keyboard-device) 73 keyboard-phandle @ if 74 active-package 75 " /aliases" find-device 76 keyboard-phandle @ get-package-path 2dup 77 encode-string " kbd" property 78 encode-string " keyboard" property 79 active-package! 80 then 81; SYSTEM-initializer 82 83\ ------------------------------------------------------------------------- 84\ pre-booting 85\ ------------------------------------------------------------------------- 86 87: update-chosen 88 " /chosen" find-device 89 stdin @ encode-int " stdin" property 90 stdout @ encode-int " stdout" property 91 device-end 92; 93 94:noname 95 set-defaults 96; PREPOST-initializer 97 98\ ------------------------------------------------------------------------- 99\ copyright property handling 100\ ------------------------------------------------------------------------- 101 102: insert-copyright-property 103 \ As required for MacOS 9 and below 104 " Pbclevtug 1983-2001 Nccyr Pbzchgre, Vap. GUVF ZRFFNTR SBE PBZCNGVOVYVGL BAYL" 105 rot13-str encode-string " copyright" 106 " /" find-package if 107 " set-property" $find if 108 execute 109 else 110 3drop drop 111 then 112 then 113; 114 115: delete-copyright-property 116 \ Remove copyright property created above 117 active-package 118 " /" find-package if 119 active-package! 120 " copyright" delete-property 121 then 122 active-package! 123; 124 125: (exit) 126 \ Clean up before returning to the interpreter 127 delete-copyright-property 128; 129 130\ ------------------------------------------------------------------------- 131\ Adler-32 wrapper 132\ ------------------------------------------------------------------------- 133 134: adler32 ( adler buf len -- checksum ) 135 " (adler32)" $find if 136 execute 137 else 138 ." Can't find " ( adler32-name ) type cr 139 3drop 0 140 then 141; 142