loader.4th revision 299706 
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 299706 2016-05-14 00:44:23Z pfg $
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 successfully
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 successfully loaded!
148  any_conf_read? if
149    s" loader_delay" getenv -1 = if
150      load_xen_throw
151      load_kernel
152      load_modules
153    else
154      drop
155      ." Loading Kernel and Modules (Ctrl-C to Abort)" cr
156      s" also support-functions" evaluate
157      s" set delay_command='load_xen_throw load_kernel load_modules'" evaluate
158      s" set delay_showdots" evaluate
159      delay_execute
160    then
161  then
162;
163
164\ ***** initialize
165\
166\	Overrides support.4th initialization word with one that does
167\	everything start one does, short of loading the kernel and
168\	modules. Returns a flag
169
170: initialize ( -- flag )
171  s" /boot/defaults/loader.conf" initialize
172  include_conf_files
173  include_nextboot_file
174  any_conf_read?
175;
176
177\ ***** read-conf
178\
179\	Read a configuration file, whose name was specified on the command
180\	line, if interpreted, or given on the stack, if compiled in.
181
182: (read-conf)  ( addr len -- )
183  conf_files string=
184  include_conf_files \ Will recurse on new loader_conf_files definitions
185;
186
187: read-conf  ( <filename> | addr len -- ) ( throws: abort & user-defined )
188  state @ if
189    \ Compiling
190    postpone (read-conf)
191  else
192    \ Interpreting
193    bl parse (read-conf)
194  then
195; immediate
196
197\ show, enable, disable, toggle module loading. They all take module from
198\ the next word
199
200: set-module-flag ( module_addr val -- ) \ set and print flag
201  over module.flag !
202  dup module.name strtype
203  module.flag @ if ."  will be loaded" else ."  will not be loaded" then cr
204;
205
206: enable-module find-module ?dup if true set-module-flag then ;
207
208: disable-module find-module ?dup if false set-module-flag then ;
209
210: toggle-module find-module ?dup if dup module.flag @ 0= set-module-flag then ;
211
212\ ***** show-module
213\
214\	Show loading information about a module.
215
216: show-module ( <module> -- ) find-module ?dup if show-one-module then ;
217
218\ Words to be used inside configuration files
219
220: retry false ;         \ For use in load error commands
221: ignore true ;         \ For use in load error commands
222
223\ Return to strict forth vocabulary
224
225: #type
226  over - >r
227  type
228  r> spaces
229;
230
231: .? 2 spaces 2swap 15 #type 2 spaces type cr ;
232
233: ?
234  ['] ? execute
235  s" boot-conf" s" load kernel and modules, then autoboot" .?
236  s" read-conf" s" read a configuration file" .?
237  s" enable-module" s" enable loading of a module" .?
238  s" disable-module" s" disable loading of a module" .?
239  s" toggle-module" s" toggle loading of a module" .?
240  s" show-module" s" show module load data" .?
241  s" try-include" s" try to load/interpret files" .?
242;
243
244: try-include ( -- ) \ see loader.4th(8)
245  ['] include ( -- xt ) \ get the execution token of `include'
246  catch ( xt -- exception# | 0 ) if \ failed
247    LF parse ( c -- s-addr/u ) 2drop \ advance >in to EOL (drop data)
248    \ ... prevents words unused by `include' from being interpreted
249  then
250; immediate \ interpret immediately for access to `source' (aka tib)
251
252only forth definitions
253