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 \ provide u> if needed
  31 s" 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
  41 s" 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
  53 s" 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
  65 256 dictthreshold !  \ 256 cells minimum free space
  66 2048 dictincrease !  \ 2048 additional cells each time
  67
  68 include /boot/support.4th
  69 include /boot/color.4th
  70 include /boot/delay.4th
  71 include /boot/check-password.4th
  72
  73 only 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
 113 only 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
 158 also forth definitions previous
 159
 160 builtin: boot
 161 builtin: boot-conf
 162
 163 only 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
 292 only forth definitions