2019-02-20 21:00:27 +01:00
|
|
|
# ATA (Hard Disk) Driver
|
|
|
|
|
2020-03-02 22:49:51 +01:00
|
|
|
This implements a basic PIO mode ATA driver.
|
|
|
|
|
2019-02-21 05:01:42 +01:00
|
|
|
The code here works (at least under qemu), but is *very*
|
|
|
|
dangerous to use. It will allow you to read or write a
|
|
|
|
sector to/from a dedicated `ata:Sector` buffer. No checks
|
|
|
|
are made to validate the sector number. Using these (esp.
|
|
|
|
`ata:write`) is likely to cause data loss.
|
|
|
|
|
2020-02-29 16:50:19 +01:00
|
|
|
# Settings
|
|
|
|
|
|
|
|
~~~
|
2020-08-27 21:17:38 +02:00
|
|
|
#10000 'ata:Delay var-n
|
2020-02-29 16:50:19 +01:00
|
|
|
~~~
|
|
|
|
|
2019-02-21 05:01:42 +01:00
|
|
|
# Constants
|
|
|
|
|
|
|
|
~~~
|
2020-03-02 22:49:51 +01:00
|
|
|
0x20 'ata:READ const
|
|
|
|
0x30 'ata:WRITE const
|
2020-02-29 16:50:19 +01:00
|
|
|
0xE7 'ata:FLUSH-CACHE const
|
2019-02-21 05:01:42 +01:00
|
|
|
|
2020-03-02 22:49:51 +01:00
|
|
|
(port (name (access_modes
|
|
|
|
(---- (----------------------- (------------
|
|
|
|
0x1F0 'ata:PRIMARY const
|
|
|
|
0x1F0 'ata:DATA const (rw
|
|
|
|
0x1F1 'ata:ERROR const (r
|
|
|
|
0x1F1 'ata:FEATURES const (w
|
|
|
|
0x1F2 'ata:SECTOR-COUNT const (rw
|
|
|
|
0x1F3 'ata:SECTOR-NUMBER const (rw
|
|
|
|
0x1F4 'ata:CYLINDER-LOW const (rw
|
|
|
|
0x1F5 'ata:CYLINDER-HIGH const (rw
|
|
|
|
0x1F6 'ata:DRIVE const (rw
|
|
|
|
0x1F6 'ata:HEAD const (rw
|
|
|
|
0x1F7 'ata:STATUS const (r
|
|
|
|
0x1F7 'ata:COMMAND const (w
|
2020-02-29 16:50:19 +01:00
|
|
|
|
|
|
|
0x3F6 'ata:PRIMARY-DCR-AS const
|
2019-02-21 05:01:42 +01:00
|
|
|
~~~
|
|
|
|
|
|
|
|
# Common
|
|
|
|
|
|
|
|
~~~
|
2019-02-21 22:25:43 +01:00
|
|
|
:ata:clear-bsy (-)
|
2020-02-29 16:50:19 +01:00
|
|
|
[ ata:COMMAND pio:in-byte 0x80 and n:zero? ] until ;
|
2019-02-21 22:25:43 +01:00
|
|
|
|
2019-02-21 05:01:42 +01:00
|
|
|
:ata:set-sector (n-)
|
2020-02-29 16:50:19 +01:00
|
|
|
0xE0 ata:HEAD pio:out-byte
|
|
|
|
0x00 ata:FEATURES pio:out-byte
|
|
|
|
0x01 ata:SECTOR-COUNT pio:out-byte
|
|
|
|
dup ata:SECTOR-NUMBER pio:out-byte
|
|
|
|
dup #8 shift ata:CYLINDER-LOW pio:out-byte
|
|
|
|
#16 shift ata:CYLINDER-HIGH pio:out-byte ;
|
2019-02-21 05:01:42 +01:00
|
|
|
~~~
|
|
|
|
|
|
|
|
# Reading a Sector
|
|
|
|
|
|
|
|
~~~
|
2020-02-29 16:50:19 +01:00
|
|
|
:mask 0xFF and ;
|
|
|
|
:delay @ata:Delay [ ] times ;
|
|
|
|
|
|
|
|
:ata:read-word
|
|
|
|
ata:PRIMARY pio:in-word ;
|
|
|
|
|
|
|
|
:store-word
|
|
|
|
[ mask over store n:inc ] sip #8 shift over store n:inc ;
|
|
|
|
|
2019-02-21 22:25:43 +01:00
|
|
|
:ata:read (an-)
|
2019-02-21 05:01:42 +01:00
|
|
|
ata:set-sector
|
2020-02-29 16:50:19 +01:00
|
|
|
ata:READ ata:COMMAND pio:out-byte
|
|
|
|
delay
|
|
|
|
#256 [ ata:read-word store-word ] times drop ;
|
2019-02-21 05:01:42 +01:00
|
|
|
~~~
|
|
|
|
|
|
|
|
# Writing a Sector
|
|
|
|
|
|
|
|
~~~
|
2020-02-29 16:50:19 +01:00
|
|
|
:ata:write-word
|
|
|
|
ata:PRIMARY pio:out-word ;
|
|
|
|
|
|
|
|
:fetch-word
|
|
|
|
fetch-next [ fetch-next #-8 shift ] dip + ;
|
|
|
|
|
2019-02-26 05:19:39 +01:00
|
|
|
:ata:write (an-)
|
2019-02-21 05:01:42 +01:00
|
|
|
ata:set-sector
|
2020-02-29 16:50:19 +01:00
|
|
|
ata:WRITE ata:COMMAND pio:out-byte
|
|
|
|
delay
|
|
|
|
#256 [ fetch-word ata:write-word ] times drop
|
|
|
|
ata:FLUSH-CACHE ata:COMMAND pio:out-byte ata:clear-bsy ;
|
2019-02-21 05:01:42 +01:00
|
|
|
~~~
|