;Begin---------------------------------------------------------- ; ; Disk interface task for the 63B03 system ; ; Update history: ; --------------- ; 02-02-1998 : Started with the thing. The hardware has been ; finished today. All seems to work. Now I need ; software to get some life into it. ; ; 05-02-1998 : Hit a bloody trick of the 8255: When you change ; the modus byte ALL outputs are set to 0. I now ; know why nobody wants to use this bugger. The ; solution for this shit is easy: I plan to put an ; inverter in all the control lines. The following ; lines will be inverted: ; /CS0, /CS1, /IORD, /IOW, /RES, IRQ (the latter ; for the 63B03, it has a /IRQ input).. ; This is the software change needed to make things ; work again... ; ; 06-02-1998 : Hardware change done, disk reset works ; Started testing the disk interface functions. ; The recalibrate command works too, the stop ; disk/start disk functions seem to be not ; present in this 40 MB disk. I also made a LBA ; routine, I can now access the disk as a set of ; sequential blocks, without counting heads etc.. ; It seems the PC hardware starts counting sectors ; starting at 1 (WHY???), all other numbers start ; at 0... ; ; My disk (about 40 MB) tells me it has ; 980 cyls, 5 heads, 17 secs/track. In fact it does ; tell me different numbers, only the label ; indicates that it has been translated... ; ; At this moment I only support disk block read ; and disk block write. I want to make some file- ; system too. Besides, this thing works code-bound. ; I want to start using interrupts too... ; ; 08-02-1998 : /IRQ hardware made ok. The disk can now generate ; interrupts. These will come into the system via ; the CPU's /IRQ signal. I even crashed the system ; by giving /IRQ's with no handler in place... ; Start making the disk software /IRQ-driven. ; ; 10-02-1998 : Changed the interrupt generation/detection ; software Found one nasty bug in the interrupt ; usage as I did it: I first gave a disk reset on ; the IDE bus, then started giving commends right ; away. On this ONE occasion I do NOT have the ; disk's interrupt facility available, the disk is ; still executing its internal reset. I have to ; wait for ready there, THEN start issuing ; commands... Also set the bus control signals to ; output BEFORE I start using the bus at all... Now ; the interrupt mechanism works like the beauty it ; is... ; ; 11-02-1998 : Cleaned up the data transfer code. The disk I/O ; was very slow due to very systematic code. ; ReadWord/WriteWord code substituted in the ; ReadBlock/WriteBlock code. Routines ReadWord/ ; WriteWord removed from the code. There was an ; error in the writeword routine, I've removed it. ; ; 15-02-1998 : I have given up about the interrupt-driven disk ; control. It KEEPS on giving unexplained errors. ; Does NOT want to work independently of the disk ; type and is a general pain in the ass. What ; exactly goes wrong I have no idea about. I now ; use the scheduler's delay routines to get ready ; status from the disk and that works fine. Both ; the 40 MB disk and the 127 MB disk run like the ; sunshine in this modus. The non-interrupt modus ; does in fact not make any significant differenct ; for the transfer speed. I dropped from 32 KB/s to ; 25 KB/s. That is very acceptable for this ; microcontroller. The controller is in this modus ; a lot slower than the disk.... ; ; I'm now going to set the thing up for the 127 MB ; disk with proper track/head numbers. Works ok ; too. ; ; Next test is with the 212 MB disk. I have to take ; care that I stay below track 600 for this disk, ; tracks 630 .. 660 are bad... Sunshine again.. ; ; 16-02-1998 : Made Identify working. It now dumps a nice ; display of what the disk can do. My antique 42MB ; disk gives only half an answer (and a wrong one ; as well, it does NOT tell about the 5 heads,17 ; sectors translation it does..) but the other ones ; like this ident command/display a lot. Also ; shifted the buffers in memory a bit. I now want ; to start writing to the disk (till now I have ; only been reading...). ; Ok, I really messed up the data on my 42 MB disk, ; but it DOES write as well as read. I get back ; what I have written, so far, so good. Now I have ; to make: ; ; 1) A proper disk I/O task. That means that I have ; to implement some way of communicating with ; the disk I/O task. signals? I REALLY would ; like to use some sort of mailbox mechanism. ; For that I will have to extend my scheduler. ; ; 2) some sort of file-system. I am already ; contemplating a MFS (Microcontroller File ; System) for some time now. It's about time to ; start working on one.. ; ; 18-02-1998 : Started making task # 0E into a disk monitor. ; ;End------------------------------------------------------------ include "debug.a03" ; use all debugger routines etc.. ;Defs----------------------------------------------------------- ; ; The I/O ports of the IDE controller ; IoBase equ $0500 ; I/O base address for the disk IoCtl equ $0500 ; Control byte for IDE IoDatL equ $0501 ; Low byte data IDE IoDatH equ $0502 ; High byte data IDE IoMod equ $0503 ; I/O modus IDE ; ; The I/O modi I use ; DMout equ $80 ; all output DMin equ $8B ; ctl = output, data input ; ; The bits of the control byte ; DCNOP equ %00000000 ; Nothing on IDE ctl bus DCRes equ %10000000 ; /reset bit DCIor equ %01000000 ; /IORD bit DCIow equ %00100000 ; /IOWR bit DCCs1 equ %00010000 ; /CS1 bit DCCs0 equ %00001000 ; /CS0 bit DCAdr equ %00000111 ; ADR mask bits ; ; IDE adresses ; IDECmd equ $07 ; addres for command IDESts equ $07 ; addres status register IDEHd equ $06 ; addres head number IDECylH equ $05 ; addres cylinder number high IDECylL equ $04 ; addres cylinder number low IDESec equ $03 ; addres sector number IDENum equ $02 ; addres number of sectors IDEData equ $00 ; addres for data bus IDERIRQ equ $0E ; addres Reset/IRQ register IDEErr equ $01 ; addres Error register ; ; The head number (0..F) also has the mask for master/slave ; I fix this at Master, I do not think I will use two drives ; on my IDE interface. ; IDEHdA equ %00001111 ; head number and mask IDEHdO equ %10100000 ; head number or mask ; ; The Reset/IRQ register has two interesting bits ; IDESRes equ $00000100 ; Soft Reset bit IDENIRQ equ $00000010 ; 0 = IRQ active ; ; The bits from IDESts ; StsBsy equ %10000000 ; busy flag StsRdy equ %01000000 ; ready flag StsWft equ %00100000 ; Write error StsSKC equ %00010000 ; seek complete StsDrq equ %00001000 ; Data Request StsCorr equ %00000100 ; ECC executed StsIdx equ %00000010 ; Index found StsErr equ %00000001 ; error flag ; ; Command opcodes ; CmdRecal equ $10 ; recalibrate disk CmdRead equ $20 ; write a block CmdWrite equ $30 ; read block CmdStop equ $E0 ; Stop disk CmdStrt equ $E1 ; Start disk CmdIdent equ $EC ; Identify disk ; ; The default state (I will always leave it in this state) is: ; IDE bus on input, control word == IDENOP ($FF) ; ; I use a memory command packet to tell the disk what to do ; This packet has the following makeup: ; SDA equ 0 ; offset source/destination ; address in memory for the ; operation LBA3 equ 2 ; offset LBA LBA2 equ 3 ; 32-bits number for a disk LBA1 equ 4 ; of max 2.1E12 bytes... LBA0 equ 5 ; should be enough! ; ; I use Lineair Block Access (LBA) ALL THE TIME. For this disk ; (that does not support it by itself) I have a routine called ; SetLBA to convert the LBA to a CHS configuration. ; ; I use two parameters to decribe the disk geometry: ; ; - The number of blocks per cylinder: ; in CHS terms this is HxS ; ; - The number of blocks per track ; in CHS terms this is S ; ; From these two I can convert LBA to CHS completely. They are ; stored in the following two words: ; ; 42 MB disk: SPC equ 85 ; Sectors per Cylinder SPT equ 17 ; Sectors per track ; ; 127 MB disk: ;SPC equ 272 | Sectors per Cylinder ;SPT equ 17 | Sectors per track ; ; 212 MB disk: ;SPC equ 420 | Sectors per Cylinder ;SPT equ 35 | Sectors per track ; ; I now use the CPU's /IRQ input to handle the disk's IRQ ; signals. The below parameters are for handling these IRQ-s ; irqdisk equ %00000001 ; IRQ bit 0 used for the disk ; ;End------------------------------------------------------------ ;Debug---------------------------------------------------------- ; ; debug defines for this code ; ;End------------------------------------------------------------ ; make the thing as a task org $4000 ; some address db "TSK",$0E ; low prio task, a disk is SLOOOW dw DiskTask ; code address dw DiskStk ; stack db "DiskTask" ; module name DiskStk equ $4FFF ; leave some room (a LOT, in ; fact) ; command block 0 CMDBLK0:dw $4800 ; SDA = $4800 dw $0000 ; LBA = $00000000 dw $0000 ; ; command block 1 CMDBLK1:dw $4A00 ; SDA = $4A00 dw $0000 ; LBA = $00000000 dw $0000 ; org $4040 ; start of the real code DiskTask: ldaa #DMin ; control bits output, the rest staa IoMod ; input ; preset control word ldaa #DCNOP ; control word on not active staa IoCtl ; ; make reset pulse on IDE bus ldaa #DCRes ; make a Reset control word staa IoCtl ; set on output ldab #1 ; spec says 25 us minimum ldaa #sysSleep ; suspend for 10 ms jsr Sys ; ; set control word to not active again ldaa #DCNOP ; staa IoCtl ; diskl: jsr Prompt ; give prompt diskt1: jsr RecData ; cmpa #' ' ; skip spaces beq diskt1 ; cmpa #cr ; beq DiskTask ; ; let CI do the real work again ldx #diskttab ; jsr CI ; jmp diskl ; diskttab: db '?' ; help dw DHelp ; db 'I' ; identify dw DIdent ; db 'R' ; Read sector dw DRead ; db 'W' ; Write sector dw DWrite ; db 'S' ; Stop disk dw DStop ; db 'W' ; Start disk dw DStart ; db 'N' ; Reset disk dw DReset ; db $00 ; what remains dw NoCmd ; DHelp: ldx #DHelpTxt ; jsr SndStr ; rts ; DHelpTxt: db cr,lf,"Disk task commands:" db cr,lf db cr,lf,"I = Identify disk" db cr,lf,"R = Read disk sector" db cr,lf,"W = Write disk sector" db cr,lf,"S = Stop the disk" db cr,lf,"U = Wake up the disk" db cr,lf,"N = Reset the disk" db eom DIdent: ldx #CMDBLK0 ; jsr IdentDisk ; jsr IdentReport ; rts ; DRead: ldx #CMDBLK0 ; jsr ReadSec ; rts ; DWrite: ldx #CMDBLK0 ; jsr WriteSec ; rts ; DStop: jsr StopDisk ; rts ; DStart: jsr StartDisk ; rts ; DReset: jsr InitIDE ; rts ; ;--------------------------------------------------------------- ; Routine InitIDE ; purp: Init the IDE bus ; in : nothing ; out : nothing ; uses: nothing ; set I/O port modus to activate the control signals InitIDE:ldaa #DMin ; control bits output, the rest staa IoMod ; input ; preset control word ldaa #DCNOP ; control word on not active staa IoCtl ; ; make reset pulse on IDE bus ldaa #DCRes ; make a Reset control word staa IoCtl ; set on output ldab #1 ; spec says 25 us minimum ldaa #sysSleep ; suspend for 10 ms jsr Sys ; ; set control word to not active again ldaa #DCNOP ; staa IoCtl ; ; select the master device, I use a set head number for ; that, The head byte also holds the master/slave select jsr SetOut ; bus on output ldaa #IDEHd ; set address jsr SetAdr ; ldaa #$00 ; select head no 0 oraa #IDEHdO ; or byte jsr WriteByte ; write to the bus jsr SetIn ; ; wait till reset executed jsr WaitNBSY ; wait till disk is ready.. ; THEN start giving orders. ; give the disk a recalibrate command ldaa #CmdRecal ; jsr WriteCmd ; ; wait till command executed jsr WaitNBSY ; ; done rts ; ;--------------------------------------------------------------- ; Routine SetIn ; purp: set all ports of the 8255 for input from the IDE bus ; in : nothing ; out : nothing ; uses: nothing ; NB : This also resets ALL control lines and adr selection SetIn: psha ; save accu ldaa #DMin ; get control word staa IoMod ; pula ; rts ; ;--------------------------------------------------------------- ; Routine SetOut ; purp: set all ports of the 8255 for output to the IDE bus ; in : nothing ; out : nothing ; uses: nothing ; NB : This also resets ALL control lines and adr selection SetOut: psha ; save accu ldaa #DMout ; get control word staa IoMod ; pula ; rts ; ;--------------------------------------------------------------- ; Routine StopDisk ; purp: spin down the disk ; in : nothing ; out : nothing ; uses: nothing StopDisk: jsr WaitNBSY ; wait till disk is ready ldaa #CmdStop ; give the command jsr WriteCmd ; rts ; ;--------------------------------------------------------------- ; Routine StartDisk ; purp: spin up the disk ; in : nothing ; out : nothing ; uses: nothing StartDisk: jsr WaitNBSY ; wait till disk is ready ldaa #CmdStrt ; give the command jsr WriteCmd ; rts ; ;--------------------------------------------------------------- ; Routine RecalDisk ; purp: ReCalibrate the disk ; in : nothing ; out : nothing ; uses: nothing RecalDisk: jsr WaitNBSY ; wait till disk is ready ldaa #CmdRecal ; give the command jsr WriteCmd ; rts ; ;--------------------------------------------------------------- ; Routine ReadByte ; purp: Read one byte from the IDE bus ; in : nothing ; out : byte in A ; uses: nothing ; nb : assumes address and bus have been set ReadByte: pshb ; save b ldab IoCtl ; get current orab #DCIor ; set Io read stab IoCtl ; set ldaa IoDatL ; get data ldab IoCtl ; andb #lo ~DCIor ; reset IoRead again stab IoCtl ; pulb ; rts ; ;--------------------------------------------------------------- ; Routine WriteByte ; purp: Read one byte from the IDE bus ; in : byte in A ; out : nothing ; uses: nothing WriteByte: pshb ; save b ldab IoCtl ; get current orab #DCIow ; assert Io Write stab IoCtl ; staa IoDatL ; get data ldab IoCtl ; negate Io Write andb #lo ~DCIow ; stab IoCtl ; pulb ; rts ; ;--------------------------------------------------------------- ; Routine SetAdr ; purp: Set an address on the IDE bus ; in : address in A [0 .. F] ; out : nothing ; uses: nothing SetAdr: pshb ; save B psha ; A too for the moment ; set which CS to assert anda #%00001000 ; see if adres > 8 beq wrad1 ; ldaa #DCCs1 ; high address bra wrad2 ; wrad1: ldaa #DCCs0 ; low address wrad2: ; put low bits in place pulb ; addres -> B pshb ; back on stack andb #DCAdr ; low addres in B aba ; get low addres in A staa IoCtl ; set on control output ; get registers back pula ; pulb ; rts ; ;--------------------------------------------------------------- ; Routine WriteCmd ; purp: Write one command to the IDE device ; in : command in A ; out : nothing ; uses: nothing WriteCmd: psha ; save a jsr SetOut ; set bus to output ldaa #IDECmd ; set address jsr SetAdr ; pula ; get command byte back jsr WriteByte ; write the byte rts ; done ;--------------------------------------------------------------- ; Routine ReadSts ; purp: get status if the IDE device ; in : nothing ; out : status byte in A ; uses: nothing ReadSts: jsr SetIn ; set bus to input ldaa #IDESts ; set address jsr SetAdr ; jsr ReadByte ; read the byte rts ; done ;--------------------------------------------------------------- ; Routine ReadReg ; purp: get byte from the IDE device ; in : address in A ; out : data byte in A ; uses: nothing ReadReg: jsr SetAdr ; jsr ReadByte ; rts ; ;--------------------------------------------------------------- ; Routine WaitNBSY ; purp: wait till the drive indicates ready status ; in : nothing ; out : nothing ; uses: nothing WaitNBSY:psha ; save registers pshb ; ; test if device ready wtrdy1: jsr ReadSts ; get status byte anda #StsBsy ; get status bits beq wtrdy2 ; ; not ready, wait 10 ms ldaa #sysSleep ; sleep ldab #1 ; one clock cycle jsr Sys ; ; try again bra wtrdy1 ; ; device is ready wtrdy2: pulb ; pula ; rts ; done ;--------------------------------------------------------------- ; Routine WaitDRDY ; purp: wait till the drive indicates ready status ; in : nothing ; out : nothing ; uses: nothing WaitDRDY: psha ; save registers pshb ; ; test if device ready wtdrdy1:jsr ReadSts ; get status byte anda #StsRdy ; get status bits bne wtdrdy2 ; ; not ready, wait 10 ms ldaa #sysSleep ; sleep ldab #1 ; one clock cycle jsr Sys ; ; try again bra wtdrdy1 ; ; device is ready wtdrdy2:pulb ; pula ; rts ; done ;--------------------------------------------------------------- ; Routine WaitDrq ; purp: wait till the drive indicates ready for data status ; in : nothing ; out : nothing ; uses: nothing WaitDrq:psha ; save registers pshb ; ; test if device ready for data wtdrq1: jsr ReadSts ; get status byte anda #StsDrq ; get status bits bne wtdrq2 ; ; not ready, wait 10 ms ldaa #sysSleep ; sleep ldab #1 ; one clock cycle jsr Sys ; ; try again bra wtdrq1 ; ; device is ready for data wtdrq2: pulb ; pula ; rts ; done ;--------------------------------------------------------------- ; Routine ReadBlock ; purp: read one block from the IDE device ; in : X -> result address (512 bytes) ; out : nothing ; uses: nothing ReadBlock: ; save registers psha ; pshb ; pshx ; ; setup for data read jsr SetIn ; set to input ldaa #IDEData ; set address jsr SetAdr ; ; init loop counter ldaa #$00 ; 256 word reads rdblk1: ldab IoCtl ; get current orab #DCIor ; assert Io Read stab IoCtl ; set ldab IoDatL ; get low byte stab 0,x ; store inx ; ldab IoDatH ; get high data stab 0,x ; store inx ; ldab IoCtl ; andb #lo ~DCIor ; negate Io Read stab IoCtl ; deca ; bne rdblk1 ; loop ; done, get things back pulx ; pulb ; pula ; rts ; ;--------------------------------------------------------------- ; Routine WriteBlock ; purp: write one block of data to the IDE device ; in : X -> data address (512 bytes) ; out : nothing ; uses: nothing WriteBlock: ; save registers psha ; pshb ; pshx ; ; setup for data write jsr SetOut ; bus to output ldaa #IDEData ; set address jsr SetAdr ; ; init loop counter ldaa #$00 ; 256 word write wrblk1: ldab 0,x ; write data byte stab IoDatL ; to I/O ports inx ; ldab 0,x ; stab IoDatH ; inx ; ldab IoCtl ; strobe write orab #DCIow ; assert Io Write stab IoCtl ; andb #lo ~DCIow ; negate Io Write stab IoCtl ; deca ; loop bne wrblk1 ; ; done, get things back pulx ; pulb ; pula ; rts ; ;--------------------------------------------------------------- ; Routine SetLBA ; purp: sets the LBA for the next transfer ; in : X -> command packet ; X+0 = ..\ not used or changed here ; X+1 = ../ ; X+2 = LBA3 (high) ; X+2 = LBA2 ; X+3 = LBA1 ; X+4 = LBA0 (low) ; out : registers of the IDE controller loaded ; uses: nothing ; ; NB: I select ONE sector to be processed ; ; I make a stack frame to convert, these are the offsets in ; the stack frame (after tsx, relative to X) LBS3 equ 0 ; stack frame LBAS LBS2 equ 1 ; LBS1 equ 2 ; LBS0 equ 3 ; cylinder high SetLBA: ; prepare for disk output jsr SetOut ; ; load input data to stack pshx ; save X ldaa LBA0,x ; psha ; 3 ldaa LBA1,x ; psha ; 2 ldaa LBA2,x ; psha ; 1 ldaa LBA3,x ; psha ; 0 tsx ; make X stack frame pointer ; init for divide by SPC (=sectors/cylinder) ; to get the cylinder number. I know the result ; will fit in 16 bits, so 16 bits result is enough. ldab #16 ; 16 divide loops lbac1: pshb ; save counter on stack ;shift 1 place to left, fill with 0 bit asl LBS0,x ; shift divident, rol LBS1,x ; fill up with 0 rol LBS2,x ; rol LBS3,x ; ; test if substract fits ldd LBS3,x ; get high word subd #SPC ; bcs lbac2 ; does not fit, next loop again ; fits, set lower cylinder bit, store result std LBS3,x ; inc LBS0,x ; ; handle loop things lbac2: pulb ; decb ; bne lbac1 ; ; write result to disk registers ldaa #IDECylL ; jsr SetAdr ; ldaa LBS0,x ; jsr WriteByte ; ldaa #IDECylH ; jsr SetAdr ; ldaa LBS1,x ; jsr WriteByte ; ; see about head number ldaa #0 ; simple substract will do the staa LBS0,x ; work, max H times... ; get remaining blocks count ldd LBS3,x ; ; test if one head more lbac3: subd #SPT ; minus one track's sectors bcs lbac4 ; see if reult is minus inc LBS0,x ; no, one more head bra lbac3 ; ; gone one too far already lbac4: addd #SPT ; and sector count addd #$0001 ; sector count starts at 1 !! std LBS3,x ; save for a moment ; write to disk registers ldaa #IDEHd ; Head is special jsr SetAdr ; ldaa LBS0,x ; anda #IDEHdA ; have to set some bits oraa #IDEHdO ; to get it working good jsr WriteByte ; ldaa #IDESec ; sectors is easy again jsr SetAdr ; ldaa LBS2,x ; low byte only as sector # jsr WriteByte ; ; set up for ONE sector transfer ldaa #IDENum ; jsr SetAdr ; ldaa #1 ; jsr WriteByte ; ; clean up the stack ins ; four bytes LBA ins ; ins ; ins ; ; get X back too pulx ; ; done rts ; ;--------------------------------------------------------------- ; Routine ReadSec ; purp: reads one sector from the disk ; in : X -> command packet ; X+0 = dest addres high ; X+1 = dest addres low ; X+2 = LBA3 ; X+3 = LBA2 ; X+4 = LBA1 ; X+5 = LBA0 ; out : data read into the destination address ; uses: nothing ; wait for bsy bit cleared ReadSec:jsr WaitNBSY ; wait till disk is ready ; select the device 0 ldaa #IDEHd ; set address jsr SetAdr ; ldaa #$00 ; set head no = 0 anda #IDEHdA ; oraa #IDEHdO ; jsr WriteByte ; ; load parameters rdsec0: jsr SetLBA ; set address ldaa #CmdRead ; give read command jsr WriteCmd ; ; wait for busy gone jsr WaitNBSY ; ; test on errors jsr ReadSts ; get status byte tab ; anda #StsErr ; check error bit beq rdsec1 ; no error -> cont ; error, notify jsr DiskErr ; report the error rdsec1: tba ; test if DRQ anda #StsDrq ; bne rdsec2 ; ; no data requested, quit rts ; ; transport the data block to destination rdsec2: pshx ; ldx SDA,x ; get dest address jsr ReadBlock ; get the data pulx ; rts ; done ;--------------------------------------------------------------- ; Routine WriteSec ; purp: Write one sector to the disk ; in : X -> command packet ; X+0 = source addres high ; X+1 = source addres low ; X+2 = LBA High ; X+3 = LBA Middle ; X+4 = LBA low ; out : data written to the disk ; uses: nothing WriteSec: jsr WaitNBSY ; wait till disk is ready ; select the device 0 ldaa #IDEHd ; set address jsr SetAdr ; ldaa #$00 ; set head no = 0 anda #IDEHdA ; oraa #IDEHdO ; jsr WriteByte ; jsr SetLBA ; set address ldaa #CmdWrite ; give write command jsr WriteCmd ; ; wait till command ready jsr WaitNBSY ; ; test on errors jsr ReadSts ; get status byte tab ; anda #StsErr ; check error bit beq wrsec1 ; no error -> cont ; error, notify jsr DiskErr ; report the error wrsec1: tba ; test if DRQ anda #StsDrq ; bne wrsec2 ; ; no data requested, quit rts ; ; transport the data block to destination wrsec2: pshx ; ldx SDA,x ; get dest address jsr WriteBlock ; get the data pulx ; rts ; done jsr WaitDrq ; wait for data pshx ; ldx SDA,x ; get dest address jsr WriteBlock ; get data pulx ; rts ; ;--------------------------------------------------------------- ; Routine IdentDisk ; purp: Get the disk's parameters from the disk itself ; in : X -> command packet ; X+0 = dest addres high ; X+1 = dest addres low ; out : ident packet from the disk in memory ; uses: nothing IdentDisk: jsr WaitNBSY ; wait till disk ready ; give command ldaa #CmdIdent ; send Ident command jsr WriteCmd ; ; wait for busy gone jsr WaitNBSY ; ; test on errors jsr ReadSts ; get status byte tab ; anda #StsErr ; check error bit beq idget1 ; no error -> cont ; error, notify jsr DiskErr ; report the error idget1: tba ; test if DRQ anda #StsDrq ; bne idget2 ; ; no data requested, quit rts ; ; transport the data block to destination idget2: pshx ; ldx SDA,x ; get dest address jsr ReadBlock ; get the data pulx ; rts ; done ;--------------------------------------------------------------- ; Routine IdentReport ; purp: give extensive disk identification report ; in : X -> disk command packet ; out : disk ident info via the sio ; uses: registers IdentReport: ; data packet pointed to by the disk command packet psha ; save registers pshb ; pshx ; save x too ; make X -> ident info NB: this is in LOW-HIGH (Intel) ; word format. I want to be SOMEWHAT compatible with ; a PC. Perhaps I can someday read the file-system I make ; with a PC too... ldx SDA,x ; x -> ident data pshx ; ; go dump info ldx #IDModel ; model name jsr SndStr ; pulx ; pshx ; ldab #54 ; start in SDA block abx ; ldab #20 ; 20 words ; see if any name there tst 1,x ; beq idnm ; zero byte -> no model there ; go print the model name idml: ldaa 1,x ; first byte (LOW-HIGH) jsr SndData ; ldaa 0,x ; jsr SndData ; inx ; inx ; decb ; bne idml ; bra idme ; ; no name given idnm: ldx #IDNoMod ; jsr SndStr ; ; name done idme: nop ; ; see about ATA/ATAPI modus pulx ; pshx ; ldx #IDAta ; jsr SndStr ; pulx ; pshx ; ldaa 1,x ; get ATA/ATAPI status anda #$80 ; highest bit beq riata ; ; is an ATAPI device ldx #IDMAtapi ; bra israta ; ; is an ATA device riata: ldx #IDMAta ; ; print device type israta: jsr SndStr ; ; see about removable/fixed pulx ; pshx ; ldaa 0,x ; anda #$40 ; seems to be bit 6 beq rirem ; ; is a fixed disk ldx #IDFix ; bra rifrm ; ; is a removable disk rirem: ldx #IDRem ; rifrm: jsr SndStr ; ; get number of cylinders ldx #IDCyl ; jsr SndStr ; pulx ; pshx ; ldaa 3,x ; jsr SndHex ; ldaa 2,x ; jsr SndHex1 ; ; get number of heads ldx #IDHead ; jsr SndStr ; pulx ; pshx ; ldaa 7,x ; jsr SndHex ; ldaa 6,x ; jsr SndHex1 ; ; get number of sectors ldx #IDSec ; jsr SndStr ; pulx ; pshx ; ldaa 13,x ; jsr SndHex ; ldaa 12,x ; jsr SndHex1 ; pulx ; X -> data block pulx ; X -> command packet pulb ; restore registers pula ; rts ; done IDModel:db cr,lf,"Device name: ",eom IDNoMod:db "Not specified",eom IDAta: db cr,lf,"Device type: ",eom IDMAta: db "ATA, ",eom IDMAtapi:db "ATAPI, ",eom IDFix: db "Fixed",eom IDRem: db "Removable",eom IDCyl: db cr,lf,"Cylinders :",eom IDHead: db cr,lf,"Heads :",eom IDSec: db cr,lf,"Sectors :",eom ;--------------------------------------------------------------- ; Routine DiskErr ; purp: give extensive error reporting for disk errors ; in : X -> disk command packet ; out : error messages about what went wrong with a disk access ; uses: registers DiskErr:psha ; save registers pshb ; pshx ; save pointer to LBA ; general error message ldx #ErrDsk ; jsr SndStr ; ; status ldx #ErrSts ; give error string jsr SndStr ; ldaa #IDESts ; first the IDE Staus register jsr ReadReg ; jsr SndHex ; ; the error bits ldx #ErrBit ; jsr SndStr ; ldaa #IDEErr ; jsr ReadReg ; jsr SndHex ; ; LBA here it happened ldx #ErrLBA ; jsr SndStr ; pulx ; pshx ; ldd LBA3,x ; jsr SndHex ; tba ; jsr SndHex1 ; ldd LBA1,x ; jsr SndHex1 ; tba ; jsr SndHex1 ; ; the CHS where it happened ldx #ErrCHS ; jsr SndStr ; ldaa #IDECylH ; jsr ReadReg ; jsr SndHex ; ldaa #IDECylL ; jsr ReadReg ; jsr SndHex1 ; ldaa #IDEHd ; jsr ReadReg ; jsr SndHex ; ldaa #IDESec ; jsr ReadReg ; jsr SndHex ; ; end with a new line jsr NewLine ; ; get registers back pulx ; pulb ; pula ; ; done rts ; ErrDsk: db cr,lf,">> Disk Error <<",eom ErrSts: db cr,lf,">> Status :",eom ErrBit: db cr,lf,">> Error :",eom ErrLBA: db cr,lf,">> LBA :",eom ErrCHS: db cr,lf,">> CHS :",eom ;---------------------------------------------------- end