瀏覽代碼

* DLL support

git-svn-id: trunk@3623 -
peter 19 年之前
父節點
當前提交
a57708e63d
共有 3 個文件被更改,包括 81 次插入27 次删除
  1. 26 7
      compiler/link.pas
  2. 17 0
      compiler/ogbase.pas
  3. 38 20
      compiler/ogcoff.pas

+ 26 - 7
compiler/link.pas

@@ -88,6 +88,7 @@ Type
        procedure ParseScript_Order;
        procedure ParseScript_Order;
        procedure ParseScript_CalcPos;
        procedure ParseScript_CalcPos;
        procedure PrintLinkerScript;
        procedure PrintLinkerScript;
+       function  RunLinkScript(const outputname:string):boolean;
     protected
     protected
        property CObjInput:TObjInputClass read FCObjInput write FCObjInput;
        property CObjInput:TObjInputClass read FCObjInput write FCObjInput;
        property CExeOutput:TExeOutputClass read FCExeOutput write FCExeOutput;
        property CExeOutput:TExeOutputClass read FCExeOutput write FCExeOutput;
@@ -95,9 +96,11 @@ Type
        procedure DefaultLinkScript;virtual;abstract;
        procedure DefaultLinkScript;virtual;abstract;
        linkscript : TStringList;
        linkscript : TStringList;
     public
     public
+       IsSharedLibrary : boolean;
        Constructor Create;override;
        Constructor Create;override;
        Destructor Destroy;override;
        Destructor Destroy;override;
        Function  MakeExecutable:boolean;override;
        Function  MakeExecutable:boolean;override;
+       Function  MakeSharedLibrary:boolean;override;
        procedure AddExternalSymbol(const libname,symname:string);override;
        procedure AddExternalSymbol(const libname,symname:string);override;
      end;
      end;
 
 
@@ -819,6 +822,10 @@ end;
               ExeOutput.Load_Symbol(para)
               ExeOutput.Load_Symbol(para)
             else if keyword='ENTRYNAME' then
             else if keyword='ENTRYNAME' then
               ExeOutput.Load_EntryName(para)
               ExeOutput.Load_EntryName(para)
+            else if keyword='ISSHAREDLIBRARY' then
+              ExeOutput.Load_IsSharedLibrary
+            else if keyword='IMAGEBASE' then
+              ExeOutput.Load_ImageBase(para)
             else if keyword='READOBJECT' then
             else if keyword='READOBJECT' then
               Load_ReadObject(para)
               Load_ReadObject(para)
             else if keyword='READUNITOBJECTS' then
             else if keyword='READUNITOBJECTS' then
@@ -906,15 +913,13 @@ end;
       end;
       end;
 
 
 
 
-    function TInternalLinker.MakeExecutable:boolean;
+    function TInternalLinker.RunLinkScript(const outputname:string):boolean;
       label
       label
         myexit;
         myexit;
-      var
-        s,s2 : string;
       begin
       begin
-        MakeExecutable:=false;
+        result:=false;
 
 
-        Message1(exec_i_linking,current_module.exefilename^);
+        Message1(exec_i_linking,outputname);
 
 
 {$warning TODO Load custom linker script}
 {$warning TODO Load custom linker script}
         DefaultLinkScript;
         DefaultLinkScript;
@@ -951,7 +956,7 @@ end;
         if ErrorCount>0 then
         if ErrorCount>0 then
           goto myexit;
           goto myexit;
 
 
-        exeoutput.WriteExeFile(current_module.exefilename^);
+        exeoutput.WriteExeFile(outputname);
 
 
 {$warning TODO fixed section names}
 {$warning TODO fixed section names}
         status.codesize:=exeoutput.findexesection('.text').size;
         status.codesize:=exeoutput.findexesection('.text').size;
@@ -969,7 +974,21 @@ end;
         exeoutput.free;
         exeoutput.free;
         exeoutput:=nil;
         exeoutput:=nil;
 
 
-        MakeExecutable:=true;
+        result:=true;
+      end;
+
+
+    function TInternalLinker.MakeExecutable:boolean;
+      begin
+        IsSharedLibrary:=false;
+        result:=RunLinkScript(current_module.exefilename^);
+      end;
+
+
+    function TInternalLinker.MakeSharedLibrary:boolean;
+      begin
+        IsSharedLibrary:=true;
+        result:=RunLinkScript(current_module.sharedlibfilename^);
       end;
       end;
 
 
 
 

+ 17 - 0
compiler/ogbase.pas

@@ -362,6 +362,7 @@ interface
         property CExeSection:TExeSectionClass read FCExeSection write FCExeSection;
         property CExeSection:TExeSectionClass read FCExeSection write FCExeSection;
         property CObjData:TObjDataClass read FCObjData write FCObjData;
         property CObjData:TObjDataClass read FCObjData write FCObjData;
       public
       public
+        IsSharedLibrary : boolean;
         constructor create;virtual;
         constructor create;virtual;
         destructor  destroy;override;
         destructor  destroy;override;
         function  FindExeSection(const aname:string):TExeSection;
         function  FindExeSection(const aname:string):TExeSection;
@@ -369,6 +370,8 @@ interface
         procedure Load_Start;virtual;
         procedure Load_Start;virtual;
         procedure Load_EntryName(const aname:string);virtual;
         procedure Load_EntryName(const aname:string);virtual;
         procedure Load_Symbol(const aname:string);virtual;
         procedure Load_Symbol(const aname:string);virtual;
+        procedure Load_IsSharedLibrary;
+        procedure Load_ImageBase(const avalue:string);
         procedure Order_Start;virtual;
         procedure Order_Start;virtual;
         procedure Order_End;virtual;
         procedure Order_End;virtual;
         procedure Order_ExeSection(const aname:string);virtual;
         procedure Order_ExeSection(const aname:string);virtual;
@@ -1334,6 +1337,20 @@ implementation
       end;
       end;
 
 
 
 
+    procedure TExeOutput.Load_IsSharedLibrary;
+      begin
+        IsSharedLibrary:=true;
+      end;
+
+
+    procedure TExeOutput.Load_ImageBase(const avalue:string);
+      var
+        code : integer;
+      begin
+        val(avalue,ImageBase,code);
+      end;
+
+
     procedure TExeOutput.Load_Symbol(const aname:string);
     procedure TExeOutput.Load_Symbol(const aname:string);
       begin
       begin
         internalObjData.createsection('*'+aname,0,[]);
         internalObjData.createsection('*'+aname,0,[]);

+ 38 - 20
compiler/ogcoff.pas

@@ -1814,6 +1814,7 @@ const win32stub : array[0..131] of byte=(
                  end;
                  end;
 {$warning TODO idata keep can maybe replaced with grouping of text and idata}
 {$warning TODO idata keep can maybe replaced with grouping of text and idata}
                if (Copy(secname,1,6)='.idata') or
                if (Copy(secname,1,6)='.idata') or
+                  (Copy(secname,1,6)='.edata') or
                   (Copy(secname,1,6)='.rsrc') then
                   (Copy(secname,1,6)='.rsrc') then
                  include(secoptions,oso_keep);
                  include(secoptions,oso_keep);
                objsec:=TCoffObjSection(createsection(secname,secalign,secoptions));
                objsec:=TCoffObjSection(createsection(secname,secalign,secoptions));
@@ -2063,11 +2064,22 @@ const win32stub : array[0..131] of byte=(
         header      : coffheader;
         header      : coffheader;
         djoptheader : coffdjoptheader;
         djoptheader : coffdjoptheader;
         peoptheader : coffpeoptheader;
         peoptheader : coffpeoptheader;
-        rsrcexesec,
-        idataexesec,
         textExeSec,
         textExeSec,
         dataExeSec,
         dataExeSec,
         bssExeSec   : TExeSection;
         bssExeSec   : TExeSection;
+
+        procedure UpdateDataDir(const secname:string;idx:longint);
+        var
+          exesec : TExeSection;
+        begin
+          exesec:=FindExeSection(secname);
+          if assigned(exesec) then
+            begin
+              peoptheader.DataDirectory[idx].vaddr:=exesec.mempos;
+              peoptheader.DataDirectory[idx].size:=exesec.Size;
+           end;
+        end;
+
       begin
       begin
         result:=false;
         result:=false;
         FCoffSyms:=TDynamicArray.Create(symbolresize);
         FCoffSyms:=TDynamicArray.Create(symbolresize);
@@ -2096,9 +2108,9 @@ const win32stub : array[0..131] of byte=(
           header.opthdr:=sizeof(coffdjoptheader);
           header.opthdr:=sizeof(coffdjoptheader);
         if win32 then
         if win32 then
           begin
           begin
-            header.flag:=PE_FILE_EXECUTABLE_IMAGE or PE_FILE_RELOCS_STRIPPED or
-                         {PE_FILE_BYTES_REVERSED_LO or }
-                         PE_FILE_LINE_NUMS_STRIPPED;
+            header.flag:=PE_FILE_EXECUTABLE_IMAGE or PE_FILE_RELOCS_STRIPPED or PE_FILE_LINE_NUMS_STRIPPED;
+            if IsSharedLibrary then
+              header.flag:=header.flag or PE_FILE_DLL;
             if FindExeSection('.stab')=nil then
             if FindExeSection('.stab')=nil then
               header.flag:=header.flag or PE_FILE_DEBUG_STRIPPED;
               header.flag:=header.flag or PE_FILE_DEBUG_STRIPPED;
             if (cs_link_strip in aktglobalswitches) then
             if (cs_link_strip in aktglobalswitches) then
@@ -2151,18 +2163,9 @@ const win32stub : array[0..131] of byte=(
             peoptheader.SizeOfHeapCommit:=$1000;
             peoptheader.SizeOfHeapCommit:=$1000;
             peoptheader.LoaderFlags:=0;
             peoptheader.LoaderFlags:=0;
             peoptheader.NumberOfRvaAndSizes:=PE_DATADIR_ENTRIES;
             peoptheader.NumberOfRvaAndSizes:=PE_DATADIR_ENTRIES;
-            idataexesec:=FindExeSection('.idata');
-            if assigned(idataexesec) then
-              begin
-                peoptheader.DataDirectory[PE_DATADIR_IDATA].vaddr:=idataexesec.mempos;
-                peoptheader.DataDirectory[PE_DATADIR_IDATA].size:=idataexesec.Size;
-              end;
-            rsrcexesec:=FindExeSection('.rsrc');
-            if assigned(rsrcexesec) then
-              begin
-                peoptheader.DataDirectory[PE_DATADIR_RSRC].vaddr:=rsrcexesec.mempos;
-                peoptheader.DataDirectory[PE_DATADIR_RSRC].size:=rsrcexesec.Size;
-              end;
+            UpdateDataDir('.idata',PE_DATADIR_IDATA);
+            UpdateDataDir('.edata',PE_DATADIR_EDATA);
+            UpdateDataDir('.rsrc',PE_DATADIR_RSRC);
             FWriter.write(peoptheader,sizeof(peoptheader));
             FWriter.write(peoptheader,sizeof(peoptheader));
           end
           end
         else
         else
@@ -2409,10 +2412,22 @@ const win32stub : array[0..131] of byte=(
         with LinkScript do
         with LinkScript do
           begin
           begin
             Concat('READUNITOBJECTS');
             Concat('READUNITOBJECTS');
-            if apptype=app_gui then
-              Concat('ENTRYNAME _WinMainCRTStartup')
+            if IsSharedLibrary then
+              begin
+                Concat('ISSHAREDLIBRARY');
+                Concat('IMAGEBASE $10000000');
+                if apptype=app_gui then
+                  Concat('ENTRYNAME _DLLWinMainCRTStartup')
+                else
+                  Concat('ENTRYNAME _DLLMainCRTStartup');
+              end
             else
             else
-              Concat('ENTRYNAME _mainCRTStartup');
+              begin
+                if apptype=app_gui then
+                  Concat('ENTRYNAME _WinMainCRTStartup')
+                else
+                  Concat('ENTRYNAME _mainCRTStartup');
+              end;
             Concat('HEADER');
             Concat('HEADER');
             Concat('EXESECTION .text');
             Concat('EXESECTION .text');
             Concat('  OBJSECTION .text*');
             Concat('  OBJSECTION .text*');
@@ -2438,6 +2453,9 @@ const win32stub : array[0..131] of byte=(
             Concat('  OBJSECTION .idata$6');
             Concat('  OBJSECTION .idata$6');
             Concat('  OBJSECTION .idata$7');
             Concat('  OBJSECTION .idata$7');
             Concat('ENDEXESECTION');
             Concat('ENDEXESECTION');
+            Concat('EXESECTION .edata');
+            Concat('  OBJSECTION .edata*');
+            Concat('ENDEXESECTION');
             Concat('EXESECTION .rsrc');
             Concat('EXESECTION .rsrc');
             Concat('  OBJSECTION .rsrc*');
             Concat('  OBJSECTION .rsrc*');
             Concat('ENDEXESECTION');
             Concat('ENDEXESECTION');