@@ 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;
@@ 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;