library pcanlib;

(* DLL driver for ISA-CAN interface board under WIN32 (95/98/NT)
This version is for BasicCAN mode (11 bits identifier), not for Extended Frame
mode (29 bits identifier)
To solve interrupts handling problems under WIN32, this driver uses Polling approach
It supports full load CAN networks up to 250kbauds. Higher speeds can lead to CAN
chip overflow if CAN network is highly.
Note : CAN transmission is direct. The background queue is not implemented with
this version

Under WIN95/98, you can use this driver either with DIRECTIO or HWPORT95 hardware
access libraries.
Under WIN NT, you have to use an external system driver (not provided), via an
importation library like DIRECTIO. DO NOT USE DIRECTIO OR HWPORT95 HARDWARE
ACCESS LIBRARY UNDER NT !!!

Made under DELPHI 3.0 (normally compatible with DELPHI 4&5
Do not compile with DELPHI 2 or DELPHI 1 !
(c) B.BOUCHEZ 1995 for 16 bits version
(c) B.BOUCHEZ 1997-2000 for 32 bits version
Evolutions :
V1.02 : High speed timer modification into ONE SHOT mode (Needs ONESHOT compiling option)
V1.03 : Timer procedure return value changed into MMRESULT

To compile this library under DELPHI 1 (for 16 bits targets) :
- remove all Stdcall directives
- use 16 bits Borland MMSystem.pas file. Note that some older version of this file
  have a bug in function prototype definitons. You have to correct the MMSystem file
  in this case !
- do not use external hardware access library. Use directly IN and OUT assembler
  instructions, like in DIRECTIO.PAS

IMPORTANT NOTE : to avoid protection mechanism problems under WINDOWS, it's
better to use I/O prototype address ($330-33F range)

USING THIS LIBRARY IS UNDER YOUR RESPONSIBILITY. WE CAN'T ASSUME ANY DAMAGE
DUE TO ANY MALFUNCTION OF THIS LIBRARY
*)

uses
  SysUtils,
  Classes,
  Windows,
  MMSystem;

{$I ERR_CODE_IOLIB.PAS}

Const
  Err_DriverRunning = -1;
  Err_DriverStopped = -2;
  Err_IOLibNotFound = -3;
  Err_CANBoardNotFound = -4;
  Err_CANActive = -5;
  Err_CANInactive = -6;
  Err_WinRessource = -7;  (* Not enough windows ressources *)
  Err_RXQueueOverflow = -8;
  Err_TXQueueOverflow = -9;

  (* SJA1000 registers *)
  CANCtrlReg = $00;     (* Control *)
  CANCmdReg = $01;      (* Command *)
  CANStatReg = $02;     (* Status *)
  CANIntReg = $03;      (* Interrupt *)
  CANACReg = $04;       (* Acceptance Code *)
  CANAMReg = $05;       (* Acceptance Mask *)
  CANBT0Reg = $06;      (* Bus Timing 0 *)
  CANBT1Reg = $07;      (* Bus Timing 1 *)
  CANOCReg = $08;       (* Output Control *)
  CANTXBuffer = $0A;    (* Beginning of Transmit Buffer *)
  CANRXBuffer = 20;     (* Beginning of Receive Buffer *)
  CANClkReg = $1F;      (* Clock Divider *)

  MaxMessageCAN = 1024;

Type
  TOpenIOLibrary = Function : Integer; StdCall;
  TCloseIOLibrary = Function : Integer; StdCall;
  TGetIOPort = Function (PortAd : Word) : Integer; StdCall;
  TWriteIOPort = Procedure (PortAd, PortDa : Word); StdCall;

  TMessageCAN = Record
    Descripteur : Word;
    Donnees : Array [1..8] of Byte;
  End;
  PMessageCAN = ^TMessageCAN;
  TFileCAN = Array [1..MaxMessageCAN] of TMessageCAN;
  PFileCAN = ^TFileCAN;

Var
  OpenIOLibrary : TOpenIOLibrary;
  CloseIOLibrary : TCloseIOLibrary;
  GetIOPort : TGetIOPort;
  WriteIOPort : TWriteIOPort;
  DriverActif : Boolean;  (* CAN driver is already running *)
  CANActif : Boolean;  (* CAN chip is active *)
  HandleDLL : THandle;
  RegAdrCAN : Word;  (* Adress register of ISA-CAN board *)
  RegDataCAN : Word;  (* Data register of ISA-CAN board *)
  FileCANRX : PFileCAN;  (* Received CAN Data ring *)
  FileCANTX : PFileCAN;  (* Transmit CAN data ring - not used *)
  IDTimer : MMResult;  (* High speed timer handle *)
  AcceptCode : Byte;
  AcceptMask : Byte;
  BTR0 : Byte;
  BTR1 : Byte;
  PointLectureTX : Integer;   (* Data rings pointers *)
  PointEcritureTX : Integer;
  PointLectureRX : Integer;
  PointEcritureRX : Integer;
  SaturationFileRX : Boolean;  (* Data rings overflow *)
  SaturationFileTX : Boolean;
  {$IFDEF ONESHOT}
  DemandeArretTimer : Boolean;
  TimerArrete : Boolean;
  {$ENDIF}

Procedure TimerCallBack (uTimerID, uMessage : Word; dwUser, dw1, dw2 : Longint); StdCall; Export;

Var
  EtatCAN : Integer;
  OldPointEcritureRX : Integer;
  Identifier : Word;
  I, NbData : Integer;

Begin
  {$IFDEF ONESHOT}
  timeKillEvent (IDTimer);
  {$ENDIF}
  (* Message available ? *)
  WriteIOPort (RegAdrCAN, CANStatReg);
  EtatCAN:=GetIOPort (RegDataCAN);

  If (EtatCAN and 1)<>0 then begin
    OldPointEcritureRX:=PointEcritureRX;
    Inc (PointEcritureRX);
    If (PointEcritureRX>MaxMessageCAN) then PointEcritureRX:=1;
    If (PointEcritureRX=PointLectureRX) then begin
      SaturationFileRX:=True;
      PointEcritureRX:=OldPointEcritureRX;
    End
    Else begin
      (* Save ID+RTR+DLC *)
      WriteIOPort (RegAdrCAN, CANRXBuffer);
      Identifier:=Word(GetIOPort(RegDataCAN)) shl 8;

      WriteIOPort (RegAdrCAN, CANRXBuffer+1);
      Identifier:=Identifier or Word(GetIOPort(RegDataCAN));

      FileCANRX^[PointEcritureRX].Descripteur:=Identifier;

      (* Store datas into memory *)
      NbData:=Identifier and $F;
      If (NbData>8) then NbData:=8;
      For I:=1 to NbData do begin
        WriteIOPort(RegAdrCAN, CANRXBuffer+1+I);
        FileCANRX^[PointEcritureRX].Donnees[I]:=GetIOPort(RegDataCAN);
      End;
    End;

    (* Free CAN buffer *)
    WriteIOPort (RegAdrCAN, CANCmdReg);
    WriteIOPort (RegDataCAN, $04);  (* Release Data Buffer *)
  End;

  (* Process transmission *)

  {$IFDEF ONESHOT}
  (* Restart Timer *)
  If not DemandeArretTimer then begin
    IDTimer:=timeSetEvent(1, 1, @TimerCallBack, 0, TIME_ONESHOT);
  End
  Else TimerArrete:=True;
  {$ENDIF}
End;  (* End of TimerCallBack procedure *)

(* ------------------------------------------------------------------------- *)

Function SetCANFilter (ACAM : Word) : Integer; StdCall; Export;

(* Set Acceptance registers
 Hi(ACAM) = acceptance code
 Lo(ACAM) = acceptance mask
*)

Begin
  SetCANFilter:=NoErr;
  If CANActif then begin
    SetCANFilter:=Err_CANActive;
    Exit;
  End;

  AcceptCode:=Hi(ACAM);
  AcceptMask:=Lo(ACAM);
End;  (* End of SetCANFilter function *)

(* ------------------------------------------------------------------------- *)

Function SetCANTiming (BTVal : Word) : Integer; StdCall; Export;

(* Set bus timing registers
BTR0 value = hi(BTVal)
BTR1 value = lo(BTVal)
*)

Begin
  SetCANTiming:=NoErr;
  If CANActif then begin
    SetCANTiming:=Err_CANActive;
    Exit;
  End;

  BTR0:=Hi(BTVal);
  BTR1:=Lo(BTVal);
End;  (* End of SetCANTiming function *)

(* ------------------------------------------------------------------------- *)

Function StartCAN : Integer; StdCall; Export;

(* Activate CAN chip and clears data rings *)

Begin
  StartCAN:=NoErr;
  If not DriverActif then begin
    StartCAN:=Err_DriverStopped;
    Exit;
  End;

  If CANActif then begin
    StartCAN:=Err_CANActive;
    Exit;
  End;

  (* Clears data rings *)
  PointLectureTX:=1;
  PointEcritureTX:=1;
  PointLectureRX:=1;
  PointEcritureRX:=1;
  SaturationFileRX:=False;
  SaturationFileTX:=False;

  (* Setting up CAN chip *)
  WriteIOPort (RegAdrCAN, CANCtrlReg);
  WriteIOPort (RegDataCAN, $01);  (* Reset Request *)

  WriteIOPort (RegAdrCAN, CANACReg);
  WriteIOPort (RegDataCAN, AcceptMask);

  WriteIOPort (RegAdrCAN, CANAMReg);
  WriteIOPort (RegDataCAN, AcceptCode);

  WriteIOPort (RegAdrCAN, CANBT0Reg);
  WriteIOPort (RegDataCAN, BTR0);

  WriteIOPort (RegAdrCAN, CANBT1Reg);
  WriteIOPort (RegDataCAN, BTR1);

  WriteIOPort (RegAdrCAN, CANOCReg);
  WriteIOPort (RegDataCAN, $FA);  (* For 82C250 transceiver *)

  WriteIOPort (RegAdrCAN, CANCtrlReg);
  WriteIOPort (RegDataCAN, $00);  (* Activate CAN chip *)

  CANActif:=True;
End;  (* End of StartCAN function *)

(* ------------------------------------------------------------------------- *)

Function StopCAN : Integer; StdCall; Export;

(* Désactivate CAN chip by soft Reset soft.
  Data rings remain unaffected *)

Begin
  StopCAN:=NoErr;
  If CANActif then begin
    WriteIOPort (RegAdrCAN, CANCtrlReg);
    WriteIOPort (RegDataCAN, $01);
    CANActif:=False;
  End
  Else StopCAN:=Err_CANInactive;
End;  (* End of StopCAN function *)

(* ------------------------------------------------------------------------- *)

Function GetCANMessage (CANMsg : PMessageCAN) : Integer; StdCall; Export;

(*
Get next CAN message in reception data ring
If message available : return value=1
If error : return value=negative (Err_RXQueueOverflow doesn't invalidate CAN message)
CANMsg=address to store received CAN frame
Note that GetCANMessage can be called even if CAN chip is not active
*)

Begin
  GetCANMessage:=1;

  If not DriverActif then begin
    GetCANMessage:=Err_DriverStopped;
    Exit;
  End;

  (* No message available *)
  If (PointLectureRX=PointEcritureRX) then begin
    GetCANMessage:=0;
    Exit;
  End;

  (* Message available *)
  Inc (PointLectureRX);
  If (PointLectureRX>MaxMessageCAN) then PointLectureRX:=1;
  CANMsg^:=FileCANRX^[PointLectureRX];
  If SaturationFileRX then begin
    SaturationFileRX:=False;
    GetCANMessage:=Err_RXQueueOverflow;
  End;
End;  (* End of GetCANMessage function *)

(* ------------------------------------------------------------------------- *)

Function SendCANMessage (CANMsg : PMessageCAN; ViaRing : Word) : Integer; StdCall; Export;

(* Send CAN message on CAN network
If ViaRing=0, CAN message is immediately sent. If CAN chip is already transmitting,
an error is reported.
Si ViaRing<>0, CAN message is sent in background, via data ring.
NOTE : THIS LAST FUNCTIONNALITY IS NOT IMPLEMENTEDIN THIS VERSION !!!
ALWAYS USE ViaRing=0 *)

Var
  I, NbData : Integer;

Begin
  SendCANMessage:=NoErr;

  If not CANActif then begin
    SendCANMessage:=Err_CANInactive;
    Exit;
  End;

  (* Check if TX buffer is free *)
  WriteIOPort (RegAdrCAN, CANStatReg);
  If (GetIOPort(RegDataCAN) and $04)=0 then begin  (* Transmit Buffer Locked *)
    SendCANMessage:=Err_TXQueueOverflow;
    Exit;
  End;

  (* Charge le message *)
  WriteIOPort (RegAdrCAN, CANTXBuffer);
  WriteIOPort (RegDataCAN, Hi(CANMsg^.Descripteur));  (* Hi ID *)

  WriteIOPort (RegAdrCAN, CANTXBuffer+1);
  WriteIOPort (RegDataCAN, Lo(CANMsg^.Descripteur));  (* Lo ID+RTR+DLC *)

  NbData:=CANMsg^.Descripteur and $F;
  If (NbData>8) then NbData:=8;

  If (NbData>0) then begin
    For I:=1 to NbData do begin
      WriteIOPort (RegAdrCAN, CANTXBuffer+I+1);
      WriteIOPort (RegDataCAN, CANMsg^.Donnees[I]);
    End;
  End;

  WriteIOPort (RegAdrCAN, CANCmdReg);
  WriteIOPort (RegDataCAN, $01);  (* Transmission Request *)
End;  (* End of SendCANMessage function *)

(* ------------------------------------------------------------------------- *)

Function AbortCANTransmission : Integer; StdCall; Export;

(* Asks for an Abort Transmission on current CAN message.
CAN message is lost *)

Begin
  AbortCANTransmission:=NoErr;
  If not CANActif then begin
    AbortCANTransmission:=Err_CANInactive;
    Exit;
  End;

  WriteIOPort (RegAdrCAN, CANCmdReg);
  WriteIOPort (RegDataCAN, $2);  (* Abort Transmission *)
End;  (* End of AbortCANTransmission function *)

(* ------------------------------------------------------------------------- *)

Function GetCANStatus : Word; StdCall; Export;

(* Return CAN chip and driver status+clears DataOverrun indicator
Bit 0 to 7 : CAN chip status register
Bit 8 : CAN chip status (Reset or Active)
Bit 9 : RX ring status (OK or Overflow)
Bit 10 : TX ring status (OK or Overflow)
Bit 11 : Fast timer running correctly
*)

Var
  Temp : Word;

Begin
  GetCANStatus:=0;
  If not DriverActif then Exit;

  WriteIOPort (RegAdrCAN, CANStatReg);
  Temp:=0;
  Temp:=Temp or Lo(LoWord(GetIOPort(RegDataCAN)));

  If CANActif then Temp:=Temp or $100;
  If SaturationFileRX then Temp:=Temp or $200;
  If SaturationFileTX then Temp:=Temp or $400;
  If (IDTimer<>0) then Temp:=Temp or $800;
  GetCANStatus:=Temp;
End;  (* End of GetCANStatus function *)

(* ------------------------------------------------------------------------- *)

Procedure CloseDriver; StdCall; Export;

Begin
  If DriverActif then begin
    timeEndPeriod(1);
  End;

  {$IFDEF ONESHOT}
  DemandeArretTimer:=True;
  Repeat
  Until TimerArrete;
  {$ELSE}
  (* Stops fast timer *)
  If (IDTimer<>0) then begin
    timeKillEvent(IDTimer);
    IDTimer:=0;
  End;
  {$ENDIF}

  (* Free data rings ressources *)
  If (FileCANRX<>Nil) then begin
    Dispose (FileCANRX);
    FileCANRX:=Nil;
  End;
  If (FileCANTX<>Nil) then begin
    Dispose (FileCANTX);
    FileCANTX:=Nil;
  End;

  (* Desactivate CAN chip by soft Reset *)
  StopCAN;

  (* Free I/O library *)
  If (HandleDLL<>0) then begin
    CloseIOLibrary;
    FreeLibrary (HandleDLL);
    HandleDLL:=0;
  End;

  DriverActif:=False;
End;  (* End of CloseDriver function*)

(* ------------------------------------------------------------------------- *)

Function OpenDriver (BasePort : Word; DriverName : PChar) : Integer; StdCall; Export;

(* Starts driver
BasePort = I/O address of ISA-CAN board
DriverName = hardware access library name (DIRECTIO, HWPORT95 or other)
*) 

Begin
  OpenDriver:=NoErr;
  If DriverActif then begin
    OpenDriver:=Err_DriverRunning;
    Exit;
  End;

  (* Open I/O library *)
  HandleDLL:=LoadLibrary(DriverName);
  If HandleDLL<=0 then begin
    HandleDLL:=0;
    OpenDriver:=Err_IOLibNotFound;
    Exit;
  End;

  (* Function instanciations *)
  @OpenIOLibrary:=GetProcAddress(HandleDLL, 'OpenIOLibrary');
  @CloseIOLibrary:=GetProcAddress(HandleDLL, 'CloseIOLibrary');
  @GetIOPort:=GetProcAddress(HandleDLL, 'GetIOPort');
  @WriteIOPort:=GetProcAddress(HandleDLL, 'WriteIOPort');

  (* Activate Hardware library *)
  Result:=OpenIOLibrary;
  If Result<>0 then begin
    OpenDriver:=Result;
    CloseDriver;
    Exit;
  End;

  RegAdrCAN:=BasePort;
  RegDataCAN:=RegAdrCAN+1;

  (* Reset CAN Chip *)
  WriteIOPort (RegAdrCAN, CANCtrlReg);
  WriteIOPort (RegDataCAN, $01);
  CANActif:=False;

  (* Check for ISA-CAN board *)
  WriteIOPort (RegAdrCAN, CANClkReg);
  WriteIOPort (RegDataCAN, $7);

  WriteIOPort (RegAdrCAN, CANClkReg);
  If GETIOPort(RegDataCAN)<>7 then begin
    OpenDriver:=Err_CANBoardNotFound;
    CloseDriver;
    Exit;
  End;

  (* Set-up Acceptance (no filter) and 50kbds rate by default *)
  AcceptCode:=$FF;
  AcceptMask:=$FF;
  BTR0:=$47;
  BTR1:=$2F;

  (* Allocate data rings *)
  Try
    New (FileCANRX);
    New (FileCANTX);
  Except
    On EOutOfMemory do begin
      CloseDriver;
      OpenDriver:=Err_WinRessource;
      Exit;
    End;
  End;

  (* Start fast timer *)
  {$IFDEF ONESHOT}
  IDTimer:=timeSetEvent(1, 1, @TimerCallBack, 0, TIME_ONESHOT);
  TimerArrete:=False;
  DemandeArretTimer:=False;
  {$ELSE}
  IDTimer:=timeSetEvent(1, 1, @TimerCallBack, 0, TIME_PERIODIC);
  {$ENDIF}
  If (IDTimer=0) then begin
    CloseDriver;
    OpenDriver:=Err_WinRessource;
    Exit;
  End;
  timeBeginPeriod(1);
  DriverActif:=True;
End;  (* End of OpenDriver function *)

(* ------------------------------------------------------------------------- *)

Exports
  OpenDriver Index 1,
  CloseDriver Index 2,
  SetCANFilter Index 3,
  SetCANTiming Index 4,
  StartCAN Index 5,
  StopCAN Index 6,
  GetCANMessage Index 7,
  SendCANMessage Index 8,
  AbortCANTransmission Index 9,
  GetCANStatus Index 10,
  TimerCallBack Index 100;

begin
  DriverActif:=False;
  CANActif:=False;
  HandleDLL:=0;
  FileCANRX:=Nil;
  FileCANTX:=Nil;
  IDTimer:=0;
  PointLectureTX:=1;
  PointEcritureTX:=1;
  PointLectureRX:=1;
  PointEcritureRX:=1;
  SaturationFileRX:=False;
  SaturationFileTX:=False;
  TimerArrete:=True;
  DemandeArretTimer:=False;
end.