added experimental stream handling code

This commit is contained in:
2013-12-28 16:52:31 +00:00
parent de981a1706
commit 3721e3c1a6
10 changed files with 575 additions and 111 deletions

View File

@ -6,23 +6,62 @@
-- # # # # # # # # # # #
-- # # # # # # # # # # # # #
-- ##### #### # # ###### # # ###### # # #######
--
-- Literal
-- Number: 1, 10
-- String: "hello"
--
-- Environment
-- The environment holds the key/value pairs.
--
-- Procedure
-- Some builtin-procedure objects are registered to the top-level environment
-- upon start-up. You can break the mapping between a name and a procedure
-- as it's in the normal environment.
--
-- Syntax Object
-- Some syntax objects are registered upon start-up. They are handled
-- very specially when the list containing one of them as the first argument
-- is evaluated.
--
-- Evaluation Rule
-- A literal object evaluates to itself. A Symbol object evaluates to
-- a value found in the environment. List evaluation is slightly more
-- complex. Each element of a list is evluated using the standard evaluation
-- rule. The first argument acts as a function and the rest of the arguments
-- are applied to the function. An element must evaluate to a closure to be
-- a function. The syntax object bypasses the normal evaluation rule and is
-- evaluated according to the object-specific rule.
--
---------------------------------------------------------------------
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
type Interpreter_Record is limited private;
type Interpreter_Pointer is access all Interpreter_Record;
-- -----------------------------------------------------------------------------
-- While I could define Heap_Element and Heap_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 Heap_Element is mod 2 ** System.Storage_Unit;
type Heap_Size is range 0 .. (2 ** (System.Word_Size - 1)) - 1;
-- -----------------------------------------------------------------------
-- 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;
@ -173,8 +212,8 @@ package H2.Scheme is
-- 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.
-- to Object_Pointer_Bytes and checking the minimum allocation
-- size in Allocate_Bytes_In_Heap().
case Kind is
when Moved_Object =>
New_Pointer: Object_Pointer := null;
@ -248,26 +287,72 @@ package H2.Scheme is
pragma Inline (Pointer_To_Byte);
-- -----------------------------------------------------------------------------
-- While I could define Heap_Element and Heap_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 Heap_Element is mod 2 ** System.Storage_Unit;
type Heap_Size is range 0 .. (2 ** (System.Word_Size - 1)) - 1;
type Stream_Record is abstract tagged limited null record;
procedure Open (Stream: in out Stream_Record) is abstract;
procedure Close (Stream: in out Stream_Record) is abstract;
procedure Read (Stream: in out Stream_Record;
Data: out Object_String;
Last: out Standard.Natural) is abstract;
procedure Write (Stream: in out Stream_Record;
Data: out Object_String;
Last: out Standard.Natural) is abstract;
type Stream_Pointer is access all Stream_Record'Class;
type Stream_Allocator is access
procedure (Interp: in out Interpreter_Record;
Name: access Object_String;
Result: out Stream_Pointer);
type Stream_Deallocator is access
procedure (Interp: in out Interpreter_Record;
Source: in out Stream_Pointer);
type IO_Flags is mod 2 ** 4;
IO_End_Reached: constant IO_Flags := IO_Flags'(2#0001#);
IO_Error_Occurred: constant IO_Flags := IO_Flags'(2#0001#);
type IO_Record;
type IO_Pointer is access all IO_Record;
type IO_Record is record
--type IO_Record is limited record
Stream: Stream_Pointer := null;
--Data: Object_String(1..2048) := (others => ' ');
Data: Object_String(1..5) := (others => ' ');
Last: Standard.Natural := 0;
Pos: Standard.Natural := 0;
Flags: IO_Flags := 0; -- EOF, ERROR
Next: IO_Pointer;
end record;
-- -----------------------------------------------------------------------------
type Trait_Mask is mod 2 ** System.Word_Size;
No_Garbage_Collection: constant Trait_Mask := 2#0000_0000_0000_0001#;
No_Optimization: constant Trait_Mask := 2#0000_0000_0000_0010#;
type Option_Kind is (Trait_Option);
type Option_Kind is (Trait_Option, Stream_Option);
type Option_Record (Kind: Option_Kind) is record
case Kind is
when Trait_Option =>
Trait_Bits: Trait_Mask := 0;
when Stream_Option =>
Allocate: Stream_Allocator := null;
Deallocate: Stream_Deallocator := null;
end case;
end record;
-- -----------------------------------------------------------------------------
-- The nil/true/false object are represented by special pointer values.
@ -297,26 +382,6 @@ package H2.Scheme is
-- -----------------------------------------------------------------------------
type Interpreter_Record is limited private;
type Interpreter_Text_IO_Record is abstract tagged null record;
procedure Open (IO: in out Interpreter_Text_IO_Record;
Name: in Object_String) is abstract;
procedure Close (IO: in out Interpreter_Text_IO_Record) is abstract;
procedure Read (IO: in out Interpreter_Text_IO_Record;
Data: in Object_String;
Last: in Standard.Natural) is abstract;
procedure Write (IO: in out Interpreter_Text_IO_Record;
Data: out Object_String;
Last: out Standard.Natural) is abstract;
-- -----------------------------------------------------------------------------
procedure Make_Test_Object (Interp: in out Interpreter_Record; Result: out Object_Pointer);
procedure Open (Interp: in out Interpreter_Record;
@ -325,6 +390,21 @@ procedure Make_Test_Object (Interp: in out Interpreter_Record; Result: out Objec
procedure Close (Interp: in out Interpreter_Record);
function Get_Storage_Pool (Interp: in Interpreter_Record) return Storage_Pool_Pointer;
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);
procedure Set_Input_Stream (Interp: in out Interpreter_Record;
Stream: in out Stream_Record'Class);
-- Source must be open for Read() to work.
procedure Read (Interp: in out Interpreter_Record;
Result: out Object_Pointer);
procedure Evaluate (Interp: in out Interpreter_Record;
Source: in Object_Pointer;
Result: out Object_Pointer);
@ -332,12 +412,8 @@ procedure Make_Test_Object (Interp: in out Interpreter_Record; Result: out Objec
procedure Print (Interp: in out Interpreter_Record;
Source: in Object_Pointer);
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);
procedure Run_Loop (Interp: in out Interpreter_Record;
Result: out Object_Pointer);
-- -----------------------------------------------------------------------------
@ -361,12 +437,13 @@ private
Next: Object_Pointer := Nil_Pointer;
end record;
type Interpreter_Pointer is access all Interpreter_Record;
--type Interpreter_Record is tagged limited record
type Interpreter_Record is limited record
Self: Interpreter_Pointer := null;
--Self: Interpreter_Pointer := null;
Self: Interpreter_Pointer := Interpreter_Record'Unchecked_Access; -- Current instance's pointer
Storage_Pool: Storage_Pool_Pointer := null;
Trait: Option_Record(Trait_Option);
Stream: Option_Record(Stream_Option);
Heap: Heap_Pointer_Array := (others => null);
Current_Heap: Heap_Number := Heap_Number'First;
@ -380,9 +457,9 @@ private
R: Register_Record;
Line: Object_String(1..1024);
Line_Last: Standard.Natural;
Line_Pos: Standard.Natural;
-- TODO: Buffer_Record needs to be stacked to handle "load".
Input: aliased IO_Record;
IO: IO_Pointer := null;
end record;
end H2.Scheme;