blob: 3d99a34a1dd318a8d190234875cde7f9fb700e45 (
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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
\ 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
\ -------------------------------------------------------------------------
\ copyright property handling
\ -------------------------------------------------------------------------
: insert-copyright-property
\ As required for MacOS 9 and below
" Pbclevtug 1983-2001 Nccyr Pbzchgre, Vap. GUVF ZRFFNTR SBE PBZCNGVOVYVGL BAYL"
rot13-str encode-string " copyright"
" /" find-package if
" set-property" $find if
execute
else
3drop drop
then
then
;
: delete-copyright-property
\ Remove copyright property created above
active-package
" /" find-package if
active-package!
" copyright" delete-property
then
active-package!
;
: (exit)
\ Clean up before returning to the interpreter
delete-copyright-property
;
\ -------------------------------------------------------------------------
\ Adler-32 wrapper
\ -------------------------------------------------------------------------
: adler32 ( adler buf len -- checksum )
" (adler32)" $find if
execute
else
." Can't find " ( adler32-name ) type cr
3drop 0
then
;
|