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