loader.4th revision 61650
1\ Copyright (c) 1999 Daniel C. Sobral <dcs@freebsd.org> 2\ All rights reserved. 3\ 4\ Redistribution and use in source and binary forms, with or without 5\ modification, are permitted provided that the following conditions 6\ are met: 7\ 1. Redistributions of source code must retain the above copyright 8\ notice, this list of conditions and the following disclaimer. 9\ 2. Redistributions in binary form must reproduce the above copyright 10\ notice, this list of conditions and the following disclaimer in the 11\ documentation and/or other materials provided with the distribution. 12\ 13\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 14\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 15\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 16\ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 17\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 18\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 19\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 20\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 21\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 22\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 23\ SUCH DAMAGE. 24\ 25\ $FreeBSD: head/sys/boot/forth/loader.4th 61650 2000-06-14 07:18:18Z peter $ 26 27\ s" arch-alpha" environment? [if] [if] 28\ s" loader_version" environment? [if] 29\ 3 < [if] 30\ .( Loader version 0.3+ required) cr 31\ abort 32\ [then] 33\ [else] 34\ .( Could not get loader version!) cr 35\ abort 36\ [then] 37\ [then] [then] 38 39\ s" arch-i386" environment? [if] [if] 40\ s" loader_version" environment? [if] 41\ 8 < [if] 42\ .( Loader version 0.8+ required) cr 43\ abort 44\ [then] 45\ [else] 46\ .( Could not get loader version!) cr 47\ abort 48\ [then] 49\ [then] [then] 50 51include /boot/support.4th 52 53only forth definitions also support-functions 54 55\ ***** boot-conf 56\ 57\ Prepares to boot as specified by loaded configuration files. 58 59also support-functions definitions 60 61: bootpath s" /boot/" ; 62: modulepath s" module_path" ; 63: saveenv ( addr len | 0 -1 -- addr' len | 0 -1 ) 64 dup -1 = if exit then 65 dup allocate abort" Out of memory" 66 swap 2dup 2>r 67 move 68 2r> 69; 70: freeenv ( addr len | 0 -1 ) 71 -1 = if drop else free abort" Freeing error" then 72; 73: restoreenv ( addr len | 0 -1 -- ) 74 dup -1 = if ( it wasn't set ) 75 2drop 76 modulepath unsetenv 77 else 78 over >r 79 modulepath setenv 80 r> free abort" Freeing error" 81 then 82; 83 84only forth also support-functions also builtins definitions 85 86: boot-conf ( args 1 | 0 "args" -- flag ) 87 0 1 unload drop 88 89 0= if ( interpreted ) 90 \ Get next word on the command line 91 bl word count 92 ?dup 0= if ( there wasn't anything ) 93 drop 0 94 else ( put in the number of strings ) 95 1 96 then 97 then ( interpreted ) 98 99 if ( there are arguments ) 100 \ Try to load the kernel 101 s" kernel_options" getenv dup -1 = if drop 2dup 1 else 2over 2 then 102 103 1 load if ( load command failed ) 104 \ Remove garbage from the stack 105 106 \ Set the environment variable module_path, and try loading 107 \ the kernel again. 108 109 \ First, save module_path value 110 modulepath getenv saveenv dup -1 = if 0 swap then 2>r 111 112 \ Sets the new value 113 2dup modulepath setenv 114 115 \ Try to load the kernel 116 s" load ${kernel} ${kernel_options}" ['] evaluate catch 117 if ( load failed yet again ) 118 \ Remove garbage from the stack 119 2drop 120 121 \ Try prepending /boot/ 122 bootpath 2over nip over + allocate 123 if ( out of memory ) 124 2drop 2drop 125 2r> restoreenv 126 100 exit 127 then 128 129 0 2swap strcat 2swap strcat 130 2dup modulepath setenv 131 132 drop free if ( freeing memory error ) 133 2drop 134 2r> restoreenv 135 100 exit 136 then 137 138 \ Now, once more, try to load the kernel 139 s" load ${kernel} ${kernel_options}" ['] evaluate catch 140 if ( failed once more ) 141 2drop 142 2r> restoreenv 143 100 exit 144 then 145 146 else ( we found the kernel on the path passed ) 147 148 2drop ( discard command line arguments ) 149 150 then ( could not load kernel from directory passed ) 151 152 \ Load the remaining modules, if the kernel was loaded at all 153 ['] load_modules catch if 2r> restoreenv 100 exit then 154 155 \ Call autoboot to perform the booting 156 0 1 autoboot 157 158 \ Keep new module_path 159 2r> freeenv 160 161 exit 162 then ( could not load kernel with name passed ) 163 164 2drop ( discard command line arguments ) 165 166 else ( try just a straight-forward kernel load ) 167 s" load ${kernel} ${kernel_options}" ['] evaluate catch 168 if ( kernel load failed ) 2drop 100 exit then 169 170 then ( there are command line arguments ) 171 172 \ Load the remaining modules, if the kernel was loaded at all 173 ['] load_modules catch if 100 exit then 174 175 \ Call autoboot to perform the booting 176 0 1 autoboot 177; 178 179also forth definitions 180builtin: boot-conf 181only forth definitions also support-functions 182 183\ ***** check-password 184\ 185\ If a password was defined, execute autoboot and ask for 186\ password if autoboot returns. 187 188: check-password 189 password .addr @ if 190 0 autoboot 191 false >r 192 begin 193 bell emit bell emit 194 ." Password: " 195 password .len @ read-password 196 dup password .len @ = if 197 2dup password .addr @ password .len @ 198 compare 0= if r> drop true >r then 199 then 200 drop free drop 201 r@ 202 until 203 r> drop 204 then 205; 206 207\ ***** start 208\ 209\ Initializes support.4th global variables, sets loader_conf_files, 210\ process conf files, and, if any one such file was succesfully 211\ read to the end, load kernel and modules. 212 213: start ( -- ) ( throws: abort & user-defined ) 214 s" /boot/defaults/loader.conf" initialize 215 include_conf_files 216 \ Will *NOT* try to load kernel and modules if no configuration file 217 \ was succesfully loaded! 218 any_conf_read? if 219 load_kernel 220 load_modules 221 then 222; 223 224\ ***** initialize 225\ 226\ Overrides support.4th initialization word with one that does 227\ everything start one does, short of loading the kernel and 228\ modules. Returns a flag 229 230: initialize ( -- flag ) 231 s" /boot/defaults/loader.conf" initialize 232 include_conf_files 233 any_conf_read? 234; 235 236\ ***** read-conf 237\ 238\ Read a configuration file, whose name was specified on the command 239\ line, if interpreted, or given on the stack, if compiled in. 240 241: (read-conf) ( addr len -- ) 242 conf_files .addr @ ?dup if free abort" Fatal error freeing memory" then 243 strdup conf_files .len ! conf_files .addr ! 244 include_conf_files \ Will recurse on new loader_conf_files definitions 245; 246 247: read-conf ( <filename> | addr len -- ) ( throws: abort & user-defined ) 248 state @ if 249 \ Compiling 250 postpone (read-conf) 251 else 252 \ Interpreting 253 bl parse (read-conf) 254 then 255; immediate 256 257\ ***** enable-module 258\ 259\ Turn a module loading on. 260 261: enable-module ( <module> -- ) 262 bl parse module_options @ >r 263 begin 264 r@ 265 while 266 2dup 267 r@ module.name dup .addr @ swap .len @ 268 compare 0= if 269 2drop 270 r@ module.name dup .addr @ swap .len @ type 271 true r> module.flag ! 272 ." will be loaded." cr 273 exit 274 then 275 r> module.next @ >r 276 repeat 277 r> drop 278 type ." wasn't found." cr 279; 280 281\ ***** disable-module 282\ 283\ Turn a module loading off. 284 285: disable-module ( <module> -- ) 286 bl parse module_options @ >r 287 begin 288 r@ 289 while 290 2dup 291 r@ module.name dup .addr @ swap .len @ 292 compare 0= if 293 2drop 294 r@ module.name dup .addr @ swap .len @ type 295 false r> module.flag ! 296 ." will not be loaded." cr 297 exit 298 then 299 r> module.next @ >r 300 repeat 301 r> drop 302 type ." wasn't found." cr 303; 304 305\ ***** toggle-module 306\ 307\ Turn a module loading on/off. 308 309: toggle-module ( <module> -- ) 310 bl parse module_options @ >r 311 begin 312 r@ 313 while 314 2dup 315 r@ module.name dup .addr @ swap .len @ 316 compare 0= if 317 2drop 318 r@ module.name dup .addr @ swap .len @ type 319 r@ module.flag @ 0= dup r> module.flag ! 320 if 321 ." will be loaded." cr 322 else 323 ." will not be loaded." cr 324 then 325 exit 326 then 327 r> module.next @ >r 328 repeat 329 r> drop 330 type ." wasn't found." cr 331; 332 333\ ***** show-module 334\ 335\ Show loading information about a module. 336 337: show-module ( <module> -- ) 338 bl parse module_options @ >r 339 begin 340 r@ 341 while 342 2dup 343 r@ module.name dup .addr @ swap .len @ 344 compare 0= if 345 2drop 346 ." Name: " r@ module.name dup .addr @ swap .len @ type cr 347 ." Path: " r@ module.loadname dup .addr @ swap .len @ type cr 348 ." Type: " r@ module.type dup .addr @ swap .len @ type cr 349 ." Flags: " r@ module.args dup .addr @ swap .len @ type cr 350 ." Before load: " r@ module.beforeload dup .addr @ swap .len @ type cr 351 ." After load: " r@ module.afterload dup .addr @ swap .len @ type cr 352 ." Error: " r@ module.loaderror dup .addr @ swap .len @ type cr 353 ." Status: " r> module.flag @ if ." Load" else ." Don't load" then cr 354 exit 355 then 356 r> module.next @ >r 357 repeat 358 r> drop 359 type ." wasn't found." cr 360; 361 362\ Words to be used inside configuration files 363 364: retry false ; \ For use in load error commands 365: ignore true ; \ For use in load error commands 366 367\ Return to strict forth vocabulary 368 369only forth also 370 371