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