+ unitpath,librarypath,includepath,objectpath directives

compiler/files.pas

@@ -155,6 +155,10 @@ unit files;
           linkofiles    : tstringcontainer;
           used_units    : tlinkedlist;
 
+          localunitsearchpath,           { local searchpaths }
+          localobjectsearchpath,
+          localincludesearchpath,
+          locallibrarysearchpath : pstring;
 
           path,                     { path where the module is find/created }
           outpath,
@@ -799,12 +803,8 @@ uses
 
     function tmodule.search_unit(const n : string;onlysource:boolean):boolean;
       var
-         ext       : string[8];
          singlepathstring,
-         unitPath,
-         filename  : string;
-         found     : boolean;
-         start,i   : longint;
+         filename : string;
 
          Function UnitExists(const ext:string):boolean;
          begin
@@ -812,70 +812,89 @@ uses
            UnitExists:=FileExists(Singlepathstring+FileName+ext);
          end;
 
+         Function SearchPath(unitpath:string):boolean;
+         var
+           found   : boolean;
+           start,i : longint;
+           ext     : string[8];
+         begin
+           start:=1;
+           Found:=false;
+           repeat
+           { Create current path to check }
+             i:=pos(';',unitpath);
+             if i=0 then
+              i:=length(unitpath)+1;
+             singlepathstring:=FixPath(copy(unitpath,start,i-start),false);
+             delete(unitpath,start,i-start+1);
+             if not onlysource then
+              begin
+              { Check for PPL file }
+                if not Found then
+                 begin
+                   Found:=UnitExists(target_info.unitlibext);
+                   if Found then
+                    Begin
+                      SetFileName(SinglePathString+FileName,false);
+                      Found:=OpenPPU;
+                    End;
+                  end;
+              { Check for PPU file }
+                if not Found then
+                 begin
+                   Found:=UnitExists(target_info.unitext);
+                   if Found then
+                    Begin
+                      SetFileName(SinglePathString+FileName,false);
+                      Found:=OpenPPU;
+                    End;
+                 end;
+              end;
+           { Check for Sources }
+             if not Found then
+              begin
+                ppufile:=nil;
+                do_compile:=true;
+              {Check for .pp file}
+                Found:=UnitExists(target_os.sourceext);
+                if Found then
+                 Ext:=target_os.sourceext
+                else
+                 begin
+                 {Check for .pas}
+                   Found:=UnitExists(target_os.pasext);
+                   if Found then
+                    Ext:=target_os.pasext;
+                 end;
+                stringdispose(mainsource);
+                if Found then
+                 begin
+                   sources_avail:=true;
+                 {Load Filenames when found}
+                   mainsource:=StringDup(SinglePathString+FileName+Ext);
+                   SetFileName(SinglePathString+FileName,false);
+                 end
+                else
+                 sources_avail:=false;
+              end;
+           until Found or (unitpath='');
+           SearchPath:=Found;
+         end;
+
+       var
+         fnd : boolean;
        begin
-         start:=1;
          filename:=FixFileName(n);
-         unitpath:=UnitSearchPath;
-         Found:=false;
-         repeat
-         { Create current path to check }
-           i:=pos(';',unitpath);
-           if i=0 then
-            i:=length(unitpath)+1;
-           singlepathstring:=FixPath(copy(unitpath,start,i-start),false);
-           delete(unitpath,start,i-start+1);
-           if not onlysource then
-            begin
-            { Check for PPL file }
-              if not Found then
-               begin
-                 Found:=UnitExists(target_info.unitlibext);
-                 if Found then
-                  Begin
-                    SetFileName(SinglePathString+FileName,false);
-                    Found:=OpenPPU;
-                  End;
-                end;
-            { Check for PPU file }
-              if not Found then
-               begin
-                 Found:=UnitExists(target_info.unitext);
-                 if Found then
-                  Begin
-                    SetFileName(SinglePathString+FileName,false);
-                    Found:=OpenPPU;
-                  End;
-               end;
-            end;
-         { Check for Sources }
-           if not Found then
-            begin
-              ppufile:=nil;
-              do_compile:=true;
-            {Check for .pp file}
-              Found:=UnitExists(target_os.sourceext);
-              if Found then
-               Ext:=target_os.sourceext
-              else
-               begin
-               {Check for .pas}
-                 Found:=UnitExists(target_os.pasext);
-                 if Found then
-                  Ext:=target_os.pasext;
-               end;
-              stringdispose(mainsource);
-              if Found then
-               begin
-                 sources_avail:=true;
-               {Load Filenames when found}
-                 mainsource:=StringDup(SinglePathString+FileName+Ext);
-                 SetFileName(SinglePathString+FileName,false);
-               end
-              else
-               sources_avail:=false;
-            end;
-         until Found or (unitpath='');
-         search_unit:=Found;
+         { try to find unit
+            1. cwd
+            2. local unit path
+            3. global unit path }
+         fnd:=SearchPath('.');
+         if (not fnd) and assigned(current_module^.LocalUnitSearchPath) then
+          fnd:=SearchPath(current_module^.LocalUnitSearchPath^);
+         if not fnd then
+          fnd:=SearchPath(UnitSearchPath);
+         search_unit:=fnd;
       end;
 
     procedure tmodule.reset;
@@ -974,6 +993,10 @@ uses
 {$endif tp}
          path:=nil;
          setfilename(p+n,true);
+         localunitsearchpath:=nil;
+         localobjectsearchpath:=nil;
+         localincludesearchpath:=nil;
+         locallibrarysearchpath:=nil;
          used_units.init;
          new(sourcefiles,init);
          resourcefiles.init_no_double;
@@ -1048,6 +1071,10 @@ uses
         stringdispose(modulename);
         stringdispose(mainsource);
         stringdispose(asmprefix);
+        stringdispose(localunitsearchpath);
+        stringdispose(localobjectsearchpath);
+        stringdispose(localincludesearchpath);
+        stringdispose(locallibrarysearchpath);
         if assigned(globalsymtable) then
           dispose(punitsymtable(globalsymtable),done);
         globalsymtable:=nil;
@@ -1097,7 +1124,10 @@ uses
 end.
 {
   $Log$
-  Revision 1.87  1999-02-16 00:48:23  peter
+  Revision 1.88  1999-03-25 16:55:29  peter
+    + unitpath,librarypath,includepath,objectpath directives
+
+  Revision 1.87  1999/02/16 00:48:23  peter
     * save in the ppu if linked with obj file instead of using the
       library flag, so the .inc files are also checked
 

compiler/link.pas

@@ -105,7 +105,7 @@ begin
    Glibc2:=true
   else
    DynamicLinker:='/lib/ld-linux.so.1';
-  LibrarySearchPath:='/lib;/usr/lib';
+  LibrarySearchPath:='/lib;/usr/lib;/usr/lib/X11';
 {$else}
   DynamicLinker:='';
   LibrarySearchPath:='';
@@ -178,10 +178,22 @@ begin
      Findobjectfile:=s;
      exit;
    end;
-  findobjectfile:=search(s,'.;'+unitsearchpath+';'+exepath,found)+s;
-  { if not found then check the object searchpath also }
-  if not found then
+  { find object file
+     1. cwd
+     2. unit search path
+     3. local object path
+     4. global object path
+     5. exepath }
+  found:=false;
+  findobjectfile:=search(s,'.',found)+s;
+  if (not found) then
+   findobjectfile:=search(s,unitsearchpath,found)+s;
+  if (not found) and assigned(current_module^.localobjectsearchpath) then
+   findobjectfile:=search(s,current_module^.localobjectsearchpath^,found)+s;
+  if (not found) then
    findobjectfile:=search(s,objectsearchpath,found)+s;
+  if (not found) then
+   findobjectfile:=search(s,exepath,found)+s;
   if not(cs_link_extern in aktglobalswitches) and (not found) then
    Message1(exec_w_objfile_not_found,s);
 end;
@@ -199,7 +211,19 @@ begin
      FindLibraryFile:=s;
      exit;
    end;
-  findlibraryfile:=search(s,'.;'+librarysearchpath+';'+exepath,found)+s;
+  { find libary
+     1. cwd
+     2. local libary dir
+     3. global libary dir
+     4. exe path of the compiler }
+  found:=false;
+  findlibraryfile:=search(s,'.',found)+s;
+  if (not found) and assigned(current_module^.locallibrarysearchpath) then
+   findlibraryfile:=search(s,current_module^.locallibrarysearchpath^,found)+s;
+  if (not found) then
+   findlibraryfile:=search(s,librarysearchpath,found)+s;
+  if (not found) then
+   findlibraryfile:=search(s,exepath,found)+s;
   if not(cs_link_extern in aktglobalswitches) and (not found) then
    Message1(exec_w_libfile_not_found,s);
 end;
@@ -280,6 +304,17 @@ Var
      WriteLn(Linkresponse,s);
   end;
 
+  procedure WriteResFileName(const s:string);
+  begin
+    if s<>'' then
+     begin
+       if (pos('\',s)=0) and (pos('/',s)=0) then
+         WriteLn(Linkresponse,'.'+DirSep+s)
+       else
+         WriteLn(Linkresponse,s);
+     end;
+  end;
+
 begin
   WriteResponseFile:=False;
   linux_link_c:=false;
@@ -331,6 +366,19 @@ begin
    exit;
 
   { Write library searchpath }
+  if assigned(current_module^.locallibrarysearchpath) then
+   begin
+     S2:=current_module^.locallibrarysearchpath^;
+     Repeat
+       i:=Pos(';',S2);
+       If i=0 then
+        i:=255;
+       S:=Copy(S2,1,i-1);
+       If S<>'' then
+         WriteRes(target_link.libpathprefix+s+target_link.libpathsuffix);
+       Delete (S2,1,i);
+     until S2='';
+   end;
   S2:=LibrarySearchPath;
   Repeat
     i:=Pos(';',S2);
@@ -345,32 +393,32 @@ begin
   WriteRes(target_link.inputstart);
   { add objectfiles, start with prt0 always }
   if prtobj<>'' then
-   WriteRes(FindObjectFile(prtobj));
+   WriteResFileName(FindObjectFile(prtobj));
   { try to add crti and crtbegin, they are normally not required, but
     adding can sometimes be usefull }
   if linux_link_c then
    begin
      s:=search('crtbegin.o',librarysearchpath,found)+'crtbegin.o';
      if found then
-      WriteRes(s);
+      WriteResFileName(s);
      s:=search('crti.o',librarysearchpath,found)+'crti.o';
      if found then
-      WriteRes(s);
+      WriteResFileName(s);
    end;
   while not ObjectFiles.Empty do
    begin
      s:=ObjectFiles.Get;
      if s<>'' then
-      WriteRes(s);
+      WriteResFileName(s);
    end;
   if linux_link_c then
    begin
      s:=search('crtend.o',librarysearchpath,found)+'crtend.o';
      if found then
-      WriteRes(s);
+      WriteResFileName(s);
      s:=search('crtn.o',librarysearchpath,found)+'crtn.o';
      if found then
-      WriteRes(s);
+      WriteResFileName(s);
    end;
 
   { Write sharedlibraries like -l<lib> }
@@ -404,7 +452,7 @@ begin
      While not StaticLibFiles.Empty do
       begin
         S:=StaticLibFiles.Get;
-        WriteRes(s)
+        WriteResFileName(s)
       end;
      WriteRes(target_link.GroupEnd);
    end;
@@ -562,7 +610,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.48  1999-03-23 16:22:43  peter
+  Revision 1.49  1999-03-25 16:55:30  peter
+    + unitpath,librarypath,includepath,objectpath directives
+
+  Revision 1.48  1999/03/23 16:22:43  peter
     * crtbegin/crtend only added if found
 
   Revision 1.47  1999/02/05 16:45:47  michael

compiler/readme

@@ -17,7 +17,7 @@ Changes in the syntax or semantic of FPC:
              anymore (solved several bugs) but this could lead to errors
              on previously accepted code (PM)
   01/02/99:  c styled comments are supported (/* ... */), mainly
-             for the Sibyl sources of Medigo (FK) 
+             for the Sibyl sources of Medigo (FK)
   02/02/99:  class destructors take now two parameters: flag
              if the helper routine should free the instance and
              self pointer (FK)
@@ -27,4 +27,6 @@ Changes in the syntax or semantic of FPC:
              into a 4 bytes parameter (needed for C and DLL calls) (PM)
   11/03/99   the makefile.fpc is now also needed for the compiler and RTL, you can
              find it in the base.zip package (PFV)
+  24/03/99   new directives UNITPATH,INCLUDEPATH,OBJECTPATH,LIBRARYPATH to
+             set the searchpaths where to find the files for that module (PFV)
 

compiler/scandir.inc

@@ -33,16 +33,18 @@ type
      _DIR_FATAL,
      _DIR_HINT,_DIR_HINTS,
      _DIR_I,_DIR_I386_ATT,_DIR_I386_DIRECT,_DIR_I386_INTEL,_DIR_IOCHECKS,
-       _DIR_IF,_DIR_IFDEF,_DIR_IFNDEF,_DIR_IFOPT,_DIR_INCLUDE,_DIR_INFO,
-     _DIR_L,_DIR_LINK,_DIR_LINKLIB,_DIR_LOCALSYMBOLS,_DIR_LONGSTRINGS,
+       _DIR_IF,_DIR_IFDEF,_DIR_IFNDEF,_DIR_IFOPT,_DIR_INCLUDE,_DIR_INCLUDEPATH,
+       _DIR_INFO,
+     _DIR_L,_DIR_LIBRARYPATH,_DIR_LINK,_DIR_LINKLIB,_DIR_LOCALSYMBOLS,
+       _DIR_LONGSTRINGS,
      _DIR_M,_DIR_MEMORY,_DIR_MESSAGE,_DIR_MINENUMSIZE,_DIR_MMX,_DIR_MODE,
      _DIR_NOTE,_DIR_NOTES,
-     _DIR_OPENSTRINGS,_DIR_OUTPUT_FORMAT,_DIR_OVERFLOWCHECKS,
+     _DIR_OBJECTPATH,_DIR_OPENSTRINGS,_DIR_OUTPUT_FORMAT,_DIR_OVERFLOWCHECKS,
      _DIR_PACKENUM,_DIR_PACKRECORDS,
      _DIR_R,_DIR_RANGECHECKS,_DIR_REFERENCEINFO,
      _DIR_SATURATION,_DIR_SMARTLINK,_DIR_STACKFRAMES,_DIR_STOP,
      _DIR_TYPEDADDRESS,_DIR_TYPEINFO,
-     _DIR_UNDEF,
+     _DIR_UNDEF,_DIR_UNITPATH,
      _DIR_VARSTRINGCHECKS,
      _DIR_WAIT,_DIR_WARNING,_DIR_WARNINGS,
      _DIR_Z1,_DIR_Z2,_DIR_Z4
@@ -59,16 +61,18 @@ const
      'FATAL',
      'HINT','HINTS',
      'I','I386_ATT','I386_DIRECT','I386_INTEL','IOCHECKS',
-       'IF','IFDEF','IFNDEF','IFOPT','INCLUDE','INFO',
-     'L','LINK','LINKLIB','LOCALSYMBOLS','LONGSTRINGS',
+       'IF','IFDEF','IFNDEF','IFOPT','INCLUDE','INCLUDEPATH',
+       'INFO',
+     'L','LIBRARYPATH','LINK','LINKLIB','LOCALSYMBOLS',
+       'LONGSTRINGS',
      'M','MEMORY','MESSAGE','MINENUMSIZE','MMX','MODE',
      'NOTE','NOTES',
-     'OPENSTRINGS','OUTPUT_FORMAT','OVERFLOWCHECKS',
+     'OBJECTPATH','OPENSTRINGS','OUTPUT_FORMAT','OVERFLOWCHECKS',
      'PACKENUM','PACKRECORDS',
      'R','RANGECHECKS','REFERENCEINFO',
      'SATURATION','SMARTLINK','STACKFRAMES','STOP',
      'TYPEDADDRESS','TYPEINFO',
-     'UNDEF',
+     'UNDEF','UNITPATH',
      'VARSTRINGCHECKS',
      'WAIT','WARNING','WARNINGS',
      'Z1','Z2','Z4'
@@ -570,8 +574,16 @@ const
          begin
            hs:=FixFileName(hs);
            fsplit(hs,path,name,ext);
-         { first look in the path of _d then currentmodule }
-           path:=search(name+ext,path+';'+current_scanner^.inputfile^.path^+';'+includesearchpath,found);
+         { look for the include file
+            1. specified path,path of current inputfile,current dir
+            2. local includepath
+            3. global includepath }
+           found:=false;
+           path:=search(name+ext,path+';'+current_scanner^.inputfile^.path^+';.',found);
+           if (not found) and assigned(current_module^.localincludesearchpath) then
+            path:=search(name+ext,current_module^.localincludesearchpath^,found);
+           if (not found) then
+            path:=search(name+ext,includesearchpath,found);
          { shutdown current file }
            current_scanner^.tempcloseinputfile;
          { load new file }
@@ -638,6 +650,62 @@ const
       end;
 
 
+    procedure dir_unitpath(t:tdirectivetoken);
+      begin
+        if not current_module^.in_global then
+         Message(scan_w_switch_is_global)
+        else
+          begin
+            current_scanner^.skipspace;
+            if assigned(current_module^.localunitsearchpath) then
+             stringdispose(current_module^.localunitsearchpath);
+            current_module^.localunitsearchpath:=stringdup(current_scanner^.readcomment);
+          end;
+      end;
+
+
+    procedure dir_includepath(t:tdirectivetoken);
+      begin
+        if not current_module^.in_global then
+         Message(scan_w_switch_is_global)
+        else
+          begin
+            current_scanner^.skipspace;
+            if assigned(current_module^.localincludesearchpath) then
+             stringdispose(current_module^.localincludesearchpath);
+            current_module^.localincludesearchpath:=stringdup(current_scanner^.readcomment);
+          end;
+      end;
+
+
+    procedure dir_librarypath(t:tdirectivetoken);
+      begin
+        if not current_module^.in_global then
+         Message(scan_w_switch_is_global)
+        else
+          begin
+            current_scanner^.skipspace;
+            if assigned(current_module^.locallibrarysearchpath) then
+             stringdispose(current_module^.locallibrarysearchpath);
+            current_module^.locallibrarysearchpath:=stringdup(current_scanner^.readcomment);
+          end;
+      end;
+
+
+    procedure dir_objectpath(t:tdirectivetoken);
+      begin
+        if not current_module^.in_global then
+         Message(scan_w_switch_is_global)
+        else
+          begin
+            current_scanner^.skipspace;
+            if assigned(current_module^.localobjectsearchpath) then
+             stringdispose(current_module^.localobjectsearchpath);
+            current_module^.localobjectsearchpath:=stringdup(current_scanner^.readcomment);
+          end;
+      end;
+
+
     procedure dir_mode(t:tdirectivetoken);
       begin
         if not current_module^.in_global then
@@ -901,8 +969,10 @@ const
          {_DIR_IFNDEF} dir_conditional,
          {_DIR_IFOPT} dir_conditional,
          {_DIR_INCLUDE} dir_include,
+         {_DIR_INCLUDEPATH} dir_includepath,
          {_DIR_INFO} dir_message,
          {_DIR_L} dir_linkobject,
+         {_DIR_LIBRARYPATH} dir_librarypath,
          {_DIR_LINK} dir_linkobject,
          {_DIR_LINKLIB} dir_linklib,
          {_DIR_LOCALSYMBOLS} dir_delphiswitch,
@@ -915,6 +985,7 @@ const
          {_DIR_MODE} dir_mode,
          {_DIR_NOTE} dir_message,
          {_DIR_NOTES} dir_setverbose,
+         {_DIR_OBJECTPATH} dir_objectpath,
          {_DIR_OPENSTRINGS} dir_delphiswitch,
          {_DIR_OUTPUT_FORMAT} dir_outputformat,
          {_DIR_OVERFLOWCHECKS} dir_delphiswitch,
@@ -930,6 +1001,7 @@ const
          {_DIR_TYPEDADDRESS} dir_delphiswitch,
          {_DIR_TYPEINFO} dir_delphiswitch,
          {_DIR_UNDEF} dir_undef,
+         {_DIR_UNITPATH} dir_unitpath,
          {_DIR_VARSTRINGCHECKS} dir_delphiswitch,
          {_DIR_WAIT} dir_wait,
          {_DIR_WARNING} dir_message,
@@ -1005,7 +1077,10 @@ const
 
 {
   $Log$
-  Revision 1.47  1999-02-22 13:07:05  pierre
+  Revision 1.48  1999-03-25 16:55:34  peter
+    + unitpath,librarypath,includepath,objectpath directives
+
+  Revision 1.47  1999/02/22 13:07:05  pierre
     + -b and -bl options work !
     + cs_local_browser ($L+) is disabled if cs_browser ($Y+)
       is not enabled when quitting global section