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$ 27 28only forth definitions 29 30\ provide u> if needed 31s" u>" sfind [if] drop [else] 32 drop 33: u> 34 2dup u< if 2drop 0 exit then 35 swap u< if -1 exit then 36 0 37; 38[then] 39 40\ provide xemit if needed 41s" xemit" sfind [if] drop [else] 42 drop 43: xemit 44 dup 0x80 u< if emit exit then 45 0 swap 0x3F 46 begin 2dup u> while 47 2/ >r dup 0x3F and 0x80 or swap 6 rshift r> 48 repeat 0x7F xor 2* or 49 begin dup 0x80 u< 0= while emit repeat drop 50; 51[then] 52 53s" arch-i386" environment? [if] [if] 54 s" loader_version" environment? [if] 55 11 < [if] 56 .( Loader version 1.1+ required) cr 57 abort 58 [then] 59 [else] 60 .( Could not get loader version!) cr 61 abort 62 [then] 63[then] [then] 64 65256 dictthreshold ! \ 256 cells minimum free space 662048 dictincrease ! \ 2048 additional cells each time 67 68include /boot/support.4th 69include /boot/color.4th 70include /boot/delay.4th 71include /boot/check-password.4th 72 73only forth definitions 74 75: bootmsg ( -- ) 76 loader_color? dup ( -- bool bool ) 77 if 7 fg 4 bg then 78 ." Booting..." 79 if me then 80 cr 81; 82 83: try-menu-unset 84 \ menu-unset may not be present 85 s" beastie_disable" getenv 86 dup -1 <> if 87 s" YES" compare-insensitive 0= if 88 exit 89 then 90 else 91 drop 92 then 93 s" menu-unset" 94 sfind if 95 execute 96 else 97 drop 98 then 99 s" menusets-unset" 100 sfind if 101 execute 102 else 103 drop 104 then 105; 106 107only forth also support-functions also builtins definitions 108 109: boot 110 0= if ( interpreted ) get_arguments then 111 112 \ Unload only if a path was passed 113 dup if 114 >r over r> swap 115 c@ [char] - <> if 116 0 1 unload drop 117 else 118 s" kernelname" getenv? if ( a kernel has been loaded ) 119 try-menu-unset 120 bootmsg 1 boot exit 121 then 122 load_kernel_and_modules 123 ?dup if exit then 124 try-menu-unset 125 bootmsg 0 1 boot exit 126 then 127 else 128 s" kernelname" getenv? if ( a kernel has been loaded ) 129 try-menu-unset 130 bootmsg 1 boot exit 131 then 132 load_kernel_and_modules 133 ?dup if exit then 134 try-menu-unset 135 bootmsg 0 1 boot exit 136 then 137 load_kernel_and_modules 138 ?dup 0= if bootmsg 0 1 boot then 139; 140 141\ ***** boot-conf 142\ 143\ Prepares to boot as specified by loaded configuration files. 144 145: boot-conf 146 0= if ( interpreted ) get_arguments then 147 0 1 unload drop 148 load_kernel_and_modules 149 ?dup 0= if 0 1 autoboot then 150; 151 152also forth definitions previous 153 154builtin: boot 155builtin: boot-conf 156 157only forth definitions also support-functions 158 159\ ***** start 160\ 161\ Initializes support.4th global variables, sets loader_conf_files, 162\ processes conf files, and, if any one such file was successfully 163\ read to the end, loads kernel and modules. 164 165: start ( -- ) ( throws: abort & user-defined ) 166 s" /boot/defaults/loader.conf" initialize 167 include_conf_files 168 include_nextboot_file 169 \ If the user defined a post-initialize hook, call it now 170 s" post-initialize" sfind if execute else drop then 171 \ Will *NOT* try to load kernel and modules if no configuration file 172 \ was successfully loaded! 173 any_conf_read? if 174 s" loader_delay" getenv -1 = if 175 load_xen_throw 176 load_kernel 177 load_modules 178 else 179 drop 180 ." Loading Kernel and Modules (Ctrl-C to Abort)" cr 181 s" also support-functions" evaluate 182 s" set delay_command='load_xen_throw load_kernel load_modules'" evaluate 183 s" set delay_showdots" evaluate 184 delay_execute 185 then 186 then 187; 188 189\ ***** initialize 190\ 191\ Overrides support.4th initialization word with one that does 192\ everything start one does, short of loading the kernel and 193\ modules. Returns a flag. 194 195: initialize ( -- flag ) 196 s" /boot/defaults/loader.conf" initialize 197 include_conf_files 198 include_nextboot_file 199 \ If the user defined a post-initialize hook, call it now 200 s" post-initialize" sfind if execute else drop then 201 any_conf_read? 202; 203 204\ ***** read-conf 205\ 206\ Read a configuration file, whose name was specified on the command 207\ line, if interpreted, or given on the stack, if compiled in. 208 209: (read-conf) ( addr len -- ) 210 conf_files string= 211 include_conf_files \ Will recurse on new loader_conf_files definitions 212; 213 214: read-conf ( <filename> | addr len -- ) ( throws: abort & user-defined ) 215 state @ if 216 \ Compiling 217 postpone (read-conf) 218 else 219 \ Interpreting 220 bl parse (read-conf) 221 then 222; immediate 223 224\ show, enable, disable, toggle module loading. They all take module from 225\ the next word 226 227: set-module-flag ( module_addr val -- ) \ set and print flag 228 over module.flag ! 229 dup module.name strtype 230 module.flag @ if ." will be loaded" else ." will not be loaded" then cr 231; 232 233: enable-module find-module ?dup if true set-module-flag then ; 234 235: disable-module find-module ?dup if false set-module-flag then ; 236 237: toggle-module find-module ?dup if dup module.flag @ 0= set-module-flag then ; 238 239\ ***** show-module 240\ 241\ Show loading information about a module. 242 243: show-module ( <module> -- ) find-module ?dup if show-one-module then ; 244 245\ Words to be used inside configuration files 246 247: retry false ; \ For use in load error commands 248: ignore true ; \ For use in load error commands 249 250\ Return to strict forth vocabulary 251 252: #type 253 over - >r 254 type 255 r> spaces 256; 257 258: .? 2 spaces 2swap 15 #type 2 spaces type cr ; 259 260\ Execute the ? command to print all the commands defined in 261\ C, then list the ones we support here. Please note that this 262\ doesn't use pager_* routines that the C implementation of ? 263\ does, so these will always appear, even if you stop early 264\ there. And they may cause the commands to scroll off the 265\ screen if the number of commands modulus LINES is close 266\ to LINEs.... 267: ? 268 ['] ? execute 269 s" boot-conf" s" load kernel and modules, then autoboot" .? 270 s" read-conf" s" read a configuration file" .? 271 s" enable-module" s" enable loading of a module" .? 272 s" disable-module" s" disable loading of a module" .? 273 s" toggle-module" s" toggle loading of a module" .? 274 s" show-module" s" show module load data" .? 275 s" try-include" s" try to load/interpret files" .? 276; 277 278: try-include ( -- ) \ see loader.4th(8) 279 ['] include ( -- xt ) \ get the execution token of `include' 280 catch ( xt -- exception# | 0 ) if \ failed 281 LF parse ( c -- s-addr/u ) 2drop \ advance >in to EOL (drop data) 282 \ ... prevents words unused by `include' from being interpreted 283 then 284; immediate \ interpret immediately for access to `source' (aka tib) 285 286only forth definitions 287