浏览代码

* working browser and newppu
* some small fixes against crashes which occured in bp7 (but not in
fpc?!)

peter 27 年之前
父节点
当前提交
c614d62eaf
共有 11 个文件被更改,包括 598 次插入482 次删除
  1. 202 94
      compiler/browser.pas
  2. 8 3
      compiler/files.pas
  3. 44 12
      compiler/parser.pas
  4. 11 6
      compiler/pass_1.pas
  5. 15 4
      compiler/pmodules.pas
  6. 18 9
      compiler/pp.pas
  7. 56 45
      compiler/ppu.pas
  8. 17 30
      compiler/scanner.pas
  9. 96 81
      compiler/symdef.inc
  10. 33 34
      compiler/symppu.inc
  11. 98 164
      compiler/symsym.inc

+ 202 - 94
compiler/browser.pas

@@ -1,8 +1,8 @@
 {
     $Id$
-    Copyright (c) 1996-98 by Florian Klaempfl
+    Copyright (c) 1993-98 by the FPC development team
 
-    This unit implements a browser object
+    Support routines for the browser
 
     This program is free software; you can redistribute it and/or modify
     it under the terms of the GNU General Public License as published by
@@ -17,78 +17,98 @@
     You should have received a copy of the GNU General Public License
     along with this program; if not, write to the Free Software
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-}
 
+ ****************************************************************************
+}
+{$ifdef TP}
+  {$N+,E+}
+{$endif}
 unit browser;
 
 interface
-
-uses globals,cobjects,files;
-
+uses
+  cobjects,files;
+
+const
+{$ifdef TP}
+  logbufsize   = 1024;
+{$else}
+  logbufsize   = 16384;
+{$endif}
 type
   pref = ^tref;
   tref = object
-         nextref   : pref;
-         posinfo : tfileposinfo;
-         moduleindex : word;
-         constructor init(ref : pref;pos : pfileposinfo);
-         constructor load(var ref : pref;fileindex : word;line,column : longint);
-         destructor done; virtual;
-         function  get_file_line : string;
-         end;
-
-  { simple method to chain all refs }
-  procedure add_new_ref(var ref : pref;pos : pfileposinfo);
+    nextref     : pref;
+    posinfo     : tfileposinfo;
+    moduleindex : word;
+    constructor init(ref:pref;pos:pfileposinfo);
+    destructor  done; virtual;
+    function  get_file_line : string;
+  end;
+
+  pbrowser=^tbrowser;
+  tbrowser=object
+    fname    : string;
+    logopen  : boolean;
+    f        : file;
+    buf      : pchar;
+    bufidx   : longint;
+    identidx : longint;
+    constructor init;
+    destructor done;
+    procedure setfilename(const fn:string);
+    procedure createlog;
+    procedure flushlog;
+    procedure addlog(const s:string);
+    procedure addlogrefs(p:pref);
+    procedure closelog;
+    procedure ident;
+    procedure unident;
+  end;
+
+var
+  browse : tbrowser;
 
   function get_source_file(moduleindex,fileindex : word) : pinputfile;
 
-  { one big problem remains for overloaded procedure }
-  { we should be able to separate them               }
-  { this might be feasable in pass_1                 }
-
 implementation
 
-  uses scanner,verbose;
+  uses
+    globals,systems,verbose;
 
-  constructor tref.init(ref :pref;pos : pfileposinfo);
+{****************************************************************************
+                               TRef
+****************************************************************************}
 
-    begin
-       nextref:=nil;
-       if ref<>nil then
+
+    constructor tref.init(ref :pref;pos : pfileposinfo);
+      begin
+        nextref:=nil;
+        if assigned(pos) then
+          posinfo:=pos^;
+        if assigned(current_module) then
+          moduleindex:=current_module^.unit_index;
+        if assigned(ref) then
           ref^.nextref:=@self;
-       if assigned(pos) then
-         posinfo:=pos^;
-       if current_module<>nil then
-         begin
-            moduleindex:=current_module^.unit_index;
-         end;
-    end;
-
-  constructor tref.load(var ref : pref;fileindex : word;line,column : longint);
-
-    begin
-       moduleindex:=current_module^.unit_index;
-       if assigned(ref) then
-         ref^.nextref:=@self;
-       nextref:=nil;
-       posinfo.fileindex:=fileindex;
-       posinfo.line:=line;
-       posinfo.column:=column;
-       ref:=@self;
-    end;
-
-  destructor tref.done;
-
-    var
-       inputfile : pinputfile;
-    begin
-       inputfile:=get_source_file(moduleindex,posinfo.fileindex);
-       if inputfile<>nil then
-         dec(inputfile^.ref_count);
-    end;
+      end;
 
-    function tref.get_file_line : string;
 
+    destructor tref.done;
+      var
+         inputfile : pinputfile;
+         ref : pref;
+      begin
+         inputfile:=get_source_file(moduleindex,posinfo.fileindex);
+         if inputfile<>nil then
+           dec(inputfile^.ref_count);
+         ref:=@self;
+         if assigned(ref^.nextref) then
+          dispose(ref^.nextref,done);
+         nextref:=nil;
+      end;
+
+
+    function tref.get_file_line : string;
       var
          inputfile : pinputfile;
       begin
@@ -110,15 +130,125 @@ implementation
               +tostr(posinfo.line)+','+tostr(posinfo.column)+')'
       end;
 
-  procedure add_new_ref(var ref : pref;pos : pfileposinfo);
+{****************************************************************************
+                              TBrowser
+****************************************************************************}
+
+    constructor tbrowser.init;
+      begin
+        fname:=FixFileName('browser.log');
+        logopen:=false;
+      end;
+
+
+    destructor tbrowser.done;
+      begin
+        if logopen then
+         closelog;
+      end;
+
+
+    procedure tbrowser.setfilename(const fn:string);
+      begin
+        fname:=FixFileName(fn);
+      end;
+
+
+    procedure tbrowser.createlog;
+      begin
+        if logopen then
+         closelog;
+        assign(f,fname);
+        {$I-}
+         rewrite(f,1);
+        {$I+}
+        if ioresult<>0 then
+         exit;
+        logopen:=true;
+        getmem(buf,logbufsize);
+        bufidx:=0;
+        identidx:=0;
+      end;
+
+
+    procedure tbrowser.flushlog;
+      begin
+        if logopen then
+         blockwrite(f,buf^,bufidx);
+        bufidx:=0;
+      end;
+
+
+    procedure tbrowser.closelog;
+      begin
+        if logopen then
+         begin
+           flushlog;
+           close(f);
+           freemem(buf,logbufsize);
+           logopen:=false;
+         end;
+      end;
+
 
-    var
-       newref : pref;
+    procedure tbrowser.addlog(const s:string);
+      begin
+        if not logopen then
+         exit;
+      { add ident }
+        if identidx>0 then
+         begin
+           if bufidx+identidx>logbufsize then
+            flushlog;
+           fillchar(buf[bufidx],identidx,' ');
+           inc(bufidx,identidx);
+         end;
+      { add text }
+        if bufidx+length(s)>logbufsize-2 then
+         flushlog;
+        move(s[1],buf[bufidx],length(s));
+        inc(bufidx,length(s));
+      { add crlf }
+        buf[bufidx]:=target_os.newline[1];
+        inc(bufidx);
+        if length(target_os.newline)=2 then
+         begin
+           buf[bufidx]:=target_os.newline[2];
+           inc(bufidx);
+         end;
+      end;
+
+
+    procedure tbrowser.addlogrefs(p:pref);
+      var
+        ref : pref;
+      begin
+        ref:=p;
+        Ident;
+        while assigned(ref) do
+         begin
+           Browse.AddLog(ref^.get_file_line);
+           ref:=ref^.nextref;
+         end;
+        Unident;
+      end;
+
+
+    procedure tbrowser.ident;
+      begin
+        inc(identidx,2);
+      end;
+
+
+    procedure tbrowser.unident;
+      begin
+        dec(identidx,2);
+      end;
+
+{****************************************************************************
+                             Helpers
+****************************************************************************}
 
-    begin
-       new(newref,init(ref,pos));
-       ref:=newref;
-    end;
 
     function get_source_file(moduleindex,fileindex : word) : pinputfile;
 
@@ -145,10 +275,17 @@ implementation
            end;
       end;
 
+begin
+  browse.init
 end.
 {
   $Log$
-  Revision 1.4  1998-06-11 10:11:57  peter
+  Revision 1.5  1998-06-13 00:10:04  peter
+    * working browser and newppu
+    * some small fixes against crashes which occured in bp7 (but not in
+      fpc?!)
+
+  Revision 1.4  1998/06/11 10:11:57  peter
     * -gb works again
 
   Revision 1.3  1998/05/20 09:42:32  pierre
@@ -167,34 +304,5 @@ end.
     + UseTokenInfo for better source position
     * fixed one remaining bug in scanner for line counts
     * several little fixes
-
-  Revision 1.1.1.1  1998/03/25 11:18:12  root
-  * Restored version
-
-  Revision 1.5  1998/03/10 16:27:36  pierre
-    * better line info in stabs debug
-    * symtabletype and lexlevel separated into two fields of tsymtable
-    + ifdef MAKELIB for direct library output, not complete
-    + ifdef CHAINPROCSYMS for overloaded seach across units, not fully
-      working
-    + ifdef TESTFUNCRET for setting func result in underfunction, not
-      working
-
-  Revision 1.4  1998/03/10 01:17:15  peter
-    * all files have the same header
-    * messages are fully implemented, EXTDEBUG uses Comment()
-    + AG... files for the Assembler generation
-
-  Revision 1.3  1998/03/02 01:48:06  peter
-    * renamed target_DOS to target_GO32V1
-    + new verbose system, merged old errors and verbose units into one new
-      verbose.pas, so errors.pas is obsolete
-
-  Revision 1.2  1998/02/13 10:34:37  daniel
-  * Made Motorola version compilable.
-  * Fixed optimizer
-
-  Revision 1.1.1.1  1997/11/27 08:32:51  michael
-  FPC Compiler CVS start
 }
 

+ 8 - 3
compiler/files.pas

@@ -210,8 +210,8 @@ unit files;
 
        { unit flags }
        uf_init           = $1;
-       uf_uses_dbx       = $2;
-       uf_uses_browser   = $4;
+       uf_has_dbx        = $2;
+       uf_has_browser    = $4;
        uf_in_library     = $8;
        uf_shared_library = $10;
        uf_big_endian     = $20;
@@ -945,7 +945,12 @@ unit files;
 end.
 {
   $Log$
-  Revision 1.20  1998-06-12 14:50:48  peter
+  Revision 1.21  1998-06-13 00:10:05  peter
+    * working browser and newppu
+    * some small fixes against crashes which occured in bp7 (but not in
+      fpc?!)
+
+  Revision 1.20  1998/06/12 14:50:48  peter
     * removed the tree dependency to types.pas
     * long_fil.pas support (not fully tested yet)
 

+ 44 - 12
compiler/parser.pas

@@ -36,6 +36,9 @@ unit parser;
       systems,cobjects,globals,verbose,
       symtable,files,aasm,hcodegen,
       assemble,link,script,gendef,
+{$ifdef UseBrowser}
+      browser,
+{$endif UseBrowser}
       scanner,pbase,pdecl,psystem,pmodules;
 
 
@@ -82,6 +85,7 @@ unit parser;
          oldpreprocstack : ppreprocstack;
          oldorgpattern,oldprocprefix : string;
          old_block_type : tblock_type;
+         oldlastlinepos,
          oldinputbuffer,
          oldinputpointer : pchar;
          olds_point,oldparse_only : boolean;
@@ -196,6 +200,7 @@ unit parser;
 
          oldinputbuffer:=inputbuffer;
          oldinputpointer:=inputpointer;
+         oldlastlinepos:=lastlinepos;
          olds_point:=s_point;
          oldc:=c;
          oldcomment_level:=comment_level;
@@ -235,30 +240,38 @@ unit parser;
          aktoptprocessor:=initoptprocessor;
          aktasmmode:=initasmmode;
 
-         { we need this to make the system unit }
+       { we need this to make the system unit }
          if compile_system then
           aktswitches:=aktswitches+[cs_compilesystem];
 
 
-         { macros }
+       { macros }
          macros:=new(psymtable,init(macrosymtable));
          macros^.name:=stringdup('Conditionals for '+filename);
          define_macros;
 
-         { startup scanner }
+       { startup scanner }
          token:=yylex;
 
-         { init code generator for a new module }
+       { init code generator for a new module }
          codegen_newmodule;
 {$ifdef GDB}
          reset_gdb_info;
 {$endif GDB}
-         { global switches are read, so further changes aren't allowed }
+       { global switches are read, so further changes aren't allowed }
          current_module^.in_main:=true;
 
-         { open assembler response }
+       { Handle things which need to be once }
          if (compile_level=1) then
-          AsmRes.Init('ppas');
+          begin
+          { open assembler response }
+            AsmRes.Init('ppas');
+{$ifdef UseBrowser}
+          { open browser if set }
+            if cs_browser in initswitches then
+             Browse.CreateLog;
+{$endif UseBrowser}
+          end;
 
          { if the current file isn't a system unit  }
          { the the system unit will be loaded       }
@@ -339,7 +352,6 @@ unit parser;
                    Linker.MakeExecutable;
                  end;
               end;
-
            end
          else
            Message1(unit_f_errors_in_unit,tostr(status.errorcount));
@@ -373,11 +385,14 @@ done:
 
          procprefix:=oldprocprefix;
 
-         { close the inputfiles }
 {$ifdef UseBrowser}
-         {  we need the names for the browser ! }
-         current_module^.sourcefiles.close_all;
+       {  close input files, but dont remove if we use the browser ! }
+         if cs_browser in initswitches then
+          current_module^.sourcefiles.close_all
+         else
+          current_module^.sourcefiles.done;
 {$else UseBrowser}
+       { close the inputfiles }
          current_module^.sourcefiles.done;
 {$endif not UseBrowser}
          { restore scanner state }
@@ -398,6 +413,7 @@ done:
          preprocstack:=oldpreprocstack;
          inputbuffer:=oldinputbuffer;
          inputpointer:=oldinputpointer;
+         lastlinepos:=oldlastlinepos;
          s_point:=olds_point;
          c:=oldc;
          comment_level:=oldcomment_level;
@@ -417,6 +433,7 @@ done:
          importssection:=oldimports;
          exportssection:=oldexports;
          resourcesection:=oldresource;
+         rttilist:=oldrttilist;
 
          { restore current state }
          aktswitches:=oldswitches;
@@ -425,13 +442,23 @@ done:
          aktoptprocessor:=oldoptprocessor;
          aktasmmode:=oldasmmode;
 
+       { Shut down things when the last file is compiled }
          if (compile_level=1) then
           begin
+          { Close script }
             if (not AsmRes.Empty) then
              begin
                Message1(exec_i_closing_script,AsmRes.Fn);
                AsmRes.WriteToDisk;
              end;
+{$ifdef UseBrowser}
+          { Write Browser }
+            if cs_browser in initswitches then
+             begin
+               Comment(V_Info,'Writing Browser '+Browse.Fname);
+               write_browser_log;
+             end;
+{$endif UseBrowser}
           end;
          dec(compile_level);
       end;
@@ -439,7 +466,12 @@ done:
 end.
 {
   $Log$
-  Revision 1.23  1998-06-08 22:59:48  peter
+  Revision 1.24  1998-06-13 00:10:08  peter
+    * working browser and newppu
+    * some small fixes against crashes which occured in bp7 (but not in
+      fpc?!)
+
+  Revision 1.23  1998/06/08 22:59:48  peter
     * smartlinking works for win32
     * some defines to exclude some compiler parts
 

+ 11 - 6
compiler/pass_1.pas

@@ -171,7 +171,7 @@ unit pass_1;
         end;
 
     function is_assignment_overloaded(from_def,to_def : pdef) : boolean;forward;
-    
+
     function isconvertable(def_from,def_to : pdef;
              var doconv : tconverttype;fromtreetype : ttreetyp;
              explicit : boolean) : boolean;
@@ -2589,7 +2589,7 @@ unit pass_1;
       overloaded function
       this is the reason why it is not in the parser
        PM }
-      
+
     procedure test_protected_sym(sym : psym);
 
       begin
@@ -2599,7 +2599,7 @@ unit pass_1;
            (pobjectdef(sym^.owner^.defowner)^.owner^.symtabletype=unitsymtable))) then
           Message(parser_e_cant_access_protected_member);
       end;
-      
+
     procedure test_protected(p : ptree);
 
       begin
@@ -2623,7 +2623,7 @@ unit pass_1;
               test_protected_sym(p^.vs);
            end;
       end;
-      
+
     procedure firstcallparan(var p : ptree;defcoll : pdefcoll);
 
       var store_valid : boolean;
@@ -3210,7 +3210,7 @@ unit pass_1;
                    if make_ref then
                      begin
                         get_cur_file_pos(curtokenpos);
-                        add_new_ref(procs^.data^.lastref,@curtokenpos);
+                        procs^.data^.lastref:=new(pref,init(procs^.data^.lastref,@curtokenpos));
                      end;
      {$endif UseBrowser}
 
@@ -5012,7 +5012,12 @@ unit pass_1;
 end.
 {
   $Log$
-  Revision 1.30  1998-06-12 10:32:28  pierre
+  Revision 1.31  1998-06-13 00:10:09  peter
+    * working browser and newppu
+    * some small fixes against crashes which occured in bp7 (but not in
+      fpc?!)
+
+  Revision 1.30  1998/06/12 10:32:28  pierre
     * column problem hopefully solved
     + C vars declaration changed
 

+ 15 - 4
compiler/pmodules.pas

@@ -203,10 +203,12 @@ unit pmodules;
           { ok, now load the unit }
             hp^.symtable:=new(punitsymtable,load(hp));
           { if this is the system unit insert the intern symbols }
-            make_ref:=false;
             if compile_system then
-              insertinternsyms(psymtable(hp^.symtable));
-            make_ref:=true;
+              begin
+                make_ref:=false;
+                insertinternsyms(psymtable(hp^.symtable));
+                make_ref:=true;
+              end;
           end;
        { now only read the implementation part }
          hp^.in_implementation:=true;
@@ -715,10 +717,12 @@ unit pmodules;
          p:=new(punitsymtable,init(staticsymtable,current_module^.modulename^));
 
          {Generate a procsym.}
+         make_ref:=false;
          aktprocsym:=new(Pprocsym,init(current_module^.modulename^+'_init'));
          aktprocsym^.definition:=new(Pprocdef,init);
          aktprocsym^.definition^.options:=aktprocsym^.definition^.options or pounitinit;
          aktprocsym^.definition^.setmangledname(current_module^.modulename^+'_init');
+         make_ref:=true;
 
          {The generated procsym has a local symtable. Discard it and turn
           it into the static one.}
@@ -879,10 +883,12 @@ unit pmodules;
          st:=new(punitsymtable,init(staticsymtable,current_module^.modulename^));
 
          {Generate a procsym.}
+         make_ref:=false;
          aktprocsym:=new(Pprocsym,init('main'));
          aktprocsym^.definition:=new(Pprocdef,init);
          aktprocsym^.definition^.options:=aktprocsym^.definition^.options or poproginit;
          aktprocsym^.definition^.setmangledname(target_os.Cprefix+'main');
+         make_ref:=true;
          {The localst is a local symtable. Change it into the static
           symtable.}
          dispose(aktprocsym^.definition^.localst,done);
@@ -962,7 +968,12 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.27  1998-06-11 13:58:08  peter
+  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?!)
+
+  Revision 1.27  1998/06/11 13:58:08  peter
     * small fix to let newppu compile
 
   Revision 1.26  1998/06/09 16:01:47  pierre

+ 18 - 9
compiler/pp.pas

@@ -1,4 +1,4 @@
-{
+ {
     $Id$
     Copyright (c) 1993-98 by Florian Klaempfl
 
@@ -195,13 +195,6 @@ var
 procedure myexit;{$ifndef FPC}far;{$endif}
 begin
   exitproc:=oldexit;
-{$ifdef UseBrowser}
-  if browser_file_open then
-    begin
-       close(browserfile);
-       browser_file_open:=false;
-    end;
-{$endif UseBrowser}
 {$ifdef tp}
   if use_big then
    symbolstream.done;
@@ -217,6 +210,11 @@ begin
               erroraddr:=nil;
               Writeln('Error: Out of memory');
             end;
+     else
+      begin
+        erroraddr:=nil;
+        Writeln('Error: Runtime Error ',exitcode);
+      end;
      end;
    {when the module is assigned, then the messagefile is also loaded}
      if assigned(current_module) and assigned(current_module^.current_inputfile) then
@@ -338,6 +336,9 @@ begin
 {$ifdef linux}
    Message1(general_u_gcclibpath,Linker.librarysearchpath);
 {$endif}
+{$ifdef TP}
+   Comment(V_Info,'Memory: '+tostr(MemAvail)+' Bytes Free');
+{$endif}
 
    start:=getrealtime;
    compile(inputdir+inputfile+inputextension,false);
@@ -349,6 +350,9 @@ begin
 
    clearnodes;
    done_symtable;
+{$ifdef TP}
+   Comment(V_Info,'Memory: '+tostr(MemAvail)+' Bytes Free');
+{$endif}
 {$ifdef EXTDEBUG}
    Comment(V_Info,'Memory lost = '+tostr(EntryMemAvail-MemAvail));
 {$endif EXTDEBUG}
@@ -360,7 +364,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.12  1998-05-23 01:21:23  peter
+  Revision 1.13  1998-06-13 00:10:11  peter
+    * working browser and newppu
+    * some small fixes against crashes which occured in bp7 (but not in
+      fpc?!)
+
+  Revision 1.12  1998/05/23 01:21:23  peter
     + aktasmmode, aktoptprocessor, aktoutputformat
     + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
     + $LIBNAME to set the library name where the unit will be put in

+ 56 - 45
compiler/ppu.pas

@@ -36,13 +36,15 @@ const
 {$endif}
 
 {ppu entries}
+  mainentryid         = 1;
+  subentryid          = 2;
   {special}
   iberror             = 0;
   ibenddefs           = 250;
   ibendsyms           = 251;
   ibendinterface      = 252;
   ibendimplementation = 253;
-  ibentry             = 254;
+  ibendbrowser        = 254;
   ibend               = 255;
   {general}
   ibmodulename     = 1;
@@ -54,7 +56,8 @@ const
   iblinksharedlibs = 7;
   iblinkstaticlibs = 8;
   ibdbxcount       = 9;
-  ibref            = 10;
+  ibsymref         = 10;
+  ibdefref         = 11;
   {syms}
   ibtypesym       = 20;
   ibprocsym       = 21;
@@ -65,7 +68,6 @@ const
   ibabsolutesym   = 26;
   ibpropertysym   = 27;
   ibvarsym_C      = 28;
-  
   {defenitions}
   iborddef        = 40;
   ibpointerdef    = 41;
@@ -89,8 +91,8 @@ const
 
 { unit flags }
   uf_init           = $1;
-  uf_uses_dbx       = $2;
-  uf_uses_browser   = $4;
+  uf_has_dbx        = $2;
+  uf_has_browser    = $4;
   uf_big_endian     = $8;
   uf_in_library     = $10;
   uf_shared_library = $20;
@@ -113,7 +115,7 @@ type
   tppuentry=packed record
     id   : byte;
     nr   : byte;
-    size : word;
+    size : longint;
   end;
 
   pppufile=^tppufile;
@@ -133,10 +135,11 @@ type
     bufstart,
     bufsize,
     bufidx   : longint;
-    entry    : tppuentry;
     entrybufstart,
     entrystart,
     entryidx : longint;
+    entry    : tppuentry;
+    entrytyp : byte;
 
     constructor init(fn:string);
     destructor  done;
@@ -153,12 +156,14 @@ type
     procedure skipdata(len:longint);
     function  readentry:byte;
     function  EndOfEntry:boolean;
+    procedure getdatabuf(var b;len:longint;var result:longint);
     procedure getdata(var b;len:longint);
     function  getbyte:byte;
     function  getword:word;
     function  getlongint:longint;
     function  getdouble:double;
     function  getstring:string;
+    function  skipuntilentry(untilb:byte):boolean;
   {write}
     function  create:boolean;
     procedure writeheader;
@@ -352,6 +357,9 @@ begin
   bufidx:=0;
   Mode:=1;
   FillChar(entry,sizeof(tppuentry),0);
+  entryidx:=0;
+  entrystart:=0;
+  entrybufstart:=0;
   Error:=false;
   open:=true;
 end;
@@ -432,8 +440,9 @@ begin
   if entryidx<entry.size then
    skipdata(entry.size-entryidx);
   readdata(entry,sizeof(tppuentry));
+  entrystart:=bufstart+bufidx;
   entryidx:=0;
-  if entry.id<>ibentry then
+  if not entry.id in [mainentryid,subentryid] then
    begin
      readentry:=iberror;
      error:=true;
@@ -449,6 +458,17 @@ begin
 end;
 
 
+procedure tppufile.getdatabuf(var b;len:longint;var result:longint);
+begin
+  if entryidx+len>entry.size then
+   result:=entry.size-entryidx
+  else
+   result:=len;
+  readdata(b,result);
+  inc(entryidx,result);
+end;
+
+
 procedure tppufile.getdata(var b;len:longint);
 begin
   if entryidx+len>entry.size then
@@ -470,9 +490,6 @@ begin
      error:=true;
      exit;
    end;
-{  if bufidx+1>bufsize then
-  getbyte:=ord(buf[bufidx]);
-  inc(bufidx);}
   readdata(b,1);
   getbyte:=b;
   inc(entryidx);
@@ -490,7 +507,6 @@ begin
      error:=true;
      exit;
    end;
-{  getword:=pword(@entrybuf[entrybufidx])^;}
   readdata(w,2);
   getword:=w;
   inc(entryidx,2);
@@ -510,8 +526,6 @@ begin
    end;
   readdata(l,4);
   getlongint:=l;
-{
-  getlongint:=plongint(@entrybuf[entrybufidx])^;}
   inc(entryidx,4);
 end;
 
@@ -529,8 +543,6 @@ begin
    end;
   readdata(d,sizeof(double));
   getdouble:=d;
-{
-  getlongint:=plongint(@entrybuf[entrybufidx])^;}
   inc(entryidx,sizeof(double));
 end;
 
@@ -547,11 +559,20 @@ begin
    end;
   ReadData(s[1],length(s));
   getstring:=s;
-{ move(entrybuf[entrybufidx],s[1],length(s));}
   inc(entryidx,length(s));
 end;
 
 
+function tppufile.skipuntilentry(untilb:byte):boolean;
+var
+  b : byte;
+begin
+  repeat
+    b:=readentry;
+  until (b in [ibend,iberror]) or ((b=untilb) and (entry.id=mainentryid));
+  skipuntilentry:=(b=untilb);
+end;
+
 {*****************************************************************************
                                 TPPUFile Writing
 *****************************************************************************}
@@ -576,6 +597,7 @@ begin
   Error:=false;
   do_crc:=true;
   size:=0;
+  entrytyp:=mainentryid;
 {start}
   NewEntry;
   create:=true;
@@ -600,8 +622,6 @@ end;
 
 procedure tppufile.writebuf;
 begin
-  if do_crc then
-   UpdateCrc32(crc,buf,bufidx);
   blockwrite(f,buf^,bufidx);
   inc(bufstart,bufidx);
   bufidx:=0;
@@ -641,7 +661,7 @@ procedure tppufile.NewEntry;
 begin
   with entry do
    begin
-     id:=ibentry;
+     id:=entrytyp;
      nr:=ibend;
      size:=0;
    end;
@@ -659,15 +679,14 @@ var
   opos : longint;
 begin
 {create entry}
-  entry.id:=ibentry;
+  entry.id:=entrytyp;
   entry.nr:=ibnr;
   entry.size:=entryidx;
 {it's already been sent to disk ?}
   if entrybufstart<>bufstart then
    begin
-   {flush when the entry is partly in the new buffer}
-     if entrybufstart+sizeof(entry)>bufstart then
-      WriteBuf;
+   {flush to be sure}
+     WriteBuf;
    {write entry}
      opos:=filepos(f);
      seek(f,entrystart);
@@ -685,6 +704,8 @@ end;
 
 procedure tppufile.putdata(var b;len:longint);
 begin
+  if do_crc then
+   crc:=UpdateCrc32(crc,b,len);
   writedata(b,len);
   inc(entryidx,len);
 end;
@@ -694,57 +715,47 @@ end;
 procedure tppufile.putbyte(b:byte);
 begin
   writedata(b,1);
-{
-  entrybuf[entrybufidx]:=chr(b);}
   inc(entryidx);
 end;
 
 
 procedure tppufile.putword(w:word);
-type
-  pword = ^word;
 begin
   if change_endian then
    w:=swap(w);
-{  pword(@entrybuf[entrybufidx])^:=w;}
-  writedata(w,2);
-  inc(entryidx,2);
+  putdata(w,2);
 end;
 
 
 procedure tppufile.putlongint(l:longint);
-type
-  plongint = ^longint;
 begin
-{  plongint(@entrybuf[entrybufidx])^:=l;}
   if change_endian then
    l:=swap(l shr 16) or (longint(swap(l and $ffff)) shl 16);
-  writedata(l,4);
-  inc(entryidx,4);
+  putdata(l,4);
 end;
 
 
 procedure tppufile.putdouble(d:double);
-type
-  pdouble = ^double;
 begin
-{  plongint(@entrybuf[entrybufidx])^:=l;}
-  writedata(d,sizeof(double));
-  inc(entryidx,sizeof(double));
+  putdata(d,sizeof(double));
 end;
 
+
 procedure tppufile.putstring(s:string);
 begin
-  writedata(s,length(s)+1);
-{  move(s,entrybuf[entrybufidx],length(s)+1);}
-  inc(entryidx,length(s)+1);
+  putdata(s,length(s)+1);
 end;
 
 
 end.
 {
   $Log$
-  Revision 1.4  1998-06-09 16:01:48  pierre
+  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?!)
+
+  Revision 1.4  1998/06/09 16:01:48  pierre
     + added procedure directive parsing for procvars
       (accepted are popstack cdecl and pascal)
     + added C vars with the following syntax

+ 17 - 30
compiler/scanner.pas

@@ -146,12 +146,11 @@ unit scanner;
         c              : char;
         orgpattern,
         pattern        : string;
-        macrobuffer    : ^tmacrobuffer;
+        macrobuffer    : pmacrobuffer;
         lastlinepos,
         lasttokenpos,
         inputbuffer,
         inputpointer   : pchar;
-{        parse_types,   }                   { true, if type declarations are parsed }
         s_point        : boolean;
         comment_level,
         yylexcount,
@@ -263,19 +262,10 @@ unit scanner;
       begin
          get_current_col:=current_column;
       end;
-      
+
     function get_file_col : longint;
       begin
-(*  how was expecting files larger than 2Go ???
-{$ifdef TP}
-        if lastlinepos<=lasttokenpos then
-          get_file_col:=longint(lasttokenpos)-longint(lastlinepos)
-        else
-          get_file_col:=longint(lastlinepos)-longint(lasttokenpos);
-{$else}
-         get_file_col:=cardinal(lasttokenpos)-cardinal(lastlinepos);
-{$endif} *)
-          get_file_col:=longint(lasttokenpos)-longint(lastlinepos);
+        get_file_col:=lasttokenpos-lastlinepos;
       end;
 
 
@@ -346,6 +336,7 @@ unit scanner;
             end;
            inputbuffer[readsize]:=#0;
            inputpointer:=inputbuffer;
+           lastlinepos:=inputpointer;
          { Set EOF when main source and at endoffile }
            if eof(current_module^.current_inputfile^.f) then
             begin
@@ -363,6 +354,7 @@ 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;
          end;
       { load next char }
         c:=inputpointer^;
@@ -522,7 +514,6 @@ unit scanner;
                end;
             end;
           end;
-{          readchar; }
           c:=inputpointer^;
           if c=#0 then
            reload
@@ -539,7 +530,6 @@ unit scanner;
       begin
         while c in [' ',#9..#13] do
          begin
-{           readchar; }
            c:=inputpointer^;
            if c=#0 then
             reload
@@ -576,7 +566,6 @@ unit scanner;
            else
             found:=0;
            end;
-{           readchar;}
            c:=inputpointer^;
            if c=#0 then
             reload
@@ -584,7 +573,6 @@ unit scanner;
             inc(longint(inputpointer));
            if c in [#10,#13] then
             linebreak;
-
          until (found=2);
       end;
 
@@ -605,7 +593,6 @@ unit scanner;
             '}' : dec_comment_level;
             #26 : Message(scan_f_end_of_file);
            end;
-{           readchar; }
            c:=inputpointer^;
            if c=#0 then
             reload
@@ -669,7 +656,6 @@ unit scanner;
              else
               found:=0;
              end;
-{             readchar; }
              c:=inputpointer^;
              if c=#0 then
               reload
@@ -728,9 +714,7 @@ unit scanner;
         tokenpos.column:=get_file_col;
         tokenpos.fileindex:=current_module^.current_index;
 
-
       { Check first for a identifier/keyword, this is 20+% faster (PFV) }
-
         if c in ['_','A'..'Z','a'..'z'] then
          begin
            orgpattern:=readstring;
@@ -865,11 +849,11 @@ unit scanner;
                         if c='*' then
                          begin
                            skipoldtpcomment;
-{$ifndef TP}
+                        {$ifndef TP}
                            yylex:=yylex();
-{$else TP}
+                        {$else}
                            yylex:=yylex;
-{$endif TP}
+                        {$endif}
                            exit;
                          end;
                         yylex:=LKLAMMER;
@@ -941,11 +925,11 @@ unit scanner;
                                end;
                          '/' : begin
                                  skipdelphicomment;
-{$ifndef TP}
+                               {$ifndef TP}
                                  yylex:=yylex();
-{$else TP}
+                               {$else TP}
                                  yylex:=yylex;
-{$endif TP}
+                               {$endif TP}
                                  exit;
                                end;
                         end;
@@ -1199,8 +1183,6 @@ unit scanner;
         with fileinfo do
          begin
            line:=current_module^.current_inputfile^.line_no;
-        {fileinfo.fileindex:=current_module^.current_inputfile^.ref_index;}
-        { should allways be the same !! }
            fileindex:=current_module^.current_index;
            column:=get_current_col;
          end;
@@ -1281,7 +1263,12 @@ unit scanner;
 end.
 {
   $Log$
-  Revision 1.24  1998-06-12 10:32:36  pierre
+  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?!)
+
+  Revision 1.24  1998/06/12 10:32:36  pierre
     * column problem hopefully solved
     + C vars declaration changed
 

+ 96 - 81
compiler/symdef.inc

@@ -29,7 +29,8 @@
          deftype:=abstractdef;
          owner := nil;
          next := nil;
-         number := 0;
+         sym := nil;
+         indexnb := 0;
          if registerdef then
            symtablestack^.registerdef(@self);
          has_rtti:=false;
@@ -48,20 +49,19 @@
            end;
          lastglobaldef := @self;
          nextglobal := nil;
-         sym := nil;
 {$endif GDB}
       end;
 
     constructor tdef.load;
       begin
-{$ifdef GDB}
          deftype:=abstractdef;
-         is_def_stab_written := false;
-         number := 0;
+         indexnb := 0;
          sym := nil;
          owner := nil;
          next := nil;
          has_rtti:=false;
+{$ifdef GDB}
+         is_def_stab_written := false;
          globalnb := 0;
          if assigned(lastglobaldef) then
            begin
@@ -580,7 +580,7 @@
 
     constructor torddef.init(t : tbasetype;v,b : longint);
       begin
-         tdef.init;
+         inherited init;
          deftype:=orddef;
          low:=v;
          high:=b;
@@ -590,7 +590,7 @@
 
     constructor torddef.load;
       begin
-         tdef.load;
+         inherited load;
          deftype:=orddef;
          typ:=tbasetype(readbyte);
          low:=readlong;
@@ -910,7 +910,7 @@
           _private : array[1..26] of byte;
           userdata : array[1..16] of byte;
           name : string[79 or 255 for linux]; }
-{$ifdef i386}   
+{$ifdef i386}
 
       if (target_info.target=target_GO32V1) or
          (target_info.target=target_GO32V2) then
@@ -1356,13 +1356,11 @@
       end;
 
     function tarraydef.needs_rtti : boolean;
-
       begin
          needs_rtti:=definition^.needs_rtti;
       end;
 
     procedure tarraydef.generate_rtti;
-
       begin
          { first, generate the rtti of the element type, else we get mixed }
          { up because the rtti would be mixed                              }
@@ -1797,14 +1795,16 @@
          localst^.next:=parast;
 {$ifdef UseBrowser}
          defref:=nil;
-         if make_ref then
-           add_new_ref(defref,@tokenpos);
-         lastref:=defref;
          lastwritten:=nil;
-         refcount:=1;
+         refcount:=0;
+         if (cs_browser in aktswitches) and make_ref then
+          begin
+            defref:=new(pref,init(defref,@tokenpos));
+            inc(refcount);
+          end;
+         lastref:=defref;
 {$endif UseBrowser}
-
-         { first, we assume, that all registers are used }
+       { first, we assume, that all registers are used }
 {$ifdef i386}
          usedregisters:=$ff;
 {$endif i386}
@@ -1821,10 +1821,8 @@
       end;
 
     constructor tprocdef.load;
-
       var
          s : string;
-
       begin
          { deftype:=procdef; this is at the wrong place !! }
          inherited load;
@@ -1854,47 +1852,78 @@
          localst:=nil;
          forwarddef:=false;
 {$ifdef UseBrowser}
-         if (current_module^.flags and uf_uses_browser)<>0 then
-           load_references
-         else
-           begin
-              lastref:=nil;
-              lastwritten:=nil;
-              defref:=nil;
-              refcount:=0;
-           end;
+         lastref:=nil;
+         lastwritten:=nil;
+         defref:=nil;
+         refcount:=0;
+         if (current_module^.flags and uf_has_browser)<>0 then
+           load_references;
 {$endif UseBrowser}
       end;
 
 {$ifdef UseBrowser}
+
+{$ifdef NEWPPU}
+
     procedure tprocdef.load_references;
+      var
+        pos : tfileposinfo;
+      begin
+        while (not ppufile^.endofentry) do
+         begin
+           readposinfo(pos);
+           inc(refcount);
+           lastref:=new(pref,init(lastref,@pos));
+           if refcount=1 then
+            defref:=lastref;
+         end;
+      end;
 
-      var fileindex : word;
-          b : byte;
-          l,c : longint;
 
+    procedure tprocdef.write_references;
+      var
+        ref : pref;
+      begin
+        if lastwritten=lastref then
+          exit;
+      { write address of this symbol }
+        writedefref(@self);
+      { write refs }
+        if assigned(lastwritten) then
+          ref:=lastwritten
+        else
+          ref:=defref;
+        while assigned(ref) do
+          begin
+             writeposinfo(ref^.posinfo);
+             ref:=ref^.nextref;
+          end;
+        ppufile^.writeentry(ibdefref);
+        lastwritten:=lastref;
+      end;
+
+{$else NEWPPU}
+
+    procedure tprocdef.load_references;
+      var
+        pos : tfileposinfo;
+        b   : byte;
       begin
          b:=readbyte;
-         refcount:=0;
-         lastref:=nil;
-         lastwritten:=nil;
-         defref:=nil;
          while b=ibref do
            begin
-              fileindex:=readword;
-              l:=readlong;
-              c:=readword;
+              readposinfo(pos);
               inc(refcount);
-              lastref:=new(pref,load(lastref,fileindex,l,c));
-              if refcount=1 then defref:=lastref;
+              lastref:=new(pref,init(lastref,@pos));
+              if refcount=1 then
+                defref:=lastref;
               b:=readbyte;
            end;
           if b <> ibend then
-         { Message(unit_f_ppu_read);
-          message disappeared ?? }
-            Comment(V_fatal,'error in load_reference');
+           Comment(V_fatal,'error in load_reference');
       end;
 
+
     procedure tprocdef.write_references;
 
       var ref : pref;
@@ -1911,9 +1940,7 @@
          while assigned(ref) do
            begin
               writebyte(ibref);
-              writeword(ref^.posinfo.fileindex);
-              writelong(ref^.posinfo.line);
-              writeword(ref^.posinfo.column);
+              writeposinfo(ref^.posinfo);
               ref:=ref^.nextref;
            end;
          lastwritten:=lastref;
@@ -1937,44 +1964,34 @@
          while assigned(ref) do
            begin
               writebyte(ibref);
-              writeword(ref^.posinfo.fileindex);
-              writelong(ref^.posinfo.line);
-              writeword(ref^.posinfo.column);
+              writeposinfo(ref^.posinfo);
               ref:=ref^.nextref;
            end;
          lastwritten:=lastref;
          writebyte(ibend);
-         ppufile.do_crc:=true;
+         ppufile.do_crc:=false;
       end;
 
-    procedure tprocdef.write_ref_to_file(var f : text);
 
-      var ref : pref;
-         i : longint;
+{$endif NEWPPU}
 
+    procedure tprocdef.add_to_browserlog;
       begin
-         ref:=defref;
-         if assigned(ref) then
-           begin
-              for i:=1 to reffile_indent do
-                system.write(f,' ');
-              writeln(f,'***',mangledname);
-           end;
-         inc(reffile_indent,2);
-         while assigned(ref) do
-           begin
-              for i:=1 to reffile_indent do
-                system.write(f,' ');
-              writeln(f,ref^.get_file_line);
-              ref:=ref^.nextref;
-           end;
-         dec(reffile_indent,2);
+         if assigned(defref) then
+          begin
+            Browse.AddLog('***'+mangledname);
+            Browse.AddLogRefs(defref);
+          end;
       end;
+
 {$endif UseBrowser}
 
     destructor tprocdef.done;
-
       begin
+{$ifdef UseBrowser}
+         if assigned(defref) then
+           dispose(defref,done);
+{$endif UseBrowser}
          if assigned(parast) then
            dispose(parast,done);
          if assigned(localst) then
@@ -1983,13 +2000,12 @@
 {$ifdef tp}
          not(use_big) and
 {$endif}
-         assigned(_mangledname) then
+           assigned(_mangledname) then
            strdispose(_mangledname);
          inherited done;
       end;
 
     procedure tprocdef.write;
-
       begin
 {$ifndef NEWPPU}
          writebyte(ibprocdef);
@@ -2019,14 +2035,9 @@
                writeptree(ptree(code));
                }
            end;
-           
 {$ifdef NEWPPU}
          ppufile^.writeentry(ibprocdef);
 {$endif}
-{$ifdef UseBrowser}
-         if (current_module^.flags and uf_uses_browser)<>0 then
-           write_references;
-{$endif UseBrowser}
       end;
 
 {$ifdef GDB}
@@ -2620,7 +2631,12 @@
 
 {
   $Log$
-  Revision 1.9  1998-06-12 14:10:37  michael
+  Revision 1.10  1998-06-13 00:10:16  peter
+    * working browser and newppu
+    * some small fixes against crashes which occured in bp7 (but not in
+      fpc?!)
+
+  Revision 1.9  1998/06/12 14:10:37  michael
   * Fixed wrong code for ansistring
 
   Revision 1.8  1998/06/11 10:11:58  peter
@@ -2640,9 +2656,8 @@
       for win32
 
   Revision 1.4  1998/06/04 09:55:45  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.3  1998/06/03 22:49:03  peter
     + wordbool,longbool
@@ -2660,4 +2675,4 @@
     * symtable adapted for $ifdef NEWPPU
 
 }
-  
+

+ 33 - 34
compiler/symppu.inc

@@ -42,31 +42,37 @@
         ppufile^.putbyte(b);
       end;
 
+
     procedure writeword(w:word);
       begin
         ppufile^.putword(w);
       end;
 
+
     procedure writelong(l:longint);
       begin
         ppufile^.putlongint(l);
       end;
 
+
     procedure writedouble(d:double);
       begin
         ppufile^.putdata(d,sizeof(double));
       end;
 
+
     procedure writestring(const s:string);
       begin
         ppufile^.putstring(s);
       end;
 
+
     procedure writeset(var s); {You cannot pass an array[0..31] of byte!}
       begin
         ppufile^.putdata(s,32);
       end;
 
+
     procedure writecontainer(var p:tstringcontainer;id:byte;hold:boolean);
       var
         hcontainer : tstringcontainer;
@@ -86,6 +92,7 @@
          p:=hcontainer;
       end;
 
+
     procedure writeposinfo(const p:tfileposinfo);
       begin
         writeword(p.fileindex);
@@ -93,6 +100,7 @@
         writeword(p.column);
       end;
 
+
     procedure writedefref(p : pdef);
       begin
         if p=nil then
@@ -103,12 +111,11 @@
             ppufile^.putword($ffff)
            else
             ppufile^.putword(p^.owner^.unitid);
-           ppufile^.putword(p^.number);
+           ppufile^.putword(p^.indexnb);
          end;
       end;
 
 
-{$ifdef UseBrowser}
     procedure writesymref(p : psym);
       begin
         if p=nil then
@@ -122,13 +129,9 @@
            writeword(p^.indexnb);
          end;
       end;
-{$endif UseBrowser}
 
-    procedure writeunitas(const s : string;unit_symtable : punitsymtable);
-{$ifdef UseBrowser}
-      var
-         pus : punitsymtable;
-{$endif UseBrowser}
+
+    procedure writeunitas(const s : string;unittable : punitsymtable);
       begin
          Message1(unit_u_ppu_write,s);
 
@@ -142,31 +145,25 @@
                  flags:=flags or uf_in_library;
              end;
             if use_dbx then
-             flags:=flags or uf_uses_dbx;
+             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;
+            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);
-         unit_symtable^.writeasunit;
-{$ifdef UseBrowser}
-         { write all new references to old unit elements }
-         pus:=punitsymtable(unit_symtable^.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}
+
+       { write symbols and definitions }
+         unittable^.writeasunit;
+
+       { flush to be sure }
          ppufile^.flush;
        { create and write header }
          ppufile^.header.size:=ppufile^.size;
@@ -234,6 +231,7 @@
          p:=hcontainer;
       end;
 
+
     procedure writeposinfo(const p:tfileposinfo);
       begin
         writeword(p.fileindex);
@@ -251,12 +249,10 @@
             writeword($ffff)
            else
             writeword(p^.owner^.unitid);
-           writeword(p^.number);
+           writeword(p^.indexnb);
          end;
       end;
 
-
-{$ifdef UseBrowser}
     procedure writesymref(p : psym);
       begin
         if p=nil then
@@ -270,10 +266,8 @@
            writeword(p^.indexnb);
          end;
       end;
-{$endif UseBrowser}
-
 
-    procedure writeunitas(const s : string;unit_symtable : punitsymtable);
+    procedure writeunitas(const s : string;unittable : punitsymtable);
 {$ifdef UseBrowser}
       var
          pus : punitsymtable;
@@ -291,7 +285,7 @@
                  flags:=flags or uf_in_library;
              end;
             if use_dbx then
-             flags:=flags or uf_uses_dbx;
+             flags:=flags or uf_has_dbx;
             if target_os.endian=en_big_endian then
              flags:=flags or uf_big_endian;
 {$ifdef UseBrowser}
@@ -312,12 +306,12 @@
          ppufile.write_data(unitheader,sizeof(unitheader));
          ppufile.clear_crc;
          ppufile.do_crc:=true;
-         unit_symtable^.writeasunit;
+         unittable^.writeasunit;
          ppufile.flush;
          ppufile.do_crc:=false;
 {$ifdef UseBrowser}
          { write all new references to old unit elements }
-         pus:=punitsymtable(unit_symtable^.next);
+         pus:=punitsymtable(unittable^.next);
          if use_browser then
          while assigned(pus) do
            begin
@@ -532,7 +526,12 @@
 
 {
   $Log$
-  Revision 1.2  1998-05-28 14:40:28  peter
+  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?!)
+
+  Revision 1.2  1998/05/28 14:40:28  peter
     * fixes for newppu, remake3 works now with it
 
   Revision 1.1  1998/05/27 19:45:09  peter
@@ -540,4 +539,4 @@
     * symtable adapted for $ifdef NEWPPU
 
 }
-  
+

+ 98 - 164
compiler/symsym.inc

@@ -41,10 +41,13 @@
 {$ifdef UseBrowser}
          defref:=nil;
          lastwritten:=nil;
-         if make_ref then
-           add_new_ref(defref,@tokenpos);
+         refcount:=0;
+         if (cs_browser in aktswitches) and make_ref then
+          begin
+            defref:=new(pref,init(defref,@tokenpos));
+            inc(refcount);
+          end;
          lastref:=defref;
-         refcount:=1;
 {$endif UseBrowser}
       end;
 
@@ -55,6 +58,7 @@
          right:=nil;
          setname(readstring);
          typ:=abstractsym;
+         line_no:=0;
          if object_options then
            properties:=symprop(readbyte)
          else
@@ -64,16 +68,10 @@
          defref:=nil;
          lastwritten:=nil;
          refcount:=0;
-         if (current_module^.flags and uf_uses_browser)<>0 then
-           { references do not change the ppu caracteristics      }
-           { this only save the references to variables/functions }
-           { defined in the unit what about the others            }
-           load_references;
 {$endif UseBrowser}
 {$ifdef GDB}
          isstabwritten := false;
 {$endif GDB}
-         line_no:=0;
       end;
 
 {$ifdef UseBrowser}
@@ -82,98 +80,51 @@
 
     procedure tsym.load_references;
       var
-        fileindex : word;
-        b         : byte;
-        l,c       : longint;
+        pos : tfileposinfo;
       begin
-         b:=readentry;
-         if b=ibref then
-          begin
-            while (not ppufile^.endofentry) do
-             begin
-               fileindex:=readword;
-               l:=readlong;
-               c:=readword;
-               inc(refcount);
-               lastref:=new(pref,load(lastref,fileindex,l,c));
-               if refcount=1 then
-                defref:=lastref;
-             end;
-          end
-         else
-          Message(unit_f_ppu_read_error);
-         lastwritten:=lastref;
+        while (not ppufile^.endofentry) do
+         begin
+           readposinfo(pos);
+           inc(refcount);
+           lastref:=new(pref,init(lastref,@pos));
+           if refcount=1 then
+            defref:=lastref;
+         end;
+        lastwritten:=lastref;
       end;
 
     procedure tsym.write_references;
       var
-        ref : pref;
-      begin
-      { references do not change the ppu caracteristics      }
-      { this only save the references to variables/functions }
-      { defined in the unit what about the others            }
-         ppufile^.do_crc:=false;
-         if assigned(lastwritten) then
-           ref:=lastwritten
-         else
-           ref:=defref;
-         while assigned(ref) do
-           begin
-              writeposinfo(ref^.posinfo);
-              ref:=ref^.nextref;
-           end;
-         lastwritten:=lastref;
-         ppufile^.writeentry(ibref);
-         ppufile^.do_crc:=true;
-      end;
-
-
-    procedure load_external_references;
-      var b     : byte;
-          sym   : psym;
-          prdef : pdef;
-      begin
-        b:=readentry;
-        if b=ibextsymref then
+        ref   : pref;
+        prdef : pdef;
+      begin
+        if lastwritten=lastref then
+          exit;
+      { write address to this symbol }
+        writesymref(@self);
+      { write symbol refs }
+        if assigned(lastwritten) then
+          ref:=lastwritten
+        else
+          ref:=defref;
+        while assigned(ref) do
          begin
-           sym:=readsymref;
-           resolvesym(sym);
-           sym^.load_references;
+           writeposinfo(ref^.posinfo);
+           ref:=ref^.nextref;
+         end;
+        lastwritten:=lastref;
+        ppufile^.writeentry(ibsymref);
+      { when it's a procsym then write also the refs to the definition
+        due the overloading }
+        if typ=procsym then
+         begin
+           prdef:=pprocsym(@self)^.definition;
+           while assigned(prdef) do
+            begin
+              pprocdef(prdef)^.write_references;
+              prdef:=pprocdef(prdef)^.nextoverloaded;
+            end;
          end;
-         ibextdefref : begin
-                         prdef:=readdefref;
-                         resolvedef(prdef);
-                         if prdef^.deftype<>procdef then
-                          Message(unit_f_ppu_read_error);
-                         pprocdef(prdef)^.load_references;
-                       end;
-        else
-          Message(unit_f_ppu_read_error);
-        end;
-      end;
-
-    procedure tsym.write_external_references;
-      var ref : pref;
-          prdef : pdef;
-      begin
-         ppufile^.do_crc:=false;
-         if lastwritten=lastref then
-           exit;
-         writesymref(@self);
-         writeentry(ibextsymref);
-
-         write_references;
-
-         if typ=procsym then
-           begin
-              prdef:=pprocsym(@self)^.definition;
-              while assigned(prdef) do
-                begin
-                   pprocdef(prdef)^.write_external_references;
-                   prdef:=pprocdef(prdef)^.nextoverloaded;
-                end;
-           end;
-         ppufile^.do_crc:=true;
       end;
 
 {$else NEWPPU}
@@ -228,37 +179,6 @@
       end;
 
 
-    procedure load_external_references;
-
-      var b : byte;
-          sym : psym;
-          prdef : pdef;
-      begin
-         b:=readbyte;
-         while (b=ibextsymref) or (b=ibextdefref) do
-           begin
-              if b=ibextsymref then
-                begin
-                   sym:=readsymref;
-                   resolvesym(sym);
-                   sym^.load_references;
-                   b:=readbyte;
-                end
-              else
-              if b=ibextdefref then
-                begin
-                   prdef:=readdefref;
-                   resolvedef(prdef);
-                   if prdef^.deftype<>procdef then
-                    Message(unit_f_ppu_read_error);
-                   pprocdef(prdef)^.load_references;
-                   b:=readbyte;
-                end;
-           end;
-         if b <> ibend then
-           Message(unit_f_ppu_read_error);
-      end;
-
     procedure tsym.write_external_references;
       var ref : pref;
           prdef : pdef;
@@ -296,44 +216,48 @@
 
 {$endif NEWPPU}
 
-    procedure tsym.write_ref_to_file(var f : text);
-
-      var ref : pref;
-         i : longint;
-
+    procedure tsym.add_to_browserlog;
+      var
+        prdef : pprocdef;
       begin
-         ref:=defref;
-         if assigned(ref) then
-           begin
-              for i:=1 to reffile_indent do
-                system.write(f,' ');
-              writeln(f,'***',name,'***');
-           end;
-         inc(reffile_indent,2);
-         while assigned(ref) do
-           begin
-              for i:=1 to reffile_indent do
-                system.write(f,' ');
-              writeln(f,ref^.get_file_line);
-              ref:=ref^.nextref;
-           end;
-         dec(reffile_indent,2);
+        if assigned(defref) then
+         begin
+           Browse.AddLog('***'+name+'***');
+           Browse.AddLogRefs(defref);
+         end;
+      { when it's a procsym then write also the refs to the definition
+        due the overloading }
+        if typ=procsym then
+         begin
+           prdef:=pprocsym(@self)^.definition;
+           while assigned(prdef) do
+            begin
+              pprocdef(prdef)^.add_to_browserlog;
+              prdef:=pprocdef(prdef)^.nextoverloaded;
+            end;
+         end;
       end;
 {$endif UseBrowser}
 
-    destructor tsym.done;
 
+    destructor tsym.done;
       begin
 {$ifdef tp}
          if not(use_big) then
 {$endif tp}
            strdispose(_name);
-         if assigned(left) then dispose(left,done);
-         if assigned(right) then dispose(right,done);
+{$ifdef UseBrowser}
+         if assigned(defref) then
+          dispose(defref,done);
+{$endif UseBrowser}
+         if assigned(left) then
+           dispose(left,done);
+         if assigned(right) then
+           dispose(right,done);
       end;
 
-    destructor tsym.single_done;
 
+    destructor tsym.single_done;
       begin
 {$ifdef tp}
          if not(use_big) then
@@ -348,8 +272,8 @@
          if object_options then
            writebyte(byte(properties));
 {$ifdef UseBrowser}
-         if (current_module^.flags and uf_uses_browser)<>0 then
-           write_references;
+{         if cs_browser in aktswitches then
+           write_references; }
 {$endif UseBrowser}
       end;
 
@@ -462,9 +386,13 @@
 ****************************************************************************}
 
     constructor tunitsym.init(const n : string;ref : punitsymtable);
-
+      var
+        old_make_ref : boolean;
       begin
-         tsym.init(n);
+         old_make_ref:=make_ref;
+         make_ref:=false;
+         inherited init(n);
+         make_ref:=old_make_ref;
          typ:=unitsym;
          unitsymtable:=ref;
          prevsym:=ref^.unitsym;
@@ -627,8 +555,8 @@
 
     constructor tprogramsym.init(const n : string);
       begin
-         tsym.init(n);
-         typ:=programsym;
+        inherited init(n);
+        typ:=programsym;
       end;
 
 {****************************************************************************
@@ -637,8 +565,8 @@
 
     constructor terrorsym.init;
       begin
-         tsym.init('');
-         typ:=errorsym;
+        inherited init('');
+        typ:=errorsym;
       end;
 
 {****************************************************************************
@@ -877,12 +805,12 @@
          address:=0;
          refs:=0;
          is_valid := 1;
+         var_options:=0;
          { can we load the value into a register ? }
          case p^.deftype of
         pointerdef,
            enumdef,
-        procvardef :
-          var_options:=var_options or vo_regable;
+        procvardef : var_options:=var_options or vo_regable;
             orddef : case porddef(p)^.typ of
                        u8bit,u16bit,u32bit,
                        bool8bit,bool16bit,bool32bit,
@@ -906,7 +834,8 @@
          varspez:=tvarspez(readbyte);
          if read_member then
            address:=readlong
-         else address:=0;
+         else
+           address:=0;
          definition:=readdefref;
          refs := 0;
          is_valid := 1;
@@ -923,7 +852,7 @@
          var_options:=var_options or vo_is_C_var;
          _mangledname:=strpnew(target_os.Cprefix+mangled);
       end;
-      
+
     constructor tvarsym.load_C;
 
       begin
@@ -1248,7 +1177,7 @@
          strdispose(_mangledname);
          inherited done;
       end;
-      
+
 
 {****************************************************************************
                              TTYPEDCONSTSYM
@@ -1742,7 +1671,12 @@
 
 {
   $Log$
-  Revision 1.9  1998-06-12 16:15:35  pierre
+  Revision 1.10  1998-06-13 00:10:18  peter
+    * working browser and newppu
+    * some small fixes against crashes which occured in bp7 (but not in
+      fpc?!)
+
+  Revision 1.9  1998/06/12 16:15:35  pierre
     * external name 'C_var';
       export name 'intern_C_var';
       cdecl;