1\ Copyright (c) 1999 Daniel C. Sobral <dcs@freebsd.org>
2\ All rights reserved.
3\
4\ Redistribution and use in source and binary forms, with or without
5\ modification, are permitted provided that the following conditions
6\ are met:
7\ 1. Redistributions of source code must retain the above copyright
8\ notice, this list of conditions and the following disclaimer.
9\ 2. Redistributions in binary form must reproduce the above copyright
10\ notice, this list of conditions and the following disclaimer in the
11\ documentation and/or other materials provided with the distribution.
12\
13\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
14\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
15\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
16\ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
17\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
18\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
19\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
20\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
21\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
22\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
23\ SUCH DAMAGE.
24\
|
25\ $FreeBSD: head/sys/boot/forth/loader.4th 61376 2000-06-07 22:10:05Z dcs $
|
| 25\ $FreeBSD: head/sys/boot/forth/loader.4th 61379 2000-06-07 22:19:49Z dcs $ |
26
|
27s" arch-alpha" environment? [if]
28s" loader_version" environment? 3 < abort" Loader version 0.3+ required"
29[then]
30
31s" arch-i386" environment? [if]
32s" loader_version" environment? 8 < abort" Loader version 0.8+ required"
33[then]
34 |
35include /boot/support.4th
36
37only forth definitions also support-functions
38
39\ ***** boot-conf
40\
41\ Prepares to boot as specified by loaded configuration files.
42
43also support-functions definitions
44
45: bootpath s" /boot/" ;
46: modulepath s" module_path" ;
47: saveenv ( addr len | 0 -1 -- addr' len | 0 -1 )
48 dup -1 = if exit then
49 dup allocate abort" Out of memory"
50 swap 2dup 2>r
51 move
52 2r>
53;
54: freeenv ( addr len | 0 -1 )
55 -1 = if drop else free abort" Freeing error" then
56;
57: restoreenv ( addr len | 0 -1 -- )
58 dup -1 = if ( it wasn't set )
59 2drop
60 modulepath unsetenv
61 else
62 over >r
63 modulepath setenv
64 r> free abort" Freeing error"
65 then
66;
67
68only forth also support-functions also builtins definitions
69
70: boot-conf ( args 1 | 0 "args" -- flag )
71 0 1 unload drop
72
73 0= if ( interpreted )
74 \ Get next word on the command line
75 bl word count
76 ?dup 0= if ( there wasn't anything )
77 drop 0
78 else ( put in the number of strings )
79 1
80 then
81 then ( interpreted )
82
83 if ( there are arguments )
84 \ Try to load the kernel
85 s" kernel_options" getenv dup -1 = if drop 2dup 1 else 2over 2 then
86
87 1 load if ( load command failed )
88 \ Remove garbage from the stack
89
90 \ Set the environment variable module_path, and try loading
91 \ the kernel again.
92
93 \ First, save module_path value
94 modulepath getenv saveenv dup -1 = if 0 swap then 2>r
95
96 \ Sets the new value
97 2dup modulepath setenv
98
99 \ Try to load the kernel
100 s" load ${kernel} ${kernel_options}" ['] evaluate catch
101 if ( load failed yet again )
102 \ Remove garbage from the stack
103 2drop
104
105 \ Try prepending /boot/
106 bootpath 2over nip over + allocate
107 if ( out of memory )
108 2drop 2drop
109 2r> restoreenv
110 100 exit
111 then
112
113 0 2swap strcat 2swap strcat
114 2dup modulepath setenv
115
116 drop free if ( freeing memory error )
117 2drop
118 2r> restoreenv
119 100 exit
120 then
121
122 \ Now, once more, try to load the kernel
123 s" load ${kernel} ${kernel_options}" ['] evaluate catch
124 if ( failed once more )
125 2drop
126 2r> restoreenv
127 100 exit
128 then
129
130 else ( we found the kernel on the path passed )
131
132 2drop ( discard command line arguments )
133
134 then ( could not load kernel from directory passed )
135
136 \ Load the remaining modules, if the kernel was loaded at all
137 ['] load_modules catch if 2r> restoreenv 100 exit then
138
139 \ Call autoboot to perform the booting
140 0 1 autoboot
141
142 \ Keep new module_path
143 2r> freeenv
144
145 exit
146 then ( could not load kernel with name passed )
147
148 2drop ( discard command line arguments )
149
150 else ( try just a straight-forward kernel load )
151 s" load ${kernel} ${kernel_options}" ['] evaluate catch
152 if ( kernel load failed ) 2drop 100 exit then
153
154 then ( there are command line arguments )
155
156 \ Load the remaining modules, if the kernel was loaded at all
157 ['] load_modules catch if 100 exit then
158
159 \ Call autoboot to perform the booting
160 0 1 autoboot
161;
162
163also forth definitions
164builtin: boot-conf
165only forth definitions also support-functions
166
167\ ***** check-password
168\
169\ If a password was defined, execute autoboot and ask for
170\ password if autoboot returns.
171
172: check-password
173 password .addr @ if
174 0 autoboot
175 false >r
176 begin
177 bell emit bell emit
178 ." Password: "
179 password .len @ read-password
180 dup password .len @ = if
181 2dup password .addr @ password .len @
182 compare 0= if r> drop true >r then
183 then
184 drop free drop
185 r@
186 until
187 r> drop
188 then
189;
190
191\ ***** start
192\
193\ Initializes support.4th global variables, sets loader_conf_files,
194\ process conf files, and, if any one such file was succesfully
195\ read to the end, load kernel and modules.
196
197: start ( -- ) ( throws: abort & user-defined )
198 s" /boot/defaults/loader.conf" initialize
199 include_conf_files
200 \ Will *NOT* try to load kernel and modules if no configuration file
201 \ was succesfully loaded!
202 any_conf_read? if
203 load_kernel
204 load_modules
205 then
206;
207
208\ ***** initialize
209\
210\ Overrides support.4th initialization word with one that does
211\ everything start one does, short of loading the kernel and
212\ modules. Returns a flag
213
214: initialize ( -- flag )
215 s" /boot/defaults/loader.conf" initialize
216 include_conf_files
217 any_conf_read?
218;
219
220\ ***** read-conf
221\
222\ Read a configuration file, whose name was specified on the command
223\ line, if interpreted, or given on the stack, if compiled in.
224
225: (read-conf) ( addr len -- )
226 conf_files .addr @ ?dup if free abort" Fatal error freeing memory" then
227 strdup conf_files .len ! conf_files .addr !
228 include_conf_files \ Will recurse on new loader_conf_files definitions
229;
230
231: read-conf ( <filename> | addr len -- ) ( throws: abort & user-defined )
232 state @ if
233 \ Compiling
234 postpone (read-conf)
235 else
236 \ Interpreting
237 bl parse (read-conf)
238 then
239; immediate
240
241\ ***** enable-module
242\
243\ Turn a module loading on.
244
245: enable-module ( <module> -- )
246 bl parse module_options @ >r
247 begin
248 r@
249 while
250 2dup
251 r@ module.name dup .addr @ swap .len @
252 compare 0= if
253 2drop
254 r@ module.name dup .addr @ swap .len @ type
255 true r> module.flag !
256 ." will be loaded." cr
257 exit
258 then
259 r> module.next @ >r
260 repeat
261 r> drop
262 type ." wasn't found." cr
263;
264
265\ ***** disable-module
266\
267\ Turn a module loading off.
268
269: disable-module ( <module> -- )
270 bl parse module_options @ >r
271 begin
272 r@
273 while
274 2dup
275 r@ module.name dup .addr @ swap .len @
276 compare 0= if
277 2drop
278 r@ module.name dup .addr @ swap .len @ type
279 false r> module.flag !
280 ." will not be loaded." cr
281 exit
282 then
283 r> module.next @ >r
284 repeat
285 r> drop
286 type ." wasn't found." cr
287;
288
289\ ***** toggle-module
290\
291\ Turn a module loading on/off.
292
293: toggle-module ( <module> -- )
294 bl parse module_options @ >r
295 begin
296 r@
297 while
298 2dup
299 r@ module.name dup .addr @ swap .len @
300 compare 0= if
301 2drop
302 r@ module.name dup .addr @ swap .len @ type
303 r@ module.flag @ 0= dup r> module.flag !
304 if
305 ." will be loaded." cr
306 else
307 ." will not be loaded." cr
308 then
309 exit
310 then
311 r> module.next @ >r
312 repeat
313 r> drop
314 type ." wasn't found." cr
315;
316
317\ ***** show-module
318\
319\ Show loading information about a module.
320
321: show-module ( <module> -- )
322 bl parse module_options @ >r
323 begin
324 r@
325 while
326 2dup
327 r@ module.name dup .addr @ swap .len @
328 compare 0= if
329 2drop
330 ." Name: " r@ module.name dup .addr @ swap .len @ type cr
331 ." Path: " r@ module.loadname dup .addr @ swap .len @ type cr
332 ." Type: " r@ module.type dup .addr @ swap .len @ type cr
333 ." Flags: " r@ module.args dup .addr @ swap .len @ type cr
334 ." Before load: " r@ module.beforeload dup .addr @ swap .len @ type cr
335 ." After load: " r@ module.afterload dup .addr @ swap .len @ type cr
336 ." Error: " r@ module.loaderror dup .addr @ swap .len @ type cr
337 ." Status: " r> module.flag @ if ." Load" else ." Don't load" then cr
338 exit
339 then
340 r> module.next @ >r
341 repeat
342 r> drop
343 type ." wasn't found." cr
344;
345
346\ Words to be used inside configuration files
347
348: retry false ; \ For use in load error commands
349: ignore true ; \ For use in load error commands
350
351\ Return to strict forth vocabulary
352
353only forth also
354
|