deleted the mark object
This commit is contained in:
		| @ -171,6 +171,7 @@ procedure Execute (Interp: in out Interpreter_Record) is | |||||||
| 			Set_Frame_Opcode (Interp.Stack, Opcode_Grouped_Call_Finish);  | 			Set_Frame_Opcode (Interp.Stack, Opcode_Grouped_Call_Finish);  | ||||||
| 			Set_Frame_Operand (Interp.Stack, Get_Cdr(X)); | 			Set_Frame_Operand (Interp.Stack, Get_Cdr(X)); | ||||||
| 			Clear_Frame_Result (Interp.Stack); | 			Clear_Frame_Result (Interp.Stack); | ||||||
|  |  | ||||||
| 			Push_Frame (Interp, Opcode_Evaluate_Object, Get_Car(X)); | 			Push_Frame (Interp, Opcode_Evaluate_Object, Get_Car(X)); | ||||||
| 		--else | 		--else | ||||||
| 		--	-- Nothing to evaluate. | 		--	-- Nothing to evaluate. | ||||||
| @ -189,6 +190,7 @@ procedure Execute (Interp: in out Interpreter_Record) is | |||||||
| 			Set_Frame_Opcode (Interp.Stack, Opcode_Grouped_Call_Finish);  | 			Set_Frame_Opcode (Interp.Stack, Opcode_Grouped_Call_Finish);  | ||||||
| 			Set_Frame_Operand (Interp.Stack, Get_Cdr(X)); | 			Set_Frame_Operand (Interp.Stack, Get_Cdr(X)); | ||||||
| 			Clear_Frame_Result (Interp.Stack); | 			Clear_Frame_Result (Interp.Stack); | ||||||
|  |  | ||||||
| 			Push_Frame (Interp, Opcode_Evaluate_Object, Get_Car(X)); | 			Push_Frame (Interp, Opcode_Evaluate_Object, Get_Car(X)); | ||||||
| 		else | 		else | ||||||
| 			-- Nothing more to evaluate. | 			-- Nothing more to evaluate. | ||||||
|  | |||||||
| @ -137,9 +137,6 @@ package body H2.Scheme is | |||||||
| 	Frame_Environment_Index: constant Pointer_Object_Size := 4; | 	Frame_Environment_Index: constant Pointer_Object_Size := 4; | ||||||
| 	Frame_Result_Index: constant Pointer_Object_Size := 5; | 	Frame_Result_Index: constant Pointer_Object_Size := 5; | ||||||
|  |  | ||||||
| 	Mark_Object_Size: constant Pointer_Object_Size := 1; |  | ||||||
| 	Mark_Context_Index: constant Pointer_Object_Size := 1; |  | ||||||
|  |  | ||||||
| 	Procedure_Object_Size: constant Pointer_Object_Size := 1; | 	Procedure_Object_Size: constant Pointer_Object_Size := 1; | ||||||
| 	Procedure_Opcode_Index: constant Pointer_Object_Size := 1; | 	Procedure_Opcode_Index: constant Pointer_Object_Size := 1; | ||||||
|  |  | ||||||
| @ -738,7 +735,6 @@ ada.text_io.put_line ("HEAP SOURCE IS NIL"); | |||||||
| 		New_Heap := Interp.Current_Heap + 1; | 		New_Heap := Interp.Current_Heap + 1; | ||||||
|  |  | ||||||
| 		-- Migrate some root objects | 		-- Migrate some root objects | ||||||
| --Print_Object_Pointer (">>> [GC] ROOT OBJECTS ...", Interp.Mark); |  | ||||||
| --Print_Object_Pointer (">>> [GC] Stack BEFORE ...", Interp.Stack); | --Print_Object_Pointer (">>> [GC] Stack BEFORE ...", Interp.Stack); | ||||||
| 		if Is_Normal_Pointer(Interp.Stack) then | 		if Is_Normal_Pointer(Interp.Stack) then | ||||||
| 			Interp.Stack := Move_One_Object(Interp.Stack); | 			Interp.Stack := Move_One_Object(Interp.Stack); | ||||||
| @ -746,7 +742,6 @@ ada.text_io.put_line ("HEAP SOURCE IS NIL"); | |||||||
|  |  | ||||||
| 		Interp.Root_Environment := Move_One_Object(Interp.Root_Environment); | 		Interp.Root_Environment := Move_One_Object(Interp.Root_Environment); | ||||||
| 		Interp.Root_Frame := Move_One_Object(Interp.Root_Frame); | 		Interp.Root_Frame := Move_One_Object(Interp.Root_Frame); | ||||||
| 		Interp.Mark := Move_One_Object(Interp.Mark); |  | ||||||
|  |  | ||||||
| 		-- Migrate temporary object pointers | 		-- Migrate temporary object pointers | ||||||
| 		for I in Interp.Top.Data'First .. Interp.Top.Last loop | 		for I in Interp.Top.Data'First .. Interp.Top.Last loop | ||||||
| @ -1299,6 +1294,7 @@ Ada.Text_IO.Put_Line ("Make_String..."); | |||||||
| 		return Frame.Pointer_Slot(Frame_Parent_Index); | 		return Frame.Pointer_Slot(Frame_Parent_Index); | ||||||
| 	end Get_Frame_Parent; | 	end Get_Frame_Parent; | ||||||
|  |  | ||||||
|  |  | ||||||
| 	----------------------------------------------------------------------------- | 	----------------------------------------------------------------------------- | ||||||
|  |  | ||||||
| 	-- | 	-- | ||||||
| @ -1515,19 +1511,6 @@ Ada.Text_IO.Put_Line ("Make_String..."); | |||||||
| 	 | 	 | ||||||
| 	----------------------------------------------------------------------------- | 	----------------------------------------------------------------------------- | ||||||
|  |  | ||||||
| 	function Make_Mark (Interp:  access Interpreter_Record; |  | ||||||
| 	                    Context: in     Object_Integer) return Object_Pointer is |  | ||||||
| 		Mark: Object_Pointer; |  | ||||||
| 	begin |  | ||||||
| 		-- TODO: allocate it in a static heap, not in a normal heap. |  | ||||||
| 		Mark := Allocate_Pointer_Object (Interp, Mark_Object_Size, Nil_Pointer); |  | ||||||
| 		Mark.Pointer_Slot(Mark_Context_Index) := Integer_To_Pointer(Context); |  | ||||||
| 		Mark.Tag := Mark_Object; |  | ||||||
| 		return Mark; |  | ||||||
| 	end Make_Mark; |  | ||||||
|  |  | ||||||
| 	----------------------------------------------------------------------------- |  | ||||||
|  |  | ||||||
| 	function Make_Closure (Interp: access Interpreter_Record; | 	function Make_Closure (Interp: access Interpreter_Record; | ||||||
| 	                       Code:   in     Object_Pointer; | 	                       Code:   in     Object_Pointer; | ||||||
| 	                       Envir:  in     Object_Pointer) return Object_Pointer is | 	                       Envir:  in     Object_Pointer) return Object_Pointer is | ||||||
| @ -1787,7 +1770,6 @@ Ada.Text_IO.Put_Line ("Make_String..."); | |||||||
|  |  | ||||||
| -- TODO: disallow garbage collecion during initialization. | -- TODO: disallow garbage collecion during initialization. | ||||||
| 		Initialize_Heap (Initial_Heap_Size); | 		Initialize_Heap (Initial_Heap_Size); | ||||||
| 		Interp.Mark := Make_Mark(Interp.Self, 0); -- to indicate the end of cons evaluation |  | ||||||
|  |  | ||||||
| 		Interp.Root_Environment := Make_Environment(Interp.Self, Nil_Pointer); | 		Interp.Root_Environment := Make_Environment(Interp.Self, Nil_Pointer); | ||||||
| 		Interp.Root_Frame := Make_Frame(Interp.Self, Nil_Pointer, Opcode_To_Pointer(Opcode_Exit), Nil_Pointer, Interp.Root_Environment); | 		Interp.Root_Frame := Make_Frame(Interp.Self, Nil_Pointer, Opcode_To_Pointer(Opcode_Exit), Nil_Pointer, Interp.Root_Environment); | ||||||
| @ -1927,8 +1909,6 @@ Ada.Text_IO.Put_Line ("Make_String..."); | |||||||
| 						when Others => | 						when Others => | ||||||
| 							if Atom.Kind = Character_Object then | 							if Atom.Kind = Character_Object then | ||||||
| 								Output_Character_Array (Atom.Character_Slot); | 								Output_Character_Array (Atom.Character_Slot); | ||||||
| 							elsif Atom.Tag = Mark_Object then |  | ||||||
| 								Ada.Text_IO.Put ("#INTERNAL MARK#"); |  | ||||||
| 							else | 							else | ||||||
| 								Ada.Text_IO.Put ("#NOIMPL# => " & Object_Tag'Image(Atom.Tag)); | 								Ada.Text_IO.Put ("#NOIMPL# => " & Object_Tag'Image(Atom.Tag)); | ||||||
| 							end if; | 							end if; | ||||||
| @ -2102,7 +2082,8 @@ end if; | |||||||
| 	                                       Envir:   in     Object_Pointer) is | 	                                       Envir:   in     Object_Pointer) is | ||||||
| 		pragma Inline (Push_Frame_With_Environment); | 		pragma Inline (Push_Frame_With_Environment); | ||||||
| 	begin | 	begin | ||||||
| 		Interp.Stack := Make_Frame(Interp.Self, Interp.Stack, Opcode_To_Pointer(Opcode), Operand, Envir); | 		Interp.Stack := Make_Frame(Interp.Self, Interp.Stack, Opcode_To_Pointer(Opcode), | ||||||
|  | 		                           Operand, Envir); | ||||||
| 	end Push_Frame_With_Environment; | 	end Push_Frame_With_Environment; | ||||||
|  |  | ||||||
| 	procedure Pop_Frame (Interp: in out Interpreter_Record) is | 	procedure Pop_Frame (Interp: in out Interpreter_Record) is | ||||||
|  | |||||||
| @ -210,8 +210,7 @@ package H2.Scheme is | |||||||
| 		Procedure_Object, | 		Procedure_Object, | ||||||
| 		Closure_Object, | 		Closure_Object, | ||||||
| 		Continuation_Object, | 		Continuation_Object, | ||||||
| 		Frame_Object, | 		Frame_Object | ||||||
| 		Mark_Object |  | ||||||
| 	); | 	); | ||||||
|  |  | ||||||
| 	type Object_Record(Kind: Object_Kind; Size: Object_Size) is record | 	type Object_Record(Kind: Object_Kind; Size: Object_Size) is record | ||||||
| @ -500,8 +499,8 @@ private | |||||||
| 		Symbol_Table: Object_Pointer := Nil_Pointer; | 		Symbol_Table: Object_Pointer := Nil_Pointer; | ||||||
| 		Root_Environment: Object_Pointer := Nil_Pointer; | 		Root_Environment: Object_Pointer := Nil_Pointer; | ||||||
| 		Root_Frame: Object_Pointer := Nil_Pointer; | 		Root_Frame: Object_Pointer := Nil_Pointer; | ||||||
| 		Stack: aliased Object_Pointer := Nil_Pointer; | 		Stack: Object_Pointer := Nil_Pointer; | ||||||
| 		Mark: Object_Pointer := Nil_Pointer; | 		Active_Frame: Object_Pointer := NIl_Pointer;	 | ||||||
|  |  | ||||||
| 		Symbol: Common_Symbol_Record; | 		Symbol: Common_Symbol_Record; | ||||||
| 		Top: Top_Record; -- temporary object pointers | 		Top: Top_Record; -- temporary object pointers | ||||||
|  | |||||||
		Reference in New Issue
	
	Block a user