+ added vmt_offset in tobjectdef.write for fututre use

(first steps to have objects without vmt if no virtual !!)
  + added fpu_used field for tabstractprocdef  :
    sets this level to 2 if the functions return with value in FPU
    (is then set to correct value at parsing of implementation)
    THIS MIGHT refuse some code with FPU expression too complex
    that were accepted before and even in some cases
    that don't overflow in fact
    ( like if f : float; is a forward that finally in implementation
     only uses one fpu register !!)
    Nevertheless I think that it will improve security on
    FPU operations !!
  * most other changes only for UseBrowser code
    (added symtable references for record and objects)
    local switch for refs to args and local of each function
    (static symtable still missing)
    UseBrowser still not stable and probably broken by
    the definition hash array !!

compiler/browser.pas

@@ -41,6 +41,7 @@ type
     nextref     : pref;
     posinfo     : tfileposinfo;
     moduleindex : word;
+    is_written  : boolean;
     constructor init(ref:pref;pos:pfileposinfo);
     destructor  done; virtual;
     function  get_file_line : string;
@@ -50,7 +51,9 @@ type
   tbrowser=object
     fname    : string;
     logopen  : boolean;
+    stderrlog : boolean;
     f        : file;
+    elements_to_list : pstringqueue;
     buf      : pchar;
     bufidx   : longint;
     identidx : longint;
@@ -64,6 +67,8 @@ type
     procedure closelog;
     procedure ident;
     procedure unident;
+    procedure browse_symbol(s : string);
+    procedure list_elements;
   end;
 
 var
@@ -74,7 +79,7 @@ var
 implementation
 
   uses
-    comphook,globals,systems,verbose;
+    comphook,globals,symtable,systems,verbose;
 
 {****************************************************************************
                                TRef
@@ -90,6 +95,7 @@ implementation
           moduleindex:=current_module^.unit_index;
         if assigned(ref) then
           ref^.nextref:=@self;
+        is_written:=false;
       end;
 
 
@@ -138,6 +144,7 @@ implementation
       begin
         fname:=FixFileName('browser.log');
         logopen:=false;
+        elements_to_list:=new(pstringqueue,init);
       end;
 
 
@@ -174,7 +181,17 @@ implementation
     procedure tbrowser.flushlog;
       begin
         if logopen then
-         blockwrite(f,buf^,bufidx);
+         if not stderrlog then
+           blockwrite(f,buf^,bufidx)
+         else
+           begin
+             buf[bufidx]:=#0;
+{$ifndef TP}
+             write(stderr,buf);
+{$else TP}
+             write(buf);
+{$endif TP}
+           end;
         bufidx:=0;
       end;
 
@@ -189,7 +206,21 @@ implementation
            logopen:=false;
          end;
       end;
+      
+    procedure tbrowser.list_elements;
 
+      begin
+
+         stderrlog:=true;
+         getmem(buf,logbufsize);
+         logopen:=true;
+         while not elements_to_list^.empty do
+           browse_symbol(elements_to_list^.get);
+         flushlog;
+         logopen:=false;
+         freemem(buf,logbufsize);
+         stderrlog:=false;
+      end;
 
     procedure tbrowser.addlog(const s:string);
       begin
@@ -234,6 +265,112 @@ implementation
       end;
 
 
+    procedure tbrowser.browse_symbol(s : string);
+      var
+         sym,symb : psym;
+         symt : psymtable;
+         hp : pmodule;
+         ss : string;
+         p : byte;
+
+         procedure next_substring;
+           begin
+              p:=pos('.',s);
+              if p>0 then
+                begin
+                   ss:=copy(s,1,p-1);
+                   s:=copy(s,p+1,255);
+                end
+              else
+                begin
+                  ss:=s;
+                  s:='';
+                end;
+          end;
+      begin
+         symt:=symtablestack;
+         next_substring;
+         sym:=symt^.search(ss);
+         if not assigned(sym) then
+           begin
+              symt:=nil;
+              { try all loaded_units }
+              hp:=pmodule(loaded_units.first);
+              while assigned(hp) do
+                begin
+                   if hp^.modulename^=ss then
+                     begin
+                        symt:=hp^.symtable;
+                        break;
+                     end;
+                   hp:=pmodule(hp^.next);
+                end;
+              if not assigned(symt) then
+                begin
+                   addlog('!!!Symbol '+ss+' not found !!!');
+                   exit;
+                end
+              else
+                begin
+                   next_substring;
+                   sym:=symt^.search(ss);
+                end;
+           end;
+
+         if (sym^.typ=unitsym) and (s<>'') then
+           begin
+              symt:=punitsym(sym)^.unitsymtable;
+              next_substring;
+              sym:=symt^.search(ss);
+           end;
+         while assigned(sym) and (s<>'') do
+           begin
+              next_substring;
+              case sym^.typ of
+                typesym :
+                  begin
+                     if ptypesym(sym)^.definition^.deftype in [recorddef,objectdef] then
+                       begin
+                          if ptypesym(sym)^.definition^.deftype=recorddef then
+                            symt:=precdef(ptypesym(sym)^.definition)^.symtable
+                          else
+                            symt:=pobjectdef(ptypesym(sym)^.definition)^.publicsyms;
+                          sym:=symt^.search(ss);
+                       end;
+                  end;
+                varsym :
+                  begin
+                     if pvarsym(sym)^.definition^.deftype in [recorddef,objectdef] then
+                       begin
+                          if pvarsym(sym)^.definition^.deftype=recorddef then
+                            symt:=precdef(pvarsym(sym)^.definition)^.symtable
+                          else
+                            symt:=pobjectdef(pvarsym(sym)^.definition)^.publicsyms;
+                          sym:=symt^.search(ss);
+                       end;
+                  end;
+                procsym :
+                  begin
+                     symt:=pprocsym(sym)^.definition^.parast;
+                     symb:=symt^.search(ss);
+                     if not assigned(symb) then
+                       begin
+                          symt:=pprocsym(sym)^.definition^.parast;
+                          sym:=symt^.search(ss);
+                       end
+                     else
+                       sym:=symb;
+                  end;
+                {else
+                  sym^.add_to_browserlog;}
+                end;
+           end;
+           if assigned(sym) then
+             sym^.add_to_browserlog
+           else
+             addlog('!!!Symbol '+ss+' not found !!!');
+      end;
+      
     procedure tbrowser.ident;
       begin
         inc(identidx,2);
@@ -271,7 +408,7 @@ implementation
                    get_source_file:=f;
                    exit;
                 end;
-              f:=pinputfile(f^.next);
+              f:=pinputfile(f^.ref_next);
            end;
       end;
 
@@ -280,7 +417,27 @@ begin
 end.
 {
   $Log$
-  Revision 1.6  1998-09-01 07:54:16  pierre
+  Revision 1.7  1998-09-21 08:45:05  pierre
+    + added vmt_offset in tobjectdef.write for fututre use
+      (first steps to have objects without vmt if no virtual !!)
+    + added fpu_used field for tabstractprocdef  :
+      sets this level to 2 if the functions return with value in FPU
+      (is then set to correct value at parsing of implementation)
+      THIS MIGHT refuse some code with FPU expression too complex
+      that were accepted before and even in some cases
+      that don't overflow in fact
+      ( like if f : float; is a forward that finally in implementation
+       only uses one fpu register !!)
+      Nevertheless I think that it will improve security on
+      FPU operations !!
+    * most other changes only for UseBrowser code
+      (added symtable references for record and objects)
+      local switch for refs to args and local of each function
+      (static symtable still missing)
+      UseBrowser still not stable and probably broken by
+      the definition hash array !!
+
+  Revision 1.6  1998/09/01 07:54:16  pierre
     * UseBrowser a little updated (might still be buggy !!)
     * bug in psub.pas in function specifier removed
     * stdcall allowed in interface and in implementation

compiler/cg386cal.pas

@@ -883,6 +883,7 @@ implementation
                                          new(r);
                                          reset_reference(r^);
                                          r^.base:=R_ESI;
+                                         r^.offset:= p^.procdefinition^._class^.vmt_offset;
                                          exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
                                       end;
 
@@ -930,6 +931,7 @@ implementation
                              new(r);
                              reset_reference(r^);
                              r^.base:=R_ESI;
+                             r^.offset:= p^.procdefinition^._class^.vmt_offset;
                              exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
                           end
                         else
@@ -1024,6 +1026,8 @@ implementation
                             new(r);
                             reset_reference(r^);
                             r^.base:=R_ESI;
+                            { this is one point where we need vmt_offset (PM) }
+                            r^.offset:= p^.procdefinition^._class^.vmt_offset;
                             exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
                             new(r);
                             reset_reference(r^);
@@ -1390,7 +1394,27 @@ implementation
 end.
 {
   $Log$
-  Revision 1.25  1998-09-20 12:26:35  peter
+  Revision 1.26  1998-09-21 08:45:06  pierre
+    + added vmt_offset in tobjectdef.write for fututre use
+      (first steps to have objects without vmt if no virtual !!)
+    + added fpu_used field for tabstractprocdef  :
+      sets this level to 2 if the functions return with value in FPU
+      (is then set to correct value at parsing of implementation)
+      THIS MIGHT refuse some code with FPU expression too complex
+      that were accepted before and even in some cases
+      that don't overflow in fact
+      ( like if f : float; is a forward that finally in implementation
+       only uses one fpu register !!)
+      Nevertheless I think that it will improve security on
+      FPU operations !!
+    * most other changes only for UseBrowser code
+      (added symtable references for record and objects)
+      local switch for refs to args and local of each function
+      (static symtable still missing)
+      UseBrowser still not stable and probably broken by
+      the definition hash array !!
+
+  Revision 1.25  1998/09/20 12:26:35  peter
     * merged fixes
 
   Revision 1.24  1998/09/17 09:42:10  peter

compiler/cg386inl.pas

@@ -626,6 +626,8 @@ implementation
                          p^.location.loc:=LOC_REGISTER;
                          p^.location.register:=getregister32;
                          { load VMT pointer }
+                         inc(p^.left^.location.reference.offset,
+                           pobjectdef(p^.left^.resulttype)^.vmt_offset);
                          exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
                          newreference(p^.left^.location.reference),
                            p^.location.register)));
@@ -934,7 +936,27 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  1998-09-20 12:26:37  peter
+  Revision 1.7  1998-09-21 08:45:07  pierre
+    + added vmt_offset in tobjectdef.write for fututre use
+      (first steps to have objects without vmt if no virtual !!)
+    + added fpu_used field for tabstractprocdef  :
+      sets this level to 2 if the functions return with value in FPU
+      (is then set to correct value at parsing of implementation)
+      THIS MIGHT refuse some code with FPU expression too complex
+      that were accepted before and even in some cases
+      that don't overflow in fact
+      ( like if f : float; is a forward that finally in implementation
+       only uses one fpu register !!)
+      Nevertheless I think that it will improve security on
+      FPU operations !!
+    * most other changes only for UseBrowser code
+      (added symtable references for record and objects)
+      local switch for refs to args and local of each function
+      (static symtable still missing)
+      UseBrowser still not stable and probably broken by
+      the definition hash array !!
+
+  Revision 1.6  1998/09/20 12:26:37  peter
     * merged fixes
 
   Revision 1.5  1998/09/17 09:42:15  peter

compiler/csopt386.pas

@@ -278,7 +278,10 @@ Procedure RemoveInstructs(AsmL: PAasmOutput; First, Last: Pai);
 {Removes the marked instructions and disposes the PPaiProps of the other
  instructions, restoring theirline number}
 Var p, hp1: Pai;
-    TmpLine, InstrCnt: Longint;
+{$IfDef TP}
+    TmpLine: Longint;
+{$EndIf TP}
+    InstrCnt: Longint;
 Begin
   p := First;
   If (p^.typ in SkipInstr) Then
@@ -324,7 +327,27 @@ End.
 
 {
  $Log$
- Revision 1.7  1998-09-20 17:12:35  jonas
+ Revision 1.8  1998-09-21 08:45:09  pierre
+   + added vmt_offset in tobjectdef.write for fututre use
+     (first steps to have objects without vmt if no virtual !!)
+   + added fpu_used field for tabstractprocdef  :
+     sets this level to 2 if the functions return with value in FPU
+     (is then set to correct value at parsing of implementation)
+     THIS MIGHT refuse some code with FPU expression too complex
+     that were accepted before and even in some cases
+     that don't overflow in fact
+     ( like if f : float; is a forward that finally in implementation
+      only uses one fpu register !!)
+     Nevertheless I think that it will improve security on
+     FPU operations !!
+   * most other changes only for UseBrowser code
+     (added symtable references for record and objects)
+     local switch for refs to args and local of each function
+     (static symtable still missing)
+     UseBrowser still not stable and probably broken by
+     the definition hash array !!
+
+ Revision 1.7  1998/09/20 17:12:35  jonas
  * small fix for uncertain optimizations & more cleaning up
 
  Revision 1.5  1998/09/16 17:59:59  jonas

compiler/files.pas

@@ -94,6 +94,7 @@ unit files;
           constructor init;
           destructor done;
           procedure register_file(f : pinputfile);
+          procedure inverse_register_indexes;
           function  get_file(l:longint) : pinputfile;
           function  get_file_name(l :longint):string;
           function  get_file_path(l :longint):string;
@@ -485,6 +486,23 @@ unit files;
       end;
 
 
+   { this procedure is necessary after loading the
+     sources files from a PPU file  PM }
+   procedure tfilemanager.inverse_register_indexes;
+     var
+        f : pinputfile;
+     begin
+        f:=files;
+        while assigned(f) do
+          begin
+             f^.ref_index:=last_ref_index-f^.ref_index+1;
+             f:=f^.ref_next;
+          end;
+
+     end;
+     
+   
+   
    function tfilemanager.get_file(l :longint) : pinputfile;
      var
         ff : pinputfile;
@@ -869,7 +887,27 @@ unit files;
 end.
 {
   $Log$
-  Revision 1.45  1998-09-18 09:58:51  peter
+  Revision 1.46  1998-09-21 08:45:10  pierre
+    + added vmt_offset in tobjectdef.write for fututre use
+      (first steps to have objects without vmt if no virtual !!)
+    + added fpu_used field for tabstractprocdef  :
+      sets this level to 2 if the functions return with value in FPU
+      (is then set to correct value at parsing of implementation)
+      THIS MIGHT refuse some code with FPU expression too complex
+      that were accepted before and even in some cases
+      that don't overflow in fact
+      ( like if f : float; is a forward that finally in implementation
+       only uses one fpu register !!)
+      Nevertheless I think that it will improve security on
+      FPU operations !!
+    * most other changes only for UseBrowser code
+      (added symtable references for record and objects)
+      local switch for refs to args and local of each function
+      (static symtable still missing)
+      UseBrowser still not stable and probably broken by
+      the definition hash array !!
+
+  Revision 1.45  1998/09/18 09:58:51  peter
     * -s doesn't require the .o to be available, this allows compiling of
       everything on other platforms (profiling the windows.pp loading ;)
 

compiler/parser.pas

@@ -355,10 +355,13 @@ unit parser;
 {$ifdef UseBrowser}
           { Write Browser }
             if cs_browser in aktmoduleswitches then
-             begin
+              if Browse.elements_to_list^.empty then
-               Message1(parser_i_writing_browser_log,Browse.Fname);
+                begin
-               write_browser_log;
+                   Message1(parser_i_writing_browser_log,Browse.Fname);
-             end;
+                   write_browser_log;
+                end
+              else
+                Browse.list_elements;
 {$endif UseBrowser}
           end;
 
@@ -368,7 +371,27 @@ unit parser;
 end.
 {
   $Log$
-  Revision 1.45  1998-09-18 08:01:35  pierre
+  Revision 1.46  1998-09-21 08:45:12  pierre
+    + added vmt_offset in tobjectdef.write for fututre use
+      (first steps to have objects without vmt if no virtual !!)
+    + added fpu_used field for tabstractprocdef  :
+      sets this level to 2 if the functions return with value in FPU
+      (is then set to correct value at parsing of implementation)
+      THIS MIGHT refuse some code with FPU expression too complex
+      that were accepted before and even in some cases
+      that don't overflow in fact
+      ( like if f : float; is a forward that finally in implementation
+       only uses one fpu register !!)
+      Nevertheless I think that it will improve security on
+      FPU operations !!
+    * most other changes only for UseBrowser code
+      (added symtable references for record and objects)
+      local switch for refs to args and local of each function
+      (static symtable still missing)
+      UseBrowser still not stable and probably broken by
+      the definition hash array !!
+
+  Revision 1.45  1998/09/18 08:01:35  pierre
     + improvement on the usebrowser part
       (does not work correctly for now)
 

compiler/pass_1.pas

@@ -3644,10 +3644,8 @@ unit pass_1;
                 end;
            end;
 
-{$ifdef StoreFPULevel}
          { a fpu can be used in any procedure !! }
          p^.registersfpu:=p^.procdefinition^.fpu_used;
-{$endif StoreFPULevel}
          { if this is a call to a method calc the registers }
          if (p^.methodpointer<>nil) then
            begin
@@ -5514,7 +5512,27 @@ unit pass_1;
 end.
 {
   $Log$
-  Revision 1.87  1998-09-20 18:00:21  florian
+  Revision 1.88  1998-09-21 08:45:14  pierre
+    + added vmt_offset in tobjectdef.write for fututre use
+      (first steps to have objects without vmt if no virtual !!)
+    + added fpu_used field for tabstractprocdef  :
+      sets this level to 2 if the functions return with value in FPU
+      (is then set to correct value at parsing of implementation)
+      THIS MIGHT refuse some code with FPU expression too complex
+      that were accepted before and even in some cases
+      that don't overflow in fact
+      ( like if f : float; is a forward that finally in implementation
+       only uses one fpu register !!)
+      Nevertheless I think that it will improve security on
+      FPU operations !!
+    * most other changes only for UseBrowser code
+      (added symtable references for record and objects)
+      local switch for refs to args and local of each function
+      (static symtable still missing)
+      UseBrowser still not stable and probably broken by
+      the definition hash array !!
+
+  Revision 1.87  1998/09/20 18:00:21  florian
     * small compiling problems fixed
 
   Revision 1.86  1998/09/20 17:46:50  florian

compiler/pass_2.pas

@@ -470,9 +470,7 @@ implementation
                 make_const_global:=true;
               do_secondpass(p);
 
-{$ifdef StoreFPULevel}
               procinfo.def^.fpu_used:=p^.registersfpu;
-{$endif StoreFPULevel}
               { all registers can be used again }
               resetusableregisters;
            end;
@@ -483,7 +481,27 @@ implementation
 end.
 {
   $Log$
-  Revision 1.3  1998-09-17 09:42:40  peter
+  Revision 1.4  1998-09-21 08:45:16  pierre
+    + added vmt_offset in tobjectdef.write for fututre use
+      (first steps to have objects without vmt if no virtual !!)
+    + added fpu_used field for tabstractprocdef  :
+      sets this level to 2 if the functions return with value in FPU
+      (is then set to correct value at parsing of implementation)
+      THIS MIGHT refuse some code with FPU expression too complex
+      that were accepted before and even in some cases
+      that don't overflow in fact
+      ( like if f : float; is a forward that finally in implementation
+       only uses one fpu register !!)
+      Nevertheless I think that it will improve security on
+      FPU operations !!
+    * most other changes only for UseBrowser code
+      (added symtable references for record and objects)
+      local switch for refs to args and local of each function
+      (static symtable still missing)
+      UseBrowser still not stable and probably broken by
+      the definition hash array !!
+
+  Revision 1.3  1998/09/17 09:42:40  peter
     + pass_2 for cg386
     * Message() -> CGMessage() for pass_1/pass_2
 

compiler/pmodules.pas

@@ -178,7 +178,7 @@ unit pmodules;
       var
         pu           : pused_unit;
         loaded_unit  : pmodule;
-        nextmapentry,firstimplementation : longint;
+        nextmapentry : longint;
       begin
       { init the map }
         new(current_module^.map);
@@ -210,7 +210,6 @@ unit pmodules;
             end;
            pu:=pused_unit(pu^.next);
          end;
-        firstimplementation:=nextmapentry;
       { ok, now load the unit }
         current_module^.symtable:=new(punitsymtable,loadasunit);
       { if this is the system unit insert the intern symbols }
@@ -254,7 +253,7 @@ unit pmodules;
         if cs_browser in aktmoduleswitches then
           begin
              punitsymtable(current_module^.symtable)^.
-               load_implementation_refs(firstimplementation);
+               load_symtable_refs;
           end;
 {$endif UseBrowser}
         { remove the map, it's not needed anymore }
@@ -925,7 +924,27 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.49  1998-09-18 08:01:36  pierre
+  Revision 1.50  1998-09-21 08:45:17  pierre
+    + added vmt_offset in tobjectdef.write for fututre use
+      (first steps to have objects without vmt if no virtual !!)
+    + added fpu_used field for tabstractprocdef  :
+      sets this level to 2 if the functions return with value in FPU
+      (is then set to correct value at parsing of implementation)
+      THIS MIGHT refuse some code with FPU expression too complex
+      that were accepted before and even in some cases
+      that don't overflow in fact
+      ( like if f : float; is a forward that finally in implementation
+       only uses one fpu register !!)
+      Nevertheless I think that it will improve security on
+      FPU operations !!
+    * most other changes only for UseBrowser code
+      (added symtable references for record and objects)
+      local switch for refs to args and local of each function
+      (static symtable still missing)
+      UseBrowser still not stable and probably broken by
+      the definition hash array !!
+
+  Revision 1.49  1998/09/18 08:01:36  pierre
     + improvement on the usebrowser part
       (does not work correctly for now)
 

compiler/ppu.pas

@@ -70,7 +70,9 @@ const
   ibabsolutesym   = 26;
   ibpropertysym   = 27;
   ibvarsym_C      = 28;
-  {defenitions}
+  ibunitsym       = 29;  { needed for browser }
+  iblabelsym      = 30;
+  {definitions}
   iborddef        = 40;
   ibpointerdef    = 41;
   ibarraydef      = 42;
@@ -99,7 +101,7 @@ const
   uf_in_library    = $40; { is the file in another file than <ppufile>.* ? }
   uf_static_linked = $80;
   uf_shared_linked = $100;
-
+  uf_local_browser = $200;
 
 type
 {$ifdef m68k}
@@ -772,7 +774,27 @@ end;
 end.
 {
   $Log$
-  Revision 1.12  1998-09-18 08:01:37  pierre
+  Revision 1.13  1998-09-21 08:45:18  pierre
+    + added vmt_offset in tobjectdef.write for fututre use
+      (first steps to have objects without vmt if no virtual !!)
+    + added fpu_used field for tabstractprocdef  :
+      sets this level to 2 if the functions return with value in FPU
+      (is then set to correct value at parsing of implementation)
+      THIS MIGHT refuse some code with FPU expression too complex
+      that were accepted before and even in some cases
+      that don't overflow in fact
+      ( like if f : float; is a forward that finally in implementation
+       only uses one fpu register !!)
+      Nevertheless I think that it will improve security on
+      FPU operations !!
+    * most other changes only for UseBrowser code
+      (added symtable references for record and objects)
+      local switch for refs to args and local of each function
+      (static symtable still missing)
+      UseBrowser still not stable and probably broken by
+      the definition hash array !!
+
+  Revision 1.12  1998/09/18 08:01:37  pierre
     + improvement on the usebrowser part
       (does not work correctly for now)
 

compiler/symdef.inc

@@ -1774,9 +1774,7 @@
       begin
          inherited init;
          para1:=nil;
-{$ifdef StoreFPULevel}
+         fpu_used:=0;
-         fpu_used:=255;
-{$endif StoreFPULevel}
          options:=0;
          retdef:=voiddef;
          savesize:=Sizeof(pointer);
@@ -1810,6 +1808,15 @@
          para1:=hp;
       end;
 
+    { all functions returning in FPU are
+      assume to use 2 FPU registers
+      until the function implementation
+      is processed   PM }
+    procedure tabstractprocdef.test_if_fpu_result;
+      begin
+         if assigned(retdef) and is_fpu(retdef) then
+           fpu_used:=2;
+      end;
 
     procedure tabstractprocdef.deref;
       var
@@ -1833,9 +1840,7 @@
       begin
          inherited load;
          retdef:=readdefref;
-{$ifdef StoreFPULevel}
          fpu_used:=readbyte;
-{$endif StoreFPULevel}
          options:=readlong;
          count:=readword;
          para1:=nil;
@@ -1888,9 +1893,7 @@
       begin
          inherited write;
          writedefref(retdef);
-{$ifdef StoreFPULevel}
          writebyte(fpu_used);
-{$endif StoreFPULevel}
          writelong(options);
          hp:=para1;
          count:=0;
@@ -2046,23 +2049,37 @@
     procedure tprocdef.load_references;
       var
         pos : tfileposinfo;
+        move_last : boolean;
       begin
+        move_last:=lastwritten=lastref;
         while (not current_ppu^.endofentry) do
          begin
            readposinfo(pos);
            inc(refcount);
            lastref:=new(pref,init(lastref,@pos));
+           lastref^.is_written:=true;
            if refcount=1 then
             defref:=lastref;
          end;
+        if move_last then
+          lastwritten:=lastref;
+        if (current_module^.flags and uf_local_browser)<>0 then
+          begin
+             new(parast,load);
+             parast^.load_browser;
+             new(localst,load);
+             localst^.load_browser;
+          end;
       end;
 
 
-    procedure tprocdef.write_references;
+    function tprocdef.write_references : boolean;
       var
         ref : pref;
+        move_last : boolean;
       begin
-        if lastwritten=lastref then
+        move_last:=lastwritten=lastref;
+        if move_last and ((current_module^.flags and uf_local_browser)=0) then
           exit;
       { write address of this symbol }
         writedefref(@self);
@@ -2072,12 +2089,35 @@
         else
           ref:=defref;
         while assigned(ref) do
-          begin
+         begin
-             writeposinfo(ref^.posinfo);
+           if ref^.moduleindex=current_module^.unit_index then
-             ref:=ref^.nextref;
+             begin
-          end;
+                writeposinfo(ref^.posinfo);
+                ref^.is_written:=true;
+                if move_last then
+                  lastwritten:=ref;
+             end
+           else if not ref^.is_written then
+             move_last:=false
+           else if move_last then
+             lastwritten:=ref;
+           ref:=ref^.nextref;
+         end;
         current_ppu^.writeentry(ibdefref);
-        lastwritten:=lastref;
+        write_references:=true;
+        if (current_module^.flags and uf_local_browser)<>0 then
+          begin
+             { we need dummy para and local symtables
+               PPU files are then easier to read PM }
+             if not assigned(parast) then
+               parast:=new(psymtable,init(parasymtable));
+             parast^.write;
+             parast^.write_browser;
+             if not assigned(localst) then
+               localst:=new(psymtable,init(localsymtable));
+             localst^.write;
+             localst^.write_browser;
+          end;
       end;
 
 
@@ -2087,10 +2127,13 @@
           begin
             Browse.AddLog('***'+mangledname);
             Browse.AddLogRefs(defref);
-            if assigned(parast) then
+            if (current_module^.flags and uf_local_browser)<>0 then
-              parast^.writebrowserlog;
+              begin
-            if assigned(localst) then
+                 if assigned(parast) then
-              localst^.writebrowserlog;
+                   parast^.writebrowserlog;
+                 if assigned(localst) then
+                   localst^.writebrowserlog;
+              end;
           end;
       end;
 {$endif UseBrowser}
@@ -2317,12 +2360,12 @@
       begin
          { here we cannot get a real good value so just give something }
          { plausible (PM) }
-{$ifdef StoreFPULevel}
+         { a more secure way would be
+           to allways store in a temp }
          if is_fpu(retdef) then
            fpu_used:=2
          else
            fpu_used:=0;
-{$endif StoreFPULevel}
          inherited write;
          current_ppu^.writeentry(ibprocvardef);
       end;
@@ -2417,6 +2460,7 @@
         deftype:=objectdef;
         childof:=c;
         options:=0;
+        vmt_offset:=0;
         { some options are inherited !! }
         if assigned(c) then
           options:= c^.options and
@@ -2447,6 +2491,7 @@
          tdef.load;
          deftype:=objectdef;
          savesize:=readlong;
+         vmt_offset:=readlong;
          name:=stringdup(readstring);
          childof:=pobjectdef(readdefref);
          options:=readlong;
@@ -2601,6 +2646,7 @@
       begin
          tdef.write;
          writelong(size);
+         writelong(vmt_offset);
          writestring(name^);
          writedefref(childof);
          writelong(options);
@@ -2969,7 +3015,27 @@
 
 {
   $Log$
-  Revision 1.45  1998-09-20 08:31:29  florian
+  Revision 1.46  1998-09-21 08:45:21  pierre
+    + added vmt_offset in tobjectdef.write for fututre use
+      (first steps to have objects without vmt if no virtual !!)
+    + added fpu_used field for tabstractprocdef  :
+      sets this level to 2 if the functions return with value in FPU
+      (is then set to correct value at parsing of implementation)
+      THIS MIGHT refuse some code with FPU expression too complex
+      that were accepted before and even in some cases
+      that don't overflow in fact
+      ( like if f : float; is a forward that finally in implementation
+       only uses one fpu register !!)
+      Nevertheless I think that it will improve security on
+      FPU operations !!
+    * most other changes only for UseBrowser code
+      (added symtable references for record and objects)
+      local switch for refs to args and local of each function
+      (static symtable still missing)
+      UseBrowser still not stable and probably broken by
+      the definition hash array !!
+
+  Revision 1.45  1998/09/20 08:31:29  florian
     + bit 6 of tpropinfo.propprocs is set, if the property contains a
       constant index
 

compiler/symppu.inc

@@ -133,18 +133,13 @@
     procedure writesourcefiles;
       var
         hp    : pinputfile;
-        index : longint;
       begin
       { second write the used source files }
         hp:=current_module^.sourcefiles.files;
-        index:=current_module^.sourcefiles.last_ref_index;
         while assigned(hp) do
          begin
          { only name and extension }
            current_ppu^.putstring(hp^.name^);
-         { index in that order }
-           hp^.ref_index:=index;
-           dec(index);
            hp:=hp^.ref_next;
          end;
         current_ppu^.writeentry(ibsourcefiles);
@@ -380,17 +375,20 @@
                     temp:=temp+' *'
                   end;
                end;
+{$ifdef UseBrowser}
+              new(hp,init(hs));
+              { the indexing is wrong here PM }
+              current_module^.sourcefiles.register_file(hp);
+{$endif UseBrowser}
             end;
            Message1(unit_t_ppu_source,hs+temp);
-{$ifdef UseBrowser}
-           new(hp,init(hs));
-           { 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);
+        
+        { the indexing is corrected here PM }
+        current_module^.sourcefiles.inverse_register_indexes;
       { check if we want to rebuild every unit, only if the sources are
         available }
         if do_build and current_module^.sources_avail then
@@ -441,7 +439,27 @@
 
 {
   $Log$
-  Revision 1.14  1998-09-01 07:54:24  pierre
+  Revision 1.15  1998-09-21 08:45:23  pierre
+    + added vmt_offset in tobjectdef.write for fututre use
+      (first steps to have objects without vmt if no virtual !!)
+    + added fpu_used field for tabstractprocdef  :
+      sets this level to 2 if the functions return with value in FPU
+      (is then set to correct value at parsing of implementation)
+      THIS MIGHT refuse some code with FPU expression too complex
+      that were accepted before and even in some cases
+      that don't overflow in fact
+      ( like if f : float; is a forward that finally in implementation
+       only uses one fpu register !!)
+      Nevertheless I think that it will improve security on
+      FPU operations !!
+    * most other changes only for UseBrowser code
+      (added symtable references for record and objects)
+      local switch for refs to args and local of each function
+      (static symtable still missing)
+      UseBrowser still not stable and probably broken by
+      the definition hash array !!
+
+  Revision 1.14  1998/09/01 07:54:24  pierre
     * UseBrowser a little updated (might still be buggy !!)
     * bug in psub.pas in function specifier removed
     * stdcall allowed in interface and in implementation

compiler/symsym.inc

@@ -76,27 +76,38 @@
     procedure tsym.load_references;
       var
         pos : tfileposinfo;
+        move_last : boolean;
       begin
+        move_last:=lastwritten=lastref;
         while (not current_ppu^.endofentry) do
          begin
            readposinfo(pos);
            inc(refcount);
            lastref:=new(pref,init(lastref,@pos));
+           lastref^.is_written:=true;
            if refcount=1 then
             defref:=lastref;
          end;
-        lastwritten:=lastref;
+        if move_last then
+          lastwritten:=lastref;
       end;
 
-    procedure tsym.write_references;
+    { big problem here :
+      wrong refs were written because of
+      interface parsing of other units PM
+      moduleindex must be checked !! }
+      
+    function tsym.write_references : boolean;
       var
         ref   : pref;
-        prdef : pdef;
+        symref_written,move_last : boolean;
       begin
+        write_references:=false;
         if lastwritten=lastref then
           exit;
-      { write address to this symbol }
+      { should we update lastref }
-        writesymref(@self);
+        move_last:=true;
+        symref_written:=false;
       { write symbol refs }
         if assigned(lastwritten) then
           ref:=lastwritten
@@ -104,17 +115,32 @@
           ref:=defref;
         while assigned(ref) do
          begin
-           writeposinfo(ref^.posinfo);
+           if ref^.moduleindex=current_module^.unit_index then
+             begin
+              { write address to this symbol }
+                if not symref_written then
+                  begin
+                     writesymref(@self);
+                     symref_written:=true;
+                  end;
+                writeposinfo(ref^.posinfo);
+                ref^.is_written:=true;
+                if move_last then
+                  lastwritten:=ref;
+             end
+           else if not ref^.is_written then
+             move_last:=false
+           else if move_last then
+             lastwritten:=ref;
            ref:=ref^.nextref;
          end;
-        lastwritten:=lastref;
+        if symref_written then
-        current_ppu^.writeentry(ibsymref);
+          current_ppu^.writeentry(ibsymref);
+        write_references:=symref_written;
       end;
 
 
     procedure tsym.add_to_browserlog;
-      var
-        prdef : pprocdef;
       begin
         if assigned(defref) then
          begin
@@ -147,10 +173,6 @@
          writestring(name);
          if object_options then
            writebyte(byte(properties));
-{$ifdef UseBrowser}
-{         if cs_browser in aktmoduleswitches then
-           write_references; }
-{$endif UseBrowser}
       end;
 
     procedure tsym.deref;
@@ -237,6 +259,17 @@
          defined:=false;
       end;
 
+    constructor tlabelsym.load;
+
+      begin
+         tsym.load;
+         typ:=labelsym;
+         { this is all dummy
+           it is only used for local browsing }
+         number:=nil;
+         defined:=true;
+      end;
+
     destructor tlabelsym.done;
 
       begin
@@ -255,7 +288,13 @@
     procedure tlabelsym.write;
 
       begin
-         Message(sym_e_ill_label_decl);
+         if owner^.symtabletype in [unitsymtable,globalsymtable] then
+           Message(sym_e_ill_label_decl)
+         else
+           begin
+              tsym.write;
+              current_ppu^.writeentry(iblabelsym);
+           end;
       end;
 
 {****************************************************************************
@@ -277,6 +316,15 @@
          refs:=0;
       end;
 
+    constructor tunitsym.load;
+
+      begin
+         tsym.load;
+         typ:=unitsym;
+         unitsymtable:=punitsymtable(current_module^.symtable);
+         prevsym:=nil;
+      end;
+      
     destructor tunitsym.done;
       begin
          if assigned(unitsymtable) and (unitsymtable^.unitsym=@self) then
@@ -286,6 +334,8 @@
 
     procedure tunitsym.write;
       begin
+         tsym.write;
+         current_ppu^.writeentry(ibunitsym);
       end;
 
 {$ifdef GDB}
@@ -422,11 +472,14 @@
           end;
       end;
 
-    procedure tprocsym.write_references;
+    function tprocsym.write_references : boolean;
       var
         prdef : pprocdef;
       begin
-         inherited write_references;
+         write_references:=false;
+         if not inherited write_references then
+           exit;
+         write_references:=true;
          prdef:=definition;
          while assigned(prdef) and (prdef^.owner=definition^.owner) do
           begin
@@ -1567,22 +1620,19 @@
              pobjectdef(definition)^.publicsyms^.load_browser;
       end;
 
-    procedure ttypesym.write_references;
+    function ttypesym.write_references : boolean;
       begin
-        if lastwritten<>lastref then
+        if not inherited write_references then
-          begin
-             inherited write_references;
-          end
          { write address of this symbol if record or object
            even if no real refs are there
            because we need it for the symtable }
-         else if (definition^.deftype=recorddef) or
+         if (definition^.deftype=recorddef) or
-                 (definition^.deftype=objectdef) then
+            (definition^.deftype=objectdef) then
           begin
              writesymref(@self);
              current_ppu^.writeentry(ibsymref);
           end;
-             
+         write_references:=true;
          if (definition^.deftype=recorddef) then
             precdef(definition)^.symtable^.write_browser;
          if (definition^.deftype=objectdef) then
@@ -1590,8 +1640,6 @@
       end;
 
     procedure ttypesym.add_to_browserlog;
-      var
-        aktobjdef : pobjectdef;
       begin
          inherited add_to_browserlog;
          if (definition^.deftype=recorddef) then
@@ -1669,7 +1717,27 @@
 
 {
   $Log$
-  Revision 1.44  1998-09-18 16:03:47  florian
+  Revision 1.45  1998-09-21 08:45:24  pierre
+    + added vmt_offset in tobjectdef.write for fututre use
+      (first steps to have objects without vmt if no virtual !!)
+    + added fpu_used field for tabstractprocdef  :
+      sets this level to 2 if the functions return with value in FPU
+      (is then set to correct value at parsing of implementation)
+      THIS MIGHT refuse some code with FPU expression too complex
+      that were accepted before and even in some cases
+      that don't overflow in fact
+      ( like if f : float; is a forward that finally in implementation
+       only uses one fpu register !!)
+      Nevertheless I think that it will improve security on
+      FPU operations !!
+    * most other changes only for UseBrowser code
+      (added symtable references for record and objects)
+      local switch for refs to args and local of each function
+      (static symtable still missing)
+      UseBrowser still not stable and probably broken by
+      the definition hash array !!
+
+  Revision 1.44  1998/09/18 16:03:47  florian
     * some changes to compile with Delphi
 
   Revision 1.43  1998/09/18 08:01:38  pierre

compiler/tree.pas

@@ -191,8 +191,6 @@ unit tree;
 {$endif SUPPORT_MMX}
           left,right : ptree;
           resulttype : pdef;
-          { line : longint;
-          fileindex,colon : word; }
           fileinfo : tfileposinfo;
           localswitches : tlocalswitches;
 {$ifdef extdebug}
@@ -1569,7 +1567,27 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.38  1998-09-16 01:06:47  carl
+  Revision 1.39  1998-09-21 08:45:27  pierre
+    + added vmt_offset in tobjectdef.write for fututre use
+      (first steps to have objects without vmt if no virtual !!)
+    + added fpu_used field for tabstractprocdef  :
+      sets this level to 2 if the functions return with value in FPU
+      (is then set to correct value at parsing of implementation)
+      THIS MIGHT refuse some code with FPU expression too complex
+      that were accepted before and even in some cases
+      that don't overflow in fact
+      ( like if f : float; is a forward that finally in implementation
+       only uses one fpu register !!)
+      Nevertheless I think that it will improve security on
+      FPU operations !!
+    * most other changes only for UseBrowser code
+      (added symtable references for record and objects)
+      local switch for refs to args and local of each function
+      (static symtable still missing)
+      UseBrowser still not stable and probably broken by
+      the definition hash array !!
+
+  Revision 1.38  1998/09/16 01:06:47  carl
     * crash bugfix in firstaddr
 
   Revision 1.37  1998/09/08 10:38:04  pierre