stand/forth/loader.4th

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