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