passrc: initial program parsing. Fixed PasExpr constructor warnings. Added initial labels parsing

git-svn-id: trunk@15902 -

packages/fcl-passrc/src/pastree.pp

@@ -138,12 +138,12 @@ type
   TPasExpr = class(TPasElement)
     Kind      : TPasExprKind;
     OpCode    : TexprOpcode;
-    constructor Create(AParent : TPasElement; AKind: TPasExprKind; AOpCode: TexprOpcode);
+    constructor Create(AParent : TPasElement; AKind: TPasExprKind; AOpCode: TexprOpcode); virtual; overload;
   end;
 
   TUnaryExpr = class(TPasExpr)
     Operand   : TPasExpr;
-    constructor Create(AParent : TPasElement; AOperand: TPasExpr; AOpCode: TExprOpCode);
+    constructor Create(AParent : TPasElement; AOperand: TPasExpr; AOpCode: TExprOpCode); overload;
     function GetDeclaration(full : Boolean) : string; override;
     destructor Destroy; override;
   end;
@@ -153,28 +153,28 @@ type
   TBinaryExpr = class(TPasExpr)
     left      : TPasExpr;
     right     : TPasExpr;
-    constructor Create(AParent : TPasElement; xleft, xright: TPasExpr; AOpCode: TExprOpCode);
-    constructor CreateRange(AParent : TPasElement; xleft, xright: TPasExpr);
+    constructor Create(AParent : TPasElement; xleft, xright: TPasExpr; AOpCode: TExprOpCode); overload;
+    constructor CreateRange(AParent : TPasElement; xleft, xright: TPasExpr); overload;
     function GetDeclaration(full : Boolean) : string; override;
     destructor Destroy; override;
   end;
 
   TPrimitiveExpr = class(TPasExpr)
     Value     : AnsiString;
-    constructor Create(AParent : TPasElement; AKind: TPasExprKind; const AValue : Ansistring);
+    constructor Create(AParent : TPasElement; AKind: TPasExprKind; const AValue : Ansistring); overload;
     function GetDeclaration(full : Boolean) : string; override;
   end;
   
   TBoolConstExpr = class(TPasExpr)
     Value     : Boolean;
-    constructor Create(AParent : TPasElement; AKind: TPasExprKind; const ABoolValue : Boolean);
+    constructor Create(AParent : TPasElement; AKind: TPasExprKind; const ABoolValue : Boolean); overload;
     function GetDeclaration(full : Boolean) : string; override;
   end;
 
   { TNilExpr }
 
   TNilExpr = class(TPasExpr)
-    constructor Create(AParent : TPasElement);
+    constructor Create(AParent : TPasElement); overload;
     function GetDeclaration(full : Boolean) : string; override;
   end;
 
@@ -184,7 +184,7 @@ type
     Value     : TPasExpr;
     Params    : array of TPasExpr;
     {pekArray, pekFuncCall, pekSet}
-    constructor Create(AParent : TPasElement; AKind: TPasExprKind);
+    constructor Create(AParent : TPasElement; AKind: TPasExprKind); overload;
     function GetDeclaration(full : Boolean) : string; override;
     destructor Destroy; override;
     procedure AddParam(xp: TPasExpr);
@@ -199,7 +199,7 @@ type
 
   TRecordValues = class(TPasExpr)
     Fields    : array of TRecordValuesItem;
-    constructor Create(AParent : TPasElement);
+    constructor Create(AParent : TPasElement); overload;
     destructor Destroy; override;
     procedure AddField(const AName: AnsiString; Value: TPasExpr);
     function GetDeclaration(full : Boolean) : string; override;
@@ -209,7 +209,7 @@ type
 
   TArrayValues = class(TPasExpr)
     Values    : array of TPasExpr;
-    constructor Create(AParent : TPasElement);
+    constructor Create(AParent : TPasElement); overload;
     destructor Destroy; override;
     procedure AddValues(AValue: TPasExpr);
     function GetDeclaration(full : Boolean) : string; override;
@@ -270,6 +270,10 @@ type
     Filename   : String;  // the IN filename, only written when not empty.
   end;
 
+  { TPasProgram }
+
+  TPasProgram = class(TPasModule);
+
   { TPasPackage }
 
   TPasPackage = class(TPasElement)
@@ -736,6 +740,15 @@ type
     Commands: TStrings;
   end;
 
+  { TPasLabels }
+
+  TPasLabels = class(TPasImplElement)
+  public
+    Labels  : TStrings;
+    constructor Create(const AName: string; AParent: TPasElement); override;
+    destructor Destroy; override;
+  end;
+
   TPasImplBeginBlock = class;
   TPasImplRepeatUntil = class;
   TPasImplIfElse = class;
@@ -2422,6 +2435,7 @@ end;
 
 constructor TPasExpr.Create(AParent : TPasElement; AKind: TPasExprKind; AOpCode: TexprOpcode);
 begin
+  Create(ClassName, AParent);
   Kind:=AKind;
   OpCode:=AOpCode;
 end;
@@ -2645,4 +2659,18 @@ begin
   inherited Create(AParent,pekNil, eopNone);
 end;
 
+{ TPasLabels }
+
+constructor TPasLabels.Create(const AName:string;AParent:TPasElement);
+begin
+  inherited Create(AName,AParent);
+  Labels := TStringList.Create;
+end;
+
+destructor TPasLabels.Destroy;
+begin
+  Labels.Free;
+  inherited Destroy;
+end;
+
 end.

packages/fcl-passrc/src/pparser.pp

@@ -160,6 +160,7 @@ type
 
     procedure ParseMain(var Module: TPasModule);
     procedure ParseUnit(var Module: TPasModule);
+    procedure ParseProgram(var Module: TPasModule);
     procedure ParseInterface;
     procedure ParseImplementation;
     procedure ParseInitialization;
@@ -186,6 +187,7 @@ type
     procedure ParseProcBeginBlock(Parent: TProcedureBody);
     procedure ParseStatement(Parent: TPasImplBlock;
                              out NewImplElement: TPasImplElement);
+    procedure ParseLabels(AParent: TPasElement);
 
     property FileResolver: TFileResolver read FFileResolver;
     property Scanner: TPascalScanner read FScanner;
@@ -1226,6 +1228,7 @@ begin
   NextToken;
   case CurToken of
     tkUnit: ParseUnit(Module);
+    tkProgram: ParseProgram(Module);
     else
       ParseExc(Format(SParserExpectTokenError, ['unit']));
   end;
@@ -1253,6 +1256,26 @@ begin
   end;
 end;
 
+// Starts after the "program" token
+procedure TPasParser.ParseProgram(var Module: TPasModule);
+begin
+  Module := nil;
+  Module := TPasModule(CreateElement(TPasProgram, ExpectIdentifier,
+    Engine.Package));
+  CurModule:=Module;
+  try
+    if Assigned(Engine.Package) then
+    begin
+      Module.PackageName := Engine.Package.Name;
+      Engine.Package.Modules.Add(Module);
+    end;
+    NextToken;
+    ParseImplementation;
+  finally
+    CurModule:=nil;
+  end;
+end;
+
 // Starts after the "interface" token
 procedure TPasParser.ParseInterface;
 var
@@ -1537,7 +1560,12 @@ begin
           end
         else
           ParseExc(SParserSyntaxError);
-        end
+        end;
+      tklabel:
+        begin
+          if not (Declarations is TInterfaceSection) then
+            ParseLabels(Declarations);
+        end;
     else
       ParseExc(SParserSyntaxError);
     end;
@@ -2895,6 +2923,18 @@ begin
   end;
 end;
 
+procedure TPasParser.ParseLabels(AParent: TPasElement);
+var
+  Labels: TPasLabels;
+begin
+  Labels:=TPasLabels(CreateElement(TPasLabels, '', AParent));
+  repeat
+    Labels.Labels.Add(ExpectIdentifier);
+    NextToken;
+    if not (CurToken in [tkSemicolon, tkComma]) then
+      ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkSemicolon]]));
+  until CurToken=tkSemicolon;
+end;
 
 // Starts after the "procedure" or "function" token
 function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement;