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