1 () ()
2
3
4
5 Copyright (c) 1999 Daniel C. Sobral <dcs@FreeBSD.org> Copyright (c)
6 2011-2015 Devin Teske <dteske@FreeBSD.org> All rights reserved.
7 Redistribution and use in source and binary forms, with or without
8 modification, are permitted provided that the following conditions are met:
9 1. Redistributions of source code must retain the above copyright notice,
10 this list of conditions and the following disclaimer. 2. Redistributions in
11 binary form must reproduce the above copyright notice, this list of
12 conditions and the following disclaimer in the documentation and/or other
13 materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE
14 AUTHOR AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
15 INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
16 FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
17 AUTHOR OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
18 SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
19 PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
20 OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
21 WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
22 OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
23 ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. $FreeBSD$
24
25 only forth definitions
26
27 s" arch-i386" environment? [if] [if] s" loader_version" environment? [if]
28 11 < [if] .( Loader version 1.1+ required) cr
29 abort [then] [else] .( Could not get loader
30 version!) cr abort [then] [then] [then]
31
32 include /boot/forth/support.4th include /boot/forth/color.4th include
33 /boot/forth/delay.4th include /boot/forth/check-password.4th s" efi-version"
34 getenv? [if] include /boot/forth/efi.4th [then]
35
36 only forth definitions
37
38 : bootmsg ( -- )
39 loader_color? dup ( -- bool bool )
40 if 7 fg 4 bg then
41 ." Booting..."
42 if me then
43 cr ;
44
45 : try-menu-unset
46 menu-unset may not be present
47 s" beastie_disable" getenv
48 dup -1 <> if
49 s" YES" compare-insensitive 0= if
50 exit
51 then
52 else
53 drop
54 then
55 s" menu-unset"
56 sfind if
57 execute
58 else
59 drop
60 then
61 s" menusets-unset"
62 sfind if
63 execute
64 else
65 drop
66 then ;
67
68 only forth also support-functions also builtins definitions
69
70 the boot-args was parsed to individual options while loaded now compose
71 boot-args, so the boot can set kernel arguments note the command line
72 switched for boot command will cause environment variable boot-args to be
73 ignored There are 2 larger strings, acpi-user-options and existing boot-args
74 other switches are 1 byte each, so allocate boot-args+acpi + extra bytes for
75 rest. Be sure to review this, if more options are to be added into
76 environment.
77
78 : set-boot-args { | addr len baddr blen aaddr alen -- }
79 s" boot-args" getenv dup -1 <> if
80 to blen to baddr
81 else
82 drop
83 then
84 s" acpi-user-options" getenv dup -1 <> if
85 to alen to aaddr
86 else
87 drop
88 then
89
90 allocate temporary space. max is:
91 7 kernel switches
92 26 for acpi, so use 40 for safety
93 blen alen 40 + + allocate abort" out of memory"
94 to addr
95 boot-addr may have file name before options, copy it to addr
96 baddr 0<> if
97 baddr c@ [char] - <> if
98 baddr blen [char] - strchr ( addr len )
99 dup 0= if no options, copy all
100 2drop
101 baddr addr blen move
102 blen to len
103 0 to blen
104 0 to baddr
105 else ( addr len )
106 dup blen
107 swap -
108 to len ( addr len )
109 to blen ( addr )
110 baddr addr len move ( addr )
111 to baddr baddr points now to first option
112 then
113 then
114 then
115 now add kernel switches
116 len 0<> if
117 bl addr len + c! len 1+ to len
118 then
119 [char] - addr len + c! len 1+ to len
120
121 s" boot_single" getenv dup -1 <> if
122 s" YES" compare-insensitive 0= if
123 [char] s addr len + c! len 1+ to len
124 then
125 else
126 drop
127 then
128 s" boot_verbose" getenv dup -1 <> if
129 s" YES" compare-insensitive 0= if
130 [char] v addr len + c! len 1+ to len
131 then
132 else
133 drop
134 then
135 s" boot_kmdb" getenv dup -1 <> if
136 s" YES" compare-insensitive 0= if
137 [char] k addr len + c! len 1+ to len
138 then
139 else
140 drop
141 then
142 s" boot_drop_into_kmdb" getenv dup -1 <> if
143 s" YES" compare-insensitive 0= if
144 [char] d addr len + c! len 1+ to len
145 then
146 else
147 drop
148 then
149 s" boot_reconfigure" getenv dup -1 <> if
150 s" YES" compare-insensitive 0= if
151 [char] r addr len + c! len 1+ to len
152 then
153 else
154 drop
155 then
156 s" boot_ask" getenv dup -1 <> if
157 s" YES" compare-insensitive 0= if
158 [char] a addr len + c! len 1+ to len
159 then
160 else
161 drop
162 then
163
164 now add remining boot args if blen != 0.
165 baddr[0] is '-', if baddr[1] != 'B' append to addr,
166 otherwise add space then copy
167 blen 0<> if
168 baddr 1+ c@ [char] B = if
169 addr len + 1- c@ [char] - = if if addr[len -1] == '-' baddr 1+
170 to baddr blen 1- to blen
171 else bl addr len + c! len 1+ to len
172 then
173 else
174 baddr 1+ to baddr
175 blen 1- to blen
176 then
177 baddr addr len + blen move
178 len blen + to len
179 0 to baddr
180 0 to blen
181 then
182 last part - add acpi.
183 alen 0<> if
184 addr len + 1- c@ [char] - <> if
185 bl addr len + c! len 1+ to len
186 [char] - addr len + c! len 1+ to len
187 then
188 s" B acpi-user-options=" dup -rot ( len addr len )
189 addr len + swap move ( len )
190 len + to len
191 aaddr addr len + alen move
192 len alen + to len
193 then
194
195 check for left over '-'
196 addr len 1- + c@ [char] - = if
197 len 1- to len but now we may also have left over ' '
198 len if ( len <> 0 )
199 addr len 1- + c@ bl = if len 1- to len
200 then
201 then
202 then
203
204 if len != 0, set boot-args
205 len 0<> if
206 addr len s" boot-args" setenv
207 then
208 addr free drop ;
209
210 : boot
211 0= if ( interpreted ) get_arguments then
212 set-boot-args
213
214 Unload only if a path was passed. Paths start with /
215 dup if
216 >r over r> swap
217 c@ [char] / = if
218 0 1 unload drop
219 else
220 s" kernelname" getenv? if ( a kernel has been loaded )
221 try-menu-unset
222 bootmsg 1 boot exit
223 then
224 load_kernel_and_modules
225 ?dup if exit then
226 try-menu-unset
227 bootmsg 0 1 boot exit
228 then
229 else
230 s" kernelname" getenv? if ( a kernel has been loaded )
231 try-menu-unset
232 bootmsg 1 boot exit
233 then
234 load_kernel_and_modules
235 ?dup if exit then
236 try-menu-unset
237 bootmsg 0 1 boot exit
238 then
239 load_kernel_and_modules
240 ?dup 0= if bootmsg 0 1 boot then ;
241
242 ***** boot-conf Prepares to boot as specified by loaded configuration
243 files.
244
245 : boot-conf
246 0= if ( interpreted ) get_arguments then
247 0 1 unload drop
248 load_kernel_and_modules
249 ?dup 0= if 0 1 autoboot then ;
250
251 also forth definitions previous
252
253 builtin: boot builtin: boot-conf
254
255 only forth definitions also support-functions
256
257 in case the boot-args is set, parse it and extract following options: -a
258 to boot_ask=YES -s to boot_single=YES -v to boot_verbose=YES -k to
259 boot_kmdb=YES -d to boot_drop_into_kmdb=YES -r to boot_reconfigure=YES -B
260 acpi-user-options=X to acpi-user-options=X This is needed so that the menu
261 can manage these options. Unfortunately, this also means that boot-args will
262 override previously set options, but we have no way to control the processing
263 order here. boot-args will be rebuilt at boot. NOTE: The best way to
264 address the order is to *not* set any above options in boot-args.
265
266 : parse-boot-args { | baddr blen -- }
267 s" boot-args" getenv dup -1 = if drop exit then
268 to blen
269 to baddr
270
271 baddr blen
272
273 loop over all instances of switch blocks, starting with '-'
274 begin
275 [char] - strchr
276 2dup to blen to baddr
277 dup 0<>
278 while ( addr len ) points to -
279 block for switch B. keep it on top of the stack for case
280 the property list will get empty.
281
282 over 1+ c@ [char] B = if 2dup save "-B ...." in case options
283 is empty 2 - swap 2 + ( addr len len-2 addr+2 ) skip -B
284
285 begin skip spaces
286 dup c@ bl =
287 while
288 1+ swap 1- swap
289 repeat
290
291 ( addr len len' addr' )
292 its 3 cases now: end of string, -switch, or option list
293
294 over 0= if end of string, remove trailing -B 2drop
295 ( addr len ) swap 0 swap c! store 0 at -B blen
296 swap ( blen len ) - ( rem ) baddr swap ( addr
297 rem ) dup 0= if s" boot-args" unsetenv 2drop exit
298 then trailing space(s) begin over
299 ( addr rem addr ) over + 1- ( addr rem addr+rem-1 )
300 c@ bl = while 1- swap ( rem-1 addr ) over
301 ( rem-1 addr rem-1 ) over + ( rem-1 addr addr+rem-1
302 ) 0 swap c! swap repeat s" boot-args" setenv recurse
303 restart exit
304 then ( addr len len' addr' )
305 dup c@ [char] - = if it is switch. set to boot-args swap s" boot-
306 args" setenv 2drop recurse restart exit
307 then ( addr len len' addr' )
308 its options string "option1,option2,... -..."
309 cut acpi-user-options=xxx and restart the parser
310 or skip to next option block
311 begin dup c@ dup 0<> swap bl <> and stop if space or 0
312 while dup 18 s" acpi-user-options=" compare 0= if matched
313 ( addr len len' addr' ) addr' points to acpi options,
314 find its end [',' or ' ' or 0 ] set it as acpi-user-options and move
315 remaining to addr' 2dup ( addr len len' addr' len' addr' )
316 skip to next option in list loop to first , or bl or 0
317 begin dup c@ [char] , <> >r dup c@ bl <> >r dup
318 c@ 0<> r> r> and and while 1+ swap 1- swap repeat
319 ( addr len len' addr' len" addr" ) >r >r (
320 addr len len' addr' R: addr" len" ) over r@ - ( addr len len'
321 addr' proplen R: addr" len" ) dup 5 + ( addr len len' addr'
322 proplen proplen+5 ) allocate abort" out of memory"
323
324 0 s" set " strcat ( addr len len' addr' proplen caddr clen ) >r >r
325 2dup r> r> 2swap strcat ( addr len len' addr' proplen caddr clen ) 2dup +
326 0 swap c! terminate with 0 2dup evaluate drop free drop
327 ( addr len len' addr' proplen R: addr" len" ) acpi-
328 user-options is set, now move remaining string to its place. addr: -B,
329 addr': acpi... addr": reminder swap ( addr len len' proplen
330 addr' ) r> r> ( addr len len' proplen addr' len" addr" )
331 dup c@ [char] , = if skip , and move addr" to addr' 1+
332 swap 1- ( addr len len' proplen addr' addr" len" ) rot swap 1+
333 move ( addr len len' proplen ) else its bl or 0 ( addr len len'
334 proplen addr' len" addr" ) for both bl and 0 we need to copy to
335 addr'-1 to remove comma, then reset boot-args, and recurse will clear
336 -B if there are no properties left. dup c@ 0= if 2drop
337 ( addr len len' proplen addr' ) 1- 0 swap c! ( addr len
338 len' proplen ) else >r >r ( addr len len' proplen
339 addr' R: addr" len" ) 1- swap 1+ swap r> r> ( addr
340 len len' proplen addr' len" addr" ) rot rot move ( addr len len'
341 proplen ) then then
342
343 2swap 2drop ( len' proplen ) nip ( proplen )
344 baddr blen rot - s" boot-args" setenv recurse exit
345 else ( addr len len' addr' ) not acpi option,
346 skip to next option in list loop to first , or bl or 0 begin
347 dup c@ [char] , <> >r dup c@ bl <> >r dup c@ 0<> r>
348 r> and and while 1+ swap 1- swap repeat if its ',',
349 skip over dup c@ [char] , = if 1+ swap 1- swap then
350 then
351 repeat ( addr len len' addr' )
352 this block is done, remove addr and len from stack
353 2swap 2drop swap
354 then
355
356 over c@ [char] - = if ( addr len )
357 2dup 1- swap 1+ ( addr len len' addr' )
358 begin loop till ' ' or 0 dup c@ dup 0<> swap bl <>
359 and
360 while dup c@ [char] s = if s" set boot_single=YES" evaluate
361 TRUE else dup c@ [char] v = if s" set boot_verbose=YES" evaluate
362 TRUE else dup c@ [char] k = if s" set boot_kmdb=YES" evaluate TRUE
363 else dup c@ [char] d = if s" set boot_drop_into_kmdb=YES" evaluate
364 TRUE else dup c@ [char] r = if s" set boot_reconfigure=YES"
365 evaluate TRUE else dup c@ [char] a = if s" set boot_ask=YES" evaluate
366 TRUE then then then then then then dup TRUE = if drop dup >r
367 ( addr len len' addr' R: addr' ) 1+ swap 1- ( addr len
368 addr'+1 len'-1 R: addr' ) r> swap move ( addr len )
369
370 2drop baddr blen 1- check if we have space after '-', if so, drop
371 '- ' swap dup 1+ c@ bl = if 2 + swap 2 - else
372 swap then dup dup 0= swap 1 = or if empty or only '-'
373 is left. 2drop s" boot-args" unsetenv exit else
374 s" boot-args" setenv then recurse exit then
375 1+ swap 1- swap
376 repeat
377
378 2swap 2drop
379 dup c@ 0= if end of string 2drop exit
380 else swap
381 then
382 then
383 repeat
384
385 2drop ;
386
387 ***** start Initializes support.4th global variables, sets
388 loader_conf_files, processes conf files, and, if any one such file was
389 successfully read to the end, loads kernel and modules.
390
391 : start ( -- ) ( throws: abort & user-defined )
392 s" /boot/defaults/loader.conf" initialize
393 include_bootenv
394 include_conf_files
395 include_transient
396 If the user defined a post-initialize hook, call it now
397 s" post-initialize" sfind if execute else drop then
398 parse-boot-args
399 Will *NOT* try to load kernel and modules if no configuration file
400 was successfully loaded!
401 any_conf_read? if
402 s" loader_delay" getenv -1 = if
403 load_xen_throw
404 load_kernel
405 load_modules
406 else
407 drop
408 ." Loading Kernel and Modules (Ctrl-C to Abort)" cr
409 s" also support-functions" evaluate
410 s" set delay_command='load_xen_throw load_kernel load_modules'" evaluate
411 s" set delay_showdots" evaluate
412 delay_execute
413 then
414 then ;
415
416 ***** initialize Overrides support.4th initialization word with one that
417 does everything start one does, short of loading the kernel and modules.
418 Returns a flag.
419
420 : initialize ( -- flag )
421 s" /boot/defaults/loader.conf" initialize
422 include_bootenv
423 include_conf_files
424 include_transient
425 If the user defined a post-initialize hook, call it now
426 s" post-initialize" sfind if execute else drop then
427 parse-boot-args
428 any_conf_read? ;
429
430 ***** read-conf Read a configuration file, whose name was specified on the
431 command line, if interpreted, or given on the stack, if compiled in.
432
433 : (read-conf) ( addr len -- )
434 conf_files string=
435 include_conf_files Will recurse on new loader_conf_files definitions ;
436
437 : read-conf ( <filename> | addr len -- ) ( throws: abort & user-defined )
438 state @ if
439 Compiling
440 postpone (read-conf)
441 else
442 Interpreting
443 bl parse (read-conf)
444 then ; immediate
445
446 show, enable, disable, toggle module loading. They all take module from the
447 next word
448
449 : set-module-flag ( module_addr val -- ) set and print flag
450 over module.flag !
451 dup module.name strtype
452 module.flag @ if ." will be loaded" else ." will not be loaded" then cr ;
453
454 : enable-module find-module ?dup if true set-module-flag then ;
455
456 : disable-module find-module ?dup if false set-module-flag then ;
457
458 : toggle-module find-module ?dup if dup module.flag @ 0= set-module-flag then
459 ;
460
461 ***** show-module Show loading information about a module.
462
463 : show-module ( <module> -- ) find-module ?dup if show-one-module then ;
464
465 : set-module-path ( addr len <module> -- )
466 find-module ?dup if
467 module.loadname string=
468 then ;
469
470 Words to be used inside configuration files
471
472 : retry false ; For use in load error commands : ignore true ;
473 For use in load error commands
474
475 Return to strict forth vocabulary
476
477 : #type
478 over - >r
479 type
480 r> spaces ;
481
482 : .? 2 spaces 2swap 15 #type 2 spaces type cr ;
483
484 : ?
485 ['] ? execute
486 s" boot-conf" s" load kernel and modules, then autoboot" .?
487 s" read-conf" s" read a configuration file" .?
488 s" enable-module" s" enable loading of a module" .?
489 s" disable-module" s" disable loading of a module" .?
490 s" toggle-module" s" toggle loading of a module" .?
491 s" show-module" s" show module load data" .?
492 s" try-include" s" try to load/interpret files" .?
493 s" beadm" s" list or activate Boot Environments" .? ;
494
495 : try-include ( -- ) see loader.4th(8)
496 ['] include ( -- xt ) get the execution token of `include'
497 catch ( xt -- exception# | 0 ) if failed
498 LF parse ( c -- s-addr/u ) 2drop advance >in to EOL (drop data)
499 ... prevents words unused by `include' from being interpreted
500 then ; immediate interpret immediately for access to `source' (aka tib)
501
502 include /boot/forth/beadm.4th only forth definitions
503
504
505
506 August 28, 2019 ()