sys/boot/forth/loader.4th

   1 \ Copyright (c) 1999 Daniel C. Sobral <dcs@freebsd.org>
   2 \ All rights reserved.
   3 \
   4 \ Redistribution and use in source and binary forms, with or without
   5 \ modification, are permitted provided that the following conditions
   6 \ are met:
   7 \ 1. Redistributions of source code must retain the above copyright
   8 \    notice, this list of conditions and the following disclaimer.
   9 \ 2. Redistributions in binary form must reproduce the above copyright
  10 \    notice, this list of conditions and the following disclaimer in the
  11 \    documentation and/or other materials provided with the distribution.
  12 \
  13 \ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
  14 \ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  15 \ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  16 \ ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
  17 \ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  18 \ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  19 \ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  20 \ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  21 \ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  22 \ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  23 \ SUCH DAMAGE.
  24 \
  25 \ $FreeBSD: src/sys/boot/forth/loader.4th,v 1.5.2.1 2000/07/07 00:14:34 obrien Exp $
  26
  27 s" arch-alpha" environment? [if] [if]
  28         s" loader_version" environment?  [if]
  29                 3 < [if]
  30                         .( Loader version 0.3+ required) cr
  31                         abort
  32                 [then]
  33         [else]
  34                 .( Could not get loader version!) cr
  35                 abort
  36         [then]
  37 [then] [then]
  38
  39 s" arch-i386" environment? [if] [if]
  40         s" loader_version" environment?  [if]
  41                 8 < [if]
  42                         .( Loader version 0.8+ required) cr
  43                         abort
  44                 [then]
  45         [else]
  46                 .( Could not get loader version!) cr
  47                 abort
  48         [then]
  49 [then] [then]
  50
  51 include /boot/support.4th
  52
  53 only forth definitions also support-functions
  54
  55 \ ***** boot-conf
  56 \
  57 \       Prepares to boot as specified by loaded configuration files.
  58
  59 also support-functions definitions
  60
  61 : bootpath s" /boot/" ;
  62 : modulepath s" module_path" ;
  63 : saveenv ( addr len | 0 -1 -- addr' len | 0 -1 )
  64   dup -1 = if exit then
  65   dup allocate abort" Out of memory"
  66   swap 2dup 2>r
  67   move
  68   2r>
  69 ;
  70 : freeenv ( addr len | 0 -1 )
  71   -1 = if drop else free abort" Freeing error" then
  72 ;
  73 : restoreenv  ( addr len | 0 -1 -- )
  74   dup -1 = if ( it wasn't set )
  75     2drop
  76     modulepath unsetenv
  77   else
  78     over >r
  79     modulepath setenv
  80     r> free abort" Freeing error"
  81   then
  82 ;
  83
  84 only forth also support-functions also builtins definitions
  85
  86 : boot-conf  ( args 1 | 0 "args" -- flag )
  87   0 1 unload drop
  88
  89   0= if ( interpreted )
  90     \ Get next word on the command line
  91     bl word count
  92     ?dup 0= if ( there wasn't anything )
  93       drop 0
  94     else ( put in the number of strings )
  95       1
  96     then
  97   then ( interpreted )
  98
  99   if ( there are arguments )
 100     \ Try to load the kernel
 101     s" kernel_options" getenv dup -1 = if drop 2dup 1 else 2over 2 then
 102
 103     1 load if ( load command failed )
 104       \ Remove garbage from the stack
 105
 106       \ Set the environment variable module_path, and try loading
 107       \ the kernel again.
 108
 109       \ First, save module_path value
 110       modulepath getenv saveenv dup -1 = if 0 swap then 2>r
 111
 112       \ Sets the new value
 113       2dup modulepath setenv
 114
 115       \ Try to load the kernel
 116       s" load ${kernel} ${kernel_options}" ['] evaluate catch
 117       if ( load failed yet again )
 118         \ Remove garbage from the stack
 119         2drop
 120
 121         \ Try prepending /boot/
 122         bootpath 2over nip over + allocate
 123         if ( out of memory )
 124           2drop 2drop
 125           2r> restoreenv
 126           100 exit
 127         then
 128
 129         0 2swap strcat 2swap strcat
 130         2dup modulepath setenv
 131
 132         drop free if ( freeing memory error )
 133           2drop
 134           2r> restoreenv
 135           100 exit
 136         then
 137
 138         \ Now, once more, try to load the kernel
 139         s" load ${kernel} ${kernel_options}" ['] evaluate catch
 140         if ( failed once more )
 141           2drop
 142           2r> restoreenv
 143           100 exit
 144         then
 145
 146       else ( we found the kernel on the path passed )
 147
 148         2drop ( discard command line arguments )
 149
 150       then ( could not load kernel from directory passed )
 151
 152       \ Load the remaining modules, if the kernel was loaded at all
 153       ['] load_modules catch if 2r> restoreenv 100 exit then
 154
 155       \ Call autoboot to perform the booting
 156       0 1 autoboot
 157
 158       \ Keep new module_path
 159       2r> freeenv
 160
 161       exit
 162     then ( could not load kernel with name passed )
 163
 164     2drop ( discard command line arguments )
 165
 166   else ( try just a straight-forward kernel load )
 167     s" load ${kernel} ${kernel_options}" ['] evaluate catch
 168     if ( kernel load failed ) 2drop 100 exit then
 169
 170   then ( there are command line arguments )
 171
 172   \ Load the remaining modules, if the kernel was loaded at all
 173   ['] load_modules catch if 100 exit then
 174
 175   \ Call autoboot to perform the booting
 176   0 1 autoboot
 177 ;
 178
 179 also forth definitions
 180 builtin: boot-conf
 181 only forth definitions also support-functions
 182
 183 \ ***** check-password
 184 \
 185 \       If a password was defined, execute autoboot and ask for
 186 \       password if autoboot returns.
 187
 188 : check-password
 189   password .addr @ if
 190     0 autoboot
 191     false >r
 192     begin
 193       bell emit bell emit
 194       ." Password: "
 195       password .len @ read-password
 196       dup password .len @ = if
 197         2dup password .addr @ password .len @
 198         compare 0= if r> drop true >r then
 199       then
 200       drop free drop
 201       r@
 202     until
 203     r> drop
 204   then
 205 ;
 206
 207 \ ***** start
 208 \
 209 \       Initializes support.4th global variables, sets loader_conf_files,
 210 \       process conf files, and, if any one such file was succesfully
 211 \       read to the end, load kernel and modules.
 212
 213 : start  ( -- ) ( throws: abort & user-defined )
 214   s" /boot/defaults/loader.conf" initialize
 215   include_conf_files
 216   \ Will *NOT* try to load kernel and modules if no configuration file
 217   \ was succesfully loaded!
 218   any_conf_read? if
 219     load_kernel
 220     load_modules
 221   then
 222 ;
 223
 224 \ ***** initialize
 225 \
 226 \       Overrides support.4th initialization word with one that does
 227 \       everything start one does, short of loading the kernel and
 228 \       modules. Returns a flag
 229
 230 : initialize ( -- flag )
 231   s" /boot/defaults/loader.conf" initialize
 232   include_conf_files
 233   any_conf_read?
 234 ;
 235
 236 \ ***** read-conf
 237 \
 238 \       Read a configuration file, whose name was specified on the command
 239 \       line, if interpreted, or given on the stack, if compiled in.
 240
 241 : (read-conf)  ( addr len -- )
 242   conf_files .addr @ ?dup if free abort" Fatal error freeing memory" then
 243   strdup conf_files .len ! conf_files .addr !
 244   include_conf_files \ Will recurse on new loader_conf_files definitions
 245 ;
 246
 247 : read-conf  ( <filename> | addr len -- ) ( throws: abort & user-defined )
 248   state @ if
 249     \ Compiling
 250     postpone (read-conf)
 251   else
 252     \ Interpreting
 253     bl parse (read-conf)
 254   then
 255 ; immediate
 256
 257 \ ***** enable-module
 258 \
 259 \       Turn a module loading on.
 260
 261 : enable-module ( <module> -- )
 262   bl parse module_options @ >r
 263   begin
 264     r@
 265   while
 266     2dup
 267     r@ module.name dup .addr @ swap .len @
 268     compare 0= if
 269       2drop
 270       r@ module.name dup .addr @ swap .len @ type
 271       true r> module.flag !
 272       ."  will be loaded." cr
 273       exit
 274     then
 275     r> module.next @ >r
 276   repeat
 277   r> drop
 278   type ."  wasn't found." cr
 279 ;
 280
 281 \ ***** disable-module
 282 \
 283 \       Turn a module loading off.
 284
 285 : disable-module ( <module> -- )
 286   bl parse module_options @ >r
 287   begin
 288     r@
 289   while
 290     2dup
 291     r@ module.name dup .addr @ swap .len @
 292     compare 0= if
 293       2drop
 294       r@ module.name dup .addr @ swap .len @ type
 295       false r> module.flag !
 296       ."  will not be loaded." cr
 297       exit
 298     then
 299     r> module.next @ >r
 300   repeat
 301   r> drop
 302   type ."  wasn't found." cr
 303 ;
 304
 305 \ ***** toggle-module
 306 \
 307 \       Turn a module loading on/off.
 308
 309 : toggle-module ( <module> -- )
 310   bl parse module_options @ >r
 311   begin
 312     r@
 313   while
 314     2dup
 315     r@ module.name dup .addr @ swap .len @
 316     compare 0= if
 317       2drop
 318       r@ module.name dup .addr @ swap .len @ type
 319       r@ module.flag @ 0= dup r> module.flag !
 320       if
 321         ."  will be loaded." cr
 322       else
 323         ."  will not be loaded." cr
 324       then
 325       exit
 326     then
 327     r> module.next @ >r
 328   repeat
 329   r> drop
 330   type ."  wasn't found." cr
 331 ;
 332
 333 \ ***** show-module
 334 \
 335 \       Show loading information about a module.
 336
 337 : show-module ( <module> -- )
 338   bl parse module_options @ >r
 339   begin
 340     r@
 341   while
 342     2dup
 343     r@ module.name dup .addr @ swap .len @
 344     compare 0= if
 345       2drop
 346       ." Name: " r@ module.name dup .addr @ swap .len @ type cr
 347       ." Path: " r@ module.loadname dup .addr @ swap .len @ type cr
 348       ." Type: " r@ module.type dup .addr @ swap .len @ type cr
 349       ." Flags: " r@ module.args dup .addr @ swap .len @ type cr
 350       ." Before load: " r@ module.beforeload dup .addr @ swap .len @ type cr
 351       ." After load: " r@ module.afterload dup .addr @ swap .len @ type cr
 352       ." Error: " r@ module.loaderror dup .addr @ swap .len @ type cr
 353       ." Status: " r> module.flag @ if ." Load" else ." Don't load" then cr
 354       exit
 355     then
 356     r> module.next @ >r
 357   repeat
 358   r> drop
 359   type ."  wasn't found." cr
 360 ;
 361
 362 \ Words to be used inside configuration files
 363
 364 : retry false ;         \ For use in load error commands
 365 : ignore true ;         \ For use in load error commands
 366
 367 \ Return to strict forth vocabulary
 368
 369 only forth also
 370