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