qemu/roms/SLOF/slof/fs/scsi-disk.fs

   1 \ *****************************************************************************
   2 \ * Copyright (c) 2011 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 \ Create new VSCSI child device
  14
  15 \ Create device
  16 new-device
  17
  18 \ Set name
  19 s" disk" device-name
  20
  21 s" block" device-type
  22
  23 false VALUE scsi-disk-debug?
  24
  25 \ Get SCSI bits
  26 scsi-open
  27
  28 \ Send SCSI commands to controller
  29
  30 : execute-scsi-command ( buf-addr buf-len dir cmd-addr cmd-len -- ... )
  31                        ( ... [ sense-buf sense-len ] stat )
  32     " execute-scsi-command" $call-parent
  33 ;
  34
  35 : retry-scsi-command ( buf-addr buf-len dir cmd-addr cmd-len #retries -- ... )
  36                      ( ... 0 | [ sense-buf sense-len ] stat )
  37     " retry-scsi-command" $call-parent
  38 ;
  39
  40 \ ---------------------------------\
  41 \ Common SCSI Commands and helpers \
  42 \ ---------------------------------\
  43
  44 0 INSTANCE VALUE block-size
  45 0 INSTANCE VALUE max-transfer
  46 0 INSTANCE VALUE max-block-num
  47 0 INSTANCE VALUE is_cdrom
  48 INSTANCE VARIABLE deblocker
  49
  50 \ This scratch area is made global for now as we only
  51 \ use it for small temporary commands such as inquiry
  52 \ read-capacity or media events
  53 CREATE scratch 100 allot
  54 CREATE cdb 10 allot
  55
  56 : dump-scsi-error ( sense-buf sense-len stat name namelen -- )
  57     ." SCSI-DISK: " my-self instance>path type ." ," type ."  failed" cr
  58     ." SCSI-DISK: Status " dup . .status-text
  59     0<> IF
  60         ."  Sense " scsi-get-sense-data dup . .sense-text
  61         ."  ASC " . ." ASCQ " . cr
  62     ELSE drop THEN
  63 ;
  64
  65 : read-blocks ( addr block# #blocks -- #read )
  66     scsi-disk-debug? IF
  67         ." SCSI-DISK: read-blocks " .s cr
  68     THEN
  69
  70     \ Bound check. This should probably be done by deblocker
  71     \ but it doesn't at this point so do it here
  72     2dup + max-block-num > IF
  73         ." SCSI-DISK: Access beyond end of device ! " cr
  74         drop
  75         dup max-block-num > IF
  76           drop drop 0 EXIT
  77         THEN
  78         dup max-block-num swap -
  79     THEN
  80
  81     dup block-size *                            ( addr block# #blocks len )
  82     >r rot r>                                   ( block# #blocks addr len )
  83     2swap                                       ( addr len block# #blocks )
  84     dup >r
  85     cdb scsi-build-read-10                      ( addr len )
  86     r> -rot                                     ( #blocks addr len )
  87     scsi-dir-read cdb scsi-param-size 10
  88     retry-scsi-command
  89                                                 ( #blocks [ sense-buf sense-len ] stat )
  90     dup 0<> IF " read-blocks" dump-scsi-error -65 throw ELSE drop THEN
  91 ;
  92
  93 : (inquiry) ( size -- buffer | NULL )
  94     dup cdb scsi-build-inquiry
  95     \ 16 retries for inquiry to flush out any UAs
  96     scratch swap scsi-dir-read cdb scsi-param-size 10 retry-scsi-command
  97     \ Success ?
  98     0= IF scratch ELSE 2drop 0 THEN
  99 ;
 100
 101 : inquiry ( -- buffer | NULL )
 102     scsi-disk-debug? IF
 103         ." SCSI-DISK: inquiry " .s cr
 104     THEN
 105     d# 36 (inquiry) 0= IF 0 EXIT THEN
 106     scratch inquiry-data>add-length c@ 5 +
 107     (inquiry)
 108 ;
 109
 110 : read-capacity ( -- blocksize #blocks )
 111     \ Now issue the read-capacity command
 112     scsi-disk-debug? IF
 113         ." SCSI-DISK: read-capacity " .s cr
 114     THEN
 115     \ Make sure that there are zeros in the buffer in case something goes wrong:
 116     scratch 10 erase
 117     cdb scsi-build-read-cap-10 scratch scsi-length-read-cap-10-data scsi-dir-read
 118     cdb scsi-param-size 1 retry-scsi-command
 119     \ Success ?
 120     dup 0<> IF " read-capacity" dump-scsi-error 0 0 EXIT THEN
 121     drop scratch scsi-get-capacity-10 1 +
 122 ;
 123
 124 100 CONSTANT test-unit-retries
 125
 126 \ SCSI test-unit-read
 127 : test-unit-ready ( true | [ ascq asc sense-key false ] )
 128     scsi-disk-debug? IF
 129         ." SCSI-DISK: test-unit-ready " .s cr
 130     THEN
 131     cdb scsi-build-test-unit-ready
 132     0 0 0 cdb scsi-param-size test-unit-retries retry-scsi-command
 133     \ stat == 0, return
 134     0= IF true EXIT THEN
 135     \ check sense len, no sense -> return HW error
 136     0= IF drop 0 0 4 false EXIT THEN
 137     \ get sense
 138     scsi-get-sense-data false
 139 ;
 140
 141
 142 : start-stop-unit ( state# -- true | false )
 143     scsi-disk-debug? IF
 144         ." SCSI-DISK: start-stop-unit " .s cr
 145     THEN
 146     cdb scsi-build-start-stop-unit
 147     0 0 0 cdb scsi-param-size 10 retry-scsi-command
 148     \ Success ?
 149     0= IF true ELSE 2drop false THEN
 150 ;
 151
 152 : compare-sense ( ascq asc key ascq2 asc2 key2 -- true | false )
 153     3 pick =        ( ascq asc key ascq2 asc2 keycmp )
 154     swap 4 pick =   ( ascq asc key ascq2 keycmp asccmp )
 155     rot 5 pick =    ( ascq asc key keycmp asccmp ascqcmp )
 156     and and nip nip nip
 157 ;
 158
 159 \ -------------------------\
 160 \ CDROM specific functions \
 161 \ -------------------------\
 162
 163 0 CONSTANT CDROM-READY
 164 1 CONSTANT CDROM-NOT-READY
 165 2 CONSTANT CDROM-NO-DISK
 166 3 CONSTANT CDROM-TRAY-OPEN
 167 4 CONSTANT CDROM-INIT-REQUIRED
 168 5 CONSTANT CDROM-TRAY-MAYBE-OPEN
 169
 170 : cdrom-try-close-tray ( -- )
 171     scsi-const-load start-stop-unit drop
 172 ;
 173
 174 : cdrom-must-close-tray ( -- )
 175     scsi-const-load start-stop-unit not IF
 176         ." Tray open !" cr -65 throw
 177     THEN
 178 ;
 179
 180 : get-media-event ( -- true | false )
 181     scsi-disk-debug? IF
 182         ." SCSI-DISK: get-media-event " .s cr
 183     THEN
 184     cdb scsi-build-get-media-event
 185     scratch scsi-length-media-event scsi-dir-read cdb scsi-param-size 1 retry-scsi-command
 186     \ Success ?
 187     0= IF true ELSE 2drop false THEN
 188 ;
 189
 190 : cdrom-status ( -- status )
 191     test-unit-ready
 192     IF CDROM-READY EXIT THEN
 193
 194     scsi-disk-debug? IF
 195         ." TestUnitReady sense: " 3dup . . . cr
 196     THEN
 197
 198     3dup 1 4 2 compare-sense IF
 199         3drop CDROM-NOT-READY EXIT
 200     THEN
 201
 202     get-media-event IF
 203         scratch w@ 4 >= IF
 204             scratch 2 + c@ 04 = IF
 205                 scratch 5 + c@
 206                 dup 02 and 0<> IF drop 3drop CDROM-READY EXIT THEN
 207                 dup 01 and 0<> IF drop 3drop CDROM-TRAY-OPEN EXIT THEN
 208                 drop 3drop CDROM-NO-DISK EXIT
 209             THEN
 210         THEN
 211     THEN
 212
 213     3dup 2 4 2 compare-sense IF
 214         3drop CDROM-INIT-REQUIRED EXIT
 215     THEN
 216     over 4 = over 2 = and IF
 217         \ Format in progress... what do we do ? Just ignore
 218         3drop CDROM-READY EXIT
 219     THEN
 220     over 3a = IF
 221         3drop CDROM-NO-DISK EXIT
 222     THEN
 223
 224     \ Other error...
 225     3drop CDROM-TRAY-MAYBE-OPEN
 226 ;
 227
 228 : prep-cdrom ( -- ready? )
 229     5 0 DO
 230         cdrom-status CASE
 231             CDROM-READY           OF UNLOOP true EXIT ENDOF
 232             CDROM-NO-DISK         OF ." No medium !" cr UNLOOP false EXIT ENDOF
 233             CDROM-TRAY-OPEN       OF cdrom-must-close-tray ENDOF
 234             CDROM-INIT-REQUIRED   OF cdrom-try-close-tray ENDOF
 235             CDROM-TRAY-MAYBE-OPEN OF cdrom-try-close-tray ENDOF
 236         ENDCASE
 237         d# 1000 ms
 238     LOOP
 239     ." Drive not ready !" cr false
 240 ;
 241
 242 \ ------------------------\
 243 \ Disk specific functions \
 244 \ ------------------------\
 245
 246 : prep-disk ( -- ready? )
 247     test-unit-ready not IF
 248         ." SCSI-DISK: Disk not ready ! "
 249         ." Sense " dup .sense-text ." [" . ." ]"
 250         ."  ASC " . ."  ASCQ " . cr
 251         false EXIT THEN true
 252 ;
 253
 254 \ --------------------------\
 255 \ Standard device interface \
 256 \ --------------------------\
 257
 258 : open ( -- true | false )
 259     scsi-disk-debug? IF
 260         ." SCSI-DISK: open [" .s ." ] unit is " my-unit . . ."  [" .s ." ]" cr
 261     THEN
 262     my-unit " set-address" $call-parent
 263
 264     inquiry dup 0= IF drop false EXIT THEN
 265     scsi-disk-debug? IF
 266         ." ---- inquiry: ----" cr
 267         dup 100 dump cr
 268         ." ------------------" cr
 269     THEN
 270
 271     \ Skip devices with PQ != 0
 272     dup inquiry-data>peripheral c@ e0 and 0 <> IF
 273         ." SCSI-DISK: Unsupported PQ != 0" cr
 274         false EXIT
 275     THEN
 276
 277     inquiry-data>peripheral c@ CASE
 278         5   OF true to is_cdrom ENDOF
 279         7   OF true to is_cdrom ENDOF
 280     ENDCASE
 281
 282     scsi-disk-debug? IF
 283         is_cdrom IF
 284             ." SCSI-DISK: device treated as CD-ROM" cr
 285         ELSE
 286             ." SCSI-DISK: device treated as disk" cr
 287         THEN
 288     THEN
 289
 290     is_cdrom IF prep-cdrom ELSE prep-disk THEN
 291     not IF false EXIT THEN
 292
 293     " max-transfer" $call-parent to max-transfer
 294
 295     read-capacity to max-block-num to block-size
 296     max-block-num 0= block-size 0= OR IF
 297        ." SCSI-DISK: Failed to get disk capacity!" cr
 298        FALSE EXIT
 299     THEN
 300
 301     scsi-disk-debug? IF
 302         ." Capacity: " max-block-num . ." blocks of " block-size . cr
 303     THEN
 304
 305     0 0 " deblocker" $open-package dup deblocker ! dup IF
 306         " disk-label" find-package IF
 307             my-args rot interpose
 308         THEN
 309    THEN 0<>
 310 ;
 311
 312 : close ( -- )
 313     deblocker @ close-package ;
 314
 315 : seek ( pos.lo pos.hi -- status )
 316     s" seek" deblocker @ $call-method ;
 317
 318 : read ( addr len -- actual )
 319     s" read" deblocker @ $call-method ;
 320
 321 \ Get rid of SCSI bits
 322 scsi-close
 323
 324 finish-device