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