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