blob: 458af1bc77a6a2b3ddc866137a6fb174b3058450 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
\ qemu specific initialization code
\
\ Copyright (C) 2005 Stefan Reinauer
\
\ This program is free software; you can redistribute it and/or
\ modify it under the terms of the GNU General Public License
\ as published by the Free Software Foundation
\
\ -------------------------------------------------------------------------
\ initialization
\ -------------------------------------------------------------------------
: make-openable ( path )
find-dev if
begin ?dup while
\ install trivial open and close methods
dup active-package! is-open
parent
repeat
then
;
: preopen ( chosen-str node-path )
2dup make-openable
" /chosen" find-device
open-dev ?dup if
encode-int 2swap property
else
2drop
then
;
\ preopen device nodes (and store the ihandles under /chosen)
:noname
" rtc" " rtc" preopen
" memory" " /memory" preopen
; SYSTEM-initializer
\ use the tty interface if available
: activate-tty-interface
" /packages/terminal-emulator" find-dev if drop
then
;
variable keyboard-phandle 0 keyboard-phandle !
: (find-keyboard-device) ( phandle -- )
recursive
keyboard-phandle @ 0= if \ Return first match
>dn.child @
begin ?dup while
dup dup " device_type" rot get-package-property 0= if
drop dup cstrlen
" keyboard" strcmp 0= if
dup to keyboard-phandle
then
then
(find-keyboard-device)
>dn.peer @
repeat
else
drop
then
;
\ create the keyboard devalias
:noname
device-tree @ (find-keyboard-device)
keyboard-phandle @ if
active-package
" /aliases" find-device
keyboard-phandle @ get-package-path
encode-string " keyboard" property
active-package!
then
; SYSTEM-initializer
\ -------------------------------------------------------------------------
\ pre-booting
\ -------------------------------------------------------------------------
: update-chosen
" /chosen" find-device
stdin @ encode-int " stdin" property
stdout @ encode-int " stdout" property
device-end
;
:noname
set-defaults
; PREPOST-initializer
|
