1 \ *****************************************************************************
2 \ * Copyright (c) 2004, 2008 IBM Corporation
3 \ * All rights reserved.
4 \ * This program and the accompanying materials
5 \ * are made available under the terms of the BSD License
6 \ * which accompanies this distribution, and is available at
7 \ * http://www.opensource.org/licenses/bsd-license.php
10 \ * IBM Corporation - initial implementation
11 \ ****************************************************************************/
15 VARIABLE state-valid false state-valid !
16 CREATE go-args 2 cells allot go-args 2 cells erase
18 \ \\\\\\\\\\\\\\ Structure/Implementation Dependent Methods
22 ELSE s" diagnostic-mode?" evaluate and IF s" diag-file" evaluate
23 ELSE s" boot-file" evaluate THEN THEN
26 : $bootdev ( -- device-name len )
27 bootdevice 2@ dup IF s" " $cat THEN
28 s" diagnostic-mode?" evaluate IF
29 s" diag-device" evaluate
31 s" boot-device" evaluate
33 $cat \ prepend bootdevice setting from vpd-bootlist
37 drop true ABORT" No boot device!"
42 \ \\\\\\\\\\\\\\ Implementation Independent Methods (Depend on Previous)
45 : set-boot-args ( str len -- ) dup IF strdup ELSE nip dup THEN bootargs 2! ;
47 : (set-boot-device) ( str len -- )
48 ?dup IF 1+ strdup 1- ELSE drop 0 0 THEN bootdevice 2!
51 ' (set-boot-device) to set-boot-device
53 : (add-boot-device) ( str len -- ) \ Concatenate " str" to "bootdevice"
54 bootdevice 2@ ?dup IF $cat-space ELSE drop THEN set-boot-device
57 ' (add-boot-device) to add-boot-device
61 : no-go ( -- ) -64 boot-exception-handler ABORT ;
67 0 ciregs >r3 ! 0 ciregs >r4 !
68 go-args 2@ go-entry start-elf client-data
69 claim-list elf-release 0 to claim-list
71 -6d boot-exception-handler ABORT
74 : go-64 ( args len entry r2 -- )
75 0 ciregs >r3 ! 0 ciregs >r4 !
76 start-elf64 client-data
77 claim-list elf-release 0 to claim-list
96 -6d boot-exception-handler ABORT
114 go-entry 8 + @ xbflip
118 -6d boot-exception-handler ABORT
128 -6d boot-exception-handler ABORT
131 : load-elf-init ( arg len file-addr -- success )
132 false state-valid ! \ Not valid anymore ...
133 claim-list IF \ Release claimed mem
134 claim-list elf-release 0 to claim-list \ from last load
137 true swap -1 ( arg len true file-addr -1 )
138 elf-load-claim ( arg len true claim-list entry elftype )
140 ( arg len true claim-list entry elftype )
142 1 OF ['] go-32-be ENDOF ( arg len true claim-list entry go )
143 2 OF ['] go-64-be ENDOF ( arg len true claim-list entry go )
144 3 OF ['] go-64-lev1 ENDOF ( arg len true claim-list entry go )
145 4 OF ['] go-64-lev2 ENDOF ( arg len true claim-list entry go )
146 5 OF ['] go-32-lev1 ENDOF ( arg len true claim-list entry go )
147 dup OF ['] no-go to go
148 2drop 3drop false EXIT ENDOF ( false )
151 to go to go-entry to claim-list
152 dup state-valid ! -rot
161 : init-program ( -- )
162 $bootargs get-load-base ['] load-elf-init CATCH ?dup IF
163 boot-exception-handler
164 2drop 2drop false \ Could not claim
166 0 ciregs 2dup >r3 ! >r4 ! \ Valid (ELF ) Image
172 \ \\\\\\\\\\\\\\ Exported Interface:
174 \ Generic device load method:
177 : do-load ( devstr len -- img-size ) \ Device method wrapper
178 use-load-watchdog? IF
179 \ Set watchdog timer to 10 minutes, multiply with 2 because DHCP
180 \ needs 1 second per try and add 1 min to avoid race conditions
181 \ with watchdog timeout.
184 my-self >r current-node @ >r \ Save my-self
185 ." Trying to load: " $bootargs type ." from: " 2dup type ." ... "
188 dup ihandle>phandle set-node
189 -rot ( ihandle devstr len )
191 2dup 1- + c@ [char] : <> IF \ Add : to device path if missing
192 1+ strdup 2dup 1- + [char] : swap c!
195 encode-string s" bootpath" set-chosen
196 $bootargs encode-string s" bootargs" set-chosen
197 get-load-base s" load" 3 pick ['] $call-method CATCH IF
198 -67 boot-exception-handler 3drop drop false
204 drop 0 \ Could not load
207 swap close-dev device-end dup to load-size
208 ELSE -68 boot-exception-handler 3drop false THEN
209 r> set-node r> to my-self \ Restore my-self
212 : parse-load ( "{devlist}" -- success ) \ Parse-execute boot-device list
213 cr BEGIN parse-word dup WHILE
214 ( de-alias ) do-load dup 0< IF drop 0 THEN IF
215 state-valid @ IF ." Successfully loaded" cr THEN
216 true 0d parse strdup load-list 2! EXIT
218 REPEAT 2drop 0 0 load-list 2! false
221 : load ( "{params}<eol>"} -- success ) \ Client interface to load
222 parse-word 0d parse -leading 2swap ?dup IF
228 set-boot-args s" parse-load " $bootdev $cat strdup evaluate
231 : load-next ( -- success ) \ Continue after go failed
232 load-list 2@ ?dup IF s" parse-load " 2swap $cat strdup evaluate
236 \ \\\\\\\\\\\\\\\\\\\\\\\\\\
238 \ -> Should be in loaders.fs
244 : (go-and-catch) ( -- )
245 \ Recommended Practice: Forth Source Support (scripts starting with comment)
246 get-load-base c@ 5c = get-load-base 1+ c@ 20 = AND IF
247 load-size alloc-mem ( allocated-addr )
248 ?dup 0= IF ." alloc-mem failed." cr EXIT THEN
249 load-size >r >r ( R: allocate-addr load-size )
250 get-load-base r@ load-size move \ Move away from load-base
251 r@ load-size evaluate \ Run the script
255 \ Assume it's a normal executable, use "go" to run it:
256 ['] go behavior CATCH IF -69 boot-exception-handler THEN
260 \ if the board does not get the bootlist from the nvram
261 \ then this word is supposed to be overloaded with the
262 \ word to get the bootlist from VPD (or from wheresoever)
265 \ \\\\\\\\\\\\\\ Exported Interface:
267 \ IEEE 1275 : load (user interface)
270 load 0= IF -65 boot-exception-handler EXIT THEN
271 disable-watchdog (go-and-catch)
272 BEGIN load-next WHILE
273 disable-watchdog (go-and-catch)
276 \ When we return from boot print the banner again.
280 : load load 0= IF -65 boot-exception-handler THEN ;
282 \ \\\\ Temporary hacks for backwards compatibility
283 : yaboot ." Use 'boot disk' instead " ;
285 : netboot ( -- rc ) ." Use 'boot net' instead " ;
287 : netboot-arg ( arg-string -- rc )
288 s" boot net " 2swap $cat (parse-line) $cat
292 : netload ( -- rc ) (parse-line)
293 load-base-override >r flash-load-base to load-base-override
294 s" load net:" strdup 2swap $cat strdup evaluate
295 r> to load-base-override
299 : neteval ( -- ) FLASH-LOAD-BASE netload evaluate ;