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