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$
  26
  27 s" arch-i386" environment? [if] [if]
  28         s" loader_version" environment?  [if]
  29                 11 < [if]
  30                         .( Loader version 1.1+ required) cr
  31                         abort
  32                 [then]
  33         [else]
  34                 .( Could not get loader version!) cr
  35                 abort
  36         [then]
  37 [then] [then]
  38
  39 256 dictthreshold !  \ 256 cells minimum free space
  40 2048 dictincrease !  \ 2048 additional cells each time
  41
  42 include /boot/support.4th
  43 include /boot/color.4th
  44 include /boot/delay.4th
  45
  46 only forth also support-functions also builtins definitions
  47
  48 : bootmsg ( -- )
  49   loader_color? if
  50     ." \e[37;44mBooting...\e[0m" cr
  51   else
  52     ." Booting..." cr
  53   then
  54 ;
  55
  56 : try-menu-unset
  57   \ menu-unset may not be present
  58   s" beastie_disable" getenv
  59   dup -1 <> if
  60     s" YES" compare-insensitive 0= if
  61       exit
  62     then
  63   else
  64     drop
  65   then
  66   s" menu-unset"
  67   sfind if
  68     execute
  69   else
  70     drop
  71   then
  72   s" menusets-unset"
  73   sfind if
  74     execute
  75   else
  76     drop
  77   then
  78 ;
  79
  80 : boot
  81   0= if ( interpreted ) get_arguments then
  82
  83   \ Unload only if a path was passed
  84   dup if
  85     >r over r> swap
  86     c@ [char] - <> if
  87       0 1 unload drop
  88     else
  89       s" kernelname" getenv? if ( a kernel has been loaded )
  90         try-menu-unset
  91         bootmsg 1 boot exit
  92       then
  93       load_kernel_and_modules
  94       ?dup if exit then
  95       try-menu-unset
  96       bootmsg 0 1 boot exit
  97     then
  98   else
  99     s" kernelname" getenv? if ( a kernel has been loaded )
 100       try-menu-unset
 101       bootmsg 1 boot exit
 102     then
 103     load_kernel_and_modules
 104     ?dup if exit then
 105     try-menu-unset
 106     bootmsg 0 1 boot exit
 107   then
 108   load_kernel_and_modules
 109   ?dup 0= if bootmsg 0 1 boot then
 110 ;
 111
 112 \ ***** boot-conf
 113 \
 114 \       Prepares to boot as specified by loaded configuration files.
 115
 116 : boot-conf
 117   0= if ( interpreted ) get_arguments then
 118   0 1 unload drop
 119   load_kernel_and_modules
 120   ?dup 0= if 0 1 autoboot then
 121 ;
 122
 123 also forth definitions also builtins
 124
 125 builtin: boot
 126 builtin: boot-conf
 127
 128 only forth definitions also support-functions
 129
 130 include /boot/check-password.4th
 131
 132 \ ***** start
 133 \
 134 \       Initializes support.4th global variables, sets loader_conf_files,
 135 \       processes conf files, and, if any one such file was succesfully
 136 \       read to the end, loads kernel and modules.
 137
 138 : start  ( -- ) ( throws: abort & user-defined )
 139   s" /boot/defaults/loader.conf" initialize
 140   include_conf_files
 141   include_nextboot_file
 142   \ Will *NOT* try to load kernel and modules if no configuration file
 143   \ was succesfully loaded!
 144   any_conf_read? if
 145     s" loader_delay" getenv -1 = if
 146       load_kernel
 147       load_modules
 148     else
 149       drop
 150       ." Loading Kernel and Modules (Ctrl-C to Abort)" cr
 151       s" also support-functions" evaluate
 152       s" set delay_command='load_kernel load_modules'" evaluate
 153       s" set delay_showdots" evaluate
 154       delay_execute
 155     then
 156   then
 157 ;
 158
 159 \ ***** initialize
 160 \
 161 \       Overrides support.4th initialization word with one that does
 162 \       everything start one does, short of loading the kernel and
 163 \       modules. Returns a flag
 164
 165 : initialize ( -- flag )
 166   s" /boot/defaults/loader.conf" initialize
 167   include_conf_files
 168   include_nextboot_file
 169   any_conf_read?
 170 ;
 171
 172 \ ***** read-conf
 173 \
 174 \       Read a configuration file, whose name was specified on the command
 175 \       line, if interpreted, or given on the stack, if compiled in.
 176
 177 : (read-conf)  ( addr len -- )
 178   conf_files string=
 179   include_conf_files \ Will recurse on new loader_conf_files definitions
 180 ;
 181
 182 : read-conf  ( <filename> | addr len -- ) ( throws: abort & user-defined )
 183   state @ if
 184     \ Compiling
 185     postpone (read-conf)
 186   else
 187     \ Interpreting
 188     bl parse (read-conf)
 189   then
 190 ; immediate
 191
 192 \ show, enable, disable, toggle module loading. They all take module from
 193 \ the next word
 194
 195 : set-module-flag ( module_addr val -- ) \ set and print flag
 196   over module.flag !
 197   dup module.name strtype
 198   module.flag @ if ."  will be loaded" else ."  will not be loaded" then cr
 199 ;
 200
 201 : enable-module find-module ?dup if true set-module-flag then ;
 202
 203 : disable-module find-module ?dup if false set-module-flag then ;
 204
 205 : toggle-module find-module ?dup if dup module.flag @ 0= set-module-flag then ;
 206
 207 \ ***** show-module
 208 \
 209 \       Show loading information about a module.
 210
 211 : show-module ( <module> -- ) find-module ?dup if show-one-module then ;
 212
 213 \ Words to be used inside configuration files
 214
 215 : retry false ;         \ For use in load error commands
 216 : ignore true ;         \ For use in load error commands
 217
 218 \ Return to strict forth vocabulary
 219
 220 : #type
 221   over - >r
 222   type
 223   r> spaces
 224 ;
 225
 226 : .? 2 spaces 2swap 15 #type 2 spaces type cr ;
 227
 228 : ?
 229   ['] ? execute
 230   s" boot-conf" s" load kernel and modules, then autoboot" .?
 231   s" read-conf" s" read a configuration file" .?
 232   s" enable-module" s" enable loading of a module" .?
 233   s" disable-module" s" disable loading of a module" .?
 234   s" toggle-module" s" toggle loading of a module" .?
 235   s" show-module" s" show module load data" .?
 236   s" try-include" s" try to load/interpret files" .?
 237 ;
 238
 239 : try-include ( -- ) \ see loader.4th(8)
 240   ['] include ( -- xt ) \ get the execution token of `include'
 241   catch ( xt -- exception# | 0 ) if \ failed
 242     LF parse ( c -- s-addr/u ) 2drop \ advance >in to EOL (drop data)
 243     \ ... prevents words unused by `include' from being interpreted
 244   then
 245 ; immediate \ interpret immediately for access to `source' (aka tib)
 246
 247 only forth also
 248