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
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
|
\ *****************************************************************************
\ * Copyright (c) 2004, 2008 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
\ ****************************************************************************/
\
\ 26.06.2007 added: two devices (Master/Slave) per channel
1 encode-int s" #address-cells" property
0 encode-int s" #size-cells" property
: decode-unit 1 hex-decode-unit ;
: encode-unit 1 hex-encode-unit ;
0 VALUE >ata \ base address for command-block
0 VALUE >ata1 \ base address for control block
true VALUE no-timeout \ flag that no timeout occurred
0c CONSTANT #cdb-bytes \ command descriptor block (12 bytes)
800 CONSTANT atapi-size
200 CONSTANT ata-size
\ *****************************
\ Some register access helpers.
\ *****************************
: ata-ctrl! 2 >ata1 + io-c! ; \ device control reg
: ata-astat@ 2 >ata1 + io-c@ ; \ read alternate status
: ata-data@ 0 >ata + io-w@ ; \ data reg
: ata-data! 0 >ata + io-w! ; \ data reg
: ata-err@ 1 >ata + io-c@ ; \ error reg
: ata-feat! 1 >ata + io-c! ; \ feature reg
: ata-cnt@ 2 >ata + io-c@ ; \ sector count reg
: ata-cnt! 2 >ata + io-c! ; \ sector count reg
: ata-lbal! 3 >ata + io-c! ; \ lba low reg
: ata-lbal@ 3 >ata + io-c@ ; \ lba low reg
: ata-lbam! 4 >ata + io-c! ; \ lba mid reg
: ata-lbam@ 4 >ata + io-c@ ; \ lba mid reg
: ata-lbah! 5 >ata + io-c! ; \ lba high reg
: ata-lbah@ 5 >ata + io-c@ ; \ lba high reg
: ata-dev! 6 >ata + io-c! ; \ device reg
: ata-dev@ 6 >ata + io-c@ ; \ device reg
: ata-cmd! 7 >ata + io-c! ; \ command reg
: ata-stat@ 7 >ata + io-c@ ; \ status reg
\ **********************************************************************
\ ATA / ATAPI Commands specifications:
\ - AT Attachment 8 - ATA/ATAPI Command Set (ATA8-ACS)
\ - ATA Packet Interface for CD-ROMs SFF-8020i
\ - ATA/ATAPI Host Adapters Standard (T13/1510D)
\ **********************************************************************
00 CONSTANT cmd#nop \ ATA and ATAPI
08 CONSTANT cmd#device-reset \ ATAPI only (mandatory)
20 CONSTANT cmd#read-sector \ ATA and ATAPI
90 CONSTANT cmd#execute-device-diagnostic \ ATA and ATAPI
a0 CONSTANT cmd#packet \ ATAPI only (mandatory)
a1 CONSTANT cmd#identify-packet-device \ ATAPI only (mandatory)
ec CONSTANT cmd#identify-device \ ATA and ATAPI
\ *****************************
\ Setup Regs for ATA:
\ BAR 0 & 1 : Device 0
\ BAR 2 & 3 : Device 1
\ *****************************
: set-regs ( n -- )
dup
01 and \ only Chan 0 or Chan 1 allowed
3 lshift dup 10 + config-l@ -4 and to >ata
14 + config-l@ -4 and to >ata1
02 ata-ctrl! \ disable interrupts
02 and
IF
10
ELSE
00
THEN
ata-dev!
;
ata-size VALUE block-size
80000 VALUE max-transfer \ Arbitrary, really
CREATE sector d# 512 allot
CREATE packet-cdb #cdb-bytes allot
CREATE return-buffer atapi-size allot
scsi-open \ add scsi functions
\ ********************************
\ show all ATAPI-registers
\ data-register not read in order
\ to not influence PIO mode
\ ********************************
: show-regs
cr
cr ." alt. Status: " ata-astat@ .
cr ." Status : " ata-stat@ .
cr ." Device : " ata-dev@ .
cr ." Error-Reg : " ata-err@ .
cr ." Sect-Count : " ata-cnt@ .
cr ." LBA-Low : " ata-lbal@ .
cr ." LBA-Med : " ata-lbam@ .
cr ." LBA-High : " ata-lbah@ .
;
\ ***************************************************
\ reads ATAPI-Status and displays it if check-bit set
\ ***************************************************
: status-check ( -- )
ata-stat@
dup
01 and \ is 'check' flag set ?
IF
cr
." - ATAPI-Status: " .
ata-err@ \ retrieve sense code
dup
60 = \ sense code = 6 ?
IF
." ( media changed or reset )" \ 'unit attention'
drop \ drop err-reg content
ELSE
dup
." (Err : " . \ show err-reg content
space
rshift 4 .sense-text \ show text string
29 emit
THEN
cr
ELSE
drop \ remove unused status
THEN
;
\ *************************************
\ Wait for interface ready condition
\ Bit 7 of Status-Register is busy flag
\ new version with abort after 5 sec.
\ *************************************
: wait-for-ready
get-msecs \ start timer
BEGIN
ata-stat@ 80 and 0<> \ busy flag still set ?
no-timeout and
WHILE \ yes
dup get-msecs swap
- \ calculate timer difference
FFFF AND \ reduce to 65.5 seconds
d# 5000 > \ difference > 5 seconds ?
IF
false to no-timeout
THEN
REPEAT
drop
;
\ *************************************
\ wait for specific status bits
\ new version with abort after 5 sec.
\ *************************************
: wait-for-status ( val mask -- )
get-msecs \ initial timer value (start)
>r
BEGIN
2dup \ val mask
ata-stat@ and <> \ expected status ?
no-timeout and \ and no timeout ?
WHILE
get-msecs r@ - \ calculate timer difference
FFFF AND \ mask-off overflow bits
d# 5000 > \ 5 seconds exceeded ?
IF
false to no-timeout \ set global flag
THEN
REPEAT
r> \ clean return stack
3drop
;
\ *********************************
\ remove extra spaces from string end
\ *********************************
: cut-string ( saddr nul -- )
swap
over +
swap
1 rshift \ bytecount -> wordcount
0 do
/w -
dup ( addr -- addr addr )
w@ ( addr addr -- addr nuw )
dup ( addr nuw -- addr nuw nuw )
2020 =
IF
drop
0
ELSE
LEAVE
THEN
over
w!
LOOP
drop
drop
;
\ ****************************************************
\ prints model-string received by identify device
\ ****************************************************
: show-model ( dev# chan# -- )
2dup
." CH " . \ channel 0 / 1
0= IF ." / MA" \ Master / Slave
ELSE ." / SL"
THEN
swap
2 * + ." (@" . ." ) : " \ device number
sector 1 +
c@
80 AND 0=
IF
." ATA-Drive "
ELSE
." ATAPI-Drive "
THEN
22 emit \ start string display with "
sector d# 54 + \ string starts 54 bytes from buffer start
dup
d# 40 \ and is 40 chars long
cut-string \ remove all trailing spaces
BEGIN
dup
w@
wbflip
wbsplit
dup 0<> \ first char
IF
emit
dup 0<> \ second char
IF
emit
wa1+ \ increment address for next
false
ELSE \ second char = EndOfString
drop
true
THEN
ELSE \ first char = EndOfString
drop
drop
true
THEN
UNTIL \ end of string detected
drop
22 emit \ end string display
sector c@ \ get lower byte of first doublet
80 AND \ check bit 7
IF
." (removable media)"
THEN
sector 1 +
c@
80 AND 0= IF \ is this an ATA drive ?
sector d# 120 + \ get word 60 + 61
rl@-le \ read 32-bit as little endian value
d# 512 \ standard ATA block-size
swap
.capacity-text ( block-size #blocks -- )
THEN
sector d# 98 + \ goto word 49
w@
wbflip
200 and 0= IF cr ." ** LBA is not supported " THEN
sector c@ \ get lower byte of first doublet
03 AND 01 = \ we use 12-byte packet commands (=00b)
IF
cr ." packet size = 16 ** not supported ! **"
THEN
no-timeout not \ any timeout occurred so far ?
IF
cr ." ** timeout **"
THEN
;
\ ****************************
\ ATA functions
\ ****************************
: pio-sector ( addr -- ) 100 0 DO ata-data@
over w! wa1+ LOOP drop ;
: pio-sector ( addr -- )
wait-for-ready pio-sector ;
: pio-sectors ( n addr -- ) swap 0 ?DO dup pio-sector 200 + LOOP drop ;
: lba! lbsplit
0f and 40 or \ always set LBA-mode + LBA (27..24)
ata-dev@ 10 and or \ add current device-bit (DEV)
ata-dev! \ set LBA (27..24)
ata-lbah! \ set LBA (23..16)
ata-lbam! \ set LBA (15..8)
ata-lbal! \ set LBA (7..0)
;
: read-sectors ( lba count addr -- )
>r dup >r ata-cnt! lba! 20 ata-cmd! r> r> pio-sectors ;
: read-sectors ( lba count addr dev-nr -- )
set-regs ( lba count addr ) \ Set ata regs
BEGIN >r dup 100 > WHILE
over 100 r@ read-sectors
>r 100 + r> 100 - r> 20000 + REPEAT
r> read-sectors
;
: ata-read-blocks ( addr block# #blocks dev# -- #read )
swap dup >r swap >r rot r> ( addr block# #blocks dev # R: #blocks )
read-sectors r> ( R: #read )
;
\ *******************************
\ ATAPI functions
\ preset LBA register with maximum
\ allowed block-size (16-bits)
\ *******************************
: set-lba ( block-length -- )
lbsplit ( quad -- b1.lo b2 b3 b4.hi )
drop \ skip upper two bytes
drop
ata-lbah!
ata-lbam!
;
\ *******************************************
\ gets byte-count and reads a block of words
\ from data-register to a buffer
\ *******************************************
: read-pio-block ( buff-addr -- buff-addr-new )
ata-lbah@ 8 lshift \ get block length High
ata-lbam@ or \ get block length Low
1 rshift \ bcount -> wcount
dup
0> IF \ any data to transfer?
0 DO \ words to read
dup \ buffer-address
ata-data@ swap w! \ write 16-bits
wa1+ \ address of next entry
LOOP
ELSE
drop ( buff-addr wcount -- buff-addr )
THEN
wait-for-ready
;
\ ********************************************
\ ATAPI support
\ Send a command block (12 bytes) in PIO mode
\ read data if requested
\ ********************************************
: send-atapi-packet ( req-buffer -- )
>r ( R: req-buffer )
atapi-size set-lba \ set regs to length limit
00 ata-feat!
cmd#packet ata-cmd! \ A0 = ATAPI packet command
48 C8 wait-for-status ( val mask -- ) \ BSY:0 DRDY:1 DRQ:1
6 0 do
packet-cdb i 2 * + \ transfer command block (12 bytes)
w@
ata-data! \ 6 doublets PIO transfer to device
loop \ copy packet to data-reg
status-check ( -- ) \ status err bit set ? -> display
wait-for-ready ( -- ) \ busy released ?
BEGIN
ata-stat@ 08 and 08 = WHILE \ Data-Request-Bit set ?
r> \ get last target buffer address
read-pio-block \ only if from device requested
>r \ start of next block
REPEAT
r> \ original value
drop \ return clean
;
: atapi-packet-io ( -- )
return-buffer atapi-size erase \ clear return buffer
return-buffer send-atapi-packet \ send 'packet-cdb' , get 'return-buffer'
;
\ ********************************
\ ATAPI packet commands
\ ********************************
\ Methods to access atapi disk
: atapi-test ( -- true|false )
packet-cdb scsi-build-test-unit-ready \ command-code: 00
atapi-packet-io ( ) \ send CDB, get return-buffer
ata-stat@ 1 and IF false ELSE true THEN
;
: atapi-sense ( -- ascq asc sense-key )
d# 252 packet-cdb scsi-build-request-sense ( alloc-len cdb -- )
atapi-packet-io ( ) \ send CDB, get return-buffer
return-buffer scsi-get-sense-data ( cdb-addr -- ascq asc sense-key )
;
: atapi-read-blocks ( address block# #blocks dev# -- #read-blocks )
set-regs ( address block# #blocks )
dup >r ( address block# #blocks )
packet-cdb scsi-build-read-10 ( address block# #blocks cdb -- )
send-atapi-packet ( address -- )
r> \ return requested number of blocks
;
\ ***************************************
\ read capacity of drive medium
\ use SCSI-Support Package
\ ***************************************
: atapi-read-capacity ( -- )
packet-cdb scsi-build-read-cap-10 \ fill block with command
atapi-packet-io ( ) \ send CDB, get return-buffer
return-buffer scsi-get-capacity-10 ( cdb -- block-size #blocks )
.capacity-text ( block-size #blocks -- )
status-check ( -- )
;
\ ***************************************
\ read capacity of drive medium
\ use SCSI-Support Package
\ ***************************************
: atapi-read-capacity-ext ( -- )
packet-cdb scsi-build-read-cap-16 \ fill block with command
atapi-packet-io ( ) \ send CDB, get return-buffer
return-buffer scsi-get-capacity-16 ( cdb -- block-size #blocks )
.capacity-text ( block-size #blocks -- )
status-check ( -- )
;
\ ***********************************************
\ wait until media in drive is ready ( max 5 sec)
\ ***********************************************
: wait-for-media-ready ( -- true|false )
get-msecs \ initial timer value (start)
>r
BEGIN
atapi-test \ unit ready? false if not
not
no-timeout and
WHILE
atapi-sense ( -- ascq asc sense-key )
02 = \ sense key 2 = media error
IF \ check add. sense code
3A = \ asc: device not ready ?
IF
false to no-timeout
." empty (" . 29 emit \ show asc qualifier
ELSE
drop \ discard asc qualifier
THEN \ medium not present, abort waiting
ELSE
drop \ discard asc
drop \ discard ascq
THEN
get-msecs r@ - \ calculate timer difference
FFFF AND \ mask-off overflow bits
d# 5000 > \ 5 seconds exceeded ?
IF
false to no-timeout \ set global flag
THEN
REPEAT
r>
drop
no-timeout
;
\ ******************************************************
\ Method pointer for read-blocks methods
\ controller implements 2 channels (primary / secondary)
\ for 2 devices each (master / slasve)
\ ******************************************************
\ 2 channels (primary/secondary) per controller
2 CONSTANT #chan
\ 2 devices (master/slave) per channel
2 CONSTANT #dev
\ results in a total of devices
\ connected to a controller with
\ two separate channels (4)
: #totaldev #dev #chan * ;
CREATE read-blocks-xt #totaldev cells allot read-blocks-xt #totaldev cells erase
\ Execute read-blocks of device
: dev-read-blocks ( address block# #blocks dev# -- #read-blocks )
dup cells read-blocks-xt + @ execute
;
\ **********************************************************
\ Read device type
\ Signature ATAPI ATA
\ ---------------------------------------------
\ Sector Count 01h 01h
\ Sector Number 01h 01h
\ Cylinder Low 14h 00h
\ Cylinder High EBh 00h
\ Device/Head 00h or 10h 00h or 01h
\ see also ATA/ATAPI errata at:
\ http://suif.stanford.edu/~csapuntz/blackmagic.html
\ **********************************************************
: read-ident ( -- true|false )
false
00 ata-lbal! \ clear previous signature
00 ata-lbam!
00 ata-lbah!
cmd#identify-device ata-cmd! wait-for-ready \ first try ATA, ATAPI aborts command
ata-stat@ CF and 48 =
IF
drop true \ cmd accepted, this is a ATA
d# 512 set-lba \ set LBA to sector-length
ELSE \ ATAPI sends signature instead
ata-lbam@ 14 = IF \ cylinder low = 14 ?
ata-lbah@ EB = IF \ cylinder high = EB ?
cmd#device-reset ata-cmd! wait-for-ready \ only supported by ATAPI
cmd#identify-packet-device ata-cmd! wait-for-ready \ first try ata
ata-stat@ CF and 48 = IF
drop true \ replace flag
THEN
THEN
THEN
THEN
dup IF
ata-stat@ 8 AND IF \ data requested (as expected) ?
sector read-pio-block
drop \ discard address end
ELSE
drop false
THEN
THEN
no-timeout not IF \ check without any timeout ?
drop
false \ no, detection discarded
THEN
;
scsi-close \ remove scsi commands from word list
\ *************************************************
\ Init controller ( chan 0 and 1 )
\ device 0 (= master) and device 1 ( = slave)
\ #dev #chan Dev-ID
\ ----------------------
\ 0 0 0 Master of Channel 0
\ 0 1 1 Master of Channel 1
\ 1 0 2 Slave of Channel 0
\ 1 1 3 Slave of Channel 1
\ *************************************************
: find-disks ( -- )
#chan 0 DO \ check 2 channels (primary & secondary)
#dev 0 DO \ check 2 devices per channel (master / slave)
i 2 * j +
set-regs \ set base address and dev-register for register access
ata-stat@ 7f and 7f <> \ Check, if device is connected
IF
true to no-timeout \ preset timeout-flag
read-ident ( -- true|false )
IF
i j show-model \ print manufacturer + device string
sector 1+ c@ C0 and 80 = \ Check for ata or atapi
IF
wait-for-media-ready \ wait up to 5 sec if not ready
no-timeout and
IF
atapi-read-capacity
atapi-size to block-size \ ATAPI: 2048 bytes
80000 to max-transfer
['] atapi-read-blocks i 2 * j + cells read-blocks-xt + !
s" cdrom" strdup i 2 * j + s" generic-disk.fs" included
ELSE
." -" \ show hint for not registered
THEN
ELSE
ata-size to block-size \ ATA: 512 bytes
80000 to max-transfer
['] ata-read-blocks i 2 * j + cells read-blocks-xt + !
s" disk" strdup i 2 * j + s" generic-disk.fs" included
THEN
cr
THEN
THEN
i 2 * j + 200 + cp
LOOP
LOOP
;
find-disks
|
