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