redefined Object_String for simpler string handling and made other related changes
This commit is contained in:
parent
bec5235659
commit
24829df3a6
@ -1,3 +1,4 @@
|
|||||||
|
|
||||||
with H2.Scheme;
|
with H2.Scheme;
|
||||||
with H2.Pool;
|
with H2.Pool;
|
||||||
with Storage;
|
with Storage;
|
||||||
@ -5,6 +6,7 @@ with Stream;
|
|||||||
with Ada.Text_IO;
|
with Ada.Text_IO;
|
||||||
with Ada.Unchecked_Deallocation;
|
with Ada.Unchecked_Deallocation;
|
||||||
|
|
||||||
|
|
||||||
procedure scheme is
|
procedure scheme is
|
||||||
--package S renames H2.Scheme;
|
--package S renames H2.Scheme;
|
||||||
--package S is new H2.Scheme (Wide_Character, Wide_String);
|
--package S is new H2.Scheme (Wide_Character, Wide_String);
|
||||||
|
@ -1,9 +1,11 @@
|
|||||||
with H2.Pool;
|
with H2.Pool;
|
||||||
with Ada.Characters.Conversions;
|
with Ada.Characters.Conversions;
|
||||||
|
with Ada.Unchecked_Conversion;
|
||||||
|
|
||||||
package body Stream is
|
package body Stream is
|
||||||
|
|
||||||
------------------------------------------------------------------
|
------------------------------------------------------------------
|
||||||
|
use type S.Object_String_Size;
|
||||||
|
|
||||||
procedure Open (Stream: in out String_Input_Stream_Record) is
|
procedure Open (Stream: in out String_Input_Stream_Record) is
|
||||||
begin
|
begin
|
||||||
@ -19,8 +21,8 @@ Ada.Wide_Text_IO.Put_Line ("****** CLOSE STRING STREAM ******");
|
|||||||
|
|
||||||
procedure Read (Stream: in out String_Input_Stream_Record;
|
procedure Read (Stream: in out String_Input_Stream_Record;
|
||||||
Data: out S.Object_String;
|
Data: out S.Object_String;
|
||||||
Last: out Standard.Natural) is
|
Last: out S.Object_String_Size) is
|
||||||
Avail: Standard.Natural;
|
Avail: S.Object_String_Size;
|
||||||
begin
|
begin
|
||||||
Avail := Stream.Str'Last - Stream.Pos;
|
Avail := Stream.Str'Last - Stream.Pos;
|
||||||
if Avail <= 0 then
|
if Avail <= 0 then
|
||||||
@ -39,7 +41,7 @@ Ada.Wide_Text_IO.Put_Line ("****** CLOSE STRING STREAM ******");
|
|||||||
|
|
||||||
procedure Write (Stream: in out String_Input_Stream_Record;
|
procedure Write (Stream: in out String_Input_Stream_Record;
|
||||||
Data: out S.Object_String;
|
Data: out S.Object_String;
|
||||||
Last: out Standard.Natural) is
|
Last: out S.Object_String_Size) is
|
||||||
begin
|
begin
|
||||||
--raise S.Stream_Error;
|
--raise S.Stream_Error;
|
||||||
Last := Data'First - 1;
|
Last := Data'First - 1;
|
||||||
@ -48,20 +50,24 @@ Ada.Wide_Text_IO.Put_Line ("****** CLOSE STRING STREAM ******");
|
|||||||
------------------------------------------------------------------
|
------------------------------------------------------------------
|
||||||
|
|
||||||
procedure Open (Stream: in out File_Stream_Record) is
|
procedure Open (Stream: in out File_Stream_Record) is
|
||||||
|
subtype Wide_String is Standard.Wide_String(1 .. Standard.Natural(Stream.Name'Length));
|
||||||
|
function To_Wide_String is new Ada.Unchecked_Conversion (S.Object_String, Wide_String);
|
||||||
begin
|
begin
|
||||||
Ada.Wide_Text_IO.Put_Line (">>>>> OPEN File STREAM <<<<<");
|
Ada.Wide_Text_IO.Put_Line (">>>>> OPEN File STREAM <<<<< " & To_Wide_String(Stream.Name.all));
|
||||||
Ada.Wide_Text_IO.Open (Stream.Handle, Ada.Wide_Text_IO.In_File, Ada.Characters.Conversions.To_String(Stream.Name.all));
|
Ada.Wide_Text_IO.Open (Stream.Handle, Ada.Wide_Text_IO.In_File, Ada.Characters.Conversions.To_String(To_Wide_String(Stream.Name.all)));
|
||||||
end Open;
|
end Open;
|
||||||
|
|
||||||
procedure Close (Stream: in out File_Stream_Record) is
|
procedure Close (Stream: in out File_Stream_Record) is
|
||||||
|
subtype Wide_String is Standard.Wide_String(1 .. Standard.Natural(Stream.Name'Length));
|
||||||
|
function To_Wide_String is new Ada.Unchecked_Conversion (S.Object_String, Wide_String);
|
||||||
begin
|
begin
|
||||||
Ada.Wide_Text_IO.Put_Line (">>>>> CLOSE File STREAM <<<<<");
|
Ada.Wide_Text_IO.Put_Line (">>>>> CLOSE File STREAM <<<<< " & To_Wide_String(Stream.Name.all));
|
||||||
Ada.Wide_Text_IO.Close (Stream.Handle);
|
Ada.Wide_Text_IO.Close (Stream.Handle);
|
||||||
end Close;
|
end Close;
|
||||||
|
|
||||||
procedure Read (Stream: in out File_Stream_Record;
|
procedure Read (Stream: in out File_Stream_Record;
|
||||||
Data: out S.Object_String;
|
Data: out S.Object_String;
|
||||||
Last: out Standard.Natural) is
|
Last: out S.Object_String_Size) is
|
||||||
begin
|
begin
|
||||||
for I in Data'First .. Data'Last loop
|
for I in Data'First .. Data'Last loop
|
||||||
begin
|
begin
|
||||||
@ -78,7 +84,7 @@ Ada.Wide_Text_IO.Put_Line (">>>>> CLOSE File STREAM <<<<<");
|
|||||||
|
|
||||||
procedure Write (Stream: in out File_Stream_Record;
|
procedure Write (Stream: in out File_Stream_Record;
|
||||||
Data: out S.Object_String;
|
Data: out S.Object_String;
|
||||||
Last: out Standard.Natural) is
|
Last: out S.Object_String_Size) is
|
||||||
begin
|
begin
|
||||||
--raise S.Stream_Error;
|
--raise S.Stream_Error;
|
||||||
Last := Data'First - 1;
|
Last := Data'First - 1;
|
||||||
|
@ -3,49 +3,39 @@ with Ada.Wide_Text_IO;
|
|||||||
|
|
||||||
package Stream is
|
package Stream is
|
||||||
|
|
||||||
--package S renames H2.Scheme;
|
package S is new H2.Scheme (Standard.Wide_Character);
|
||||||
package S is new H2.Scheme (Standard.Wide_Character, Standard.Wide_String);
|
|
||||||
|
|
||||||
------------------------------------------------------------
|
------------------------------------------------------------
|
||||||
--type Object_String_Pointer is access all S.Object_String;
|
--type Object_String_Pointer is access all S.Object_String;
|
||||||
type Object_String_Pointer is access constant S.Object_String;
|
type Object_String_Pointer is access constant S.Object_String;
|
||||||
type String_Input_Stream_Record(Str: Object_String_Pointer) is new S.Stream_Record with record
|
type String_Input_Stream_Record(Str: Object_String_Pointer) is new S.Stream_Record with record
|
||||||
Pos: Standard.Natural := 0;
|
Pos: S.Object_String_Size := 0;
|
||||||
end record;
|
end record;
|
||||||
|
|
||||||
--type String_Input_Stream_Record(Len: Standard.Natural) is new S.Stream_Record with record
|
|
||||||
-- Pos: Standard.Natural := 0;
|
|
||||||
-- Str: S.Object_String (1 .. Len) := (others => ' ');
|
|
||||||
--end record;
|
|
||||||
|
|
||||||
procedure Open (Stream: in out String_Input_Stream_Record);
|
procedure Open (Stream: in out String_Input_Stream_Record);
|
||||||
procedure Close (Stream: in out String_Input_Stream_Record);
|
procedure Close (Stream: in out String_Input_Stream_Record);
|
||||||
procedure Read (Stream: in out String_Input_Stream_Record;
|
procedure Read (Stream: in out String_Input_Stream_Record;
|
||||||
Data: out S.Object_String;
|
Data: out S.Object_String;
|
||||||
Last: out Standard.Natural);
|
Last: out S.Object_String_Size);
|
||||||
procedure Write (Stream: in out String_Input_Stream_Record;
|
procedure Write (Stream: in out String_Input_Stream_Record;
|
||||||
Data: out S.Object_String;
|
Data: out S.Object_String;
|
||||||
Last: out Standard.Natural);
|
Last: out S.Object_String_Size);
|
||||||
|
|
||||||
------------------------------------------------------------
|
------------------------------------------------------------
|
||||||
--type File_Stream_Record(Name: Object_String_Pointer) is new S.Stream_Record with record
|
|
||||||
-- Handle: H2.Text_IO.File_Type;
|
|
||||||
--end record;
|
|
||||||
|
|
||||||
type File_Stream_Record is new S.Stream_Record with record
|
type File_Stream_Record is new S.Stream_Record with record
|
||||||
Name: S.Constant_Object_String_Pointer;
|
Name: S.Constant_Object_String_Pointer;
|
||||||
Handle: Ada.Wide_Text_IO.File_Type;
|
Handle: Ada.Wide_Text_IO.File_Type;
|
||||||
end record;
|
end record;
|
||||||
|
|
||||||
|
|
||||||
procedure Open (Stream: in out File_Stream_Record);
|
procedure Open (Stream: in out File_Stream_Record);
|
||||||
procedure Close (Stream: in out File_Stream_Record);
|
procedure Close (Stream: in out File_Stream_Record);
|
||||||
procedure Read (Stream: in out File_Stream_Record;
|
procedure Read (Stream: in out File_Stream_Record;
|
||||||
Data: out S.Object_String;
|
Data: out S.Object_String;
|
||||||
Last: out Standard.Natural);
|
Last: out S.Object_String_Size);
|
||||||
procedure Write (Stream: in out File_Stream_Record;
|
procedure Write (Stream: in out File_Stream_Record;
|
||||||
Data: out S.Object_String;
|
Data: out S.Object_String;
|
||||||
Last: out Standard.Natural);
|
Last: out S.Object_String_Size);
|
||||||
|
|
||||||
------------------------------------------------------------
|
------------------------------------------------------------
|
||||||
procedure Allocate_Stream (Interp: in out S.Interpreter_Record;
|
procedure Allocate_Stream (Interp: in out S.Interpreter_Record;
|
||||||
|
@ -1,3 +1,5 @@
|
|||||||
|
# This script requires QSEAWK.
|
||||||
|
|
||||||
BEGIN {
|
BEGIN {
|
||||||
printf ("-- Generated with ascii.txt and ascii.awk\n");
|
printf ("-- Generated with ascii.txt and ascii.awk\n");
|
||||||
printf ("-- Run qseawk -f ascii.awk ascii.txt > h2-ascii.ads for regeneration\n\n");
|
printf ("-- Run qseawk -f ascii.awk ascii.txt > h2-ascii.ads for regeneration\n\n");
|
||||||
|
@ -31,14 +31,14 @@ package body Token is
|
|||||||
Pool.Deallocate (Tmp);
|
Pool.Deallocate (Tmp);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Buffer := (null, 0, 0);
|
Buffer := ( Ptr => null, Len => 0, Last => 0);
|
||||||
end if;
|
end if;
|
||||||
end Purge_Buffer;
|
end Purge_Buffer;
|
||||||
|
|
||||||
procedure Append_Buffer (Interp: in out Interpreter_Record;
|
procedure Append_Buffer (Interp: in out Interpreter_Record;
|
||||||
Buffer: in out Buffer_Record;
|
Buffer: in out Buffer_Record;
|
||||||
Source: in Object_String) is
|
Source: in Object_String) is
|
||||||
Incr: Standard.Natural;
|
Incr: Object_String_Size;
|
||||||
begin
|
begin
|
||||||
if Buffer.Last >= Buffer.Len then
|
if Buffer.Last >= Buffer.Len then
|
||||||
if Buffer.Len <= 0 then
|
if Buffer.Len <= 0 then
|
||||||
|
@ -125,6 +125,19 @@ package body H2.Scheme is
|
|||||||
function Get_New_Location (Object: in Object_Pointer) return Object_Pointer;
|
function Get_New_Location (Object: in Object_Pointer) return Object_Pointer;
|
||||||
pragma Inline (Get_New_Location);
|
pragma Inline (Get_New_Location);
|
||||||
|
|
||||||
|
-----------------------------------------------------------------------------
|
||||||
|
-- FOR DEBUGGING. REMVOE THESE LATER
|
||||||
|
-----------------------------------------------------------------------------
|
||||||
|
procedure Output_Character_Array (Source: in Object_Character_Array) is
|
||||||
|
-- for debugging only.
|
||||||
|
begin
|
||||||
|
for I in Source'Range loop
|
||||||
|
--Ada.Text_IO.Put (Source(I));
|
||||||
|
-- TODO: note this is a hack for quick printing.
|
||||||
|
Ada.Text_IO.Put (Standard.Character'Val(Object_Character'Pos(Source(I))));
|
||||||
|
end loop;
|
||||||
|
end Output_Character_Array;
|
||||||
|
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- POINTER AND DATA CONVERSION
|
-- POINTER AND DATA CONVERSION
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
@ -262,104 +275,6 @@ package body H2.Scheme is
|
|||||||
return Object_Byte(Word / (2 ** Object_Pointer_Type_Bits));
|
return Object_Byte(Word / (2 ** Object_Pointer_Type_Bits));
|
||||||
end Pointer_To_Byte;
|
end Pointer_To_Byte;
|
||||||
|
|
||||||
-- Check if a character object contains a given string in the payload.
|
|
||||||
function Match (Object: in Object_Pointer;
|
|
||||||
Data: in Object_String) return Standard.Boolean is
|
|
||||||
Slot: Object_Character_Array renames Object.Character_Slot;
|
|
||||||
begin
|
|
||||||
return Slot(Slot'First .. Slot'Last - 1) = Object_Character_Array(Data);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure Copy_String (Source: in Object_String;
|
|
||||||
Target: out Object_Character_Array) is
|
|
||||||
begin
|
|
||||||
-- This procedure is not generic. The size of the Source
|
|
||||||
-- and Target must be in the expected length.
|
|
||||||
pragma Assert (Source'Length + 1 = Target'Length);
|
|
||||||
|
|
||||||
-- Method 1. Naive. It doesn't look Adaish.
|
|
||||||
-- ---------------------------------------------------------------------
|
|
||||||
--declare
|
|
||||||
-- X: Object_Size;
|
|
||||||
--begin
|
|
||||||
-- X := Target'First;
|
|
||||||
-- for I in Source'Range loop
|
|
||||||
-- Target(X) := Source(I);
|
|
||||||
-- X := X + 1;
|
|
||||||
-- end loop;
|
|
||||||
-- Target(X) := Object_Character'First; -- Object_Character'Val(0);
|
|
||||||
--end;
|
|
||||||
|
|
||||||
-- Method 2.
|
|
||||||
-- ObjectAda complains that the member of Object_String is not
|
|
||||||
-- aliased because Object_Character_Array is an array of aliased
|
|
||||||
-- Object_Character.It points to LRM 4.6(12); The component subtypes
|
|
||||||
-- shall statically match.
|
|
||||||
-- ---------------------------------------------------------------------
|
|
||||||
--Target(Target'First .. Target'Last - 1) := Object_Character_Array (Source(Source'First .. Source'Last));
|
|
||||||
--Target(Target'Last) := Object_Character'First; -- Object_Character'Val(0);
|
|
||||||
|
|
||||||
-- Method 3. Use unchecked conversion
|
|
||||||
declare
|
|
||||||
subtype Character_Array is Object_Character_Array (Target'First .. Target'Last - 1);
|
|
||||||
function To_Character_Array is new Ada.Unchecked_Conversion (Object_String, Character_Array);
|
|
||||||
begin
|
|
||||||
Target(Target'First .. Target'Last - 1) := To_Character_Array(Source);
|
|
||||||
Target(Target'Last) := Object_Character'First; -- Object_Character'Val(0);
|
|
||||||
end;
|
|
||||||
end Copy_String;
|
|
||||||
|
|
||||||
procedure Copy_String (Source: in Object_Character_Array;
|
|
||||||
Target: out Object_String) is
|
|
||||||
begin
|
|
||||||
pragma Assert (Source'Length = Target'Length + 1);
|
|
||||||
|
|
||||||
--declare
|
|
||||||
-- X: Standard.Natural;
|
|
||||||
--begin
|
|
||||||
-- X := Target'First;
|
|
||||||
-- for I in Source'First .. Source'Last - 1 loop
|
|
||||||
-- Target(X) := Source(I);
|
|
||||||
-- X := X + 1;
|
|
||||||
-- end loop;
|
|
||||||
--end;
|
|
||||||
|
|
||||||
declare
|
|
||||||
subtype Character_Array is Object_Character_Array (Source'First .. Source'Last - 1);
|
|
||||||
subtype String_Array is Object_String (Target'Range);
|
|
||||||
function To_Character_Array is new Ada.Unchecked_Conversion(Character_Array, String_Array);
|
|
||||||
begin
|
|
||||||
Target := To_Character_Array (Source (Source'First .. Source'Last - 1));
|
|
||||||
end;
|
|
||||||
end Copy_String;
|
|
||||||
|
|
||||||
function Character_Array_To_String (Source: in Object_Character_Array) return Object_String is
|
|
||||||
begin
|
|
||||||
-- ObjectAda complains that the member of Object_String is not
|
|
||||||
-- aliased because Object_Character_Array is an array of aliased
|
|
||||||
-- Object_Character. It points to LRM 4.6(12); The component subtypes
|
|
||||||
-- shall statically match. So let me turn to unchecked conversion.
|
|
||||||
declare
|
|
||||||
subtype Character_Array is Object_Character_Array (Source'First .. Source'Last - 1);
|
|
||||||
subtype String_Array is Object_String (1 .. Source'Length - 1);
|
|
||||||
function To_Character_Array is new Ada.Unchecked_Conversion (Character_Array, String_Array);
|
|
||||||
begin
|
|
||||||
return To_Character_Array (Source (Source'First .. Source'Last - 1));
|
|
||||||
--return String_Array (Source (Source'First .. Source'Last - 1));
|
|
||||||
end;
|
|
||||||
end Character_Array_To_String;
|
|
||||||
|
|
||||||
--Text_IO.Put (Character_Array_To_String (Atom.Character_Slot));
|
|
||||||
procedure Output_Character_Array (Source: in Object_Character_Array) is
|
|
||||||
-- for debugging only.
|
|
||||||
begin
|
|
||||||
for I in Source'First .. Source'Last loop
|
|
||||||
--Ada.Text_IO.Put (Source(I));
|
|
||||||
-- TODO: note this is a hack for quick printing.
|
|
||||||
Ada.Text_IO.Put (Standard.Character'Val(Object_Character'Pos(Source(I))));
|
|
||||||
end loop;
|
|
||||||
end Output_Character_Array;
|
|
||||||
|
|
||||||
-- TODO: move away these utilities routines
|
-- TODO: move away these utilities routines
|
||||||
--function To_Thin_String_Pointer (Source: in Object_Pointer) return Thin_String_Pointer is
|
--function To_Thin_String_Pointer (Source: in Object_Pointer) return Thin_String_Pointer is
|
||||||
-- type Character_Pointer is access all Object_Character;
|
-- type Character_Pointer is access all Object_Character;
|
||||||
@ -410,11 +325,9 @@ package body H2.Scheme is
|
|||||||
" at " & Object_Kind'Image(Source.Kind) &
|
" at " & Object_Kind'Image(Source.Kind) &
|
||||||
" size " & Object_Size'Image(Source.Size) & " - ");
|
" size " & Object_Size'Image(Source.Size) & " - ");
|
||||||
if Source.Kind = Moved_Object then
|
if Source.Kind = Moved_Object then
|
||||||
--Text_IO.Put_Line (Character_Array_To_String (Get_New_Location(Source).Character_Slot));
|
Output_Character_Array (Get_New_Location(Source).Character_Slot);
|
||||||
null;
|
|
||||||
else
|
else
|
||||||
--Text_IO.Put_Line (Character_Array_To_String (Source.Character_Slot));
|
Output_Character_Array (Source.Character_Slot);
|
||||||
null;
|
|
||||||
end if;
|
end if;
|
||||||
else
|
else
|
||||||
Ada.Text_IO.Put_Line (Msg & " at " & Object_Word'Image(W) & " at " & Object_Kind'Image(Source.Kind));
|
Ada.Text_IO.Put_Line (Msg & " at " & Object_Word'Image(W) & " at " & Object_Kind'Image(Source.Kind));
|
||||||
@ -424,7 +337,7 @@ package body H2.Scheme is
|
|||||||
function String_To_Integer_Pointer (Source: in Object_String) return Object_Pointer is
|
function String_To_Integer_Pointer (Source: in Object_String) return Object_Pointer is
|
||||||
V: Object_Integer := 0;
|
V: Object_Integer := 0;
|
||||||
Negative: Standard.Boolean := False;
|
Negative: Standard.Boolean := False;
|
||||||
First: Standard.Natural;
|
First: Object_String_Size;
|
||||||
begin
|
begin
|
||||||
-- TODO: BIGNUM, RANGE CHECK, ETC
|
-- TODO: BIGNUM, RANGE CHECK, ETC
|
||||||
pragma Assert (Source'Length > 0);
|
pragma Assert (Source'Length > 0);
|
||||||
@ -842,7 +755,8 @@ Ada.Text_IO.Put_Line (">>> [GC DONE]");
|
|||||||
Flags => 0,
|
Flags => 0,
|
||||||
Scode => 0,
|
Scode => 0,
|
||||||
Tag => Unknown_Object,
|
Tag => Unknown_Object,
|
||||||
Character_Slot => (others => Object_Character'First)
|
Character_Slot => (others => Ch.NUL),
|
||||||
|
Character_Terminator => Ch.NUL
|
||||||
);
|
);
|
||||||
|
|
||||||
return Result;
|
return Result;
|
||||||
@ -857,7 +771,7 @@ Ada.Text_IO.Put_Line (">>> [GC DONE]");
|
|||||||
end if;
|
end if;
|
||||||
|
|
||||||
Result := Allocate_Character_Object (Interp, Character_Object_Size'(Source'Length));
|
Result := Allocate_Character_Object (Interp, Character_Object_Size'(Source'Length));
|
||||||
Copy_String (Source, Result.Character_Slot);
|
Result.Character_Slot := Source;
|
||||||
return Result;
|
return Result;
|
||||||
end Allocate_Character_Object;
|
end Allocate_Character_Object;
|
||||||
|
|
||||||
@ -981,6 +895,7 @@ Ada.Text_IO.Put_Line (">>> [GC DONE]");
|
|||||||
Source: in Object_String) return Object_Pointer is
|
Source: in Object_String) return Object_Pointer is
|
||||||
Result: Object_Pointer;
|
Result: Object_Pointer;
|
||||||
begin
|
begin
|
||||||
|
Ada.Text_IO.Put_Line ("Make_String...");
|
||||||
Result := Allocate_Character_Object (Interp, Source);
|
Result := Allocate_Character_Object (Interp, Source);
|
||||||
Result.Tag := String_Object;
|
Result.Tag := String_Object;
|
||||||
--Print_Object_Pointer ("Make_String Result - " & Source, Result);
|
--Print_Object_Pointer ("Make_String Result - " & Source, Result);
|
||||||
@ -1013,7 +928,8 @@ Ada.Text_IO.Put_Line (">>> [GC DONE]");
|
|||||||
--Text_IO.Put_Line (Car.Kind'Img & Car.Tag'Img & Object_Word'Image(Pointer_To_Word(Car)));
|
--Text_IO.Put_Line (Car.Kind'Img & Car.Tag'Img & Object_Word'Image(Pointer_To_Word(Car)));
|
||||||
pragma Assert (Car.Tag = Symbol_Object);
|
pragma Assert (Car.Tag = Symbol_Object);
|
||||||
|
|
||||||
if Match(Car, Source) then
|
--if Match_Character_Object(Car, Source) then
|
||||||
|
if Car.Character_Slot = Source then
|
||||||
return Car;
|
return Car;
|
||||||
--Print_Object_Pointer ("Make_Symbol Result (Existing) - " & Source, Car);
|
--Print_Object_Pointer ("Make_Symbol Result (Existing) - " & Source, Car);
|
||||||
end if;
|
end if;
|
||||||
@ -1558,7 +1474,9 @@ Ada.Text_IO.Put_Line ("1111111111");
|
|||||||
Interp.Mark := Make_Mark (Interp.Self, 0); -- to indicate the end of cons evluation
|
Interp.Mark := Make_Mark (Interp.Self, 0); -- to indicate the end of cons evluation
|
||||||
Interp.Root_Environment := Make_Environment (Interp.Self, Nil_Pointer);
|
Interp.Root_Environment := Make_Environment (Interp.Self, Nil_Pointer);
|
||||||
Interp.Environment := Interp.Root_Environment;
|
Interp.Environment := Interp.Root_Environment;
|
||||||
|
Ada.Text_IO.Put_Line ("11111111111111111111111111111111111111");
|
||||||
Make_Syntax_Objects;
|
Make_Syntax_Objects;
|
||||||
|
Ada.Text_IO.Put_Line ("2222222222222222222222222");
|
||||||
Make_Procedure_Objects;
|
Make_Procedure_Objects;
|
||||||
Ada.Text_IO.Put_Line ("99999");
|
Ada.Text_IO.Put_Line ("99999");
|
||||||
|
|
||||||
|
@ -41,7 +41,6 @@ with Ada.Unchecked_Conversion;
|
|||||||
|
|
||||||
generic
|
generic
|
||||||
type Character_Type is (<>);
|
type Character_Type is (<>);
|
||||||
type String_Type is array (Standard.Positive range<>) of Character_Type;
|
|
||||||
package H2.Scheme is
|
package H2.Scheme is
|
||||||
|
|
||||||
type Interpreter_Record is limited private;
|
type Interpreter_Record is limited private;
|
||||||
@ -125,16 +124,16 @@ package H2.Scheme is
|
|||||||
type Object_Byte is mod 2 ** System.Storage_Unit;
|
type Object_Byte is mod 2 ** System.Storage_Unit;
|
||||||
for Object_Byte'Size use System.Storage_Unit;
|
for Object_Byte'Size use System.Storage_Unit;
|
||||||
|
|
||||||
--subtype Object_Character is Standard.Wide_Character;
|
|
||||||
--subtype Object_String is Standard.Wide_String;
|
|
||||||
subtype Object_Character is Character_Type;
|
subtype Object_Character is Character_Type;
|
||||||
subtype Object_String is String_Type;
|
subtype Object_String_Size is Object_Size range 0 .. Object_Size'Last - 1;
|
||||||
|
subtype Object_String_Range is Object_Size range 1 .. Object_Size'Last - 1;
|
||||||
|
type Object_String is array (Object_String_Range range <>) of Object_Character;
|
||||||
|
|
||||||
type Object_String_Pointer is access all Object_String;
|
type Object_String_Pointer is access all Object_String;
|
||||||
type Constant_Object_String_Pointer is access constant Object_String;
|
type Constant_Object_String_Pointer is access constant Object_String;
|
||||||
|
|
||||||
type Object_Byte_Array is array (Object_Size range <>) of Object_Byte;
|
type Object_Byte_Array is array (Object_Size range <>) of Object_Byte;
|
||||||
type Object_Character_Array is array (Object_Size range <>) of Object_Character;
|
subtype Object_Character_Array is Object_String;
|
||||||
type Object_Pointer_Array is array (Object_Size range <>) of Object_Pointer;
|
type Object_Pointer_Array is array (Object_Size range <>) of Object_Pointer;
|
||||||
type Object_Word_Array is array (Object_Size range <>) of Object_Word;
|
type Object_Word_Array is array (Object_Size range <>) of Object_Word;
|
||||||
|
|
||||||
@ -217,7 +216,8 @@ package H2.Scheme is
|
|||||||
when Pointer_Object =>
|
when Pointer_Object =>
|
||||||
Pointer_Slot: Object_Pointer_Array(1 .. Size) := (others => null);
|
Pointer_Slot: Object_Pointer_Array(1 .. Size) := (others => null);
|
||||||
when Character_Object =>
|
when Character_Object =>
|
||||||
Character_Slot: Object_Character_Array (0 .. Size) := (others => Object_Character'First);
|
Character_Slot: Object_Character_Array(1 .. Size) := (others => Object_Character'First);
|
||||||
|
Character_Terminator: Object_Character := Object_Character'First; -- TODO: can this guarantee termining NULL? require some attribute for it to work?
|
||||||
when Byte_Object =>
|
when Byte_Object =>
|
||||||
Byte_Slot: Object_Byte_Array(1 .. Size) := (others => 0);
|
Byte_Slot: Object_Byte_Array(1 .. Size) := (others => 0);
|
||||||
when Word_Object =>
|
when Word_Object =>
|
||||||
@ -294,11 +294,11 @@ package H2.Scheme is
|
|||||||
|
|
||||||
procedure Read (Stream: in out Stream_Record;
|
procedure Read (Stream: in out Stream_Record;
|
||||||
Data: out Object_String;
|
Data: out Object_String;
|
||||||
Last: out Standard.Natural) is abstract;
|
Last: out Object_String_Size) is abstract;
|
||||||
|
|
||||||
procedure Write (Stream: in out Stream_Record;
|
procedure Write (Stream: in out Stream_Record;
|
||||||
Data: out Object_String;
|
Data: out Object_String;
|
||||||
Last: out Standard.Natural) is abstract;
|
Last: out Object_String_Size) is abstract;
|
||||||
|
|
||||||
type Stream_Pointer is access all Stream_Record'Class;
|
type Stream_Pointer is access all Stream_Record'Class;
|
||||||
|
|
||||||
@ -331,8 +331,8 @@ package H2.Scheme is
|
|||||||
Stream: Stream_Pointer := null;
|
Stream: Stream_Pointer := null;
|
||||||
--Data: Object_String(1..2048) := (others => Object_Character'First);
|
--Data: Object_String(1..2048) := (others => Object_Character'First);
|
||||||
Data: Object_String(1..5) := (others => Object_Character'First);
|
Data: Object_String(1..5) := (others => Object_Character'First);
|
||||||
Last: Standard.Natural := 0;
|
Last: Object_String_Size := 0;
|
||||||
Pos: Standard.Natural := 0;
|
Pos: Object_String_Size := 0;
|
||||||
Flags: IO_Flags := 0; -- EOF, ERROR
|
Flags: IO_Flags := 0; -- EOF, ERROR
|
||||||
Next: IO_Pointer := null;
|
Next: IO_Pointer := null;
|
||||||
Iochar: IO_Character_Record; -- the last character read.
|
Iochar: IO_Character_Record; -- the last character read.
|
||||||
@ -419,14 +419,16 @@ package H2.Scheme is
|
|||||||
|
|
||||||
-- -----------------------------------------------------------------------------
|
-- -----------------------------------------------------------------------------
|
||||||
|
|
||||||
subtype Thin_String is Object_String (Standard.Positive'Range);
|
subtype Thin_String is Object_String (Object_String_Range'Range);
|
||||||
type Thin_String_Pointer is access all Thin_String;
|
type Thin_String_Pointer is access all Thin_String;
|
||||||
for Thin_String_Pointer'Size use Object_Pointer_Bits;
|
for Thin_String_Pointer'Size use Object_Pointer_Bits;
|
||||||
|
|
||||||
type Buffer_Record is record
|
type Buffer_Record is record
|
||||||
Ptr: Thin_String_Pointer := null;
|
Ptr: Thin_String_Pointer := null;
|
||||||
Len: Standard.Natural := 0;
|
Len: Object_String_Size := 0;
|
||||||
Last: Standard.Natural := 0;
|
Last: Object_String_Size := 0;
|
||||||
end record;
|
end record;
|
||||||
|
|
||||||
private
|
private
|
||||||
type Heap_Element_Array is array (Heap_Size range <>) of aliased Heap_Element;
|
type Heap_Element_Array is array (Heap_Size range <>) of aliased Heap_Element;
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user