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    2dup " HALT" str= IF 2drop 0 EXIT THEN
 185    my-self >r current-node @ >r         \ Save my-self
 186    ." Trying to load: " $bootargs type ."  from: " 2dup type ."  ... "
 187    2dup open-dev dup IF
 188       dup to my-self
 189       dup ihandle>phandle set-node
 190       -rot                              ( ihandle devstr len )
 191       encode-string s" bootpath" set-chosen
 192       $bootargs encode-string s" bootargs" set-chosen
 193       get-load-base s" load" 3 pick ['] $call-method CATCH IF
 194         -67 boot-exception-handler 3drop drop false
 195       ELSE
 196          dup 0> IF
 197             init-program
 198          ELSE
 199             false state-valid !
 200             drop 0                                     \ Could not load
 201          THEN
 202       THEN
 203       swap close-dev device-end dup to load-size
 204    ELSE -68 boot-exception-handler 3drop false THEN
 205    r> set-node r> to my-self                           \ Restore my-self
 206 ;
 207
 208 : parse-load ( "{devlist}" -- success ) \ Parse-execute boot-device list
 209    cr BEGIN parse-word dup WHILE
 210          de-alias do-load dup 0< IF drop 0 THEN IF
 211             state-valid @ IF ."   Successfully loaded" cr THEN
 212             true 0d parse strdup load-list 2! EXIT
 213          THEN
 214    REPEAT 2drop 0 0 load-list 2! false
 215 ;
 216
 217 : load ( "{params}<eol>"} -- success )  \ Client interface to load
 218    parse-word 0d parse -leading 2swap ?dup IF
 219       de-alias
 220       set-boot-device
 221    ELSE
 222       drop
 223    THEN
 224    set-boot-args s" parse-load " $bootdev $cat strdup evaluate
 225 ;
 226
 227 : load-next ( -- success )      \ Continue after go failed
 228    load-list 2@ ?dup IF s" parse-load " 2swap $cat strdup evaluate
 229    ELSE drop false THEN
 230 ;
 231
 232 \ \\\\\\\\\\\\\\\\\\\\\\\\\\
 233 \ load/go utilities
 234 \ -> Should be in loaders.fs
 235
 236 : noload false ;
 237
 238 ' no-go to go
 239
 240 : (go-and-catch)  ( -- )
 241    \ Recommended Practice: Forth Source Support (scripts starting with comment)
 242    get-load-base c@ 5c =  get-load-base 1+ c@ 20 = AND IF
 243       load-size alloc-mem            ( allocated-addr )
 244       ?dup 0= IF ." alloc-mem failed." cr EXIT THEN
 245       load-size >r >r                ( R: allocate-addr load-size )
 246       get-load-base r@ load-size move    \ Move away from load-base
 247       r@ load-size evaluate          \ Run the script
 248       r> r> free-mem
 249       EXIT
 250    THEN
 251    \ Assume it's a normal executable, use "go" to run it:
 252    ['] go behavior CATCH IF -69 boot-exception-handler THEN
 253 ;
 254
 255
 256 \ if the board does not get the bootlist from the nvram
 257 \ then this word is supposed to be overloaded with the
 258 \ word to get the bootlist from VPD (or from wheresoever)
 259 read-bootlist
 260
 261 \ \\\\\\\\\\\\\\ Exported Interface:
 262 \ *
 263 \ IEEE 1275 : load (user interface)
 264 \ *
 265 : boot
 266    load 0= IF -65 boot-exception-handler EXIT THEN
 267    disable-watchdog (go-and-catch)
 268    BEGIN load-next WHILE
 269       disable-watchdog (go-and-catch)
 270    REPEAT
 271
 272    \ When we return from boot print the banner again.
 273    .banner
 274 ;
 275
 276 : load load 0= IF -65 boot-exception-handler THEN ;
 277
 278 \ \\\\ Temporary hacks for backwards compatibility
 279 : yaboot ." Use 'boot disk' instead " ;
 280
 281 : netboot ( -- rc ) ." Use 'boot net' instead " ;
 282
 283 : netboot-arg ( arg-string -- rc )
 284    s" boot net " 2swap $cat (parse-line) $cat
 285    evaluate
 286 ;
 287
 288 : netload ( -- rc ) (parse-line)
 289    load-base-override >r flash-load-base to load-base-override
 290    s" load net:" strdup 2swap $cat strdup evaluate
 291    r> to load-base-override
 292    load-size
 293 ;
 294
 295 : neteval ( -- ) FLASH-LOAD-BASE netload evaluate ;
 296