-- --
-- B o d y --
-- --
--- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- Program to construct C header file a-einfo.h (C version of einfo.ads spec)
--- for use by Gigi. This header file contaInF all definitions and access
+-- for use by Gigi. This header file contains all definitions and access
-- functions, but does not contain set procedures, since Gigi is not allowed
-- to modify the GNAT tree)
Rtn : VString := Nul;
Term : VString := Nul;
+ InB : File_Type;
+ -- Used to read initial header from body
+
InF : File_Type;
-- Used to read full text of both spec and body
Ofile : File_Type;
-- Used to write output file
- wsp : Pattern := NSpan (' ' & ASCII.HT);
- Comment : Pattern := wsp & "--";
- For_Rep : Pattern := wsp & "for";
- Get_Func : Pattern := wsp * A & "function" & wsp & Break (' ') * Name;
- Inline : Pattern := wsp & "pragma Inline (" & Break (')') * Name;
- Get_Pack : Pattern := wsp & "package ";
- Get_Enam : Pattern := wsp & Break (',') * N & ',';
- Find_Fun : Pattern := wsp & "function";
- F_Subtyp : Pattern := wsp * A & "subtype " & Break (' ') * N;
- G_Subtyp : Pattern := wsp & "subtype" & wsp & Break (' ') * NewS
- & wsp & "is" & wsp & Break (" ;") * OldS
- & wsp & ';' & wsp & Rtab (0);
- F_Typ : Pattern := wsp * A & "type " & Break (' ') * N & " is (";
- Get_Nam : Pattern := wsp * A & Break (",)") * Nam & Len (1) * Term;
- Get_Styp : Pattern := wsp * A & "subtype " & Break (' ') * N;
- Get_N1 : Pattern := wsp & Break (' ') * N1;
- Get_N2 : Pattern := wsp & "-- " & Rest * N2;
- Get_N3 : Pattern := wsp & Break (';') * N3;
- Get_FN : Pattern := wsp * C & "function" & wsp & Break (" (") * FN;
- Is_Rturn : Pattern := BreakX ('r') & "return";
- Is_Begin : Pattern := wsp & "begin";
- Get_Asrt : Pattern := wsp & "pragma Assert";
- Semicoln : Pattern := BreakX (';');
- Get_Cmnt : Pattern := BreakX ('-') * A & "--";
- Get_Expr : Pattern := wsp & "return " & Break (';') * Expr;
- Chek_End : Pattern := wsp & "end" & BreakX (';') & ';';
- Get_B1 : Pattern := BreakX (' ') * A & " in " & Rest * B;
- Get_B2 : Pattern := BreakX (' ') * A & " = " & Rest * B;
- Get_B3 : Pattern := BreakX (' ') * A & " /= " & Rest * B;
- To_Paren : Pattern := wsp * Filler & '(';
- Get_Fml : Pattern := Break (" :") * Formal & wsp & ':' & wsp
- & BreakX (" );") * Formaltyp;
- Nxt_Fml : Pattern := wsp & "; ";
- Get_Rtn : Pattern := wsp & "return" & wsp & BreakX (" ;") * Rtn;
- Rem_Prn : Pattern := wsp & ')';
+ wsp : constant Pattern := NSpan (' ' & ASCII.HT);
+ Comment : constant Pattern := wsp & "--";
+ For_Rep : constant Pattern := wsp & "for";
+ Get_Func : constant Pattern := wsp * A & "function" & wsp
+ & Break (' ') * Name;
+ Inline : constant Pattern := wsp & "pragma Inline (" & Break (')') * Name;
+ Get_Pack : constant Pattern := wsp & "package ";
+ Get_Enam : constant Pattern := wsp & Break (',') * N & ',';
+ Find_Fun : constant Pattern := wsp & "function";
+ F_Subtyp : constant Pattern := wsp * A & "subtype " & Break (' ') * N;
+ G_Subtyp : constant Pattern := wsp & "subtype" & wsp & Break (' ') * NewS
+ & wsp & "is" & wsp & Break (" ;") * OldS
+ & wsp & ';' & wsp & Rtab (0);
+ F_Typ : constant Pattern := wsp * A & "type " & Break (' ') * N &
+ " is (";
+ Get_Nam : constant Pattern := wsp * A & Break (",)") * Nam
+ & Len (1) * Term;
+ Get_Styp : constant Pattern := wsp * A & "subtype " & Break (' ') * N;
+ Get_N1 : constant Pattern := wsp & Break (' ') * N1;
+ Get_N2 : constant Pattern := wsp & "-- " & Rest * N2;
+ Get_N3 : constant Pattern := wsp & Break (';') * N3;
+ Get_FN : constant Pattern := wsp * C & "function" & wsp
+ & Break (" (") * FN;
+ Is_Rturn : constant Pattern := BreakX ('r') & "return";
+ Is_Begin : constant Pattern := wsp & "begin";
+ Get_Asrt : constant Pattern := wsp & "pragma Assert";
+ Semicoln : constant Pattern := BreakX (';');
+ Get_Cmnt : constant Pattern := BreakX ('-') * A & "--";
+ Get_Expr : constant Pattern := wsp & "return " & Break (';') * Expr;
+ Chek_End : constant Pattern := wsp & "end" & BreakX (';') & ';';
+ Get_B1 : constant Pattern := BreakX (' ') * A & " in " & Rest * B;
+ Get_B2 : constant Pattern := BreakX (' ') * A & " = " & Rest * B;
+ Get_B3 : constant Pattern := BreakX (' ') * A & " /= " & Rest * B;
+ To_Paren : constant Pattern := wsp * Filler & '(';
+ Get_Fml : constant Pattern := Break (" :") * Formal & wsp & ':' & wsp
+ & BreakX (" );") * Formaltyp;
+ Nxt_Fml : constant Pattern := wsp & "; ";
+ Get_Rtn : constant Pattern := wsp & "return" & wsp & BreakX (" ;") * Rtn;
+ Rem_Prn : constant Pattern := wsp & ')';
M : Match_Result;
Create (Ofile, Out_File, "a-einfo.h");
end if;
+ Open (InB, In_File, "einfo.adb");
Open (InF, In_File, "einfo.ads");
Lineno := 0;
-
- -- Write header to output file
-
loop
Line := Get_Line (InF);
Lineno := Lineno + 1;
Match (Line,
"-- S p e c ",
"-- C Header File ");
-
Match (Line, "--", "/*");
Match (Line, Rtab (2) * A & "--", M);
Replace (M, A & "*/");
-- Read body to find inlined functions
+ Close (InB);
Close (InF);
Open (InF, In_File, "einfo.adb");
Lineno := 0;
Line := Getlin;
exit when not Match (Line, Get_Asrt);
- -- Pragma asser found, get its continuation lines
+ -- Pragma assert found, get its continuation lines
loop
exit when Match (Line, Semicoln);
Match (Line, Get_Cmnt, M);
Replace (M, A);
- -- Get continuations of return statemnt
+ -- Get continuations of return statement
while not Match (Line, Semicoln) loop
Nextlin := Getlin;
OSDN Git Service
