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