Changeset 42 for branches/DelphiToC/Produce/UCSource.pas

Timestamp:

Aug 5, 2010, 3:13:03 PM (14 years ago)

Author:

george

Message:

Enhanced C code generation.

File:

• branches/DelphiToC/Produce/UCSource.pas (modified) (5 diffs)

branches/DelphiToC/Produce/UCSource.pas

@@ -7 +7 @@
 uses
   SysUtils, Variants, Classes, Graphics, Controls, Forms,
-  Dialogs, StdCtrls, UPascalSource, UCodeProducer;
+  Dialogs, StdCtrls, UPascalSource, UCodeProducer, StrUtils;
 
 type
+
+  { TCProducer }
+
   TCProducer = class(TCodeProducer)
+  private
+    function TranslateType(Name: string): string;
+    function TranslateOperator(Name: string): string;
+    procedure Emit(Text: string);
+    procedure GenerateCommonBlock(CommonBlock: TCommonBlock;
+      LabelPrefix: string);
+    procedure GenerateProgram(ProgramBlock: TProgram);
+    procedure GenerateBeginEnd(BeginEnd: TBeginEnd);
+    procedure GenerateCommand(Command: TCommand);
+    procedure GenerateWhileDo(WhileDo: TWhileDo);
+    procedure GenerateIfThenElse(IfThenElse: TIfThenElse);
+    procedure GenerateAssignment(Assignment: TAssignment);
+    procedure GenerateMethodCall(MethodCall: TMethodCall);
+    function GenerateExpression(Expression: TExpression): string;
+  public
     TextSource: TStringList;
+    IndentationLength: Integer;
+    Indetation: Integer;
     procedure Produce; override;
     constructor Create;
     destructor Destroy; override;
-  private
-    procedure GenerateCommonBlock(CommonBlock: TCommonBlock;
-      LabelPrefix: string);
-    procedure GenerateProgram(ProgramBlock: TProgram);
   end;
 
@@ -28 +44 @@
 begin
   TextSource := TStringList.Create;
+  IndentationLength := 2;
 end;
 
@@ -34 +51 @@
   TextSource.Free;
   inherited;
+end;
+
+function TCProducer.TranslateType(Name: string): string;
+begin
+  if Name = 'Byte' then Result := 'uint8_t';
+  if Name = 'Word' then Result := 'uint16_t';
+  if Name = 'Void' then Result := 'void';
+end;
+
+function TCProducer.TranslateOperator(Name: string): string;
+begin
+  if Name = '=' then Result := '=='
+  else if Name = 'shl' then Result := '<<'
+  else if Name = 'shr' then Result := '>>'
+  else if Name = 'not' then Result := '!'
+  else if Name = 'mod' then Result := '^'
+  else if Name = ':=' then Result := '='
+  else if Name = '@' then Result := '*'
+  else if Name = 'and' then Result := '&'
+  else if Name = 'or' then Result := '|'
+  else if Name = 'xor' then Result := '^'
+  else Result := Name;
+end;
+
+procedure TCProducer.Emit(Text: string);
+begin
+  TextSource.Add(DupeString(' ', IndentationLength * Indetation) + Text);
 end;
 
@@ -47 +91 @@
   I: Integer;
 begin
+  Indetation := 0;;
   with ProgramBlock do
   for I := 0 to Modules.Count - 1 do
     GenerateCommonBlock(TModule(Modules[I]), '');
+end;
+
+procedure TCProducer.GenerateBeginEnd(BeginEnd: TBeginEnd);
+var
+  I: Integer;
+begin
+  Emit('{');
+  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('');
+  end;
+
+  // Commands
+  for I := 0 to BeginEnd.Commands.Count - 1 do
+    GenerateCommand(TCommand(BeginEnd.Commands[I]));
+
+  Dec(Indetation);
+  Emit('}');
+end;
+
+procedure TCProducer.GenerateCommand(Command: TCommand);
+begin
+  if Command is TBeginEnd then GenerateBeginEnd(TBeginEnd(Command))
+  else if Command is TWhileDo then GenerateWhileDo(TWhileDo(Command))
+  else if Command is TIfThenElse then GenerateIfThenElse(TIfThenElse(Command))
+  else if Command is TAssignment then GenerateAssignment(TAssignment(Command))
+  else if Command is TMethodCall then GenerateMethodCall(TMethodCall(Command));
+end;
+
+procedure TCProducer.GenerateWhileDo(WhileDo: TWhileDo);
+begin
+  Emit('while (' + GenerateExpression(WhileDo.Condition) + ')');
+  GenerateCommand(WhileDo.Command);
+end;
+
+procedure TCProducer.GenerateIfThenElse(IfThenElse: TIfThenElse);
+begin
+  Emit('if(' + GenerateExpression(IfThenElse.Condition) + ')');
+  GenerateCommand(IfThenElse.Command);
+  Emit('else ');
+  GenerateCommand(IfThenElse.ElseCommand);
+end;
+
+procedure TCProducer.GenerateAssignment(Assignment: TAssignment);
+begin
+  Emit(Assignment.Target.Name + ' = ' + GenerateExpression(Assignment.Source) + ';');
+end;
+
+procedure TCProducer.GenerateMethodCall(MethodCall: TMethodCall);
+begin
+  Emit(MethodCall.Method.Name + '();');
+end;
+
+function TCProducer.GenerateExpression(Expression: TExpression): string;
+begin
+  case Expression.NodeType of
+    ntConstant: Result := Expression.Value;
+    ntVariable: Result := Expression.Variable.Name;
+    ntFunction: Result := Expression.Method.Name;
+    ntOperator: begin
+      Result := GenerateExpression(TExpression(Expression.SubItems.First))
+        + ' ' + TranslateOperator(Expression.OperatorName) + ' ' +
+        GenerateExpression(TExpression(Expression.SubItems.Last));
+    end;
+    ntNone: ;
+  end;
 end;
 
@@ -58 +175 @@
 begin
   with CommonBlock do begin
-    TextSource.Add('void ' + Name + '()');
-    TextSource.Add('{');
-
-    TextSource.Add('}');
+    Emit('void ' + Name + '()');
+    GenerateBeginEnd(Code);
   end;
 end;