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