xref: /illumos-gate/usr/src/boot/forth/loader.4th (revision 22028508)
1199767f8SToomas Soome\ Copyright (c) 1999 Daniel C. Sobral <dcs@FreeBSD.org>
2199767f8SToomas Soome\ Copyright (c) 2011-2015 Devin Teske <dteske@FreeBSD.org>
3199767f8SToomas Soome\ All rights reserved.
4199767f8SToomas Soome\
5199767f8SToomas Soome\ Redistribution and use in source and binary forms, with or without
6199767f8SToomas Soome\ modification, are permitted provided that the following conditions
7199767f8SToomas Soome\ are met:
8199767f8SToomas Soome\ 1. Redistributions of source code must retain the above copyright
9199767f8SToomas Soome\    notice, this list of conditions and the following disclaimer.
10199767f8SToomas Soome\ 2. Redistributions in binary form must reproduce the above copyright
11199767f8SToomas Soome\    notice, this list of conditions and the following disclaimer in the
12199767f8SToomas Soome\    documentation and/or other materials provided with the distribution.
13199767f8SToomas Soome\
24199767f8SToomas Soome\ SUCH DAMAGE.
25199767f8SToomas Soome\
26199767f8SToomas Soome\ $FreeBSD$
27199767f8SToomas Soome
28199767f8SToomas Soomeonly forth definitions
29199767f8SToomas Soome
30199767f8SToomas Soomes" arch-i386" environment? [if] [if]
31199767f8SToomas Soome	s" loader_version" environment?  [if]
32199767f8SToomas Soome		11 < [if]
33199767f8SToomas Soome			.( Loader version 1.1+ required) cr
34199767f8SToomas Soome			abort
35199767f8SToomas Soome		[then]
36199767f8SToomas Soome	[else]
37199767f8SToomas Soome		.( Could not get loader version!) cr
38199767f8SToomas Soome		abort
39199767f8SToomas Soome	[then]
40199767f8SToomas Soome[then] [then]
41199767f8SToomas Soome
42199767f8SToomas Soomeinclude /boot/forth/support.4th
43199767f8SToomas Soomeinclude /boot/forth/color.4th
44199767f8SToomas Soomeinclude /boot/forth/delay.4th
45199767f8SToomas Soomeinclude /boot/forth/check-password.4th
46a1625066SAndy Fiddamanefi? [if]
47eee59048SToomas Soome	include /boot/forth/efi.4th
48eee59048SToomas Soome[then]
49199767f8SToomas Soome
50199767f8SToomas Soomeonly forth definitions
51199767f8SToomas Soome
52199767f8SToomas Soome: bootmsg ( -- )
53199767f8SToomas Soome  loader_color? dup ( -- bool bool )
54199767f8SToomas Soome  if 7 fg 4 bg then
55199767f8SToomas Soome  ." Booting..."
56199767f8SToomas Soome  if me then
57199767f8SToomas Soome  cr
58199767f8SToomas Soome;
59199767f8SToomas Soome
60199767f8SToomas Soome: try-menu-unset
61199767f8SToomas Soome  \ menu-unset may not be present
62199767f8SToomas Soome  s" beastie_disable" getenv
63199767f8SToomas Soome  dup -1 <> if
64199767f8SToomas Soome    s" YES" compare-insensitive 0= if
65199767f8SToomas Soome      exit
66199767f8SToomas Soome    then
67199767f8SToomas Soome  else
68199767f8SToomas Soome    drop
69199767f8SToomas Soome  then
70199767f8SToomas Soome  s" menu-unset"
71199767f8SToomas Soome  sfind if
72199767f8SToomas Soome    execute
73199767f8SToomas Soome  else
74199767f8SToomas Soome    drop
75199767f8SToomas Soome  then
76199767f8SToomas Soome  s" menusets-unset"
77199767f8SToomas Soome  sfind if
78199767f8SToomas Soome    execute
79199767f8SToomas Soome  else
80199767f8SToomas Soome    drop
81199767f8SToomas Soome  then
82199767f8SToomas Soome;
83199767f8SToomas Soome
84199767f8SToomas Soomeonly forth also support-functions also builtins definitions
85199767f8SToomas Soome
86199767f8SToomas Soome\ the boot-args was parsed to individual options while loaded
87199767f8SToomas Soome\ now compose boot-args, so the boot can set kernel arguments
88199767f8SToomas Soome\ note the command line switched for boot command will cause
89199767f8SToomas Soome\ environment variable boot-args to be ignored
90199767f8SToomas Soome\ There are 2 larger strings, acpi-user-options and existing boot-args
91199767f8SToomas Soome\ other switches are 1 byte each, so allocate boot-args+acpi + extra bytes
92199767f8SToomas Soome\ for rest. Be sure to review this, if more options are to be added into
93199767f8SToomas Soome\ environment.
94199767f8SToomas Soome
95199767f8SToomas Soome: set-boot-args { | addr len baddr blen aaddr alen -- }
96199767f8SToomas Soome  s" boot-args" getenv dup -1 <> if
97199767f8SToomas Soome    to blen to baddr
98199767f8SToomas Soome  else
99199767f8SToomas Soome    drop
100199767f8SToomas Soome  then
101199767f8SToomas Soome  s" acpi-user-options" getenv dup -1 <> if
102199767f8SToomas Soome    to alen to aaddr
103199767f8SToomas Soome  else
104199767f8SToomas Soome    drop
105199767f8SToomas Soome  then
106199767f8SToomas Soome
107199767f8SToomas Soome  \ allocate temporary space. max is:
108199767f8SToomas Soome  \  7 kernel switches
109199767f8SToomas Soome  \  26 for acpi, so use 40 for safety
110199767f8SToomas Soome  blen alen 40 + + allocate abort" out of memory"
111199767f8SToomas Soome  to addr
112199767f8SToomas Soome  \ boot-addr may have file name before options, copy it to addr
113199767f8SToomas Soome  baddr 0<> if
114199767f8SToomas Soome    baddr c@ [char] - <> if
115199767f8SToomas Soome      baddr blen [char] - strchr		( addr len )
116199767f8SToomas Soome      dup 0= if				\ no options, copy all
117199767f8SToomas Soome        2drop
118199767f8SToomas Soome        baddr addr blen move
119199767f8SToomas Soome        blen to len
120199767f8SToomas Soome        0 to blen
121199767f8SToomas Soome        0 to baddr
122199767f8SToomas Soome      else				( addr len )
123199767f8SToomas Soome        dup blen
124199767f8SToomas Soome        swap -
125199767f8SToomas Soome        to len				( addr len )
126199767f8SToomas Soome        to blen				( addr )
127a1625066SAndy Fiddaman        baddr addr len move		( addr )
128199767f8SToomas Soome        to baddr			\ baddr points now to first option
129199767f8SToomas Soome      then
130199767f8SToomas Soome    then
131199767f8SToomas Soome  then
132199767f8SToomas Soome  \ now add kernel switches
133199767f8SToomas Soome  len 0<> if
134199767f8SToomas Soome    bl addr len + c! len 1+ to len
135199767f8SToomas Soome  then
136199767f8SToomas Soome  [char] - addr len + c! len 1+ to len
137199767f8SToomas Soome
138199767f8SToomas Soome  s" boot_single" getenv dup -1 <> if
139199767f8SToomas Soome     s" YES" compare-insensitive 0= if
140199767f8SToomas Soome       [char] s addr len + c! len 1+ to len
141199767f8SToomas Soome     then
142199767f8SToomas Soome  else
143199767f8SToomas Soome    drop
144199767f8SToomas Soome  then
145199767f8SToomas Soome  s" boot_verbose" getenv dup -1 <> if
146199767f8SToomas Soome     s" YES" compare-insensitive 0= if
147199767f8SToomas Soome       [char] v addr len + c! len 1+ to len
148199767f8SToomas Soome     then
149199767f8SToomas Soome  else
150199767f8SToomas Soome    drop
151199767f8SToomas Soome  then
152199767f8SToomas Soome  s" boot_kmdb" getenv dup -1 <> if
153199767f8SToomas Soome     s" YES" compare-insensitive 0= if
154199767f8SToomas Soome       [char] k addr len + c! len 1+ to len
155199767f8SToomas Soome     then
156199767f8SToomas Soome  else
157199767f8SToomas Soome    drop
158199767f8SToomas Soome  then
159c3e6a6edSJohn Levon  s" boot_drop_into_kmdb" getenv dup -1 <> if
160199767f8SToomas Soome     s" YES" compare-insensitive 0= if
161199767f8SToomas Soome       [char] d addr len + c! len 1+ to len
162199767f8SToomas Soome     then
163199767f8SToomas Soome  else
164199767f8SToomas Soome    drop
165199767f8SToomas Soome  then
166199767f8SToomas Soome  s" boot_reconfigure" getenv dup -1 <> if
167199767f8SToomas Soome     s" YES" compare-insensitive 0= if
168199767f8SToomas Soome       [char] r addr len + c! len 1+ to len
169199767f8SToomas Soome     then
170199767f8SToomas Soome  else
171199767f8SToomas Soome    drop
172199767f8SToomas Soome  then
173199767f8SToomas Soome  s" boot_ask" getenv dup -1 <> if
174199767f8SToomas Soome     s" YES" compare-insensitive 0= if
175199767f8SToomas Soome       [char] a addr len + c! len 1+ to len
176199767f8SToomas Soome     then
177199767f8SToomas Soome  else
178199767f8SToomas Soome    drop
179199767f8SToomas Soome  then
180199767f8SToomas Soome
181199767f8SToomas Soome  \ now add remining boot args if blen != 0.
182199767f8SToomas Soome  \ baddr[0] is '-', if baddr[1] != 'B' append to addr,
183199767f8SToomas Soome  \ otherwise add space then copy
184199767f8SToomas Soome  blen 0<> if
185199767f8SToomas Soome    baddr 1+ c@ [char] B = if
186199767f8SToomas Soome      addr len + 1- c@ [char] - = if	 \ if addr[len -1] == '-'
187199767f8SToomas Soome	baddr 1+ to baddr
188199767f8SToomas Soome	blen 1- to blen
189199767f8SToomas Soome      else
190199767f8SToomas Soome	bl addr len + c! len 1+ to len
191199767f8SToomas Soome      then
192199767f8SToomas Soome    else
193199767f8SToomas Soome      baddr 1+ to baddr
194199767f8SToomas Soome      blen 1- to blen
195199767f8SToomas Soome    then
196199767f8SToomas Soome    baddr addr len + blen move
197199767f8SToomas Soome    len blen + to len
198199767f8SToomas Soome    0 to baddr
199199767f8SToomas Soome    0 to blen
200199767f8SToomas Soome  then
201199767f8SToomas Soome  \ last part - add acpi.
202199767f8SToomas Soome  alen 0<> if
203199767f8SToomas Soome    addr len + 1- c@ [char] - <> if
204199767f8SToomas Soome      bl addr len + c! len 1+ to len
205199767f8SToomas Soome      [char] - addr len + c! len 1+ to len
206199767f8SToomas Soome    then
207199767f8SToomas Soome    s" B acpi-user-options=" dup -rot		( len addr len )
208199767f8SToomas Soome    addr len + swap move			( len )
209199767f8SToomas Soome    len + to len
210199767f8SToomas Soome    aaddr addr len + alen move
211199767f8SToomas Soome    len alen + to len
212199767f8SToomas Soome  then
213199767f8SToomas Soome
214199767f8SToomas Soome  \ check for left over '-'
215199767f8SToomas Soome  addr len 1- + c@ [char] - = if
216199767f8SToomas Soome    len 1- to len
217199767f8SToomas Soome				\ but now we may also have left over ' '
218199767f8SToomas Soome    len if ( len <> 0 )
219199767f8SToomas Soome      addr len 1- + c@ bl = if
220199767f8SToomas Soome	len 1- to len
221199767f8SToomas Soome      then
222199767f8SToomas Soome    then
223199767f8SToomas Soome  then
224199767f8SToomas Soome
225199767f8SToomas Soome  \ if len != 0, set boot-args
226199767f8SToomas Soome  len 0<> if
227199767f8SToomas Soome    addr len s" boot-args" setenv
228199767f8SToomas Soome  then
229199767f8SToomas Soome  addr free drop
230199767f8SToomas Soome;
231199767f8SToomas Soome
232199767f8SToomas Soome: boot
233199767f8SToomas Soome  0= if ( interpreted ) get_arguments then
234199767f8SToomas Soome  set-boot-args
235199767f8SToomas Soome
236199767f8SToomas Soome  \ Unload only if a path was passed. Paths start with /
237199767f8SToomas Soome  dup if
238199767f8SToomas Soome    >r over r> swap
239199767f8SToomas Soome    c@ [char] / = if
240199767f8SToomas Soome      0 1 unload drop
241199767f8SToomas Soome    else
242199767f8SToomas Soome      s" kernelname" getenv? if ( a kernel has been loaded )
243199767f8SToomas Soome        try-menu-unset
244199767f8SToomas Soome        bootmsg 1 boot exit
245199767f8SToomas Soome      then
246199767f8SToomas Soome      load_kernel_and_modules
247199767f8SToomas Soome      ?dup if exit then
248199767f8SToomas Soome      try-menu-unset
249199767f8SToomas Soome      bootmsg 0 1 boot exit
250199767f8SToomas Soome    then
251199767f8SToomas Soome  else
252199767f8SToomas Soome    s" kernelname" getenv? if ( a kernel has been loaded )
253199767f8SToomas Soome      try-menu-unset
254199767f8SToomas Soome      bootmsg 1 boot exit
255199767f8SToomas Soome    then
256199767f8SToomas Soome    load_kernel_and_modules
257199767f8SToomas Soome    ?dup if exit then
258199767f8SToomas Soome    try-menu-unset
259199767f8SToomas Soome    bootmsg 0 1 boot exit
260199767f8SToomas Soome  then
261199767f8SToomas Soome  load_kernel_and_modules
262199767f8SToomas Soome  ?dup 0= if bootmsg 0 1 boot then
263199767f8SToomas Soome;
264199767f8SToomas Soome
265199767f8SToomas Soome\ ***** boot-conf
266199767f8SToomas Soome\
267199767f8SToomas Soome\	Prepares to boot as specified by loaded configuration files.
268199767f8SToomas Soome
269199767f8SToomas Soome: boot-conf
270199767f8SToomas Soome  0= if ( interpreted ) get_arguments then
271199767f8SToomas Soome  0 1 unload drop
272199767f8SToomas Soome  load_kernel_and_modules
273199767f8SToomas Soome  ?dup 0= if 0 1 autoboot then
274199767f8SToomas Soome;
275199767f8SToomas Soome
276199767f8SToomas Soomealso forth definitions previous
277199767f8SToomas Soome
278199767f8SToomas Soomebuiltin: boot
279199767f8SToomas Soomebuiltin: boot-conf
280199767f8SToomas Soome
281199767f8SToomas Soomeonly forth definitions also support-functions
282199767f8SToomas Soome
283a1625066SAndy Fiddaman\
284199767f8SToomas Soome\ in case the boot-args is set, parse it and extract following options:
285199767f8SToomas Soome\ -a to boot_ask=YES
286199767f8SToomas Soome\ -s to boot_single=YES
287199767f8SToomas Soome\ -v to boot_verbose=YES
288199767f8SToomas Soome\ -k to boot_kmdb=YES
289c3e6a6edSJohn Levon\ -d to boot_drop_into_kmdb=YES
290199767f8SToomas Soome\ -r to boot_reconfigure=YES
291199767f8SToomas Soome\ -B acpi-user-options=X to acpi-user-options=X
292a1625066SAndy Fiddaman\
293199767f8SToomas Soome\ This is needed so that the menu can manage these options. Unfortunately, this
2945bdf86e2SToomas Soome\ also means that boot-args will override previously set options, but we have no
2955bdf86e2SToomas Soome\ way to control the processing order here. boot-args will be rebuilt at boot.
296a1625066SAndy Fiddaman\
297199767f8SToomas Soome\ NOTE: The best way to address the order is to *not* set any above options
298199767f8SToomas Soome\ in boot-args.
299199767f8SToomas Soome
300199767f8SToomas Soome: parse-boot-args  { | baddr blen -- }
301199767f8SToomas Soome  s" boot-args" getenv dup -1 = if drop exit then
302199767f8SToomas Soome  to blen
303199767f8SToomas Soome  to baddr
304199767f8SToomas Soome
305199767f8SToomas Soome  baddr blen
306199767f8SToomas Soome
307199767f8SToomas Soome  \ loop over all instances of switch blocks, starting with '-'
308199767f8SToomas Soome  begin
309199767f8SToomas Soome    [char] - strchr
310199767f8SToomas Soome    2dup to blen to baddr
311199767f8SToomas Soome    dup 0<>
312199767f8SToomas Soome  while				( addr len ) \ points to -
313199767f8SToomas Soome    \ block for switch B. keep it on top of the stack for case
314199767f8SToomas Soome    \ the property list will get empty.
315199767f8SToomas Soome
316199767f8SToomas Soome    over 1+ c@ [char] B = if
317199767f8SToomas Soome	2dup			\ save "-B ...." in case options is empty
318199767f8SToomas Soome	2 - swap 2 +		( addr len len-2 addr+2 ) \ skip -B
319199767f8SToomas Soome
320199767f8SToomas Soome      begin			\ skip spaces
321199767f8SToomas Soome        dup c@ bl =
322199767f8SToomas Soome      while
323199767f8SToomas Soome        1+ swap 1- swap
324199767f8SToomas Soome      repeat
325199767f8SToomas Soome
326199767f8SToomas Soome				( addr len len' addr' )
327199767f8SToomas Soome      \ its 3 cases now: end of string, -switch, or option list
328199767f8SToomas Soome
329199767f8SToomas Soome      over 0= if		\ end of string, remove trailing -B
330199767f8SToomas Soome	2drop			( addr len )
331199767f8SToomas Soome	swap 0 swap c!		\ store 0 at -B
332199767f8SToomas Soome	blen swap		( blen len )
333199767f8SToomas Soome	-			( rem )
334199767f8SToomas Soome	baddr swap		( addr rem )
335199767f8SToomas Soome	dup 0= if
336199767f8SToomas Soome	  s" boot-args" unsetenv
337199767f8SToomas Soome	  2drop
338199767f8SToomas Soome	  exit
339199767f8SToomas Soome	then
340199767f8SToomas Soome				\ trailing space(s)
341199767f8SToomas Soome	begin
342199767f8SToomas Soome	  over			( addr rem addr )
343199767f8SToomas Soome	  over + 1-		( addr rem addr+rem-1 )
344199767f8SToomas Soome	  c@ bl =
345199767f8SToomas Soome	while
346199767f8SToomas Soome	  1- swap		( rem-1 addr )
347199767f8SToomas Soome	  over			( rem-1 addr rem-1 )
348199767f8SToomas Soome	  over +		( rem-1 addr addr+rem-1 )
349199767f8SToomas Soome	  0 swap c!
350199767f8SToomas Soome	  swap
351199767f8SToomas Soome	repeat
352199767f8SToomas Soome	s" boot-args" setenv
353199767f8SToomas Soome	recurse			\ restart
354199767f8SToomas Soome	exit
355199767f8SToomas Soome      then
356199767f8SToomas Soome				( addr len len' addr' )
357199767f8SToomas Soome      dup c@ [char] - = if	\ it is switch. set to boot-args
358199767f8SToomas Soome	swap s" boot-args" setenv
359199767f8SToomas Soome	2drop
360199767f8SToomas Soome	recurse			\ restart
361199767f8SToomas Soome	exit
362199767f8SToomas Soome      then
363199767f8SToomas Soome				( addr len len' addr' )
364199767f8SToomas Soome      \ its options string "option1,option2,... -..."
365199767f8SToomas Soome      \ cut acpi-user-options=xxx and restart the parser
366199767f8SToomas Soome      \ or skip to next option block
367199767f8SToomas Soome      begin
368199767f8SToomas Soome	dup c@ dup 0<> swap bl <> and \ stop if space or 0
369199767f8SToomas Soome      while
370199767f8SToomas Soome	dup 18 s" acpi-user-options=" compare 0= if	\ matched
371199767f8SToomas Soome				( addr len len' addr' )
372199767f8SToomas Soome	  \ addr' points to acpi options, find its end [',' or ' ' or 0 ]
373199767f8SToomas Soome	  \ set it as acpi-user-options and move remaining to addr'
374199767f8SToomas Soome	  2dup			( addr len len' addr' len' addr' )
375199767f8SToomas Soome	  \ skip to next option in list
376199767f8SToomas Soome	  \ loop to first , or bl or 0
377199767f8SToomas Soome	  begin
378199767f8SToomas Soome	    dup c@ [char] , <> >r
379199767f8SToomas Soome	    dup c@ bl <> >r
380199767f8SToomas Soome	    dup c@ 0<> r> r> and and
381199767f8SToomas Soome	  while
382199767f8SToomas Soome	    1+ swap 1- swap
383199767f8SToomas Soome	  repeat
384199767f8SToomas Soome				( addr len len' addr' len" addr" )
385a1625066SAndy Fiddaman	  >r >r			( addr len len' addr' R: addr" len" )
386199767f8SToomas Soome	  over r@ -		( addr len len' addr' proplen R: addr" len" )
387199767f8SToomas Soome	  dup 5 +		( addr len len' addr' proplen proplen+5 )
388199767f8SToomas Soome	  allocate abort" out of memory"
389199767f8SToomas Soome
390199767f8SToomas Soome	  0 s" set " strcat	( addr len len' addr' proplen caddr clen )
391199767f8SToomas Soome	  >r >r 2dup r> r> 2swap strcat ( addr len len' addr' proplen caddr clen )
392199767f8SToomas Soome	  2dup + 0 swap c!	\ terminate with 0
393199767f8SToomas Soome	  2dup evaluate drop free drop
394199767f8SToomas Soome				( addr len len' addr' proplen R: addr" len" )
395199767f8SToomas Soome	  \ acpi-user-options is set, now move remaining string to its place.
396199767f8SToomas Soome	  \ addr: -B, addr': acpi... addr": reminder
397199767f8SToomas Soome	  swap			( addr len len' proplen addr' )
398199767f8SToomas Soome	  r> r>			( addr len len' proplen addr' len" addr" )
399199767f8SToomas Soome	  dup c@ [char] , = if
400199767f8SToomas Soome	    \ skip , and move addr" to addr'
401199767f8SToomas Soome	    1+ swap 1-		( addr len len' proplen addr' addr" len" )
402199767f8SToomas Soome	    rot	swap 1+ move	( addr len len' proplen )
403199767f8SToomas Soome	  else	\ its bl or 0	( addr len len' proplen addr' len" addr" )
404199767f8SToomas Soome	    \ for both bl and 0 we need to copy to addr'-1 to remove
405199767f8SToomas Soome	    \ comma, then reset boot-args, and recurse will clear -B
406199767f8SToomas Soome	    \ if there are no properties left.
407199767f8SToomas Soome	    dup c@ 0= if
408199767f8SToomas Soome	      2drop		( addr len len' proplen addr' )
409199767f8SToomas Soome	      1- 0 swap c!	( addr len len' proplen )
410199767f8SToomas Soome	    else
411199767f8SToomas Soome	      >r >r		( addr len len' proplen addr' R: addr" len" )
412199767f8SToomas Soome	      1- swap 1+ swap
413199767f8SToomas Soome	      r> r>		( addr len len' proplen addr' len" addr" )
414199767f8SToomas Soome	      rot rot move	( addr len len' proplen )
415199767f8SToomas Soome	    then
416199767f8SToomas Soome	  then
417199767f8SToomas Soome
418199767f8SToomas Soome	  2swap 2drop		( len' proplen )
419199767f8SToomas Soome	  nip			( proplen )
420199767f8SToomas Soome	  baddr blen rot -
421199767f8SToomas Soome	  s" boot-args" setenv
422199767f8SToomas Soome	  recurse
423199767f8SToomas Soome	  exit
424199767f8SToomas Soome	else
425199767f8SToomas Soome				( addr len len' addr' )
426199767f8SToomas Soome	  \ not acpi option, skip to next option in list
427199767f8SToomas Soome	  \ loop to first , or bl or 0
428199767f8SToomas Soome	  begin
429199767f8SToomas Soome	    dup c@ [char] , <> >r
430199767f8SToomas Soome	    dup c@ bl <> >r
431199767f8SToomas Soome	    dup c@ 0<> r> r> and and
432199767f8SToomas Soome	  while
433199767f8SToomas Soome	    1+ swap 1- swap
434199767f8SToomas Soome	  repeat
435199767f8SToomas Soome	  \ if its ',', skip over
436199767f8SToomas Soome	  dup c@ [char] , = if
437199767f8SToomas Soome	    1+ swap 1- swap
438199767f8SToomas Soome	  then
439199767f8SToomas Soome	then
440199767f8SToomas Soome      repeat
441199767f8SToomas Soome				( addr len len' addr' )
442199767f8SToomas Soome      \ this block is done, remove addr and len from stack
443199767f8SToomas Soome      2swap 2drop swap
444199767f8SToomas Soome    then
445199767f8SToomas Soome
446199767f8SToomas Soome    over c@ [char] - = if	( addr len )
447199767f8SToomas Soome      2dup 1- swap 1+		( addr len len' addr' )
448199767f8SToomas Soome      begin			\ loop till ' ' or 0
449199767f8SToomas Soome	dup c@ dup 0<> swap bl <> and
450199767f8SToomas Soome      while
451199767f8SToomas Soome	dup c@ [char] s = if
452199767f8SToomas Soome	  s" set boot_single=YES" evaluate TRUE
453199767f8SToomas Soome	else dup c@ [char] v = if
454199767f8SToomas Soome	  s" set boot_verbose=YES" evaluate TRUE
455199767f8SToomas Soome	else dup c@ [char] k = if
456199767f8SToomas Soome	  s" set boot_kmdb=YES" evaluate TRUE
457199767f8SToomas Soome	else dup c@ [char] d = if
458c3e6a6edSJohn Levon	  s" set boot_drop_into_kmdb=YES" evaluate TRUE
459199767f8SToomas Soome	else dup c@ [char] r = if
460199767f8SToomas Soome	  s" set boot_reconfigure=YES" evaluate TRUE
461199767f8SToomas Soome	else dup c@ [char] a = if
462199767f8SToomas Soome	  s" set boot_ask=YES" evaluate TRUE
463199767f8SToomas Soome	then then then then then then
464199767f8SToomas Soome	dup TRUE = if
465199767f8SToomas Soome	  drop
466199767f8SToomas Soome	  dup >r		( addr len len' addr' R: addr' )
467199767f8SToomas Soome	  1+ swap 1-		( addr len addr'+1 len'-1 R: addr' )
468199767f8SToomas Soome	  r> swap move		( addr len )
469199767f8SToomas Soome
470199767f8SToomas Soome	  2drop baddr blen 1-
471199767f8SToomas Soome	  \ check if we have space after '-', if so, drop '- '
472199767f8SToomas Soome	  swap dup 1+ c@ bl = if
473199767f8SToomas Soome	      2 + swap 2 -
474199767f8SToomas Soome	  else
475199767f8SToomas Soome	      swap
476199767f8SToomas Soome	  then
477199767f8SToomas Soome	  dup dup 0= swap 1 = or if	\ empty or only '-' is left.
478199767f8SToomas Soome	    2drop
479199767f8SToomas Soome	    s" boot-args" unsetenv
480199767f8SToomas Soome	    exit
481199767f8SToomas Soome	  else
482199767f8SToomas Soome	    s" boot-args" setenv
483199767f8SToomas Soome	  then
484199767f8SToomas Soome	  recurse
485199767f8SToomas Soome	  exit
486199767f8SToomas Soome	then
487199767f8SToomas Soome	1+ swap 1- swap
488199767f8SToomas Soome      repeat
489199767f8SToomas Soome
490199767f8SToomas Soome      2swap 2drop
491199767f8SToomas Soome      dup c@ 0= if		\ end of string
492199767f8SToomas Soome	2drop
493199767f8SToomas Soome	exit
494199767f8SToomas Soome      else
495199767f8SToomas Soome	swap
496199767f8SToomas Soome      then
497199767f8SToomas Soome    then
498199767f8SToomas Soome  repeat
499199767f8SToomas Soome
500199767f8SToomas Soome  2drop
501199767f8SToomas Soome;
502199767f8SToomas Soome
503199767f8SToomas Soome\ ***** start
504199767f8SToomas Soome\
505199767f8SToomas Soome\       Initializes support.4th global variables, sets loader_conf_files,
506288c4f44SToomas Soome\       processes conf files, and, if any one such file was successfully
507199767f8SToomas Soome\       read to the end, loads kernel and modules.
508199767f8SToomas Soome
509199767f8SToomas Soome: start  ( -- ) ( throws: abort & user-defined )
510199767f8SToomas Soome  s" /boot/defaults/loader.conf" initialize
511199767f8SToomas Soome  include_bootenv
512199767f8SToomas Soome  include_conf_files
513199767f8SToomas Soome  include_transient
514231d7891SToomas Soome  \ If the user defined a post-initialize hook, call it now
515231d7891SToomas Soome  s" post-initialize" sfind if execute else drop then
516199767f8SToomas Soome  parse-boot-args
517199767f8SToomas Soome  \ Will *NOT* try to load kernel and modules if no configuration file
518288c4f44SToomas Soome  \ was successfully loaded!
519199767f8SToomas Soome  any_conf_read? if
520199767f8SToomas Soome    s" loader_delay" getenv -1 = if
521199767f8SToomas Soome      load_xen_throw
522199767f8SToomas Soome      load_kernel
523199767f8SToomas Soome      load_modules
524199767f8SToomas Soome    else
525199767f8SToomas Soome      drop
526199767f8SToomas Soome      ." Loading Kernel and Modules (Ctrl-C to Abort)" cr
527199767f8SToomas Soome      s" also support-functions" evaluate
528199767f8SToomas Soome      s" set delay_command='load_xen_throw load_kernel load_modules'" evaluate
529199767f8SToomas Soome      s" set delay_showdots" evaluate
530199767f8SToomas Soome      delay_execute
531199767f8SToomas Soome    then
532199767f8SToomas Soome  then
533199767f8SToomas Soome;
534199767f8SToomas Soome
535199767f8SToomas Soome\ ***** initialize
536199767f8SToomas Soome\
537199767f8SToomas Soome\	Overrides support.4th initialization word with one that does
538199767f8SToomas Soome\	everything start one does, short of loading the kernel and
539231d7891SToomas Soome\	modules. Returns a flag.
540199767f8SToomas Soome
541199767f8SToomas Soome: initialize ( -- flag )
542199767f8SToomas Soome  s" /boot/defaults/loader.conf" initialize
543199767f8SToomas Soome  include_bootenv
544199767f8SToomas Soome  include_conf_files
545199767f8SToomas Soome  include_transient
546231d7891SToomas Soome  \ If the user defined a post-initialize hook, call it now
547231d7891SToomas Soome  s" post-initialize" sfind if execute else drop then
548199767f8SToomas Soome  parse-boot-args
549199767f8SToomas Soome  any_conf_read?
550199767f8SToomas Soome;
551199767f8SToomas Soome
552199767f8SToomas Soome\ ***** read-conf
553199767f8SToomas Soome\
554199767f8SToomas Soome\	Read a configuration file, whose name was specified on the command
555199767f8SToomas Soome\	line, if interpreted, or given on the stack, if compiled in.
556199767f8SToomas Soome
557199767f8SToomas Soome: (read-conf)  ( addr len -- )
558199767f8SToomas Soome  conf_files string=
559199767f8SToomas Soome  include_conf_files \ Will recurse on new loader_conf_files definitions
560199767f8SToomas Soome;
561199767f8SToomas Soome
562199767f8SToomas Soome: read-conf  ( <filename> | addr len -- ) ( throws: abort & user-defined )
563199767f8SToomas Soome  state @ if
564199767f8SToomas Soome    \ Compiling
565199767f8SToomas Soome    postpone (read-conf)
566199767f8SToomas Soome  else
567199767f8SToomas Soome    \ Interpreting
568199767f8SToomas Soome    bl parse (read-conf)
569199767f8SToomas Soome  then
570199767f8SToomas Soome; immediate
571199767f8SToomas Soome
572199767f8SToomas Soome\ show, enable, disable, toggle module loading. They all take module from
573199767f8SToomas Soome\ the next word
574199767f8SToomas Soome
575199767f8SToomas Soome: set-module-flag ( module_addr val -- ) \ set and print flag
576199767f8SToomas Soome  over module.flag !
577199767f8SToomas Soome  dup module.name strtype
578199767f8SToomas Soome  module.flag @ if ."  will be loaded" else ."  will not be loaded" then cr
579199767f8SToomas Soome;
580199767f8SToomas Soome
581199767f8SToomas Soome: enable-module find-module ?dup if true set-module-flag then ;
582199767f8SToomas Soome
583199767f8SToomas Soome: disable-module find-module ?dup if false set-module-flag then ;
584199767f8SToomas Soome
585199767f8SToomas Soome: toggle-module find-module ?dup if dup module.flag @ 0= set-module-flag then ;
586199767f8SToomas Soome
587199767f8SToomas Soome\ ***** show-module
588199767f8SToomas Soome\
589199767f8SToomas Soome\	Show loading information about a module.
590199767f8SToomas Soome
591199767f8SToomas Soome: show-module ( <module> -- ) find-module ?dup if show-one-module then ;
592199767f8SToomas Soome
593f2aacf29SToomas Soome: set-module-path ( addr len <module> -- )
594f2aacf29SToomas Soome  find-module ?dup if
595f2aacf29SToomas Soome    module.loadname string=
596f2aacf29SToomas Soome  then
597f2aacf29SToomas Soome;
598f2aacf29SToomas Soome
599199767f8SToomas Soome\ Words to be used inside configuration files
600199767f8SToomas Soome
601199767f8SToomas Soome: retry false ;         \ For use in load error commands
602199767f8SToomas Soome: ignore true ;         \ For use in load error commands
603199767f8SToomas Soome
604199767f8SToomas Soome\ Return to strict forth vocabulary
605199767f8SToomas Soome
606199767f8SToomas Soome: #type
607199767f8SToomas Soome  over - >r
608199767f8SToomas Soome  type
609199767f8SToomas Soome  r> spaces
610199767f8SToomas Soome;
611199767f8SToomas Soome
612199767f8SToomas Soome: .? 2 spaces 2swap 15 #type 2 spaces type cr ;
613199767f8SToomas Soome
614199767f8SToomas Soome: ?
615199767f8SToomas Soome  ['] ? execute
616199767f8SToomas Soome  s" boot-conf" s" load kernel and modules, then autoboot" .?
617199767f8SToomas Soome  s" read-conf" s" read a configuration file" .?
618199767f8SToomas Soome  s" enable-module" s" enable loading of a module" .?
619199767f8SToomas Soome  s" disable-module" s" disable loading of a module" .?
620199767f8SToomas Soome  s" toggle-module" s" toggle loading of a module" .?
621199767f8SToomas Soome  s" show-module" s" show module load data" .?
622199767f8SToomas Soome  s" try-include" s" try to load/interpret files" .?
623199767f8SToomas Soome  s" beadm" s" list or activate Boot Environments" .?
624199767f8SToomas Soome;
625199767f8SToomas Soome
626199767f8SToomas Soome: try-include ( -- ) \ see loader.4th(8)
627199767f8SToomas Soome  ['] include ( -- xt ) \ get the execution token of `include'
628199767f8SToomas Soome  catch ( xt -- exception# | 0 ) if \ failed
629199767f8SToomas Soome    LF parse ( c -- s-addr/u ) 2drop \ advance >in to EOL (drop data)
630199767f8SToomas Soome    \ ... prevents words unused by `include' from being interpreted
631199767f8SToomas Soome  then
632199767f8SToomas Soome; immediate \ interpret immediately for access to `source' (aka tib)
633199767f8SToomas Soome
634199767f8SToomas Soomeinclude /boot/forth/beadm.4th
635199767f8SToomas Soomeonly forth definitions