+ targetcpu

  * cleaner pmodules for newppu

compiler/aopt386.pas

@@ -548,7 +548,7 @@ End;
                                imul 6, reg1 to
                                  lea (reg1,reg1,2), reg1
                                  add reg1, reg1}
-                                If (aktoptprocessor <= i486)
+                                If (aktoptprocessor <= int486)
                                   Then
                                     Begin
                                       TmpRef^.Index := TRegister(Pai386(p)^.op2);
@@ -618,7 +618,7 @@ End;
                                imul 10, reg1 to
                                  lea (reg1,reg1,4), reg1
                                  add reg1, reg1}
-                                 If (aktoptprocessor <= i486) Then
+                                 If (aktoptprocessor <= int486) Then
                                    Begin
                                      If (Pai386(p)^.op3t = Top_Reg)
                                        Then
@@ -653,7 +653,7 @@ End;
                                imul 12, reg1 to
                                  lea (reg1,reg1,2), reg1
                                  lea (,reg1,4), reg1}
-                                 If (aktoptprocessor <= i486)
+                                 If (aktoptprocessor <= int486)
                                    Then
                                      Begin
                                        TmpRef^.Index := TRegister(Pai386(p)^.op2);
@@ -1631,7 +1631,11 @@ end;
 End.
 {
   $Log$
-  Revision 1.14  1998-05-30 14:31:02  peter
+  Revision 1.15  1998-06-16 08:56:17  peter
+    + targetcpu
+    * cleaner pmodules for newppu
+
+  Revision 1.14  1998/05/30 14:31:02  peter
     + $ASMMODE
 
   Revision 1.13  1998/05/24 18:42:37  jonas

compiler/cg386set.pas

@@ -715,7 +715,7 @@ implementation
                    else
                      max_linear_list:=2;
                    { a jump table crashes the pipeline! }
-                   if aktoptprocessor=i486 then
+                   if aktoptprocessor=int486 then
                      inc(max_linear_list,3);
                        if aktoptprocessor=pentium then
                      inc(max_linear_list,6);
@@ -765,7 +765,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.1  1998-06-05 17:44:13  peter
+  Revision 1.2  1998-06-16 08:56:18  peter
+    + targetcpu
+    * cleaner pmodules for newppu
+
+  Revision 1.1  1998/06/05 17:44:13  peter
     * splitted cgi386
 
 }

compiler/files.pas

@@ -122,6 +122,7 @@ unit files;
           { used in firstpass for faster settings }
           current_index : word;
 
+          path,                     { path where the module is find/created }
           modulename,               { name of the module in uppercase }
           objfilename,              { fullname of the objectfile }
           asmfilename,              { fullname of the assemblerfile }
@@ -132,9 +133,9 @@ unit files;
           constructor init(const s:string;_is_unit:boolean);
           destructor special_done;virtual; { this is to be called only when compiling again }
 
-          procedure setfilename(const path,name:string);
+          procedure setfilename(const _path,name:string);
 {$ifdef NEWPPU}
-          function  openppu(const unit_path:string):boolean;
+          function  openppu:boolean;
 {$else}
           function  load_ppu(const unit_path,n,ext:string):boolean;
 {$endif}
@@ -143,12 +144,22 @@ unit files;
 
        pused_unit = ^tused_unit;
        tused_unit = object(tlinkedlist_item)
-          u               : pmodule;
+          unitid          : word;
+{$ifdef NEWPPU}
+          name            : pstring;
+          checksum        : longint;
+          loaded          : boolean;
+{$endif NEWPPU}
           in_uses,
           in_interface,
           is_stab_written : boolean;
-          unitid          : word;
+          u               : pmodule;
+{$ifdef NEWPPU}
+          constructor init(_u : pmodule;intface:boolean);
+          constructor init_to_load(const n:string;c:longint;intface:boolean);
+{$else NEWPPU}
           constructor init(_u : pmodule;f : byte);
+{$endif NEWPPU}
           destructor done;virtual;
        end;
 
@@ -225,6 +236,9 @@ unit files;
     var
        main_module    : pmodule;
        current_module : pmodule;
+{$ifdef NEWPPU}
+       current_ppu    : pppufile;
+{$endif}
        global_unit_count : word;
        loaded_units   : tlinkedlist;
 
@@ -349,7 +363,7 @@ unit files;
                                   TMODULE
  ****************************************************************************}
 
-    procedure tmodule.setfilename(const path,name:string);
+    procedure tmodule.setfilename(const _path,name:string);
       var
         s : string;
       begin
@@ -357,7 +371,9 @@ unit files;
          stringdispose(asmfilename);
          stringdispose(ppufilename);
          stringdispose(libfilename);
-         s:=FixFileName(FixPath(path)+name);
+         stringdispose(path);
+         path:=stringdup(FixPath(_path));
+         s:=FixFileName(FixPath(_path)+name);
          objfilename:=stringdup(s+target_info.objext);
          asmfilename:=stringdup(s+target_info.asmext);
          ppufilename:=stringdup(s+target_info.unitext);
@@ -366,29 +382,18 @@ unit files;
 
 {$ifdef NEWPPU}
 
-    function tmodule.openppu(const unit_path:string):boolean;
+    function tmodule.openppu:boolean;
       var
-         temp,hs : string;
-         b       : byte;
-         incfile_found : boolean;
          objfiletime,
          ppufiletime,
-         asmfiletime,
-         source_time : longint;
-{$ifdef UseBrowser}
-         hp : pextfile;
-         _d : dirstr;
-         _n : namestr;
-         _e : extstr;
-{$endif UseBrowser}
-
+         asmfiletime : longint;
     begin
       openppu:=false;
     { Get ppufile time (also check if the file exists) }
       ppufiletime:=getnamedfiletime(ppufilename^);
       if ppufiletime=-1 then
        exit;
-
+    { Open the ppufile }
       Message1(unit_u_ppu_loading,ppufilename^);
       ppufile:=new(pppufile,init(ppufilename^));
       if not ppufile^.open then
@@ -411,6 +416,21 @@ unit files;
          Message1(unit_d_ppu_invalid_version,tostr(ppufile^.GetPPUVersion));
          exit;
        end;
+    { check the target processor }
+      if ttargetcpu(ppufile^.header.cpu)<>target_cpu then
+       begin
+         dispose(ppufile,done);
+         Comment(V_Debug,'unit is compiled for an other processor');
+         exit;
+       end;
+    { check target }
+      if ttarget(ppufile^.header.target)<>target_info.target then
+       begin
+         dispose(ppufile,done);
+         Comment(V_Debug,'unit is compiled for an other target');
+         exit;
+       end;
+{!!!!!!!!!!!!!!!!!!! }
     { Load values to be access easier }
       flags:=ppufile^.header.flags;
       crc:=ppufile^.header.checksum;
@@ -418,83 +438,9 @@ unit files;
       Message1(unit_d_ppu_time,filetimestring(ppufiletime));
       Message1(unit_d_ppu_flags,tostr(flags));
       Message1(unit_d_ppu_crc,tostr(ppufile^.header.checksum));
-    { Unitname }
-      b:=ppufile^.readentry;
-      if b=ibmodulename then
-       begin
-         stringdispose(modulename);
-         modulename:=stringdup(ppufile^.getstring);
-         b:=ppufile^.readentry;
-       end;
-
-    { search source files there is at least one source file }
+    { check the object and assembler file to see if we need only to
+      assemble, only if it's not in a library }
       do_compile:=false;
-      sources_avail:=true;
-      if b=ibsourcefiles then
-       begin
-         while not ppufile^.endofentry do
-          begin
-            hs:=ppufile^.getstring;
-            temp:='';
-            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(unit_path+hs);
-               if Source_Time=-1 then
-                 begin
-                    { search for include files in the includepathlist }
-                    if b<>ibend then
-                      begin
-                         temp:=search(hs,includesearchpath,incfile_found);
-                         if incfile_found then
-                           begin
-                              hs:=temp+hs;
-                              Source_Time:=GetNamedFileTime(hs);
-                           end;
-                      end;
-                 end
-               else
-                 hs:=unit_path+hs;
-               if Source_Time=-1 then
-                begin
-                  sources_avail:=false;
-                  temp:=' not found';
-                end
-               else
-                begin
-                  temp:=' time '+filetimestring(source_time);
-                  if (source_time>ppufiletime) then
-                   begin
-                     do_compile:=true;
-                     temp:=temp+' *'
-                   end;
-                end;
-             end;
-            Message1(unit_t_ppu_source,hs+temp);
-   {$ifdef UseBrowser}
-            fsplit(hs,_d,_n,_e);
-            new(hp,init(_d,_n,_e));
-            { the indexing should match what is done in writeasunit }
-            sourcefiles.register_file(hp);
-   {$endif UseBrowser}
-          end;
-       end;
-    { main source is always the last }
-      stringdispose(mainsource);
-      mainsource:=stringdup(hs);
-
-    { check the object and assembler file if not a library }
       if (flags and uf_in_library)=0 then
        begin
          if (flags and uf_smartlink)<>0 then
@@ -532,7 +478,7 @@ unit files;
       var
          ext       : string[8];
          singlepathstring,
-         Path,
+         unitPath,
          filename  : string;
          found     : boolean;
          start,i   : longint;
@@ -546,15 +492,15 @@ unit files;
        begin
          start:=1;
          filename:=FixFileName(n);
-         path:=UnitSearchPath;
+         unitpath:=UnitSearchPath;
          Found:=false;
          repeat
          { Create current path to check }
-           i:=pos(';',path);
+           i:=pos(';',unitpath);
            if i=0 then
-            i:=length(path)+1;
-           singlepathstring:=FixPath(copy(path,start,i-start));
-           delete(path,start,i-start+1);
+            i:=length(unitpath)+1;
+           singlepathstring:=FixPath(copy(unitpath,start,i-start));
+           delete(unitpath,start,i-start+1);
          { Check for PPL file }
            if not (cs_link_static in aktswitches) then
             begin
@@ -562,7 +508,7 @@ unit files;
               if Found then
                Begin
                  SetFileName(SinglePathString,FileName);
-                 Found:=OpenPPU(singlepathstring);
+                 Found:=OpenPPU;
                End;
              end;
          { Check for PPU file }
@@ -572,7 +518,7 @@ unit files;
               if Found then
                Begin
                  SetFileName(SinglePathString,FileName);
-                 Found:=OpenPPU(singlepathstring);
+                 Found:=OpenPPU;
                End;
             end;
          { Check for Sources }
@@ -602,7 +548,7 @@ unit files;
               else
                sources_avail:=false;
             end;
-         until Found or (path='');
+         until Found or (unitpath='');
          search_unit:=Found;
       end;
 
@@ -779,7 +725,7 @@ unit files;
       var
          ext       : string[8];
          singlepathstring,
-         Path,
+         UnitPath,
          filename  : string;
          found     : boolean;
          start,i   : longint;
@@ -793,15 +739,15 @@ unit files;
        begin
          start:=1;
          filename:=FixFileName(n);
-         path:=UnitSearchPath;
+         unitpath:=UnitSearchPath;
          Found:=false;
          repeat
          {Create current path to check}
-           i:=pos(';',path);
+           i:=pos(';',unitpath);
            if i=0 then
-            i:=length(path)+1;
-           singlepathstring:=FixPath(copy(path,start,i-start));
-           delete(path,start,i-start+1);
+            i:=length(unitpath)+1;
+           singlepathstring:=FixPath(copy(unitpath,start,i-start));
+           delete(unitpath,start,i-start+1);
          { Check for PPL file }
            if not (cs_link_static in aktswitches) then
             begin
@@ -849,7 +795,7 @@ unit files;
               else
                sources_avail:=false;
             end;
-         until Found or (path='');
+         until Found or (unitpath='');
          search_unit:=Found;
       end;
 
@@ -874,6 +820,7 @@ unit files;
          asmfilename:=nil;
          libfilename:=nil;
          ppufilename:=nil;
+         path:=nil;
          setfilename(p,n);
          used_units.init;
          sourcefiles.init;
@@ -932,26 +879,65 @@ unit files;
                               TUSED_UNIT
  ****************************************************************************}
 
+{$ifdef NEWPPU}
 
-    constructor tused_unit.init(_u : pmodule;f : byte);
+    constructor tused_unit.init(_u : pmodule;intface:boolean);
+      begin
+        u:=_u;
+        in_interface:=intface;
+        in_uses:=false;
+        is_stab_written:=false;
+        loaded:=true;
+        name:=stringdup(_u^.modulename^);
+        checksum:=_u^.crc;
+        unitid:=0;
+      end;
 
+    constructor tused_unit.init_to_load(const n:string;c:longint;intface:boolean);
       begin
-         u:=_u;
-         in_interface:=false;
-         in_uses:=false;
-         is_stab_written:=false;
-         unitid:=f;
+        u:=nil;
+        in_interface:=intface;
+        in_uses:=false;
+        is_stab_written:=false;
+        loaded:=false;
+        name:=stringdup(n);
+        checksum:=c;
+        unitid:=0;
       end;
 
     destructor tused_unit.done;
       begin
-         inherited done;
+        stringdispose(name);
+        inherited done;
+      end;
+
+{$else NEWPPU}
+
+    constructor tused_unit.init(_u : pmodule;f : byte);
+      begin
+        u:=_u;
+        in_interface:=false;
+        in_uses:=false;
+        is_stab_written:=false;
+        unitid:=f;
+      end;
+
+    destructor tused_unit.done;
+      begin
+        inherited done;
       end;
 
+{$endif NEWPPU}
+
+
 end.
 {
   $Log$
-  Revision 1.23  1998-06-15 14:44:36  daniel
+  Revision 1.24  1998-06-16 08:56:20  peter
+    + targetcpu
+    * cleaner pmodules for newppu
+
+  Revision 1.23  1998/06/15 14:44:36  daniel
 
 
   * BP updates.

compiler/opts386.pas

@@ -60,8 +60,8 @@ begin
             'x' : initswitches:=initswitches+[cs_optimize,cs_maxoptimieren];
             'z' : initswitches:=initswitches+[cs_optimize,cs_uncertainopts];
             '2' : initoptprocessor:=pentium2;
-            '3' : initoptprocessor:=systems.i386;
-            '4' : initoptprocessor:=i486;
+            '3' : initoptprocessor:=int386;
+            '4' : initoptprocessor:=int486;
             '5' : initoptprocessor:=pentium;
             '6' : initoptprocessor:=pentiumpro;
             '7' : initoptprocessor:=cx6x86;
@@ -89,7 +89,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.7  1998-05-30 14:31:05  peter
+  Revision 1.8  1998-06-16 08:56:22  peter
+    + targetcpu
+    * cleaner pmodules for newppu
+
+  Revision 1.7  1998/05/30 14:31:05  peter
     + $ASMMODE
 
   Revision 1.6  1998/05/28 17:26:48  peter

compiler/parser.pas

@@ -75,8 +75,6 @@ unit parser;
 
     procedure compile(const filename:string;compile_system:boolean);
       var
-         hp : pmodule;
-
          { some variables to save the compiler state }
          oldtoken : ttoken;
          oldtokenpos : tfileposinfo;
@@ -85,6 +83,7 @@ unit parser;
          oldpreprocstack : ppreprocstack;
          oldorgpattern,oldprocprefix : string;
          old_block_type : tblock_type;
+         oldcurrlinepos,
          oldlastlinepos,
          oldinputbuffer,
          oldinputpointer : pchar;
@@ -200,6 +199,7 @@ unit parser;
 
          oldinputbuffer:=inputbuffer;
          oldinputpointer:=inputpointer;
+         oldcurrlinepos:=currlinepos;
          oldlastlinepos:=lastlinepos;
          olds_point:=s_point;
          oldc:=c;
@@ -273,35 +273,7 @@ unit parser;
 {$endif UseBrowser}
           end;
 
-         { if the current file isn't a system unit  }
-         { the the system unit will be loaded       }
-         if not(cs_compilesystem in aktswitches) then
-           begin
-              { should be done in unit system (changing the field system_unit)
-                                                                      FK
-              }
-              hp:=loadunit(upper(target_info.system_unit),true,true);
-              systemunit:=hp^.symtable;
-              make_ref:=false;
-              readconstdefs;
-              { we could try to overload caret by default }
-              symtablestack:=systemunit;
-              { if POWER is defined in the RTL then use it for starstar overloading }
-              getsym('POWER',false);
-              if assigned(srsym) and (srsym^.typ=procsym) and
-                 (overloaded_operators[STARSTAR]=nil) then
-                begin
-                   overloaded_operators[STARSTAR]:=
-                     new(pprocsym,init(overloaded_names[STARSTAR]));
-                   overloaded_operators[STARSTAR]^.definition:=pprocsym(srsym)^.definition;
-                end;
-              make_ref:=true;
-           end
-         else
-           begin
-              createconstdefs;
-              systemunit:=nil;
-           end;
+         loadsystemunit;
 
          registerdef:=true;
          make_ref:=true;
@@ -418,6 +390,7 @@ done:
          inputbuffer:=oldinputbuffer;
          inputpointer:=oldinputpointer;
          lastlinepos:=oldlastlinepos;
+         currlinepos:=oldcurrlinepos;
          s_point:=olds_point;
          c:=oldc;
          comment_level:=oldcomment_level;
@@ -470,7 +443,11 @@ done:
 end.
 {
   $Log$
-  Revision 1.25  1998-06-15 15:38:07  pierre
+  Revision 1.26  1998-06-16 08:56:23  peter
+    + targetcpu
+    * cleaner pmodules for newppu
+
+  Revision 1.25  1998/06/15 15:38:07  pierre
     * small bug in systems.pas corrected
     + operators in different units better hanlded
 

compiler/pass_1.pas

@@ -5018,7 +5018,11 @@ unit pass_1;
 end.
 {
   $Log$
-  Revision 1.32  1998-06-14 18:23:57  peter
+  Revision 1.33  1998-06-16 08:56:24  peter
+    + targetcpu
+    * cleaner pmodules for newppu
+
+  Revision 1.32  1998/06/14 18:23:57  peter
     * fixed xor bug (from mailinglist)
 
   Revision 1.31  1998/06/13 00:10:09  peter
@@ -5048,9 +5052,8 @@ end.
       to a procedure
 
   Revision 1.26  1998/06/04 09:55:39  pierre
-    * demangled name of procsym reworked to become independant of the mangling scheme
-
-  Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
+    * demangled name of procsym reworked to become independant
+      of the mangling scheme
 
   Revision 1.25  1998/06/03 22:48:57  peter
     + wordbool,longbool

compiler/pmodules.pas

@@ -30,7 +30,7 @@ unit pmodules;
       files;
 
     procedure addlinkerfiles(hp:pmodule);
-    function  loadunit(const s : string;compile_system, in_uses : boolean) : pmodule;
+    procedure loadsystemunit;
     procedure proc_unit;
     procedure proc_program(islibrary : boolean);
 
@@ -141,103 +141,234 @@ unit pmodules;
       end;
 
 
+{$ifdef NEWPPU}
+
+    function loadunit(const s : string;compile_system:boolean) : pmodule;forward;
+
+    procedure load_usedunits(compile_system:boolean);
+      var
+        pu           : pused_unit;
+        loaded_unit  : pmodule;
+        nextmapentry : longint;
+      begin
+      { init the map }
+        new(current_module^.map);
+        nextmapentry:=1;
+      { load the used units from interface }
+        pu:=pused_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);
+              pu^.u:=loaded_unit;
+              pu^.loaded:=true;
+              if current_module^.compiled then
+               exit;
+              if loaded_unit^.crc<>pu^.checksum then
+               begin
+                 current_module^.do_compile:=true;
+                 exit;
+               end;
+            { setup the map entry for deref }
+              current_module^.map^[nextmapentry]:=loaded_unit^.symtable;
+              inc(nextmapentry);
+              if nextmapentry>maxunits then
+               Message(unit_f_too_much_units);
+            end;
+           pu:=pused_unit(pu^.next);
+         end;
+      { ok, now load the unit }
+        current_module^.symtable:=new(punitsymtable,loadasunit);
+      { if this is the system unit insert the intern symbols }
+        if compile_system then
+         begin
+           make_ref:=false;
+           insertinternsyms(psymtable(current_module^.symtable));
+           make_ref:=true;
+         end;
+      { now only read the implementation part }
+        current_module^.in_implementation:=true;
+      { load the used units from implementation }
+        pu:=pused_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;
+              if loaded_unit^.crc<>pu^.checksum then
+               begin
+                 current_module^.do_compile:=true;
+                 exit;
+               end;
+            { setup the map entry for deref }
+{              current_module^.map^[nextmapentry]:=loaded_unit^.symtable;
+              inc(nextmapentry);
+              if nextmapentry>maxunits then
+               Message(unit_f_too_much_units); }
+            end;
+           pu:=pused_unit(pu^.next);
+         end;
+      { 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) : pmodule;
+      var
+         st : punitsymtable;
+         old_current_ppu : pppufile;
+         old_current_module,hp,nextmodule : pmodule;
+         hs : pstring;
+      begin
+         old_current_module:=current_module;
+         old_current_ppu:=current_ppu;
+         { be sure not to mix lines from different files }
+         { update_line; }
+         { unit not found }
+         st:=nil;
+         { search all loaded units }
+         hp:=pmodule(loaded_units.first);
+         while assigned(hp) do
+           begin
+              if hp^.modulename^=s then
+                begin
+                   { the unit is already registered   }
+                   { and this means that the unit     }
+                   { is already compiled              }
+                   { else there is a cyclic unit use  }
+                   if assigned(hp^.symtable) then
+                     st:=punitsymtable(hp^.symtable)
+                   else
+                    begin
+                    { recompile the unit ? }
+                      if (not current_module^.in_implementation) and (hp^.in_implementation) then
+                       Message(unit_f_circular_unit_reference);
+                    end;
+                   break;
+                end;
+              { the next unit }
+              hp:=pmodule(hp^.next);
+           end;
+       { the unit is not in the symtable stack }
+         if (not assigned(st)) then
+{           ((not current_module^.in_implementation) and (hp^.in_implementation)) then }
+          begin
+          { load the unit, it's not loaded yet }
+            if not assigned(hp) then
+             begin
+               { generates a new unit info record }
+               current_module:=new(pmodule,init(s,true));
+               current_ppu:=current_module^.ppufile;
+               { now we can register the unit }
+               loaded_units.insert(current_module);
+               { 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 needn't the ppufile }
+                  if assigned(current_module^.ppufile) then
+                   begin
+                     dispose(current_module^.ppufile,done);
+                     current_module^.ppufile:=nil;
+                   end;
+                  if not(current_module^.sources_avail) then
+                   Message1(unit_f_cant_compile_unit,current_module^.modulename^)
+                  else
+                   begin
+                     if assigned(old_current_module^.current_inputfile) then
+                      old_current_module^.current_inputfile^.tempclose;
+                     compile(current_module^.mainsource^,compile_system);
+                     if (not old_current_module^.compiled) and assigned(old_current_module^.current_inputfile) then
+                      old_current_module^.current_inputfile^.tempreopen;
+                    end;
+                 end
+                else
+                 begin
+                 { only reassemble ? }
+                   if (current_module^.do_assemble) then
+                    OnlyAsm(current_module^.asmfilename^);
+                  { add the files for the linker }
+                   addlinkerfiles(current_module);
+                 end;
+               { register the unit _once_ }
+               usedunits.concat(new(pused_unit,init(current_module,true)));
+             end
+            else
+            { we have to compile the unit again, but it is already inserted !!}
+            { we may have problem with the lost symtable !! }
+             begin
+               current_module:=hp;
+               { we must preserve the unit chain }
+               nextmodule:=pmodule(current_module^.next);
+               { we have to cleanup a little }
+               current_module^.special_done;
+               new(hs);
+               hs^:=current_module^.mainsource^;
+               current_module^.init(hs^,true);
+               dispose(hs);
+               { we must preserve the unit chain }
+               current_module^.next:=nextmodule;
+               if assigned(current_module^.ppufile) then
+                begin
+                  current_ppu:=current_module^.ppufile;
+                  load_interface;
+                  load_usedunits(compile_system)
+                end
+               else
+                begin
+{$ifdef UseBrowser}
+                { here we need to remove the names ! }
+                  current_module^.sourcefiles.done;
+                  current_module^.sourcefiles.init;
+{$endif UseBrowser}
+                  if assigned(old_current_module^.current_inputfile) then
+                   old_current_module^.current_inputfile^.tempclose;
+                  Message1(parser_d_compiling_second_time,current_module^.mainsource^);
+                  compile(current_module^.mainsource^,compile_system);
+                  if (not old_current_module^.compiled) and assigned(old_current_module^.current_inputfile) then
+                   old_current_module^.current_inputfile^.tempreopen;
+                end;
+               current_module^.compiled:=true;
+             end;
+            hp:=current_module;
+          end;
+         { set the old module }
+         current_ppu:=old_current_ppu;
+         current_module:=old_current_module;
+         loadunit:=hp;
+      end;
+
+{$else NEWPPU}
+
+{*****************************************************************************
+
+                               Old PPU
+
+*****************************************************************************}
+
+    function loadunit(const s : string;compile_system, in_uses : boolean) : pmodule;forward;
 
     procedure load_ppu(oldhp,hp : pmodule;compile_system : boolean);
       var
          loaded_unit  : pmodule;
          b            : byte;
          checksum,
-{$ifndef NEWPPU}
          count,
-{$endif NEWPPU}
          nextmapentry : longint;
          hs           : string;
       begin
          { init the map }
          new(hp^.map);
          nextmapentry:=1;
-
-{$ifdef NEWPPU}
-         { load the used units from interface }
-         b:=hp^.ppufile^.readentry;
-         if b=ibloadunit_int then
-          begin
-            while not hp^.ppufile^.endofentry do
-             begin
-               hs:=hp^.ppufile^.getstring;
-               checksum:=hp^.ppufile^.getlongint;
-               loaded_unit:=loadunit(hs,false,false);
-               if hp^.compiled then
-                exit;
-             { if the crc of a used unit is the same as written to the
-               PPU file, we needn't to recompile the current unit }
-               if (loaded_unit^.crc<>checksum) then
-                begin
-                { we have to compile the current unit remove stuff which isn't
-                  needed }
-                { forget the map }
-                  dispose(hp^.map);
-                  hp^.map:=nil;
-                { remove the ppufile }
-                  dispose(hp^.ppufile,done);
-                  hp^.ppufile:=nil;
-                { recompile or give an fatal error }
-                  if not(hp^.sources_avail) then
-                   Message1(unit_f_cant_compile_unit,hp^.modulename^)
-                  else
-                   begin
-                      if assigned(oldhp^.current_inputfile) then
-                        oldhp^.current_inputfile^.tempclose;
-                      compile(hp^.mainsource^,compile_system);
-                      if (not oldhp^.compiled) and assigned(oldhp^.current_inputfile) then
-                        oldhp^.current_inputfile^.tempreopen;
-                   end;
-                  exit;
-                end;
-             { setup the map entry for deref }
-               hp^.map^[nextmapentry]:=loaded_unit^.symtable;
-               inc(nextmapentry);
-               if nextmapentry>maxunits then
-                Message(unit_f_too_much_units);
-             end;
-          { ok, now load the unit }
-            hp^.symtable:=new(punitsymtable,load(hp));
-          { if this is the system unit insert the intern symbols }
-            if compile_system then
-              begin
-                make_ref:=false;
-                insertinternsyms(psymtable(hp^.symtable));
-                make_ref:=true;
-              end;
-          end;
-       { now only read the implementation part }
-         hp^.in_implementation:=true;
-       { load the used units from implementation }
-         b:=hp^.ppufile^.readentry;
-         if b=ibloadunit_imp then
-          begin
-            while not hp^.ppufile^.endofentry do
-             begin
-               hs:=hp^.ppufile^.getstring;
-               checksum:=hp^.ppufile^.getlongint;
-               loaded_unit:=loadunit(hs,false,false);
-               if hp^.compiled then
-                exit;
-             end;
-          end;
-{$ifdef NEWPPU}
-       { The next entry should be an ibendimplementation }
-         b:=hp^.ppufile^.readentry;
-         if b <> ibendimplementation then
-          Message1(unit_f_ppu_invalid_entry,tostr(b));
-       { The next entry should be an ibend }
-         b:=hp^.ppufile^.readentry;
-         if b <> ibend then
-          Message1(unit_f_ppu_invalid_entry,tostr(b));
-{$endif}
-         hp^.ppufile^.close;
-{!         dispose(hp^.ppufile,done);}
-{$else}
          { load the used units from interface }
          hp^.ppufile^.read_data(b,1,count);
          while (b=ibloadunit) do
@@ -283,7 +414,7 @@ unit pmodules;
               hp^.ppufile^.read_data(b,1,count);
            end;
          { ok, now load the unit }
-         hp^.symtable:=new(punitsymtable,load(hp));
+         hp^.symtable:=new(punitsymtable,load(hp^.modulename^));
          { if this is the system unit insert the intern }
          { symbols                                      }
          make_ref:=false;
@@ -334,7 +465,6 @@ unit pmodules;
               hp^.ppufile^.read_data(b,1,count);
            end;
          hp^.ppufile^.close;
-{$endif}
          dispose(hp^.map);
          hp^.map:=nil;
       end;
@@ -410,11 +540,7 @@ unit pmodules;
                     OnlyAsm(hp^.asmfilename^);
                  { we should know there the PPU file else it's an error and
                    we can't load the unit }
-{$ifdef NEWPPU}
-{                  if hp^.ppufile^.name^<>'' then}
-{$else}
                   if hp^.ppufile^.name^<>'' then
-{$endif}
                     load_ppu(old_current_module,hp,compile_system);
                  { add the files for the linker }
                   addlinkerfiles(hp);
@@ -460,7 +586,7 @@ unit pmodules;
                     { here we need to remove the names ! }
                     hp^.sourcefiles.done;
                     hp^.sourcefiles.init;
-{$endif not UseBrowser}
+{$endif UseBrowser}
                    if assigned(old_current_module^.current_inputfile) then
                      old_current_module^.current_inputfile^.tempclose;
                    Message1(parser_d_compiling_second_time,hp^.mainsource^);
@@ -480,6 +606,47 @@ unit pmodules;
          loadunit:=hp;
       end;
 
+{$endif NEWPPU}
+
+
+    procedure loadsystemunit;
+      var
+        hp : pmodule;
+      begin
+      { if the current file isn't a system unit the the system unit
+        will be loaded }
+        if not(cs_compilesystem in aktswitches) then
+          begin
+{$ifdef NEWPPU}
+            hp:=loadunit(upper(target_info.system_unit),true);
+            systemunit:=hp^.symtable;
+          { add to the used units }
+            current_module^.used_units.concat(new(pused_unit,init(hp,true)));
+{$else NEWPPU}
+            hp:=loadunit(upper(target_info.system_unit),true,true);
+            systemunit:=hp^.symtable;
+          { add to the used units }
+            current_module^.used_units.concat(new(pused_unit,init(hp,0)));
+{$endif NEWPPU}
+          { read default constant definitions }
+            make_ref:=false;
+            readconstdefs;
+          { we could try to overload caret by default }
+            symtablestack:=systemunit;
+          { if POWER is defined in the RTL then use it for starstar overloading }
+            getsym('POWER',false);
+            if assigned(srsym) and (srsym^.typ=procsym) and
+               (overloaded_operators[STARSTAR]=nil) then
+              overloaded_operators[STARSTAR]:=pprocsym(srsym);
+            make_ref:=true;
+          end
+        else
+          begin
+             createconstdefs;
+             systemunit:=nil;
+          end;
+      end;
+
 
     procedure loadunits;
       var
@@ -497,7 +664,14 @@ unit pmodules;
          repeat
            s:=pattern;
            consume(ID);
+{$ifdef NEWPPU}
+           hp2:=loadunit(s,false);
+         { the current module uses the unit hp2 }
+           current_module^.used_units.concat(new(pused_unit,init(hp2,not current_module^.in_implementation)));
+           pused_unit(current_module^.used_units.last)^.in_uses:=true;
+{$else NEWPPU}
            hp2:=loadunit(s,false,true);
+{$endif NEWPPU}
            if current_module^.compiled then
              exit;
            refsymtable^.insert(new(punitsym,init(s,hp2^.symtable)));
@@ -512,10 +686,11 @@ unit pmodules;
          until false;
          consume(SEMICOLON);
 
-         { now insert the units in the symtablestack }
-          hp:=pused_unit(current_module^.used_units.first);
          { set the symtable to systemunit so it gets reorderd correctly }
          symtablestack:=systemunit;
+
+         { now insert the units in the symtablestack }
+         hp:=pused_unit(current_module^.used_units.first);
          while assigned(hp) do
            begin
 {$IfDef GDB}
@@ -700,7 +875,6 @@ unit pmodules;
          consume(_IMPLEMENTATION);
 
          parse_only:=false;
-         refsymtable^.number_defs;
 
 {$ifdef GDB}
          { add all used definitions even for implementation}
@@ -733,6 +907,10 @@ unit pmodules;
          { to reinsert it after loading the implementation units }
          symtablestack:=unitst^.next;
 
+         { number the definitions, so a deref from other units works }
+	 numberunits;
+         refsymtable^.number_defs;
+
          { Read the implementation units }
          parse_implementation_uses(unitst);
 
@@ -968,7 +1146,11 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.28  1998-06-13 00:10:10  peter
+  Revision 1.29  1998-06-16 08:56:25  peter
+    + targetcpu
+    * cleaner pmodules for newppu
+
+  Revision 1.28  1998/06/13 00:10:10  peter
     * working browser and newppu
     * some small fixes against crashes which occured in bp7 (but not in
       fpc?!)

compiler/ppu.pas

@@ -82,12 +82,10 @@ const
   ibsetdef        = 50;
   ibprocvardef    = 51;
   ibfloatdef      = 52;
-  ibextsymref     = 53;
-  ibextdefref     = 54;
-  ibclassrefdef   = 55;
-  iblongstringdef = 56;
-  ibansistringdef = 57;
-  ibwidestringdef = 58;
+  ibclassrefdef   = 53;
+  iblongstringdef = 54;
+  ibansistringdef = 55;
+  ibwidestringdef = 56;
 
 { unit flags }
   uf_init           = $1;
@@ -106,6 +104,7 @@ type
     id       : array[1..3] of char; { = 'PPU' }
     ver      : array[1..3] of char;
     compiler : word;
+    cpu      : word;
     target   : word;
     flags    : longint;
     size     : longint; { size of the ppufile without header }
@@ -750,7 +749,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.5  1998-06-13 00:10:12  peter
+  Revision 1.6  1998-06-16 08:56:26  peter
+    + targetcpu
+    * cleaner pmodules for newppu
+
+  Revision 1.5  1998/06/13 00:10:12  peter
     * working browser and newppu
     * some small fixes against crashes which occured in bp7 (but not in
       fpc?!)

compiler/rai386.pas

@@ -1347,8 +1347,8 @@ var
 
     { this makes cpu.pp uncompilable, but i think this code should be }
     { inserted in the system unit anyways.                            }
-    if (instruc >= lastop_in_table) and
-       ((cs_compilesystem in aktswitches) or (aktoptprocessor > systems.i386)) then
+    if (instruc >= lastop_in_table) then
+{       ((cs_compilesystem in aktswitches) or (aktoptprocessor > systems.i386)) then }
       begin
          Message(assem_w_opcode_not_in_table);
          fits:=true;
@@ -3376,7 +3376,11 @@ Begin
 end.
 {
   $Log$
-  Revision 1.10  1998-06-12 10:32:33  pierre
+  Revision 1.11  1998-06-16 08:56:28  peter
+    + targetcpu
+    * cleaner pmodules for newppu
+
+  Revision 1.10  1998/06/12 10:32:33  pierre
     * column problem hopefully solved
     + C vars declaration changed
 

compiler/ratti386.pas

@@ -1539,7 +1539,7 @@ const
     { the att version only if the processor > i386 or we are compiling  }
     { the system unit then this will be allowed...                      }
     if (instruc >= lastop_in_table) and
-       ((cs_compilesystem in aktswitches) or (aktoptprocessor >systems.i386)) then
+       ((cs_compilesystem in aktswitches) or (aktoptprocessor>int386)) then
       begin
          Message1(assem_w_opcode_not_in_table,att_op2str[instruc]);
          fits:=true;
@@ -3691,7 +3691,11 @@ end.
 
 {
   $Log$
-  Revision 1.12  1998-06-12 10:32:35  pierre
+  Revision 1.13  1998-06-16 08:56:29  peter
+    + targetcpu
+    * cleaner pmodules for newppu
+
+  Revision 1.12  1998/06/12 10:32:35  pierre
     * column problem hopefully solved
     + C vars declaration changed
 

compiler/scanner.pas

@@ -147,6 +147,7 @@ unit scanner;
         orgpattern,
         pattern        : string;
         macrobuffer    : pmacrobuffer;
+        currlinepos,
         lastlinepos,
         lasttokenpos,
         inputbuffer,
@@ -336,7 +337,7 @@ unit scanner;
             end;
            inputbuffer[readsize]:=#0;
            inputpointer:=inputbuffer;
-           lastlinepos:=inputpointer;
+           currlinepos:=inputpointer;
          { Set EOF when main source and at endoffile }
            if eof(current_module^.current_inputfile^.f) then
             begin
@@ -354,8 +355,9 @@ unit scanner;
            status.currentsource:=current_module^.current_inputfile^.name^+current_module^.current_inputfile^.ext^;
            inputbuffer:=current_module^.current_inputfile^.buf;
            inputpointer:=inputbuffer+current_module^.current_inputfile^.bufpos;
-           lastlinepos:=inputpointer;
+           currlinepos:=inputpointer;
          end;
+        lastlinepos:=currlinepos;
       { load next char }
         c:=inputpointer^;
         inc(longint(inputpointer));
@@ -387,7 +389,7 @@ unit scanner;
         inc(current_module^.current_inputfile^.true_line);
         status.currentline:=current_module^.current_inputfile^.true_line;
         inc(status.compiledlines);
-        lastlinepos:=inputpointer;
+        currlinepos:=inputpointer;
       end;
 
 
@@ -709,6 +711,7 @@ unit scanner;
         until false;
 
       { Save current token position }
+        lastlinepos:=currlinepos;
         lasttokenpos:=inputpointer;
         tokenpos.line:=current_module^.current_inputfile^.true_line;
         tokenpos.column:=get_file_col;
@@ -1173,6 +1176,7 @@ unit scanner;
         comment_level:=0;
         lasttokenpos:=inputpointer;
         lastlinepos:=inputpointer;
+        currlinepos:=inputpointer;
         s_point:=false;
         block_type:=bt_general;
      end;
@@ -1263,7 +1267,11 @@ unit scanner;
 end.
 {
   $Log$
-  Revision 1.25  1998-06-13 00:10:15  peter
+  Revision 1.26  1998-06-16 08:56:30  peter
+    + targetcpu
+    * cleaner pmodules for newppu
+
+  Revision 1.25  1998/06/13 00:10:15  peter
     * working browser and newppu
     * some small fixes against crashes which occured in bp7 (but not in
       fpc?!)

compiler/symdef.inc

@@ -406,10 +406,10 @@
            writelong(len);
 {$ifdef NEWPPU}
          case string_typ of
-           shortstring : ppufile^.writeentry(ibstringdef);
-            longstring : ppufile^.writeentry(iblongstringdef);
-            ansistring : ppufile^.writeentry(ibansistringdef);
-            widestring : ppufile^.writeentry(ibwidestringdef);
+           shortstring : current_ppu^.writeentry(ibstringdef);
+            longstring : current_ppu^.writeentry(iblongstringdef);
+            ansistring : current_ppu^.writeentry(ibansistringdef);
+            widestring : current_ppu^.writeentry(ibwidestringdef);
          end;
 {$endif}
       end;
@@ -535,7 +535,7 @@
          tdef.write;
          writelong(max);
 {$ifdef NEWPPU}
-         ppufile^.writeentry(ibenumdef);
+         current_ppu^.writeentry(ibenumdef);
 {$endif}
       end;
 
@@ -699,7 +699,7 @@
          writelong(low);
          writelong(high);
 {$ifdef NEWPPU}
-         ppufile^.writeentry(iborddef);
+         current_ppu^.writeentry(iborddef);
 {$endif}
       end;
 
@@ -772,7 +772,7 @@
          tdef.write;
          writebyte(byte(typ));
 {$ifdef NEWPPU}
-         ppufile^.writeentry(ibfloatdef);
+         current_ppu^.writeentry(ibfloatdef);
 {$endif}
       end;
 
@@ -892,7 +892,7 @@
          if filetype=ft_typed then
            writedefref(typed_as);
 {$ifdef NEWPPU}
-         ppufile^.writeentry(ibfiledef);
+         current_ppu^.writeentry(ibfiledef);
 {$endif}
       end;
 
@@ -1013,7 +1013,7 @@
          tdef.write;
          writedefref(definition);
 {$ifdef NEWPPU}
-         ppufile^.writeentry(ibpointerdef);
+         current_ppu^.writeentry(ibpointerdef);
 {$endif}
       end;
 
@@ -1099,7 +1099,7 @@
          tdef.write;
          writedefref(definition);
 {$ifdef NEWPPU}
-         ppufile^.writeentry(ibclassrefdef);
+         current_ppu^.writeentry(ibclassrefdef);
 {$endif}
       end;
 
@@ -1177,7 +1177,7 @@
          if settype=varset then
            writelong(savesize);
 {$ifdef NEWPPU}
-         ppufile^.writeentry(ibsetdef);
+         current_ppu^.writeentry(ibsetdef);
 {$endif}
       end;
 
@@ -1240,7 +1240,7 @@
 {$endif}
          tdef.write;
 {$ifdef NEWPPU}
-         ppufile^.writeentry(ibformaldef);
+         current_ppu^.writeentry(ibformaldef);
 {$endif}
       end;
 
@@ -1327,7 +1327,7 @@
          writelong(lowrange);
          writelong(highrange);
 {$ifdef NEWPPU}
-         ppufile^.writeentry(ibarraydef);
+         current_ppu^.writeentry(ibarraydef);
 {$endif}
       end;
 
@@ -1483,7 +1483,7 @@
          tdef.write;
          writelong(savesize);
 {$ifdef NEWPPU}
-         ppufile^.writeentry(ibrecorddef);
+         current_ppu^.writeentry(ibrecorddef);
 {$endif}
          self.symtable^.writeasstruct;
          read_member:=oldread_member;
@@ -1862,8 +1862,6 @@
          lastwritten:=nil;
          defref:=nil;
          refcount:=0;
-         if (current_module^.flags and uf_has_browser)<>0 then
-           load_references;
 {$endif UseBrowser}
       end;
 
@@ -1875,7 +1873,7 @@
       var
         pos : tfileposinfo;
       begin
-        while (not ppufile^.endofentry) do
+        while (not current_ppu^.endofentry) do
          begin
            readposinfo(pos);
            inc(refcount);
@@ -1904,7 +1902,7 @@
              writeposinfo(ref^.posinfo);
              ref:=ref^.nextref;
           end;
-        ppufile^.writeentry(ibdefref);
+        current_ppu^.writeentry(ibdefref);
         lastwritten:=lastref;
       end;
 
@@ -2051,7 +2049,7 @@
                }
            end;
 {$ifdef NEWPPU}
-         ppufile^.writeentry(ibprocdef);
+         current_ppu^.writeentry(ibprocdef);
 {$endif}
       end;
 
@@ -2219,7 +2217,7 @@
 {$endif StoreFPULevel}
          inherited write;
 {$ifdef NEWPPU}
-         ppufile^.writeentry(ibprocvardef);
+         current_ppu^.writeentry(ibprocvardef);
 {$endif}
       end;
 
@@ -2471,7 +2469,7 @@
          writedefref(childof);
          writelong(options);
 {$ifdef NEWPPU}
-         ppufile^.writeentry(ibobjectdef);
+         current_ppu^.writeentry(ibobjectdef);
 {$endif}
          if (options and (oo_hasprivate or oo_hasprotected))<>0 then
            object_options:=true;
@@ -2646,7 +2644,11 @@
 
 {
   $Log$
-  Revision 1.13  1998-06-15 15:38:09  pierre
+  Revision 1.14  1998-06-16 08:56:31  peter
+    + targetcpu
+    * cleaner pmodules for newppu
+
+  Revision 1.13  1998/06/15 15:38:09  pierre
     * small bug in systems.pas corrected
     + operators in different units better hanlded
 

compiler/symppu.inc

@@ -31,45 +31,46 @@
     {$ENDIF}
 {$ENDIF}
 
+
+{$ifdef NEWPPU}
+
 {*****************************************************************************
                                  PPU Writing
 *****************************************************************************}
 
-{$ifdef NEWPPU}
-
     procedure writebyte(b:byte);
       begin
-        ppufile^.putbyte(b);
+        current_ppu^.putbyte(b);
       end;
 
 
     procedure writeword(w:word);
       begin
-        ppufile^.putword(w);
+        current_ppu^.putword(w);
       end;
 
 
     procedure writelong(l:longint);
       begin
-        ppufile^.putlongint(l);
+        current_ppu^.putlongint(l);
       end;
 
 
     procedure writedouble(d:double);
       begin
-        ppufile^.putdata(d,sizeof(double));
+        current_ppu^.putdata(d,sizeof(double));
       end;
 
 
     procedure writestring(const s:string);
       begin
-        ppufile^.putstring(s);
+        current_ppu^.putstring(s);
       end;
 
 
     procedure writeset(var s); {You cannot pass an array[0..31] of byte!}
       begin
-        ppufile^.putdata(s,32);
+        current_ppu^.putdata(s,32);
       end;
 
 
@@ -83,11 +84,11 @@
         while not p.empty do
          begin
            s:=p.get;
-           ppufile^.putstring(s);
+           current_ppu^.putstring(s);
            if hold then
             hcontainer.insert(s);
          end;
-        ppufile^.writeentry(id);
+        current_ppu^.writeentry(id);
         if hold then
          p:=hcontainer;
       end;
@@ -95,23 +96,23 @@
 
     procedure writeposinfo(const p:tfileposinfo);
       begin
-        writeword(p.fileindex);
-        writelong(p.line);
-        writeword(p.column);
+        current_ppu^.putword(p.fileindex);
+        current_ppu^.putlongint(p.line);
+        current_ppu^.putword(p.column);
       end;
 
 
     procedure writedefref(p : pdef);
       begin
         if p=nil then
-         ppufile^.putlongint($ffffffff)
+         current_ppu^.putlongint($ffffffff)
         else
          begin
            if (p^.owner^.symtabletype in [recordsymtable,objectsymtable]) then
-            ppufile^.putword($ffff)
+            current_ppu^.putword($ffff)
            else
-            ppufile^.putword(p^.owner^.unitid);
-           ppufile^.putword(p^.indexnb);
+            current_ppu^.putword(p^.owner^.unitid);
+           current_ppu^.putword(p^.indexnb);
          end;
       end;
 
@@ -119,159 +120,57 @@
     procedure writesymref(p : psym);
       begin
         if p=nil then
-         writelong($ffffffff)
+         current_ppu^.putlongint($ffffffff)
         else
          begin
            if (p^.owner^.symtabletype in [recordsymtable,objectsymtable]) then
-            writeword($ffff)
+            current_ppu^.putword($ffff)
            else
-            writeword(p^.owner^.unitid);
-           writeword(p^.indexnb);
+            current_ppu^.putword(p^.owner^.unitid);
+           current_ppu^.putword(p^.indexnb);
          end;
       end;
 
 
-    procedure writeunitas(const s : string;unittable : punitsymtable);
-      begin
-         Message1(unit_u_ppu_write,s);
-
-       { create unit flags }
-         with Current_Module^ do
-          begin
-            if cs_smartlink in aktswitches then
-             begin
-               flags:=flags or uf_smartlink;
-               if SplitName(ppufilename^)<>SplitName(libfilename^) then
-                 flags:=flags or uf_in_library;
-             end;
-            if use_dbx then
-             flags:=flags or uf_has_dbx;
-            if target_os.endian=en_big_endian then
-             flags:=flags or uf_big_endian;
-{$ifdef UseBrowser}
-            if cs_browser in aktswitches then
-             flags:=flags or uf_has_browser;
-{$endif UseBrowser}
-          end;
-
-       { open ppufile }
-         ppufile:=new(pppufile,init(s));
-         ppufile^.change_endian:=source_os.endian<>target_os.endian;
-         if not ppufile^.create then
-          Message(unit_f_ppu_cannot_write);
-
-       { write symbols and definitions }
-         unittable^.writeasunit;
-
-       { flush to be sure }
-         ppufile^.flush;
-       { create and write header }
-         ppufile^.header.size:=ppufile^.size;
-         ppufile^.header.checksum:=ppufile^.crc;
-         ppufile^.header.compiler:=wordversion;
-         ppufile^.header.target:=word(target_info.target);
-         ppufile^.header.flags:=current_module^.flags;
-         ppufile^.writeheader;
-       { save crc in current_module also }
-         current_module^.crc:=ppufile^.crc;
-       { close }
-         ppufile^.close;
-         dispose(ppufile,done);
-      end;
-
-
-{$else NEWPPU}
-
-    procedure writebyte(b:byte);
-      begin
-        ppufile.write_data(b,1);
-      end;
-
-    procedure writeword(w:word);
-      begin
-        ppufile.write_data(w,2);
-      end;
-
-    procedure writelong(l:longint);
-      begin
-        ppufile.write_data(l,4);
-      end;
-
-    procedure writedouble(d:double);
-      begin
-        ppufile.write_data(d,sizeof(double));
-      end;
-
-    procedure writestring(s : string);
-      begin
-        ppufile.write_data(s,length(s)+1);
-      end;
-
-    procedure writeset(var s); {You cannot pass an array[0..31] of byte!}
-      begin
-        ppufile.write_data(s,32);
-      end;
-
-    procedure writecontainer(var p:tstringcontainer;id:byte;hold:boolean);
+    procedure writesourcefiles;
       var
-        hcontainer : tstringcontainer;
-        s          : string;
+        hp2   : pextfile;
+        index : longint;
       begin
-        if hold then
-         hcontainer.init;
-        while not p.empty do
+      { second write the used source files }
+        hp2:=current_module^.sourcefiles.files;
+        index:=current_module^.sourcefiles.last_ref_index;
+        while assigned(hp2) do
          begin
-           writebyte(id);
-           s:=p.get;
-           writestring(s);
-           if hold then
-            hcontainer.insert(s);
+         { only name and extension }
+           current_ppu^.putstring(hp2^.name^+hp2^.ext^);
+         { index in that order }
+           hp2^.ref_index:=index;
+           dec(index);
+           hp2:=hp2^._next;
          end;
-        if hold then
-         p:=hcontainer;
+        current_ppu^.writeentry(ibsourcefiles);
       end;
 
 
-    procedure writeposinfo(const p:tfileposinfo);
-      begin
-        writeword(p.fileindex);
-        writelong(p.line);
-        writeword(p.column);
-      end;
-
-    procedure writedefref(p : pdef);
+    procedure writeusedunit;
+      var
+        hp      : pused_unit;
       begin
-        if p=nil then
-         writelong($ffffffff)
-        else
+      numberunits;
+        hp:=pused_unit(current_module^.used_units.first);
+        while assigned(hp) do
          begin
-           if (p^.owner^.symtabletype in [recordsymtable,objectsymtable]) then
-            writeword($ffff)
-           else
-            writeword(p^.owner^.unitid);
-           writeword(p^.indexnb);
+           current_ppu^.putstring(hp^.name^);
+           current_ppu^.putlongint(hp^.checksum);
+           current_ppu^.putbyte(byte(hp^.in_interface));
+           hp:=pused_unit(hp^.next);
          end;
+        current_ppu^.writeentry(ibloadunit_int);
       end;
 
-    procedure writesymref(p : psym);
-      begin
-        if p=nil then
-         writelong($ffffffff)
-        else
-         begin
-           if (p^.owner^.symtabletype in [recordsymtable,objectsymtable]) then
-            writeword($ffff)
-           else
-            writeword(p^.owner^.unitid);
-           writeword(p^.indexnb);
-         end;
-      end;
 
     procedure writeunitas(const s : string;unittable : punitsymtable);
-{$ifdef UseBrowser}
-      var
-         pus : punitsymtable;
-{$endif UseBrowser}
       begin
          Message1(unit_u_ppu_write,s);
 
@@ -289,134 +188,258 @@
             if target_os.endian=en_big_endian then
              flags:=flags or uf_big_endian;
 {$ifdef UseBrowser}
-            if use_browser then
-             flags:=flags or uf_uses_browser;
+            if cs_browser in aktswitches then
+             flags:=flags or uf_has_browser;
 {$endif UseBrowser}
           end;
 
-       { open en init ppufile }
-         ppufile.init(s,ppubufsize);
-         ppufile.change_endian:=source_os.endian<>target_os.endian;
-         ppufile.rewrite;
-         if ioresult<>0 then
+       { open ppufile }
+         current_ppu:=new(pppufile,init(s));
+         current_ppu^.change_endian:=source_os.endian<>target_os.endian;
+         if not current_ppu^.create then
           Message(unit_f_ppu_cannot_write);
-       { create and write header }
-         unitheader[8]:=char(byte(target_info.target));
-         unitheader[9]:=char(current_module^.flags);
-         ppufile.write_data(unitheader,sizeof(unitheader));
-         ppufile.clear_crc;
-         ppufile.do_crc:=true;
+
+       { write symbols and definitions }
          unittable^.writeasunit;
-         ppufile.flush;
-         ppufile.do_crc:=false;
-{$ifdef UseBrowser}
-         { write all new references to old unit elements }
-         pus:=punitsymtable(unittable^.next);
-         if use_browser then
-         while assigned(pus) do
-           begin
-              if pus^.symtabletype = unitsymtable then
-                pus^.write_external_references;
-              pus:=punitsymtable(pus^.next);
-           end;
-{$endif UseBrowser}
-         { writes the checksum }
-         ppufile.seek(10);
-         current_module^.crc:=ppufile.getcrc;
-         ppufile.write_data(current_module^.crc,4);
-         ppufile.flush;
-         ppufile.done;
+
+       { flush to be sure }
+         current_ppu^.flush;
+       { create and write header }
+         current_ppu^.header.size:=current_ppu^.size;
+         current_ppu^.header.checksum:=current_ppu^.crc;
+         current_ppu^.header.compiler:=wordversion;
+         current_ppu^.header.cpu:=word(target_cpu);
+         current_ppu^.header.target:=word(target_info.target);
+         current_ppu^.header.flags:=current_module^.flags;
+         current_ppu^.writeheader;
+       { save crc in current_module also }
+         current_module^.crc:=current_ppu^.crc;
+       { close }
+         current_ppu^.close;
+         dispose(current_ppu,done);
       end;
 
-{$endif NEWPPU}
 
 {*****************************************************************************
                                  PPU Reading
 *****************************************************************************}
 
-{$ifdef NEWPPU}
     function readbyte:byte;
       begin
-        readbyte:=ppufile^.getbyte;
-        if ppufile^.error then
+        readbyte:=current_ppu^.getbyte;
+        if current_ppu^.error then
          Message(unit_f_ppu_read_error);
       end;
 
+
     function readword:word;
       begin
-        readword:=ppufile^.getword;
-        if ppufile^.error then
+        readword:=current_ppu^.getword;
+        if current_ppu^.error then
          Message(unit_f_ppu_read_error);
       end;
 
+
     function readlong:longint;
       begin
-        readlong:=ppufile^.getlongint;
-        if ppufile^.error then
+        readlong:=current_ppu^.getlongint;
+        if current_ppu^.error then
          Message(unit_f_ppu_read_error);
       end;
 
+
     function readdouble : double;
       var
          d : double;
       begin
-        ppufile^.getdata(d,sizeof(double));
-        if ppufile^.error then
+        current_ppu^.getdata(d,sizeof(double));
+        if current_ppu^.error then
          Message(unit_f_ppu_read_error);
         readdouble:=d;
       end;
 
+
     function readstring : string;
       begin
-        readstring:=ppufile^.getstring;
-        if ppufile^.error then
+        readstring:=current_ppu^.getstring;
+        if current_ppu^.error then
          Message(unit_f_ppu_read_error);
       end;
 
+
     procedure readset(var s);   {You cannot pass an array [0..31] of byte.}
       begin
-        ppufile^.getdata(s,32);
-        if ppufile^.error then
+        current_ppu^.getdata(s,32);
+        if current_ppu^.error then
          Message(unit_f_ppu_read_error);
       end;
 
+
     procedure readcontainer(var p:tstringcontainer);
       begin
-        while not current_module^.ppufile^.endofentry do
-         p.insert(current_module^.ppufile^.getstring);
+        while not current_ppu^.endofentry do
+         p.insert(current_ppu^.getstring);
       end;
 
+
     procedure readposinfo(var p:tfileposinfo);
       begin
-        p.fileindex:=readword;
-        p.line:=readlong;
-        p.column:=readword;
+        p.fileindex:=current_ppu^.getword;
+        p.line:=current_ppu^.getlongint;
+        p.column:=current_ppu^.getword;
       end;
 
+
     function readdefref : pdef;
       var
         hd : pdef;
       begin
-        longint(hd):=readword;
-        longint(hd):=longint(hd) or (longint(readword) shl 16);
+        longint(hd):=current_ppu^.getword;
+        longint(hd):=longint(hd) or (longint(current_ppu^.getword) shl 16);
         readdefref:=hd;
       end;
 
+
 {$ifdef UseBrowser}
     function readsymref : psym;
       var
         hd : psym;
       begin
-        longint(hd):=readword;
-        longint(hd):=longint(hd) or (longint(readword) shl 16);
+        longint(hd):=current_ppu^.getword;
+        longint(hd):=longint(hd) or (longint(current_ppu^.getword) shl 16);
         readsymref:=hd;
       end;
 {$endif}
 
 
+    procedure readsourcefiles;
+      var
+        temp,hs       : string;
+        incfile_found : boolean;
+        ppufiletime,
+        source_time   : longint;
+{$ifdef UseBrowser}
+        hp : pextfile;
+        _d,_n,_e : string;
+{$endif UseBrowser}
+      begin
+        ppufiletime:=getnamedfiletime(current_module^.ppufilename^);
+        current_module^.sources_avail:=true;
+        while not current_ppu^.endofentry do
+         begin
+           hs:=current_ppu^.getstring;
+           temp:='';
+           if (current_module^.flags and uf_in_library)<>0 then
+            begin
+              current_module^.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(current_module^.path^+hs);
+              if Source_Time=-1 then
+                begin
+                { search for include files in the includepathlist }
+                  temp:=search(hs,includesearchpath,incfile_found);
+                  if incfile_found then
+                   begin
+                     hs:=temp+hs;
+                     Source_Time:=GetNamedFileTime(hs);
+                   end;
+                end
+              else
+                hs:=current_module^.path^+hs;
+              if Source_Time=-1 then
+               begin
+                 current_module^.sources_avail:=false;
+                 temp:=' not found';
+               end
+              else
+               begin
+                 temp:=' time '+filetimestring(source_time);
+                 if (source_time>ppufiletime) then
+                  begin
+                    current_module^.do_compile:=true;
+                    temp:=temp+' *'
+                  end;
+               end;
+            end;
+           Message1(unit_t_ppu_source,hs+temp);
+{$ifdef UseBrowser}
+           fsplit(hs,_d,_n,_e);
+           new(hp,init(_d,_n,_e));
+           { the indexing should match what is done in writeasunit }
+           current_module^.sourcefiles.register_file(hp);
+{$endif UseBrowser}
+         end;
+      { main source is always the last }
+        stringdispose(current_module^.mainsource);
+        current_module^.mainsource:=stringdup(hs);
+      { check if we want to rebuild every unit, only if the sources are
+        available }
+        if do_build and current_module^.sources_avail then
+         current_module^.do_compile:=true;
+      end;
+
+
+    procedure readloadunit;
+      var
+        hs : string;
+        checksum : longint;
+        in_interface : boolean;
+      begin
+        while not current_ppu^.endofentry do
+         begin
+           hs:=current_ppu^.getstring;
+           checksum:=current_ppu^.getlongint;
+           in_interface:=(current_ppu^.getbyte<>0);
+           current_module^.used_units.concat(new(pused_unit,init_to_load(hs,checksum,in_interface)));
+         end;
+      end;
+
+
+    procedure load_interface;
+      var
+        b : byte;
+      begin
+       { read interface part }
+         repeat
+           b:=current_ppu^.readentry;
+           case b of
+            { ibinitunit : usedunits^.insert(readstring); }
+            ibmodulename : begin
+                             stringdispose(current_module^.modulename);
+                             current_module^.modulename:=stringdup(current_ppu^.getstring);
+                           end;
+           ibsourcefiles : readsourcefiles;
+          ibloadunit_int : readloadunit;
+        iblinksharedlibs : readcontainer(current_module^.LinkSharedLibs);
+        iblinkstaticlibs : readcontainer(current_module^.LinkStaticLibs);
+            iblinkofiles : readcontainer(current_module^.LinkOFiles);
+          ibendinterface : break;
+           else
+             Message1(unit_f_ppu_invalid_entry,tostr(b));
+           end;
+         until false;
+      end;
+
+
 {$else NEWPPU}
 
 
+{*****************************************************************************
+
+                               Old PPU
+
+*****************************************************************************}
+
     function readbyte : byte;
 
       var
@@ -522,11 +545,163 @@
       end;
 {$endif UseBrowser}
 
+    procedure writebyte(b:byte);
+      begin
+        ppufile.write_data(b,1);
+      end;
+
+    procedure writeword(w:word);
+      begin
+        ppufile.write_data(w,2);
+      end;
+
+    procedure writelong(l:longint);
+      begin
+        ppufile.write_data(l,4);
+      end;
+
+    procedure writedouble(d:double);
+      begin
+        ppufile.write_data(d,sizeof(double));
+      end;
+
+    procedure writestring(s : string);
+      begin
+        ppufile.write_data(s,length(s)+1);
+      end;
+
+    procedure writeset(var s); {You cannot pass an array[0..31] of byte!}
+      begin
+        ppufile.write_data(s,32);
+      end;
+
+    procedure writecontainer(var p:tstringcontainer;id:byte;hold:boolean);
+      var
+        hcontainer : tstringcontainer;
+        s          : string;
+      begin
+        if hold then
+         hcontainer.init;
+        while not p.empty do
+         begin
+           writebyte(id);
+           s:=p.get;
+           writestring(s);
+           if hold then
+            hcontainer.insert(s);
+         end;
+        if hold then
+         p:=hcontainer;
+      end;
+
+
+    procedure writeposinfo(const p:tfileposinfo);
+      begin
+        writeword(p.fileindex);
+        writelong(p.line);
+        writeword(p.column);
+      end;
+
+    procedure writedefref(p : pdef);
+      begin
+        if p=nil then
+         writelong($ffffffff)
+        else
+         begin
+           if (p^.owner^.symtabletype in [recordsymtable,objectsymtable]) then
+            writeword($ffff)
+           else
+            writeword(p^.owner^.unitid);
+           writeword(p^.indexnb);
+         end;
+      end;
+
+    procedure writesymref(p : psym);
+      begin
+        if p=nil then
+         writelong($ffffffff)
+        else
+         begin
+           if (p^.owner^.symtabletype in [recordsymtable,objectsymtable]) then
+            writeword($ffff)
+           else
+            writeword(p^.owner^.unitid);
+           writeword(p^.indexnb);
+         end;
+      end;
+
+    procedure writeunitas(const s : string;unittable : punitsymtable);
+{$ifdef UseBrowser}
+      var
+         pus : punitsymtable;
+{$endif UseBrowser}
+      begin
+         Message1(unit_u_ppu_write,s);
+
+       { create unit flags }
+         with Current_Module^ do
+          begin
+            if cs_smartlink in aktswitches then
+             begin
+               flags:=flags or uf_smartlink;
+               if SplitName(ppufilename^)<>SplitName(libfilename^) then
+                 flags:=flags or uf_in_library;
+             end;
+            if use_dbx then
+             flags:=flags or uf_has_dbx;
+            if target_os.endian=en_big_endian then
+             flags:=flags or uf_big_endian;
+{$ifdef UseBrowser}
+            if use_browser then
+             flags:=flags or uf_uses_browser;
+{$endif UseBrowser}
+          end;
+
+       { open en init ppufile }
+         ppufile.init(s,ppubufsize);
+         ppufile.change_endian:=source_os.endian<>target_os.endian;
+         ppufile.rewrite;
+         if ioresult<>0 then
+          Message(unit_f_ppu_cannot_write);
+       { create and write header }
+         unitheader[8]:=char(byte(target_info.target));
+         unitheader[9]:=char(current_module^.flags);
+         ppufile.write_data(unitheader,sizeof(unitheader));
+         ppufile.clear_crc;
+         ppufile.do_crc:=true;
+         unittable^.writeasunit;
+         ppufile.flush;
+         ppufile.do_crc:=false;
+{$ifdef UseBrowser}
+         { write all new references to old unit elements }
+         pus:=punitsymtable(unittable^.next);
+         if use_browser then
+         while assigned(pus) do
+           begin
+              if pus^.symtabletype = unitsymtable then
+                pus^.write_external_references;
+              pus:=punitsymtable(pus^.next);
+           end;
+{$endif UseBrowser}
+         { writes the checksum }
+         ppufile.seek(10);
+         current_module^.crc:=ppufile.getcrc;
+         ppufile.write_data(current_module^.crc,4);
+         ppufile.flush;
+         ppufile.done;
+      end;
+
+
+
 {$endif NEWPPU}
 
 {
   $Log$
-  Revision 1.3  1998-06-13 00:10:17  peter
+  Revision 1.4  1998-06-16 08:56:32  peter
+    + targetcpu
+    * cleaner pmodules for newppu
+
+  Revision 1.3  1998/06/13 00:10:17  peter
     * working browser and newppu
     * some small fixes against crashes which occured in bp7 (but not in
       fpc?!)

compiler/symsym.inc

@@ -82,7 +82,7 @@
       var
         pos : tfileposinfo;
       begin
-        while (not ppufile^.endofentry) do
+        while (not current_ppu^.endofentry) do
          begin
            readposinfo(pos);
            inc(refcount);
@@ -113,7 +113,7 @@
            ref:=ref^.nextref;
          end;
         lastwritten:=lastref;
-        ppufile^.writeentry(ibsymref);
+        current_ppu^.writeentry(ibsymref);
       { when it's a procsym then write also the refs to the definition
         due the overloading }
         if typ=procsym then
@@ -515,7 +515,7 @@
          tsym.write;
          writedefref(pdef(definition));
 {$ifdef NEWPPU}
-         ppufile^.writeentry(ibprocsym);
+         current_ppu^.writeentry(ibprocsym);
 {$endif}
       end;
 
@@ -673,7 +673,7 @@
          writedefref(readaccessdef);
          writedefref(writeaccessdef);
 {$ifdef NEWPPU}
-         ppufile^.writeentry(ibpropertysym);
+         current_ppu^.writeentry(ibpropertysym);
 {$endif}
       end;
 
@@ -756,7 +756,7 @@
           toaddr : writelong(address);
          end;
 {$ifdef NEWPPU}
-        ppufile^.writeentry(ibabsolutesym);
+        current_ppu^.writeentry(ibabsolutesym);
 {$endif}
       end;
 
@@ -900,9 +900,9 @@
            end;
 {$ifdef NEWPPU}
          if (var_options and vo_is_C_var)<>0 then
-           ppufile^.writeentry(ibvarsym_C)
+           current_ppu^.writeentry(ibvarsym_C)
          else
-         ppufile^.writeentry(ibvarsym);
+         current_ppu^.writeentry(ibvarsym);
 {$endif}
       end;
 
@@ -1239,7 +1239,7 @@
          writedefref(definition);
          writestring(prefix^);
 {$ifdef NEWPPU}
-         ppufile^.writeentry(ibtypedconstsym);
+         current_ppu^.writeentry(ibtypedconstsym);
 {$endif}
       end;
 
@@ -1387,7 +1387,7 @@
             else internalerror(13);
          end;
 {$ifdef NEWPPU}
-        ppufile^.writeentry(ibconstsym);
+        current_ppu^.writeentry(ibconstsym);
 {$endif}
       end;
 
@@ -1497,7 +1497,7 @@
          writedefref(definition);
          writelong(value);
 {$ifdef NEWPPU}
-         ppufile^.writeentry(ibenumsym);
+         current_ppu^.writeentry(ibenumsym);
 {$endif}
       end;
 
@@ -1573,7 +1573,7 @@
          tsym.write;
          writedefref(definition);
 {$ifdef NEWPPU}
-         ppufile^.writeentry(ibtypesym);
+         current_ppu^.writeentry(ibtypesym);
 {$endif}
       end;
 
@@ -1680,7 +1680,11 @@
 
 {
   $Log$
-  Revision 1.13  1998-06-15 15:38:10  pierre
+  Revision 1.14  1998-06-16 08:56:34  peter
+    + targetcpu
+    * cleaner pmodules for newppu
+
+  Revision 1.13  1998/06/15 15:38:10  pierre
     * small bug in systems.pas corrected
     + operators in different units better hanlded
 

compiler/systems.pas

@@ -28,9 +28,11 @@ unit systems;
     type
        tendian = (endian_little,en_big_endian);
 
+       ttargetcpu = (i386,m68k,alpha);
+
        tprocessors = (
        {$ifdef i386}
-              i386,i486,pentium,pentiumpro,cx6x86,pentium2,amdk6
+              int386,int486,pentium,pentiumpro,cx6x86,pentium2,amdk6
        {$endif}
        {$ifdef m68k}
               MC68000,MC68020
@@ -44,7 +46,7 @@ unit systems;
        {$endif}
        {$ifdef m68k}
 			  M68K_MOT
-	   {$endif}
+       {$endif}
 	   );
 
 
@@ -164,6 +166,14 @@ unit systems;
           idtxt : string[8];
        end;
 
+    const
+{$ifdef i386}
+       target_cpu = i386;
+{$endif i386}
+{$ifdef m68k}
+       target_cpu = m68k;
+{$endif m68k}
+
     var
        target_info : ttargetinfo;
        target_os   : tosinfo;
@@ -844,7 +854,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.20  1998-06-15 15:38:14  pierre
+  Revision 1.21  1998-06-16 08:56:36  peter
+    + targetcpu
+    * cleaner pmodules for newppu
+
+  Revision 1.20  1998/06/15 15:38:14  pierre
     * small bug in systems.pas corrected
     + operators in different units better hanlded