added initial files
This commit is contained in:
24
lib/Makefile.in
Normal file
24
lib/Makefile.in
Normal file
@ -0,0 +1,24 @@
|
||||
all: @abs_builddir@/@ADA_OBJDIR@
|
||||
#gnatmake -x -aP@abs_builddir@ -Plib
|
||||
gprbuild @abs_builddir@/lib.gpr
|
||||
|
||||
install: install-exec install-data
|
||||
|
||||
install-data:
|
||||
|
||||
install-exec:
|
||||
|
||||
uninstall:
|
||||
|
||||
@abs_builddir@/@ADA_OBJDIR@:
|
||||
mkdir -p @abs_builddir@/@ADA_OBJDIR@
|
||||
|
||||
clean:
|
||||
rm -rf @abs_builddir@/@ADA_OBJDIR@
|
||||
rm -f @abs_builddir@/*.ali
|
||||
rm -f @abs_builddir@/*.so
|
||||
rm -f @abs_builddir@/*.a
|
||||
rm -f @abs_builddir@/*.cgpr
|
||||
|
||||
|
||||
distclean: clean
|
||||
86
lib/h2-pool.adb
Normal file
86
lib/h2-pool.adb
Normal file
@ -0,0 +1,86 @@
|
||||
with Ada.Unchecked_Conversion;
|
||||
with Ada.Unchecked_Deallocation;
|
||||
|
||||
package body H2.Pool is
|
||||
|
||||
function Allocate (Pool: in Storage_Pool_Pointer := null) return Pointer_Type is
|
||||
P: Storage_Pool_Pointer;
|
||||
|
||||
begin
|
||||
if Pool = null then
|
||||
P := Storage_Pool;
|
||||
else
|
||||
P := Pool;
|
||||
end if;
|
||||
|
||||
if P = null then
|
||||
return new Normal_Type;
|
||||
else
|
||||
declare
|
||||
type Pooled_Pointer is access Normal_Type;
|
||||
for Pooled_Pointer'Storage_Pool use P.all;
|
||||
function To_Pointer_Type is new Ada.Unchecked_Conversion (Pooled_Pointer, Pointer_Type);
|
||||
Tmp: Pooled_Pointer;
|
||||
begin
|
||||
Tmp := new Normal_Type;
|
||||
return To_Pointer_Type (Tmp);
|
||||
end;
|
||||
end if;
|
||||
end Allocate;
|
||||
|
||||
function Allocate (Source: in Normal_Type;
|
||||
Pool: in Storage_Pool_Pointer := null) return Pointer_Type is
|
||||
P: Storage_Pool_Pointer;
|
||||
begin
|
||||
if Pool = null then
|
||||
P := Storage_Pool;
|
||||
else
|
||||
P := Pool;
|
||||
end if;
|
||||
|
||||
if P = null then
|
||||
return new Normal_Type'(Source);
|
||||
else
|
||||
declare
|
||||
type Pooled_Pointer is access Normal_Type;
|
||||
for Pooled_Pointer'Storage_Pool use P.all;
|
||||
function To_Pointer_Type is new Ada.Unchecked_Conversion (Pooled_Pointer, Pointer_Type);
|
||||
Tmp: Pooled_Pointer;
|
||||
begin
|
||||
Tmp := new Normal_Type'(Source);
|
||||
return To_Pointer_Type (Tmp);
|
||||
end;
|
||||
end if;
|
||||
end Allocate;
|
||||
|
||||
procedure Deallocate (Target: in out Pointer_Type;
|
||||
Pool: in Storage_Pool_Pointer := null) is
|
||||
P: Storage_Pool_Pointer;
|
||||
begin
|
||||
if Pool = null then
|
||||
P := Storage_Pool;
|
||||
else
|
||||
P := Pool;
|
||||
end if;
|
||||
|
||||
if P = null then
|
||||
declare
|
||||
procedure Dealloc is new Ada.Unchecked_Deallocation (Normal_Type, Pointer_Type);
|
||||
begin
|
||||
Dealloc (Target);
|
||||
end;
|
||||
else
|
||||
declare
|
||||
type Pooled_Pointer is access Normal_Type;
|
||||
for Pooled_Pointer'Storage_Pool use P.all;
|
||||
function To_Pooled_Pointer is new Ada.Unchecked_Conversion (Pointer_Type, Pooled_Pointer);
|
||||
procedure Dealloc is new Ada.Unchecked_Deallocation (Normal_Type, Pooled_Pointer);
|
||||
Tmp: Pooled_Pointer := To_Pooled_Pointer (Target);
|
||||
begin
|
||||
Dealloc (Tmp);
|
||||
Target := null;
|
||||
end;
|
||||
end if;
|
||||
end Deallocate;
|
||||
|
||||
end H2.Pool;
|
||||
25
lib/h2-pool.ads
Normal file
25
lib/h2-pool.ads
Normal file
@ -0,0 +1,25 @@
|
||||
--------------------------------------------------------------------
|
||||
-- Instantantiate this package before using. To allocate integers,
|
||||
--
|
||||
-- package Integer_Pool is new Pool (Integer, Integer_Pointer, Storage_Pool);
|
||||
--
|
||||
-- Integer_Pool.Allocate (10);
|
||||
--------------------------------------------------------------------
|
||||
|
||||
generic
|
||||
type Normal_Type is private;
|
||||
type Pointer_Type is access Normal_Type;
|
||||
Storage_Pool: in Storage_Pool_Pointer := null;
|
||||
|
||||
package H2.Pool is
|
||||
|
||||
function Allocate (Pool: in Storage_Pool_Pointer := null) return Pointer_Type;
|
||||
|
||||
function Allocate (Source: in Normal_Type;
|
||||
Pool: in Storage_Pool_Pointer := null) return Pointer_Type;
|
||||
|
||||
procedure Deallocate (Target: in out Pointer_Type;
|
||||
Pool: in Storage_Pool_Pointer := null);
|
||||
|
||||
end H2.Pool;
|
||||
|
||||
1218
lib/h2-scheme.adb
Normal file
1218
lib/h2-scheme.adb
Normal file
File diff suppressed because it is too large
Load Diff
341
lib/h2-scheme.ads
Normal file
341
lib/h2-scheme.ads
Normal file
@ -0,0 +1,341 @@
|
||||
---------------------------------------------------------------------
|
||||
-- ##### # # #####
|
||||
-- # # #### # # ###### # # ###### # # # #
|
||||
-- # # # # # # ## ## # # # #
|
||||
-- ##### # ###### ##### # ## # ##### ##### ####### #####
|
||||
-- # # # # # # # # # # #
|
||||
-- # # # # # # # # # # # # #
|
||||
-- ##### #### # # ###### # # ###### # # #######
|
||||
---------------------------------------------------------------------
|
||||
|
||||
with System;
|
||||
with System.Storage_Pools;
|
||||
|
||||
|
||||
with Ada.Unchecked_Conversion;
|
||||
-- TODO: delete these after debugging
|
||||
with ada.text_io;
|
||||
with ada.wide_text_io;
|
||||
with ada.integer_text_io;
|
||||
with ada.long_integer_text_io;
|
||||
--with system.address_image;
|
||||
-- TODO: delete above after debugging
|
||||
|
||||
package H2.Scheme is
|
||||
|
||||
-- An object pointer takes up as many bytes as a system word.
|
||||
Object_Pointer_Bits: constant := System.Word_Size;
|
||||
Object_Pointer_Bytes: constant := Object_Pointer_Bits / System.Storage_Unit;
|
||||
|
||||
-- I use the lower 2 bits to indicate the type of an object pointer.
|
||||
-- A real object pointer is typically allocated on a word boundary.
|
||||
-- As a result, the lower 2 bits should always be 0. Using this
|
||||
-- property, I keep some other values at the lower 2 bits to indicate
|
||||
-- some other direct values like an integer or a character.
|
||||
Object_Pointer_Type_Bits: constant := 2;
|
||||
type Object_Pointer_Type is mod 2 ** Object_Pointer_Type_Bits;
|
||||
Object_Pointer_Type_Pointer: constant Object_Pointer_Type := 2#00#;
|
||||
Object_Pointer_Type_Integer: constant Object_Pointer_Type := 2#01#;
|
||||
Object_Pointer_Type_Character: constant Object_Pointer_Type := 2#10#;
|
||||
Object_Pointer_Type_Byte: constant Object_Pointer_Type := 2#11#;
|
||||
Object_Pointer_Type_Mask: constant Object_Pointer_Type := 2#11#;
|
||||
|
||||
type Object_Record;
|
||||
type Object_Pointer is access all Object_Record;
|
||||
for Object_Pointer'Size use Object_Pointer_Bits;
|
||||
|
||||
-- Object_Word is a numeric type as large as Object_Poinetr;
|
||||
type Object_Word is mod 2 ** Object_Pointer_Bits;
|
||||
for Object_Word'Size use Object_Pointer_Bits;
|
||||
|
||||
-- Object_Signed_Word is the signed version of Object_Word.
|
||||
-- Note Object_Word is a modular type while this is a signed range.
|
||||
type Object_Signed_Word is range -(2 ** (Object_Pointer_Bits - 1)) ..
|
||||
+(2 ** (Object_Pointer_Bits - 1)) - 1;
|
||||
for Object_Signed_Word'Size use Object_Pointer_Bits;
|
||||
|
||||
-- The actual number of bits for an integer the number of bits excluding
|
||||
-- the pointer type bits.
|
||||
Object_Integer_Bits: constant := Object_Pointer_Bits - Object_Pointer_Type_Bits;
|
||||
|
||||
-- Object_Integer represents the range of SmallInteger.
|
||||
-- It defines an integer that can be held in the upper Object_Integer_Bits
|
||||
-- bits. Conversion functions betwen Object_Integer and Object_Pointer
|
||||
-- use the highest 1 bit to represent the sign after shifting. So, the
|
||||
-- range is shrunk further by 1 bit, resulting in -2 in the foluma below.
|
||||
-- -----------------------------------------------------------------------
|
||||
-- type Object_Integer is range -(2 ** (Object_Integer_Bits - 2)) ..
|
||||
-- +(2 ** (Object_Integer_Bits - 2)) - 1;
|
||||
-- -----------------------------------------------------------------------
|
||||
-- If i don't include -(2 ** (Object_Integer_Bits - 1)) into the range,
|
||||
-- it can be extended to a larger range. That's because the excluded number
|
||||
-- conflicts with the highest sign bit during the conversion process.
|
||||
-- -----------------------------------------------------------------------
|
||||
type Object_Integer is range -(2 ** (Object_Integer_Bits - 1)) + 1 ..
|
||||
+(2 ** (Object_Integer_Bits - 1)) - 1;
|
||||
-- -----------------------------------------------------------------------
|
||||
-- What is a better choice? TODO: decide what to use
|
||||
-- -----------------------------------------------------------------------
|
||||
-- Let Object_Integer take up as large a space as Object_Pointer
|
||||
-- despite the actual range of Object_Integer.
|
||||
for Object_Integer'Size use Object_Pointer_Bits;
|
||||
|
||||
-- The Object_Size type defines the size of object payload.
|
||||
-- It is the number of payload items for each object kind.
|
||||
--type Object_Size is new Object_Word range 0 .. (2 ** (System.Word_Size - 1)) - 1;
|
||||
--type Object_Size is new Object_Word range 0 .. 1000; -- TODO: remove this line and uncommect the live above
|
||||
type Object_Size is new Object_Word;
|
||||
for Object_Size'Size use Object_Pointer_Bits; -- for GC
|
||||
|
||||
type Object_Byte is mod 2 ** 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;
|
||||
--package Text_IO renames Ada.Wide_Text_IO;
|
||||
subtype Object_Character is Standard.Character;
|
||||
subtype Object_String is Standard.String;
|
||||
package Text_IO renames Ada.Text_IO;
|
||||
|
||||
type Object_Byte_Array is array (Object_Size range <>) of Object_Byte;
|
||||
type Object_Character_Array is array (Object_Size range <>) of Object_Character;
|
||||
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_Kind is (
|
||||
Moved_Object, -- internal use only
|
||||
Pointer_Object,
|
||||
Character_Object,
|
||||
Byte_Object,
|
||||
Word_Object
|
||||
);
|
||||
for Object_Kind use (
|
||||
Moved_Object => 0,
|
||||
Pointer_Object => 1,
|
||||
Character_Object => 2,
|
||||
Byte_Object => 3,
|
||||
Word_Object => 4
|
||||
);
|
||||
|
||||
-- -----------------------------------------------------------------------
|
||||
|
||||
-- Object_Record contains the Flags field that can be used
|
||||
-- freely for management purpose. The Object_Flags type
|
||||
-- represents the value that can be stored in this field.
|
||||
type Object_Flags is mod 2 ** 4;
|
||||
Syntax_Object: constant Object_Flags := Object_Flags'(2#0001#);
|
||||
|
||||
type Syntax_Code is mod 2 ** 4;
|
||||
AND_SYNTAX: constant Syntax_Code := Syntax_Code'(0);
|
||||
BEGIN_SYNTAX: constant Syntax_Code := Syntax_Code'(0);
|
||||
CASE_SYNTAX: constant Syntax_Code := Syntax_Code'(0);
|
||||
COND_SYNTAX: constant Syntax_Code := Syntax_Code'(0);
|
||||
DEFINE_SYNTAX: constant Syntax_Code := Syntax_Code'(0);
|
||||
IF_SYNTAX: constant Syntax_Code := Syntax_Code'(0);
|
||||
LAMBDA_SYNTAX: constant Syntax_Code := Syntax_Code'(0);
|
||||
LET_SYNTAX: constant Syntax_Code := Syntax_Code'(0);
|
||||
LETAST_SYNTAX: constant Syntax_Code := Syntax_Code'(0);
|
||||
LETREC_SYNTAX: constant Syntax_Code := Syntax_Code'(0);
|
||||
OR_SYNTAX: constant Syntax_Code := Syntax_Code'(0);
|
||||
QUOTE_SYNTAX: constant Syntax_Code := Syntax_Code'(0);
|
||||
SET_SYNTAX: constant Syntax_Code := Syntax_Code'(0);
|
||||
|
||||
|
||||
type Object_Tag is (
|
||||
Unknown_Object,
|
||||
Cons_Object,
|
||||
String_Object,
|
||||
Symbol_Object,
|
||||
Number_Object,
|
||||
Array_Object,
|
||||
Table_Object,
|
||||
Lambda_Object,
|
||||
Continuation_Object,
|
||||
Frame_Object
|
||||
);
|
||||
|
||||
type Object_Record (Kind: Object_Kind; Size: Object_Size) is record
|
||||
Flags: Object_Flags := 0;
|
||||
Scode: Syntax_Code := 0;
|
||||
Tag: Object_Tag := Unknown_Object;
|
||||
|
||||
-- Object payload:
|
||||
-- I assume that the smallest payload is able to hold an
|
||||
-- object pointer by specifying the alignement attribute
|
||||
-- to Object_Pointer_Bytes. this implementation will break
|
||||
-- severely if this assumption is not correct.
|
||||
case Kind is
|
||||
when Moved_Object =>
|
||||
New_Pointer: Object_Pointer := null;
|
||||
when Pointer_Object =>
|
||||
Pointer_Slot: Object_Pointer_Array (1 .. Size) := (others => null);
|
||||
when Character_Object =>
|
||||
Character_Slot: Object_Character_Array (0 .. Size) := (others => Object_Character'First);
|
||||
when Byte_Object =>
|
||||
Byte_Slot: Object_Byte_Array (1 .. Size) := (others => 0);
|
||||
when Word_Object =>
|
||||
Word_Slot: Object_Word_Array (1 .. Size) := (others => 0);
|
||||
end case;
|
||||
end record;
|
||||
for Object_Record use record
|
||||
Kind at 0 range 0 .. 3; -- 4 bits (0 .. 15)
|
||||
Flags at 0 range 4 .. 7; -- 4 bits
|
||||
Scode at 0 range 8 .. 11; -- 4 bits (0 .. 15)
|
||||
Tag at 0 range 12 .. 15; -- 4 bits (0 .. 15)
|
||||
-- there are still some space unused in the first word. What can i do?
|
||||
end record;
|
||||
for Object_Record'Alignment use Object_Pointer_Bytes;
|
||||
|
||||
-- the following 3 size types are defined for limiting the object size range.
|
||||
subtype Empty_Object_Record is Object_Record (Byte_Object, 0);
|
||||
|
||||
-- the number of bytes in an object header. this is fixed in size
|
||||
Object_Header_Bytes: constant Object_Size := Empty_Object_Record'Max_Size_In_Storage_Elements;
|
||||
-- the largest number of bytes that an object can hold after the header
|
||||
Object_Payload_Max_Bytes: constant Object_Size := Object_Size'Last - Object_Header_Bytes;
|
||||
|
||||
-- the following types are defined to set the byte range of the object data.
|
||||
-- the upper bound is set to the maximum that don't cause overflow in calcuating the size in bits.
|
||||
-- the compiler doesn't seem to be able to return 'Size or 'Max_Size_In_Storage_Elements properly
|
||||
-- when the number of bits calculated overflows.
|
||||
subtype Byte_Object_Size is Object_Size range
|
||||
Object_Size'First .. (Object_Payload_Max_Bytes / (Object_Byte'Max_Size_In_Storage_Elements * System.Storage_Unit));
|
||||
subtype Character_Object_Size is Object_Size range
|
||||
Object_Size'First .. (Object_Payload_Max_Bytes / (Object_Character'Max_Size_In_Storage_Elements * System.Storage_Unit));
|
||||
subtype Pointer_Object_Size is Object_Size range
|
||||
Object_Size'First .. (Object_Payload_Max_Bytes / (Object_Pointer'Max_Size_In_Storage_Elements * System.Storage_Unit));
|
||||
subtype Word_Object_Size is Object_Size range
|
||||
Object_Size'First .. (Object_Payload_Max_Bytes / (Object_Word'Max_Size_In_Storage_Elements * System.Storage_Unit));
|
||||
|
||||
-- -----------------------------------------------------------------------------
|
||||
-- Various pointer classification and conversion procedures
|
||||
-- -----------------------------------------------------------------------------
|
||||
function Is_Pointer (Pointer: in Object_Pointer) return Standard.Boolean;
|
||||
function Is_Special_Pointer (Pointer: in Object_Pointer) return Standard.Boolean;
|
||||
function Is_Normal_Pointer (Pointer: in Object_Pointer) return Standard.Boolean;
|
||||
function Is_Integer (Pointer: in Object_Pointer) return Standard.Boolean;
|
||||
function Is_Character (Pointer: in Object_Pointer) return Standard.Boolean;
|
||||
function Is_Byte (Pointer: in Object_Pointer) return Standard.Boolean;
|
||||
|
||||
function Integer_To_Pointer (Int: in Object_Integer) return Object_Pointer;
|
||||
function Character_To_Pointer (Char: in Object_Character) return Object_Pointer;
|
||||
function Byte_To_Pointer (Byte: in Object_Byte) return Object_Pointer;
|
||||
|
||||
function Pointer_To_Integer (Pointer: in Object_Pointer) return Object_Integer;
|
||||
function Pointer_To_Character (Pointer: in Object_Pointer) return Object_Character;
|
||||
function Pointer_To_Byte (Pointer: in Object_Pointer) return Object_Byte;
|
||||
|
||||
pragma Inline (Is_Special_Pointer);
|
||||
pragma Inline (Is_Pointer);
|
||||
pragma Inline (Is_Integer);
|
||||
pragma Inline (Is_Character);
|
||||
pragma Inline (Integer_To_Pointer);
|
||||
pragma Inline (Character_To_Pointer);
|
||||
pragma Inline (Byte_To_Pointer);
|
||||
pragma Inline (Pointer_To_Integer);
|
||||
pragma Inline (Pointer_To_Character);
|
||||
pragma Inline (Pointer_To_Byte);
|
||||
|
||||
-- -----------------------------------------------------------------------------
|
||||
-- While I could define Memory_Element and Memory_Size to be
|
||||
-- the subtype of Object_Byte and Object_Size each, they are not
|
||||
-- logically the same thing.
|
||||
-- subtype Storage_Element is Object_Byte;
|
||||
-- subtype Storage_Count is Object_Size;
|
||||
type Memory_Element is mod 2 ** System.Storage_Unit;
|
||||
type Memory_Size is range 0 .. (2 ** (System.Word_Size - 1)) - 1;
|
||||
|
||||
type Interpreter_Record is limited private;
|
||||
|
||||
type Trait_Mask is mod 2 ** System.Word_Size;
|
||||
No_Garbage_Collection: constant Trait_Mask := 2 ** 0;
|
||||
|
||||
type Option_Kind is (Trait_Option);
|
||||
type Option_Record (Kind: Option_Kind) is record
|
||||
case Kind is
|
||||
when Trait_Option =>
|
||||
Trait_Bits: Trait_Mask := 0;
|
||||
end case;
|
||||
end record;
|
||||
|
||||
-- -----------------------------------------------------------------------------
|
||||
|
||||
-- The nil/true/false object are represented by special pointer values.
|
||||
-- The special values are defined under the assumption that actual objects
|
||||
-- are never allocated on one of these addresses. Addresses of 0, 4, 8 are
|
||||
-- very low, making the assumption pretty safe.
|
||||
Nil_Word: constant Object_Word := 2#0000#; -- 0
|
||||
--Nil_Pointer: constant Object_Pointer;
|
||||
--for Nil_Pointer'Address use Nil_Word'Address;
|
||||
--pragma Import (Ada, Nil_Pointer);
|
||||
|
||||
True_Word: constant Object_Word := 2#0100#; -- 4
|
||||
--True_Pointer: constant Object_Pointer;
|
||||
--for True_Pointer'Address use True_Word'Address;
|
||||
--pragma Import (Ada, True_Pointer);
|
||||
|
||||
False_Word: constant Object_Word := 2#1000#; -- 8
|
||||
--False_Pointer: constant Object_Pointer;
|
||||
--for False_Pointer'Address use False_Word'Address;
|
||||
--pragma Import (Ada, False_Pointer);
|
||||
|
||||
function Object_Word_To_Pointer is new Ada.Unchecked_Conversion (Object_Word, Object_Pointer);
|
||||
function Object_Pointer_To_Word is new Ada.Unchecked_Conversion (Object_Pointer, Object_Word);
|
||||
Nil_Pointer: constant Object_Pointer := Object_Word_To_Pointer (Nil_Word);
|
||||
True_Pointer: constant Object_Pointer := Object_Word_To_Pointer (True_Word);
|
||||
False_Pointer: constant Object_Pointer := Object_Word_To_Pointer (False_Word);
|
||||
|
||||
-- -----------------------------------------------------------------------------
|
||||
|
||||
procedure Open (Interp: in out Interpreter_Record;
|
||||
Initial_Heap_Size:in Memory_Size;
|
||||
Storage_Pool: in Storage_Pool_Pointer := null);
|
||||
|
||||
procedure Close (Interp: in out Interpreter_Record);
|
||||
|
||||
procedure Evaluate (Interp: in out Interpreter_Record);
|
||||
|
||||
procedure Set_Option (Interp: in out Interpreter_Record;
|
||||
Option: in Option_Record);
|
||||
|
||||
procedure Get_Option (Interp: in out Interpreter_Record;
|
||||
Option: in out Option_Record);
|
||||
|
||||
-- -----------------------------------------------------------------------------
|
||||
|
||||
private
|
||||
type Heap_Array is array (Memory_Size range <>) of aliased Memory_Element;
|
||||
|
||||
type Heap_Record (Size: Memory_Size) is record
|
||||
Space: Heap_Array (1 .. Size) := (others => 0);
|
||||
Bound: Memory_Size := 0;
|
||||
end record;
|
||||
for Heap_Record'Alignment use Object_Pointer_Bytes;
|
||||
type Heap_Pointer is access all Heap_Record;
|
||||
|
||||
type Heap_Number is mod 2 ** 1;
|
||||
type Heap_Pointer_Array is Array (Heap_Number'First .. Heap_Number'Last) of Heap_Pointer;
|
||||
|
||||
type Register_Record is limited record
|
||||
Code: Object_Pointer := Nil_Pointer;
|
||||
Envir: Object_Pointer := Nil_Pointer;
|
||||
Args: Object_Pointer := Nil_Pointer;
|
||||
Next: Object_Pointer := Nil_Pointer;
|
||||
end record;
|
||||
|
||||
type Interpreter_Record is limited record
|
||||
Storage_Pool: Storage_Pool_Pointer := null;
|
||||
Trait: Option_Record (Trait_Option);
|
||||
|
||||
Heap: Heap_Pointer_Array := (others => null);
|
||||
Current_Heap: Heap_Number := Heap_Number'First;
|
||||
|
||||
Root_Table: Object_Pointer := Nil_Pointer;
|
||||
Symbol_Table: Object_Pointer := Nil_Pointer;
|
||||
Environment: Object_Pointer := Nil_Pointer;
|
||||
Stack: Object_Pointer := Nil_Pointer;
|
||||
|
||||
R: Register_Record;
|
||||
end record;
|
||||
|
||||
end H2.Scheme;
|
||||
10
lib/h2.ads
Normal file
10
lib/h2.ads
Normal file
@ -0,0 +1,10 @@
|
||||
with System.Storage_Pools;
|
||||
|
||||
package H2 is
|
||||
|
||||
subtype Character is Standard.Wide_Character;
|
||||
|
||||
type Storage_Pool_Pointer is
|
||||
access all System.Storage_Pools.Root_Storage_Pool'Class;
|
||||
|
||||
end H2;
|
||||
33
lib/lib.gpr.in
Normal file
33
lib/lib.gpr.in
Normal file
@ -0,0 +1,33 @@
|
||||
project Lib is
|
||||
|
||||
for Source_Dirs use ("@abs_srcdir@");
|
||||
for Library_Name use "h2";
|
||||
for Library_Kind use "dynamic";
|
||||
for Library_Dir use ".";
|
||||
--for Library_Src_Dir use ".";
|
||||
for Object_Dir use "@ADA_OBJDIR@";
|
||||
|
||||
for Source_Files use (
|
||||
"h2.ads",
|
||||
"h2-pool.adb",
|
||||
"h2-pool.ads",
|
||||
"h2-scheme.adb",
|
||||
"h2-scheme.ads"
|
||||
);
|
||||
for Library_Interface use (
|
||||
"h2",
|
||||
"h2.pool",
|
||||
"h2.scheme"
|
||||
);
|
||||
|
||||
package Compiler is
|
||||
for Default_Switches ("Ada") use (
|
||||
"-gnata", "-gnato", "-gnatN", "-gnatwl"
|
||||
);
|
||||
end Compiler;
|
||||
|
||||
--package Install is
|
||||
-- for Prefix use "@prefix@";
|
||||
--end Install;
|
||||
end Lib;
|
||||
|
||||
10
lib/libh2.gpr.in
Normal file
10
lib/libh2.gpr.in
Normal file
@ -0,0 +1,10 @@
|
||||
project LibH2 is
|
||||
|
||||
for Library_Name use "h2";
|
||||
for Library_Kind use "dynamic";
|
||||
for Library_Dir use "@abs_builddir@";
|
||||
for Source_Files use ();
|
||||
for Externally_Built use "true";
|
||||
|
||||
end LibH2;
|
||||
|
||||
Reference in New Issue
Block a user