I2C version of PN532 routines.

Work in progress.
6 files changed, 1900 insertions(+), 1 deletions(-)

A => avr-i2c-master.adb
A => avr-i2c-master.ads
A => avr-i2c.ads
M nfc_tags.adb
A => pn532_twi.adb
A => pn532_twi.ads
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 nfc_tags.adb +5 -1
@@ 18,15 18,19 @@ 
 with System;
 with PM_Strings;
 with NDEF;
-with PN532;
+with PN532_TWI;
 with AVR.UART;
 with AVR.Interrupts;
 with Interfaces;
 with Ada.Characters.Latin_1;
 with AVR.Programspace;
 
+
+
 package body NFC_Tags is
    use Interfaces;
+   
+   package PN532 renames PN532_TWI;
 
    procedure Print_Str (Place : System.Address);
 

          
A => pn532_twi.adb +1052 -0
@@ 0,0 1,1052 @@ 
+-- PN532/NFC routines using AVR-Ada
+--
+-- Copyright (c) 2015 Tero Koskinen <tero.koskinen@iki.fi>
+--
+-- Permission to use, copy, modify, and distribute this software for any
+-- purpose with or without fee is hereby granted, provided that the above
+-- copyright notice and this permission notice appear in all copies.
+--
+-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+--
+
+with System;
+with Interfaces;
+with AVR.I2C;
+with AVR.I2C.Master;
+with AVR.Real_Time.Clock;
+pragma Unreferenced(AVR.Real_Time.Clock);
+with AVR.UART;
+with AVR.Strings;
+with AVR.Programspace;
+with AVR.MCU;
+with AVR;
+
+use Interfaces;
+
+package body PN532_TWI is
+   use AVR;
+   
+   IRQ_Bit : Boolean renames AVR.MCU.PIND_Bits (2);
+
+   PN532_I2C_ADDRESS : constant := (16#48# / 2);
+
+   PN532_FIRMWARE_VERSION : constant := 16#02#;
+   PN532_SAMCONFIG        : constant := 16#14#;
+   PN532_IN_LIST_PASSIVE_TARGET : constant := 16#4A#;
+   PN532_IN_DATA_EXCHANGE : constant := 16#40#;
+   PN532_TG_INIT_AS_TARGET : constant := 16#8C#;
+   PN532_TG_GET_DATA : constant := 16#86#;
+   PN532_TG_SET_DATA : constant := 16#8E#;
+
+   HOST_TO_PN532 : constant := 16#D4#;
+
+   PN532_TIMEOUT_VALUE : constant := 2000;
+
+   PN532_106_KBPS_ISOIEC_14443_A : constant := 0;
+
+   MIFARE_READ_CARD_CMD : constant := 16#30#;
+   MIFARE_WRITE_CARD_CMD : constant := 16#A2#;
+   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;
+
+   procedure PN532_Get_Data (Buf : out PN532_Buf;
+                             Len : out Unsigned_8;
+                             Status  : out Boolean);
+   function PN532_Send_R_APDU (SW1 : Unsigned_8; SW2 : Unsigned_8) return Boolean;
+
+   procedure Log (Msg : AVR.Strings.AVR_String) is
+   begin
+      AVR.UART.Put (Msg);
+      AVR.UART.CRLF;
+   end Log;
+
+   procedure Log (Buf : PN532_Buf) is
+   begin
+      for I in Buf'Range loop
+         AVR.UART.Put (Data => Buf (I), Base => 16);
+         AVR.UART.Put (" ");
+      end loop;
+      AVR.UART.CRLF;
+   end Log;
+
+   procedure PN532_Delay is
+   begin
+      delay 0.002;
+   end PN532_Delay;
+   pragma Inline (PN532_Delay);
+
+   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
+      PN532_Delay;
+      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;
+   
+
+   function PN532_Wait_For_Ready (Timeout : Unsigned_32) return Boolean is
+      Counter : Unsigned_32 := 0;
+   begin
+      loop
+         exit when not IRQ_Bit;
+         Counter := Counter + 1;
+         if Counter >= Timeout then
+            return False;
+         end if;
+      end loop;
+      
+      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;
+      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;
+      Log ("ACK:");
+      Log (Buf);
+
+      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
+               AVR.I2C.Master.Request (PN532_I2C_ADDRESS, 1);
+               loop
+                  exit when AVR.I2C.Master.Data_Is_Available;
+               end loop;
+               Code := AVR.I2C.Master.Get;
+            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;
+   end PN532_Read_Reply;
+
+   function PN532_Send_Command (Cmd : PN532_Buf; Timeout : Unsigned_32)
+     return Boolean
+   is
+      Status : Boolean;
+      Reply : Reply_Type;
+      Error_Code : Unsigned_8;
+   begin
+      PN532_Write (Cmd);
+
+      Status := PN532_Wait_For_Ready (Timeout);
+      if not Status then -- timeout
+         return False;
+      end if;
+
+      PN532_Read_Reply (Reply, Error_Code);
+
+      if Reply = REPLY_ERROR or Reply = REPLY_NACK then
+         Log ("PN532_Send_Command, invalid reply");
+         return False;
+      end if;
+
+      return True;
+   end PN532_Send_Command;
+
+   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_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;
+         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) := 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;
+
+   function PN532_SAM_Config return Boolean is
+      Cmd : PN532_Buf := ( PN532_SAMCONFIG,
+                           1, -- normal mode
+                           20, -- timeout (50 * 20) ms
+                           1);
+      Status : Boolean;
+      Reply : PN532_Buf (1..1) := (1 => 0);
+      Len : Unsigned_8;
+      Reply_Status : Reply_Type;
+      Error_Code : Unsigned_8;
+   begin
+      Status := PN532_Send_Command (Cmd, PN532_TIMEOUT_VALUE);
+      if not Status then
+         return False;
+      end if;
+      
+      PN532_Read_Data (Reply, Len, Status);
+      Log (Reply (1..Len));
+      if Status and Reply (1) = 16#15# then
+         return True;
+      end if;
+
+      return False;
+   end PN532_SAM_Config;
+
+   function PN532_Read_Firmware return Unsigned_32 is
+      Cmd : PN532_Buf (1..1) := (1 => PN532_FIRMWARE_VERSION);
+      Reply : PN532_Buf (1..12);
+      Status : Boolean;
+   begin
+      Status := PN532_Send_Command (Cmd, PN532_TIMEOUT_VALUE);
+      if not Status then
+         return 0;
+      end if;
+
+      PN532_Read_Raw (Reply);
+
+      -- Bytes are: IC(8) Ver(9) Rev(10) Support(11)
+      -- See PN532 user manual section 7.2.2 GetFirmwareVersion
+      return Unsigned_32 (Reply (8)) * (2**24) +
+             Unsigned_32 (Reply (9)) * (2**16) +
+             Unsigned_32 (Reply (10)) * (2**8) +
+             Unsigned_32 (Reply (11));
+   end PN532_Read_Firmware;
+
+   procedure PN532_Detect_Tag
+     (Sens_Res : out Unsigned_16;
+      Sel_Res : out Unsigned_8;
+      NFC_ID  : out PN532_Buf;
+      NFC_ID_Len : out Unsigned_8;
+      Status : out Boolean)
+   is
+      Cmd : PN532_Buf (1..3) :=
+        (PN532_IN_LIST_PASSIVE_TARGET,
+         1, -- Maximum amount of detected tags
+         PN532_106_KBPS_ISOIEC_14443_A);
+
+      Reply : PN532_Buf (1..40) := (others => 0);
+      Len   : Unsigned_8;
+      Ok    : Boolean;
+   begin
+      Ok := PN532_Send_Command (Cmd, PN532_TIMEOUT_VALUE);
+
+      if not Ok then
+         Status := False;
+         return;
+      end if;
+
+      if not PN532_Wait_For_Ready (PN532_TIMEOUT_VALUE) then
+         Status := False;
+         return;
+      end if;
+
+      PN532_Read_Data (Reply, Len, Ok);
+      if not Ok or Len = 0 then -- Some error
+         Status := False;
+         return;
+      end if;
+
+      if Reply (2) = 0 then -- No tags found
+         Status := False;
+         return;
+      end if;
+
+      Sens_Res := Unsigned_16 (Reply (5)) * 256 or Unsigned_16 (Reply (4));
+      Sel_Res := Reply (6);
+
+      NFC_ID_Len := Reply (7);
+      if NFC_ID_Len > NFC_ID'Length then
+         NFC_ID_Len := NFC_ID'Length;
+      end if;
+      NFC_ID := Reply (8..7 + NFC_ID_Len);
+
+      Status := Ok;
+   end PN532_Detect_Tag;
+
+   procedure PN532_Read_NFC_Forum_Type_2_Tag_Block
+     (Block      : NFC_Forum_Type_2_Block;
+      Buf        : out PN532_Buf;
+      Byte_Count : out Unsigned_8;
+      Status     : out Boolean)
+   is
+      Cmd : PN532_Buf (1..4) := (PN532_IN_DATA_EXCHANGE,
+                                 1, -- card number
+                                 MIFARE_READ_CARD_CMD,
+                                 0); -- Block number
+      Reply : PN532_Buf (1..40);
+      Reply_Len : Unsigned_8;
+      Len   : Unsigned_8;
+      Ok    : Boolean;
+   begin
+      Cmd (4) := Block;
+
+      Ok := PN532_Send_Command (Cmd, PN532_TIMEOUT_VALUE);
+      if not Ok then
+         Status := False;
+         return;
+      end if;
+
+      if not PN532_Wait_For_Ready (PN532_TIMEOUT_VALUE) then
+         Status := False;
+         return;
+      end if;
+
+      PN532_Read_Data (Reply, Reply_Len, Ok);
+
+      if (not Ok) or (Reply_Len < 3) then
+         Status := False;
+         return;
+      end if;
+
+      if Reply (2) /= 0 then -- status code not ok?
+         Status := False;
+         return;
+      end if;
+
+      Len := Unsigned_8'Min (Reply_Len - 3, Buf'Length);
+      Byte_Count := Len;
+      Buf (1..Len) := Reply (3 .. Len + 2);
+
+      Status := True;
+   end PN532_Read_NFC_Forum_Type_2_Tag_Block;
+
+   procedure PN532_Write_NFC_Forum_Type_2_Tag_Block
+     (Block_Number : NFC_Forum_Type_2_Block;
+      Buf          : PN532_Buf_4;
+      Status       : out Boolean)
+   is
+      Cmd : PN532_Buf (1..8) := (PN532_IN_DATA_EXCHANGE,
+                                 1, -- card number
+                                 MIFARE_WRITE_CARD_CMD,
+                                 Block_Number, -- Block number
+                                 others => 0);
+      Reply : PN532_Buf (1..10);
+      Reply_Len : Unsigned_8;
+      Ok    : Boolean;
+   begin
+      Cmd (5..8) := Buf;
+
+      Ok := PN532_Send_Command (Cmd, PN532_TIMEOUT_VALUE);
+      if not Ok then
+         Status := False;
+         return;
+      end if;
+
+      if not PN532_Wait_For_Ready (PN532_TIMEOUT_VALUE) then
+         Status := False;
+         return;
+      end if;
+
+      PN532_Read_Data (Reply, Reply_Len, Ok);
+
+      if (not Ok) or (Reply_Len < 3) then
+         Status := False;
+         return;
+      end if;
+
+      if Reply (2) /= 0 then -- status code not ok?
+         Status := False;
+         return;
+      end if;
+
+      Status := True;
+   end PN532_Write_NFC_Forum_Type_2_Tag_Block;
+
+   procedure PN532_Authenticate_Mifare_Classic_Tag_Block
+      (Block_Number : Mifare_Classic_Block;
+       UID          : PN532_Buf;
+       Key          : Mifare_Auth;
+       Key_Data     : PN532_Buf_6;
+       Status       : out Boolean)
+   is
+      Cmd : PN532_Buf (1..20);
+      Reply : PN532_Buf (1..15);
+      Reply_Len : Unsigned_8;
+      Ok    : Boolean;
+   begin
+      Cmd (1) := PN532_IN_DATA_EXCHANGE;
+      Cmd (2) := 1; -- card number
+      if Key = AUTH_A then
+         Cmd (3) := MIFARE_AUTH_KEY_A_CMD;
+      else
+         Cmd (3) := MIFARE_AUTH_KEY_B_CMD;
+      end if;
+      Cmd (4) := Unsigned_8 (Block_Number);
+      Cmd (5..4 + Key_Data'Length) := Key_Data;
+      if UID'Length > 10 then
+         Log ("UID too big");
+         Status := False;
+         return;
+      end if;
+      Cmd (11..10 + UID'Length) := UID;
+
+      Log (Cmd (1..10+UID'Length));
+      Ok := PN532_Send_Command (Cmd (1..10+UID'Length), PN532_TIMEOUT_VALUE);
+      if not Ok then
+         Log ("Send command failed");
+         Status := False;
+         return;
+      end if;
+
+      if not PN532_Wait_For_Ready (PN532_TIMEOUT_VALUE) then
+         Log ("timeout");
+         Status := False;
+         return;
+      end if;
+
+      PN532_Read_Data (Reply, Reply_Len, Ok);
+      Log ("Reply:");
+      Log (Reply (1..Reply_Len));
+
+      if (not Ok) or (Reply_Len < 3) then
+         Log ("Read data failed");
+         Status := False;
+         return;
+      end if;
+
+      if Reply (2) = 16#14# then -- Mifare authentication error
+         Log ("Mifare auth error");
+         Status := False;
+         return;
+      elsif Reply (2) /= 0 then -- status code not ok?
+         Status := False;
+         return;
+      end if;
+
+      Status := True;
+   end PN532_Authenticate_Mifare_Classic_Tag_Block;
+
+
+   -- C-APDU for select application
+   -- CLA INS P1  P2  LC  Data           Le
+   -- 00h A4h 04h 00h 07h D2760000850101 00
+   function PN532_NFC_Forum_Type_4_Select_Application return Boolean
+   is
+      Data : PN532_Buf (1..20) := (PN532_IN_DATA_EXCHANGE,
+                                   1, -- card number
+                                   16#00#, -- class
+                                   16#A4#, -- instruction
+                                   16#04#, -- select by name
+                                   16#00#, -- first or only occurrence
+                                   16#07#,
+                                   16#D2#, 16#76#, 16#00#, 16#00#, 16#85#, 16#01#, 16#01#,
+                                   16#00#, -- response data field may be present
+                                   others => 0);
+      Reply_Len : Unsigned_8;
+      Ok    : Boolean;
+   begin
+      Ok := PN532_Send_Command (Data (1..15), PN532_TIMEOUT_VALUE);
+      if not Ok then
+         return False;
+      end if;
+
+      if not PN532_Wait_For_Ready (PN532_TIMEOUT_VALUE) then
+         return False;
+      end if;
+
+      PN532_Read_Data (Data, Reply_Len, Ok);
+
+      if (not Ok) or (Reply_Len < 5) then
+         return False;
+      end if;
+
+      if Data (2) /= 0 then -- status code not ok?
+         return False;
+      end if;
+
+      if Data (Reply_Len - 2) = 16#90# and Data (Reply_Len - 1) = 16#00# then
+         -- ok
+         return True;
+      elsif Data (Reply_Len - 2) = 16#6A# and Data (Reply_Len - 1) = 16#82# then
+         -- application not found
+         null;
+      end if;
+
+      return False;
+   end PN532_NFC_Forum_Type_4_Select_Application;
+
+   -- C-APDU for select file
+   -- CLA INS P1  P2  LC  Data Le
+   -- 00h A4h 00h 0Ch 02h xxyy --
+   function PN532_NFC_Forum_Type_4_Select_File
+     (File_ID : Interfaces.Unsigned_16) return Boolean
+   is
+      Cmd : PN532_Buf (1..9) := (PN532_IN_DATA_EXCHANGE,
+                                  1, -- card number
+                                  16#00#, -- class
+                                  16#A4#, -- instruction
+                                  16#00#, -- select by identifier
+                                  16#0C#, -- first or only occurrence
+                                  16#02#, -- two bytes data
+                                  Unsigned_8 (File_ID / 256), Unsigned_8 (File_ID and 16#FF#));
+      Reply : PN532_Buf (1..40);
+      Reply_Len : Unsigned_8;
+      Ok    : Boolean;
+   begin
+      Ok := PN532_Send_Command (Cmd, PN532_TIMEOUT_VALUE);
+      if not Ok then
+         return False;
+      end if;
+
+      if not PN532_Wait_For_Ready (PN532_TIMEOUT_VALUE) then
+         return False;
+      end if;
+
+      PN532_Read_Data (Reply, Reply_Len, Ok);
+
+      if (not Ok) or (Reply_Len < 5) then
+         return False;
+      end if;
+
+      if Reply (2) /= 0 then -- status code not ok?
+         return False;
+      end if;
+
+      if Reply (Reply_Len - 2) = 16#90# and Reply (Reply_Len - 1) = 16#00# then
+         -- ok
+         return True;
+      elsif Reply (Reply_Len - 2) = 16#6A#
+        and Reply (Reply_Len - 1) = 16#82#
+      then -- file not found
+         return False;
+      end if;
+
+      return False;
+   end PN532_NFC_Forum_Type_4_Select_File;
+
+   -- C-APDU for read binary
+   -- CLA INS P1  P2  Le
+   -- 00h B0h xxh yyh zzh (xx yy = offset, zz = length)
+   procedure PN532_NFC_Forum_Type_4_Read_Binary
+     (Offset     : Interfaces.Unsigned_16;
+      Buf        : out PN532_Buf;
+      Byte_Count : out Unsigned_8;
+      Status     : out Boolean)
+   is
+      Cmd : PN532_Buf (1..7);
+      Len : Unsigned_8;
+      Reply : PN532_Buf (1..70);
+      Reply_Len : Unsigned_8;
+      Ok    : Boolean;
+   begin
+      Len := Buf'Length;
+      if Len > Reply'Length then
+         Len := Reply'Length;
+      end if;
+      Cmd (1) := PN532_IN_DATA_EXCHANGE;
+      Cmd (2) := 1; -- card number
+      Cmd (3) := 16#00#; -- class
+      Cmd (4) := 16#B0#; -- instruction
+      Cmd (5) := Unsigned_8 (Offset and 16#FF#);
+      Cmd (6) := Unsigned_8 (Offset / 256);
+      Cmd (7) := Len;
+
+      Ok := PN532_Send_Command (Cmd, PN532_TIMEOUT_VALUE);
+      if not Ok then
+         Status := False;
+         return;
+      end if;
+
+      if not PN532_Wait_For_Ready (PN532_TIMEOUT_VALUE) then
+         Status := False;
+         return;
+      end if;
+
+      PN532_Read_Data (Reply, Reply_Len, Ok);
+
+      if (not Ok) or (Reply_Len < 5) then
+         Status := False;
+         return;
+      end if;
+
+      if Reply (2) /= 0 then -- status code not ok?
+         Status := False;
+         return;
+      end if;
+
+      if Reply (Reply_Len - 2) = 16#90# and Reply (Reply_Len - 1) = 16#00# then
+         -- ok, copying buffer
+
+         Len := Reply_Len - 5;
+         Buf (Buf'First .. Buf'First + Len) := Reply (3 .. 3 + Len);
+         Byte_Count := Len;
+         Status := True;
+      else
+         Status := False;
+         -- AVR.UART.Put ("Read failed"); AVR.UART.CRLF;
+      end if;
+   end PN532_NFC_Forum_Type_4_Read_Binary;
+
+   procedure PN532_NFC_Forum_Type_4_Update_Binary
+     (Offset : Interfaces.Unsigned_16;
+      Buf    : PN532_Buf;
+      Status : out Boolean)
+   is
+      Cmd       : PN532_Buf (1..70);
+      Reply     : PN532_Buf (1..10);
+      Reply_Len : Unsigned_8;
+      Ok        : Boolean;
+   begin
+      Cmd (1) := PN532_IN_DATA_EXCHANGE;
+      Cmd (2) := 1; -- card number
+      Cmd (3) := 16#00#; -- class
+      Cmd (4) := 16#D6#; -- instruction
+      Cmd (5) := Unsigned_8 (Offset / 256); -- offset p1
+      Cmd (6) := Unsigned_8 (Offset and 16#FF#); -- offset p2
+      Cmd (7) := Buf'Length;
+      if Buf'Length > Cmd'Length - 7 then
+         Status := False;
+         return;
+      end if;
+
+      Cmd (8..7 + Buf'Length) := Buf;
+
+      -- Log ("Update command:");
+      -- Log (Cmd (1..7 + Buf'Length));
+
+      -- Log (Cmd (1..7 + Buf'Length));
+
+      Ok := PN532_Send_Command (Cmd (1..7 + Buf'Length), PN532_TIMEOUT_VALUE);
+      if not Ok then
+         Status := False;
+         return;
+      end if;
+
+      if not PN532_Wait_For_Ready (PN532_TIMEOUT_VALUE) then
+         Status := False;
+         return;
+      end if;
+
+      PN532_Read_Data (Reply, Reply_Len, Ok);
+
+      if (not Ok) or (Reply_Len < 5) then
+         Status := False;
+         return;
+      end if;
+
+      if Reply (2) /= 0 then -- status code not ok?
+         -- Log ("PN532 error:");
+         -- AVR.UART.Put (Data => Reply (2), Base => 16);
+         -- AVR.UART.CRLF;
+         Status := False;
+         return;
+      end if;
+
+      if Reply (Reply_Len - 2) = 16#90# and Reply (Reply_Len - 1) = 16#00# then
+         Status := True;
+      else
+         Status := False;
+      end if;
+   end PN532_NFC_Forum_Type_4_Update_Binary;
+
+   function PN532_Set_Data (Buf : PN532_Buf; Buf2 : PN532_Buf)
+     return Boolean
+   is
+      Cmd : PN532_Buf (1..70);
+      Ok : Boolean;
+      Reply : PN532_Buf (1..10);
+      Reply_Len : Unsigned_8;
+   begin
+      if Buf'Length + Buf2'Length >= Cmd'Length - 2 then
+         -- Log ("PN532_Set_Data: Buf too big");
+         return False;
+      end if;
+
+      Cmd (1) := PN532_TG_SET_DATA;
+      Cmd (2 .. 1 + Buf'Length) := Buf;
+      if Buf2'Length > 0 then
+         Cmd (2 + Buf'Length .. 1 + Buf'Length + Buf2'Length) := Buf2;
+      end if;
+
+      Ok := PN532_Send_Command
+        (Cmd (1 .. 1 + Buf'Length + Buf2'Length), PN532_TIMEOUT_VALUE);
+
+      if not Ok then
+         return False;
+      end if;
+
+      if not PN532_Wait_For_Ready (PN532_TIMEOUT_VALUE) then
+         return False;
+      end if;
+
+      PN532_Read_Data (Reply, Reply_Len, Ok);
+      if not Ok or Reply_Len = 0 then -- Some error
+         return False;
+      end if;
+
+      if Reply (2) /= 0 then
+         -- AVR.UART.Put ("PN532 error code: ");
+         -- AVR.UART.Put (Data => Reply (2), Base => 16);
+         -- AVR.UART.CRLF;
+         return False;
+      end if;
+
+      return True;
+   end PN532_Set_Data;
+
+   Null_Buf : constant PN532_Buf (1..0) := (others => 0);
+
+   function PN532_Set_Data (Buf : PN532_Buf) return Boolean is
+   begin
+      return PN532_Set_Data(Buf => Buf, Buf2 => Null_Buf);
+   end PN532_Set_Data;
+
+   procedure PN532_Get_Data (Buf : out PN532_Buf;
+                             Len : out Unsigned_8;
+                             Status  : out Boolean)
+   is
+      Cmd : PN532_Buf (1..1) := (1 => PN532_TG_GET_DATA);
+      Ok : Boolean;
+      Reply : PN532_Buf (1..48);
+      Reply_Len : Unsigned_8;
+   begin
+      Ok := PN532_Send_Command (Cmd, PN532_TIMEOUT_VALUE);
+
+      if not Ok then
+         Status := False;
+         return;
+      end if;
+
+      if not PN532_Wait_For_Ready (PN532_TIMEOUT_VALUE) then
+         Status := False;
+         return;
+      end if;
+
+      PN532_Read_Data (Reply, Reply_Len, Ok);
+      if not Ok or Reply_Len = 0 then -- Some error
+         Status := False;
+         return;
+      end if;
+
+      if Reply (2) /= 0 then
+         -- AVR.UART.Put ("PN532 error code: ");
+         -- AVR.UART.Put (Data => Reply (2), Base => 16);
+         -- AVR.UART.CRLF;
+         Status := False;
+         return;
+      end if;
+
+      Len := Reply_Len - 3;
+
+      Buf (1 .. Len) := Reply (3 .. 3 + Len);
+      Status := True;
+   end PN532_Get_Data;
+
+   Init_Cmd : constant PN532_Buf :=
+     (PN532_TG_INIT_AS_TARGET,
+      16#05#,         -- 4h = ISO/IEC 14443-4A only
+      16#04#, 16#00#, -- sens res
+      16#12#, 16#34#, 16#46#, -- NFCID1
+      16#20#,         -- sel res
+      16#01#, 16#FE#,
+      16#A2#, 16#A3#, 16#A4#,
+      16#A6#, 16#A7#, 16#A8#,
+      16#C0#, 16#C1#, 16#C2#,
+      16#C3#, 16#C4#, 16#C5#,
+      16#C6#, 16#C7#, 16#FF#,
+      16#FF#,
+      16#AA#, 16#99#, 16#88#, -- NFCID3t
+      16#77#, 16#66#, 16#55#, 16#44#,
+      16#33#, 16#22#, 16#11#,
+      16#00#, -- Length of historical bytes
+      16#00#  -- Length of general bytes
+      );
+
+   Init_Cmd_PM : Buf_In_Progmem := (Init_Cmd'Length, Init_Cmd);
+   pragma Linker_Section (Init_Cmd_PM, ".progmem");
+
+   function PN532_Init_As_Target return Boolean is
+      use type System.Address;
+
+      Data  : PN532_Buf (1..40);
+      Len   : Unsigned_8;
+      Ok    : Boolean;
+   begin
+      Len := AVR.Programspace.Get_Byte (Init_Cmd_PM'Address);
+      for I in Unsigned_8 range 1..Len loop
+         Data (I) := AVR.Programspace.Get_Byte
+           (Init_Cmd_PM'Address + System.Address (I));
+      end loop;
+
+      Ok := PN532_Send_Command (Data (1..Len), PN532_TIMEOUT_VALUE);
+
+      if not Ok then
+         return False;
+      end if;
+
+      if not PN532_Wait_For_Ready (PN532_TIMEOUT_VALUE) then
+         return False;
+      end if;
+
+      PN532_Read_Data (Data, Len, Ok);
+      if not Ok or Len = 0 then -- Some error
+         return False;
+      end if;
+
+      if Data (2) /= 16#08# then
+         -- AVR.UART.Put ("Unsupported mode ");
+         -- AVR.UART.Put (Data => Reply (2), Base => 16);
+         -- AVR.UART.CRLF;
+         return False;
+      end if;
+
+      return True;
+   end PN532_Init_As_Target;
+
+   function PN532_Send_R_APDU (SW1 : Unsigned_8; SW2 : Unsigned_8) return Boolean is
+      Cmd : PN532_Buf (1..2) := (SW1, SW2);
+   begin
+      return PN532_Set_Data (Cmd);
+   end PN532_Send_R_APDU;
+
+   APDU_SELECT_FILE : constant := 16#A4#;
+   APDU_READ_BINARY : constant := 16#B0#;
+
+   type Current_File_Type is (FILE_NONE, FILE_CC, FILE_NDEF);
+   Current_File : Current_File_Type := FILE_NONE;
+
+   CC_Reply : constant PN532_Buf (1..17) :=
+     (16#00#, 16#0F#, 16#20#, 16#00#,
+      16#3B#, 16#00#, 16#34#, 16#04#,
+      16#06#, 16#E1#, 16#04#, 16#00#,
+      16#32#, 16#00#, 16#00#,
+      16#90#, 16#00#);
+
+   procedure Handle_Select_File (P1 : Unsigned_8; P2 : Unsigned_8;Rest : PN532_Buf) is
+      Ok : Boolean;
+   begin
+      if P1 = 4 and P2 = 0 then -- select by name
+         if Rest'Length > 3 then
+            if Rest (Rest'First) = 7 and Rest (Rest'First + 1 .. Rest'Last - 1) =
+              (16#D2#, 16#76#,16#00#,16#00#,16#85#,16#01#,16#01#)
+            then
+               if not PN532_Send_R_APDU (16#90#, 16#00#) then
+                  null; -- ignore the error for now
+               end if;
+               return;
+            end if;
+         end if;
+
+         if not PN532_Send_R_APDU (16#6D#, 16#00#) then
+            null; -- ignore the error
+         end if;
+         return;
+      elsif P1 = 0 then -- select by id
+         if P2 = 16#0C# and Rest = (16#02#, 16#E1#, 16#03#) then
+            Ok := PN532_Send_R_APDU (16#90#, 16#00#);
+            Current_File := FILE_CC;
+            return;
+         elsif P2 = 16#0C# and Rest = (16#02#, 16#E1#, 16#04#) then
+            Ok := PN532_Send_R_APDU (16#90#, 16#00#);
+            Current_File := FILE_NDEF;
+            return;
+         else
+            Ok := PN532_Send_R_APDU (16#90#, 16#00#);
+            return;
+         end if;
+      end if;
+
+      if not PN532_Send_R_APDU (16#6D#, 16#00#) then
+         null;
+      end if;
+   end Handle_Select_File;
+
+   procedure PN532_NFC_Forum_Type_4_Emulate (NDEF_Message : PN532_Buf;
+                                             Status : out Boolean)
+   is
+      Data : PN532_Buf (1..32);
+      Data_Len : Unsigned_8;
+      Offset : Unsigned_16;
+      Ok : Boolean;
+      NDEF_Read_Binary_Done : Boolean := False;
+   begin
+      if not PN532_Init_As_Target then
+         Status := False;
+         return;
+      end if;
+
+      delay 0.2;
+
+      loop
+         PN532_Get_Data (Data, Data_Len, Ok);
+         if not Ok then
+            Status := NDEF_Read_Binary_Done;
+            return;
+         end if;
+
+         if Data (1) = 0 then
+            case Data (2) is
+               when APDU_SELECT_FILE =>
+                  if Data_Len > 5 then
+                     Handle_Select_File (Data (3), Data (4), Data (5..Data_Len));
+                  else
+                     -- Log ("short apdu");
+                     Ok := PN532_Send_R_APDU (16#6D#, 16#00#);
+                  end if;
+               when APDU_READ_BINARY =>
+                  if Current_File = FILE_CC then
+                     Ok := PN532_Set_Data (CC_Reply);
+                  elsif Current_File = FILE_NDEF and Data_Len >= 5 then
+                     Offset := Unsigned_16 (Data (3)) * 256 + Unsigned_16 (Data (4));
+                     if NDEF_Message'First + Unsigned_8 (Offset)
+                       + Data (5) - 1 <= NDEF_Message'Last
+                     then
+                        Ok := PN532_Set_Data
+                             (Buf  => NDEF_Message
+                                      (NDEF_Message'First + Unsigned_8 (Offset) ..
+                                        NDEF_Message'First + Unsigned_8 (Offset) + Data (5) - 1),
+                              Buf2 => (16#90#, 16#00#));
+                     else
+                        Ok := PN532_Send_R_APDU (16#6D#, 16#00#);
+                     end if;
+                     NDEF_Read_Binary_Done := True;
+                  else
+                     Ok := PN532_Send_R_APDU (16#6D#, 16#00#);
+                  end if;
+               when others =>
+                  -- Log ("Unsupp. ins");
+                  -- instruction not supported, or invalid
+                  Ok := PN532_Send_R_APDU (16#6D#, 16#00#);
+                  Status := False;
+                  return;
+            end case;
+         else
+            if not PN532_Send_R_APDU (16#6E#, 16#00#) then -- class not supported
+               -- Log ("PN532_Send_R_APDU failed");
+               Status := False;
+               return;
+            end if;
+         end if;
+      end loop;
+   end PN532_NFC_Forum_Type_4_Emulate;
+
+   procedure Init is
+      Empty_Buf : AVR.I2C.Data_Buffer (1 .. 1) := (1 => 16#55#);
+   begin
+      Log ("PN532.Init");
+      AVR.I2C.Master.Init;
+      
+      AVR.MCU.DDRD_Bits (6) := DD_Output;
+      AVR.MCU.DDRD_Bits (3) := DD_Output; -- Reset pin
+      AVR.MCU.DDRD_Bits (2) := DD_Input; -- IRQ, digital pin 2
+      AVR.MCU.PORTD_Bits (3) := True;
+      AVR.MCU.PORTD_Bits (3) := False;
+      AVR.MCU.PORTD_Bits (6) := False;
+      delay 0.4;
+      AVR.MCU.PORTD_Bits (6) := True;
+      AVR.MCU.PORTD_Bits (3) := True;
+      
+      Log ("PN532.Init done");
+   end Init;
+end PN532_TWI;

          
A => pn532_twi.ads +81 -0
@@ 0,0 1,81 @@ 
+-- PN532/NFC routines using AVR-Ada
+--
+-- Copyright (c) 2015 Tero Koskinen <tero.koskinen@iki.fi>
+--
+-- Permission to use, copy, modify, and distribute this software for any
+-- purpose with or without fee is hereby granted, provided that the above
+-- copyright notice and this permission notice appear in all copies.
+--
+-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+--
+
+with Interfaces;
+
+package PN532_TWI is
+   type PN532_Buf is array
+     (Interfaces.Unsigned_8 range <>) of Interfaces.Unsigned_8;
+
+   subtype PN532_Buf_4 is PN532_Buf (1..4);
+   subtype PN532_Buf_6 is PN532_Buf (1..6);
+
+   subtype NFC_Forum_Type_2_Block is Interfaces.Unsigned_8 range 0 .. 63;
+   subtype Mifare_Classic_Block is Interfaces.Unsigned_8 range 0 .. 255;
+
+   type Mifare_Auth is (AUTH_A, AUTH_B);
+
+   CAPABILITY_CONTAINER_FILE : constant := 16#E103#;
+
+   procedure Init;
+
+   function PN532_SAM_Config return Boolean;
+   function PN532_Read_Firmware return Interfaces.Unsigned_32;
+   procedure PN532_Detect_Tag
+     (Sens_Res : out Interfaces.Unsigned_16;
+      Sel_Res  : out Interfaces.Unsigned_8;
+      NFC_ID  : out PN532_Buf;
+      NFC_ID_Len : out Interfaces.Unsigned_8;
+      Status   : out Boolean);
+
+   procedure PN532_Authenticate_Mifare_Classic_Tag_Block
+      (Block_Number : Mifare_Classic_Block;
+       UID          : PN532_Buf;
+       Key          : Mifare_Auth;
+       Key_Data     : PN532_Buf_6;
+       Status       : out Boolean);
+
+   procedure PN532_Read_NFC_Forum_Type_2_Tag_Block
+     (Block      : NFC_Forum_Type_2_Block;
+      Buf        : out PN532_Buf;
+      Byte_Count : out Interfaces.Unsigned_8;
+      Status     : out Boolean);
+
+   procedure PN532_Write_NFC_Forum_Type_2_Tag_Block
+     (Block_Number : NFC_Forum_Type_2_Block;
+      Buf          : PN532_Buf_4;
+      Status       : out Boolean);
+
+   function PN532_NFC_Forum_Type_4_Select_Application return Boolean;
+
+   function PN532_NFC_Forum_Type_4_Select_File
+     (File_ID : Interfaces.Unsigned_16) return Boolean;
+
+   procedure PN532_NFC_Forum_Type_4_Read_Binary
+     (Offset     : Interfaces.Unsigned_16;
+      Buf        : out PN532_Buf;
+      Byte_Count : out Interfaces.Unsigned_8;
+      Status     : out Boolean);
+
+   procedure PN532_NFC_Forum_Type_4_Emulate (NDEF_Message : PN532_Buf;
+                                             Status : out Boolean);
+
+   procedure PN532_NFC_Forum_Type_4_Update_Binary
+     (Offset : Interfaces.Unsigned_16;
+      Buf    : PN532_Buf;
+      Status : out Boolean);
+end PN532_TWI;