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