144603Sdcs\ Copyright (c) 1999 Daniel C. Sobral <dcs@freebsd.org> 244603Sdcs\ All rights reserved. 344603Sdcs\ 444603Sdcs\ Redistribution and use in source and binary forms, with or without 544603Sdcs\ modification, are permitted provided that the following conditions 644603Sdcs\ are met: 744603Sdcs\ 1. Redistributions of source code must retain the above copyright 844603Sdcs\ notice, this list of conditions and the following disclaimer. 944603Sdcs\ 2. Redistributions in binary form must reproduce the above copyright 1044603Sdcs\ notice, this list of conditions and the following disclaimer in the 1144603Sdcs\ documentation and/or other materials provided with the distribution. 1244603Sdcs\ 1344603Sdcs\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 1444603Sdcs\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 1544603Sdcs\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 1644603Sdcs\ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 1744603Sdcs\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 1844603Sdcs\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 1944603Sdcs\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 2044603Sdcs\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 2144603Sdcs\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 2244603Sdcs\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 2344603Sdcs\ SUCH DAMAGE. 2444603Sdcs\ 2550477Speter\ $FreeBSD$ 2644603Sdcs 2761694Sdcss" arch-i386" environment? [if] [if] 2861694Sdcs s" loader_version" environment? [if] 2987636Sjhb 11 < [if] 3087636Sjhb .( Loader version 1.1+ required) cr 3161694Sdcs abort 3261694Sdcs [then] 3361694Sdcs [else] 3461694Sdcs .( Could not get loader version!) cr 3561694Sdcs abort 3661694Sdcs [then] 3761694Sdcs[then] [then] 3861379Sdcs 3977444Sdcs256 dictthreshold ! \ 256 cells minimum free space 4077444Sdcs2048 dictincrease ! \ 2048 additional cells each time 4177444Sdcs 4244603Sdcsinclude /boot/support.4th 43241361Sdteskeinclude /boot/color.4th 44262702Sdteskeinclude /boot/delay.4th 4544603Sdcs 4665883Sdcsonly forth also support-functions also builtins definitions 4761376Sdcs 48262701Sdteske: bootmsg ( -- ) 49262701Sdteske loader_color? if 50262701Sdteske ." [37;44mBooting...[0m" cr 51262701Sdteske else 52262701Sdteske ." Booting..." cr 53262701Sdteske then 54262701Sdteske; 55262701Sdteske 56228985Spluknet: try-menu-unset 57229881Spluknet \ menu-unset may not be present 58229881Spluknet s" beastie_disable" getenv 59229881Spluknet dup -1 <> if 60229881Spluknet s" YES" compare-insensitive 0= if 61229881Spluknet exit 62229881Spluknet then 63229881Spluknet else 64229881Spluknet drop 65229881Spluknet then 66228985Spluknet s" menu-unset" 67229881Spluknet sfind if 68229881Spluknet execute 69229881Spluknet else 70229881Spluknet drop 71228985Spluknet then 72242667Sdteske s" menusets-unset" 73242667Sdteske sfind if 74242667Sdteske execute 75242667Sdteske else 76242667Sdteske drop 77242667Sdteske then 78228985Spluknet; 79228985Spluknet 8065883Sdcs: boot 8165949Sdcs 0= if ( interpreted ) get_arguments then 8261376Sdcs 8365630Sdcs \ Unload only if a path was passed 8465883Sdcs dup if 8565883Sdcs >r over r> swap 8665630Sdcs c@ [char] - <> if 8765630Sdcs 0 1 unload drop 8865630Sdcs else 8966871Sdcs s" kernelname" getenv? if ( a kernel has been loaded ) 90228985Spluknet try-menu-unset 91262701Sdteske bootmsg 1 boot exit 9265938Sdcs then 9366871Sdcs load_kernel_and_modules 9466871Sdcs ?dup if exit then 95228985Spluknet try-menu-unset 96262701Sdteske bootmsg 0 1 boot exit 9765630Sdcs then 9865630Sdcs else 9966871Sdcs s" kernelname" getenv? if ( a kernel has been loaded ) 100228985Spluknet try-menu-unset 101262701Sdteske bootmsg 1 boot exit 10265938Sdcs then 10366871Sdcs load_kernel_and_modules 10466871Sdcs ?dup if exit then 105228985Spluknet try-menu-unset 106262701Sdteske bootmsg 0 1 boot exit 10765630Sdcs then 10865945Sdcs load_kernel_and_modules 109262701Sdteske ?dup 0= if bootmsg 0 1 boot then 11065621Sdcs; 11165621Sdcs 112228985Spluknet\ ***** boot-conf 113228985Spluknet\ 114228985Spluknet\ Prepares to boot as specified by loaded configuration files. 115228985Spluknet 11665621Sdcs: boot-conf 11765949Sdcs 0= if ( interpreted ) get_arguments then 11865630Sdcs 0 1 unload drop 11965945Sdcs load_kernel_and_modules 12065621Sdcs ?dup 0= if 0 1 autoboot then 12165621Sdcs; 12265621Sdcs 12365621Sdcsalso forth definitions also builtins 12465883Sdcs 12565621Sdcsbuiltin: boot 12661376Sdcsbuiltin: boot-conf 12765883Sdcs 12861376Sdcsonly forth definitions also support-functions 12961376Sdcs 130222417Sjulianinclude /boot/check-password.4th 13153672Sdcs 13244603Sdcs\ ***** start 13344603Sdcs\ 13444603Sdcs\ Initializes support.4th global variables, sets loader_conf_files, 135262701Sdteske\ processes conf files, and, if any one such file was succesfully 136262701Sdteske\ read to the end, loads kernel and modules. 13744603Sdcs 13844603Sdcs: start ( -- ) ( throws: abort & user-defined ) 13944603Sdcs s" /boot/defaults/loader.conf" initialize 14044603Sdcs include_conf_files 14197201Sgordon include_nextboot_file 14244603Sdcs \ Will *NOT* try to load kernel and modules if no configuration file 14344603Sdcs \ was succesfully loaded! 14444603Sdcs any_conf_read? if 145262702Sdteske s" loader_delay" getenv -1 = if 146262702Sdteske load_kernel 147262702Sdteske load_modules 148262702Sdteske else 149262702Sdteske drop 150262702Sdteske ." Loading Kernel and Modules (Ctrl-C to Abort)" cr 151262702Sdteske s" also support-functions" evaluate 152262702Sdteske s" set delay_command='load_kernel load_modules'" evaluate 153262702Sdteske s" set delay_showdots" evaluate 154262702Sdteske delay_execute 155262702Sdteske then 15644603Sdcs then 15744603Sdcs; 15844603Sdcs 15947198Sdcs\ ***** initialize 16047198Sdcs\ 16147198Sdcs\ Overrides support.4th initialization word with one that does 16247198Sdcs\ everything start one does, short of loading the kernel and 16347198Sdcs\ modules. Returns a flag 16447198Sdcs 16547198Sdcs: initialize ( -- flag ) 16647198Sdcs s" /boot/defaults/loader.conf" initialize 16747198Sdcs include_conf_files 16897201Sgordon include_nextboot_file 16947198Sdcs any_conf_read? 17047198Sdcs; 17147198Sdcs 17244603Sdcs\ ***** read-conf 17344603Sdcs\ 17444603Sdcs\ Read a configuration file, whose name was specified on the command 17544603Sdcs\ line, if interpreted, or given on the stack, if compiled in. 17644603Sdcs 17744603Sdcs: (read-conf) ( addr len -- ) 178186789Sluigi conf_files string= 17944603Sdcs include_conf_files \ Will recurse on new loader_conf_files definitions 18044603Sdcs; 18144603Sdcs 18244603Sdcs: read-conf ( <filename> | addr len -- ) ( throws: abort & user-defined ) 18344603Sdcs state @ if 18444603Sdcs \ Compiling 18544603Sdcs postpone (read-conf) 18644603Sdcs else 18744603Sdcs \ Interpreting 18844603Sdcs bl parse (read-conf) 18944603Sdcs then 19044603Sdcs; immediate 19144603Sdcs 192186789Sluigi\ show, enable, disable, toggle module loading. They all take module from 193186789Sluigi\ the next word 19446005Sdcs 195186789Sluigi: set-module-flag ( module_addr val -- ) \ set and print flag 196186789Sluigi over module.flag ! 197186789Sluigi dup module.name strtype 198186789Sluigi module.flag @ if ." will be loaded" else ." will not be loaded" then cr 19946005Sdcs; 20046005Sdcs 201186789Sluigi: enable-module find-module ?dup if true set-module-flag then ; 20246005Sdcs 203186789Sluigi: disable-module find-module ?dup if false set-module-flag then ; 20446005Sdcs 205186789Sluigi: toggle-module find-module ?dup if dup module.flag @ 0= set-module-flag then ; 20646005Sdcs 20744603Sdcs\ ***** show-module 20844603Sdcs\ 20944603Sdcs\ Show loading information about a module. 21044603Sdcs 211186789Sluigi: show-module ( <module> -- ) find-module ?dup if show-one-module then ; 21244603Sdcs 21344603Sdcs\ Words to be used inside configuration files 21444603Sdcs 21544603Sdcs: retry false ; \ For use in load error commands 21644603Sdcs: ignore true ; \ For use in load error commands 21744603Sdcs 21844603Sdcs\ Return to strict forth vocabulary 21944603Sdcs 22065949Sdcs: #type 22165949Sdcs over - >r 22265949Sdcs type 22365949Sdcs r> spaces 22465949Sdcs; 22565949Sdcs 22665949Sdcs: .? 2 spaces 2swap 15 #type 2 spaces type cr ; 22765949Sdcs 22865949Sdcs: ? 22965949Sdcs ['] ? execute 23065949Sdcs s" boot-conf" s" load kernel and modules, then autoboot" .? 23165949Sdcs s" read-conf" s" read a configuration file" .? 23265949Sdcs s" enable-module" s" enable loading of a module" .? 23365949Sdcs s" disable-module" s" disable loading of a module" .? 23465949Sdcs s" toggle-module" s" toggle loading of a module" .? 23565949Sdcs s" show-module" s" show module load data" .? 236262704Sdteske s" try-include" s" try to load/interpret files" .? 23765949Sdcs; 23865949Sdcs 239262704Sdteske: try-include ( -- ) \ see loader.4th(8) 240262704Sdteske ['] include ( -- xt ) \ get the execution token of `include' 241262704Sdteske catch ( xt -- exception# | 0 ) if \ failed 242262704Sdteske LF parse ( c -- s-addr/u ) 2drop \ advance >in to EOL (drop data) 243262704Sdteske \ ... prevents words unused by `include' from being interpreted 244262704Sdteske then 245262704Sdteske; immediate \ interpret immediately for access to `source' (aka tib) 246262704Sdteske 24744603Sdcsonly forth also 24847198Sdcs 249