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