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