blob: 197847147cf0d18bf6321f5172c1e665b601679a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
|
\ *****************************************************************************
\ * 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
|
