reorganized h2
This commit is contained in:
229
h2/bin/scheme.adb
Normal file
229
h2/bin/scheme.adb
Normal file
@ -0,0 +1,229 @@
|
||||
|
||||
with H2.Wide;
|
||||
with H2.Slim;
|
||||
with H2.Pool;
|
||||
with Storage;
|
||||
with Slim_Stream;
|
||||
with Wide_Stream;
|
||||
with Ada.Text_IO;
|
||||
with Ada.Wide_Text_IO;
|
||||
with Ada.Unchecked_Deallocation;
|
||||
with Ada.Exceptions;
|
||||
|
||||
with H2.OS;
|
||||
with H2.IO;
|
||||
use type H2.System_Length;
|
||||
|
||||
with Interfaces.C;
|
||||
|
||||
procedure scheme is
|
||||
package Stream renames Wide_Stream;
|
||||
package Scheme renames H2.Wide.Scheme;
|
||||
--package Stream renames Slim_Stream;
|
||||
--package Scheme renames H2.Slim.Scheme;
|
||||
|
||||
Pool: aliased Storage.Global_Pool;
|
||||
SI: Scheme.Interpreter_Record;
|
||||
|
||||
I: Scheme.Object_Pointer;
|
||||
O: Scheme.Object_Pointer;
|
||||
|
||||
--String: aliased S.Object_String := "(car '(1 2 3))";
|
||||
String: aliased constant Scheme.Object_Character_Array := "((lambda (x y) (+ x y)) 9 7)";
|
||||
String_Stream: Stream.String_Input_Stream_Record (String'Unchecked_Access);
|
||||
--String_Stream: Stream.String_Input_Stream_Record := (Len => String'Length, Str => String, Pos => 0);
|
||||
|
||||
File_Name: aliased Scheme.Object_Character_Array := "test.adb";
|
||||
--File_Name: aliased constant Scheme.Object_Character_Array := "시험.scm";
|
||||
--File_Stream: Stream.File_Stream_Record (File_Name'Unchecked_Access);
|
||||
--File_Stream: Stream.File_Stream_Record := (Name => File_Name'Unchecked_Access);
|
||||
File_Stream: Stream.File_Stream_Record;
|
||||
|
||||
--procedure h2init;
|
||||
--pragma Import (C, h2init, "h2init");
|
||||
|
||||
begin
|
||||
--h2init;
|
||||
ada.text_io.put ("Object_Size'Last: ");
|
||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Object_Size'Last));
|
||||
|
||||
ada.text_io.put ("Object_Byte'Size: ");
|
||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Object_Byte'Size));
|
||||
ada.text_io.put ("Object_Word'Size: ");
|
||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Object_Word'Size));
|
||||
ada.text_io.put ("Object_Pointer'Size: ");
|
||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Object_Pointer'Size));
|
||||
|
||||
|
||||
ada.text_io.put ("Object_Pointer_Bits: ");
|
||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Object_Pointer_Bits));
|
||||
ada.text_io.put ("Object_Pointer_Bytes: ");
|
||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Object_Pointer_Bytes));
|
||||
ada.text_io.put ("Object_Header_Bytes: ");
|
||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Object_Header_Bytes));
|
||||
ada.text_io.put ("Object_Payload_Max_Bytes: ");
|
||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Object_Payload_Max_Bytes));
|
||||
|
||||
ada.text_io.put ("Byte_Object_Size_last: ");
|
||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Byte_Object_Size_Last));
|
||||
ada.text_io.put ("Pointer_Object_Size_last: ");
|
||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Pointer_Object_Size_Last));
|
||||
|
||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Empty_Object_Record'Size));
|
||||
ada.text_io.put_line (Scheme.Object_Size'Image(Scheme.Empty_Object_Record'Max_Size_In_Storage_Elements));
|
||||
|
||||
declare
|
||||
package OS is new H2.OS (
|
||||
H2.Slim.Character,
|
||||
H2.Wide.Character,
|
||||
H2.Slim.String,
|
||||
H2.Wide.String,
|
||||
H2.Wide.Utf8.To_Unicode_String,
|
||||
H2.Wide.Utf8.From_Unicode_String);
|
||||
package File renames OS.File;
|
||||
|
||||
F: File.File_Pointer;
|
||||
FL: File.Flag_Record;
|
||||
Length: H2.System_Length;
|
||||
Buffer: H2.System_Byte_Array (50 .. 100);
|
||||
begin
|
||||
--OS.File.Set_Flag_Bits (FL, OS.File.FLAG_WRITE);
|
||||
File.Set_Flag_Bits (FL, File.FLAG_READ);
|
||||
File.Open (F, H2.Wide.String'("/etc/passwd"), FL);
|
||||
File.Read (F, Buffer, Length);
|
||||
File.Close (F);
|
||||
|
||||
File.Write (OS.File.Get_Stdout, Buffer(Buffer'First .. Buffer'First + Length - 1), Length);
|
||||
end;
|
||||
|
||||
declare
|
||||
package IO is new H2.IO (
|
||||
H2.Slim.Character,
|
||||
H2.Wide.Character,
|
||||
H2.Slim.String,
|
||||
H2.Wide.String,
|
||||
H2.Wide.Utf8.To_Unicode_String,
|
||||
H2.Wide.Utf8.From_Unicode_String,
|
||||
H2.Wide.Utf8.Sequence_Length);
|
||||
|
||||
package File renames IO.File;
|
||||
|
||||
F, F2: File.File_Record;
|
||||
FL: File.Flag_Record;
|
||||
Buffer: H2.Slim.String (1 .. 200);
|
||||
BufferW: H2.Wide.String (1 .. 27);
|
||||
IL, OL: H2.System_Length;
|
||||
Option: File.Option_Record;
|
||||
begin
|
||||
--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 (Standard.String(Buffer(Buffer'First .. Buffer'First + Length - 1)));
|
||||
--File.Close (F);
|
||||
|
||||
ada.text_io.put_line ("------------------");
|
||||
|
||||
|
||||
--Stdout.Get_Line (..
|
||||
--Stdout.Print ("-----------------");
|
||||
--Stdout.Print_Line ("-------------------");
|
||||
|
||||
File.Set_Flag_Bits (FL, File.FLAG_READ);
|
||||
File.Set_Flag_Bits (FL, File.FLAG_NONBLOCK);
|
||||
File.Open (F, H2.Slim.String'("/tmp/xxx"), FL);
|
||||
|
||||
--Option := File.Get_Option(F2);
|
||||
File.Clear_Flag_Bits (FL, FL.Bits);
|
||||
File.Set_Flag_Bits (FL, File.FLAG_WRITE);
|
||||
File.Set_Flag_Bits (FL, File.FLAG_CREATE);
|
||||
File.Set_Flag_Bits (FL, File.FLAG_TRUNCATE);
|
||||
File.Open (F2, H2.Wide.String'("/tmp/yyy"), FL);
|
||||
|
||||
File.Set_Option_Bits (Option, File.Option_CRLF_IN);
|
||||
--File.Set_Option_Bits (Option, File.Option_CRLF_OUT);
|
||||
--Option.LF := IO.Ascii.Code.Colon;
|
||||
File.Set_Option (F2, Option);
|
||||
File.Set_Option (F, Option);
|
||||
|
||||
loop
|
||||
|
||||
--File.Get_Line (F, Buffer, IL);
|
||||
File.Get_Line (F, BufferW, IL);
|
||||
|
||||
--ada.text_io.put_line (standard.string(buffer(1..il)));
|
||||
--ada.wide_text_io.put_line (standard.wide_string(bufferw(1..il)));
|
||||
--File.Read (F, BufferW, IL);
|
||||
exit when IL <= 0;
|
||||
|
||||
--File.Put_Line (F2, Buffer(Buffer'First .. Buffer'First + IL - 1), OL);
|
||||
File.Put_Line (F2, BufferW(Buffer'First .. Buffer'First + IL - 1), OL);
|
||||
pragma Assert (IL = OL);
|
||||
|
||||
--Ada.Text_IO.PUt (Standard.String(Buffer(Buffer'First .. Buffer'First + IL - 1)));
|
||||
--Ada.Wide_Text_IO.Put_Line (Standard.Wide_String(BufferW(BufferW'First .. BufferW'First + IL - 1)));
|
||||
end loop;
|
||||
|
||||
--File.Write (F2, H2.Wide.String'("나는 피리부는 사나이 정말로 멋있는 사나이"), OL);
|
||||
--File.Write_Line (F2, H2.Wide.String'("이세상에 문디없어면 무슨재미로 너도 나도 만세."), OL);
|
||||
--File.Write_Line (F2, H2.Wide.String'("이세상에 for the first time 우하."), OL);
|
||||
--File.Write_Line (F2, H2.Wide.String'(""), OL);
|
||||
File.Close (F2);
|
||||
File.Close (F);
|
||||
|
||||
exception
|
||||
when Error: others =>
|
||||
Ada.Text_IO.Put_Line ("~~~~~~~~~~ EXCEPTION ~~~~~~~~~~" & Ada.Exceptions.Exception_Information(Error));
|
||||
|
||||
if File.Is_Open(F2) then
|
||||
File.Close (F2);
|
||||
end if;
|
||||
if File.Is_Open(F) then
|
||||
File.Close (F);
|
||||
end if;
|
||||
end;
|
||||
|
||||
declare
|
||||
|
||||
LC_ALL : constant Interfaces.C.int := 0;
|
||||
procedure setlocale (
|
||||
category : Interfaces.C.int;
|
||||
locale : Interfaces.C.char_array);
|
||||
pragma Import (C, setlocale);
|
||||
Empty : aliased Interfaces.C.char_array := (0 => Interfaces.C.nul);
|
||||
|
||||
begin
|
||||
setlocale (LC_ALL, Empty);
|
||||
end;
|
||||
|
||||
|
||||
Scheme.Open (SI, 2_000_000, Pool'Unchecked_Access);
|
||||
--Scheme.Open (SI, null);
|
||||
|
||||
-- Specify the named stream handler
|
||||
Scheme.Set_Option (SI, (Scheme.Stream_Option,
|
||||
Stream.Allocate_Stream'Access,
|
||||
Stream.Deallocate_Stream'Access)
|
||||
);
|
||||
|
||||
Scheme.Set_Option (SI, (Scheme.Trait_Option, Scheme.No_Optimization));
|
||||
|
||||
File_Stream.Name := File_Name'Unchecked_Access;
|
||||
begin
|
||||
Scheme.Set_Input_Stream (SI, File_Stream); -- specify main input stream
|
||||
--Schee.Set_Input_Stream (SI, String_Stream);
|
||||
exception
|
||||
when others =>
|
||||
Ada.Text_IO.Put_Line ("Cannot open Input Stream");
|
||||
end;
|
||||
--Scheme.Set_Output_Stream (SI, Stream); -- specify main output stream.
|
||||
|
||||
Ada.Text_IO.Put_Line ("-------------------------------------------");
|
||||
Scheme.Run_Loop (SI, I);
|
||||
Scheme.Print (SI, I);
|
||||
Scheme.Close (SI);
|
||||
|
||||
Ada.Text_IO.Put_Line ("BYE...");
|
||||
|
||||
end scheme;
|
Reference in New Issue
Block a user