1 \ qemu specific initialization code
3 \ Copyright (C) 2005 Stefan Reinauer
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
11 \ -------------------------------------------------------------------------
13 \ -------------------------------------------------------------------------
15 : make-openable ( path )
18 \ install trivial open and close methods
19 dup active-package! is-open
25 : preopen ( chosen-str node-path )
28 " /chosen" find-device
30 encode-int 2swap property
36 \ preopen device nodes (and store the ihandles under /chosen)
39 " memory" " /memory" preopen
43 \ use the tty interface if available
44 : activate-tty-interface
45 " /packages/terminal-emulator" find-dev if drop
49 variable keyboard-phandle 0 keyboard-phandle !
51 : (find-keyboard-device) ( phandle -- )
53 keyboard-phandle @ 0= if \ Return first match
56 dup dup " device_type" rot get-package-property 0= if
58 " keyboard" strcmp 0= if
59 dup to keyboard-phandle
62 (find-keyboard-device)
70 \ create the keyboard devalias
72 device-tree @ (find-keyboard-device)
75 " /aliases" find-device
76 keyboard-phandle @ get-package-path
77 encode-string " keyboard" property
82 \ -------------------------------------------------------------------------
84 \ -------------------------------------------------------------------------
87 " /chosen" find-device
88 stdin @ encode-int " stdin" property
89 stdout @ encode-int " stdout" property
97 \ -------------------------------------------------------------------------
98 \ copyright property handling
99 \ -------------------------------------------------------------------------
101 : insert-copyright-property
102 \ As required for MacOS 9 and below
103 " Pbclevtug 1983-2001 Nccyr Pbzchgre, Vap. GUVF ZRFFNTR SBE PBZCNGVOVYVGL BAYL"
104 rot13-str encode-string " copyright"
106 " set-property" $find if
114 : delete-copyright-property
115 \ Remove copyright property created above
119 " copyright" delete-property
125 \ Clean up before returning to the interpreter
126 delete-copyright-property
129 \ -------------------------------------------------------------------------
131 \ -------------------------------------------------------------------------
133 : adler32 ( adler buf len -- checksum )
134 " (adler32)" $find if
137 ." Can't find " ( adler32-name ) type cr