loader.4th revision 77444
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 77444 2001-05-29 23:49:10Z dcs $ 26 27s" arch-alpha" environment? [if] [if] 28 s" loader_version" environment? [if] 29 11 < [if] 30 .( Loader version 1.1+ required) cr 31 abort 32 [then] 33 [else] 34 .( Could not get loader version!) cr 35 abort 36 [then] 37[then] [then] 38 39s" arch-i386" environment? [if] [if] 40 s" loader_version" environment? [if] 41 10 < [if] 42 .( Loader version 1.0+ required) cr 43 abort 44 [then] 45 [else] 46 .( Could not get loader version!) cr 47 abort 48 [then] 49[then] [then] 50 51256 dictthreshold ! \ 256 cells minimum free space 522048 dictincrease ! \ 2048 additional cells each time 53 54include /boot/support.4th 55 56\ ***** boot-conf 57\ 58\ Prepares to boot as specified by loaded configuration files. 59 60only forth also support-functions also builtins definitions 61 62: boot 63 0= if ( interpreted ) get_arguments then 64 65 \ Unload only if a path was passed 66 dup if 67 >r over r> swap 68 c@ [char] - <> if 69 0 1 unload drop 70 else 71 s" kernelname" getenv? if ( a kernel has been loaded ) 72 1 boot exit 73 then 74 load_kernel_and_modules 75 ?dup if exit then 76 0 1 boot exit 77 then 78 else 79 s" kernelname" getenv? if ( a kernel has been loaded ) 80 1 boot exit 81 then 82 load_kernel_and_modules 83 ?dup if exit then 84 0 1 boot exit 85 then 86 load_kernel_and_modules 87 ?dup 0= if 0 1 boot then 88; 89 90: boot-conf 91 0= if ( interpreted ) get_arguments then 92 0 1 unload drop 93 load_kernel_and_modules 94 ?dup 0= if 0 1 autoboot then 95; 96 97also forth definitions also builtins 98 99builtin: boot 100builtin: boot-conf 101 102only forth definitions also support-functions 103 104\ ***** check-password 105\ 106\ If a password was defined, execute autoboot and ask for 107\ password if autoboot returns. 108 109: check-password 110 password .addr @ if 111 0 autoboot 112 false >r 113 begin 114 bell emit bell emit 115 ." Password: " 116 password .len @ read-password 117 dup password .len @ = if 118 2dup password .addr @ password .len @ 119 compare 0= if r> drop true >r then 120 then 121 drop free drop 122 r@ 123 until 124 r> drop 125 then 126; 127 128\ ***** start 129\ 130\ Initializes support.4th global variables, sets loader_conf_files, 131\ process conf files, and, if any one such file was succesfully 132\ read to the end, load kernel and modules. 133 134: start ( -- ) ( throws: abort & user-defined ) 135 s" /boot/defaults/loader.conf" initialize 136 include_conf_files 137 \ Will *NOT* try to load kernel and modules if no configuration file 138 \ was succesfully loaded! 139 any_conf_read? if 140 load_kernel 141 load_modules 142 then 143; 144 145\ ***** initialize 146\ 147\ Overrides support.4th initialization word with one that does 148\ everything start one does, short of loading the kernel and 149\ modules. Returns a flag 150 151: initialize ( -- flag ) 152 s" /boot/defaults/loader.conf" initialize 153 include_conf_files 154 any_conf_read? 155; 156 157\ ***** read-conf 158\ 159\ Read a configuration file, whose name was specified on the command 160\ line, if interpreted, or given on the stack, if compiled in. 161 162: (read-conf) ( addr len -- ) 163 conf_files .addr @ ?dup if free abort" Fatal error freeing memory" then 164 strdup conf_files .len ! conf_files .addr ! 165 include_conf_files \ Will recurse on new loader_conf_files definitions 166; 167 168: read-conf ( <filename> | addr len -- ) ( throws: abort & user-defined ) 169 state @ if 170 \ Compiling 171 postpone (read-conf) 172 else 173 \ Interpreting 174 bl parse (read-conf) 175 then 176; immediate 177 178\ ***** enable-module 179\ 180\ Turn a module loading on. 181 182: enable-module ( <module> -- ) 183 bl parse module_options @ >r 184 begin 185 r@ 186 while 187 2dup 188 r@ module.name dup .addr @ swap .len @ 189 compare 0= if 190 2drop 191 r@ module.name dup .addr @ swap .len @ type 192 true r> module.flag ! 193 ." will be loaded." cr 194 exit 195 then 196 r> module.next @ >r 197 repeat 198 r> drop 199 type ." wasn't found." cr 200; 201 202\ ***** disable-module 203\ 204\ Turn a module loading off. 205 206: disable-module ( <module> -- ) 207 bl parse module_options @ >r 208 begin 209 r@ 210 while 211 2dup 212 r@ module.name dup .addr @ swap .len @ 213 compare 0= if 214 2drop 215 r@ module.name dup .addr @ swap .len @ type 216 false r> module.flag ! 217 ." will not be loaded." cr 218 exit 219 then 220 r> module.next @ >r 221 repeat 222 r> drop 223 type ." wasn't found." cr 224; 225 226\ ***** toggle-module 227\ 228\ Turn a module loading on/off. 229 230: toggle-module ( <module> -- ) 231 bl parse module_options @ >r 232 begin 233 r@ 234 while 235 2dup 236 r@ module.name dup .addr @ swap .len @ 237 compare 0= if 238 2drop 239 r@ module.name dup .addr @ swap .len @ type 240 r@ module.flag @ 0= dup r> module.flag ! 241 if 242 ." will be loaded." cr 243 else 244 ." will not be loaded." cr 245 then 246 exit 247 then 248 r> module.next @ >r 249 repeat 250 r> drop 251 type ." wasn't found." cr 252; 253 254\ ***** show-module 255\ 256\ Show loading information about a module. 257 258: show-module ( <module> -- ) 259 bl parse module_options @ >r 260 begin 261 r@ 262 while 263 2dup 264 r@ module.name dup .addr @ swap .len @ 265 compare 0= if 266 2drop 267 ." Name: " r@ module.name dup .addr @ swap .len @ type cr 268 ." Path: " r@ module.loadname dup .addr @ swap .len @ type cr 269 ." Type: " r@ module.type dup .addr @ swap .len @ type cr 270 ." Flags: " r@ module.args dup .addr @ swap .len @ type cr 271 ." Before load: " r@ module.beforeload dup .addr @ swap .len @ type cr 272 ." After load: " r@ module.afterload dup .addr @ swap .len @ type cr 273 ." Error: " r@ module.loaderror dup .addr @ swap .len @ type cr 274 ." Status: " r> module.flag @ if ." Load" else ." Don't load" then cr 275 exit 276 then 277 r> module.next @ >r 278 repeat 279 r> drop 280 type ." wasn't found." cr 281; 282 283\ Words to be used inside configuration files 284 285: retry false ; \ For use in load error commands 286: ignore true ; \ For use in load error commands 287 288\ Return to strict forth vocabulary 289 290: #type 291 over - >r 292 type 293 r> spaces 294; 295 296: .? 2 spaces 2swap 15 #type 2 spaces type cr ; 297 298: ? 299 ['] ? execute 300 s" boot-conf" s" load kernel and modules, then autoboot" .? 301 s" read-conf" s" read a configuration file" .? 302 s" enable-module" s" enable loading of a module" .? 303 s" disable-module" s" disable loading of a module" .? 304 s" toggle-module" s" toggle loading of a module" .? 305 s" show-module" s" show module load data" .? 306; 307 308only forth also 309 310