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