Changeset 75 for branches/Transpascal/Compiler

Timestamp:

Oct 21, 2010, 7:56:25 AM (15 years ago)

Author:

george

Message:

• Modified: Parsing sections in record type.

Location:

branches/Transpascal/Compiler

Files:

• Analyze/UGrammer.pas (added)
• Analyze/UPascalParser.pas (modified) (14 diffs)
• Produce/UProducerC.pas (modified) (7 diffs)
• UCompiler.pas (modified) (1 diff)

branches/Transpascal/Compiler/Analyze/UPascalParser.pas

@@ -26 +26 @@
     procedure ParseUnitImplementation(SourceCode: TModuleUnit);
     procedure ParseProgram(SourceCode: TModuleProgram);
-    procedure ParseCommonBlock(SourceCode: TCommonBlock; EndSymbol: char = ';');
+    procedure ParseCommonBlock(SourceCode: TCommonBlock; EndSymbol: char = ';';
+      WithBody: Boolean = True);
     procedure ParseCommonBlockInterface(SourceCode: TCommonBlock);
     function ParseCommand(SourceCode: TCommonBlock): TCommand;
@@ -368 +369 @@
 
     ParseCommonBlock(Body, '.');
+    SourceCode.ParentProgram.Modules.Add(SourceCode);
   end;
 end;
@@ -384 +386 @@
   if NextToken = 'implementation' then
     ParseUnitImplementation(SourceCode);
+
+  SourceCode.ParentProgram.Modules.Add(SourceCode);
 
   if NextToken = 'initialization' then begin
@@ -411 +415 @@
     ParseUses(SourceCode.UsedModules, False);
 
-  ParseCommonBlock(SourceCode.Body, '.');
+  ParseCommonBlock(SourceCode.Body, '.', False);
 end;
 
@@ -417 +421 @@
 
 procedure TPascalParser.ParseCommonBlock(SourceCode: TCommonBlock;
-  EndSymbol: char = ';');
+  EndSymbol: char = ';'; WithBody: Boolean = True);
 begin
   with SourceCode do begin
     while (NextToken <> EndSymbol) do begin
-      if NextToken = 'var' then
+      if NextToken = 'var' then begin
+        Expect('var');
         ParseVariableList(Variables)
-      else if NextToken = 'const' then
+      end else
+      if NextToken = 'const' then begin
+        Expect('const');
         ParseConstantList(Constants)
-      else if NextToken = 'type' then
-        ParseTypeList(Types)
-      else if NextToken = 'procedure' then
+      end else
+      if NextToken = 'type' then begin
+        Expect('type');
+        ParseTypeList(Types);
+      end else
+      if NextToken = 'procedure' then
         ParseFunctionList(Functions)
       else if NextToken = 'function' then
         ParseFunctionList(Functions)
       else begin
-        ParseBeginEnd(Code);
+        if WithBody then
+          ParseBeginEnd(Code);
         Break;
       end;
     end;
-    Expect(EndSymbol);
+    if WithBody then Expect(EndSymbol);
   end;
 end;
@@ -444 +455 @@
   with SourceCode do begin
     while (NextToken <> 'implementation') and (NextTokenType <> ttEndOfFile) do begin
-      if NextToken = 'var' then
-        ParseVariableList(Variables)
-      else if NextToken = 'const' then
-        ParseConstantList(Constants, True)
-      else if NextToken = 'type' then
-        ParseTypeList(Types, True)
-      else if NextToken = 'procedure' then
+      if NextToken = 'var' then begin
+        Expect('var');
+        ParseVariableList(Variables);
+      end else
+      if NextToken = 'const' then begin
+        Expect('const');
+        ParseConstantList(Constants, True);
+      end else
+      if NextToken = 'type' then begin
+        Expect('type');
+        ParseTypeList(Types, True);
+      end else
+      if NextToken = 'procedure' then
         ParseFunctionList(Functions, True)
       else if NextToken = 'function' then
@@ -496 +513 @@
   I: integer;
 begin
+  try
   Identifiers := TStringList.Create;
   with SourceCode do begin
     with TFunction(Items[Add(TFunction.Create)]) do begin
       Parent := SourceCode.Parent;
-      if NextToken = 'procedure' then
-      begin
+      if NextToken = 'procedure' then begin
         Expect('procedure');
         HaveResult := False;
-      end
-      else
-      begin
+      end else begin
         Expect('function');
         HaveResult := True;
@@ -545 +560 @@
             end;
           end;
+          if NextToken = ';' then Expect(';');
         end;
         Expect(')');
@@ -580 +596 @@
     if not Exported then ParseCommonBlock(TFunction(Last));
   end;
-  Identifiers.Destroy;
+  finally
+    Identifiers.Free;
+  end;
 end;
 
@@ -638 +656 @@
   Identifiers := TStringList.Create;
   with SourceCode do begin
-    Expect('var');
     while IsIdentificator(NextToken) and (NextTokenType <> ttEndOfFile) do begin
       Identifiers.Clear;
@@ -694 +711 @@
 begin
   Identifiers := TStringList.Create;
-  with SourceCode do
-  begin
-    Expect('const');
-    while IsIdentificator(NextToken) do
-    begin
+  with SourceCode do begin
+    while IsIdentificator(NextToken) do begin
       ConstantName := ReadCode;
       Constant := Search(ConstantName);
-      if not Assigned(Constant) then
-      begin
+      if not Assigned(Constant) then begin
         Identifiers.Add(ConstantName);
-        while NextToken = ',' do
-        begin
+        while NextToken = ',' do begin
           Expect(',');
           Identifiers.Add(ReadCode);
         end;
-      end
-      else
+      end else
         ErrorMessage(SRedefineIdentifier, [ConstantName], -1);
       Expect(':');
@@ -742 +753 @@
   with SourceCode do
   begin
-    Expect('type');
     while IsIdentificator(NextToken) do begin
       NewType := ParseType(SourceCode);
@@ -872 +882 @@
 function TPascalParser.ParseTypeRecord(TypeList: TTypeList; Name: string
   ): TType;
+type
+  TSectionType = (stVar, stType, stConst);
 var
   Visibility: TTypeVisibility;
-begin
+  SectionType: TSectionType;
+begin
+  SectionType := stVar;
   Visibility := tvPublic;
       Expect('record');
       Result := TTypeRecord.Create;
       TTypeRecord(Result).Parent := TypeList;
+      TTypeRecord(Result).CommonBlock.Parent := TypeList.Parent;
       TType(Result).Name := Name;
       while (NextToken <> 'end') and (NextTokenType <> ttEndOfFile) do
@@ -898 +913 @@
           Visibility := tvProtected;
         end else
-        if NextToken = 'var' then
-          ParseVariableList(TTypeRecord(Result).CommonBlock.Variables)
-        else if NextToken = 'const' then
+        if NextToken = 'var' then begin
+          Expect('var');
+          SectionType := stVar
+        end else
+        if NextToken = 'const' then begin
+          Expect('const');
+          SectionType := stConst
+        end else
+        if NextToken = 'type' then begin
+          Expect('type');
+          SectionType := stType;
+        end;
+
+        if SectionType = stVar then begin
+          if NextToken = 'procedure' then
+            ParseFunctionList(TTypeRecord(Result).CommonBlock.Functions, True)
+          else if NextToken = 'function' then
+            ParseFunctionList(TTypeRecord(Result).CommonBlock.Functions, True)
+          else begin
+            ParseVariableList(TTypeRecord(Result).CommonBlock.Variables, True)
+            //TTypeRecord(Result).CommonBlock.Types.Add(ParseType(TypeList, True, ':'));
+            //TType(TTypeRecord(Result).CommonBlock.Types.Last).Visibility := Visibility;
+          end;                                                                          ParseVariableList(TTypeRecord(Result).CommonBlock.Variables)
+        end
+        else if SectionType = stConst then
           ParseConstantList(TTypeRecord(Result).CommonBlock.Constants, True)
-        else if NextToken = 'type' then
-          ParseTypeList(TTypeRecord(Result).CommonBlock.Types, True)
-        else if NextToken = 'procedure' then
-          ParseFunctionList(TTypeRecord(Result).CommonBlock.Functions, True)
-        else if NextToken = 'function' then
-          ParseFunctionList(TTypeRecord(Result).CommonBlock.Functions, True)
-        else begin
-          TTypeRecord(Result).CommonBlock.Types.Add(ParseType(TypeList, True, ':'));
-          TType(TTypeRecord(Result).CommonBlock.Types.Last).Visibility := Visibility;
-        end;
-        Expect(';');
+        else if SectionType = stType then
+          ParseTypeList(TTypeRecord(Result).CommonBlock.Types, True);
       end;
       Expect('end');

branches/Transpascal/Compiler/Produce/UProducerC.pas

@@ -29 +29 @@
     procedure GenerateFunctions(Functions: TFunctionList);
     procedure GenerateBeginEnd(BeginEnd: TBeginEnd);
+    procedure GenerateVariableList(VariableList: TVariableList);
+    procedure GenerateVariable(Variable: TVariable);
     procedure GenerateCommand(Command: TCommand);
     procedure GenerateWhileDo(WhileDo: TWhileDo);
@@ -123 +125 @@
     GenerateUses(TModuleProgram(Module).UsedModules);
     GenerateCommonBlock(TModuleProgram(Module).Body, '');
+  end else
+  if Module is TModuleUnit then begin
+    GenerateUses(TModuleProgram(Module).UsedModules);
+    GenerateCommonBlock(TModuleUnit(Module).Body, '');
   end;
 end;
@@ -176 +182 @@
   Inc(Indetation);
 
-
   // Variables
   if BeginEnd.Parent is TCommonBlock then begin
-    for I := 0 to BeginEnd.CommonBlock.Variables.Count - 1 do
-    with TVariable(BeginEnd.CommonBlock.Variables[I]) do
-      Emit(TranslateType(ValueType.Name) + ' ' + Name + ';');
-    Emit('');
+    GenerateVariableList(BeginEnd.CommonBlock.Variables);
   end;
 
@@ -191 +193 @@
   Dec(Indetation);
   Emit('}');
+end;
+
+procedure TProducerC.GenerateVariableList(VariableList: TVariableList);
+var
+  I: Integer;
+begin
+  for I := 0 to VariableList.Count - 1 do
+    GenerateVariable(TVariable(VariableList[I]));
+//  Emit('');
+end;
+
+procedure TProducerC.GenerateVariable(Variable: TVariable);
+begin
+  with Variable do
+    Emit(TranslateType(ValueType.Name) + ' ' + Name + ';');
 end;
 
@@ -296 +313 @@
   if Assigned(AType) then begin
   if AType is TTypeRecord then begin
-    Emit('typedef struct');
+    Emit('struct');
     Emit('{');
     Inc(Indetation);
-    for I := 0 to TTypeRecord(AType).CommonBlock.Types.Count - 1 do begin
-      GenerateType(TType(TTypeRecord(AType).CommonBlock.Types[I]));
-      Emit(';');
-    end;
+    GenerateVariableList(TTypeRecord(AType).CommonBlock.Variables);
     Dec(Indetation);
     Emit('} ' + TranslateType(AType.Name), False);
@@ -321 +335 @@
   end else begin
     if Assigned(AType.UsedType) then begin
-      GenerateType(AType.UsedType);
+      //GenerateType(AType.UsedType);
+      Emit(AType.UsedType.Name, False);
       Emit(' ', False);
     end;
@@ -338 +353 @@
     with TType(Types[I]) do
     if (not System) then begin
+      Emit('typedef ', False);
       GenerateType(TType(Types[I]));
       Emit(';');

branches/Transpascal/Compiler/UCompiler.pas

@@ -67 +67 @@
     Parser.Process;
     //ShowMessage(IntToHex(Integer(Addr(Parser.OnGetSource)), 8));
-    NewModule := Parser.ParseModule(ProgramCode);
-    ProgramCode.Modules.Add(NewModule);
+    Parser.ParseModule(ProgramCode);
     for I := 0 to ProgramCode.Modules.Count - 1 do begin
       Producer.Produce(TModule(ProgramCode.Modules[I]));