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