freebsd-dev/sys/boot/forth/loader.4th
Daniel C. Sobral 80a1a63ef5 Enhance boot-conf.
Now boot-conf can also receive parameters to be passed to the kernel
being booted. The syntax is the same as in the boot command, so one
boots /kernel.OLD in single-user mode by typing:

boot-conf /kernel.OLD -s   instead of
boot-conf -s /kernel.OLD

The syntax still supports use of directory instead of file name, so

boot-conf kernel.OLD -s

may be used to boot /boot/kernel.OLD/kernel.ko in single-user mode.

Notice that if one passes a flag to boot-conf, it will override the
flags set in .conf files, but only for that invocation. If the user
aborts the countdown and tries again without passing any flags, the
flags set in .conf files will be used.

Some factorization was done in the process of enhancing boot-conf,
as it has been growing steadly as features are getting added, becoming
too big for a Forth word. It still could do with more factorization,
as a matter of fact.

Override the builtin "boot" with something based on boot-conf. It will
behave exactly like boot-conf, but booting directly instead of going
through autoboot.

Since we are now pairing kernel and module set in the same directory,
this change to boot makes sense.
2000-09-08 21:11:57 +00:00

465 lines
10 KiB
Forth

\ Copyright (c) 1999 Daniel C. Sobral <dcs@freebsd.org>
\ All rights reserved.
\
\ Redistribution and use in source and binary forms, with or without
\ modification, are permitted provided that the following conditions
\ are met:
\ 1. Redistributions of source code must retain the above copyright
\ notice, this list of conditions and the following disclaimer.
\ 2. Redistributions in binary form must reproduce the above copyright
\ notice, this list of conditions and the following disclaimer in the
\ documentation and/or other materials provided with the distribution.
\
\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
\ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
\ SUCH DAMAGE.
\
\ $FreeBSD$
s" arch-alpha" environment? [if] [if]
s" loader_version" environment? [if]
3 < [if]
.( Loader version 0.3+ required) cr
abort
[then]
[else]
.( Could not get loader version!) cr
abort
[then]
[then] [then]
s" arch-i386" environment? [if] [if]
s" loader_version" environment? [if]
8 < [if]
.( Loader version 0.8+ required) cr
abort
[then]
[else]
.( Could not get loader version!) cr
abort
[then]
[then] [then]
include /boot/support.4th
only forth definitions also support-functions
\ ***** boot-conf
\
\ Prepares to boot as specified by loaded configuration files.
also support-functions definitions
: bootpath s" /boot/" ;
: modulepath s" module_path" ;
: saveenv ( addr len | 0 -1 -- addr' len | 0 -1 )
dup -1 = if exit then
dup allocate abort" Out of memory"
swap 2dup 2>r
move
2r>
;
: freeenv ( addr len | 0 -1 )
-1 = if drop else free abort" Freeing error" then
;
: restoreenv ( addr len | 0 -1 -- )
dup -1 = if ( it wasn't set )
2drop
modulepath unsetenv
else
over >r
modulepath setenv
r> free abort" Freeing error"
then
;
: set-tempoptions ( addrN lenN ... addr1 len1 N -- addr len 1 | 0 )
\ No options, set the default ones
dup 0= if
s" kernel_options" getenv dup -1 = if
drop
else
s" temp_options" setenv
then
exit
then
\ Skip filename
2 pick
c@
[char] - <> if
swap >r swap >r
1 >r \ Filename present
1 - \ One less argument
else
0 >r \ Filename not present
then
\ If no other arguments exist, use default options
?dup 0= if
s" kernel_options" getenv dup -1 = if
drop
else
s" temp_options" setenv
then
\ Put filename back on the stack, if necessary
r> if r> r> 1 else 0 then
exit
then
\ Concatenate remaining arguments into a single string
>r strdup r>
1 ?do
\ Allocate new buffer
2over nip over + 1+
allocate if out_of_memory throw then
\ Copy old buffer over
0 2swap over >r strcat
\ Free old buffer
r> free if free_error throw then
\ Copy a space
s" " strcat
\ Copy next string (do not free)
2swap strcat
loop
\ Set temp_options variable, free whatever memory that needs freeing
over >r
s" temp_options" setenv
r> free if free_error throw then
\ Put filename back on the stack, if necessary
r> if r> r> 1 else 0 then
;
: get-arguments ( -- addrN lenN ... addr1 len1 N )
0
begin
\ Get next word on the command line
parse-word
?dup while
2>r ( push to the rstack, so we can retrieve in the correct order )
1+
repeat
drop ( empty string )
dup
begin
dup
while
2r> rot
>r rot r>
1 -
repeat
drop
;
also builtins
: load-kernel ( addr len -- addr len error? )
s" temp_options" getenv dup -1 = if
drop 2dup 1
else
2over 2
then
1 load
;
: load-conf ( args 1 | 0 "args" -- flag )
0 1 unload drop
0= if ( interpreted ) get-arguments then
set-tempoptions
if ( there are arguments )
load-kernel if ( load command failed )
\ Set the environment variable module_path, and try loading
\ the kernel again.
\ First, save module_path value
modulepath getenv saveenv dup -1 = if 0 swap then 2>r
\ Sets the new value
2dup modulepath setenv
\ Try to load the kernel
s" load ${kernel} ${temp_options}" ['] evaluate catch
if ( load failed yet again )
\ Remove garbage from the stack
2drop
\ Try prepending /boot/
bootpath 2over nip over + allocate
if ( out of memory )
2drop 2drop
2r> restoreenv
100 exit
then
0 2swap strcat 2swap strcat
2dup modulepath setenv
drop free if ( freeing memory error )
2drop
2r> restoreenv
100 exit
then
\ Now, once more, try to load the kernel
s" load ${kernel} ${temp_options}" ['] evaluate catch
if ( failed once more )
2drop
2r> restoreenv
100 exit
then
else ( we found the kernel on the path passed )
2drop ( discard command line arguments )
then ( could not load kernel from directory passed )
\ Load the remaining modules, if the kernel was loaded at all
['] load_modules catch if 2r> restoreenv 100 exit then
\ Return 0 to indicate success
0
\ Keep new module_path
2r> freeenv
exit
then ( could not load kernel with name passed )
2drop ( discard command line arguments )
else ( try just a straight-forward kernel load )
s" load ${kernel} ${temp_options}" ['] evaluate catch
if ( kernel load failed ) 2drop 100 exit then
then ( there are command line arguments )
\ Load the remaining modules, if the kernel was loaded at all
['] load_modules catch if 100 exit then
\ Return 0 to indicate success
0
;
only forth also support-functions also builtins definitions
: boot
load-conf
?dup 0= if 0 1 boot then
;
: boot-conf
load-conf
?dup 0= if 0 1 autoboot then
;
also forth definitions also builtins
builtin: boot
builtin: boot-conf
only forth definitions also support-functions
\ ***** check-password
\
\ If a password was defined, execute autoboot and ask for
\ password if autoboot returns.
: check-password
password .addr @ if
0 autoboot
false >r
begin
bell emit bell emit
." Password: "
password .len @ read-password
dup password .len @ = if
2dup password .addr @ password .len @
compare 0= if r> drop true >r then
then
drop free drop
r@
until
r> drop
then
;
\ ***** start
\
\ Initializes support.4th global variables, sets loader_conf_files,
\ process conf files, and, if any one such file was succesfully
\ read to the end, load kernel and modules.
: start ( -- ) ( throws: abort & user-defined )
s" /boot/defaults/loader.conf" initialize
include_conf_files
\ Will *NOT* try to load kernel and modules if no configuration file
\ was succesfully loaded!
any_conf_read? if
load_kernel
load_modules
then
;
\ ***** initialize
\
\ Overrides support.4th initialization word with one that does
\ everything start one does, short of loading the kernel and
\ modules. Returns a flag
: initialize ( -- flag )
s" /boot/defaults/loader.conf" initialize
include_conf_files
any_conf_read?
;
\ ***** read-conf
\
\ Read a configuration file, whose name was specified on the command
\ line, if interpreted, or given on the stack, if compiled in.
: (read-conf) ( addr len -- )
conf_files .addr @ ?dup if free abort" Fatal error freeing memory" then
strdup conf_files .len ! conf_files .addr !
include_conf_files \ Will recurse on new loader_conf_files definitions
;
: read-conf ( <filename> | addr len -- ) ( throws: abort & user-defined )
state @ if
\ Compiling
postpone (read-conf)
else
\ Interpreting
bl parse (read-conf)
then
; immediate
\ ***** enable-module
\
\ Turn a module loading on.
: enable-module ( <module> -- )
bl parse module_options @ >r
begin
r@
while
2dup
r@ module.name dup .addr @ swap .len @
compare 0= if
2drop
r@ module.name dup .addr @ swap .len @ type
true r> module.flag !
." will be loaded." cr
exit
then
r> module.next @ >r
repeat
r> drop
type ." wasn't found." cr
;
\ ***** disable-module
\
\ Turn a module loading off.
: disable-module ( <module> -- )
bl parse module_options @ >r
begin
r@
while
2dup
r@ module.name dup .addr @ swap .len @
compare 0= if
2drop
r@ module.name dup .addr @ swap .len @ type
false r> module.flag !
." will not be loaded." cr
exit
then
r> module.next @ >r
repeat
r> drop
type ." wasn't found." cr
;
\ ***** toggle-module
\
\ Turn a module loading on/off.
: toggle-module ( <module> -- )
bl parse module_options @ >r
begin
r@
while
2dup
r@ module.name dup .addr @ swap .len @
compare 0= if
2drop
r@ module.name dup .addr @ swap .len @ type
r@ module.flag @ 0= dup r> module.flag !
if
." will be loaded." cr
else
." will not be loaded." cr
then
exit
then
r> module.next @ >r
repeat
r> drop
type ." wasn't found." cr
;
\ ***** show-module
\
\ Show loading information about a module.
: show-module ( <module> -- )
bl parse module_options @ >r
begin
r@
while
2dup
r@ module.name dup .addr @ swap .len @
compare 0= if
2drop
." Name: " r@ module.name dup .addr @ swap .len @ type cr
." Path: " r@ module.loadname dup .addr @ swap .len @ type cr
." Type: " r@ module.type dup .addr @ swap .len @ type cr
." Flags: " r@ module.args dup .addr @ swap .len @ type cr
." Before load: " r@ module.beforeload dup .addr @ swap .len @ type cr
." After load: " r@ module.afterload dup .addr @ swap .len @ type cr
." Error: " r@ module.loaderror dup .addr @ swap .len @ type cr
." Status: " r> module.flag @ if ." Load" else ." Don't load" then cr
exit
then
r> module.next @ >r
repeat
r> drop
type ." wasn't found." cr
;
\ Words to be used inside configuration files
: retry false ; \ For use in load error commands
: ignore true ; \ For use in load error commands
\ Return to strict forth vocabulary
only forth also