--- /dev/null
+\ *****************************************************************************
+\ * Copyright (c) 2011 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
+\ ****************************************************************************/
+
+\ Create new VSCSI child device
+
+\ Create device
+new-device
+
+\ Set name
+s" disk" device-name
+
+s" block" device-type
+
+false VALUE scsi-disk-debug?
+
+\ Get SCSI bits
+scsi-open
+
+\ Send SCSI commands to controller
+
+: execute-scsi-command ( buf-addr buf-len dir cmd-addr cmd-len -- ... )
+ ( ... [ sense-buf sense-len ] stat )
+ " execute-scsi-command" $call-parent
+;
+
+: retry-scsi-command ( buf-addr buf-len dir cmd-addr cmd-len #retries -- ... )
+ ( ... 0 | [ sense-buf sense-len ] stat )
+ " retry-scsi-command" $call-parent
+;
+
+\ ---------------------------------\
+\ Common SCSI Commands and helpers \
+\ ---------------------------------\
+
+0 INSTANCE VALUE block-size
+0 INSTANCE VALUE max-transfer
+0 INSTANCE VALUE max-block-num
+0 INSTANCE VALUE is_cdrom
+INSTANCE VARIABLE deblocker
+
+\ This scratch area is made global for now as we only
+\ use it for small temporary commands such as inquiry
+\ read-capacity or media events
+CREATE scratch 100 allot
+CREATE cdb 10 allot
+
+: dump-scsi-error ( sense-buf sense-len stat name namelen -- )
+ ." SCSI-DISK: " my-self instance>path type ." ," type ." failed" cr
+ ." SCSI-DISK: Status " dup . .status-text
+ 0<> IF
+ ." Sense " scsi-get-sense-data dup . .sense-text
+ ." ASC " . ." ASCQ " . cr
+ ELSE drop THEN
+;
+
+: read-blocks ( addr block# #blocks -- #read )
+ scsi-disk-debug? IF
+ ." SCSI-DISK: read-blocks " .s cr
+ THEN
+
+ \ Bound check. This should probably be done by deblocker
+ \ but it doesn't at this point so do it here
+ 2dup + max-block-num > IF
+ ." SCSI-DISK: Access beyond end of device ! " cr
+ drop
+ dup max-block-num > IF
+ drop drop 0 EXIT
+ THEN
+ dup max-block-num swap -
+ THEN
+
+ dup block-size * ( addr block# #blocks len )
+ >r rot r> ( block# #blocks addr len )
+ 2swap ( addr len block# #blocks )
+ dup >r
+ cdb scsi-build-read-10 ( addr len )
+ r> -rot ( #blocks addr len )
+ scsi-dir-read cdb scsi-param-size 10
+ retry-scsi-command
+ ( #blocks [ sense-buf sense-len ] stat )
+ dup 0<> IF " read-blocks" dump-scsi-error -65 throw ELSE drop THEN
+;
+
+: (inquiry) ( size -- buffer | NULL )
+ dup cdb scsi-build-inquiry
+ \ 16 retries for inquiry to flush out any UAs
+ scratch swap scsi-dir-read cdb scsi-param-size 10 retry-scsi-command
+ \ Success ?
+ 0= IF scratch ELSE 2drop 0 THEN
+;
+
+: inquiry ( -- buffer | NULL )
+ scsi-disk-debug? IF
+ ." SCSI-DISK: inquiry " .s cr
+ THEN
+ d# 36 (inquiry) 0= IF 0 EXIT THEN
+ scratch inquiry-data>add-length c@ 5 +
+ (inquiry)
+;
+
+: read-capacity ( -- blocksize #blocks )
+ \ Now issue the read-capacity command
+ scsi-disk-debug? IF
+ ." SCSI-DISK: read-capacity " .s cr
+ THEN
+ \ Make sure that there are zeros in the buffer in case something goes wrong:
+ scratch 10 erase
+ cdb scsi-build-read-cap-10 scratch scsi-length-read-cap-10-data scsi-dir-read
+ cdb scsi-param-size 1 retry-scsi-command
+ \ Success ?
+ dup 0<> IF " read-capacity" dump-scsi-error 0 0 EXIT THEN
+ drop scratch scsi-get-capacity-10 1 +
+;
+
+100 CONSTANT test-unit-retries
+
+\ SCSI test-unit-read
+: test-unit-ready ( true | [ ascq asc sense-key false ] )
+ scsi-disk-debug? IF
+ ." SCSI-DISK: test-unit-ready " .s cr
+ THEN
+ cdb scsi-build-test-unit-ready
+ 0 0 0 cdb scsi-param-size test-unit-retries retry-scsi-command
+ \ stat == 0, return
+ 0= IF true EXIT THEN
+ \ check sense len, no sense -> return HW error
+ 0= IF drop 0 0 4 false EXIT THEN
+ \ get sense
+ scsi-get-sense-data false
+;
+
+
+: start-stop-unit ( state# -- true | false )
+ scsi-disk-debug? IF
+ ." SCSI-DISK: start-stop-unit " .s cr
+ THEN
+ cdb scsi-build-start-stop-unit
+ 0 0 0 cdb scsi-param-size 10 retry-scsi-command
+ \ Success ?
+ 0= IF true ELSE 2drop false THEN
+;
+
+: compare-sense ( ascq asc key ascq2 asc2 key2 -- true | false )
+ 3 pick = ( ascq asc key ascq2 asc2 keycmp )
+ swap 4 pick = ( ascq asc key ascq2 keycmp asccmp )
+ rot 5 pick = ( ascq asc key keycmp asccmp ascqcmp )
+ and and nip nip nip
+;
+
+\ -------------------------\
+\ CDROM specific functions \
+\ -------------------------\
+
+0 CONSTANT CDROM-READY
+1 CONSTANT CDROM-NOT-READY
+2 CONSTANT CDROM-NO-DISK
+3 CONSTANT CDROM-TRAY-OPEN
+4 CONSTANT CDROM-INIT-REQUIRED
+5 CONSTANT CDROM-TRAY-MAYBE-OPEN
+
+: cdrom-try-close-tray ( -- )
+ scsi-const-load start-stop-unit drop
+;
+
+: cdrom-must-close-tray ( -- )
+ scsi-const-load start-stop-unit not IF
+ ." Tray open !" cr -65 throw
+ THEN
+;
+
+: get-media-event ( -- true | false )
+ scsi-disk-debug? IF
+ ." SCSI-DISK: get-media-event " .s cr
+ THEN
+ cdb scsi-build-get-media-event
+ scratch scsi-length-media-event scsi-dir-read cdb scsi-param-size 1 retry-scsi-command
+ \ Success ?
+ 0= IF true ELSE 2drop false THEN
+;
+
+: cdrom-status ( -- status )
+ test-unit-ready
+ IF CDROM-READY EXIT THEN
+
+ scsi-disk-debug? IF
+ ." TestUnitReady sense: " 3dup . . . cr
+ THEN
+
+ 3dup 1 4 2 compare-sense IF
+ 3drop CDROM-NOT-READY EXIT
+ THEN
+
+ get-media-event IF
+ scratch w@ 4 >= IF
+ scratch 2 + c@ 04 = IF
+ scratch 5 + c@
+ dup 02 and 0<> IF drop 3drop CDROM-READY EXIT THEN
+ dup 01 and 0<> IF drop 3drop CDROM-TRAY-OPEN EXIT THEN
+ drop 3drop CDROM-NO-DISK EXIT
+ THEN
+ THEN
+ THEN
+
+ 3dup 2 4 2 compare-sense IF
+ 3drop CDROM-INIT-REQUIRED EXIT
+ THEN
+ over 4 = over 2 = and IF
+ \ Format in progress... what do we do ? Just ignore
+ 3drop CDROM-READY EXIT
+ THEN
+ over 3a = IF
+ 3drop CDROM-NO-DISK EXIT
+ THEN
+
+ \ Other error...
+ 3drop CDROM-TRAY-MAYBE-OPEN
+;
+
+: prep-cdrom ( -- ready? )
+ 5 0 DO
+ cdrom-status CASE
+ CDROM-READY OF UNLOOP true EXIT ENDOF
+ CDROM-NO-DISK OF ." No medium !" cr UNLOOP false EXIT ENDOF
+ CDROM-TRAY-OPEN OF cdrom-must-close-tray ENDOF
+ CDROM-INIT-REQUIRED OF cdrom-try-close-tray ENDOF
+ CDROM-TRAY-MAYBE-OPEN OF cdrom-try-close-tray ENDOF
+ ENDCASE
+ d# 1000 ms
+ LOOP
+ ." Drive not ready !" cr false
+;
+
+\ ------------------------\
+\ Disk specific functions \
+\ ------------------------\
+
+: prep-disk ( -- ready? )
+ test-unit-ready not IF
+ ." SCSI-DISK: Disk not ready ! "
+ ." Sense " dup .sense-text ." [" . ." ]"
+ ." ASC " . ." ASCQ " . cr
+ false EXIT THEN true
+;
+
+\ --------------------------\
+\ Standard device interface \
+\ --------------------------\
+
+: open ( -- true | false )
+ scsi-disk-debug? IF
+ ." SCSI-DISK: open [" .s ." ] unit is " my-unit . . ." [" .s ." ]" cr
+ THEN
+ my-unit " set-address" $call-parent
+
+ inquiry dup 0= IF drop false EXIT THEN
+ scsi-disk-debug? IF
+ ." ---- inquiry: ----" cr
+ dup 100 dump cr
+ ." ------------------" cr
+ THEN
+
+ \ Skip devices with PQ != 0
+ dup inquiry-data>peripheral c@ e0 and 0 <> IF
+ ." SCSI-DISK: Unsupported PQ != 0" cr
+ false EXIT
+ THEN
+
+ inquiry-data>peripheral c@ CASE
+ 5 OF true to is_cdrom ENDOF
+ 7 OF true to is_cdrom ENDOF
+ ENDCASE
+
+ scsi-disk-debug? IF
+ is_cdrom IF
+ ." SCSI-DISK: device treated as CD-ROM" cr
+ ELSE
+ ." SCSI-DISK: device treated as disk" cr
+ THEN
+ THEN
+
+ is_cdrom IF prep-cdrom ELSE prep-disk THEN
+ not IF false EXIT THEN
+
+ " max-transfer" $call-parent to max-transfer
+
+ read-capacity to max-block-num to block-size
+ max-block-num 0= block-size 0= OR IF
+ ." SCSI-DISK: Failed to get disk capacity!" cr
+ FALSE EXIT
+ THEN
+
+ scsi-disk-debug? IF
+ ." Capacity: " max-block-num . ." blocks of " block-size . cr
+ THEN
+
+ 0 0 " deblocker" $open-package dup deblocker ! dup IF
+ " disk-label" find-package IF
+ my-args rot interpose
+ THEN
+ THEN 0<>
+;
+
+: close ( -- )
+ deblocker @ close-package ;
+
+: seek ( pos.lo pos.hi -- status )
+ s" seek" deblocker @ $call-method ;
+
+: read ( addr len -- actual )
+ s" read" deblocker @ $call-method ;
+
+\ Get rid of SCSI bits
+scsi-close
+
+finish-device
Code Review / kvmfornfv.git / blobdiff