\ *****************************************************************************
\ * 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