loader.4th revision 46005 
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\	$Id: loader.4th,v 1.1 1999/03/09 14:06:55 dcs Exp $
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\ ***** start
42\
43\       Initializes support.4th global variables, sets loader_conf_files,
44\       process conf files, and, if any one such file was succesfully
45\       read to the end, load kernel and modules.
46
47: start  ( -- ) ( throws: abort & user-defined )
48  s" /boot/defaults/loader.conf" initialize
49  include_conf_files
50  \ Will *NOT* try to load kernel and modules if no configuration file
51  \ was succesfully loaded!
52  any_conf_read? if
53    load_kernel
54    load_modules
55  then
56;
57
58\ ***** read-conf
59\
60\	Read a configuration file, whose name was specified on the command
61\	line, if interpreted, or given on the stack, if compiled in.
62
63: (read-conf)  ( addr len -- )
64  conf_files .addr @ ?dup if free abort" Fatal error freeing memory" then
65  strdup conf_files .len ! conf_files .addr !
66  include_conf_files \ Will recurse on new loader_conf_files definitions
67;
68
69: read-conf  ( <filename> | addr len -- ) ( throws: abort & user-defined )
70  state @ if
71    \ Compiling
72    postpone (read-conf)
73  else
74    \ Interpreting
75    bl parse (read-conf)
76  then
77; immediate
78
79\ ***** enable-module
80\
81\       Turn a module loading on.
82
83: enable-module ( <module> -- )
84  bl parse module_options @ >r
85  begin
86    r@
87  while
88    2dup
89    r@ module.name dup .addr @ swap .len @
90    compare 0= if
91      2drop
92      r@ module.name dup .addr @ swap .len @ type
93      true r> module.flag !
94      ."  will be loaded." cr
95      exit
96    then
97    r> module.next @ >r
98  repeat
99  r> drop
100  type ."  wasn't found." cr
101;
102
103\ ***** disable-module
104\
105\       Turn a module loading off.
106
107: disable-module ( <module> -- )
108  bl parse module_options @ >r
109  begin
110    r@
111  while
112    2dup
113    r@ module.name dup .addr @ swap .len @
114    compare 0= if
115      2drop
116      r@ module.name dup .addr @ swap .len @ type
117      false r> module.flag !
118      ."  will not be loaded." cr
119      exit
120    then
121    r> module.next @ >r
122  repeat
123  r> drop
124  type ."  wasn't found." cr
125;
126
127\ ***** toggle-module
128\
129\       Turn a module loading on/off.
130
131: toggle-module ( <module> -- )
132  bl parse module_options @ >r
133  begin
134    r@
135  while
136    2dup
137    r@ module.name dup .addr @ swap .len @
138    compare 0= if
139      2drop
140      r@ module.name dup .addr @ swap .len @ type
141      r@ module.flag @ 0= dup r> module.flag !
142      if
143        ."  will be loaded." cr
144      else
145        ."  will not be loaded." cr
146      then
147      exit
148    then
149    r> module.next @ >r
150  repeat
151  r> drop
152  type ."  wasn't found." cr
153;
154
155\ ***** show-module
156\
157\	Show loading information about a module.
158
159: show-module ( <module> -- )
160  bl parse module_options @ >r
161  begin
162    r@
163  while
164    2dup
165    r@ module.name dup .addr @ swap .len @
166    compare 0= if
167      2drop
168      ." Name: " r@ module.name dup .addr @ swap .len @ type cr
169      ." Path: " r@ module.loadname dup .addr @ swap .len @ type cr
170      ." Type: " r@ module.type dup .addr @ swap .len @ type cr
171      ." Flags: " r@ module.args dup .addr @ swap .len @ type cr
172      ." Before load: " r@ module.beforeload dup .addr @ swap .len @ type cr
173      ." After load: " r@ module.afterload dup .addr @ swap .len @ type cr
174      ." Error: " r@ module.loaderror dup .addr @ swap .len @ type cr
175      ." Status: " r> module.flag @ if ." Load" else ." Don't load" then cr
176      exit
177    then
178    r> module.next @ >r
179  repeat
180  r> drop
181  type ."  wasn't found." cr
182;
183
184\ Words to be used inside configuration files
185
186: retry false ;         \ For use in load error commands
187: ignore true ;         \ For use in load error commands
188
189\ Return to strict forth vocabulary
190
191only forth also
192 
193