Initial import from FreeBSD RELENG_4:
[dragonfly.git] / sys / boot / forth / loader.4th
CommitLineData
984263bc
MD
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: src/sys/boot/forth/loader.4th,v 1.5.2.1 2000/07/07 00:14:34 obrien Exp $
26
27s" arch-alpha" environment? [if] [if]
28 s" loader_version" environment? [if]
29 3 < [if]
30 .( Loader version 0.3+ required) cr
31 abort
32 [then]
33 [else]
34 .( Could not get loader version!) cr
35 abort
36 [then]
37[then] [then]
38
39s" arch-i386" environment? [if] [if]
40 s" loader_version" environment? [if]
41 8 < [if]
42 .( Loader version 0.8+ required) cr
43 abort
44 [then]
45 [else]
46 .( Could not get loader version!) cr
47 abort
48 [then]
49[then] [then]
50
51include /boot/support.4th
52
53only forth definitions also support-functions
54
55\ ***** boot-conf
56\
57\ Prepares to boot as specified by loaded configuration files.
58
59also support-functions definitions
60
61: bootpath s" /boot/" ;
62: modulepath s" module_path" ;
63: saveenv ( addr len | 0 -1 -- addr' len | 0 -1 )
64 dup -1 = if exit then
65 dup allocate abort" Out of memory"
66 swap 2dup 2>r
67 move
68 2r>
69;
70: freeenv ( addr len | 0 -1 )
71 -1 = if drop else free abort" Freeing error" then
72;
73: restoreenv ( addr len | 0 -1 -- )
74 dup -1 = if ( it wasn't set )
75 2drop
76 modulepath unsetenv
77 else
78 over >r
79 modulepath setenv
80 r> free abort" Freeing error"
81 then
82;
83
84only forth also support-functions also builtins definitions
85
86: boot-conf ( args 1 | 0 "args" -- flag )
87 0 1 unload drop
88
89 0= if ( interpreted )
90 \ Get next word on the command line
91 bl word count
92 ?dup 0= if ( there wasn't anything )
93 drop 0
94 else ( put in the number of strings )
95 1
96 then
97 then ( interpreted )
98
99 if ( there are arguments )
100 \ Try to load the kernel
101 s" kernel_options" getenv dup -1 = if drop 2dup 1 else 2over 2 then
102
103 1 load if ( load command failed )
104 \ Remove garbage from the stack
105
106 \ Set the environment variable module_path, and try loading
107 \ the kernel again.
108
109 \ First, save module_path value
110 modulepath getenv saveenv dup -1 = if 0 swap then 2>r
111
112 \ Sets the new value
113 2dup modulepath setenv
114
115 \ Try to load the kernel
116 s" load ${kernel} ${kernel_options}" ['] evaluate catch
117 if ( load failed yet again )
118 \ Remove garbage from the stack
119 2drop
120
121 \ Try prepending /boot/
122 bootpath 2over nip over + allocate
123 if ( out of memory )
124 2drop 2drop
125 2r> restoreenv
126 100 exit
127 then
128
129 0 2swap strcat 2swap strcat
130 2dup modulepath setenv
131
132 drop free if ( freeing memory error )
133 2drop
134 2r> restoreenv
135 100 exit
136 then
137
138 \ Now, once more, try to load the kernel
139 s" load ${kernel} ${kernel_options}" ['] evaluate catch
140 if ( failed once more )
141 2drop
142 2r> restoreenv
143 100 exit
144 then
145
146 else ( we found the kernel on the path passed )
147
148 2drop ( discard command line arguments )
149
150 then ( could not load kernel from directory passed )
151
152 \ Load the remaining modules, if the kernel was loaded at all
153 ['] load_modules catch if 2r> restoreenv 100 exit then
154
155 \ Call autoboot to perform the booting
156 0 1 autoboot
157
158 \ Keep new module_path
159 2r> freeenv
160
161 exit
162 then ( could not load kernel with name passed )
163
164 2drop ( discard command line arguments )
165
166 else ( try just a straight-forward kernel load )
167 s" load ${kernel} ${kernel_options}" ['] evaluate catch
168 if ( kernel load failed ) 2drop 100 exit then
169
170 then ( there are command line arguments )
171
172 \ Load the remaining modules, if the kernel was loaded at all
173 ['] load_modules catch if 100 exit then
174
175 \ Call autoboot to perform the booting
176 0 1 autoboot
177;
178
179also forth definitions
180builtin: boot-conf
181only forth definitions also support-functions
182
183\ ***** check-password
184\
185\ If a password was defined, execute autoboot and ask for
186\ password if autoboot returns.
187
188: check-password
189 password .addr @ if
190 0 autoboot
191 false >r
192 begin
193 bell emit bell emit
194 ." Password: "
195 password .len @ read-password
196 dup password .len @ = if
197 2dup password .addr @ password .len @
198 compare 0= if r> drop true >r then
199 then
200 drop free drop
201 r@
202 until
203 r> drop
204 then
205;
206
207\ ***** start
208\
209\ Initializes support.4th global variables, sets loader_conf_files,
210\ process conf files, and, if any one such file was succesfully
211\ read to the end, load kernel and modules.
212
213: start ( -- ) ( throws: abort & user-defined )
214 s" /boot/defaults/loader.conf" initialize
215 include_conf_files
216 \ Will *NOT* try to load kernel and modules if no configuration file
217 \ was succesfully loaded!
218 any_conf_read? if
219 load_kernel
220 load_modules
221 then
222;
223
224\ ***** initialize
225\
226\ Overrides support.4th initialization word with one that does
227\ everything start one does, short of loading the kernel and
228\ modules. Returns a flag
229
230: initialize ( -- flag )
231 s" /boot/defaults/loader.conf" initialize
232 include_conf_files
233 any_conf_read?
234;
235
236\ ***** read-conf
237\
238\ Read a configuration file, whose name was specified on the command
239\ line, if interpreted, or given on the stack, if compiled in.
240
241: (read-conf) ( addr len -- )
242 conf_files .addr @ ?dup if free abort" Fatal error freeing memory" then
243 strdup conf_files .len ! conf_files .addr !
244 include_conf_files \ Will recurse on new loader_conf_files definitions
245;
246
247: read-conf ( <filename> | addr len -- ) ( throws: abort & user-defined )
248 state @ if
249 \ Compiling
250 postpone (read-conf)
251 else
252 \ Interpreting
253 bl parse (read-conf)
254 then
255; immediate
256
257\ ***** enable-module
258\
259\ Turn a module loading on.
260
261: enable-module ( <module> -- )
262 bl parse module_options @ >r
263 begin
264 r@
265 while
266 2dup
267 r@ module.name dup .addr @ swap .len @
268 compare 0= if
269 2drop
270 r@ module.name dup .addr @ swap .len @ type
271 true r> module.flag !
272 ." will be loaded." cr
273 exit
274 then
275 r> module.next @ >r
276 repeat
277 r> drop
278 type ." wasn't found." cr
279;
280
281\ ***** disable-module
282\
283\ Turn a module loading off.
284
285: disable-module ( <module> -- )
286 bl parse module_options @ >r
287 begin
288 r@
289 while
290 2dup
291 r@ module.name dup .addr @ swap .len @
292 compare 0= if
293 2drop
294 r@ module.name dup .addr @ swap .len @ type
295 false r> module.flag !
296 ." will not be loaded." cr
297 exit
298 then
299 r> module.next @ >r
300 repeat
301 r> drop
302 type ." wasn't found." cr
303;
304
305\ ***** toggle-module
306\
307\ Turn a module loading on/off.
308
309: toggle-module ( <module> -- )
310 bl parse module_options @ >r
311 begin
312 r@
313 while
314 2dup
315 r@ module.name dup .addr @ swap .len @
316 compare 0= if
317 2drop
318 r@ module.name dup .addr @ swap .len @ type
319 r@ module.flag @ 0= dup r> module.flag !
320 if
321 ." will be loaded." cr
322 else
323 ." will not be loaded." cr
324 then
325 exit
326 then
327 r> module.next @ >r
328 repeat
329 r> drop
330 type ." wasn't found." cr
331;
332
333\ ***** show-module
334\
335\ Show loading information about a module.
336
337: show-module ( <module> -- )
338 bl parse module_options @ >r
339 begin
340 r@
341 while
342 2dup
343 r@ module.name dup .addr @ swap .len @
344 compare 0= if
345 2drop
346 ." Name: " r@ module.name dup .addr @ swap .len @ type cr
347 ." Path: " r@ module.loadname dup .addr @ swap .len @ type cr
348 ." Type: " r@ module.type dup .addr @ swap .len @ type cr
349 ." Flags: " r@ module.args dup .addr @ swap .len @ type cr
350 ." Before load: " r@ module.beforeload dup .addr @ swap .len @ type cr
351 ." After load: " r@ module.afterload dup .addr @ swap .len @ type cr
352 ." Error: " r@ module.loaderror dup .addr @ swap .len @ type cr
353 ." Status: " r> module.flag @ if ." Load" else ." Don't load" then cr
354 exit
355 then
356 r> module.next @ >r
357 repeat
358 r> drop
359 type ." wasn't found." cr
360;
361
362\ Words to be used inside configuration files
363
364: retry false ; \ For use in load error commands
365: ignore true ; \ For use in load error commands
366
367\ Return to strict forth vocabulary
368
369only forth also
370