summaryrefslogtreecommitdiffstats
path: root/qemu/roms/SLOF/slof/fs/scsi-disk.fs
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