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