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