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