qemu/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
  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
  78 ;
  79
  80 : set-le ( -- )
  81     1 ciregs >r13 !
  82 ;
  83
  84 : set-be ( -- )
  85     0 ciregs >r13 !
  86 ;
  87
  88 : go-64-be ( -- )
  89     state-valid @ IF
  90         set-be
  91         go-args 2@
  92         go-entry @
  93         go-entry 8 + @
  94         go-64
  95     THEN
  96     -6d boot-exception-handler ABORT
  97 ;
  98
  99
 100 : go-32-be
 101     set-be
 102     go-32
 103 ;
 104
 105 : go-32-lev1
 106     set-le
 107     go-32
 108 ;
 109
 110 : go-64-lev1
 111     state-valid @ IF
 112         go-args 2@
 113         go-entry @ xbflip
 114         go-entry 8 + @ xbflip
 115         set-le
 116         go-64
 117     THEN
 118     -6d boot-exception-handler ABORT
 119 ;
 120
 121 : go-64-lev2
 122     state-valid @ IF
 123         go-args 2@
 124         go-entry 0
 125         set-le
 126         go-64
 127     THEN
 128     -6d boot-exception-handler ABORT
 129 ;
 130
 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
 135    THEN
 136
 137    true swap -1                       ( arg len true file-addr -1 )
 138    elf-load-claim                     ( arg len true claim-list entry elftype )
 139
 140    ( arg len true claim-list entry elftype )
 141    CASE
 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 )
 149    ENDCASE
 150
 151    to go to go-entry to claim-list
 152    dup state-valid ! -rot
 153
 154    2 pick IF
 155       go-args 2!
 156    ELSE
 157       2drop
 158    THEN
 159 ;
 160
 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
 165    ELSE IF
 166          0 ciregs 2dup >r3 ! >r4 !  \ Valid (ELF ) Image
 167       THEN
 168    THEN
 169 ;
 170
 171
 172 \ \\\\\\\\\\\\\\ Exported Interface:
 173 \ *
 174 \ Generic device load method:
 175 \ *
 176
 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.
 182       4ec set-watchdog
 183    THEN
 184    my-self >r current-node @ >r         \ Save my-self
 185    ." Trying to load: " $bootargs type ."  from: " 2dup type ."  ... "
 186    2dup open-dev dup IF
 187       dup to my-self
 188       dup ihandle>phandle set-node
 189       -rot                              ( ihandle devstr len )
 190       my-args nip 0= IF
 191          2dup 1- + c@ [char] : <> IF    \ Add : to device path if missing
 192             1+ strdup 2dup 1- + [char] : swap c!
 193          THEN
 194       THEN
 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
 199       ELSE
 200          dup 0> IF
 201             init-program
 202          ELSE
 203             false state-valid !
 204             drop 0                                     \ Could not load
 205          THEN
 206       THEN
 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
 210 ;
 211
 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
 217          THEN
 218    REPEAT 2drop 0 0 load-list 2! false
 219 ;
 220
 221 : load ( "{params}<eol>"} -- success )  \ Client interface to load
 222    parse-word 0d parse -leading 2swap ?dup IF
 223       de-alias
 224       set-boot-device
 225    ELSE
 226       drop
 227    THEN
 228    set-boot-args s" parse-load " $bootdev $cat strdup evaluate
 229 ;
 230
 231 : load-next ( -- success )      \ Continue after go failed
 232    load-list 2@ ?dup IF s" parse-load " 2swap $cat strdup evaluate
 233    ELSE drop false THEN
 234 ;
 235
 236 \ \\\\\\\\\\\\\\\\\\\\\\\\\\
 237 \ load/go utilities
 238 \ -> Should be in loaders.fs
 239
 240 : noload false ;
 241
 242 ' no-go to go
 243
 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
 252       r> r> free-mem
 253       EXIT
 254    THEN
 255    \ Assume it's a normal executable, use "go" to run it:
 256    ['] go behavior CATCH IF -69 boot-exception-handler THEN
 257 ;
 258
 259
 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)
 263 read-bootlist
 264
 265 \ \\\\\\\\\\\\\\ Exported Interface:
 266 \ *
 267 \ IEEE 1275 : load (user interface)
 268 \ *
 269 : boot
 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)
 274    REPEAT
 275
 276    \ When we return from boot print the banner again.
 277    .banner
 278 ;
 279
 280 : load load 0= IF -65 boot-exception-handler THEN ;
 281
 282 \ \\\\ Temporary hacks for backwards compatibility
 283 : yaboot ." Use 'boot disk' instead " ;
 284
 285 : netboot ( -- rc ) ." Use 'boot net' instead " ;
 286
 287 : netboot-arg ( arg-string -- rc )
 288    s" boot net " 2swap $cat (parse-line) $cat
 289    evaluate
 290 ;
 291
 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
 296    load-size
 297 ;
 298
 299 : neteval ( -- ) FLASH-LOAD-BASE netload evaluate ;
 300