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
27only forth definitions
28
29\ provide u> if needed
30s" u>" sfind [if] drop [else]
31	drop
32: u>
33	2dup u< if 2drop 0 exit then
34	swap u< if -1 exit then
35	0
36;
37[then]
38
39\ provide xemit if needed
40s" xemit" sfind [if] drop [else]
41	drop
42: xemit
43	dup 0x80 u< if emit exit then
44	0 swap 0x3F
45	begin 2dup u> while
46		2/ >r dup 0x3F and 0x80 or swap 6 rshift r>
47	repeat 0x7F xor 2* or
48	begin dup 0x80 u< 0= while emit repeat drop
49;
50[then]
51
52s" arch-i386" environment? [if] [if]
53	s" loader_version" environment?  [if]
54		11 < [if]
55			.( Loader version 1.1+ required) cr
56			abort
57		[then]
58	[else]
59		.( Could not get loader version!) cr
60		abort
61	[then]
62[then] [then]
63
64512 dictthreshold !  \ cells minimum free space
652048 dictincrease !  \ additional cells each time
66
67include /boot/support.4th
68include /boot/color.4th
69include /boot/delay.4th
70include /boot/check-password.4th
71
72only forth definitions
73
74: maybe-resetcons ( -- )
75  loader_color? if
76    ris
77  then
78;
79
80: bootmsg ( -- )
81  loader_color? dup ( -- bool bool )
82  if 7 fg 4 bg then
83  ." Booting..."
84  if me then
85  cr
86;
87
88: try-menu-unset
89  \ menu-unset may not be present
90  s" beastie_disable" getenv
91  dup -1 <> if
92    s" YES" compare-insensitive 0= if
93      exit
94    then
95  else
96    drop
97  then
98  s" menu-unset"
99  sfind if
100    execute
101  else
102    drop
103  then
104  s" menusets-unset"
105  sfind if
106    execute
107  else
108    drop
109  then
110;
111
112only forth also support-functions also builtins definitions
113
114: boot
115  0= if ( interpreted ) get_arguments then
116
117  \ Unload only if a path was passed
118  dup if
119    >r over r> swap
120    c@ [char] - <> if
121      0 1 unload drop
122    else
123      s" kernelname" getenv? if ( a kernel has been loaded )
124        try-menu-unset
125        bootmsg 1 boot exit
126      then
127      load_kernel_and_modules
128      ?dup if exit then
129      try-menu-unset
130      bootmsg 0 1 boot exit
131    then
132  else
133    s" kernelname" getenv? if ( a kernel has been loaded )
134      try-menu-unset
135      bootmsg 1 boot exit
136    then
137    load_kernel_and_modules
138    ?dup if exit then
139    try-menu-unset
140    bootmsg 0 1 boot exit
141  then
142  load_kernel_and_modules
143  ?dup 0= if bootmsg 0 1 boot then
144;
145
146\ ***** boot-conf
147\
148\	Prepares to boot as specified by loaded configuration files.
149
150: boot-conf
151  0= if ( interpreted ) get_arguments then
152  0 1 unload drop
153  load_kernel_and_modules
154  ?dup 0= if 0 1 autoboot then
155;
156
157also forth definitions previous
158
159builtin: boot
160builtin: boot-conf
161
162only forth definitions also support-functions
163
164\ ***** start
165\
166\       Initializes support.4th global variables, sets loader_conf_files,
167\       processes conf files, and, if any one such file was successfully
168\       read to the end, loads kernel and modules.
169
170: start  ( -- ) ( throws: abort & user-defined )
171  s" /boot/defaults/loader.conf" initialize
172  include_conf_files
173  include_nextboot_file
174  \ If the user defined a post-initialize hook, call it now
175  s" post-initialize" sfind if execute else drop then
176  \ Will *NOT* try to load kernel and modules if no configuration file
177  \ was successfully loaded!
178  any_conf_read? if
179    s" loader_delay" getenv -1 = if
180      load_xen_throw
181      load_kernel
182      load_modules
183    else
184      drop
185      ." Loading Kernel and Modules (Ctrl-C to Abort)" cr
186      s" also support-functions" evaluate
187      s" set delay_command='load_xen_throw load_kernel load_modules'" evaluate
188      s" set delay_showdots" evaluate
189      delay_execute
190    then
191  then
192;
193
194\ ***** initialize
195\
196\	Overrides support.4th initialization word with one that does
197\	everything start one does, short of loading the kernel and
198\	modules. Returns a flag.
199
200: initialize ( -- flag )
201  s" /boot/defaults/loader.conf" initialize
202  include_conf_files
203  include_nextboot_file
204  \ If the user defined a post-initialize hook, call it now
205  s" post-initialize" sfind if execute else drop then
206  any_conf_read?
207;
208
209\ ***** read-conf
210\
211\	Read a configuration file, whose name was specified on the command
212\	line, if interpreted, or given on the stack, if compiled in.
213
214: (read-conf)  ( addr len -- )
215  conf_files string=
216  include_conf_files \ Will recurse on new loader_conf_files definitions
217;
218
219: read-conf  ( <filename> | addr len -- ) ( throws: abort & user-defined )
220  state @ if
221    \ Compiling
222    postpone (read-conf)
223  else
224    \ Interpreting
225    bl parse (read-conf)
226  then
227; immediate
228
229\ show, enable, disable, toggle module loading. They all take module from
230\ the next word
231
232: set-module-flag ( module_addr val -- ) \ set and print flag
233  over module.flag !
234  dup module.name strtype
235  module.flag @ if ."  will be loaded" else ."  will not be loaded" then cr
236;
237
238: enable-module find-module ?dup if true set-module-flag then ;
239
240: disable-module find-module ?dup if false set-module-flag then ;
241
242: toggle-module find-module ?dup if dup module.flag @ 0= set-module-flag then ;
243
244\ ***** show-module
245\
246\	Show loading information about a module.
247
248: show-module ( <module> -- ) find-module ?dup if show-one-module then ;
249
250\ Words to be used inside configuration files
251
252: retry false ;         \ For use in load error commands
253: ignore true ;         \ For use in load error commands
254
255\ Return to strict forth vocabulary
256
257: #type
258  over - >r
259  type
260  r> spaces
261;
262
263: .? 2 spaces 2swap 15 #type 2 spaces type cr ;
264
265\ Execute the ? command to print all the commands defined in
266\ C, then list the ones we support here. Please note that this
267\ doesn't use pager_* routines that the C implementation of ?
268\ does, so these will always appear, even if you stop early
269\ there. And they may cause the commands to scroll off the
270\ screen if the number of commands modulus LINES is close
271\ to LINEs....
272: ?
273  ['] ? execute
274  s" boot-conf" s" load kernel and modules, then autoboot" .?
275  s" read-conf" s" read a configuration file" .?
276  s" enable-module" s" enable loading of a module" .?
277  s" disable-module" s" disable loading of a module" .?
278  s" toggle-module" s" toggle loading of a module" .?
279  s" show-module" s" show module load data" .?
280  s" try-include" s" try to load/interpret files" .?
281;
282
283: try-include ( -- ) \ see loader.4th(8)
284  ['] include ( -- xt ) \ get the execution token of `include'
285  catch ( xt -- exception# | 0 ) if \ failed
286    LF parse ( c -- s-addr/u ) 2drop \ advance >in to EOL (drop data)
287    \ ... prevents words unused by `include' from being interpreted
288  then
289; immediate \ interpret immediately for access to `source' (aka tib)
290
291only forth definitions
292