roms/SLOF/slof/fs/boot.fs

   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
   8 \ *
   9 \ * Contributors:
  10 \ *     IBM Corporation - initial implementation
  11 \ ****************************************************************************/
  12
  13 0 VALUE load-size
  14 0 VALUE go-entry
  15 VARIABLE state-valid false state-valid !
  16 CREATE go-args 2 cells allot go-args 2 cells erase
  17
  18 \ \\\\\\\\\\\\\\ Structure/Implementation Dependent Methods
  19
  20 : $bootargs
  21    bootargs 2@ ?dup IF
  22    ELSE s" diagnostic-mode?" evaluate and IF s" diag-file" evaluate
  23    ELSE s" boot-file" evaluate THEN THEN
  24 ;
  25
  26 : $bootdev ( -- device-name len )
  27    bootdevice 2@ dup IF s"  " $cat THEN
  28    s" diagnostic-mode?" evaluate IF
  29       s" diag-device" evaluate
  30    ELSE
  31       s" boot-device" evaluate
  32    THEN
  33    $cat \ prepend bootdevice setting from vpd-bootlist
  34    strdup
  35    ?dup 0= IF
  36       disable-watchdog
  37       drop true ABORT" No boot device!"
  38    THEN
  39 ;
  40
  41
  42 \ \\\\\\\\\\\\\\ Implementation Independent Methods (Depend on Previous)
  43 \ *
  44 \ *
  45 : set-boot-args ( str len -- ) dup IF strdup ELSE nip dup THEN bootargs 2! ;
  46
  47 : (set-boot-device) ( str len -- )
  48    ?dup IF 1+ strdup 1- ELSE drop 0 0 THEN bootdevice 2!
  49 ;
  50
  51 ' (set-boot-device) to set-boot-device
  52
  53 : (add-boot-device) ( str len -- )      \ Concatenate " str" to "bootdevice"
  54    bootdevice 2@ ?dup IF $cat-space ELSE drop THEN set-boot-device
  55 ;
  56
  57 ' (add-boot-device) to add-boot-device
  58
  59 0 value claim-list
  60
  61 : no-go ( -- ) -64 boot-exception-handler ABORT ;
  62
  63 defer go ( -- )
  64
  65 : go-32 ( -- )
  66    state-valid @ IF
  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
  70    THEN
  71    -6d boot-exception-handler ABORT
  72 ;
  73 : go-64 ( -- )
  74    state-valid @ IF
  75       0 ciregs >r3 ! 0 ciregs >r4 !
  76       go-args 2@ go-entry start-elf64 client-data
  77       claim-list elf-release 0 to claim-list
  78    THEN
  79    -6d boot-exception-handler ABORT
  80 ;
  81
  82 : load-elf-init ( arg len file-addr -- success )
  83    false state-valid !                            \ Not valid anymore ...
  84    claim-list IF                                    \ Release claimed mem
  85       claim-list elf-release 0 to claim-list        \ from last load
  86    THEN
  87
  88    true swap -1                       ( arg len true file-addr -1 )
  89    elf-load-claim                     ( arg len true claim-list entry elftype )
  90
  91    ( arg len true claim-list entry elftype )
  92    CASE
  93       1  OF ['] go-32 ENDOF           ( arg len true claim-list entry go )
  94       2  OF ['] go-64 ENDOF           ( arg len true claim-list entry go )
  95       dup OF ['] no-go to go
  96          2drop 3drop false EXIT   ENDOF                   ( false )
  97    ENDCASE
  98
  99    to go to go-entry to claim-list
 100    dup state-valid ! -rot
 101
 102    2 pick IF
 103       go-args 2!
 104    ELSE
 105       2drop
 106    THEN
 107 ;
 108
 109 : init-program ( -- )
 110    $bootargs LOAD-BASE ['] load-elf-init CATCH ?dup IF
 111       boot-exception-handler
 112       2drop 2drop false          \ Could not claim
 113    ELSE IF
 114          0 ciregs 2dup >r3 ! >r4 !  \ Valid (ELF ) Image
 115       THEN
 116    THEN
 117 ;
 118
 119
 120 \ \\\\\\\\\\\\\\ Exported Interface:
 121 \ *
 122 \ Generic device load method:
 123 \ *
 124
 125 : do-load ( devstr len -- img-size )    \ Device method wrapper
 126    use-load-watchdog? IF
 127       \ Set watchdog timer to 10 minutes, multiply with 2 because DHCP
 128       \ needs 1 second per try and add 1 min to avoid race conditions
 129       \ with watchdog timeout.
 130       4ec set-watchdog
 131    THEN
 132    my-self >r current-node @ >r         \ Save my-self
 133    ." Trying to load: " $bootargs type ."  from: " 2dup type ."  ... "
 134    2dup open-dev dup IF
 135       dup to my-self
 136       dup ihandle>phandle set-node
 137       -rot                              ( ihandle devstr len )
 138       my-args nip 0= IF
 139          2dup 1- + c@ [char] : <> IF    \ Add : to device path if missing
 140             1+ strdup 2dup 1- + [char] : swap c!
 141          THEN
 142       THEN
 143       encode-string s" bootpath" set-chosen
 144       $bootargs encode-string s" bootargs" set-chosen
 145       LOAD-BASE s" load" 3 pick ['] $call-method CATCH IF
 146         -67 boot-exception-handler 3drop drop false
 147       ELSE
 148          dup 0> IF
 149             init-program
 150          ELSE
 151             false state-valid !
 152             drop 0                                     \ Could not load
 153          THEN
 154       THEN
 155       swap close-dev device-end dup to load-size
 156    ELSE -68 boot-exception-handler 3drop false THEN
 157    r> set-node r> to my-self                           \ Restore my-self
 158 ;
 159
 160 : parse-load ( "{devlist}" -- success ) \ Parse-execute boot-device list
 161    cr BEGIN parse-word dup WHILE
 162          ( de-alias ) do-load dup 0< IF drop 0 THEN IF
 163             state-valid @ IF ."   Successfully loaded" cr THEN
 164             true 0d parse strdup load-list 2! EXIT
 165          THEN
 166    REPEAT 2drop 0 0 load-list 2! false
 167 ;
 168
 169 : load ( "{params}<eol>"} -- success )  \ Client interface to load
 170    parse-word 0d parse -leading 2swap ?dup IF
 171       de-alias
 172       set-boot-device
 173    ELSE
 174       drop
 175    THEN
 176    set-boot-args s" parse-load " $bootdev $cat strdup evaluate
 177 ;
 178
 179 : load-next ( -- success )      \ Continue after go failed
 180    load-list 2@ ?dup IF s" parse-load " 2swap $cat strdup evaluate
 181    ELSE drop false THEN
 182 ;
 183
 184 \ \\\\\\\\\\\\\\\\\\\\\\\\\\
 185 \ load/go utilities
 186 \ -> Should be in loaders.fs
 187
 188 : noload false ;
 189
 190 ' no-go to go
 191
 192 : (go-and-catch)  ( -- )
 193    \ Recommended Practice: Forth Source Support (scripts starting with comment)
 194    load-base c@ 5c =  load-base 1+ c@ 20 = AND IF
 195       load-size alloc-mem            ( allocated-addr )
 196       ?dup 0= IF ." alloc-mem failed." cr EXIT THEN
 197       load-size >r >r                ( R: allocate-addr load-size )
 198       load-base r@ load-size move    \ Move away from load-base
 199       r@ load-size evaluate          \ Run the script
 200       r> r> free-mem
 201       EXIT
 202    THEN
 203    \ Assume it's a normal executable, use "go" to run it:
 204    ['] go behavior CATCH IF -69 boot-exception-handler THEN
 205 ;
 206
 207
 208 \ if the board does not get the bootlist from the nvram
 209 \ then this word is supposed to be overloaded with the
 210 \ word to get the bootlist from VPD (or from wheresoever)
 211 read-bootlist
 212
 213 \ \\\\\\\\\\\\\\ Exported Interface:
 214 \ *
 215 \ IEEE 1275 : load (user interface)
 216 \ *
 217 : boot
 218    load 0= IF -65 boot-exception-handler EXIT THEN
 219    disable-watchdog (go-and-catch)
 220    BEGIN load-next WHILE
 221       disable-watchdog (go-and-catch)
 222    REPEAT
 223
 224    \ When we return from boot print the banner again.
 225    .banner
 226 ;
 227
 228 : load load 0= IF -65 boot-exception-handler THEN ;
 229
 230 \ \\\\ Temporary hacks for backwards compatibility
 231 : yaboot ." Use 'boot disk' instead " ;
 232
 233 : netboot ( -- rc ) ." Use 'boot net' instead " ;
 234
 235 : netboot-arg ( arg-string -- rc )
 236    s" boot net " 2swap $cat (parse-line) $cat
 237    evaluate
 238 ;
 239
 240 : netload ( -- rc ) (parse-line)
 241    load-base >r FLASH-LOAD-BASE to load-base
 242    s" load net:" strdup 2swap $cat strdup evaluate
 243    r> to load-base
 244    load-size
 245 ;
 246
 247 : neteval ( -- ) FLASH-LOAD-BASE netload evaluate ;
 248