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.24 2002/05/24 02:28:58 gordon Exp $
  26 \ $DragonFly: src/sys/boot/forth/loader.4th,v 1.5 2004/10/14 09:06:21 dillon Exp $
  27
  28 s" arch-alpha" environment? [if] [if]
  29         s" loader_version" environment?  [if]
  30                 12 < [if]
  31                         .( Loader version 1.2+ required) cr
  32                         abort
  33                 [then]
  34         [else]
  35                 .( Could not get loader version!) cr
  36                 abort
  37         [then]
  38 [then] [then]
  39
  40 s" arch-i386" environment? [if] [if]
  41         s" loader_version" environment?  [if]
  42                 11 < [if]
  43                         .( Loader version 1.1+ required) cr
  44                         abort
  45                 [then]
  46         [else]
  47                 .( Could not get loader version!) cr
  48                 abort
  49         [then]
  50 [then] [then]
  51
  52 256 dictthreshold !  \ 256 cells minimum free space
  53 2048 dictincrease !  \ 2048 additional cells each time
  54
  55 include /boot/support.4th
  56
  57 \ ***** boot-conf
  58 \
  59 \       Prepares to boot as specified by loaded configuration files.
  60
  61 only forth also support-functions also builtins definitions
  62
  63 : boot
  64   0= if ( interpreted ) get_arguments then
  65
  66   \ Unload only if a path was passed
  67   dup if
  68     >r over r> swap
  69     c@ [char] - <> if
  70       0 1 unload drop
  71     else
  72       s" kernelname" getenv? if ( a kernel has been loaded )
  73         1 boot exit
  74       then
  75       load_kernel_and_modules
  76       ?dup if exit then
  77       0 1 boot exit
  78     then
  79   else
  80     s" kernelname" getenv? if ( a kernel has been loaded )
  81       1 boot exit
  82     then
  83     load_kernel_and_modules
  84     ?dup if exit then
  85     0 1 boot exit
  86   then
  87   load_kernel_and_modules
  88   ?dup 0= if 0 1 boot then
  89 ;
  90
  91 : boot-conf
  92   0= if ( interpreted ) get_arguments then
  93   0 1 unload drop
  94   load_kernel_and_modules
  95   ?dup 0= if 0 1 autoboot then
  96 ;
  97
  98 also forth definitions also builtins
  99
 100 builtin: boot
 101 builtin: boot-conf
 102
 103 only forth definitions also support-functions
 104
 105 \ ***** check-password
 106 \
 107 \       If a password was defined, execute autoboot and ask for
 108 \       password if autoboot returns.
 109
 110 : check-password
 111   password .addr @ if
 112     0 autoboot
 113     false >r
 114     begin
 115       bell emit bell emit
 116       ." Password: "
 117       password .len @ read-password
 118       dup password .len @ = if
 119         2dup password .addr @ password .len @
 120         compare 0= if r> drop true >r then
 121       then
 122       drop free drop
 123       r@
 124     until
 125     r> drop
 126   then
 127 ;
 128
 129 \ ***** start
 130 \
 131 \       Initializes support.4th global variables, sets loader_conf_files,
 132 \       process conf files, and, if any one such file was succesfully
 133 \       read to the end, load kernel and modules.
 134
 135 : start  ( -- ) ( throws: abort & user-defined )
 136   s" boot.nfsroot.path" getenv? if
 137     s" kernel.BOOTP" s" kernel" setenv
 138     s" /boot/defaults/loader-bootp.conf" initialize
 139   else
 140     s" kernel" s" kernel" setenv
 141     s" /boot/defaults/loader.conf" initialize
 142   then
 143   include_conf_files
 144   include_nextboot_file
 145   \ Will *NOT* try to load kernel and modules if no configuration file
 146   \ was succesfully loaded!
 147   any_conf_read? if
 148     load_kernel
 149     load_modules
 150   then
 151 ;
 152
 153 \ ***** initialize
 154 \
 155 \       Overrides support.4th initialization word with one that does
 156 \       everything start one does, short of loading the kernel and
 157 \       modules. Returns a flag
 158
 159 : initialize ( -- flag )
 160   s" /boot/defaults/loader.conf" initialize
 161   include_conf_files
 162   include_nextboot_file
 163   any_conf_read?
 164 ;
 165
 166 \ ***** read-conf
 167 \
 168 \       Read a configuration file, whose name was specified on the command
 169 \       line, if interpreted, or given on the stack, if compiled in.
 170
 171 : (read-conf)  ( addr len -- )
 172   conf_files .addr @ ?dup if free abort" Fatal error freeing memory" then
 173   strdup conf_files .len ! conf_files .addr !
 174   include_conf_files \ Will recurse on new loader_conf_files definitions
 175 ;
 176
 177 : read-conf  ( <filename> | addr len -- ) ( throws: abort & user-defined )
 178   state @ if
 179     \ Compiling
 180     postpone (read-conf)
 181   else
 182     \ Interpreting
 183     bl parse (read-conf)
 184   then
 185 ; immediate
 186
 187 \ ***** enable-module
 188 \
 189 \       Turn a module loading on.
 190
 191 : enable-module ( <module> -- )
 192   bl parse module_options @ >r
 193   begin
 194     r@
 195   while
 196     2dup
 197     r@ module.name dup .addr @ swap .len @
 198     compare 0= if
 199       2drop
 200       r@ module.name dup .addr @ swap .len @ type
 201       true r> module.flag !
 202       ."  will be loaded." cr
 203       exit
 204     then
 205     r> module.next @ >r
 206   repeat
 207   r> drop
 208   type ."  wasn't found." cr
 209 ;
 210
 211 \ ***** disable-module
 212 \
 213 \       Turn a module loading off.
 214
 215 : disable-module ( <module> -- )
 216   bl parse module_options @ >r
 217   begin
 218     r@
 219   while
 220     2dup
 221     r@ module.name dup .addr @ swap .len @
 222     compare 0= if
 223       2drop
 224       r@ module.name dup .addr @ swap .len @ type
 225       false r> module.flag !
 226       ."  will not be loaded." cr
 227       exit
 228     then
 229     r> module.next @ >r
 230   repeat
 231   r> drop
 232   type ."  wasn't found." cr
 233 ;
 234
 235 \ ***** toggle-module
 236 \
 237 \       Turn a module loading on/off.
 238
 239 : toggle-module ( <module> -- )
 240   bl parse module_options @ >r
 241   begin
 242     r@
 243   while
 244     2dup
 245     r@ module.name dup .addr @ swap .len @
 246     compare 0= if
 247       2drop
 248       r@ module.name dup .addr @ swap .len @ type
 249       r@ module.flag @ 0= dup r> module.flag !
 250       if
 251         ."  will be loaded." cr
 252       else
 253         ."  will not be loaded." cr
 254       then
 255       exit
 256     then
 257     r> module.next @ >r
 258   repeat
 259   r> drop
 260   type ."  wasn't found." cr
 261 ;
 262
 263 \ ***** show-module
 264 \
 265 \       Show loading information about a module.
 266
 267 : show-module ( <module> -- )
 268   bl parse module_options @ >r
 269   begin
 270     r@
 271   while
 272     2dup
 273     r@ module.name dup .addr @ swap .len @
 274     compare 0= if
 275       2drop
 276       ." Name: " r@ module.name dup .addr @ swap .len @ type cr
 277       ." Path: " r@ module.loadname dup .addr @ swap .len @ type cr
 278       ." Type: " r@ module.type dup .addr @ swap .len @ type cr
 279       ." Flags: " r@ module.args dup .addr @ swap .len @ type cr
 280       ." Before load: " r@ module.beforeload dup .addr @ swap .len @ type cr
 281       ." After load: " r@ module.afterload dup .addr @ swap .len @ type cr
 282       ." Error: " r@ module.loaderror dup .addr @ swap .len @ type cr
 283       ." Status: " r> module.flag @ if ." Load" else ." Don't load" then cr
 284       exit
 285     then
 286     r> module.next @ >r
 287   repeat
 288   r> drop
 289   type ."  wasn't found." cr
 290 ;
 291
 292 \ Words to be used inside configuration files
 293
 294 : retry false ;         \ For use in load error commands
 295 : ignore true ;         \ For use in load error commands
 296
 297 \ Return to strict forth vocabulary
 298
 299 : #type
 300   over - >r
 301   type
 302   r> spaces
 303 ;
 304
 305 : .? 2 spaces 2swap 15 #type 2 spaces type cr ;
 306
 307 : ?
 308   ['] ? execute
 309   s" boot-conf" s" load kernel and modules, then autoboot" .?
 310   s" read-conf" s" read a configuration file" .?
 311   s" enable-module" s" enable loading of a module" .?
 312   s" disable-module" s" disable loading of a module" .?
 313   s" toggle-module" s" toggle loading of a module" .?
 314   s" show-module" s" show module load data" .?
 315 ;
 316
 317 only forth also
 318