loader.4th revision 53672 
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 53672 1999-11-24 17:56:40Z dcs $
26
27include /boot/support.4th
28
29only forth definitions also support-functions
30
31\ ***** boot-conf
32\
33\	Prepares to boot as specified by loaded configuration files.
34
35: boot-conf
36  load_kernel
37  load_modules
38  0 autoboot
39;
40
41\ ***** check-password
42\
43\	If a password was defined, execute autoboot and ask for
44\	password if autoboot returns.
45
46: check-password
47  password .addr @ if
48    0 autoboot
49    false >r
50    begin
51      bell emit bell emit
52      ." Password: "
53      password .len @ read-password
54      dup password .len @ = if
55        2dup password .addr @ password .len @
56        compare 0= if r> drop true >r then
57      then
58      drop free drop
59      r@
60    until
61    r> drop
62  then
63;
64
65\ ***** start
66\
67\       Initializes support.4th global variables, sets loader_conf_files,
68\       process conf files, and, if any one such file was succesfully
69\       read to the end, load kernel and modules.
70
71: start  ( -- ) ( throws: abort & user-defined )
72  s" /boot/defaults/loader.conf" initialize
73  include_conf_files
74  \ Will *NOT* try to load kernel and modules if no configuration file
75  \ was succesfully loaded!
76  any_conf_read? if
77    load_kernel
78    load_modules
79  then
80;
81
82\ ***** initialize
83\
84\	Overrides support.4th initialization word with one that does
85\	everything start one does, short of loading the kernel and
86\	modules. Returns a flag
87
88: initialize ( -- flag )
89  s" /boot/defaults/loader.conf" initialize
90  include_conf_files
91  any_conf_read?
92;
93
94\ ***** read-conf
95\
96\	Read a configuration file, whose name was specified on the command
97\	line, if interpreted, or given on the stack, if compiled in.
98
99: (read-conf)  ( addr len -- )
100  conf_files .addr @ ?dup if free abort" Fatal error freeing memory" then
101  strdup conf_files .len ! conf_files .addr !
102  include_conf_files \ Will recurse on new loader_conf_files definitions
103;
104
105: read-conf  ( <filename> | addr len -- ) ( throws: abort & user-defined )
106  state @ if
107    \ Compiling
108    postpone (read-conf)
109  else
110    \ Interpreting
111    bl parse (read-conf)
112  then
113; immediate
114
115\ ***** enable-module
116\
117\       Turn a module loading on.
118
119: enable-module ( <module> -- )
120  bl parse module_options @ >r
121  begin
122    r@
123  while
124    2dup
125    r@ module.name dup .addr @ swap .len @
126    compare 0= if
127      2drop
128      r@ module.name dup .addr @ swap .len @ type
129      true r> module.flag !
130      ."  will be loaded." cr
131      exit
132    then
133    r> module.next @ >r
134  repeat
135  r> drop
136  type ."  wasn't found." cr
137;
138
139\ ***** disable-module
140\
141\       Turn a module loading off.
142
143: disable-module ( <module> -- )
144  bl parse module_options @ >r
145  begin
146    r@
147  while
148    2dup
149    r@ module.name dup .addr @ swap .len @
150    compare 0= if
151      2drop
152      r@ module.name dup .addr @ swap .len @ type
153      false r> module.flag !
154      ."  will not be loaded." cr
155      exit
156    then
157    r> module.next @ >r
158  repeat
159  r> drop
160  type ."  wasn't found." cr
161;
162
163\ ***** toggle-module
164\
165\       Turn a module loading on/off.
166
167: toggle-module ( <module> -- )
168  bl parse module_options @ >r
169  begin
170    r@
171  while
172    2dup
173    r@ module.name dup .addr @ swap .len @
174    compare 0= if
175      2drop
176      r@ module.name dup .addr @ swap .len @ type
177      r@ module.flag @ 0= dup r> module.flag !
178      if
179        ."  will be loaded." cr
180      else
181        ."  will not be loaded." cr
182      then
183      exit
184    then
185    r> module.next @ >r
186  repeat
187  r> drop
188  type ."  wasn't found." cr
189;
190
191\ ***** show-module
192\
193\	Show loading information about a module.
194
195: show-module ( <module> -- )
196  bl parse module_options @ >r
197  begin
198    r@
199  while
200    2dup
201    r@ module.name dup .addr @ swap .len @
202    compare 0= if
203      2drop
204      ." Name: " r@ module.name dup .addr @ swap .len @ type cr
205      ." Path: " r@ module.loadname dup .addr @ swap .len @ type cr
206      ." Type: " r@ module.type dup .addr @ swap .len @ type cr
207      ." Flags: " r@ module.args dup .addr @ swap .len @ type cr
208      ." Before load: " r@ module.beforeload dup .addr @ swap .len @ type cr
209      ." After load: " r@ module.afterload dup .addr @ swap .len @ type cr
210      ." Error: " r@ module.loaderror dup .addr @ swap .len @ type cr
211      ." Status: " r> module.flag @ if ." Load" else ." Don't load" then cr
212      exit
213    then
214    r> module.next @ >r
215  repeat
216  r> drop
217  type ."  wasn't found." cr
218;
219
220\ Words to be used inside configuration files
221
222: retry false ;         \ For use in load error commands
223: ignore true ;         \ For use in load error commands
224
225\ Return to strict forth vocabulary
226
227only forth also
228
229