Navigation

← Previous Changeset
Next Changeset →

Changeset 2662

Timestamp:

10/20/08 11:07:24 (3 months ago)

Author:

maxr

Message:

ada: part of ongoing unicode support

Files:

Legend:

: Unmodified
: Added
: Removed
: Modified
: Copied
: Moved

trunk/tendra/src/producers/ada/libgela/gela-source_buffers-portable.adb

r2604	r2662
1	1	with Ada.Streams.Stream_IO;
	2	with Ada.Unchecked_Conversion;
2	3	with Ada.Unchecked_Deallocation;
3	4
4	5	package body Gela.Source_Buffers.Portable is
	6
	7	type Stream_Element_Access is access all Ada.Streams.Stream_Element;
	8
	9	function Convert is new Ada.Unchecked_Conversion
	10	(Stream_Element_Access, Cursor);
5	11
6	12	----------
…	…
9	15
10	16	procedure Open
11		(~~This~~ : in out Source_Buffer;
12		Name : in String)
	17	(Object : in out Source_Buffer;
	18	File_Name : in String)
13	19	is
14	20	use Ada.Streams;
…	…
21	27	Upper : Stream_Element_Offset;
22	28	Last : Stream_Element_Offset;
	29
	30	End_Of_File : constant Stream_Element :=
	31	Stream_Element'Val (Code_Unit'Pos (Source_Buffers.End_Of_File));
23	32	begin
24		Open (Input, In_File, Name);
	33	Open (Input, In_File, File_Name);
25	34
26	35	File_Size := Size (Input);
27	36
28		if File_Size > IO_Count (Offset'Last) then
29		Close (Input);
30		raise Use_Error;
31		else
32		This.Internal_Size := Offset (File_Size);
33		end if;
	37	-- Reserve a few bytes for End_Of_File marker.
	38	Upper := Stream_Element_Offset (File_Size + 2);
34	39
35		if This.Internal_Size = 0 then
36		return;
37		end if;
	40	Object.Internal_Array := new Stream_Element_Array (1 .. Upper);
38	41
39		~~Upper := Stream_Element_Offset (File_Size~~);
	42	Read (Input, Object.Internal_Array.all, Last);
40	43
41		This.Internal_Array := new Stream_Element_Array (1 .. Upper);
42
43		Read (Input, This.Internal_Array.all, Last);
44
45		This.Internal_Array (Last + 1 .. Upper) := (others => 0);
46
47		This.Internal_Data := This.Internal_Array (1)'Address;
	44	Object.Internal_Array (Last + 1 .. Upper) := (others => End_Of_File);
48	45
49	46	Close (Input);
…	…
54	51	-----------
55	52
56		procedure Close (~~This~~ : in out Source_Buffer) is
	53	procedure Close (Object : in out Source_Buffer) is
57	54	procedure Deallocate is new Ada.Unchecked_Deallocation
58	55	(Ada.Streams.Stream_Element_Array, Array_Access);
59	56	begin
60		Deallocate (This.Internal_Array);
61		This.Internal_Data := System.Null_Address;
	57	Deallocate (Object.Internal_Array);
62	58	end Close;
	59
	60	------------------
	61	-- Buffer_Start --
	62	------------------
	63
	64	function Buffer_Start (Object : Source_Buffer) return Cursor is
	65	begin
	66	return Convert (Object.Internal_Array (1)'Access);
	67	end Buffer_Start;
63	68
64	69	end Gela.Source_Buffers.Portable;

trunk/tendra/src/producers/ada/libgela/gela-source_buffers-portable.ads

r2604	r2662
15	15	package Gela.Source_Buffers.Portable is
16	16
17		type Source_Buffer is new ~~Abstract_~~Source_Buffer with private;
	17	type Source_Buffer is new Source_Buffers.Source_Buffer with private;
18	18
19	19	procedure Open
20		(~~This~~ : in out Source_Buffer;
21		Name : in String);
	20	(Object : in out Source_Buffer;
	21	File_Name : in String);
22	22
23		procedure Close (This : in out Source_Buffer);
	23	procedure Close (Object : in out Source_Buffer);
	24
	25	function Buffer_Start (Object : Source_Buffer) return Cursor;
24	26
25	27	private
26	28	type Array_Access is access all Ada.Streams.Stream_Element_Array;
27	29
28		type Source_Buffer is new ~~Abstract_~~Source_Buffer with record
	30	type Source_Buffer is new Source_Buffers.Source_Buffer with record
29	31	Internal_Array : Array_Access;
30	32	end record;

trunk/tendra/src/producers/ada/libgela/gela-source_buffers.adb

r2604	r2662
1		with Interfaces.C.Pointers;
2		with System.Address_To_Access_Conversions;
	1	package body Gela.Source_Buffers is
3	2
4		package body Gela.Source_Buffers is
5		use Interfaces;
	3	-------------
	4	-- Element --
	5	-------------
6	6
7		type Code_Unit_8_Array is
8		array (Count range <>) of aliased Code_Unit_8;
9
10		type Code_Unit_16_Array is
11		array (Count range <>) of aliased Code_Unit_16;
12
13		type Code_Unit_32_Array is
14		array (Count range <>) of aliased Code_Unit_32;
15
16		package P8 is new C.Pointers (Count, Code_Unit_8, Code_Unit_8_Array, 0);
17		package P16 is new C.Pointers (Count, Code_Unit_16, Code_Unit_16_Array, 0);
18		package P32 is new C.Pointers (Count, Code_Unit_32, Code_Unit_32_Array, 0);
19
20		package Conv_8 is new System.Address_To_Access_Conversions (Code_Unit_8);
21		package Conv_16 is new System.Address_To_Access_Conversions (Code_Unit_16);
22		package Conv_32 is new System.Address_To_Access_Conversions (Code_Unit_32);
23
24		subtype Source_Buffer_Class is Abstract_Source_Buffer'Class;
25
26		---------
27		-- "+" --
28		---------
29
30		function "+"
31		(Left : in Code_Unit_8_Access;
32		Right : in Offset)
33		return Code_Unit_8_Access
34		is
35		use P8;
	7	function Element (Object : Cursor) return Code_Unit is
36	8	begin
37		return Code_Unit_8_Access (Pointer (Left) + C.ptrdiff_t (Right));
38		end "+";
39
40		---------
41		-- "+" --
42		---------
43
44		function "+"
45		(Left : in Code_Unit_16_Access;
46		Right : in Offset)
47		return Code_Unit_16_Access
48		is
49		use P16;
50		begin
51		return Code_Unit_16_Access (Pointer (Left) + C.ptrdiff_t (Right));
52		end "+";
53
54		---------
55		-- "+" --
56		---------
57
58		function "+"
59		(Left : in Code_Unit_32_Access;
60		Right : in Offset)
61		return Code_Unit_32_Access
62		is
63		use P32;
64		begin
65		return Code_Unit_32_Access (Pointer (Left) + C.ptrdiff_t (Right));
66		end "+";
	9	return Object.all;
	10	end Element;
67	11
68	12	----------
69		-- ~~Data~~ --
	13	-- Next --
70	14	----------
71	15
72		function Data
73		(This : in Abstract_Source_Buffer)
74		return Code_Unit_8_Access
75		is
76		begin
77		if not Is_Open (Source_Buffer_Class (This)) then
78		raise Use_Error;
79		else
80		return Code_Unit_8_Access (Conv_8.To_Pointer (This.Internal_Data));
81		end if;
82		end Data;
83
84		----------
85		-- Data --
86		----------
87
88		function Data
89		(This : in Abstract_Source_Buffer)
90		return Code_Unit_16_Access
91		is
92		package Conv is
93		new System.Address_To_Access_Conversions (Code_Unit_16);
94		begin
95		if not Is_Open (Source_Buffer_Class (This)) then
96		raise Use_Error;
97		else
98		return Code_Unit_16_Access (Conv_16.To_Pointer (This.Internal_Data));
99		end if;
100		end Data;
101
102		----------
103		-- Data --
104		----------
105
106		function Data
107		(This : in Abstract_Source_Buffer)
108		return Code_Unit_32_Access
109		is
110		package Conv is
111		new System.Address_To_Access_Conversions (Code_Unit_32);
112		begin
113		if not Is_Open (Source_Buffer_Class (This)) then
114		raise Use_Error;
115		else
116		return Code_Unit_32_Access (Conv_32.To_Pointer (This.Internal_Data));
117		end if;
118		end Data;
119
120		----------
121		-- Size --
122		----------
123
124		function Size
125		(This : in Abstract_Source_Buffer;
126		Unit_Size : in Code_Unit_Size)
127		return Offset
128		is
129		begin
130		case Unit_Size is
131		when Unit_8 =>
132		return This.Internal_Size;
133		when Unit_16 =>
134		return This.Internal_Size / 2;
135		when Unit_32 =>
136		return This.Internal_Size / 4;
137		end case;
138		end Size;
139
140		-------------
141		-- Is_Open --
142		-------------
143
144		function Is_Open (This : in Abstract_Source_Buffer) return Boolean is
145		use type System.Address;
146		begin
147		return This.Internal_Data /= System.Null_Address;
148		end Is_Open;
149
150		--------------
151		-- Finalize --
152		--------------
153
154		procedure Finalize (This : in out Abstract_Source_Buffer) is
155		begin
156		if Is_Open (Source_Buffer_Class (This)) then
157		Close (Source_Buffer_Class (This));
158		end if;
159		end Finalize;
	16	procedure Next (Object : in out Cursor) renames Increment;
160	17
161	18	end Gela.Source_Buffers;

trunk/tendra/src/producers/ada/libgela/gela-source_buffers.ads

r2604	r2662
11	11	--
12	12	-- Such buffer contains source represented as array of code units.
13		-- Direct pointer to code units provided to speed access up. User is
14		-- responsible to watch pointer stay in buffer boundaries.
	13	-- Direct pointer (cursor) to code units provided to speed access up.
	14	-- User is responsible to watch pointer stay in buffer boundaries.
	15	-- Special code unit value (End_Of_File) is returned when end of
	16	-- source buffer is reached.
15	17
16		with System;
17		with Ada.Finalization;
	18	with Interfaces.C.Pointers;
18	19
19	20	package Gela.Source_Buffers is
20	21	pragma Preelaborate;
21	22
22		type ~~Offset is range 0 .. Integer'Last~~;
	23	type Cursor is private;
23	24
24		~~subtype Count is Offset range 1 .. Offset'Last~~;
	25	type Source_Buffer is abstract tagged private;
25	26
26		type Code_Unit_8 is mod 2 ** 8;
27		type Code_Unit_8_Access is access all Code_Unit_8;
	27	function Buffer_Start (Object : Source_Buffer) return Cursor is abstract;
28	28
29		type Code_Unit_16 is mod 2 ** 16;
30		type Code_Unit_16_Access is access all Code_Unit_16;
	29	subtype Code_Unit is Character;
31	30
32		type Code_Unit_32 is mod 2 ** 32;
33		type Code_Unit_32_Access is access all Code_Unit_32;
	31	function Element (Object : Cursor) return Code_Unit;
34	32
35		function "+"
36		(Left : in Code_Unit_8_Access;
37		Right : in Offset)
38		return Code_Unit_8_Access;
	33	procedure Next (Object : in out Cursor);
39	34
40		function "+"
41		(Left : in Code_Unit_16_Access;
42		Right : in Offset)
43		return Code_Unit_16_Access;
44
45		function "+"
46		(Left : in Code_Unit_32_Access;
47		Right : in Offset)
48		return Code_Unit_32_Access;
49
50		type Code_Unit_Size is (Unit_8, Unit_16, Unit_32);
51
52		----------------------------
53		-- Abstract_Source_Buffer --
54		----------------------------
55
56		type Abstract_Source_Buffer is abstract tagged limited private;
57
58		function Data (This : in Abstract_Source_Buffer)
59		return Code_Unit_8_Access;
60
61		function Data (This : in Abstract_Source_Buffer)
62		return Code_Unit_16_Access;
63
64		function Data (This : in Abstract_Source_Buffer)
65		return Code_Unit_32_Access;
66
67		function Size
68		(This : in Abstract_Source_Buffer;
69		Unit_Size : in Code_Unit_Size) return Offset;
70
71		function Is_Open (This : in Abstract_Source_Buffer) return Boolean;
72
73		procedure Close (This : in out Abstract_Source_Buffer) is abstract;
	35	End_Of_File : constant Code_Unit;
74	36
75	37	Use_Error : exception;
76	38
77	39	private
78		pragma Inline ("+");
79		pragma Inline (Is_Open);
80		pragma Inline (Size);
	40	pragma Inline (Element);
	41	pragma Inline (Next);
81	42
82		type Abstract_Source_Buffer is abstract
83		new Ada.Finalization.Limited_Controlled
84		with record
85		Internal_Data : System.Address := System.Null_Address;
86		Internal_Size : Offset := 0;
87		end record;
	43	End_Of_File : constant Code_Unit := Code_Unit'Val (0);
88	44
89		procedure Finalize (This : in out Abstract_Source_Buffer);
	45	type Code_Unit_Array is array (Positive range <>) of aliased Code_Unit;
	46
	47	package Pointers is new Interfaces.C.Pointers
	48	(Index => Positive,
	49	Element => Code_Unit,
	50	Element_Array => Code_Unit_Array,
	51	Default_Terminator => End_Of_File);
	52
	53	type Cursor is new Pointers.Pointer;
	54
	55	type Source_Buffer is abstract tagged null record;
90	56
91	57	end Gela.Source_Buffers;

Download in other formats: