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