loader.4th revision 229881 
1\ Copyright (c) 1999 Daniel C. Sobral <dcs@freebsd.org>
2\ All rights reserved.
3\
4\ Redistribution and use in source and binary forms, with or without
5\ modification, are permitted provided that the following conditions
6\ are met:
7\ 1. Redistributions of source code must retain the above copyright
8\    notice, this list of conditions and the following disclaimer.
9\ 2. Redistributions in binary form must reproduce the above copyright
10\    notice, this list of conditions and the following disclaimer in the
11\    documentation and/or other materials provided with the distribution.
12\
13\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
14\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
15\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
16\ ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
17\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
18\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
19\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
20\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
21\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
22\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
23\ SUCH DAMAGE.
24\
25\ $FreeBSD: head/sys/boot/forth/loader.4th 229881 2012-01-09 20:25:14Z pluknet $
26
27s" arch-i386" environment? [if] [if]
28	s" loader_version" environment?  [if]
29		11 < [if]
30			.( Loader version 1.1+ required) cr
31			abort
32		[then]
33	[else]
34		.( Could not get loader version!) cr
35		abort
36	[then]
37[then] [then]
38
39256 dictthreshold !  \ 256 cells minimum free space
402048 dictincrease !  \ 2048 additional cells each time
41
42include /boot/support.4th
43
44only forth also support-functions also builtins definitions
45
46: try-menu-unset
47  \ menu-unset may not be present
48  s" beastie_disable" getenv
49  dup -1 <> if
50    s" YES" compare-insensitive 0= if
51      exit
52    then
53  else
54    drop
55  then
56  s" menu-unset"
57  sfind if
58    execute
59  else
60    drop
61  then
62;
63
64: boot
65  0= if ( interpreted ) get_arguments then
66
67  \ Unload only if a path was passed
68  dup if
69    >r over r> swap
70    c@ [char] - <> if
71      0 1 unload drop
72    else
73      s" kernelname" getenv? if ( a kernel has been loaded )
74        try-menu-unset
75        1 boot exit
76      then
77      load_kernel_and_modules
78      ?dup if exit then
79      try-menu-unset
80      0 1 boot exit
81    then
82  else
83    s" kernelname" getenv? if ( a kernel has been loaded )
84      try-menu-unset
85      1 boot exit
86    then
87    load_kernel_and_modules
88    ?dup if exit then
89    try-menu-unset
90    0 1 boot exit
91  then
92  load_kernel_and_modules
93  ?dup 0= if 0 1 boot then
94;
95
96\ ***** boot-conf
97\
98\	Prepares to boot as specified by loaded configuration files.
99
100: boot-conf
101  0= if ( interpreted ) get_arguments then
102  0 1 unload drop
103  load_kernel_and_modules
104  ?dup 0= if 0 1 autoboot then
105;
106
107also forth definitions also builtins
108
109builtin: boot
110builtin: boot-conf
111
112only forth definitions also support-functions
113
114include /boot/check-password.4th
115
116\ ***** start
117\
118\       Initializes support.4th global variables, sets loader_conf_files,
119\       process conf files, and, if any one such file was succesfully
120\       read to the end, load kernel and modules.
121
122: start  ( -- ) ( throws: abort & user-defined )
123  s" /boot/defaults/loader.conf" initialize
124  include_conf_files
125  include_nextboot_file
126  \ Will *NOT* try to load kernel and modules if no configuration file
127  \ was succesfully loaded!
128  any_conf_read? if
129    load_kernel
130    load_modules
131  then
132;
133
134\ ***** initialize
135\
136\	Overrides support.4th initialization word with one that does
137\	everything start one does, short of loading the kernel and
138\	modules. Returns a flag
139
140: initialize ( -- flag )
141  s" /boot/defaults/loader.conf" initialize
142  include_conf_files
143  include_nextboot_file
144  any_conf_read?
145;
146
147\ ***** read-conf
148\
149\	Read a configuration file, whose name was specified on the command
150\	line, if interpreted, or given on the stack, if compiled in.
151
152: (read-conf)  ( addr len -- )
153  conf_files string=
154  include_conf_files \ Will recurse on new loader_conf_files definitions
155;
156
157: read-conf  ( <filename> | addr len -- ) ( throws: abort & user-defined )
158  state @ if
159    \ Compiling
160    postpone (read-conf)
161  else
162    \ Interpreting
163    bl parse (read-conf)
164  then
165; immediate
166
167\ show, enable, disable, toggle module loading. They all take module from
168\ the next word
169
170: set-module-flag ( module_addr val -- ) \ set and print flag
171  over module.flag !
172  dup module.name strtype
173  module.flag @ if ."  will be loaded" else ."  will not be loaded" then cr
174;
175
176: enable-module find-module ?dup if true set-module-flag then ;
177
178: disable-module find-module ?dup if false set-module-flag then ;
179
180: toggle-module find-module ?dup if dup module.flag @ 0= set-module-flag then ;
181
182\ ***** show-module
183\
184\	Show loading information about a module.
185
186: show-module ( <module> -- ) find-module ?dup if show-one-module then ;
187
188\ Words to be used inside configuration files
189
190: retry false ;         \ For use in load error commands
191: ignore true ;         \ For use in load error commands
192
193\ Return to strict forth vocabulary
194
195: #type
196  over - >r
197  type
198  r> spaces
199;
200
201: .? 2 spaces 2swap 15 #type 2 spaces type cr ;
202
203: ?
204  ['] ? execute
205  s" boot-conf" s" load kernel and modules, then autoboot" .?
206  s" read-conf" s" read a configuration file" .?
207  s" enable-module" s" enable loading of a module" .?
208  s" disable-module" s" disable loading of a module" .?
209  s" toggle-module" s" toggle loading of a module" .?
210  s" show-module" s" show module load data" .?
211;
212
213only forth also
214
215