* GDB works again better :

    correct type info in one pass
  + UseTokenInfo for better source position
  * fixed one remaining bug in scanner for line counts
  * several little fixes

compiler/browser.pas

@@ -95,11 +95,10 @@ implementation
       begin
         get_file_line:='';
         if inputfile=nil then exit;
-{$ifdef USE_RHIDE}
-        get_file_line:=lowercase(inputfile^.name^+inputfile^.ext^)+':'+tostr(lineno)+':'
-{$else  USE_RHIDE}
-        get_file_line:=inputfile^.name^+inputfile^.ext^+'('+tostr(lineno)+')'
-{$endif USE_RHIDE}
+        if Use_Rhide then
+          get_file_line:=lowercase(inputfile^.name^+inputfile^.ext^)+':'+tostr(lineno)+':'
+        else
+          get_file_line:=inputfile^.name^+inputfile^.ext^+'('+tostr(lineno)+')'
       end;
 
   procedure add_new_ref(var ref : pref);
@@ -134,8 +133,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.1  1998-03-25 11:18:12  root
-  Initial revision
+  Revision 1.2  1998-04-30 15:59:39  pierre
+    * GDB works again better :
+      correct type info in one pass
+    + 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

compiler/cgi386.pas

@@ -4786,6 +4786,9 @@ implementation
 
       begin
          secondpass(p^.left);
+         if (p^.left^.resulttype<>pdef(voiddef)) then
+           if p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE] then
+             ungetiftemp(p^.left^.location.reference);
       end;
 
     procedure secondblockn(var p : ptree);
@@ -4802,6 +4805,9 @@ implementation
                 begin
                    cleartempgen;
                    secondpass(hp^.right);
+                   if (hp^.right^.resulttype<>pdef(voiddef)) then
+                     if hp^.right^.location.loc in [LOC_MEM,LOC_REFERENCE] then
+                       ungetiftemp(hp^.right^.location.reference);
                 end;
               hp:=hp^.left;
            end;
@@ -5751,22 +5757,24 @@ do_jmp:
       begin
          oldcodegenerror:=codegenerror;
          oldswitches:=aktswitches;
-           oldis:=current_module^.current_inputfile;
-            oldnr:=current_module^.current_inputfile^.line_no;
+         oldis:=current_module^.current_inputfile;
+         oldnr:=current_module^.current_inputfile^.line_no;
 
          codegenerror:=false;
-           current_module^.current_inputfile:=p^.inputfile;
-         current_module^.current_inputfile^.line_no:=p^.line;
+         current_module^.current_inputfile:=
+           pinputfile(current_module^.sourcefiles.get_file(p^.fileinfo.fileindex));
+         current_module^.current_inputfile^.line_no:=p^.fileinfo.line;
          aktswitches:=p^.pragmas;
          if not(p^.error) then
            begin
               procedures[p^.treetype](p);
               p^.error:=codegenerror;
-                 codegenerror:=codegenerror or oldcodegenerror;
+              codegenerror:=codegenerror or oldcodegenerror;
            end
-         else codegenerror:=true;
+         else
+           codegenerror:=true;
          aktswitches:=oldswitches;
-           current_module^.current_inputfile:=oldis;
+         current_module^.current_inputfile:=oldis;
          current_module^.current_inputfile^.line_no:=oldnr;
       end;
 
@@ -6025,7 +6033,14 @@ do_jmp:
 end.
 {
   $Log$
-  Revision 1.18  1998-04-29 10:33:48  pierre
+  Revision 1.19  1998-04-30 15:59:39  pierre
+    * GDB works again better :
+      correct type info in one pass
+    + UseTokenInfo for better source position
+    * fixed one remaining bug in scanner for line counts
+    * several little fixes
+
+  Revision 1.18  1998/04/29 10:33:48  pierre
     + added some code for ansistring (not complete nor working yet)
     * corrected operator overloading
     * corrected nasm output

compiler/cgi386ad.inc

@@ -133,17 +133,18 @@
          flags : tresflags;
       begin
          if (p^.left^.resulttype^.deftype<>stringdef) and
-            not ((p^.left^.resulttype^.deftype=setdef) and
-               (psetdef(p^.left^.resulttype)^.settype<>smallset)) then
-           begin
-              { this can be useful if for instance length(string) is called }
+             ((p^.left^.resulttype^.deftype<>setdef) or
+              (psetdef(p^.left^.resulttype)^.settype=smallset)) then
               if (p^.left^.location.loc=LOC_REFERENCE) or
                  (p^.left^.location.loc=LOC_MEM) then
                 ungetiftemp(p^.left^.location.reference);
+         if (p^.right^.resulttype^.deftype<>stringdef) and
+             ((p^.right^.resulttype^.deftype<>setdef) or
+              (psetdef(p^.right^.resulttype)^.settype=smallset)) then
+              { this can be useful if for instance length(string) is called }
               if (p^.right^.location.loc=LOC_REFERENCE) or
                  (p^.right^.location.loc=LOC_MEM) then
                 ungetiftemp(p^.right^.location.reference);
-           end;
          { in case of comparison operation the put result in the flags }
          if cmpop then
            begin
@@ -1270,7 +1271,14 @@
 
 {
      $Log$
-     Revision 1.5  1998-04-29 10:33:49  pierre
+     Revision 1.6  1998-04-30 15:59:40  pierre
+       * GDB works again better :
+         correct type info in one pass
+       + UseTokenInfo for better source position
+       * fixed one remaining bug in scanner for line counts
+       * several little fixes
+
+     Revision 1.5  1998/04/29 10:33:49  pierre
        + added some code for ansistring (not complete nor working yet)
        * corrected operator overloading
        * corrected nasm output

compiler/cobjects.pas

@@ -43,12 +43,21 @@ unit cobjects;
     type
        pstring = ^string;
 
+       tfileposinfo = record
+         line : longint; { could be changed to abspos }
+         fileindex,column : word;
+       end;
+       pfileposinfo = ^tfileposinfo;
+
        { some help data types }
        pstringitem = ^tstringitem;
 
        tstringitem = record
           data : pstring;
           next : pstringitem;
+{$ifdef UseTokenInfo}
+          fileinfo : tfileposinfo; { pointer to tinputfile }
+{$endif UseTokenInfo}
        end;
 
        plinkedlist_item = ^tlinkedlist_item;
@@ -127,9 +136,15 @@ unit cobjects;
 
           { inserts a string }
           procedure insert(const s : string);
+{$ifdef UseTokenInfo}
+          procedure insert_with_tokeninfo(const s : string;const file_info : tfileposinfo);
+{$endif UseTokenInfo}
 
           { gets a string }
           function get : string;
+{$ifdef UseTokenInfo}
+    function get_with_tokeninfo(var file_info : tfileposinfo) : string;
+{$endif UseTokenInfo}
 
           { deletes all strings }
           procedure clear;
@@ -456,6 +471,33 @@ end;
          last:=hp;
       end;
 
+{$ifdef UseTokenInfo}
+          procedure tstringcontainer.insert_with_tokeninfo
+            (const s : string; const file_info : tfileposinfo);
+
+      var
+         hp : pstringitem;
+
+      begin
+         if not(doubles) then
+           begin
+              hp:=root;
+              while assigned(hp) do
+                begin
+                   if hp^.data^=s then exit;
+                   hp:=hp^.next;
+                end;
+           end;
+         new(hp);
+         hp^.next:=nil;
+         hp^.data:=stringdup(s);
+         hp^.fileinfo:=file_info;
+         if root=nil then root:=hp
+           else last^.next:=hp;
+         last:=hp;
+      end;
+
+{$endif UseTokenInfo}
     procedure tstringcontainer.clear;
 
       var
@@ -492,6 +534,32 @@ end;
           end;
       end;
 
+{$ifdef UseTokenInfo}
+    function tstringcontainer.get_with_tokeninfo(var file_info : tfileposinfo) : string;
+
+      var
+         hp : pstringitem;
+
+      begin
+         if root=nil then
+          begin
+             get_with_tokeninfo:='';
+             file_info.fileindex:=0;
+             file_info.line:=0;
+             file_info.column:=0;
+          end
+         else
+          begin
+            get_with_tokeninfo:=root^.data^;
+            hp:=root;
+            root:=root^.next;
+            stringdispose(hp^.data);
+            file_info:=hp^.fileinfo;
+            dispose(hp);
+          end;
+      end;
+{$endif UseTokenInfo}
+
 {****************************************************************************
                             TLINKEDLIST_ITEM
  ****************************************************************************}
@@ -995,7 +1063,14 @@ end;
 end.
 {
   $Log$
-  Revision 1.4  1998-04-29 10:33:50  pierre
+  Revision 1.5  1998-04-30 15:59:40  pierre
+    * GDB works again better :
+      correct type info in one pass
+    + UseTokenInfo for better source position
+    * fixed one remaining bug in scanner for line counts
+    * several little fixes
+
+  Revision 1.4  1998/04/29 10:33:50  pierre
     + added some code for ansistring (not complete nor working yet)
     * corrected operator overloading
     * corrected nasm output

compiler/files.pas

@@ -71,14 +71,9 @@ unit files;
           destructor done;
           procedure close_all;
           procedure register_file(f : pextfile);
+          function  get_file(w : word) : pextfile;
        end;
 
-       tfileposinfo = record
-         infile : pinputfile;
-         line : longint; { could be changed to abspos }
-       end;
-       pfileposinfo = ^tfileposinfo;
-
     type
        tunitmap = array[0..maxunits-1] of pointer;
        punitmap = ^tunitmap;
@@ -110,6 +105,8 @@ unit files;
           linkofiles    : tstringcontainer;
           used_units    : tlinkedlist;
           current_inputfile : pinputfile;
+          { used in firstpass for faster settings }
+          current_index : word;
 
           unitname,                 { name of the (unit) module in uppercase }
           objfilename,              { fullname of the objectfile }
@@ -258,11 +255,10 @@ unit files;
     function tinputfile.get_file_line : string;
 
       begin
-{$ifdef USE_RHIDE}
-        get_file_line:=lowercase(name^+ext^)+':'+tostr(line_no)+':'
-{$else  USE_RHIDE}
-        get_file_line:=name^+ext^+'('+tostr(line_no)+')'
-{$endif USE_RHIDE}
+        if Use_Rhide then
+          get_file_line:=lowercase(bstoslash(path^)+name^+ext^)+':'+tostr(line_no)+':'
+        else
+          get_file_line:=name^+ext^+'('+tostr(line_no)+')'
       end;
 
 {****************************************************************************
@@ -305,6 +301,16 @@ unit files;
          files:=f;
       end;
 
+   function tfilemanager.get_file(w : word) : pextfile;
+
+     var
+        ff : pextfile;
+     begin
+        ff:=files;
+        while assigned(ff) and (ff^.ref_index<>w) do
+          ff:=ff^._next;
+        get_file:=ff;
+     end;
 {****************************************************************************
                                   TMODULE
  ****************************************************************************}
@@ -624,7 +630,14 @@ unit files;
 end.
 {
   $Log$
-  Revision 1.4  1998-04-29 10:33:52  pierre
+  Revision 1.5  1998-04-30 15:59:40  pierre
+    * GDB works again better :
+      correct type info in one pass
+    + UseTokenInfo for better source position
+    * fixed one remaining bug in scanner for line counts
+    * several little fixes
+
+  Revision 1.4  1998/04/29 10:33:52  pierre
     + added some code for ansistring (not complete nor working yet)
     * corrected operator overloading
     * corrected nasm output

compiler/parser.pas

@@ -303,6 +303,7 @@ unit parser;
          token:=tokeninfo^.token;
 {$endif UseTokenInfo}
 
+         reset_gdb_info;
          { init asm writing }
          datasegment:=new(paasmoutput,init);
          codesegment:=new(paasmoutput,init);
@@ -462,6 +463,7 @@ done:
               dispose(consts,Done);
            end;
 
+         reset_gdb_info;
          { restore symtable state }
 {$ifdef UseBrowser}
          if (compile_level>1) then
@@ -524,7 +526,6 @@ done:
 
          nextlabelnr:=oldnextlabelnr;
 
-         reset_gdb_info;
          if (compile_level=1) then
           begin
             if (not AsmRes.Empty) then
@@ -539,7 +540,14 @@ done:
 end.
 {
   $Log$
-  Revision 1.8  1998-04-29 10:33:55  pierre
+  Revision 1.9  1998-04-30 15:59:40  pierre
+    * GDB works again better :
+      correct type info in one pass
+    + UseTokenInfo for better source position
+    * fixed one remaining bug in scanner for line counts
+    * several little fixes
+
+  Revision 1.8  1998/04/29 10:33:55  pierre
     + added some code for ansistring (not complete nor working yet)
     * corrected operator overloading
     * corrected nasm output

compiler/pass_1.pas

@@ -1711,6 +1711,7 @@ unit pass_1;
     procedure firstnothing(var p : ptree);
 
       begin
+         p^.resulttype:=voiddef;
       end;
 
     procedure firstassignment(var p : ptree);
@@ -4017,20 +4018,39 @@ unit pass_1;
            procinfo.flags:=procinfo.flags or pi_do_call;
       end;
 
-    { !!!!!!!!!!!! unused }
-    procedure firstexpr(var p : ptree);
+    procedure firststatement(var p : ptree);
 
       begin
-         firstpass(p^.left);
+         { left is the next statement in the list }
+         p^.resulttype:=voiddef;
+
+         { no temps over several statements }
+         cleartempgen;
+         { right is the statement itself calln assignn or a complex one }
+         firstpass(p^.right);
+         if (not (cs_extsyntax in aktswitches)) and
+            assigned(p^.right^.resulttype) and
+            (p^.right^.resulttype<>pdef(voiddef)) then
+           Message(cg_e_illegal_expression);
          if codegenerror then
            exit;
-         p^.registers32:=p^.left^.registers32;
-         p^.registersfpu:=p^.left^.registersfpu;
+         p^.registers32:=p^.right^.registers32;
+         p^.registersfpu:=p^.right^.registersfpu;
 {$ifdef SUPPORT_MMX}
-         p^.registersmmx:=p^.left^.registersmmx;
+         p^.registersmmx:=p^.right^.registersmmx;
 {$endif SUPPORT_MMX}
-         if (cs_extsyntax in aktswitches) and (p^.left^.resulttype<>pdef(voiddef)) then
-           Message(cg_e_illegal_expression);
+         firstpass(p^.left);
+         if codegenerror then
+           exit;
+              if p^.right^.registers32>p^.registers32 then
+                p^.registers32:=p^.right^.registers32;
+              if p^.right^.registersfpu>p^.registersfpu then
+                p^.registersfpu:=p^.right^.registersfpu;
+{$ifdef SUPPORT_MMX}
+              if p^.right^.registersmmx>p^.registersmmx then
+                p^.registersmmx:=p^.right^.registersmmx;
+{$endif}
+
       end;
 
     procedure firstblock(var p : ptree);
@@ -4067,28 +4087,29 @@ unit pass_1;
                            end;
                       end
                    { warning if unreachable code occurs and elimate this }
-                                   else if (hp^.right^.treetype in
-                                        [exitn,breakn,continuen,goton]) and
-                                        assigned(hp^.left) and
-                                        (hp^.left^.treetype<>labeln) then
-                                                 begin
-                                                        { use correct line number }
-                                                        current_module^.current_inputfile:=hp^.left^.inputfile;
-                                                        current_module^.current_inputfile^.line_no:=hp^.left^.line;
-
-                                                        disposetree(hp^.left);
-                            hp^.left:=nil;
-                            Message(cg_w_unreachable_code);
-
-                            { old lines }
-                            current_module^.current_inputfile:=hp^.right^.inputfile;
-                            current_module^.current_inputfile^.line_no:=hp^.right^.line;
-                         end;
+                   else if (hp^.right^.treetype in
+                     [exitn,breakn,continuen,goton]) and
+                     assigned(hp^.left) and
+                     (hp^.left^.treetype<>labeln) then
+                     begin
+                        { use correct line number }
+                        set_current_file_line(hp^.left);
+                        disposetree(hp^.left);
+                        hp^.left:=nil;
+                        Message(cg_w_unreachable_code);
+
+                        { old lines }
+                        set_current_file_line(hp^.right);
+                     end;
                 end;
               if assigned(hp^.right) then
                 begin
                    cleartempgen;
                    firstpass(hp^.right);
+                   if (not (cs_extsyntax in aktswitches)) and
+                      assigned(hp^.right^.resulttype) and
+                      (hp^.right^.resulttype<>pdef(voiddef)) then
+                     Message(cg_e_illegal_expression);
                    if codegenerror then
                      exit;
 
@@ -4700,7 +4721,7 @@ unit pass_1;
                    setelen,         {A set element (i.e. [a,b]).}
                    setconstrn,      {A set constant (i.e. [1,2]).}
                    blockn,          {A block of statements.}
-                   anwein,          {A linear list of nodes.}
+                   statementn,      {One statement in list of nodes.}
                    loopn,           { used in genloopnode, must be converted }
                    ifn,             {An if statement.}
                    breakn,          {A break statement.}
@@ -4741,7 +4762,7 @@ unit pass_1;
              firstnot,firstinline,firstniln,firsterror,
              firsttypen,firsthnewn,firsthdisposen,firstnewn,
              firstsimplenewdispose,firstnothing,firstsetcons,firstblock,
-             firstnothing,firstnothing,firstif,firstnothing,
+             firststatement,firstnothing,firstif,firstnothing,
              firstnothing,first_while_repeat,first_while_repeat,firstfor,
              firstexitn,firstwith,firstcase,firstlabel,
              firstgoto,firstsimplenewdispose,firsttryexcept,firstraise,
@@ -4767,8 +4788,9 @@ unit pass_1;
 {$endif extdebug}
 
          codegenerror:=false;
-         current_module^.current_inputfile:=p^.inputfile;
-         current_module^.current_inputfile^.line_no:=p^.line;
+         current_module^.current_inputfile:=
+           pinputfile(current_module^.sourcefiles.get_file(p^.fileinfo.fileindex));
+         current_module^.current_inputfile^.line_no:=p^.fileinfo.line;
          aktswitches:=p^.pragmas;
 
          if not(p^.error) then
@@ -4805,7 +4827,14 @@ unit pass_1;
 end.
 {
   $Log$
-  Revision 1.13  1998-04-29 10:33:56  pierre
+  Revision 1.14  1998-04-30 15:59:41  pierre
+    * GDB works again better :
+      correct type info in one pass
+    + UseTokenInfo for better source position
+    * fixed one remaining bug in scanner for line counts
+    * several little fixes
+
+  Revision 1.13  1998/04/29 10:33:56  pierre
     + added some code for ansistring (not complete nor working yet)
     * corrected operator overloading
     * corrected nasm output

compiler/pbase.pas

@@ -25,7 +25,7 @@ unit pbase;
   interface
 
     uses
-       cobjects,globals,scanner,symtable,systems,verbose;
+       files,cobjects,globals,scanner,symtable,systems,verbose;
 
     const
        { forward types should only be possible inside  }
@@ -208,7 +208,12 @@ unit pbase;
       begin
          sc:=new(pstringcontainer,init);
          repeat
+{$ifndef UseTokenInfo}
            sc^.insert(pattern);
+{$else UseTokenInfo}
+           sc^.insert_with_tokeninfo(pattern,
+             tokeninfo^.fi);
+{$endif UseTokenInfo}
            consume(ID);
            if token=COMMA then consume(COMMA)
              else break
@@ -222,12 +227,27 @@ unit pbase;
 
       var
          s : string;
+{$ifdef UseTokenInfo}
+         filepos : tfileposinfo;
+         ss : pvarsym;
+{$endif UseTokenInfo}
+
 
       begin
-         s:=sc^.get;
+{$ifdef UseTokenInfo}
+        s:=sc^.get_with_tokeninfo(filepos);
+{$else UseTokenInfo}
+        s:=sc^.get;
+{$endif UseTokenInfo}
          while s<>'' do
            begin
+{$ifndef UseTokenInfo}
               st^.insert(new(pvarsym,init(s,def)));
+{$else UseTokenInfo}
+              ss:=new(pvarsym,init(s,def));
+              ss^.line_no:=filepos.line;
+              st^.insert(ss);
+{$endif UseTokenInfo}
               { static data fields are inserted in the globalsymtable }
               if (st^.symtabletype=objectsymtable) and
                  ((current_object_option and sp_static)<>0) then
@@ -235,7 +255,11 @@ unit pbase;
                    s:=lowercase(st^.name^)+'_'+s;
                    st^.defowner^.owner^.insert(new(pvarsym,init(s,def)));
                 end;
+{$ifdef UseTokenInfo}
+              s:=sc^.get_with_tokeninfo(filepos);
+{$else UseTokenInfo}
               s:=sc^.get;
+{$endif UseTokenInfo}
            end;
          dispose(sc,done);
       end;
@@ -244,7 +268,14 @@ end.
 
 {
   $Log$
-  Revision 1.3  1998-04-29 10:33:57  pierre
+  Revision 1.4  1998-04-30 15:59:41  pierre
+    * GDB works again better :
+      correct type info in one pass
+    + UseTokenInfo for better source position
+    * fixed one remaining bug in scanner for line counts
+    * several little fixes
+
+  Revision 1.3  1998/04/29 10:33:57  pierre
     + added some code for ansistring (not complete nor working yet)
     * corrected operator overloading
     * corrected nasm output

compiler/pdecl.pas

@@ -56,7 +56,7 @@ unit pdecl;
 
     uses
        cobjects,scanner,aasm,tree,pass_1,
-       types,hcodegen,verbose,systems
+       files,types,hcodegen,verbose,systems
 {$ifdef GDB}
        ,gdb
 {$endif GDB}
@@ -382,6 +382,9 @@ unit pdecl;
            sc : pstringcontainer;
            hp : pdef;
            s : string;
+{$ifdef UseTokenInfo}
+           filepos : tfileposinfo;
+{$endif UseTokenInfo}
            pp : pprocdef;
 
         begin
@@ -988,7 +991,7 @@ unit pdecl;
            begin
               do_count_dbx:=true;
               if assigned(aktclass^.owner) and assigned(aktclass^.owner^.name) then
-               debuglist^.concat(new(pai_stabs,init(strpnew('"vmt_'+aktclass^.owner^.name^+n+':S'+
+               datasegment^.concat(new(pai_stabs,init(strpnew('"vmt_'+aktclass^.owner^.name^+n+':S'+
                 typeglobalnumber('__vtbl_ptr_type')+'",'+tostr(N_STSYM)+',0,0,'+aktclass^.vmt_mangledname))));
            end;
 {$endif * GDB *}
@@ -1534,6 +1537,10 @@ unit pdecl;
          old_block_type : tblock_type;
          { to handle absolute }
          abssym : pabsolutesym;
+{$ifdef UseTokenInfo}
+         filepos : tfileposinfo;
+{$endif UseTokenInfo}
+
 
       begin
          hs:='';
@@ -1550,7 +1557,11 @@ unit pdecl;
               p:=read_type('');
               if do_absolute and (token=ID) and (pattern='ABSOLUTE') then
                 begin
-                   s:=sc^.get;
+{$ifdef UseTokenInfo}
+        s:=sc^.get_with_tokeninfo(filepos);
+{$else UseTokenInfo}
+        s:=sc^.get;
+{$endif UseTokenInfo}
                    if sc^.get<>'' then
                     Message(parser_e_absolute_only_one_var);
                    dispose(sc,done);
@@ -1566,6 +1577,9 @@ unit pdecl;
                         abssym^.typ:=absolutesym;
                         abssym^.abstyp:=tovar;
                         abssym^.ref:=srsym;
+{$ifdef UseTokenInfo}
+                        abssym^.line_no:=filepos.line;
+{$endif UseTokenInfo}
                         symtablestack^.insert(abssym);
                      end
                    else
@@ -1577,6 +1591,9 @@ unit pdecl;
                         abssym^.typ:=absolutesym;
                         abssym^.abstyp:=toasm;
                         abssym^.asmname:=stringdup(s);
+{$ifdef UseTokenInfo}
+                        abssym^.line_no:=filepos.line;
+{$endif UseTokenInfo}
                         symtablestack^.insert(abssym);
                      end
                    else
@@ -1589,6 +1606,9 @@ unit pdecl;
                           abssym^.typ:=absolutesym;
                           abssym^.abstyp:=toaddr;
                           abssym^.absseg:=false;
+{$ifdef UseTokenInfo}
+                          abssym^.line_no:=filepos.line;
+{$endif UseTokenInfo}
                           s:=pattern;
                           consume(INTCONST);
                           val(s,abssym^.address,code);
@@ -1758,7 +1778,14 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.12  1998-04-29 10:33:57  pierre
+  Revision 1.13  1998-04-30 15:59:41  pierre
+    * GDB works again better :
+      correct type info in one pass
+    + UseTokenInfo for better source position
+    * fixed one remaining bug in scanner for line counts
+    * several little fixes
+
+  Revision 1.12  1998/04/29 10:33:57  pierre
     + added some code for ansistring (not complete nor working yet)
     * corrected operator overloading
     * corrected nasm output

compiler/pmodules.pas

@@ -496,11 +496,15 @@ unit pmodules;
           aktprocsym:=oldprocsym;
       end;
 
-      procedure parse_uses(symt:Psymtable);
+      procedure parse_implementation_uses(symt:Psymtable);
 
+      var
+         old_module_in_implementation : boolean;
       begin
          if token=_USES then
            begin
+              old_module_in_implementation:=module_in_implementation;
+              module_in_implementation:=true;
               current_module^.in_implementation:=true;
               symt^.symtabletype:=unitsymtable;
               loadunits;
@@ -508,6 +512,7 @@ unit pmodules;
 {$ifdef DEBUG}
               test_symtablestack;
 {$endif DEBUG}
+              module_in_implementation:=old_module_in_implementation;
            end;
       end;
 
@@ -694,7 +699,7 @@ unit pmodules;
          { to reinsert it after loading the implementation units }
          symtablestack:=unitst^.next;
 
-         parse_uses(unitst);
+         parse_implementation_uses(unitst);
 
          { but reinsert the global symtable as lasts }
          unitst^.next:=symtablestack;
@@ -950,7 +955,14 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.7  1998-04-29 10:33:59  pierre
+  Revision 1.8  1998-04-30 15:59:41  pierre
+    * GDB works again better :
+      correct type info in one pass
+    + UseTokenInfo for better source position
+    * fixed one remaining bug in scanner for line counts
+    * several little fixes
+
+  Revision 1.7  1998/04/29 10:33:59  pierre
     + added some code for ansistring (not complete nor working yet)
     * corrected operator overloading
     * corrected nasm output

compiler/pstatmnt.pas

@@ -100,12 +100,12 @@ unit pstatmnt;
            begin
               if first=nil then
                 begin
-                   last:=gennode(anwein,nil,statement);
+                   last:=gennode(statementn,nil,statement);
                    first:=last;
                 end
               else
                 begin
-                   last^.left:=gennode(anwein,nil,statement);
+                   last^.left:=gennode(statementn,nil,statement);
                    last:=last^.left;
                 end;
               if token<>SEMICOLON then
@@ -225,7 +225,7 @@ unit pstatmnt;
            p^.labelnr:=aktcaselabel;
 
            { concats instruction }
-           instruc:=gennode(anwein,instruc,p);
+           instruc:=gennode(statementn,instruc,p);
 
            if not((token=_ELSE) or (token=_OTHERWISE) or (token=_END)) then
              consume(SEMICOLON);
@@ -262,12 +262,12 @@ unit pstatmnt;
            begin
               if first=nil then
                 begin
-                   last:=gennode(anwein,nil,statement);
+                   last:=gennode(statementn,nil,statement);
                    first:=last;
                 end
               else
                 begin
-                   last^.left:=gennode(anwein,nil,statement);
+                   last^.left:=gennode(statementn,nil,statement);
                    last:=last^.left;
                 end;
               if token<>SEMICOLON then
@@ -455,22 +455,22 @@ unit pstatmnt;
          consume(_TRY);
          first:=nil;
          while (token<>_FINALLY) and (token<>_EXCEPT) do
-                   begin
+           begin
               if first=nil then
                 begin
-                                   last:=gennode(anwein,nil,statement);
+                   last:=gennode(statementn,nil,statement);
                    first:=last;
                 end
               else
                 begin
-                                   last^.left:=gennode(anwein,nil,statement);
+                   last^.left:=gennode(statementn,nil,statement);
                    last:=last^.left;
                 end;
-                          if token<>SEMICOLON then
-                                break;
-                          consume(SEMICOLON);
-                          emptystats;
-                   end;
+              if token<>SEMICOLON then
+                break;
+              consume(SEMICOLON);
+              emptystats;
+           end;
          p_try_block:=gensinglenode(blockn,first);
 
          if token=_FINALLY then
@@ -791,12 +791,12 @@ unit pstatmnt;
            begin
               if first=nil then
                 begin
-                   last:=gennode(anwein,nil,statement);
+                   last:=gennode(statementn,nil,statement);
                    first:=last;
                 end
               else
                 begin
-                   last^.left:=gennode(anwein,nil,statement);
+                   last^.left:=gennode(statementn,nil,statement);
                    last:=last^.left;
                 end;
               if token=_END then
@@ -828,7 +828,7 @@ unit pstatmnt;
          code : ptree;
          labelnr : plabel;
 {$ifdef UseTokenInfo}
-         filepos : tfilepos;
+         filepos : tfileposinfo;
 {$endif UseTokenInfo}
 
       label
@@ -836,7 +836,7 @@ unit pstatmnt;
 
       begin
 {$ifdef UseTokenInfo}
-         filepos:=tokeninfo^.filepos;
+         filepos:=tokeninfo^.fi;
 {$endif UseTokenInfo}
          case token of
             _GOTO : begin
@@ -1076,7 +1076,14 @@ unit pstatmnt;
 end.
 {
   $Log$
-  Revision 1.5  1998-04-29 10:33:59  pierre
+  Revision 1.6  1998-04-30 15:59:42  pierre
+    * GDB works again better :
+      correct type info in one pass
+    + UseTokenInfo for better source position
+    * fixed one remaining bug in scanner for line counts
+    * several little fixes
+
+  Revision 1.5  1998/04/29 10:33:59  pierre
     + added some code for ansistring (not complete nor working yet)
     * corrected operator overloading
     * corrected nasm output

compiler/scandir.inc

@@ -604,7 +604,9 @@ const
            current_module^.current_inputfile^.bufpos:=longint(inputpointer)-longint(inputbuffer);
            hp^.next:=current_module^.current_inputfile;
            current_module^.current_inputfile:=hp;
+           status.currentsource:=current_module^.current_inputfile^.name^+current_module^.current_inputfile^.ext^;
            current_module^.sourcefiles.register_file(hp);
+           current_module^.current_index:=hp^.ref_index;
            inputbuffer:=current_module^.current_inputfile^.buf;
            Message1(scan_u_start_include_file,current_module^.current_inputfile^.name^);
            reload;
@@ -823,7 +825,14 @@ const
 
 {
   $Log$
-  Revision 1.4  1998-04-29 13:42:27  peter
+  Revision 1.5  1998-04-30 15:59:42  pierre
+    * GDB works again better :
+      correct type info in one pass
+    + UseTokenInfo for better source position
+    * fixed one remaining bug in scanner for line counts
+    * several little fixes
+
+  Revision 1.4  1998/04/29 13:42:27  peter
     + $IOCHECKS and $ALIGN to test already, other will follow soon
     * fixed the wrong linecounting with comments
 

compiler/scanner.pas

@@ -28,7 +28,7 @@ unit scanner;
   interface
 
     uses
-       globals,files;
+       cobjects,globals,files;
 
     const
 {$ifdef TP}
@@ -135,15 +135,6 @@ unit scanner;
          destructor done;
       end;
 
-{$ifdef UseTokenInfo}
-
-      ttokeninfo = record
-                 token : ttoken;
-                 fi : tfileposinfo;
-                 end;
-      ptokeninfo = ^ttokeninfo;
-{$endif UseTokenInfo}
-
     var
         c              : char;
         orgpattern,
@@ -162,6 +153,15 @@ unit scanner;
         preprocstack   : ppreprocstack;
 
 
+{$ifdef UseTokenInfo}
+    type
+      ttokeninfo = record
+                 token : ttoken;
+                 fi : tfileposinfo;
+                 end;
+      ptokeninfo = ^ttokeninfo;
+{$endif UseTokenInfo}
+
       {public}
         procedure syntaxerror(const s : string);
 {$ifndef UseTokenInfo}
@@ -170,6 +170,9 @@ unit scanner;
         function yylex : ptokeninfo;
 {$endif UseTokenInfo}
         function asmgetchar : char;
+        function get_current_col : longint;
+        procedure get_cur_file_pos(var fileinfo : tfileposinfo);
+        procedure set_cur_file_pos(const fileinfo : tfileposinfo);
 
         procedure InitScanner(const fn: string);
         procedure DoneScanner(testendif:boolean);
@@ -178,13 +181,14 @@ unit scanner;
   implementation
 
      uses
-       dos,cobjects,verbose,pbase,
+       dos,verbose,pbase,
        symtable,switches,link;
 
      var
     { this is usefull to get the write filename
       for the last instruction of an include file !}
        FileHasChanged : Boolean;
+         status : tcompilestatus;
 
 
 {*****************************************************************************
@@ -350,6 +354,8 @@ unit scanner;
            current_module^.current_inputfile^.close;
          { load next module }
            current_module^.current_inputfile:=current_module^.current_inputfile^.next;
+           current_module^.current_index:=current_module^.current_inputfile^.ref_index;
+           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;
          end;
@@ -361,11 +367,11 @@ unit scanner;
 
     procedure linebreak;
       var
-         status : tcompilestatus;
          cur : char;
       begin
         cur:=c;
-        if byte(inputpointer^)=0 then
+        if (byte(inputpointer^)=0) and
+           current_module^.current_inputfile^.filenotatend then
           begin
              reload;
              if byte(cur)+byte(c)<>23 then
@@ -382,7 +388,8 @@ unit scanner;
            totalcompiledlines:=abslines;
            currentline:=current_module^.current_inputfile^.line_no
                +current_module^.current_inputfile^.line_count;
-           currentsource:=current_module^.current_inputfile^.name^+current_module^.current_inputfile^.ext^;
+           { you call strcopy here at each line !!! }
+           {currentsource:=current_module^.current_inputfile^.name^+current_module^.current_inputfile^.ext^;}
            totallines:=0;
          end;
         if compilestatusproc(status) then
@@ -419,16 +426,9 @@ unit scanner;
               readstring[i]:=c;
             end;
         { get next char }
-           c:=inputpointer^;
-           if c=#0 then
-            reload
-           else
-            inc(longint(inputpointer));
+           readchar;
          end;
         readstring[0]:=chr(i);
-      { was the next char a linebreak ? }
-        if c in [#10,#13] then
-         linebreak;
       end;
 
 
@@ -472,16 +472,12 @@ unit scanner;
               readnumber[i]:=c;
             end;
         { get next char }
-           c:=inputpointer^;
-           if c=#0 then
-            reload
-           else
-            inc(longint(inputpointer));
+           readchar;
          end;
         readnumber[0]:=chr(i);
       { was the next char a linebreak ? }
-        if c in [#10,#13] then
-         linebreak;
+      {  if c in [#10,#13] then
+         linebreak; }
       end;
 
 
@@ -526,13 +522,14 @@ unit scanner;
       begin
         while c in [' ',#9..#13] do
          begin
-           c:=inputpointer^;
+           readchar;
+           {c:=inputpointer^;
            if c=#0 then
             reload
            else
             inc(longint(inputpointer));
            if c in [#10,#13] then
-            linebreak;
+            linebreak; }
          end;
       end;
 
@@ -561,13 +558,12 @@ unit scanner;
            else
             found:=0;
            end;
-           c:=inputpointer^;
+           readchar;
+           {c:=inputpointer^;
            if c=#0 then
             reload
            else
-            inc(longint(inputpointer));
-           if c in [#10,#13] then
-            linebreak;
+            inc(longint(inputpointer));}
          until (found=2);
       end;
 
@@ -588,14 +584,14 @@ unit scanner;
             '}' : dec_comment_level;
             #26 : Message(scan_f_end_of_file);
            end;
-           c:=inputpointer^;
+           readchar;
+           {c:=inputpointer^;
            if c=#0 then
             reload
            else
-            inc(longint(inputpointer));
-           if c in [#10,#13] then
-            linebreak;
+            inc(longint(inputpointer));}
          end;
+       {if (c=#10) or (c=#13) then linebreak;}
       end;
 
 
@@ -651,13 +647,12 @@ unit scanner;
              else
               found:=0;
              end;
-             c:=inputpointer^;
+             readchar;
+             {c:=inputpointer^;
              if c=#0 then
               reload
              else
-              inc(longint(inputpointer));
-             if c in [#10,#13] then
-              linebreak;
+              inc(longint(inputpointer));}
            until (found=2);
          end;
       end;
@@ -672,6 +667,7 @@ unit scanner;
         y    : ttoken;
 {$ifdef UseTokenInfo}
         newyylex : ptokeninfo;
+        line,column : longint;
 {$endif UseTokenInfo}
         code : word;
         l    : longint;
@@ -683,6 +679,10 @@ unit scanner;
          exit_label;
 {$endif UseTokenInfo}
      begin
+{$ifdef UseTokenInfo}
+        line:=current_module^.current_inputfile^.line_no;
+        column:=get_current_col;
+{$endif UseTokenInfo}
         { was the last character a point ? }
         { this code is needed because the scanner if there is a 1. found if  }
         { this is a floating point number or range like 1..3                 }
@@ -717,6 +717,11 @@ unit scanner;
         until false;
 
         lasttokenpos:=longint(inputpointer);
+{$ifdef UseTokenInfo}
+        line:=current_module^.current_inputfile^.line_no;
+        column:=get_current_col;
+        { will become line:=lasttokenpos ??;}
+{$endif UseTokenInfo}
         case c of
        '_','A'..'Z',
            'a'..'z' : begin
@@ -741,7 +746,9 @@ unit scanner;
                                  hp:=new(pinputfile,init('','Macro '+pattern,''));
                                  hp^.next:=current_module^.current_inputfile;
                                  current_module^.current_inputfile:=hp;
+                                 status.currentsource:=current_module^.current_inputfile^.name^;
                                  current_module^.sourcefiles.register_file(hp);
+                                 current_module^.current_index:=hp^.ref_index;
                                { set an own buffer }
                                  getmem(hp2,mac^.buflen+1);
                                  current_module^.current_inputfile^.setbuf(hp2,mac^.buflen+1);
@@ -1087,7 +1094,7 @@ unit scanner;
 {$ifndef UseTokenInfo}
                            yylex:=DOUBLEADDR;
 {$else UseTokenInfo}
-                           yylex:=DOUBLEADDR;
+                           y:=DOUBLEADDR;
 {$endif UseTokenInfo}
                          end
                         else
@@ -1287,8 +1294,9 @@ unit scanner;
       exit_label:
         new(newyylex);
         newyylex^.token:=y;
-        newyylex^.fi.infile:=current_module^.current_inputfile;
-        newyylex^.fi.line:=current_module^.current_inputfile^.line_no;
+        newyylex^.fi.fileindex:=current_module^.current_index;
+        newyylex^.fi.line:=line;
+        newyylex^.fi.column:=column;
         yylex:=newyylex;
 {$endif UseTokenInfo}
      end;
@@ -1352,6 +1360,8 @@ unit scanner;
         current_module^.current_inputfile:=new(pinputfile,init(d,n,e));
         current_module^.current_inputfile^.reset;
         current_module^.sourcefiles.register_file(current_module^.current_inputfile);
+        current_module^.current_index:=current_module^.current_inputfile^.ref_index;
+        status.currentsource:=current_module^.current_inputfile^.name^+current_module^.current_inputfile^.ext^;
         if ioresult<>0 then
          Message(scan_f_cannot_open_input);
         inputbuffer:=current_module^.current_inputfile^.buf;
@@ -1363,6 +1373,27 @@ unit scanner;
         s_point:=false;
      end;
 
+   procedure get_cur_file_pos(var fileinfo : tfileposinfo);
+
+     begin
+        fileinfo.line:=current_module^.current_inputfile^.line_no;
+        {fileinfo.fileindex:=current_module^.current_inputfile^.ref_index;}
+        { should allways be the same !! }
+        fileinfo.fileindex:=current_module^.current_index;
+        fileinfo.column:=get_current_col;
+     end;
+
+   procedure set_cur_file_pos(const fileinfo : tfileposinfo);
+
+     begin
+        current_module^.current_index:=fileinfo.fileindex;
+        current_module^.current_inputfile:=
+          pinputfile(current_module^.sourcefiles.get_file(fileinfo.fileindex));
+        current_module^.current_inputfile^.line_no:=fileinfo.line;
+        {fileinfo.fileindex:=current_module^.current_inputfile^.ref_index;}
+        { should allways be the same !! }
+        { fileinfo.column:=get_current_col; }
+     end;
 
    procedure DoneScanner(testendif:boolean);
      var
@@ -1385,7 +1416,14 @@ unit scanner;
 end.
 {
   $Log$
-  Revision 1.13  1998-04-29 13:42:27  peter
+  Revision 1.14  1998-04-30 15:59:42  pierre
+    * GDB works again better :
+      correct type info in one pass
+    + UseTokenInfo for better source position
+    * fixed one remaining bug in scanner for line counts
+    * several little fixes
+
+  Revision 1.13  1998/04/29 13:42:27  peter
     + $IOCHECKS and $ALIGN to test already, other will follow soon
     * fixed the wrong linecounting with comments
 

compiler/tree.pas

@@ -29,7 +29,7 @@ unit tree;
   interface
 
     uses
-       globals,symtable,cobjects,verbose,aasm,files
+       globals,scanner,symtable,cobjects,verbose,aasm,files
 {$ifdef i386}
        ,i386
 {$endif}
@@ -97,7 +97,7 @@ unit tree;
                    setelen,         {A set element (i.e. [a,b]).}
                    setconstrn,      {A set constant (i.e. [1,2]).}
                    blockn,          {A block of statements.}
-                   anwein,          {A linear list of nodes.}
+                   statementn,      {One statement in a block of nodes.}
                    loopn,           { used in genloopnode, must be converted }
                    ifn,             {An if statement.}
                    breakn,          {A break statement.}
@@ -193,12 +193,9 @@ unit tree;
 {$endif SUPPORT_MMX}
           left,right : ptree;
           resulttype : pdef;
-          inputfile : pinputfile;
-          {$ifdef TP}
-          line:word;
-          {$else}
-          line : longint;
-          {$endif}
+          { line : longint;
+          fileindex,colon : word; }
+          fileinfo : tfileposinfo;
           pragmas : Tcswitches;
 {$ifdef extdebug}
         firstpasscount : longint;
@@ -285,6 +282,7 @@ unit tree;
     procedure set_location(var destloc,sourceloc : tlocation);
     procedure swap_location(var destloc,sourceloc : tlocation);
     procedure set_file_line(from,_to : ptree);
+    procedure set_current_file_line(_to : ptree);
     procedure set_tree_filepos(p : ptree;const filepos : tfileposinfo);
 
 {$ifdef extdebug}
@@ -296,8 +294,9 @@ unit tree;
 
   implementation
 
-    const
-       oldswitches : tcswitches = [];
+{$ifdef UseTokenInfo}
+    uses pbase;
+{$endif UseTokenInfo}
 
 {****************************************************************************
         this is a pool for the tree nodes to get more performance
@@ -349,8 +348,14 @@ unit tree;
          hp^.error:=false;
 
          { we know also the position }
-         hp^.line:=current_module^.current_inputfile^.line_no;
-         hp^.inputfile:=current_module^.current_inputfile;
+{$ifdef UseTokenInfo}
+         if assigned(tokeninfo) then
+           begin
+              hp^.fileinfo:=tokeninfo^.fi;
+           end
+         else
+{$endif UseTokenInfo}
+           get_cur_file_pos(hp^.fileinfo);
          hp^.pragmas:=aktswitches;
          getnode:=hp;
       end;
@@ -540,17 +545,22 @@ unit tree;
     procedure set_file_line(from,_to : ptree);
 
       begin
-         if from<>nil then
-           begin
-              _to^.line:=from^.line;
-              _to^.inputfile:=from^.inputfile;
-           end;
+         if assigned(from) then
+           _to^.fileinfo:=from^.fileinfo;
+      end;
+
+    procedure set_current_file_line(_to : ptree);
+
+      begin
+         current_module^.current_inputfile:=
+           pinputfile(current_module^.sourcefiles.get_file(_to^.fileinfo.fileindex));
+         current_module^.current_inputfile^.line_no:=_to^.fileinfo.line;
+         current_module^.current_index:=_to^.fileinfo.fileindex;
       end;
 
    procedure set_tree_filepos(p : ptree;const filepos : tfileposinfo);
      begin
-        p^.line:=filepos.line;
-        p^.inputfile:=filepos.infile;
+        p^.fileinfo:=filepos;
      end;
 
    function genwithnode(symtable : psymtable;l,r : ptree;count : longint) : ptree;
@@ -1253,7 +1263,14 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.4  1998-04-29 10:34:08  pierre
+  Revision 1.5  1998-04-30 15:59:43  pierre
+    * GDB works again better :
+      correct type info in one pass
+    + UseTokenInfo for better source position
+    * fixed one remaining bug in scanner for line counts
+    * several little fixes
+
+  Revision 1.4  1998/04/29 10:34:08  pierre
     + added some code for ansistring (not complete nor working yet)
     * corrected operator overloading
     * corrected nasm output

compiler/verb_def.pas

@@ -26,8 +26,6 @@ uses verbose;
 
 {$define allow_oldstyle}
 
-var
-  UseStdErr : boolean;
 procedure SetRedirectFile(const fn:string);
 
 procedure _stop;
@@ -45,20 +43,14 @@ uses
   strings,dos,cobjects,systems,globals,files;
 
 const
-{$ifdef USE_RHIDE}
   { RHIDE expect gcc like error output }
-  fatalstr='fatal: ';
-  errorstr='error: ';
-  warningstr='warning: ';
-  notestr='warning: ';
-  hintstr='warning: ';
-{$else}
+  rh_errorstr='error: ';
+  rh_warningstr='warning: ';
   fatalstr='Fatal Error: ';
   errorstr='Error: ';
   warningstr='Warning: ';
   notestr='Note: ';
   hintstr='Hint: ';
-{$endif USE_RHIDE}
 
 var
   redirexitsave : pointer;
@@ -107,35 +99,50 @@ end;
 Procedure _comment(Level:Longint;const s:string);
 var
   hs : string;
-{$ifdef USE_RHIDE}
   i  : longint;
-{$endif}
 begin
   if (verbosity and Level)=Level then
    begin
    {Create hs}
      hs:='';
-     if (verbosity and Level)=V_Hint then
-      hs:=hintstr;
-     if (verbosity and Level)=V_Note then
-      hs:=notestr;
-     if (verbosity and Level)=V_Warning then
-      hs:=warningstr;
-     if (verbosity and Level)=V_Error then
-      hs:=errorstr;
-     if (verbosity and Level)=V_Fatal then
-      hs:=fatalstr;
+     if not(use_rhide) then
+       begin
+          if (verbosity and Level)=V_Hint then
+           hs:=hintstr;
+          if (verbosity and Level)=V_Note then
+           hs:=notestr;
+          if (verbosity and Level)=V_Warning then
+           hs:=warningstr;
+          if (verbosity and Level)=V_Error then
+           hs:=errorstr;
+          if (verbosity and Level)=V_Fatal then
+           hs:=fatalstr;
+       end
+     else
+       begin
+          if (verbosity and Level)=V_Hint then
+           hs:=rh_warningstr;
+          if (verbosity and Level)=V_Note then
+           hs:=rh_warningstr;
+          if (verbosity and Level)=V_Warning then
+           hs:=rh_warningstr;
+          if (verbosity and Level)=V_Error then
+           hs:=rh_errorstr;
+          if (verbosity and Level)=V_Fatal then
+           hs:=rh_errorstr;
+       end;
      if (Level<$100) and Assigned(current_module) and
         Assigned(current_module^.current_inputfile) then
       hs:=current_module^.current_inputfile^.get_file_line+' '+hs;
-{$ifdef USE_RHIDE}
+(* {$ifdef USE_RHIDE}
+    What was this ??? I did not code that (PM)
      if (Level<$100) then
       begin
         i:=length(hs)+1;
         hs:=hs+lowercase(Copy(s,1,5))+Copy(s,6,255);
       end
      else
-{$endif USE_RHIDE}
+{$endif USE_RHIDE} *)
       hs:=hs+s;
 {$ifdef FPC}
      if UseStdErr and (Level<$100) then
@@ -215,9 +222,9 @@ end;
 {$endif}
 
 begin
-{$ifdef USE_RHIDE}
+(* {$ifdef USE_RHIDE}
   UseStdErr:=true;
-{$endif USE_RHIDE}
+{$endif USE_RHIDE} *)
 {$ifdef FPC}
   do_stop:=@_stop;
   do_comment:=@_comment;
@@ -242,7 +249,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.4  1998-04-29 10:34:09  pierre
+  Revision 1.5  1998-04-30 15:59:43  pierre
+    * GDB works again better :
+      correct type info in one pass
+    + UseTokenInfo for better source position
+    * fixed one remaining bug in scanner for line counts
+    * several little fixes
+
+  Revision 1.4  1998/04/29 10:34:09  pierre
     + added some code for ansistring (not complete nor working yet)
     * corrected operator overloading
     * corrected nasm output

compiler/verbose.pas

@@ -51,13 +51,16 @@ Const
   V_Debug       = $8000;
 
   V_All         = $ffffffff;
-  V_Default     = V_Error;
+  V_Default     = V_Fatal + V_Error;
 
   Verbosity     : longint=V_Default;
 
 var
   errorcount    : longint;  { number of generated errors }
   msg           : pmessage;
+  UseStdErr : boolean;
+  Use_Rhide : boolean;
+
 
 procedure LoadMsgFile(const fn:string);
 function  SetVerbosity(const s:string):boolean;
@@ -116,41 +119,99 @@ end;
 function SetVerbosity(const s:string):boolean;
 var
   m : Longint;
-  c : Word;
+  i : Word;
+  inverse : boolean;
+  c : char;
 begin
   setverbosity:=false;
-  val(s,m,c);
-  if (c=0) and (s<>'') then
+  val(s,m,i);
+  if (i=0) and (s<>'') then
    verbosity:=m
   else
    begin
-     for c:=1 to length(s) do
-      case upcase(s[c]) of
-      { Special cases }
-       'A' : Verbosity:=V_All;
-       '0' : Verbosity:=V_Default;
-      { Normal cases - do an or }
-       'E' : Verbosity:=Verbosity or V_Error;
-       'I' : Verbosity:=Verbosity or V_Info;
-       'W' : Verbosity:=Verbosity or V_Warning;
-       'N' : Verbosity:=Verbosity or V_Note;
-       'H' : Verbosity:=Verbosity or V_Hint;
-       'L' : Verbosity:=Verbosity or V_Linenrs;
-       'U' : Verbosity:=Verbosity or V_Used;
-       'T' : Verbosity:=Verbosity or V_Tried;
-       'M' : Verbosity:=Verbosity or V_Macro;
-       'P' : Verbosity:=Verbosity or V_Procedure;
-       'C' : Verbosity:=Verbosity or V_Conditional;
-       'D' : Verbosity:=Verbosity or V_Debug;
-      end;
-   end;
+     for i:=1 to length(s) do
+       begin
+          c:=s[i];
+          if (i<length(s)) and (s[i+1]='-') then
+            begin
+               inc(i);
+               inverse:=true;
+            end
+          else
+            inverse:=false;
+          case upcase(s[i]) of
+          { Special cases }
+           'A' : Verbosity:=V_All;
+           '0' : Verbosity:=V_Default;
+           'R' : begin
+                    if inverse then
+                      begin
+                         Use_rhide:=false;
+                         UseStdErr:=false;
+                      end
+                    else
+                      begin
+                         Use_rhide:=true;
+                         UseStdErr:=true;
+                      end;
+                 end;
+          { Normal cases - do an or }
+           'E' : if inverse then
+                   Verbosity:=Verbosity and (not V_Error)
+                 else
+                   Verbosity:=Verbosity or V_Error;
+           'I' : if inverse then
+                   Verbosity:=Verbosity and (not V_Info)
+                 else
+                   Verbosity:=Verbosity or V_Info;
+           'W' : if inverse then
+                   Verbosity:=Verbosity and (not V_Warning)
+                 else
+                   Verbosity:=Verbosity or V_Warning;
+           'N' : if inverse then
+                   Verbosity:=Verbosity and (not V_Note)
+                 else
+                   Verbosity:=Verbosity or V_Note;
+           'H' : if inverse then
+                   Verbosity:=Verbosity and (not V_Hint)
+                 else
+                   Verbosity:=Verbosity or V_Hint;
+           'L' : if inverse then
+                   Verbosity:=Verbosity and (not V_Linenrs)
+                 else
+                   Verbosity:=Verbosity or V_Linenrs;
+           'U' : if inverse then
+                   Verbosity:=Verbosity and (not V_Used)
+                 else
+                   Verbosity:=Verbosity or V_Used;
+           'T' : if inverse then
+                   Verbosity:=Verbosity and (not V_Tried)
+                 else
+                   Verbosity:=Verbosity or V_Tried;
+           'M' : if inverse then
+                   Verbosity:=Verbosity and (not V_Macro)
+                 else
+                   Verbosity:=Verbosity or V_Macro;
+           'P' : if inverse then
+                   Verbosity:=Verbosity and (not V_Procedure)
+                 else
+                   Verbosity:=Verbosity or V_Procedure;
+           'C' : if inverse then
+                   Verbosity:=Verbosity and (not V_Conditional)
+                 else
+                   Verbosity:=Verbosity or V_Conditional;
+           'D' : if inverse then
+                   Verbosity:=Verbosity and (not V_Debug)
+                 else
+                   Verbosity:=Verbosity or V_Debug;
+           end;
+       end;
+     end;
   if Verbosity=0 then
    Verbosity:=V_Default;
   setverbosity:=true;
 end;
 
-
-
 procedure stop;
 begin
 {$ifndef TP}
@@ -292,7 +353,14 @@ end.
 
 {
   $Log$
-  Revision 1.4  1998-04-23 12:11:22  peter
+  Revision 1.5  1998-04-30 15:59:43  pierre
+    * GDB works again better :
+      correct type info in one pass
+    + UseTokenInfo for better source position
+    * fixed one remaining bug in scanner for line counts
+    * several little fixes
+
+  Revision 1.4  1998/04/23 12:11:22  peter
     * fixed -v0 to displayV_Default (=errors+fatals)
 
   Revision 1.3  1998/04/13 21:15:42  florian