aboutsummaryrefslogtreecommitdiffstats
path: root/ortho
diff options
context:
space:
mode:
Diffstat (limited to 'ortho')
-rw-r--r--ortho/debug/ortho_debug.adb8
-rw-r--r--ortho/mcode/ortho_code_main.adb4
-rw-r--r--ortho/oread/ortho_front.adb48
3 files changed, 19 insertions, 41 deletions
diff --git a/ortho/debug/ortho_debug.adb b/ortho/debug/ortho_debug.adb
index 023729b27..ba0290426 100644
--- a/ortho/debug/ortho_debug.adb
+++ b/ortho/debug/ortho_debug.adb
@@ -410,7 +410,9 @@ package body Ortho_Debug is
is
subtype O_Cnode_Sizeof_Type is O_Cnode_Type (OC_Sizeof_Lit);
begin
- if Rtype.Kind /= ON_Unsigned_Type then
+ if Rtype.Kind /= ON_Unsigned_Type
+ and then Rtype.Kind /= ON_Access_Type
+ then
raise Type_Error;
end if;
Check_Complete_Type (Atype);
@@ -442,7 +444,9 @@ package body Ortho_Debug is
is
subtype O_Cnode_Offsetof_Type is O_Cnode_Type (OC_Offsetof_Lit);
begin
- if Rtype.Kind /= ON_Unsigned_Type then
+ if Rtype.Kind /= ON_Unsigned_Type
+ and then Rtype.Kind /= ON_Access_Type
+ then
raise Type_Error;
end if;
if Field.Parent /= Rec_Type then
diff --git a/ortho/mcode/ortho_code_main.adb b/ortho/mcode/ortho_code_main.adb
index 7454d8f1c..a0e6dc6c6 100644
--- a/ortho/mcode/ortho_code_main.adb
+++ b/ortho/mcode/ortho_code_main.adb
@@ -33,7 +33,7 @@ procedure Ortho_Code_Main
is
Output : String_Acc := null;
type Format_Type is (Format_Coff, Format_Elf);
- Format : Format_Type := Format_Elf;
+ Format : constant Format_Type := Format_Elf;
Fd : File_Descriptor;
First_File : Natural;
@@ -56,7 +56,7 @@ begin
I := 1;
while I <= Argc loop
declare
- Arg : String := Argument (I);
+ Arg : constant String := Argument (I);
begin
if Arg (1) = '-' then
if Arg'Length > 5 and then Arg (1 .. 5) = "--be-" then
diff --git a/ortho/oread/ortho_front.adb b/ortho/oread/ortho_front.adb
index 0d3e17875..2b82fd801 100644
--- a/ortho/oread/ortho_front.adb
+++ b/ortho/oread/ortho_front.adb
@@ -899,6 +899,7 @@ package body Ortho_Front is
function Parse_Constant_Value (Atype : Node_Acc) return O_Cnode;
function Parse_Address (Prefix : Node_Acc) return O_Enode;
+ function Parse_Constant_Address (Prefix : Node_Acc) return O_Cnode;
procedure Parse_Declaration;
procedure Parse_Compound_Statement;
@@ -1320,6 +1321,7 @@ package body Ortho_Front is
Res := New_Float_Literal (Atype.Type_Onode, Token_Float);
when Tok_Ident =>
declare
+ Pfx : Node_Acc;
N : Node_Acc;
begin
-- Note: we don't use get_decl, since the name can be a literal
@@ -1328,7 +1330,8 @@ package body Ortho_Front is
and then Token_Sym.Name.Inter.Kind = Decl_Type
then
-- A typed expression.
- N := Token_Sym.Name.Inter.Decl_Dtype;
+ Pfx := Token_Sym.Name.Inter;
+ N := Pfx.Decl_Dtype;
if Atype /= null and then N /= Atype then
Parse_Error ("type mismatch");
end if;
@@ -1345,6 +1348,11 @@ package body Ortho_Front is
Res := Parse_Sizeof (N);
elsif Token_Sym = Id_Alignof then
Res := Parse_Alignof (N);
+ elsif Token_Sym = Id_Address
+ or Token_Sym = Id_Unchecked_Address
+ or Token_Sym = Id_Subprg_Addr
+ then
+ Res := Parse_Constant_Address (Pfx);
elsif Token_Sym = Id_Conv then
Next_Expect (Tok_Left_Paren);
Next_Token;
@@ -2312,7 +2320,6 @@ package body Ortho_Front is
end if;
end if;
Expect (Tok_Right_Paren);
- Next_Token;
return Res;
end Parse_Constant_Address;
@@ -2346,7 +2353,8 @@ package body Ortho_Front is
| Type_Signed
| Type_Enum
| Type_Float
- | Type_Boolean =>
+ | Type_Boolean
+ | Type_Access =>
--return Parse_Primary_Expression (Atype);
return Parse_Typed_Literal (Atype);
when Type_Record =>
@@ -2397,40 +2405,6 @@ package body Ortho_Front is
Next_Token;
return Res;
end;
- when Type_Access =>
- -- The only way to initialize an access is either NULL
- -- or 'Address.
- if Tok = Tok_Null then
- Res := New_Null_Access (Atype.Type_Onode);
- Next_Token;
- return Res;
- end if;
-
- if Tok /= Tok_Ident then
- Parse_Error ("identifier expected for access literal");
- end if;
-
- declare
- T : Node_Acc;
- begin
- T := Get_Decl (Token_Sym);
- Next_Expect (Tok_Tick);
- Next_Token;
- if Tok = Tok_Left_Brack then
- if T.Kind /= Decl_Type
- or else T.Decl_Dtype.Kind /= Type_Access
- then
- Parse_Error ("name is not an access type name");
- end if;
- Next_Expect (Tok_Null);
- Next_Expect (Tok_Right_Brack);
- Next_Token;
- return New_Null_Access (Atype.Type_Onode);
- else
- Expect (Tok_Ident);
- return Parse_Constant_Address (T);
- end if;
- end;
when others =>
raise Program_Error;
end case;