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