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