generation of pascal code for simple headers is nearly complete

bepascal/bepascal/codegen/apireader.pp

@@ -25,6 +25,9 @@ interface
 uses
   Classes, SysUtils, xmlread, dom;
   
+const
+  ImportFuncString =  ' cdecl; external BePascalLibName name ''%s_%s'';';
+
 type
   TNode = class(TObject)
   private
@@ -92,6 +95,7 @@ type
   private
     FResultType : TResultType;
     FClasse : TClasse;
+    BodyPas : string;
     function GetParam(Index : integer) : TParam;
   protected
   public
@@ -100,6 +104,10 @@ type
     function IsConstructor : boolean;
     function IsDestructor : boolean;
     function HasParams : boolean;
+    function ProcName : string;
+    function ProcNameInObject : string;    
+    function SelfParam : string;
+    function SelfParamImpl : string;
     procedure Start; override;
     procedure Ends; override;    
     property ResultType : TResultType read FResultType;
@@ -111,13 +119,16 @@ type
   protected
     function GetType : string;
   public
+    function IsObject : boolean;
     property Typ : string read GetType;
   end;
   TParam = class(TTypedItem)
   private
+    FFunction : TFunction;
   protected
   public
     procedure Middle; override;
+    property ParentFunction : TFunction read FFunction;
   end;
   TResultType = class(TNode)
   private
@@ -372,6 +383,7 @@ begin
       if Node.ChildNodes.Item[i].Attributes.GetNamedItem('NAME') <> nil then
       begin
         aParam := TParam.Create(Node.ChildNodes.Item[i]);
+        aParam.FFunction := Self;
         WriteLn('Param : ' + aParam.Name + '; ' + 'Type : ' + aParam.Typ);
         List.AddObject(aParam.Name, aParam);
       end
@@ -412,6 +424,42 @@ begin
   Result := (Count > 0);
 end;
 
+function TFunction.ProcName : string;
+begin
+  if IsConstructor then
+    Result := 'Create'
+  else if IsDestructor then
+    Result := 'Free'
+  else
+    Result := Name;
+end;
+
+function TFunction.ProcNameInObject : string;
+begin
+  if IsConstructor then
+    Result := 'Create'
+  else if IsDestructor then
+    Result := 'Destroy'
+  else
+    Result := Name;
+end;
+
+function TFunction.SelfParam : string;
+begin
+  if IsConstructor then
+    Result := '(AObject : TBeObject; '
+  else
+    Result := '(AObject : TCPlusObject; '
+end;
+
+function TFunction.SelfParamImpl : string;
+begin
+  if IsConstructor then
+    Result := '(Self, '
+  else
+    Result := '(CPlusObject, '
+end;
+
 procedure TFunction.Start;
 var
   EndChar : string;
@@ -424,49 +472,101 @@ begin
   with SourceWriter.InterfacePas do
   begin
     if IsConstructor then
-      Add(Format('    constructor %s%s', [Name, EndChar]))
+      Add(Format('    constructor %s%s', [ProcNameInObject, EndChar]))
     else if IsDestructor then
-      Add(Format('    destructor %s%s', [Name, EndChar]))
+      Add(Format('    destructor %s%s', [ProcNameInObject, EndChar]))
     else if (ResultType.Typ = '') or (ResultType.Typ = 'void') then
       Add(Format('    procedure %s%s', [Name, EndChar]))
     else
       Add(Format('    function %s%s', [Name, EndChar]));
   end;
+    // Import of C functions
+  with SourceWriter.ImportFuncsPas do
+  begin
+    if (ResultType.Typ = '') or (ResultType.Typ = 'void') then
+      Add(Format('procedure %s_%s%s', [Classe.Name, ProcName, SelfParam]))
+    else
+      Add(Format('function %s_%s%s', [Classe.Name, ProcName, SelfParam]));
+  end;
+  with SourceWriter.ImplementationPas do
+  begin
+    if (ResultType.Typ = '') or (ResultType.Typ = 'void') then
+      Add(Format('procedure %s.%s%s', [CppToPas(Classe.Name + ' *'), ProcName, EndChar]))
+    else
+      Add(Format('function %s.%s%s', [CppToPas(Classe.Name + ' *'), ProcName, EndChar]));    
+  end;
+  //Body
+    if (ResultType.Typ = '') or (ResultType.Typ = 'void') then
+      BodyPas := Format('  %s_%s%s', [Classe.Name, ProcName, SelfParamImpl])
+    else
+      BodyPas := Format('  %s_%s%s', [Classe.Name, ProcName, SelfParamImpl]);
 end;
 
 procedure TFunction.Ends;
 var
-  s : string;
   EndChar : string;
-begin
+  procedure DeleteLastSep(List : TStringList);
-  WriteLn('Function ends');
+  var
-  if hasParams then
+    s : string;
   begin
-    EndChar := ')';
+    // Delete the last '; '
-    with SourceWriter.InterfacePas do
+    s := List.Strings[List.Count - 1];
-    begin
+    System.Delete(s, Length(s) - 1, 2);
-      // Delete the last '; '
+    List.Strings[List.Count - 1] := s; 
-      s := Strings[Count - 1];
-      System.Delete(s, Length(s) - 1, 2);
-      Strings[Count - 1] := s;
-    end;
-  end
-  else
-  begin
-    EndChar := '';
   end;
-  with SourceWriter.InterfacePas do
+  procedure AddLastSep(List : TStringList);
+  var
+    s : string;
   begin
     if not((ResultType.Typ = '') or (ResultType.Typ = 'void')) then
     begin
       WriteLn(ResultType.Typ);
       WriteLn(Name);
-      s := Format('%s%s : %s;', [Strings[Count - 1], EndChar, CppToPas(ResultType.Typ)]);
+      s := Format('%s%s : %s;', [List.Strings[List.Count - 1], EndChar, CppToPas(ResultType.Typ)]);
-      Strings[Count - 1] := s;
+      List.Strings[List.Count - 1] := s;
     end
     else
-      Strings[Count - 1] := Format('%s%s;', [Strings[Count - 1], EndChar]);
+      List.Strings[List.Count - 1] := Format('%s%s;', [List.Strings[List.Count - 1], EndChar]);
   end;
+var
+  s : string;
+begin
+  WriteLn('Function ends');
+  if hasParams then
+  begin
+    EndChar := ')';
+    DeleteLastSep(SourceWriter.InterfacePas);
+  end
+  else
+  begin
+    EndChar := '';
+  end;
+  AddLastSep(SourceWriter.InterfacePas);
+    // Import C functions
+  EndChar := ')';
+  DeleteLastSep(SourceWriter.ImportFuncsPas);
+  AddLastSep(SourceWriter.ImportFuncsPas);
+  with SourceWriter.ImportFuncsPas do
+  begin
+    s := Format('%s' + ImportFuncString, [Strings[Count - 1], Classe.Name, ProcName]);
+    Strings[Count - 1] := s;
+  end;
+  
+  if hasParams then
+  begin
+    EndChar := ')';
+    DeleteLastSep(SourceWriter.ImplementationPas);
+  end
+  else
+  begin
+    EndChar := '';
+  end;
+  AddLastSep(SourceWriter.ImplementationPas);
+  SourceWriter.ImplementationPas.Add('begin');  
+  System.Delete(BodyPas, Length(BodyPas) - 1, 2);
+  SourceWriter.ImplementationPas.Add(BodyPas + ');');
+  SourceWriter.ImplementationPas.Add('end;');
+  SourceWriter.ImplementationPas.Add('');      
 end;
 
 function TTypedItem.GetType : string;
@@ -474,18 +574,31 @@ begin
   Result := FNode.Attributes.GetNamedItem('TYPE').NodeValue;
 end;
 
+function TTypedItem.IsObject : boolean;
+begin
+  // The first letter is a 'B' -> this is an object !
+  Result := (Typ[1] = 'B');
+end;
+
 procedure TParam.Middle;
-var
+  procedure WriteParam(List : TStringList);
-  s : string;
+  var
+    s : string;
+  begin
+    WriteLn(List.Strings[List.Count - 1]);
+    s := Format('%s%s : %s; ', [List.Strings[List.Count - 1], Name, CppToPas(Typ)]);
+    List.Strings[List.Count - 1] := s;
+    WriteLn(List.Strings[List.Count - 1]);    
+  end;
 begin
   WriteLn('Param Middle');
-  with SourceWriter.InterfacePas do
+  WriteParam(SourceWriter.InterfacePas);
-  begin
+  WriteParam(SourceWriter.ImportFuncsPas);
-    WriteLn(Strings[Count - 1]);
+  WriteParam(SourceWriter.ImplementationPas);
-    s := Format('%s%s : %s; ', [Strings[Count - 1], Name, CppToPas(Typ)]);
+  if IsObject then
-    Strings[Count - 1] := s;
+    ParentFunction.BodyPas := Format('%s%s.CPlusObject, ', [ParentFunction.BodyPas, Name])
-    WriteLn(Strings[Count - 1]);    
+  else
-  end;
+    ParentFunction.BodyPas := Format('%s%s, ', [ParentFunction.BodyPas, Name]);
 end;
 
 function TResultType.GetType : string;

bepascal/bepascal/codegen/sourcewrite.pp

@@ -118,8 +118,10 @@ begin
   FCpp.SaveToFile(FFileName + '.cpp');
   FCpp.Free;
   FPas.Add(FInterfacePas.Text);
-  FPas.Add(FImplementationPas.Text);
   FPas.Add(FImportFuncsPas.Text);
+  FPas.Add('implementation');
+  FPas.Add('');
+  FPas.Add(FImplementationPas.Text);
   // write the end of pascal unit
   FPas.Add('end.');
   FPas.SaveToFile(LowerCase(FFileName) + '.pp');

bepascal/bepascal/codegen/typmap.pp

@@ -14,12 +14,18 @@ const
   TypMapFileName = 'typemap.txt';
 var
   aTypMap : TStringList;
+  NewTypMap : TStringList;
 
 function CppToPas(CppType : string) : string;
+var
+  i : integer;
 begin
   Result := aTypMap.Values[CppType];
-//  if Result = '' then
+  if Result = '' then
-//    aTypMap.Values[CppType] := '';
+  begin
+    if not NewTypMap.Find(CppType + '=', i) then
+      NewTypMap.Add(CppType + '=');
+  end;
 end;
 
 function PasToCpp(PasType : string) : string;
@@ -32,10 +38,14 @@ initialization
   aTypMap := TStringList.Create;
   aTypMap.LoadFromFile(TypMapFileName);
   aTypMap.Sorted := True;
+  NewTypMap := TStringList.Create;
+	NewTypMap.Sorted := True;
   
 finalization
 //  WriteLn(aTypMap.Text);
   aTypMap.SaveToFile(TypMapFileName);
   aTypMap.Free;
-
+  NewTypMap.SaveToFile(TypMapFileName + '.new');
+  NewTypMap.Free;
+  
 end.