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