Remove arch-alpha variable.
[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.8 2005/02/20 16:31:53 swildner Exp $
27
28 s" arch-i386" environment? [if] [if]
29         s" loader_version" environment?  [if]
30                 11 < [if]
31                         .( Loader version 1.1+ required) cr
32                         abort
33                 [then]
34         [else]
35                 .( Could not get loader version!) cr
36                 abort
37         [then]
38 [then] [then]
39
40 256 dictthreshold !  \ 256 cells minimum free space
41 2048 dictincrease !  \ 2048 additional cells each time
42
43 include /boot/support.4th
44
45 \ ***** boot-conf
46 \
47 \       Prepares to boot as specified by loaded configuration files.
48
49 only forth also support-functions also builtins definitions
50
51 : boot
52   0= if ( interpreted ) get_arguments then
53
54   \ Unload only if a path was passed
55   dup if
56     >r over r> swap
57     c@ [char] - <> if
58       0 1 unload drop
59     else
60       s" kernelname" getenv? if ( a kernel has been loaded )
61         1 boot exit
62       then
63       load_kernel_and_modules
64       ?dup if exit then
65       0 1 boot exit
66     then
67   else
68     s" kernelname" getenv? if ( a kernel has been loaded )
69       1 boot exit
70     then
71     load_kernel_and_modules
72     ?dup if exit then
73     0 1 boot exit
74   then
75   load_kernel_and_modules
76   ?dup 0= if 0 1 boot then
77 ;
78
79 : boot-conf
80   0= if ( interpreted ) get_arguments then
81   0 1 unload drop
82   load_kernel_and_modules
83   ?dup 0= if 0 1 autoboot then
84 ;
85
86 also forth definitions also builtins
87
88 builtin: boot
89 builtin: boot-conf
90
91 only forth definitions also support-functions
92
93 \ ***** check-password
94 \
95 \       If a password was defined, execute autoboot and ask for
96 \       password if autoboot returns.
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.nfsroot.path" getenv? if
125     s" /boot/defaults/loader-bootp.conf" initialize
126   else
127     s" /boot/defaults/loader.conf" initialize
128   then
129   include_conf_files
130   include_nextboot_file
131   \ Will *NOT* try to load kernel and modules if no configuration file
132   \ was succesfully loaded!
133   any_conf_read? if
134     load_kernel
135     load_modules
136   then
137 ;
138
139 \ ***** initialize
140 \
141 \       Overrides support.4th initialization word with one that does
142 \       everything start one does, short of loading the kernel and
143 \       modules. Returns a flag
144
145 : initialize ( -- flag )
146   s" boot.nfsroot.path" getenv? if
147     s" /boot/defaults/loader-bootp.conf" initialize
148   else
149     s" /boot/defaults/loader.conf" initialize
150   then
151   include_conf_files
152   include_nextboot_file
153   any_conf_read?
154 ;
155
156 \ ***** read-conf
157 \
158 \       Read a configuration file, whose name was specified on the command
159 \       line, if interpreted, or given on the stack, if compiled in.
160
161 : (read-conf)  ( addr len -- )
162   conf_files .addr @ ?dup if free abort" Fatal error freeing memory" then
163   strdup conf_files .len ! conf_files .addr !
164   include_conf_files \ Will recurse on new loader_conf_files definitions
165 ;
166
167 : read-conf  ( <filename> | addr len -- ) ( throws: abort & user-defined )
168   state @ if
169     \ Compiling
170     postpone (read-conf)
171   else
172     \ Interpreting
173     bl parse (read-conf)
174   then
175 ; immediate
176
177 \ ***** enable-module
178 \
179 \       Turn a module loading on.
180
181 : enable-module ( <module> -- )
182   bl parse module_options @ >r
183   begin
184     r@
185   while
186     2dup
187     r@ module.name dup .addr @ swap .len @
188     compare 0= if
189       2drop
190       r@ module.name dup .addr @ swap .len @ type
191       true r> module.flag !
192       ."  will be loaded." cr
193       exit
194     then
195     r> module.next @ >r
196   repeat
197   r> drop
198   type ."  wasn't found." cr
199 ;
200
201 \ ***** disable-module
202 \
203 \       Turn a module loading off.
204
205 : disable-module ( <module> -- )
206   bl parse module_options @ >r
207   begin
208     r@
209   while
210     2dup
211     r@ module.name dup .addr @ swap .len @
212     compare 0= if
213       2drop
214       r@ module.name dup .addr @ swap .len @ type
215       false r> module.flag !
216       ."  will not be loaded." cr
217       exit
218     then
219     r> module.next @ >r
220   repeat
221   r> drop
222   type ."  wasn't found." cr
223 ;
224
225 \ ***** toggle-module
226 \
227 \       Turn a module loading on/off.
228
229 : toggle-module ( <module> -- )
230   bl parse module_options @ >r
231   begin
232     r@
233   while
234     2dup
235     r@ module.name dup .addr @ swap .len @
236     compare 0= if
237       2drop
238       r@ module.name dup .addr @ swap .len @ type
239       r@ module.flag @ 0= dup r> module.flag !
240       if
241         ."  will be loaded." cr
242       else
243         ."  will not be loaded." cr
244       then
245       exit
246     then
247     r> module.next @ >r
248   repeat
249   r> drop
250   type ."  wasn't found." cr
251 ;
252
253 \ ***** show-module
254 \
255 \       Show loading information about a module.
256
257 : show-module ( <module> -- )
258   bl parse module_options @ >r
259   begin
260     r@
261   while
262     2dup
263     r@ module.name dup .addr @ swap .len @
264     compare 0= if
265       2drop
266       ." Name: " r@ module.name dup .addr @ swap .len @ type cr
267       ." Path: " r@ module.loadname dup .addr @ swap .len @ type cr
268       ." Type: " r@ module.type dup .addr @ swap .len @ type cr
269       ." Flags: " r@ module.args dup .addr @ swap .len @ type cr
270       ." Before load: " r@ module.beforeload dup .addr @ swap .len @ type cr
271       ." After load: " r@ module.afterload dup .addr @ swap .len @ type cr
272       ." Error: " r@ module.loaderror dup .addr @ swap .len @ type cr
273       ." Status: " r> module.flag @ if ." Load" else ." Don't load" then cr
274       exit
275     then
276     r> module.next @ >r
277   repeat
278   r> drop
279   type ."  wasn't found." cr
280 ;
281
282 \ Words to be used inside configuration files
283
284 : retry false ;         \ For use in load error commands
285 : ignore true ;         \ For use in load error commands
286
287 \ Return to strict forth vocabulary
288
289 : #type
290   over - >r
291   type
292   r> spaces
293 ;
294
295 : .? 2 spaces 2swap 15 #type 2 spaces type cr ;
296
297 : ?
298   ['] ? execute
299   s" boot-conf" s" load kernel and modules, then autoboot" .?
300   s" read-conf" s" read a configuration file" .?
301   s" enable-module" s" enable loading of a module" .?
302   s" disable-module" s" disable loading of a module" .?
303   s" toggle-module" s" toggle loading of a module" .?
304   s" show-module" s" show module load data" .?
305 ;
306
307 only forth also
308