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