Oberon/ETH Oberon/ATADisks.Mod

(* ETH Oberon, Copyright 1990-2005 Computer Systems Institute, ETH Zurich, CH-8092 Zurich.
Refer to the license ftp://ftp.ethoberon.ethz.ch/ETHOberon/license.txt . *)

MODULE ATADisks; (** non-portable *)	(* cp/pjm/prk *)

(* 
Native Oberon ATA disk driver with Intel 82371SB (PIIX3) bus-mastering support (e.g. 440FX chipset).

Reference: T13/1153D Rev. 17, AT Attachment with Packet Interface Extension (ATA/ATAPI-4).

30.07.1998	cp	first version working
04.12.1998	pjm	added bus-mastering and restructured
23.03.1999	pjm	fixed chs parameters
24.03.1999	pjm	non-polling versions of PIO transfers
26.03.1999	pjm	LBA mode implemented
19.04.1999	pjm	Fixed for Compaq laptop
23.08.1999	prk	Adding more ATAPI support
31.08.1999	pjm	Modified for Disks module
22.11.2005	ple	CompactFlash recognition per J. Sedlacek and AosATADisks.Mod
*)

IMPORT SYSTEM, Kernel, Disks, PCI;

CONST
	MaxControllers = 2;	(* <= 10 *)
	MaxDevices = 2*MaxControllers;
	MaxTries = 5;
	
	BMEnabled = TRUE;	(* check for bus-master chipset *)
	OverrideBIOS = TRUE;	(* enable bus-master even if BIOS did not *)
	PrimaryEnabled = TRUE;	(* disable for testing *)
	SecondaryEnabled = TRUE;	(* disable for testing *)
	UseConfigParams = TRUE;	(* disable for testing *)
	TraceStatus = TRUE;	(* show error information *)
	TraceIdentify = FALSE;	(* show identify information *)
	Experimental = TRUE;	(* media handling code *)
	AllowEject = TRUE;	(* allow ejection of removable media *)
	TraceCalls = FALSE;	(* show procedures called *)
	SelectWait = FALSE;	(* wait before select *)
	EarlyBug = TRUE;	(* temporary workaround for early interrupts *)

	SelectTimeout = 5000;	(* ms *)
	IOTimeout = 10000;	(* ms *)
	IdentifyTimeout = 500;	(* ms *)
	ResetTimeout = 1000;	(* ms *)
	
	MaxTransfer = 256;	(* <= 256 *)
	MaxPRD = 3;	(* <= 4 *)
	BS = 512;
	CDRomBS = 2048;
	MinLBA = 8000000;	(* (> 0) if reported size larger than this, use LBA mode *)
	
	(* According "CF+ and CompactFlash Specification Version 1.4" by CompactFlash Association*)
	CompactFlashSignature = 848AH; (*CF*)
	
	AtapiBit = 0;  RemovableBit = 1;  DMABit = 2;  LBABit = 3;
	Packet16Bit = 4;	(*packets are 16 bytes long instead of 12 - Atapi only *)
	RMSNBit = 5;	(*Media Status Notification supported*)
	LockBit = 6;	(*locking supported - RMSN only *)
	EjectBit = 7;	(*power eject supported - RMSN only *)
	CDRom = 8;	(*CDRom device - atapi only *)
	CompactFlash = 9; (*CF*)
	ERR = 0;  DRQ = 3;  DRDY = 6;  BSY = 7;
	
	(*GetMediaStatus Flags*)
	NM = 1;  MCR = 3;  MC = 5;  WP = 6;
	
TYPE
	CHS = RECORD
		cyls, hds, spt: LONGINT
	END;
	
	ID = RECORD
		type: SET;
		ver: LONGINT;
		model: ARRAY 44 OF CHAR
	END;
	
	Packet16 = ARRAY 16 OF CHAR;

	PRDT = POINTER TO RECORD
		prd: ARRAY MaxPRD OF RECORD	(* aligned on 32-byte boundary, see Intel 290550-002 sec. 2.7.3 *)
			adr, count: LONGINT
		END
	END;
	
	Controller = POINTER TO RECORD
		port, port2, irq, bmbase: LONGINT;
		interrupts, mark: LONGINT;
		prdt: PRDT;
		busy: BOOLEAN
	END;
	
	Device = POINTER TO RECORD (Disks.Device)
		controller: Controller;
		dev: LONGINT;	(* 0 or 1 *)
		size: LONGINT;	(* total size *)
		chs: CHS;	(* for controller *)
		getpar: CHS;	(* for GetParams *)
		id: ID;
		init: BOOLEAN;	(* initialized? *)
		sense: LONGINT;	(*last device sense, atapi only*)
	END;
	
VAR
	controller: ARRAY MaxControllers OF Controller;
	device: ARRAY MaxDevices OF Device;
	irqs: SET;
	Nunexpected, Nunknown: LONGINT;	(* number of unknown/unexpected interrupts *)

PROCEDURE WriteStatus(msg: ARRAY OF CHAR;  port: LONGINT);
VAR ch: CHAR;  t: LONGINT;
BEGIN
	IF TraceStatus THEN
		Kernel.WriteString(msg); Kernel.WriteHex(port, 9);
		SYSTEM.PORTIN(port+6, ch);
		Kernel.WriteChar(" ");  Kernel.WriteInt(ORD(ch) DIV 10H MOD 2, 1);
		SYSTEM.PORTIN(port+5, ch);  t := ORD(ch);
		SYSTEM.PORTIN(port+4, ch);  t := ASH(t, 8) + ORD(ch);
		Kernel.WriteChar(" ");  Kernel.WriteInt(t, 1);
		SYSTEM.PORTIN(port+6, ch);
		Kernel.WriteChar(" ");  Kernel.WriteInt(ORD(ch) MOD 10H, 1);
		SYSTEM.PORTIN(port+3, ch);
		Kernel.WriteChar(" ");  Kernel.WriteInt(ORD(ch), 1);
		SYSTEM.PORTIN(port+1, ch);
		Kernel.WriteHex(ORD(ch), -3);
		SYSTEM.PORTIN(port+7, ch);
		Kernel.WriteHex(ORD(ch), -3)
	END
END WriteStatus;

(* Wait for specified value of controller status bits. *)

PROCEDURE WaitStatus(port: LONGINT;  mask, expect, bad: SET;  ms: LONGINT): BOOLEAN;
VAR t: Kernel.MilliTimer;  s: SET;  ch: CHAR;
BEGIN
	Kernel.SetTimer(t, ms);
	REPEAT
		SYSTEM.PORTIN(port+7, ch);  s := SYSTEM.VAL(SET, LONG(ORD(ch)))
	UNTIL (s * mask = expect) OR (s * bad # {}) OR Kernel.Expired(t);
	IF TraceStatus & ((s * bad # {}) OR (s * mask # expect)) THEN
		WriteStatus("Status", port);
		Kernel.WriteHex(SYSTEM.VAL(LONGINT, s), -3);
		Kernel.WriteHex(SYSTEM.VAL(LONGINT, mask), -3);
		Kernel.WriteHex(SYSTEM.VAL(LONGINT, expect), -3);
		Kernel.WriteHex(SYSTEM.VAL(LONGINT, bad), -3);
		Kernel.WriteChar(" ");  Kernel.WriteInt(ms, 1);
		Kernel.WriteLn
	END;
	RETURN (s * mask = expect) & (s * bad = {})
END WaitStatus;

(* Wait for specified value of controller status bits using the alternate status bits (don't clear interrupts). *)

PROCEDURE WaitAltStatus(port, port2: LONGINT;  mask, expect, bad: SET;  ms: LONGINT): BOOLEAN;
VAR t: Kernel.MilliTimer;  s: SET;  ch: CHAR;
BEGIN
	Kernel.SetTimer(t, ms);
	REPEAT
		SYSTEM.PORTIN(port2, ch);  s := SYSTEM.VAL(SET, LONG(ORD(ch)));
	UNTIL (s * mask = expect) OR (s * bad # {}) OR Kernel.Expired(t);
	IF TraceStatus & ((s * bad # {}) OR (s * mask # expect)) THEN
		Kernel.WriteString("ATADisks: s");  Kernel.WriteHex(SYSTEM.VAL(LONGINT, s), -3);
		Kernel.WriteString(", mask");  Kernel.WriteHex(SYSTEM.VAL(LONGINT, mask), -3);
		Kernel.WriteString(", exp");  Kernel.WriteHex(SYSTEM.VAL(LONGINT, expect), -3);
		Kernel.WriteString(", bad");  Kernel.WriteHex(SYSTEM.VAL(LONGINT, bad), -3);
		Kernel.WriteString(", time ");  Kernel.WriteInt(ms, 1);
		Kernel.WriteLn
	END;
	RETURN (s * mask = expect) & (s * bad = {})
END WaitAltStatus;

(* NanoDelay - Delay at least ns nanoseconds. *)

PROCEDURE NanoDelay(ns: LONGINT);
BEGIN
	ns := ns DIV 2;	(* 400MHz clock => 2.5ns cycle *)
	WHILE ns > 0 DO DEC(ns) END
END NanoDelay;

(* Select device for next command (0 or 1).  Section 9.6. *)

PROCEDURE SelectDevice(port, d, timeout: LONGINT): LONGINT;
VAR res: LONGINT;
BEGIN
	IF ~SelectWait OR WaitStatus(port, {DRQ,BSY}, {}, {}, timeout) THEN
		SYSTEM.PORTOUT(port+6, CHR(ASH(d, 4)));
		NanoDelay(400);
		IF WaitStatus(port, {DRQ,BSY}, {}, {}, timeout) THEN res := 0 ELSE res := 2 END
	ELSE
		res := 1
	END;
	RETURN res
END SelectDevice;

(* Issue a command to the controller. *)

PROCEDURE Command(d: Device;  cmd: CHAR;  lba, num: LONGINT);
VAR port, sector, cylinder, head, x: LONGINT;
BEGIN
	port := d.controller.port;
	ASSERT((num > 0) & (num <= 100H));
	SYSTEM.PORTOUT(port+2, CHR(num MOD 100H));	(* 0 means 256 *)
	IF LBABit IN d.id.type THEN
		ASSERT((lba >= 0) & (lba < 10000000H));
		SYSTEM.PORTOUT(port+3, CHR(lba MOD 100H));
		SYSTEM.PORTOUT(port+4, CHR(ASH(lba, -8) MOD 100H));
		SYSTEM.PORTOUT(port+5, CHR(ASH(lba, -16) MOD 100H));
		SYSTEM.PORTOUT(port+6, CHR((40H + ASH(d.dev, 4) + ASH(lba, -24) MOD 10H)))
	ELSE
		sector := lba MOD d.chs.spt + 1;  x := lba DIV d.chs.spt;
		head := x MOD d.chs.hds;  cylinder := x DIV d.chs.hds;
		ASSERT((sector < 100H) & (cylinder < 10000H) & (head < 10H));
		SYSTEM.PORTOUT(port+3, CHR(sector));
		SYSTEM.PORTOUT(port+4, CHR(cylinder MOD 100H));
		SYSTEM.PORTOUT(port+5, CHR(cylinder DIV 100H));
		SYSTEM.PORTOUT(port+6, CHR((ASH(d.dev, 4) + head)))
	END;
	SYSTEM.PORTOUT(port+7, cmd)
END Command;

(* Interrupt handler (needed for DMA operation). *)

PROCEDURE InterruptHandler;
VAR i, u, int: LONGINT;  ctrl: Controller;
BEGIN
	SYSTEM.STI();
	SYSTEM.GETREG(SYSTEM.EBP, int);  SYSTEM.GET(int+40, int);
	DEC(int, Kernel.IRQ);  u := 1;
	FOR i := 0 TO MaxControllers-1 DO
		ctrl := controller[i];
		IF (ctrl # NIL) & (ctrl.irq = int) THEN u := 0;  INC(ctrl.interrupts) END
	END;
	SYSTEM.CLI();
	INC(Nunknown, u)
END InterruptHandler;

(* Wait for an interrupt to occur. *)

PROCEDURE WaitInterrupt(c: Controller;  ms: LONGINT): BOOLEAN;
VAR t: Kernel.MilliTimer;  ok: BOOLEAN;
BEGIN
	Kernel.SetTimer(t, ms);
	REPEAT ok := c.interrupts # c.mark UNTIL ok OR Kernel.Expired(t);
	c.mark := c.interrupts;
	RETURN ok
END WaitInterrupt;

(* Start interrupt waiting period. *)

PROCEDURE StartInterrupt(c: Controller);
BEGIN
	INC(Nunexpected, c.interrupts - c.mark);
	c.mark := c.interrupts
END StartInterrupt;

(* Block port input instruction. *)

PROCEDURE -RepInWord(port, bufAdr, len: LONGINT);
CODE {SYSTEM.i386}
	POP ECX
	POP EDI
	POP EDX
	CLD
	REP INSW
END RepInWord;

(* Block port out instruction. *)

PROCEDURE -RepOutWord(port, bufAdr, len: LONGINT);
CODE {SYSTEM.i386}
	POP ECX
	POP ESI
	POP EDX
	CLD
	REP OUTSW
END RepOutWord;

PROCEDURE WaitNotBusy(port2: LONGINT);
VAR x: CHAR;
BEGIN
	SYSTEM.PORTIN(port2, x);
	IF 7 IN SYSTEM.VAL(SET, LONG(ORD(x))) THEN
		Kernel.WriteString("ATA: early interrupt");  Kernel.WriteHex(ORD(x), -3);  Kernel.WriteLn;
		(*Kernel.WriteChar(8X);*)
		REPEAT
			SYSTEM.PORTIN(port2, x)
		UNTIL ~(7 IN SYSTEM.VAL(SET, LONG(ORD(x))))
	END
END WaitNotBusy;

(* Read blocks using PIO protocol. *)

PROCEDURE ReadPIO(d: Device;  lba, num, bufAdr: LONGINT): LONGINT;
VAR port, port2, res: LONGINT;  x: CHAR;  s: SET;  c: Controller;
BEGIN
	res := 0;  c := d.controller;  port := c.port;  port2 := c.port2;
	StartInterrupt(c);
	Command(d, 20X, lba, num);	(* read sectors *)
	REPEAT
		IF WaitInterrupt(c, IOTimeout) THEN
			IF EarlyBug THEN WaitNotBusy(c.port2) END;
			SYSTEM.PORTIN(port+7, x);  s := SYSTEM.VAL(SET, LONG(ORD(x)));
			IF ~(ERR IN s) THEN
				RepInWord(port, bufAdr, BS DIV 2);
				INC(bufAdr, BS);  DEC(num)
			ELSE
				res := 20
			END
		ELSE
			res := 19
		END
	UNTIL (num = 0) OR (res # 0);
	SYSTEM.PORTIN(port2, x);	(* according to spec *)
	SYSTEM.PORTIN(port+7, x);  s := SYSTEM.VAL(SET, LONG(ORD(x)));
	IF (res = 0) & (ERR IN s) THEN res := 21 END;
	IF TraceStatus & (res # 0) THEN WriteStatus("ReadPIO", port);  Kernel.WriteLn END;
	RETURN res
END ReadPIO;

(* Write blocks using PIO protocol. *)

PROCEDURE WritePIO(d: Device;  lba, num, bufAdr: LONGINT): LONGINT;
VAR port, port2, res: LONGINT;  x: CHAR;  s: SET;  c: Controller;
BEGIN
	res := 0;  c := d.controller;  port := c.port;  port2 := c.port2;
	StartInterrupt(c);
	Command(d, 30X, lba, num);	(* write sectors *)
	IF WaitAltStatus(port, port2, {DRQ,BSY}, {DRQ}, {ERR}, IOTimeout) THEN
		REPEAT
			RepOutWord(port, bufAdr, BS DIV 2);
			INC(bufAdr, BS);  DEC(num);
			IF WaitInterrupt(c, IOTimeout) THEN
				IF EarlyBug THEN WaitNotBusy(c.port2) END;
				SYSTEM.PORTIN(port+7, x);  s := SYSTEM.VAL(SET, LONG(ORD(x)));
				IF ERR IN s THEN res := 24 END
			ELSE
				res := 23
			END
		UNTIL (num = 0) OR (res # 0)
	ELSE
		res := 22
	END;
	IF res # 0 THEN
		IF TraceStatus THEN WriteStatus("WritePIO", port);  Kernel.WriteLn END;
		SYSTEM.PORTIN(port+7, x)	(* clear interrupt *)
	END;
	RETURN res
END WritePIO;

(* Send packet command, atapi only *)

PROCEDURE CommandPacket(d: Device;  VAR pkt: Packet16): LONGINT;
VAR res, port: LONGINT;  x: CHAR;  c: Controller;
BEGIN
	c := d.controller;  port := c.port;
	SYSTEM.PORTOUT(port+1, 0X);	(* no OVL, no DMA *)
	SYSTEM.PORTOUT(port+2, 0X);	(* tag 0 *)
	SYSTEM.PORTOUT(port+4, 0FEX);	(* byte count limit *)
	SYSTEM.PORTOUT(port+5, 0FFX);
	SYSTEM.PORTOUT(port+6, CHR(ASH(d.dev, 4)));	(*device*)
	SYSTEM.PORTOUT(port+7, 0A0X);	(* packet *)
	NanoDelay(400);
	IF WaitStatus(port, {DRQ,BSY}, {DRQ}, {}, SelectTimeout) THEN
		IF Packet16Bit IN d.id.type THEN
			RepOutWord(port, SYSTEM.ADR(pkt[0]), 8)
		ELSE
			RepOutWord(port, SYSTEM.ADR(pkt[0]), 6)
		END;
		SYSTEM.PORTIN(c.port2, x);	(* ensure status is valid *)
		res := 0
	ELSE
		res := 31
	END;
	RETURN res
END CommandPacket;

(* Compose packet command, atapi only *)

PROCEDURE ComposePacket(VAR pkt: Packet16;  cmd: CHAR;  lba, num: LONGINT);
BEGIN
	pkt[0] := cmd;
	pkt[1] := 0X;
	pkt[2] := CHR(ASH(lba, -24) MOD 100H);
	pkt[3] := CHR(ASH(lba, -16) MOD 100H);
	pkt[4] := CHR(ASH(lba, -8) MOD 100H);
	pkt[5] := CHR(lba MOD 100H);
	pkt[6] := 0X;
	pkt[7] := CHR(ASH(num, -8) MOD 100H);
	pkt[8] := CHR(num MOD 100H);
	pkt[9] := 0X;  pkt[10] := 0X;  pkt[11] := 0X;
	pkt[12] := 0X;  pkt[13] := 0X;  pkt[14] := 0X;  pkt[15] := 0X;
END ComposePacket;

(* Transfer a packet and read/write data, atapi only *)

PROCEDURE TransferPacket(d: Device;  pkt: Packet16;  read: BOOLEAN;  bufAdr, size: LONGINT): LONGINT;
VAR res, port, avail, key, code: LONGINT;  x: CHAR;
BEGIN
	port := d.controller.port;
	res := CommandPacket(d, pkt);
	WHILE (res = 0) & (size > 0) DO
		IF WaitStatus(port, {DRQ,BSY}, {DRQ}, {ERR}, IOTimeout) THEN
			SYSTEM.PORTIN(port+4, x);  avail := LONG(ORD(x));
			SYSTEM.PORTIN(port+5, x);  avail := avail + LONG(ORD(x))*100H;
			IF avail > size THEN avail := size END;
			(*Kernel.WriteString("Avail = "); Kernel.WriteInt(avail, 0); Kernel.WriteChar("/"); Kernel.WriteInt(size, 0); Kernel.WriteLn;*)

			IF read THEN
				RepInWord(port, bufAdr, avail DIV 2)
			ELSE
				RepOutWord(port, bufAdr, avail DIV 2)
			END;
			INC(bufAdr, avail); DEC(size, avail)
		ELSE 
			res := 33;
			SYSTEM.PORTIN(port+1, x);  key := ORD(x) DIV 10H;
			IF key # 0 THEN
				res := 34;
				code := SensePacketDevice(d);  d.sense := code;
				(*Kernel.WriteString("Transfer -> Sense "); Kernel.WriteHex(code, 0); Kernel.WriteLn;*)
				IF (key = 6) & ((code DIV 100H) = 29H) THEN	(*attention + power on, ignore*)
					res := CommandPacket(d, pkt)	(*resubmit command*)
				END
			END
		END
	END;
	IF (res = 0) & ~WaitStatus(port, {BSY, DRDY}, {DRDY}, {ERR}, IOTimeout) THEN res := 32 END;
	RETURN res
END TransferPacket;

(* Sense device, packet only *)

PROCEDURE SensePacketDevice(d: Device): LONGINT;
VAR pkt: Packet16;  sense, res, port: LONGINT; buf: ARRAY 18 OF CHAR;
BEGIN
	port := d.controller.port;
	ComposePacket(pkt, 03X, 0, 0);	(* Request Sense *)
	pkt[4] := 12X;	(* buffer size *)
	res := TransferPacket(d, pkt, TRUE, SYSTEM.ADR(buf[0]), LEN(buf));
	IF res = 0 THEN
		sense := ORD(buf[12])*100H + ORD(buf[13]);
	ELSE
		sense := ORD(buf[12])*100H + ORD(buf[13]);
		Kernel.WriteString("sense failed = "); Kernel.WriteHex(sense, -5); Kernel.WriteLn;
		sense := -1
	END;
	RETURN sense
END SensePacketDevice;

(* Read device blocksize with ModeSense command, packet only *)

PROCEDURE GetModeInfo(dev: Device; VAR blockSize: LONGINT): LONGINT;
VAR pkt: Packet16;  buf: ARRAY 12 OF CHAR;  res, port(*, size*): LONGINT;
BEGIN
	port := dev.controller.port;
	ComposePacket(pkt, 1AX, 0, 0);	(*ModeSense*)
	pkt[2] := 3FX;	(*mode page: all pages*)
	pkt[4] := 0CX;	(*buffer size*)
(*
	ComposePacket(pkt, 5AX(*1AX*), 0, 0);	(*ModeSense10*)
	pkt[2] := 0BFX(*3FX*);	(*default values + mode page: all pages*)
	pkt[8(*4*)] := 0CX;	(*buffer size*)
*)
	res := TransferPacket(dev, pkt, TRUE, SYSTEM.ADR(buf[0]), LEN(buf));
	IF (res = 34) & (dev.sense = 2800H) THEN	(*failed because of media change, repeat*)
		res := TransferPacket(dev, pkt, TRUE, SYSTEM.ADR(buf[0]), LEN(buf))
	END;
	IF (res = 0) & (ORD(buf[3]) = 8) THEN	(*if one descriptor returned*)
		blockSize := ORD(buf[4+7]);
		blockSize := blockSize + SYSTEM.LSH(ORD(buf[4+5]), 16);
		blockSize := blockSize + SYSTEM.LSH(ORD(buf[4+6]), 8);
		(*size := ORD(buf[4+3]);
		size := size + SYSTEM.LSH(ORD(buf[4+2]), 16);
		size := size + SYSTEM.LSH(ORD(buf[4+1]), 8);*)
	ELSE
		blockSize := 0;
		(*size := 0;*)
	END;
	IF blockSize = 0 THEN
		Kernel.WriteString("GetModeInfo "); Kernel.WriteString(dev.name);
		Kernel.WriteChar(" "); Kernel.WriteInt(blockSize, 1); Kernel.WriteLn;
		blockSize := BS
	END;
	RETURN res
END GetModeInfo;

(* Read medium capacity, packet only *)

PROCEDURE ReadCapacity(d: Device;  VAR blkSize, size: LONGINT): LONGINT;
VAR pkt: Packet16;  buf: ARRAY 8 OF CHAR;  res, port: LONGINT;
BEGIN
	IF TraceCalls THEN  Kernel.WriteString("ReadCapacity");  Kernel.WriteLn  END;
	port := d.controller.port;
	ComposePacket(pkt, 25X, 0, 0);	(* read capacity *)
	res := TransferPacket(d, pkt, TRUE, SYSTEM.ADR(buf[0]), LEN(buf));
	IF (res = 34) & (d.sense = 0401H) THEN	(*failed because getting ready, repeat*)
		NanoDelay(1000);	(*wait a little*)
		REPEAT  res := TransferPacket(d, pkt, TRUE, SYSTEM.ADR(buf[0]), LEN(buf))  UNTIL (res = 0) OR (d.sense # 0401H)
	END;
	IF (res = 34) & (d.sense = 2800H) THEN	(*failed because of media change, repeat*)
			res := TransferPacket(d, pkt, TRUE, SYSTEM.ADR(buf[0]), LEN(buf))
	END;	(*yes, error 2800H may follow 0401H*)
	IF res = 0 THEN
		size := 1 + ASH(LONG(ORD(buf[0])), 24) + ASH(LONG(ORD(buf[1])), 16);
		size := size + ASH(LONG(ORD(buf[2])), 8) + LONG(ORD(buf[3]));
		blkSize := ASH(LONG(ORD(buf[4])), 24) + ASH(LONG(ORD(buf[5])), 16);
		blkSize := blkSize + ASH(LONG(ORD(buf[6])), 8) + LONG(ORD(buf[7]));
		IF (CDRom IN d.id.type) & (blkSize # 2048) THEN
			Kernel.WriteString(d.name);  Kernel.WriteString(" block size set to 2048, was ");
			Kernel.WriteInt(blkSize, 0);  Kernel.WriteLn;
			blkSize := 2048
		END;
		IF TraceIdentify THEN
			Kernel.WriteString("ATADisks: read capacity ");
			Kernel.WriteInt(size, 4); Kernel.WriteString(" * ");
			Kernel.WriteInt(blkSize, 4); Kernel.WriteString(" = ");
			Kernel.WriteInt(size * (blkSize DIV 512) DIV 2048, 4); Kernel.WriteString(" MB");
			Kernel.WriteLn
		END
	END;
	RETURN res
END ReadCapacity;

(* test unit ready, packet only *)

PROCEDURE TestUnitReady(d: Device): LONGINT;
VAR port, res: LONGINT;  pkt: Packet16;
BEGIN
	IF TraceCalls THEN  Kernel.WriteString("TestUnitReady");  Kernel.WriteLn  END;
	port := d.controller.port;
	ComposePacket(pkt, 0X, 0, 0);	(* test unit ready command *)
	res := TransferPacket(d, pkt, FALSE, 0, 0);
	RETURN res
END TestUnitReady;

(* set CDRom Speed *)

(*
PROCEDURE SetCDSpeed(dev: Device;  read, write: LONGINT);
VAR res, port: LONGINT;  pkt: Packet16;
BEGIN
	port := dev.controller.port;
	ComposePacket(pkt, 0BBX, 0, 0);	(* set cd-rom speed command *)
	pkt[2] := CHR(ASH(read, -8) MOD 100H);
	pkt[3] := CHR(read MOD 100H);
	pkt[4] := CHR(ASH(write, -8) MOD 100H);
	pkt[5] := CHR(write MOD 100H);
	res := TransferPacket(dev, pkt, FALSE, 0, 0);
	IF res # 0 THEN
		Kernel.WriteString("SetSpeed failed ");  Kernel.WriteHex(SensePacketDevice(dev), 0);  Kernel.WriteLn
	END;
END SetCDSpeed;
*)

(* lock/unlock media *)

PROCEDURE LockMedium(d: Device; lock: BOOLEAN): LONGINT;
VAR port, res: LONGINT;  pkt: Packet16;
BEGIN
	IF Experimental THEN
		port := d.controller.port;
		IF AtapiBit IN d.id.type THEN
			ComposePacket(pkt, 1EX, 0, 0);	(* allow medium removal *)
			IF lock THEN pkt[4] := 1X END;
			res := TransferPacket(d, pkt, FALSE, 0, 0);
			RETURN res
		ELSIF CompactFlash IN d.id.type THEN (*CF*)
			RETURN Disks.Ok
		ELSE
			res := SelectDevice(port, d.dev, SelectTimeout);
			IF res = 0 THEN
				IF lock THEN
					SYSTEM.PORTOUT(port+7, 0DEX)	(* media lock *)
				ELSE
					SYSTEM.PORTOUT(port+7, 0DFX)	(* media unlock *)
				END;
				NanoDelay(400);
				IF ~WaitStatus(port, {BSY}, {}, {ERR}, ResetTimeout) THEN  res := 29  END
			END;
			RETURN res (*CF*)
		END
	ELSE
		RETURN Disks.Unsupported
	END
END LockMedium;

(* eject media *)

PROCEDURE RemoveMedium(d: Device): LONGINT;
VAR port, res: LONGINT;  pkt: Packet16;
BEGIN
	port := d.controller.port;
	IF AtapiBit IN d.id.type THEN
		ComposePacket(pkt, 01BX, 0, 0);	(* StartStopUnit *)
		pkt[4] := 2X;	(*eject*)
		res := TransferPacket(d, pkt, FALSE, 0, 0);
	ELSE
		SYSTEM.PORTOUT(port+6, CHR((ASH(d.dev, 4))));
		SYSTEM.PORTOUT(port+7, 0EDX);	(* media eject *)
		NanoDelay(400);
		IF ~WaitStatus(port, {BSY}, {}, {ERR}, ResetTimeout) THEN  res := 39  END
	END;
	RETURN res
END RemoveMedium;

(* get the media status, RMSN only *)

PROCEDURE GetMediaStatus(dev: Device;  VAR status: SET): LONGINT;
VAR port, res: LONGINT;  ch: CHAR;
BEGIN
	port := dev.controller.port;
	SYSTEM.PORTOUT(port+6, CHR((ASH(dev.dev, 4))));
	SYSTEM.PORTOUT(port+7, 0DAX);	(* get media status *)
	IF WaitStatus(port, {BSY}, {}, {}, ResetTimeout) THEN
		res := 0;
		SYSTEM.PORTIN(port+1, ch);  status := SYSTEM.VAL(SET, LONG(ORD(ch)))
	ELSE
		res := 38;
		ch := 0X;  status := {}
	END;
	RETURN res
END GetMediaStatus;

(* switch on/off RMSN, RMSN only *)

PROCEDURE SetRMSN(dev: Device;  on: BOOLEAN): LONGINT;
VAR  port, res: LONGINT;  ch: CHAR;
BEGIN
	IF Experimental THEN
		port := dev.controller.port;
		(*WriteStatus("SetRMSN", port); Kernel.WriteLn;*)
		res := SelectDevice(port, dev.dev, IdentifyTimeout);
		IF res = 0 THEN
			IF on THEN
				SYSTEM.PORTOUT(port+1, 95X)	(* enable media status notification *)
			ELSE
				SYSTEM.PORTOUT(port+1, 31X)	(* disable media status notification *)
			END;
			SYSTEM.PORTOUT(port+4, 0X);
			SYSTEM.PORTOUT(port+5, 0X);
			SYSTEM.PORTOUT(port+7, 0EFX);	(* set features *)
			NanoDelay(400);
			IF WaitStatus(port, {BSY}, {}, {ERR}, ResetTimeout) THEN
				res := 0;
				Kernel.WriteString(dev.name); Kernel.WriteString(": enable RMSN with:");
				SYSTEM.PORTIN(port+5, ch);
				IF 0 IN SYSTEM.VAL(SET, ch) THEN  Kernel.WriteString(" PENA") END;
				IF 1 IN SYSTEM.VAL(SET, ch) THEN  INCL(dev.id.type, LockBit);  Kernel.WriteString(" LOCK")  END;
				IF 2 IN SYSTEM.VAL(SET, ch) THEN  INCL(dev.id.type, EjectBit);  Kernel.WriteString(" PEJ")  END;
				Kernel.WriteLn
			ELSE
				res := 35;
				Kernel.WriteString(dev.name); Kernel.WriteString(": device doesn't support RMSN");
				SYSTEM.PORTIN(port+5, ch);  Kernel.WriteHex(ORD(ch), -3);
				Kernel.WriteLn
			END
		END
	ELSE
		res := 0
	END;
	RETURN res
END SetRMSN;

(* Check if media has changed and update it, removable only *)

PROCEDURE CheckRemovable(dev: Device;  read: BOOLEAN;  lba, num: LONGINT): LONGINT;
VAR port, res, code, blockSize: LONGINT;  status: SET;  changed: BOOLEAN;
BEGIN
	port := dev.controller.port;  changed := FALSE;
	IF RMSNBit IN dev.id.type THEN
		res := GetMediaStatus(dev, status);
		IF res = 0 THEN
			IF NM IN status THEN
				res := Disks.MediaMissing
			ELSIF AllowEject & (MCR IN status) THEN	(*remove request*)
				res := RemoveMedium(dev);
				IF res = 0 THEN
					REPEAT  res := GetMediaStatus(dev, status)  UNTIL  (res # 0) OR (NM IN status);
					dev.size := 0;  res := Disks.MediaMissing;
					EXCL(dev.flags, Disks.ReadOnly)
				END
			ELSIF (MC IN status) OR (dev.size = 0) THEN
				res := ReadCapacity(dev, blockSize, dev.size);
				ASSERT((res # 0) OR (blockSize = dev.blockSize));
				IF WP IN status THEN INCL(dev.flags, Disks.ReadOnly) ELSE EXCL(dev.flags, Disks.ReadOnly) END;
				changed := TRUE;
			END
		END
	ELSIF AtapiBit IN dev.id.type THEN
		res := TestUnitReady(dev);
		IF res = 34 THEN
			code := dev.sense
		ELSIF (res = 0) OR (res = 32) THEN
			code := SensePacketDevice(dev)
		ELSE
			code := 0;
		END;
		IF code = 0 THEN
			IF dev.size = 0 THEN
				res := ReadCapacity(dev, dev.blockSize, dev.size);  changed := TRUE;
				IF dev.blockSize = 0 THEN dev.blockSize := blockSize END
			END	(*first time*)
		ELSIF code = 2800H THEN	(* medium may have changed *)
			res := ReadCapacity(dev, blockSize, dev.size);  changed := TRUE;
			IF dev.blockSize = 0 THEN dev.blockSize := blockSize END
		ELSIF code = 3A00H THEN	(* medium not present *)
			res := Disks.MediaMissing;  
		ELSIF code = -1 THEN
			res := Disks.MediaMissing
		ELSE
			res := Disks.Unsupported;
			Kernel.WriteString("Check/Unknown Sense "); Kernel.WriteHex(code, 0); Kernel.WriteLn;
		END
	ELSIF CompactFlash IN dev.id.type THEN (*CF*)
		res := Disks.Ok (*? CompactFlash treated as non removable - to be completed *)
	ELSE
		res := Disks.Unsupported
	END;
	
	IF (res # 0) OR (num = 0) THEN
		(*skip*)
	ELSIF (lba >= dev.size) OR (lba+num > dev.size) THEN	(* out of range *)
		res := 226
	ELSIF ~read & (WP IN status) THEN	(* write protected *)
		res := 28
	ELSIF changed THEN
		res := Disks.MediaChanged
	END;
	
	RETURN res
END CheckRemovable;

(* Transfer blocks using DMA. *)

PROCEDURE TransferDMA(d: Device;  read: BOOLEAN;  lba, num, bufAdr: LONGINT): LONGINT;
VAR port, res, bmbase, i, size, left: LONGINT;  x: CHAR;  s: SET;  c: Controller;
BEGIN
	ASSERT(~ODD(bufAdr));	(* transfer must be word-aligned *)
	ASSERT((num > 0) & (num <= MaxTransfer));
	res := 0;  c := d.controller;
	port := c.port;  bmbase := c.bmbase;  ASSERT(bmbase # 0);
		(* init prdt *)
	i := 0;  size := num*BS;
	REPEAT
		left := 10000H - bufAdr MOD 10000H;	(* bytes left until next 64k boundary *)
		IF left > size THEN left := size END;
		c.prdt.prd[i].adr := bufAdr;  c.prdt.prd[i].count := left;
		INC(bufAdr, left);  DEC(size, left);  INC(i)
	UNTIL size = 0;
	INCL(SYSTEM.VAL(SET, c.prdt.prd[i-1].count), 31);	(* end marker *)
		(* init dma *)
	SYSTEM.PORTOUT(bmbase+4, SYSTEM.ADR(c.prdt.prd[0]));
	IF read THEN s := {3} ELSE s := {} END;
	SYSTEM.PORTOUT(bmbase, SYSTEM.VAL(CHAR, s));	(* set direction *)
	SYSTEM.PORTIN(bmbase+2, x);
	s := SYSTEM.VAL(SET, LONG(ORD(x)));
	SYSTEM.PORTOUT(bmbase+2, CHR(SYSTEM.VAL(LONGINT, s + {1,2})));	(* clear error, interrupt by writing *)
		(* init transfer *)
	StartInterrupt(c);
	IF read THEN x := 0C8X ELSE x := 0CAX END;	(* read dma or write dma *)
	Command(d, x, lba, num);
	SYSTEM.PORTIN(bmbase, x);
	s := SYSTEM.VAL(SET, LONG(ORD(x)));
	SYSTEM.PORTOUT(bmbase, CHR(SYSTEM.VAL(LONGINT, s + {0})));	(* start bm *)
	IF WaitInterrupt(c, IOTimeout) THEN
		IF EarlyBug THEN WaitNotBusy(c.port2) END;
		SYSTEM.PORTIN(bmbase+2, x);	(* check dma status *)
		s := SYSTEM.VAL(SET, LONG(ORD(x)));
		IF 1 IN s THEN res := 8 END
	ELSE
		res := 7
	END;
	SYSTEM.PORTIN(bmbase, x);
	s := SYSTEM.VAL(SET, LONG(ORD(x)));
	SYSTEM.PORTOUT(bmbase, CHR(SYSTEM.VAL(LONGINT, s - {0})));	(* stop bm *)
	SYSTEM.PORTIN(port+7, x);	(* clear interrupt *)
	s := SYSTEM.VAL(SET, LONG(ORD(x)));
	IF (res = 0) & (ERR IN s) THEN res := 9 END;
	RETURN res
END TransferDMA;

(* Initialize/Reset the selected device. *)

PROCEDURE InitDevice(port, port2, dev: LONGINT;  type: SET;  chs: CHS): LONGINT;
VAR x: CHAR;  sector, head, res: LONGINT;
BEGIN
	IF AtapiBit IN type THEN
		res := 0
	ELSE
		sector := chs.spt;
		head := chs.hds;
		SYSTEM.PORTOUT(port+2, CHR(sector));
		SYSTEM.PORTOUT(port+3, 0X);
		SYSTEM.PORTOUT(port+4, 0X);
		SYSTEM.PORTOUT(port+5, 0X);
		SYSTEM.PORTOUT(port+6, CHR((ASH(dev, 4) + (head-1) MOD 10H)));
		SYSTEM.PORTOUT(port+7, 091X);	(* initialize device parameters *)
		SYSTEM.PORTIN(port2, x);
		IF ~WaitStatus(port, {BSY}, {}, {ERR}, ResetTimeout) THEN
			IF LBABit IN type THEN
				Kernel.WriteString("ATADisks: using LBA mode, init dev param ignored");
				Kernel.WriteLn
			ELSE
				res := 17
			END
		END
	END;
	RETURN res
END InitDevice;

(* Convert a string to an integer. *)

PROCEDURE StrToInt(VAR i: LONGINT;  VAR s: ARRAY OF CHAR): LONGINT;
VAR vd, vh, sgn, d: LONGINT;  hex: BOOLEAN;
BEGIN
	vd := 0;  vh := 0;  hex := FALSE;
	IF s[i] = "-" THEN sgn := -1; INC(i) ELSE sgn := 1 END;
	LOOP
		IF (s[i] >= "0") & (s[i] <= "9") THEN d := ORD(s[i])-ORD("0")
		ELSIF (CAP(s[i]) >= "A") & (CAP(s[i]) <= "F") THEN d := ORD(CAP(s[i]))-ORD("A")+10; hex := TRUE
		ELSE EXIT
		END;
		vd := 10*vd + d;  vh := 16*vh + d;
		INC(i)
	END;
	IF CAP(s[i]) = "H" THEN hex := TRUE; INC(i) END;	(* optional H *)
	IF hex THEN vd := vh END;
	RETURN sgn * vd
END StrToInt;

(* Initialize controller parameters. *)

PROCEDURE ParseControllerConfig(num, dirq, dc: LONGINT);
VAR s: ARRAY 32 OF CHAR;  id: ARRAY 8 OF CHAR;  p, c, r, irq: LONGINT;
BEGIN
	id := "IDE#";  id[3] := CHR(ORD("0") + num);
	Kernel.GetConfig(id, s);
	IF (num = 0) & (s = "") THEN Kernel.GetConfig("IDE", s) END;
	IF UseConfigParams & (s # "") THEN
		p := 0;  c := 0;  r := 0;
		irq := StrToInt(p, s);
		IF (irq # 0) & (s[p] = ",") THEN
			INC(p);  c := StrToInt(p, s);
			IF s[p] = "," THEN
				INC(p);  r := StrToInt(p, s)
			END;
			IF c = 0 THEN c := dc END;
			IF (r = 0) & (c > 0) THEN r := c + 206H END
		END
	ELSE
		irq := dirq;  c := dc;  r := c + 206H
	END;
	IF c > 0 THEN
		NEW(controller[num]);
		controller[num].port := c;  controller[num].port2 := r;  controller[num].irq := irq;
		controller[num].bmbase := 0	(* BM disabled *)
	END
END ParseControllerConfig;

(* Get hard disk parameters. *)

PROCEDURE GetPar(p: LONGINT;  ofs: LONGINT): LONGINT;
VAR x: CHAR;
BEGIN
	SYSTEM.GET(p+12+ofs, x);
	RETURN ORD(x)
END GetPar;

(* Parse hard disk parameters of first two drives from BIOS. *)

PROCEDURE GetKernelCHS(d: LONGINT;  VAR chs1: CHS);
VAR p, t, i : LONGINT;  chs: CHS;
BEGIN
	p := Kernel.bt;  i := 0;
	LOOP
		SYSTEM.GET(p, t);
		IF t = -1 THEN EXIT	(* end *)
		ELSIF t = 5 THEN	(* HD params *)
			IF i = d THEN
				chs.cyls := GetPar(p, 0) + 100H*GetPar(p, 1);
				chs.hds := GetPar(p, 2);  chs.spt := GetPar(p, 14);
				IF chs.cyls * chs.hds * chs.spt > 0 THEN chs1 := chs END
			END;
			INC(i)
		END;
		SYSTEM.GET(p+4, t);  INC(p, t)
	END
END GetKernelCHS;

(* Convert an ATA identify string to a readable format. *)

PROCEDURE GetATAString(VAR buf: ARRAY OF INTEGER;  from, to: LONGINT;  VAR s: ARRAY OF CHAR);
VAR i, j: LONGINT;
BEGIN
	FOR i := from TO to DO
		s[2*(i-from)] := CHR(buf[i] DIV 100H MOD 100H);
		s[2*(i-from)+1] := CHR(buf[i] MOD 100H)
	END;
	s[2*(to-from+1)] := 0X;
	i := 0;  j := 0;
	WHILE s[i] # 0X DO
		IF (s[i] >= 20X) & (s[i] <= 7EX) THEN s[j] := s[i];  INC(j) END;
		INC(i);
		IF (j # 0) & (s[j-1] = 20X) THEN
			WHILE s[i] = 20X DO INC(i) END
		END
	END;
	IF (j # 0) & (s[j-1] = 20X) THEN DEC(j) END;
	s[j] := 0X
END GetATAString;

(* Identify an Atapi packet device. *)

PROCEDURE IdentifyAtapi(port, port2: LONGINT;  VAR id: ID): LONGINT;
VAR res: LONGINT;  x: CHAR;  buf: ARRAY BS DIV 2 OF INTEGER;
BEGIN
	SYSTEM.PORTOUT(port+7, 0A1X);	(* identify ATAPI device *)
	SYSTEM.PORTIN(port2, x);	(* ensure status ok *)
	IF WaitStatus(port, {BSY}, {}, {}, IdentifyTimeout) THEN
		INCL(id.type, AtapiBit);
		RepInWord(port, SYSTEM.ADR(buf[0]), BS DIV 2);
		IF 0 IN SYSTEM.VAL(SET, LONG(buf[0])) THEN INCL(id.type, Packet16Bit) END;
		IF 7 IN SYSTEM.VAL(SET, LONG(buf[0])) THEN INCL(id.type, RemovableBit) END;
		IF SYSTEM.VAL(SET, LONG(buf[0])) * {8..12} = {8, 10} THEN INCL(id.type, CDRom) END;
		IF 8 IN SYSTEM.VAL(SET, LONG(buf[49])) THEN INCL(id.type, DMABit) END;
		IF SYSTEM.VAL(SET, LONG(buf[127])) * {0,1} = {0} THEN INCL(id.type, RMSNBit) END;
		IF LONG(buf[0]) MOD 10000H = CompactFlashSignature THEN INCL(id.type, CompactFlash) END; (*CF*)
		GetATAString(buf, 27, 46, id.model);
		IF (buf[80] # -1) & (buf[81] # -1) THEN
			id.ver := ASH(LONG(buf[80]) MOD 10000H, 16) + LONG(buf[81]) MOD 10000H
		END;
		res := 0
	ELSE
		res := 12
	END;
	RETURN res
END IdentifyAtapi;

(* Identify an ATA device. *)

PROCEDURE IdentifyATA(port: LONGINT;  VAR chs: CHS;  VAR size: LONGINT;  VAR id: ID): LONGINT;
VAR res, size1: LONGINT;  buf: ARRAY BS DIV 2 OF INTEGER;
BEGIN
	RepInWord(port, SYSTEM.ADR(buf[0]), BS DIV 2);
	(*Kernel.WriteMemory(SYSTEM.ADR(buf[0]), BS);*)
	chs.cyls := LONG(buf[1]) MOD 10000H;
	chs.hds := LONG(buf[3]) MOD 10000H;
	chs.spt := LONG(buf[6]) MOD 10000H;
	size := ASH(LONG(buf[61]) MOD 10000H, 16) + LONG(buf[60]) MOD 10000H;
	IF size >= MinLBA THEN INCL(id.type, LBABit) END;
	size1 := chs.cyls * chs.hds * chs.spt;
	IF size < size1 THEN size := size1 END;
	IF SYSTEM.VAL(SET, LONG(buf[0])) * {6,7} = {7} THEN INCL(id.type, RemovableBit) END;
	IF SYSTEM.VAL(SET, LONG(buf[127])) * {0,1} = {0} THEN INCL(id.type, RMSNBit) END;
	IF LONG(buf[0]) MOD 10000H = CompactFlashSignature THEN INCL(id.type, CompactFlash) END; (*CF*)
	INCL(id.type, DMABit);	(* DMA support mandatory in ATA/ATAPI-4 *)
	GetATAString(buf, 27, 46, id.model);
	IF (buf[80] # -1) & (buf[81] # -1) THEN
		id.ver := ASH(LONG(buf[80]) MOD 10000H, 16) + LONG(buf[81]) MOD 10000H
	END;
	IF (chs.hds <= 16) & (chs.spt <= 255) THEN res := 0 ELSE res := 25 END;
	RETURN res
END IdentifyATA;

(* Identify a device. *)

PROCEDURE IdentifyDevice(controller: Controller;  dev: LONGINT;  VAR chs: CHS;  VAR size: LONGINT;  VAR id: ID): LONGINT;
VAR res, port, port2: LONGINT;  x: CHAR;  t: Kernel.MilliTimer;  zip: ARRAY 12 OF CHAR;
BEGIN
	id.type := {};  id.ver := 0;  chs.cyls := 0;  chs.hds := 0;  chs.spt := 0;  size := 0;
	port := controller.port;  port2 := controller.port2;
	IF port # 0 THEN
		Kernel.SetTimer(t, 50);  REPEAT UNTIL Kernel.Expired(t);
		res := SelectDevice(port, dev, IdentifyTimeout);
		IF res = 0 THEN
			StartInterrupt(controller);
			SYSTEM.PORTOUT(port+7, 0ECX);	(* identify device *)
			IF WaitInterrupt(controller, IdentifyTimeout) THEN
				IF EarlyBug THEN WaitNotBusy(controller.port2) END;
				SYSTEM.PORTIN(port+5, x);	(* signature byte *)
				IF x = 0EBX THEN
					res := IdentifyAtapi(port, port2, id);
						(* hack to make bootable zips (should write code to detect geometry) *)
					COPY(id.model, zip); zip[10] := 0X;
					IF zip = "IOMEGA ZIP" THEN
						chs.hds := 40H; chs.spt := 20H;
						IF id.model[11] = "2" THEN chs.cyls := 239 ELSE chs.cyls := 96 END;
					END
				ELSE
					res := IdentifyATA(port, chs, size, id);
					IF (res = 0) & (size = 0) THEN res := 13 END
				END
			ELSE
				res := 14
			END
		END;
		Kernel.SetTimer(t, 50);  REPEAT UNTIL Kernel.Expired(t);
		SYSTEM.PORTOUT(port+6, 0X);	(* select device 0 again *)
		NanoDelay(400)
	ELSE
		res := 15
	END;
	RETURN res
END IdentifyDevice;

(* Clean up unloaded module. *)

PROCEDURE Cleanup;
VAR i: LONGINT;  d: Device;
BEGIN
	IF Kernel.shutdown = 0 THEN
		FOR i := 0 TO MaxDevices-1 DO
			d := device[i];
			IF d # NIL THEN Disks.Unregister(d) END
		END;
		FOR i := 0 TO 15 DO
			IF i IN irqs THEN
				EXCL(irqs, i);
				Kernel.RemoveIP(InterruptHandler, SHORT(Kernel.IRQ + i))
			END
		END
	END
END Cleanup;

(* Initialization. *)

PROCEDURE IdentifyControllers;
VAR i: LONGINT;
BEGIN
	FOR i := 0 TO MaxControllers-1 DO controller[i] := NIL END;
	IF PrimaryEnabled THEN ParseControllerConfig(0, 14, 01F0H) END;
	IF SecondaryEnabled THEN ParseControllerConfig(1, 15, 0170H) END;
	IF MaxControllers > 2 THEN	(* compile-time expression *)
		FOR i := 2 TO MaxControllers-1 DO ParseControllerConfig(i, 0, 0) END
	END
END IdentifyControllers;

PROCEDURE ResetController(ctrl: Controller): BOOLEAN;
VAR t: Kernel.MilliTimer;
BEGIN
	SYSTEM.PORTOUT(ctrl.port2, 4X);	(* reset controller *)
	Kernel.SetTimer(t, 1);  REPEAT UNTIL Kernel.Expired(t);	(* wait > 4.8us *)
	SYSTEM.PORTOUT(ctrl.port2, 8X);
	RETURN WaitStatus(ctrl.port, {BSY}, {}, {}, ResetTimeout)
END ResetController;

PROCEDURE IdentifyDevices;
VAR
	p, q, a, n, res, size, tmp: LONGINT;  ctrl: Controller;  dev: Device;  chs: CHS;  id: ID;  x: CHAR;
	name: Disks.Name;  s: ARRAY 16 OF CHAR;  useBIOS: BOOLEAN;
BEGIN
	Kernel.GetConfig("ATABIOS", s);
	useBIOS := s[0] = "1";
	IF useBIOS THEN
		Kernel.WriteString("Using BIOS geometry");  Kernel.WriteLn
	END;
		(* identify all devices *)
	a := 0;  n := 0;
	FOR p := 0 TO MaxDevices-1 DO
		ctrl := controller[p DIV 2];
		IF ctrl # NIL THEN
			name := "IDEx";  name[3] := CHR(48 + p);
			res := IdentifyDevice(ctrl, p MOD 2, chs, size, id);
			IF res = 0 THEN
				NEW(dev);  Disks.InitDevice(dev, name);
				dev.controller := ctrl;  dev.dev := p MOD 2;  dev.init := FALSE;
				dev.id := id;  dev.size := size;  dev.chs := chs;  dev.getpar := dev.chs;
				COPY(id.model, dev.desc);
				IF AtapiBit IN id.type THEN
					SYSTEM.PORTOUT(ctrl.port+6, CHR(ASH(dev.dev, 4)));
					SYSTEM.PORTOUT(ctrl.port+7, 8X);	(* reset packet device *)
					SYSTEM.PORTIN(ctrl.port2, x);
					IF ~WaitStatus(ctrl.port, {BSY}, {}, {}, ResetTimeout) THEN res := 16 END;
					res := TestUnitReady(dev);
					IF res # 0 THEN tmp := SensePacketDevice(dev); res := 0 END;
					IF CDRom IN id.type THEN
						(*SetCDSpeed(dev, 0FFFFH, 0FFFFH);*)	(* use the maximal speed *)
						dev.blockSize := CDRomBS	(* ATAPI/CDRom shall all use this size *)
					ELSE res := GetModeInfo(dev, dev.blockSize)	(* detect block size *)
					END;
					IF (res = 0) & ~(RemovableBit IN dev.id.type) THEN  res := ReadCapacity(dev, tmp, dev.size)  END
				ELSE
					dev.blockSize := BS;
					IF (p < 2) & useBIOS THEN GetKernelCHS(p, dev.getpar) END;	(* override CHS *)
					IF dev.size > 16383*16*63 THEN
						dev.getpar.cyls := dev.size DIV (dev.getpar.hds * dev.getpar.spt)
					END
				END;
				device[q] := dev;  INC(q);
				IF (res = 0) & (RMSNBit IN id.type) THEN
					res := SetRMSN(dev, TRUE);
					(*IF res # 0 THEN  EXCL(dev.id.type, RMSNBit) END*)
				END
			ELSE (* skip *)
			END;
			IF TraceIdentify THEN
				Kernel.WriteString(name);  Kernel.WriteString(": Identify = ");
				Kernel.WriteInt(res, 1);  Kernel.WriteLn
			END;
			IF ~ResetController(ctrl) THEN
				Kernel.WriteString(name);  Kernel.WriteString(": reset failed");  Kernel.WriteLn
			ELSIF TraceIdentify THEN
				Kernel.WriteString(name);  Kernel.WriteString(": reset ok");  Kernel.WriteLn
			END
		END
	END;
	WHILE q # MaxDevices DO device[q] := NIL;  INC(q) END
END IdentifyDevices;

PROCEDURE ShowCHS(chs: CHS);
BEGIN
	Kernel.WriteInt(chs.cyls, 1);
	Kernel.WriteChar("*");
	Kernel.WriteInt(chs.hds, 1);
	Kernel.WriteChar("*");
	Kernel.WriteInt(chs.spt, 1)
END ShowCHS;

PROCEDURE ShowDevices;
VAR i, j: LONGINT;  dev: Device;
BEGIN
	FOR i := 0 TO MaxDevices-1 DO
		dev := device[i];
		IF dev # NIL THEN
			j := 0;  WHILE controller[j] # dev.controller DO INC(j) END;
			Kernel.WriteString("IDE");  Kernel.WriteInt(j*2 + dev.dev, 1);
			IF AtapiBit IN dev.id.type  THEN
				Kernel.WriteString(", packet");
				IF Packet16Bit IN dev.id.type THEN Kernel.WriteString("16") ELSE Kernel.WriteString("12") END;
			ELSE
				Kernel.WriteString(", ");  Kernel.WriteInt(dev.size DIV 2048, 1);  Kernel.WriteString("MB");
				Kernel.WriteString(", ");  ShowCHS(dev.chs);
				IF (dev.getpar.cyls # dev.chs.cyls) OR (dev.getpar.hds # dev.chs.hds) OR (dev.getpar.spt # dev.chs.spt) THEN
					Kernel.WriteString(", (");  ShowCHS(dev.getpar);  Kernel.WriteChar(")")
				END
			END;
			IF RemovableBit IN dev.id.type THEN Kernel.WriteString(", removable") END;
			IF CompactFlash IN dev.id.type THEN Kernel.WriteString(", CompactFlash") END; (*CF*)
			IF RMSNBit IN dev.id.type THEN Kernel.WriteString(", RMSN") END;
			IF ~(DMABit IN dev.id.type) THEN Kernel.WriteString(", no DMA") END;
			IF LBABit IN dev.id.type THEN Kernel.WriteString(", LBA") END;
			Kernel.WriteString(", ");  Kernel.WriteString(dev.id.model);
			IF dev.id.ver # 0 THEN
				Kernel.WriteString(", ver ");
				j := 30;  WHILE (j # 16) & ~ODD(ASH(dev.id.ver, -j)) DO DEC(j) END;
				Kernel.WriteInt(j-16, 1);  Kernel.WriteChar(".");
				Kernel.WriteInt(dev.id.ver MOD 10000H, 1)
			END;
			Kernel.WriteLn
		END
	END
END ShowDevices;

PROCEDURE InitControllers;
VAR i: LONGINT;  ctrl: Controller;
BEGIN
	FOR i := 0 TO MaxControllers-1 DO
		ctrl := controller[i];
		Kernel.WriteString("IDE");  Kernel.WriteInt(i*2, 1);
		Kernel.WriteString("..");  Kernel.WriteInt(i*2+1, 1);  Kernel.WriteString(": ");
		IF ctrl # NIL THEN
			Kernel.WriteInt(ctrl.irq, 1);  Kernel.WriteHex(ctrl.port, 9);  Kernel.WriteHex(ctrl.port2, 9);
			Kernel.WriteChar(" ");
			IF ResetController(ctrl) THEN
				Kernel.WriteString("reset ok");  Kernel.WriteLn;
				IF ~(ctrl.irq IN irqs) THEN
					Kernel.InstallIP(InterruptHandler, SHORT(Kernel.IRQ + ctrl.irq));
					INCL(irqs, ctrl.irq)
				END
			ELSE
				controller[i] := NIL;
				IF ~TraceStatus THEN
					Kernel.WriteString("reset failed");  Kernel.WriteLn
				END
			END
		ELSE
			Kernel.WriteString("disabled");  Kernel.WriteLn
		END
	END
END InitControllers;

PROCEDURE InitBusMaster;
VAR bus, dev, fkt, i, bmbase, iobase: LONGINT;  s: SET;  str: ARRAY 8 OF CHAR;

	PROCEDURE FindDevice(id, vendor: LONGINT): BOOLEAN;	(* set bus, dev, fkt as side-effect *)
	VAR res: LONGINT;
	BEGIN
		res := PCI.FindPCIDevice(id, vendor, 0, bus, dev, fkt);
		RETURN res = PCI.Done
	END FindDevice;
	
	PROCEDURE ReadDWord(adr: LONGINT;  VAR s: SET);
	VAR res: LONGINT;
	BEGIN
		res := PCI.ReadConfigDword(bus, dev, fkt, adr, SYSTEM.VAL(LONGINT, s));
		IF res # PCI.Done THEN s := {} END
	END ReadDWord;

	PROCEDURE WriteByte(adr: LONGINT;  s: SET);
	VAR res: LONGINT;
	BEGIN
		res := PCI.WriteConfigByte(bus, dev, fkt, adr, SYSTEM.VAL(LONGINT, s));
		(* ignore res *)
	END WriteByte;

BEGIN
	IF BMEnabled THEN
		Kernel.GetConfig("ATABM", str);
		IF str[0] # "0" THEN
			IF FindDevice(7010H, 8086H) OR FindDevice(7111H, 8086H) OR 
				FindDevice(2411H, 8086H) OR FindDevice(2421H, 8086H) THEN
				ReadDWord(PCI.CmdReg, s);
				IF OverrideBIOS & (s * {0,2} = {0}) THEN	(* override BIOS-disabled BM setting *)
					Kernel.WriteString("Overriding BIOS bus-master setting");  Kernel.WriteLn;
					WriteByte(PCI.CmdReg, s + {2});
					ReadDWord(PCI.CmdReg, s)
				END;
				IF s * {0,2} = {0,2} THEN	(* ports & BM enabled *)
					ReadDWord(20H, s);	(* BMIBA *)
					bmbase := SYSTEM.VAL(LONGINT, s * {4..15});
					IF bmbase # 0 THEN
						ReadDWord(40H, s);	(* IDETIM *)
						FOR i := 0 TO 1 DO	(* primary and secondary controller *)
							IF i = 0 THEN iobase := 1F0H ELSE iobase := 170H END;	(* standard ports *)
							IF (15 IN s) & (controller[i] # NIL) & (controller[i].port = iobase) THEN
								Kernel.WriteString("IDE");  Kernel.WriteInt(i*2, 1);
								Kernel.WriteString("..");  Kernel.WriteInt(i*2+1, 1);
								Kernel.WriteString(": Bus-master enabled");  Kernel.WriteLn;
								controller[i].bmbase := bmbase + 8*i;
								NEW(controller[i].prdt)
							END;
							s := SYSTEM.LSH(s, -16)
						END
					ELSE
						Kernel.WriteString("Bus-master ports disabled (BIOS)");  Kernel.WriteLn
					END
				ELSE
					Kernel.WriteString("Bus-master disabled");  Kernel.WriteLn
				END
			ELSE
				(*Kernel.WriteString("Bus-master chipset not detected");  Kernel.WriteLn*)
			END
		END
	END
END InitBusMaster;

(* Main transfer procedure. *)

PROCEDURE Transfer(d: Disks.Device;  op, lba, num: LONGINT;  VAR data: ARRAY OF CHAR;  ofs: LONGINT;  VAR res: LONGINT);
VAR dev: Device;  ctrl: Controller;  num1, try, bufAdr: LONGINT;  pkt: Packet16;  read: BOOLEAN;
BEGIN
	IF TraceCalls THEN Kernel.WriteString(d.name); Kernel.WriteString(" Transfer"); Kernel.WriteLn END;
	IF (op = Disks.Read) OR (op = Disks.Write) THEN
		read := op = Disks.Read;
		dev := d(Device);  bufAdr := SYSTEM.ADR(data[ofs]);
		IF dev # NIL THEN
			IF (lba >= 0) & (num >= 0) & ((lba < dev.size) & (lba+num <= dev.size) OR (RemovableBit IN dev.id.type)) THEN
				ASSERT(num*dev.blockSize <= LEN(data)-ofs);	(* range check *)
				ctrl := dev.controller;
				SYSTEM.CLI();
				IF ctrl.busy THEN SYSTEM.STI();  SYSTEM.HALT(17) END;
				ctrl.busy := TRUE;
				SYSTEM.STI();
				res := SelectDevice(ctrl.port, dev.dev, SelectTimeout);
				IF (res = 0) & ~dev.init THEN	(* initialize *)
					res := InitDevice(ctrl.port, ctrl.port2, dev.dev, dev.id.type, dev.chs);
					dev.init := res = 0
				END;
				IF (res = 0) & (RemovableBit IN dev.id.type) THEN res := CheckRemovable(dev, read, lba, num) END;
				WHILE (res = 0) & (num > 0) DO
					try := MaxTries;  num1 := MaxTransfer;
					IF num1 > num THEN num1 := num END;
					REPEAT
						IF AtapiBit IN dev.id.type THEN
							IF read THEN ComposePacket(pkt, 28X, lba, num)
							ELSE ComposePacket(pkt, 2AX, lba, num)
							END;
							res := TransferPacket(dev, pkt, read, bufAdr, num*dev.blockSize)
						ELSE
							IF (ctrl.bmbase # 0) & ~ODD(bufAdr) THEN
								res := TransferDMA(dev, read, lba, num1, bufAdr)
							ELSE
								IF read THEN res := ReadPIO(dev, lba, num1, bufAdr)
								ELSE res := WritePIO(dev, lba, num1, bufAdr)
								END
							END
						END;
						DEC(try)
					UNTIL (res = 0) OR (try = 0);
					INC(lba, num1);  DEC(num, num1);  INC(bufAdr, BS*num1)
				END;
				ctrl.busy := FALSE
			ELSE
				res := 26
			END
		ELSE
			res := 11
		END
	ELSE
		res := Disks.Unsupported
	END
END Transfer;
	
PROCEDURE GetSize(d: Disks.Device;  VAR size, res: LONGINT);
VAR dev: Device;
BEGIN
	dev := d(Device);  res := 0;
	IF TraceCalls THEN Kernel.WriteString(d.name); Kernel.WriteString(" GetSize"); Kernel.WriteLn END;
	IF RemovableBit IN dev.id.type THEN
		res := CheckRemovable(dev, FALSE, 0, 0);
		IF res = Disks.MediaChanged THEN res := 0 END
	END;
	IF res # 0 THEN
		size := 0
	ELSIF AtapiBit IN dev.id.type THEN
		size := dev.size;
		res := 0
	ELSE
		size := dev.getpar.cyls*dev.getpar.hds*dev.getpar.spt;
		res := 0
	END
END GetSize;

PROCEDURE Handle(d: Disks.Device;  VAR msg: Disks.Message;  VAR res: LONGINT);
VAR dev: Device;
BEGIN
	dev := d(Device);
	IF msg IS Disks.GetGeometryMsg THEN
		IF TraceCalls THEN Kernel.WriteString(d.name); Kernel.WriteString(" Handle/GetGeometry"); Kernel.WriteLn END;
		IF dev.getpar.spt # 0 THEN
			WITH msg: Disks.GetGeometryMsg DO
				msg.cyls := dev.getpar.cyls;  msg.hds := dev.getpar.hds;  msg.spt := dev.getpar.spt;
				res := Disks.Ok
			END
		ELSE
			res := Disks.Unsupported
		END
	ELSIF msg IS Disks.LockMsg THEN
		IF TraceCalls THEN Kernel.WriteString(d.name); Kernel.WriteString(" Handle/Lock"); Kernel.WriteLn END;
		IF (RemovableBit IN dev.id.type) THEN
			res := LockMedium(dev, TRUE)
		ELSE
			res := Disks.Unsupported
		END
	ELSIF msg IS Disks.UnlockMsg THEN
		IF TraceCalls THEN Kernel.WriteString(d.name); Kernel.WriteString(" Handle/Unlock"); Kernel.WriteLn END;
		IF (RemovableBit IN dev.id.type) THEN
			res := LockMedium(dev, FALSE)
		ELSE
			res := Disks.Unsupported
		END
	ELSIF msg IS Disks.EjectMsg THEN
		IF TraceCalls THEN Kernel.WriteString(d.name); Kernel.WriteString(" Handle/Eject"); Kernel.WriteLn END;
		IF (RemovableBit IN dev.id.type) THEN
			res := RemoveMedium(dev)
		ELSE
			res := Disks.Unsupported
		END
	ELSE
		IF TraceCalls THEN Kernel.WriteString(d.name); Kernel.WriteString(" Handle/others"); Kernel.WriteLn END;
		res := Disks.Unsupported
	END
END Handle;

PROCEDURE Register;
VAR i: LONGINT;  dev: Device;
BEGIN
	FOR i := 0 TO MaxDevices-1 DO
		dev := device[i];
		IF dev # NIL THEN
			dev.flags := {};
			IF RemovableBit IN dev.id.type THEN INCL(dev.flags, Disks.Removable) END;
			dev.transfer := Transfer;  dev.getSize := GetSize;  dev.handle := Handle;
			Disks.Register(dev)
		END
	END
END Register;

(** The install command has no effect, as all ATA devices are installed when the module is loaded. *)
PROCEDURE Install*;
END Install;

BEGIN
	Kernel.WriteString("ATADisks 08.12.2000 by cp, pjm, prk");  Kernel.WriteLn;
	irqs := {};  Kernel.InstallTermHandler(Cleanup);
	IdentifyControllers;
	InitControllers;
	IdentifyDevices;
	ShowDevices;
	(*InitControllers*);	(* re-initialize controllers after identify *)
	InitBusMaster;
	Register
END ATADisks.

Error codes:
1	device select failed before issueing
2	device select failed after issueing
3	pio read failed
4	pio read error
5	pio write failed
6	pio write error
7	dma transfer timeout
8	dma transfer failed
9	dma transfer error
10	controller re-entered
11	device does not exist
12	identify atapi failed
13	device size is 0
14	identify failed
15	bad controller port
16	atapi reset failed
17	ata set parameters failed
18	
19	pio read timeout
20	pio read error
21	pio read error
22	pio write error
23	pio write timeout
24	pio write error
25	identify ata geometry bad
26	transfer out of range
27	no media
28	media write protected
29	media unlock failed
30	sync cache failed
31	packet command failed
32	transfer packet error (did not complete)
33	transfer failed (no sense data available)
34	transfer failed (sense data available)
35	rmsn failed (not supported)
36	read capacity packet failed
37	unit attention failed
38	get status failed
39	remove ata medium failed

ATADisks.Install	System.Free ATADisks ~

ATAErrors.Text

to do:
o check selected device
o atapi identify with interrupt
o set ReadOnly bit in device.flags depending on removable media status for non RMSN devices