diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/c_asndfile.c | 4 | ||||
| -rw-r--r-- | src/c_asndfile.h | 3 | ||||
| -rw-r--r-- | src/libsndfile-commands.adb | 210 | ||||
| -rw-r--r-- | src/libsndfile-virtual.adb | 60 | ||||
| -rw-r--r-- | src/libsndfile-virtual.ads | 22 | ||||
| -rw-r--r-- | src/libsndfile.adb | 123 | ||||
| -rw-r--r-- | src/libsndfile.ads | 58 |
7 files changed, 245 insertions, 235 deletions
diff --git a/src/c_asndfile.c b/src/c_asndfile.c index 116fa0c..5424c91 100644 --- a/src/c_asndfile.c +++ b/src/c_asndfile.c @@ -105,6 +105,10 @@ const int err_malformed_file = SF_ERR_MALFORMED_FILE; const int err_unsupported_encoding = SF_ERR_UNSUPPORTED_ENCODING; +size_t c_pointer_size() { + return sizeof(void*); +} + SNDFILE * asf_open(const char * path, int mode, Asf_Info * sfinfo) { SF_INFO actual; diff --git a/src/c_asndfile.h b/src/c_asndfile.h index 8c2a173..4ff7606 100644 --- a/src/c_asndfile.h +++ b/src/c_asndfile.h @@ -106,6 +106,9 @@ extern const int err_malformed_file; extern const int err_unsupported_encoding; +size_t c_pointer_size(); + + typedef struct { int64_t frames; int samplerate; diff --git a/src/libsndfile-commands.adb b/src/libsndfile-commands.adb index 4ccfb28..5338a7b 100644 --- a/src/libsndfile-commands.adb +++ b/src/libsndfile-commands.adb @@ -9,10 +9,8 @@ pragma Ada_2012; with - Ada.Assertions, Ada.Strings.Fixed, - Interfaces.C.Strings, - System; + Interfaces.C; use type @@ -225,33 +223,33 @@ package body Libsndfile.Commands is ------------------------ function sf_command - (File : in System.Address; + (File : in Storage.Integer_Address; Cmd : in Interfaces.C.int; - Data : in System.Address; + Data : in Storage.Integer_Address; Size : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, sf_command, "sf_command"); function asfc_get_current_sf_info - (File : in System.Address; - Info : out File_Info) + (File : in Storage.Integer_Address; + Info : out C_File_Info) return Interfaces.C.int; pragma Import (C, asfc_get_current_sf_info, "asfc_get_current_sf_info"); function asfc_file_truncate - (File : in System.Address; + (File : in Storage.Integer_Address; Pos : in Interfaces.Integer_64) return Interfaces.C.int; pragma Import (C, asfc_file_truncate, "asfc_file_truncate"); function asfc_set_raw_start_offset - (File : in System.Address; + (File : in Storage.Integer_Address; Pos : in Interfaces.Integer_64) return Interfaces.C.int; pragma Import (C, asfc_set_raw_start_offset, "asfc_set_raw_start_offset"); function asfc_get_embed_file_info - (File : in System.Address; + (File : in Storage.Integer_Address; Info : in out C_Embedded_Info) return Interfaces.C.int; pragma Import (C, asfc_get_embed_file_info, "asfc_get_embed_file_info"); @@ -303,7 +301,7 @@ package body Libsndfile.Commands is (Info : in Format_Info) return Major_Format is - Raw : Interfaces.Unsigned_32 := + Raw : constant Interfaces.Unsigned_32 := Interfaces.Unsigned_32 (Info.C_Data.My_Format) and sf_format_typemask; begin return To_Major (Interfaces.C.int (Raw)); @@ -313,7 +311,7 @@ package body Libsndfile.Commands is (Info : in Format_Info) return Minor_Format is - Raw : Interfaces.Unsigned_32 := + Raw : constant Interfaces.Unsigned_32 := Interfaces.Unsigned_32 (Info.C_Data.My_Format) and sf_format_submask; begin return To_Minor (Interfaces.C.int (Raw)); @@ -323,7 +321,7 @@ package body Libsndfile.Commands is (Info : in Format_Info) return Endianness is - Raw : Interfaces.Unsigned_32 := + Raw : constant Interfaces.Unsigned_32 := Interfaces.Unsigned_32 (Info.C_Data.My_Format) and sf_format_endmask; begin return To_Endian (Interfaces.C.int (Raw)); @@ -416,9 +414,9 @@ package body Libsndfile.Commands is return Natural is begin return Natural (sf_command - (System.Null_Address, + (Null_Pointer, sfc_get_lib_version, - Buffer'Address, + Storage.To_Integer (Buffer'Address), Buffer'Length)); end Get_Library_String; @@ -430,7 +428,7 @@ package body Libsndfile.Commands is return Natural (sf_command (File.Ptr, sfc_get_log_info, - Buffer'Address, + Storage.To_Integer (Buffer'Address), Buffer'Length)); end Get_Log_Info; @@ -441,7 +439,7 @@ package body Libsndfile.Commands is Result : File_Info; Code : Interfaces.C.int; begin - Code := asfc_get_current_sf_info (File.Ptr, Result); + Code := asfc_get_current_sf_info (File.Ptr, Result.Data); if Code /= 0 then Raise_Error (Code); raise Program_Error; @@ -460,7 +458,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_calc_signal_max, - Result'Address, + Storage.To_Integer (Result'Address), Interfaces.C.double'Size / Interfaces.C.CHAR_BIT); if Code /= 0 then Raise_Error (Code); @@ -480,7 +478,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_calc_norm_signal_max, - Result'Address, + Storage.To_Integer (Result'Address), Interfaces.C.double'Size / Interfaces.C.CHAR_BIT); if Code /= 0 then Raise_Error (Code); @@ -497,11 +495,10 @@ package body Libsndfile.Commands is Result : Long_Float_Array (1 .. Natural (File.Chans)); Code : Interfaces.C.int; begin - Ada.Assertions.Assert (Long_Float'Size = Interfaces.C.double'Size); Code := sf_command (File.Ptr, sfc_calc_max_all_channels, - Result'Address, + Storage.To_Integer (Result'Address), Interfaces.C.double'Size / Interfaces.C.CHAR_BIT * File.Chans); if Code /= 0 then Raise_Error (Code); @@ -518,11 +515,10 @@ package body Libsndfile.Commands is Result : Long_Float_Array (1 .. Natural (File.Chans)); Code : Interfaces.C.int; begin - Ada.Assertions.Assert (Long_Float'Size = Interfaces.C.double'Size); Code := sf_command (File.Ptr, sfc_calc_norm_max_all_channels, - Result'Address, + Storage.To_Integer (Result'Address), Interfaces.C.double'Size / Interfaces.C.CHAR_BIT * File.Chans); if Code /= 0 then Raise_Error (Code); @@ -542,7 +538,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_get_signal_max, - Result'Address, + Storage.To_Integer (Result'Address), Interfaces.C.double'Size / Interfaces.C.CHAR_BIT); if Code = sf_false then raise Command_Error; @@ -563,7 +559,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_get_max_all_channels, - Result'Address, + Storage.To_Integer (Result'Address), Interfaces.C.double'Size / Interfaces.C.CHAR_BIT * File.Chans); if Code = sf_false then raise Command_Error; @@ -578,26 +574,26 @@ package body Libsndfile.Commands is (File : in Sound_File; Value : in Boolean) is - Code : Interfaces.C.int; - begin - Code := sf_command + Ignore : Interfaces.C.int := sf_command (File.Ptr, sfc_set_norm_float, - System.Null_Address, + Null_Pointer, (if Value then sf_true else sf_false)); + begin + null; end Set_Normed_Float; procedure Set_Normed_Double (File : in Sound_File; Value : in Boolean) is - Code : Interfaces.C.int; - begin - Code := sf_command + Ignore : Interfaces.C.int := sf_command (File.Ptr, sfc_set_norm_double, - System.Null_Address, + Null_Pointer, (if Value then sf_true else sf_false)); + begin + null; end Set_Normed_Double; function Get_Normed_Float @@ -609,7 +605,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_get_norm_float, - System.Null_Address, + Null_Pointer, 0); if Code = sf_true then return True; @@ -629,7 +625,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_get_norm_double, - System.Null_Address, + Null_Pointer, 0); if Code = sf_true then return True; @@ -644,37 +640,37 @@ package body Libsndfile.Commands is (File : in Sound_File; Value : in Boolean) is - Code : Interfaces.C.int; - begin - Code := sf_command + Ignore : Interfaces.C.int := sf_command (File.Ptr, sfc_set_scale_float_int_read, - System.Null_Address, + Null_Pointer, (if Value then sf_true else sf_false)); + begin + null; end Set_Scale_Float_Integer_Read; procedure Set_Scale_Integer_Float_Write (File : in Sound_File; Value : in Boolean) is - Code : Interfaces.C.int; - begin - Code := sf_command + Ignore : Interfaces.C.int := sf_command (File.Ptr, sfc_set_scale_int_float_write, - System.Null_Address, + Null_Pointer, (if Value then sf_true else sf_false)); + begin + null; end Set_Scale_Integer_Float_Write; function Get_Simple_Format_Count return Natural is - Result, Code : Interfaces.C.int; + Result, Ignore : Interfaces.C.int; begin - Code := sf_command - (System.Null_Address, + Ignore := sf_command + (Null_Pointer, sfc_get_simple_format_count, - Result'Address, + Storage.To_Integer (Result'Address), Interfaces.C.int'Size / Interfaces.C.CHAR_BIT); if Result < 0 then raise Program_Error; @@ -694,9 +690,9 @@ package body Libsndfile.Commands is Code : Interfaces.C.int; begin Code := sf_command - (System.Null_Address, + (Null_Pointer, sfc_get_simple_format, - Raw'Address, + Storage.To_Integer (Raw'Address), C_Format_Info'Size / Interfaces.C.CHAR_BIT); if Code /= 0 then raise Command_Error; @@ -716,9 +712,9 @@ package body Libsndfile.Commands is Code : Interfaces.C.int; begin Code := sf_command - (System.Null_Address, + (Null_Pointer, sfc_get_format_info, - Raw'Address, + Storage.To_Integer (Raw'Address), C_Format_Info'Size / Interfaces.C.CHAR_BIT); if Code /= 0 then raise Command_Error; @@ -744,12 +740,12 @@ package body Libsndfile.Commands is function Get_Format_Major_Count return Natural is - Result, Code : Interfaces.C.int; + Result, Ignore : Interfaces.C.int; begin - Code := sf_command - (System.Null_Address, + Ignore := sf_command + (Null_Pointer, sfc_get_format_major_count, - Result'Address, + Storage.To_Integer (Result'Address), Interfaces.C.int'Size / Interfaces.C.CHAR_BIT); return Natural (Result); end Get_Format_Major_Count; @@ -765,9 +761,9 @@ package body Libsndfile.Commands is Code : Interfaces.C.int; begin Code := sf_command - (System.Null_Address, + (Null_Pointer, sfc_get_format_major, - Raw'Address, + Storage.To_Integer (Raw'Address), C_Format_Info'Size / Interfaces.C.CHAR_BIT); if Code /= 0 then raise Command_Error; @@ -779,12 +775,12 @@ package body Libsndfile.Commands is function Get_Format_Subtype_Count return Natural is - Result, Code : Interfaces.C.int; + Result, Ignore : Interfaces.C.int; begin - Code := sf_command - (System.Null_Address, + Ignore := sf_command + (Null_Pointer, sfc_get_format_subtype_count, - Result'Address, + Storage.To_Integer (Result'Address), Interfaces.C.int'Size / Interfaces.C.CHAR_BIT); return Natural (Result); end Get_Format_Subtype_Count; @@ -800,9 +796,9 @@ package body Libsndfile.Commands is Code : Interfaces.C.int; begin Code := sf_command - (System.Null_Address, + (Null_Pointer, sfc_get_format_subtype, - Raw'Address, + Storage.To_Integer (Raw'Address), C_Format_Info'Size / Interfaces.C.CHAR_BIT); if Code /= 0 then raise Command_Error; @@ -815,38 +811,38 @@ package body Libsndfile.Commands is (File : in Sound_File; Value : in Boolean) is - Code : Interfaces.C.int; - begin - Code := sf_command + Ignore : Interfaces.C.int := sf_command (File.Ptr, sfc_set_add_peak_chunk, - System.Null_Address, + Null_Pointer, (if Value then sf_true else sf_false)); + begin + null; end Set_Add_Peak_Chunk; procedure Update_Header_Now (File : in Sound_File) is - Code : Interfaces.C.int; - begin - Code := sf_command + Ignore : Interfaces.C.int := sf_command (File.Ptr, sfc_update_header_now, - System.Null_Address, + Null_Pointer, 0); + begin + null; end Update_Header_Now; procedure Set_Update_Header_Auto (File : in Sound_File; Value : in Boolean) is - Code : Interfaces.C.int; - begin - Code := sf_command + Ignore : Interfaces.C.int := sf_command (File.Ptr, sfc_set_update_header_auto, - System.Null_Address, + Null_Pointer, (if Value then sf_true else sf_false)); + begin + null; end Set_Update_Header_Auto; procedure File_Truncate @@ -877,13 +873,13 @@ package body Libsndfile.Commands is (File : in Sound_File; Value : in Boolean) is - Code : Interfaces.C.int; - begin - Code := sf_command + Ignore : Interfaces.C.int := sf_command (File.Ptr, sfc_set_clipping, - System.Null_Address, + Null_Pointer, (if Value then sf_true else sf_false)); + begin + null; end Set_Clipping; function Get_Clipping @@ -895,7 +891,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_get_clipping, - System.Null_Address, + Null_Pointer, 0); if Code = sf_true then return True; @@ -932,7 +928,7 @@ package body Libsndfile.Commands is Result := sf_command (File.Ptr, sfc_wavex_get_ambisonic, - System.Null_Address, + Null_Pointer, 0); if Result = 0 then return Ambisonic_Unsupported; @@ -962,7 +958,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_wavex_set_ambisonic, - System.Null_Address, + Null_Pointer, My_Value); if Code = 0 then raise Command_Error; @@ -982,7 +978,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_set_vbr_encoding_quality, - My_Value'Address, + Storage.To_Integer (My_Value'Address), Interfaces.C.double'Size / Interfaces.C.CHAR_BIT); if Code = sf_false then raise Command_Error; @@ -1002,7 +998,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_set_ogg_page_latency_ms, - My_Value'Address, + Storage.To_Integer (My_Value'Address), Interfaces.C.double'Size / Interfaces.C.CHAR_BIT); if Code /= 0 then raise Command_Error; @@ -1019,7 +1015,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_get_ogg_stream_serialno, - Result'Address, + Storage.To_Integer (Result'Address), Interfaces.Integer_32'Size / Interfaces.C.CHAR_BIT); if Code = 0 then return Integer (Result); @@ -1039,7 +1035,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_set_compression_level, - My_Value'Address, + Storage.To_Integer (My_Value'Address), Interfaces.C.double'Size / Interfaces.C.CHAR_BIT); if Code = sf_false then raise Command_Error; @@ -1057,7 +1053,7 @@ package body Libsndfile.Commands is Result := sf_command (File.Ptr, sfc_raw_data_needs_endswap, - System.Null_Address, + Null_Pointer, 0); if Result = sf_true then return True; @@ -1078,7 +1074,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_get_broadcast_info, - Raw'Address, + Storage.To_Integer (Raw'Address), C_Broadcast_Info'Size / Interfaces.C.CHAR_BIT); if Code = sf_true then return Result : Broadcast_Info do @@ -1125,7 +1121,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_set_broadcast_info, - C_Data'Address, + Storage.To_Integer (C_Data'Address), C_Broadcast_Info'Size / Interfaces.C.CHAR_BIT); if Code = sf_false then raise Command_Error; @@ -1145,7 +1141,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_get_channel_map_info, - Raw'Address, + Storage.To_Integer (Raw'Address), Interfaces.C.int'Size / Interfaces.C.CHAR_BIT * File.Chans); if Code = sf_false then raise Command_Error; @@ -1175,7 +1171,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_set_channel_map_info, - My_Value'Address, + Storage.To_Integer (My_Value'Address), Interfaces.C.int'Size / Interfaces.C.CHAR_BIT * File.Chans); if Code = sf_false then raise Command_Error; @@ -1194,7 +1190,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_get_cart_info, - Raw'Address, + Storage.To_Integer (Raw'Address), Raw'Size / Interfaces.C.CHAR_BIT); if Code = sf_false then raise Command_Error; @@ -1270,7 +1266,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_set_cart_info, - C_Data'Address, + Storage.To_Integer (C_Data'Address), C_Data'Size / Interfaces.C.CHAR_BIT); if Code = sf_false then raise Command_Error; @@ -1289,7 +1285,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_get_loop_info, - Raw'Address, + Storage.To_Integer (Raw'Address), C_Loop_Info'Size / Interfaces.C.CHAR_BIT); if Code = sf_false then raise Command_Error; @@ -1320,7 +1316,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_get_instrument, - Result.C_Data'Address, + Storage.To_Integer (Result.C_Data'Address), C_Instrument_Info'Size / Interfaces.C.CHAR_BIT); if Code = sf_false then raise Command_Error; @@ -1340,7 +1336,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_set_instrument, - Info.C_Data'Address, + Storage.To_Integer (Info.C_Data'Address), C_Instrument_Info'Size / Interfaces.C.CHAR_BIT); if Code = sf_false then raise Command_Error; @@ -1359,7 +1355,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_get_cue_count, - Result'Address, + Storage.To_Integer (Result'Address), Interfaces.Unsigned_32'Size / Interfaces.C.CHAR_BIT); if Code = sf_false then raise Command_Error; @@ -1380,7 +1376,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_get_cue, - Raw'Address, + Storage.To_Integer (Raw'Address), C_Cue_Info'Size / Interfaces.C.CHAR_BIT); if Code = sf_false then raise Command_Error; @@ -1429,7 +1425,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_set_cue, - C_Data'Address, + Storage.To_Integer (C_Data'Address), C_Cue_Info'Size / Interfaces.C.CHAR_BIT); if Code = sf_false then raise Command_Error; @@ -1442,13 +1438,13 @@ package body Libsndfile.Commands is (File : in Sound_File; Value : in Boolean) is - Code : Interfaces.C.int; - begin - Code := sf_command + Ignore : Interfaces.C.int := sf_command (File.Ptr, sfc_rf64_auto_downgrade, - System.Null_Address, + Null_Pointer, (if Value then sf_true else sf_false)); + begin + null; end RF64_Auto_Downgrade; function Get_Original_Samplerate @@ -1460,7 +1456,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_get_original_samplerate, - Result'Address, + Storage.To_Integer (Result'Address), Interfaces.C.int'Size / Interfaces.C.CHAR_BIT); if Code = sf_true then return Natural (Result); @@ -1479,7 +1475,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_set_original_samplerate, - My_Value'Address, + Storage.To_Integer (My_Value'Address), Interfaces.C.int'Size / Interfaces.C.CHAR_BIT); if Code = sf_false then raise Command_Error; @@ -1497,7 +1493,7 @@ package body Libsndfile.Commands is Result := sf_command (File.Ptr, sfc_get_bitrate_mode, - System.Null_Address, + Null_Pointer, 0); if Result = sf_bitrate_mode_constant then return Constant_Mode; @@ -1525,7 +1521,7 @@ package body Libsndfile.Commands is Code := sf_command (File.Ptr, sfc_set_bitrate_mode, - My_Value'Address, + Storage.To_Integer (My_Value'Address), Interfaces.C.int'Size / Interfaces.C.CHAR_BIT); if Code = sf_false then raise Command_Error; diff --git a/src/libsndfile-virtual.adb b/src/libsndfile-virtual.adb index 260be7d..1aae30b 100644 --- a/src/libsndfile-virtual.adb +++ b/src/libsndfile-virtual.adb @@ -14,8 +14,7 @@ with use type - Interfaces.C.int, - System.Address; + Interfaces.C.int; package body Libsndfile.Virtual is @@ -32,9 +31,9 @@ package body Libsndfile.Virtual is function asf_open_virtual (Mode : in Interfaces.C.int; - Sfinfo : in out File_Info; - Data : in System.Address) - return System.Address; + Sfinfo : in out C_File_Info; + Data : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, asf_open_virtual, "asf_open_virtual"); @@ -45,11 +44,11 @@ package body Libsndfile.Virtual is ---------------------- function Ada_Filelen_Hook - (Data : in System.Address) + (Data : in Storage.Integer_Address) return Interfaces.Integer_64 is - Virtual : Virt_Conversions.Object_Pointer := - Virt_Conversions.To_Pointer (Data); + Virtual : constant Virt_Conversions.Object_Pointer := + Virt_Conversions.To_Pointer (Storage.To_Address (Data)); begin return Interfaces.Integer_64 (Virtual.My_Length.all); end Ada_Filelen_Hook; @@ -58,11 +57,11 @@ package body Libsndfile.Virtual is function Ada_Seek_Hook (Offset : in Interfaces.Integer_64; Whence : in Interfaces.C.int; - Data : in System.Address) + Data : in Storage.Integer_Address) return Interfaces.Integer_64 is - Virtual : Virt_Conversions.Object_Pointer := - Virt_Conversions.To_Pointer (Data); + Virtual : constant Virt_Conversions.Object_Pointer := + Virt_Conversions.To_Pointer (Storage.To_Address (Data)); My_Whence : Seek_From; begin if Whence = sf_seek_set then @@ -79,15 +78,15 @@ package body Libsndfile.Virtual is function Ada_Read_Hook - (Ptr : in System.Address; + (Ptr : in Storage.Integer_Address; Count : in Interfaces.Integer_64; - Data : in System.Address) + Data : in Storage.Integer_Address) return Interfaces.Integer_64 is - Virtual : Virt_Conversions.Object_Pointer := - Virt_Conversions.To_Pointer (Data); + Virtual : constant Virt_Conversions.Object_Pointer := + Virt_Conversions.To_Pointer (Storage.To_Address (Data)); Buffer : Raw_Data (1 .. Integer (Count)); - for Buffer'Address use Ptr; + for Buffer'Address use Storage.To_Address (Ptr); pragma Import (Ada, Buffer); begin return Interfaces.Integer_64 (Virtual.My_Read (Buffer, Count_Type (Count))); @@ -95,15 +94,15 @@ package body Libsndfile.Virtual is function Ada_Write_Hook - (Ptr : in System.Address; + (Ptr : in Storage.Integer_Address; Count : in Interfaces.Integer_64; - Data : in System.Address) + Data : in Storage.Integer_Address) return Interfaces.Integer_64 is - Virtual : Virt_Conversions.Object_Pointer := - Virt_Conversions.To_Pointer (Data); + Virtual : constant Virt_Conversions.Object_Pointer := + Virt_Conversions.To_Pointer (Storage.To_Address (Data)); Buffer : Raw_Data (1 .. Integer (Count)); - for Buffer'Address use Ptr; + for Buffer'Address use Storage.To_Address (Ptr); pragma Import (Ada, Buffer); begin return Interfaces.Integer_64 (Virtual.My_Write (Buffer, Count_Type (Count))); @@ -111,11 +110,11 @@ package body Libsndfile.Virtual is function Ada_Tell_Hook - (Data : in System.Address) + (Data : in Storage.Integer_Address) return Interfaces.Integer_64 is - Virtual : Virt_Conversions.Object_Pointer := - Virt_Conversions.To_Pointer (Data); + Virtual : constant Virt_Conversions.Object_Pointer := + Virt_Conversions.To_Pointer (Storage.To_Address (Data)); begin return Interfaces.Integer_64 (Virtual.My_Tell.all); end Ada_Tell_Hook; @@ -130,32 +129,33 @@ package body Libsndfile.Virtual is procedure Open (File : in out Virtual_Sound_File; Mode : in File_Mode; - Info : in out File_Info; + Info : in out File_Info'Class; Length : in File_Length_Function; Seek : in Seek_Function; Read : in Read_Function; Write : in Write_Function; Tell : in Tell_Function) is - Mode_Int : Interfaces.C.int := (case Mode is + Mode_Int : constant Interfaces.C.int := (case Mode is when Read_Only => sfm_read, when Write_Only => sfm_write, when Read_Write => sfm_rdwr); - Result : System.Address; + Result : Storage.Integer_Address; begin File.My_Virtual.My_Length := Length; File.My_Virtual.My_Seek := Seek; File.My_Virtual.My_Read := Read; File.My_Virtual.My_Write := Write; File.My_Virtual.My_Tell := Tell; - Result := asf_open_virtual (Mode_Int, Info, File.My_Virtual'Address); - if Result = System.Null_Address then + Result := asf_open_virtual + (Mode_Int, Info.Data, Storage.To_Integer (File.My_Virtual'Address)); + if Result = Null_Pointer then Raise_Error (sf_error (Result)); raise Program_Error; else File.Ptr := Result; File.FMode := Mode; - File.Chans := Info.My_Channels; + File.Chans := Info.Data.My_Channels; end if; end Open; diff --git a/src/libsndfile-virtual.ads b/src/libsndfile-virtual.ads index 98f88da..d0691b9 100644 --- a/src/libsndfile-virtual.ads +++ b/src/libsndfile-virtual.ads @@ -9,8 +9,7 @@ pragma Ada_2012; private with - Interfaces, - System; + Interfaces; package Libsndfile.Virtual is @@ -53,7 +52,7 @@ package Libsndfile.Virtual is procedure Open (File : in out Virtual_Sound_File; Mode : in File_Mode; - Info : in out File_Info; + Info : in out File_Info'Class; Length : in File_Length_Function; Seek : in Seek_Function; Read : in Read_Function; @@ -74,42 +73,39 @@ private My_Tell : Tell_Function; end record with Convention => C; - type Virtual_Sound_File is new Sound_File with record My_Virtual : Virtual_Data; end record; - - function Ada_Filelen_Hook - (Data : in System.Address) + (Data : in Storage.Integer_Address) return Interfaces.Integer_64; pragma Export (C, Ada_Filelen_Hook, "ada_filelen_hook"); function Ada_Seek_Hook (Offset : in Interfaces.Integer_64; Whence : in Interfaces.C.int; - Data : in System.Address) + Data : in Storage.Integer_Address) return Interfaces.Integer_64; pragma Export (C, Ada_Seek_Hook, "ada_seek_hook"); function Ada_Read_Hook - (Ptr : in System.Address; + (Ptr : in Storage.Integer_Address; Count : in Interfaces.Integer_64; - Data : in System.Address) + Data : in Storage.Integer_Address) return Interfaces.Integer_64; pragma Export (C, Ada_Read_Hook, "ada_read_hook"); function Ada_Write_Hook - (Ptr : in System.Address; + (Ptr : in Storage.Integer_Address; Count : in Interfaces.Integer_64; - Data : in System.Address) + Data : in Storage.Integer_Address) return Interfaces.Integer_64; pragma Export (C, Ada_Write_Hook, "ada_write_hook"); function Ada_Tell_Hook - (Data : in System.Address) + (Data : in Storage.Integer_Address) return Interfaces.Integer_64; pragma Export (C, Ada_Tell_Hook, "ada_tell_hook"); diff --git a/src/libsndfile.adb b/src/libsndfile.adb index 6d12273..80f1d96 100644 --- a/src/libsndfile.adb +++ b/src/libsndfile.adb @@ -9,17 +9,14 @@ pragma Ada_2012; with - Ada.Assertions, - Interfaces.C.Strings, - System; + Interfaces.C.Strings; use type Interfaces.Integer_64, Interfaces.Unsigned_8, Interfaces.C.int, - Interfaces.C.Strings.chars_ptr, - System.Address; + Interfaces.C.Strings.chars_ptr; package body Libsndfile is @@ -280,17 +277,17 @@ package body Libsndfile is function asf_open (Path : in Interfaces.C.char_array; Mode : in Interfaces.C.int; - Sfinfo : in out File_Info) - return System.Address; + Sfinfo : in out C_File_Info) + return Storage.Integer_Address; pragma Import (C, asf_open, "asf_open"); function asf_format_check - (Sfinfo : in File_Info) + (Sfinfo : in C_File_Info) return Interfaces.C.int; pragma Import (C, asf_format_check, "asf_format_check"); function asf_seek - (Sndfile : in System.Address; + (Sndfile : in Storage.Integer_Address; Frames : in Interfaces.Integer_64; Whence : in Interfaces.C.int) return Interfaces.Integer_64; @@ -298,16 +295,16 @@ package body Libsndfile is pragma Inline (asf_seek); function sf_close - (File : in System.Address) + (File : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, sf_close, "sf_close"); procedure sf_write_sync - (File : in System.Address); + (File : in Storage.Integer_Address); pragma Import (C, sf_write_sync, "sf_write_sync"); function asf_readf_short - (File : in System.Address; + (File : in Storage.Integer_Address; DPtr : out C_Short_Data; Items : in Interfaces.Integer_64) return Interfaces.Integer_64; @@ -315,7 +312,7 @@ package body Libsndfile is pragma Inline (asf_readf_short); function asf_readf_int - (File : in System.Address; + (File : in Storage.Integer_Address; DPtr : out C_Integer_Data; Items : in Interfaces.Integer_64) return Interfaces.Integer_64; @@ -323,7 +320,7 @@ package body Libsndfile is pragma Inline (asf_readf_int); function asf_readf_float - (File : in System.Address; + (File : in Storage.Integer_Address; DPtr : out C_Float_Data; Items : in Interfaces.Integer_64) return Interfaces.Integer_64; @@ -331,7 +328,7 @@ package body Libsndfile is pragma Inline (asf_readf_float); function asf_readf_double - (File : in System.Address; + (File : in Storage.Integer_Address; DPtr : out C_Double_Data; Items : in Interfaces.Integer_64) return Interfaces.Integer_64; @@ -339,7 +336,7 @@ package body Libsndfile is pragma Inline (asf_readf_double); function asf_writef_short - (File : in System.Address; + (File : in Storage.Integer_Address; DPtr : in C_Short_Data; Items : in Interfaces.Integer_64) return Interfaces.Integer_64; @@ -347,7 +344,7 @@ package body Libsndfile is pragma Inline (asf_writef_short); function asf_writef_int - (File : in System.Address; + (File : in Storage.Integer_Address; DPtr : in C_Integer_Data; Items : in Interfaces.Integer_64) return Interfaces.Integer_64; @@ -355,7 +352,7 @@ package body Libsndfile is pragma Inline (asf_writef_int); function asf_writef_float - (File : in System.Address; + (File : in Storage.Integer_Address; DPtr : in C_Float_Data; Items : in Interfaces.Integer_64) return Interfaces.Integer_64; @@ -363,7 +360,7 @@ package body Libsndfile is pragma Inline (asf_writef_float); function asf_writef_double - (File : in System.Address; + (File : in Storage.Integer_Address; DPtr : in C_Double_Data; Items : in Interfaces.Integer_64) return Interfaces.Integer_64; @@ -371,29 +368,29 @@ package body Libsndfile is pragma Inline (asf_writef_double); function asf_read_raw - (File : in System.Address; - DPtr : in System.Address; + (File : in Storage.Integer_Address; + DPtr : in Storage.Integer_Address; Bytes : in Interfaces.Integer_64) return Interfaces.Integer_64; pragma Import (C, asf_read_raw, "asf_read_raw"); pragma Inline (asf_read_raw); function asf_write_raw - (File : in System.Address; - DPtr : in System.Address; + (File : in Storage.Integer_Address; + DPtr : in Storage.Integer_Address; Bytes : in Interfaces.Integer_64) return Interfaces.Integer_64; pragma Import (C, asf_write_raw, "asf_write_raw"); pragma Inline (asf_write_raw); function sf_get_string - (File : in System.Address; + (File : in Storage.Integer_Address; Kind : in Interfaces.C.int) return Interfaces.C.Strings.chars_ptr; pragma Import (C, sf_get_string, "sf_get_string"); function sf_set_string - (File : in System.Address; + (File : in Storage.Integer_Address; Kind : in Interfaces.C.int; Str : in Interfaces.C.char_array) return Interfaces.C.int; @@ -404,7 +401,7 @@ package body Libsndfile is pragma Import (C, sf_version_string, "sf_version_string"); function sf_current_byterate - (File : in System.Address) + (File : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, sf_current_byterate, "sf_current_byterate"); @@ -702,14 +699,14 @@ package body Libsndfile is return File_Info is begin return This : File_Info do - This.My_Frames := 0; - This.My_Sample_Rate := Interfaces.C.int (Rate); - This.My_Channels := Interfaces.C.int (Channels); - This.My_Major := To_Cint (Major); - This.My_Minor := To_Cint (Minor); - This.My_Endian := To_Cint (Endian); - This.My_Sections := 0; - This.My_Seekable := 0; + This.Data.My_Frames := 0; + This.Data.My_Sample_Rate := Interfaces.C.int (Rate); + This.Data.My_Channels := Interfaces.C.int (Channels); + This.Data.My_Major := To_Cint (Major); + This.Data.My_Minor := To_Cint (Minor); + This.Data.My_Endian := To_Cint (Endian); + This.Data.My_Sections := 0; + This.Data.My_Seekable := 0; end return; end Create; @@ -717,58 +714,58 @@ package body Libsndfile is (Info : in File_Info) return Count_Type is begin - return Count_Type (Info.My_Frames); + return Count_Type (Info.Data.My_Frames); end Frames; function Rate (Info : in File_Info) return Natural is begin - return Natural (Info.My_Sample_Rate); + return Natural (Info.Data.My_Sample_Rate); end Rate; function Channels (Info : in File_Info) return Natural is begin - return Natural (Info.My_Channels); + return Natural (Info.Data.My_Channels); end Channels; function Major (Info : in File_Info) return Major_Format is begin - return To_Major (Info.My_Major); + return To_Major (Info.Data.My_Major); end Major; function Minor (Info : in File_Info) return Minor_Format is begin - return To_Minor (Info.My_Minor); + return To_Minor (Info.Data.My_Minor); end Minor; function Endian (Info : in File_Info) return Endianness is begin - return To_Endian (Info.My_Endian); + return To_Endian (Info.Data.My_Endian); end Endian; function Sections (Info : in File_Info) return Natural is begin - return Natural (Info.My_Sections); + return Natural (Info.Data.My_Sections); end Sections; function Seekable (Info : in File_Info) return Boolean is begin - if Info.My_Seekable = sf_false then + if Info.Data.My_Seekable = sf_false then return False; - elsif Info.My_Seekable = sf_true then + elsif Info.Data.My_Seekable = sf_true then return True; else raise Program_Error; @@ -786,7 +783,7 @@ package body Libsndfile is (File : in Sound_File) return Boolean is begin - return File.Ptr /= System.Null_Address; + return File.Ptr /= Null_Pointer; end Is_Open; @@ -800,22 +797,22 @@ package body Libsndfile is (File : in out Sound_File; Name : in String; Mode : in File_Mode; - Info : in out File_Info) + Info : in out File_Info'Class) is - Mode_Int : Interfaces.C.int := (case Mode is + Mode_Int : constant Interfaces.C.int := (case Mode is when Read_Only => sfm_read, when Write_Only => sfm_write, when Read_Write => sfm_rdwr); - Result : System.Address; + Result : Storage.Integer_Address; begin - Result := asf_open (Interfaces.C.To_C (Name), Mode_Int, Info); - if Result = System.Null_Address then + Result := asf_open (Interfaces.C.To_C (Name), Mode_Int, Info.Data); + if Result = Null_Pointer then Raise_Error (sf_error (Result)); raise Program_Error; else File.Ptr := Result; File.FMode := Mode; - File.Chans := Info.My_Channels; + File.Chans := Info.Data.My_Channels; end if; end Open; @@ -823,7 +820,7 @@ package body Libsndfile is (Info : in File_Info) return Boolean is - Result : Interfaces.C.int := asf_format_check (Info); + Result : constant Interfaces.C.int := asf_format_check (Info.Data); begin if Result = sf_true then return True; @@ -875,7 +872,7 @@ package body Libsndfile is if Result /= 0 then Raise_Error (Result); else - File.Ptr := System.Null_Address; + File.Ptr := Null_Pointer; end if; end Close; @@ -895,7 +892,6 @@ package body Libsndfile is for Buffer'Address use Data'Address; pragma Import (Ada, Buffer); begin - Ada.Assertions.Assert (Short_Integer'Size = Interfaces.C.short'Size); return Count_Type (asf_readf_short (File.Ptr, Buffer, Interfaces.Integer_64 (Frames))); end Read_Short; @@ -909,7 +905,6 @@ package body Libsndfile is for Buffer'Address use Data'Address; pragma Import (Ada, Buffer); begin - Ada.Assertions.Assert (Integer'Size = Interfaces.C.int'Size); return Count_Type (asf_readf_int (File.Ptr, Buffer, Interfaces.Integer_64 (Frames))); end Read_Integer; @@ -923,7 +918,6 @@ package body Libsndfile is for Buffer'Address use Data'Address; pragma Import (Ada, Buffer); begin - Ada.Assertions.Assert (Float'Size = Interfaces.C.C_float'Size); return Count_Type (asf_readf_float (File.Ptr, Buffer, Interfaces.Integer_64 (Frames))); end Read_Float; @@ -937,7 +931,6 @@ package body Libsndfile is for Buffer'Address use Data'Address; pragma Import (Ada, Buffer); begin - Ada.Assertions.Assert (Long_Float'Size = Interfaces.C.double'Size); return Count_Type (asf_readf_double (File.Ptr, Buffer, Interfaces.Integer_64 (Frames))); end Read_Double; @@ -951,7 +944,6 @@ package body Libsndfile is for Buffer'Address use Data'Address; pragma Import (Ada, Buffer); begin - Ada.Assertions.Assert (Short_Integer'Size = Interfaces.C.short'Size); return Count_Type (asf_writef_short (File.Ptr, Buffer, Interfaces.Integer_64 (Frames))); end Write_Short; @@ -965,7 +957,6 @@ package body Libsndfile is for Buffer'Address use Data'Address; pragma Import (Ada, Buffer); begin - Ada.Assertions.Assert (Integer'Size = Interfaces.C.int'Size); return Count_Type (asf_writef_int (File.Ptr, Buffer, Interfaces.Integer_64 (Frames))); end Write_Integer; @@ -979,7 +970,6 @@ package body Libsndfile is for Buffer'Address use Data'Address; pragma Import (Ada, Buffer); begin - Ada.Assertions.Assert (Float'Size = Interfaces.C.C_float'Size); return Count_Type (asf_writef_float (File.Ptr, Buffer, Interfaces.Integer_64 (Frames))); end Write_Float; @@ -993,7 +983,6 @@ package body Libsndfile is for Buffer'Address use Data'Address; pragma Import (Ada, Buffer); begin - Ada.Assertions.Assert (Long_Float'Size = Interfaces.C.double'Size); return Count_Type (asf_writef_double (File.Ptr, Buffer, Interfaces.Integer_64 (Frames))); end Write_Double; @@ -1003,8 +992,10 @@ package body Libsndfile is Bytes : in Count_Type) return Count_Type is begin - Ada.Assertions.Assert (Character'Size = 8); - return Count_Type (asf_read_raw (File.Ptr, Data'Address, Interfaces.Integer_64 (Bytes))); + return Count_Type (asf_read_raw + (File.Ptr, + Storage.To_Integer (Data'Address), + Interfaces.Integer_64 (Bytes))); end Read_Raw; function Write_Raw @@ -1013,8 +1004,10 @@ package body Libsndfile is Bytes : in Count_Type) return Count_Type is begin - Ada.Assertions.Assert (Character'Size = 8); - return Count_Type (asf_write_raw (File.Ptr, Data'Address, Interfaces.Integer_64 (Bytes))); + return Count_Type (asf_write_raw + (File.Ptr, + Storage.To_Integer (Data'Address), + Interfaces.Integer_64 (Bytes))); end Write_Raw; function Get_Meta @@ -1080,7 +1073,7 @@ package body Libsndfile is (File : in Sound_File) return Natural is - Result : Interfaces.C.int := sf_current_byterate (File.Ptr); + Result : constant Interfaces.C.int := sf_current_byterate (File.Ptr); begin if Result >= 0 then return Natural (Result); diff --git a/src/libsndfile.ads b/src/libsndfile.ads index d88c06d..f996f9d 100644 --- a/src/libsndfile.ads +++ b/src/libsndfile.ads @@ -14,7 +14,7 @@ with private with Interfaces.C, - System; + System.Storage_Elements; package Libsndfile is @@ -51,7 +51,7 @@ package Libsndfile is Track_Number_String, Genre_String); - type File_Info is private; + type File_Info is tagged private; type Major_Format is (Format_Unknown, @@ -222,7 +222,7 @@ package Libsndfile is (File : in out Sound_File; Name : in String; Mode : in File_Mode; - Info : in out File_Info) + Info : in out File_Info'Class) with Pre => not Is_Open (File), Post => Is_Open (File); @@ -343,8 +343,34 @@ package Libsndfile is private + package Storage renames System.Storage_Elements; + use type Interfaces.C.size_t, Storage.Integer_Address; + + + Null_Pointer : constant Storage.Integer_Address := Storage.To_Integer (System.Null_Address); + + pragma Linker_Options ("-lsndfile"); + + function c_pointer_size + return Interfaces.C.size_t; + pragma Import (C, c_pointer_size, "c_pointer_size"); + + -- If this fails then we are on an architecture that for whatever reason + -- has significant problems interfacing between C and Ada + pragma Assert + (c_pointer_size * Interfaces.C.CHAR_BIT = Storage.Integer_Address'Size, + "Size of C void pointers and size of Ada address values do not match"); + + -- More things that shouldn't fail unless something really weird happens + pragma Assert (Short_Integer'Size = Interfaces.C.short'Size); + pragma Assert (Integer'Size = Interfaces.C.int'Size); + pragma Assert (Float'Size = Interfaces.C.C_float'Size); + pragma Assert (Long_Float'Size = Interfaces.C.double'Size); + pragma Assert (Character'Size = Interfaces.C.CHAR_BIT); + + pragma Inline (Is_Open); pragma Inline (Write_Sync); pragma Inline (Read_Raw); @@ -352,12 +378,10 @@ private pragma Inline (Version_String); - - type Sound_File is tagged limited record - Ptr : System.Address := System.Null_Address; - FMode : File_Mode := Read_Only; - Chans : Interfaces.C.int := 0; + Ptr : Storage.Integer_Address := Null_Pointer; + FMode : File_Mode := Read_Only; + Chans : Interfaces.C.int := 0; end record; @@ -368,7 +392,7 @@ private -- This cannot correspond to the C-side SF_INFO since sf_count_t can vary - type File_Info is record + type C_File_Info is record My_Frames : Interfaces.Integer_64; My_Sample_Rate : Interfaces.C.int; My_Channels : Interfaces.C.int; @@ -379,10 +403,12 @@ private My_Seekable : Interfaces.C.int; end record with Convention => C; - - Blank_Info : constant File_Info := (My_Frames => 0, others => 0); + type File_Info is tagged record + Data : C_File_Info; + end record; + Blank_Info : constant File_Info := (Data => (My_Frames => 0, others => 0)); procedure Raise_Error @@ -413,8 +439,6 @@ private return Interfaces.C.int; - - sf_false : constant Interfaces.C.int; pragma Import (C, sf_false, "sf_false"); @@ -422,8 +446,6 @@ private pragma Import (C, sf_true, "sf_true"); - - sfm_read : constant Interfaces.C.int; pragma Import (C, sfm_read, "sfm_read"); @@ -434,8 +456,6 @@ private pragma Import (C, sfm_rdwr, "sfm_rdwr"); - - sf_seek_set : constant Interfaces.C.int; pragma Import (C, sf_seek_set, "sf_seek_set"); @@ -446,10 +466,8 @@ private pragma Import (C, sf_seek_end, "sf_seek_end"); - - function sf_error - (File : in System.Address) + (File : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, sf_error, "sf_error"); |