implemented some functions h2-io-file.
renamed h2-sysapi to h2-os
This commit is contained in:
		| @ -9,8 +9,9 @@ with Ada.Text_IO; | |||||||
| with Ada.Unchecked_Deallocation; | with Ada.Unchecked_Deallocation; | ||||||
|  |  | ||||||
|  |  | ||||||
| with H2.Sysapi; | with H2.OS; | ||||||
| with H2.IO; | with H2.IO; | ||||||
|  | use type H2.System_Length; | ||||||
|  |  | ||||||
| with Interfaces.C; | with Interfaces.C; | ||||||
|  |  | ||||||
| @ -44,27 +45,27 @@ begin | |||||||
| 	--h2init; | 	--h2init; | ||||||
|  |  | ||||||
| declare | declare | ||||||
| 	package Sysapi is new H2.Sysapi ( | 	package OS is new H2.OS ( | ||||||
| 		H2.Slim.Character, | 		H2.Slim.Character, | ||||||
| 		H2.Wide.Character, | 		H2.Wide.Character, | ||||||
| 		H2.Slim.String, | 		H2.Slim.String, | ||||||
| 		H2.Wide.String, | 		H2.Wide.String, | ||||||
| 		H2.Wide.Utf8.To_Unicode_String, | 		H2.Wide.Utf8.To_Unicode_String, | ||||||
| 		H2.Wide.Utf8.From_Unicode_String); | 		H2.Wide.Utf8.From_Unicode_String); | ||||||
| 	package File renames Sysapi.File; | 	package File renames OS.File; | ||||||
|  |  | ||||||
| 	F: File.File_Pointer; | 	F: File.File_Pointer; | ||||||
| 	FL: File.Flag_Record; | 	FL: File.Flag_Record; | ||||||
| 	Last: H2.System_Length; | 	Length: H2.System_Length; | ||||||
| 	Buffer: H2.System_Byte_Array (50 .. 100); | 	Buffer: H2.System_Byte_Array (50 .. 100); | ||||||
| begin | 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.Set_Flag_Bits (FL, File.FLAG_READ); | ||||||
| 	File.Open (F, H2.Wide.String'("/etc/passwd"), FL); | 	File.Open (F, H2.Wide.String'("/etc/passwd"), FL); | ||||||
| 	File.Read (F, Buffer, Last); | 	File.Read (F, Buffer, Length); | ||||||
| 	File.Close (F); | 	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; | end; | ||||||
|  |  | ||||||
| declare | declare | ||||||
| @ -74,14 +75,35 @@ declare | |||||||
| 		H2.Slim.String, | 		H2.Slim.String, | ||||||
| 		H2.Wide.String, | 		H2.Wide.String, | ||||||
| 		H2.Wide.Utf8.To_Unicode_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; | 	package File renames IO.File; | ||||||
|  |  | ||||||
| 	F: File.File_Record; | 	F: File.File_Record; | ||||||
| 	FL: File.Flag_Record; | 	FL: File.Flag_Record; | ||||||
|  | 	Buffer: H2.Slim.String (1 .. 10); | ||||||
|  | 	Length: H2.System_Length; | ||||||
| begin | 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); | 	File.Close (F); | ||||||
| end; | end; | ||||||
|  |  | ||||||
|  | |||||||
| @ -8,9 +8,9 @@ EXTRA_DIST =  \ | |||||||
| 	h2-ascii.ads  \ | 	h2-ascii.ads  \ | ||||||
| 	h2-utf8.ads \ | 	h2-utf8.ads \ | ||||||
| 	h2-utf8.adb  \ | 	h2-utf8.adb  \ | ||||||
| 	h2-sysapi.ads \ | 	h2-os.ads \ | ||||||
| 	h2-sysapi.adb \ | 	h2-os.adb \ | ||||||
| 	posix/h2-sysapi-file.adb \ | 	posix/h2-os-file.adb \ | ||||||
| 	h2-io.ads \ | 	h2-io.ads \ | ||||||
| 	h2-io.adb \ | 	h2-io.adb \ | ||||||
| 	h2-io-file.adb \ | 	h2-io-file.adb \ | ||||||
|  | |||||||
| @ -178,9 +178,9 @@ EXTRA_DIST = \ | |||||||
| 	h2-ascii.ads  \ | 	h2-ascii.ads  \ | ||||||
| 	h2-utf8.ads \ | 	h2-utf8.ads \ | ||||||
| 	h2-utf8.adb  \ | 	h2-utf8.adb  \ | ||||||
| 	h2-sysapi.ads \ | 	h2-os.ads \ | ||||||
| 	h2-sysapi.adb \ | 	h2-os.adb \ | ||||||
| 	posix/h2-sysapi-file.adb \ | 	posix/h2-os-file.adb \ | ||||||
| 	h2-io.ads \ | 	h2-io.ads \ | ||||||
| 	h2-io.adb \ | 	h2-io.adb \ | ||||||
| 	h2-io-file.adb \ | 	h2-io-file.adb \ | ||||||
|  | |||||||
| @ -1,3 +1,5 @@ | |||||||
|  | with H2.Ascii; | ||||||
|  |  | ||||||
| separate (H2.IO) | separate (H2.IO) | ||||||
|  |  | ||||||
| package body File is | package body File is | ||||||
| @ -7,7 +9,10 @@ package body File is | |||||||
| 	                Flag: in     Flag_Record; | 	                Flag: in     Flag_Record; | ||||||
| 	                Pool: in     Storage_Pool_Pointer := null) is | 	                Pool: in     Storage_Pool_Pointer := null) is | ||||||
| 	begin | 	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; | 	end Open; | ||||||
|  |  | ||||||
| 	procedure Open (File: in out File_Record; | 	procedure Open (File: in out File_Record; | ||||||
| @ -15,41 +20,226 @@ package body File is | |||||||
| 	                Flag: in     Flag_Record; | 	                Flag: in     Flag_Record; | ||||||
| 	                Pool: in     Storage_Pool_Pointer := null) is | 	                Pool: in     Storage_Pool_Pointer := null) is | ||||||
| 	begin | 	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; | 	end Open; | ||||||
|  |  | ||||||
|  |  | ||||||
| 	procedure Close (File: in out File_Record) is | 	procedure Close (File: in out File_Record) is | ||||||
| 	begin | 	begin | ||||||
| 		Sysapi.File.Close (File.File); | 		OS.File.Close (File.File); | ||||||
| 		File.File := null; | 		File.File := null; | ||||||
| 		File.Last := System_Length'First; |  | ||||||
| 	end Close; | 	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;  | 	procedure Read (File:   in out File_Record;  | ||||||
| 	                Buffer: in out Slim_String; | 	                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 | 	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; | 	end Read; | ||||||
|  |  | ||||||
| 	procedure Read (File:   in out File_Record;  | 	procedure Read (File:   in out File_Record;  | ||||||
| 	                Buffer: in out Wide_String; | 	                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 | 	begin | ||||||
| 		null; | 		null; | ||||||
| 	end Read; | 	end Read_Line; | ||||||
|  |  | ||||||
| 	procedure Write (File:   in out File_Record;  | 	procedure Write (File:   in out File_Record;  | ||||||
| 	                 Buffer: in     Slim_String; | 	                 Buffer: in     Slim_String; | ||||||
| 	                 Last:   out    System_Length) is | 	                 Length: out    System_Length) is | ||||||
| 	begin | 	begin | ||||||
| 		null; | 		null; | ||||||
| 	end Write; | 	end Write; | ||||||
|  |  | ||||||
| 	procedure Write (File:   in out File_Record;  | 	procedure Write (File:   in out File_Record;  | ||||||
| 	                 Buffer: in     Wide_String; | 	                 Buffer: in     Wide_String; | ||||||
| 	                 Last:   out    System_Length) is | 	                 Length: out    System_Length) is | ||||||
| 	begin | 	begin | ||||||
| 		null; | 		null; | ||||||
| 	end Write; | 	end Write; | ||||||
|  | |||||||
| @ -1,4 +1,4 @@ | |||||||
| with H2.Sysapi; | with H2.OS; | ||||||
|  |  | ||||||
| generic | generic | ||||||
| 	type Slim_Character is (<>); | 	type Slim_Character is (<>); | ||||||
| @ -7,31 +7,36 @@ generic | |||||||
| 	type Wide_String is array(System_Index range<>) of Wide_Character; | 	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 Slim_To_Wide (Slim: in Slim_String) return Wide_String; | ||||||
| 	with function Wide_To_Slim (Wide: in Wide_String) return Slim_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 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 | 	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_READ:       constant Flag_Bits := OS.File.FLAG_READ; | ||||||
| 		FLAG_WRITE:      constant := Sysapi.File.FLAG_WRITE; | 		FLAG_WRITE:      constant Flag_Bits := OS.File.FLAG_WRITE; | ||||||
| 		FLAG_CREATE:     constant := Sysapi.File.FLAG_CREATE; | 		FLAG_CREATE:     constant Flag_Bits := OS.File.FLAG_CREATE; | ||||||
| 		FLAG_EXCLUSIVE:  constant := Sysapi.File.FLAG_EXCLUSIVE; | 		FLAG_EXCLUSIVE:  constant Flag_Bits := OS.File.FLAG_EXCLUSIVE; | ||||||
| 		FLAG_TRUNCATE:   constant := Sysapi.File.FLAG_TRUNCATE; | 		FLAG_TRUNCATE:   constant Flag_Bits := OS.File.FLAG_TRUNCATE; | ||||||
| 		FLAG_APPEND:     constant := Sysapi.File.FLAG_APPEND; | 		FLAG_APPEND:     constant Flag_Bits := OS.File.FLAG_APPEND; | ||||||
| 		FLAG_NONBLOCK:   constant := Sysapi.File.FLAG_NONBLOCK; | 		FLAG_NONBLOCK:   constant Flag_Bits := OS.File.FLAG_NONBLOCK; | ||||||
| 		FLAG_SYNC:       constant := Sysapi.File.FLAG_SYNC; | 		FLAG_SYNC:       constant Flag_Bits := OS.File.FLAG_SYNC; | ||||||
| 		FLAG_NOFOLLOW:   constant := Sysapi.File.FLAG_NOFOLLOW; | 		FLAG_NOFOLLOW:   constant Flag_Bits := OS.File.FLAG_NOFOLLOW; | ||||||
|  |  | ||||||
| 		type File_Record is limited record | 		type File_Buffer is private; | ||||||
| 			File: Sysapi.File.File_Pointer := null; | 		type File_Record is limited private; | ||||||
| 			Buffer: System_Byte_Array (1 .. 2048); | 			 | ||||||
| 			Last: System_Length := System_Length'First; |  | ||||||
| 		end record; | 		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;  | 		procedure Open (File: in out File_Record;  | ||||||
| 					 Name: in     Slim_String; | 					 Name: in     Slim_String; | ||||||
| @ -47,21 +52,43 @@ package H2.IO is | |||||||
|  |  | ||||||
| 		procedure Read (File:   in out File_Record;  | 		procedure Read (File:   in out File_Record;  | ||||||
| 					 Buffer: in out Slim_String; | 					 Buffer: in out Slim_String; | ||||||
| 					 Last:   out    System_Length); | 					 Length: out    System_Length); | ||||||
|  |  | ||||||
| 		procedure Read (File:   in out File_Record; | 		procedure Read (File:   in out File_Record; | ||||||
| 					 Buffer: in out Wide_String; | 					 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;  | 		procedure Write (File:   in out File_Record;  | ||||||
| 					  Buffer: in     Slim_String; | 					  Buffer: in     Slim_String; | ||||||
| 					  Last:   out    System_Length); | 					  Length: out    System_Length); | ||||||
|  |  | ||||||
| 		procedure Write (File:   in out File_Record; | 		procedure Write (File:   in out File_Record; | ||||||
| 					  Buffer: in     Wide_String; | 					  Buffer: in     Wide_String; | ||||||
| 					  Last:   out    System_Length); | 					  Length: out    System_Length); | ||||||
|  |  | ||||||
| 		procedure Flush (File: in out File_Record); | 		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 File; | ||||||
|  |  | ||||||
| end H2.IO; | end H2.IO; | ||||||
|  | |||||||
| @ -1,4 +1,4 @@ | |||||||
| package body H2.Sysapi is | package body H2.OS is | ||||||
| 
 | 
 | ||||||
| 	package body File is separate; | 	package body File is separate; | ||||||
| 
 | 
 | ||||||
| @ -12,4 +12,4 @@ package body H2.Sysapi is | |||||||
| 		Flag.Bits := Flag.Bits and not Bits; | 		Flag.Bits := Flag.Bits and not Bits; | ||||||
| 	end Clear_File_Flag_Bits; | 	end Clear_File_Flag_Bits; | ||||||
| 
 | 
 | ||||||
| end H2.Sysapi; | end H2.OS; | ||||||
| @ -7,7 +7,7 @@ generic | |||||||
| 	with function Slim_To_Wide (Slim: in Slim_String) return Wide_String; | 	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 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; | 		Bits: File_Mode_Bits := 0; | ||||||
| 	end record; | 	end record; | ||||||
| 
 | 
 | ||||||
| 	procedure Set_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;  | ||||||
| 	procedure Clear_File_Flag_Bits (Flag: in out File_Flag_Record; Bits: in File_Flag_Bits); | 	                              Bits: in     File_Flag_Bits); | ||||||
|  | 
 | ||||||
|  | 	procedure Clear_File_Flag_Bits (Flag: in out File_Flag_Record; | ||||||
|  | 	                                Bits: in     File_Flag_Bits); | ||||||
| 
 | 
 | ||||||
| 	package File is | 	package File is | ||||||
| 		type File_Record is tagged null record; | 		type File_Record is tagged null record; | ||||||
| 		type File_Pointer is access all File_Record'Class; | 		type File_Pointer is access all File_Record'Class; | ||||||
| 
 | 
 | ||||||
| 		subtype Flag_Bits is Sysapi.File_Flag_Bits; | 		subtype Flag_Bits is OS.File_Flag_Bits; | ||||||
| 		subtype Mode_Bits is Sysapi.File_Mode_Bits; | 		subtype Mode_Bits is OS.File_Mode_Bits; | ||||||
| 		subtype Flag_Record is Sysapi.File_Flag_Record; | 		subtype Flag_Record is OS.File_Flag_Record; | ||||||
| 		subtype Mode_Record is Sysapi.File_Mode_Record; | 		subtype Mode_Record is OS.File_Mode_Record; | ||||||
| 
 | 
 | ||||||
| 		FLAG_READ:       constant Flag_Bits := 2#0000_0000_0000_0001#; | 		FLAG_READ:       constant Flag_Bits := 2#0000_0000_0000_0001#; | ||||||
| 		FLAG_WRITE:      constant Flag_Bits := 2#0000_0000_0000_0010#; | 		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# ); | 		DEFAULT_MODE: constant Mode_Record := ( Bits => 2#110_100_100# ); | ||||||
| 
 | 
 | ||||||
| 		procedure Set_Flag_Bits (Flag: in out Flag_Record; | 		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; | 		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_Stdin return File_Pointer; | ||||||
| 		function Get_Stdout return File_Pointer; | 		function Get_Stdout return File_Pointer; | ||||||
| @ -84,11 +87,11 @@ package H2.Sysapi is | |||||||
| 
 | 
 | ||||||
| 		procedure Read (File:   in     File_Pointer;  | 		procedure Read (File:   in     File_Pointer;  | ||||||
| 		                Buffer: in out System_Byte_Array;  | 		                Buffer: in out System_Byte_Array;  | ||||||
| 		                Last:   out    System_Length); | 		                Length: out    System_Length); | ||||||
| 
 | 
 | ||||||
| 		procedure Write (File:   in  File_Pointer;  | 		procedure Write (File:   in  File_Pointer;  | ||||||
| 		                 Buffer: in  System_Byte_Array;  | 		                 Buffer: in  System_Byte_Array;  | ||||||
| 		                 Last:   out System_Length); | 		                 Length: out System_Length); | ||||||
| 
 | 
 | ||||||
| 		pragma Inline (Get_Stdin); | 		pragma Inline (Get_Stdin); | ||||||
| 		pragma Inline (Get_Stdout); | 		pragma Inline (Get_Stdout); | ||||||
| @ -100,4 +103,4 @@ package H2.Sysapi is | |||||||
| 	--                Mode: in  Mode_Record) renames File.Open; | 	--                Mode: in  Mode_Record) renames File.Open; | ||||||
| 	--procedure Close_File (File: in out File_Pointer) renames File.Close; | 	--procedure Close_File (File: in out File_Pointer) renames File.Close; | ||||||
| 
 | 
 | ||||||
| end H2.Sysapi; | end H2.OS; | ||||||
| @ -6,6 +6,9 @@ generic | |||||||
| package H2.Utf8 is | package H2.Utf8 is | ||||||
| 	pragma Preelaborate (Utf8); | 	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_Unicode_Character: exception; | ||||||
| 	Invalid_Utf8_Sequence: exception; | 	Invalid_Utf8_Sequence: exception; | ||||||
| 	Insufficient_Utf8_Sequence: exception; | 	Insufficient_Utf8_Sequence: exception; | ||||||
|  | |||||||
| @ -1,10 +1,14 @@ | |||||||
| project Lib is | project Lib is | ||||||
|  |  | ||||||
|  | 	type Platform_Type is ("posix", "win32"); | ||||||
|  | 	Platform: Platform_Type := external ("platform", "posix"); | ||||||
|  |  | ||||||
| 	for Source_Dirs use ( | 	for Source_Dirs use ( | ||||||
| 		"@abs_srcdir@", | 		"@abs_srcdir@", | ||||||
| 		"@abs_srcdir@/posix", | 		"@abs_srcdir@/" & Platform, | ||||||
| 		"@abs_builddir@/posix" | 		"@abs_builddir@/" & Platform | ||||||
| 	); | 	); | ||||||
|  |  | ||||||
| 	for Library_Name use "h2"; | 	for Library_Name use "h2"; | ||||||
| 	for Library_Kind use "dynamic"; | 	for Library_Kind use "dynamic"; | ||||||
| 	for Library_Dir use "."; | 	for Library_Dir use "."; | ||||||
| @ -13,10 +17,13 @@ project Lib is | |||||||
|  |  | ||||||
| 	for Source_Files use ( | 	for Source_Files use ( | ||||||
| 		"h2.ads", | 		"h2.ads", | ||||||
| 		"h2-sysdef.ads", |  | ||||||
| 		"h2-ascii.ads", | 		"h2-ascii.ads", | ||||||
| 		"h2-pool.adb", | 		"h2-pool.adb", | ||||||
| 		"h2-pool.ads", | 		"h2-pool.ads", | ||||||
|  | 		"h2-os.adb", | ||||||
|  | 		"h2-os.ads", | ||||||
|  | 		"h2-os-file.adb", | ||||||
|  | 		"h2-sysdef.ads", | ||||||
| 		"h2-io.ads", | 		"h2-io.ads", | ||||||
| 		"h2-io.adb", | 		"h2-io.adb", | ||||||
| 		"h2-io-file.adb", | 		"h2-io-file.adb", | ||||||
| @ -28,9 +35,6 @@ project Lib is | |||||||
| 		"h2-scheme-execute-evaluate.adb", | 		"h2-scheme-execute-evaluate.adb", | ||||||
| 		"h2-scheme-token.adb", | 		"h2-scheme-token.adb", | ||||||
| 		"h2-slim.ads", | 		"h2-slim.ads", | ||||||
| 		"h2-sysapi.adb", |  | ||||||
| 		"h2-sysapi.ads", |  | ||||||
| 		"h2-sysapi-file.adb", |  | ||||||
| 		"h2-utf8.adb", | 		"h2-utf8.adb", | ||||||
| 		"h2-utf8.ads", | 		"h2-utf8.ads", | ||||||
| 		"h2-wide.ads", | 		"h2-wide.ads", | ||||||
| @ -43,8 +47,8 @@ project Lib is | |||||||
| 		"h2.pool", | 		"h2.pool", | ||||||
| 		"h2.scheme", | 		"h2.scheme", | ||||||
| 		"h2.slim", | 		"h2.slim", | ||||||
| 		"h2.sysapi", |  | ||||||
| 		"h2.sysdef", | 		"h2.sysdef", | ||||||
|  | 		"h2.os", | ||||||
| 		"h2.utf8", | 		"h2.utf8", | ||||||
| 		"h2.wide", | 		"h2.wide", | ||||||
| 		"h2.wide_wide" | 		"h2.wide_wide" | ||||||
| @ -56,6 +60,15 @@ project Lib is | |||||||
| 		); | 		); | ||||||
| 	end Compiler; | 	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 | 	--package Install is | ||||||
| 	--	for Prefix use "@prefix@"; | 	--	for Prefix use "@prefix@"; | ||||||
| 	--end Install; | 	--end Install; | ||||||
|  | |||||||
| @ -2,7 +2,7 @@ | |||||||
| with H2.Pool; | with H2.Pool; | ||||||
| with H2.Sysdef; | with H2.Sysdef; | ||||||
| 
 | 
 | ||||||
| separate (H2.Sysapi) | separate (H2.OS) | ||||||
| 
 | 
 | ||||||
| package body File is | package body File is | ||||||
| 
 | 
 | ||||||
| @ -131,32 +131,35 @@ package body File is | |||||||
| 		end if; | 		end if; | ||||||
| 	end Close; | 	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); | 		F: Posix_File_Pointer := Posix_File_Pointer(File); | ||||||
| 		N: Sysdef.ssize_t; | 		N: Sysdef.ssize_t; | ||||||
| 	begin | 	begin | ||||||
| 		N := Sys_Read (F.Handle, Buffer'Address, Buffer'Length); | 		N := Sys_Read (F.Handle, Buffer'Address, Buffer'Length); | ||||||
| 		if Sysdef."<=" (N, ERROR_RETURN) then | 		if Sysdef."<=" (N, ERROR_RETURN) then | ||||||
| 			raise Constraint_Error; -- TODO rename exception | 			raise Constraint_Error; -- TODO rename exception | ||||||
| 		elsif Sysdef."=" (N, 0) then |  | ||||||
| 			Last := Buffer'First - 1; |  | ||||||
| 		else | 		else | ||||||
| 			Last := Buffer'First + System_Length(N) - 1; | 			Length := System_Length(N); | ||||||
| 		end if; | 		end if; | ||||||
| 	end Read; | 	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); | 		F: Posix_File_Pointer := Posix_File_Pointer(File); | ||||||
| 		N: Sysdef.ssize_t; | 		N: Sysdef.ssize_t; | ||||||
| 	begin | 	begin | ||||||
| 		N := Sys_Write (F.Handle, Buffer'Address, Buffer'Length); | 		N := Sys_Write (F.Handle, Buffer'Address, Buffer'Length); | ||||||
| 		if Sysdef."<=" (N, ERROR_RETURN) then | 		if Sysdef."<=" (N, ERROR_RETURN) then | ||||||
| 			raise Constraint_Error; -- TODO rename exception | 			raise Constraint_Error; -- TODO rename exception | ||||||
| 		elsif Sysdef."=" (N, 0) then |  | ||||||
| 			Last := Buffer'First - 1; |  | ||||||
| 		else | 		else | ||||||
| 			Last := Buffer'First + System_Length(N) - 1; | 			Length := System_Length(N); | ||||||
| 		end if; | 		end if; | ||||||
|  | 
 | ||||||
| 	end Write; | 	end Write; | ||||||
| 
 | 
 | ||||||
| end File; | end File; | ||||||
		Reference in New Issue
	
	Block a user