Procházet zdrojové kódy

+ Support for Link on target especially for MacOS
+ TLinkerMPW
+ TAsmScriptMPW

olle před 21 roky
rodič
revize
dfa6403a70

+ 112 - 10
compiler/globals.pas

@@ -708,6 +708,97 @@ implementation
        FixFileName[0]:=s[0];
      end;
 
+   {Translates a unix or dos path to a mac path for use in MPW. 
+   If already a mac path, it does nothing. The origin of this 
+   algorithm will be put in macos/dos.pp, please update this
+   from that, because there is some flaws in the algo below.}
+    procedure TranslatePathToMac (var path: string);
+  
+      var
+        slashPos, oldpos, newpos, oldlen: Integer;
+        inname: Boolean;
+  
+    begin
+      slashPos := Pos('/', path);
+      if (slashPos <> 0) then   {its a unix path}
+        begin
+          if slashPos = 1 then  {its a full path}
+            begin
+              Delete(path,1,1);
+              Insert('{Boot}', path, 1);
+            end 
+          else {its a partial path}
+            Insert('/', path, 1);
+        end
+      else
+        begin
+          slashPos := Pos('\', path);
+          if (slashPos <> 0) then   {its a dos path}
+            begin
+              if slashPos = 1 then {its a full path, without drive letter}
+                begin
+                  Delete(path,1,1);
+                  Insert('{Boot}', path, 1);
+                end 
+              else if (Length(path) >= 2) and (path[2] = ':') then {its a full path, with drive letter}
+                begin
+                  Delete(path, 1, 2);
+                  Insert('{Boot}', path, 1)
+                end
+              else {its a partial path}
+                Insert('/', path, 1);
+            end;
+        end;
+  
+      if (slashPos <> 0) then   {its a unix or dos path}
+        begin
+          {Translate "/../" to "::" , "/./" to ":" and "/" to ":" ) in place. }
+          oldlen := Length(path);
+          newpos := 0;
+          oldpos := 0;
+          inname := false;
+          while oldpos < oldlen do
+            begin
+              oldpos := oldpos + 1;
+              case path[oldpos] of
+                '.': 
+                  if (((oldpos < oldlen) and (path[oldpos + 1] in ['.', '/', '\'])) or (oldpos = oldlen)) and not inname then
+                    begin {its really a lonely ".." or "."}
+                        {Skip two chars in any case. }
+                         {For ".." then ".." is skiped and for "." then "./" is skiped, this}
+                        {reqires the next char is a "/". Thats why a "/" was }
+                        {appended on the end above.}
+                      oldpos := oldpos + 1;
+                    end
+                  else  {its part of a filename (hidden unix file, e g ".nisse")}
+                    begin
+                      inname := true;
+                      newpos := newpos + 1;
+                      path[newpos] := path[oldpos];
+                    end;
+                '/', '\': 
+                  begin
+                    inname := false;
+                    newpos := newpos + 1;
+                    path[newpos] := ':';  {Exchange to mac dir separator.}
+                  end;
+                'A'..'Z' :
+                  begin
+                    inname := true;
+                    newpos := newpos + 1;
+                    path[newpos] :=char(byte(path[oldpos])+32);
+                  end;
+                else
+                  begin
+                    inname := true;
+                    newpos := newpos + 1;
+                    path[newpos] := path[oldpos];
+                  end;
+              end;
+            end;
+          SetLength(path,newpos);
+        end;
+    end;
 
     Function TargetFixPath(s:string;allowdot:boolean):string;
       var
@@ -734,11 +825,16 @@ implementation
 
    function TargetFixFileName(const s:string):string;
      var
-       i      : longint;
+       i : longint;
      begin
-       if target_info.files_case_relevent then
-        begin
-          for i:=1 to length(s) do
+       if target_info.system = system_powerpc_MACOS then
+         begin
+           TargetFixFileName:= s;
+           TranslatePathToMac(TargetFixFileName);
+         end
+       else if target_info.files_case_relevent then
+         begin
+           for i:=1 to length(s) do
            begin
              case s[i] of
                '/','\' :
@@ -747,10 +843,11 @@ implementation
                  TargetFixFileName[i]:=s[i];
              end;
            end;
-        end
+           TargetFixFileName[0]:=s[0];
+         end
        else
-        begin
-          for i:=1 to length(s) do
+         begin
+           for i:=1 to length(s) do
            begin
              case s[i] of
                '/','\' :
@@ -761,8 +858,8 @@ implementation
                   TargetFixFileName[i]:=s[i];
              end;
            end;
-        end;
-       TargetFixFileName[0]:=s[0];
+           TargetFixFileName[0]:=s[0];
+         end;
      end;
 
 
@@ -1807,7 +1904,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.124  2004-02-08 16:38:51  florian
+  Revision 1.125  2004-02-19 20:40:15  olle
+    + Support for Link on target especially for MacOS
+    + TLinkerMPW
+    + TAsmScriptMPW
+
+  Revision 1.124  2004/02/08 16:38:51  florian
     + PtrInt declared if VER1_0
 
   Revision 1.123  2004/01/28 22:16:31  peter

+ 18 - 1
compiler/link.pas

@@ -119,6 +119,13 @@ begin
   findobjectfile:='';
   if s='' then
    exit;
+
+  {When linking on target, there is no object files to look for at
+   the host. Look for the corresponding assembler file instead,
+   because it will be assembled to object file on the target.}
+  if cs_link_on_target in aktglobalswitches then
+	s:= ForceExtension(s,target_info.asmext);
+
   { when it does not belong to the unit then check if
     the specified file exists without searching any paths }
   if not isunit then
@@ -153,6 +160,11 @@ begin
    found:=FindFile(s,exepath,foundfile);
   if not(cs_link_extern in aktglobalswitches) and (not found) then
    Message1(exec_w_objfile_not_found,s);
+
+  {Restore file extension}
+  if cs_link_on_target in aktglobalswitches then
+	foundfile:= ForceExtension(foundfile,target_info.objext);
+
   findobjectfile:=ScriptFixFileName(foundfile);
 end;
 
@@ -664,7 +676,12 @@ initialization
 end.
 {
   $Log$
-  Revision 1.39  2003-12-11 17:53:03  florian
+  Revision 1.40  2004-02-19 20:40:15  olle
+    + Support for Link on target especially for MacOS
+    + TLinkerMPW
+    + TAsmScriptMPW
+
+  Revision 1.39  2003/12/11 17:53:03  florian
     * fixed external smartlinking
 
   Revision 1.38  2003/09/14 21:33:11  peter

+ 100 - 5
compiler/script.pas

@@ -78,6 +78,15 @@ type
     Procedure WriteToDisk;override;
   end;
 
+  TAsmScriptMPW = class (TAsmScript)
+    Constructor Create (Const ScriptName : String); override;
+    Procedure AddAsmCommand (Const Command, Options,FileName : String);override;
+    Procedure AddLinkCommand (Const Command, Options, FileName : String);override;
+    Procedure AddDeleteCommand (Const FileName : String);override;
+    Procedure AddDeleteDirCommand (Const FileName : String);override;
+    Procedure WriteToDisk;override;
+  end;
+
   TLinkRes = Class (TScript)
     procedure Add(const s:string);
     procedure AddFileName(const s:string);
@@ -101,7 +110,7 @@ uses
   {$endif}
 {$endif}
   cutils,
-  globtype,globals,systems;
+  globtype,globals,systems,verbose;
 
 
 {****************************************************************************
@@ -154,7 +163,7 @@ end;
 
 procedure TScript.Add(const s:string);
 begin
-  data.Concat(s);
+   data.Concat(s);
 end;
 
 
@@ -163,6 +172,35 @@ begin
   Empty:=Data.Empty;
 end;
 
+(*
+procedure TScript.WriteToDisk;
+var
+  t : file;
+  s : string;
+  le: string[2];
+begin
+  if cs_link_on_target in aktglobalswitches then
+    le:= target_info.newline
+  else
+    le:= source_info.newline;
+
+  Assign(t,fn);
+  Rewrite(t,1);
+
+  while not data.Empty do
+    begin
+      s:= data.GetFirst;
+      BlockWrite(t, s[1] ,Length(s));
+      BlockWrite(t, le[1], Length(le));
+    end;
+
+  Close(t);
+{$ifdef hasUnix}
+  if executable then
+   {$ifdef VER1_0}ChMod{$else}fpchmod{$endif}(fn,493);
+{$endif}
+end;
+*)
 
 procedure TScript.WriteToDisk;
 var
@@ -193,7 +231,6 @@ begin
 {$endif}
 end;
 
-
 {****************************************************************************
                                   Asm Response
 ****************************************************************************}
@@ -205,7 +242,7 @@ end;
 
 
 {****************************************************************************
-                                  Asm Response
+                                  DOS Asm Response
 ****************************************************************************}
 
 Constructor TAsmScriptDos.Create (Const ScriptName : String);
@@ -386,6 +423,57 @@ Begin
 end;
 
 
+{****************************************************************************
+                                  MPW (MacOS) Asm Response
+****************************************************************************}
+
+Constructor TAsmScriptMPW.Create (Const ScriptName : String);
+begin
+  Inherited Create(ScriptName);
+end;
+
+
+Procedure TAsmScriptMPW.AddAsmCommand (Const Command, Options,FileName : String);
+begin
+  if FileName<>'' then
+    Add('Echo Assembling '+ScriptFixFileName(FileName));
+  Add(maybequoted(command)+' '+Options);
+end;
+
+
+Procedure TAsmScriptMPW.AddLinkCommand (Const Command, Options, FileName : String);
+begin
+  if FileName<>'' then
+    Add('Echo Linking '+ScriptFixFileName(FileName));
+  Add(maybequoted(command)+' '+Options);
+
+  {Add resources}
+  if true then {If SIOW}
+    Add('Rez -append "{RIncludes}"SIOW.r -o '+ ScriptFixFileName(FileName));
+end;
+
+
+Procedure TAsmScriptMPW.AddDeleteCommand (Const FileName : String);
+begin
+ Add('Delete '+ScriptFixFileName(FileName));
+end;
+
+
+Procedure TAsmScriptMPW.AddDeleteDirCommand (Const FileName : String);
+begin
+ Add('Delete '+FileName);
+end;
+
+
+Procedure TAsmScriptMPW.WriteToDisk;
+Begin
+  AddStart('# Script for assembling and linking a FreePascal program on MPW (MacOS)');
+  Add('Echo Done');
+  inherited WriteToDisk;
+end;
+
+
+
 Procedure GenerateAsmRes(const st : string);
 var
   scripttyp : tscripttype;
@@ -401,6 +489,8 @@ begin
       AsmRes:=TAsmScriptDos.Create(st);
     script_amiga :
       AsmRes:=TAsmScriptAmiga.Create(st);
+    script_mpw :
+      AsmRes:=TAsmScriptMPW.Create(st);
   end;
 end;
 
@@ -434,7 +524,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.25  2003-11-10 17:22:28  marco
+  Revision 1.26  2004-02-19 20:40:15  olle
+    + Support for Link on target especially for MacOS
+    + TLinkerMPW
+    + TAsmScriptMPW
+
+  Revision 1.25  2003/11/10 17:22:28  marco
    * havelinuxrtl10 fixes
 
   Revision 1.24  2003/09/30 19:54:23  peter

+ 8 - 2
compiler/systems.pas

@@ -151,7 +151,8 @@ interface
        );
 
        tscripttype = (script_none
-            ,script_dos,script_unix,script_amiga
+            ,script_dos,script_unix,script_amiga,
+            script_mpw
        );
 
        tabi = (abi_default
@@ -688,7 +689,12 @@ finalization
 end.
 {
   $Log$
-  Revision 1.84  2004-02-13 15:56:11  marco
+  Revision 1.85  2004-02-19 20:40:15  olle
+    + Support for Link on target especially for MacOS
+    + TLinkerMPW
+    + TAsmScriptMPW
+
+  Revision 1.84  2004/02/13 15:56:11  marco
    * getosreldate
 
   Revision 1.83  2004/02/13 05:42:16  karoly

+ 7 - 2
compiler/systems/i_macos.pas

@@ -66,7 +66,7 @@ unit i_macos;
             linkextern   : nil;
             ar           : ar_mpw_ar;
             res          : res_powerpc_mpw;
-            script       : script_unix;
+            script       : script_mpw;
             endian       : endian_big;
             alignment    :
               (
@@ -102,7 +102,12 @@ initialization
 end.
 {
   $Log$
-  Revision 1.12  2003-10-03 22:09:49  peter
+  Revision 1.13  2004-02-19 20:40:20  olle
+    + Support for Link on target especially for MacOS
+    + TLinkerMPW
+    + TAsmScriptMPW
+
+  Revision 1.12  2003/10/03 22:09:49  peter
     * removed paraalign
 
   Revision 1.11  2003/08/08 15:54:01  olle

+ 130 - 3
compiler/systems/t_macos.pas

@@ -27,7 +27,7 @@ unit t_macos;
 interface
 
   uses
-     import,symsym,symdef;
+     import,symsym,symdef,link;
 
   type
     timportlibmacos=class(timportlib)
@@ -37,10 +37,18 @@ interface
       procedure generatelib;override;
     end;
 
+    tlinkermpw=class(texternallinker)
+    private
+      Function  WriteResponseFile(isdll:boolean) : Boolean;
+    public
+      constructor Create;override;
+      procedure SetDefaultInfo;override;
+      function  MakeExecutable:boolean;override;
+    end;
+
 implementation
 
     uses
-       link,
        cutils,cclasses,
        globtype,globals,systems,verbose,script,fmodule,i_macos,
        symconst;
@@ -82,6 +90,119 @@ procedure timportlibmacos.generatelib;
 begin
 end;
 
+{*****************************************************************************
+                                  TLINKERMPW
+*****************************************************************************}
+
+Constructor TLinkerMPW.Create;
+begin
+  Inherited Create;
+  //LibrarySearchPath.AddPath('/lib;/usr/lib;/usr/X11R6/lib',true);
+end;
+
+
+procedure TLinkerMPW.SetDefaultInfo;
+
+begin
+  with Info do
+   begin
+     ExeCmd[1]:='PPCLink $OPT $DYNLINK $STATIC $STRIP -tocdataref off -dead on -o $EXE -@filelist $RES';
+     DllCmd[1]:='PPCLink $OPT $INIT $FINI $SONAME -shared -o $EXE -@filelist $RES';
+   end;
+end;
+
+
+Function TLinkerMPW.WriteResponseFile(isdll:boolean) : Boolean;
+
+begin
+  WriteResponseFile:=False;
+end;
+
+
+function TLinkerMPW.MakeExecutable:boolean;
+var
+  binstr,
+  cmdstr  : string;
+  success : boolean;
+  DynLinkStr : string[60];
+  StaticStr,
+  StripStr   : string[40];
+
+  s: string;
+
+begin
+  //TODO Only external link in MPW is possible, otherwise yell.
+
+  if not(cs_link_extern in aktglobalswitches) then
+    Message1(exec_i_linking,current_module.exefilename^);
+
+{ Create some replacements }
+(*
+  StaticStr:='';
+  StripStr:='';
+  DynLinkStr:='';
+  if (cs_link_staticflag in aktglobalswitches) then
+   StaticStr:='-static';
+  if (cs_link_strip in aktglobalswitches) then
+   StripStr:='-s';
+  If (cs_profile in aktmoduleswitches) or
+     ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then
+   DynLinkStr:='-dynamic-linker='+Info.DynamicLinker;
+*)
+
+{ Call linker }
+  SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
+  Replace(cmdstr,'$EXE',current_module.exefilename^);
+  Replace(cmdstr,'$OPT',Info.ExtraOptions);
+  Replace(cmdstr,'$RES',outputexedir+Info.ResName);
+  Replace(cmdstr,'$STATIC',StaticStr);
+  Replace(cmdstr,'$STRIP',StripStr);
+  Replace(cmdstr,'$DYNLINK',DynLinkStr);
+
+  with AsmRes do
+    begin
+      {#182 is escape char in MPW (analog to backslash in unix). The space}
+      {ensures there is whitespace separating items.}
+      Add('PPCLink '#182);
+
+      { Add MPW standard libraries}
+      if true then // if not MPWTool
+        begin
+          Add('"{PPCLibraries}PPCSIOW.o" '#182);
+          Add('"{PPCLibraries}PPCToolLibs.o" '#182);
+        end;
+
+      Add('"{SharedLibraries}InterfaceLib" '#182);
+      Add('"{SharedLibraries}StdCLib" '#182);
+      Add('"{SharedLibraries}MathLib" '#182);
+      Add('"{PPCLibraries}StdCRuntime.o" '#182);
+      Add('"{PPCLibraries}PPCCRuntime.o" '#182);
+
+      {Add main objectfiles}
+      while not ObjectFiles.Empty do
+        begin
+          s:=ObjectFiles.GetFirst;
+          if s<>'' then
+            Add(s+' '#182);
+        end;
+
+	  {Add last lines of the link command}
+      if true then //If SIOW, to avoid some warnings.
+        Add('-ignoredups __start -ignoredups .__start -ignoredups main -ignoredups .main '#182); 
+
+      Add('-tocdataref off -sym on -dead on -o '+ current_module.exefilename^); 
+
+      {Add mac resources}
+      if true then //If SIOW
+        Add('Rez -append "{RIncludes}"SIOW.r -o ' + current_module.exefilename^);
+
+      success:= true;
+    end;
+
+  MakeExecutable:=success;   { otherwise a recursive call to link method }
+end;
+
+
 
 {*****************************************************************************
                                   Initialize
@@ -93,13 +214,19 @@ initialization
   RegisterImport(system_m68k_macos,timportlibmacos);
 {$endif m68k}
 {$ifdef powerpc}
+  RegisterExternalLinker(system_powerpc_macos_info,TLinkerMPW);
   RegisterTarget(system_powerpc_macos_info);
   RegisterImport(system_powerpc_macos,timportlibmacos);
 {$endif powerpc}
 end.
 {
   $Log$
-  Revision 1.6  2003-04-27 08:52:00  florian
+  Revision 1.7  2004-02-19 20:40:20  olle
+    + Support for Link on target especially for MacOS
+    + TLinkerMPW
+    + TAsmScriptMPW
+
+  Revision 1.6  2003/04/27 08:52:00  florian
     * another compile fix
 
   Revision 1.5  2003/04/27 08:50:45  peter