612 lines
22 KiB
Forth
612 lines
22 KiB
Forth
\ *****************************************************************************
|
|
\ * 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
|
|
|