Print this page
NEX-16819 loader UEFI support
Includes work by Toomas Soome <tsoome@me.com>
Upstream commits:
loader: pxe receive cleanup
9475 libefi: Do not return only if ReceiveFilter
installboot: should support efi system partition
8931 boot1.efi: scan all display modes rather than
loader: spinconsole updates
loader: gfx experiment to try GOP Blt() function.
sha1 build test
loader: add sha1 hash calculation
common/sha1: update for loader build
loader: biosdisk rework
uts: 32-bit kernel FB needs mapping in low memory
uts: add diag-device
uts: boot console mirror with diag-device
uts: enable very early console on ttya
kmdb: add diag-device as input/output device
uts: test VGA memory exclusion from mapping
uts: clear boot mapping and protect boot pages test
uts: add dboot map debug printf
uts: need to release FB pages in release_bootstrap()
uts: add screenmap ioctl
uts: update sys/queue.h
loader: add illumos uts/common to include path
loader: tem/gfx font cleanup
loader: vbe checks
uts: gfx_private set KD_TEXT when KD_RESETTEXT is
uts: gfx 8-bit update
loader: gfx 8-bit fix
loader: always set media size from partition.
uts: MB2 support for 32-bit kernel
loader: x86 should have tem 80x25
uts: x86 should have tem 80x25
uts: font update
loader: font update
uts: tem attributes
loader: tem.c comment added
uts: use font module
loader: add font module
loader: build rules for new font setup
uts: gfx_private update for new font structure
uts: early boot update for new font structure
uts: font update
uts: font build rules update for new fonts
uts: tem update to new font structure
loader: module.c needs to include tem_impl.h
uts: gfx_private 8x16 font rework
uts: make font_lookup public
loader: font rework
uts: font rework
9259 libefi: efi_alloc_and_read should check for PMBR
uts: tem utf-8 support
loader: implement tem utf-8 support
loader: tem should be able to display UTF-8
7784 uts: console input should support utf-8
7796 uts: ldterm default to utf-8
uts: do not reset serial console
uts: set up colors even if tem is not console
uts: add type for early boot properties
uts: gfx_private experiment with drm and vga
uts: gfx_private should use setmode drm callback.
uts: identify FB types and set up gfx_private based
loader: replace gop and vesa with framebuffer
uts: boot needs simple tem to support mdb
uts: boot_keyboard should emit esc sequences for
uts: gfx_private FB showuld be written by line
kmdb: set terminal window size
uts: gfx_private needs to keep track of early boot FB
pnglite: move pnglite to usr/src/common
loader: gfx_fb
ficl-sys: add gfx primitives
loader: add illumos.png logo
ficl: add fb-putimage
loader: add png support
loader: add alpha blending for gfx_fb
loader: use term-drawrect for menu frame
ficl: add simple gfx words
uts: provide fb_info via fbgattr dev_specific array.
uts: gfx_private add alpha blending
uts: update sys/ascii.h
uts: tem OSC support (incomplete)
uts: implement env module support and use data from
uts: tem get colors from early boot data
loader: use crc32 from libstand (libz)
loader: optimize for size
loader: pass tem info to the environment
loader: import tem for loader console
loader: UEFI loader needs to set ISADIR based on
loader: need UEFI32 support
8918 loader.efi: add vesa edid support
uts: tem_safe_pix_clear_prom_output() should only
uts: tem_safe_pix_clear_entire_screen() should use
uts: tem_safe_check_first_time() should query cursor
uts: tem implement cls callback & visual_io v4
uts: gfx_vgatext use block cursor for vgatext
uts: gfx_private implement cls callback & visual_io
uts: gfx_private bitmap framebuffer implementation
uts: early start frame buffer console support
uts: font functions should check the input char
uts: font rendering should support 16/24/32bit depths
uts: use smallest font as fallback default.
uts: update terminal dimensions based on selected
7834 uts: vgatext should use gfx_private
uts: add spacing property to 8859-1.bdf
terminfo: add underline for sun-color
terminfo: sun-color has 16 colors
uts: add font load callback type
loader: do not repeat int13 calls with error 0x20 and
8905 loader: add skein/edonr support
8904 common/crypto: make skein and edonr loader
Reviewed by: Yuri Pankov <yuri.pankov@nexenta.com>
Reviewed by: Sanjay Nadkarni <sanjay.nadkarni@nexenta.com>
Reviewed by: Evan Layton <evan.layton@nexenta.com>
Revert "NEX-16819 loader UEFI support"
This reverts commit ec06b9fc617b99234e538bf2e7e4d02a24993e0c.
Reverting due to failures in the zfs-tests and the sharefs-tests
NEX-16819 loader UEFI support
Includes work by Toomas Soome <tsoome@me.com>
Upstream commits:
loader: pxe receive cleanup
9475 libefi: Do not return only if ReceiveFilter
installboot: should support efi system partition
8931 boot1.efi: scan all display modes rather than
loader: spinconsole updates
loader: gfx experiment to try GOP Blt() function.
sha1 build test
loader: add sha1 hash calculation
common/sha1: update for loader build
loader: biosdisk rework
uts: 32-bit kernel FB needs mapping in low memory
uts: add diag-device
uts: boot console mirror with diag-device
uts: enable very early console on ttya
kmdb: add diag-device as input/output device
uts: test VGA memory exclusion from mapping
uts: clear boot mapping and protect boot pages test
uts: add dboot map debug printf
uts: need to release FB pages in release_bootstrap()
uts: add screenmap ioctl
uts: update sys/queue.h
loader: add illumos uts/common to include path
loader: tem/gfx font cleanup
loader: vbe checks
uts: gfx_private set KD_TEXT when KD_RESETTEXT is
uts: gfx 8-bit update
loader: gfx 8-bit fix
loader: always set media size from partition.
uts: MB2 support for 32-bit kernel
loader: x86 should have tem 80x25
uts: x86 should have tem 80x25
uts: font update
loader: font update
uts: tem attributes
loader: tem.c comment added
uts: use font module
loader: add font module
loader: build rules for new font setup
uts: gfx_private update for new font structure
uts: early boot update for new font structure
uts: font update
uts: font build rules update for new fonts
uts: tem update to new font structure
loader: module.c needs to include tem_impl.h
uts: gfx_private 8x16 font rework
uts: make font_lookup public
loader: font rework
uts: font rework
libefi: efi_alloc_and_read should check for PMBR
uts: tem utf-8 support
loader: implement tem utf-8 support
loader: tem should be able to display UTF-8
7784 uts: console input should support utf-8
7796 uts: ldterm default to utf-8
uts: do not reset serial console
uts: set up colors even if tem is not console
uts: add type for early boot properties
uts: gfx_private experiment with drm and vga
uts: gfx_private should use setmode drm callback.
uts: identify FB types and set up gfx_private based
loader: replace gop and vesa with framebuffer
uts: boot needs simple tem to support mdb
uts: boot_keyboard should emit esc sequences for
uts: gfx_private FB showuld be written by line
kmdb: set terminal window size
uts: gfx_private needs to keep track of early boot FB
pnglite: move pnglite to usr/src/common
loader: gfx_fb
ficl-sys: add gfx primitives
loader: add illumos.png logo
ficl: add fb-putimage
loader: add png support
loader: add alpha blending for gfx_fb
loader: use term-drawrect for menu frame
ficl: add simple gfx words
uts: provide fb_info via fbgattr dev_specific array.
uts: gfx_private add alpha blending
uts: update sys/ascii.h
uts: tem OSC support (incomplete)
uts: implement env module support and use data from
uts: tem get colors from early boot data
loader: use crc32 from libstand (libz)
loader: optimize for size
loader: pass tem info to the environment
loader: import tem for loader console
loader: UEFI loader needs to set ISADIR based on
loader: need UEFI32 support
8918 loader.efi: add vesa edid support
uts: tem_safe_pix_clear_prom_output() should only
uts: tem_safe_pix_clear_entire_screen() should use
uts: tem_safe_check_first_time() should query cursor
uts: tem implement cls callback & visual_io v4
uts: gfx_vgatext use block cursor for vgatext
uts: gfx_private implement cls callback & visual_io
uts: gfx_private bitmap framebuffer implementation
uts: early start frame buffer console support
uts: font functions should check the input char
uts: font rendering should support 16/24/32bit depths
uts: use smallest font as fallback default.
uts: update terminal dimensions based on selected
7834 uts: vgatext should use gfx_private
uts: add spacing property to 8859-1.bdf
terminfo: add underline for sun-color
terminfo: sun-color has 16 colors
uts: add font load callback type
loader: do not repeat int13 calls with error 0x20 and
8905 loader: add skein/edonr support
8904 common/crypto: make skein and edonr loader
Reviewed by: Yuri Pankov <yuri.pankov@nexenta.com>
Reviewed by: Sanjay Nadkarni <sanjay.nadkarni@nexenta.com>
Reviewed by: Evan Layton <evan.layton@nexenta.com>
| Split |
Close |
| Expand all |
| Collapse all |
--- old/usr/src/boot/sys/boot/forth/support.4th
+++ new/usr/src/boot/sys/boot/forth/support.4th
1 1 \ Copyright (c) 1999 Daniel C. Sobral <dcs@FreeBSD.org>
2 2 \ All rights reserved.
3 3 \
4 4 \ Redistribution and use in source and binary forms, with or without
5 5 \ modification, are permitted provided that the following conditions
6 6 \ are met:
7 7 \ 1. Redistributions of source code must retain the above copyright
8 8 \ notice, this list of conditions and the following disclaimer.
9 9 \ 2. Redistributions in binary form must reproduce the above copyright
10 10 \ notice, this list of conditions and the following disclaimer in the
11 11 \ documentation and/or other materials provided with the distribution.
12 12 \
13 13 \ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
14 14 \ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
15 15 \ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
16 16 \ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
17 17 \ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
18 18 \ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
19 19 \ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
20 20 \ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
21 21 \ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
22 22 \ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
23 23 \ SUCH DAMAGE.
24 24
25 25 \ Loader.rc support functions:
26 26 \
27 27 \ initialize ( addr len -- ) as above, plus load_conf_files
28 28 \ load_conf ( addr len -- ) load conf file given
29 29 \ include_bootenv ( -- ) load bootenv.rc
30 30 \ include_conf_files ( -- ) load all conf files in load_conf_files
31 31 \ print_syntax_error ( -- ) print line and marker of where a syntax
32 32 \ error was detected
33 33 \ print_line ( -- ) print last line processed
34 34 \ load_kernel ( -- ) load kernel
35 35 \ load_modules ( -- ) load modules flagged
36 36 \
37 37 \ Exported structures:
38 38 \
39 39 \ string counted string structure
40 40 \ cell .addr string address
41 41 \ cell .len string length
42 42 \ module module loading information structure
43 43 \ cell module.flag should we load it?
44 44 \ string module.name module's name
45 45 \ string module.loadname name to be used in loading the module
46 46 \ string module.type module's type (file | hash | rootfs)
47 47 \ string module.hash module's sha1 hash
48 48 \ string module.args flags to be passed during load
49 49 \ string module.largs internal argument list
50 50 \ string module.beforeload command to be executed before load
51 51 \ string module.afterload command to be executed after load
52 52 \ string module.loaderror command to be executed if load fails
53 53 \ cell module.next list chain
54 54 \
55 55 \ Exported global variables;
56 56 \
57 57 \ string conf_files configuration files to be loaded
58 58 \ cell modules_options pointer to first module information
59 59 \ value verbose? indicates if user wants a verbose loading
60 60 \ value any_conf_read? indicates if a conf file was successfully read
61 61 \
62 62 \ Other exported words:
63 63 \ note, strlen is internal
64 64 \ strdup ( addr len -- addr' len) similar to strdup(3)
65 65 \ strcat ( addr len addr' len' -- addr len+len' ) similar to strcat(3)
66 66 \ s' ( | string' -- addr len | ) similar to s"
67 67 \ rudimentary structure support
68 68
69 69 \ Exception values
70 70
71 71 1 constant ESYNTAX
72 72 2 constant ENOMEM
73 73 3 constant EFREE
74 74 4 constant ESETERROR \ error setting environment variable
75 75 5 constant EREAD \ error reading
76 76 6 constant EOPEN
77 77 7 constant EEXEC \ XXX never catched
78 78 8 constant EBEFORELOAD
79 79 9 constant EAFTERLOAD
80 80
81 81 \ I/O constants
82 82
83 83 0 constant SEEK_SET
84 84 1 constant SEEK_CUR
85 85 2 constant SEEK_END
86 86
87 87 0 constant O_RDONLY
88 88 1 constant O_WRONLY
89 89 2 constant O_RDWR
90 90
91 91 \ Crude structure support
92 92
93 93 : structure:
94 94 create here 0 , ['] drop , 0
95 95 does> create here swap dup @ allot cell+ @ execute
96 96 ;
97 97 : member: create dup , over , + does> cell+ @ + ;
98 98 : ;structure swap ! ;
99 99 : constructor! >body cell+ ! ;
100 100 : constructor: over :noname ;
101 101 : ;constructor postpone ; swap cell+ ! ; immediate
102 102 : sizeof ' >body @ state @ if postpone literal then ; immediate
103 103 : offsetof ' >body cell+ @ state @ if postpone literal then ; immediate
104 104 : ptr 1 cells member: ;
105 105 : int 1 cells member: ;
106 106
107 107 \ String structure
108 108
109 109 structure: string
110 110 ptr .addr
111 111 int .len
112 112 constructor:
113 113 0 over .addr !
114 114 0 swap .len !
115 115 ;constructor
116 116 ;structure
117 117
118 118
119 119 \ Module options linked list
120 120
121 121 structure: module
122 122 int module.flag
123 123 sizeof string member: module.name
124 124 sizeof string member: module.loadname
125 125 sizeof string member: module.type
126 126 sizeof string member: module.hash
127 127 sizeof string member: module.args
128 128 sizeof string member: module.largs
129 129 sizeof string member: module.beforeload
130 130 sizeof string member: module.afterload
131 131 sizeof string member: module.loaderror
132 132 ptr module.next
133 133 ;structure
134 134
135 135 \ Internal loader structures (preloaded_file, kernel_module, file_metadata)
136 136 \ must be in sync with the C struct in sys/boot/common/bootstrap.h
137 137 structure: preloaded_file
138 138 ptr pf.name
139 139 ptr pf.type
140 140 ptr pf.args
141 141 ptr pf.metadata \ file_metadata
142 142 int pf.loader
143 143 int pf.addr
144 144 int pf.size
145 145 ptr pf.modules \ kernel_module
146 146 ptr pf.next \ preloaded_file
147 147 ;structure
148 148
149 149 structure: kernel_module
150 150 ptr km.name
151 151 ptr km.args
152 152 ptr km.fp \ preloaded_file
153 153 ptr km.next \ kernel_module
154 154 ;structure
155 155
156 156 structure: file_metadata
157 157 int md.size
158 158 2 member: md.type \ this is not ANS Forth compatible (XXX)
159 159 ptr md.next \ file_metadata
160 160 0 member: md.data \ variable size
161 161 ;structure
162 162
163 163 \ end of structures
164 164
165 165 \ Global variables
166 166
167 167 string conf_files
168 168 create module_options sizeof module.next allot 0 module_options !
169 169 create last_module_option sizeof module.next allot 0 last_module_option !
170 170 0 value verbose?
171 171
172 172 \ Support string functions
173 173 : strdup { addr len -- addr' len' }
174 174 len allocate if ENOMEM throw then
175 175 addr over len move len
176 176 ;
177 177
178 178 : strcat { addr len addr' len' -- addr len+len' }
179 179 addr' addr len + len' move
180 180 addr len len' +
181 181 ;
182 182
183 183 : strchr { addr len c -- addr' len' }
184 184 begin
185 185 len
186 186 while
187 187 addr c@ c = if addr len exit then
188 188 addr 1 + to addr
189 189 len 1 - to len
190 190 repeat
191 191 0 0
192 192 ;
193 193
194 194 : s' \ same as s", allows " in the string
195 195 [char] ' parse
196 196 state @ if postpone sliteral then
197 197 ; immediate
198 198
199 199 : 2>r postpone >r postpone >r ; immediate
200 200 : 2r> postpone r> postpone r> ; immediate
201 201 : 2r@ postpone 2r> postpone 2dup postpone 2>r ; immediate
202 202
203 203 : getenv? getenv -1 = if false else drop true then ;
204 204
205 205 \ determine if a word appears in a string, case-insensitive
206 206 : contains? ( addr1 len1 addr2 len2 -- 0 | -1 )
207 207 2 pick 0= if 2drop 2drop true exit then
208 208 dup 0= if 2drop 2drop false exit then
209 209 begin
210 210 begin
211 211 swap dup c@ dup 32 = over 9 = or over 10 = or
212 212 over 13 = or over 44 = or swap drop
213 213 while 1+ swap 1- repeat
214 214 swap 2 pick 1- over <
215 215 while
216 216 2over 2over drop over compare-insensitive 0= if
217 217 2 pick over = if 2drop 2drop true exit then
218 218 2 pick tuck - -rot + swap over c@ dup 32 =
219 219 over 9 = or over 10 = or over 13 = or over 44 = or
220 220 swap drop if 2drop 2drop true exit then
221 221 then begin
222 222 swap dup c@ dup 32 = over 9 = or over 10 = or
223 223 over 13 = or over 44 = or swap drop
224 224 if false else true then 2 pick 0> and
225 225 while 1+ swap 1- repeat
226 226 swap
227 227 repeat
228 228 2drop 2drop false
229 229 ;
230 230
231 231 : boot_serial? ( -- 0 | -1 )
232 232 s" console" getenv dup -1 <> if
233 233 2dup
234 234 s" ttya" 2swap contains? ( addr len f )
235 235 -rot 2dup ( f addr len addr len )
236 236 s" ttyb" 2swap contains? ( f addr len f )
237 237 -rot 2dup ( f f addr len addr len )
238 238 s" ttyc" 2swap contains? ( f f addr len f )
239 239 -rot ( f f f addr len )
240 240 s" ttyd" 2swap contains? ( f f addr len f )
241 241 or or or
242 242 else drop false then
243 243 s" boot_serial" getenv dup -1 <> if
244 244 swap drop 0>
245 245 else drop false then
246 246 or \ console contains tty ( or ) boot_serial
247 247 s" boot_multicons" getenv dup -1 <> if
248 248 swap drop 0>
249 249 else drop false then
250 250 or \ previous boolean ( or ) boot_multicons
251 251 ;
252 252
253 253 \ Private definitions
254 254
255 255 vocabulary support-functions
256 256 only forth also support-functions definitions
257 257
258 258 \ Some control characters constants
259 259
260 260 7 constant bell
261 261 8 constant backspace
262 262 9 constant tab
263 263 10 constant lf
264 264 13 constant <cr>
265 265
266 266 \ Read buffer size
267 267
268 268 80 constant read_buffer_size
269 269
270 270 \ Standard suffixes
271 271
272 272 : load_module_suffix s" _load" ;
273 273 : module_loadname_suffix s" _name" ;
274 274 : module_type_suffix s" _type" ;
275 275 : module_hash_suffix s" _hash" ;
276 276 : module_args_suffix s" _flags" ;
277 277 : module_beforeload_suffix s" _before" ;
278 278 : module_afterload_suffix s" _after" ;
279 279 : module_loaderror_suffix s" _error" ;
280 280
281 281 \ Support operators
282 282
283 283 : >= < 0= ;
284 284 : <= > 0= ;
285 285
286 286 \ Assorted support functions
287 287
288 288 : free-memory free if EFREE throw then ;
289 289
290 290 : strget { var -- addr len } var .addr @ var .len @ ;
291 291
292 292 \ assign addr len to variable.
293 293 : strset { addr len var -- } addr var .addr ! len var .len ! ;
294 294
295 295 \ free memory and reset fields
296 296 : strfree { var -- } var .addr @ ?dup if free-memory 0 0 var strset then ;
297 297
298 298 \ free old content, make a copy of the string and assign to variable
299 299 : string= { addr len var -- } var strfree addr len strdup var strset ;
300 300
301 301 : strtype ( str -- ) strget type ;
302 302
303 303 \ assign a reference to what is on the stack
304 304 : strref { addr len var -- addr len }
305 305 addr var .addr ! len var .len ! addr len
306 306 ;
307 307
308 308 \ unquote a string
309 309 : unquote ( addr len -- addr len )
310 310 over c@ [char] " = if 2 chars - swap char+ swap then
311 311 ;
312 312
313 313 \ Assignment data temporary storage
314 314
315 315 string name_buffer
316 316 string value_buffer
317 317
318 318 \ Line by line file reading functions
319 319 \
320 320 \ exported:
321 321 \ line_buffer
322 322 \ end_of_file?
323 323 \ fd
324 324 \ read_line
325 325 \ reset_line_reading
326 326
327 327 vocabulary line-reading
328 328 also line-reading definitions
329 329
330 330 \ File data temporary storage
331 331
332 332 string read_buffer
333 333 0 value read_buffer_ptr
334 334
335 335 \ File's line reading function
336 336
337 337 get-current ( -- wid ) previous definitions
338 338
339 339 string line_buffer
340 340 0 value end_of_file?
341 341 variable fd
342 342
343 343 >search ( wid -- ) definitions
344 344
345 345 : skip_newlines
346 346 begin
347 347 read_buffer .len @ read_buffer_ptr >
348 348 while
349 349 read_buffer .addr @ read_buffer_ptr + c@ lf = if
350 350 read_buffer_ptr char+ to read_buffer_ptr
351 351 else
352 352 exit
353 353 then
354 354 repeat
355 355 ;
356 356
357 357 : scan_buffer ( -- addr len )
358 358 read_buffer_ptr >r
359 359 begin
360 360 read_buffer .len @ r@ >
361 361 while
362 362 read_buffer .addr @ r@ + c@ lf = if
363 363 read_buffer .addr @ read_buffer_ptr + ( -- addr )
364 364 r@ read_buffer_ptr - ( -- len )
365 365 r> to read_buffer_ptr
366 366 exit
367 367 then
368 368 r> char+ >r
369 369 repeat
370 370 read_buffer .addr @ read_buffer_ptr + ( -- addr )
371 371 r@ read_buffer_ptr - ( -- len )
372 372 r> to read_buffer_ptr
373 373 ;
374 374
375 375 : line_buffer_resize ( len -- len )
376 376 >r
377 377 line_buffer .len @ if
378 378 line_buffer .addr @
379 379 line_buffer .len @ r@ +
380 380 resize if ENOMEM throw then
381 381 else
382 382 r@ allocate if ENOMEM throw then
383 383 then
384 384 line_buffer .addr !
385 385 r>
386 386 ;
387 387
388 388 : append_to_line_buffer ( addr len -- )
389 389 line_buffer strget
390 390 2swap strcat
391 391 line_buffer .len !
392 392 drop
393 393 ;
394 394
395 395 : read_from_buffer
396 396 scan_buffer ( -- addr len )
397 397 line_buffer_resize ( len -- len )
398 398 append_to_line_buffer ( addr len -- )
399 399 ;
400 400
401 401 : refill_required?
402 402 read_buffer .len @ read_buffer_ptr =
403 403 end_of_file? 0= and
404 404 ;
405 405
406 406 : refill_buffer
407 407 0 to read_buffer_ptr
408 408 read_buffer .addr @ 0= if
409 409 read_buffer_size allocate if ENOMEM throw then
410 410 read_buffer .addr !
411 411 then
412 412 fd @ read_buffer .addr @ read_buffer_size fread
413 413 dup -1 = if EREAD throw then
414 414 dup 0= if true to end_of_file? then
415 415 read_buffer .len !
416 416 ;
417 417
418 418 get-current ( -- wid ) previous definitions >search ( wid -- )
419 419
420 420 : reset_line_reading
421 421 0 to read_buffer_ptr
422 422 ;
423 423
424 424 : read_line
425 425 line_buffer strfree
426 426 skip_newlines
427 427 begin
428 428 read_from_buffer
429 429 refill_required?
430 430 while
431 431 refill_buffer
432 432 repeat
433 433 ;
434 434
435 435 only forth also support-functions definitions
436 436
437 437 \ Conf file line parser:
438 438 \ <line> ::= <spaces><name><spaces>'='<spaces><value><spaces>[<comment>] |
439 439 \ <spaces>[<comment>]
440 440 \ <name> ::= <letter>{<letter>|<digit>|'_'|'-'}
441 441 \ <vname> ::= <letter>{<letter>|<digit>|'_'|'-'|','}
442 442 \ <value> ::= '"'{<character_set>|'\'<anything>}'"' | <vname>
443 443 \ <character_set> ::= ASCII 32 to 126, except '\' and '"'
444 444 \ <comment> ::= '#'{<anything>}
445 445 \
446 446 \ bootenv line parser:
447 447 \ <line> ::= <spaces>setprop<spaces><name><spaces><value><spaces>[<comment>] |
448 448 \ <spaces>[<comment>]
449 449 \
450 450 \ exported:
451 451 \ line_pointer
452 452 \ process_conf
453 453 \ process_conf
454 454
455 455 0 value line_pointer
456 456
457 457 vocabulary file-processing
458 458 also file-processing definitions
459 459
460 460 \ parser functions
461 461 \
462 462 \ exported:
463 463 \ get_assignment
464 464 \ get_prop
465 465
466 466 vocabulary parser
467 467 also parser definitions
468 468
469 469 0 value parsing_function
470 470 0 value end_of_line
471 471
472 472 : end_of_line? line_pointer end_of_line = ;
473 473
474 474 \ classifiers for various character classes in the input line
475 475
476 476 : letter?
477 477 line_pointer c@ >r
478 478 r@ [char] A >=
479 479 r@ [char] Z <= and
480 480 r@ [char] a >=
481 481 r> [char] z <= and
482 482 or
483 483 ;
484 484
485 485 : digit?
486 486 line_pointer c@ >r
487 487 r@ [char] - =
488 488 r@ [char] 0 >=
489 489 r> [char] 9 <= and
490 490 or
491 491 ;
492 492
493 493 : "quote? line_pointer c@ [char] " = ;
494 494
495 495 : 'quote? line_pointer c@ [char] ' = ;
496 496
497 497 : assignment_sign? line_pointer c@ [char] = = ;
498 498
499 499 : comment? line_pointer c@ [char] # = ;
500 500
501 501 : space? line_pointer c@ bl = line_pointer c@ tab = or ;
502 502
503 503 : backslash? line_pointer c@ [char] \ = ;
504 504
505 505 : underscore? line_pointer c@ [char] _ = ;
506 506
507 507 : dot? line_pointer c@ [char] . = ;
508 508
509 509 : dash? line_pointer c@ [char] - = ;
510 510
511 511 : comma? line_pointer c@ [char] , = ;
512 512
513 513 : at? line_pointer c@ [char] @ = ;
514 514
515 515 : slash? line_pointer c@ [char] / = ;
516 516
517 517 : colon? line_pointer c@ [char] : = ;
518 518
519 519 \ manipulation of input line
520 520 : skip_character line_pointer char+ to line_pointer ;
521 521
522 522 : skip_to_end_of_line end_of_line to line_pointer ;
523 523
524 524 : eat_space
525 525 begin
|
↓ open down ↓ |
525 lines elided |
↑ open up ↑ |
526 526 end_of_line? if 0 else space? then
527 527 while
528 528 skip_character
529 529 repeat
530 530 ;
531 531
532 532 : parse_name ( -- addr len )
533 533 line_pointer
534 534 begin
535 535 end_of_line? if 0 else
536 - letter? digit? underscore? dot? dash?
537 - or or or or
536 + letter? digit? underscore? dot? dash? comma?
537 + or or or or or
538 538 then
539 539 while
540 540 skip_character
541 541 repeat
542 542 line_pointer over -
543 543 strdup
544 544 ;
545 545
546 546 : parse_value ( -- addr len )
547 547 line_pointer
548 548 begin
549 549 end_of_line? if 0 else
550 550 letter? digit? underscore? dot? comma? dash? at? slash? colon?
551 551 or or or or or or or or
552 552 then
553 553 while
554 554 skip_character
555 555 repeat
556 556 line_pointer over -
557 557 strdup
558 558 ;
559 559
560 560 : remove_backslashes { addr len | addr' len' -- addr' len' }
561 561 len allocate if ENOMEM throw then
562 562 to addr'
563 563 addr >r
564 564 begin
565 565 addr c@ [char] \ <> if
566 566 addr c@ addr' len' + c!
567 567 len' char+ to len'
568 568 then
569 569 addr char+ to addr
570 570 r@ len + addr =
571 571 until
572 572 r> drop
573 573 addr' len'
574 574 ;
575 575
576 576 : parse_quote ( xt -- addr len )
577 577 >r ( R: xt )
578 578 line_pointer
579 579 skip_character
580 580 end_of_line? if ESYNTAX throw then
581 581 begin
582 582 r@ execute 0=
583 583 while
584 584 backslash? if
585 585 skip_character
586 586 end_of_line? if ESYNTAX throw then
587 587 then
588 588 skip_character
589 589 end_of_line? if ESYNTAX throw then
590 590 repeat
591 591 r> drop
592 592 skip_character
593 593 line_pointer over -
594 594 remove_backslashes
595 595 ;
596 596
597 597 : read_name
598 598 parse_name ( -- addr len )
599 599 name_buffer strset
600 600 ;
601 601
602 602 : read_value
603 603 "quote? if
604 604 ['] "quote? parse_quote ( -- addr len )
605 605 else
606 606 'quote? if
607 607 ['] 'quote? parse_quote ( -- addr len )
608 608 else
609 609 parse_value ( -- addr len )
610 610 then
611 611 then
612 612 value_buffer strset
613 613 ;
614 614
615 615 : comment
616 616 skip_to_end_of_line
617 617 ;
618 618
619 619 : white_space_4
620 620 eat_space
621 621 comment? if ['] comment to parsing_function exit then
622 622 end_of_line? 0= if ESYNTAX throw then
623 623 ;
624 624
625 625 : variable_value
626 626 read_value
627 627 ['] white_space_4 to parsing_function
628 628 ;
629 629
630 630 : white_space_3
631 631 eat_space
632 632 slash? letter? digit? "quote? 'quote? or or or or if
633 633 ['] variable_value to parsing_function exit
634 634 then
635 635 ESYNTAX throw
636 636 ;
637 637
638 638 : assignment_sign
639 639 skip_character
640 640 ['] white_space_3 to parsing_function
641 641 ;
642 642
643 643 : white_space_2
644 644 eat_space
645 645 assignment_sign? if ['] assignment_sign to parsing_function exit then
646 646 ESYNTAX throw
647 647 ;
648 648
649 649 : variable_name
650 650 read_name
651 651 ['] white_space_2 to parsing_function
652 652 ;
653 653
654 654 : white_space_1
655 655 eat_space
656 656 letter? if ['] variable_name to parsing_function exit then
657 657 comment? if ['] comment to parsing_function exit then
658 658 end_of_line? 0= if ESYNTAX throw then
659 659 ;
660 660
661 661 : prop_name
662 662 eat_space
663 663 read_name
664 664 ['] white_space_3 to parsing_function
665 665 ;
666 666
667 667 : get_prop_cmd
668 668 eat_space
669 669 s" setprop" line_pointer over compare 0=
670 670 if line_pointer 7 + to line_pointer
671 671 ['] prop_name to parsing_function exit
672 672 then
673 673 comment? if ['] comment to parsing_function exit then
674 674 end_of_line? 0= if ESYNTAX throw then
675 675 ;
676 676
677 677 get-current ( -- wid ) previous definitions >search ( wid -- )
678 678
679 679 : get_assignment
680 680 line_buffer strget + to end_of_line
681 681 line_buffer .addr @ to line_pointer
682 682 ['] white_space_1 to parsing_function
683 683 begin
684 684 end_of_line? 0=
685 685 while
686 686 parsing_function execute
687 687 repeat
688 688 parsing_function ['] comment =
689 689 parsing_function ['] white_space_1 =
690 690 parsing_function ['] white_space_4 =
691 691 or or 0= if ESYNTAX throw then
692 692 ;
693 693
694 694 : get_prop
695 695 line_buffer strget + to end_of_line
696 696 line_buffer .addr @ to line_pointer
697 697 ['] get_prop_cmd to parsing_function
698 698 begin
699 699 end_of_line? 0=
700 700 while
701 701 parsing_function execute
702 702 repeat
703 703 parsing_function ['] comment =
704 704 parsing_function ['] get_prop_cmd =
705 705 parsing_function ['] white_space_4 =
706 706 or or 0= if ESYNTAX throw then
707 707 ;
708 708
709 709 only forth also support-functions also file-processing definitions
710 710
711 711 \ Process line
712 712
713 713 : assignment_type? ( addr len -- flag )
714 714 name_buffer strget
715 715 compare 0=
716 716 ;
717 717
718 718 : suffix_type? ( addr len -- flag )
719 719 name_buffer .len @ over <= if 2drop false exit then
720 720 name_buffer .len @ over - name_buffer .addr @ +
721 721 over compare 0=
722 722 ;
723 723
724 724 : loader_conf_files? s" loader_conf_files" assignment_type? ;
725 725
726 726 : verbose_flag? s" verbose_loading" assignment_type? ;
727 727
728 728 : execute? s" exec" assignment_type? ;
729 729
730 730 : module_load? load_module_suffix suffix_type? ;
731 731
732 732 : module_loadname? module_loadname_suffix suffix_type? ;
733 733
734 734 : module_type? module_type_suffix suffix_type? ;
735 735
736 736 : module_hash? module_hash_suffix suffix_type? ;
737 737
738 738 : module_args? module_args_suffix suffix_type? ;
739 739
740 740 : module_beforeload? module_beforeload_suffix suffix_type? ;
741 741
742 742 : module_afterload? module_afterload_suffix suffix_type? ;
743 743
744 744 : module_loaderror? module_loaderror_suffix suffix_type? ;
745 745
746 746 \ build a 'set' statement and execute it
747 747 : set_environment_variable
748 748 name_buffer .len @ value_buffer .len @ + 5 chars + \ size of result string
749 749 allocate if ENOMEM throw then
750 750 dup 0 \ start with an empty string and append the pieces
751 751 s" set " strcat
752 752 name_buffer strget strcat
753 753 s" =" strcat
754 754 value_buffer strget strcat
755 755 ['] evaluate catch if
756 756 2drop free drop
757 757 ESETERROR throw
758 758 else
759 759 free-memory
760 760 then
761 761 ;
762 762
763 763 : set_conf_files
764 764 set_environment_variable
765 765 s" loader_conf_files" getenv conf_files string=
766 766 ;
767 767
768 768 : append_to_module_options_list ( addr -- )
769 769 module_options @ 0= if
770 770 dup module_options !
771 771 last_module_option !
772 772 else
773 773 dup last_module_option @ module.next !
774 774 last_module_option !
775 775 then
776 776 ;
777 777
778 778 : set_module_name { addr -- } \ check leaks
779 779 name_buffer strget addr module.name string=
780 780 ;
781 781
782 782 : yes_value?
783 783 value_buffer strget unquote
784 784 s" yes" compare-insensitive 0=
785 785 ;
786 786
787 787 : find_module_option ( -- addr | 0 ) \ return ptr to entry matching name_buffer
788 788 module_options @
789 789 begin
790 790 dup
791 791 while
792 792 dup module.name strget
793 793 name_buffer strget
794 794 compare 0= if exit then
795 795 module.next @
796 796 repeat
797 797 ;
798 798
799 799 : new_module_option ( -- addr )
800 800 sizeof module allocate if ENOMEM throw then
801 801 dup sizeof module erase
802 802 dup append_to_module_options_list
803 803 dup set_module_name
804 804 ;
805 805
806 806 : get_module_option ( -- addr )
807 807 find_module_option
808 808 ?dup 0= if new_module_option then
809 809 ;
810 810
811 811 : set_module_flag
812 812 name_buffer .len @ load_module_suffix nip - name_buffer .len !
813 813 yes_value? get_module_option module.flag !
814 814 ;
815 815
816 816 : set_module_args
817 817 name_buffer .len @ module_args_suffix nip - name_buffer .len !
818 818 value_buffer strget unquote
819 819 get_module_option module.args string=
820 820 ;
821 821
822 822 : set_module_loadname
823 823 name_buffer .len @ module_loadname_suffix nip - name_buffer .len !
824 824 value_buffer strget unquote
825 825 get_module_option module.loadname string=
826 826 ;
827 827
828 828 : set_module_type
829 829 name_buffer .len @ module_type_suffix nip - name_buffer .len !
830 830 value_buffer strget unquote
831 831 get_module_option module.type string=
832 832 ;
833 833
834 834 : set_module_hash
835 835 name_buffer .len @ module_hash_suffix nip - name_buffer .len !
836 836 value_buffer strget unquote
837 837 get_module_option module.hash string=
838 838 ;
839 839
840 840 : set_module_beforeload
841 841 name_buffer .len @ module_beforeload_suffix nip - name_buffer .len !
842 842 value_buffer strget unquote
843 843 get_module_option module.beforeload string=
844 844 ;
845 845
846 846 : set_module_afterload
847 847 name_buffer .len @ module_afterload_suffix nip - name_buffer .len !
848 848 value_buffer strget unquote
849 849 get_module_option module.afterload string=
850 850 ;
851 851
852 852 : set_module_loaderror
853 853 name_buffer .len @ module_loaderror_suffix nip - name_buffer .len !
854 854 value_buffer strget unquote
855 855 get_module_option module.loaderror string=
856 856 ;
857 857
858 858 : set_verbose
859 859 yes_value? to verbose?
860 860 ;
861 861
862 862 : execute_command
863 863 value_buffer strget unquote
864 864 ['] evaluate catch if EEXEC throw then
865 865 ;
866 866
867 867 : process_assignment
868 868 name_buffer .len @ 0= if exit then
869 869 loader_conf_files? if set_conf_files exit then
870 870 verbose_flag? if set_verbose exit then
871 871 execute? if execute_command exit then
872 872 module_load? if set_module_flag exit then
873 873 module_loadname? if set_module_loadname exit then
874 874 module_type? if set_module_type exit then
875 875 module_hash? if set_module_hash exit then
876 876 module_args? if set_module_args exit then
877 877 module_beforeload? if set_module_beforeload exit then
878 878 module_afterload? if set_module_afterload exit then
879 879 module_loaderror? if set_module_loaderror exit then
880 880 set_environment_variable
881 881 ;
882 882
883 883 \ free_buffer ( -- )
884 884 \
885 885 \ Free some pointers if needed. The code then tests for errors
886 886 \ in freeing, and throws an exception if needed. If a pointer is
887 887 \ not allocated, it's value (0) is used as flag.
888 888
889 889 : free_buffers
890 890 name_buffer strfree
891 891 value_buffer strfree
892 892 ;
893 893
894 894 \ Higher level file processing
895 895
896 896 get-current ( -- wid ) previous definitions >search ( wid -- )
897 897
898 898 : process_bootenv
899 899 begin
900 900 end_of_file? 0=
901 901 while
902 902 free_buffers
903 903 read_line
904 904 get_prop
905 905 ['] process_assignment catch
906 906 ['] free_buffers catch
907 907 swap throw throw
908 908 repeat
909 909 ;
910 910
911 911 : process_conf
912 912 begin
913 913 end_of_file? 0=
914 914 while
915 915 free_buffers
916 916 read_line
917 917 get_assignment
918 918 ['] process_assignment catch
919 919 ['] free_buffers catch
920 920 swap throw throw
921 921 repeat
922 922 ;
923 923
924 924 : peek_file ( addr len -- )
925 925 0 to end_of_file?
926 926 reset_line_reading
927 927 O_RDONLY fopen fd !
928 928 fd @ -1 = if EOPEN throw then
929 929 free_buffers
930 930 read_line
931 931 get_assignment
932 932 ['] process_assignment catch
933 933 ['] free_buffers catch
934 934 fd @ fclose
935 935 swap throw throw
936 936 ;
937 937
938 938 only forth also support-functions definitions
939 939
940 940 \ Interface to loading conf files
941 941
942 942 : load_conf ( addr len -- )
943 943 0 to end_of_file?
944 944 reset_line_reading
945 945 O_RDONLY fopen fd !
946 946 fd @ -1 = if EOPEN throw then
947 947 ['] process_conf catch
948 948 fd @ fclose
949 949 throw
950 950 ;
951 951
952 952 : print_line line_buffer strtype cr ;
953 953
954 954 : print_syntax_error
955 955 line_buffer strtype cr
956 956 line_buffer .addr @
957 957 begin
958 958 line_pointer over <>
959 959 while
960 960 bl emit char+
961 961 repeat
962 962 drop
963 963 ." ^" cr
964 964 ;
965 965
966 966 : load_bootenv ( addr len -- )
967 967 0 to end_of_file?
968 968 reset_line_reading
969 969 O_RDONLY fopen fd !
970 970 fd @ -1 = if EOPEN throw then
971 971 ['] process_bootenv catch
972 972 fd @ fclose
973 973 throw
974 974 ;
975 975
976 976 \ Debugging support functions
977 977
978 978 only forth definitions also support-functions
979 979
980 980 : test-file
981 981 ['] load_conf catch dup .
982 982 ESYNTAX = if cr print_syntax_error then
983 983 ;
984 984
985 985 \ find a module name, leave addr on the stack (0 if not found)
986 986 : find-module ( <module> -- ptr | 0 )
987 987 bl parse ( addr len )
988 988 module_options @ >r ( store current pointer )
989 989 begin
990 990 r@
991 991 while
992 992 2dup ( addr len addr len )
993 993 r@ module.name strget
994 994 compare 0= if drop drop r> exit then ( found it )
995 995 r> module.next @ >r
996 996 repeat
997 997 type ." was not found" cr r>
998 998 ;
999 999
1000 1000 : show-nonempty ( addr len mod -- )
1001 1001 strget dup verbose? or if
1002 1002 2swap type type cr
1003 1003 else
1004 1004 drop drop drop drop
1005 1005 then ;
1006 1006
1007 1007 : show-one-module { addr -- addr }
1008 1008 ." Name: " addr module.name strtype cr
1009 1009 s" Path: " addr module.loadname show-nonempty
1010 1010 s" Type: " addr module.type show-nonempty
1011 1011 s" Hash: " addr module.hash show-nonempty
1012 1012 s" Flags: " addr module.args show-nonempty
1013 1013 s" Before load: " addr module.beforeload show-nonempty
1014 1014 s" After load: " addr module.afterload show-nonempty
1015 1015 s" Error: " addr module.loaderror show-nonempty
1016 1016 ." Status: " addr module.flag @ if ." Load" else ." Don't load" then cr
1017 1017 cr
1018 1018 addr
1019 1019 ;
1020 1020
1021 1021 : show-module-options
1022 1022 module_options @
1023 1023 begin
1024 1024 ?dup
1025 1025 while
1026 1026 show-one-module
1027 1027 module.next @
1028 1028 repeat
1029 1029 ;
1030 1030
1031 1031 : free-one-module { addr -- addr }
1032 1032 addr module.name strfree
1033 1033 addr module.loadname strfree
1034 1034 addr module.type strfree
1035 1035 addr module.hash strfree
1036 1036 addr module.args strfree
1037 1037 addr module.largs strfree
1038 1038 addr module.beforeload strfree
1039 1039 addr module.afterload strfree
1040 1040 addr module.loaderror strfree
1041 1041 addr
1042 1042 ;
1043 1043
1044 1044 : free-module-options
1045 1045 module_options @
1046 1046 begin
1047 1047 ?dup
1048 1048 while
1049 1049 free-one-module
1050 1050 dup module.next @
1051 1051 swap free-memory
1052 1052 repeat
1053 1053 0 module_options !
1054 1054 0 last_module_option !
1055 1055 ;
1056 1056
1057 1057 only forth also support-functions definitions
1058 1058
1059 1059 \ Variables used for processing multiple conf files
1060 1060
1061 1061 string current_file_name_ref \ used to print the file name
1062 1062
1063 1063 \ Indicates if any conf file was successfully read
1064 1064
1065 1065 0 value any_conf_read?
1066 1066
1067 1067 \ loader_conf_files processing support functions
1068 1068
1069 1069 \ true if string in addr1 is smaller than in addr2
1070 1070 : compar ( addr1 addr2 -- flag )
1071 1071 swap ( addr2 addr1 )
1072 1072 dup cell+ ( addr2 addr1 addr )
1073 1073 swap @ ( addr2 addr len )
1074 1074 rot ( addr len addr2 )
1075 1075 dup cell+ ( addr len addr2 addr' )
1076 1076 swap @ ( addr len addr' len' )
1077 1077 compare -1 =
1078 1078 ;
1079 1079
1080 1080 \ insertion sort algorithm. we dont expect large amounts of data to be
1081 1081 \ sorted, so insert should be ok. compar needs to implement < operator.
1082 1082 : insert ( start end -- start )
1083 1083 dup @ >r ( r: v ) \ v = a[i]
1084 1084 begin
1085 1085 2dup < \ j>0
1086 1086 while
1087 1087 r@ over cell- @ compar \ a[j-1] > v
1088 1088 while
1089 1089 cell- \ j--
1090 1090 dup @ over cell+ ! \ a[j] = a[j-1]
1091 1091 repeat then
1092 1092 r> swap ! \ a[j] = v
1093 1093 ;
1094 1094
1095 1095 : sort ( array len -- )
1096 1096 1 ?do dup i cells + insert loop drop
1097 1097 ;
1098 1098
1099 1099 : opendir
1100 1100 s" /boot/conf.d" fopendir if fd ! else
1101 1101 EOPEN throw
1102 1102 then
1103 1103 ;
1104 1104
1105 1105 : readdir ( addr len flag | flag )
1106 1106 fd @ freaddir
1107 1107 ;
1108 1108
1109 1109 : closedir
1110 1110 fd @ fclosedir
1111 1111 ;
1112 1112
1113 1113 : entries ( -- n ) \ count directory entries
1114 1114 ['] opendir catch ( n array )
1115 1115 throw
1116 1116
1117 1117 0 ( i )
1118 1118 begin \ count the entries
1119 1119 readdir ( i addr len flag | i flag )
1120 1120 dup -1 = if
1121 1121 -ROT 2drop
1122 1122 swap 1+ swap
1123 1123 then
1124 1124 0=
1125 1125 until
1126 1126 closedir
1127 1127 ;
1128 1128
1129 1129 \ built-in prefix directory name; it must end with /, so we don't
1130 1130 \ need to check and insert it.
1131 1131 : make_cstring ( addr len -- addr' )
1132 1132 dup ( addr len len )
1133 1133 s" /boot/conf.d/" ( addr len len addr' len' )
1134 1134 rot ( addr len addr' len' len )
1135 1135 over + ( addr len addr' len' total ) \ space for prefix+str
1136 1136 dup cell+ 1+ \ 1+ for '\0'
1137 1137 allocate if
1138 1138 -1 abort" malloc failed"
1139 1139 then
1140 1140 ( addr len addr' len' total taddr )
1141 1141 dup rot ( addr len addr' len' taddr taddr total )
1142 1142 swap ! ( addr len addr' len' taddr ) \ store length
1143 1143 dup >r \ save reference
1144 1144 cell+ \ point to string area
1145 1145 2dup 2>r ( addr len addr' len' taddr' ) ( R: taddr len' taddr' )
1146 1146 swap move ( addr len )
1147 1147 2r> + ( addr len taddr' ) ( R: taddr )
1148 1148 swap 1+ move \ 1+ for '\0'
1149 1149 r> ( taddr )
1150 1150 ;
1151 1151
1152 1152 : scan_conf_dir ( -- addr len -1 | 0 )
1153 1153 s" currdev" getenv -1 <> if
1154 1154 3 \ we only need first 3 chars
1155 1155 s" net" compare 0= if
1156 1156 s" boot.tftproot.server" getenv? if
1157 1157 0 exit \ readdir does not work on tftp
1158 1158 then
1159 1159 then
1160 1160 then
1161 1161
1162 1162 ['] entries catch if
1163 1163 0 exit
1164 1164 then
1165 1165 dup 0= if exit then \ nothing to do
1166 1166
1167 1167 dup cells allocate ( n array flag ) \ allocate array
1168 1168 if 0 exit then
1169 1169 ['] opendir catch if ( n array )
1170 1170 free drop drop
1171 1171 0 exit
1172 1172 then
1173 1173 over 0 do
1174 1174 readdir ( n array addr len flag | n array flag )
1175 1175 0= if -1 abort" unexpected readdir error" then \ shouldnt happen
1176 1176 ( n array addr len )
1177 1177 \ we have relative name, make it absolute and convert to counted string
1178 1178 make_cstring ( n array addr )
1179 1179 over I cells + ! ( n array )
1180 1180 loop
1181 1181 closedir
1182 1182 2dup swap sort
1183 1183 \ we have now array of strings with directory entry names.
1184 1184 \ calculate size of concatenated string
1185 1185 over 0 swap 0 do ( n array 0 )
1186 1186 over I cells + @ ( n array total array[I] )
1187 1187 @ + 1+ ( n array total' )
1188 1188 loop
1189 1189 dup allocate if drop free 2drop 0 exit then
1190 1190 ( n array len addr )
1191 1191 \ now concatenate all entries.
1192 1192 2swap ( len addr n array )
1193 1193 over 0 swap 0 do ( len addr n array 0 )
1194 1194 over I cells + @ ( len addr n array total array[I] )
1195 1195 dup @ swap cell+ ( len addr n array total len addr' )
1196 1196 over ( len addr n array total len addr' len )
1197 1197 6 pick ( len addr n array total len addr' len addr )
1198 1198 4 pick + ( len addr n array total len addr' len addr+total )
1199 1199 swap move + ( len addr n array total+len )
1200 1200 3 pick ( len addr n array total addr )
1201 1201 over + bl swap c! 1+ ( len addr n array total )
1202 1202 over I cells + @ free drop \ free array[I]
1203 1203 loop
1204 1204 drop free drop drop ( len addr )
1205 1205 swap ( addr len )
1206 1206 -1
1207 1207 ;
1208 1208
1209 1209 : get_conf_files ( -- addr len ) \ put addr/len on stack, reset var
1210 1210 \ ." -- starting on <" conf_files strtype ." >" cr \ debugging
1211 1211 scan_conf_dir if \ concatenate with conf_files
1212 1212 ( addr len )
1213 1213 dup conf_files .len @ + 2 + allocate abort" out of memory" ( addr len addr' )
1214 1214 dup conf_files strget ( addr len addr' caddr clen )
1215 1215 rot swap move ( addr len addr' )
1216 1216 \ add space
1217 1217 dup conf_files .len @ + ( addr len addr' addr'+clen )
1218 1218 dup bl swap c! 1+ ( addr len addr' addr'' )
1219 1219 3 pick swap ( addr len addr' addr addr'' )
1220 1220 3 pick move ( addr len addr' )
1221 1221 rot ( len addr' addr )
1222 1222 free drop swap ( addr' len )
1223 1223 conf_files .len @ + 1+ ( addr len )
1224 1224 conf_files strfree
1225 1225 else
1226 1226 conf_files strget 0 0 conf_files strset
1227 1227 then
1228 1228 ;
1229 1229
1230 1230 : skip_leading_spaces { addr len pos -- addr len pos' }
1231 1231 begin
1232 1232 pos len = if 0 else addr pos + c@ bl = then
1233 1233 while
1234 1234 pos char+ to pos
1235 1235 repeat
1236 1236 addr len pos
1237 1237 ;
1238 1238
1239 1239 \ return the file name at pos, or free the string if nothing left
1240 1240 : get_file_name { addr len pos -- addr len pos' addr' len' || 0 }
1241 1241 pos len = if
1242 1242 addr free abort" Fatal error freeing memory"
1243 1243 0 exit
1244 1244 then
1245 1245 pos >r
1246 1246 begin
1247 1247 \ stay in the loop until have chars and they are not blank
1248 1248 pos len = if 0 else addr pos + c@ bl <> then
1249 1249 while
1250 1250 pos char+ to pos
1251 1251 repeat
1252 1252 addr len pos addr r@ + pos r> -
1253 1253 ;
1254 1254
1255 1255 : get_next_file ( addr len ptr -- addr len ptr' addr' len' | 0 )
1256 1256 skip_leading_spaces
1257 1257 get_file_name
1258 1258 ;
1259 1259
1260 1260 : print_current_file
1261 1261 current_file_name_ref strtype
1262 1262 ;
1263 1263
1264 1264 : process_conf_errors
1265 1265 dup 0= if true to any_conf_read? drop exit then
1266 1266 >r 2drop r>
1267 1267 dup ESYNTAX = if
1268 1268 ." Warning: syntax error on file " print_current_file cr
1269 1269 print_syntax_error drop exit
1270 1270 then
1271 1271 dup ESETERROR = if
1272 1272 ." Warning: bad definition on file " print_current_file cr
1273 1273 print_line drop exit
1274 1274 then
1275 1275 dup EREAD = if
1276 1276 ." Warning: error reading file " print_current_file cr drop exit
1277 1277 then
1278 1278 dup EOPEN = if
1279 1279 verbose? if ." Warning: unable to open file " print_current_file cr then
1280 1280 drop exit
1281 1281 then
1282 1282 dup EFREE = abort" Fatal error freeing memory"
1283 1283 dup ENOMEM = abort" Out of memory"
1284 1284 throw \ Unknown error -- pass ahead
1285 1285 ;
1286 1286
1287 1287 \ Process loader_conf_files recursively
1288 1288 \ Interface to loader_conf_files processing
1289 1289
1290 1290 : include_bootenv
1291 1291 s" /boot/solaris/bootenv.rc"
1292 1292 ['] load_bootenv catch
1293 1293 dup 0= if drop exit then
1294 1294 >r 2drop r>
1295 1295 dup ESYNTAX = if
1296 1296 ." Warning: syntax error on /boot/solaris/bootenv.rc" cr drop exit
1297 1297 then
1298 1298 dup EREAD = if
1299 1299 ." Warning: error reading /boot/solaris/bootenv.rc" cr drop exit
1300 1300 then
1301 1301 dup EOPEN = if
1302 1302 verbose? if ." Warning: unable to open /boot/solaris/bootenv.rc" cr then
1303 1303 drop exit
1304 1304 then
1305 1305 dup EFREE = abort" Fatal error freeing memory"
1306 1306 dup ENOMEM = abort" Out of memory"
1307 1307 throw \ Unknown error -- pass ahead
1308 1308 ;
1309 1309
1310 1310 : include_transient
1311 1311 s" /boot/transient.conf" ['] load_conf catch
1312 1312 dup 0= if drop exit then \ no error
1313 1313 >r 2drop r>
1314 1314 dup ESYNTAX = if
1315 1315 ." Warning: syntax error on file /boot/transient.conf" cr
1316 1316 drop exit
1317 1317 then
1318 1318 dup ESETERROR = if
1319 1319 ." Warning: bad definition on file /boot/transient.conf" cr
1320 1320 drop exit
1321 1321 then
1322 1322 dup EREAD = if
1323 1323 ." Warning: error reading file /boot/transient.conf" cr drop exit
1324 1324 then
1325 1325 dup EOPEN = if
1326 1326 verbose? if ." Warning: unable to open file /boot/transient.conf" cr then
1327 1327 drop exit
1328 1328 then
1329 1329 dup EFREE = abort" Fatal error freeing memory"
1330 1330 dup ENOMEM = abort" Out of memory"
1331 1331 throw \ Unknown error -- pass ahead
1332 1332 ;
1333 1333
1334 1334 : include_conf_files
1335 1335 get_conf_files 0 ( addr len offset )
1336 1336 begin
1337 1337 get_next_file ?dup ( addr len 1 | 0 )
1338 1338 while
1339 1339 current_file_name_ref strref
1340 1340 ['] load_conf catch
1341 1341 process_conf_errors
1342 1342 conf_files .addr @ if recurse then
1343 1343 repeat
1344 1344 ;
1345 1345
1346 1346 \ Module loading functions
1347 1347
1348 1348 \ concat two strings by allocating space
1349 1349 : concat { a1 l1 a2 l2 -- a' l' }
1350 1350 l1 l2 + allocate if ENOMEM throw then
1351 1351 0 a1 l1 strcat
1352 1352 a2 l2 strcat
1353 1353 ;
1354 1354
1355 1355 \ build module argument list as: "hash= name= module.args"
1356 1356 \ if type is hash, name= will have module name without .hash suffix
1357 1357 \ will free old largs and set new.
1358 1358
1359 1359 : build_largs { addr -- addr }
1360 1360 addr module.largs strfree
1361 1361 addr module.hash .len @
1362 1362 if ( set hash= )
1363 1363 s" hash=" addr module.hash strget concat
1364 1364 addr module.largs strset \ largs = "hash=" + module.hash
1365 1365 then
1366 1366
1367 1367 addr module.type strget s" hash" compare 0=
1368 1368 if ( module.type == "hash" )
1369 1369 addr module.largs strget s" name=" concat
1370 1370
1371 1371 addr module.loadname .len @
1372 1372 if ( module.loadname != NULL )
1373 1373 addr module.loadname strget concat
1374 1374 else
1375 1375 addr module.name strget concat
1376 1376 then
1377 1377
1378 1378 addr module.largs strfree
1379 1379 addr module.largs strset \ largs = largs + name
1380 1380
1381 1381 \ last thing to do is to strip off ".hash" suffix
1382 1382 addr module.largs strget [char] . strchr
1383 1383 dup if ( strchr module.largs '.' )
1384 1384 s" .hash" compare 0=
1385 1385 if ( it is ".hash" )
1386 1386 addr module.largs .len @ 5 -
1387 1387 addr module.largs .len !
1388 1388 then
1389 1389 else
1390 1390 2drop
1391 1391 then
1392 1392 then
1393 1393 \ and now add up the module.args
1394 1394 addr module.largs strget s" " concat
1395 1395 addr module.args strget concat
1396 1396 addr module.largs strfree
1397 1397 addr module.largs strset
1398 1398 addr
1399 1399 ;
1400 1400
1401 1401 : load_parameters { addr -- addr addrN lenN ... addr1 len1 N }
1402 1402 addr build_largs
1403 1403 addr module.largs strget
1404 1404 addr module.loadname .len @ if
1405 1405 addr module.loadname strget
1406 1406 else
1407 1407 addr module.name strget
1408 1408 then
1409 1409 addr module.type .len @ if
1410 1410 addr module.type strget
1411 1411 s" -t "
1412 1412 4 ( -t type name flags )
1413 1413 else
1414 1414 2 ( name flags )
1415 1415 then
1416 1416 ;
1417 1417
1418 1418 : before_load ( addr -- addr )
1419 1419 dup module.beforeload .len @ if
1420 1420 dup module.beforeload strget
1421 1421 ['] evaluate catch if EBEFORELOAD throw then
1422 1422 then
1423 1423 ;
1424 1424
1425 1425 : after_load ( addr -- addr )
1426 1426 dup module.afterload .len @ if
1427 1427 dup module.afterload strget
1428 1428 ['] evaluate catch if EAFTERLOAD throw then
1429 1429 then
1430 1430 ;
1431 1431
1432 1432 : load_error ( addr -- addr )
1433 1433 dup module.loaderror .len @ if
1434 1434 dup module.loaderror strget
1435 1435 evaluate \ This we do not intercept so it can throw errors
1436 1436 then
1437 1437 ;
1438 1438
1439 1439 : pre_load_message ( addr -- addr )
1440 1440 verbose? if
1441 1441 dup module.name strtype
1442 1442 ." ..."
1443 1443 then
1444 1444 ;
1445 1445
1446 1446 : load_error_message verbose? if ." failed!" cr then ;
1447 1447
1448 1448 : load_successful_message verbose? if ." ok" cr then ;
1449 1449
1450 1450 : load_module
1451 1451 load_parameters load
1452 1452 ;
1453 1453
1454 1454 : process_module ( addr -- addr )
1455 1455 pre_load_message
1456 1456 before_load
1457 1457 begin
1458 1458 ['] load_module catch if
1459 1459 dup module.loaderror .len @ if
1460 1460 load_error \ Command should return a flag!
1461 1461 else
1462 1462 load_error_message true \ Do not retry
1463 1463 then
1464 1464 else
1465 1465 after_load
1466 1466 load_successful_message true \ Successful, do not retry
1467 1467 then
1468 1468 until
1469 1469 ;
1470 1470
1471 1471 : process_module_errors ( addr ior -- )
1472 1472 dup EBEFORELOAD = if
1473 1473 drop
1474 1474 ." Module "
1475 1475 dup module.name strtype
1476 1476 dup module.loadname .len @ if
1477 1477 ." (" dup module.loadname strtype ." )"
1478 1478 then
1479 1479 cr
1480 1480 ." Error executing "
1481 1481 dup module.beforeload strtype cr \ XXX there was a typo here
1482 1482 abort
1483 1483 then
1484 1484
1485 1485 dup EAFTERLOAD = if
1486 1486 drop
1487 1487 ." Module "
1488 1488 dup module.name .addr @ over module.name .len @ type
1489 1489 dup module.loadname .len @ if
1490 1490 ." (" dup module.loadname strtype ." )"
1491 1491 then
1492 1492 cr
1493 1493 ." Error executing "
1494 1494 dup module.afterload strtype cr
1495 1495 abort
1496 1496 then
1497 1497
1498 1498 throw \ Don't know what it is all about -- pass ahead
1499 1499 ;
1500 1500
1501 1501 \ Module loading interface
1502 1502
1503 1503 \ scan the list of modules, load enabled ones.
1504 1504 : load_modules ( -- ) ( throws: abort & user-defined )
1505 1505 module_options @ ( list_head )
1506 1506 begin
1507 1507 ?dup
1508 1508 while
1509 1509 dup module.flag @ if
1510 1510 ['] process_module catch
1511 1511 process_module_errors
1512 1512 then
1513 1513 module.next @
1514 1514 repeat
1515 1515 ;
1516 1516
1517 1517 \ h00h00 magic used to try loading either a kernel with a given name,
1518 1518 \ or a kernel with the default name in a directory of a given name
1519 1519 \ (the pain!)
1520 1520
1521 1521 : bootpath s" /platform/" ;
1522 1522 : modulepath s" module_path" ;
1523 1523
1524 1524 \ Functions used to save and restore module_path's value.
1525 1525 : saveenv ( addr len | -1 -- addr' len | 0 -1 )
1526 1526 dup -1 = if 0 swap exit then
1527 1527 strdup
1528 1528 ;
1529 1529 : freeenv ( addr len | 0 -1 )
1530 1530 -1 = if drop else free abort" Freeing error" then
1531 1531 ;
1532 1532 : restoreenv ( addr len | 0 -1 -- )
1533 1533 dup -1 = if ( it wasn't set )
1534 1534 2drop
1535 1535 modulepath unsetenv
1536 1536 else
1537 1537 over >r
1538 1538 modulepath setenv
1539 1539 r> free abort" Freeing error"
1540 1540 then
1541 1541 ;
1542 1542
1543 1543 : clip_args \ Drop second string if only one argument is passed
1544 1544 1 = if
1545 1545 2swap 2drop
1546 1546 1
1547 1547 else
1548 1548 2
1549 1549 then
1550 1550 ;
1551 1551
1552 1552 also builtins
1553 1553
1554 1554 \ Parse filename from a semicolon-separated list
1555 1555
1556 1556 : parse-; ( addr len -- addr' len-x addr x )
1557 1557 over 0 2swap ( addr 0 addr len )
1558 1558 begin
1559 1559 dup 0 <> ( addr 0 addr len )
1560 1560 while
1561 1561 over c@ [char] ; <> ( addr 0 addr len flag )
1562 1562 while
1563 1563 1- swap 1+ swap
1564 1564 2swap 1+ 2swap
1565 1565 repeat then
1566 1566 dup 0 <> if
1567 1567 1- swap 1+ swap
1568 1568 then
1569 1569 2swap
1570 1570 ;
1571 1571
1572 1572 \ Try loading one of multiple kernels specified
1573 1573
1574 1574 : try_multiple_kernels ( addr len addr' len' args -- flag )
1575 1575 >r
1576 1576 begin
1577 1577 parse-; 2>r
1578 1578 2over 2r>
1579 1579 r@ clip_args
1580 1580 s" DEBUG" getenv? if
1581 1581 s" echo Module_path: ${module_path}" evaluate
1582 1582 ." Kernel : " >r 2dup type r> cr
1583 1583 dup 2 = if ." Flags : " >r 2over type r> cr then
1584 1584 then
1585 1585 \ if it's xen, the xen kernel is loaded, unix needs to be loaded as module
1586 1586 s" xen_kernel" getenv -1 <> if
1587 1587 drop \ drop address from getenv
1588 1588 >r \ argument count to R
1589 1589 s" kernel" s" -t " \ push 2 strings into the stack
1590 1590 r> 2 + \ increment argument count
1591 1591 then
1592 1592
1593 1593 1 ['] load catch dup if
1594 1594 ( addr0 len0 addr1 len1 ... args 1 error )
1595 1595 >r \ error code to R
1596 1596 drop \ drop 1
1597 1597 0 do 2drop loop \ drop addr len pairs
1598 1598 r> \ set flag for while
1599 1599 then
1600 1600 while
1601 1601 dup 0=
1602 1602 until
1603 1603 1 >r \ Failure
1604 1604 else
1605 1605 0 >r \ Success
1606 1606 then
1607 1607 2drop 2drop
1608 1608 r>
1609 1609 r> drop
1610 1610 ;
1611 1611
1612 1612 \ Try to load a kernel; the kernel name is taken from one of
1613 1613 \ the following lists, as ordered:
1614 1614 \
1615 1615 \ 1. The "bootfile" environment variable
1616 1616 \ 2. The "kernel" environment variable
1617 1617 \
1618 1618 \ Flags are passed, if available. If not, dummy values must be given.
1619 1619 \
1620 1620 \ The kernel gets loaded from the current module_path.
1621 1621
1622 1622 : load_a_kernel ( flags len 1 | x x 0 -- flag )
1623 1623 local args
1624 1624 2local flags
1625 1625 0 0 2local kernel
1626 1626 end-locals
1627 1627
1628 1628 \ Check if a default kernel name exists at all, exits if not
1629 1629 s" bootfile" getenv dup -1 <> if
1630 1630 to kernel
1631 1631 flags kernel args 1+ try_multiple_kernels
1632 1632 dup 0= if exit then
1633 1633 then
1634 1634 drop
1635 1635
1636 1636 s" kernel" getenv dup -1 <> if
1637 1637 to kernel
1638 1638 else
1639 1639 drop
1640 1640 1 exit \ Failure
1641 1641 then
1642 1642
1643 1643 \ Try all default kernel names
1644 1644 flags kernel args 1+ try_multiple_kernels
1645 1645 ;
1646 1646
1647 1647 \ Try to load a kernel; the kernel name is taken from one of
1648 1648 \ the following lists, as ordered:
1649 1649 \
1650 1650 \ 1. The "bootfile" environment variable
1651 1651 \ 2. The "kernel" environment variable
1652 1652 \
1653 1653 \ Flags are passed, if provided.
1654 1654 \
1655 1655 \ The kernel will be loaded from a directory computed from the
1656 1656 \ path given. Two directories will be tried in the following order:
1657 1657 \
1658 1658 \ 1. /boot/path
1659 1659 \ 2. path
1660 1660 \
1661 1661 \ The module_path variable is overridden if load is successful, by
1662 1662 \ prepending the successful path.
1663 1663
1664 1664 : load_from_directory ( path len 1 | flags len' path len 2 -- flag )
1665 1665 local args
1666 1666 2local path
1667 1667 args 1 = if 0 0 then
1668 1668 2local flags
1669 1669 0 0 2local oldmodulepath \ like a string
1670 1670 0 0 2local newmodulepath \ like a string
1671 1671 end-locals
1672 1672
1673 1673 \ Set the environment variable module_path, and try loading
1674 1674 \ the kernel again.
1675 1675 modulepath getenv saveenv to oldmodulepath
1676 1676
1677 1677 \ Try prepending /boot/ first
1678 1678 bootpath nip path nip + \ total length
1679 1679 oldmodulepath nip dup -1 = if
1680 1680 drop
1681 1681 else
1682 1682 1+ + \ add oldpath -- XXX why the 1+ ?
1683 1683 then
1684 1684 allocate if ( out of memory ) 1 exit then \ XXX throw ?
1685 1685
1686 1686 0
1687 1687 bootpath strcat
1688 1688 path strcat
1689 1689 2dup to newmodulepath
1690 1690 modulepath setenv
1691 1691
1692 1692 \ Try all default kernel names
1693 1693 flags args 1- load_a_kernel
1694 1694 0= if ( success )
1695 1695 oldmodulepath nip -1 <> if
1696 1696 newmodulepath s" ;" strcat
1697 1697 oldmodulepath strcat
1698 1698 modulepath setenv
1699 1699 newmodulepath drop free-memory
1700 1700 oldmodulepath drop free-memory
1701 1701 then
1702 1702 0 exit
1703 1703 then
1704 1704
1705 1705 \ Well, try without the prepended /boot/
1706 1706 path newmodulepath drop swap move
1707 1707 newmodulepath drop path nip
1708 1708 2dup to newmodulepath
1709 1709 modulepath setenv
1710 1710
1711 1711 \ Try all default kernel names
1712 1712 flags args 1- load_a_kernel
1713 1713 if ( failed once more )
1714 1714 oldmodulepath restoreenv
1715 1715 newmodulepath drop free-memory
1716 1716 1
1717 1717 else
1718 1718 oldmodulepath nip -1 <> if
1719 1719 newmodulepath s" ;" strcat
1720 1720 oldmodulepath strcat
1721 1721 modulepath setenv
1722 1722 newmodulepath drop free-memory
1723 1723 oldmodulepath drop free-memory
1724 1724 then
1725 1725 0
1726 1726 then
1727 1727 ;
1728 1728
1729 1729 \ Try to load a kernel; the kernel name is taken from one of
1730 1730 \ the following lists, as ordered:
1731 1731 \
1732 1732 \ 1. The "bootfile" environment variable
1733 1733 \ 2. The "kernel" environment variable
1734 1734 \ 3. The "path" argument
1735 1735 \
1736 1736 \ Flags are passed, if provided.
1737 1737 \
1738 1738 \ The kernel will be loaded from a directory computed from the
1739 1739 \ path given. Two directories will be tried in the following order:
1740 1740 \
1741 1741 \ 1. /boot/path
1742 1742 \ 2. path
1743 1743 \
1744 1744 \ Unless "path" is meant to be kernel name itself. In that case, it
1745 1745 \ will first be tried as a full path, and, next, search on the
1746 1746 \ directories pointed by module_path.
1747 1747 \
1748 1748 \ The module_path variable is overridden if load is successful, by
1749 1749 \ prepending the successful path.
1750 1750
1751 1751 : load_directory_or_file ( path len 1 | flags len' path len 2 -- flag )
1752 1752 local args
1753 1753 2local path
1754 1754 args 1 = if 0 0 then
1755 1755 2local flags
1756 1756 end-locals
1757 1757
1758 1758 \ First, assume path is an absolute path to a directory
1759 1759 flags path args clip_args load_from_directory
1760 1760 dup 0= if exit else drop then
1761 1761
1762 1762 \ Next, assume path points to the kernel
1763 1763 flags path args try_multiple_kernels
1764 1764 ;
1765 1765
1766 1766 : initialize ( addr len -- )
1767 1767 strdup conf_files strset
1768 1768 ;
1769 1769
1770 1770 : boot-args ( -- addr len 1 | 0 )
1771 1771 s" boot-args" getenv
1772 1772 dup -1 = if drop 0 else 1 then
1773 1773 ;
1774 1774
1775 1775 : standard_kernel_search ( flags 1 | 0 -- flag )
1776 1776 local args
1777 1777 args 0= if 0 0 then
1778 1778 2local flags
1779 1779 s" kernel" getenv
1780 1780 dup -1 = if 0 swap then
1781 1781 2local path
1782 1782 end-locals
1783 1783
1784 1784 path nip -1 = if ( there isn't a "kernel" environment variable )
1785 1785 flags args load_a_kernel
1786 1786 else
1787 1787 flags path args 1+ clip_args load_directory_or_file
1788 1788 then
1789 1789 ;
1790 1790
1791 1791 : load_kernel ( -- ) ( throws: abort )
1792 1792 s" xen_kernel" getenv -1 = if
1793 1793 boot-args standard_kernel_search
1794 1794 abort" Unable to load a kernel!"
1795 1795 exit
1796 1796 then
1797 1797
1798 1798 drop
1799 1799 \ we have loaded the xen kernel, load unix as module
1800 1800 s" bootfile" getenv dup -1 <> if
1801 1801 s" kernel" s" -t " 3 1 load
1802 1802 then
1803 1803 abort" Unable to load a kernel!"
1804 1804 ;
1805 1805
1806 1806 : load_xen ( -- )
1807 1807 s" xen_kernel" getenv dup -1 <> if
1808 1808 1 1 load ( c-addr/u flag N -- flag )
1809 1809 else
1810 1810 drop
1811 1811 0 ( -1 -- flag )
1812 1812 then
1813 1813 ;
1814 1814
1815 1815 : load_xen_throw ( -- ) ( throws: abort )
1816 1816 load_xen
1817 1817 abort" Unable to load Xen!"
1818 1818 ;
1819 1819
1820 1820 : set_defaultoptions ( -- )
1821 1821 s" boot-args" getenv dup -1 = if
1822 1822 drop
1823 1823 else
1824 1824 s" temp_options" setenv
1825 1825 then
1826 1826 ;
1827 1827
1828 1828 \ pick the i-th argument, i starts at 0
1829 1829 : argv[] ( aN uN ... a1 u1 N i -- aN uN ... a1 u1 N ai+1 ui+1 )
1830 1830 2dup = if 0 0 exit then \ out of range
1831 1831 dup >r
1832 1832 1+ 2* ( skip N and ui )
1833 1833 pick
1834 1834 r>
1835 1835 1+ 2* ( skip N and ai )
1836 1836 pick
1837 1837 ;
1838 1838
1839 1839 : drop_args ( aN uN ... a1 u1 N -- )
1840 1840 0 ?do 2drop loop
1841 1841 ;
1842 1842
1843 1843 : argc
1844 1844 dup
1845 1845 ;
1846 1846
1847 1847 : queue_argv ( aN uN ... a1 u1 N a u -- a u aN uN ... a1 u1 N+1 )
1848 1848 >r
1849 1849 over 2* 1+ -roll
1850 1850 r>
1851 1851 over 2* 1+ -roll
1852 1852 1+
1853 1853 ;
1854 1854
1855 1855 : unqueue_argv ( aN uN ... a1 u1 N -- aN uN ... a2 u2 N-1 a1 u1 )
1856 1856 1- -rot
1857 1857 ;
1858 1858
1859 1859 \ compute the length of the buffer including the spaces between words
1860 1860 : strlen(argv) ( aN uN .. a1 u1 N -- aN uN .. a1 u1 N len )
1861 1861 dup 0= if 0 exit then
1862 1862 0 >r \ Size
1863 1863 0 >r \ Index
1864 1864 begin
1865 1865 argc r@ <>
1866 1866 while
1867 1867 r@ argv[]
1868 1868 nip
1869 1869 r> r> rot + 1+
1870 1870 >r 1+ >r
1871 1871 repeat
1872 1872 r> drop
1873 1873 r>
1874 1874 ;
1875 1875
1876 1876 : concat_argv ( aN uN ... a1 u1 N -- a u )
1877 1877 strlen(argv) allocate if ENOMEM throw then
1878 1878 0 2>r ( save addr 0 on return stack )
1879 1879
1880 1880 begin
1881 1881 dup
1882 1882 while
1883 1883 unqueue_argv ( ... N a1 u1 )
1884 1884 2r> 2swap ( old a1 u1 )
1885 1885 strcat
1886 1886 s" " strcat ( append one space ) \ XXX this gives a trailing space
1887 1887 2>r ( store string on the result stack )
1888 1888 repeat
1889 1889 drop_args
1890 1890 2r>
1891 1891 ;
1892 1892
1893 1893 : set_tempoptions ( addrN lenN ... addr1 len1 N -- addr len 1 | 0 )
1894 1894 \ Save the first argument, if it exists and is not a flag
1895 1895 argc if
1896 1896 0 argv[] drop c@ [char] - <> if
1897 1897 unqueue_argv 2>r \ Filename
1898 1898 1 >r \ Filename present
1899 1899 else
1900 1900 0 >r \ Filename not present
1901 1901 then
1902 1902 else
1903 1903 0 >r \ Filename not present
1904 1904 then
1905 1905
1906 1906 \ If there are other arguments, assume they are flags
1907 1907 ?dup if
1908 1908 concat_argv
1909 1909 2dup s" temp_options" setenv
1910 1910 drop free if EFREE throw then
1911 1911 else
1912 1912 set_defaultoptions
1913 1913 then
1914 1914
1915 1915 \ Bring back the filename, if one was provided
1916 1916 r> if 2r> 1 else 0 then
1917 1917 ;
1918 1918
1919 1919 : get_arguments ( -- addrN lenN ... addr1 len1 N )
1920 1920 0
1921 1921 begin
1922 1922 \ Get next word on the command line
1923 1923 parse-word
1924 1924 ?dup while
1925 1925 queue_argv
1926 1926 repeat
1927 1927 drop ( empty string )
1928 1928 ;
1929 1929
1930 1930 : load_kernel_and_modules ( args -- flag )
1931 1931 set_tempoptions
1932 1932 argc >r
1933 1933 s" temp_options" getenv dup -1 <> if
1934 1934 queue_argv
1935 1935 else
1936 1936 drop
1937 1937 then
1938 1938 load_xen
1939 1939 ?dup 0= if ( success )
1940 1940 r> if ( a path was passed )
1941 1941 load_directory_or_file
1942 1942 else
1943 1943 standard_kernel_search
1944 1944 then
1945 1945 ?dup 0= if ['] load_modules catch then
1946 1946 then
1947 1947 ;
1948 1948
1949 1949 only forth definitions
|
↓ open down ↓ |
1402 lines elided |
↑ open up ↑ |
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX