[OpenSPARC-T2-SAM] / obp / obp / pkg / boot / bootparm.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: bootparm.fth
\ 
\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
\ 
\  - Do no alter or remove copyright notices
\ 
\  - Redistribution and use of this software in source and binary forms, with 
\    or without modification, are permitted provided that the following 
\    conditions are met: 
\ 
\  - Redistribution of source code must retain the above copyright notice, 
\    this list of conditions and the following disclaimer.
\ 
\  - Redistribution in binary form must reproduce the above copyright notice,
\    this list of conditions and the following disclaimer in the
\    documentation and/or other materials provided with the distribution. 
\ 
\    Neither the name of Sun Microsystems, Inc. or the names of contributors 
\ may be used to endorse or promote products derived from this software 
\ without specific prior written permission. 
\ 
\     This software is provided "AS IS," without a warranty of any kind. 
\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES, 
\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A 
\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN 
\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR 
\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR 
\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN 
\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR 
\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE 
\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY, 
\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF 
\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
\ 
\ You acknowledge that this software is not designed, licensed or
\ intended for use in the design, construction, operation or maintenance of
\ any nuclear facility. 
\ 
\ ========== Copyright Header End ============================================
id: @(#)bootparm.fth 3.42 07/06/22
purpose: Implements the boot command - parses arguments, etc.
copyright: Copyright 2007 Sun Microsystems, Inc.  All rights reserved.
copyright: Use is subject to license terms.

\ Forth support for the booting process

\ Booting entries:
\ a) User types  "boot ....."
\ b) The client program invokes the "reboot" client interface service
\
\ We need a flag indicating whether or not to reset the machine.
\

headers

headerless
true	value		init-incomplete? \ TRUE until probe/init complete
defer config-load-base ' load-base to config-load-base
headers
default-load-base value load-base
warning @ warning off
\ duplicate definition in fm/kernel/readline.fth
variable file-size
warning !
headerless
: init-load-base ( -- )  config-load-base to load-base  ;

headers
d# 256 buffer: path-buf   ' path-buf  " bootpath" chosen-string
d# 128 buffer: args-buf   ' args-buf  " bootargs" chosen-string
headerless

\ test the status property of the device ihandle passed in.
\ if status property does not exist, it is assumed to be "okay"
\ if status property exists, and is "okay", return true.
\ if status property exists and is not "okay", return false.

: device-status-ok? ( phandle -- flag )
   " status" rot get-package-property 0= if     \ if property exists
      decode-string 2swap 2drop                 ( str len )
      " okay" $= 0= if                          \ status property is not "okay"
         false exit                             ( flag )
      then                                      \ status property is "okay"
   then                                         ( )
   true                                         ( flag )
;

\ A defer word is used in case a platform wants to take some
\ action (like updating signature) after certain boot failures.

\ Hook executed if there is trouble accessing the device
defer boot-read-fail-hook   ( -- ) ' noop is boot-read-fail-hook

\ Hook executed if device node for specified path is not found
defer boot-locate-fail-hook ( -- )

\ Platforms may handle boot-locate-fail-hook in the same way as
\ boot-read-fail-hook. This is the default behaviour assigned to
\ boot-locate-fail-hook. Other platforms can assign platform specific
\ action to boot-locate-fail-hook in platform specific code.
' boot-read-fail-hook is boot-locate-fail-hook

\ Hook executed at the entry of boot-read
defer boot-read-hook        ( -- ) ' noop is boot-read-hook

\ Hook executed if the device specified in default device list
\ (boot-device or diag-device) cannot be opened for operation
defer default-device-hook   ( -- ) ' noop is default-device-hook

: boot-read  ( adr len -- )
   boot-read-hook                               ( adr len )
   2dup locate-device                           ( adr,len phandle false | adr,len true )
   if                                           ( adr,len phandle | adr,len )
      boot-locate-fail-hook                     ( adr,len )
      true abort" "r"nCan't locate boot device"r"n"
   then                                         ( adr,len phandle )
   device-status-ok? 0=                         ( adr,len flag )
   if                                           ( adr,len )
      boot-read-fail-hook                        ( adr,len )
      true abort" "r"nCan't boot from device: 'status' property NOT ""okay"""r"n"
   then                                         ( adr,len )
   open-dev  ( fileid | 0 )  ?dup  0=  if
      boot-read-fail-hook
      ( print-probe-list )
      true abort" "r"nCan't open boot device"r"n"
   then                                         ( fileid )
   true to already-go?
   dup ihandle>devname path-buf place-cstr drop ( fileid )

   >r                                           ( )
   file-size off  load-base                     ( load-adr )
   " load" r@  ['] $call-method  catch  if      ( load-adr adr len fid )
      boot-read-fail-hook                       ( load-adr adr len fid )
      2drop 2drop  r> close-dev                 ( )
      true abort" "r"nBoot load failed"r"n"     ( )
   then                                         ( file-size )
   file-size !                                  ( )
   r> close-dev                                 ( )
;

: (default-device)  ( -- $devname )
[ifndef] SUN4V
   diagnostic-mode?  if  diag-device  else  boot-device  then
[else]
   boot-device
[then]

   strip-blanks                       ( devnames$ )
   begin                              ( devnames$ )
      bl left-parse-string            ( right$ left$ )
      2swap strip-blanks  dup >r      ( left$ right$ ) ( r: right-len )
      2swap strip-blanks              ( right$ left$ )
      r>                              ( right$ left$ right-len )
   while                              ( right$ left$ )
      2dup locate-device 0= if        ( right$ left$ phandle )
         device-status-ok? if         ( right$ left$ )
            2dup open-dev ?dup  if    ( right$ left$ ihandle )
               close-dev 2swap 2drop exit ( left$ )
            else
	       default-device-hook    ( right$ left$ )
            then                      ( right$ left$ )
         then                         ( right$ left$ )
      then                            ( right$ left$ )
      2drop                           ( right$ )
   repeat                             ( right$ )
   2swap 2drop                        ( devname$ )
   strip-blanks                       ( devname$ )
;
defer default-device
' (default-device) to default-device

: default-file  ( -- file&args$ )
[ifndef] SUN4V
   diagnostic-mode?  if  diag-file  else  boot-file  then
[else]
   boot-file
[then]
   strip-blanks
;

\ Gets the boot command line, either user-specified or default.
: parse-boot-command  ( cmd-str -- file-str device-str )
   -leading            \ Skip leading blanks   ( cmd-str )

   ?dup 0=  if
      \ Whole thing is null; use default file and default device
      drop  default-file  default-device  exit
   then					( cmd-str )

   2dup  bl left-parse-string           ( cmd-str rem-str 1st-str )

   \ We know that 1st-str is not null because we have already checked
   \ for the entire string = null

   over c@  ascii /  =  if              ( cmd-str rem-str 1st-str )
      \ Explicit pathname in first word; use it as the device and the
      \ rest of the command line as the file
      2rot 2drop                        ( file-str device-str )
   else                                 ( cmd-str rem-str 1st-str )
      aliased?  if                      ( cmd-str rem-str alias$ )
         \ First word is alias; expand it as the device and use the
	 \ rest of the command line as the file.
         2rot 2drop                     ( file-str device-str )
      else                              ( cmd-str rem-str 1st-str )
         \ First word is neither a path nor an alias; use the default
	 \ device as the device and the entire command line as the file.
         2drop 2drop                    ( file-str )
         default-device  ?expand-alias  ( file-str device-str )
      then
   then                                 ( file-str device-str )

   2 pick  0=  if
      \ No file name given; use the default file instead
      2swap 2drop  default-file 2swap
   then                                 ( file-str device-str )

   2swap -leading  2swap -leading       ( file-str device-str )
;


headerless
create boot-file-not-found ," The attempt to a load a boot image failed."

headerless
\ Loads the file specified by the boot command line string at adr,len
: $boot-read  ( cmd-str -- )
   parse-boot-command                         ( file-str device-str )

   min+mode? if                               ( file-str device-str )
      ." Boot device: "  2dup type            ( file-str device-str )
      ."   File and args: " 2over type cr     ( file-str device-str )
   then

   2swap args-buf  place-cstr drop	      ( device-str )

   boot-read                                  ( )
;

: boot-getline  \ command line  ( -- adr len )
   -1 parse  -trailing  ( adr len )
;

: $append  ( adr len buf -- )
   \ Insert a space to separate the strings if both are non-empty
   >r dup 0<>					( adr len 0? )
   r@  c@ 0<> and  if  "  " r@ $cat  then	( adr len )
   r>  $cat					( sdr len )
;

\ $restart never returns to its caller.  It resets the machine, leaving
\ hints in a system-dependent "safe" location so that the system will reboot
\ itself with the specified string.

defer restart-hook ( -- )  ' noop is restart-hook

: $restart  ( tail$ mid$ head$ -- )

   restart-hook                         ( tail$ mid$ head$ )

   "temp >r				( tail$ mid$ head$ )
   r@ place				( mid$ tail$ )
   r@ $append				( mid$ )
   r@ $append				( -- )
   r> count				( adr len )

   stdout-line# stdout-column#
   save-reboot-info                         (  )
   reset-all
;

\ The defer word can be used by platforms to take some action
\ such as updating the domain signature.
defer $reboot-hook ( -- ) ' noop is $reboot-hook 
: $reboot  ( arg$ dev$ -- )  $reboot-hook " boot"  $restart  ;

: reboot-same  ( -- )  args-buf cscount  path-buf cscount  $reboot  ;

: ?boot-password  ( adr len -- adr len )
   ?secure  security-mode  case                  ( adr len )
      1  of  dup 0<>    endof   \ Need password only for non-default boot
      2  of  true       endof   \ Always need password
      ( default ) false  swap   \ Don't need password
   endcase                                       ( adr len password-needed? )
   if  password-okay?  0=  if  quit  then  then  ( adr len )
;

\ The defer word can be used by platforms to take some action
\ such as updating the domain signature.
defer $boot-load-hook  ( -- )  ' noop is $boot-load-hook
: $boot-load  ( cmd-str -- )
   ?boot-password                     ( cmd-str )
   state-valid off  restartable? off  ( cmd-str )
   cleanup                            ( cmd-str )
   $boot-load-hook
   init-load-base $boot-read          (  )
;

create not-executable ," The file just loaded does not appear to be executable."

headers
: $load  ( adr len -- )
   already-go? if  null$ $reboot  then  $boot-load
;
: ?go  ( -- )
   ?secure  restartable? @  if  go exit  then
   load-base  file-size @ ?dup  if  'execute-buffer  execute  else  drop  then
;

\ Defer words are used in case a platform wants to take some action
\ (like updating signature) at certain points in the boot process.
defer $boot-hook  ( -- )  ' noop is $boot-hook
defer $boot-failed-hook  ( -- )  ' noop is $boot-failed-hook
: $boot ( adr,len -- )
   $load $boot-hook ?go $boot-failed-hook not-executable throw
;

\ Reads the first level boot file, but doesn't jump to it.
: load  \ boot-spec  ( -- )
   boot-getline  $boot-load
;

headerless
: (bootable?) ( comment$ -- )
   init-incomplete? if			\ Did probe/init run to completion?
      cmn-fatal[
      " OpenBoot initialization sequence prematurely terminated."
      ]cmn-end				\ Tell user bad news
      false to init-incomplete?		\ Only issue this message once
   then
   system-fatal-state? if
      " FATAL: system is not bootable" "temp >r r@ pack ( pstr )
      $cat  r> count set-abort-message			( )
      -2 throw						( )
   else
      2drop
   then
;
headers

\ Reads and executes the first level boot file; executed by the user
: boot  \ boot-spec  ( -- )
   " , boot command is disabled" (bootable?)
   boot-getline  $boot
;

warning @ warning off
alias go ?go
warning !

headerless

: safe-evaluate  ( adr len -- )
   ['] evaluate  catch  ?dup  if  nip nip .error  then
;
: do-auto-boot ( -- )
   auto-boot?  if
      " , auto-boot is disabled" (bootable?)
      interrupt-auto-boot? if
         ." Aborting auto-boot sequence." cr
      else
         boot-command  safe-evaluate             \ Go ahead and try to auto-boot
      then
   then
;

\ do-reboot attempts to boot using the parameters that were saved in 
\ reboot info area
: do-reboot ( -- )
   " , reboot is disabled" (bootable?)

   get-reboot-info    ( bootcmd$ line# column# )

   \  Cursor position is restored in fwritestr.fth
   2drop                                    ( bootcmd$ )

[ifndef] SUN4V
\ Suppress "Rebooting" message since for LDOMs, halt from Solaris to OpenBoot
\ involves execution of "reboot-command" LDOM variable 
   min+mode? if                             ( bootcmd$ )
      ." Rebooting with command: " 2dup type cr  ( bootcmd$ )
   then                                     ( bootcmd$ )
[then]

   safe-evaluate  exit
;

\ if auto-boot executes after a reset resulting from a reboot, do-reboot
\ is executed, otherwise, do-auto-boot is executed.
: auto-boot  ( -- )
   reboot? if
      do-reboot			(  )
   else
      " boot-" do-drop-in	(  )
      do-auto-boot		(  )
      " boot+" do-drop-in	(  )
   then
;

headers
cif: boot     ( cstr -- )  cscount  null$ reclaim-machine $reboot  ;
cif: restart  ( cstr -- )  cscount  null$ null$  reclaim-machine $restart  ;
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: bootparm.fth
	4	\
	5	\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
	6	\
	7	\ - Do no alter or remove copyright notices
	8	\
	9	\ - Redistribution and use of this software in source and binary forms, with
	10	\ or without modification, are permitted provided that the following
	11	\ conditions are met:
	12	\
	13	\ - Redistribution of source code must retain the above copyright notice,
	14	\ this list of conditions and the following disclaimer.
	15	\
	16	\ - Redistribution in binary form must reproduce the above copyright notice,
	17	\ this list of conditions and the following disclaimer in the
	18	\ documentation and/or other materials provided with the distribution.
	19	\
	20	\ Neither the name of Sun Microsystems, Inc. or the names of contributors
	21	\ may be used to endorse or promote products derived from this software
	22	\ without specific prior written permission.
	23	\
	24	\ This software is provided "AS IS," without a warranty of any kind.
	25	\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES,
	26	\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A
	27	\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN
	28	\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR
	29	\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR
	30	\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN
	31	\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR
	32	\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE
	33	\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY,
	34	\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF
	35	\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
	36	\
	37	\ You acknowledge that this software is not designed, licensed or
	38	\ intended for use in the design, construction, operation or maintenance of
	39	\ any nuclear facility.
	40	\
	41	\ ========== Copyright Header End ============================================
	42	id: @(#)bootparm.fth 3.42 07/06/22
	43	purpose: Implements the boot command - parses arguments, etc.
	44	copyright: Copyright 2007 Sun Microsystems, Inc. All rights reserved.
	45	copyright: Use is subject to license terms.
	46
	47	\ Forth support for the booting process
	48
	49	\ Booting entries:
	50	\ a) User types "boot ....."
	51	\ b) The client program invokes the "reboot" client interface service
	52	\
	53	\ We need a flag indicating whether or not to reset the machine.
	54	\
	55
	56	headers
	57
	58	headerless
	59	true value init-incomplete? \ TRUE until probe/init complete
	60	defer config-load-base ' load-base to config-load-base
	61	headers
	62	default-load-base value load-base
	63	warning @ warning off
	64	\ duplicate definition in fm/kernel/readline.fth
65	variable file-size
66	warning !
67	headerless
68	: init-load-base ( -- ) config-load-base to load-base ;
69
70	headers
71	d# 256 buffer: path-buf ' path-buf " bootpath" chosen-string
72	d# 128 buffer: args-buf ' args-buf " bootargs" chosen-string
73	headerless
74
75	\ test the status property of the device ihandle passed in.
76	\ if status property does not exist, it is assumed to be "okay"
77	\ if status property exists, and is "okay", return true.
78	\ if status property exists and is not "okay", return false.
79
80	: device-status-ok? ( phandle -- flag )
81	" status" rot get-package-property 0= if \ if property exists
82	decode-string 2swap 2drop ( str len )
83	" okay" $= 0= if \ status property is not "okay"
84	false exit ( flag )
85	then \ status property is "okay"
86	then ( )
87	true ( flag )
88	;
89
90	\ A defer word is used in case a platform wants to take some
91	\ action (like updating signature) after certain boot failures.
92
93	\ Hook executed if there is trouble accessing the device
94	defer boot-read-fail-hook ( -- ) ' noop is boot-read-fail-hook
95
96	\ Hook executed if device node for specified path is not found
97	defer boot-locate-fail-hook ( -- )
98
99	\ Platforms may handle boot-locate-fail-hook in the same way as
100	\ boot-read-fail-hook. This is the default behaviour assigned to
101	\ boot-locate-fail-hook. Other platforms can assign platform specific
102	\ action to boot-locate-fail-hook in platform specific code.
103	' boot-read-fail-hook is boot-locate-fail-hook
104
105	\ Hook executed at the entry of boot-read
106	defer boot-read-hook ( -- ) ' noop is boot-read-hook
107
108	\ Hook executed if the device specified in default device list
109	\ (boot-device or diag-device) cannot be opened for operation
110	defer default-device-hook ( -- ) ' noop is default-device-hook
111
112	: boot-read ( adr len -- )
113	boot-read-hook ( adr len )
114	2dup locate-device ( adr,len phandle false \| adr,len true )
115	if ( adr,len phandle \| adr,len )
116	boot-locate-fail-hook ( adr,len )
117	true abort" "r"nCan't locate boot device"r"n"
118	then ( adr,len phandle )
119	device-status-ok? 0= ( adr,len flag )
120	if ( adr,len )
121	boot-read-fail-hook ( adr,len )
122	true abort" "r"nCan't boot from device: 'status' property NOT ""okay"""r"n"
123	then ( adr,len )
124	open-dev ( fileid \| 0 ) ?dup 0= if
125	boot-read-fail-hook
126	( print-probe-list )
127	true abort" "r"nCan't open boot device"r"n"
128	then ( fileid )
129	true to already-go?
130	dup ihandle>devname path-buf place-cstr drop ( fileid )
131
132	>r ( )
133	file-size off load-base ( load-adr )
134	" load" r@ ['] $call-method catch if ( load-adr adr len fid )
135	boot-read-fail-hook ( load-adr adr len fid )
136	2drop 2drop r> close-dev ( )
137	true abort" "r"nBoot load failed"r"n" ( )
138	then ( file-size )
139	file-size ! ( )
140	r> close-dev ( )
141	;
142
143	: (default-device) ( -- $devname )
144	[ifndef] SUN4V
145	diagnostic-mode? if diag-device else boot-device then
146	[else]
147	boot-device
148	[then]
149
150	strip-blanks ( devnames$ )
151	begin ( devnames$ )
152	bl left-parse-string ( right$ left$ )
153	2swap strip-blanks dup >r ( left$ right$ ) ( r: right-len )
154	2swap strip-blanks ( right$ left$ )
155	r> ( right$ left$ right-len )
156	while ( right$ left$ )
157	2dup locate-device 0= if ( right$ left$ phandle )
158	device-status-ok? if ( right$ left$ )
159	2dup open-dev ?dup if ( right$ left$ ihandle )
160	close-dev 2swap 2drop exit ( left$ )
161	else
162	default-device-hook ( right$ left$ )
163	then ( right$ left$ )
164	then ( right$ left$ )
165	then ( right$ left$ )
166	2drop ( right$ )
167	repeat ( right$ )
168	2swap 2drop ( devname$ )
169	strip-blanks ( devname$ )
170	;
171	defer default-device
172	' (default-device) to default-device
173
174	: default-file ( -- file&args$ )
175	[ifndef] SUN4V
176	diagnostic-mode? if diag-file else boot-file then
177	[else]
178	boot-file
179	[then]
180	strip-blanks
181	;
182
183	\ Gets the boot command line, either user-specified or default.
184	: parse-boot-command ( cmd-str -- file-str device-str )
185	-leading \ Skip leading blanks ( cmd-str )
186
187	?dup 0= if
188	\ Whole thing is null; use default file and default device
189	drop default-file default-device exit
190	then ( cmd-str )
191
192	2dup bl left-parse-string ( cmd-str rem-str 1st-str )
193
194	\ We know that 1st-str is not null because we have already checked
195	\ for the entire string = null
196
197	over c@ ascii / = if ( cmd-str rem-str 1st-str )
198	\ Explicit pathname in first word; use it as the device and the
199	\ rest of the command line as the file
200	2rot 2drop ( file-str device-str )
201	else ( cmd-str rem-str 1st-str )
202	aliased? if ( cmd-str rem-str alias$ )
203	\ First word is alias; expand it as the device and use the
204	\ rest of the command line as the file.
205	2rot 2drop ( file-str device-str )
206	else ( cmd-str rem-str 1st-str )
207	\ First word is neither a path nor an alias; use the default
208	\ device as the device and the entire command line as the file.
209	2drop 2drop ( file-str )
210	default-device ?expand-alias ( file-str device-str )
211	then
212	then ( file-str device-str )
213
214	2 pick 0= if
215	\ No file name given; use the default file instead
216	2swap 2drop default-file 2swap
217	then ( file-str device-str )
218
219	2swap -leading 2swap -leading ( file-str device-str )
220	;
221
222
223	headerless
224	create boot-file-not-found ," The attempt to a load a boot image failed."
225
226	headerless
227	\ Loads the file specified by the boot command line string at adr,len
228	: $boot-read ( cmd-str -- )
229	parse-boot-command ( file-str device-str )
230
231	min+mode? if ( file-str device-str )
232	." Boot device: " 2dup type ( file-str device-str )
233	." File and args: " 2over type cr ( file-str device-str )
234	then
235
236	2swap args-buf place-cstr drop ( device-str )
237
238	boot-read ( )
239	;
240
241	: boot-getline \ command line ( -- adr len )
242	-1 parse -trailing ( adr len )
243	;
244
245	: $append ( adr len buf -- )
246	\ Insert a space to separate the strings if both are non-empty
247	>r dup 0<> ( adr len 0? )
248	r@ c@ 0<> and if " " r@ $cat then ( adr len )
249	r> $cat ( sdr len )
250	;
251
252	\ $restart never returns to its caller. It resets the machine, leaving
253	\ hints in a system-dependent "safe" location so that the system will reboot
254	\ itself with the specified string.
255
256	defer restart-hook ( -- ) ' noop is restart-hook
257
258	: $restart ( tail$ mid$ head$ -- )
259
260	restart-hook ( tail$ mid$ head$ )
261
262	"temp >r ( tail$ mid$ head$ )
263	r@ place ( mid$ tail$ )
264	r@ $append ( mid$ )
265	r@ $append ( -- )
266	r> count ( adr len )
267
268	stdout-line# stdout-column#
269	save-reboot-info ( )
270	reset-all
271	;
272
273	\ The defer word can be used by platforms to take some action
274	\ such as updating the domain signature.
275	defer $reboot-hook ( -- ) ' noop is $reboot-hook
276	: $reboot ( arg$ dev$ -- ) $reboot-hook " boot" $restart ;
277
278	: reboot-same ( -- ) args-buf cscount path-buf cscount $reboot ;
279
280	: ?boot-password ( adr len -- adr len )
281	?secure security-mode case ( adr len )
282	1 of dup 0<> endof \ Need password only for non-default boot
283	2 of true endof \ Always need password
284	( default ) false swap \ Don't need password
285	endcase ( adr len password-needed? )
286	if password-okay? 0= if quit then then ( adr len )
287	;
288
289	\ The defer word can be used by platforms to take some action
290	\ such as updating the domain signature.
291	defer $boot-load-hook ( -- ) ' noop is $boot-load-hook
292	: $boot-load ( cmd-str -- )
293	?boot-password ( cmd-str )
294	state-valid off restartable? off ( cmd-str )
295	cleanup ( cmd-str )
296	$boot-load-hook
297	init-load-base $boot-read ( )
298	;
299
300	create not-executable ," The file just loaded does not appear to be executable."
301
302	headers
303	: $load ( adr len -- )
304	already-go? if null$ $reboot then $boot-load
305	;
306	: ?go ( -- )
307	?secure restartable? @ if go exit then
308	load-base file-size @ ?dup if 'execute-buffer execute else drop then
309	;
310
311	\ Defer words are used in case a platform wants to take some action
312	\ (like updating signature) at certain points in the boot process.
313	defer $boot-hook ( -- ) ' noop is $boot-hook
314	defer $boot-failed-hook ( -- ) ' noop is $boot-failed-hook
315	: $boot ( adr,len -- )
316	$load $boot-hook ?go $boot-failed-hook not-executable throw
317	;
318
319	\ Reads the first level boot file, but doesn't jump to it.
320	: load \ boot-spec ( -- )
321	boot-getline $boot-load
322	;
323
324	headerless
325	: (bootable?) ( comment$ -- )
326	init-incomplete? if \ Did probe/init run to completion?
327	cmn-fatal[
328	" OpenBoot initialization sequence prematurely terminated."
329	]cmn-end \ Tell user bad news
330	false to init-incomplete? \ Only issue this message once
331	then
332	system-fatal-state? if
333	" FATAL: system is not bootable" "temp >r r@ pack ( pstr )
334	$cat r> count set-abort-message ( )
335	-2 throw ( )
336	else
337	2drop
338	then
339	;
340	headers
341
342	\ Reads and executes the first level boot file; executed by the user
343	: boot \ boot-spec ( -- )
344	" , boot command is disabled" (bootable?)
345	boot-getline $boot
346	;
347
348	warning @ warning off
349	alias go ?go
350	warning !
351
352	headerless
353
354	: safe-evaluate ( adr len -- )
355	['] evaluate catch ?dup if nip nip .error then
356	;
357	: do-auto-boot ( -- )
358	auto-boot? if
359	" , auto-boot is disabled" (bootable?)
360	interrupt-auto-boot? if
361	." Aborting auto-boot sequence." cr
362	else
363	boot-command safe-evaluate \ Go ahead and try to auto-boot
364	then
365	then
366	;
367
368	\ do-reboot attempts to boot using the parameters that were saved in
369	\ reboot info area
370	: do-reboot ( -- )
371	" , reboot is disabled" (bootable?)
372
373	get-reboot-info ( bootcmd$ line# column# )
374
375	\ Cursor position is restored in fwritestr.fth
376	2drop ( bootcmd$ )
377
378	[ifndef] SUN4V
379	\ Suppress "Rebooting" message since for LDOMs, halt from Solaris to OpenBoot
380	\ involves execution of "reboot-command" LDOM variable
381	min+mode? if ( bootcmd$ )
382	." Rebooting with command: " 2dup type cr ( bootcmd$ )
383	then ( bootcmd$ )
384	[then]
385
386	safe-evaluate exit
387	;
388
389	\ if auto-boot executes after a reset resulting from a reboot, do-reboot
390	\ is executed, otherwise, do-auto-boot is executed.
391	: auto-boot ( -- )
392	reboot? if
393	do-reboot ( )
394	else
395	" boot-" do-drop-in ( )
396	do-auto-boot ( )
397	" boot+" do-drop-in ( )
398	then
399	;
400
401	headers
402	cif: boot ( cstr -- ) cscount null$ reclaim-machine $reboot ;
403	cif: restart ( cstr -- ) cscount null$ null$ reclaim-machine $restart ;