Merge I2C branch to default.
12 files changed, 1289 insertions(+), 226 deletions(-)

A => .hgignore
A => avr-i2c-master.adb
A => avr-i2c-master.ads
A => avr-i2c.ads
M pn532.adb => generic_pn532.adb
M pn532.ads => generic_pn532.ads
M nfc_tags.adb
A => pn532_bus_i2c.adb
A => pn532_bus_i2c.ads
A => pn532_bus_spi.adb
A => pn532_bus_spi.ads
A => pn532_types.ads
A => .hgignore +6 -0
@@ 0,0 1,6 @@ 
+syntax: glob
+
+objects
+nfc.elf
+nfc.hex
+main.map

          
A => avr-i2c-master.adb +598 -0
@@ 0,0 1,598 @@ 
+---------------------------------------------------------------------------
+-- The AVR-Ada Library is free software;  you can redistribute it and/or --
+-- modify it under terms of the  GNU General Public License as published --
+-- by  the  Free Software  Foundation;  either  version 2, or  (at  your --
+-- option) any later version.  The AVR-Ada Library is distributed in the --
+-- hope that it will be useful, but  WITHOUT ANY WARRANTY;  without even --
+-- the  implied warranty of MERCHANTABILITY or FITNESS FOR A  PARTICULAR --
+-- PURPOSE. See the GNU General Public License for more details.         --
+--                                                                       --
+-- As a special exception, if other files instantiate generics from this --
+-- unit,  or  you  link  this  unit  with  other  files  to  produce  an --
+-- executable   this  unit  does  not  by  itself  cause  the  resulting --
+-- executable to  be  covered by the  GNU General  Public License.  This --
+-- exception does  not  however  invalidate  any  other reasons why  the --
+-- executable file might be covered by the GNU Public License.           --
+---------------------------------------------------------------------------
+--
+-- I2C package implementation for masters using TWI support in the AVR
+-- (mega) chips.  This implementation is mainly based on Tero
+-- Koskine's TWI EEPROM package and the Atmel implementation note
+-- (AVR315: Using the TWI module as I2C Master).
+--
+-- A very detailed and easy to understand description is (in German
+-- language) at http://www.mikrocontroller.net/articles/AVR_TWI
+
+
+with Interfaces;                   use Interfaces;
+with AVR;                          use AVR;
+with AVR.Config;                   use AVR.Config;
+with AVR.Interrupts;
+with AVR.MCU;
+with AVR.UART;
+
+package body AVR.I2C.Master is
+
+
+   Speed : constant Speed_Mode := Fast;
+
+   ---------------------------------------------------------------------------
+
+
+   TW_READ  : constant := 1;
+   TW_WRITE : constant := 0;
+
+   Error_State : Error_T;
+
+   -- Start condition
+   TW_START        : constant := 16#08#;
+   TW_REP_START    : constant := 16#10#;
+
+   -- Master transmitter
+   TW_MT_SLA_ACK   : constant := 16#18#; -- SLA+W transmitted, ACK got
+   TW_MT_SLA_NACK  : constant := 16#20#; -- SLA+W transmitted, NACK got
+
+   TW_MT_DATA_ACK  : constant := 16#28#; -- data transmitted, ACK got
+   TW_MT_DATA_NACK : constant := 16#30#; -- data transmitted, NACK got
+
+   -- Master receiver
+   TW_MR_SLA_ACK   : constant := 16#40#; -- SLA+R transmitted, ACK got
+   TW_MR_SLA_NACK  : constant := 16#48#; -- SLA+R transmitted, NACK got
+
+   TW_MR_DATA_ACK  : constant := 16#50#; -- data transmitted, ACK got
+   TW_MR_DATA_NACK : constant := 16#58#; -- data transmitted, NACK got
+
+   -- Generic errors
+   TW_BUS_ERROR    : constant := 0;
+   TW_NO_INFO      : constant := 16#F8#; -- no information available
+   TW_ARB_LOST     : constant := 16#38#; -- arbitr. lost in SLA+W/R or data
+
+
+
+   Buffer        : Data_Buffer (Buffer_Range);
+
+   Data_Index    : Buffer_Range;
+   Data_Max      : Buffer_Index;
+   Data_Received : Buffer_Index;
+   Data_Sent     : Boolean; -- All data sent?
+
+   type TWI_State_Enum is (Ready, Master_Receive, Master_Transmit);
+   TWI_State : TWI_State_Enum;
+   pragma Volatile (TWI_State);
+   Slave_Addr_RW : Interfaces.Unsigned_8;
+   pragma Volatile (Slave_Addr_RW);
+
+
+   procedure Send_Stop;
+   procedure Reply (Ack : Boolean);
+   pragma Inline (Reply);
+
+   procedure Release;
+   pragma Inline (Release);
+
+
+   procedure Init is
+      use AVR.MCU;
+   begin
+      Data_Index := Buffer_Range'First;
+      Data_Max := Buffer_Range'First;
+      Data_Sent := False;
+      TWI_State := Ready;
+
+      -- Init twi ports (portc 4&5)
+      PORTC_Bits (4) := True;
+      PORTC_Bits (5) := True;
+
+      -- Init twi prescaler and bitrate
+      TWSR_Bits (TWPS0_Bit) := False;
+      TWSR_Bits (TWPS1_Bit) := False;
+      -- Interfaces.Unsigned_8 (((CPU_Speed / TWI_FREQ) - 16) / 2);
+      -- (((16_000_000 / 100_000 = 160) - 16 = 144) / 2 = 72)
+      -- (((16_000_000 / 400_000 = 40) - 16 = 24) / 2 = 12)
+      pragma Assert (AVR.Config.Clock_Frequency = 16_000_000);
+      if Speed = Fast then
+         TWBR := 12;
+      else
+         TWBR := 72;
+      end if;
+
+      -- Enable twi, acks, and interrupt
+      TWCR_Bits := (TWEN_Bit => True,
+                    TWIE_Bit => True,
+                    TWEA_Bit => True,
+                    others   => False);
+
+      AVR.Interrupts.Enable;
+
+      Error_State := OK;
+   end Init;
+
+
+   procedure Request (Device : I2C_Address;
+                      Count  : Buffer_Index)
+   is
+      use type Interfaces.Unsigned_8;
+      use AVR.MCU;
+   begin
+      Data_Index    := Buffer_Range'First;
+      Data_Max      := Count;
+      Data_Received := 0;
+      Error_State   := OK; -- TWI_Error_State := TWI_No_Error;
+      TWI_State     := Master_Receive;
+
+      Slave_Addr_RW := TW_READ or (Unsigned_8(Device) * 2);
+
+      TWCR_Bits := (TWEN_Bit  => True,
+                    TWIE_Bit  => True,
+                    TWEA_Bit  => True,
+                    TWINT_Bit => True,
+                    TWSTA_Bit => True,
+                    others    => False);
+
+      loop
+         exit when TWI_State /= Master_Receive;
+      end loop;
+   end Request;
+
+
+   function Data_Is_Available return Boolean
+   is
+   begin
+      return Data_Index <= Data_Received;
+   end Data_Is_Available;
+
+
+   procedure Send (Device : I2C_Address;
+                   Data   : Data_Buffer)
+   is
+      use AVR.MCU;
+   begin
+      Data_Sent := False;
+      --  for I in Data'Range loop
+      --     Buffer (Index) := Data (I);
+      --     Index := Index + 1;
+      --  end loop;
+      Buffer (1 .. Data'Length) := Data;
+      Data_Index := Buffer_Range'First;
+      Data_Max   := Data'Last; -- Data_Max   := Index - 1;
+
+      TWI_State   := Master_Transmit;
+      Error_State := OK; -- TWI_Error_State := TWI_No_Error;
+
+      Slave_Addr_RW := TW_WRITE or (Unsigned_8(Device) * 2);
+
+      -- Send start condition
+      TWCR_Bits := (TWEN_Bit  => True,
+                    TWIE_Bit  => True,
+                    TWEA_Bit  => True,
+                    TWINT_Bit => True,
+                    TWSTA_Bit => True,
+                    others    => False);
+
+      loop
+         exit when TWI_State /= Master_Transmit;
+      end loop;
+   end Send;
+
+
+   procedure Send (Device : I2C_Address;
+                   Data   : Unsigned_8)
+   is
+      use AVR.MCU;
+   begin
+      Data_Sent  := False;
+      Buffer (1) := Data;
+      Data_Index := 1;
+      Data_Max   := 1;
+
+      TWI_State   := Master_Transmit;
+      Error_State := OK;
+
+      Slave_Addr_RW := TW_WRITE or (Unsigned_8(Device) * 2);
+
+      -- Send start condition
+      TWCR_Bits := (TWEN_Bit  => True,
+                    TWIE_Bit  => True,
+                    TWEA_Bit  => True,
+                    TWINT_Bit => True,
+                    TWSTA_Bit => True,
+                    others    => False);
+
+      loop
+         exit when TWI_State /= Master_Transmit;
+      end loop;
+   end Send;
+
+
+   procedure Send (Device : I2C_Address;
+                   Data   : Unsigned_16)
+   is
+      use AVR.MCU;
+   begin
+      Data_Sent  := False;
+      Buffer (1) := High_Byte(Data);
+      Buffer (2) := Low_Byte(Data);
+      Data_Index := 1;
+      Data_Max   := 2;
+
+      TWI_State   := Master_Transmit;
+      Error_State := OK;
+
+      Slave_Addr_RW := TW_WRITE or (Unsigned_8(Device) * 2);
+
+      -- Send start condition
+      TWCR_Bits := (TWEN_Bit  => True,
+                    TWIE_Bit  => True,
+                    TWEA_Bit  => True,
+                    TWINT_Bit => True,
+                    TWSTA_Bit => True,
+                    others    => False);
+
+      loop
+         exit when TWI_State /= Master_Transmit;
+      end loop;
+   end Send;
+
+
+   procedure Send_Stop is
+      use AVR.MCU;
+   begin
+      TWCR_Bits := (TWEN_Bit  => True,
+                    TWIE_Bit  => True,
+                    TWEA_Bit  => True,
+                    TWINT_Bit => True,
+                    TWSTO_Bit => True,
+                    others    => False);
+      loop
+         exit when not TWCR_Bits (TWSTO_Bit);
+      end loop;
+      TWI_State := Ready;
+   end Send_Stop;
+
+
+   procedure Reply (Ack : Boolean) is
+      use AVR.MCU;
+   begin
+      TWCR_Bits := (TWEN_Bit  => True,
+                    TWIE_Bit  => True,
+                    TWEA_Bit  => Ack,   --  <--
+                    TWINT_Bit => True,
+                    others    => False);
+   end Reply;
+
+
+   procedure Release is
+      use AVR.MCU;
+   begin
+      TWCR_Bits := (TWEN_Bit  => True,
+                    TWIE_Bit  => True,
+                    TWEA_Bit  => True,
+                    TWINT_Bit => True,
+                    others    => False);
+      TWI_State := Ready;
+   end Release;
+
+
+   procedure TWI_Interrupt;
+   pragma Machine_Attribute (Entity         => TWI_Interrupt,
+                             Attribute_Name => "signal");
+   pragma Export (C, TWI_Interrupt, MCU.Sig_TWI_String);
+
+   procedure TWI_Interrupt is
+      use AVR.MCU;
+
+      TW_Status_Mask : constant Unsigned_8 :=
+        TWS7_Mask or TWS6_Mask or TWS5_Mask or TWS4_Mask or TWS3_Mask;
+      TW_Status      : constant Unsigned_8 :=
+        TWSR and TW_Status_Mask;
+
+   begin
+      case TW_Status is
+
+      when TW_START | TW_REP_START =>
+         TWDR := Slave_Addr_RW;
+         Reply (Ack => True);
+
+      when TW_ARB_LOST =>
+         Error_State := Lost_Arbitration;
+         Release;
+
+      -- Master data receive
+
+      -- Address sent, got ack from slave
+      when TW_MR_SLA_ACK =>
+         if Data_Received  < Data_Max - 1 then
+            Reply (Ack => True);
+         else
+            Reply (Ack => False);
+         end if;
+
+
+      -- no ACK after sending the address --> stop
+      when TW_MR_SLA_NACK =>
+         Send_Stop;
+
+
+      -- Data available from slave
+      when TW_MR_DATA_ACK =>
+         Data_Received := Data_Received + 1;
+         Buffer (Data_Received) := TWDR;
+         if Data_Received < Data_Max then
+            Reply (Ack => True);
+         else
+            Reply (Ack => False);
+         end if;
+
+
+      -- Final data byte got
+      when TW_MR_DATA_NACK =>
+         Data_Received := Data_Received + 1;
+         Buffer (Data_Received) := TWDR;
+         Send_Stop;
+
+
+      -- Master data transmit
+      --
+
+      when TW_MT_SLA_ACK | TW_MT_DATA_ACK =>
+         if Data_Index <= Data_Max and then not Data_Sent then
+            TWDR := Buffer (Data_Index);
+            if Data_Index < Data_Max then
+               Data_Index := Data_Index + 1;
+            else
+               Data_Sent := True;
+            end if;
+            Reply (Ack => True);
+         else
+            Send_Stop;
+         end if;
+
+
+      when TW_MT_SLA_NACK =>
+         Error_State := No_Ack_On_Address;
+         Send_Stop;
+
+      when TW_MT_DATA_NACK =>
+         Error_State := No_Ack_On_Data;
+         Send_Stop;
+
+      when others =>
+         null;
+      end case;
+   end TWI_Interrupt;
+
+   -------------------------------------------------------------------------
+
+
+   --  sending data to a slave consists of three steps
+   --     1) provide the target address (Talk_To)
+   --     2) queue the data to be sent (Put)
+   --     3) actually send the data and terminate the session by a stop
+   --        sequence (Send)
+
+   --  The stop sequence is
+   --     - either a real stop releasing the bus (Action=Stop).
+   --       Potentially another master might take over the bus.
+   --     - or the master continuous to control the bus
+   --       (Action=Restart) allowing further send or receive messages.
+
+   --  Design considerations: although the unconstrained array in Ada
+   --  is quite elegant at the source code level, it generates a lot
+   --  of assembler instructions for AVR.  We therefore also provide
+   --  non overloaded functions with constrained arrays.  In a typical
+   --  application with only one or very few clients on the bus you
+   --  probably use only one of the constrained functions.  All other
+   --  code is automatically removed during linking.
+
+
+   --  procedure Send (Device: I2C_Address)
+   --  is
+   --     use AVR.MCU;
+
+   --     R : Unsigned_8;
+
+   --     Addr : constant Unsigned_8 := TW_WRITE or (Unsigned_8(Device) * 2);
+   --  begin
+   --     Error_State := OK;
+
+   --     Start_Condition;
+
+   --  end Send;
+
+
+   --  procedure Talk_To (Device : I2C_Address;
+   --                     Data   : Data_Buffer;
+   --                     Action : End_Of_Transmission := Stop)
+   --  is
+   --  begin
+   --     Send (Device);     if Error_State /= OK then return; end if;
+   --     Put (Data);        if Error_State /= OK then return; end if;
+   --     Finish_Send (Action);
+   --  end Talk_To;
+
+
+   --  procedure Talk_To (Device : I2C_Address;
+   --                     Data   : Unsigned_8;
+   --                     Action : End_Of_Transmission := Stop)
+   --  is
+   --  begin
+   --     Send (Device);     if Error_State /= OK then return; end if;
+   --     Put (Data);        if Error_State /= OK then return; end if;
+   --     Finish_Send (Action);
+   --  end Talk_To;
+
+
+   --  procedure Talk_To2 (Device : I2C_Address;
+   --                      Data   : Data_Buffer;
+   --                      Action : End_Of_Transmission := Stop)
+   --  is
+   --  begin
+   --     Send (Device);     if Error_State /= OK then return; end if;
+   --     Put (Data);        if Error_State /= OK then return; end if;
+   --     Finish_Send (Action);
+   --  end Talk_To2;
+
+
+   --  procedure Put (Data : Data_Buffer)
+   --  is
+   --  begin
+   --     for D of Data loop
+   --        Put (D);
+   --     end loop;
+   --  end Put;
+
+
+   --  procedure Put (Data : Unsigned_8)
+   --  is
+   --     R : Unsigned_8;
+   --  begin
+   --     null;
+   --  end Put;
+
+
+   --  procedure Put (Data : Integer_8)
+   --  is
+   --     function To_U8 is new Ada.Unchecked_Conversion (Source => Integer_8,
+   --                                                     Target => Unsigned_8);
+   --  begin
+   --     Put (To_U8(Data));
+   --  end Put;
+
+
+   --  procedure Put (Data : Unsigned_16)
+   --  is
+   --  begin
+   --     Put (High_Byte (Data));
+   --     Put (Low_Byte (Data));
+   --  end Put;
+
+
+   --  procedure Put (Data : Integer_16)
+   --  is
+   --     function To_U16 is new Ada.Unchecked_Conversion (Source => Integer_16,
+   --                                                      Target => Unsigned_16);
+   --  begin
+   --     Put (To_U16(Data));
+   --  end Put;
+
+
+   procedure Finish_Send (Action : End_Of_Transmission := Stop)
+   is
+   begin
+      if Action = Stop then
+         Send_Stop;
+      else
+         null;
+         --  restart is just another start
+      end if;
+   end Finish_Send;
+
+
+   --  For receiving data from a slave you also have to provide the
+   --  slave address.  Available data is indicated by
+   --  Data_Is_Avalable.  The actual data can be retrieved with the
+   --  Get functions.  At the end of the slave transmission the master
+   --  emits a stop sequence following the same rules as for sending
+   --  from master to the slave.
+
+
+   function Get_U8 return Unsigned_8 is
+      Ret_Val : Unsigned_8 := 0;
+   begin
+      if Data_Index <= Data_Received then
+         Ret_Val := Buffer (Data_Index);
+         Data_Index := Data_Index + 1;
+      end if;
+      return Ret_Val;
+   end Get_U8;
+   function Get return Unsigned_8 renames Get_U8;
+
+
+   --  function Get return Integer_8
+   --  is
+   --     function I8 is new Ada.Unchecked_Conversion (Source => Unsigned_8,
+   --                                                  Target => Integer_8);
+   --     T : constant Unsigned_8 := Get;
+   --  begin
+   --     return I8(T);
+   --  end Get;
+
+
+   function Get return Unsigned_16
+   is
+      T : constant Unsigned_8 := Get;
+   begin
+      return Unsigned_16(T) * 2**8 + Unsigned_16(Get_U8);
+   end Get;
+
+
+   --  function Get return Integer_16
+   --  is
+   --  begin
+   --     return Get;
+   --  end Get;
+
+
+   --  procedure Send_And_Receive (Device :     I2C_Address;
+   --                              Arg    :     Unsigned_8;
+   --                              Data   : out Data_Buffer)
+   --  is
+   --  begin
+   --     Send (Device, Arg);
+   --     Request (Device, Data'Length);
+   --     Get (Data);
+   --     Send_Stop;
+   --  end Send_And_Receive;
+
+
+   procedure Send_And_Receive (Device :     I2C_Address;
+                               Arg    :     Unsigned_8;
+                               Data   : out Unsigned_8)
+   is
+   begin
+      Send (Device, Arg);
+      Request (Device, 1);
+      Data := Get;
+   end Send_And_Receive;
+
+
+   procedure Send_And_Receive (Device :     I2C_Address;
+                               Arg    :     Unsigned_8;
+                               Data   : out Unsigned_16)
+   is
+   begin
+      Send (Device, Arg);
+      Request (Device, 2);
+      Data := Get;
+   end Send_And_Receive;
+
+
+   function Get_Error return Error_T is
+   begin
+      return Error_State;
+   end Get_Error;
+
+
+begin
+   Error_State := OK;
+end AVR.I2C.Master;

          
A => avr-i2c-master.ads +110 -0
@@ 0,0 1,110 @@ 
+---------------------------------------------------------------------------
+-- The AVR-Ada Library is free software;  you can redistribute it and/or --
+-- modify it under terms of the  GNU General Public License as published --
+-- by  the  Free Software  Foundation;  either  version 2, or  (at  your --
+-- option) any later version.  The AVR-Ada Library is distributed in the --
+-- hope that it will be useful, but  WITHOUT ANY WARRANTY;  without even --
+-- the  implied warranty of MERCHANTABILITY or FITNESS FOR A  PARTICULAR --
+-- PURPOSE. See the GNU General Public License for more details.         --
+--                                                                       --
+-- As a special exception, if other files instantiate generics from this --
+-- unit,  or  you  link  this  unit  with  other  files  to  produce  an --
+-- executable   this  unit  does  not  by  itself  cause  the  resulting --
+-- executable to  be  covered by the  GNU General  Public License.  This --
+-- exception does  not  however  invalidate  any  other reasons why  the --
+-- executable file might be covered by the GNU Public License.           --
+---------------------------------------------------------------------------
+
+--
+-- I2C package for masters
+--
+
+with Interfaces;                   use Interfaces;
+
+package AVR.I2C.Master is
+
+   --  set the transmission speed (100kHz=standard, 400kHz=fast) at
+   --  the top of the package body
+
+   --  initialize as a master
+   procedure Init;
+
+
+   --  sending data to a slave (device) consists of three steps
+   --     1) provide the target address (Send)
+   --     2) queue the data to be sent (Put)
+   --     3) actually send the data and terminate the session by a stop
+   --        sequence (Finish_Send)
+
+   --  The stop sequence is
+   --     - either a real stop releasing the bus (Action=Stop).
+   --       Potentially another master might take over the bus.
+   --     - or the master continuous to control the bus
+   --       (Action=Restart) allowing further send or receive messages.
+
+   --  Design considerations: although the unconstrained array in Ada
+   --  is quite elegant at the source code level, it generates a lot
+   --  of assembler instructions for AVR.  We therefore also provide
+   --  non overloaded functions with constrained arrays.  In a typical
+   --  application with only one or very few clients on the bus you
+   --  probably use only one of the constrained functions.  All other
+   --  code is automatically removed during linking.
+
+   type End_Of_Transmission is (Stop, Restart);
+
+   --  procedure Send (Device : I2C_Address);
+   procedure Send (Device : I2C_Address;
+                   Data   : Data_Buffer);
+   procedure Send (Device : I2C_Address;
+                   Data   : Unsigned_8);
+   procedure Send (Device : I2C_Address;
+                   Data   : Unsigned_16);
+   --  procedure Send (To     : I2C_Address;
+   --                  Data   : Nat8_Arr2;
+   --                  Action : End_Of_Transmission := Stop);
+
+   --  procedure Put (Data : Data_Buffer);
+   --  procedure Put (Data : Unsigned_8);
+   --  procedure Put (Data : Integer_8);
+   --  procedure Put (Data : Unsigned_16);
+   --  procedure Put (Data : Integer_16);
+
+   procedure Finish_Send (Action : End_Of_Transmission := Stop);
+
+
+   --  For receiving data from a slave you also have to provide the
+   --  slave (device) address.  Available data is indicated by
+   --  Data_Is_Avalable.  The actual data can be retrieved with the
+   --  Get functions.  At the end of the slave transmission the master
+   --  emits a stop sequence following the same rules as for sending
+   --  from master to the slave.
+
+   procedure Request (Device : I2C_Address;
+                      Count  : Buffer_Index);
+
+   function Data_Is_Available return Boolean;
+   pragma Inline (Data_Is_Available);
+
+   function Get return Unsigned_8;
+   --  function Get return Integer_8;
+   function Get return Unsigned_16;
+   --  function Get return Integer_16;
+   --  procedure Get (Data : out Data_Buffer);
+   --  function Get_No_Ack return Unsigned_8;
+   --  function Get_No_Ack return Integer_8;
+   --  function Get_No_Ack return Unsigned_16;
+   --  function Get_No_Ack return Integer_16;
+   -- procedure Finish_Request (Action : End_Of_Transmission := Stop);
+
+
+   procedure Send_And_Receive (Device :     I2C_Address;
+                               Arg    :     Unsigned_8;
+                               Data   : out Unsigned_8);
+   procedure Send_And_Receive (Device :     I2C_Address;
+                               Arg    :     Unsigned_8;
+                               Data   : out Unsigned_16);
+
+
+   function Get_Error return Error_T;
+
+end AVR.I2C.Master;

          
A => avr-i2c.ads +54 -0
@@ 0,0 1,54 @@ 
+---------------------------------------------------------------------------
+-- The AVR-Ada Library is free software;  you can redistribute it and/or --
+-- modify it under terms of the  GNU General Public License as published --
+-- by  the  Free Software  Foundation;  either  version 2, or  (at  your --
+-- option) any later version.  The AVR-Ada Library is distributed in the --
+-- hope that it will be useful, but  WITHOUT ANY WARRANTY;  without even --
+-- the  implied warranty of MERCHANTABILITY or FITNESS FOR A  PARTICULAR --
+-- PURPOSE. See the GNU General Public License for more details.         --
+--                                                                       --
+-- As a special exception, if other files instantiate generics from this --
+-- unit,  or  you  link  this  unit  with  other  files  to  produce  an --
+-- executable   this  unit  does  not  by  itself  cause  the  resulting --
+-- executable to  be  covered by the  GNU General  Public License.  This --
+-- exception does  not  however  invalidate  any  other reasons why  the --
+-- executable file might be covered by the GNU Public License.           --
+---------------------------------------------------------------------------
+
+--
+-- I2C package for AVR-Ada
+--
+
+
+with AVR;
+
+package AVR.I2C is
+   pragma Pure;
+
+   type Error_T is
+     (OK,
+      No_Data,
+      Data_Out_Of_Bound,
+      Unexpected_Start_Con,
+      Unexpected_Stop_Con,
+      Unexpected_Data_Col,
+      Lost_Arbitration,
+      No_Ack_On_Data,
+      No_Ack_On_Address,
+      Missing_Start_Con,
+      Missing_Stop_Con);
+
+   --type TWI_Error_Enum is (TWI_No_Error, TWI_Bus_Error, TWI_Lost_Arbitration,
+   -- TWI_NACK);
+
+   type Speed_Mode is (Standard, --  100kHz
+                       Fast,     --  400kHz
+                       Fast_Plus);
+
+   type I2C_Address is new Nat8 range 0 .. 127;
+
+   subtype Buffer_Index is Nat8 range 0 .. 64;
+   subtype Buffer_Range is Nat8 range 1 .. 64;
+   type Data_Buffer is array (Buffer_Range range <>) of Nat8;
+
+end AVR.I2C;

          
M pn532.adb => generic_pn532.adb +18 -201
@@ 17,16 17,16 @@ 
 
 with System;
 with Interfaces;
-with SPI;
 with AVR.Real_Time.Clock;
 pragma Unreferenced(AVR.Real_Time.Clock);
 with AVR.UART;
 with AVR.Strings;
 with AVR.Programspace;
+with PN532_BUS_SPI;
 
 use Interfaces;
 
-package body PN532 is
+package body Generic_PN532 is
 
    PN532_FIRMWARE_VERSION : constant := 16#02#;
    PN532_SAMCONFIG        : constant := 16#14#;

          
@@ 36,13 36,7 @@ package body PN532 is
    PN532_TG_GET_DATA : constant := 16#86#;
    PN532_TG_SET_DATA : constant := 16#8E#;
 
-   SPI_STATUS : constant := 2#10#;
-   SPI_WRITE  : constant := 2#01#;
-   SPI_READ   : constant := 2#11#;
-
-   HOST_TO_PN532 : constant := 16#D4#;
-
-   PN532_TIMEOUT_VALUE : constant := 2000;
+   PN532_TIMEOUT_VALUE : constant := 20000;
 
    PN532_106_KBPS_ISOIEC_14443_A : constant := 0;
 

          
@@ 51,8 45,6 @@ package body PN532 is
    MIFARE_AUTH_KEY_A_CMD : constant := 16#60#;
    MIFARE_AUTH_KEY_B_CMD : constant := 16#61#;
 
-   type Reply_Type is (REPLY_ACK, REPLY_NACK, REPLY_ERROR);
-
    type Buf_In_Progmem (Len : AVR.Nat8) is record
       Text : PN532_Buf (1..Len);
    end record;

          
@@ 77,75 69,14 @@ package body PN532 is
       AVR.UART.CRLF;
    end Log;
 
-   procedure PN532_Delay is
-   begin
-      delay 0.002;
-   end PN532_Delay;
-   pragma Inline (PN532_Delay);
-
-   procedure PN532_SPI_Enable is
-   begin
-      SPI.SS_Out := False;
-   end PN532_SPI_Enable;
-   pragma Inline (PN532_SPI_Enable);
-
-   procedure PN532_SPI_Disable is
-   begin
-      SPI.SS_Out := True;
-   end PN532_SPI_Disable;
-   pragma Inline (PN532_SPI_Disable);
-
-   procedure PN532_Write (Cmd : PN532_Buf)  is
-      Checksum : Unsigned_8 := 16#FF#;
-      Len : Unsigned_8 := Cmd'Length + 1;
-   begin
-      PN532_SPI_Enable;
-      PN532_Delay;
-
-      SPI.Send(SPI_WRITE);
-
-      SPI.Send(0);
-      SPI.Send(0);
-      SPI.Send(16#FF#);
-
-      SPI.Send (Len);
-      SPI.Send ((not Len) + 1);
-
-      SPI.Send(HOST_TO_PN532);
-
-      Checksum := Checksum + HOST_TO_PN532;
-
-      for I in Cmd'Range loop
-         SPI.Send (Cmd (I));
-         Checksum := Checksum + Cmd (I);
-      end loop;
-
-      SPI.Send(not Checksum);
-      SPI.Send(0);
-
-      PN532_SPI_Disable;
-   end PN532_Write;
-
-   function PN532_Status return Unsigned_8 is
-      Status : Unsigned_8;
-   begin
-      PN532_SPI_Enable;
-      PN532_Delay;
-      SPI.Send (SPI_STATUS);
-      Status := SPI.Read;
-      PN532_SPI_Disable;
-
-      return Status;
-   end PN532_Status;
-
    function PN532_Wait_For_Ready (Timeout : Unsigned_32) return Boolean is
       Counter : Unsigned_32 := 0;
    begin
       loop
-         exit when PN532_Status = 1;
+         exit when not PN532_Busy;
          Counter := Counter + 1;
 
-         if Counter > Timeout then
+         if Counter >= Timeout then
             return False;
          end if;
       end loop;

          
@@ 153,47 84,6 @@ package body PN532 is
       return True;
    end PN532_Wait_For_Ready;
 
-   procedure PN532_Read_Reply (Reply : out Reply_Type; Code : out Unsigned_8) is
-      Buf : PN532_Buf (1..6);
-      Len : Unsigned_8;
-   begin
-      PN532_SPI_Enable;
-      PN532_Delay;
-      SPI.Send (SPI_READ);
-      Code := 0;
-
-      for I in Buf'Range loop
-         Buf (I) := SPI.Read;
-      end loop;
-
-      if Buf (1) = 0 and Buf (2) = 0 and Buf (3) = 16#FF# then
-         if Buf (4) = 0 and Buf (5) = 16#FF# and Buf (6) = 0 then -- ACK
-            Reply := REPLY_ACK;
-         elsif Buf(4) = 16#FF# and Buf(5) = 0 and Buf (6) = 0 then -- NACK
-            Reply := REPLY_NACK;
-         else -- ERROR
-            Reply := REPLY_ERROR;
-            Len := Buf (4);
-            if Buf (5) + Len = 0 then -- checksum ok
-               Code := Buf (6);
-               Buf (1) := SPI.Read;
-               Buf (2) := SPI.Read;
-            end if;
-         end if;
-      else
-         -- Log ("Unknown reply");
-         -- for I in Buf'Range loop
-         --    AVR.UART.Put (Data => Buf (I), Base => 16);
-         --    AVR.UART.Put (" ");
-         -- end loop;
-         -- AVR.UART.CRLF;
-         Reply := REPLY_ERROR;
-         Code := 255;
-      end if;
-
-      PN532_SPI_Disable;
-   end PN532_Read_Reply;
-
    function PN532_Send_Command (Cmd : PN532_Buf; Timeout : Unsigned_32)
      return Boolean
    is

          
@@ 218,76 108,6 @@ package body PN532 is
       return True;
    end PN532_Send_Command;
 
-   procedure PN532_Read_Raw (Buf : out PN532_Buf) is
-   begin
-      PN532_SPI_Enable;
-      PN532_Delay;
-
-      SPI.Send (SPI_READ);
-
-      for I in Buf'Range loop
-         Buf (I) := SPI.Read;
-      end loop;
-
-      PN532_SPI_Disable;
-   end PN532_Read_Raw;
-
-   procedure PN532_Read_Data
-     (Buf    : out PN532_Buf;
-      Len    : out Unsigned_8;
-      Status : out Boolean)
-   is
-      Header : PN532_Buf (1..6);
-      Checksum : Unsigned_8 := 16#FF#;
-      Msg_Len : Unsigned_8;
-   begin
-      PN532_SPI_Enable;
-      PN532_Delay;
-
-      SPI.Send (SPI_READ);
-
-      for I in Header'Range loop
-         Header (I) := SPI.Read;
-      end loop;
-
-      if not (Header (2) = 0 and Header (3) = 16#FF#) then
-         -- Log ("PN532_Read_Data: Invalid header");
-         PN532_SPI_Disable;
-         Status := False;
-         return;
-      end if;
-
-      Msg_Len := Header (4);
-      if Msg_Len + Header (5) /= 0 then
-         PN532_SPI_Disable;
-         Status := False;
-         -- Log ("PN532_Read_Data: Invalid header len checksum");
-         return;
-      end if;
-
-      Checksum := Checksum + Header (6);
-
-      Msg_Len := Unsigned_8'Min (Buf'Length, Msg_Len);
-
-      for I in Unsigned_8 range 1 .. Msg_Len loop
-         Buf (I) := SPI.Read;
-         Checksum := Checksum + Buf (I);
-      end loop;
-
-      Header (1) := SPI.Read;
-      Header (2) := SPI.Read;
-      Header (1) := not Header (1);
-
-      if Checksum /= Header (1) then
-         -- Log ("PN532_Read_Data: Invalid checksum");
-         Status := False;
-      else
-         Status := True;
-         Len := Msg_Len;
-      end if;
-
-      PN532_SPI_Disable;
-   end PN532_Read_Data;
 
    function PN532_SAM_Config return Boolean is
       Cmd : PN532_Buf := ( PN532_SAMCONFIG,

          
@@ 302,6 122,12 @@ package body PN532 is
       if not Status then
          return False;
       end if;
+      
+      Status := PN532_Wait_For_Ready (PN532_TIMEOUT_VALUE);
+      if not Status then
+         Log ("timeout2");
+         return False;
+      end if;
 
       PN532_Read_Data (Reply, Len, Status);
       if Status and Reply (1) = 16#15# then

          
@@ 354,7 180,7 @@ package body PN532 is
          return;
       end if;
 
-      if not PN532_Wait_For_Ready (PN532_TIMEOUT_VALUE) then
+      if not PN532_Wait_For_Ready (PN532_TIMEOUT_VALUE * 30) then
          Status := False;
          return;
       end if;

          
@@ 875,6 701,11 @@ package body PN532 is
 
    Init_Cmd_PM : Buf_In_Progmem := (Init_Cmd'Length, Init_Cmd);
    pragma Linker_Section (Init_Cmd_PM, ".progmem");
+   
+   procedure Init is
+   begin
+      PN532_Init;
+   end Init;
 
    function PN532_Init_As_Target return Boolean is
       use type System.Address;

          
@@ 1041,18 872,4 @@ package body PN532 is
       end loop;
    end PN532_NFC_Forum_Type_4_Emulate;
 
-   procedure Init is
-   begin
-      Log ("PN532.Init");
-      SPI.Init;
-
-      PN532_SPI_Disable;
-      PN532_Delay;
-      PN532_SPI_Enable;
-
-      SPI.Send(16#55#);
-
-      delay 0.9;
-      PN532_SPI_Disable;
-   end Init;
-end PN532;
+end Generic_PN532;

          
M pn532.ads => generic_pn532.ads +21 -4
@@ 16,10 16,27 @@ 
 --
 
 with Interfaces;
+with PN532_Types;
 
-package PN532 is
-   type PN532_Buf is array
-     (Interfaces.Unsigned_8 range <>) of Interfaces.Unsigned_8;
+use PN532_Types;
+
+generic
+   with procedure PN532_Init;
+   
+   with function PN532_Busy return Boolean;
+
+   with procedure PN532_Write (Cmd : PN532_Buf);
+   
+   with procedure PN532_Read_Reply
+     (Reply : out Reply_Type; Code : out Interfaces.Unsigned_8);
+   
+   with procedure PN532_Read_Raw (Buf : out PN532_Buf);
+   
+   with procedure PN532_Read_Data
+     (Buf    : out PN532_Buf;
+      Len    : out Interfaces.Unsigned_8;
+      Status : out Boolean);
+package Generic_PN532 is
 
    subtype PN532_Buf_4 is PN532_Buf (1..4);
    subtype PN532_Buf_6 is PN532_Buf (1..6);

          
@@ 78,4 95,4 @@ package PN532 is
      (Offset : Interfaces.Unsigned_16;
       Buf    : PN532_Buf;
       Status : out Boolean);
-end PN532;
+end Generic_PN532;

          
M nfc_tags.adb +40 -21
@@ 18,26 18,45 @@ 
 with System;
 with PM_Strings;
 with NDEF;
-with PN532;
+with PN532_BUS_SPI;
+with Generic_PN532;
 with AVR.UART;
 with AVR.Interrupts;
 with Interfaces;
 with Ada.Characters.Latin_1;
 with AVR.Programspace;
+with PN532_Types;
+
 
 package body NFC_Tags is
    use Interfaces;
+   use PN532_Types;
+
+   package PN532 is new Generic_PN532
+     (PN532_Init => PN532_BUS_SPI.PN532_Init,
+      PN532_Busy => PN532_BUS_SPI.PN532_Busy,
+      PN532_Write => PN532_BUS_SPI.PN532_Write,
+      PN532_Read_Reply => PN532_BUS_SPI.PN532_Read_Reply,
+      PN532_Read_Raw => PN532_BUS_SPI.PN532_Read_Raw,
+      PN532_Read_Data => PN532_BUS_SPI.PN532_Read_Data);
+--   package PN532 is new Generic_PN532
+--     (PN532_Init => PN532_BUS_I2C.PN532_Init,
+--      PN532_Busy => PN532_BUS_I2C.PN532_Busy,
+--      PN532_Write => PN532_BUS_I2C.PN532_Write,
+--      PN532_Read_Reply => PN532_BUS_I2C.PN532_Read_Reply,
+--      PN532_Read_Raw => PN532_BUS_I2C.PN532_Read_Raw,
+--      PN532_Read_Data => PN532_BUS_I2C.PN532_Read_Data);
 
    procedure Print_Str (Place : System.Address);
 
-   procedure Read_Mifare_Classic_Tag (NFC_ID : PN532.PN532_Buf) is
+   procedure Read_Mifare_Classic_Tag (NFC_ID : PN532_Buf) is
       Status : Boolean;
-      Key_A : PN532.PN532_Buf_6 := (255, 255, 255, 255, 255, 255);
-      MAD_Key_A : PN532.PN532_Buf_6 :=
+      Key_A : PN532_Buf_6 := (255, 255, 255, 255, 255, 255);
+      MAD_Key_A : PN532_Buf_6 :=
         (16#A0#, 16#A1#,  16#A2#, 16#A3#, 16#A4#, 16#A5#);
-      Key_B : PN532.PN532_Buf_6 := (255, 255, 255, 255, 255, 255);
-      Data : PN532.PN532_Buf (1 .. 16);
-      NFC_Data : PN532.PN532_Buf (1 .. 48);
+      Key_B : PN532_Buf_6 := (255, 255, 255, 255, 255, 255);
+      Data : PN532_Buf (1 .. 16);
+      NFC_Data : PN532_Buf (1 .. 48);
       Len : Unsigned_8;
    begin
       AVR.UART.Put ("UID len: ");

          
@@ 129,8 148,8 @@ package body NFC_Tags is
       Card_Block_Count : Unsigned_8;
       Card_Size : Unsigned_16;
       Status : Boolean;
-      Data : PN532.PN532_Buf (1 .. 16);
-      NFC_Data : PN532.PN532_Buf (1 .. 48);
+      Data : PN532_Buf (1 .. 16);
+      NFC_Data : PN532_Buf (1 .. 48);
       NDEF_Loc : Unsigned_8 := 0;
    begin
       Print_Str (PM_Strings.Type_2_Tag_PM'Address); AVR.UART.CRLF;

          
@@ 208,11 227,11 @@ package body NFC_Tags is
 
    end Read_Forum_Type_2_Tag;
 
-   procedure Write_Forum_Type_2_Tag (Data : PN532.PN532_Buf) is
+   procedure Write_Forum_Type_2_Tag (Data : PN532_Buf) is
       use type PN532.NFC_Forum_Type_2_Block;
 
       Status : Boolean;
-      Block : PN532.PN532_Buf (1..4);
+      Block : PN532_Buf (1..4);
       I : Unsigned_8 := Data'First;
       Len : Unsigned_8;
       Current_Block : PN532.NFC_Forum_Type_2_Block := 4;

          
@@ 252,8 271,8 @@ package body NFC_Tags is
 
    procedure Read_Forum_Type_4_Tag is
       Status : Boolean;
-      Data : PN532.PN532_Buf (1 .. 16);
-      NFC_Data : PN532.PN532_Buf (1 .. 64);
+      Data : PN532_Buf (1 .. 16);
+      NFC_Data : PN532_Buf (1 .. 64);
       Len : Unsigned_8;
       NDEF_ID : Unsigned_16;
       NDEF_Len : Unsigned_16;

          
@@ 315,11 334,11 @@ package body NFC_Tags is
       AVR.UART.CRLF;
    end Read_Forum_Type_4_Tag;
 
-   procedure Update_Forum_Type_4_Tag (New_Content : PN532.PN532_Buf)
+   procedure Update_Forum_Type_4_Tag (New_Content : PN532_Buf)
    is
       Status   : Boolean;
-      Data     : PN532.PN532_Buf (1 .. 16);
-      NFC_Data : PN532.PN532_Buf (1 .. 2);
+      Data     : PN532_Buf (1 .. 16);
+      NFC_Data : PN532_Buf (1 .. 2);
       Len      : Unsigned_8;
       NDEF_ID  : Unsigned_16;
    begin

          
@@ 387,7 406,7 @@ package body NFC_Tags is
    procedure Read_Tag is
       Sel_Res  : Unsigned_8;
       Sens_Res : Unsigned_16;
-      NFC_ID   : PN532.PN532_Buf (1..16);
+      NFC_ID   : PN532_Buf (1..16);
       NFC_ID_Len : Unsigned_8;
       Status   : Boolean;
    begin

          
@@ 435,7 454,7 @@ package body NFC_Tags is
    procedure Write_Tag is
       use AVR.UART;
 
-      NDEF_Data : PN532.PN532_Buf (1..18) :=
+      NDEF_Data : PN532_Buf (1..18) :=
         (03, 15, -- len
          16#D1#, 16#01#, 16#09#, 16#54#,
          16#02#, -- plain text

          
@@ 453,8 472,8 @@ package body NFC_Tags is
 
       Ch : Character;
       Len : Unsigned_8 := 0;
-      My_String : PN532.PN532_Buf (1..8);
-      NFC_ID : PN532.PN532_Buf (1..7);
+      My_String : PN532_Buf (1..8);
+      NFC_ID : PN532_Buf (1..7);
       NFC_ID_Len : Unsigned_8;
       Sel_Res  : Unsigned_8;
       Sens_Res : Unsigned_16;

          
@@ 530,7 549,7 @@ package body NFC_Tags is
    end Write_Tag;
 
 
-   NDEF_Hello : constant PN532.PN532_Buf (1..14) :=
+   NDEF_Hello : constant PN532_Buf (1..14) :=
      (00, 12, -- len
       16#D1#, 16#01#, 16#08#, 16#54#,
       16#02#, -- plain text

          
A => pn532_bus_i2c.adb +183 -0
@@ 0,0 1,183 @@ 
+with AVR;
+with AVR.MCU;
+with AVR.I2C;
+with AVR.I2C.Master;
+
+package body PN532_BUS_I2C is
+   use AVR;
+
+   -- IRQ line
+   IRQ_Bit : Boolean renames AVR.MCU.PIND_Bits (2);
+   IRQ_Bit_Direction : Boolean renames AVR.MCU.DDRD_Bits (2);
+
+   -- Reset
+   Reset_Bit : Boolean renames AVR.MCU.PORTD_Bits (3);
+   Reset_Bit_Direction : Boolean renames AVR.MCU.DDRD_Bits (3);
+
+   PN532_I2C_ADDRESS : constant := (16#48# / 2);
+
+   procedure PN532_Init is
+   begin
+      delay 0.1;
+      AVR.I2C.Master.Init;
+
+      IRQ_Bit_Direction := DD_Input; -- IRQ, digital pin 2
+
+      Reset_Bit_Direction := DD_Output;
+      Reset_Bit := True;
+      Reset_Bit := False;
+      delay 0.4;
+      Reset_Bit := True;
+
+      delay 0.02;
+   end PN532_Init;
+
+   function PN532_Busy return Boolean is
+   begin
+      return IRQ_Bit;
+   end PN532_Busy;
+   pragma Inline_Always (PN532_Busy);
+
+   procedure PN532_Write (Cmd : PN532_Buf)  is
+      Buf      : AVR.I2C.Data_Buffer (1 .. 64);
+      Checksum : Unsigned_8 := 16#FF#;
+      Len      : Unsigned_8 := Cmd'Length + 1;
+      Index    : Unsigned_8;
+   begin
+      delay 0.002;
+      
+      if Cmd'Length > Buf'Length + 8 then
+         return;
+      end if;
+
+      Buf (1) := 0;
+      Buf (2) := 0;
+      Buf (3) := 16#FF#;
+
+      Buf (4) := Len;
+      Buf (5) := (not Len) + 1;
+
+      Buf (6) := HOST_TO_PN532;
+
+      Checksum := Checksum + HOST_TO_PN532;
+
+      Index := 7;
+      -- Buf (Index .. Index - 1 + Cmd'Length) := Cmd;
+      for I in Cmd'Range loop
+         Buf (Index) := Cmd (I);
+         Checksum := Checksum + Cmd (I);
+         Index := Index + 1;
+      end loop;
+
+      Buf (Index) := (not Checksum);
+      Index := Index + 1;
+      Buf (Index) := 0;
+
+      AVR.I2C.Master.Send (PN532_I2C_ADDRESS, Buf (1..Index));
+      -- AVR.I2C.Master.Finish_Send;
+   end PN532_Write;
+
+   procedure PN532_Read_Raw (Buf : out PN532_Buf) is
+   begin
+      for I in Buf'Range loop
+         exit when not AVR.I2C.Master.Data_Is_Available;
+         Buf (I) := AVR.I2C.Master.Get;
+      end loop;
+   end PN532_Read_Raw;
+
+   procedure PN532_Read_Reply (Reply : out Reply_Type; Code : out Unsigned_8) is
+      Buf : PN532_Buf (1..6);
+      Len : Unsigned_8;
+      Ok : Unsigned_8;
+   begin
+      AVR.I2C.Master.Request (PN532_I2C_ADDRESS, 7);
+      Code := 0;
+
+      loop
+         exit when AVR.I2C.Master.Data_Is_Available;
+      end loop;
+      Ok := AVR.I2C.Master.Get;
+      if (Ok and 1) /= 1 then
+         Reply := REPLY_ERROR;
+         return;
+      end if;
+
+      for I in Buf'Range loop
+         loop
+            exit when AVR.I2C.Master.Data_Is_Available;
+         end loop;
+         Buf (I) := AVR.I2C.Master.Get;
+      end loop;
+
+      if Buf (1) = 0 and Buf (2) = 0 and Buf (3) = 16#FF# then
+         if Buf (4) = 0 and Buf (5) = 16#FF# and Buf (6) = 0 then -- ACK
+            Reply := REPLY_ACK;
+         elsif Buf(4) = 16#FF# and Buf(5) = 0 and Buf (6) = 0 then -- NACK
+            Reply := REPLY_NACK;
+         else -- ERROR
+            Reply := REPLY_ERROR;
+            Len := Buf (4);
+            if Buf (5) + Len = 0 then -- checksum ok
+               Code := Buf (6);
+            end if;
+         end if;
+      else
+         Reply := REPLY_ERROR;
+         Code := 255;
+      end if;
+   end PN532_Read_Reply;
+
+   procedure PN532_Read_Data
+     (Buf    : out PN532_Buf;
+      Len    : out Unsigned_8;
+      Status : out Boolean)
+   is
+      Header : PN532_Buf (1..6);
+      Checksum : Unsigned_8 := 16#FF#;
+      Msg_Len : Unsigned_8;
+      Ready_Status : Unsigned_8;
+   begin
+      AVR.I2C.Master.Request (PN532_I2C_ADDRESS, 60);
+      loop
+         exit when AVR.I2C.Master.Data_Is_Available;
+      end loop;
+      Ready_Status := AVR.I2C.Master.Get;
+
+      for I in Header'Range loop
+         Header (I) := AVR.I2C.Master.Get;
+      end loop;
+
+      if not (Header (2) = 0 and Header (3) = 16#FF#) then
+         -- invalid header
+         Status := False;
+         return;
+      end if;
+
+      Msg_Len := Header (4);
+      if Msg_Len + Header (5) /= 0 then
+         Status := False;
+         return;
+      end if;
+
+      Checksum := Checksum + Header (6);
+
+      Msg_Len := Unsigned_8'Min (Buf'Length, Msg_Len);
+
+      for I in Unsigned_8 range 1 .. Msg_Len loop
+         Buf (I) := AVR.I2C.Master.Get;
+         Checksum := Checksum + Buf (I);
+      end loop;
+
+      Header (1) := AVR.I2C.Master.Get;
+      Header (2) := AVR.I2C.Master.Get;
+      Header (1) := not Header (1);
+
+      if Checksum /= Header (1) then
+         -- Log ("PN532_Read_Data: Invalid checksum");
+         Status := False;
+      else
+         Status := True;
+         Len := Msg_Len;
+      end if;
+   end PN532_Read_Data;
+end PN532_BUS_I2C;
  No newline at end of file

          
A => pn532_bus_i2c.ads +23 -0
@@ 0,0 1,23 @@ 
+with Interfaces;
+with PN532_Types;
+
+use PN532_Types;
+use Interfaces;
+
+package PN532_BUS_I2C is
+   procedure PN532_Init;
+   
+   function PN532_Busy return Boolean;
+
+   procedure PN532_Write (Cmd : PN532_Buf);
+   
+   procedure PN532_Read_Reply (Reply : out Reply_Type; Code : out Unsigned_8);
+   
+   procedure PN532_Read_Raw (Buf : out PN532_Buf);
+   
+   procedure PN532_Read_Data
+     (Buf    : out PN532_Buf;
+      Len    : out Unsigned_8;
+      Status : out Boolean);
+
+end PN532_BUS_I2C;
  No newline at end of file

          
A => pn532_bus_spi.adb +200 -0
@@ 0,0 1,200 @@ 
+with Interfaces;
+with SPI;
+with AVR.Real_Time.Clock;
+pragma Unreferenced(AVR.Real_Time.Clock);
+
+use Interfaces;
+
+package body PN532_BUS_SPI is
+   SPI_STATUS : constant := 2#10#;
+   SPI_WRITE  : constant := 2#01#;
+   SPI_READ   : constant := 2#11#;
+
+   procedure PN532_Delay is
+   begin
+      delay 0.002;
+   end PN532_Delay;
+   pragma Inline (PN532_Delay);
+
+   procedure PN532_SPI_Enable is
+   begin
+      SPI.SS_Out := False;
+   end PN532_SPI_Enable;
+   pragma Inline (PN532_SPI_Enable);
+
+   procedure PN532_SPI_Disable is
+   begin
+      SPI.SS_Out := True;
+   end PN532_SPI_Disable;
+   pragma Inline (PN532_SPI_Disable);
+
+   procedure PN532_Init is
+   begin
+      delay 0.1;
+      SPI.Init;
+
+      PN532_SPI_Disable;
+      PN532_Delay;
+      PN532_SPI_Enable;
+
+      SPI.Send(16#55#);
+
+      delay 0.9;
+      PN532_SPI_Disable;
+   end PN532_Init;
+
+   procedure PN532_Write (Cmd : PN532_Buf)  is
+      Checksum : Unsigned_8 := 16#FF#;
+      Len : Unsigned_8 := Cmd'Length + 1;
+   begin
+      PN532_SPI_Enable;
+      PN532_Delay;
+
+      SPI.Send(SPI_WRITE);
+
+      SPI.Send(0);
+      SPI.Send(0);
+      SPI.Send(16#FF#);
+
+      SPI.Send (Len);
+      SPI.Send ((not Len) + 1);
+
+      SPI.Send(HOST_TO_PN532);
+
+      Checksum := Checksum + HOST_TO_PN532;
+
+      for I in Cmd'Range loop
+         SPI.Send (Cmd (I));
+         Checksum := Checksum + Cmd (I);
+      end loop;
+
+      SPI.Send(not Checksum);
+      SPI.Send(0);
+
+      PN532_SPI_Disable;
+   end PN532_Write;
+
+   function PN532_Busy return Boolean is
+      Status : Unsigned_8;
+   begin
+      PN532_SPI_Enable;
+      PN532_Delay;
+      SPI.Send (SPI_STATUS);
+      Status := SPI.Read;
+      PN532_SPI_Disable;
+
+      return Status /= 1;
+   end PN532_Busy;
+
+   procedure PN532_Read_Reply (Reply : out Reply_Type; Code : out Unsigned_8) is
+      Buf : PN532_Buf (1..6);
+      Len : Unsigned_8;
+   begin
+      PN532_SPI_Enable;
+      PN532_Delay;
+      SPI.Send (SPI_READ);
+      Code := 0;
+
+      for I in Buf'Range loop
+         Buf (I) := SPI.Read;
+      end loop;
+
+      if Buf (1) = 0 and Buf (2) = 0 and Buf (3) = 16#FF# then
+         if Buf (4) = 0 and Buf (5) = 16#FF# and Buf (6) = 0 then -- ACK
+            Reply := REPLY_ACK;
+         elsif Buf(4) = 16#FF# and Buf(5) = 0 and Buf (6) = 0 then -- NACK
+            Reply := REPLY_NACK;
+         else -- ERROR
+            Reply := REPLY_ERROR;
+            Len := Buf (4);
+            if Buf (5) + Len = 0 then -- checksum ok
+               Code := Buf (6);
+               Buf (1) := SPI.Read;
+               Buf (2) := SPI.Read;
+            end if;
+         end if;
+      else
+         -- Log ("Unknown reply");
+         -- for I in Buf'Range loop
+         --    AVR.UART.Put (Data => Buf (I), Base => 16);
+         --    AVR.UART.Put (" ");
+         -- end loop;
+         -- AVR.UART.CRLF;
+         Reply := REPLY_ERROR;
+         Code := 255;
+      end if;
+
+      PN532_SPI_Disable;
+   end PN532_Read_Reply;
+
+   procedure PN532_Read_Raw (Buf : out PN532_Buf) is
+   begin
+      PN532_SPI_Enable;
+      PN532_Delay;
+
+      SPI.Send (SPI_READ);
+
+      for I in Buf'Range loop
+         Buf (I) := SPI.Read;
+      end loop;
+
+      PN532_SPI_Disable;
+   end PN532_Read_Raw;
+
+   procedure PN532_Read_Data
+     (Buf    : out PN532_Buf;
+      Len    : out Unsigned_8;
+      Status : out Boolean)
+   is
+      Header : PN532_Buf (1..6);
+      Checksum : Unsigned_8 := 16#FF#;
+      Msg_Len : Unsigned_8;
+   begin
+      PN532_SPI_Enable;
+      PN532_Delay;
+
+      SPI.Send (SPI_READ);
+
+      for I in Header'Range loop
+         Header (I) := SPI.Read;
+      end loop;
+
+      if not (Header (2) = 0 and Header (3) = 16#FF#) then
+         -- Log ("PN532_Read_Data: Invalid header");
+         PN532_SPI_Disable;
+         Status := False;
+         return;
+      end if;
+
+      Msg_Len := Header (4);
+      if Msg_Len + Header (5) /= 0 then
+         PN532_SPI_Disable;
+         Status := False;
+         -- Log ("PN532_Read_Data: Invalid header len checksum");
+         return;
+      end if;
+
+      Checksum := Checksum + Header (6);
+
+      Msg_Len := Unsigned_8'Min (Buf'Length, Msg_Len);
+
+      for I in Unsigned_8 range 1 .. Msg_Len loop
+         Buf (I) := SPI.Read;
+         Checksum := Checksum + Buf (I);
+      end loop;
+
+      Header (1) := SPI.Read;
+      Header (2) := SPI.Read;
+      Header (1) := not Header (1);
+
+      if Checksum /= Header (1) then
+         -- Log ("PN532_Read_Data: Invalid checksum");
+         Status := False;
+      else
+         Status := True;
+         Len := Msg_Len;
+      end if;
+
+      PN532_SPI_Disable;
+   end PN532_Read_Data;
+end PN532_BUS_SPI;

          
A => pn532_bus_spi.ads +23 -0
@@ 0,0 1,23 @@ 
+with Interfaces;
+with PN532_Types;
+
+use PN532_Types;
+use Interfaces;
+
+package PN532_BUS_SPI is
+   procedure PN532_Init;
+
+   function PN532_Busy return Boolean;
+
+   procedure PN532_Write (Cmd : PN532_Buf);
+
+   procedure PN532_Read_Reply (Reply : out Reply_Type; Code : out Unsigned_8);
+
+   procedure PN532_Read_Raw (Buf : out PN532_Buf);
+
+   procedure PN532_Read_Data
+     (Buf    : out PN532_Buf;
+      Len    : out Unsigned_8;
+      Status : out Boolean);
+
+end PN532_BUS_SPI;
  No newline at end of file

          
A => pn532_types.ads +13 -0
@@ 0,0 1,13 @@ 
+with Interfaces;
+
+package PN532_Types is
+   type PN532_Buf is array
+     (Interfaces.Unsigned_8 range <>) of Interfaces.Unsigned_8;
+     
+   type Reply_Type is (REPLY_ACK, REPLY_NACK, REPLY_ERROR);
+     
+   subtype PN532_Buf_4 is PN532_Buf (1..4);
+   subtype PN532_Buf_6 is PN532_Buf (1..6);
+   
+   HOST_TO_PN532 : constant := 16#D4#;
+end PN532_Types;
  No newline at end of file