loader.4th revision 280924 
1\ Copyright (c) 1999 Daniel C. Sobral <dcs@FreeBSD.org>
2\ Copyright (c) 2011-2015 Devin Teske <dteske@FreeBSD.org>
3\ All rights reserved.
4\
5\ Redistribution and use in source and binary forms, with or without
6\ modification, are permitted provided that the following conditions
7\ are met:
8\ 1. Redistributions of source code must retain the above copyright
9\    notice, this list of conditions and the following disclaimer.
10\ 2. Redistributions in binary form must reproduce the above copyright
11\    notice, this list of conditions and the following disclaimer in the
12\    documentation and/or other materials provided with the distribution.
13\
14\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
15\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
16\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
17\ ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
18\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
19\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
20\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
21\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
22\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
23\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
24\ SUCH DAMAGE.
25\
26\ $FreeBSD: head/sys/boot/forth/loader.4th 280924 2015-03-31 22:32:35Z dteske $
27
28s" arch-i386" environment? [if] [if]
29	s" loader_version" environment?  [if]
30		11 < [if]
31			.( Loader version 1.1+ required) cr
32			abort
33		[then]
34	[else]
35		.( Could not get loader version!) cr
36		abort
37	[then]
38[then] [then]
39
40256 dictthreshold !  \ 256 cells minimum free space
412048 dictincrease !  \ 2048 additional cells each time
42
43include /boot/support.4th
44include /boot/color.4th
45include /boot/delay.4th
46
47only forth also support-functions also builtins definitions
48
49: bootmsg ( -- )
50  loader_color? if
51    ." [37;44mBooting...[0m" cr
52  else
53    ." Booting..." cr
54  then
55;
56
57: try-menu-unset
58  \ menu-unset may not be present
59  s" beastie_disable" getenv
60  dup -1 <> if
61    s" YES" compare-insensitive 0= if
62      exit
63    then
64  else
65    drop
66  then
67  s" menu-unset"
68  sfind if
69    execute
70  else
71    drop
72  then
73  s" menusets-unset"
74  sfind if
75    execute
76  else
77    drop
78  then
79;
80
81: boot
82  0= if ( interpreted ) get_arguments then
83
84  \ Unload only if a path was passed
85  dup if
86    >r over r> swap
87    c@ [char] - <> if
88      0 1 unload drop
89    else
90      s" kernelname" getenv? if ( a kernel has been loaded )
91        try-menu-unset
92        bootmsg 1 boot exit
93      then
94      load_kernel_and_modules
95      ?dup if exit then
96      try-menu-unset
97      bootmsg 0 1 boot exit
98    then
99  else
100    s" kernelname" getenv? if ( a kernel has been loaded )
101      try-menu-unset
102      bootmsg 1 boot exit
103    then
104    load_kernel_and_modules
105    ?dup if exit then
106    try-menu-unset
107    bootmsg 0 1 boot exit
108  then
109  load_kernel_and_modules
110  ?dup 0= if bootmsg 0 1 boot then
111;
112
113\ ***** boot-conf
114\
115\	Prepares to boot as specified by loaded configuration files.
116
117: boot-conf
118  0= if ( interpreted ) get_arguments then
119  0 1 unload drop
120  load_kernel_and_modules
121  ?dup 0= if 0 1 autoboot then
122;
123
124also forth definitions also builtins
125
126builtin: boot
127builtin: boot-conf
128
129only forth definitions also support-functions
130
131include /boot/check-password.4th
132
133\ ***** start
134\
135\       Initializes support.4th global variables, sets loader_conf_files,
136\       processes conf files, and, if any one such file was succesfully
137\       read to the end, loads kernel and modules.
138
139: start  ( -- ) ( throws: abort & user-defined )
140  s" /boot/defaults/loader.conf" initialize
141  include_conf_files
142  include_nextboot_file
143  \ Will *NOT* try to load kernel and modules if no configuration file
144  \ was succesfully loaded!
145  any_conf_read? if
146    s" loader_delay" getenv -1 = if
147      load_xen_throw
148      load_kernel
149      load_modules
150    else
151      drop
152      ." Loading Kernel and Modules (Ctrl-C to Abort)" cr
153      s" also support-functions" evaluate
154      s" set delay_command='load_xen_throw load_kernel load_modules'" evaluate
155      s" set delay_showdots" evaluate
156      delay_execute
157    then
158  then
159;
160
161\ ***** initialize
162\
163\	Overrides support.4th initialization word with one that does
164\	everything start one does, short of loading the kernel and
165\	modules. Returns a flag
166
167: initialize ( -- flag )
168  s" /boot/defaults/loader.conf" initialize
169  include_conf_files
170  include_nextboot_file
171  any_conf_read?
172;
173
174\ ***** read-conf
175\
176\	Read a configuration file, whose name was specified on the command
177\	line, if interpreted, or given on the stack, if compiled in.
178
179: (read-conf)  ( addr len -- )
180  conf_files string=
181  include_conf_files \ Will recurse on new loader_conf_files definitions
182;
183
184: read-conf  ( <filename> | addr len -- ) ( throws: abort & user-defined )
185  state @ if
186    \ Compiling
187    postpone (read-conf)
188  else
189    \ Interpreting
190    bl parse (read-conf)
191  then
192; immediate
193
194\ show, enable, disable, toggle module loading. They all take module from
195\ the next word
196
197: set-module-flag ( module_addr val -- ) \ set and print flag
198  over module.flag !
199  dup module.name strtype
200  module.flag @ if ."  will be loaded" else ."  will not be loaded" then cr
201;
202
203: enable-module find-module ?dup if true set-module-flag then ;
204
205: disable-module find-module ?dup if false set-module-flag then ;
206
207: toggle-module find-module ?dup if dup module.flag @ 0= set-module-flag then ;
208
209\ ***** show-module
210\
211\	Show loading information about a module.
212
213: show-module ( <module> -- ) find-module ?dup if show-one-module then ;
214
215\ Words to be used inside configuration files
216
217: retry false ;         \ For use in load error commands
218: ignore true ;         \ For use in load error commands
219
220\ Return to strict forth vocabulary
221
222: #type
223  over - >r
224  type
225  r> spaces
226;
227
228: .? 2 spaces 2swap 15 #type 2 spaces type cr ;
229
230: ?
231  ['] ? execute
232  s" boot-conf" s" load kernel and modules, then autoboot" .?
233  s" read-conf" s" read a configuration file" .?
234  s" enable-module" s" enable loading of a module" .?
235  s" disable-module" s" disable loading of a module" .?
236  s" toggle-module" s" toggle loading of a module" .?
237  s" show-module" s" show module load data" .?
238  s" try-include" s" try to load/interpret files" .?
239;
240
241: try-include ( -- ) \ see loader.4th(8)
242  ['] include ( -- xt ) \ get the execution token of `include'
243  catch ( xt -- exception# | 0 ) if \ failed
244    LF parse ( c -- s-addr/u ) 2drop \ advance >in to EOL (drop data)
245    \ ... prevents words unused by `include' from being interpreted
246  then
247; immediate \ interpret immediately for access to `source' (aka tib)
248
249only forth also
250
251