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
  44 \ ***** boot-conf
  45 \
  46 \       Prepares to boot as specified by loaded configuration files.
  47
  48 only forth also support-functions also builtins definitions
  49
  50 : boot
  51   0= if ( interpreted ) get_arguments then
  52
  53   \ Unload only if a path was passed
  54   dup if
  55     >r over r> swap
  56     c@ [char] - <> if
  57       0 1 unload drop
  58     else
  59       s" kernelname" getenv? if ( a kernel has been loaded )
  60         1 boot exit
  61       then
  62       load_kernel_and_modules
  63       ?dup if exit then
  64       0 1 boot exit
  65     then
  66   else
  67     s" kernelname" getenv? if ( a kernel has been loaded )
  68       1 boot exit
  69     then
  70     load_kernel_and_modules
  71     ?dup if exit then
  72     0 1 boot exit
  73   then
  74   load_kernel_and_modules
  75   ?dup 0= if 0 1 boot then
  76 ;
  77
  78 : boot-conf
  79   0= if ( interpreted ) get_arguments then
  80   0 1 unload drop
  81   load_kernel_and_modules
  82   ?dup 0= if 0 1 autoboot then
  83 ;
  84
  85 also forth definitions also builtins
  86
  87 builtin: boot
  88 builtin: boot-conf
  89
  90 only forth definitions also support-functions
  91
  92 \ ***** check-password
  93 \
  94 \       If a password was defined, execute autoboot and ask for
  95 \       password if autoboot returns.
  96 \       Do not exit unless the right password is given.
  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/defaults/loader.conf" initialize
 125   include_conf_files
 126   include_nextboot_file
 127   \ Will *NOT* try to load kernel and modules if no configuration file
 128   \ was succesfully loaded!
 129   any_conf_read? if
 130     load_kernel
 131     load_modules
 132   then
 133 ;
 134
 135 \ ***** initialize
 136 \
 137 \       Overrides support.4th initialization word with one that does
 138 \       everything start one does, short of loading the kernel and
 139 \       modules. Returns a flag
 140
 141 : initialize ( -- flag )
 142   s" /boot/defaults/loader.conf" initialize
 143   include_conf_files
 144   include_nextboot_file
 145   any_conf_read?
 146 ;
 147
 148 \ ***** read-conf
 149 \
 150 \       Read a configuration file, whose name was specified on the command
 151 \       line, if interpreted, or given on the stack, if compiled in.
 152
 153 : (read-conf)  ( addr len -- )
 154   conf_files string=
 155   include_conf_files \ Will recurse on new loader_conf_files definitions
 156 ;
 157
 158 : read-conf  ( <filename> | addr len -- ) ( throws: abort & user-defined )
 159   state @ if
 160     \ Compiling
 161     postpone (read-conf)
 162   else
 163     \ Interpreting
 164     bl parse (read-conf)
 165   then
 166 ; immediate
 167
 168 \ show, enable, disable, toggle module loading. They all take module from
 169 \ the next word
 170
 171 : set-module-flag ( module_addr val -- ) \ set and print flag
 172   over module.flag !
 173   dup module.name strtype
 174   module.flag @ if ."  will be loaded" else ."  will not be loaded" then cr
 175 ;
 176
 177 : enable-module find-module ?dup if true set-module-flag then ;
 178
 179 : disable-module find-module ?dup if false set-module-flag then ;
 180
 181 : toggle-module find-module ?dup if dup module.flag @ 0= set-module-flag then ;
 182
 183 \ ***** show-module
 184 \
 185 \       Show loading information about a module.
 186
 187 : show-module ( <module> -- ) find-module ?dup if show-one-module then ;
 188
 189 \ Words to be used inside configuration files
 190
 191 : retry false ;         \ For use in load error commands
 192 : ignore true ;         \ For use in load error commands
 193
 194 \ Return to strict forth vocabulary
 195
 196 : #type
 197   over - >r
 198   type
 199   r> spaces
 200 ;
 201
 202 : .? 2 spaces 2swap 15 #type 2 spaces type cr ;
 203
 204 : ?
 205   ['] ? execute
 206   s" boot-conf" s" load kernel and modules, then autoboot" .?
 207   s" read-conf" s" read a configuration file" .?
 208   s" enable-module" s" enable loading of a module" .?
 209   s" disable-module" s" disable loading of a module" .?
 210   s" toggle-module" s" toggle loading of a module" .?
 211   s" show-module" s" show module load data" .?
 212 ;
 213
 214 only forth also
 215