Преглед на файлове

* moved some util functions from globals,cobjects to cutils
* splitted files into finput,fmodule

peter преди 25 години
родител
ревизия
4c94659743
променени са 72 файла, в които са добавени 2574 реда и са изтрити 1280 реда
  1. 9 4
      compiler/aasm.pas
  2. 7 3
      compiler/ag386att.pas
  3. 7 3
      compiler/ag386bin.pas
  4. 7 3
      compiler/ag386int.pas
  5. 7 3
      compiler/ag386nsm.pas
  6. 6 2
      compiler/assemble.pas
  7. 7 3
      compiler/browlog.pas
  8. 6 2
      compiler/cg386add.pas
  9. 6 2
      compiler/cg386inl.pas
  10. 6 2
      compiler/cg386ld.pas
  11. 6 2
      compiler/cg386mat.pas
  12. 6 2
      compiler/cg386mem.pas
  13. 7 3
      compiler/cgai386.pas
  14. 10 721
      compiler/cobjects.pas
  15. 7 2
      compiler/comphook.pas
  16. 6 2
      compiler/compiler.pas
  17. 6 2
      compiler/comprsrc.pas
  18. 7 2
      compiler/cpuasm.pas
  19. 6 2
      compiler/cpubase.pas
  20. 6 2
      compiler/cresstr.pas
  21. 599 0
      compiler/cutils.pas
  22. 8 3
      compiler/export.pas
  23. 591 0
      compiler/finput.pas
  24. 918 0
      compiler/fmodule.pas
  25. 6 2
      compiler/gendef.pas
  26. 8 372
      compiler/globals.pas
  27. 7 3
      compiler/hcgdata.pas
  28. 6 2
      compiler/hcodegen.pas
  29. 6 2
      compiler/htypechk.pas
  30. 6 2
      compiler/import.pas
  31. 7 3
      compiler/link.pas
  32. 6 2
      compiler/og386.pas
  33. 6 2
      compiler/og386cff.pas
  34. 6 2
      compiler/og386elf.pas
  35. 6 2
      compiler/options.pas
  36. 6 2
      compiler/opts386.pas
  37. 6 2
      compiler/opts68k.pas
  38. 7 3
      compiler/parser.pas
  39. 6 2
      compiler/pass_2.pas
  40. 6 2
      compiler/pbase.pas
  41. 7 3
      compiler/pdecl.pas
  42. 6 2
      compiler/pexports.pas
  43. 6 2
      compiler/pexpr.pas
  44. 10 6
      compiler/pmodules.pas
  45. 6 2
      compiler/pstatmnt.pas
  46. 6 2
      compiler/psub.pas
  47. 6 2
      compiler/ptconst.pas
  48. 6 2
      compiler/ptype.pas
  49. 7 3
      compiler/ra386att.pas
  50. 7 3
      compiler/ra386dir.pas
  51. 7 3
      compiler/ra386int.pas
  52. 16 11
      compiler/rautils.pas
  53. 7 3
      compiler/regvars.pas
  54. 8 6
      compiler/scanner.pas
  55. 6 2
      compiler/switches.pas
  56. 6 2
      compiler/symdef.inc
  57. 8 6
      compiler/symtable.pas
  58. 6 2
      compiler/t_go32v1.pas
  59. 6 2
      compiler/t_go32v2.pas
  60. 7 3
      compiler/t_linux.pas
  61. 7 3
      compiler/t_os2.pas
  62. 6 2
      compiler/t_win32.pas
  63. 6 2
      compiler/tcadd.pas
  64. 6 2
      compiler/tccal.pas
  65. 6 2
      compiler/tccnv.pas
  66. 6 2
      compiler/tcflw.pas
  67. 6 2
      compiler/tcld.pas
  68. 6 2
      compiler/tcmem.pas
  69. 7 3
      compiler/temp_gen.pas
  70. 6 2
      compiler/tgeni386.pas
  71. 6 2
      compiler/tree.pas
  72. 10 14
      compiler/verbose.pas

+ 9 - 4
compiler/aasm.pas

@@ -31,10 +31,10 @@ unit aasm;
   interface
 
     uses
-       globtype,systems,cobjects,globals;
+       cutils,cobjects,
+       globtype,globals,systems;
 
     type
-
        tait = (
           ait_none,
           ait_direct,
@@ -425,7 +425,8 @@ type
 implementation
 
 uses
-  strings,files,verbose;
+  strings,
+  fmodule,verbose;
 
 {****************************************************************************
                              TAI
@@ -1180,7 +1181,11 @@ uses
 end.
 {
   $Log$
-  Revision 1.10  2000-08-20 17:38:21  peter
+  Revision 1.11  2000-08-27 16:11:48  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.10  2000/08/20 17:38:21  peter
     * smartlinking fixed for linux (merged)
 
   Revision 1.9  2000/08/16 18:33:53  peter

+ 7 - 3
compiler/ag386att.pas

@@ -49,8 +49,8 @@ unit ag386att;
       dos,
 {$endif Delphi}
       strings,
-      globtype,globals,systems,
-      files,verbose,cpubase,cpuasm
+      cutils,globtype,globals,systems,
+      fmodule,finput,verbose,cpubase,cpuasm
 {$ifdef GDB}
       ,gdb
 {$endif GDB}
@@ -902,7 +902,11 @@ unit ag386att;
 end.
 {
   $Log$
-  Revision 1.4  2000-08-20 17:38:21  peter
+  Revision 1.5  2000-08-27 16:11:49  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.4  2000/08/20 17:38:21  peter
     * smartlinking fixed for linux (merged)
 
   Revision 1.3  2000/07/13 12:08:24  michael

+ 7 - 3
compiler/ag386bin.pas

@@ -31,7 +31,7 @@ unit ag386bin;
   interface
 
     uses
-       cpubase,cobjects,aasm,files,assemble;
+       cpubase,cobjects,aasm,fmodule,finput,assemble;
 
     type
       togtype=(og_none,og_dbg,og_coff,og_pecoff,og_elf);
@@ -78,7 +78,7 @@ unit ag386bin;
 
     uses
        strings,
-       globtype,globals,systems,verbose,
+       cutils,globtype,globals,systems,verbose,
        cpuasm,
 {$ifdef GDB}
        gdb,
@@ -1039,7 +1039,11 @@ unit ag386bin;
 end.
 {
   $Log$
-  Revision 1.6  2000-08-12 15:34:22  peter
+  Revision 1.7  2000-08-27 16:11:49  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.6  2000/08/12 15:34:22  peter
     + usedasmsymbollist to check and reset only the used symbols (merged)
 
   Revision 1.5  2000/08/08 19:28:57  peter

+ 7 - 3
compiler/ag386int.pas

@@ -41,8 +41,8 @@ unit ag386int;
 
     uses
       strings,
-      globtype,globals,systems,cobjects,
-      files,verbose,cpubase,cpuasm
+      cutils,globtype,globals,systems,cobjects,
+      fmodule,finput,verbose,cpubase,cpuasm
 {$ifdef GDB}
       ,gdb
 {$endif GDB}
@@ -645,7 +645,11 @@ ait_stab_function_name : ;
 end.
 {
   $Log$
-  Revision 1.4  2000-08-20 17:38:21  peter
+  Revision 1.5  2000-08-27 16:11:49  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.4  2000/08/20 17:38:21  peter
     * smartlinking fixed for linux (merged)
 
   Revision 1.3  2000/07/13 12:08:24  michael

+ 7 - 3
compiler/ag386nsm.pas

@@ -42,8 +42,8 @@ unit ag386nsm;
 
     uses
       strings,
-      globtype,globals,systems,cobjects,
-      files,verbose,cpubase,cpuasm
+      cutils,globtype,globals,systems,cobjects,
+      fmodule,finput,verbose,cpubase,cpuasm
 {$ifdef GDB}
       ,gdb
 {$endif GDB}
@@ -774,7 +774,11 @@ unit ag386nsm;
 end.
 {
   $Log$
-  Revision 1.4  2000-08-20 17:38:21  peter
+  Revision 1.5  2000-08-27 16:11:49  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.4  2000/08/20 17:38:21  peter
     * smartlinking fixed for linux (merged)
 
   Revision 1.3  2000/07/13 12:08:24  michael

+ 6 - 2
compiler/assemble.pas

@@ -90,7 +90,7 @@ Procedure OnlyAsm;
 Implementation
 
 uses
-  script,files,systems,verbose
+  cutils,script,fmodule,systems,verbose
 {$ifdef linux}
   ,linux
 {$endif}
@@ -606,7 +606,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2000-07-13 12:08:24  michael
+  Revision 1.4  2000-08-27 16:11:49  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.3  2000/07/13 12:08:24  michael
   + patched to 1.1.0 with former 1.09patch from peter
 
   Revision 1.2  2000/07/13 11:32:32  michael

+ 7 - 3
compiler/browlog.pas

@@ -27,7 +27,7 @@ unit browlog;
 
 interface
 uses
-  cobjects,globtype,files,symconst,symtable;
+  cobjects,globtype,fmodule,finput,symconst,symtable;
 
 const
 {$ifdef TP}
@@ -74,7 +74,7 @@ var
 implementation
 
   uses
-    comphook,globals,systems,verbose;
+    cutils,comphook,globals,systems,verbose;
 
     function get_file_line(ref:pref): string;
       var
@@ -448,7 +448,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:32  michael
+  Revision 1.3  2000-08-27 16:11:49  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.2  2000/07/13 11:32:32  michael
   + removed logs
 
 }

+ 6 - 2
compiler/cg386add.pas

@@ -37,7 +37,7 @@ implementation
 
     uses
       globtype,systems,
-      cobjects,verbose,globals,
+      cutils,cobjects,verbose,globals,
       symconst,symtable,aasm,types,
       hcodegen,temp_gen,pass_2,
       cpubase,cpuasm,
@@ -2324,7 +2324,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.4  2000-08-04 22:00:50  peter
+  Revision 1.5  2000-08-27 16:11:49  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.4  2000/08/04 22:00:50  peter
     * merges from fixes
 
   Revision 1.3  2000/07/27 09:25:05  jonas

+ 6 - 2
compiler/cg386inl.pas

@@ -33,7 +33,7 @@ implementation
 
     uses
       globtype,systems,
-      cobjects,verbose,globals,files,
+      cutils,cobjects,verbose,globals,fmodule,
       symconst,symtable,aasm,types,
       hcodegen,temp_gen,pass_1,pass_2,
       cpubase,cpuasm,
@@ -1537,7 +1537,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  2000-08-16 13:06:06  florian
+  Revision 1.7  2000-08-27 16:11:49  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.6  2000/08/16 13:06:06  florian
     + support of 64 bit integer constants
 
   Revision 1.5  2000/08/04 22:00:50  peter

+ 6 - 2
compiler/cg386ld.pas

@@ -36,7 +36,7 @@ implementation
 
     uses
       globtype,systems,
-      cobjects,verbose,globals,files,
+      cobjects,verbose,globals,fmodule,
       symconst,symtable,aasm,types,
       hcodegen,temp_gen,pass_2,
       cpubase,cpuasm,
@@ -1008,7 +1008,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.4  2000-08-16 13:06:06  florian
+  Revision 1.5  2000-08-27 16:11:49  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.4  2000/08/16 13:06:06  florian
     + support of 64 bit integer constants
 
   Revision 1.3  2000/07/13 12:08:25  michael

+ 6 - 2
compiler/cg386mat.pas

@@ -36,7 +36,7 @@ implementation
 
     uses
       globtype,systems,
-      cobjects,verbose,globals,
+      cutils,cobjects,verbose,globals,
       symconst,symtable,aasm,types,
       hcodegen,temp_gen,pass_2,
       cpubase,cpuasm,
@@ -988,7 +988,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.4  2000-07-28 13:28:25  jonas
+  Revision 1.5  2000-08-27 16:11:49  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.4  2000/07/28 13:28:25  jonas
     * fixed bug in secondshlshr where ecx was released too soon in some
       cases causing a combination of -Or and -dnewoptimizations to generate
       wrong code

+ 6 - 2
compiler/cg386mem.pas

@@ -47,7 +47,7 @@ implementation
       strings,gdb,
 {$endif GDB}
       globtype,systems,
-      cobjects,verbose,globals,
+      cutils,cobjects,verbose,globals,
       symconst,symtable,aasm,types,
       hcodegen,temp_gen,pass_2,pass_1,
       cpubase,cpuasm,
@@ -958,7 +958,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.5  2000-07-28 07:38:13  jonas
+  Revision 1.6  2000-08-27 16:11:49  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.5  2000/07/28 07:38:13  jonas
     * refined previous fix (sometimes the number of necessary registers was
       overestimated) (merged from fixes branch)
 

+ 7 - 3
compiler/cgai386.pas

@@ -115,7 +115,7 @@ unit cgai386;
                               para_offset:longint;alignment : longint);
 
 {$ifdef TEMPS_NOT_PUSH}
-    { does the same as restore/, but uses temp. space instead of pushing }
+    { does the same as restore, but uses temp. space instead of pushing }
     function maybe_push(needed : byte;p : ptree;isint64 : boolean) : boolean;
     procedure restorefromtemp(p : ptree;isint64 : boolean);
 {$endif TEMPS_NOT_PUSH}
@@ -164,7 +164,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
   implementation
 
     uses
-       strings,globtype,systems,globals,verbose,files,types,pbase,
+       strings,cutils,globtype,systems,globals,verbose,fmodule,types,pbase,
        tgeni386,temp_gen,hcodegen,ppu,regvars
 {$ifdef GDB}
        ,gdb
@@ -4072,7 +4072,11 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 end.
 {
   $Log$
-  Revision 1.12  2000-08-24 19:07:54  peter
+  Revision 1.13  2000-08-27 16:11:49  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.12  2000/08/24 19:07:54  peter
     * don't initialize if localvarsym is set because that varsym will
       already be initialized
     * first initialize local data before copy of value para's (merged)

+ 10 - 721
compiler/cobjects.pas

@@ -37,23 +37,10 @@
 
 unit cobjects;
 
-{ define OLDSPEEDVALUE}
-
   interface
 
     uses
-{$ifdef DELPHI4}
-       dmisc,
-       sysutils
-{$else DELPHI4}
-       strings
-{$ifndef linux}
-       ,dos
-{$else}
-       ,linux
-{$endif}
-{$endif DELPHI4}
-      ;
+      cutils;
 
     const
        { the real size will be [-hasharray..hasharray] ! }
@@ -64,15 +51,6 @@ unit cobjects;
 {$endif}
 
     type
-       pstring = ^string;
-
-{$ifdef TP}
-       { redeclare dword only in case of emergency, some small things
-         of the compiler won't work then correctly (FK)
-       }
-       dword = longint;
-{$endif TP}
-
        pfileposinfo = ^tfileposinfo;
        tfileposinfo = record
          line      : longint;
@@ -225,6 +203,7 @@ unit cobjects;
          indexnext  : Pnamedindexobject;
        { dictionary }
          _name      : Pstring;
+         _valuename : Pstring; { uppercase name }
          left,right : Pnamedindexobject;
          speedvalue : longint;
        { singlelist }
@@ -329,99 +308,6 @@ unit cobjects;
         procedure grow(gsize:longint);
       end;
 
-{$ifdef BUFFEREDFILE}
-       { this is implemented to allow buffered binary I/O }
-       pbufferedfile = ^tbufferedfile;
-       tbufferedfile = object
-           f : file;
-           buf : pchar;
-           bufsize,buflast,bufpos : longint;
-
-           { 0 closed, 1 input, 2 output }
-           iomode : byte;
-
-           { true, if the compile should change the endian of the output }
-           change_endian : boolean;
-
-           { calcules a crc for the file,                                    }
-           { but it's assumed, that there no seek while do_crc is true       }
-           do_crc : boolean;
-           crc : longint;
-           { temporary closing feature }
-           tempclosed : boolean;
-           tempmode : byte;
-           temppos : longint;
-
-           { inits a buffer with the size bufsize which is assigned to }
-           { the file  filename                                        }
-           constructor init(const filename : string;_bufsize : longint);
-
-           { closes the file, if needed, and releases the memory }
-           destructor done;virtual;
-
-           { opens the file for input, other accesses are rejected }
-           function  reset:boolean;
-
-           { opens the file for output, other accesses are rejected }
-           procedure rewrite;
-
-           { reads or writes the buffer from or to disk }
-           procedure flush;
-
-           { writes a string to the file }
-           { the string is written without a length byte }
-           procedure write_string(const s : string);
-
-           { writes a zero terminated string }
-           procedure write_pchar(p : pchar);
-
-           { write specific data types, takes care of }
-           { byte order                               }
-           procedure write_byte(b : byte);
-           procedure write_word(w : word);
-           procedure write_long(l : longint);
-           procedure write_double(d : double);
-
-           { writes any data }
-           procedure write_data(var data;count : longint);
-
-           { reads any data }
-           procedure read_data(var data;bytes : longint;var count : longint);
-
-           { closes the file and releases the buffer }
-           procedure close;
-
-           { temporary closing }
-           procedure tempclose;
-           procedure tempreopen;
-
-           { goto the given position }
-           procedure seek(l : longint);
-
-           { installes an user defined buffer      }
-           { and releases the old one, but be      }
-           { careful, if the old buffer contains   }
-           { data, this data is lost               }
-           procedure setbuf(p : pchar;s : longint);
-
-           { reads the file time stamp of the file, }
-           { the file must be opened                }
-           function getftime : longint;
-
-           { returns filesize }
-           function getsize : longint;
-
-           { returns the path }
-           function getpath : string;
-
-           { resets the crc }
-           procedure clear_crc;
-
-           { returns the crc }
-           function getcrc : longint;
-       end;
-{$endif BUFFEREDFILE}
-
 {$ifdef fixLeaksOnError}
     PStackItem = ^TStackItem;
     TStackItem = record
@@ -442,38 +328,8 @@ unit cobjects;
     end;
 {$endif fixLeaksOnError}
 
-    function getspeedvalue(const s : string) : longint;
-
-    { releases the string p and assignes nil to p }
-    { if p=nil then freemem isn't called          }
-    procedure stringdispose(var p : pstring);
-
-    { idem for ansistrings }
-    procedure ansistringdispose(var p : pchar;length : longint);
 
-    { allocates mem for a copy of s, copies s to this mem and returns }
-    { a pointer to this mem                                           }
-    function stringdup(const s : string) : pstring;
-
-    { allocates memory for s and copies s as zero terminated string
-      to that mem and returns a pointer to that mem }
-    function  strpnew(const s : string) : pchar;
-    procedure strdispose(var p : pchar);
-
-    { makes a char lowercase, with spanish, french and german char set }
-    function lowercase(c : char) : char;
-
-    { makes zero terminated string to a pascal string }
-    { the data in p is modified and p is returned     }
-    function pchar2pstring(p : pchar) : pstring;
-
-    { ambivalent to pchar2pstring }
-    function pstring2pchar(p : pstring) : pchar;
-
-  implementation
-
-    uses
-      comphook;
+implementation
 
 {*****************************************************************************
                                     Memory debug
@@ -508,12 +364,11 @@ unit cobjects;
         show;
       end;
 
+
 {*****************************************************************************
                                  Stack
 *****************************************************************************}
 
-
-
 {$ifdef fixLeaksOnError}
 constructor TStack.init;
 begin
@@ -566,192 +421,6 @@ end;
 {$endif fixLeaksOnError}
 
 
-{$ifndef OLDSPEEDVALUE}
-
-{*****************************************************************************
-                                   Crc 32
-*****************************************************************************}
-
-var
-  Crc32Tbl : array[0..255] of longint;
-
-procedure MakeCRC32Tbl;
-var
-  crc : longint;
-  i,n : byte;
-begin
-  for i:=0 to 255 do
-   begin
-     crc:=i;
-     for n:=1 to 8 do
-      if odd(crc) then
-       crc:=(crc shr 1) xor longint($edb88320)
-      else
-       crc:=crc shr 1;
-     Crc32Tbl[i]:=crc;
-   end;
-end;
-
-
-{$ifopt R+}
-  {$define Range_check_on}
-{$endif opt R+}
-
-{$R- needed here }
-{CRC 32}
-Function GetSpeedValue(Const s:String):longint;
-var
-  i,InitCrc : longint;
-begin
-  if Crc32Tbl[1]=0 then
-   MakeCrc32Tbl;
-  InitCrc:=$ffffffff;
-  for i:=1 to Length(s) do
-   InitCrc:=Crc32Tbl[byte(InitCrc) xor ord(s[i])] xor (InitCrc shr 8);
-  GetSpeedValue:=InitCrc;
-end;
-
-{$ifdef Range_check_on}
-  {$R+}
-  {$undef Range_check_on}
-{$endif Range_check_on}
-
-{$else}
-
-{$ifndef TP}
-    function getspeedvalue(const s : string) : longint;
-      var
-        p1,p2:^byte;
-        i : longint;
-
-      begin
-        p1:=@s;
-        longint(p2):=longint(p1)+p1^+1;
-        inc(longint(p1));
-        i:=0;
-        while p1<>p2 do
-         begin
-           i:=i + ord(p1^);
-           inc(longint(p1));
-         end;
-        getspeedvalue:=i;
-      end;
-{$else}
-    function getspeedvalue(const s : string) : longint;
-      type
-        ptrrec=record
-          ofs,seg:word;
-        end;
-      var
-        l,w   : longint;
-        p1,p2 : ^byte;
-      begin
-        p1:=@s;
-        ptrrec(p2).seg:=ptrrec(p1).seg;
-        ptrrec(p2).ofs:=ptrrec(p1).ofs+p1^+1;
-        inc(p1);
-        l:=0;
-        while p1<>p2 do
-         begin
-           l:=l + ord(p1^);
-           inc(p1);
-         end;
-        getspeedvalue:=l;
-      end;
-{$endif}
-
-{$endif OLDSPEEDVALUE}
-
-
-    function pchar2pstring(p : pchar) : pstring;
-      var
-         w,i : longint;
-      begin
-         w:=strlen(p);
-         for i:=w-1 downto 0 do
-           p[i+1]:=p[i];
-         p[0]:=chr(w);
-         pchar2pstring:=pstring(p);
-      end;
-
-
-    function pstring2pchar(p : pstring) : pchar;
-      var
-         w,i : longint;
-      begin
-         w:=length(p^);
-         for i:=1 to w do
-           p^[i-1]:=p^[i];
-         p^[w]:=#0;
-         pstring2pchar:=pchar(p);
-      end;
-
-
-    function lowercase(c : char) : char;
-       begin
-          case c of
-             #65..#90 : c := chr(ord (c) + 32);
-             #154 : c:=#129;  { german }
-             #142 : c:=#132;  { german }
-             #153 : c:=#148;  { german }
-             #144 : c:=#130;  { french }
-             #128 : c:=#135;  { french }
-             #143 : c:=#134;  { swedish/norge (?) }
-             #165 : c:=#164;  { spanish }
-             #228 : c:=#229;  { greek }
-             #226 : c:=#231;  { greek }
-             #232 : c:=#227;  { greek }
-          end;
-          lowercase := c;
-       end;
-
-
-    function strpnew(const s : string) : pchar;
-      var
-         p : pchar;
-      begin
-         getmem(p,length(s)+1);
-         strpcopy(p,s);
-         strpnew:=p;
-      end;
-
-
-    procedure strdispose(var p : pchar);
-      begin
-        if assigned(p) then
-         begin
-           freemem(p,strlen(p)+1);
-           p:=nil;
-         end;
-      end;
-
-
-    procedure stringdispose(var p : pstring);
-      begin
-         if assigned(p) then
-           freemem(p,length(p^)+1);
-         p:=nil;
-      end;
-
-
-    procedure ansistringdispose(var p : pchar;length : longint);
-      begin
-         if assigned(p) then
-           freemem(p,length+1);
-         p:=nil;
-      end;
-
-
-    function stringdup(const s : string) : pstring;
-      var
-         p : pstring;
-      begin
-         getmem(p,length(s)+1);
-         p^:=s;
-         stringdup:=p;
-      end;
-
-
 {****************************************************************************
                                   TStringQueue
 ****************************************************************************}
@@ -1150,11 +819,11 @@ end;
 
 
     destructor tlinkedlist.done;
-
       begin
          clear;
       end;
 
+
     procedure tlinkedlist.clear;
       var
          newnode : plinkedlist_item;
@@ -1493,8 +1162,6 @@ end;
                             lr:=left;
                         end;
                 end;
-            if (oldroot=nil) or (root=nil) then
-                do_internalerror(218); {Internalerror is not available...}
             if root^.left<>nil then
                 begin
                     {Now the node pointing to root must point to the left
@@ -2198,392 +1865,14 @@ end;
          p^.indexnext:=nil;
       end;
 
-
-{$ifdef BUFFEREDFILE}
-
-{****************************************************************************
-                               TBUFFEREDFILE
- ****************************************************************************}
-
-    Const
-       crcseed = $ffffffff;
-
-       crctable : array[0..255] of longint = (
-          $00000000,$77073096,$ee0e612c,$990951ba,$076dc419,$706af48f,
-          $e963a535,$9e6495a3,$0edb8832,$79dcb8a4,$e0d5e91e,$97d2d988,
-          $09b64c2b,$7eb17cbd,$e7b82d07,$90bf1d91,$1db71064,$6ab020f2,
-          $f3b97148,$84be41de,$1adad47d,$6ddde4eb,$f4d4b551,$83d385c7,
-          $136c9856,$646ba8c0,$fd62f97a,$8a65c9ec,$14015c4f,$63066cd9,
-          $fa0f3d63,$8d080df5,$3b6e20c8,$4c69105e,$d56041e4,$a2677172,
-          $3c03e4d1,$4b04d447,$d20d85fd,$a50ab56b,$35b5a8fa,$42b2986c,
-          $dbbbc9d6,$acbcf940,$32d86ce3,$45df5c75,$dcd60dcf,$abd13d59,
-          $26d930ac,$51de003a,$c8d75180,$bfd06116,$21b4f4b5,$56b3c423,
-          $cfba9599,$b8bda50f,$2802b89e,$5f058808,$c60cd9b2,$b10be924,
-          $2f6f7c87,$58684c11,$c1611dab,$b6662d3d,$76dc4190,$01db7106,
-          $98d220bc,$efd5102a,$71b18589,$06b6b51f,$9fbfe4a5,$e8b8d433,
-          $7807c9a2,$0f00f934,$9609a88e,$e10e9818,$7f6a0dbb,$086d3d2d,
-          $91646c97,$e6635c01,$6b6b51f4,$1c6c6162,$856530d8,$f262004e,
-          $6c0695ed,$1b01a57b,$8208f4c1,$f50fc457,$65b0d9c6,$12b7e950,
-          $8bbeb8ea,$fcb9887c,$62dd1ddf,$15da2d49,$8cd37cf3,$fbd44c65,
-          $4db26158,$3ab551ce,$a3bc0074,$d4bb30e2,$4adfa541,$3dd895d7,
-          $a4d1c46d,$d3d6f4fb,$4369e96a,$346ed9fc,$ad678846,$da60b8d0,
-          $44042d73,$33031de5,$aa0a4c5f,$dd0d7cc9,$5005713c,$270241aa,
-          $be0b1010,$c90c2086,$5768b525,$206f85b3,$b966d409,$ce61e49f,
-          $5edef90e,$29d9c998,$b0d09822,$c7d7a8b4,$59b33d17,$2eb40d81,
-          $b7bd5c3b,$c0ba6cad,$edb88320,$9abfb3b6,$03b6e20c,$74b1d29a,
-          $ead54739,$9dd277af,$04db2615,$73dc1683,$e3630b12,$94643b84,
-          $0d6d6a3e,$7a6a5aa8,$e40ecf0b,$9309ff9d,$0a00ae27,$7d079eb1,
-          $f00f9344,$8708a3d2,$1e01f268,$6906c2fe,$f762575d,$806567cb,
-          $196c3671,$6e6b06e7,$fed41b76,$89d32be0,$10da7a5a,$67dd4acc,
-          $f9b9df6f,$8ebeeff9,$17b7be43,$60b08ed5,$d6d6a3e8,$a1d1937e,
-          $38d8c2c4,$4fdff252,$d1bb67f1,$a6bc5767,$3fb506dd,$48b2364b,
-          $d80d2bda,$af0a1b4c,$36034af6,$41047a60,$df60efc3,$a867df55,
-          $316e8eef,$4669be79,$cb61b38c,$bc66831a,$256fd2a0,$5268e236,
-          $cc0c7795,$bb0b4703,$220216b9,$5505262f,$c5ba3bbe,$b2bd0b28,
-          $2bb45a92,$5cb36a04,$c2d7ffa7,$b5d0cf31,$2cd99e8b,$5bdeae1d,
-          $9b64c2b0,$ec63f226,$756aa39c,$026d930a,$9c0906a9,$eb0e363f,
-          $72076785,$05005713,$95bf4a82,$e2b87a14,$7bb12bae,$0cb61b38,
-          $92d28e9b,$e5d5be0d,$7cdcefb7,$0bdbdf21,$86d3d2d4,$f1d4e242,
-          $68ddb3f8,$1fda836e,$81be16cd,$f6b9265b,$6fb077e1,$18b74777,
-          $88085ae6,$ff0f6a70,$66063bca,$11010b5c,$8f659eff,$f862ae69,
-          $616bffd3,$166ccf45,$a00ae278,$d70dd2ee,$4e048354,$3903b3c2,
-          $a7672661,$d06016f7,$4969474d,$3e6e77db,$aed16a4a,$d9d65adc,
-          $40df0b66,$37d83bf0,$a9bcae53,$debb9ec5,$47b2cf7f,$30b5ffe9,
-          $bdbdf21c,$cabac28a,$53b39330,$24b4a3a6,$bad03605,$cdd70693,
-          $54de5729,$23d967bf,$b3667a2e,$c4614ab8,$5d681b02,$2a6f2b94,
-          $b40bbe37,$c30c8ea1,$5a05df1b,$2d02ef8d);
-
-    constructor tbufferedfile.init(const filename : string;_bufsize : longint);
-
-      begin
-         assign(f,filename);
-         bufsize:=_bufsize;
-         bufpos:=0;
-         buflast:=0;
-         do_crc:=false;
-         iomode:=0;
-         tempclosed:=false;
-         change_endian:=false;
-         clear_crc;
-      end;
-
-    destructor tbufferedfile.done;
-
-      begin
-         close;
-      end;
-
-    procedure tbufferedfile.clear_crc;
-
-      begin
-         crc:=crcseed;
-      end;
-
-    procedure tbufferedfile.setbuf(p : pchar;s : longint);
-
-      begin
-         flush;
-         freemem(buf,bufsize);
-         bufsize:=s;
-         buf:=p;
-      end;
-
-    function tbufferedfile.reset:boolean;
-
-      var
-         ofm : byte;
-      begin
-         ofm:=filemode;
-         iomode:=1;
-         getmem(buf,bufsize);
-         filemode:=0;
-         {$I-}
-          system.reset(f,1);
-         {$I+}
-         reset:=(ioresult=0);
-         filemode:=ofm;
-      end;
-
-    procedure tbufferedfile.rewrite;
-
-      begin
-         iomode:=2;
-         getmem(buf,bufsize);
-         system.rewrite(f,1);
-      end;
-
-    procedure tbufferedfile.flush;
-
-      var
-{$ifdef FPC}
-         count : longint;
-{$else}
-         count : integer;
-{$endif}
-
-      begin
-         if iomode=2 then
-           begin
-              if bufpos=0 then
-                exit;
-              blockwrite(f,buf^,bufpos)
-           end
-         else if iomode=1 then
-            if buflast=bufpos then
-              begin
-                 blockread(f,buf^,bufsize,count);
-                 buflast:=count;
-              end;
-         bufpos:=0;
-      end;
-
-    function tbufferedfile.getftime : longint;
-
-      var
-         l : longint;
-{$ifdef linux}
-         Info : Stat;
-{$endif}
-      begin
-{$ifndef linux}
-         { this only works if the file is open !! }
-         dos.getftime(f,l);
-{$else}
-         Fstat(f,Info);
-         l:=info.mtime;
-{$endif}
-         getftime:=l;
-      end;
-
-    function tbufferedfile.getsize : longint;
-
-      begin
-        getsize:=filesize(f);
-      end;
-
-    procedure tbufferedfile.seek(l : longint);
-
-      begin
-         if iomode=2 then
-           begin
-              flush;
-              system.seek(f,l);
-           end
-         else if iomode=1 then
-           begin
-              { forces a reload }
-              bufpos:=buflast;
-              system.seek(f,l);
-              flush;
-           end;
-      end;
-
-    type
-{$ifdef tp}
-       bytearray1 = array [1..65535] of byte;
-{$else}
-       bytearray1 = array [1..10000000] of byte;
-{$endif}
-
-    procedure tbufferedfile.read_data(var data;bytes : longint;var count : longint);
-
-      var
-         p : pchar;
-         c,i : longint;
-
-      begin
-         p:=pchar(@data);
-         count:=0;
-         while bytes-count>0 do
-           begin
-              if bytes-count>buflast-bufpos then
-                begin
-                   move((buf+bufpos)^,(p+count)^,buflast-bufpos);
-                   inc(count,buflast-bufpos);
-                   bufpos:=buflast;
-                   flush;
-                   { can't we read anything ? }
-                   if bufpos=buflast then
-                     break;
-                end
-              else
-                begin
-                   move((buf+bufpos)^,(p+count)^,bytes-count);
-                   inc(bufpos,bytes-count);
-                   count:=bytes;
-                   break;
-                end;
-           end;
-         if do_crc then
-           begin
-              c:=crc;
-              for i:=1 to bytes do
-              c:=(c shr 8) xor crctable[byte(c) xor (bytearray1(data)[i])];
-              crc:=c;
-           end;
-      end;
-
-    procedure tbufferedfile.write_data(var data;count : longint);
-
-      var
-         c,i : longint;
-
-      begin
-         if bufpos+count>bufsize then
-           flush;
-         move(data,(buf+bufpos)^,count);
-         inc(bufpos,count);
-         if do_crc then
-           begin
-              c:=crc;
-              for i:=1 to count do
-                c:=(c shr 8) xor crctable[byte(c) xor (bytearray1(data)[i])];
-              crc:=c;
-           end;
-      end;
-
-    function tbufferedfile.getcrc : longint;
-
-      begin
-         getcrc:=crc xor crcseed;
-      end;
-
-    procedure tbufferedfile.write_string(const s : string);
-
-      begin
-        if bufpos+length(s)>bufsize then
-          flush;
-        { why is there not CRC here ??? }
-        move(s[1],(buf+bufpos)^,length(s));
-        inc(bufpos,length(s));
-         { should be
-        write_data(s[1],length(s)); }
-      end;
-
-    procedure tbufferedfile.write_pchar(p : pchar);
-
-      var
-         l : longint;
-
-      begin
-        l:=strlen(p);
-        if l>=bufsize then
-          do_internalerror(222);
-        { why is there not CRC here ???}
-        if bufpos+l>bufsize then
-          flush;
-        move(p^,(buf+bufpos)^,l);
-        inc(bufpos,l);
-         { should be
-        write_data(p^,l); }
-      end;
-
-    procedure tbufferedfile.write_byte(b : byte);
-
-      begin
-         write_data(b,sizeof(byte));
-      end;
-
-    procedure tbufferedfile.write_long(l : longint);
-
-      var
-         w1,w2 : word;
-
-      begin
-         if change_endian then
-           begin
-              w1:=l and $ffff;
-              w2:=l shr 16;
-              l:=swap(w2)+(longint(swap(w1)) shl 16);
-           end;
-         write_data(l,sizeof(longint));
-      end;
-
-    procedure tbufferedfile.write_word(w : word);
-
-      begin
-         if change_endian then
-           begin
-              w:=swap(w);
-           end;
-         write_data(w,sizeof(word));
-      end;
-
-    procedure tbufferedfile.write_double(d : double);
-
-      begin
-         write_data(d,sizeof(double));
-      end;
-
-    function tbufferedfile.getpath : string;
-
-      begin
-{$ifdef dummy}
-         getpath:=strpas(filerec(f).name);
-{$endif}
-         getpath:='';
-      end;
-
-    procedure tbufferedfile.close;
-
-      begin
-         if iomode<>0 then
-           begin
-              flush;
-              system.close(f);
-              freemem(buf,bufsize);
-              buf:=nil;
-              iomode:=0;
-           end;
-      end;
-
-    procedure tbufferedfile.tempclose;
-
-      begin
-        if iomode<>0 then
-         begin
-           temppos:=system.filepos(f);
-           tempmode:=iomode;
-           tempclosed:=true;
-           system.close(f);
-           iomode:=0;
-         end
-        else
-         tempclosed:=false;
-      end;
-
-    procedure tbufferedfile.tempreopen;
-
-      var
-         ofm : byte;
-
-      begin
-         if tempclosed then
-           begin
-              case tempmode of
-               1 : begin
-                     ofm:=filemode;
-                     iomode:=1;
-                     filemode:=0;
-                     system.reset(f,1);
-                     filemode:=ofm;
-                   end;
-               2 : begin
-                     iomode:=2;
-                     system.rewrite(f,1);
-                   end;
-              end;
-              system.seek(f,temppos);
-              tempclosed:=false;
-           end;
-      end;
-
-{$endif BUFFEREDFILE}
-
 end.
 {
   $Log$
-  Revision 1.10  2000-08-19 18:44:27  peter
+  Revision 1.11  2000-08-27 16:11:50  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.10  2000/08/19 18:44:27  peter
     * new tdynamicarray implementation using blocks instead of
       reallocmem (merged)
 

+ 7 - 2
compiler/comphook.pas

@@ -23,7 +23,8 @@
 unit comphook;
 interface
 
-uses files;
+uses
+  finput;
 
 Const
 { <$10000 will show file and line }
@@ -370,7 +371,11 @@ Function def_GetNamedFileTime (Const F : String) : Longint;
 end.
 {
   $Log$
-  Revision 1.4  2000-08-13 13:04:15  peter
+  Revision 1.5  2000-08-27 16:11:50  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.4  2000/08/13 13:04:15  peter
     * -vb update
 
   Revision 1.3  2000/08/12 15:30:45  peter

+ 6 - 2
compiler/compiler.pas

@@ -117,7 +117,7 @@ uses
   dos,
 {$endif Delphi}
   verbose,comphook,systems,
-  cobjects,globals,options,parser,symtable,link,import,export,tokens;
+  cutils,cobjects,globals,options,parser,symtable,link,import,export,tokens;
 
 function Compile(const cmd:string):longint;
 
@@ -355,7 +355,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.4  2000-08-21 09:14:40  jonas
+  Revision 1.5  2000-08-27 16:11:50  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.4  2000/08/21 09:14:40  jonas
     - removed catch unit from uses clause for Linux (clashed with fpcatch
      from IDE and is already in pp.pas for command line compiler) (merged
      from fixes branch)

+ 6 - 2
compiler/comprsrc.pas

@@ -46,7 +46,7 @@ uses
 {$else Delphi}
   dos,
 {$endif Delphi}
-  Systems,Globtype,Globals,Verbose,Files,
+  Systems,cutils,Globtype,Globals,Verbose,Fmodule,
   Script;
 
 {****************************************************************************
@@ -140,7 +140,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2000-08-04 22:00:51  peter
+  Revision 1.4  2000-08-27 16:11:50  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.3  2000/08/04 22:00:51  peter
     * merges from fixes
 
   Revision 1.2  2000/07/13 11:32:38  michael

+ 7 - 2
compiler/cpuasm.pas

@@ -141,8 +141,9 @@ type
 
 
 implementation
+
 uses
-  og386;
+  cutils,og386;
 
 {*****************************************************************************
                                  TaiRegAlloc
@@ -1673,7 +1674,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2000-07-13 12:08:25  michael
+  Revision 1.4  2000-08-27 16:11:50  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.3  2000/07/13 12:08:25  michael
   + patched to 1.1.0 with former 1.09patch from peter
 
   Revision 1.2  2000/07/13 11:32:38  michael

+ 6 - 2
compiler/cpubase.pas

@@ -39,7 +39,7 @@ interface
 {$endif}
 
 uses
-  globals,strings,cobjects,aasm;
+  globals,strings,cutils,cobjects,aasm;
 
 const
 { Size of the instruction table converted by nasmconv.pas }
@@ -902,7 +902,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.4  2000-08-05 13:25:06  peter
+  Revision 1.5  2000-08-27 16:11:50  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.4  2000/08/05 13:25:06  peter
     * packenum 1 fixes (merged)
 
   Revision 1.3  2000/07/14 05:11:48  michael

+ 6 - 2
compiler/cresstr.pas

@@ -59,7 +59,7 @@ var
 implementation
 
 uses
-   globals,aasm,verbose,files;
+   cutils,globals,aasm,verbose,fmodule;
 
 
 { ---------------------------------------------------------------------
@@ -284,7 +284,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.4  2000-08-15 09:45:29  michael
+  Revision 1.5  2000-08-27 16:11:50  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.4  2000/08/15 09:45:29  michael
   + Merged changes in fixbranch
 
   Revision 1.1.2.1  2000/08/15 09:41:56  michael

+ 599 - 0
compiler/cutils.pas

@@ -0,0 +1,599 @@
+{
+    $Id$
+    Copyright (C) 1998-2000 by Florian Klaempfl
+
+    This unit implements some support functions
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+
+{$ifdef tp}
+  {$E+,N+}
+{$endif}
+
+unit cutils;
+
+interface
+
+    type
+       pstring = ^string;
+
+{$ifdef TP}
+       { redeclare dword only in case of emergency, some small things
+         of the compiler won't work then correctly (FK)
+       }
+       dword = longint;
+{$endif TP}
+
+
+    function min(a,b : longint) : longint;
+    function max(a,b : longint) : longint;
+    function align(i,a:longint):longint;
+    function align_from_size(datasize:longint;length:longint):longint;
+    procedure Replace(var s:string;s1:string;const s2:string);
+    procedure ReplaceCase(var s:string;const s1,s2:string);
+    function upper(const s : string) : string;
+    function lower(const s : string) : string;
+    function trimspace(const s:string):string;
+    procedure uppervar(var s : string);
+    function hexstr(val : longint;cnt : byte) : string;
+    {$ifdef FPC}
+    function tostru(i:cardinal) : string;
+    {$else}
+    function tostru(i:longint) : string;
+    {$endif}
+    function tostr(i : longint) : string;
+    function tostr_with_plus(i : longint) : string;
+    procedure valint(S : string;var V : longint;var code : integer);
+    function is_number(const s : string) : boolean;
+    function ispowerof2(value : longint;var power : longint) : boolean;
+
+    { releases the string p and assignes nil to p }
+    { if p=nil then freemem isn't called          }
+    procedure stringdispose(var p : pstring);
+
+
+    { allocates mem for a copy of s, copies s to this mem and returns }
+    { a pointer to this mem                                           }
+    function stringdup(const s : string) : pstring;
+
+    { allocates memory for s and copies s as zero terminated string
+      to that mem and returns a pointer to that mem }
+    function  strpnew(const s : string) : pchar;
+    procedure strdispose(var p : pchar);
+
+    { makes a char lowercase, with spanish, french and german char set }
+    function lowercase(c : char) : char;
+
+    { makes zero terminated string to a pascal string }
+    { the data in p is modified and p is returned     }
+    function pchar2pstring(p : pchar) : pstring;
+
+    { ambivalent to pchar2pstring }
+    function pstring2pchar(p : pstring) : pchar;
+
+{ Speed/Hash value }
+function getspeedvalue(const s : string) : longint;
+
+{ Ansistring (pchar+length) support }
+procedure ansistringdispose(var p : pchar;length : longint);
+function compareansistrings(p1,p2 : pchar;length1,length2 : longint) : longint;
+function concatansistrings(p1,p2 : pchar;length1,length2 : longint) : pchar;
+
+
+implementation
+
+uses
+  strings;
+
+    function min(a,b : longint) : longint;
+    {
+      return the minimal of a and b
+    }
+      begin
+         if a>b then
+           min:=b
+         else
+           min:=a;
+      end;
+
+
+    function max(a,b : longint) : longint;
+    {
+      return the maximum of a and b
+    }
+      begin
+         if a<b then
+           max:=b
+         else
+           max:=a;
+      end;
+
+    function align_from_size(datasize:longint;length:longint):longint;
+
+    {Increases the datasize with the required alignment; i.e. on pentium
+     words should be aligned word; and dwords should be aligned dword.
+     So for a word (len=2), datasize is increased to the nearest multiple
+     of 2, and for len=4, datasize is increased to the nearest multiple of
+     4.}
+
+    var data_align:word;
+
+    begin
+        {$IFDEF I386}
+        if length>2 then
+            data_align:=4
+        else if length>1 then
+            data_align:=2
+        else
+            data_align:=1;
+        {$ENDIF}
+        {$IFDEF M68K}
+        data_align:=2;
+        {$ENDIF}
+        align_from_size:=(datasize+data_align-1) and not(data_align-1);
+    end;
+
+
+    function align(i,a:longint):longint;
+    {
+      return value <i> aligned <a> boundary
+    }
+      begin
+        { for 0 and 1 no aligning is needed }
+        if a<=1 then
+         align:=i
+        else
+         align:=(i+a-1) and not(a-1);
+      end;
+
+
+    procedure Replace(var s:string;s1:string;const s2:string);
+      var
+         last,
+         i  : longint;
+      begin
+        s1:=upper(s1);
+        last:=0;
+        repeat
+          i:=pos(s1,upper(s));
+          if i=last then
+           i:=0;
+          if (i>0) then
+           begin
+             Delete(s,i,length(s1));
+             Insert(s2,s,i);
+             last:=i;
+           end;
+        until (i=0);
+      end;
+
+
+    procedure ReplaceCase(var s:string;const s1,s2:string);
+      var
+         last,
+         i  : longint;
+      begin
+        last:=0;
+        repeat
+          i:=pos(s1,s);
+          if i=last then
+           i:=0;
+          if (i>0) then
+           begin
+             Delete(s,i,length(s1));
+             Insert(s2,s,i);
+             last:=i;
+           end;
+        until (i=0);
+      end;
+
+
+    function upper(const s : string) : string;
+    {
+      return uppercased string of s
+    }
+      var
+         i  : longint;
+      begin
+         for i:=1 to length(s) do
+          if s[i] in ['a'..'z'] then
+           upper[i]:=char(byte(s[i])-32)
+          else
+           upper[i]:=s[i];
+        upper[0]:=s[0];
+      end;
+
+
+    function lower(const s : string) : string;
+    {
+      return lowercased string of s
+    }
+      var
+         i : longint;
+      begin
+         for i:=1 to length(s) do
+          if s[i] in ['A'..'Z'] then
+           lower[i]:=char(byte(s[i])+32)
+          else
+           lower[i]:=s[i];
+        lower[0]:=s[0];
+      end;
+
+
+    procedure uppervar(var s : string);
+    {
+      uppercase string s
+    }
+      var
+         i : longint;
+      begin
+         for i:=1 to length(s) do
+          if s[i] in ['a'..'z'] then
+           s[i]:=char(byte(s[i])-32);
+      end;
+
+    function hexstr(val : longint;cnt : byte) : string;
+      const
+        HexTbl : array[0..15] of char='0123456789ABCDEF';
+      var
+        i : longint;
+      begin
+        hexstr[0]:=char(cnt);
+        for i:=cnt downto 1 do
+         begin
+           hexstr[i]:=hextbl[val and $f];
+           val:=val shr 4;
+         end;
+      end;
+
+{$ifdef FPC}
+   function tostru(i:cardinal):string;
+   {
+     return string of value i, but for cardinals
+   }
+      var
+        hs : string;
+      begin
+        str(i,hs);
+        tostru:=hs;
+      end;
+{$else FPC}
+    function tostru(i:longint):string;
+      begin
+        tostru:=tostr(i);
+      end;
+{$endif FPC}
+
+
+   function trimspace(const s:string):string;
+   {
+     return s with all leading and ending spaces and tabs removed
+   }
+     var
+       i,j : longint;
+     begin
+       i:=length(s);
+       while (i>0) and (s[i] in [#9,' ']) do
+        dec(i);
+       j:=1;
+       while (j<i) and (s[j] in [#9,' ']) do
+        inc(j);
+       trimspace:=Copy(s,j,i-j+1);
+     end;
+
+
+   function tostr(i : longint) : string;
+   {
+     return string of value i
+   }
+     var
+        hs : string;
+     begin
+        str(i,hs);
+        tostr:=hs;
+     end;
+
+
+   function tostr_with_plus(i : longint) : string;
+   {
+     return string of value i, but always include a + when i>=0
+   }
+     var
+        hs : string;
+     begin
+        str(i,hs);
+        if i>=0 then
+          tostr_with_plus:='+'+hs
+        else
+          tostr_with_plus:=hs;
+     end;
+
+
+    procedure valint(S : string;var V : longint;var code : integer);
+    {
+      val() with support for octal, which is not supported under tp7
+    }
+{$ifndef FPC}
+      var
+        vs : longint;
+        c  : byte;
+      begin
+        if s[1]='%' then
+          begin
+             vs:=0;
+             longint(v):=0;
+             for c:=2 to length(s) do
+               begin
+                  if s[c]='0' then
+                    vs:=vs shl 1
+                  else
+                  if s[c]='1' then
+                    vs:=vs shl 1+1
+                  else
+                    begin
+                      code:=c;
+                      exit;
+                    end;
+               end;
+             code:=0;
+             longint(v):=vs;
+          end
+        else
+         system.val(S,V,code);
+      end;
+{$else not FPC}
+      begin
+         system.val(S,V,code);
+      end;
+{$endif not FPC}
+
+
+    function is_number(const s : string) : boolean;
+    {
+      is string a correct number ?
+    }
+      var
+         w : integer;
+         l : longint;
+      begin
+         valint(s,l,w);
+         is_number:=(w=0);
+      end;
+
+
+    function ispowerof2(value : longint;var power : longint) : boolean;
+    {
+      return if value is a power of 2. And if correct return the power
+    }
+      var
+         hl : longint;
+         i : longint;
+      begin
+         hl:=1;
+         ispowerof2:=true;
+         for i:=0 to 31 do
+           begin
+              if hl=value then
+                begin
+                   power:=i;
+                   exit;
+                end;
+              hl:=hl shl 1;
+           end;
+         ispowerof2:=false;
+      end;
+
+
+    function pchar2pstring(p : pchar) : pstring;
+      var
+         w,i : longint;
+      begin
+         w:=strlen(p);
+         for i:=w-1 downto 0 do
+           p[i+1]:=p[i];
+         p[0]:=chr(w);
+         pchar2pstring:=pstring(p);
+      end;
+
+
+    function pstring2pchar(p : pstring) : pchar;
+      var
+         w,i : longint;
+      begin
+         w:=length(p^);
+         for i:=1 to w do
+           p^[i-1]:=p^[i];
+         p^[w]:=#0;
+         pstring2pchar:=pchar(p);
+      end;
+
+
+    function lowercase(c : char) : char;
+       begin
+          case c of
+             #65..#90 : c := chr(ord (c) + 32);
+             #154 : c:=#129;  { german }
+             #142 : c:=#132;  { german }
+             #153 : c:=#148;  { german }
+             #144 : c:=#130;  { french }
+             #128 : c:=#135;  { french }
+             #143 : c:=#134;  { swedish/norge (?) }
+             #165 : c:=#164;  { spanish }
+             #228 : c:=#229;  { greek }
+             #226 : c:=#231;  { greek }
+             #232 : c:=#227;  { greek }
+          end;
+          lowercase := c;
+       end;
+
+
+    function strpnew(const s : string) : pchar;
+      var
+         p : pchar;
+      begin
+         getmem(p,length(s)+1);
+         strpcopy(p,s);
+         strpnew:=p;
+      end;
+
+
+    procedure strdispose(var p : pchar);
+      begin
+        if assigned(p) then
+         begin
+           freemem(p,strlen(p)+1);
+           p:=nil;
+         end;
+      end;
+
+
+    procedure stringdispose(var p : pstring);
+      begin
+         if assigned(p) then
+           freemem(p,length(p^)+1);
+         p:=nil;
+      end;
+
+
+    function stringdup(const s : string) : pstring;
+      var
+         p : pstring;
+      begin
+         getmem(p,length(s)+1);
+         p^:=s;
+         stringdup:=p;
+      end;
+
+
+
+{*****************************************************************************
+                               GetSpeedValue
+*****************************************************************************}
+
+var
+  Crc32Tbl : array[0..255] of longint;
+
+procedure MakeCRC32Tbl;
+var
+  crc : longint;
+  i,n : byte;
+begin
+  for i:=0 to 255 do
+   begin
+     crc:=i;
+     for n:=1 to 8 do
+      if odd(crc) then
+       crc:=(crc shr 1) xor longint($edb88320)
+      else
+       crc:=crc shr 1;
+     Crc32Tbl[i]:=crc;
+   end;
+end;
+
+
+{$ifopt R+}
+  {$define Range_check_on}
+{$endif opt R+}
+
+{$R- needed here }
+{CRC 32}
+Function GetSpeedValue(Const s:String):longint;
+var
+  i,InitCrc : longint;
+begin
+  if Crc32Tbl[1]=0 then
+   MakeCrc32Tbl;
+  InitCrc:=$ffffffff;
+  for i:=1 to Length(s) do
+   InitCrc:=Crc32Tbl[byte(InitCrc) xor ord(s[i])] xor (InitCrc shr 8);
+  GetSpeedValue:=InitCrc;
+end;
+
+{$ifdef Range_check_on}
+  {$R+}
+  {$undef Range_check_on}
+{$endif Range_check_on}
+
+
+{*****************************************************************************
+                               Ansistring (PChar+Length)
+*****************************************************************************}
+
+    procedure ansistringdispose(var p : pchar;length : longint);
+      begin
+         if assigned(p) then
+           freemem(p,length+1);
+         p:=nil;
+      end;
+
+
+    { enable ansistring comparison }
+    { 0 means equal }
+    { 1 means p1 > p2 }
+    { -1 means p1 < p2 }
+    function compareansistrings(p1,p2 : pchar;length1,length2 : longint) : longint;
+      var
+         i,j : longint;
+      begin
+         compareansistrings:=0;
+         j:=min(length1,length2);
+         i:=0;
+         while (i<j) do
+          begin
+            if p1[i]>p2[i] then
+             begin
+               compareansistrings:=1;
+               exit;
+             end
+            else
+             if p1[i]<p2[i] then
+              begin
+                compareansistrings:=-1;
+                exit;
+              end;
+            inc(i);
+          end;
+         if length1>length2 then
+          compareansistrings:=1
+         else
+          if length1<length2 then
+           compareansistrings:=-1;
+      end;
+
+
+    function concatansistrings(p1,p2 : pchar;length1,length2 : longint) : pchar;
+      var
+         p : pchar;
+      begin
+         getmem(p,length1+length2+1);
+         move(p1[0],p[0],length1);
+         move(p2[0],p[length1],length2+1);
+         concatansistrings:=p;
+      end;
+
+
+
+
+end.
+{
+  $Log$
+  Revision 1.1  2000-08-27 16:11:50  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+}

+ 8 - 3
compiler/export.pas

@@ -25,7 +25,8 @@ unit export;
 interface
 
 uses
-  cobjects{$IFDEF NEWST},objects{$ENDIF NEWST},symtable;
+  cutils,cobjects,
+  symtable;
 
 const
    { export options }
@@ -68,7 +69,7 @@ procedure DoneExport;
 implementation
 
 uses
-  systems,verbose,globals,files
+  systems,verbose,globals,fmodule
 {$ifdef i386}
   {$ifndef NOTARGETLINUX}
     ,t_linux
@@ -213,7 +214,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:41  michael
+  Revision 1.3  2000-08-27 16:11:50  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.2  2000/07/13 11:32:41  michael
   + removed logs
 
 }

+ 591 - 0
compiler/finput.pas

@@ -0,0 +1,591 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Florian Klaempfl
+
+    This unit implements an extended file management
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit finput;
+
+{$ifdef TP}
+  {$V+}
+{$endif}
+
+  interface
+
+    uses
+      cutils;
+
+    const
+{$ifdef FPC}
+       InputFileBufSize=32*1024;
+       linebufincrease=512;
+{$else}
+       InputFileBufSize=1024;
+       linebufincrease=64;
+{$endif}
+
+    type
+{$ifdef TP}
+       tlongintarr = array[0..16000] of longint;
+{$else}
+       tlongintarr = array[0..1000000] of longint;
+{$endif}
+       plongintarr = ^tlongintarr;
+
+       pinputfile = ^tinputfile;
+       tinputfile = object
+         path,name : pstring;       { path and filename }
+         next      : pinputfile;    { next file for reading }
+
+         is_macro,
+         endoffile,                 { still bytes left to read }
+         closed       : boolean;    { is the file closed }
+
+         buf          : pchar;      { buffer }
+         bufstart,                  { buffer start position in the file }
+         bufsize,                   { amount of bytes in the buffer }
+         maxbufsize   : longint;    { size in memory for the buffer }
+
+         saveinputpointer : pchar;  { save fields for scanner variables }
+         savelastlinepos,
+         saveline_no      : longint;
+
+         linebuf    : plongintarr;  { line buffer to retrieve lines }
+         maxlinebuf : longint;
+
+         ref_count  : longint;      { to handle the browser refs }
+         ref_index  : longint;
+         ref_next   : pinputfile;
+
+         constructor init(const fn:string);
+         destructor done;
+         procedure setpos(l:longint);
+         procedure seekbuf(fpos:longint);
+         procedure readbuf;
+         function  open:boolean;
+         procedure close;
+         procedure tempclose;
+         function  tempopen:boolean;
+         procedure setmacro(p:pchar;len:longint);
+         procedure setline(line,linepos:longint);
+         function  getlinestr(l:longint):string;
+       {$ifdef FPC}protected{$else}public{$endif}
+         function fileopen(const filename: string): boolean; virtual;
+         function fileseek(pos: longint): boolean; virtual;
+         function fileread(var databuf; maxsize: longint): longint; virtual;
+         function fileeof: boolean; virtual;
+         function fileclose: boolean; virtual;
+       end;
+
+       pdosinputfile = ^tdosinputfile;
+       tdosinputfile = object(tinputfile)
+       {$ifdef FPC}protected{$else}public{$endif}
+         function fileopen(const filename: string): boolean; virtual;
+         function fileseek(pos: longint): boolean; virtual;
+         function fileread(var databuf; maxsize: longint): longint; virtual;
+         function fileeof: boolean; virtual;
+         function fileclose: boolean; virtual;
+       private
+         f            : file;       { current file handle }
+       end;
+
+       pinputfilemanager = ^tinputfilemanager;
+       tinputfilemanager = object
+          files : pinputfile;
+          last_ref_index : longint;
+          cacheindex : longint;
+          cacheinputfile : pinputfile;
+          constructor init;
+          destructor done;
+          procedure register_file(f : pinputfile);
+          procedure inverse_register_indexes;
+          function  get_file(l:longint) : pinputfile;
+          function  get_file_name(l :longint):string;
+          function  get_file_path(l :longint):string;
+       end;
+
+
+implementation
+
+uses
+{$ifdef Delphi}
+  dmisc,
+{$else Delphi}
+  dos,
+{$endif Delphi}
+  cobjects,globals;
+
+{****************************************************************************
+                                  TINPUTFILE
+ ****************************************************************************}
+
+    constructor tinputfile.init(const fn:string);
+      var
+        p:dirstr;
+        n:namestr;
+        e:extstr;
+      begin
+        FSplit(fn,p,n,e);
+        name:=stringdup(n+e);
+        path:=stringdup(p);
+        next:=nil;
+      { file info }
+        is_macro:=false;
+        endoffile:=false;
+        closed:=true;
+        buf:=nil;
+        bufstart:=0;
+        bufsize:=0;
+        maxbufsize:=InputFileBufSize;
+      { save fields }
+        saveinputpointer:=nil;
+        saveline_no:=0;
+        savelastlinepos:=0;
+      { indexing refs }
+        ref_next:=nil;
+        ref_count:=0;
+        ref_index:=0;
+      { line buffer }
+        linebuf:=nil;
+        maxlinebuf:=0;
+      end;
+
+
+    destructor tinputfile.done;
+      begin
+        if not closed then
+         close;
+        stringdispose(path);
+        stringdispose(name);
+      { free memory }
+        if assigned(linebuf) then
+         freemem(linebuf,maxlinebuf shl 2);
+      end;
+
+
+    procedure tinputfile.setpos(l:longint);
+      begin
+        bufstart:=l;
+      end;
+
+
+    procedure tinputfile.seekbuf(fpos:longint);
+      begin
+        if closed then
+         exit;
+        fileseek(fpos);
+        bufstart:=fpos;
+        bufsize:=0;
+      end;
+
+
+    procedure tinputfile.readbuf;
+      begin
+        if is_macro then
+         endoffile:=true;
+        if closed then
+         exit;
+        inc(bufstart,bufsize);
+        bufsize:=fileread(buf^,maxbufsize-1);
+        buf[bufsize]:=#0;
+        endoffile:=fileeof;
+      end;
+
+
+    function tinputfile.open:boolean;
+      begin
+        open:=false;
+        if not closed then
+         Close;
+        if not fileopen(path^+name^) then
+         exit;
+      { file }
+        endoffile:=false;
+        closed:=false;
+        Getmem(buf,MaxBufsize);
+        bufstart:=0;
+        bufsize:=0;
+        open:=true;
+      end;
+
+
+    procedure tinputfile.close;
+      begin
+        if is_macro then
+         begin
+           if assigned(buf) then
+             Freemem(buf,maxbufsize);
+           buf:=nil;
+           {is_macro:=false;
+           still needed for dispose in scanner PM }
+           closed:=true;
+           exit;
+         end;
+        if not closed then
+         begin
+           if fileclose then;
+           closed:=true;
+         end;
+        if assigned(buf) then
+          begin
+             Freemem(buf,maxbufsize);
+             buf:=nil;
+          end;
+        bufstart:=0;
+      end;
+
+
+    procedure tinputfile.tempclose;
+      begin
+        if is_macro then
+         exit;
+        if not closed then
+         begin
+           if fileclose then;
+           Freemem(buf,maxbufsize);
+           buf:=nil;
+           closed:=true;
+         end;
+      end;
+
+    function tinputfile.tempopen:boolean;
+      begin
+        tempopen:=false;
+        if is_macro then
+         begin
+           { seek buffer postion to bufstart }
+           if bufstart>0 then
+            begin
+              move(buf[bufstart],buf[0],bufsize-bufstart+1);
+              bufstart:=0;
+            end;
+           tempopen:=true;
+           exit;
+         end;
+        if not closed then
+         exit;
+        if not fileopen(path^+name^) then
+         exit;
+        closed:=false;
+      { get new mem }
+        Getmem(buf,maxbufsize);
+      { restore state }
+        fileseek(BufStart);
+        bufsize:=0;
+        readbuf;
+        tempopen:=true;
+      end;
+
+
+    procedure tinputfile.setmacro(p:pchar;len:longint);
+      begin
+      { create new buffer }
+        getmem(buf,len+1);
+        move(p^,buf^,len);
+        buf[len]:=#0;
+      { reset }
+        bufstart:=0;
+        bufsize:=len;
+        maxbufsize:=len+1;
+        is_macro:=true;
+        endoffile:=true;
+        closed:=true;
+      end;
+
+
+    procedure tinputfile.setline(line,linepos:longint);
+      var
+        oldlinebuf  : plongintarr;
+      begin
+        if line<1 then
+         exit;
+        while (line>=maxlinebuf) do
+         begin
+           oldlinebuf:=linebuf;
+         { create new linebuf and move old info }
+           getmem(linebuf,(maxlinebuf+linebufincrease) shl 2);
+           if assigned(oldlinebuf) then
+            begin
+              move(oldlinebuf^,linebuf^,maxlinebuf shl 2);
+              freemem(oldlinebuf,maxlinebuf shl 2);
+            end;
+           fillchar(linebuf^[maxlinebuf],linebufincrease shl 2,0);
+           inc(maxlinebuf,linebufincrease);
+         end;
+        linebuf^[line]:=linepos;
+      end;
+
+
+    function tinputfile.getlinestr(l:longint):string;
+      var
+        c    : char;
+        i,
+        fpos : longint;
+        p    : pchar;
+      begin
+        getlinestr:='';
+        if l<maxlinebuf then
+         begin
+           fpos:=linebuf^[l];
+           { fpos is set negativ if the line was already written }
+           { but we still know the correct value                 }
+           if fpos<0 then
+             fpos:=-fpos+1;
+           if closed then
+            open;
+         { in current buf ? }
+           if (fpos<bufstart) or (fpos>bufstart+bufsize) then
+            begin
+              seekbuf(fpos);
+              readbuf;
+            end;
+         { the begin is in the buf now simply read until #13,#10 }
+           i:=0;
+           p:=@buf[fpos-bufstart];
+           repeat
+             c:=p^;
+             if c=#0 then
+              begin
+                if endoffile then
+                 break;
+                readbuf;
+                p:=buf;
+                c:=p^;
+              end;
+             if c in [#10,#13] then
+              break;
+             inc(i);
+             getlinestr[i]:=c;
+             inc(longint(p));
+           until (i=255);
+           {$ifndef TP}
+             {$ifopt H+}
+               setlength(getlinestr,i);
+             {$else}
+               getlinestr[0]:=chr(i);
+             {$endif}
+           {$else}
+             getlinestr[0]:=chr(i);
+           {$endif}
+         end;
+      end;
+
+
+    function tinputfile.fileopen(const filename: string): boolean;
+      begin
+        abstract;
+        fileopen:=false;
+      end;
+
+
+    function tinputfile.fileseek(pos: longint): boolean;
+      begin
+        abstract;
+        fileseek:=false;
+      end;
+
+
+    function tinputfile.fileread(var databuf; maxsize: longint): longint;
+      begin
+        abstract;
+        fileread:=0;
+      end;
+
+
+    function tinputfile.fileeof: boolean;
+      begin
+        abstract;
+        fileeof:=false;
+      end;
+
+
+    function tinputfile.fileclose: boolean;
+      begin
+        abstract;
+        fileclose:=false;
+      end;
+
+
+{****************************************************************************
+                                TDOSINPUTFILE
+ ****************************************************************************}
+
+    function tdosinputfile.fileopen(const filename: string): boolean;
+      var
+        ofm : byte;
+      begin
+        ofm:=filemode;
+        filemode:=0;
+        Assign(f,filename);
+        {$I-}
+         reset(f,1);
+        {$I+}
+        filemode:=ofm;
+        fileopen:=(ioresult=0);
+      end;
+
+
+    function tdosinputfile.fileseek(pos: longint): boolean;
+      begin
+        {$I-}
+         seek(f,Pos);
+        {$I+}
+        fileseek:=(ioresult=0);
+      end;
+
+
+    function tdosinputfile.fileread(var databuf; maxsize: longint): longint;
+      var w: {$ifdef TP}word{$else}longint{$endif};
+      begin
+        blockread(f,databuf,maxsize,w);
+        fileread:=w;
+      end;
+
+
+    function tdosinputfile.fileeof: boolean;
+      begin
+        fileeof:=eof(f);
+      end;
+
+
+    function tdosinputfile.fileclose: boolean;
+      begin
+        {$I-}
+         system.close(f);
+        {$I+}
+        fileclose:=(ioresult=0);
+      end;
+
+
+{****************************************************************************
+                                Tinputfilemanager
+ ****************************************************************************}
+
+    constructor tinputfilemanager.init;
+      begin
+         files:=nil;
+         last_ref_index:=0;
+         cacheindex:=0;
+         cacheinputfile:=nil;
+      end;
+
+
+    destructor tinputfilemanager.done;
+      var
+         hp : pinputfile;
+      begin
+         hp:=files;
+         while assigned(hp) do
+          begin
+            files:=files^.ref_next;
+            dispose(hp,done);
+            hp:=files;
+          end;
+         last_ref_index:=0;
+      end;
+
+
+    procedure tinputfilemanager.register_file(f : pinputfile);
+      begin
+         { don't register macro's }
+         if f^.is_macro then
+          exit;
+         inc(last_ref_index);
+         f^.ref_next:=files;
+         f^.ref_index:=last_ref_index;
+         files:=f;
+         { update cache }
+         cacheindex:=last_ref_index;
+         cacheinputfile:=f;
+{$ifdef FPC}
+  {$ifdef heaptrc}
+         writeln(stderr,f^.name^,' index ',current_module^.unit_index*100000+f^.ref_index);
+  {$endif heaptrc}
+{$endif FPC}
+      end;
+
+
+   { this procedure is necessary after loading the
+     sources files from a PPU file  PM }
+   procedure tinputfilemanager.inverse_register_indexes;
+     var
+        f : pinputfile;
+     begin
+        f:=files;
+        while assigned(f) do
+          begin
+             f^.ref_index:=last_ref_index-f^.ref_index+1;
+             f:=f^.ref_next;
+          end;
+        { reset cache }
+        cacheindex:=0;
+        cacheinputfile:=nil;
+     end;
+
+
+
+   function tinputfilemanager.get_file(l :longint) : pinputfile;
+     var
+        ff : pinputfile;
+     begin
+       { check cache }
+       if (l=cacheindex) and assigned(cacheinputfile) then
+        begin
+          get_file:=cacheinputfile;
+          exit;
+        end;
+       ff:=files;
+       while assigned(ff) and (ff^.ref_index<>l) do
+         ff:=ff^.ref_next;
+       get_file:=ff;
+     end;
+
+
+   function tinputfilemanager.get_file_name(l :longint):string;
+     var
+       hp : pinputfile;
+     begin
+       hp:=get_file(l);
+       if assigned(hp) then
+        get_file_name:=hp^.name^
+       else
+        get_file_name:='';
+     end;
+
+
+   function tinputfilemanager.get_file_path(l :longint):string;
+     var
+       hp : pinputfile;
+     begin
+       hp:=get_file(l);
+       if assigned(hp) then
+        get_file_path:=hp^.path^
+       else
+        get_file_path:='';
+     end;
+
+
+end.
+{
+  $Log$
+  Revision 1.1  2000-08-27 16:11:50  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+}

+ 918 - 0
compiler/fmodule.pas

@@ -0,0 +1,918 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Florian Klaempfl
+
+    This unit implements the first loading and searching of the modules
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit fmodule;
+
+{$ifdef TP}
+  {$V+}
+{$endif}
+
+{$ifdef TP}
+  {$define SHORTASMPREFIX}
+{$endif}
+{$ifdef go32v1}
+  {$define SHORTASMPREFIX}
+{$endif}
+{$ifdef go32v2}
+  {$define SHORTASMPREFIX}
+{$endif}
+{$ifdef OS2}
+  { Allthough OS/2 supports long filenames I play it safe and
+    use 8.3 filenames, because this allows the compiler to run
+    on a FAT partition. (DM) }
+  {$define SHORTASMPREFIX}
+{$endif}
+
+
+  interface
+
+    uses
+       cutils,cobjects,
+       globals,ppu,finput;
+
+    const
+{$ifdef tp}
+       maxunits = 128;
+{$else}
+       maxunits = 1024;
+{$endif}
+
+    type
+       trecompile_reason = (rr_unknown,
+         rr_noppu,rr_sourcenewer,rr_build,rr_libolder,rr_objolder,
+         rr_asmolder,rr_crcchanged
+       );
+
+       plinkcontaineritem=^tlinkcontaineritem;
+       tlinkcontaineritem=object(tcontaineritem)
+          data     : pstring;
+          needlink : longint;
+          constructor init(const s:string;m:longint);
+          destructor  done;virtual;
+       end;
+
+       plinkcontainer=^tlinkcontainer;
+       tlinkcontainer=object(tcontainer)
+          constructor Init;
+          procedure insert(const s : string;m:longint);
+          function get(var m:longint) : string;
+          function getusemask(mask:longint) : string;
+          function find(const s:string):boolean;
+       end;
+
+       pmodule = ^tmodule;
+
+{$ifndef NEWMAP}
+       tunitmap = array[0..maxunits-1] of pointer;
+       punitmap = ^tunitmap;
+{$else NEWMAP}
+       tunitmap = array[0..maxunits-1] of pmodule;
+       punitmap = ^tunitmap;
+{$endif NEWMAP}
+
+       tmodule = object(tlinkedlist_item)
+          ppufile       : pppufile; { the PPU file }
+          crc,
+          interface_crc,
+          flags         : longint;  { the PPU flags }
+
+          compiled,                 { unit is already compiled }
+          do_reload,                { force reloading of the unit }
+          do_assemble,              { only assemble the object, don't recompile }
+          do_compile,               { need to compile the sources }
+          sources_avail,            { if all sources are reachable }
+          sources_checked,          { if there is already done a check for the sources }
+          is_unit,
+          in_compile,               { is it being compiled ?? }
+          in_second_compile,        { is this unit being compiled for the 2nd time? }
+          in_second_load,           { is this unit PPU loaded a 2nd time? }
+          in_implementation,        { processing the implementation part? }
+          in_global     : boolean;  { allow global settings }
+          recompile_reason : trecompile_reason;  { the reason why the unit should be recompiled }
+
+          islibrary     : boolean;  { if it is a library (win32 dll) }
+          map           : punitmap; { mapping of all used units }
+          unitcount     : word;     { local unit counter }
+          unit_index    : word;     { global counter for browser }
+          globalsymtable,           { pointer to the local/static symtable of this unit }
+          localsymtable : pointer;  { pointer to the psymtable of this unit }
+          scanner       : pointer;  { scanner object used }
+          loaded_from   : pmodule;
+          uses_imports  : boolean;  { Set if the module imports from DLL's.}
+          imports       : plinkedlist;
+          _exports      : plinkedlist;
+
+          sourcefiles   : pinputfilemanager;
+          resourcefiles : tstringcontainer;
+
+          linkunitofiles,
+          linkunitstaticlibs,
+          linkunitsharedlibs,
+          linkotherofiles,           { objects,libs loaded from the source }
+          linkothersharedlibs,       { using $L or $LINKLIB or import lib (for linux) }
+          linkotherstaticlibs  : tlinkcontainer;
+
+          used_units           : tlinkedlist;
+          dependent_units      : tlinkedlist;
+
+          localunitsearchpath,           { local searchpaths }
+          localobjectsearchpath,
+          localincludesearchpath,
+          locallibrarysearchpath : TSearchPathList;
+
+          path,                     { path where the module is find/created }
+          outputpath,               { path where the .s / .o / exe are created }
+          modulename,               { name of the module in uppercase }
+          objfilename,              { fullname of the objectfile }
+          asmfilename,              { fullname of the assemblerfile }
+          ppufilename,              { fullname of the ppufile }
+          staticlibfilename,        { fullname of the static libraryfile }
+          sharedlibfilename,        { fullname of the shared libraryfile }
+          exefilename,              { fullname of the exefile }
+          asmprefix,                { prefix for the smartlink asmfiles }
+          mainsource    : pstring;  { name of the main sourcefile }
+{$ifdef Test_Double_checksum}
+          crc_array : pointer;
+          crc_size : longint;
+          crc_array2 : pointer;
+          crc_size2 : longint;
+{$endif def Test_Double_checksum}
+          constructor init(const s:string;_is_unit:boolean);
+          destructor done;virtual;
+          procedure reset;
+          procedure setfilename(const fn:string;allowoutput:boolean);
+          function  openppu:boolean;
+          function  search_unit(const n : string;onlysource:boolean):boolean;
+       end;
+
+       pused_unit = ^tused_unit;
+       tused_unit = object(tlinkedlist_item)
+          unitid          : word;
+          name            : pstring;
+          checksum,
+          interface_checksum : longint;
+          loaded          : boolean;
+          in_uses,
+          in_interface,
+          is_stab_written : boolean;
+          u               : pmodule;
+          constructor init(_u : pmodule;intface:boolean);
+          constructor init_to_load(const n:string;c,intfc:longint;intface:boolean);
+          destructor done;virtual;
+       end;
+
+       pdependent_unit = ^tdependent_unit;
+       tdependent_unit = object(tlinkedlist_item)
+          u : pmodule;
+          constructor init(_u : pmodule);
+       end;
+
+    var
+       main_module       : pmodule;     { Main module of the program }
+       current_module    : pmodule;     { Current module which is compiled or loaded }
+       compiled_module   : pmodule;     { Current module which is compiled }
+       current_ppu       : pppufile;    { Current ppufile which is read }
+       global_unit_count : word;
+       usedunits         : tlinkedlist; { Used units for this program }
+       loaded_units      : tlinkedlist; { All loaded units }
+       SmartLinkOFiles   : TStringContainer; { List of .o files which are generated,
+                                               used to delete them after linking }
+
+function get_source_file(moduleindex,fileindex : word) : pinputfile;
+
+
+implementation
+
+uses
+{$ifdef delphi}
+  dmisc,
+{$else}
+  dos,
+{$endif}
+  globtype,verbose,systems,
+  symtable,scanner;
+
+
+{*****************************************************************************
+                             Global Functions
+*****************************************************************************}
+
+    function get_source_file(moduleindex,fileindex : word) : pinputfile;
+      var
+         hp : pmodule;
+         f : pinputfile;
+      begin
+         hp:=pmodule(loaded_units.first);
+         while assigned(hp) and (hp^.unit_index<>moduleindex) do
+           hp:=pmodule(hp^.next);
+         get_source_file:=nil;
+         if not assigned(hp) then
+           exit;
+         f:=pinputfile(hp^.sourcefiles^.files);
+         while assigned(f) do
+           begin
+              if f^.ref_index=fileindex then
+                begin
+                   get_source_file:=f;
+                   exit;
+                end;
+              f:=pinputfile(f^.ref_next);
+           end;
+      end;
+
+
+{****************************************************************************
+                             TLinkContainerItem
+ ****************************************************************************}
+
+constructor TLinkContainerItem.Init(const s:string;m:longint);
+begin
+  inherited Init;
+  data:=stringdup(s);
+  needlink:=m;
+end;
+
+
+destructor TLinkContainerItem.Done;
+begin
+  stringdispose(data);
+end;
+
+
+{****************************************************************************
+                           TLinkContainer
+ ****************************************************************************}
+
+    constructor TLinkContainer.Init;
+      begin
+        inherited init;
+      end;
+
+
+    procedure TLinkContainer.insert(const s : string;m:longint);
+      var
+        newnode : plinkcontaineritem;
+      begin
+         {if find(s) then
+          exit; }
+         new(newnode,init(s,m));
+         inherited insert(newnode);
+      end;
+
+
+    function TLinkContainer.get(var m:longint) : string;
+      var
+        p : plinkcontaineritem;
+      begin
+        p:=plinkcontaineritem(inherited get);
+        if p=nil then
+         begin
+           get:='';
+           m:=0;
+           exit;
+         end;
+        get:=p^.data^;
+        m:=p^.needlink;
+        dispose(p,done);
+      end;
+
+
+    function TLinkContainer.getusemask(mask:longint) : string;
+      var
+         p : plinkcontaineritem;
+         found : boolean;
+      begin
+        found:=false;
+        repeat
+          p:=plinkcontaineritem(inherited get);
+          if p=nil then
+           begin
+             getusemask:='';
+             exit;
+           end;
+          getusemask:=p^.data^;
+          found:=(p^.needlink and mask)<>0;
+          dispose(p,done);
+        until found;
+      end;
+
+
+    function TLinkContainer.find(const s:string):boolean;
+      var
+        newnode : plinkcontaineritem;
+      begin
+        find:=false;
+        newnode:=plinkcontaineritem(root);
+        while assigned(newnode) do
+         begin
+           if newnode^.data^=s then
+            begin
+              find:=true;
+              exit;
+            end;
+           newnode:=plinkcontaineritem(newnode^.next);
+         end;
+      end;
+
+
+{****************************************************************************
+                                  TMODULE
+ ****************************************************************************}
+
+    procedure tmodule.setfilename(const fn:string;allowoutput:boolean);
+      var
+        p : dirstr;
+        n : NameStr;
+        e : ExtStr;
+      begin
+         stringdispose(objfilename);
+         stringdispose(asmfilename);
+         stringdispose(ppufilename);
+         stringdispose(staticlibfilename);
+         stringdispose(sharedlibfilename);
+         stringdispose(exefilename);
+         stringdispose(outputpath);
+         stringdispose(path);
+         { Create names }
+         fsplit(fn,p,n,e);
+         n:=FixFileName(n);
+         { set path }
+         path:=stringdup(FixPath(p,false));
+         { obj,asm,ppu names }
+         p:=path^;
+         if AllowOutput then
+          begin
+            if (OutputUnitDir<>'') then
+             p:=OutputUnitDir
+            else
+             if (OutputExeDir<>'') then
+              p:=OutputExeDir;
+          end;
+         outputpath:=stringdup(p);
+         objfilename:=stringdup(p+n+target_info.objext);
+         asmfilename:=stringdup(p+n+target_info.asmext);
+         ppufilename:=stringdup(p+n+target_info.unitext);
+         { lib and exe could be loaded with a file specified with -o }
+         if AllowOutput and (OutputFile<>'') and (compile_level=1) then
+          n:=OutputFile;
+         staticlibfilename:=stringdup(p+target_os.libprefix+n+target_os.staticlibext);
+         if target_info.target=target_i386_WIN32 then
+           sharedlibfilename:=stringdup(p+n+target_os.sharedlibext)
+         else
+           sharedlibfilename:=stringdup(p+target_os.libprefix+n+target_os.sharedlibext);
+         { output dir of exe can be specified separatly }
+         if AllowOutput and (OutputExeDir<>'') then
+          p:=OutputExeDir
+         else
+          p:=path^;
+         exefilename:=stringdup(p+n+target_info.exeext);
+      end;
+
+
+    function tmodule.openppu:boolean;
+      var
+        objfiletime,
+        ppufiletime,
+        asmfiletime : longint;
+      begin
+        openppu:=false;
+        Message1(unit_t_ppu_loading,ppufilename^);
+      { Get ppufile time (also check if the file exists) }
+        ppufiletime:=getnamedfiletime(ppufilename^);
+        if ppufiletime=-1 then
+         exit;
+      { Open the ppufile }
+        Message1(unit_u_ppu_name,ppufilename^);
+        ppufile:=new(pppufile,init(ppufilename^));
+        ppufile^.change_endian:=source_os.endian<>target_os.endian;
+        if not ppufile^.open then
+         begin
+           dispose(ppufile,done);
+           Message(unit_u_ppu_file_too_short);
+           exit;
+         end;
+      { check for a valid PPU file }
+        if not ppufile^.CheckPPUId then
+         begin
+           dispose(ppufile,done);
+           Message(unit_u_ppu_invalid_header);
+           exit;
+         end;
+      { check for allowed PPU versions }
+        if not (ppufile^.GetPPUVersion = CurrentPPUVersion) then
+         begin
+           dispose(ppufile,done);
+           Message1(unit_u_ppu_invalid_version,tostr(ppufile^.GetPPUVersion));
+           exit;
+         end;
+      { check the target processor }
+        if ttargetcpu(ppufile^.header.cpu)<>target_cpu then
+         begin
+           dispose(ppufile,done);
+           Message(unit_u_ppu_invalid_processor);
+           exit;
+         end;
+      { check target }
+        if ttarget(ppufile^.header.target)<>target_info.target then
+         begin
+           dispose(ppufile,done);
+           Message(unit_u_ppu_invalid_target);
+           exit;
+         end;
+      { Load values to be access easier }
+        flags:=ppufile^.header.flags;
+        crc:=ppufile^.header.checksum;
+        interface_crc:=ppufile^.header.interface_checksum;
+      { Show Debug info }
+        Message1(unit_u_ppu_time,filetimestring(ppufiletime));
+        Message1(unit_u_ppu_flags,tostr(flags));
+        Message1(unit_u_ppu_crc,tostr(ppufile^.header.checksum));
+        Message1(unit_u_ppu_crc,tostr(ppufile^.header.interface_checksum)+' (intfc)');
+      { check the object and assembler file to see if we need only to
+        assemble, only if it's not in a library }
+        do_compile:=false;
+        if (flags and uf_in_library)=0 then
+         begin
+           if (flags and uf_smart_linked)<>0 then
+            begin
+              objfiletime:=getnamedfiletime(staticlibfilename^);
+              Message2(unit_u_check_time,staticlibfilename^,filetimestring(objfiletime));
+              if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
+                begin
+                  recompile_reason:=rr_libolder;
+                  Message(unit_u_recompile_staticlib_is_older);
+                  do_compile:=true;
+                  exit;
+                end;
+            end;
+           if (flags and uf_static_linked)<>0 then
+            begin
+              { the objectfile should be newer than the ppu file }
+              objfiletime:=getnamedfiletime(objfilename^);
+              Message2(unit_u_check_time,objfilename^,filetimestring(objfiletime));
+              if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
+               begin
+                 { check if assembler file is older than ppu file }
+                 asmfileTime:=GetNamedFileTime(asmfilename^);
+                 Message2(unit_u_check_time,asmfilename^,filetimestring(asmfiletime));
+                 if (asmfiletime<0) or (ppufiletime>asmfiletime) then
+                  begin
+                    Message(unit_u_recompile_obj_and_asm_older);
+                    recompile_reason:=rr_objolder;
+                    do_compile:=true;
+                    exit;
+                  end
+                 else
+                  begin
+                    Message(unit_u_recompile_obj_older_than_asm);
+                    if not(cs_asm_extern in aktglobalswitches) then
+                     begin
+                       do_compile:=true;
+                       recompile_reason:=rr_asmolder;
+                       exit;
+                     end;
+                  end;
+               end;
+            end;
+         end;
+        openppu:=true;
+      end;
+
+
+    function tmodule.search_unit(const n : string;onlysource:boolean):boolean;
+      var
+         singlepathstring,
+         filename : string;
+
+         Function UnitExists(const ext:string):boolean;
+         begin
+           Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
+           UnitExists:=FileExists(Singlepathstring+FileName+ext);
+         end;
+
+         Function PPUSearchPath(const s:string):boolean;
+         var
+           found   : boolean;
+         begin
+           Found:=false;
+           singlepathstring:=FixPath(s,false);
+         { Check for PPU file }
+           Found:=UnitExists(target_info.unitext);
+           if Found then
+            Begin
+              SetFileName(SinglePathString+FileName,false);
+              Found:=OpenPPU;
+            End;
+           PPUSearchPath:=Found;
+         end;
+
+         Function SourceSearchPath(const s:string):boolean;
+         var
+           found   : boolean;
+           ext     : string[8];
+         begin
+           Found:=false;
+           singlepathstring:=FixPath(s,false);
+         { Check for Sources }
+           ppufile:=nil;
+           do_compile:=true;
+           recompile_reason:=rr_noppu;
+         {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;
+           SourceSearchPath:=Found;
+         end;
+
+         Function SearchPath(const s:string):boolean;
+         var
+           found : boolean;
+         begin
+           { First check for a ppu, then for the source }
+           found:=false;
+           if not onlysource then
+            found:=PPUSearchPath(s);
+           if not found then
+            found:=SourceSearchPath(s);
+           SearchPath:=found;
+         end;
+
+         Function SearchPathList(list:TSearchPathList):boolean;
+         var
+           hp : PStringQueueItem;
+           found : boolean;
+         begin
+           found:=false;
+           hp:=list.First;
+           while assigned(hp) do
+            begin
+              found:=SearchPath(hp^.data^);
+              if found then
+               break;
+              hp:=hp^.next;
+            end;
+           SearchPathList:=found;
+         end;
+
+       var
+         fnd : boolean;
+       begin
+         filename:=FixFileName(n);
+         { try to find unit
+            1. look for ppu in cwd
+            2. look for ppu in outputpath if set, this is tp7 compatible (PFV)
+            3. look for source in cwd
+            4. local unit pathlist
+            5. global unit pathlist }
+         fnd:=false;
+         if not onlysource then
+          begin
+            fnd:=PPUSearchPath('.');
+            if (not fnd) and (current_module^.outputpath^<>'') then
+             fnd:=PPUSearchPath(current_module^.outputpath^);
+           end;
+         if (not fnd) then
+          fnd:=SourceSearchPath('.');
+         if (not fnd) then
+          fnd:=SearchPathList(current_module^.LocalUnitSearchPath);
+         if (not fnd) then
+          fnd:=SearchPathList(UnitSearchPath);
+
+         { try to find a file with the first 8 chars of the modulename, like
+           dos }
+         if (not fnd) and (length(filename)>8) then
+          begin
+            filename:=copy(filename,1,8);
+            fnd:=SearchPath('.');
+            if (not fnd) then
+             fnd:=SearchPathList(current_module^.LocalUnitSearchPath);
+            if not fnd then
+             fnd:=SearchPathList(UnitSearchPath);
+          end;
+         search_unit:=fnd;
+      end;
+
+
+
+    procedure tmodule.reset;
+      var
+         pm : pdependent_unit;
+      begin
+        if assigned(scanner) then
+          pscannerfile(scanner)^.invalid:=true;
+        if assigned(globalsymtable) then
+          begin
+            dispose(punitsymtable(globalsymtable),done);
+            globalsymtable:=nil;
+          end;
+        if assigned(localsymtable) then
+          begin
+            dispose(punitsymtable(localsymtable),done);
+            localsymtable:=nil;
+          end;
+        if assigned(map) then
+         begin
+           dispose(map);
+           map:=nil;
+         end;
+        if assigned(ppufile) then
+         begin
+           dispose(ppufile,done);
+           ppufile:=nil;
+         end;
+        sourcefiles^.done;
+        sourcefiles^.init;
+        imports^.done;
+        imports^.init;
+        _exports^.done;
+        _exports^.init;
+        used_units.done;
+        used_units.init;
+        { all units that depend on this one must be recompiled ! }
+        pm:=pdependent_unit(dependent_units.first);
+        while assigned(pm) do
+          begin
+            if pm^.u^.in_second_compile then
+             Comment(v_debug,'No reload already in second compile: '+pm^.u^.modulename^)
+            else
+             begin
+               pm^.u^.do_reload:=true;
+               Comment(v_debug,'Reloading '+pm^.u^.modulename^+' needed because '+modulename^+' is reloaded');
+             end;
+            pm:=pdependent_unit(pm^.next);
+          end;
+        dependent_units.done;
+        dependent_units.init;
+        resourcefiles.done;
+        resourcefiles.init;
+        linkunitofiles.done;
+        linkunitofiles.init;
+        linkunitstaticlibs.done;
+        linkunitstaticlibs.init;
+        linkunitsharedlibs.done;
+        linkunitsharedlibs.init;
+        linkotherofiles.done;
+        linkotherofiles.init;
+        linkotherstaticlibs.done;
+        linkotherstaticlibs.init;
+        linkothersharedlibs.done;
+        linkothersharedlibs.init;
+        uses_imports:=false;
+        do_assemble:=false;
+        do_compile:=false;
+        { sources_avail:=true;
+        should not be changed PM }
+        compiled:=false;
+        in_implementation:=false;
+        in_global:=true;
+        {loaded_from:=nil;
+        should not be changed PFV }
+        flags:=0;
+        crc:=0;
+        interface_crc:=0;
+        unitcount:=1;
+        recompile_reason:=rr_unknown;
+      end;
+
+
+    constructor tmodule.init(const s:string;_is_unit:boolean);
+      var
+        p : dirstr;
+        n : namestr;
+        e : extstr;
+      begin
+        FSplit(s,p,n,e);
+      { Programs have the name program to don't conflict with dup id's }
+        if _is_unit then
+{$ifdef UNITALIASES}
+          modulename:=stringdup(GetUnitAlias(Upper(n)))
+{$else}
+          modulename:=stringdup(Upper(n))
+{$endif}
+        else
+          modulename:=stringdup('PROGRAM');
+        mainsource:=stringdup(s);
+        ppufilename:=nil;
+        objfilename:=nil;
+        asmfilename:=nil;
+        staticlibfilename:=nil;
+        sharedlibfilename:=nil;
+        exefilename:=nil;
+        { Dos has the famous 8.3 limit :( }
+{$ifdef SHORTASMPREFIX}
+        asmprefix:=stringdup(FixFileName('as'));
+{$else}
+        asmprefix:=stringdup(FixFileName(n));
+{$endif}
+        outputpath:=nil;
+        path:=nil;
+        setfilename(p+n,true);
+        localunitsearchpath.init;
+        localobjectsearchpath.init;
+        localincludesearchpath.init;
+        locallibrarysearchpath.init;
+        used_units.init;
+        dependent_units.init;
+        new(sourcefiles,init);
+        resourcefiles.init;
+        linkunitofiles.init;
+        linkunitstaticlibs.init;
+        linkunitsharedlibs.init;
+        linkotherofiles.init;
+        linkotherstaticlibs.init;
+        linkothersharedlibs.init;
+        ppufile:=nil;
+        scanner:=nil;
+        map:=nil;
+        globalsymtable:=nil;
+        localsymtable:=nil;
+        loaded_from:=nil;
+        flags:=0;
+        crc:=0;
+        interface_crc:=0;
+        do_reload:=false;
+        unitcount:=1;
+        inc(global_unit_count);
+        unit_index:=global_unit_count;
+        do_assemble:=false;
+        do_compile:=false;
+        sources_avail:=true;
+        sources_checked:=false;
+        compiled:=false;
+        recompile_reason:=rr_unknown;
+        in_second_load:=false;
+        in_compile:=false;
+        in_second_compile:=false;
+        in_implementation:=false;
+        in_global:=true;
+        is_unit:=_is_unit;
+        islibrary:=false;
+        uses_imports:=false;
+        imports:=new(plinkedlist,init);
+        _exports:=new(plinkedlist,init);
+      { search the PPU file if it is an unit }
+        if is_unit then
+         begin
+           search_unit(modulename^,false);
+           { it the sources_available is changed then we know that
+             the sources aren't available }
+           if not sources_avail then
+            sources_checked:=true;
+         end;
+      end;
+
+
+    destructor tmodule.done;
+{$ifdef MEMDEBUG}
+      var
+        d : tmemdebug;
+{$endif}
+      begin
+        if assigned(map) then
+         dispose(map);
+        if assigned(ppufile) then
+         dispose(ppufile,done);
+        ppufile:=nil;
+        if assigned(imports) then
+         dispose(imports,done);
+        imports:=nil;
+        if assigned(_exports) then
+         dispose(_exports,done);
+        _exports:=nil;
+        if assigned(scanner) then
+          pscannerfile(scanner)^.invalid:=true;
+        if assigned(sourcefiles) then
+         dispose(sourcefiles,done);
+        sourcefiles:=nil;
+        used_units.done;
+        dependent_units.done;
+        resourcefiles.done;
+        linkunitofiles.done;
+        linkunitstaticlibs.done;
+        linkunitsharedlibs.done;
+        linkotherofiles.done;
+        linkotherstaticlibs.done;
+        linkothersharedlibs.done;
+        stringdispose(objfilename);
+        stringdispose(asmfilename);
+        stringdispose(ppufilename);
+        stringdispose(staticlibfilename);
+        stringdispose(sharedlibfilename);
+        stringdispose(exefilename);
+        stringdispose(outputpath);
+        stringdispose(path);
+        stringdispose(modulename);
+        stringdispose(mainsource);
+        stringdispose(asmprefix);
+        localunitsearchpath.done;
+        localobjectsearchpath.done;
+        localincludesearchpath.done;
+        locallibrarysearchpath.done;
+{$ifdef MEMDEBUG}
+        d.init('symtable');
+{$endif}
+        if assigned(globalsymtable) then
+          dispose(punitsymtable(globalsymtable),done);
+        globalsymtable:=nil;
+        if assigned(localsymtable) then
+          dispose(punitsymtable(localsymtable),done);
+        localsymtable:=nil;
+{$ifdef MEMDEBUG}
+        d.done;
+{$endif}
+        inherited done;
+      end;
+
+
+{****************************************************************************
+                              TUSED_UNIT
+ ****************************************************************************}
+
+    constructor tused_unit.init(_u : pmodule;intface:boolean);
+      begin
+        u:=_u;
+        in_interface:=intface;
+        in_uses:=false;
+        is_stab_written:=false;
+        loaded:=true;
+        name:=stringdup(_u^.modulename^);
+        checksum:=_u^.crc;
+        interface_checksum:=_u^.interface_crc;
+        unitid:=0;
+      end;
+
+
+    constructor tused_unit.init_to_load(const n:string;c,intfc:longint;intface:boolean);
+      begin
+        u:=nil;
+        in_interface:=intface;
+        in_uses:=false;
+        is_stab_written:=false;
+        loaded:=false;
+        name:=stringdup(n);
+        checksum:=c;
+        interface_checksum:=intfc;
+        unitid:=0;
+      end;
+
+
+    destructor tused_unit.done;
+      begin
+        stringdispose(name);
+        inherited done;
+      end;
+
+
+{****************************************************************************
+                            TDENPENDENT_UNIT
+ ****************************************************************************}
+
+    constructor tdependent_unit.init(_u : pmodule);
+      begin
+         u:=_u;
+      end;
+
+end.
+{
+  $Log$
+  Revision 1.1  2000-08-27 16:11:50  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+}

+ 6 - 2
compiler/gendef.pas

@@ -47,7 +47,7 @@ var
 implementation
 
 uses
-  systems,globtype,globals;
+  systems,cutils,globtype,globals;
 
 {******************************************************************************
                                TDefFile
@@ -164,7 +164,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:41  michael
+  Revision 1.3  2000-08-27 16:11:50  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.2  2000/07/13 11:32:41  michael
   + removed logs
 
 }

+ 8 - 372
compiler/globals.pas

@@ -45,7 +45,7 @@ unit globals;
 {$ifdef TP}
       objects,
 {$endif}
-      globtype,version,tokens,systems,cobjects;
+      globtype,version,tokens,systems,cutils,cobjects;
 
     const
 {$ifdef linux}
@@ -219,36 +219,13 @@ unit globals;
     const
        parser_current_file : string = '';
 
+    procedure abstract;
 {$ifdef debug}
     { if the pointer don't point to the heap then write an error }
     function assigned(p : pointer) : boolean;
 {$endif}
-    function min(a,b : longint) : longint;
-    function max(a,b : longint) : longint;
-    function align(i,a:longint):longint;
-    function align_from_size(datasize:longint;length:longint):longint;
-    procedure Replace(var s:string;s1:string;const s2:string);
-    procedure ReplaceCase(var s:string;const s1,s2:string);
-    function upper(const s : string) : string;
-    function lower(const s : string) : string;
-    function trimspace(const s:string):string;
-    {$ifdef FPC}
-    function tostru(i:cardinal) : string;
-    {$else}
-    function tostru(i:longint) : string;
-    {$endif}
-    procedure uppervar(var s : string);
-    function hexstr(val : longint;cnt : byte) : string;
-    function tostr(i : longint) : string;
-    function tostr_with_plus(i : longint) : string;
-    procedure valint(S : string;var V : longint;var code : integer);
-    function is_number(const s : string) : boolean;
-    function ispowerof2(value : longint;var power : longint) : boolean;
-    { enable ansistring comparison }
-    function compareansistrings(p1,p2 : pchar;length1,length2 : longint) : longint;
-    function concatansistrings(p1,p2 : pchar;length1,length2 : longint) : pchar;
+
     function bstoslash(const s : string) : string;
-    procedure abstract;
 
     function getdatestr:string;
     function gettimestr:string;
@@ -389,351 +366,6 @@ implementation
 {$endif}
 
 
-    function min(a,b : longint) : longint;
-    {
-      return the minimal of a and b
-    }
-      begin
-         if a>b then
-           min:=b
-         else
-           min:=a;
-      end;
-
-
-    function max(a,b : longint) : longint;
-    {
-      return the maximum of a and b
-    }
-      begin
-         if a<b then
-           max:=b
-         else
-           max:=a;
-      end;
-
-    function align_from_size(datasize:longint;length:longint):longint;
-
-    {Increases the datasize with the required alignment; i.e. on pentium
-     words should be aligned word; and dwords should be aligned dword.
-     So for a word (len=2), datasize is increased to the nearest multiple
-     of 2, and for len=4, datasize is increased to the nearest multiple of
-     4.}
-
-    var data_align:word;
-
-    begin
-        {$IFDEF I386}
-        if length>2 then
-            data_align:=4
-        else if length>1 then
-            data_align:=2
-        else
-            data_align:=1;
-        {$ENDIF}
-        {$IFDEF M68K}
-        data_align:=2;
-        {$ENDIF}
-        align_from_size:=(datasize+data_align-1) and not(data_align-1);
-    end;
-
-
-    function align(i,a:longint):longint;
-    {
-      return value <i> aligned <a> boundary
-    }
-      begin
-        { for 0 and 1 no aligning is needed }
-        if a<=1 then
-         align:=i
-        else
-         align:=(i+a-1) and not(a-1);
-      end;
-
-
-    procedure Replace(var s:string;s1:string;const s2:string);
-      var
-         last,
-         i  : longint;
-      begin
-        s1:=upper(s1);
-        last:=0;
-        repeat
-          i:=pos(s1,upper(s));
-          if i=last then
-           i:=0;
-          if (i>0) then
-           begin
-             Delete(s,i,length(s1));
-             Insert(s2,s,i);
-             last:=i;
-           end;
-        until (i=0);
-      end;
-
-
-    procedure ReplaceCase(var s:string;const s1,s2:string);
-      var
-         last,
-         i  : longint;
-      begin
-        last:=0;
-        repeat
-          i:=pos(s1,s);
-          if i=last then
-           i:=0;
-          if (i>0) then
-           begin
-             Delete(s,i,length(s1));
-             Insert(s2,s,i);
-             last:=i;
-           end;
-        until (i=0);
-      end;
-
-
-    function upper(const s : string) : string;
-    {
-      return uppercased string of s
-    }
-      var
-         i  : longint;
-      begin
-         for i:=1 to length(s) do
-          if s[i] in ['a'..'z'] then
-           upper[i]:=char(byte(s[i])-32)
-          else
-           upper[i]:=s[i];
-        upper[0]:=s[0];
-      end;
-
-
-    function lower(const s : string) : string;
-    {
-      return lowercased string of s
-    }
-      var
-         i : longint;
-      begin
-         for i:=1 to length(s) do
-          if s[i] in ['A'..'Z'] then
-           lower[i]:=char(byte(s[i])+32)
-          else
-           lower[i]:=s[i];
-        lower[0]:=s[0];
-      end;
-
-
-    procedure uppervar(var s : string);
-    {
-      uppercase string s
-    }
-      var
-         i : longint;
-      begin
-         for i:=1 to length(s) do
-          if s[i] in ['a'..'z'] then
-           s[i]:=char(byte(s[i])-32);
-      end;
-
-    function hexstr(val : longint;cnt : byte) : string;
-      const
-        HexTbl : array[0..15] of char='0123456789ABCDEF';
-      var
-        i : longint;
-      begin
-        hexstr[0]:=char(cnt);
-        for i:=cnt downto 1 do
-         begin
-           hexstr[i]:=hextbl[val and $f];
-           val:=val shr 4;
-         end;
-      end;
-
-{$ifdef FPC}
-   function tostru(i:cardinal):string;
-   {
-     return string of value i, but for cardinals
-   }
-      var
-        hs : string;
-      begin
-        str(i,hs);
-        tostru:=hs;
-      end;
-{$else FPC}
-    function tostru(i:longint):string;
-      begin
-        tostru:=tostr(i);
-      end;
-{$endif FPC}
-
-
-   function trimspace(const s:string):string;
-   {
-     return s with all leading and ending spaces and tabs removed
-   }
-     var
-       i,j : longint;
-     begin
-       i:=length(s);
-       while (i>0) and (s[i] in [#9,' ']) do
-        dec(i);
-       j:=1;
-       while (j<i) and (s[j] in [#9,' ']) do
-        inc(j);
-       trimspace:=Copy(s,j,i-j+1);
-     end;
-
-
-   function tostr(i : longint) : string;
-   {
-     return string of value i
-   }
-     var
-        hs : string;
-     begin
-        str(i,hs);
-        tostr:=hs;
-     end;
-
-
-   function tostr_with_plus(i : longint) : string;
-   {
-     return string of value i, but always include a + when i>=0
-   }
-     var
-        hs : string;
-     begin
-        str(i,hs);
-        if i>=0 then
-          tostr_with_plus:='+'+hs
-        else
-          tostr_with_plus:=hs;
-     end;
-
-
-    procedure valint(S : string;var V : longint;var code : integer);
-    {
-      val() with support for octal, which is not supported under tp7
-    }
-{$ifndef FPC}
-      var
-        vs : longint;
-        c  : byte;
-      begin
-        if s[1]='%' then
-          begin
-             vs:=0;
-             longint(v):=0;
-             for c:=2 to length(s) do
-               begin
-                  if s[c]='0' then
-                    vs:=vs shl 1
-                  else
-                  if s[c]='1' then
-                    vs:=vs shl 1+1
-                  else
-                    begin
-                      code:=c;
-                      exit;
-                    end;
-               end;
-             code:=0;
-             longint(v):=vs;
-          end
-        else
-         system.val(S,V,code);
-      end;
-{$else not FPC}
-      begin
-         system.val(S,V,code);
-      end;
-{$endif not FPC}
-
-
-    function is_number(const s : string) : boolean;
-    {
-      is string a correct number ?
-    }
-      var
-         w : integer;
-         l : longint;
-      begin
-         valint(s,l,w);
-         is_number:=(w=0);
-      end;
-
-
-    function ispowerof2(value : longint;var power : longint) : boolean;
-    {
-      return if value is a power of 2. And if correct return the power
-    }
-      var
-         hl : longint;
-         i : longint;
-      begin
-         hl:=1;
-         ispowerof2:=true;
-         for i:=0 to 31 do
-           begin
-              if hl=value then
-                begin
-                   power:=i;
-                   exit;
-                end;
-              hl:=hl shl 1;
-           end;
-         ispowerof2:=false;
-      end;
-
-
-    { enable ansistring comparison }
-    { 0 means equal }
-    { 1 means p1 > p2 }
-    { -1 means p1 < p2 }
-    function compareansistrings(p1,p2 : pchar;length1,length2 : longint) : longint;
-
-      var
-         i,j : longint;
-      begin
-         compareansistrings:=0;
-         j:=min(length1,length2);
-         i:=0;
-         while (i<j) do
-          begin
-            if p1[i]>p2[i] then
-             begin
-               compareansistrings:=1;
-               exit;
-             end
-            else
-             if p1[i]<p2[i] then
-              begin
-                compareansistrings:=-1;
-                exit;
-              end;
-            inc(i);
-          end;
-         if length1>length2 then
-          compareansistrings:=1
-         else
-          if length1<length2 then
-           compareansistrings:=-1;
-      end;
-
-
-    function concatansistrings(p1,p2 : pchar;length1,length2 : longint) : pchar;
-      var
-         p : pchar;
-      begin
-         getmem(p,length1+length2+1);
-         move(p1[0],p[0],length1);
-         move(p2[0],p[length1],length2+1);
-         concatansistrings:=p;
-      end;
-
-
 {****************************************************************************
                                Time Handling
 ****************************************************************************}
@@ -1566,7 +1198,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.6  2000-08-12 19:14:58  peter
+  Revision 1.7  2000-08-27 16:11:51  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.6  2000/08/12 19:14:58  peter
     * ELF writer works now also with -g
     * ELF writer is default again for linux
 

+ 7 - 3
compiler/hcgdata.pas

@@ -50,10 +50,10 @@ interface
 implementation
 
     uses
-       strings,cobjects,
+       strings,cutils,cobjects,
        globtype,globals,verbose,
        symconst,types,
-       hcodegen, systems, files
+       hcodegen, systems,fmodule
 {$ifdef INTERFACE_SUPPORT}
 {$ifdef i386}
        ,cg386ic
@@ -743,7 +743,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.3  2000-07-13 12:08:26  michael
+  Revision 1.4  2000-08-27 16:11:51  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.3  2000/07/13 12:08:26  michael
   + patched to 1.1.0 with former 1.09patch from peter
 
   Revision 1.2  2000/07/13 11:32:41  michael

+ 6 - 2
compiler/hcodegen.pas

@@ -172,7 +172,7 @@ implementation
 implementation
 
      uses
-        systems,globals,files,strings,cresstr
+        systems,globals,strings,cresstr
 {$ifdef fixLeaksOnError}
         ,comphook
 {$endif fixLeaksOnError}
@@ -462,7 +462,11 @@ end.
 
 {
   $Log$
-  Revision 1.4  2000-08-12 15:34:22  peter
+  Revision 1.5  2000-08-27 16:11:51  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.4  2000/08/12 15:34:22  peter
     + usedasmsymbollist to check and reset only the used symbols (merged)
 
   Revision 1.3  2000/08/03 13:17:26  jonas

+ 6 - 2
compiler/htypechk.pas

@@ -109,7 +109,7 @@ implementation
 
     uses
        globtype,systems,
-       cobjects,verbose,globals,
+       cutils,cobjects,verbose,globals,
        symconst,
        types,pass_1,cpubase,
 {$ifdef newcg}
@@ -1132,7 +1132,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.4  2000-08-16 18:33:53  peter
+  Revision 1.5  2000-08-27 16:11:51  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.4  2000/08/16 18:33:53  peter
     * splitted namedobjectitem.next into indexnext and listnext so it
       can be used in both lists
     * don't allow "word = word" type definitions (merged)

+ 6 - 2
compiler/import.pas

@@ -23,7 +23,7 @@ unit import;
 interface
 
 uses
-  cobjects{$IFDEF NEWST},objects{$ENDIF NEWST};
+  cutils,cobjects;
 
 type
    pimported_item = ^timported_item;
@@ -250,7 +250,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:43  michael
+  Revision 1.3  2000-08-27 16:11:51  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.2  2000/07/13 11:32:43  michael
   + removed logs
 
 }

+ 7 - 3
compiler/link.pas

@@ -30,7 +30,7 @@ Interface
   {$define ALWAYSSHELL}
 {$endif}
 
-uses cobjects,files;
+uses cobjects,fmodule;
 
 Type
     TLinkerInfo=record
@@ -81,7 +81,7 @@ uses
 {$else Delphi}
   dos,
 {$endif Delphi}
-  globtype,systems,
+  cutils,globtype,systems,
   script,globals,verbose,ppu
 {$ifdef i386}
   {$ifndef NOTARGETLINUX}
@@ -525,7 +525,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2000-07-26 13:08:19  jonas
+  Revision 1.4  2000-08-27 16:11:51  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.3  2000/07/26 13:08:19  jonas
     * merged from fixes branch (v_hint to v_tried changed when attempting
       to smart/static/shared link)
 

+ 6 - 2
compiler/og386.pas

@@ -91,7 +91,7 @@ unit og386;
 
     uses
       strings,comphook,
-      globtype,globals,verbose,files,
+      cutils,globtype,globals,verbose,fmodule,
       assemble;
 
 
@@ -279,7 +279,11 @@ unit og386;
 end.
 {
   $Log$
-  Revision 1.4  2000-08-06 10:42:29  peter
+  Revision 1.5  2000-08-27 16:11:51  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.4  2000/08/06 10:42:29  peter
     * merged patches name generation in lib and asm constant eval
 
   Revision 1.3  2000/07/13 12:08:26  michael

+ 6 - 2
compiler/og386cff.pas

@@ -170,7 +170,7 @@ unit og386cff;
 
       uses
         strings,verbose,
-        globtype,globals,files;
+        globtype,globals,fmodule;
 
     const
 {$ifdef TP}
@@ -1038,7 +1038,11 @@ unit og386cff;
 end.
 {
   $Log$
-  Revision 1.4  2000-08-19 18:44:27  peter
+  Revision 1.5  2000-08-27 16:11:51  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.4  2000/08/19 18:44:27  peter
     * new tdynamicarray implementation using blocks instead of
       reallocmem (merged)
 

+ 6 - 2
compiler/og386elf.pas

@@ -131,7 +131,7 @@ unit og386elf;
 
       uses
         strings,verbose,
-        globtype,globals,files;
+        globtype,cutils,globals,fmodule;
 
     const
 {$ifdef TP}
@@ -1049,7 +1049,11 @@ unit og386elf;
 end.
 {
   $Log$
-  Revision 1.5  2000-08-19 18:44:27  peter
+  Revision 1.6  2000-08-27 16:11:51  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.5  2000/08/19 18:44:27  peter
     * new tdynamicarray implementation using blocks instead of
       reallocmem (merged)
 

+ 6 - 2
compiler/options.pas

@@ -66,7 +66,7 @@ uses
   dos,
 {$endif Delphi}
   version,systems,
-  cobjects,
+  cutils,cobjects,
   symtable,scanner,link,messages
 {$ifdef BrowserLog}
   ,browlog
@@ -1481,7 +1481,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.5  2000-08-07 11:31:04  jonas
+  Revision 1.6  2000-08-27 16:11:51  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.5  2000/08/07 11:31:04  jonas
     * fixed bug in type conversions between enum subranges (it didn't take
       the packenum directive into account)
     + define PACKENUMFIXED symbol in options.pas

+ 6 - 2
compiler/opts386.pas

@@ -35,7 +35,7 @@ type
 implementation
 
 uses
-  globtype,systems,globals;
+  cutils,globtype,systems,globals;
 
 procedure toption386.interpret_proc_specific_options(const opt:string);
 var
@@ -112,7 +112,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2000-07-27 13:03:36  jonas
+  Revision 1.4  2000-08-27 16:11:51  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.3  2000/07/27 13:03:36  jonas
     * release alignopts
 
   Revision 1.2  2000/07/13 11:32:44  michael

+ 6 - 2
compiler/opts68k.pas

@@ -34,7 +34,7 @@ type
 implementation
 
 uses
-  globtype,systems,globals;
+  cutils,globtype,systems,globals;
 
 procedure toption68k.interpret_proc_specific_options(const opt:string);
 var
@@ -71,7 +71,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:44  michael
+  Revision 1.3  2000-08-27 16:11:51  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.2  2000/07/13 11:32:44  michael
   + removed logs
 
 }

+ 7 - 3
compiler/parser.pas

@@ -49,8 +49,8 @@ unit parser;
 
     uses
       globtype,version,tokens,systems,
-      cobjects,globals,verbose,
-      symtable,files,aasm,
+      cutils,cobjects,globals,verbose,
+      symtable,fmodule,aasm,
 {$ifndef newcg}
       hcodegen,
 {$endif newcg}
@@ -607,7 +607,11 @@ unit parser;
 end.
 {
   $Log$
-  Revision 1.3  2000-08-12 15:34:22  peter
+  Revision 1.4  2000-08-27 16:11:51  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.3  2000/08/12 15:34:22  peter
     + usedasmsymbollist to check and reset only the used symbols (merged)
 
   Revision 1.2  2000/07/13 11:32:44  michael

+ 6 - 2
compiler/pass_2.pas

@@ -45,7 +45,7 @@ implementation
 
    uses
      globtype,systems,
-     cobjects,comphook,verbose,globals,files,
+     cobjects,comphook,verbose,globals,fmodule,
      symconst,symtable,types,aasm,scanner,
      pass_1,hcodegen,temp_gen,cpubase,cpuasm,regvars
 {$ifndef newcg}
@@ -558,7 +558,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  2000-08-12 15:34:22  peter
+  Revision 1.7  2000-08-27 16:11:51  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.6  2000/08/12 15:34:22  peter
     + usedasmsymbollist to check and reset only the used symbols (merged)
 
   Revision 1.5  2000/08/03 13:17:25  jonas

+ 6 - 2
compiler/pbase.pas

@@ -94,7 +94,7 @@ unit pbase;
   implementation
 
     uses
-       files,scanner,systems,verbose;
+       scanner,systems,verbose;
 
     function tokenstring(i : ttoken):string;
       begin
@@ -197,7 +197,11 @@ end.
 
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:44  michael
+  Revision 1.3  2000-08-27 16:11:51  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.2  2000/07/13 11:32:44  michael
   + removed logs
 
 }

+ 7 - 3
compiler/pdecl.pas

@@ -43,8 +43,8 @@ unit pdecl;
 
     uses
        cobjects,scanner,
-       symconst,aasm,tree,pass_1,strings,
-       files,types,verbose,systems,import,
+       cutils,symconst,aasm,tree,pass_1,strings,
+       fmodule,types,verbose,systems,import,
        cpubase
 {$ifndef newcg}
        ,tccnv
@@ -1299,7 +1299,11 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.11  2000-08-20 15:01:17  peter
+  Revision 1.12  2000-08-27 16:11:51  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.11  2000/08/20 15:01:17  peter
     * don't allow forward class in separate type blocks for delphi (merged)
 
   Revision 1.10  2000/08/17 09:17:19  pierre

+ 6 - 2
compiler/pexports.pas

@@ -31,7 +31,7 @@ unit pexports;
 
     uses
       globtype,systems,tokens,
-      strings,cobjects,globals,verbose,
+      strings,cutils,cobjects,globals,verbose,
       scanner,symconst,symtable,pbase,
       export,GenDef,tree,pass_1,pexpr;
 
@@ -153,7 +153,11 @@ end.
 
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:44  michael
+  Revision 1.3  2000-08-27 16:11:51  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.2  2000/07/13 11:32:44  michael
   + removed logs
 
 }

+ 6 - 2
compiler/pexpr.pas

@@ -47,7 +47,7 @@ unit pexpr;
 
     uses
        globtype,systems,tokens,
-       cobjects,globals,scanner,
+       cutils,cobjects,globals,scanner,
        symconst,aasm,htypechk,
 {$ifdef newcg}
        cgbase,
@@ -2214,7 +2214,11 @@ _LECKKLAMMER : begin
 end.
 {
   $Log$
-  Revision 1.6  2000-08-20 15:12:49  peter
+  Revision 1.7  2000-08-27 16:11:51  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.6  2000/08/20 15:12:49  peter
     * auto derefence mode for array pointer (merged)
 
   Revision 1.5  2000/08/16 18:33:53  peter

+ 10 - 6
compiler/pmodules.pas

@@ -42,8 +42,8 @@ unit pmodules;
 
     uses
        globtype,version,systems,tokens,
-       cobjects,comphook,compiler,
-       globals,verbose,files,
+       cutils,cobjects,comphook,compiler,
+       globals,verbose,fmodule,finput,
        symconst,symtable,aasm,types,
 {$ifdef newcg}
        cgbase,
@@ -998,9 +998,9 @@ unit pmodules;
              main_file := current_scanner^.inputfile;
              while assigned(main_file^.next) do
                main_file := main_file^.next;
- 
+
              current_module^.SetFileName(main_file^.path^+main_file^.name^,true);
- 
+
              stringdispose(current_module^.modulename);
              current_module^.modulename:=stringdup(upper(pattern));
           { check for system unit }
@@ -1466,7 +1466,7 @@ unit pmodules;
          main_file := current_scanner^.inputfile;
          while assigned(main_file^.next) do
            main_file := main_file^.next;
- 
+
          current_module^.SetFileName(main_file^.path^+main_file^.name^,true);
 
          if islibrary then
@@ -1713,7 +1713,11 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.5  2000-08-25 08:48:22  jonas
+  Revision 1.6  2000-08-27 16:11:52  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.5  2000/08/25 08:48:22  jonas
     * fixed bug with include files at the very beginning of .pp/.pas files
       (wrong name used for generating exe/checking unit name) (merged from
       fixes branch)

+ 6 - 2
compiler/pstatmnt.pas

@@ -40,7 +40,7 @@ unit pstatmnt;
 
     uses
        globtype,systems,tokens,
-       strings,cobjects,globals,files,verbose,cpuinfo,
+       strings,cutils,cobjects,globals,fmodule,verbose,cpuinfo,
        symconst,symtable,aasm,pass_1,types,scanner,
 {$ifdef newcg}
        cgbase,
@@ -1382,7 +1382,11 @@ unit pstatmnt;
 end.
 {
   $Log$
-  Revision 1.5  2000-08-12 15:41:15  peter
+  Revision 1.6  2000-08-27 16:11:52  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.5  2000/08/12 15:41:15  peter
     * fixed bug 1096 (merged)
 
   Revision 1.4  2000/08/12 06:46:06  florian

+ 6 - 2
compiler/psub.pas

@@ -50,7 +50,7 @@ implementation
 
 uses
   globtype,systems,
-  strings,globals,verbose,files,
+  cutils,strings,globals,verbose,fmodule,
   scanner,aasm,tree,types,
   import,gendef,htypechk,
 {$ifdef newcg}
@@ -2087,7 +2087,11 @@ end.
 
 {
   $Log$
-  Revision 1.9  2000-08-16 18:33:54  peter
+  Revision 1.10  2000-08-27 16:11:52  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.9  2000/08/16 18:33:54  peter
     * splitted namedobjectitem.next into indexnext and listnext so it
       can be used in both lists
     * don't allow "word = word" type definitions (merged)

+ 6 - 2
compiler/ptconst.pas

@@ -40,7 +40,7 @@ unit ptconst;
        strings,
 {$endif Delphi}
        globtype,systems,tokens,cpuinfo,
-       cobjects,globals,scanner,
+       cutils,cobjects,globals,scanner,
        symconst,aasm,types,verbose,
        tree,pass_1,
        { parser specific stuff }
@@ -809,7 +809,11 @@ unit ptconst;
 end.
 {
   $Log$
-  Revision 1.5  2000-08-24 19:13:18  peter
+  Revision 1.6  2000-08-27 16:11:52  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.5  2000/08/24 19:13:18  peter
     * allow nil for class typed consts (merged)
 
   Revision 1.4  2000/08/16 13:06:06  florian

+ 6 - 2
compiler/ptype.pas

@@ -63,7 +63,7 @@ uses
 implementation
 
 uses
-  cobjects,globals,verbose,systems,tokens,
+  cutils,cobjects,globals,verbose,systems,tokens,
   aasm,symconst,types,
 {$ifdef GDB}
   gdb,
@@ -1606,7 +1606,11 @@ uses
 end.
 {
   $Log$
-  Revision 1.6  2000-08-16 18:33:54  peter
+  Revision 1.7  2000-08-27 16:11:52  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.6  2000/08/16 18:33:54  peter
     * splitted namedobjectitem.next into indexnext and listnext so it
       can be used in both lists
     * don't allow "word = word" type definitions (merged)

+ 7 - 3
compiler/ra386att.pas

@@ -36,8 +36,8 @@ Implementation
 
 Uses
   globtype,
-  strings,cobjects,systems,verbose,globals,
-  files,aasm,types,symconst,symtable,scanner,cpubase,
+  strings,cutils,cobjects,systems,verbose,globals,
+  fmodule,aasm,types,symconst,symtable,scanner,cpubase,
 {$ifdef NEWCG}
   cgbase,
 {$else}
@@ -2102,7 +2102,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:48  michael
+  Revision 1.3  2000-08-27 16:11:52  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.2  2000/07/13 11:32:48  michael
   + removed logs
 
 }

+ 7 - 3
compiler/ra386dir.pas

@@ -32,8 +32,8 @@ unit Ra386dir;
   implementation
 
      uses
-        files,globals,scanner,aasm,cpubase,cpuasm,
-        cobjects,symconst,symtable,types,verbose,
+        fmodule,globals,scanner,aasm,cpubase,cpuasm,
+        cutils,cobjects,symconst,symtable,types,verbose,
 {$ifdef NEWCG}
         cgbase,
 {$else}
@@ -297,7 +297,11 @@ unit Ra386dir;
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:48  michael
+  Revision 1.3  2000-08-27 16:11:52  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.2  2000/07/13 11:32:48  michael
   + removed logs
 
 }

+ 7 - 3
compiler/ra386int.pas

@@ -37,8 +37,8 @@ Implementation
 
 Uses
   globtype,
-  strings,cobjects,systems,verbose,globals,
-  files,aasm,types,scanner,symconst,symtable,cpubase,
+  strings,cutils,cobjects,systems,verbose,globals,
+  fmodule,aasm,types,scanner,symconst,symtable,cpubase,
 {$ifdef NEWCG}
   cgbase,
 {$else}
@@ -1906,7 +1906,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.4  2000-08-12 15:32:02  peter
+  Revision 1.5  2000-08-27 16:11:52  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.4  2000/08/12 15:32:02  peter
     * reference reading fix from Jonas (merged)
 
   Revision 1.3  2000/07/30 17:04:43  peter

+ 16 - 11
compiler/rautils.pas

@@ -24,16 +24,8 @@ Unit RAUtils;
 Interface
 
 Uses
-  strings,
-  cobjects,
-  globtype,types,systems,verbose,globals,files,
-  symconst,symtable,aasm,cpubase,cpuasm
-{$ifdef NEWCG}
-  ,cgbase
-{$else}
-  ,hcodegen
-{$endif}
-  ;
+  cutils,cobjects,
+  globtype,aasm,cpubase,symconst;
 
 Const
   RPNMax = 10;             { I think you only need 4, but just to be safe }
@@ -210,6 +202,15 @@ Function SearchIConstant(const s:string; var l:longint): boolean;
 
 Implementation
 
+uses
+  strings,
+  types,systems,verbose,globals,fmodule,
+  symtable,cpuasm
+{$ifdef NEWCG}
+  ,cgbase;
+{$else}
+  ,hcodegen;
+{$endif}
 
 {*************************************************************************
                               TExprParse
@@ -1565,7 +1566,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2000-08-06 10:42:29  peter
+  Revision 1.4  2000-08-27 16:11:52  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.3  2000/08/06 10:42:29  peter
     * merged patches name generation in lib and asm constant eval
 
   Revision 1.2  2000/07/13 11:32:48  michael

+ 7 - 3
compiler/regvars.pas

@@ -38,7 +38,7 @@ implementation
 
    uses
      globtype,systems,comphook,
-     cobjects,verbose,globals,
+     cutils,cobjects,verbose,globals,
      symconst,symtable,types,
      hcodegen,temp_gen,cpubase,cpuasm
 {$ifndef newcg}
@@ -196,7 +196,7 @@ implementation
               { now assign register }
               for i:=1 to maxvarregs-p^.registers32 do
                 begin
-                  if assigned(regvarinfo^.regvars[i]) and 
+                  if assigned(regvarinfo^.regvars[i]) and
                     (reg_pushes[varregs[i]] < regvarinfo^.regvars[i]^.refs) then
                     begin
                       { register is no longer available for }
@@ -441,7 +441,11 @@ end.
 
 {
   $Log$
-  Revision 1.4  2000-08-17 11:07:51  jonas
+  Revision 1.5  2000-08-27 16:11:52  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.4  2000/08/17 11:07:51  jonas
     * fixed crash when inlining assembler procedures with -Or
 
   Revision 1.3  2000/08/04 05:52:00  jonas

+ 8 - 6
compiler/scanner.pas

@@ -35,7 +35,7 @@ unit scanner;
        dmisc,
 {$endif Delphi}
        globtype,version,tokens,
-       cobjects,globals,verbose,comphook,files;
+       cobjects,globals,verbose,comphook,finput;
 
     const
 {$ifdef TP}
@@ -158,10 +158,8 @@ implementation
 {$ifndef delphi}
       dos,
 {$endif delphi}
-      systems,symtable,switches
-{$IFDEF NEWST}
-      ,symbols
-{$ENDIF NEWST};
+      cutils,systems,symtable,switches,
+      fmodule;
 
 {*****************************************************************************
                               Helper routines
@@ -1837,7 +1835,11 @@ exit_label:
 end.
 {
   $Log$
-  Revision 1.4  2000-08-12 15:30:44  peter
+  Revision 1.5  2000-08-27 16:11:53  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.4  2000/08/12 15:30:44  peter
     * IDE patch for stream reading (merged)
 
   Revision 1.3  2000/08/08 19:28:57  peter

+ 6 - 2
compiler/switches.pas

@@ -30,7 +30,7 @@ function CheckSwitch(switch,state:char):boolean;
 implementation
 uses
   globtype,systems,
-  globals,verbose,files;
+  globals,verbose,fmodule;
 
 {****************************************************************************
                           Main Switches Parsing
@@ -174,7 +174,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:49  michael
+  Revision 1.3  2000-08-27 16:11:53  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.2  2000/07/13 11:32:49  michael
   + removed logs
 
 }

+ 6 - 2
compiler/symdef.inc

@@ -898,7 +898,7 @@
          while assigned(hp) do
            begin
               rttilist^.concat(new(pai_const,init_8bit(length(hp^.name))));
-              rttilist^.concat(new(pai_string,init(globals.lower(hp^.name))));
+              rttilist^.concat(new(pai_string,init(lower(hp^.name))));
               hp:=hp^.nextenum;
            end;
          rttilist^.concat(new(pai_const,init_8bit(0)));
@@ -4257,7 +4257,11 @@ Const local_symtable_index : longint = $8001;
 
 {
   $Log$
-  Revision 1.12  2000-08-21 11:27:44  pierre
+  Revision 1.13  2000-08-27 16:11:53  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.12  2000/08/21 11:27:44  pierre
    * fix the stabs problems
 
   Revision 1.11  2000/08/16 18:33:54  peter

+ 8 - 6
compiler/symtable.pas

@@ -32,12 +32,10 @@ unit symtable;
        objects,
 {$endif Delphi}
 {$endif}
-       strings,cobjects,
+       strings,cutils,cobjects,
        globtype,globals,tokens,systems,
        symconst,
-       aasm
-       ,cpubase
-       ,cpuinfo
+       aasm,cpubase,cpuinfo
 {$ifdef GDB}
        ,gdb
 {$endif}
@@ -480,7 +478,7 @@ implementation
   uses
      version,verbose,
      types,ppu,
-     gendef,files
+     gendef,fmodule,finput
      ,tree
      ,cresstr
 {$ifdef newcg}
@@ -2993,7 +2991,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  2000-08-21 11:27:45  pierre
+  Revision 1.7  2000-08-27 16:11:54  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.6  2000/08/21 11:27:45  pierre
    * fix the stabs problems
 
   Revision 1.5  2000/08/20 14:58:41  peter

+ 6 - 2
compiler/t_go32v1.pas

@@ -42,7 +42,7 @@ unit t_go32v1;
   implementation
 
     uses
-       globtype,globals,cobjects,systems,verbose,script,files;
+       cutils,globtype,globals,cobjects,systems,verbose,script,fmodule;
 
 
 {****************************************************************************
@@ -190,7 +190,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:50  michael
+  Revision 1.3  2000-08-27 16:11:54  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.2  2000/07/13 11:32:50  michael
   + removed logs
 
 }

+ 6 - 2
compiler/t_go32v2.pas

@@ -43,7 +43,7 @@ unit t_go32v2;
   implementation
 
     uses
-       strings,globtype,globals,cobjects,systems,verbose,script,files;
+       cutils,strings,globtype,globals,cobjects,systems,verbose,script,fmodule;
 
 
 {****************************************************************************
@@ -435,7 +435,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2000-08-16 13:06:07  florian
+  Revision 1.4  2000-08-27 16:11:54  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.3  2000/08/16 13:06:07  florian
     + support of 64 bit integer constants
 
   Revision 1.2  2000/07/13 11:32:50  michael

+ 7 - 3
compiler/t_linux.pas

@@ -61,9 +61,9 @@ interface
 implementation
 
   uses
-    verbose,strings,cobjects,systems,globtype,globals,
+    cutils,verbose,strings,cobjects,systems,globtype,globals,
     symconst,script,
-    files,aasm,cpuasm,cpubase,symtable{$IFDEF NEWST},symbols{$ENDIF NEWST};
+    fmodule,aasm,cpuasm,cpubase,symtable{$IFDEF NEWST},symbols{$ENDIF NEWST};
 
 {*****************************************************************************
                                TIMPORTLIBLINUX
@@ -473,7 +473,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2000-07-13 12:08:28  michael
+  Revision 1.4  2000-08-27 16:11:54  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.3  2000/07/13 12:08:28  michael
   + patched to 1.1.0 with former 1.09patch from peter
 
   Revision 1.2  2000/07/13 11:32:50  michael

+ 7 - 3
compiler/t_os2.pas

@@ -65,8 +65,8 @@ implementation
 {$else Delphi}
      dos,
 {$endif Delphi}
-     globtype,strings,cobjects,comphook,systems,
-     globals,verbose,files,script;
+     cutils,globtype,strings,cobjects,comphook,systems,
+     globals,verbose,fmodule,script;
 
 const   profile_flag:boolean=false;
 
@@ -507,7 +507,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:50  michael
+  Revision 1.3  2000-08-27 16:11:54  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.2  2000/07/13 11:32:50  michael
   + removed logs
 
 }

+ 6 - 2
compiler/t_win32.pas

@@ -75,7 +75,7 @@ unit t_win32;
 {$endif Delphi}
        impdef,
 {$endif PAVEL_LINKLIB}
-       aasm,files,globtype,globals,cobjects,systems,verbose,
+       cutils,aasm,fmodule,globtype,globals,cobjects,systems,verbose,
        script,gendef,
        cpubase,cpuasm
 {$ifdef GDB}
@@ -1303,7 +1303,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2000-07-21 15:14:02  jonas
+  Revision 1.4  2000-08-27 16:11:54  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.3  2000/07/21 15:14:02  jonas
     + added is_addr field for labels, if they are only used for getting the address
        (e.g. for io checks) and corresponding getaddrlabel() procedure
 

+ 6 - 2
compiler/tcadd.pas

@@ -34,7 +34,7 @@ implementation
 
     uses
       globtype,systems,tokens,
-      cobjects,verbose,globals,
+      cutils,cobjects,verbose,globals,
       symconst,symtable,aasm,types,
 {$ifdef newcg}
       cgbase,
@@ -1289,7 +1289,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.5  2000-08-17 12:03:48  florian
+  Revision 1.6  2000-08-27 16:11:54  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.5  2000/08/17 12:03:48  florian
     * fixed several problems with the int64 constants
 
   Revision 1.4  2000/07/27 09:19:37  jonas

+ 6 - 2
compiler/tccal.pas

@@ -42,7 +42,7 @@ interface
 implementation
 
     uses
-      globtype,systems,
+      cutils,globtype,systems,
       cobjects,verbose,globals,
       symconst,aasm,types,
       htypechk,pass_1,cpubase
@@ -1333,7 +1333,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.8  2000-08-15 03:43:24  peter
+  Revision 1.9  2000-08-27 16:11:54  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.8  2000/08/15 03:43:24  peter
     * integer constant -> integer para enhanced to search the best matching
       procedure, just like delphi does (merged)
 

+ 6 - 2
compiler/tccnv.pas

@@ -40,7 +40,7 @@ implementation
 
    uses
       globtype,systems,tokens,
-      cobjects,verbose,globals,
+      cutils,cobjects,verbose,globals,
       symconst,symtable,aasm,types,
 {$ifdef newcg}
       cgbase,
@@ -1042,7 +1042,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  2000-08-26 19:40:19  peter
+  Revision 1.7  2000-08-27 16:11:55  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.6  2000/08/26 19:40:19  peter
     * integer(char) explicit typecast support (tp7,delphi compatible)
 
   Revision 1.5  2000/08/02 07:20:32  jonas

+ 6 - 2
compiler/tcflw.pas

@@ -47,7 +47,7 @@ implementation
 
     uses
       globtype,systems,
-      cobjects,verbose,globals,
+      cutils,cobjects,verbose,globals,
       symconst,symtable,aasm,types,htypechk,pass_1,cpubase
 {$ifdef newcg}
       ,tgobj
@@ -635,7 +635,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.4  2000-08-12 15:41:15  peter
+  Revision 1.5  2000-08-27 16:11:55  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.4  2000/08/12 15:41:15  peter
     * fixed bug 1096 (merged)
 
   Revision 1.3  2000/08/02 07:04:56  jonas

+ 6 - 2
compiler/tcld.pas

@@ -37,7 +37,7 @@ interface
 implementation
 
     uses
-      cobjects,verbose,globtype,globals,systems,
+      cutils,cobjects,verbose,globtype,globals,systems,
       symconst,symtable,aasm,types,
       htypechk,pass_1,
       tccnv,cpubase
@@ -515,7 +515,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  2000-08-15 03:41:27  peter
+  Revision 1.7  2000-08-27 16:11:55  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.6  2000/08/15 03:41:27  peter
     * previous commit was wrong file :(
 
   Revision 1.5  2000/08/13 19:21:13  peter

+ 6 - 2
compiler/tcmem.pas

@@ -44,7 +44,7 @@ implementation
 
     uses
       globtype,systems,
-      cobjects,verbose,globals,
+      cutils,cobjects,verbose,globals,
       symconst,symtable,aasm,types,
       htypechk,pass_1,cpubase
 {$ifdef newcg}
@@ -643,7 +643,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  2000-08-20 15:05:45  peter
+  Revision 1.7  2000-08-27 16:11:55  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.6  2000/08/20 15:05:45  peter
     * don't allow pointer indexing in non-fpc modes
     * array type required message instead of type mismatch (merged)
 

+ 7 - 3
compiler/temp_gen.pas

@@ -25,7 +25,7 @@ unit temp_gen;
   interface
 
     uses
-      cpubase,cpuinfo,cobjects,globals,tree,hcodegen,verbose,files,aasm;
+      cpubase,cpuinfo,cobjects,globals,tree,hcodegen,verbose,fmodule,aasm;
 
     type
       ttemptype = (tt_none,tt_free,tt_normal,tt_persistant,tt_ansistring,tt_freeansistring,tt_widestring,tt_freewidestring);
@@ -76,7 +76,7 @@ unit temp_gen;
   implementation
 
     uses
-       scanner,systems
+       cutils,scanner,systems
 {$ifdef i386}
        ,cgai386
 {$endif i386}
@@ -539,7 +539,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:52  michael
+  Revision 1.3  2000-08-27 16:11:55  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.2  2000/07/13 11:32:52  michael
   + removed logs
 
 }

+ 6 - 2
compiler/tgeni386.pas

@@ -25,7 +25,7 @@ unit tgeni386;
   interface
 
     uses
-       cobjects,globals,tree,hcodegen,verbose,files,aasm,
+       cobjects,globals,tree,hcodegen,verbose,aasm,
        cpubase,cpuasm
        ;
 
@@ -653,7 +653,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.4  2000-08-05 13:32:39  peter
+  Revision 1.5  2000-08-27 16:11:55  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.4  2000/08/05 13:32:39  peter
     * fixed build prob without support_mmx
 
   Revision 1.3  2000/08/04 05:09:49  jonas

+ 6 - 2
compiler/tree.pas

@@ -388,7 +388,7 @@ unit tree;
 
     uses
        systems,
-       globals,verbose,files,types,
+       cutils,globals,verbose,fmodule,types,
 {$ifdef newcg}
        cgbase
 {$else newcg}
@@ -2150,7 +2150,11 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.7  2000-08-17 12:03:48  florian
+  Revision 1.8  2000-08-27 16:11:55  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.7  2000/08/17 12:03:48  florian
     * fixed several problems with the int64 constants
 
   Revision 1.6  2000/08/16 13:06:07  florian

+ 10 - 14
compiler/verbose.pas

@@ -24,7 +24,8 @@ unit verbose;
 interface
 
 uses
-  messages,cobjects;
+  cutils,cobjects,
+  messages;
 
 {$ifdef TP}
   {$define EXTERN_MSG}
@@ -91,7 +92,7 @@ procedure DoneVerbose;
 
 implementation
 uses
-  files,comphook,
+  fmodule,comphook,
   version,globals;
 
 var
@@ -283,24 +284,15 @@ end;
 
 procedure stop;
 begin
-{$ifndef TP}
-  do_stop();
-{$else}
-  do_stop;
-{$endif}
+  do_stop{$ifdef FPC}(){$endif};
 end;
 
 
 procedure ShowStatus;
 begin
   UpdateStatus;
-{$ifndef TP}
-  if do_status() then
-   stop;
-{$else}
-  if do_status then
+  if do_status{$ifdef FPC}(){$endif} then
    stop;
-{$endif}
 end;
 
 
@@ -590,7 +582,11 @@ end.
 
 {
   $Log$
-  Revision 1.3  2000-08-13 12:54:55  peter
+  Revision 1.4  2000-08-27 16:11:55  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.3  2000/08/13 12:54:55  peter
     * class member decl wrong then no other error after it
     * -vb has now also line numbering
     * -vb is also used for interface/implementation different decls and