(****************** ACCESS.bus Controller (PC) ******************)
(* This listing is designed to to be compiled under *)
(* Turbo Pascal version 6.0 or above *)
(* Author : Robert Clemens *)
(* Last update : 1-23-93 *)
(****************************************************************)
{$L-} (* Link to disk off *)
{$B-} (* Boolean complete eval off *)
{$I+} (* I/O checking on *)
{$N-} (* No numeric coprocessor *)
{$M 4096, 0, 4096} (* Stack and heap size *)
{$V-} (* String checking Off *)
{$S-} (* Stack Checking Off *)
{$R-} (* Range checking off *)
program AbCon;
Uses
Crt,
Dos;
const
ECHOOFF = 0;
ECHOTX = 1;
ECHORX = 2;
ECHOFULL = 3;
EchoStr : array[0..3] of string[9] =
('OFF ',
'Txed ',
'Rxed ',
'Rxed+Txed');
EchoMode : byte = ECHOFULL;
HostAvailible : boolean = false;
CARDSPEED : byte = $18; (* 8mhz card speed *)
TimerCount : integer = 0;
Leave : boolean = false;
(*********************** Essential Basics ***********************)
type
str2 = string[2];
procedure Beep; (* Sounds terminal bell *)
var tms : byte;
begin
for tms := 1 to 3 do
begin
sound(1200);
delay(20);
sound(900);
delay(20);
end;
NoSound;
end;
function hex (b : byte) : str2; (* Convert byte to hex *)
const
h : array [0..15] of char = '0123456789ABCDEF';
begin
Hex := h [ b shr 4 ] + h [ b and 15 ];
end;
function ASCIIToHex(ch:char) : byte;
begin
case ch of
'a'..'f' : ASCIIToHex := ord(ch) - 87;
'A'..'F' : ASCIIToHex := ord(ch) - 55;
'0'..'9' : ASCIIToHex := ord(ch) - 48;
end;
end;
(***************** PCD 8584 Chip constants **********************)
const
RW_ADDRESS = $00; (* Select Own Address Register *)
RW_DATA = $40; (* Select Data Register *)
RW_CLOCK = $20; (* Select I2C Speed Register *)
ACK = $00; (* Write ACK Bit *)
NOTACK = $01; (* Write NoACK Bit *)
STOP = $02; (* Write Stop Condition *)
START = $04; (* Write Start Condition *)
ENI = $08; (* Write Enable Chip Interrupt *)
PIN = $80; (* Read/Write PIN Bit *)
BB = $01; (* Read BUS BUSY Condition *)
ARL = $02; (* Read Lost Arbitration *)
AAS = $04; (* Read Slave Receiver Condition*)
LRB = $08; (* Read Last Received Bit (ACK) *)
BER = $10; (* Read Bus ERROR Condition *)
STS = $20; (* Read STOP while Slave *)
DataPort = $300; (* These are port addresses for *)
StatPort = $301; (* the ISA card *)
ControlPort = $302;
(******************* Ab Protocol command values *****************)
const
AB_DEV_RESET = $F0;
AB_ID_REQUEST = $F1;
AB_ASSIGN_ADD = $F2;
AB_CAP_REQUEST = $F3;
AB_DEV_ATTEN = $E0;
AB_ID_REPORT = $E1;
AB_CAP_REPORT = $E3;
AB_ERROR = $E4;
AB_APP_POLL = $B0;
AB_APP_TEST = $B1;
AB_HW_SIG = $A0;
AB_TEST_REPORT = $A1;
AB_APP_RESUME = $FC;
AB_APP_HOLD = $FD;
AB_INP_ERR = $02;
AB_KEY_CLICK = $01;
(*********************** Bus Conditions *************************)
const
BUSCONFIGURED = $00;
BUSASSIGNADD = $04;
BUSCONFIRM = $08;
BUSRESET = $10;
BUSERROR = $20;
BusStatus : byte = BUSCONFIGURED;
(*********************** I2C Conditions *************************)
const
I2CIDLE = 0;
I2CRxING = 1;
I2CTxING = 2;
I2CSTOP = 4;
I2CERROR = 5;
I2CStatus : byte = I2CIDLE;
(********************** Device Conditions ***********************)
const
DEVRESET = $00;
DEVWAIT = $01;
DEVCONFIRM = $02;
DEVGETCAP = $04;
DEVWAITCAP = $08;
DEVREADY = $10;
DEVERROR = $20;
(***************** AB Data Constants and Types ******************)
const
MAXABMSGLEN = 127;
MAXDEVICES = 15;
MAXCAPABILITIESLEN = 127;
BUSRESETDELAY = 5;
HOST_ADDRESS = $50;
DEVICE_DEFAULT= $6E;
PROTOCOL = $80;
MAXTXPAKS = 16;
MAXRXPAKS = 32;
ReportPtr : byte = 0;
InputPtr : byte = 0;
TxLoadPtr : byte = 0;
TxPtr : byte = 0;
type
AB_DEVICE = record
Status : integer;
Address : integer;
class : integer;
ID : string[30];
Capabilities : string[MAXCAPABILITIESLEN];
DisplayMe : byte;
CapOffset : word;
end;
AB_DEVICES = record
Device : array[0..MAXDEVICES] of AB_Device;
end;
AbMessage = array[0..MAXABMSGLEN] of byte;
var
Devices : array[0..MAXDEVICES] of AB_Device;
AbMsg : AbMessage;
ABIntNum : byte;
IntEnableMask : byte;
OldIntMask : byte;
ReadData : byte;
WriteData : byte;
StatusData : byte;
OldABIntVector : pointer;
OldTimerIntVector : pointer;
RxMsgPaks : array[0..MAXRXPAKS,0..130] of byte;
TxMsgPaks : array[0..MAXTXPAKS,0..130] of byte;
RxMsgLen : integer;
TxCnt : byte;
RxCnt : byte;
RxChkSum : byte;
TxChkSum : byte;
chtr : char;
(************* Build a pak and attempt to send it ***************)
procedure TxPak(dtn,src,lgth : byte; msg : AbMessage);
var c : byte;
len : byte;
begin (* Assemble a message *)
len := lgth and $7F; (* and calculate Check- *)
TxChkSum := dtn; (* sum then put it into *)
TxMsgPaks[TxLoadPtr,2] := dtn; (* the transmit queue. *)
TxChkSum := TxChkSum xor src;
TxMsgPaks[TxLoadPtr,3] := src;
TxChkSum := TxChkSum xor lgth;
TxMsgPaks[TxLoadPtr,4] := lgth;
for c := 1 to len do
begin
TxChkSum := TxChkSum xor msg[c];
TxMsgPaks[TxLoadPtr,c + 4] := msg[c];
end;
TxMsgPaks[TxLoadPtr,len + 5] := TxChkSum;
TxMsgPaks[TxLoadPtr,1] := len + 5;
TxMsgPaks[TxLoadPtr,0] := 2;
if ((EchoMode and ECHOTX) = ECHOTX) then
begin
write('Tx.. ');
for c := 0 to TxMsgPaks[TxLoadPtr,1] do
write(hex(TxMsgPaks[TxLoadPtr,c]),' ');
writeln;
end;
Inc(TxLoadPtr);
if TxLoadPtr = MAXTXPAKS then TxLoadPtr := 0;
if (port[StatPort] <> $81) then exit;
port[DataPort] := TxMsgPaks[TxPtr,TxMsgPaks[TxPtr,0]];
port[StatPort] := PIN + RW_DATA + ENI + START + NOTACK;
I2CStatus := I2CTxING;
end;
(********************** Timer Service ***************************)
(*$F+ *)
procedure Timer;
interrupt;
var
ds : byte;
begin
asm
push ss
pushf (* Setup for RETI instruction *)
call OldTimerIntVector (* Call old Timer ISR *)
pop ss
end;
if TxPtr <> TxLoadPtr then
begin
if ((port[StatPort] and BB) = 0) then exit;
port[DataPort] := TxMsgPaks[TxPtr,TxMsgPaks[TxPtr,0]];
port[StatPort] := PIN + RW_DATA + ENI + START + NOTACK;
I2CStatus := I2CTxING;
exit;
end;
if BusStatus <> BUSCONFIGURED then
begin
if BusStatus = BUSCONFIRM then
begin
Dec(TimerCount);
if TimerCount = 0 then
begin
for ds := 1 to MAXDEVICES do
if (Devices[ds].Status = DEVCONFIRM) then
Devices[ds].Status := DEVRESET;
AbMsg[1] := AB_ID_REQUEST;
TxPak(DEVICE_DEFAULT,
HOST_ADDRESS,
PROTOCOL + 1,
AbMsg);
BusStatus := BUSCONFIGURED;
end
else exit;
end;
if BusStatus = BUSRESET then
begin
Dec(TimerCount);
if TimerCount = (BUSRESETDELAY - 3) then
begin
if not HOSTAVAILIBLE then
begin
AbMsg[1] := AB_DEV_RESET;
for ds := MAXDEVICES downto 1 do
begin
TxPak((ds * 2) + HOST_ADDRESS,
HOST_ADDRESS,
PROTOCOL + 1,
AbMsg);
end;
end
else
begin
AbMsg[1] := AB_ID_REQUEST;
for ds := MAXDEVICES downto 1 do
begin
TxPak((ds * 2) + HOST_ADDRESS,
HOST_ADDRESS,
PROTOCOL + 1,
AbMsg);
end;
AbMsg[1] := AB_DEV_RESET;
TxPak(DEVICE_DEFAULT,
HOST_ADDRESS,
PROTOCOL + 1,
AbMsg);
end;
end;
if TimerCount = 0 then
begin
AbMsg[1] := AB_ID_REQUEST;
TxPak(DEVICE_DEFAULT,
HOST_ADDRESS,
PROTOCOL + 1,
AbMsg);
BusStatus := BUSASSIGNADD;
TimerCount := 3;
end
else exit;
end;
if BusStatus = BUSASSIGNADD then
begin
Dec(TimerCount);
for ds := MAXDEVICES downto 1 do (* Start Get Capability *)
begin (* phase for device *)
if Devices[ds].Status = DEVGETCAP then
begin
AbMsg[1] := AB_CAP_REQUEST;
AbMsg[2] := 0;
AbMsg[3] := 0;
TxPak((ds * 2) + HOST_ADDRESS,
HOST_ADDRESS,
PROTOCOL + 3,
AbMsg);
Devices[ds].Status := DEVWAITCAP;
end;
end;
if TimerCount = 0 then
begin
BusStatus := BUSCONFIGURED;
end
else exit;
end;
end;
end;
(*$F- *)
(*********************** AB Interupt handler ********************)
function DataReady:boolean; (* Is data in input buf *)
begin
DataReady := InputPtr <> ReportPtr;
end;
(*$F+ *)
procedure DevInterrupt; (* Main Interrupt Handler *)
interrupt;
begin
if I2CStatus > I2CRxING then (* Transmit Routine *)
begin
Inc(TxMsgPaks[TxPtr,0]);
if I2CStatus = I2CSTOP then
begin
port[StatPort] := PIN + RW_DATA + ENI + STOP + NOTACK;
I2CStatus := I2CIDLE;
Inc(TxPtr);
if TxPtr = MAXTXPAKS then TxPtr := 0;
end
else
begin
port[dataport] := TxMsgPaks[TxPtr,TxMsgPaks[TxPtr,0]];
if TxMsgPaks[TxPtr,0] = TxMsgPaks[TxPtr,1] then I2CStatus := I2CSTOP
else I2CStatus := I2CTxING;
end;
end
else
begin (* Receive Routine *)
StatusData := port[StatPort];
ReadData := port[DataPort]; (* Read DataPort *)
if (StatusData and AAS) = AAS then
begin
RxMsgPaks[InputPtr,0] := 0; (* Say Message OK *)
RxMsgPaks[InputPtr,1] := ReadData;(* Read Dest address *)
RxChkSum := ReadData;
RxCnt := 2;
I2CStatus := I2CRxing;
end
else
if StatusData = $00 then (* Read a good byte *)
begin
RxMsgPaks[InputPtr,RxCnt] := ReadData;
RxChkSum := RxChkSum xor ReadData;
if RxCnt = 2 then RxMsglen := ReadData and $7F
else Dec(RxMsgLen); (* look for End of Msg *)
Inc(RxCnt);
if RxMsgLen = -1 then (* Do Checksum *)
if (RxChkSum xor ReadData) <> 0 then
RxMsgPaks[InputPtr,0] := $FF; (* Checksum bad *)
end
else
begin
if (StatusData and STS) = STS then I2CStatus := I2CIDLE
else
begin
I2CStatus := I2CERROR;
RxMsgPaks[InputPtr,0] := StatusData; (* Message bad *)
end;
Inc(InputPtr);
if InputPtr = MAXRXPAKS then InputPtr := 0;
if InputPtr = ReportPtr then writeln('Rx Queue OVERRUN !!');
end;
end;
port[$20] := $20;
end;
(*$F- *)
procedure InstallAbInterrupt;
begin
GetIntVec(AbIntNum,OldABIntVector);
SetIntVec(AbIntNum,@DevInterrupt);
port[$21] := port[$21] and IntEnableMask;
end;
procedure UnInstallAbInterrupt;
begin
port[$21] := OldIntMask;
SetIntVec(AbIntNum,OldABIntVector);
end;
(*********************** Display Routines ***********************)
procedure DisplayMenu;
begin
writeln('READ "S"tatusPort, "D"ataPort "H"ex Value "R"eset Devices');
writeln('WRITE S"t"atusPort, D"a"taPort "E"cho Mode "U"ser Input "Q"uit');
writeln('===============================================================================');
window(1,4,79,Hi(WindMax));
writeln('EchoMode = RXed+Txed');
end;
procedure DisplayRxedMessage;
var c : byte;
begin
if RxMsgPaks[ReportPtr,0] <> 0 then
begin
write('Rx ERROR ! ');
end
else write('Rx.. ');
for c := 0 to (RxMsgPaks[ReportPtr,3] and $7F) + 4 do
write(hex(RxMsgPaks[ReportPtr,c]),' ');
writeln;
end;
(************************ Ab Code Begins ************************)
procedure Reset8584; (* Software reset of PCD8584 *)
begin
port[ControlPort] := 1;
delay(50);
port[ControlPort] := 0;
end;
procedure SetStatusRegister(Rgst : byte; Dta : byte);
begin (* Set PCD8584 Control Register *)
port[StatPort] := PIN + Rgst;
port[DataPort] := Dta;
port[StatPort] := PIN + RW_DATA + ENI + ACK;
if port[StatPort] <> $81 then
begin
writeln('ACCESS.bus Adapter Board not found..');
halt;
end;
end;
procedure Init8584;
begin
SetStatusRegister(RW_ADDRESS,HOST_ADDRESS shr 1);
SetStatusRegister(RW_CLOCK,CARDSPEED);
end;
procedure ResetAbDevices;
var n : byte;
begin
if EchoMode > ECHOOFF then writeln('Resetting all Ab Devices...');
BusStatus := BUSRESET;
AbMsg[1] := AB_DEV_RESET;
for n := MAXDEVICES downto 1 do
begin
TxPak((n * 2) + HOST_ADDRESS,
HOST_ADDRESS,
PROTOCOL + 1,
AbMsg);
end;
end;
procedure ResetAll;
begin
Reset8584;
Init8584;
FillChar(Devices,sizeof(Devices),$00);
I2CStatus := I2CIDLE;
ResetAbDevices;
end;
(*********************** AB Message Parser **********************)
procedure CheckQueue;
label Escape;
var
DevNumber : byte;
AddressAssigned: boolean;
c : byte;
SlotScan : byte;
begin
Repeat
if (EchoMode > ECHOTX) then DisplayRxedMessage;
DevNumber := (RxMsgPaks[ReportPtr,2] - HOST_ADDRESS) shr 1;
if (RxMsgPaks[ReportPtr,3] and PROTOCOL) = PROTOCOL then
begin
case RxMsgPaks[ReportPtr,4] of
AB_DEV_ATTEN : begin
if (RxMsgPaks[ReportPtr,2] = DEVICE_DEFAULT) then
begin (*HOT-PLUG?*)
if (RxMsgPaks[ReportPtr,5] <> 0) then
begin
if EchoMode > 0 then
writeln('DEVICE REPORTS SELF TEST ERROR !!');
goto Escape;
end;
if (BusStatus = BUSCONFIGURED) then
begin
TimerCount := 5;
BusStatus := BUSCONFIRM;
for c := 1 to MAXDEVICES do (* Devices Present *)
begin
if Devices[c].Status = DEVREADY then
begin
Devices[c].Status := DEVCONFIRM;
AbMsg[1] := AB_ID_REQUEST;
TxPak((SlotScan * 2) + HOST_ADDRESS,
HOST_ADDRESS,
PROTOCOL + 1,
AbMsg);
end;
end;
end;
end;
end;
AB_ID_REPORT : begin
if Devices[Devnumber].Status = DEVCONFIRM then
begin
Devices[Devnumber].Status := DEVREADY;
end
else
begin
SlotScan := 0;
AddressAssigned := false;
Repeat
Inc(SlotScan);
if (Devices[SlotScan].Status = DEVRESET) then
begin
Devices[SlotScan].Status := DEVREADY;
AbMsg[1] := AB_ASSIGN_ADD;
for c := 2 to 29 do
begin
Devices[SlotScan].ID[c - 1] := chr(RxMsgPaks[ReportPtr,c + 3]);
AbMsg[c] := RxMsgPaks[ReportPtr,c + 3];
end;
AbMsg[30] := (SlotScan * 2) + HOST_ADDRESS;
Devices[SlotScan].Address := (SlotScan * 2) + HOST_ADDRESS;
TxPak(DEVICE_DEFAULT,
HOST_ADDRESS,
PROTOCOL + 30,
AbMsg);
AddressAssigned := true;
Devices[SlotScan].Status := DEVREADY;
Delay(2);
AbMsg[1] := AB_CAP_REQUEST;
AbMsg[2] := hi(Devices[SlotScan].CapOffset);
AbMsg[3] := lo(Devices[SlotScan].CapOffset);
TxPak((SlotScan * 2) + HOST_ADDRESS,
HOST_ADDRESS,
PROTOCOL + 3,
AbMsg);
if EchoMode = ECHOFULL then
begin
write('Dev ',hex((SlotScan * 2) + HOST_ADDRESS),' ');
for c := 1 to 28 do
write(Devices[SlotScan].ID[c]);
writeln;
end;
end;
Until AddressAssigned or (SlotScan > MAXDEVICES);
end;
end;
AB_CAP_REPORT : begin
if RxMsgPaks[ReportPtr,3] > $83 then
begin
Devices[DevNumber].CapOffset := (RxMsgPaks[ReportPtr,5] shl 8) +
RxMsgPaks[ReportPtr,6];
for c := 0 to (RxMsgPaks[ReportPtr,3] - $83) do
Devices[DevNumber].Capabilities[Devices[DevNumber].CapOffset + c + 1] := chr(RxMsgPaks[ReportPtr,c + 7]);
Devices[DevNumber].CapOffset :=
Devices[DevNumber].CapOffset + (RxMsgPaks[ReportPtr,3] - $83);
AbMsg[1] := AB_CAP_REQUEST;
AbMsg[2] := hi(Devices[DevNumber].CapOffset);
AbMsg[3] := lo(Devices[DevNumber].CapOffset);
TxPak((DevNumber * 2) + HOST_ADDRESS,
HOST_ADDRESS,
PROTOCOL + 3,
AbMsg);
end
else
begin
for c := 1 to 127 do write(Devices[DevNumber].Capabilities[c]);
writeln
end;
end;
end;
end;
Escape:
Inc(ReportPtr);
if ReportPtr = MAXRXPAKS then ReportPtr := 0;
Until not DataReady;
end;
(************************ Get a Hex Value ***********************)
procedure GetHex(var n : byte);
var
GetValue : byte;
begin
GetValue := 0;
Repeat
if DataReady then CheckQueue;
if Keypressed then
begin
chtr := upcase(Readkey);
case chtr of
'A'..'F',
'0'..'9': if GetValue < 2 then
begin (* Small Digit *)
if GetValue = 1 then
begin
n := n + ASCIIToHex(chtr);
GetValue := 2;
end
else
begin (* Big Digit *)
n := ASCIIToHex(chtr) * 16;
GetValue := 1;
end;
write(chtr);
end;
^M : begin
if GetValue = 1 then Beep;
end;
^H : if GetValue > 0 then
begin
if GetValue = 2 then
begin
n := n - ASCIIToHex(chtr); (* Small Digit *)
GetValue := 1;
end
else
begin
n := 0; (* Big Digit *)
GetValue := 0;
end;
gotoxy(WhereX - 1,WhereY);
write(' ');
gotoxy(WhereX - 1,WhereY);
end;
else Beep;
end;
end;
Until ((chtr = ^M) and ((GetValue = 2) or (GetValue = 0))) or (chtr = ^[);
writeln;
end;
(*********************** Get a User Messge **********************)
procedure DoUserInput(x,y : integer);
const
n : integer = 0;
dest : byte = 0;
source: byte = 0;
length: byte = 0;
var
len : integer;
Val : byte;
Msg : AbMessage;
begin
write('Enter Message (without ChkSum): ');
n := 0;
FillChar(msg,sizeof(msg),0);
REPEAT
if DataReady then CheckQueue;
if Keypressed then
begin
chtr := upcase(ReadKey);
case chtr of
'0'..'9','A'..'F'
: begin (* Get a hex number and *)
if n < 44 then (* put in the proper *)
begin (* place *)
write(chtr);
Inc(n);
Inc(x);
if (n and 1) = 1 then
val := ASCIIToHex(chtr) * 16
else
begin
write(' ');
Inc(x);
val := val + ASCIIToHex(chtr);
case n div 2 of
1 : dest := val;
2 : source := val;
3 : begin
length := val;
Len := length and $7F;
end;
4..22 : Msg[(n div 2) - 3] := val;
end;
end;
end
else Beep;
end;
^M : if length <> 0
