diff --git a/cmd/scheme.adb b/cmd/scheme.adb index 7742635..79b6968 100644 --- a/cmd/scheme.adb +++ b/cmd/scheme.adb @@ -9,8 +9,9 @@ with Ada.Text_IO; with Ada.Unchecked_Deallocation; -with H2.Sysapi; +with H2.OS; with H2.IO; +use type H2.System_Length; with Interfaces.C; @@ -44,27 +45,27 @@ begin --h2init; declare - package Sysapi is new H2.Sysapi ( + package OS is new H2.OS ( H2.Slim.Character, H2.Wide.Character, H2.Slim.String, H2.Wide.String, H2.Wide.Utf8.To_Unicode_String, H2.Wide.Utf8.From_Unicode_String); - package File renames Sysapi.File; + package File renames OS.File; F: File.File_Pointer; FL: File.Flag_Record; - Last: H2.System_Length; + Length: H2.System_Length; Buffer: H2.System_Byte_Array (50 .. 100); begin - --Sysapi.File.Set_Flag_Bits (FL, Sysapi.File.FLAG_WRITE); + --OS.File.Set_Flag_Bits (FL, OS.File.FLAG_WRITE); File.Set_Flag_Bits (FL, File.FLAG_READ); File.Open (F, H2.Wide.String'("/etc/passwd"), FL); - File.Read (F, Buffer, Last); + File.Read (F, Buffer, Length); File.Close (F); - File.Write (Sysapi.File.Get_Stdout, Buffer(Buffer'First .. Last), Last); + File.Write (OS.File.Get_Stdout, Buffer(Buffer'First .. Buffer'First + Length - 1), Length); end; declare @@ -74,14 +75,35 @@ declare H2.Slim.String, H2.Wide.String, H2.Wide.Utf8.To_Unicode_String, - H2.Wide.Utf8.From_Unicode_String); + H2.Wide.Utf8.From_Unicode_String, + H2.Wide.Utf8.Sequence_Length); package File renames IO.File; F: File.File_Record; FL: File.Flag_Record; + Buffer: H2.Slim.String (1 .. 10); + Length: H2.System_Length; begin - File.Open (F, H2.Slim.String'("/tmp/qq"), FL); + --File.Open (F, H2.Slim.String'("/etc/passwd"), FL); + --File.Read (F, Buffer, Length); + --Ada.Text_IO.PUt_Line (Standard.String(Buffer(Buffer'First .. Buffer'First + Length - 1))); + + --File.Read (F, Buffer, Length); + --Ada.Text_IO.PUt_Line (Standard.String(Buffer(Buffer'First .. Buffer'First + Length - 1))); + --File.Close (F); + +ada.text_io.put_line ("------------------"); + + File.Open (F, H2.Slim.String'("/etc/passwd"), FL); + loop + File.Read_Line (F, Buffer, Length); + if Length <= 0 then + exit; + end if; + Ada.Text_IO.PUt_Line (Standard.String(Buffer(Buffer'First .. Buffer'First + Length - 1))); + end loop; + File.Close (F); end; diff --git a/lib/Makefile.am b/lib/Makefile.am index 66240aa..87a2fde 100644 --- a/lib/Makefile.am +++ b/lib/Makefile.am @@ -8,9 +8,9 @@ EXTRA_DIST = \ h2-ascii.ads \ h2-utf8.ads \ h2-utf8.adb \ - h2-sysapi.ads \ - h2-sysapi.adb \ - posix/h2-sysapi-file.adb \ + h2-os.ads \ + h2-os.adb \ + posix/h2-os-file.adb \ h2-io.ads \ h2-io.adb \ h2-io-file.adb \ diff --git a/lib/Makefile.in b/lib/Makefile.in index fee53ca..21413d6 100644 --- a/lib/Makefile.in +++ b/lib/Makefile.in @@ -178,9 +178,9 @@ EXTRA_DIST = \ h2-ascii.ads \ h2-utf8.ads \ h2-utf8.adb \ - h2-sysapi.ads \ - h2-sysapi.adb \ - posix/h2-sysapi-file.adb \ + h2-os.ads \ + h2-os.adb \ + posix/h2-os-file.adb \ h2-io.ads \ h2-io.adb \ h2-io-file.adb \ diff --git a/lib/h2-io-file.adb b/lib/h2-io-file.adb index 51d165a..5de4586 100644 --- a/lib/h2-io-file.adb +++ b/lib/h2-io-file.adb @@ -1,3 +1,5 @@ +with H2.Ascii; + separate (H2.IO) package body File is @@ -7,7 +9,10 @@ package body File is Flag: in Flag_Record; Pool: in Storage_Pool_Pointer := null) is begin - Sysapi.File.Open (File.File, Name, flag, Pool => Pool); + OS.File.Open (File.File, Name, Flag, Pool => Pool); + File.Rbuf.Length := 0; + File.Wbuf.Length := 0; + File.EOF := Standard.False; end Open; procedure Open (File: in out File_Record; @@ -15,41 +20,226 @@ package body File is Flag: in Flag_Record; Pool: in Storage_Pool_Pointer := null) is begin - Sysapi.File.Open (File.File, Name, flag, Pool => Pool); + OS.File.Open (File.File, Name, Flag, Pool => Pool); + File.Rbuf.Length := 0; + File.Wbuf.Length := 0; + File.EOF := Standard.False; end Open; - procedure Close (File: in out File_Record) is begin - Sysapi.File.Close (File.File); + OS.File.Close (File.File); File.File := null; - File.Last := System_Length'First; end Close; + procedure OS_Read_File (File: in out File_Record; + Buffer: in out System_Byte_Array; + Length: out System_Length) is + begin + OS.File.Read (File.File, Buffer, Length); + File.EOF := (Length <= 0); + end OS_Read_File; + procedure Read (File: in out File_Record; Buffer: in out Slim_String; - Last: out System_Length) is + Length: out System_Length) is + pragma Assert (Buffer'Length > 0); + + Outbuf: System_Byte_Array (Buffer'Range); + for Outbuf'Address use Buffer'Address; + + Rbuf: File_Buffer renames File.Rbuf; + L1, L2: System_Length; begin - null; + if Rbuf.Length <= 0 and then File.EOF then + -- raise EOF EXCEPTION. ??? + Length := 0; + return; + end if; + + if Outbuf'Length >= Rbuf.Data'Length then + -- The output buffer size if greater than the internal buffer size. + + L1 := Rbuf.Length; + if L1 < Outbuf'Length then + -- Read into the tail of the output buffer if insufficient + -- data is available in the internal buffer. + OS_Read_File (File, Outbuf(Outbuf'First + L1 .. Outbuf'Last), L2); + end if; + + -- Fill the head of the output buffer with the internal buffer contents + Outbuf(Outbuf'First .. Outbuf'First + L1 - 1) := Rbuf.Data(Rbuf.Data'First .. Rbuf.Data'First + L1 - 1); + + -- Empty the internal buffer. + Rbuf.Length := 0; + + -- Set the output length + Length := L1 + L2; + else + if Rbuf.Length < Rbuf.Data'Length then + -- Attempt to fill the internal buffer. It may not get full with a single read. + OS_Read_File (File, Rbuf.Data(Rbuf.Data'First + Rbuf.Length .. Rbuf.Data'Last), L1); + Rbuf.Length := RBuf.Length + L1; + end if; + + -- Determine how much need to be copied to the output buffer. + If Outbuf'Length < Rbuf.Length then + L2 := Outbuf'Length; + else + L2 := Rbuf.Length; + end if; + + -- Copy the head of the internal buffer to the output buffer + Outbuf(Outbuf'First .. Outbuf'First + L2 - 1) := Rbuf.Data(Rbuf.Data'First .. Rbuf.Data'First + L2 - 1); + + -- Move the residue of the internal buffer to the head + Rbuf.Length := Rbuf.Length - L2; + Rbuf.Data(Rbuf.Data'First .. Rbuf.Data'First + Rbuf.Length - 1) := Rbuf.Data(Rbuf.Data'First + L2 .. Rbuf.Data'First + L2 + Rbuf.Length - 1); + + -- Set the output length + Length := L2; + end if; + end Read; procedure Read (File: in out File_Record; Buffer: in out Wide_String; - Last: out System_Length) is + Length: out System_Length) is + pragma Assert (Buffer'Length > 0); + Outbuf: Wide_String renames Buffer; + + Rbuf: File_Buffer renames File.Rbuf; + Inbuf: Slim_String (Rbuf.Data'Range); + for Inbuf'Address use Rbuf.Data'Address; + + L1, L2, L3, I, J, K: System_Length; + + begin + if Rbuf.Length <= 0 and then File.EOF then + -- raise EOF EXCEPTION. ??? + Length := 0; + return; + end if; + + K := Outbuf'First - 1; + + outer: loop + if Rbuf.Length < Rbuf.Data'Length then + -- Attempt to fill the internal buffer. It may not get full with a single read. + OS_Read_File (File, Rbuf.Data(Rbuf.Data'First + Rbuf.Length .. Rbuf.Data'Last), L1); + File.EOF := (L1 <= 0); + Rbuf.Length := Rbuf.Length + L1; + end if; + + if Rbuf.Length <= 0 then + exit outer; + end if; + + L2 := Rbuf.Data'First + Rbuf.Length - 1; -- Last index of the internal buffer + I := Rbuf.Data'First; + loop + L3 := Sequence_Length (Inbuf(I)); + if L2 - I + 1 < L3 then + exit; + end if; + + K := K + 1; + J := I + L3; + Outbuf(K..K) := Slim_To_Wide(Inbuf(I .. J - 1)); + I := J; + + --if K >= Outbuf'Last or else Outbuf(K) = Ascii.Pos.LF then -- TODO: different line terminator + -- L1 := I - Rbuf.Data'First + 1; -- Length of data copied to the output buffer. + -- Rbuf.Length := Rbuf.Length - L1; -- Residue length + -- Rbuf.Data(Rbuf.Data'First .. RBuf.Data'First + Rbuf.Length - 1) := Rbuf.Data(I + 1 .. L2); -- Copy residue + -- exit outer; -- Done + --end if; + end loop; + + -- Empty the internal buffer; + Rbuf.Length := 0; + end loop outer; + + Length := K + 1 - Outbuf'First; + end Read; + + procedure Read_Line (File: in out File_Record; + Buffer: in out Slim_String; + Length: out System_Length) is + + pragma Assert (Buffer'Length > 0); + + Outbuf: System_Byte_Array (Buffer'Range); + for Outbuf'Address use Buffer'Address; + + Rbuf: File_Buffer renames File.Rbuf; + L1, L2, K: System_Length; + + package Ascii is new H2.Ascii (Slim_Character); + begin + -- Unlike Read, this procedure should use the internal buffer + -- regardless of the output buffer size as the position of + -- the line terminator is unknown. + -- + -- If the buffer is not large enough to hold a line, the output + -- is just truncated truncated to the buffer size. + + if Rbuf.Length <= 0 and then File.EOF then + -- raise EOF EXCEPTION. ??? + Length := 0; + return; + end if; + + K := Outbuf'First - 1; + + outer: loop + if Rbuf.Length < Rbuf.Data'Length then + -- Attempt to fill the internal buffer. It may not get full with a single read. + OS_Read_File (File, Rbuf.Data(Rbuf.Data'First + Rbuf.Length .. Rbuf.Data'Last), L1); + File.EOF := (L1 <= 0); + Rbuf.Length := Rbuf.Length + L1; + end if; + + if Rbuf.Length <= 0 then + exit outer; + end if; + + L2 := Rbuf.Data'First + Rbuf.Length - 1; -- Last index of the internal buffer + for I in Rbuf.Data'First .. L2 loop + K := K + 1; + Outbuf(K) := Rbuf.Data(I); + if K >= Outbuf'Last or else Outbuf(K) = Ascii.Pos.LF then -- TODO: different line terminator + L1 := I - Rbuf.Data'First + 1; -- Length of data copied to the output buffer. + Rbuf.Length := Rbuf.Length - L1; -- Residue length + Rbuf.Data(Rbuf.Data'First .. RBuf.Data'First + Rbuf.Length - 1) := Rbuf.Data(I + 1 .. L2); -- Copy residue + exit outer; -- Done + end if; + end loop; + + -- Empty the internal buffer; + Rbuf.Length := 0; + end loop outer; + + Length := K + 1 - Outbuf'First; + end Read_Line; + + procedure Read_Line (File: in out File_Record; + Buffer: in out Wide_String; + Length: out System_Length) is begin null; - end Read; + end Read_Line; procedure Write (File: in out File_Record; Buffer: in Slim_String; - Last: out System_Length) is + Length: out System_Length) is begin null; end Write; procedure Write (File: in out File_Record; Buffer: in Wide_String; - Last: out System_Length) is + Length: out System_Length) is begin null; end Write; diff --git a/lib/h2-io.ads b/lib/h2-io.ads index 699f653..d679fff 100644 --- a/lib/h2-io.ads +++ b/lib/h2-io.ads @@ -1,4 +1,4 @@ -with H2.Sysapi; +with H2.OS; generic type Slim_Character is (<>); @@ -7,31 +7,36 @@ generic type Wide_String is array(System_Index range<>) of Wide_Character; with function Slim_To_Wide (Slim: in Slim_String) return Wide_String; with function Wide_To_Slim (Wide: in Wide_String) return Slim_String; - + with function Sequence_Length (Slim: in Slim_Character) return System_Length; package H2.IO is - package Sysapi is new H2.Sysapi (Slim_Character, Wide_Character, Slim_String, Wide_String, Slim_To_Wide, Wide_To_Slim); + package OS is new H2.OS (Slim_Character, Wide_Character, Slim_String, Wide_String, Slim_To_Wide, Wide_To_Slim); package File is - subtype Flag_Record is Sysapi.File.Flag_Record; + subtype Flag_Record is OS.File.Flag_Record; + subtype Flag_Bits is OS.File.Flag_Bits; - FLAG_READ: constant := Sysapi.File.FLAG_READ; - FLAG_WRITE: constant := Sysapi.File.FLAG_WRITE; - FLAG_CREATE: constant := Sysapi.File.FLAG_CREATE; - FLAG_EXCLUSIVE: constant := Sysapi.File.FLAG_EXCLUSIVE; - FLAG_TRUNCATE: constant := Sysapi.File.FLAG_TRUNCATE; - FLAG_APPEND: constant := Sysapi.File.FLAG_APPEND; - FLAG_NONBLOCK: constant := Sysapi.File.FLAG_NONBLOCK; - FLAG_SYNC: constant := Sysapi.File.FLAG_SYNC; - FLAG_NOFOLLOW: constant := Sysapi.File.FLAG_NOFOLLOW; + FLAG_READ: constant Flag_Bits := OS.File.FLAG_READ; + FLAG_WRITE: constant Flag_Bits := OS.File.FLAG_WRITE; + FLAG_CREATE: constant Flag_Bits := OS.File.FLAG_CREATE; + FLAG_EXCLUSIVE: constant Flag_Bits := OS.File.FLAG_EXCLUSIVE; + FLAG_TRUNCATE: constant Flag_Bits := OS.File.FLAG_TRUNCATE; + FLAG_APPEND: constant Flag_Bits := OS.File.FLAG_APPEND; + FLAG_NONBLOCK: constant Flag_Bits := OS.File.FLAG_NONBLOCK; + FLAG_SYNC: constant Flag_Bits := OS.File.FLAG_SYNC; + FLAG_NOFOLLOW: constant Flag_Bits := OS.File.FLAG_NOFOLLOW; - type File_Record is limited record - File: Sysapi.File.File_Pointer := null; - Buffer: System_Byte_Array (1 .. 2048); - Last: System_Length := System_Length'First; - end record; + type File_Buffer is private; + type File_Record is limited private; + + + procedure Set_Flag_Bits (Flag: in out Flag_Record; + Bits: in Flag_Bits) renames OS.File.Set_Flag_Bits; + + procedure Clear_Flag_Bits (Flag: in out Flag_Record; + Bits: in Flag_Bits) renames OS.File.Clear_Flag_Bits; procedure Open (File: in out File_Record; Name: in Slim_String; @@ -47,21 +52,43 @@ package H2.IO is procedure Read (File: in out File_Record; Buffer: in out Slim_String; - Last: out System_Length); + Length: out System_Length); procedure Read (File: in out File_Record; Buffer: in out Wide_String; - Last: out System_Length); + Length: out System_Length); + + procedure Read_Line (File: in out File_Record; + Buffer: in out Slim_String; + Length: out System_Length); + + procedure Read_Line (File: in out File_Record; + Buffer: in out Wide_String; + Length: out System_Length); procedure Write (File: in out File_Record; Buffer: in Slim_String; - Last: out System_Length); + Length: out System_Length); procedure Write (File: in out File_Record; Buffer: in Wide_String; - Last: out System_Length); + Length: out System_Length); procedure Flush (File: in out File_Record); + + private + type File_Buffer is record + Data: System_Byte_Array (1 .. 2048); -- TODO: determine the best size + Length: System_Length := 0; + end record; + + type File_Record is limited record + File: OS.File.File_Pointer := null; + Rbuf: File_Buffer; + Wbuf: File_Buffer; + EOF: Standard.Boolean := false; + end record; + end File; end H2.IO; diff --git a/lib/h2-sysapi.adb b/lib/h2-os.adb similarity index 89% rename from lib/h2-sysapi.adb rename to lib/h2-os.adb index 4af8a39..784a5b6 100644 --- a/lib/h2-sysapi.adb +++ b/lib/h2-os.adb @@ -1,4 +1,4 @@ -package body H2.Sysapi is +package body H2.OS is package body File is separate; @@ -12,4 +12,4 @@ package body H2.Sysapi is Flag.Bits := Flag.Bits and not Bits; end Clear_File_Flag_Bits; -end H2.Sysapi; +end H2.OS; diff --git a/lib/h2-sysapi.ads b/lib/h2-os.ads similarity index 82% rename from lib/h2-sysapi.ads rename to lib/h2-os.ads index f2e6b95..2acc3bf 100644 --- a/lib/h2-sysapi.ads +++ b/lib/h2-os.ads @@ -7,7 +7,7 @@ generic with function Slim_To_Wide (Slim: in Slim_String) return Wide_String; with function Wide_To_Slim (Wide: in Wide_String) return Slim_String; -package H2.Sysapi is +package H2.OS is @@ -21,17 +21,20 @@ package H2.Sysapi is Bits: File_Mode_Bits := 0; end record; - procedure Set_File_Flag_Bits (Flag: in out File_Flag_Record; Bits: in File_Flag_Bits); - procedure Clear_File_Flag_Bits (Flag: in out File_Flag_Record; Bits: in File_Flag_Bits); + procedure Set_File_Flag_Bits (Flag: in out File_Flag_Record; + Bits: in File_Flag_Bits); + + procedure Clear_File_Flag_Bits (Flag: in out File_Flag_Record; + Bits: in File_Flag_Bits); package File is type File_Record is tagged null record; type File_Pointer is access all File_Record'Class; - subtype Flag_Bits is Sysapi.File_Flag_Bits; - subtype Mode_Bits is Sysapi.File_Mode_Bits; - subtype Flag_Record is Sysapi.File_Flag_Record; - subtype Mode_Record is Sysapi.File_Mode_Record; + subtype Flag_Bits is OS.File_Flag_Bits; + subtype Mode_Bits is OS.File_Mode_Bits; + subtype Flag_Record is OS.File_Flag_Record; + subtype Mode_Record is OS.File_Mode_Record; FLAG_READ: constant Flag_Bits := 2#0000_0000_0000_0001#; FLAG_WRITE: constant Flag_Bits := 2#0000_0000_0000_0010#; @@ -59,10 +62,10 @@ package H2.Sysapi is DEFAULT_MODE: constant Mode_Record := ( Bits => 2#110_100_100# ); procedure Set_Flag_Bits (Flag: in out Flag_Record; - Bits: in Flag_Bits) renames Sysapi.Set_File_Flag_Bits; + Bits: in Flag_Bits) renames OS.Set_File_Flag_Bits; procedure Clear_Flag_Bits (Flag: in out Flag_Record; - Bits: in Flag_Bits) renames Sysapi.Clear_File_Flag_Bits; + Bits: in Flag_Bits) renames OS.Clear_File_Flag_Bits; function Get_Stdin return File_Pointer; function Get_Stdout return File_Pointer; @@ -84,11 +87,11 @@ package H2.Sysapi is procedure Read (File: in File_Pointer; Buffer: in out System_Byte_Array; - Last: out System_Length); + Length: out System_Length); procedure Write (File: in File_Pointer; Buffer: in System_Byte_Array; - Last: out System_Length); + Length: out System_Length); pragma Inline (Get_Stdin); pragma Inline (Get_Stdout); @@ -100,4 +103,4 @@ package H2.Sysapi is -- Mode: in Mode_Record) renames File.Open; --procedure Close_File (File: in out File_Pointer) renames File.Close; -end H2.Sysapi; +end H2.OS; diff --git a/lib/h2-utf8.ads b/lib/h2-utf8.ads index 2a44273..4b97e2d 100644 --- a/lib/h2-utf8.ads +++ b/lib/h2-utf8.ads @@ -6,6 +6,9 @@ generic package H2.Utf8 is pragma Preelaborate (Utf8); + --Invalid_Unicode_Character: exception renames Invalid_Wide_Character; + --Invalid_Utf8_Sequence: exception renames Invalid_Slim_Sequence; + --Insufficient_Utf8_Sequence: exception renames Insifficient_Slim_Sequence; Invalid_Unicode_Character: exception; Invalid_Utf8_Sequence: exception; Insufficient_Utf8_Sequence: exception; diff --git a/lib/lib.gpr.in b/lib/lib.gpr.in index 09bc7ce..cd7e2a4 100644 --- a/lib/lib.gpr.in +++ b/lib/lib.gpr.in @@ -1,10 +1,14 @@ project Lib is + type Platform_Type is ("posix", "win32"); + Platform: Platform_Type := external ("platform", "posix"); + for Source_Dirs use ( "@abs_srcdir@", - "@abs_srcdir@/posix", - "@abs_builddir@/posix" + "@abs_srcdir@/" & Platform, + "@abs_builddir@/" & Platform ); + for Library_Name use "h2"; for Library_Kind use "dynamic"; for Library_Dir use "."; @@ -13,10 +17,13 @@ project Lib is for Source_Files use ( "h2.ads", - "h2-sysdef.ads", "h2-ascii.ads", "h2-pool.adb", "h2-pool.ads", + "h2-os.adb", + "h2-os.ads", + "h2-os-file.adb", + "h2-sysdef.ads", "h2-io.ads", "h2-io.adb", "h2-io-file.adb", @@ -28,9 +35,6 @@ project Lib is "h2-scheme-execute-evaluate.adb", "h2-scheme-token.adb", "h2-slim.ads", - "h2-sysapi.adb", - "h2-sysapi.ads", - "h2-sysapi-file.adb", "h2-utf8.adb", "h2-utf8.ads", "h2-wide.ads", @@ -43,8 +47,8 @@ project Lib is "h2.pool", "h2.scheme", "h2.slim", - "h2.sysapi", "h2.sysdef", + "h2.os", "h2.utf8", "h2.wide", "h2.wide_wide" @@ -56,6 +60,15 @@ project Lib is ); end Compiler; + --package Naming is + -- case Platform is + -- when "posix" => + -- for Body ("H2.OS.File") use "h2-os-file-posix.adb"; + -- when "win32" => + -- for Body ("H2.OS.File") use "h2-os-file-win32.adb"; + -- end case; + --end Naming; + --package Install is -- for Prefix use "@prefix@"; --end Install; diff --git a/lib/posix/h2-sysapi-file.adb b/lib/posix/h2-os-file.adb similarity index 90% rename from lib/posix/h2-sysapi-file.adb rename to lib/posix/h2-os-file.adb index 4241c45..397b24b 100644 --- a/lib/posix/h2-sysapi-file.adb +++ b/lib/posix/h2-os-file.adb @@ -2,7 +2,7 @@ with H2.Pool; with H2.Sysdef; -separate (H2.Sysapi) +separate (H2.OS) package body File is @@ -131,32 +131,35 @@ package body File is end if; end Close; - procedure Read (File: in File_Pointer; Buffer: in out System_Byte_Array; Last: out System_Length) is + procedure Read (File: in File_Pointer; + Buffer: in out System_Byte_Array; + Length: out System_Length) is + pragma Assert (Buffer'Length > 0); F: Posix_File_Pointer := Posix_File_Pointer(File); N: Sysdef.ssize_t; begin N := Sys_Read (F.Handle, Buffer'Address, Buffer'Length); if Sysdef."<=" (N, ERROR_RETURN) then raise Constraint_Error; -- TODO rename exception - elsif Sysdef."=" (N, 0) then - Last := Buffer'First - 1; else - Last := Buffer'First + System_Length(N) - 1; + Length := System_Length(N); end if; end Read; - procedure Write (File: in File_Pointer; Buffer: in System_Byte_Array; Last: out System_Length) is + procedure Write (File: in File_Pointer; + Buffer: in System_Byte_Array; + Length: out System_Length) is + pragma Assert (Buffer'Length > 0); F: Posix_File_Pointer := Posix_File_Pointer(File); N: Sysdef.ssize_t; begin N := Sys_Write (F.Handle, Buffer'Address, Buffer'Length); if Sysdef."<=" (N, ERROR_RETURN) then raise Constraint_Error; -- TODO rename exception - elsif Sysdef."=" (N, 0) then - Last := Buffer'First - 1; else - Last := Buffer'First + System_Length(N) - 1; + Length := System_Length(N); end if; + end Write; end File;