390 lines
11 KiB
Forth
390 lines
11 KiB
Forth
\ *****************************************************************************
|
|
\ * 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 ( addr len block# #blocks cdb )
|
|
max-block-num FFFFFFFF > IF
|
|
scsi-build-read-16 ( addr len )
|
|
ELSE
|
|
scsi-build-read-10 ( addr len )
|
|
THEN
|
|
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
|
|
;
|
|
|
|
: write-blocks ( addr block# #blocks -- #written )
|
|
scsi-disk-debug? IF
|
|
." SCSI-DISK: write-blocks " .s cr
|
|
THEN
|
|
|
|
\ Do not allow writes to the partition table (GPT is in first 34 sectors)
|
|
over 22 < IF
|
|
." SCSI-DISK ERROR: Write access to partition table is not allowed." cr
|
|
3drop 0 EXIT
|
|
THEN
|
|
|
|
\ Bound check
|
|
2dup + max-block-num > IF
|
|
." SCSI-DISK: Access beyond end of device ! " cr
|
|
3drop 0 EXIT
|
|
THEN
|
|
|
|
dup block-size * ( addr block# #blocks len )
|
|
>r rot r> ( block# #blocks addr len )
|
|
2swap ( addr len block# #blocks )
|
|
dup >r
|
|
cdb ( addr len block# #blocks cdb )
|
|
max-block-num FFFFFFFF > IF
|
|
scsi-build-write-16
|
|
ELSE
|
|
scsi-build-write-10
|
|
THEN
|
|
r> -rot ( #blocks addr len )
|
|
scsi-dir-write cdb scsi-param-size 10
|
|
retry-scsi-command
|
|
( #blocks [ sense-buf sense-len ] stat )
|
|
dup 0<> IF s" write-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 +
|
|
;
|
|
|
|
: read-capacity-16 ( -- blocksize #blocks )
|
|
\ Now issue the read-capacity-16 command
|
|
scsi-disk-debug? IF
|
|
." SCSI-DISK: read-capacity-16 " .s cr
|
|
THEN
|
|
\ Make sure that there are zeros in the buffer in case something goes wrong:
|
|
scratch scsi-length-read-cap-16-data erase
|
|
cdb scsi-build-read-cap-16 scratch scsi-length-read-cap-16-data scsi-dir-read
|
|
cdb scsi-param-size 1 retry-scsi-command
|
|
\ Success ?
|
|
dup 0<> IF " read-capacity-16" dump-scsi-error 0 0 EXIT THEN
|
|
drop scratch scsi-get-capacity-16 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
|
|
\ Ignore 7f, since this simply means that the target
|
|
\ is not supporting a peripheral device at this LUN.
|
|
inquiry-data>peripheral c@ 7f <> IF
|
|
." SCSI-DISK: Unsupported PQ != 0" cr
|
|
THEN
|
|
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
|
|
\ Check if read-capacity-10 hit the maximum value 0xFFFF.FFFF
|
|
max-block-num 100000000 = IF
|
|
read-capacity-16 to max-block-num to block-size
|
|
THEN
|
|
|
|
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 ;
|
|
|
|
: write ( addr len -- actual )
|
|
s" write" deblocker @ $call-method
|
|
;
|
|
|
|
\ Get rid of SCSI bits
|
|
scsi-close
|
|
|
|
finish-device
|