In message <344F726B.70A6@ambiente.com.br>, WF AUTOMA=?iso-
8859-1?Q?=C7=C3O ?= <wf@AMBIENTE.COM.BR> writes
>Nigel, is it this I2C Software that you developted in Pascal compatible with
 the
> RTC DS1307 (2
>WIRE) or the DS1620?

Hi Miguel,

Sorry about the slow response, I've been a bit busy and the code was on
my old machine (I've recently upgraded to a P166MMX, and I haven't got
everything copied over yet!).

I don't know the DS1307 or DS1620, but if they are I2C chips it should
be fairly easy to alter the code to use those.

>Can you send me a copy of source?

OK, it's rather rough and ready, it's what I was playing around with
trying to learn how to do I2C, and in particular use the PCF8532 clock
chip. The chip is basically a 256 byte EEPROM, but the bottom few bytes
are used as the clock chip registers, so it's just a case of reading the
correct memory locations.

The hardware side just uses a 7407 open-collector buffer chip, if you
need the cicuit I'll draw it out for you.

Program Clock;

Uses
  Dos, CRT, HexWrite, DirUtil;

TYPE
  NVM_Type = Record
    Read  : Byte;
    Write : Byte;
    Pages : Byte;
    Name  : String[7];
  End;
  Buf_Type = Array[0..255] of Byte;

CONST
  ClkOut     : Byte = 2;
  DataOut    : Byte = 1;
  DataIn     : Byte = 8;
  DataPort   = 888;
  StatusPort = 889;
  High       = True;
  Low        = False;
  WR_24C02   : Byte = $A0;
  RD_24C02   : Byte = $A1;
  Page_24C04 : Byte = $02;
  Page_24C08 : Byte = $06;
  Page_24C16 : Byte = $0E;
  Chip       : Byte = $00;  {No chip, until tested}

  NVM : Array[0..4] Of NVM_Type =
    (( Read : $00; Write : $00; Pages : 0; Name : 'No Chip'),
     ( Read : $A0; Write : $A1; Pages : 1; Name : '24C02'),
     ( Read : $A2; Write : $A3; Pages : 2; Name : '24C04'),
     ( Read : $A6; Write : $A7; Pages : 4; Name : '24C08'),
     ( Read : $AE; Write : $AF; Pages : 8; Name : '24C16'));
{ Port allocations.

LPT1 Data Port    : 888
     Status Port  : 889
     Control Port : 890

Data Port, 8 Outputs. Address 888.
Pin 2  : DB0
Pin 3  : DB1
Pin 4  : DB2
Pin 5  : DB3
Pin 6  : DB4
Pin 7  : DB5
Pin 8  : DB6
Pin 9  : DB7

Status Port, 5 Inputs. Address 889.
Pin 15 : Error     , Bit 3
Pin 13 : SLCT      , Bit 4
Pin 12 : PE        , Bit 5
Pin 10 : ACK       , Bit 6
Pin 11 : Busy      , Bit 7  (This line inverted!)

Control Port, 4 Outputs. Address 890.
Pin 1  : Strobe    , Bit 0  (This line inverted!)
Pin 14 : LF/CR     , Bit 1  (This line inverted!)
Pin 17 : SLIN      , Bit 2  (This line inverted!)
Pin 16 : Initialize, Bit 3

Pins 18 - 25 : Ground

}

{ Global variables}
Var
  I2C_Error : Byte;
  Buffer : Array[1..8] Of Buf_Type;
  CmpBuf : Array[1..8] Of Buf_Type;
  F : File of Byte;

Procedure WaitKey;
Var
  Ch : Char;
Begin
  Repeat Until Keypressed;
  Repeat
    Ch := ReadKey;
  Until Not Keypressed;
End;

Procedure SCL(Mode : Boolean);
Var
  CR : Byte;
Begin
  CR := Port[DataPort];
  If Mode Then
    Port[DataPort] := CR Or ClkOut            {Set SCL high}
  Else
    Port[DataPort] := CR And (255 - ClkOut);  {Set SCL low}
End;

Procedure SDA(Mode : Boolean);
Var
  CR : Byte;
Begin
  CR := Port[DataPort];
  If Mode Then
    Port[DataPort] := CR Or DataOut           {Set SDA high}
  Else
    Port[DataPort] := CR And (255 - DataOut); {Set SDA low}
End;


Procedure ClockPulse;
Begin
  SCL(Low);
  SCL(High);
  SCL(Low);
End;

Procedure StartBit;
Begin
  SCL(High);
  SDA(High);
  SDA(Low);
  SCL(Low);
  SDA(High);
End;

Procedure StopBit;
Begin
  SDA(Low);
  SCL(High);
  SDA(High);
End;

Function GetData : Boolean;
Var
  CR : Byte;
Begin
  CR := Port[StatusPort];
  If CR And DataIn = DataIn Then
    GetData := High
  Else
    GetData := Low;
End;

Function Hardware_Found : Boolean;
Begin
  SDA(Low);
  Delay(10);
  If GetData Then
    Hardware_Found := False
  Else
  Begin
    SDA(High);
    Delay(10);
    If Not GetData Then
      Hardware_Found := False
    Else
      Hardware_Found := True;
  End;
  StopBit;
End;

Function RX_Ack : Boolean;
Begin
  SDA(High);
  SCL(High);
  If GetData Then
    RX_Ack := False
  Else
    RX_Ack := True;
  SCL(Low);
End;

Procedure Send(Mode : Boolean);
Begin
  SDA(Mode);
  ClockPulse;
End;

Procedure TX_Ack(Mode : Boolean);
Begin
  Send(Mode);
End;

Procedure TxByte(Cmd : Byte);
Var
  BitPos : Byte;
Begin
   BitPos := 128;
   WHILE BitPos > 0 Do
   Begin
     IF (Cmd AND BitPos) = BitPos THEN
       Send(High)
     ELSE
       Send(Low);
     BitPos := BitPos Shr 1;
   End;
End;


FUNCTION RxByte : Byte;
Var
  BitPos,
  TempWord : Byte;

Begin
  TempWord := 0;
  BitPos := 128;
  WHILE BitPos > 0 Do
  Begin
    SCL(High);
    IF GetData THEN
      TempWord := TempWord + BitPos;
    BitPos := BitPos Shr 1;
    SCL(Low);
  End;
  RxByte := TempWord;
End;

Function Check_Type : Byte;
Var
  Temp : Byte;
  Ch   : Char;
  Found : Boolean;
Begin
  Found := False;
  For Temp := 4 DownTo 1 Do
  Begin
    StartBit;                {Send device select and WRITE}
    TXByte(NVM[Temp].Write); {Check for Rx_Ack, if chip exists!}
    If RX_Ack Then
    Begin
      TXByte(0);             {Send starting byte address}
      Rx_Ack;
      Found := True;         {Yes, chip found}
      Break;                 {Exit with chip type in Temp}
    End;
  End;
  StopBit;
  If Found Then
    Check_Type := Temp
  Else
    Check_Type := 0;         {If not found, chip type = 0}
End;

Procedure Set_Address(Address, Block : Byte);
Var
  Temp : Word;
Begin
  Temp := 0;
  Repeat
    StartBit;                    {Send device select and WRITE}
    TXByte(WR_24C02 + ((Block-1) Shl 1));
    Inc(Temp);
  Until RX_Ack Or (Temp > 100);  {Wait for Rx_Ack, in case writing!}
  If Temp > 100 Then             {If timed out then}
    I2C_Error := 1               {no ACK received, flag error!}
  Else
  Begin
    TXByte(Address);             {Else send byte address}
    Rx_Ack;
  End;
End;

Procedure Write_Byte(Data, Address, Block : Byte);
Begin
  Set_Address(Address, Block);
  TXByte(Data);
  Rx_Ack;
  StopBit;
End;

Function Read_Byte(Address, Block : Byte) : Byte;
Begin
  Set_Address(Address, Block);
  StartBit;            {Send device select and READ}
  TXByte(RD_24C02 + ((Block-1) Shl 1));
  Rx_Ack;
  Read_Byte := RxByte; {Read data from current address}
  StopBit;
End;

Function Read_Current_Byte(Block : Byte) : Byte;
Begin
  StartBit;            {Send device select and READ}
  TXByte(RD_24C02 + ((Block-1) Shl 1));
  Rx_Ack;
  Read_Current_Byte := RxByte; {Read data from current address}
  StopBit;
End;

Procedure ClearBuffer;
Var
  x,
  y : Byte;
Begin
  For y := 1 To 8 Do
    For x := 0 To 255 Do
    Begin
      Buffer[y, x] := 0;
      CmpBuf[y, x] := 0;
    End;
End;

Procedure ReadFile(Name : PathStr);
Var
  x,
  y : Byte;
  Size : Integer;
Begin
  ClearBuffer;
  Assign(F, Name);
  Reset(F);
  Size := FileSize(F);
  Case Size Of           {Set correct chip type for loaded file}
    256  : Chip := 1;
    512  : Chip := 2;
    1024 : Chip := 3;
    2048 : Chip := 4;
  Else
    Chip := 0;
  End; {End of Case}
  For y := 1 To NVM[Chip].Pages Do
    For x := 0 To 255 Do
    Begin
      Read(F, Buffer[y, x]);
    End;
  Close(F);
End;

Procedure WriteFile(Name : PathStr);
Var
  x,
  y : Byte;
Begin
  Assign(F, Name);
  Rewrite(F);
  For y := 1 To NVM[Chip].Pages Do
    For x := 0 To 255 Do
    Begin
      Write(F, Buffer[y, x]);
    End;
  Close(F);
End;

Procedure Read_EEPROM;
Var
  x,
  y : Byte;
Begin
  For y := 1 To NVM[Chip].Pages Do
    For x := 0 to 255 Do
      Buffer[y, x] := Read_Byte(x, y);   {Buffer received byte}
End;

Procedure Write_EEPROM;
Var
  x,
  y : Byte;
Begin
  WriteLN('Writing Buffer to EEPROM.');
  For y := 1 To NVM[Chip].Pages Do
    For x := 0 To 255 Do
    Begin
      Write_Byte(Buffer[y, x], x, y);
      If I2C_Error <> 0 Then
        Break;
    End;
End;

Procedure DisplayBuffer;
Var
  x,
  y,
  z : Byte;
  Ch : Char;
  ExitDisplay : Boolean;
Begin
  y := 1;
  ExitDisplay := False;
  Repeat
    ClrScr;
    WriteLN('Hexadecimal display of bytes in buffer.');
    WriteLN('Page ', y ,' of ', NVM[Chip].Pages);
    WriteLN;
    WriteLN('      (0) (1) (2) (3) (4) (5) (6) (7) (8) (9) (A) (B) (C)
(D) (E) (F)');
    For x := 0 to 15 Do
    Begin
      Write('(', HexByte(x*16), ')  ');
      For z := 0 to 15 Do
      Begin
        Write(HexByte(Buffer[y, x*16+z]));    {Display bytes in buffer}
        Write('  ');
      End;
      WriteLN;
    End;
    WriteLN;
    WriteLN('Cursor Up/Down to change pages, ESC to quit.');
    Repeat
    Until KeyPressed;
    Ch := ReadKey;
    If Ch = #0 Then               {Extended key pressed}
    Begin
      Ch := ReadKey;
      Case Ch Of
        #80 : Begin
                If y < NVM[Chip].Pages Then
                  Inc(y)
                Else
                  y := 1;
              End;
        #72 : Begin
                If y > 1 Then
                  Dec(y)
                Else
                  y := NVM[Chip].Pages;
              End;
      End; {End of Case}
    End
    Else
    Begin
      Case Ch Of
        #27 : ExitDisplay := True;  {ESC}
      End; {End of CASE}
    End;
  Until ExitDisplay;
End;

Function GetFileName : PathStr;
Var
  Temp : PathStr;
Begin
  Write('Enter filename : ');
  ReadLN(Temp);
  GetFileName := Temp;
End;

Procedure Cmp_To_Buffer;
Var
  x,
  y : Byte;
  Errors : Word;
Begin
  Errors := 0;
  For y := 1 To NVM[Chip].Pages Do
    For x := 0 To 255 Do
      CmpBuf[y, x] := Buffer[y, x];
  Read_EEPROM;
  For y := 1 To NVM[Chip].Pages Do
    For x := 0 To 255 Do
    Begin
      If Buffer[y, x] <> CmpBuf[y, x] Then
        Inc(Errors);
    End;
  WriteLN('There are ', Errors, ' differences between buffer and
EEPROM!.');
  WaitKey;
End;

Function BCD(Clk_Data : Byte) : String;
Var
  Temp,
  Temp1 : Byte;
  S: string[2];
Begin
  Temp := (Clk_Data And $F0) Shr 4;
  Temp1 := (Temp * 10) + (Clk_Data And $0F);
  Str(Temp1, S);
  If Length(S) = 1 Then
    S := '0' + S;
  BCD := S;
End;

Procedure Display_Clock;
Var
  Temp,
  Year,
  Month,
  Week,
  Day,
  Hours,
  Minutes,
  Seconds : String[2];
Begin
  GotoXY(10, 15);
  ClrEol;
  Seconds := BCD(Buffer[1, 2]);
  Minutes := BCD(Buffer[1, 3]);
  Hours   := BCD(Buffer[1, 4]);
  Day     := BCD(Buffer[1, 5] AND $3F);
  Month   := BCD(Buffer[1, 6] AND $1F);
  Year    := BCD((Buffer[1, 5] AND $C0) Shr 6);
  Week    := BCD((Buffer[1, 6] AND $E0) Shr 5);
  WriteLN(Day, '/', Month, '/', Year, '  ', Hours, ':', Minutes, ':',
Seconds);
End;

Procedure Show_Clock;
Var
  ch : Char;
Begin
  Repeat
    Read_EEPROM;
    Display_Clock;
  Until KeyPressed;
  Ch := ReadKey;
End;

Procedure DisplayMenu;
Begin
  ClrScr;
  WriteLN('24CXX EEPROM Programmer - Set for ', NVM[Chip].Name, '.');
  WriteLN;
  WriteLN('1   : Read EEPROM to Buffer.');
  WriteLN('2   : Write Buffer to EEPROM.');
  WriteLN('3   : Read disk file to Buffer.');
  WriteLN('4   : Write Buffer to disk file.');
  WriteLN('5   : Display Buffer on screen.');
  WriteLN('6   : Compare Buffer to EEPROM (Verify!).');
  WriteLN('7   : Display Clock.');
  WriteLN;
  WriteLN('ESC : Exit program.');
  WriteLN;
  If I2C_Error <> 0 Then
  Begin
    WriteLN('ERROR!');
    Case I2C_Error Of
      1: WriteLN('No address ACK received from the I2C Bus!');
    End;
    WriteLN('The last action may not have worked correctly!');
    I2C_Error := 0;
  End;
End;

Procedure Menu;
Var
  Ch : Char;
  ExitProg : Boolean;
Begin
  ExitProg := False;
  Repeat
    DisplayMenu;
    While Not KeyPressed Do;
    Ch := ReadKey;
    If Ch = #0 Then               {Extended key pressed}
    Begin
      Ch := ReadKey;
      Case Ch Of
        #45 : ExitProg := True;     { ALT X }
      End; {End of Case}
    End
    Else                          {Not an extended key}
    Begin
      Case Ch Of
        '1' : Read_EEPROM;
        '2' : Write_EEPROM;
        '3' : ReadFile(FileRequest('*.IIC'));
        '4' : WriteFile(GetFileName);
        '5' : DisplayBuffer;
        '6' : Cmp_To_Buffer;
        '7' : Show_Clock;
        #27 : ExitProg := True;     { ESC }
      End; {End of Case}
    End;
  Until ExitProg;
End;

{Main Program}
var
  Ch : Char;
  x : Byte;
Begin
  ClrScr;
  I2C_Error := 0;
  SCL(High);
  SDA(High);
  ClearBuffer;
  If Not HardWare_Found Then
  Begin
    WriteLN('Programmer hardware not found!.');
    Exit;
  End;
  Chip := Check_Type;
  Menu;
End.

--

Nigel.

        /--------------------------------------------------------------\
        | Nigel Goodwin   | Internet : nigelg@lpilsley.demon.co.uk     |
        | Lower Pilsley   | Web Page : http://www.lpilsley.demon.co.uk |
        | Chesterfield    |                                            |
        | England         |                                            |
        \--------------------------------------------------------------/