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.7 2004/10/14 18:36:00 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" /boot/defaults/loader-bootp.conf" initialize
 138   else
 139     s" /boot/defaults/loader.conf" initialize
 140   then
 141   include_conf_files
 142   include_nextboot_file
 143   \ Will *NOT* try to load kernel and modules if no configuration file
 144   \ was succesfully loaded!
 145   any_conf_read? if
 146     load_kernel
 147     load_modules
 148   then
 149 ;
 150
 151 \ ***** initialize
 152 \
 153 \       Overrides support.4th initialization word with one that does
 154 \       everything start one does, short of loading the kernel and
 155 \       modules. Returns a flag
 156
 157 : initialize ( -- flag )
 158   s" boot.nfsroot.path" getenv? if
 159     s" /boot/defaults/loader-bootp.conf" initialize
 160   else
 161     s" /boot/defaults/loader.conf" initialize
 162   then
 163   include_conf_files
 164   include_nextboot_file
 165   any_conf_read?
 166 ;
 167
 168 \ ***** read-conf
 169 \
 170 \       Read a configuration file, whose name was specified on the command
 171 \       line, if interpreted, or given on the stack, if compiled in.
 172
 173 : (read-conf)  ( addr len -- )
 174   conf_files .addr @ ?dup if free abort" Fatal error freeing memory" then
 175   strdup conf_files .len ! conf_files .addr !
 176   include_conf_files \ Will recurse on new loader_conf_files definitions
 177 ;
 178
 179 : read-conf  ( <filename> | addr len -- ) ( throws: abort & user-defined )
 180   state @ if
 181     \ Compiling
 182     postpone (read-conf)
 183   else
 184     \ Interpreting
 185     bl parse (read-conf)
 186   then
 187 ; immediate
 188
 189 \ ***** enable-module
 190 \
 191 \       Turn a module loading on.
 192
 193 : enable-module ( <module> -- )
 194   bl parse module_options @ >r
 195   begin
 196     r@
 197   while
 198     2dup
 199     r@ module.name dup .addr @ swap .len @
 200     compare 0= if
 201       2drop
 202       r@ module.name dup .addr @ swap .len @ type
 203       true r> module.flag !
 204       ."  will be loaded." cr
 205       exit
 206     then
 207     r> module.next @ >r
 208   repeat
 209   r> drop
 210   type ."  wasn't found." cr
 211 ;
 212
 213 \ ***** disable-module
 214 \
 215 \       Turn a module loading off.
 216
 217 : disable-module ( <module> -- )
 218   bl parse module_options @ >r
 219   begin
 220     r@
 221   while
 222     2dup
 223     r@ module.name dup .addr @ swap .len @
 224     compare 0= if
 225       2drop
 226       r@ module.name dup .addr @ swap .len @ type
 227       false r> module.flag !
 228       ."  will not be loaded." cr
 229       exit
 230     then
 231     r> module.next @ >r
 232   repeat
 233   r> drop
 234   type ."  wasn't found." cr
 235 ;
 236
 237 \ ***** toggle-module
 238 \
 239 \       Turn a module loading on/off.
 240
 241 : toggle-module ( <module> -- )
 242   bl parse module_options @ >r
 243   begin
 244     r@
 245   while
 246     2dup
 247     r@ module.name dup .addr @ swap .len @
 248     compare 0= if
 249       2drop
 250       r@ module.name dup .addr @ swap .len @ type
 251       r@ module.flag @ 0= dup r> module.flag !
 252       if
 253         ."  will be loaded." cr
 254       else
 255         ."  will not be loaded." cr
 256       then
 257       exit
 258     then
 259     r> module.next @ >r
 260   repeat
 261   r> drop
 262   type ."  wasn't found." cr
 263 ;
 264
 265 \ ***** show-module
 266 \
 267 \       Show loading information about a module.
 268
 269 : show-module ( <module> -- )
 270   bl parse module_options @ >r
 271   begin
 272     r@
 273   while
 274     2dup
 275     r@ module.name dup .addr @ swap .len @
 276     compare 0= if
 277       2drop
 278       ." Name: " r@ module.name dup .addr @ swap .len @ type cr
 279       ." Path: " r@ module.loadname dup .addr @ swap .len @ type cr
 280       ." Type: " r@ module.type dup .addr @ swap .len @ type cr
 281       ." Flags: " r@ module.args dup .addr @ swap .len @ type cr
 282       ." Before load: " r@ module.beforeload dup .addr @ swap .len @ type cr
 283       ." After load: " r@ module.afterload dup .addr @ swap .len @ type cr
 284       ." Error: " r@ module.loaderror dup .addr @ swap .len @ type cr
 285       ." Status: " r> module.flag @ if ." Load" else ." Don't load" then cr
 286       exit
 287     then
 288     r> module.next @ >r
 289   repeat
 290   r> drop
 291   type ."  wasn't found." cr
 292 ;
 293
 294 \ Words to be used inside configuration files
 295
 296 : retry false ;         \ For use in load error commands
 297 : ignore true ;         \ For use in load error commands
 298
 299 \ Return to strict forth vocabulary
 300
 301 : #type
 302   over - >r
 303   type
 304   r> spaces
 305 ;
 306
 307 : .? 2 spaces 2swap 15 #type 2 spaces type cr ;
 308
 309 : ?
 310   ['] ? execute
 311   s" boot-conf" s" load kernel and modules, then autoboot" .?
 312   s" read-conf" s" read a configuration file" .?
 313   s" enable-module" s" enable loading of a module" .?
 314   s" disable-module" s" disable loading of a module" .?
 315   s" toggle-module" s" toggle loading of a module" .?
 316   s" show-module" s" show module load data" .?
 317 ;
 318
 319 only forth also
 320