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