loader.4th revision 65949
1303231Sdim\ Copyright (c) 1999 Daniel C. Sobral <dcs@freebsd.org> 2303231Sdim\ All rights reserved. 3353358Sdim\ 4353358Sdim\ Redistribution and use in source and binary forms, with or without 5353358Sdim\ modification, are permitted provided that the following conditions 6303231Sdim\ are met: 7303231Sdim\ 1. Redistributions of source code must retain the above copyright 8303231Sdim\ notice, this list of conditions and the following disclaimer. 9303231Sdim\ 2. Redistributions in binary form must reproduce the above copyright 10303231Sdim\ notice, this list of conditions and the following disclaimer in the 11303231Sdim\ documentation and/or other materials provided with the distribution. 12303231Sdim\ 13303231Sdim\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 14303231Sdim\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 15303231Sdim\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 16327952Sdim\ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 17303231Sdim\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 18314564Sdim\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 19303231Sdim\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 20327952Sdim\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 21303231Sdim\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 22303231Sdim\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 23327952Sdim\ SUCH DAMAGE. 24303231Sdim\ 25327952Sdim\ $FreeBSD: head/sys/boot/forth/loader.4th 65949 2000-09-16 21:04:49Z dcs $ 26327952Sdim 27314564Sdims" arch-alpha" environment? [if] [if] 28303231Sdim s" loader_version" environment? [if] 29314564Sdim 3 < [if] 30314564Sdim .( Loader version 0.3+ required) cr 31314564Sdim abort 32314564Sdim [then] 33314564Sdim [else] 34314564Sdim .( Could not get loader version!) cr 35314564Sdim abort 36314564Sdim [then] 37314564Sdim[then] [then] 38314564Sdim 39303231Sdims" arch-i386" environment? [if] [if] 40314564Sdim s" loader_version" environment? [if] 41314564Sdim 8 < [if] 42314564Sdim .( Loader version 0.8+ required) cr 43314564Sdim abort 44327952Sdim [then] 45314564Sdim [else] 46314564Sdim .( Could not get loader version!) cr 47303231Sdim abort 48327952Sdim [then] 49303231Sdim[then] [then] 50314564Sdim 51303231Sdiminclude /boot/support.4th 52303231Sdim 53303231Sdim\ ***** boot-conf 54303231Sdim\ 55314564Sdim\ Prepares to boot as specified by loaded configuration files. 56303231Sdim 57303231Sdimonly forth also support-functions also builtins definitions 58303231Sdim 59303231Sdim: boot 60303231Sdim 0= if ( interpreted ) get_arguments then 61303231Sdim 62303231Sdim \ Unload only if a path was passed 63314564Sdim dup if 64314564Sdim >r over r> swap 65303231Sdim c@ [char] - <> if 66303231Sdim 0 1 unload drop 67303231Sdim else 68303231Sdim s" kernelname" getenv? 0= if ( no kernel has been loaded ) 69303231Sdim load_kernel_and_modules 70303231Sdim ?dup if exit then 71303231Sdim then 72303231Sdim 1 boot exit 73303231Sdim then 74303231Sdim else 75303231Sdim s" kernelname" getenv? 0= if ( no kernel has been loaded ) 76303231Sdim load_kernel_and_modules 77303231Sdim ?dup if exit then 78327952Sdim then 79327952Sdim 1 boot exit 80327952Sdim then 81 load_kernel_and_modules 82 ?dup 0= if 0 1 boot then 83; 84 85: boot-conf 86 0= if ( interpreted ) get_arguments then 87 0 1 unload drop 88 load_kernel_and_modules 89 ?dup 0= if 0 1 autoboot then 90; 91 92also forth definitions also builtins 93 94builtin: boot 95builtin: boot-conf 96 97only forth definitions also support-functions 98 99\ ***** check-password 100\ 101\ If a password was defined, execute autoboot and ask for 102\ password if autoboot returns. 103 104: check-password 105 password .addr @ if 106 0 autoboot 107 false >r 108 begin 109 bell emit bell emit 110 ." Password: " 111 password .len @ read-password 112 dup password .len @ = if 113 2dup password .addr @ password .len @ 114 compare 0= if r> drop true >r then 115 then 116 drop free drop 117 r@ 118 until 119 r> drop 120 then 121; 122 123\ ***** start 124\ 125\ Initializes support.4th global variables, sets loader_conf_files, 126\ process conf files, and, if any one such file was succesfully 127\ read to the end, load kernel and modules. 128 129: start ( -- ) ( throws: abort & user-defined ) 130 s" /boot/defaults/loader.conf" initialize 131 include_conf_files 132 \ Will *NOT* try to load kernel and modules if no configuration file 133 \ was succesfully loaded! 134 any_conf_read? if 135 load_kernel 136 load_modules 137 then 138; 139 140\ ***** initialize 141\ 142\ Overrides support.4th initialization word with one that does 143\ everything start one does, short of loading the kernel and 144\ modules. Returns a flag 145 146: initialize ( -- flag ) 147 s" /boot/defaults/loader.conf" initialize 148 include_conf_files 149 any_conf_read? 150; 151 152\ ***** read-conf 153\ 154\ Read a configuration file, whose name was specified on the command 155\ line, if interpreted, or given on the stack, if compiled in. 156 157: (read-conf) ( addr len -- ) 158 conf_files .addr @ ?dup if free abort" Fatal error freeing memory" then 159 strdup conf_files .len ! conf_files .addr ! 160 include_conf_files \ Will recurse on new loader_conf_files definitions 161; 162 163: read-conf ( <filename> | addr len -- ) ( throws: abort & user-defined ) 164 state @ if 165 \ Compiling 166 postpone (read-conf) 167 else 168 \ Interpreting 169 bl parse (read-conf) 170 then 171; immediate 172 173\ ***** enable-module 174\ 175\ Turn a module loading on. 176 177: enable-module ( <module> -- ) 178 bl parse module_options @ >r 179 begin 180 r@ 181 while 182 2dup 183 r@ module.name dup .addr @ swap .len @ 184 compare 0= if 185 2drop 186 r@ module.name dup .addr @ swap .len @ type 187 true r> module.flag ! 188 ." will be loaded." cr 189 exit 190 then 191 r> module.next @ >r 192 repeat 193 r> drop 194 type ." wasn't found." cr 195; 196 197\ ***** disable-module 198\ 199\ Turn a module loading off. 200 201: disable-module ( <module> -- ) 202 bl parse module_options @ >r 203 begin 204 r@ 205 while 206 2dup 207 r@ module.name dup .addr @ swap .len @ 208 compare 0= if 209 2drop 210 r@ module.name dup .addr @ swap .len @ type 211 false r> module.flag ! 212 ." will not be loaded." cr 213 exit 214 then 215 r> module.next @ >r 216 repeat 217 r> drop 218 type ." wasn't found." cr 219; 220 221\ ***** toggle-module 222\ 223\ Turn a module loading on/off. 224 225: toggle-module ( <module> -- ) 226 bl parse module_options @ >r 227 begin 228 r@ 229 while 230 2dup 231 r@ module.name dup .addr @ swap .len @ 232 compare 0= if 233 2drop 234 r@ module.name dup .addr @ swap .len @ type 235 r@ module.flag @ 0= dup r> module.flag ! 236 if 237 ." will be loaded." cr 238 else 239 ." will not be loaded." cr 240 then 241 exit 242 then 243 r> module.next @ >r 244 repeat 245 r> drop 246 type ." wasn't found." cr 247; 248 249\ ***** show-module 250\ 251\ Show loading information about a module. 252 253: show-module ( <module> -- ) 254 bl parse module_options @ >r 255 begin 256 r@ 257 while 258 2dup 259 r@ module.name dup .addr @ swap .len @ 260 compare 0= if 261 2drop 262 ." Name: " r@ module.name dup .addr @ swap .len @ type cr 263 ." Path: " r@ module.loadname dup .addr @ swap .len @ type cr 264 ." Type: " r@ module.type dup .addr @ swap .len @ type cr 265 ." Flags: " r@ module.args dup .addr @ swap .len @ type cr 266 ." Before load: " r@ module.beforeload dup .addr @ swap .len @ type cr 267 ." After load: " r@ module.afterload dup .addr @ swap .len @ type cr 268 ." Error: " r@ module.loaderror dup .addr @ swap .len @ type cr 269 ." Status: " r> module.flag @ if ." Load" else ." Don't load" then cr 270 exit 271 then 272 r> module.next @ >r 273 repeat 274 r> drop 275 type ." wasn't found." cr 276; 277 278\ Words to be used inside configuration files 279 280: retry false ; \ For use in load error commands 281: ignore true ; \ For use in load error commands 282 283\ Return to strict forth vocabulary 284 285: #type 286 over - >r 287 type 288 r> spaces 289; 290 291: .? 2 spaces 2swap 15 #type 2 spaces type cr ; 292 293: ? 294 ['] ? execute 295 s" boot-conf" s" load kernel and modules, then autoboot" .? 296 s" read-conf" s" read a configuration file" .? 297 s" enable-module" s" enable loading of a module" .? 298 s" disable-module" s" disable loading of a module" .? 299 s" toggle-module" s" toggle loading of a module" .? 300 s" show-module" s" show module load data" .? 301; 302 303only forth also 304 305