* ppu object to class rewrite

  * move ppu read and write stuff to fppu

compiler/compiler.pas

@@ -283,7 +283,7 @@ begin
       parser.preprocess(inputdir+inputfile+inputextension)
      else
 {$endif PREPROCWRITE}
-      parser.compile(inputdir+inputfile+inputextension,false);
+      parser.compile(inputdir+inputfile+inputextension);
      if status.errorcount=0 then
       begin
         starttime:=getrealtime-starttime;
@@ -328,7 +328,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.20  2001-04-21 13:37:16  peter
+  Revision 1.21  2001-05-06 14:49:16  peter
+    * ppu object to class rewrite
+    * move ppu read and write stuff to fppu
+
+  Revision 1.20  2001/04/21 13:37:16  peter
     * made tclassheader using class of to implement cpu dependent code
 
   Revision 1.19  2001/04/18 22:01:53  peter

compiler/fmodule.pas

@@ -25,23 +25,23 @@ unit fmodule;
 {$i defines.inc}
 
 {$ifdef go32v1}
-  {$define SHORTASMprefix}
+  {$define shortasmprefix}
 {$endif}
 {$ifdef go32v2}
-  {$define SHORTASMprefix}
+  {$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}
+  {$define shortasmprefix}
 {$endif}
 
 interface
 
     uses
        cutils,cclasses,
-       globals,ppu,finput,
+       globals,finput,
        symbase;
 
     const
@@ -84,11 +84,6 @@ interface
 {$endif NEWMAP}
 
        tmodule = class(tmodulebase)
-          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_compile,               { need to compile the sources }
@@ -101,7 +96,9 @@ interface
           in_implementation,        { processing the implementation part? }
           in_global     : boolean;  { allow global settings }
           recompile_reason : trecompile_reason;  { the reason why the unit should be recompiled }
-
+          crc,
+          interface_crc : cardinal;
+          flags         : cardinal;  { the PPU flags }
           islibrary     : boolean;  { if it is a library (win32 dll) }
           map           : punitmap; { mapping of all used units }
           unitcount     : longint;  { local unit counter }
@@ -131,18 +128,11 @@ interface
           locallibrarysearchpath : TSearchPathList;
 
           asmprefix     : pstring;  { prefix for the smartlink asmfiles }
-{$ifdef Test_Double_checksum}
-          crc_array : pointer;
-          crc_size : longint;
-          crc_array2 : pointer;
-          crc_size2 : longint;
-{$endif def Test_Double_checksum}
           constructor create(const s:string;_is_unit:boolean);
           destructor destroy;override;
-          procedure reset;
+          procedure reset;virtual;
+          procedure numberunits;
           procedure setfilename(const fn:string;allowoutput:boolean);
-          function  openppu:boolean;
-          function  search_unit(const n : string;onlysource:boolean):boolean;
        end;
 
        tused_unit = class(tlinkedlistitem)
@@ -312,332 +302,58 @@ uses
 
 
 {****************************************************************************
-                                  TMODULE
+                              TUSED_UNIT
  ****************************************************************************}
 
-    procedure tmodule.setfilename(const fn:string;allowoutput:boolean);
-      var
-        p : dirstr;
-        n : NameStr;
-        e : ExtStr;
+    constructor tused_unit.create(_u : tmodule;intface:boolean);
       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_info.libprefix+n+target_info.staticlibext);
-         if target_info.target=target_i386_WIN32 then
-           sharedlibfilename:=stringdup(p+n+target_info.sharedlibext)
-         else
-           sharedlibfilename:=stringdup(p+target_info.libprefix+n+target_info.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);
+        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;
 
 
-    function tmodule.openppu:boolean;
-      var
-        ppufiletime : longint;
+    constructor tused_unit.create_to_load(const n:string;c,intfc:longint;intface:boolean);
       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_info.endian<>target_info.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)');
-        do_compile:=false;
-        openppu:=true;
+        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;
 
 
-    function tmodule.search_unit(const n : string;onlysource:boolean):boolean;
-      var
-         singlepathstring,
-         filename : string;
-
-         Function UnitExists(const ext:string;var foundfile:string):boolean;
-         begin
-           Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
-           UnitExists:=FindFile(FileName+ext,Singlepathstring,foundfile);
-         end;
-
-         Function PPUSearchPath(const s:string):boolean;
-         var
-           found : boolean;
-           hs    : string;
-         begin
-           Found:=false;
-           singlepathstring:=FixPath(s,false);
-         { Check for PPU file }
-           Found:=UnitExists(target_info.unitext,hs);
-           if Found then
-            Begin
-              SetFileName(hs,false);
-              Found:=OpenPPU;
-            End;
-           PPUSearchPath:=Found;
-         end;
-
-         Function SourceSearchPath(const s:string):boolean;
-         var
-           found   : boolean;
-           hs      : string;
-         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_info.sourceext,hs);
-           if not Found then
-            begin
-              { Check for .pas }
-              Found:=UnitExists(target_info.pasext,hs);
-            end;
-           stringdispose(mainsource);
-           if Found then
-            begin
-              sources_avail:=true;
-              { Load Filenames when found }
-              mainsource:=StringDup(hs);
-              SetFileName(hs,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 : TStringListItem;
-           found : boolean;
-         begin
-           found:=false;
-           hp:=TStringListItem(list.First);
-           while assigned(hp) do
-            begin
-              found:=SearchPath(hp.Str);
-              if found then
-               break;
-              hp:=TStringListItem(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;
+    destructor tused_unit.destroy;
+      begin
+        stringdispose(name);
+        inherited destroy;
       end;
 
 
+{****************************************************************************
+                            TDENPENDENT_UNIT
+ ****************************************************************************}
 
-    procedure tmodule.reset;
-      var
-         pm : tdependent_unit;
+    constructor tdependent_unit.create(_u : tmodule);
       begin
-        if assigned(scanner) then
-          tscannerfile(scanner).invalid:=true;
-        if assigned(globalsymtable) then
-          begin
-            globalsymtable.free;
-            globalsymtable:=nil;
-          end;
-        if assigned(localsymtable) then
-          begin
-            localsymtable.free;
-            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.free;
-        sourcefiles:=tinputfilemanager.create;
-        imports.free;
-        imports:=tlinkedlist.create;
-        _exports.free;
-        _exports:=tlinkedlist.create;
-        externals.free;
-        externals:=tlinkedlist.create;
-        used_units.free;
-        used_units:=TLinkedList.Create;
-        { all units that depend on this one must be recompiled ! }
-        pm:=tdependent_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:=tdependent_unit(pm.next);
-          end;
-        dependent_units.free;
-        dependent_units:=TLinkedList.Create;
-        resourcefiles.Free;
-        resourcefiles:=TStringList.Create;
-        linkunitofiles.Free;
-        linkunitofiles:=TLinkContainer.Create;
-        linkunitstaticlibs.Free;
-        linkunitstaticlibs:=TLinkContainer.Create;
-        linkunitsharedlibs.Free;
-        linkunitsharedlibs:=TLinkContainer.Create;
-        linkotherofiles.Free;
-        linkotherofiles:=TLinkContainer.Create;
-        linkotherstaticlibs.Free;
-        linkotherstaticlibs:=TLinkContainer.Create;
-        linkothersharedlibs.Free;
-        linkothersharedlibs:=TLinkContainer.Create;
-        uses_imports:=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;
+         u:=_u;
       end;
 
 
+{****************************************************************************
+                                  TMODULE
+ ****************************************************************************}
+
     constructor tmodule.create(const s:string;_is_unit:boolean);
       var
         p : dirstr;
@@ -652,7 +368,7 @@ uses
          inherited create('Program');
         mainsource:=stringdup(s);
         { Dos has the famous 8.3 limit :( }
-{$ifdef SHORTASMprefix}
+{$ifdef shortasmprefix}
         asmprefix:=stringdup(FixFileName('as'));
 {$else}
         asmprefix:=stringdup(FixFileName(n));
@@ -671,15 +387,14 @@ uses
         linkotherofiles:=TLinkContainer.Create;
         linkotherstaticlibs:=TLinkContainer.Create;
         linkothersharedlibs:=TLinkContainer.Create;
-        ppufile:=nil;
+        crc:=0;
+        interface_crc:=0;
+        flags:=0;
         scanner:=nil;
         map:=nil;
         globalsymtable:=nil;
         localsymtable:=nil;
         loaded_from:=nil;
-        flags:=0;
-        crc:=0;
-        interface_crc:=0;
         do_reload:=false;
         unitcount:=1;
         do_compile:=false;
@@ -698,17 +413,6 @@ uses
         imports:=TLinkedList.Create;
         _exports:=TLinkedList.Create;
         externals:=TLinkedList.Create;
-      { search the PPU file if it is an unit }
-        if is_unit then
-         begin
-           { use the realmodulename so we can also find a case sensitive
-             source filename }
-           search_unit(realmodulename^,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;
 
 
@@ -720,9 +424,6 @@ uses
       begin
         if assigned(map) then
          dispose(map);
-        if assigned(ppufile) then
-         dispose(ppufile,done);
-        ppufile:=nil;
         if assigned(imports) then
          imports.free;
         imports:=nil;
@@ -775,58 +476,171 @@ uses
       end;
 
 
-{****************************************************************************
-                              TUSED_UNIT
- ****************************************************************************}
-
-    constructor tused_unit.create(_u : tmodule;intface:boolean);
+    procedure tmodule.reset;
+      var
+         pm : tdependent_unit;
       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;
+        if assigned(scanner) then
+          tscannerfile(scanner).invalid:=true;
+        if assigned(globalsymtable) then
+          begin
+            globalsymtable.free;
+            globalsymtable:=nil;
+          end;
+        if assigned(localsymtable) then
+          begin
+            localsymtable.free;
+            localsymtable:=nil;
+          end;
+        if assigned(map) then
+         begin
+           dispose(map);
+           map:=nil;
+         end;
+        sourcefiles.free;
+        sourcefiles:=tinputfilemanager.create;
+        imports.free;
+        imports:=tlinkedlist.create;
+        _exports.free;
+        _exports:=tlinkedlist.create;
+        externals.free;
+        externals:=tlinkedlist.create;
+        used_units.free;
+        used_units:=TLinkedList.Create;
+        { all units that depend on this one must be recompiled ! }
+        pm:=tdependent_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:=tdependent_unit(pm.next);
+          end;
+        dependent_units.free;
+        dependent_units:=TLinkedList.Create;
+        resourcefiles.Free;
+        resourcefiles:=TStringList.Create;
+        linkunitofiles.Free;
+        linkunitofiles:=TLinkContainer.Create;
+        linkunitstaticlibs.Free;
+        linkunitstaticlibs:=TLinkContainer.Create;
+        linkunitsharedlibs.Free;
+        linkunitsharedlibs:=TLinkContainer.Create;
+        linkotherofiles.Free;
+        linkotherofiles:=TLinkContainer.Create;
+        linkotherstaticlibs.Free;
+        linkotherstaticlibs:=TLinkContainer.Create;
+        linkothersharedlibs.Free;
+        linkothersharedlibs:=TLinkContainer.Create;
+        uses_imports:=false;
+        do_compile:=false;
+        { sources_avail:=true;
+        should not be changed PM }
+        compiled:=false;
+        in_implementation:=false;
+        in_global:=true;
+        crc:=0;
+        interface_crc:=0;
+        flags:=0;
+        {loaded_from:=nil;
+        should not be changed PFV }
+        unitcount:=1;
+        recompile_reason:=rr_unknown;
       end;
 
 
-    constructor tused_unit.create_to_load(const n:string;c,intfc:longint;intface:boolean);
+    procedure tmodule.setfilename(const fn:string;allowoutput:boolean);
+      var
+        p : dirstr;
+        n : NameStr;
+        e : ExtStr;
       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;
+         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_info.libprefix+n+target_info.staticlibext);
+         if target_info.target=target_i386_WIN32 then
+           sharedlibfilename:=stringdup(p+n+target_info.sharedlibext)
+         else
+           sharedlibfilename:=stringdup(p+target_info.libprefix+n+target_info.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;
 
 
-    destructor tused_unit.destroy;
+    procedure tmodule.numberunits;
+      var
+        counter : longint;
+        hp      : tused_unit;
+        hp1     : tmodule;
       begin
-        stringdispose(name);
-        inherited destroy;
+        { Reset all numbers to -1 }
+        hp1:=tmodule(loaded_units.first);
+        while assigned(hp1) do
+         begin
+           if assigned(hp1.globalsymtable) then
+             hp1.globalsymtable.unitid:=$ffff;
+           hp1:=tmodule(hp1.next);
+         end;
+        { Our own symtable gets unitid 0, for a program there is
+          no globalsymtable }
+        if assigned(globalsymtable) then
+          globalsymtable.unitid:=0;
+        { number units }
+        counter:=1;
+        hp:=tused_unit(used_units.first);
+        while assigned(hp) do
+         begin
+           tsymtable(hp.u.globalsymtable).unitid:=counter;
+           inc(counter);
+           hp:=tused_unit(hp.next);
+         end;
       end;
 
 
-{****************************************************************************
-                            TDENPENDENT_UNIT
- ****************************************************************************}
-
-    constructor tdependent_unit.create(_u : tmodule);
-      begin
-         u:=_u;
-      end;
-
 end.
 {
   $Log$
-  Revision 1.13  2001-04-18 22:01:53  peter
+  Revision 1.14  2001-05-06 14:49:16  peter
+    * ppu object to class rewrite
+    * move ppu read and write stuff to fppu
+
+  Revision 1.13  2001/04/18 22:01:53  peter
     * registration of targets and assemblers
 
   Revision 1.12  2001/04/13 18:08:37  peter

compiler/fppu.pas

@@ -0,0 +1,1150 @@
+{
+    $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 fppu;
+
+{$i defines.inc}
+
+{ close ppufiles on system that are
+  short on file handles like DOS system PM }
+{$ifdef GO32V1}
+  {$define SHORT_ON_FILE_HANDLES}
+{$endif GO32V1}
+{$ifdef GO32V2}
+  {$define SHORT_ON_FILE_HANDLES}
+{$endif GO32V2}
+
+interface
+
+    uses
+       cutils,cclasses,
+       globtype,globals,finput,fmodule,
+       symbase,symppu,ppu;
+
+    type
+       tppumodule = class(tmodule)
+          ppufile    : tcompilerppufile; { the PPU file }
+{$ifdef Test_Double_checksum}
+          crc_array  : pointer;
+          crc_size   : longint;
+          crc_array2 : pointer;
+          crc_size2  : longint;
+{$endif def Test_Double_checksum}
+          constructor create(const s:string;_is_unit:boolean);
+          destructor destroy;override;
+          procedure reset;override;
+          function  openppu:boolean;
+          function  search_unit(const n : string;onlysource:boolean):boolean;
+          procedure getppucrc;
+          procedure writeppu;
+          procedure loadppu;
+       private
+          procedure load_interface;
+          procedure load_symtable_refs;
+          procedure load_usedunits;
+          procedure writeusedmacro(p:TNamedIndexItem);
+          procedure writeusedmacros;
+          procedure writesourcefiles;
+          procedure writeusedunit;
+          procedure writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
+          procedure readusedmacros;
+          procedure readsourcefiles;
+          procedure readloadunit;
+          procedure readlinkcontainer(var p:tlinkcontainer);
+       end;
+
+
+    function loadunit(const s : stringid) : tmodule;
+
+
+implementation
+
+uses
+{$ifdef delphi}
+  dmisc,
+{$else}
+  dos,
+{$endif}
+  verbose,systems,version,
+  symtable,
+  scanner,
+  parser;
+
+
+{****************************************************************************
+                                TPPUMODULE
+ ****************************************************************************}
+
+    constructor tppumodule.create(const s:string;_is_unit:boolean);
+      begin
+        inherited create(s,_is_unit);
+        ppufile:=nil;
+      { search the PPU file if it is an unit }
+        if is_unit then
+         begin
+           { use the realmodulename so we can also find a case sensitive
+             source filename }
+           search_unit(realmodulename^,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 tppumodule.Destroy;
+      begin
+        if assigned(ppufile) then
+         ppufile.free;
+        ppufile:=nil;
+        inherited Destroy;
+      end;
+
+
+    procedure tppumodule.reset;
+      begin
+        if assigned(ppufile) then
+         begin
+           ppufile.free;
+           ppufile:=nil;
+         end;
+        inherited reset;
+      end;
+
+
+    function tppumodule.openppu:boolean;
+      var
+        ppufiletime : 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:=tcompilerppufile.create(ppufilename^);
+        if not ppufile.openfile then
+         begin
+           ppufile.free;
+           ppufile:=nil;
+           Message(unit_u_ppu_file_too_short);
+           exit;
+         end;
+      { check for a valid PPU file }
+        if not ppufile.CheckPPUId then
+         begin
+           ppufile.free;
+           ppufile:=nil;
+           Message(unit_u_ppu_invalid_header);
+           exit;
+         end;
+      { check for allowed PPU versions }
+        if not (ppufile.GetPPUVersion = CurrentPPUVersion) then
+         begin
+           ppufile.free;
+           ppufile:=nil;
+           Message1(unit_u_ppu_invalid_version,tostr(ppufile.GetPPUVersion));
+           exit;
+         end;
+      { check the target processor }
+        if ttargetcpu(ppufile.header.cpu)<>target_cpu then
+         begin
+           ppufile.free;
+           ppufile:=nil;
+           Message(unit_u_ppu_invalid_processor);
+           exit;
+         end;
+      { check target }
+        if ttarget(ppufile.header.target)<>target_info.target then
+         begin
+           ppufile.free;
+           ppufile:=nil;
+           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)');
+        do_compile:=false;
+        openppu:=true;
+      end;
+
+
+    function tppumodule.search_unit(const n : string;onlysource:boolean):boolean;
+      var
+         singlepathstring,
+         filename : string;
+
+         Function UnitExists(const ext:string;var foundfile:string):boolean;
+         begin
+           Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
+           UnitExists:=FindFile(FileName+ext,Singlepathstring,foundfile);
+         end;
+
+         Function PPUSearchPath(const s:string):boolean;
+         var
+           found : boolean;
+           hs    : string;
+         begin
+           Found:=false;
+           singlepathstring:=FixPath(s,false);
+         { Check for PPU file }
+           Found:=UnitExists(target_info.unitext,hs);
+           if Found then
+            Begin
+              SetFileName(hs,false);
+              Found:=OpenPPU;
+            End;
+           PPUSearchPath:=Found;
+         end;
+
+         Function SourceSearchPath(const s:string):boolean;
+         var
+           found   : boolean;
+           hs      : string;
+         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_info.sourceext,hs);
+           if not Found then
+            begin
+              { Check for .pas }
+              Found:=UnitExists(target_info.pasext,hs);
+            end;
+           stringdispose(mainsource);
+           if Found then
+            begin
+              sources_avail:=true;
+              { Load Filenames when found }
+              mainsource:=StringDup(hs);
+              SetFileName(hs,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 : TStringListItem;
+           found : boolean;
+         begin
+           found:=false;
+           hp:=TStringListItem(list.First);
+           while assigned(hp) do
+            begin
+              found:=SearchPath(hp.Str);
+              if found then
+               break;
+              hp:=TStringListItem(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;
+
+
+{**********************************
+    PPU Reading/Writing Helpers
+***********************************}
+
+    procedure tppumodule.writeusedmacro(p:TNamedIndexItem);
+      begin
+        if tmacro(p).is_used or tmacro(p).defined_at_startup then
+          begin
+            ppufile.putstring(p.name);
+            ppufile.putbyte(byte(tmacro(p).defined_at_startup));
+            ppufile.putbyte(byte(tmacro(p).is_used));
+          end;
+      end;
+
+
+    procedure tppumodule.writeusedmacros;
+      begin
+        ppufile.do_crc:=false;
+        current_scanner.macros.foreach({$ifdef FPCPROCVAR}@{$endif}writeusedmacro);
+        ppufile.writeentry(ibusedmacros);
+        ppufile.do_crc:=true;
+      end;
+
+
+    procedure tppumodule.writesourcefiles;
+      var
+        hp  : tinputfile;
+        i,j : longint;
+      begin
+      { second write the used source files }
+        ppufile.do_crc:=false;
+        hp:=sourcefiles.files;
+      { write source files directly in good order }
+        j:=0;
+        while assigned(hp) do
+          begin
+            inc(j);
+            hp:=hp.ref_next;
+          end;
+        while j>0 do
+          begin
+            hp:=sourcefiles.files;
+            for i:=1 to j-1 do
+              hp:=hp.ref_next;
+            ppufile.putstring(hp.name^);
+            dec(j);
+         end;
+        ppufile.writeentry(ibsourcefiles);
+        ppufile.do_crc:=true;
+      end;
+
+
+    procedure tppumodule.writeusedunit;
+      var
+        hp : tused_unit;
+      begin
+        { renumber the units for derefence writing }
+        numberunits;
+        { write a reference for each used unit }
+        hp:=tused_unit(used_units.first);
+        while assigned(hp) do
+         begin
+           { implementation units should not change
+             the CRC PM }
+           ppufile.do_crc:=hp.in_interface;
+           ppufile.putstring(hp.name^);
+           { the checksum should not affect the crc of this unit ! (PFV) }
+           ppufile.do_crc:=false;
+           ppufile.putlongint(hp.checksum);
+           ppufile.putlongint(hp.interface_checksum);
+           ppufile.putbyte(byte(hp.in_interface));
+           ppufile.do_crc:=true;
+           hp:=tused_unit(hp.next);
+         end;
+        ppufile.do_interface_crc:=true;
+        ppufile.writeentry(ibloadunit);
+      end;
+
+
+    procedure tppumodule.writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
+      var
+        hcontainer : tlinkcontainer;
+        s : string;
+        mask : cardinal;
+      begin
+        hcontainer:=TLinkContainer.Create;
+        while not p.empty do
+         begin
+           s:=p.get(mask);
+           if strippath then
+            ppufile.putstring(SplitFileName(s))
+           else
+            ppufile.putstring(s);
+           ppufile.putlongint(mask);
+           hcontainer.add(s,mask);
+         end;
+        ppufile.writeentry(id);
+        p.Free;
+        p:=hcontainer;
+      end;
+
+
+    procedure tppumodule.readusedmacros;
+      var
+        hs : string;
+        mac : tmacro;
+        was_defined_at_startup,
+        was_used : boolean;
+      begin
+        while not ppufile.endofentry do
+         begin
+           hs:=ppufile.getstring;
+           was_defined_at_startup:=boolean(ppufile.getbyte);
+           was_used:=boolean(ppufile.getbyte);
+           mac:=tmacro(current_scanner.macros.search(hs));
+           if assigned(mac) then
+             begin
+{$ifndef EXTDEBUG}
+           { if we don't have the sources why tell }
+              if sources_avail then
+{$endif ndef EXTDEBUG}
+               if (not was_defined_at_startup) and
+                  was_used and
+                  mac.defined_at_startup then
+                Message2(unit_h_cond_not_set_in_last_compile,hs,mainsource^);
+             end
+           else { not assigned }
+             if was_defined_at_startup and
+                was_used then
+              Message2(unit_h_cond_not_set_in_last_compile,hs,mainsource^);
+         end;
+      end;
+
+
+    procedure tppumodule.readsourcefiles;
+      var
+        temp,hs       : string;
+        temp_dir      : string;
+        main_dir      : string;
+        incfile_found,
+        main_found,
+        is_main       : boolean;
+        ppufiletime,
+        source_time   : longint;
+        hp            : tinputfile;
+      begin
+        ppufiletime:=getnamedfiletime(ppufilename^);
+        sources_avail:=true;
+        is_main:=true;
+        main_dir:='';
+        while not ppufile.endofentry do
+         begin
+           hs:=ppufile.getstring;
+           temp_dir:='';
+           if (flags and uf_in_library)<>0 then
+            begin
+              sources_avail:=false;
+              temp:=' library';
+            end
+           else if pos('Macro ',hs)=1 then
+            begin
+              { we don't want to find this file }
+              { but there is a problem with file indexing !! }
+              temp:='';
+            end
+           else
+            begin
+              { check the date of the source files }
+              Source_Time:=GetNamedFileTime(path^+hs);
+              incfile_found:=false;
+              main_found:=false;
+              if Source_Time<>-1 then
+                hs:=path^+hs
+              else
+               if not(is_main) then
+                begin
+                  Source_Time:=GetNamedFileTime(main_dir+hs);
+                  if Source_Time<>-1 then
+                    hs:=main_dir+hs;
+                end;
+              if (Source_Time=-1) then
+                begin
+                  if is_main then
+                    main_found:=unitsearchpath.FindFile(hs,temp_dir)
+                  else
+                    incfile_found:=includesearchpath.FindFile(hs,temp_dir);
+                  if incfile_found or main_found then
+                   begin
+                     Source_Time:=GetNamedFileTime(temp_dir);
+                     if Source_Time<>-1 then
+                      hs:=temp_dir;
+                   end;
+                end;
+              if Source_Time=-1 then
+               begin
+                 sources_avail:=false;
+                 temp:=' not found';
+               end
+              else
+               begin
+                 if main_found then
+                   main_dir:=temp_dir;
+                 { time newer? But only allow if the file is not searched
+                   in the include path (PFV), else you've problems with
+                   units which use the same includefile names }
+                 if incfile_found then
+                  temp:=' found'
+                 else
+                  begin
+                    temp:=' time '+filetimestring(source_time);
+                    if (source_time>ppufiletime) then
+                     begin
+                       do_compile:=true;
+                       recompile_reason:=rr_sourcenewer;
+                       temp:=temp+' *'
+                     end;
+                  end;
+               end;
+              hp:=tinputfile.create(hs);
+              { the indexing is wrong here PM }
+              sourcefiles.register_file(hp);
+            end;
+           if is_main then
+             begin
+               stringdispose(mainsource);
+               mainsource:=stringdup(hs);
+             end;
+           Message1(unit_u_ppu_source,hs+temp);
+           is_main:=false;
+         end;
+      { check if we want to rebuild every unit, only if the sources are
+        available }
+        if do_build and sources_avail then
+          begin
+             do_compile:=true;
+             recompile_reason:=rr_build;
+          end;
+      end;
+
+
+    procedure tppumodule.readloadunit;
+      var
+        hs : string;
+        intfchecksum,
+        checksum : longint;
+        in_interface : boolean;
+      begin
+        while not ppufile.endofentry do
+         begin
+           hs:=ppufile.getstring;
+           checksum:=ppufile.getlongint;
+           intfchecksum:=ppufile.getlongint;
+           in_interface:=(ppufile.getbyte<>0);
+           used_units.concat(tused_unit.create_to_load(hs,checksum,intfchecksum,in_interface));
+         end;
+      end;
+
+
+    procedure tppumodule.readlinkcontainer(var p:tlinkcontainer);
+      var
+        s : string;
+        m : longint;
+      begin
+        while not ppufile.endofentry do
+         begin
+           s:=ppufile.getstring;
+           m:=ppufile.getlongint;
+           p.add(s,m);
+         end;
+      end;
+
+
+    procedure tppumodule.load_interface;
+      var
+        b : byte;
+        newmodulename : string;
+      begin
+       { read interface part }
+         repeat
+           b:=ppufile.readentry;
+           case b of
+             ibmodulename :
+               begin
+                 newmodulename:=ppufile.getstring;
+                 if upper(newmodulename)<>modulename^ then
+                   Message2(unit_f_unit_name_error,realmodulename^,newmodulename);
+                 stringdispose(modulename);
+                 stringdispose(realmodulename);
+                 modulename:=stringdup(upper(newmodulename));
+                 realmodulename:=stringdup(newmodulename);
+               end;
+             ibsourcefiles :
+               readsourcefiles;
+             ibusedmacros :
+               readusedmacros;
+             ibloadunit :
+               readloadunit;
+             iblinkunitofiles :
+               readlinkcontainer(LinkUnitOFiles);
+             iblinkunitstaticlibs :
+               readlinkcontainer(LinkUnitStaticLibs);
+             iblinkunitsharedlibs :
+               readlinkcontainer(LinkUnitSharedLibs);
+             iblinkotherofiles :
+               readlinkcontainer(LinkotherOFiles);
+             iblinkotherstaticlibs :
+               readlinkcontainer(LinkotherStaticLibs);
+             iblinkothersharedlibs :
+               readlinkcontainer(LinkotherSharedLibs);
+             ibendinterface :
+               break;
+           else
+             Message1(unit_f_ppu_invalid_entry,tostr(b));
+           end;
+         until false;
+      end;
+
+
+    procedure tppumodule.load_symtable_refs;
+      var
+         b : byte;
+         unitindex : word;
+      begin
+        { load local symtable first }
+        if ((flags and uf_local_browser)<>0) then
+          begin
+             localsymtable:=tstaticsymtable.create(modulename^);
+             tstaticsymtable(localsymtable).load(ppufile);
+          end;
+
+        { load browser }
+        if (current_module.flags and uf_has_browser)<>0 then
+          begin
+            tstoredsymtable(globalsymtable).load_browser(ppufile);
+            unitindex:=1;
+            while assigned(map^[unitindex]) do
+             begin
+               { each unit wrote one browser entry }
+               tstoredsymtable(globalsymtable).load_browser(ppufile);
+               inc(unitindex);
+             end;
+            b:=ppufile.readentry;
+            if b<>ibendbrowser then
+             Message1(unit_f_ppu_invalid_entry,tostr(b));
+          end;
+        if ((current_module.flags and uf_local_browser)<>0) then
+          tstaticsymtable(current_module.localsymtable).load_browser(ppufile);
+      end;
+
+
+    procedure tppumodule.writeppu;
+      var
+        pu : tused_unit;
+      begin
+         Message1(unit_u_ppu_write,realmodulename^);
+
+         { create unit flags }
+{$ifdef GDB}
+         if cs_gdb_dbx in aktglobalswitches then
+          flags:=flags or uf_has_dbx;
+{$endif GDB}
+         if cs_browser in aktmoduleswitches then
+          flags:=flags or uf_has_browser;
+         if cs_local_browser in aktmoduleswitches then
+          flags:=flags or uf_local_browser;
+
+{$ifdef Test_Double_checksum_write}
+         Assign(CRCFile,s+'.IMP');
+         Rewrite(CRCFile);
+{$endif def Test_Double_checksum_write}
+
+         { create new ppufile }
+         ppufile:=tcompilerppufile.create(ppufilename^);
+         if not ppufile.createfile then
+          Message(unit_f_ppu_cannot_write);
+
+         { first the unitname }
+         ppufile.putstring(realmodulename^);
+         ppufile.writeentry(ibmodulename);
+
+         writesourcefiles;
+         writeusedmacros;
+         writeusedunit;
+
+         { write the objectfiles and libraries that come for this unit,
+           preserve the containers becuase they are still needed to load
+           the link.res. All doesn't depend on the crc! It doesn't matter
+           if a unit is in a .o or .a file }
+         ppufile.do_crc:=false;
+         writelinkcontainer(linkunitofiles,iblinkunitofiles,true);
+         writelinkcontainer(linkunitstaticlibs,iblinkunitstaticlibs,true);
+         writelinkcontainer(linkunitsharedlibs,iblinkunitsharedlibs,true);
+         writelinkcontainer(linkotherofiles,iblinkotherofiles,false);
+         writelinkcontainer(linkotherstaticlibs,iblinkotherstaticlibs,true);
+         writelinkcontainer(linkothersharedlibs,iblinkothersharedlibs,true);
+         ppufile.do_crc:=true;
+
+         ppufile.writeentry(ibendinterface);
+
+         { write the symtable entries }
+         tstoredsymtable(globalsymtable).write(ppufile);
+
+         { everything after this doesn't affect the crc }
+         ppufile.do_crc:=false;
+         ppufile.writeentry(ibendimplementation);
+
+         { write static symtable
+           needed for local debugging of unit functions }
+         if ((flags and uf_local_browser)<>0) and
+            assigned(localsymtable) then
+           tstoredsymtable(localsymtable).write(ppufile);
+
+         { write all browser section }
+         if (flags and uf_has_browser)<>0 then
+          begin
+            tstoredsymtable(globalsymtable).write_browser(ppufile);
+            pu:=tused_unit(used_units.first);
+            while assigned(pu) do
+             begin
+               tstoredsymtable(pu.u.globalsymtable).write_browser(ppufile);
+               pu:=tused_unit(pu.next);
+             end;
+            ppufile.writeentry(ibendbrowser);
+          end;
+         if ((flags and uf_local_browser)<>0) and
+            assigned(localsymtable) then
+           tstaticsymtable(localsymtable).write_browser(ppufile);
+
+         { the last entry ibend is written automaticly }
+
+         { flush to be sure }
+         ppufile.flush;
+         { create and write header }
+         ppufile.header.size:=ppufile.size;
+         ppufile.header.checksum:=ppufile.crc;
+         ppufile.header.interface_checksum:=ppufile.interface_crc;
+         ppufile.header.compiler:=wordversion;
+         ppufile.header.cpu:=word(target_cpu);
+         ppufile.header.target:=word(target_info.target);
+         ppufile.header.flags:=flags;
+         ppufile.writeheader;
+
+         { save crc in current module also }
+         crc:=ppufile.crc;
+         interface_crc:=ppufile.interface_crc;
+
+{$ifdef Test_Double_checksum_write}
+         close(CRCFile);
+{$endif Test_Double_checksum_write}
+
+         ppufile.closefile;
+         ppufile.free;
+         ppufile:=nil;
+      end;
+
+
+    procedure tppumodule.getppucrc;
+      begin
+{$ifdef Test_Double_checksum_write}
+         Assign(CRCFile,s+'.INT')
+         Rewrite(CRCFile);
+{$endif def Test_Double_checksum_write}
+
+         { create new ppufile }
+         ppufile:=tcompilerppufile.create(ppufilename^);
+         ppufile.crc_only:=true;
+         if not ppufile.createfile then
+           Message(unit_f_ppu_cannot_write);
+
+         { first the unitname }
+         ppufile.putstring(realmodulename^);
+         ppufile.writeentry(ibmodulename);
+
+         { the interface units affect the crc }
+         writeusedunit;
+
+         ppufile.writeentry(ibendinterface);
+
+         { write the symtable entries }
+         tstoredsymtable(globalsymtable).write(ppufile);
+
+         { save crc  }
+         crc:=ppufile.crc;
+         interface_crc:=ppufile.interface_crc;
+
+{$ifdef Test_Double_checksum}
+         crc_array:=ppufile.crc_test;
+         ppufile.crc_test:=nil;
+         crc_size:=ppufile.crc_index2;
+         crc_array2:=ppufile.crc_test2;
+         ppufile.crc_test2:=nil;
+         crc_size2:=ppufile.crc_index2;
+{$endif Test_Double_checksum}
+
+{$ifdef Test_Double_checksum_write}
+         close(CRCFile);
+{$endif Test_Double_checksum_write}
+
+         ppufile.closefile;
+         ppufile.free;
+         ppufile:=nil;
+      end;
+
+
+    procedure tppumodule.load_usedunits;
+      var
+        pu           : tused_unit;
+        loaded_unit  : tmodule;
+        load_refs    : boolean;
+        nextmapentry : longint;
+        b            : byte;
+      begin
+        load_refs:=true;
+        { init the map }
+        new(map);
+        fillchar(map^,sizeof(tunitmap),#0);
+{$ifdef NEWMAP}
+        map^[0]:=current_module;
+{$endif NEWMAP}
+        nextmapentry:=1;
+        { load the used units from interface }
+        in_implementation:=false;
+        pu:=tused_unit(used_units.first);
+        while assigned(pu) do
+         begin
+           if (not pu.loaded) and (pu.in_interface) then
+            begin
+              loaded_unit:=loadunit(pu.name^);
+              if compiled then
+               exit;
+              { register unit in used units }
+              pu.u:=loaded_unit;
+              pu.loaded:=true;
+              { doubles are not important for that list PM }
+              pu.u.dependent_units.concat(tdependent_unit.create(self));
+              { need to recompile the current unit ? }
+              if loaded_unit.crc<>pu.checksum then
+               begin
+                 Message2(unit_u_recompile_crc_change,modulename^,pu.name^);
+                 recompile_reason:=rr_crcchanged;
+                 do_compile:=true;
+                 dispose(map);
+                 map:=nil;
+                 exit;
+               end;
+            { setup the map entry for deref }
+{$ifndef NEWMAP}
+              map^[nextmapentry]:=loaded_unit.globalsymtable;
+{$else NEWMAP}
+              map^[nextmapentry]:=loaded_unit;
+{$endif NEWMAP}
+              inc(nextmapentry);
+              if nextmapentry>maxunits then
+               Message(unit_f_too_much_units);
+            end;
+           pu:=tused_unit(pu.next);
+         end;
+        { ok, now load the interface of this unit }
+        current_module:=self;
+        SetCompileModule(current_module);
+        globalsymtable:=tglobalsymtable.create(modulename^);
+        tstoredsymtable(globalsymtable).load(ppufile);
+        { now only read the implementation uses }
+        in_implementation:=true;
+        pu:=tused_unit(used_units.first);
+        while assigned(pu) do
+         begin
+           if (not pu.loaded) and (not pu.in_interface) then
+            begin
+              loaded_unit:=loadunit(pu.name^);
+              if compiled then
+               exit;
+            { register unit in used units }
+              pu.u:=loaded_unit;
+              pu.loaded:=true;
+            { need to recompile the current unit ? }
+              if (loaded_unit.interface_crc<>pu.interface_checksum) {and
+                 not(current_module.in_second_compile) } then
+                begin
+                  Message2(unit_u_recompile_crc_change,modulename^,pu.name^+' {impl}');
+                  recompile_reason:=rr_crcchanged;
+                  do_compile:=true;
+                  dispose(map);
+                  map:=nil;
+                  exit;
+                end;
+            { setup the map entry for deref }
+{$ifndef NEWMAP}
+              map^[nextmapentry]:=loaded_unit.globalsymtable;
+{$else NEWMAP}
+              map^[nextmapentry]:=loaded_unit;
+{$endif NEWMAP}
+              inc(nextmapentry);
+              if nextmapentry>maxunits then
+               Message(unit_f_too_much_units);
+            end;
+           pu:=tused_unit(pu.next);
+         end;
+        { read the implementation part }
+        b:=ppufile.readentry;
+        if b<>ibendimplementation then
+          Message1(unit_f_ppu_invalid_entry,tostr(b));
+        { load browser info if stored }
+        if ((flags and uf_has_browser)<>0) and load_refs then
+         begin
+           current_module:=self;
+           load_symtable_refs;
+         end;
+        { remove the map, it's not needed anymore }
+        dispose(map);
+        map:=nil;
+      end;
+
+
+    procedure tppumodule.loadppu;
+      var
+        name : string;
+      begin
+        { load interface section }
+          if not do_compile then
+           load_interface;
+        { only load units when we don't recompile }
+          if not do_compile then
+           load_usedunits;
+        { recompile if set }
+          if do_compile then
+           begin
+           { we don't need the ppufile anymore }
+             if assigned(ppufile) then
+              begin
+                ppufile.free;
+                ppufile:=nil;
+              end;
+           { recompile the unit or give a fatal error if sources not available }
+             if not(sources_avail) and
+                not(sources_checked) then
+               if (not search_unit(modulename^,true))
+                  and (length(modulename^)>8) then
+                 search_unit(copy(modulename^,1,8),true);
+             if not(sources_avail) then
+               begin
+                  if recompile_reason=rr_noppu then
+                    Message1(unit_f_cant_find_ppu,modulename^)
+                  else
+                    Message1(unit_f_cant_compile_unit,modulename^);
+               end
+             else
+              begin
+                if in_compile then
+                  begin
+                    in_second_compile:=true;
+                    Message1(parser_d_compiling_second_time,modulename^);
+                  end;
+                current_scanner.tempcloseinputfile;
+                name:=mainsource^;
+                if assigned(scanner) then
+                  tscannerfile(scanner).invalid:=true;
+                { compile this module }
+                current_module:=self;
+                compile(name);
+                in_second_compile:=false;
+                if (not current_scanner.invalid) then
+                  current_scanner.tempopeninputfile;
+              end;
+           end;
+         if assigned(ppufile) then
+           begin
+              ppufile.closefile;
+              ppufile.free;
+              ppufile:=nil;
+           end;
+        end;
+
+
+{*****************************************************************************
+                                  LoadUnit
+*****************************************************************************}
+
+    function loadunit(const s : stringid) : tmodule;
+      const
+        ImplIntf : array[boolean] of string[15]=('interface','implementation');
+      var
+        st : tglobalsymtable;
+        second_time : boolean;
+        old_current_module,hp2 : tmodule;
+        hp : tppumodule;
+        scanner : tscannerfile;
+        dummy : tmodule;
+        ups   : stringid;
+      begin
+         old_current_module:=current_module;
+         { Info }
+         Message3(unit_u_load_unit,current_module.modulename^,ImplIntf[current_module.in_implementation],s);
+         ups:=upper(s);
+         { unit not found }
+         st:=nil;
+         dummy:=nil;
+         { search all loaded units }
+         hp:=tppumodule(loaded_units.first);
+         while assigned(hp) do
+           begin
+              if hp.modulename^=ups then
+                begin
+                   { forced to reload ? }
+                   if hp.do_reload then
+                    begin
+                      hp.do_reload:=false;
+                      break;
+                    end;
+                   { the unit is already registered   }
+                   { and this means that the unit     }
+                   { is already compiled              }
+                   { else there is a cyclic unit use  }
+                   if assigned(hp.globalsymtable) then
+                     st:=tglobalsymtable(hp.globalsymtable)
+                   else
+                    begin
+                    { both units in interface ? }
+                      if (not current_module.in_implementation) and
+                         (not hp.in_implementation) then
+                       begin
+                       { check for a cycle }
+                         hp2:=current_module.loaded_from;
+                         while assigned(hp2) and (hp2<>hp) do
+                          begin
+                            if hp2.in_implementation then
+                             hp2:=nil
+                            else
+                             hp2:=hp2.loaded_from;
+                          end;
+                         if assigned(hp2) then
+                          Message2(unit_f_circular_unit_reference,current_module.modulename^,hp.modulename^);
+                       end;
+                    end;
+                   break;
+                end
+              else if copy(hp.modulename^,1,8)=ups then
+                dummy:=hp;
+              { the next unit }
+              hp:=tppumodule(hp.next);
+           end;
+         if assigned(dummy) and not assigned(hp) then
+           Message2(unit_w_unit_name_error,s,dummy.modulename^);
+       { the unit is not in the loaded units, we must load it first }
+         if (not assigned(st)) then
+          begin
+            if assigned(hp) then
+             begin
+               { remove the old unit, but save the scanner }
+               loaded_units.remove(hp);
+               scanner:=tscannerfile(hp.scanner);
+               hp.reset;
+               hp.scanner:=scanner;
+               { try to reopen ppu }
+               hp.search_unit(s,false);
+               { try to load the unit a second time first }
+               current_module:=hp;
+               current_module.in_second_load:=true;
+               Message1(unit_u_second_load_unit,current_module.modulename^);
+               second_time:=true;
+             end
+            else
+          { generates a new unit info record }
+             begin
+                current_module:=tppumodule.create(s,true);
+                scanner:=nil;
+                second_time:=false;
+             end;
+            { close old_current_ppu on system that are
+              short on file handles like DOS PM }
+{$ifdef SHORT_ON_FILE_HANDLES}
+            if old_current_module.is_unit and
+               assigned(tppumodule(old_current_module).ppufile) then
+              tppumodule(old_current_module.ppufile).tempclose;
+{$endif SHORT_ON_FILE_HANDLES}
+          { now we can register the unit }
+            current_module.loaded_from:=old_current_module;
+            loaded_units.insert(current_module);
+          { now realy load the ppu }
+            tppumodule(current_module).loadppu;
+          { set compiled flag }
+            current_module.compiled:=true;
+          { load return pointer }
+            hp:=tppumodule(current_module);
+          { for a second_time recompile reload all dependent units,
+            for a first time compile register the unit _once_ }
+            if second_time then
+             begin
+               { now reload all dependent units }
+               hp2:=tmodule(loaded_units.first);
+               while assigned(hp2) do
+                begin
+                  if hp2.do_reload then
+                   dummy:=loadunit(hp2.modulename^);
+                  hp2:=tmodule(hp2.next);
+                end;
+             end
+            else
+             usedunits.concat(tused_unit.create(current_module,true));
+          end;
+         { set the old module }
+{$ifdef SHORT_ON_FILE_HANDLES}
+         if old_current_module.is_unit and
+            assigned(tppumodule(old_current_module).ppufile) then
+           tppumodule(old_current_module.ppufile).tempopen;
+{$endif SHORT_ON_FILE_HANDLES}
+         { we are back }
+         current_module:=old_current_module;
+         SetCompileModule(current_module);
+         loadunit:=hp;
+      end;
+
+
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-05-06 14:49:17  peter
+    * ppu object to class rewrite
+    * move ppu read and write stuff to fppu
+
+}

compiler/globals.pas

@@ -353,24 +353,15 @@ implementation
      convert dos datetime t to a string YY/MM/DD HH:MM:SS
    }
      var
-     {$ifndef unix}
        DT : DateTime;
-     {$endif}
-       Year,Month,Day,Hour,Min,Sec : Word;
      begin
        if t=-1 then
         begin
           FileTimeString:='Not Found';
           exit;
         end;
-     {$ifndef unix}
        unpacktime(t,DT);
-       Year:=dT.year;month:=dt.month;day:=dt.day;
-       Hour:=dt.hour;min:=dt.min;sec:=dt.sec;
-     {$else}
-       EpochToLocal (t,year,month,day,hour,min,sec);
-     {$endif}
-       filetimestring:=L0(Year)+'/'+L0(Month)+'/'+L0(Day)+' '+L0(Hour)+':'+L0(min)+':'+L0(sec);
+       filetimestring:=L0(dt.Year)+'/'+L0(dt.Month)+'/'+L0(dt.Day)+' '+L0(dt.Hour)+':'+L0(dt.min)+':'+L0(dt.sec);
      end;
 
 
@@ -1282,7 +1273,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.32  2001-04-18 22:01:53  peter
+  Revision 1.33  2001-05-06 14:49:17  peter
+    * ppu object to class rewrite
+    * move ppu read and write stuff to fppu
+
+  Revision 1.32  2001/04/18 22:01:53  peter
     * registration of targets and assemblers
 
   Revision 1.31  2001/04/15 09:48:29  peter

compiler/parser.pas

@@ -29,7 +29,7 @@ interface
 {$ifdef PREPROCWRITE}
     procedure preprocess(const filename:string);
 {$endif PREPROCWRITE}
-    procedure compile(const filename:string;compile_system:boolean);
+    procedure compile(const filename:string);
     procedure initparser;
     procedure doneparser;
 
@@ -38,7 +38,7 @@ implementation
     uses
       cutils,cclasses,
       globtype,version,tokens,systems,globals,verbose,
-      symbase,symtable,symsym,fmodule,aasm,
+      symbase,symtable,symsym,fmodule,fppu,aasm,
       hcodegen,
       script,gendef,
 {$ifdef BrowserLog}
@@ -224,7 +224,7 @@ implementation
 {$endif PREPROCWRITE}
 
 
-    procedure compile(const filename:string;compile_system:boolean);
+    procedure compile(const filename:string);
       var
        { scanner }
          oldidtoken,
@@ -383,7 +383,7 @@ implementation
            end
          else
           begin
-            current_module:=tmodule.create(filename,false);
+            current_module:=tppumodule.create(filename,false);
             main_module:=current_module;
           end;
 
@@ -410,9 +410,6 @@ implementation
          aktspecificoptprocessor:=initspecificoptprocessor;
          aktasmmode:=initasmmode;
          aktinterfacetype:=initinterfacetype;
-         { we need this to make the system unit }
-         if compile_system then
-          aktmoduleswitches:=aktmoduleswitches+[cs_compilesystem];
 
        { startup scanner, and save in current_module }
          current_scanner:=tscannerfile.Create(filename);
@@ -482,10 +479,10 @@ implementation
 {$endif newcg}
 
        { free ppu }
-         if assigned(current_module.ppufile) then
+         if assigned(tppumodule(current_module).ppufile) then
           begin
-            dispose(current_module.ppufile,done);
-            current_module.ppufile:=nil;
+            tppumodule(current_module).ppufile.free;
+            tppumodule(current_module).ppufile:=nil;
           end;
        { free scanner }
          current_scanner.free;
@@ -620,7 +617,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.17  2001-04-18 22:01:54  peter
+  Revision 1.18  2001-05-06 14:49:17  peter
+    * ppu object to class rewrite
+    * move ppu read and write stuff to fppu
+
+  Revision 1.17  2001/04/18 22:01:54  peter
     * registration of targets and assemblers
 
   Revision 1.16  2001/04/15 09:48:30  peter

compiler/pbase.pas

@@ -82,6 +82,8 @@ interface
         pbase_old_do_stop: tstopprocedure;
 {$endif fixLeaksOnError}
 
+    procedure identifier_not_found(const s:string);
+
     function tokenstring(i : ttoken):string;
 
     { consumes token i, if the current token is unequal i }
@@ -113,7 +115,7 @@ interface
 implementation
 
     uses
-       scanner,systems,verbose;
+       globtype,scanner,systems,verbose;
 
 {****************************************************************************
                            TIdStringlistItem
@@ -186,11 +188,24 @@ implementation
                                Token Parsing
 ****************************************************************************}
 
+     procedure identifier_not_found(const s:string);
+       begin
+         Message1(sym_e_id_not_found,s);
+         { show a fatal that you need -S2 or -Sd, but only
+           if we just parsed the a token that has m_class }
+         if not(m_class in aktmodeswitches) and
+            (Upper(s)=pattern) and
+            (tokeninfo^[idtoken].keyword=m_class) then
+           Message(parser_f_need_objfpc_or_delphi_mode);
+       end;
+
+
     function tokenstring(i : ttoken):string;
       begin
         tokenstring:=tokeninfo^[i].str;
       end;
 
+
     { consumes token i, write error if token is different }
     procedure consume(i : ttoken);
       begin
@@ -207,19 +222,19 @@ implementation
           end;
       end;
 
-    function try_to_consume(i:Ttoken):boolean;
-
 
-    begin
+    function try_to_consume(i:Ttoken):boolean;
+      begin
         try_to_consume:=false;
         if (token=i) or (idtoken=i) then
-            begin
-                try_to_consume:=true;
-                if token=_END then
-                    last_endtoken_filepos:=akttokenpos;
-                current_scanner.readtoken;
-            end;
-    end;
+         begin
+           try_to_consume:=true;
+           if token=_END then
+            last_endtoken_filepos:=akttokenpos;
+           current_scanner.readtoken;
+         end;
+      end;
+
 
     procedure consume_all_until(atoken : ttoken);
       begin
@@ -322,7 +337,11 @@ end.
 
 {
   $Log$
-  Revision 1.11  2001-04-13 18:08:37  peter
+  Revision 1.12  2001-05-06 14:49:17  peter
+    * ppu object to class rewrite
+    * move ppu read and write stuff to fppu
+
+  Revision 1.11  2001/04/13 18:08:37  peter
     * scanner object to class
 
   Revision 1.10  2001/04/13 01:22:11  peter

compiler/pmodules.pas

@@ -24,15 +24,6 @@ unit pmodules;
 
 {$i defines.inc}
 
-{ close old_current_ppu on system that are
-  short on file handles like DOS system PM }
-{$ifdef GO32V1}
-  {$define SHORT_ON_FILE_HANDLES}
-{$endif GO32V1}
-{$ifdef GO32V2}
-  {$define SHORT_ON_FILE_HANDLES}
-{$endif GO32V2}
-
 {$define New_GDB}
 
 interface
@@ -46,7 +37,7 @@ implementation
     uses
        globtype,version,systems,tokens,
        cutils,comphook,
-       globals,verbose,fmodule,finput,
+       globals,verbose,fmodule,finput,fppu,
        symconst,symbase,symppu,symdef,symsym,symtable,aasm,
 {$ifdef newcg}
        cgbase,
@@ -340,306 +331,6 @@ implementation
       end;
 
 
-    function loadunit(const s : string;compile_system:boolean) : tmodule;forward;
-
-
-    procedure load_usedunits(compile_system:boolean);
-      var
-        pu           : tused_unit;
-        loaded_unit  : tmodule;
-        load_refs    : boolean;
-        nextmapentry : longint;
-      begin
-        load_refs:=true;
-      { init the map }
-        new(current_module.map);
-        fillchar(current_module.map^,sizeof(tunitmap),#0);
-{$ifdef NEWMAP}
-        current_module.map^[0]:=current_module;
-{$endif NEWMAP}
-        nextmapentry:=1;
-      { load the used units from interface }
-        current_module.in_implementation:=false;
-        pu:=tused_unit(current_module.used_units.first);
-        while assigned(pu) do
-         begin
-           if (not pu.loaded) and (pu.in_interface) then
-            begin
-              loaded_unit:=loadunit(pu.name^,false);
-              if current_module.compiled then
-               exit;
-            { register unit in used units }
-              pu.u:=loaded_unit;
-              pu.loaded:=true;
-            { doubles are not important for that list PM }
-              pu.u.dependent_units.concat(tdependent_unit.create(current_module));
-            { need to recompile the current unit ? }
-              if loaded_unit.crc<>pu.checksum then
-               begin
-                 Message2(unit_u_recompile_crc_change,current_module.modulename^,pu.name^);
-                 current_module.recompile_reason:=rr_crcchanged;
-                 current_module.do_compile:=true;
-                 dispose(current_module.map);
-                 current_module.map:=nil;
-                 exit;
-               end;
-            { setup the map entry for deref }
-{$ifndef NEWMAP}
-              current_module.map^[nextmapentry]:=loaded_unit.globalsymtable;
-{$else NEWMAP}
-              current_module.map^[nextmapentry]:=loaded_unit;
-{$endif NEWMAP}
-              inc(nextmapentry);
-              if nextmapentry>maxunits then
-               Message(unit_f_too_much_units);
-            end;
-           pu:=tused_unit(pu.next);
-         end;
-      { ok, now load the unit }
-        current_module.globalsymtable:=tglobalsymtable.create(current_module.modulename^);
-        tglobalsymtable(current_module.globalsymtable).load;
-      { now only read the implementation part }
-        current_module.in_implementation:=true;
-      { load the used units from implementation }
-        pu:=tused_unit(current_module.used_units.first);
-        while assigned(pu) do
-         begin
-           if (not pu.loaded) and (not pu.in_interface) then
-            begin
-              loaded_unit:=loadunit(pu.name^,false);
-              if current_module.compiled then
-               exit;
-            { register unit in used units }
-              pu.u:=loaded_unit;
-              pu.loaded:=true;
-            { need to recompile the current unit ? }
-              if (loaded_unit.interface_crc<>pu.interface_checksum) {and
-                 not(current_module.in_second_compile) } then
-                begin
-                  Message2(unit_u_recompile_crc_change,current_module.modulename^,pu.name^+' {impl}');
-                  current_module.recompile_reason:=rr_crcchanged;
-                  current_module.do_compile:=true;
-                  dispose(current_module.map);
-                  current_module.map:=nil;
-                  exit;
-                end;
-            { setup the map entry for deref }
-{$ifndef NEWMAP}
-              current_module.map^[nextmapentry]:=loaded_unit.globalsymtable;
-{$else NEWMAP}
-              current_module.map^[nextmapentry]:=loaded_unit;
-{$endif NEWMAP}
-              inc(nextmapentry);
-              if nextmapentry>maxunits then
-               Message(unit_f_too_much_units);
-            end;
-           pu:=tused_unit(pu.next);
-         end;
-        { load browser info if stored }
-        if ((current_module.flags and uf_has_browser)<>0) and load_refs then
-          tglobalsymtable(current_module.globalsymtable).load_symtable_refs;
-        { remove the map, it's not needed anymore }
-        dispose(current_module.map);
-        current_module.map:=nil;
-      end;
-
-
-    function loadunit(const s : string;compile_system:boolean) : tmodule;
-      const
-        ImplIntf : array[boolean] of string[15]=('interface','implementation');
-      var
-        st : tglobalsymtable;
-        second_time : boolean;
-        old_current_ppu : pppufile;
-        old_current_module,hp,hp2 : tmodule;
-        name : string;{ necessary because current_module.mainsource^ is reset in compile !! }
-        scanner : tscannerfile;
-
-        procedure loadppufile;
-        begin
-        { load interface section }
-          if not current_module.do_compile then
-           load_interface;
-        { only load units when we don't recompile }
-          if not current_module.do_compile then
-           load_usedunits(compile_system);
-        { recompile if set }
-          if current_module.do_compile then
-           begin
-           { we don't need the ppufile anymore }
-             if assigned(current_module.ppufile) then
-              begin
-                dispose(current_module.ppufile,done);
-                current_module.ppufile:=nil;
-                current_ppu:=nil;
-              end;
-           { recompile the unit or give a fatal error if sources not available }
-             if not(current_module.sources_avail) and
-                not(current_module.sources_checked) then
-               if (not current_module.search_unit(current_module.modulename^,true))
-                  and (length(current_module.modulename^)>8) then
-                 current_module.search_unit(copy(current_module.modulename^,1,8),true);
-             if not(current_module.sources_avail) then
-               begin
-                  hp:=current_module;
-                  current_module:=old_current_module;
-                  if hp.recompile_reason=rr_noppu then
-                    Message1(unit_f_cant_find_ppu,hp.modulename^)
-                  else
-                    Message1(unit_f_cant_compile_unit,hp.modulename^);
-                  current_module:=hp;
-               end
-             else
-              begin
-                if current_module.in_compile then
-                  begin
-                    current_module.in_second_compile:=true;
-                    Message1(parser_d_compiling_second_time,current_module.modulename^);
-                  end;
-                current_scanner.tempcloseinputfile;
-                name:=current_module.mainsource^;
-                if assigned(scanner) then
-                  scanner.invalid:=true;
-                compile(name,compile_system);
-                current_module.in_second_compile:=false;
-                if (not current_scanner.invalid) then
-                  current_scanner.tempopeninputfile;
-              end;
-           end;
-         if assigned(current_module.ppufile) then
-           begin
-              dispose(current_module.ppufile,done);
-              current_module.ppufile:=nil;
-              current_ppu:=nil;
-           end;
-        end;
-
-      var
-         dummy : tmodule;
-
-      begin
-         old_current_module:=current_module;
-         old_current_ppu:=current_ppu;
-         { Info }
-         Message3(unit_u_load_unit,current_module.modulename^,ImplIntf[current_module.in_implementation],s);
-         { unit not found }
-         st:=nil;
-         dummy:=nil;
-         { search all loaded units }
-         hp:=tmodule(loaded_units.first);
-         while assigned(hp) do
-           begin
-              if hp.modulename^=s then
-                begin
-                   { forced to reload ? }
-                   if hp.do_reload then
-                    begin
-                      hp.do_reload:=false;
-                      break;
-                    end;
-                   { the unit is already registered   }
-                   { and this means that the unit     }
-                   { is already compiled              }
-                   { else there is a cyclic unit use  }
-                   if assigned(hp.globalsymtable) then
-                     st:=tglobalsymtable(hp.globalsymtable)
-                   else
-                    begin
-                    { both units in interface ? }
-                      if (not current_module.in_implementation) and (not hp.in_implementation) then
-                       begin
-                       { check for a cycle }
-                         hp2:=current_module.loaded_from;
-                         while assigned(hp2) and (hp2<>hp) do
-                          begin
-                            if hp2.in_implementation then
-                             hp2:=nil
-                            else
-                             hp2:=hp2.loaded_from;
-                          end;
-                         if assigned(hp2) then
-                          Message2(unit_f_circular_unit_reference,current_module.modulename^,hp.modulename^);
-                       end;
-                    end;
-                   break;
-                end
-              else if copy(hp.modulename^,1,8)=s then
-                dummy:=hp;
-              { the next unit }
-              hp:=tmodule(hp.next);
-           end;
-         if assigned(dummy) and not assigned(hp) then
-           Message2(unit_w_unit_name_error,s,dummy.modulename^);
-       { the unit is not in the symtable stack }
-         if (not assigned(st)) then
-          begin
-            if assigned(hp) then
-             begin
-               { remove the old unit }
-               loaded_units.remove(hp);
-               scanner:=tscannerfile(hp.scanner);
-               hp.reset;
-               hp.scanner:=scanner;
-               { try to reopen ppu }
-               hp.search_unit(s,false);
-               { try to load the unit a second time first }
-               current_module:=hp;
-               current_module.in_second_load:=true;
-               Message1(unit_u_second_load_unit,current_module.modulename^);
-               second_time:=true;
-             end
-            else
-          { generates a new unit info record }
-             begin
-                current_module:=tmodule.create(s,true);
-                scanner:=nil;
-                second_time:=false;
-             end;
-            current_ppu:=current_module.ppufile;
-            { close old_current_ppu on system that are
-              short on file handles like DOS PM }
-{$ifdef SHORT_ON_FILE_HANDLES}
-            if assigned(old_current_ppu) then
-              old_current_ppu^.tempclose;
-{$endif SHORT_ON_FILE_HANDLES}
-          { now we can register the unit }
-            current_module.loaded_from:=old_current_module;
-            loaded_units.insert(current_module);
-          { now realy load the ppu }
-            loadppufile;
-          { set compiled flag }
-            current_module.compiled:=true;
-          { load return pointer }
-            hp:=current_module;
-          { for a second_time recompile reload all dependent units,
-            for a first time compile register the unit _once_ }
-            if second_time then
-             begin
-               { now reload all dependent units }
-               hp2:=tmodule(loaded_units.first);
-               while assigned(hp2) do
-                begin
-                  if hp2.do_reload then
-                   dummy:=loadunit(hp2.modulename^,false);
-                  hp2:=tmodule(hp2.next);
-                end;
-             end
-            else
-             usedunits.concat(tused_unit.create(current_module,true));
-          end;
-         { set the old module }
-{$ifdef SHORT_ON_FILE_HANDLES}
-         if assigned(old_current_ppu) then
-           old_current_ppu^.tempopen;
-{$endif SHORT_ON_FILE_HANDLES}
-         current_ppu:=old_current_ppu;
-         current_module:=old_current_module;
-         { we are back }
-         SetCompileModule(current_module);
-         loadunit:=hp;
-      end;
-
-
     procedure loaddefaultunits;
       var
         hp : tmodule;
@@ -654,7 +345,7 @@ implementation
            exit;
          end;
      { insert the system unit, it is allways the first }
-        hp:=loadunit('SYSTEM',true);
+        hp:=loadunit('System');
         systemunit:=tglobalsymtable(hp.globalsymtable);
         { it's always the first unit }
         systemunit.next:=nil;
@@ -671,7 +362,7 @@ implementation
       { Objpas unit? }
         if m_objpas in aktmodeswitches then
          begin
-           hp:=loadunit('ObjPas',false);
+           hp:=loadunit('ObjPas');
            tsymtable(hp.globalsymtable).next:=symtablestack;
            symtablestack:=hp.globalsymtable;
            { add to the used units }
@@ -683,7 +374,7 @@ implementation
       { Profile unit? Needed for go32v2 only }
         if (cs_profile in aktmoduleswitches) and (target_info.target=target_i386_go32v2) then
          begin
-           hp:=loadunit('Profile',false);
+           hp:=loadunit('Profile');
            tsymtable(hp.globalsymtable).next:=symtablestack;
            symtablestack:=hp.globalsymtable;
            { add to the used units }
@@ -698,7 +389,7 @@ implementation
            { Heaptrc unit }
            if (cs_gdb_heaptrc in aktglobalswitches) then
             begin
-              hp:=loadunit('HeapTrc',false);
+              hp:=loadunit('HeapTrc');
               tsymtable(hp.globalsymtable).next:=symtablestack;
               symtablestack:=hp.globalsymtable;
               { add to the used units }
@@ -710,7 +401,7 @@ implementation
            { Lineinfo unit }
            if (cs_gdb_lineinfo in aktglobalswitches) then
             begin
-              hp:=loadunit('LineInfo',false);
+              hp:=loadunit('LineInfo');
               tsymtable(hp.globalsymtable).next:=symtablestack;
               symtablestack:=hp.globalsymtable;
               { add to the used units }
@@ -759,7 +450,7 @@ implementation
            if not assigned(pu) and (s<>current_module.modulename^) then
             begin
             { load the unit }
-              hp2:=loadunit(s,false);
+              hp2:=loadunit(sorg);
             { the current module uses the unit hp2 }
               current_module.used_units.concat(tused_unit.create(hp2,not current_module.in_implementation));
               tused_unit(current_module.used_units.last).in_uses:=true;
@@ -1000,23 +691,13 @@ implementation
           { check for system unit }
              new(s2);
              s2^:=upper(SplitName(main_file.name^));
-             if (cs_compilesystem in aktmoduleswitches) then
-              begin
-                if ((length(current_module.modulename^)>8) or
-                   (current_module.modulename^<>'SYSTEM') or
-                   (current_module.modulename^<>s2^)) then
-                  Message1(unit_e_illegal_unit_name,current_module.realmodulename^);
-              end
-             else
-              begin
-                if (cs_check_unit_name in aktglobalswitches) and
-                   not((current_module.modulename^=s2^) or
-                       ((length(current_module.modulename^)>8) and
-                        (copy(current_module.modulename^,1,8)=s2^))) then
-                 Message1(unit_e_illegal_unit_name,current_module.realmodulename^);
-                if (current_module.modulename^='SYSTEM') then
-                 Message(unit_w_switch_us_missed);
-              end;
+             if (cs_check_unit_name in aktglobalswitches) and
+                not((current_module.modulename^=s2^) or
+                    ((length(current_module.modulename^)>8) and
+                     (copy(current_module.modulename^,1,8)=s2^))) then
+              Message1(unit_e_illegal_unit_name,current_module.realmodulename^);
+             if (current_module.modulename^='SYSTEM') then
+              include(aktmoduleswitches,cs_compilesystem);
              dispose(s2);
           end;
 
@@ -1036,7 +717,7 @@ implementation
 
          { maybe turn off m_objpas if we are compiling objpas }
          if (current_module.modulename^='OBJPAS') then
-           aktmodeswitches:=aktmodeswitches-[m_objpas];
+           exclude(aktmodeswitches,m_objpas);
 
          { this should be placed after uses !!}
 {$ifndef UseNiceNames}
@@ -1106,7 +787,7 @@ implementation
 
          { number all units, so we know if a unit is used by this unit or
            needs to be added implicitly }
-         numberunits;
+         current_module.numberunits;
 
          { ... parse the declarations }
          Message1(parser_u_parsing_interface,current_module.realmodulename^);
@@ -1128,7 +809,7 @@ implementation
 
          if not(cs_compilesystem in aktmoduleswitches) then
            if (Errorcount=0) then
-             writeunitas(current_module.ppufilename^,tglobalsymtable(symtablestack),true);
+             tppumodule(current_module).getppucrc;
 
          { Parse the implementation section }
          consume(_IMPLEMENTATION);
@@ -1161,7 +842,7 @@ implementation
          reset_global_defs;
 
          { All units are read, now give them a number }
-         numberunits;
+         current_module.numberunits;
 
          { now we can change refsymtable }
          refsymtable:=st;
@@ -1307,7 +988,6 @@ implementation
           begin
             Message1(unit_f_errors_in_unit,tostr(Errorcount));
             status.skip_error:=true;
-            closecurrentppu;
             exit;
           end;
 
@@ -1346,7 +1026,7 @@ implementation
          store_interface_crc:=current_module.interface_crc;
          store_crc:=current_module.crc;
          if (Errorcount=0) then
-           writeunitas(current_module.ppufilename^,tglobalsymtable(symtablestack),false);
+           tppumodule(current_module).writeppu;
 
          if not(cs_compilesystem in aktmoduleswitches) then
            if store_interface_crc<>current_module.interface_crc then
@@ -1359,9 +1039,6 @@ implementation
                tostr(store_crc)+'<>'+tostr(current_module.interface_crc));
 {$endif EXTDEBUG}
 
-         { must be done only after local symtable ref stores !! }
-         closecurrentppu;
-
          { remove static symtable (=refsymtable) here to save some mem }
          if not (cs_local_browser in aktmoduleswitches) then
            begin
@@ -1397,13 +1074,13 @@ implementation
             (target_info.target=target_i386_win32) and
             (target_info.assem<>as_i386_pecoff) then
            begin
-              aktglobalswitches:=aktglobalswitches+[cs_link_strip];
+              include(aktglobalswitches,cs_link_strip);
               { Warning stabs info does not work with reloc section !! }
               if cs_debuginfo in aktmoduleswitches then
                 begin
                   Message1(parser_w_parser_reloc_no_debug,current_module.mainsource^);
                   Message(parser_w_parser_win32_debug_needs_WN);
-                  aktmoduleswitches:=aktmoduleswitches-[cs_debuginfo];
+                  exclude(aktmoduleswitches,cs_debuginfo);
                 end;
            end;
 
@@ -1478,7 +1155,7 @@ implementation
          reset_global_defs;
 
          { All units are read, now give them a number }
-         numberunits;
+         current_module.numberunits;
 
          {Insert the name of the main program into the symbol table.}
          if current_module.realmodulename^<>'' then
@@ -1623,7 +1300,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.29  2001-04-18 22:01:57  peter
+  Revision 1.30  2001-05-06 14:49:17  peter
+    * ppu object to class rewrite
+    * move ppu read and write stuff to fppu
+
+  Revision 1.29  2001/04/18 22:01:57  peter
     * registration of targets and assemblers
 
   Revision 1.28  2001/04/13 18:08:37  peter

compiler/ppu.pas

@@ -41,11 +41,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-{$ifdef newcg}
-  CurrentPPUVersion=102;
-{$else newcg}
   CurrentPPUVersion=22;
-{$endif newcg}
 
 { buffer sizes }
   maxentrysize = 1024;
@@ -129,13 +125,10 @@ const
   uf_no_link       = $400; { unit has no .o generated, but can still have
                              external linking! }
   uf_has_resources = $800; { unit has resource section }
+  uf_little_endian = $1000;
 
 type
-{$ifdef m68k}
-  ppureal=single;
-{$else}
   ppureal=extended;
-{$endif}
 
   tppuerror=(ppuentrytoobig,ppuentryerror);
 
@@ -147,8 +140,8 @@ type
     target   : word;
     flags    : longint;
     size     : longint; { size of the ppufile without header }
-    checksum : longint; { checksum for this ppufile }
-    interface_checksum : longint;
+    checksum : cardinal; { checksum for this ppufile }
+    interface_checksum : cardinal;
     future   : array[0..2] of longint;
   end;
 
@@ -158,59 +151,59 @@ type
     size : longint;
   end;
 
-  pppufile=^tppufile;
-  tppufile=object
+  tppufile=class
+  private
     f        : file;
     mode     : byte; {0 - Closed, 1 - Reading, 2 - Writing}
-    error    : boolean;
     fname    : string;
-    fsize    : longint;
-
-    header   : tppuheader;
-    size,crc : longint;
+    fsize    : integer;
 {$ifdef Test_Double_checksum}
-    crcindex : longint;
-    crc_index : longint;
-    crcindex2 : longint;
-    crc_index2 : longint;
-    crc_test,crc_test2 : pcrc_array;
-
+    crcindex,
+    crc_index,
+    crcindex2,
+    crc_index2 : cardinal;
+    crc_test,
+    crc_test2  : pcrc_array;
 {$endif def Test_Double_checksum}
-    interface_crc : longint;
-    do_interface_crc : boolean;
-    crc_only : boolean;    { used to calculate interface_crc before implementation }
-    do_crc,
     change_endian : boolean;
-
     buf      : pchar;
     bufstart,
     bufsize,
-    bufidx   : longint;
+    bufidx   : integer;
     entrybufstart,
     entrystart,
-    entryidx : longint;
+    entryidx : integer;
     entry    : tppuentry;
-    entrytyp : byte;
     closed,
     tempclosed : boolean;
-    closepos : longint;
-    constructor init(fn:string);
-    destructor  done;
+    closepos : integer;
+  public
+    entrytyp : byte;
+    header           : tppuheader;
+    size             : integer;
+    crc,
+    interface_crc    : cardinal;
+    error,
+    do_crc,
+    do_interface_crc : boolean;
+    crc_only         : boolean;    { used to calculate interface_crc before implementation }
+    constructor Create(const fn:string);
+    destructor  Destroy;override;
     procedure flush;
-    procedure close;
+    procedure closefile;
     function  CheckPPUId:boolean;
-    function  GetPPUVersion:longint;
+    function  GetPPUVersion:integer;
     procedure NewHeader;
     procedure NewEntry;
   {read}
-    function  open:boolean;
+    function  openfile:boolean;
     procedure reloadbuf;
-    procedure readdata(var b;len:longint);
-    procedure skipdata(len:longint);
+    procedure readdata(var b;len:integer);
+    procedure skipdata(len:integer);
     function  readentry:byte;
     function  EndOfEntry:boolean;
-    procedure getdatabuf(var b;len:longint;var result:longint);
-    procedure getdata(var b;len:longint);
+    procedure getdatabuf(var b;len:integer;var res:integer);
+    procedure getdata(var b;len:integer);
     function  getbyte:byte;
     function  getword:word;
     function  getlongint:longint;
@@ -220,19 +213,19 @@ type
     procedure getsmallset(var b);
     function  skipuntilentry(untilb:byte):boolean;
   {write}
-    function  create:boolean;
+    function  createfile:boolean;
     procedure writeheader;
     procedure writebuf;
-    procedure writedata(var b;len:longint);
+    procedure writedata(const b;len:integer);
     procedure writeentry(ibnr:byte);
-    procedure putdata(var b;len:longint);
+    procedure putdata(const b;len:integer);
     procedure putbyte(b:byte);
     procedure putword(w:word);
     procedure putlongint(l:longint);
     procedure putreal(d:ppureal);
     procedure putstring(s:string);
-    procedure putnormalset(var b);
-    procedure putsmallset(var b);
+    procedure putnormalset(const b);
+    procedure putsmallset(const b);
     procedure tempclose;
     function  tempopen:boolean;
   end;
@@ -245,11 +238,39 @@ implementation
 {$endif def Test_Double_checksum}
     crc;
 
+{*****************************************************************************
+                             Endian Handling
+*****************************************************************************}
+
+Function SwapLong(var x : longint): longint;
+var
+  y : word;
+  z : word;
+Begin
+  y := (x shr 16) and $FFFF;
+  y := (y shl 8) or ((y shr 8) and $ff);
+  z := x and $FFFF;
+  z := (z shl 8) or ((z shr 8) and $ff);
+  SwapLong := (longint(z) shl 16) or longint(y);
+End;
+
+
+Function SwapWord(var x : word): word;
+var
+  z : byte;
+Begin
+  z := (x shr 8) and $ff;
+  x := x and $ff;
+  x := (x shl 8);
+  SwapWord := x or z;
+End;
+
+
 {*****************************************************************************
                                   TPPUFile
 *****************************************************************************}
 
-constructor tppufile.init(fn:string);
+constructor tppufile.Create(const fn:string);
 begin
   fname:=fn;
   change_endian:=false;
@@ -263,9 +284,9 @@ begin
 end;
 
 
-destructor tppufile.done;
+destructor tppufile.destroy;
 begin
-  close;
+  closefile;
   if assigned(buf) then
     freemem(buf,ppubufsize);
 end;
@@ -278,8 +299,17 @@ begin
 end;
 
 
-procedure tppufile.close;
+procedure tppufile.closefile;
 begin
+{$ifdef Test_Double_checksum}
+  if mode=2 then
+   begin
+     if assigned(crc_test) then
+      dispose(crc_test);
+     if assigned(crc_test2) then
+      dispose(crc_test2);
+   end;
+{$endif Test_Double_checksum}
   if Mode<>0 then
    begin
      Flush;
@@ -299,9 +329,9 @@ begin
 end;
 
 
-function tppufile.GetPPUVersion:longint;
+function tppufile.GetPPUVersion:integer;
 var
-  l    : longint;
+  l    : integer;
   code : integer;
 begin
   Val(header.ver[1]+header.ver[2]+header.ver[3],l,code);
@@ -336,12 +366,12 @@ end;
                                 TPPUFile Reading
 *****************************************************************************}
 
-function tppufile.open:boolean;
+function tppufile.openfile:boolean;
 var
   ofmode : byte;
-  i      : longint;
+  i      : integer;
 begin
-  open:=false;
+  openfile:=false;
   assign(f,fname);
   ofmode:=filemode;
   filemode:=$0;
@@ -357,6 +387,34 @@ begin
   if fsize<sizeof(tppuheader) then
    exit;
   blockread(f,header,sizeof(tppuheader),i);
+  { The header is always stored in little endian order }
+  { therefore swap if on a big endian machine          }
+{$IFDEF SOURCE_BIG_ENDIAN}
+  header.compiler := SwapWord(header.compiler);
+  header.cpu := SwapWord(header.cpu);
+  header.target := SwapWord(header.target);
+  header.flags := SwapLong(header.flags);
+  header.size := SwapLong(header.size);
+  header.checksum := SwapLong(header.checksum);
+  header.interface_checksum := SwapLong(header.interface_checksum);
+{$ENDIF}
+  { the PPU DATA is stored in native order }
+  if (header.flags and uf_big_endian) = uf_big_endian then
+   Begin
+{$IFDEF SOURCE_LITTLE_ENDIAN}
+     change_endian := TRUE;
+{$ELSE}
+     change_endian := FALSE;
+{$ENDIF}
+   End
+  else if (header.flags and uf_little_endian) = uf_little_endian then
+   Begin
+{$IFDEF SOURCE_BIG_ENDIAN}
+     change_endian := TRUE;
+{$ELSE}
+     change_endian := FALSE;
+{$ENDIF}
+   End;
 {reset buffer}
   bufstart:=i;
   bufsize:=0;
@@ -367,7 +425,7 @@ begin
   entrystart:=0;
   entrybufstart:=0;
   Error:=false;
-  open:=true;
+  openfile:=true;
 end;
 
 
@@ -379,11 +437,11 @@ begin
 end;
 
 
-procedure tppufile.readdata(var b;len:longint);
+procedure tppufile.readdata(var b;len:integer);
 var
   p   : pchar;
   left,
-  idx : longint;
+  idx : integer;
 begin
   p:=pchar(@b);
   idx:=0;
@@ -409,9 +467,9 @@ begin
 end;
 
 
-procedure tppufile.skipdata(len:longint);
+procedure tppufile.skipdata(len:integer);
 var
-  left : longint;
+  left : integer;
 begin
   while len>0 do
    begin
@@ -455,18 +513,18 @@ begin
 end;
 
 
-procedure tppufile.getdatabuf(var b;len:longint;var result:longint);
+procedure tppufile.getdatabuf(var b;len:integer;var res:integer);
 begin
   if entryidx+len>entry.size then
-   result:=entry.size-entryidx
+   res:=entry.size-entryidx
   else
-   result:=len;
-  readdata(b,result);
-  inc(entryidx,result);
+   res:=len;
+  readdata(b,res);
+  inc(entryidx,res);
 end;
 
 
-procedure tppufile.getdata(var b;len:longint);
+procedure tppufile.getdata(var b;len:integer);
 begin
   if entryidx+len>entry.size then
    begin
@@ -508,7 +566,7 @@ begin
    end;
   readdata(w,2);
   if change_endian then
-   getword:=swap(w)
+   getword:=swapword(w)
   else
    getword:=w;
   inc(entryidx,2);
@@ -529,9 +587,7 @@ begin
    end;
   readdata(l,4);
   if change_endian then
-  { someone added swap(l : longint) in system unit
-   this broke the following code !! }
-   getlongint:=swap(word(l shr 16)) or (longint(swap(word(l and $ffff))) shl 16)
+   getlongint:=swaplong(l)
   else
    getlongint:=l;
   inc(entryidx,4);
@@ -599,9 +655,9 @@ end;
                                 TPPUFile Writing
 *****************************************************************************}
 
-function tppufile.create:boolean;
+function tppufile.createfile:boolean;
 begin
-  create:=false;
+  createfile:=false;
 {$ifdef INTFPPU}
   if crc_only then
    begin
@@ -625,8 +681,8 @@ begin
   bufstart:=sizeof(tppuheader);
   bufidx:=0;
 {reset}
-  crc:=longint($ffffffff);
-  interface_crc:=longint($ffffffff);
+  crc:=cardinal($ffffffff);
+  interface_crc:=cardinal($ffffffff);
   do_interface_crc:=true;
   Error:=false;
   do_crc:=true;
@@ -634,18 +690,35 @@ begin
   entrytyp:=mainentryid;
 {start}
   NewEntry;
-  create:=true;
+  createfile:=true;
 end;
 
 
 procedure tppufile.writeheader;
 var
-  opos : longint;
+  opos : integer;
 begin
-{ flush buffer }
+  { flush buffer }
   writebuf;
-{ update size (w/o header!) in the header }
+  { update size (w/o header!) in the header }
   header.size:=bufstart-sizeof(tppuheader);
+  { set the endian flag }
+{$IFDEF SOURCE_BIG_ENDIAN}
+  header.flags := header.flags or uf_big_endian;
+{$ENDIF}
+{$IFDEF SOURCE_LITTLE_ENDIAN}
+  header.flags := header.flags or uf_little_endian;
+{$ENDIF}
+  { Now swap the header in the correct endian (always little endian) }
+{$IFDEF SOURCE_BIG_ENDIAN}
+  header.compiler := SwapWord(header.compiler);
+  header.cpu := SwapWord(header.cpu);
+  header.target := SwapWord(header.target);
+  header.flags := SwapLong(header.flags);
+  header.size := SwapLong(header.size);
+  header.checksum := SwapLong(header.checksum);
+  header.interface_checksum := SwapLong(header.interface_checksum);
+{$ENDIF}
 { write header and restore filepos after it }
   opos:=filepos(f);
   seek(f,0);
@@ -663,11 +736,11 @@ begin
 end;
 
 
-procedure tppufile.writedata(var b;len:longint);
+procedure tppufile.writedata(const b;len:integer);
 var
   p   : pchar;
   left,
-  idx : longint;
+  idx : integer;
 begin
   if crc_only then
     exit;
@@ -713,7 +786,7 @@ end;
 
 procedure tppufile.writeentry(ibnr:byte);
 var
-  opos : longint;
+  opos : integer;
 begin
 {create entry}
   entry.id:=entrytyp;
@@ -742,7 +815,7 @@ begin
 end;
 
 
-procedure tppufile.putdata(var b;len:longint);
+procedure tppufile.putdata(const b;len:integer);
 begin
   if do_crc then
    begin
@@ -803,24 +876,17 @@ end;
 procedure tppufile.putbyte(b:byte);
 begin
   putdata(b,1);
-{  inc(entryidx);}
 end;
 
 
 procedure tppufile.putword(w:word);
 begin
-  if change_endian then
-   w:=swap(w);
   putdata(w,2);
 end;
 
 
 procedure tppufile.putlongint(l:longint);
 begin
-  if change_endian then
-  { someone added swap(l : longint) in system unit
-   this broke the following code !! }
-   l:=swap(word(l shr 16)) or (longint(swap(word(l and $ffff))) shl 16);
   putdata(l,4);
 end;
 
@@ -837,13 +903,13 @@ begin
 end;
 
 
-procedure tppufile.putsmallset(var b);
+procedure tppufile.putsmallset(const b);
 begin
   putdata(b,4);
 end;
 
 
-procedure tppufile.putnormalset(var b);
+procedure tppufile.putnormalset(const b);
 begin
   putdata(b,32);
 end;
@@ -853,7 +919,7 @@ end;
       begin
         if not closed then
          begin
-            closepos:=filepos(f);
+           closepos:=filepos(f);
            {$I-}
             system.close(f);
            {$I+}
@@ -890,7 +956,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.7  2001-03-22 00:10:58  florian
+  Revision 1.8  2001-05-06 14:49:17  peter
+    * ppu object to class rewrite
+    * move ppu read and write stuff to fppu
+
+  Revision 1.7  2001/03/22 00:10:58  florian
     + basic variant type support in the compiler
 
   Revision 1.6  2000/12/07 17:19:43  jonas

compiler/symppu.pas

@@ -20,39 +20,30 @@
  ****************************************************************************
 }
 unit symppu;
+
+{$i defines.inc}
+
 interface
 
     uses
        globtype,globals,
-       symbase,
+       symbase,symtype,
        ppu;
 
-    var
-       current_ppu       : pppufile;    { Current ppufile which is read }
-
-    procedure writebyte(b:byte);
-    procedure writeword(w:word);
-    procedure writelong(l:longint);
-    procedure writereal(d:bestreal);
-    procedure writestring(const s:string);
-    procedure writenormalset(var s); {You cannot pass an array[0..31] of byte!}
-    procedure writesmallset(var s);
-    procedure writeguid(var g: tguid);
-    procedure writeposinfo(const p:tfileposinfo);
-    procedure writederef(p : tsymtableentry);
-
-    function readbyte:byte;
-    function readword:word;
-    function readlong:longint;
-    function readreal : bestreal;
-    function readstring : string;
-    procedure readnormalset(var s);   {You cannot pass an array [0..31] of byte.}
-    procedure readsmallset(var s);
-    procedure readguid(var g: tguid);
-    procedure readposinfo(var p:tfileposinfo);
-    function readderef : tsymtableentry;
-
-    procedure closecurrentppu;
+    type
+       tcompilerppufile=class(tppufile)
+         procedure checkerror;
+         procedure getguid(var g: tguid);
+         procedure getposinfo(var p:tfileposinfo);
+         function  getderef : tsymtableentry;
+         function  getsymlist:tsymlist;
+         procedure gettype(var t:ttype);
+         procedure putguid(const g: tguid);
+         procedure putposinfo(const p:tfileposinfo);
+         procedure putderef(p : tsymtableentry);
+         procedure putsymlist(p:tsymlist);
+         procedure puttype(const t:ttype);
+       end;
 
 
 implementation
@@ -62,99 +53,138 @@ implementation
        verbose;
 
 {*****************************************************************************
-                                 PPU Writing
+                            TCompilerPPUFile
 *****************************************************************************}
 
-    procedure writebyte(b:byte);
-      begin
-        current_ppu^.putbyte(b);
-      end;
-
-
-    procedure writeword(w:word);
+    procedure tcompilerppufile.checkerror;
       begin
-        current_ppu^.putword(w);
+        if error then
+         Message(unit_f_ppu_read_error);
       end;
 
 
-    procedure writelong(l:longint);
+    procedure tcompilerppufile.getguid(var g: tguid);
       begin
-        current_ppu^.putlongint(l);
+        getdata(g,sizeof(g));
       end;
 
 
-    procedure writereal(d:bestreal);
+    procedure tcompilerppufile.getposinfo(var p:tfileposinfo);
       begin
-        current_ppu^.putreal(d);
+        p.fileindex:=getword;
+        p.line:=getlongint;
+        p.column:=getword;
       end;
 
 
-    procedure writestring(const s:string);
+    function tcompilerppufile.getderef : tsymtableentry;
+      var
+        hp,p : tderef;
+        b : tdereftype;
       begin
-        current_ppu^.putstring(s);
+        p:=nil;
+        repeat
+          hp:=p;
+          b:=tdereftype(getbyte);
+          case b of
+            derefnil :
+              break;
+            derefunit,
+            derefaktrecordindex,
+            derefaktlocal,
+            derefaktstaticindex :
+              begin
+                p:=tderef.create(b,getword);
+                p.next:=hp;
+                break;
+              end;
+            derefindex,
+            dereflocal,
+            derefpara,
+            derefrecord :
+              begin
+                p:=tderef.create(b,getword);
+                p.next:=hp;
+              end;
+          end;
+        until false;
+        getderef:=tsymtableentry(p);
       end;
 
 
-    procedure writenormalset(var s); {You cannot pass an array[0..31] of byte!}
+    function tcompilerppufile.getsymlist:tsymlist;
+      var
+        sym : tsym;
+        p   : tsymlist;
       begin
-        current_ppu^.putdata(s,sizeof(tnormalset));
+        p:=tsymlist.create;
+        p.def:=tdef(getderef);
+        repeat
+          sym:=tsym(getderef);
+          if sym=nil then
+           break;
+          p.addsym(sym);
+        until false;
+        getsymlist:=tsymlist(p);
       end;
 
 
-    procedure writesmallset(var s);
+    procedure tcompilerppufile.gettype(var t:ttype);
       begin
-        current_ppu^.putdata(s,4);
+        t.def:=tdef(getderef);
+        t.sym:=tsym(getderef);
       end;
 
 
-    { posinfo is not relevant for changes in PPU }
-    procedure writeposinfo(const p:tfileposinfo);
+    procedure tcompilerppufile.putposinfo(const p:tfileposinfo);
       var
         oldcrc : boolean;
       begin
-        oldcrc:=current_ppu^.do_crc;
-        current_ppu^.do_crc:=false;
-        current_ppu^.putword(p.fileindex);
-        current_ppu^.putlongint(p.line);
-        current_ppu^.putword(p.column);
-        current_ppu^.do_crc:=oldcrc;
+        { posinfo is not relevant for changes in PPU }
+        oldcrc:=do_crc;
+        do_crc:=false;
+        putword(p.fileindex);
+        putlongint(p.line);
+        putword(p.column);
+        do_crc:=oldcrc;
       end;
 
 
-    procedure writeguid(var g: tguid);
+    procedure tcompilerppufile.putguid(const g: tguid);
       begin
-        current_ppu^.putdata(g,sizeof(g));
+        putdata(g,sizeof(g));
       end;
 
-    procedure writederef(p : tsymtableentry);
+
+    procedure tcompilerppufile.putderef(p : tsymtableentry);
       begin
         if p=nil then
-         current_ppu^.putbyte(ord(derefnil))
+         putbyte(ord(derefnil))
         else
          begin
            { Static symtable ? }
            if p.owner.symtabletype=staticsymtable then
             begin
-              current_ppu^.putbyte(ord(derefaktstaticindex));
-              current_ppu^.putword(p.indexnr);
+              putbyte(ord(derefaktstaticindex));
+              putword(p.indexnr);
             end
            { Local record/object symtable ? }
            else if (p.owner=aktrecordsymtable) then
             begin
-              current_ppu^.putbyte(ord(derefaktrecordindex));
-              current_ppu^.putword(p.indexnr);
+              putbyte(ord(derefaktrecordindex));
+              putword(p.indexnr);
             end
            { Local local/para symtable ? }
            else if (p.owner=aktlocalsymtable) then
             begin
-              current_ppu^.putbyte(ord(derefaktlocal));
-              current_ppu^.putword(p.indexnr);
+              putbyte(ord(derefaktlocal));
+              putword(p.indexnr);
             end
            else
             begin
-              current_ppu^.putbyte(ord(derefindex));
-              current_ppu^.putword(p.indexnr);
-           { Current unit symtable ? }
+              putbyte(ord(derefindex));
+              putword(p.indexnr);
+              { Current unit symtable ? }
               repeat
                 if not assigned(p) then
                  internalerror(556655);
@@ -168,34 +198,34 @@ implementation
                         clause, else it's an error }
                       if p.owner.unitid=$ffff then
                        internalerror(55665566);
-                      current_ppu^.putbyte(ord(derefunit));
-                      current_ppu^.putword(p.owner.unitid);
+                      putbyte(ord(derefunit));
+                      putword(p.owner.unitid);
                       break;
                     end;
                   staticsymtable :
                     begin
-                      current_ppu^.putbyte(ord(derefaktstaticindex));
-                      current_ppu^.putword(p.indexnr);
+                      putbyte(ord(derefaktstaticindex));
+                      putword(p.indexnr);
                       break;
                     end;
                   localsymtable :
                     begin
                       p:=p.owner.defowner;
-                      current_ppu^.putbyte(ord(dereflocal));
-                      current_ppu^.putword(p.indexnr);
+                      putbyte(ord(dereflocal));
+                      putword(p.indexnr);
                     end;
                   parasymtable :
                     begin
                       p:=p.owner.defowner;
-                      current_ppu^.putbyte(ord(derefpara));
-                      current_ppu^.putword(p.indexnr);
+                      putbyte(ord(derefpara));
+                      putword(p.indexnr);
                     end;
                   objectsymtable,
                   recordsymtable :
                     begin
                       p:=p.owner.defowner;
-                      current_ppu^.putbyte(ord(derefrecord));
-                      current_ppu^.putword(p.indexnr);
+                      putbyte(ord(derefrecord));
+                      putword(p.indexnr);
                     end;
                   else
                     internalerror(556656);
@@ -205,134 +235,48 @@ implementation
          end;
       end;
 
-    procedure closecurrentppu;
-      begin
-{$ifdef Test_Double_checksum}
-         if assigned(current_ppu^.crc_test) then
-           dispose(current_ppu^.crc_test);
-         if assigned(current_ppu^.crc_test2) then
-           dispose(current_ppu^.crc_test2);
-{$endif Test_Double_checksum}
-       { close }
-         current_ppu^.close;
-         dispose(current_ppu,done);
-         current_ppu:=nil;
-      end;
-
-
-{*****************************************************************************
-                                 PPU Reading
-*****************************************************************************}
-
-    function readbyte:byte;
-      begin
-        readbyte:=current_ppu^.getbyte;
-        if current_ppu^.error then
-         Message(unit_f_ppu_read_error);
-      end;
-
-
-    function readword:word;
-      begin
-        readword:=current_ppu^.getword;
-        if current_ppu^.error then
-         Message(unit_f_ppu_read_error);
-      end;
-
-
-    function readlong:longint;
-      begin
-        readlong:=current_ppu^.getlongint;
-        if current_ppu^.error then
-         Message(unit_f_ppu_read_error);
-      end;
-
 
-    function readreal : bestreal;
-      begin
-        readreal:=current_ppu^.getreal;
-        if current_ppu^.error then
-         Message(unit_f_ppu_read_error);
-      end;
-
-
-    function readstring : string;
-      begin
-        readstring:=current_ppu^.getstring;
-        if current_ppu^.error then
-         Message(unit_f_ppu_read_error);
-      end;
-
-
-    procedure readnormalset(var s);   {You cannot pass an array [0..31] of byte.}
-      begin
-        current_ppu^.getdata(s,sizeof(tnormalset));
-        if current_ppu^.error then
-         Message(unit_f_ppu_read_error);
-      end;
-
-
-    procedure readsmallset(var s);
-      begin
-        current_ppu^.getdata(s,4);
-        if current_ppu^.error then
-         Message(unit_f_ppu_read_error);
-      end;
-
-
-    procedure readguid(var g: tguid);
-      begin
-        current_ppu^.getdata(g,sizeof(g));
-        if current_ppu^.error then
-         Message(unit_f_ppu_read_error);
-      end;
-
-    procedure readposinfo(var p:tfileposinfo);
+    procedure tcompilerppufile.putsymlist(p:tsymlist);
+      var
+        hp : psymlistitem;
       begin
-        p.fileindex:=current_ppu^.getword;
-        p.line:=current_ppu^.getlongint;
-        p.column:=current_ppu^.getword;
+        putderef(p.def);
+        hp:=p.firstsym;
+        while assigned(hp) do
+         begin
+           putderef(hp^.sym);
+           hp:=hp^.next;
+         end;
+        putderef(nil);
       end;
 
 
-    function readderef : tsymtableentry;
-      var
-        hp,p : tderef;
-        b : tdereftype;
+    procedure tcompilerppufile.puttype(const t:ttype);
       begin
-        p:=nil;
-        repeat
-          hp:=p;
-          b:=tdereftype(current_ppu^.getbyte);
-          case b of
-            derefnil :
-              break;
-            derefunit,
-            derefaktrecordindex,
-            derefaktlocal,
-            derefaktstaticindex :
-              begin
-                p:=tderef.create(b,current_ppu^.getword);
-                p.next:=hp;
-                break;
-              end;
-            derefindex,
-            dereflocal,
-            derefpara,
-            derefrecord :
-              begin
-                p:=tderef.create(b,current_ppu^.getword);
-                p.next:=hp;
-              end;
-          end;
-        until false;
-        readderef:=tsymtableentry(p);
+        { Don't write symbol references for the current unit
+          and for the system unit }
+        if assigned(t.sym) and
+           (t.sym.owner.unitid<>0) and
+           (t.sym.owner.unitid<>1) then
+         begin
+           putderef(nil);
+           putderef(t.sym);
+         end
+        else
+         begin
+           putderef(t.def);
+           putderef(nil);
+         end;
       end;
 
 end.
 {
   $Log$
-  Revision 1.5  2001-04-13 01:22:16  peter
+  Revision 1.6  2001-05-06 14:49:17  peter
+    * ppu object to class rewrite
+    * move ppu read and write stuff to fppu
+
+  Revision 1.5  2001/04/13 01:22:16  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/symtype.pas

@@ -104,8 +104,6 @@ interface
         procedure reset;
         procedure setdef(p:tdef);
         procedure setsym(p:tsym);
-        procedure load;
-        procedure write;
         procedure resolve;
       end;
 
@@ -124,7 +122,6 @@ interface
         firstsym,
         lastsym  : psymlistitem;
         constructor create;
-        constructor load;
         destructor  destroy;override;
         function  empty:boolean;
         procedure setdef(p:tdef);
@@ -132,7 +129,6 @@ interface
         procedure clear;
         function  getcopy:tsymlist;
         procedure resolve;
-        procedure write;
       end;
 
 
@@ -145,7 +141,6 @@ implementation
 
     uses
        verbose,
-       symppu,
        fmodule;
 
 {****************************************************************************
@@ -300,32 +295,6 @@ implementation
       end;
 
 
-    procedure ttype.load;
-      begin
-        def:=tdef(readderef);
-        sym:=tsym(readderef);
-      end;
-
-
-    procedure ttype.write;
-      begin
-        { Don't write symbol references for the current unit
-          and for the system unit }
-        if assigned(sym) and
-           (sym.owner.unitid<>0) and
-           (sym.owner.unitid<>1) then
-         begin
-           writederef(nil);
-           writederef(sym);
-         end
-        else
-         begin
-           writederef(def);
-           writederef(nil);
-         end;
-      end;
-
-
     procedure ttype.resolve;
       begin
         if assigned(sym) then
@@ -349,22 +318,6 @@ implementation
       end;
 
 
-    constructor tsymlist.load;
-      var
-        sym : tsym;
-      begin
-        def:=tdef(readderef);
-        firstsym:=nil;
-        lastsym:=nil;
-        repeat
-          sym:=tsym(readderef);
-          if sym=nil then
-           break;
-          addsym(sym);
-        until false;
-      end;
-
-
     destructor tsymlist.destroy;
       begin
         clear;
@@ -433,21 +386,6 @@ implementation
       end;
 
 
-    procedure tsymlist.write;
-      var
-        hp : psymlistitem;
-      begin
-        writederef(def);
-        hp:=firstsym;
-        while assigned(hp) do
-         begin
-           writederef(hp^.sym);
-           hp:=hp^.next;
-         end;
-        writederef(nil);
-      end;
-
-
     procedure tsymlist.resolve;
       var
         hp : psymlistitem;
@@ -562,7 +500,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  2001-04-13 01:22:17  peter
+  Revision 1.7  2001-05-06 14:49:19  peter
+    * ppu object to class rewrite
+    * move ppu read and write stuff to fppu
+
+  Revision 1.6  2001/04/13 01:22:17  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/utils/ppudump.pp

@@ -45,7 +45,7 @@ const
   v_all            = $ff;
 
 var
-  ppufile     : pppufile;
+  ppufile     : tppufile;
   space       : string;
   read_member : boolean;
   verbose     : longint;
@@ -189,10 +189,10 @@ var
   s : string;
   m : longint;
 begin
-  while not ppufile^.endofentry do
+  while not ppufile.endofentry do
    begin
-     s:=ppufile^.getstring;
-     m:=ppufile^.getlongint;
+     s:=ppufile.getstring;
+     m:=ppufile.getlongint;
      WriteLn(prefix,s,' (',maskstr(m),')');
    end;
 end;
@@ -204,8 +204,8 @@ Procedure ReadContainer(const prefix:string);
   with prefix
 }
 begin
-  while not ppufile^.endofentry do
-   WriteLn(prefix,ppufile^.getstring);
+  while not ppufile.endofentry do
+   WriteLn(prefix,ppufile.getstring);
 end;
 
 
@@ -213,14 +213,14 @@ Procedure ReadRef;
 begin
   if (verbose and v_browser)=0 then
    exit;
-  while (not ppufile^.endofentry) and (not ppufile^.error) do
-   Writeln(space,'        - Refered : ',ppufile^.getword,', (',ppufile^.getlongint,',',ppufile^.getword,')');
+  while (not ppufile.endofentry) and (not ppufile.error) do
+   Writeln(space,'        - Refered : ',ppufile.getword,', (',ppufile.getlongint,',',ppufile.getword,')');
 end;
 
 
 Procedure ReadPosInfo;
 begin
-  Writeln(ppufile^.getword,' (',ppufile^.getlongint,',',ppufile^.getword,')');
+  Writeln(ppufile.getword,' (',ppufile.getlongint,',',ppufile.getword,')');
 end;
 
 
@@ -234,7 +234,7 @@ var
 begin
   readderef:=true;
   repeat
-    b:=tdereftype(ppufile^.getbyte);
+    b:=tdereftype(ppufile.getbyte);
     case b of
       derefnil :
         begin
@@ -245,39 +245,39 @@ begin
         end;
       derefaktrecordindex :
         begin
-          writeln('AktRecord ',s,' ',ppufile^.getword);
+          writeln('AktRecord ',s,' ',ppufile.getword);
           break;
         end;
       derefaktstaticindex :
         begin
-          writeln('AktStatic ',s,' ',ppufile^.getword);
+          writeln('AktStatic ',s,' ',ppufile.getword);
           break;
         end;
       derefaktlocalindex :
         begin
-          writeln('AktLocal ',s,' ',ppufile^.getword);
+          writeln('AktLocal ',s,' ',ppufile.getword);
           break;
         end;
       derefunit :
         begin
-          writeln('Unit ',ppufile^.getword);
+          writeln('Unit ',ppufile.getword);
           break;
         end;
       derefrecord :
         begin
-          write('RecordDef ',ppufile^.getword,', ');
+          write('RecordDef ',ppufile.getword,', ');
         end;
       derefpara :
         begin
-          write('Parameter of procdef ',ppufile^.getword,', ');
+          write('Parameter of procdef ',ppufile.getword,', ');
         end;
       dereflocal :
         begin
-          write('Local of procdef ',ppufile^.getword,', ');
+          write('Local of procdef ',ppufile.getword,', ');
         end;
       derefindex :
         begin
-          write(s,' ',ppufile^.getword,', ');
+          write(s,' ',ppufile.getword,', ');
         end;
       else
         begin
@@ -437,8 +437,8 @@ var
 begin
   write(space,'      Return type : ');
   readtype;
-  writeln(space,'         Fpu used : ',ppufile^.getbyte);
-  proctypeoption:=tproctypeoption(ppufile^.getlongint);
+  writeln(space,'         Fpu used : ',ppufile.getbyte);
+  proctypeoption:=tproctypeoption(ppufile.getlongint);
   if proctypeoption<>potype_none then
    begin
      write(space,'       TypeOption : ');
@@ -454,7 +454,7 @@ begin
        end;
      writeln;
    end;
-  ppufile^.getsmallset(proccalloptions);
+  ppufile.getsmallset(proccalloptions);
   if proccalloptions<>[] then
    begin
      write(space,'      CallOptions : ');
@@ -470,7 +470,7 @@ begin
        end;
      writeln;
    end;
-  ppufile^.getsmallset(procoptions);
+  ppufile.getsmallset(procoptions);
   if procoptions<>[] then
    begin
      write(space,'          Options : ');
@@ -486,12 +486,12 @@ begin
        end;
      writeln;
    end;
-  params:=ppufile^.getword;
+  params:=ppufile.getword;
   writeln(space,' Nr of parameters : ',params);
   if params>0 then
    begin
      repeat
-       write(space,'  - ',tvarspez[ppufile^.getbyte],' : ');
+       write(space,'  - ',tvarspez[ppufile.getbyte],' : ');
        readtype;
        write(space,'    Default : ');
        readsymref;
@@ -533,9 +533,9 @@ var
   i      : longint;
   first  : boolean;
 begin
-  writeln(space,'** Symbol Nr. ',ppufile^.getword,' **');
-  writeln(space,s,ppufile^.getstring);
-  ppufile^.getsmallset(symoptions);
+  writeln(space,'** Symbol Nr. ',ppufile.getword,' **');
+  writeln(space,s,ppufile.getstring);
+  ppufile.getsmallset(symoptions);
   if symoptions<>[] then
    begin
      write(space,'    File Pos: ');
@@ -558,7 +558,7 @@ end;
 
 procedure readcommondef(const s:string);
 begin
-  writeln(space,'** Definition Nr. ',ppufile^.getword,' **');
+  writeln(space,'** Definition Nr. ',ppufile.getword,' **');
   writeln(space,s);
   write  (space,'      Type symbol : ');
   readsymref;
@@ -588,7 +588,7 @@ var
   l1,l2 : longint;
 begin
   symcnt:=1;
-  with ppufile^ do
+  with ppufile do
    begin
      if space<>'' then
       Writeln(space,'-----------------------------');
@@ -842,7 +842,7 @@ var
   defcnt : longint;
 begin
   defcnt:=0;
-  with ppufile^ do
+  with ppufile do
    begin
      if space<>'' then
       Writeln(space,'-----------------------------');
@@ -1121,7 +1121,7 @@ var
   unitnumber : word;
   ucrc,uintfcrc : longint;
 begin
-  with ppufile^ do
+  with ppufile do
    begin
      repeat
        b:=readentry;
@@ -1218,7 +1218,7 @@ procedure readimplementation;
 var
   b : byte;
 begin
-  with ppufile^ do
+  with ppufile do
    begin
      repeat
        b:=readentry;
@@ -1249,7 +1249,7 @@ const indent : string = '';
 begin
   Writeln(indent,'Start of symtable browser');
   indent:=indent+'**';
-  with ppufile^ do
+  with ppufile do
    begin
      repeat
        b:=readentry;
@@ -1269,20 +1269,20 @@ begin
             ibdefref : begin
                          readdefref;
                          readref;
-                         if (ppufile^.header.flags and uf_local_browser)<>0 then
+                         if (ppufile.header.flags and uf_local_browser)<>0 then
                            begin
                              { parast and localst }
                              indent:=indent+'  ';
                              Writeln(indent,'Parasymtable for function');
                              readdefinitions(false);
                              readsymbols;
-                             b:=ppufile^.readentry;
+                             b:=ppufile.readentry;
                              if b=ibbeginsymtablebrowser then
                                readbrowser;
                              Writeln(indent,'Localsymtable for function');
                              readdefinitions(false);
                              readsymbols;
-                             b:=ppufile^.readentry;
+                             b:=ppufile.readentry;
                              if b=ibbeginsymtablebrowser then
                                readbrowser;
                              Indent:=Copy(Indent,1,Length(Indent)-2);
@@ -1317,21 +1317,21 @@ begin
 { fix filename }
   if pos('.',filename)=0 then
    filename:=filename+'.ppu';
-  ppufile:=new(pppufile,Init(filename));
-  if not ppufile^.open then
+  ppufile:=tppufile.create(filename);
+  if not ppufile.openfile then
    begin
      writeln ('IO-Error when opening : ',filename,', Skipping');
      exit;
    end;
 { PPU File is open, check for PPU Id }
-  if not ppufile^.CheckPPUID then
+  if not ppufile.CheckPPUID then
    begin
      writeln(Filename,' : Not a valid PPU file, Skipping');
      exit;
    end;
 { Check PPU Version }
-  Writeln('Analyzing ',filename,' (v',ppufile^.GetPPUVersion,')');
-  if ppufile^.GetPPUVersion<16 then
+  Writeln('Analyzing ',filename,' (v',ppufile.GetPPUVersion,')');
+  if ppufile.GetPPUVersion<16 then
    begin
      writeln(Filename,' : Old PPU Formats (<v16) are not supported, Skipping');
      exit;
@@ -1342,9 +1342,9 @@ begin
      Writeln;
      Writeln('Header');
      Writeln('-------');
-     with ppufile^.header do
+     with ppufile.header do
       begin
-        Writeln('Compiler version        : ',hi(ppufile^.header.compiler and $ff),'.',lo(ppufile^.header.compiler));
+        Writeln('Compiler version        : ',hi(ppufile.header.compiler and $ff),'.',lo(ppufile.header.compiler));
         WriteLn('Target processor        : ',Cpu2Str(cpu));
         WriteLn('Target operating system : ',Target2Str(target));
         Writeln('Unit flags              : ',PPUFlags2Str(flags));
@@ -1362,7 +1362,7 @@ begin
      readinterface;
    end
   else
-   ppufile^.skipuntilentry(ibendinterface);
+   ppufile.skipuntilentry(ibendinterface);
 {read the definitions}
   if (verbose and v_defs)<>0 then
    begin
@@ -1372,7 +1372,7 @@ begin
      readdefinitions(false);
    end
   else
-   ppufile^.skipuntilentry(ibenddefs);
+   ppufile.skipuntilentry(ibenddefs);
 {read the symbols}
   if (verbose and v_syms)<>0 then
    begin
@@ -1382,7 +1382,7 @@ begin
      readsymbols;
    end
   else
-   ppufile^.skipuntilentry(ibendsyms);
+   ppufile.skipuntilentry(ibendsyms);
 {read the implementation stuff}
 { Not used at the moment (PFV)
   if (verbose and v_implementation)<>0 then
@@ -1393,9 +1393,9 @@ begin
      readimplementation;
    end
   else}
-   ppufile^.skipuntilentry(ibendimplementation);
+   ppufile.skipuntilentry(ibendimplementation);
 {read the static browser units stuff}
-  if (ppufile^.header.flags and uf_local_browser)<>0 then
+  if (ppufile.header.flags and uf_local_browser)<>0 then
    begin
      if (verbose and v_defs)<>0 then
       begin
@@ -1405,7 +1405,7 @@ begin
         readdefinitions(false);
       end
      else
-      ppufile^.skipuntilentry(ibenddefs);
+      ppufile.skipuntilentry(ibenddefs);
    {read the symbols}
      if (verbose and v_syms)<>0 then
       begin
@@ -1416,7 +1416,7 @@ begin
       end;
    end;
 {read the browser units stuff}
-  if (ppufile^.header.flags and uf_has_browser)<>0 then
+  if (ppufile.header.flags and uf_has_browser)<>0 then
    begin
      if (verbose and v_browser)<>0 then
       begin
@@ -1425,7 +1425,7 @@ begin
         Writeln('---------------');
         UnitIndex:=0;
         repeat
-          b:=ppufile^.readentry;
+          b:=ppufile.readentry;
           if b = ibendbrowser then break;
           if b=ibbeginsymtablebrowser then
             begin
@@ -1439,14 +1439,14 @@ begin
       end;
    end;
 {read the static browser units stuff}
-  if (ppufile^.header.flags and uf_local_browser)<>0 then
+  if (ppufile.header.flags and uf_local_browser)<>0 then
    begin
      if (verbose and v_browser)<>0 then
       begin
         Writeln;
         Writeln('Static browser section');
         Writeln('---------------');
-        b:=ppufile^.readentry;
+        b:=ppufile.readentry;
         if b=ibbeginsymtablebrowser then
           begin
              Writeln('Unit ',UnitIndex);
@@ -1458,8 +1458,8 @@ begin
       end;
    end;
 {shutdown ppufile}
-  ppufile^.close;
-  dispose(ppufile,done);
+  ppufile.closefile;
+  ppufile.free;
   Writeln;
 end;
 
@@ -1528,7 +1528,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  2001-04-25 22:40:07  peter
+  Revision 1.2  2001-05-06 14:49:19  peter
+    * ppu object to class rewrite
+    * move ppu read and write stuff to fppu
+
+  Revision 1.1  2001/04/25 22:40:07  peter
     * compiler dependent utils in utils/ subdir
 
   Revision 1.5  2001/04/10 21:21:41  peter

compiler/utils/ppufiles.pp

@@ -127,43 +127,43 @@ Function DoPPU(const PPUFn:String):Boolean;
   Return true if successful, false otherwise.
 }
 Var
-  inppu  : pppufile;
+  inppu  : tppufile;
   b      : byte;
 
   procedure showfiles;
   begin
-    while not inppu^.endofentry do
+    while not inppu.endofentry do
      begin
-       AddFile(inppu^.getstring);
-       inppu^.getlongint;
+       AddFile(inppu.getstring);
+       inppu.getlongint;
      end;
   end;
 
 begin
   DoPPU:=false;
-  inppu:=new(pppufile,init(PPUFn));
-  if not inppu^.open then
+  inppu:=tppufile.create(PPUFn);
+  if not inppu.openfile then
    begin
-     dispose(inppu,done);
+     inppu.free;
      Error('Error: Could not open : '+PPUFn,false);
      Exit;
    end;
 { Check the ppufile }
-  if not inppu^.CheckPPUId then
+  if not inppu.CheckPPUId then
    begin
-     dispose(inppu,done);
+     inppu.free;
      Error('Error: Not a PPU File : '+PPUFn,false);
      Exit;
    end;
-  if inppu^.GetPPUVersion<CurrentPPUVersion then
+  if inppu.GetPPUVersion<CurrentPPUVersion then
    begin
-     dispose(inppu,done);
+     inppu.free;
      Error('Error: Wrong PPU Version : '+PPUFn,false);
      Exit;
    end;
 { read until the object files are found }
   repeat
-    b:=inppu^.readentry;
+    b:=inppu.readentry;
     case b of
       ibendinterface,
       ibend :
@@ -179,7 +179,7 @@ begin
          showfiles;
     end;
   until false;
-  dispose(inppu,done);
+  inppu.free;
   DoPPU:=True;
 end;
 
@@ -253,7 +253,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  2001-04-25 22:40:07  peter
+  Revision 1.2  2001-05-06 14:49:19  peter
+    * ppu object to class rewrite
+    * move ppu read and write stuff to fppu
+
+  Revision 1.1  2001/04/25 22:40:07  peter
     * compiler dependent utils in utils/ subdir
 
   Revision 1.2  2000/11/06 13:16:19  michael

compiler/utils/ppumove.pp

@@ -25,7 +25,11 @@
 Program ppumove;
 uses
 {$ifdef unix}
+  {$ifdef ver1_0}
+  linux,
+  {$else}
   unix,
+  {$endif}
 {$else unix}
   dos,
 {$endif unix}
@@ -109,7 +113,7 @@ begin
      exit;
    end;
 {$ifdef unix}
-  Shell:=unix.shell(s);
+  Shell:={$ifdef ver1_0}linux{$else}unix{$endif}.shell(s);
 {$else}
   exec(getenv('COMSPEC'),'/C '+s);
   Shell:=DosExitCode;
@@ -230,7 +234,7 @@ Function DoPPU(const PPUFn,PPLFn:String):Boolean;
 }
 Var
   inppu,
-  outppu : pppufile;
+  outppu : tppufile;
   b,
   untilb : byte;
   l,m    : longint;
@@ -240,80 +244,80 @@ begin
   DoPPU:=false;
   If Not Quiet then
    Write ('Processing ',PPUFn,'...');
-  inppu:=new(pppufile,init(PPUFn));
-  if not inppu^.open then
+  inppu:=tppufile.create(PPUFn);
+  if not inppu.openfile then
    begin
-     dispose(inppu,done);
+     inppu.free;
      Error('Error: Could not open : '+PPUFn,false);
      Exit;
    end;
 { Check the ppufile }
-  if not inppu^.CheckPPUId then
+  if not inppu.CheckPPUId then
    begin
-     dispose(inppu,done);
+     inppu.free;
      Error('Error: Not a PPU File : '+PPUFn,false);
      Exit;
    end;
-  if inppu^.GetPPUVersion<CurrentPPUVersion then
+  if inppu.GetPPUVersion<CurrentPPUVersion then
    begin
-     dispose(inppu,done);
+     inppu.free;
      Error('Error: Wrong PPU Version : '+PPUFn,false);
      Exit;
    end;
 { No .o file generated for this ppu, just skip }
-  if (inppu^.header.flags and uf_no_link)<>0 then
+  if (inppu.header.flags and uf_no_link)<>0 then
    begin
-     dispose(inppu,done);
+     inppu.free;
      If Not Quiet then
       Writeln (' No files.');
      DoPPU:=true;
      Exit;
    end;
 { Already a lib? }
-  if (inppu^.header.flags and uf_in_library)<>0 then
+  if (inppu.header.flags and uf_in_library)<>0 then
    begin
-     dispose(inppu,done);
+     inppu.free;
      Error('Error: PPU is already in a library : '+PPUFn,false);
      Exit;
    end;
 { We need a static linked unit }
-  if (inppu^.header.flags and uf_static_linked)=0 then
+  if (inppu.header.flags and uf_static_linked)=0 then
    begin
-     dispose(inppu,done);
+     inppu.free;
      Error('Error: PPU is not static linked : '+PPUFn,false);
      Exit;
    end;
 { Create the new ppu }
   if PPUFn=PPLFn then
-   outppu:=new(pppufile,init('ppumove.$$$'))
+   outppu:=tppufile.create('ppumove.$$$')
   else
-   outppu:=new(pppufile,init(PPLFn));
-  outppu^.create;
+   outppu:=tppufile.create(PPLFn);
+  outppu.createfile;
 { Create new header, with the new flags }
-  outppu^.header:=inppu^.header;
-  outppu^.header.flags:=outppu^.header.flags or uf_in_library;
+  outppu.header:=inppu.header;
+  outppu.header.flags:=outppu.header.flags or uf_in_library;
   if MakeStatic then
-   outppu^.header.flags:=outppu^.header.flags or uf_static_linked
+   outppu.header.flags:=outppu.header.flags or uf_static_linked
   else
-   outppu^.header.flags:=outppu^.header.flags or uf_shared_linked;
+   outppu.header.flags:=outppu.header.flags or uf_shared_linked;
 { read until the object files are found }
   untilb:=iblinkunitofiles;
   repeat
-    b:=inppu^.readentry;
+    b:=inppu.readentry;
     if b in [ibendinterface,ibend] then
      begin
-       dispose(inppu,done);
-       dispose(outppu,done);
+       inppu.free;
+       outppu.free;
        Error('Error: No files to be linked found : '+PPUFn,false);
        Exit;
      end;
     if b<>untilb then
      begin
        repeat
-         inppu^.getdatabuf(buffer^,bufsize,l);
-         outppu^.putdata(buffer^,l);
+         inppu.getdatabuf(buffer^,bufsize,l);
+         outppu.putdata(buffer^,l);
        until l<bufsize;
-       outppu^.writeentry(b);
+       outppu.writeentry(b);
      end;
   until (b=untilb);
 { we have now reached the section for the files which need to be added,
@@ -323,64 +327,64 @@ begin
       begin
         { add all o files, and save the entry when not creating a static
           library to keep staticlinking possible }
-        while not inppu^.endofentry do
+        while not inppu.endofentry do
          begin
-           s:=inppu^.getstring;
-           m:=inppu^.getlongint;
+           s:=inppu.getstring;
+           m:=inppu.getlongint;
            if not MakeStatic then
             begin
-              outppu^.putstring(s);
-              outppu^.putlongint(m);
+              outppu.putstring(s);
+              outppu.putlongint(m);
             end;
            AddToLinkFiles(s);
          end;
         if not MakeStatic then
-         outppu^.writeentry(b);
+         outppu.writeentry(b);
       end;
 {    iblinkunitstaticlibs :
       begin
-        AddToLinkFiles(ExtractLib(inppu^.getstring));
-        if not inppu^.endofentry then
+        AddToLinkFiles(ExtractLib(inppu.getstring));
+        if not inppu.endofentry then
          begin
            repeat
-             inppu^.getdatabuf(buffer^,bufsize,l);
-             outppu^.putdata(buffer^,l);
+             inppu.getdatabuf(buffer^,bufsize,l);
+             outppu.putdata(buffer^,l);
            until l<bufsize;
-           outppu^.writeentry(b);
+           outppu.writeentry(b);
          end;
        end; }
   end;
 { just add a new entry with the new lib }
   if MakeStatic then
    begin
-     outppu^.putstring(outputfileforlink);
-     outppu^.putlongint(link_static);
-     outppu^.writeentry(iblinkunitstaticlibs)
+     outppu.putstring(outputfileforlink);
+     outppu.putlongint(link_static);
+     outppu.writeentry(iblinkunitstaticlibs)
    end
   else
    begin
-     outppu^.putstring(outputfileforlink);
-     outppu^.putlongint(link_shared);
-     outppu^.writeentry(iblinkunitsharedlibs);
+     outppu.putstring(outputfileforlink);
+     outppu.putlongint(link_shared);
+     outppu.writeentry(iblinkunitsharedlibs);
    end;
 { read all entries until the end and write them also to the new ppu }
   repeat
-    b:=inppu^.readentry;
+    b:=inppu.readentry;
   { don't write ibend, that's written automaticly }
     if b<>ibend then
      begin
        repeat
-         inppu^.getdatabuf(buffer^,bufsize,l);
-         outppu^.putdata(buffer^,l);
+         inppu.getdatabuf(buffer^,bufsize,l);
+         outppu.putdata(buffer^,l);
        until l<bufsize;
-       outppu^.writeentry(b);
+       outppu.writeentry(b);
      end;
   until b=ibend;
 { write the last stuff and close }
-  outppu^.flush;
-  outppu^.writeheader;
-  dispose(outppu,done);
-  dispose(inppu,done);
+  outppu.flush;
+  outppu.writeheader;
+  outppu.free;
+  inppu.free;
 { rename }
   if PPUFn=PPLFn then
    begin
@@ -610,7 +614,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  2001-04-25 22:40:07  peter
+  Revision 1.2  2001-05-06 14:49:19  peter
+    * ppu object to class rewrite
+    * move ppu read and write stuff to fppu
+
+  Revision 1.1  2001/04/25 22:40:07  peter
     * compiler dependent utils in utils/ subdir
 
   Revision 1.2  2001/01/29 21:48:26  peter