initial commit
[freebsd-arm:freebsd-arm.git] / boot / forth / loader.4th
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$
26
27 s" 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
39 256 dictthreshold !  \ 256 cells minimum free space
40 2048 dictincrease !  \ 2048 additional cells each time
41
42 include /boot/support.4th
43
44 \ ***** boot-conf
45 \
46 \       Prepares to boot as specified by loaded configuration files.
47
48 only forth also support-functions also builtins definitions
49
50 : boot
51   0= if ( interpreted ) get_arguments then
52
53   \ Unload only if a path was passed
54   dup if
55     >r over r> swap
56     c@ [char] - <> if
57       0 1 unload drop
58     else
59       s" kernelname" getenv? if ( a kernel has been loaded )
60         1 boot exit
61       then
62       load_kernel_and_modules
63       ?dup if exit then
64       0 1 boot exit
65     then
66   else
67     s" kernelname" getenv? if ( a kernel has been loaded )
68       1 boot exit
69     then
70     load_kernel_and_modules
71     ?dup if exit then
72     0 1 boot exit
73   then
74   load_kernel_and_modules
75   ?dup 0= if 0 1 boot then
76 ;
77
78 : boot-conf
79   0= if ( interpreted ) get_arguments then
80   0 1 unload drop
81   load_kernel_and_modules
82   ?dup 0= if 0 1 autoboot then
83 ;
84
85 also forth definitions also builtins
86
87 builtin: boot
88 builtin: boot-conf
89
90 only forth definitions also support-functions
91
92 \ ***** check-password
93 \
94 \       If a password was defined, execute autoboot and ask for
95 \       password if autoboot returns.
96 \       Do not exit unless the right password is given.
97
98 : check-password
99   password .addr @ if
100     0 autoboot
101     false >r
102     begin
103       bell emit bell emit
104       ." Password: "
105       password .len @ read-password
106       dup password .len @ = if
107         2dup password .addr @ password .len @
108         compare 0= if r> drop true >r then
109       then
110       drop free drop
111       r@
112     until
113     r> drop
114   then
115 ;
116
117 \ ***** start
118 \
119 \       Initializes support.4th global variables, sets loader_conf_files,
120 \       process conf files, and, if any one such file was succesfully
121 \       read to the end, load kernel and modules.
122
123 : start  ( -- ) ( throws: abort & user-defined )
124   s" /boot/defaults/loader.conf" initialize
125   include_conf_files
126   include_nextboot_file
127   \ Will *NOT* try to load kernel and modules if no configuration file
128   \ was succesfully loaded!
129   any_conf_read? if
130     load_kernel
131     load_modules
132   then
133 ;
134
135 \ ***** initialize
136 \
137 \       Overrides support.4th initialization word with one that does
138 \       everything start one does, short of loading the kernel and
139 \       modules. Returns a flag
140
141 : initialize ( -- flag )
142   s" /boot/defaults/loader.conf" initialize
143   include_conf_files
144   include_nextboot_file
145   any_conf_read?
146 ;
147
148 \ ***** read-conf
149 \
150 \       Read a configuration file, whose name was specified on the command
151 \       line, if interpreted, or given on the stack, if compiled in.
152
153 : (read-conf)  ( addr len -- )
154   conf_files string=
155   include_conf_files \ Will recurse on new loader_conf_files definitions
156 ;
157
158 : read-conf  ( <filename> | addr len -- ) ( throws: abort & user-defined )
159   state @ if
160     \ Compiling
161     postpone (read-conf)
162   else
163     \ Interpreting
164     bl parse (read-conf)
165   then
166 ; immediate
167
168 \ show, enable, disable, toggle module loading. They all take module from
169 \ the next word
170
171 : set-module-flag ( module_addr val -- ) \ set and print flag
172   over module.flag !
173   dup module.name strtype
174   module.flag @ if ."  will be loaded" else ."  will not be loaded" then cr
175 ;
176
177 : enable-module find-module ?dup if true set-module-flag then ;
178
179 : disable-module find-module ?dup if false set-module-flag then ;
180
181 : toggle-module find-module ?dup if dup module.flag @ 0= set-module-flag then ;
182
183 \ ***** show-module
184 \
185 \       Show loading information about a module.
186
187 : show-module ( <module> -- ) find-module ?dup if show-one-module then ;
188
189 \ Words to be used inside configuration files
190
191 : retry false ;         \ For use in load error commands
192 : ignore true ;         \ For use in load error commands
193
194 \ Return to strict forth vocabulary
195
196 : #type
197   over - >r
198   type
199   r> spaces
200 ;
201
202 : .? 2 spaces 2swap 15 #type 2 spaces type cr ;
203
204 : ?
205   ['] ? execute
206   s" boot-conf" s" load kernel and modules, then autoboot" .?
207   s" read-conf" s" read a configuration file" .?
208   s" enable-module" s" enable loading of a module" .?
209   s" disable-module" s" disable loading of a module" .?
210   s" toggle-module" s" toggle loading of a module" .?
211   s" show-module" s" show module load data" .?
212 ;
213
214 only forth also
215