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