| \ ***************************************************************************** |
| \ * Copyright (c) 2004, 2008 IBM Corporation |
| \ * All rights reserved. |
| \ * This program and the accompanying materials |
| \ * are made available under the terms of the BSD License |
| \ * which accompanies this distribution, and is available at |
| \ * http://www.opensource.org/licenses/bsd-license.php |
| \ * |
| \ * Contributors: |
| \ * IBM Corporation - initial implementation |
| \ ****************************************************************************/ |
| |
| 0 VALUE load-size |
| 0 VALUE go-entry |
| VARIABLE state-valid false state-valid ! |
| CREATE go-args 2 cells allot go-args 2 cells erase |
| |
| 4000 CONSTANT bootdev-size |
| 0 VALUE bootdev-buf |
| |
| \ \\\\\\\\\\\\\\ Structure/Implementation Dependent Methods |
| |
| : alloc-bootdev-buf ( -- ) |
| bootdev-size alloc-mem ?dup 0= ABORT" Unable to allocate bootdev buffer!" |
| dup bootdev-size erase |
| to bootdev-buf |
| ; |
| |
| : free-bootdev-buf ( -- ) |
| bootdev-buf bootdev-size free-mem |
| 0 to bootdev-buf |
| ; |
| |
| : bootdev-string-cat ( addr1 len1 addr2 len2 -- addr1 len1+len2 ) |
| dup 3 pick + bootdev-size > ABORT" bootdev size too big!" |
| string-cat |
| ; |
| |
| : $bootargs |
| bootargs 2@ ?dup IF |
| ELSE s" diagnostic-mode?" evaluate and IF s" diag-file" evaluate |
| ELSE s" boot-file" evaluate THEN THEN |
| ; |
| |
| : $bootdev ( -- device-name len ) |
| alloc-bootdev-buf |
| bootdevice 2@ ?dup IF |
| swap bootdev-buf 2 pick move |
| bootdev-buf swap s" " bootdev-string-cat |
| ELSE |
| \ use bootdev-buf for concatenating diag mode/boot-device if any |
| drop bootdev-buf 0 |
| THEN |
| s" diagnostic-mode?" evaluate IF |
| s" diag-device" evaluate |
| ELSE |
| s" boot-device" evaluate |
| THEN |
| ( bootdev len str len1 ) |
| bootdev-string-cat \ concatenate both |
| strdup |
| free-bootdev-buf |
| ?dup 0= IF |
| disable-watchdog |
| drop true ABORT" No boot device!" |
| THEN |
| ; |
| |
| |
| \ \\\\\\\\\\\\\\ Implementation Independent Methods (Depend on Previous) |
| \ * |
| \ * |
| : set-boot-args ( str len -- ) dup IF strdup ELSE nip dup THEN bootargs 2! ; |
| |
| : (set-boot-device) ( str len -- ) |
| ?dup IF 1+ strdup 1- ELSE drop 0 0 THEN bootdevice 2! |
| ; |
| |
| ' (set-boot-device) to set-boot-device |
| |
| : (add-boot-device) ( str len -- ) \ Concatenate " str" to "bootdevice" |
| bootdevice 2@ ?dup IF |
| alloc-bootdev-buf |
| swap bootdev-buf 2 pick move |
| bootdev-buf swap s" " bootdev-string-cat |
| 2swap bootdev-string-cat |
| ELSE drop THEN |
| set-boot-device |
| bootdev-buf 0 <> IF free-bootdev-buf THEN |
| ; |
| |
| ' (add-boot-device) to add-boot-device |
| |
| 0 value claim-list |
| |
| : no-go ( -- ) -64 boot-exception-handler ABORT ; |
| |
| defer go ( -- ) |
| |
| : go-32 ( -- ) |
| state-valid @ IF |
| 0 ciregs >r3 ! 0 ciregs >r4 ! |
| go-args 2@ go-entry start-elf client-data |
| claim-list elf-release 0 to claim-list |
| THEN |
| -6d boot-exception-handler ABORT |
| ; |
| |
| : go-64 ( args len entry r2 -- ) |
| 0 ciregs >r3 ! 0 ciregs >r4 ! |
| start-elf64 client-data |
| claim-list elf-release 0 to claim-list |
| ; |
| |
| : go-direct ( -- ) |
| 0 ciregs >r3 ! 0 ciregs >r4 ! 0 ciregs >r2 ! |
| msr@ 7fffffffffffffff and 2000 or ciregs >srr1 ! |
| go-args 2@ go-entry call-client |
| ; |
| |
| : set-le ( -- ) |
| 1 ciregs >r13 ! |
| ; |
| |
| : set-be ( -- ) |
| 0 ciregs >r13 ! |
| ; |
| |
| : go-64-be ( -- ) |
| state-valid @ IF |
| set-be |
| go-args 2@ |
| go-entry @ |
| go-entry 8 + @ |
| go-64 |
| THEN |
| -6d boot-exception-handler ABORT |
| ; |
| |
| |
| : go-32-be |
| set-be |
| go-32 |
| ; |
| |
| : go-32-lev1 |
| set-le |
| go-32 |
| ; |
| |
| : go-64-lev1 |
| state-valid @ IF |
| go-args 2@ |
| go-entry @ xbflip |
| go-entry 8 + @ xbflip |
| set-le |
| go-64 |
| THEN |
| -6d boot-exception-handler ABORT |
| ; |
| |
| : go-64-lev2 |
| state-valid @ IF |
| go-args 2@ |
| go-entry 0 |
| set-le |
| go-64 |
| THEN |
| -6d boot-exception-handler ABORT |
| ; |
| |
| : load-elf-init ( arg len file-addr -- success ) |
| false state-valid ! \ Not valid anymore ... |
| claim-list IF \ Release claimed mem |
| claim-list elf-release 0 to claim-list \ from last load |
| THEN |
| |
| true swap -1 ( arg len true file-addr -1 ) |
| elf-load-claim ( arg len true claim-list entry elftype ) |
| |
| ( arg len true claim-list entry elftype ) |
| CASE |
| 1 OF ['] go-32-be ENDOF ( arg len true claim-list entry go ) |
| 2 OF ['] go-64-be ENDOF ( arg len true claim-list entry go ) |
| 3 OF ['] go-64-lev1 ENDOF ( arg len true claim-list entry go ) |
| 4 OF ['] go-64-lev2 ENDOF ( arg len true claim-list entry go ) |
| 5 OF ['] go-32-lev1 ENDOF ( arg len true claim-list entry go ) |
| dup OF ['] no-go to go |
| 2drop 3drop false EXIT ENDOF ( false ) |
| ENDCASE |
| |
| to go to go-entry to claim-list |
| dup state-valid ! -rot |
| |
| 2 pick IF |
| go-args 2! |
| ELSE |
| 2drop |
| THEN |
| ; |
| |
| : init-program ( -- ) |
| $bootargs get-load-base ['] load-elf-init CATCH ?dup IF |
| boot-exception-handler |
| 2drop 2drop false \ Could not claim |
| ELSE IF |
| 0 ciregs 2dup >r3 ! >r4 ! \ Valid (ELF ) Image |
| THEN |
| THEN |
| ; |
| |
| |
| \ \\\\\\\\\\\\\\ Exported Interface: |
| \ * |
| \ Generic device load method: |
| \ * |
| |
| : do-load ( devstr len -- img-size ) \ Device method wrapper |
| use-load-watchdog? IF |
| \ Set watchdog timer to 10 minutes, multiply with 2 because DHCP |
| \ needs 1 second per try and add 1 min to avoid race conditions |
| \ with watchdog timeout. |
| 4ec set-watchdog |
| THEN |
| 2dup " HALT" str= IF 2drop 0 EXIT THEN |
| my-self >r current-node @ >r \ Save my-self |
| ." Trying to load: " $bootargs type ." from: " 2dup type ." ... " |
| 2dup open-dev dup IF |
| dup to my-self |
| dup ihandle>phandle set-node |
| -rot ( ihandle devstr len ) |
| encode-string s" bootpath" set-chosen |
| $bootargs encode-string s" bootargs" set-chosen |
| get-load-base s" load" 3 pick ['] $call-method CATCH IF |
| -67 boot-exception-handler 3drop drop false |
| ELSE |
| dup 0> IF |
| init-program |
| ELSE |
| false state-valid ! |
| drop 0 \ Could not load |
| THEN |
| THEN |
| swap close-dev device-end dup to load-size |
| ELSE -68 boot-exception-handler 3drop false THEN |
| r> set-node r> to my-self \ Restore my-self |
| ; |
| |
| : parse-load ( "{devlist}" -- success ) \ Parse-execute boot-device list |
| cr BEGIN parse-word dup WHILE |
| de-alias do-load dup 0< IF drop 0 THEN IF |
| state-valid @ IF ." Successfully loaded" cr THEN |
| true 0d parse strdup load-list 2! EXIT |
| THEN |
| REPEAT 2drop 0 0 load-list 2! false |
| ; |
| |
| : load ( "{params}<eol>"} -- success ) \ Client interface to load |
| parse-word 0d parse -leading 2swap ?dup IF |
| de-alias |
| set-boot-device |
| ELSE |
| drop |
| THEN |
| set-boot-args |
| save-source -1 to source-id |
| $bootdev dup #ib ! span ! to ib |
| 0 >in ! |
| ['] parse-load catch restore-source throw |
| ; |
| |
| : load-next ( -- success ) \ Continue after go failed |
| load-list 2@ ?dup IF |
| save-source -1 to source-id |
| dup #ib ! span ! to ib |
| 0 >in ! |
| ['] parse-load catch restore-source throw |
| ELSE drop false THEN |
| ; |
| |
| \ \\\\\\\\\\\\\\\\\\\\\\\\\\ |
| \ load/go utilities |
| \ -> Should be in loaders.fs |
| |
| : noload false ; |
| |
| ' no-go to go |
| |
| : (go-and-catch) ( -- ) |
| \ Recommended Practice: Forth Source Support (scripts starting with comment) |
| get-load-base c@ 5c = get-load-base 1+ c@ 20 = AND IF |
| load-size alloc-mem ( allocated-addr ) |
| ?dup 0= IF ." alloc-mem failed." cr EXIT THEN |
| load-size >r >r ( R: allocate-addr load-size ) |
| get-load-base r@ load-size move \ Move away from load-base |
| r@ load-size evaluate \ Run the script |
| r> r> free-mem |
| EXIT |
| THEN |
| \ Assume it's a normal executable, use "go" to run it: |
| ['] go behavior CATCH IF -69 boot-exception-handler THEN |
| ; |
| |
| |
| \ if the board does not get the bootlist from the nvram |
| \ then this word is supposed to be overloaded with the |
| \ word to get the bootlist from VPD (or from wheresoever) |
| read-bootlist |
| |
| \ \\\\\\\\\\\\\\ Exported Interface: |
| \ * |
| \ IEEE 1275 : load (user interface) |
| \ * |
| : boot |
| load 0= IF -65 boot-exception-handler EXIT THEN |
| disable-watchdog (go-and-catch) |
| BEGIN load-next WHILE |
| disable-watchdog (go-and-catch) |
| REPEAT |
| ; |
| |
| : load load 0= IF -65 boot-exception-handler THEN ; |