loader.4th revision 280925 
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 280925 2015-03-31 23:00:48Z 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
46include /boot/check-password.4th
47
48only forth also support-functions also builtins definitions
49
50: bootmsg ( -- )
51  loader_color? dup ( -- bool bool )
52  if 7 fg 4 bg then
53  ." Booting..."
54  if me then
55  cr
56;
57
58: try-menu-unset
59  \ menu-unset may not be present
60  s" beastie_disable" getenv
61  dup -1 <> if
62    s" YES" compare-insensitive 0= if
63      exit
64    then
65  else
66    drop
67  then
68  s" menu-unset"
69  sfind if
70    execute
71  else
72    drop
73  then
74  s" menusets-unset"
75  sfind if
76    execute
77  else
78    drop
79  then
80;
81
82: boot
83  0= if ( interpreted ) get_arguments then
84
85  \ Unload only if a path was passed
86  dup if
87    >r over r> swap
88    c@ [char] - <> if
89      0 1 unload drop
90    else
91      s" kernelname" getenv? if ( a kernel has been loaded )
92        try-menu-unset
93        bootmsg 1 boot exit
94      then
95      load_kernel_and_modules
96      ?dup if exit then
97      try-menu-unset
98      bootmsg 0 1 boot exit
99    then
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  load_kernel_and_modules
111  ?dup 0= if bootmsg 0 1 boot then
112;
113
114\ ***** boot-conf
115\
116\	Prepares to boot as specified by loaded configuration files.
117
118: boot-conf
119  0= if ( interpreted ) get_arguments then
120  0 1 unload drop
121  load_kernel_and_modules
122  ?dup 0= if 0 1 autoboot then
123;
124
125also forth definitions also builtins
126
127builtin: boot
128builtin: boot-conf
129
130only forth definitions also support-functions
131
132\ ***** start
133\
134\       Initializes support.4th global variables, sets loader_conf_files,
135\       processes conf files, and, if any one such file was succesfully
136\       read to the end, loads kernel and modules.
137
138: start  ( -- ) ( throws: abort & user-defined )
139  s" /boot/defaults/loader.conf" initialize
140  include_conf_files
141  include_nextboot_file
142  \ Will *NOT* try to load kernel and modules if no configuration file
143  \ was succesfully loaded!
144  any_conf_read? if
145    s" loader_delay" getenv -1 = if
146      load_xen_throw
147      load_kernel
148      load_modules
149    else
150      drop
151      ." Loading Kernel and Modules (Ctrl-C to Abort)" cr
152      s" also support-functions" evaluate
153      s" set delay_command='load_xen_throw load_kernel load_modules'" evaluate
154      s" set delay_showdots" evaluate
155      delay_execute
156    then
157  then
158;
159
160\ ***** initialize
161\
162\	Overrides support.4th initialization word with one that does
163\	everything start one does, short of loading the kernel and
164\	modules. Returns a flag
165
166: initialize ( -- flag )
167  s" /boot/defaults/loader.conf" initialize
168  include_conf_files
169  include_nextboot_file
170  any_conf_read?
171;
172
173\ ***** read-conf
174\
175\	Read a configuration file, whose name was specified on the command
176\	line, if interpreted, or given on the stack, if compiled in.
177
178: (read-conf)  ( addr len -- )
179  conf_files string=
180  include_conf_files \ Will recurse on new loader_conf_files definitions
181;
182
183: read-conf  ( <filename> | addr len -- ) ( throws: abort & user-defined )
184  state @ if
185    \ Compiling
186    postpone (read-conf)
187  else
188    \ Interpreting
189    bl parse (read-conf)
190  then
191; immediate
192
193\ show, enable, disable, toggle module loading. They all take module from
194\ the next word
195
196: set-module-flag ( module_addr val -- ) \ set and print flag
197  over module.flag !
198  dup module.name strtype
199  module.flag @ if ."  will be loaded" else ."  will not be loaded" then cr
200;
201
202: enable-module find-module ?dup if true set-module-flag then ;
203
204: disable-module find-module ?dup if false set-module-flag then ;
205
206: toggle-module find-module ?dup if dup module.flag @ 0= set-module-flag then ;
207
208\ ***** show-module
209\
210\	Show loading information about a module.
211
212: show-module ( <module> -- ) find-module ?dup if show-one-module then ;
213
214\ Words to be used inside configuration files
215
216: retry false ;         \ For use in load error commands
217: ignore true ;         \ For use in load error commands
218
219\ Return to strict forth vocabulary
220
221: #type
222  over - >r
223  type
224  r> spaces
225;
226
227: .? 2 spaces 2swap 15 #type 2 spaces type cr ;
228
229: ?
230  ['] ? execute
231  s" boot-conf" s" load kernel and modules, then autoboot" .?
232  s" read-conf" s" read a configuration file" .?
233  s" enable-module" s" enable loading of a module" .?
234  s" disable-module" s" disable loading of a module" .?
235  s" toggle-module" s" toggle loading of a module" .?
236  s" show-module" s" show module load data" .?
237  s" try-include" s" try to load/interpret files" .?
238;
239
240: try-include ( -- ) \ see loader.4th(8)
241  ['] include ( -- xt ) \ get the execution token of `include'
242  catch ( xt -- exception# | 0 ) if \ failed
243    LF parse ( c -- s-addr/u ) 2drop \ advance >in to EOL (drop data)
244    \ ... prevents words unused by `include' from being interpreted
245  then
246; immediate \ interpret immediately for access to `source' (aka tib)
247
248only forth also
249
250