1 \ *****************************************************************************
2 \ * Copyright (c) 2011 IBM Corporation
3 \ * All rights reserved.
4 \ * This program and the accompanying materials
5 \ * are made available under the terms of the BSD License
6 \ * which accompanies this distribution, and is available at
7 \ * http://www.opensource.org/licenses/bsd-license.php
10 \ * IBM Corporation - initial implementation
11 \ ****************************************************************************/
13 \ Create new VSCSI child device
23 false VALUE scsi-disk-debug?
28 \ Send SCSI commands to controller
30 : execute-scsi-command ( buf-addr buf-len dir cmd-addr cmd-len -- ... )
31 ( ... [ sense-buf sense-len ] stat )
32 " execute-scsi-command" $call-parent
35 : retry-scsi-command ( buf-addr buf-len dir cmd-addr cmd-len #retries -- ... )
36 ( ... 0 | [ sense-buf sense-len ] stat )
37 " retry-scsi-command" $call-parent
40 \ ---------------------------------\
41 \ Common SCSI Commands and helpers \
42 \ ---------------------------------\
44 0 INSTANCE VALUE block-size
45 0 INSTANCE VALUE max-transfer
46 0 INSTANCE VALUE max-block-num
47 0 INSTANCE VALUE is_cdrom
48 INSTANCE VARIABLE deblocker
50 \ This scratch area is made global for now as we only
51 \ use it for small temporary commands such as inquiry
52 \ read-capacity or media events
53 CREATE scratch 100 allot
56 : dump-scsi-error ( sense-buf sense-len stat name namelen -- )
57 ." SCSI-DISK: " my-self instance>path type ." ," type ." failed" cr
58 ." SCSI-DISK: Status " dup . .status-text
60 ." Sense " scsi-get-sense-data dup . .sense-text
61 ." ASC " . ." ASCQ " . cr
65 : read-blocks ( addr block# #blocks -- #read )
67 ." SCSI-DISK: read-blocks " .s cr
70 \ Bound check. This should probably be done by deblocker
71 \ but it doesn't at this point so do it here
72 2dup + max-block-num > IF
73 ." SCSI-DISK: Access beyond end of device ! " cr
75 dup max-block-num > IF
78 dup max-block-num swap -
81 dup block-size * ( addr block# #blocks len )
82 >r rot r> ( block# #blocks addr len )
83 2swap ( addr len block# #blocks )
85 cdb scsi-build-read-10 ( addr len )
86 r> -rot ( #blocks addr len )
87 scsi-dir-read cdb scsi-param-size 10
89 ( #blocks [ sense-buf sense-len ] stat )
90 dup 0<> IF " read-blocks" dump-scsi-error -65 throw ELSE drop THEN
93 : (inquiry) ( size -- buffer | NULL )
94 dup cdb scsi-build-inquiry
95 \ 16 retries for inquiry to flush out any UAs
96 scratch swap scsi-dir-read cdb scsi-param-size 10 retry-scsi-command
98 0= IF scratch ELSE 2drop 0 THEN
101 : inquiry ( -- buffer | NULL )
103 ." SCSI-DISK: inquiry " .s cr
105 d# 36 (inquiry) 0= IF 0 EXIT THEN
106 scratch inquiry-data>add-length c@ 5 +
110 : read-capacity ( -- blocksize #blocks )
111 \ Now issue the read-capacity command
113 ." SCSI-DISK: read-capacity " .s cr
115 \ Make sure that there are zeros in the buffer in case something goes wrong:
117 cdb scsi-build-read-cap-10 scratch scsi-length-read-cap-10-data scsi-dir-read
118 cdb scsi-param-size 1 retry-scsi-command
120 dup 0<> IF " read-capacity" dump-scsi-error 0 0 EXIT THEN
121 drop scratch scsi-get-capacity-10 1 +
124 100 CONSTANT test-unit-retries
126 \ SCSI test-unit-read
127 : test-unit-ready ( true | [ ascq asc sense-key false ] )
129 ." SCSI-DISK: test-unit-ready " .s cr
131 cdb scsi-build-test-unit-ready
132 0 0 0 cdb scsi-param-size test-unit-retries retry-scsi-command
135 \ check sense len, no sense -> return HW error
136 0= IF drop 0 0 4 false EXIT THEN
138 scsi-get-sense-data false
142 : start-stop-unit ( state# -- true | false )
144 ." SCSI-DISK: start-stop-unit " .s cr
146 cdb scsi-build-start-stop-unit
147 0 0 0 cdb scsi-param-size 10 retry-scsi-command
149 0= IF true ELSE 2drop false THEN
152 : compare-sense ( ascq asc key ascq2 asc2 key2 -- true | false )
153 3 pick = ( ascq asc key ascq2 asc2 keycmp )
154 swap 4 pick = ( ascq asc key ascq2 keycmp asccmp )
155 rot 5 pick = ( ascq asc key keycmp asccmp ascqcmp )
159 \ -------------------------\
160 \ CDROM specific functions \
161 \ -------------------------\
163 0 CONSTANT CDROM-READY
164 1 CONSTANT CDROM-NOT-READY
165 2 CONSTANT CDROM-NO-DISK
166 3 CONSTANT CDROM-TRAY-OPEN
167 4 CONSTANT CDROM-INIT-REQUIRED
168 5 CONSTANT CDROM-TRAY-MAYBE-OPEN
170 : cdrom-try-close-tray ( -- )
171 scsi-const-load start-stop-unit drop
174 : cdrom-must-close-tray ( -- )
175 scsi-const-load start-stop-unit not IF
176 ." Tray open !" cr -65 throw
180 : get-media-event ( -- true | false )
182 ." SCSI-DISK: get-media-event " .s cr
184 cdb scsi-build-get-media-event
185 scratch scsi-length-media-event scsi-dir-read cdb scsi-param-size 1 retry-scsi-command
187 0= IF true ELSE 2drop false THEN
190 : cdrom-status ( -- status )
192 IF CDROM-READY EXIT THEN
195 ." TestUnitReady sense: " 3dup . . . cr
198 3dup 1 4 2 compare-sense IF
199 3drop CDROM-NOT-READY EXIT
204 scratch 2 + c@ 04 = IF
206 dup 02 and 0<> IF drop 3drop CDROM-READY EXIT THEN
207 dup 01 and 0<> IF drop 3drop CDROM-TRAY-OPEN EXIT THEN
208 drop 3drop CDROM-NO-DISK EXIT
213 3dup 2 4 2 compare-sense IF
214 3drop CDROM-INIT-REQUIRED EXIT
216 over 4 = over 2 = and IF
217 \ Format in progress... what do we do ? Just ignore
218 3drop CDROM-READY EXIT
221 3drop CDROM-NO-DISK EXIT
225 3drop CDROM-TRAY-MAYBE-OPEN
228 : prep-cdrom ( -- ready? )
231 CDROM-READY OF UNLOOP true EXIT ENDOF
232 CDROM-NO-DISK OF ." No medium !" cr UNLOOP false EXIT ENDOF
233 CDROM-TRAY-OPEN OF cdrom-must-close-tray ENDOF
234 CDROM-INIT-REQUIRED OF cdrom-try-close-tray ENDOF
235 CDROM-TRAY-MAYBE-OPEN OF cdrom-try-close-tray ENDOF
239 ." Drive not ready !" cr false
242 \ ------------------------\
243 \ Disk specific functions \
244 \ ------------------------\
246 : prep-disk ( -- ready? )
247 test-unit-ready not IF
248 ." SCSI-DISK: Disk not ready ! "
249 ." Sense " dup .sense-text ." [" . ." ]"
250 ." ASC " . ." ASCQ " . cr
254 \ --------------------------\
255 \ Standard device interface \
256 \ --------------------------\
258 : open ( -- true | false )
260 ." SCSI-DISK: open [" .s ." ] unit is " my-unit . . ." [" .s ." ]" cr
262 my-unit " set-address" $call-parent
264 inquiry dup 0= IF drop false EXIT THEN
266 ." ---- inquiry: ----" cr
268 ." ------------------" cr
271 \ Skip devices with PQ != 0
272 dup inquiry-data>peripheral c@ e0 and 0 <> IF
273 ." SCSI-DISK: Unsupported PQ != 0" cr
277 inquiry-data>peripheral c@ CASE
278 5 OF true to is_cdrom ENDOF
279 7 OF true to is_cdrom ENDOF
284 ." SCSI-DISK: device treated as CD-ROM" cr
286 ." SCSI-DISK: device treated as disk" cr
290 is_cdrom IF prep-cdrom ELSE prep-disk THEN
291 not IF false EXIT THEN
293 " max-transfer" $call-parent to max-transfer
295 read-capacity to max-block-num to block-size
296 max-block-num 0= block-size 0= OR IF
297 ." SCSI-DISK: Failed to get disk capacity!" cr
302 ." Capacity: " max-block-num . ." blocks of " block-size . cr
305 0 0 " deblocker" $open-package dup deblocker ! dup IF
306 " disk-label" find-package IF
307 my-args rot interpose
313 deblocker @ close-package ;
315 : seek ( pos.lo pos.hi -- status )
316 s" seek" deblocker @ $call-method ;
318 : read ( addr len -- actual )
319 s" read" deblocker @ $call-method ;
321 \ Get rid of SCSI bits