redefined Opcode_Type to enumeration

lib/h2-scheme-execute-apply.adb

@@ -420,7 +420,8 @@ r: object_pointer := get_frame_result(c);
 rw: object_word;
 for rw'address use r'address;
 begin
-ada.text_io.put ("Frame" & object_word'image(f) & " PUSH CONTINUATION CURRENT RESULT" & object_word'image(rw) & " ----> ");
+ada.text_io.put_line ("Frame" & object_word'image(f) & " " & Opcode_Type'Image(Get_Frame_Opcode(Interp.Stack)));
+ada.text_io.put ("                      CURRENT RESULT ");
 print (interp, r);
 end;
 
@@ -435,7 +436,7 @@ for w'address use c'address;
 f: object_word;
 for f'address use interp.stack'address;
 begin
-ada.text_io.put ("                      PUSH CONTINUATION");
+ada.text_io.put ("                      PUSH CONTINUATION ");
 ada.text_io.put (object_word'image(w) & " ");
 print (interp, c);
 end;
@@ -457,7 +458,8 @@ for w'address use func'address;
 f: object_word;
 for f'address use interp.stack'address;
 begin
-ada.text_io.put ("Frame" & object_word'image(f) & " POPING APPLY CONTINUATION -----> ");
+ada.text_io.put_line ("Frame" & object_word'image(f) & " " & Opcode_Type'Image(Get_Frame_Opcode(Interp.Stack)));
+ada.text_io.put ("                      POPPING ...  APPLY CONTINUATION -->> ");
 ada.text_io.put (object_word'image(w) & " ");
 end;
 Print (Interp, Args);
@@ -483,7 +485,7 @@ ada.text_io.put ("                      CURRENT RESULT " );
 print (interp, get_Frame_result(interp.stack));
 ada.text_io.put ("                      CURRENT OPERAND " );
 print (interp, get_Frame_operand(interp.stack));
-ada.text_io.put_line ("                      CURRENT OPCODE" & opcode_type'image(get_Frame_opcode(interp.stack)));
+ada.text_io.put_line ("                      CURRENT OPCODE " & opcode_type'image(get_Frame_opcode(interp.stack)));
 end;
 
 
@@ -533,7 +535,8 @@ declare
 w: object_word;
 for w'address use interp.stack'address;
 begin
-ada.text_io.put ("Frame" & object_word'image(w) & " OPERAND TO APPLY => ");
+ada.text_io.put_line ("Frame" & object_word'image(w) & " " & Opcode_Type'Image(Get_Frame_Opcode(Interp.Stack)));
+ada.text_io.put ("                      OPERAND TO APPLY => ");
 print (Interp, Operand);
 ada.text_io.put ("                      CURRENT RESULT => ");
 print (Interp, get_frame_result(interp.stack));

lib/h2-scheme-execute.adb

@@ -198,7 +198,8 @@ declare
 w: object_word;
 for w'address use interp.stack'address;
 begin
-ada.text_io.put ("Frame " & object_word'image(w) &  " EVAL-GROUP RESULT ");
+ada.text_io.put_line ("Frame" & object_word'image(w) & " " & Opcode_Type'Image(Get_Frame_Opcode(Interp.Stack)));
+ada.text_io.put ("                      EVAL-GROUP RESULT ");
 print (Interp, R);
 end;
 

lib/h2-scheme.adb

@@ -93,32 +93,35 @@ package body H2.Scheme is
 
 	subtype Moved_Object_Record is Object_Record (Moved_Object, 0);
 
-	subtype Opcode_Type is Object_Integer range 0 .. 22;
+	type Opcode_Type is (
-	Opcode_Exit:                 constant Opcode_Type := Opcode_Type'(0);
+		Opcode_Exit,
-	Opcode_Evaluate_Result:      constant Opcode_Type := Opcode_Type'(1);
+		Opcode_Evaluate_Result,
-	Opcode_Evaluate_Object:      constant Opcode_Type := Opcode_Type'(2);
+		Opcode_Evaluate_Object,
-	Opcode_Finish_And_Syntax:    constant Opcode_Type := Opcode_Type'(3); 
+		Opcode_Finish_And_Syntax,
-	Opcode_Finish_Define_Symbol: constant Opcode_Type := Opcode_Type'(4); 
+		Opcode_Finish_Define_Symbol,
-	Opcode_Finish_If_Syntax:     constant Opcode_Type := Opcode_Type'(5); 
+		Opcode_Finish_If_Syntax,
-	Opcode_Finish_Or_Syntax:     constant Opcode_Type := Opcode_Type'(6); 
+		Opcode_Finish_Or_Syntax,
+	
+		Opcode_Grouped_Call,  -- (begin ...), closure apply, let body
+		Opcode_Grouped_Call_Finish,
+		Opcode_Let_Binding,
+		Opcode_Letast_Binding,
+		Opcode_Letast_Binding_Finish,
+		Opcode_Let_Evaluation,
+		Opcode_Let_Finish,
+		Opcode_Procedure_Call,
+		Opcode_Set_Finish,
+	
+		Opcode_Apply,
+		Opcode_Read_Object,
+		Opcode_Read_List,
+		Opcode_Read_List_Cdr,
+		Opcode_Read_List_End,
+		Opcode_Close_List,
+		Opcode_Close_Quote
+	);
+	for Opcode_Type'Size use Object_Integer'Size;
 
-	Opcode_Grouped_Call:         constant Opcode_Type := Opcode_Type'(7); -- (begin ...), closure apply, let body
-	Opcode_Grouped_Call_Finish:  constant Opcode_Type := Opcode_Type'(8);
-	Opcode_Let_Binding:          constant Opcode_Type := Opcode_Type'(9);
-	Opcode_Letast_Binding:       constant Opcode_Type := Opcode_Type'(10);
-	Opcode_Letast_Binding_Finish:constant Opcode_Type := Opcode_Type'(11);
-	Opcode_Let_Evaluation:       constant Opcode_Type := Opcode_Type'(12);
-	Opcode_Let_Finish:           constant Opcode_Type := Opcode_Type'(13);
-	Opcode_Procedure_Call:       constant Opcode_Type := Opcode_Type'(14); 
-	Opcode_Set_Finish:           constant Opcode_Type := Opcode_Type'(15); 
-
-	Opcode_Apply:                constant Opcode_Type := Opcode_Type'(16);
-	Opcode_Read_Object:          constant Opcode_Type := Opcode_Type'(17);
-	Opcode_Read_List:            constant Opcode_Type := Opcode_Type'(18);
-	Opcode_Read_List_Cdr:        constant Opcode_Type := Opcode_Type'(19);
-	Opcode_Read_List_End:        constant Opcode_Type := Opcode_Type'(20);
-	Opcode_Close_List:           constant Opcode_Type := Opcode_Type'(21);
-	Opcode_Close_Quote:          constant Opcode_Type := Opcode_Type'(22);
 
 	-----------------------------------------------------------------------------
 	-- COMMON OBJECTS
@@ -276,12 +279,12 @@ package body H2.Scheme is
 
 	function Pointer_To_Word is new Ada.Unchecked_Conversion (Object_Pointer, Object_Word);
 	--function Pointer_To_Word (Pointer: in Object_Pointer) return Object_Word is
+	--	pragma Inline (Pointer_To_Word);
 	--	Word: Object_Word;
 	--	for Word'Address use Pointer'Address;
 	--begin
 	--	return Word;
 	--end Pointer_To_Word;
-	pragma Inline (Pointer_To_Word);
 
 	function Pointer_To_Integer (Pointer: in Object_Pointer) return Object_Integer is
 		Word: Object_Word := Pointer_To_Word (Pointer);
@@ -396,6 +399,24 @@ package body H2.Scheme is
 		return Integer_To_Pointer(V);
 	end String_To_Integer_Pointer;
 
+	-----------------------------------------------------------------------------
+	-- MORE CONVERSIONS
+	-----------------------------------------------------------------------------
+	--function Pointer_To_Opcode (Pointer: in Object_Pointer) return Opcode_Type renames Pointer_To_Integer;
+	--function Opcode_To_Pointer (Opcode: in Opcode_Type) return Object_Pointer renames Integer_To_Pointer;
+		
+	function Pointer_To_Opcode (Pointer: in Object_Pointer) return Opcode_Type is
+		pragma Inline (Pointer_To_Opcode);
+	begin
+		return Opcode_Type'Val(Pointer_To_Integer(Pointer));
+	end Pointer_To_Opcode;
+
+	function Opcode_To_Pointer (Opcode: in Opcode_Type) return Object_Pointer is
+		pragma Inline (Opcode_To_Pointer);
+	begin
+		 return Integer_To_Pointer(Opcode_Type'Pos(Opcode));
+	end Opcode_To_Pointer;
+
 	-----------------------------------------------------------------------------
 	-- MEMORY MANAGEMENT
 	-----------------------------------------------------------------------------
@@ -1246,15 +1267,15 @@ Ada.Text_IO.Put_Line ("Make_String...");
 		pragma Inline (Get_Frame_Opcode);
 		pragma Assert (Is_Frame(Frame));
 	begin
-		return Pointer_To_Integer(Frame.Pointer_Slot(Frame_Opcode_Index));
+		return Pointer_To_Opcode(Frame.Pointer_Slot(Frame_Opcode_Index));
 	end Get_Frame_Opcode;
 
 	procedure Set_Frame_Opcode (Frame:  in Object_Pointer; 
-	                            OpcodE: in Opcode_Type) is
+	                            Opcode: in Opcode_Type) is
 		pragma Inline (Set_Frame_Opcode);
 		pragma Assert (Is_Frame(Frame));
 	begin
-		Frame.Pointer_Slot(Frame_Opcode_Index) := Integer_To_Pointer(Opcode);
+		Frame.Pointer_Slot(Frame_Opcode_Index) := Opcode_To_Pointer(Opcode);
 	end Set_Frame_Opcode;
 
 	function Get_Frame_Operand (Frame: in Object_Pointer) return Object_Pointer is
@@ -1791,7 +1812,7 @@ Ada.Text_IO.Put_Line ("Make_String...");
 		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_Frame := Make_Frame(Interp.Self, Nil_Pointer, Integer_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);
 		Interp.Stack := Interp.Root_Frame;
 
 		Make_Syntax_Objects;
@@ -2087,8 +2108,6 @@ end if;
 		Ada.Text_IO.New_Line;
 	end Print;
 
-	function Pointer_To_Opcode (Pointer: in Object_Pointer) return Opcode_Type renames Pointer_To_Integer;
-	function Opcode_To_Pointer (Opcode: in Opcode_Type) return Object_Pointer renames Integer_To_Pointer;
 
 	procedure Push_Frame (Interp:  in out Interpreter_Record;
 	                      Opcode:  in     Opcode_Type;