loader.4th revision 241361 
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 241361 2012-10-08 23:02:35Z dteske $
26
27s" arch-i386" 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
39256 dictthreshold !  \ 256 cells minimum free space
402048 dictincrease !  \ 2048 additional cells each time
41
42include /boot/support.4th
43include /boot/color.4th
44
45only forth also support-functions also builtins definitions
46
47: try-menu-unset
48  \ menu-unset may not be present
49  s" beastie_disable" getenv
50  dup -1 <> if
51    s" YES" compare-insensitive 0= if
52      exit
53    then
54  else
55    drop
56  then
57  s" menu-unset"
58  sfind if
59    execute
60  else
61    drop
62  then
63;
64
65: boot
66  0= if ( interpreted ) get_arguments then
67
68  loader_color? if
69    ." [37;44mBooting...[0m" cr
70  else
71    ." Booting..." cr
72  then
73
74  \ Unload only if a path was passed
75  dup if
76    >r over r> swap
77    c@ [char] - <> if
78      0 1 unload drop
79    else
80      s" kernelname" getenv? if ( a kernel has been loaded )
81        try-menu-unset
82        1 boot exit
83      then
84      load_kernel_and_modules
85      ?dup if exit then
86      try-menu-unset
87      0 1 boot exit
88    then
89  else
90    s" kernelname" getenv? if ( a kernel has been loaded )
91      try-menu-unset
92      1 boot exit
93    then
94    load_kernel_and_modules
95    ?dup if exit then
96    try-menu-unset
97    0 1 boot exit
98  then
99  load_kernel_and_modules
100  ?dup 0= if 0 1 boot then
101;
102
103\ ***** boot-conf
104\
105\	Prepares to boot as specified by loaded configuration files.
106
107: boot-conf
108  0= if ( interpreted ) get_arguments then
109  0 1 unload drop
110  load_kernel_and_modules
111  ?dup 0= if 0 1 autoboot then
112;
113
114also forth definitions also builtins
115
116builtin: boot
117builtin: boot-conf
118
119only forth definitions also support-functions
120
121include /boot/check-password.4th
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  include_nextboot_file
133  \ Will *NOT* try to load kernel and modules if no configuration file
134  \ was succesfully loaded!
135  any_conf_read? if
136    load_kernel
137    load_modules
138  then
139;
140
141\ ***** initialize
142\
143\	Overrides support.4th initialization word with one that does
144\	everything start one does, short of loading the kernel and
145\	modules. Returns a flag
146
147: initialize ( -- flag )
148  s" /boot/defaults/loader.conf" initialize
149  include_conf_files
150  include_nextboot_file
151  any_conf_read?
152;
153
154\ ***** read-conf
155\
156\	Read a configuration file, whose name was specified on the command
157\	line, if interpreted, or given on the stack, if compiled in.
158
159: (read-conf)  ( addr len -- )
160  conf_files string=
161  include_conf_files \ Will recurse on new loader_conf_files definitions
162;
163
164: read-conf  ( <filename> | addr len -- ) ( throws: abort & user-defined )
165  state @ if
166    \ Compiling
167    postpone (read-conf)
168  else
169    \ Interpreting
170    bl parse (read-conf)
171  then
172; immediate
173
174\ show, enable, disable, toggle module loading. They all take module from
175\ the next word
176
177: set-module-flag ( module_addr val -- ) \ set and print flag
178  over module.flag !
179  dup module.name strtype
180  module.flag @ if ."  will be loaded" else ."  will not be loaded" then cr
181;
182
183: enable-module find-module ?dup if true set-module-flag then ;
184
185: disable-module find-module ?dup if false set-module-flag then ;
186
187: toggle-module find-module ?dup if dup module.flag @ 0= set-module-flag then ;
188
189\ ***** show-module
190\
191\	Show loading information about a module.
192
193: show-module ( <module> -- ) find-module ?dup if show-one-module then ;
194
195\ Words to be used inside configuration files
196
197: retry false ;         \ For use in load error commands
198: ignore true ;         \ For use in load error commands
199
200\ Return to strict forth vocabulary
201
202: #type
203  over - >r
204  type
205  r> spaces
206;
207
208: .? 2 spaces 2swap 15 #type 2 spaces type cr ;
209
210: ?
211  ['] ? execute
212  s" boot-conf" s" load kernel and modules, then autoboot" .?
213  s" read-conf" s" read a configuration file" .?
214  s" enable-module" s" enable loading of a module" .?
215  s" disable-module" s" disable loading of a module" .?
216  s" toggle-module" s" toggle loading of a module" .?
217  s" show-module" s" show module load data" .?
218;
219
220only forth also
221
222