+ UseTokenInfo now default

  * unit in interface uses and implementation uses gives error now
  * only one error for unknown symbol (uses lastsymknown boolean)
    the problem came from the label code !
  + first inlined procedures and function work
    (warning there might be allowed cases were the result is still wrong !!)
  * UseBrower updated gives a global list of all position of all used symbols
    with switch -gb

compiler/browser.pas

@@ -23,24 +23,24 @@ unit browser;
 
 interface
 
-uses globals, files;
+uses globals,cobjects,files;
 
 type
   pref = ^tref;
   tref = object
          nextref   : pref;
-         inputfile : pinputfile;
-         lineno    : longint;
-         constructor init(ref : pref);
-         constructor load(var ref : pref;fileindex : word;line : longint);
+         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);
+  procedure add_new_ref(var ref : pref;pos : pfileposinfo);
 
-  function get_source_file(index : word) : pinputfile;
+  function get_source_file(moduleindex,fileindex : word) : pinputfile;
 
   { one big problem remains for overloaded procedure }
   { we should be able to separate them               }
@@ -48,80 +48,95 @@ type
 
 implementation
 
-  constructor tref.init(ref :pref);
+  uses scanner,verbose;
+
+  constructor tref.init(ref :pref;pos : pfileposinfo);
 
     begin
        nextref:=nil;
        if ref<>nil then
           ref^.nextref:=@self;
+       if assigned(pos) then
+         posinfo:=pos^;
        if current_module<>nil then
          begin
-            inputfile:=current_module^.current_inputfile;
-            if inputfile<>nil then
-              begin
-                 inc(inputfile^.ref_index);
-                 lineno:=inputfile^.line_no;
-              end
-            else
-              lineno:=0;
-         end
-       else
-         begin
-            inputfile:=nil;
-            lineno:=0;
+            moduleindex:=current_module^.unit_index;
          end;
     end;
 
-  constructor tref.load(var ref : pref;fileindex : word;line : longint);
+  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;
-       inputfile:=get_source_file(fileindex);
-       lineno:=line;
+       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;
 
     function tref.get_file_line : string;
 
+      var
+         inputfile : pinputfile;
       begin
         get_file_line:='';
-        if inputfile=nil then exit;
-        if Use_Rhide then
-          get_file_line:=lowercase(inputfile^.name^+inputfile^.ext^)+':'+tostr(lineno)+':'
+        inputfile:=get_source_file(moduleindex,posinfo.fileindex);
+        if assigned(inputfile) then
+          if Use_Rhide then
+            get_file_line:=globals.lowercase(inputfile^.name^+inputfile^.ext^)
+              +':'+tostr(posinfo.line)+':'+tostr(posinfo.column)+':'
+          else
+            get_file_line:=inputfile^.name^+inputfile^.ext^
+              +'('+tostr(posinfo.line)+','+tostr(posinfo.column)+')'
         else
-          get_file_line:=inputfile^.name^+inputfile^.ext^+'('+tostr(lineno)+')'
+          if Use_Rhide then
+            get_file_line:='file_unknown:'
+              +tostr(posinfo.line)+':'+tostr(posinfo.column)+':'
+          else
+            get_file_line:='file_unknown('
+              +tostr(posinfo.line)+','+tostr(posinfo.column)+')'
       end;
 
-  procedure add_new_ref(var ref : pref);
+  procedure add_new_ref(var ref : pref;pos : pfileposinfo);
 
     var
        newref : pref;
 
     begin
-       new(newref,init(ref));
+       new(newref,init(ref,pos));
        ref:=newref;
     end;
 
-    function get_source_file(index : word) : pinputfile;
+    function get_source_file(moduleindex,fileindex : word) : pinputfile;
 
       var
+         hp : pmodule;
          f : pinputfile;
 
       begin
+         hp:=pmodule(loaded_units.first);
+         while assigned(hp) and (hp^.unit_index<>moduleindex) do
+           hp:=pmodule(hp^.next);
          get_source_file:=nil;
-         f:=pinputfile(current_module^.sourcefiles.files);
+         if not assigned(hp) then
+           exit;
+         f:=pinputfile(hp^.sourcefiles.files);
          while assigned(f) do
            begin
-              if f^.ref_index=index then
+              if f^.ref_index=fileindex then
                 begin
                    get_source_file:=f;
                    exit;
@@ -133,7 +148,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.2  1998-04-30 15:59:39  pierre
+  Revision 1.3  1998-05-20 09:42:32  pierre
+    + UseTokenInfo now default
+    * unit in interface uses and implementation uses gives error now
+    * only one error for unknown symbol (uses lastsymknown boolean)
+      the problem came from the label code !
+    + first inlined procedures and function work
+      (warning there might be allowed cases were the result is still wrong !!)
+    * UseBrower updated gives a global list of all position of all used symbols
+      with switch -gb
+
+  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

compiler/cobjects.pas

@@ -55,9 +55,7 @@ unit cobjects;
        tstringitem = record
           data : pstring;
           next : pstringitem;
-{$ifdef UseTokenInfo}
           fileinfo : tfileposinfo; { pointer to tinputfile }
-{$endif UseTokenInfo}
        end;
 
        plinkedlist_item = ^tlinkedlist_item;
@@ -144,15 +142,11 @@ 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;
@@ -176,7 +170,11 @@ unit cobjects;
            { but it's assumed, that there no seek while do_crc is true       }
            do_crc : boolean;
            crc : longint;
-
+           { temporary closing feature }
+           tempclosed : boolean;
+           tempmode : byte;
+           temppos : longint;
+           
            { inits a buffer with the size bufsize which is assigned to }
            { the file  filename                                        }
            constructor init(const filename : string;_bufsize : longint);
@@ -216,6 +214,12 @@ unit cobjects;
            { closes the file and releases the buffer }
            procedure close;
 
+{$ifdef TEST_TEMPCLOSE}
+           { temporary closing }
+           procedure tempclose;
+           procedure tempreopen;
+{$endif TEST_TEMPCLOSE}
+           
            { goto the given position }
            procedure seek(l : longint);
 
@@ -479,7 +483,6 @@ end;
          last:=hp;
       end;
 
-{$ifdef UseTokenInfo}
           procedure tstringcontainer.insert_with_tokeninfo
             (const s : string; const file_info : tfileposinfo);
 
@@ -505,7 +508,6 @@ end;
          last:=hp;
       end;
 
-{$endif UseTokenInfo}
     procedure tstringcontainer.clear;
 
       var
@@ -542,7 +544,6 @@ end;
           end;
       end;
 
-{$ifdef UseTokenInfo}
     function tstringcontainer.get_with_tokeninfo(var file_info : tfileposinfo) : string;
 
       var
@@ -566,7 +567,6 @@ end;
             dispose(hp);
           end;
       end;
-{$endif UseTokenInfo}
 
 {****************************************************************************
                             TLINKEDLIST_ITEM
@@ -807,6 +807,7 @@ end;
          buflast:=0;
          do_crc:=false;
          iomode:=0;
+         tempclosed:=false;
          change_endian:=false;
          clear_crc;
       end;
@@ -994,8 +995,11 @@ end;
       begin
         if bufpos+length(s)>bufsize then
           flush;
+        { why is there not CRC here ??? }
         move(s[1],(buf+bufpos)^,length(s));
         inc(bufpos,length(s));
+         { should be
+        write_data(s[1],length(s)); }
       end;
 
     procedure tbufferedfile.write_pchar(p : pchar);
@@ -1007,10 +1011,13 @@ end;
         l:=strlen(p);
         if l>=bufsize then
           runerror(222);
+        { why is there not CRC here ???}
         if bufpos+l>bufsize then
           flush;
         move(p^,(buf+bufpos)^,l);
         inc(bufpos,l);
+         { should be
+        write_data(p^,l); }
       end;
 
     procedure tbufferedfile.write_byte(b : byte);
@@ -1071,14 +1078,67 @@ end;
               flush;
               system.close(f);
               freemem(buf,bufsize);
+              buf:=nil;
+              iomode:=0;
+           end;
+      end;
+
+{$ifdef TEST_TEMPCLOSE}
+    procedure tbufferedfile.tempclose;
+
+      begin
+         if iomode<>0 then
+           begin
+              temppos:=system.filepos(f);
+              tempmode:=iomode;
+              tempclosed:=true;
+              system.close(f);
               iomode:=0;
+           end
+         else
+           tempclosed:=false;
+      end;
+
+    procedure tbufferedfile.tempreopen;
+
+      var
+         ofm : byte;
+         
+      begin
+         if tempclosed then
+           begin
+              if tempmode=1 then
+                begin
+                   ofm:=filemode;
+                   iomode:=1;
+                   filemode:=0;
+                   system.reset(f,1);
+                   filemode:=ofm;
+                end
+              else if tempmode=2 then
+                begin
+                   iomode:=2;
+                   system.rewrite(f,1);
+                end;
+              system.seek(f,temppos);
            end;
       end;
+{$endif TEST_TEMPCLOSE}
 
 end.
 {
   $Log$
-  Revision 1.7  1998-05-06 18:36:53  peter
+  Revision 1.8  1998-05-20 09:42:33  pierre
+    + UseTokenInfo now default
+    * unit in interface uses and implementation uses gives error now
+    * only one error for unknown symbol (uses lastsymknown boolean)
+      the problem came from the label code !
+    + first inlined procedures and function work
+      (warning there might be allowed cases were the result is still wrong !!)
+    * UseBrower updated gives a global list of all position of all used symbols
+      with switch -gb
+
+  Revision 1.7  1998/05/06 18:36:53  peter
     * tai_section extended with code,data,bss sections and enumerated type
     * ident 'compiled by FPC' moved to pmodules
     * small fix for smartlink

compiler/files.pas

@@ -102,6 +102,7 @@ unit files;
 
           map           : punitmap; { mapping of all used units }
           unitcount     : word;     { local unit counter }
+          unit_index    : word;     { global counter for browser }
           symtable      : pointer;  { pointer to the psymtable of this unit }
           output_format : tof;      { how to write this file }
 
@@ -219,6 +220,7 @@ unit files;
     var
        main_module    : pmodule;
        current_module : pmodule;
+       global_unit_count : word;
        loaded_units   : tlinkedlist;
 
 
@@ -300,11 +302,21 @@ unit files;
               dispose(hp,done);
               hp:=files;
            end;
+         last_ref_index:=0;
       end;
 
     procedure tfilemanager.close_all;
 
+      var
+         hp : pextfile;
+
       begin
+         hp:=files;
+         while assigned(hp) do
+           begin
+              hp^.close;
+              hp:=hp^._next;
+           end;
       end;
 
     procedure tfilemanager.register_file(f : pextfile);
@@ -420,6 +432,12 @@ unit files;
                sources_avail:=false;
                temp:=' library';
              end
+            else if pos('Macro ',hs)=1 then
+             begin
+               { we don't want to find this file }
+               { but there is a problem with file indexing !! }
+               temp:='';
+             end
             else
              begin
                { check the date of the source files }
@@ -849,6 +867,8 @@ unit files;
          flags:=0;
          crc:=0;
          unitcount:=1;
+         inc(global_unit_count);
+         unit_index:=global_unit_count;
          do_assemble:=false;
          do_compile:=false;
          sources_avail:=true;
@@ -909,7 +929,17 @@ unit files;
 end.
 {
   $Log$
-  Revision 1.11  1998-05-12 10:46:59  peter
+  Revision 1.12  1998-05-20 09:42:33  pierre
+    + UseTokenInfo now default
+    * unit in interface uses and implementation uses gives error now
+    * only one error for unknown symbol (uses lastsymknown boolean)
+      the problem came from the label code !
+    + first inlined procedures and function work
+      (warning there might be allowed cases were the result is still wrong !!)
+    * UseBrower updated gives a global list of all position of all used symbols
+      with switch -gb
+
+  Revision 1.11  1998/05/12 10:46:59  peter
     * moved printstatus to verb_def
     + V_Normal which is between V_Error and V_Warning and doesn't have a
       prefix like error: warning: and is included in V_Default

compiler/hcodegen.pas

@@ -50,6 +50,8 @@ unit hcodegen;
           _class : pobjectdef;
           { return type }
           retdef : pdef;
+          { the definition of the proc itself }
+          def : pdef;
           { frame pointer offset }
           framepointer_offset : longint;
           { self pointer offset }
@@ -140,14 +142,15 @@ unit hcodegen;
 
 
     { convert/concats a label for constants in the consts section }
-    function constlabel2str(p:plabel;ctype:tconsttype):string;
+    function constlabel2str(l : plabel;ctype:tconsttype):string;
+    function constlabelnb2str(pnb : longint;ctype:tconsttype):string;
     procedure concat_constlabel(p:plabel;ctype:tconsttype);
 
 
 implementation
 
      uses
-        cobjects,globals,files,strings;
+        systems,cobjects,globals,files,strings;
 
 {*****************************************************************************
          initialize/terminate the codegen for procedure and modules
@@ -353,12 +356,22 @@ implementation
       consttypestr : array[tconsttype] of string[6]=
         ('ord','string','real','bool','int','char','set');
 
-    function constlabel2str(p:plabel;ctype:tconsttype):string;
+      { Peter this gives problems for my inlines !! }
+      { we must use the number directly !!! (PM) }
+    function constlabel2str(l : plabel;ctype:tconsttype):string;
       begin
         if smartlink or (current_module^.output_format in [of_nasm,of_obj]) then
-         constlabel2str:='_$'+current_module^.unitname^+'$'+consttypestr[ctype]+'_const_'+tostr(p^.nb)
+         constlabel2str:='_$'+current_module^.unitname^+'$'+consttypestr[ctype]+'_const_'+tostr(l^.nb)
         else
-         constlabel2str:=lab2str(p);
+         constlabel2str:=lab2str(l);
+      end;
+
+    function constlabelnb2str(pnb : longint;ctype:tconsttype):string;
+      begin
+        if smartlink or (current_module^.output_format in [of_nasm,of_obj]) then
+         constlabelnb2str:='_$'+current_module^.unitname^+'$'+consttypestr[ctype]+'_const_'+tostr(pnb)
+        else
+         constlabelnb2str:=target_asm.labelprefix+tostr(pnb);
       end;
 
 
@@ -385,7 +398,17 @@ end.
 
 {
   $Log$
-  Revision 1.4  1998-05-07 00:17:01  peter
+  Revision 1.5  1998-05-20 09:42:34  pierre
+    + UseTokenInfo now default
+    * unit in interface uses and implementation uses gives error now
+    * only one error for unknown symbol (uses lastsymknown boolean)
+      the problem came from the label code !
+    + first inlined procedures and function work
+      (warning there might be allowed cases were the result is still wrong !!)
+    * UseBrower updated gives a global list of all position of all used symbols
+      with switch -gb
+
+  Revision 1.4  1998/05/07 00:17:01  peter
     * smartlinking for sets
     + consts labels are now concated/generated in hcodegen
     * moved some cpu code to cga and some none cpu depended code from cga

compiler/i386.pas

@@ -315,7 +315,8 @@ unit i386;
 
     { resets all values of ref to defaults }
     procedure reset_reference(var ref : treference);
-
+    { mostly set value of a reference }
+    function new_reference(base : tregister;offset : longint) : preference;
     { same as reset_reference, but symbol is disposed }
     { use this only for already used references       }
     procedure clear_reference(var ref : treference);
@@ -1179,7 +1180,19 @@ unit i386;
 {$endif}
       end;
 
-    procedure clear_reference(var ref : treference);
+      function new_reference(base : tregister;offset : longint) : preference;
+
+        var
+           r : preference;
+        begin
+           new(r);
+           reset_reference(r^);
+           r^.base:=base;
+           r^.offset:=offset;
+           new_reference:=r;
+        end;
+
+      procedure clear_reference(var ref : treference);
 
       begin
          stringdispose(ref.symbol);
@@ -1780,7 +1793,17 @@ unit i386;
 end.
 {
   $Log$
-  Revision 1.6  1998-05-04 17:54:25  peter
+  Revision 1.7  1998-05-20 09:42:34  pierre
+    + UseTokenInfo now default
+    * unit in interface uses and implementation uses gives error now
+    * only one error for unknown symbol (uses lastsymknown boolean)
+      the problem came from the label code !
+    + first inlined procedures and function work
+      (warning there might be allowed cases were the result is still wrong !!)
+    * UseBrower updated gives a global list of all position of all used symbols
+      with switch -gb
+
+  Revision 1.6  1998/05/04 17:54:25  peter
     + smartlinking works (only case jumptable left todo)
     * redesign of systems.pas to support assemblers and linkers
     + Unitname is now also in the PPU-file, increased version to 14

compiler/parser.pas

@@ -123,9 +123,7 @@ unit parser;
 
          { some variables to save the compiler state }
          oldtoken : ttoken;
-{$ifdef UseTokenInfo}
          oldtokenpos : tfileposinfo;
-{$endif UseTokenInfo}
          oldpattern : stringid;
 
          oldpreprocstack : ppreprocstack;
@@ -237,9 +235,7 @@ unit parser;
          oldmacros:=macros;
          oldpattern:=pattern;
          oldtoken:=token;
-{$ifdef UseTokenInfo}
          oldtokenpos:=tokenpos;
-{$endif UseTokenInfo}
          oldorgpattern:=orgpattern;
          old_block_type:=block_type;
          oldpreprocstack:=preprocstack;
@@ -284,7 +280,7 @@ unit parser;
          { init code generator for a new module }
          codegen_newmodule;
          macros:=new(psymtable,init(macrosymtable));
-
+         macros^.name:=stringdup('Conditionals for '+filename);
          define_macros;
 
          { startup scanner }
@@ -306,7 +302,6 @@ unit parser;
 
          { global switches are read, so further changes aren't allowed }
          current_module^.in_main:=true;
-
          { open assembler response }
          if (compile_level=1) then
           AsmRes.Init('ppas');
@@ -320,6 +315,7 @@ unit parser;
               }
               hp:=loadunit(upper(target_info.system_unit),true,true);
               systemunit:=hp^.symtable;
+              make_ref:=false;
               readconstdefs;
               { we could try to overload caret by default }
               symtablestack:=systemunit;
@@ -328,6 +324,7 @@ unit parser;
               if assigned(srsym) and (srsym^.typ=procsym) and
                  (overloaded_operators[STARSTAR]=nil) then
                 overloaded_operators[STARSTAR]:=pprocsym(srsym);
+              make_ref:=true;
            end
          else
            begin
@@ -364,6 +361,7 @@ unit parser;
               systemunit:=nil;
            end;
          registerdef:=true;
+         make_ref:=true;
 
          { current return type is void }
          procinfo.retdef:=voiddef;
@@ -447,16 +445,16 @@ done:
          procprefix:=oldprocprefix;
 
          { close the inputfiles }
-{$ifndef UseBrowser}
-         { but not if we want the names for the browser ! }
+{$ifdef UseBrowser}
+         {  we need the names for the browser ! }
+         current_module^.sourcefiles.close_all;
+{$else UseBrowser}
          current_module^.sourcefiles.done;
 {$endif not UseBrowser}
          { restore scanner state }
          pattern:=oldpattern;
          token:=oldtoken;
-{$ifdef UseTokenInfo}
          tokenpos:=oldtokenpos;
-{$endif UseTokenInfo}
          orgpattern:=oldorgpattern;
          block_type:=old_block_type;
 
@@ -508,7 +506,17 @@ done:
 end.
 {
   $Log$
-  Revision 1.16  1998-05-12 10:47:00  peter
+  Revision 1.17  1998-05-20 09:42:34  pierre
+    + UseTokenInfo now default
+    * unit in interface uses and implementation uses gives error now
+    * only one error for unknown symbol (uses lastsymknown boolean)
+      the problem came from the label code !
+    + first inlined procedures and function work
+      (warning there might be allowed cases were the result is still wrong !!)
+    * UseBrower updated gives a global list of all position of all used symbols
+      with switch -gb
+
+  Revision 1.16  1998/05/12 10:47:00  peter
     * moved printstatus to verb_def
     + V_Normal which is between V_Error and V_Warning and doesn't have a
       prefix like error: warning: and is included in V_Default

compiler/pass_1.pas

@@ -35,7 +35,7 @@ unit pass_1;
   implementation
 
      uses
-        cobjects,verbose,systems,globals,aasm,symtable,
+        scanner,cobjects,verbose,systems,globals,aasm,symtable,
         types,strings,hcodegen,files
 {$ifdef i386}
         ,i386
@@ -125,16 +125,20 @@ unit pass_1;
       end;
 
 
-    { calculates the needed registers for a binary operator }
-    procedure calcregisters(p : ptree;r32,fpu,mmx : word);
-
+    procedure left_right_max(p : ptree);
       begin
          p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
          p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu);
 {$ifdef SUPPORT_MMX}
          p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
 {$endif SUPPORT_MMX}
+      end;
 
+    { calculates the needed registers for a binary operator }
+    procedure calcregisters(p : ptree;r32,fpu,mmx : word);
+
+      begin
+         left_right_max(p);
          { Nur wenn links und rechts ein Unterschied < ben”tige Anzahl ist, }
          { wird ein zus„tzliches Register ben”tigt, da es dann keinen       }
          { schwierigeren Ast gibt, welcher erst ausgewertet werden kann     }
@@ -164,7 +168,8 @@ unit pass_1;
         end;
 
     function isconvertable(def_from,def_to : pdef;
-             var doconv : tconverttype;fromtreetype : ttreetyp) : boolean;
+             var doconv : tconverttype;fromtreetype : ttreetyp;
+             explicit : boolean) : boolean;
 
       { from_is_cstring muá true sein, wenn def_from die Definition einer }
       { Stringkonstanten ist, n”tig wegen der Konvertierung von String-   }
@@ -260,7 +265,9 @@ unit pass_1;
                      doconv:=tc_real_2_real;
                    { comp isn't a floating type }
 {$ifdef i386}
-                   if (pfloatdef(def_to)^.typ=s64bit) then
+                   if (pfloatdef(def_to)^.typ=s64bit) and
+                      (pfloatdef(def_from)^.typ<>s64bit)  and
+                      not (explicit) then
                      Message(parser_w_convert_real_2_comp);
 {$endif}
                 end;
@@ -1356,13 +1363,7 @@ unit pass_1;
          if codegenerror then
            exit;
 
-         p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
-         p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu);
-{$ifdef SUPPORT_MMX}
-         p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
-{$endif SUPPORT_MMX}
-         if p^.registers32<2 then p^.registers32:=2;
-
+         left_right_max(p);
          p^.resulttype:=s32bitdef;
          p^.location.loc:=LOC_REGISTER;
       end;
@@ -1887,7 +1888,7 @@ unit pass_1;
            Message(cg_e_upper_lower_than_lower);
          { both types must be compatible }
          if not(isconvertable(p^.left^.resulttype,p^.right^.resulttype,
-           ct,ordconstn)) and
+           ct,ordconstn,false)) and
            not(is_equal(p^.left^.resulttype,p^.right^.resulttype)) then
            Message(sym_e_type_mismatch);
       end;
@@ -1910,7 +1911,7 @@ unit pass_1;
            begin
               if not(isconvertable(p^.right^.resulttype,
                 parraydef(p^.left^.resulttype)^.rangedef,
-                ct,ordconstn)) and
+                ct,ordconstn,false)) and
               not(is_equal(p^.right^.resulttype,
                 parraydef(p^.left^.resulttype)^.rangedef)) then
                 Message(sym_e_type_mismatch);
@@ -2306,7 +2307,8 @@ unit pass_1;
        p^.registersmmx:=p^.left^.registersmmx;
 {$endif}
        set_location(p^.location,p^.left^.location);
-       if (not(isconvertable(p^.left^.resulttype,p^.resulttype,p^.convtyp,p^.left^.treetype))) then
+       if (not(isconvertable(p^.left^.resulttype,p^.resulttype,
+           p^.convtyp,p^.left^.treetype,p^.explizit))) then
          begin
             if is_assignment_overloaded(p^.left^.resulttype,p^.resulttype) then
               begin
@@ -2431,7 +2433,8 @@ unit pass_1;
                             end
                           else
                             begin
-                               if not isconvertable(s32bitdef,p^.resulttype,p^.convtyp,ordconstn { nur Dummy} ) then
+                               if not isconvertable(s32bitdef,p^.resulttype,p^.convtyp,
+                               ordconstn { nur Dummy},false ) then
                                  Message(cg_e_illegal_type_conversion);
                             end;
 
@@ -2451,7 +2454,8 @@ unit pass_1;
                               end
                             else
                               begin
-                                 if not isconvertable(p^.left^.resulttype,s32bitdef,p^.convtyp,ordconstn { nur Dummy} ) then
+                                 if not isconvertable(p^.left^.resulttype,s32bitdef,p^.convtyp,
+                                   ordconstn { nur Dummy},false ) then
                                    Message(cg_e_illegal_type_conversion);
                               end;
                          end
@@ -2472,7 +2476,8 @@ unit pass_1;
                               begin
                                  { this is wrong because it converts to a 4 byte long var !!
                                    if not isconvertable(p^.left^.resulttype,s32bitdef,p^.convtyp,ordconstn  nur Dummy ) then }
-                                 if not isconvertable(p^.left^.resulttype,u8bitdef,p^.convtyp,ordconstn { nur Dummy} ) then
+                                 if not isconvertable(p^.left^.resulttype,u8bitdef,
+                                   p^.convtyp,ordconstn { nur Dummy},false ) then
                                    Message(cg_e_illegal_type_conversion);
                               end;
                          end
@@ -2567,7 +2572,8 @@ unit pass_1;
                       must_be_valid:=false;
                     { here we must add something for the implicit type }
                     { conversion from array of char to pchar }
-                    if isconvertable(p^.left^.resulttype,defcoll^.data,convtyp,p^.left^.treetype) then
+                    if isconvertable(p^.left^.resulttype,defcoll^.data,convtyp,
+                      p^.left^.treetype,false) then
                       if convtyp=tc_array_to_pointer then
                         must_be_valid:=false;
                     firstpass(p^.left);
@@ -2657,10 +2663,11 @@ unit pass_1;
          pd : pprocdef;
          actprocsym : pprocsym;
          def_from,def_to,conv_to : pdef;
-         pt : ptree;
-         exactmatch : boolean;
+         pt,inlinecode : ptree;
+         exactmatch,inlined : boolean;
          paralength,l : longint;
          pdc : pdefcoll;
+         curtokenpos : tfileposinfo;
 
          { only Dummy }
          hcvt : tconverttype;
@@ -2696,10 +2703,19 @@ unit pass_1;
          store_valid:=must_be_valid;
          must_be_valid:=false;
 
+         inlined:=false;
+         if assigned(p^.procdefinition) and
+            ((p^.procdefinition^.options and poinline)<>0) then
+           begin
+              inlinecode:=p^.right;
+              if assigned(inlinecode) then
+                begin
+                   inlined:=true;
+                   p^.procdefinition^.options:=p^.procdefinition^.options and (not poinline);
+                end;
+              p^.right:=nil;
+           end;
          { procedure variable ? }
-         { right contains inline code for inlined procedures }
-         if (not assigned(p^.procdefinition)) or
-            ((p^.procdefinition^.options and poinline)=0) then
          if assigned(p^.right) then
            begin
               { procedure does a call }
@@ -2887,7 +2903,8 @@ unit pass_1;
                           begin
                              { erst am Anfang }
                              while (assigned(procs)) and
-                               not(isconvertable(pt^.resulttype,procs^.nextpara^.data,hcvt,pt^.left^.treetype)) do
+                               not(isconvertable(pt^.resulttype,procs^.nextpara^.data,
+                                 hcvt,pt^.left^.treetype,false)) do
                                begin
                                   hp:=procs^.next;
                                   dispose(procs);
@@ -2898,7 +2915,7 @@ unit pass_1;
                              while (assigned(hp)) and assigned(hp^.next) do
                                begin
                                   if not(isconvertable(pt^.resulttype,hp^.next^.nextpara^.data,
-                                    hcvt,pt^.left^.treetype)) then
+                                    hcvt,pt^.left^.treetype,false)) then
                                     begin
                                        hp2:=hp^.next^.next;
                                        dispose(hp^.next);
@@ -3077,7 +3094,11 @@ unit pass_1;
                      end;
 {$endif CHAINPROCSYMS}
      {$ifdef UseBrowser}
-                   add_new_ref(procs^.data^.lastref);
+                   if make_ref then
+                     begin
+                        get_cur_file_pos(curtokenpos);
+                        add_new_ref(procs^.data^.lastref,@curtokenpos);
+                     end;
      {$endif UseBrowser}
 
                    p^.procdefinition:=procs^.data;
@@ -3100,14 +3121,6 @@ unit pass_1;
 {$endif CHAINPROCSYMS}
                end;{ end of procedure to call determination }
 
-              { work trough all parameters to insert the type conversions }
-              if assigned(p^.left) then
-                begin
-                   old_count_ref:=count_ref;
-                   count_ref:=true;
-                   firstcallparan(p^.left,p^.procdefinition^.para1);
-                   count_ref:=old_count_ref;
-                end;
               { handle predefined procedures }
               if (p^.procdefinition^.options and pointernproc)<>0 then
                 begin
@@ -3135,6 +3148,7 @@ unit pass_1;
                 end
               else
                 { no intern procedure => we do a call }
+              { calc the correture value for the register }
               { handle predefined procedures }
               if (p^.procdefinition^.options and poinline)<>0 then
                 begin
@@ -3146,16 +3160,32 @@ unit pass_1;
                    if not assigned(p^.right) then
                      begin
                         if assigned(p^.procdefinition^.code) then
-                          p^.right:=genprocinlinenode(p,ptree(p^.procdefinition^.code))
+                          inlinecode:=genprocinlinenode(p,ptree(p^.procdefinition^.code))
                         else
                           comment(v_fatal,'no code for inline procedure stored');
-                        firstpass(p^.right);
+                        if assigned(inlinecode) then
+                          begin
+                             firstpass(inlinecode);
+                             { consider it has not inlined if called
+                               again inside the args }
+                             p^.procdefinition^.options:=p^.procdefinition^.options and (not poinline);
+                             inlined:=true;
+                          end;
+
                      end;
                 end
               else
                 procinfo.flags:=procinfo.flags or pi_do_call;
 
-              { calc the correture value for the register }
+              { work trough all parameters to insert the type conversions }
+              { !!! done now after internproc !! (PM) }
+              if assigned(p^.left) then
+                begin
+                   old_count_ref:=count_ref;
+                   count_ref:=true;
+                   firstcallparan(p^.left,p^.procdefinition^.para1);
+                   count_ref:=old_count_ref;
+                end;
 {$ifdef i386}
               for regi:=R_EAX to R_EDI do
                 begin
@@ -3246,6 +3276,11 @@ unit pass_1;
               end;
            end;
 
+         if inlined then
+           begin
+              p^.right:=inlinecode;
+              p^.procdefinition^.options:=p^.procdefinition^.options or  poinline;
+           end;
          { determine the registers of the procedure variable }
          { is this OK for inlined procs also ?? (PM)         }
          if assigned(p^.right) then
@@ -3301,7 +3336,7 @@ unit pass_1;
 
       var
          hp,hpp : ptree;
-         isreal,store_valid,file_is_typed : boolean;
+         store_count_ref,isreal,store_valid,file_is_typed : boolean;
 
       procedure do_lowhigh(adef : pdef);
 
@@ -3336,9 +3371,16 @@ unit pass_1;
         end;
 
       begin
+         store_valid:=must_be_valid;
+         store_count_ref:=count_ref;
+         count_ref:=false;
          { if we handle writeln; p^.left contains no valid address }
          if assigned(p^.left) then
            begin
+              if p^.left^.treetype=callparan then
+                firstcallparan(p^.left,nil)
+              else
+                firstpass(p^.left);
               p^.registers32:=p^.left^.registers32;
               p^.registersfpu:=p^.left^.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -3346,7 +3388,6 @@ unit pass_1;
 {$endif SUPPORT_MMX}
               set_location(p^.location,p^.left^.location);
            end;
-           store_valid:=must_be_valid;
            if not (p^.inlinenumber in [in_read_x,in_readln_x,in_sizeof_x,
                                        in_typeof_x,in_ord_x,
                                        in_reset_typedfile,in_rewrite_typedfile]) then
@@ -3492,9 +3533,8 @@ unit pass_1;
                      (penumdef(p^.resulttype)^.has_jumps) then
                     begin
                       Message(parser_e_succ_and_pred_enums_with_assign_not_possible);
-                      exit;
-                    end;
-                       if p^.left^.treetype=ordconstn then
+                    end
+                  else if p^.left^.treetype=ordconstn then
                          begin
                             if p^.inlinenumber=in_pred_x then
                               hp:=genordinalconstnode(p^.left^.value+1,
@@ -3840,6 +3880,7 @@ unit pass_1;
                  else internalerror(8);
              end;
            must_be_valid:=store_valid;
+           count_ref:=store_count_ref;
        end;
 
     procedure firstsubscriptn(var p : ptree);
@@ -4021,11 +4062,7 @@ unit pass_1;
          if codegenerror then
            exit;
 
-         p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
-         p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu);
-{$ifdef SUPPORT_MMX}
-         p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
-{$endif SUPPORT_MMX}
+         left_right_max(p);
          { this is not allways true due to optimization }
          { but if we don't set this we get problems with optimizing self code }
          if psetdef(p^.right^.resulttype)^.settype<>smallset then
@@ -4053,6 +4090,7 @@ unit pass_1;
 {$ifdef SUPPORT_MMX}
          p^.registersmmx:=p^.right^.registersmmx;
 {$endif SUPPORT_MMX}
+         { left is the next in the list }
          firstpass(p^.left);
          if codegenerror then
            exit;
@@ -4534,11 +4572,7 @@ unit pass_1;
          if codegenerror then
            exit;
 
-         p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu);
-         p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
-{$ifdef SUPPORT_MMX}
-         p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
-{$endif SUPPORT_MMX}
+         left_right_max(p);
 
          { left must be a class }
          if (p^.left^.resulttype^.deftype<>objectdef) or
@@ -4567,11 +4601,13 @@ unit pass_1;
          if codegenerror then
            exit;
 
+         left_right_max(p);
+(*       this was wrong,no ??
          p^.registersfpu:=max(p^.left^.registersfpu,p^.left^.registersfpu);
          p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
 {$ifdef SUPPORT_MMX}
          p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
-{$endif SUPPORT_MMX}
+{$endif SUPPORT_MMX}             *)
 
          { left must be a class }
          if (p^.left^.resulttype^.deftype<>objectdef) or
@@ -4626,14 +4662,7 @@ unit pass_1;
                    firstpass(p^.right);
                    p^.right:=gentypeconvnode(p^.right,s32bitdef);
                    firstpass(p^.right);
-                   p^.registersfpu:=max(p^.left^.registersfpu,
-                     p^.right^.registersfpu);
-                   p^.registers32:=max(p^.left^.registers32,
-                     p^.right^.registers32);
-{$ifdef SUPPORT_MMX}
-                   p^.registersmmx:=max(p^.left^.registersmmx,
-                     p^.right^.registersmmx);
-{$endif SUPPORT_MMX}
+                   left_right_max(p);
                 end;
            end;
       end;
@@ -4652,14 +4681,7 @@ unit pass_1;
                if codegenerror then
                  exit;
 
-               p^.registers32:=max(p^.left^.registers32,
-                 p^.right^.registers32);
-               p^.registersfpu:=max(p^.left^.registersfpu,
-                 p^.right^.registersfpu);
-{$ifdef SUPPORT_MMX}
-               p^.registersmmx:=max(p^.left^.registersmmx,
-                 p^.right^.registersmmx);
-{$endif SUPPORT_MMX}
+               left_right_max(p);
                p^.resulttype:=voiddef;
             end
          else
@@ -4838,7 +4860,7 @@ unit pass_1;
                 begin
                    comment(v_debug,'tree changed after first counting pass '
                      +tostr(longint(p^.treetype)));
-                   compare_trees(p,oldp);
+                   compare_trees(oldp,p);
                 end;
               dispose(oldp);
            end;
@@ -4872,7 +4894,17 @@ unit pass_1;
 end.
 {
   $Log$
-  Revision 1.18  1998-05-11 13:07:55  peter
+  Revision 1.19  1998-05-20 09:42:34  pierre
+    + UseTokenInfo now default
+    * unit in interface uses and implementation uses gives error now
+    * only one error for unknown symbol (uses lastsymknown boolean)
+      the problem came from the label code !
+    + first inlined procedures and function work
+      (warning there might be allowed cases were the result is still wrong !!)
+    * UseBrower updated gives a global list of all position of all used symbols
+      with switch -gb
+
+  Revision 1.18  1998/05/11 13:07:55  peter
     + $ifdef NEWPPU for the new ppuformat
     + $define GDB not longer required
     * removed all warnings and stripped some log comments

compiler/pbase.pas

@@ -94,7 +94,7 @@ unit pbase;
 
     uses
 
-       files,scanner,symtable,systems,verbose;
+       files,scanner,systems,verbose;
 
     { consumes token i, if the current token is unequal i }
     { a syntax error is written                           }
@@ -148,11 +148,7 @@ unit pbase;
          else
            begin
              if token=_END then
-{$ifdef UseTokenInfo}
                 last_endtoken_filepos:=tokenpos;
-{$else UseTokenInfo}
-                get_cur_file_pos(last_endtoken_filepos);
-{$endif UseTokenInfo}
              token:=yylex;
            end;
       end;
@@ -160,19 +156,11 @@ unit pbase;
     procedure consume_all_until(atoken : ttoken);
 
       begin
-{$ifndef UseTokenInfo}
          while (token<>atoken) and (token<>_EOF) do
            consume(token);
          { this will create an error if the token is _EOF }
          if token<>atoken then
            consume(atoken);
-{$else UseTokenInfo}
-         while (token<>atoken) and (token<>_EOF) do
-           consume(token);
-         { this will create an error if the token is _EOF }
-         if token<>atoken then
-           consume(atoken);
-{$endif UseTokenInfo}
          { this error is fatal as we have read the whole file }
          Message(scan_f_end_of_file);
       end;
@@ -193,12 +181,8 @@ unit pbase;
       begin
          sc:=new(pstringcontainer,init);
          repeat
-{$ifndef UseTokenInfo}
-           sc^.insert(pattern);
-{$else UseTokenInfo}
            sc^.insert_with_tokeninfo(pattern,
              tokenpos);
-{$endif UseTokenInfo}
            consume(ID);
            if token=COMMA then consume(COMMA)
              else break
@@ -212,27 +196,17 @@ unit pbase;
 
       var
          s : string;
-{$ifdef UseTokenInfo}
          filepos : tfileposinfo;
          ss : pvarsym;
-{$endif UseTokenInfo}
 
 
       begin
-{$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
@@ -240,11 +214,7 @@ 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;
@@ -253,7 +223,17 @@ end.
 
 {
   $Log$
-  Revision 1.6  1998-05-12 10:47:00  peter
+  Revision 1.7  1998-05-20 09:42:35  pierre
+    + UseTokenInfo now default
+    * unit in interface uses and implementation uses gives error now
+    * only one error for unknown symbol (uses lastsymknown boolean)
+      the problem came from the label code !
+    + first inlined procedures and function work
+      (warning there might be allowed cases were the result is still wrong !!)
+    * UseBrower updated gives a global list of all position of all used symbols
+      with switch -gb
+
+  Revision 1.6  1998/05/12 10:47:00  peter
     * moved printstatus to verb_def
     + V_Normal which is between V_Error and V_Warning and doesn't have a
       prefix like error: warning: and is included in V_Default

compiler/pdecl.pas

@@ -201,7 +201,7 @@ unit pdecl;
 {$ifndef GDB}
                  else d:=new(pstringdef,init(255));
 {$else GDB}
-                 else d:=globaldef('SYSTEM.STRING');
+                 else d:=globaldef('STRING');
 {$endif GDB}
 {$else UseAnsiString}
               if p^.value>255 then
@@ -211,18 +211,18 @@ unit pdecl;
 {$ifndef GDB}
                  else d:=new(pstringdef,init(255));
 {$else GDB}
-                 else d:=globaldef('SYSTEM.STRING');
+                 else d:=globaldef('STRING');
 {$endif GDB}
               consume(RECKKLAMMER);
 {$endif UseAnsiString}
               disposetree(p);
            end
-           { should string bwithout suffix be an ansistring also
+           { should string without suffix be an ansistring also
              in ansistring mode ?? (PM) }
 {$ifndef GDB}
                  else d:=new(pstringdef,init(255));
 {$else GDB}
-                 else d:=globaldef('SYSTEM.STRING');
+                 else d:=globaldef('STRING');
 {$endif GDB}
                  stringtype:=d;
           end;
@@ -382,9 +382,7 @@ unit pdecl;
            sc : pstringcontainer;
            hp : pdef;
            s : string;
-{$ifdef UseTokenInfo}
            filepos : tfileposinfo;
-{$endif UseTokenInfo}
            pp : pprocdef;
 
         begin
@@ -442,7 +440,7 @@ unit pdecl;
                          end
                        else
                          hp:=new(pformaldef,init);
-                       s:=sc^.get;
+                       s:=sc^.get_with_tokeninfo(filepos);
                        while s<>'' do
                          begin
                             new(hp2);
@@ -450,7 +448,7 @@ unit pdecl;
                             hp2^.data:=hp;
                             hp2^.next:=propertyparas;
                             propertyparas:=hp2;
-                            s:=sc^.get;
+                            s:=sc^.get_with_tokeninfo(filepos);
                          end;
                        dispose(sc,done);
                        if token=SEMICOLON then consume(SEMICOLON)
@@ -1546,9 +1544,7 @@ unit pdecl;
          old_block_type : tblock_type;
          { to handle absolute }
          abssym : pabsolutesym;
-{$ifdef UseTokenInfo}
          filepos : tfileposinfo;
-{$endif UseTokenInfo}
 
 
       begin
@@ -1566,11 +1562,7 @@ unit pdecl;
               p:=read_type('');
               if do_absolute and (token=ID) and (pattern='ABSOLUTE') then
                 begin
-{$ifdef UseTokenInfo}
-        s:=sc^.get_with_tokeninfo(filepos);
-{$else UseTokenInfo}
-        s:=sc^.get;
-{$endif UseTokenInfo}
+                   s:=sc^.get_with_tokeninfo(filepos);
                    if sc^.get<>'' then
                     Message(parser_e_absolute_only_one_var);
                    dispose(sc,done);
@@ -1586,9 +1578,7 @@ 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
@@ -1600,9 +1590,7 @@ 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
@@ -1615,9 +1603,7 @@ 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);
@@ -1787,7 +1773,17 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.17  1998-05-11 13:07:55  peter
+  Revision 1.18  1998-05-20 09:42:35  pierre
+    + UseTokenInfo now default
+    * unit in interface uses and implementation uses gives error now
+    * only one error for unknown symbol (uses lastsymknown boolean)
+      the problem came from the label code !
+    + first inlined procedures and function work
+      (warning there might be allowed cases were the result is still wrong !!)
+    * UseBrower updated gives a global list of all position of all used symbols
+      with switch -gb
+
+  Revision 1.17  1998/05/11 13:07:55  peter
     + $ifdef NEWPPU for the new ppuformat
     + $define GDB not longer required
     * removed all warnings and stripped some log comments

compiler/pexpr.pas

@@ -654,13 +654,10 @@ unit pexpr;
          d : bestreal;
          constset : pconstset;
          propsym : ppropertysym;
-{$ifdef UseTokenInfo}
          oldp1 : ptree;
          filepos : tfileposinfo;
-{$endif UseTokenInfo}
 
 
-{$ifdef UseTokenInfo}
       procedure check_tokenpos;
         begin
            if (p1<>oldp1) then
@@ -671,15 +668,12 @@ unit pexpr;
                 filepos:=tokenpos;
              end;
         end;
-{$endif UseTokenInfo}
 
       { p1 and p2 must contain valid values }
       procedure postfixoperators;
 
         begin
-{$ifdef UseTokenInfo}
              check_tokenpos;
-{$endif UseTokenInfo}
            while again do
              begin
                 case token of
@@ -904,9 +898,7 @@ unit pexpr;
                         else again:=false;
                      end;
                 end;
-{$ifdef UseTokenInfo}
              check_tokenpos;
-{$endif UseTokenInfo}
            end;
       end;
 
@@ -930,10 +922,8 @@ unit pexpr;
          possible_error : boolean;
 
       begin
-{$ifdef UseTokenInfo}
          oldp1:=nil;
          filepos:=tokenpos;
-{$endif UseTokenInfo}
          case token of
             ID:
               begin
@@ -954,7 +944,14 @@ unit pexpr;
                    end
                  else
                    begin
-                      getsym(pattern,true);
+                      if lastsymknown then
+                        begin
+                           srsym:=lastsrsym;
+                           srsymtable:=lastsrsymtable;
+                           lastsymknown:=false;
+                        end
+                      else
+                        getsym(pattern,true);
                       consume(ID);
                       { is this an access to a function result ? }
                        if assigned(aktprocsym) and
@@ -1516,9 +1513,7 @@ unit pexpr;
               end;
          end;
          factor:=p1;
-{$ifdef UseTokenInfo}
          check_tokenpos;
-{$endif UseTokenInfo}
       end;
 
     type    Toperator_precedence=(opcompare,opaddition,opmultiply);
@@ -1556,9 +1551,7 @@ unit pexpr;
 
     var p1,p2:Ptree;
         oldt:Ttoken;
-{$ifdef UseTokenInfo}
          filepos : tfileposinfo;
-{$endif UseTokenInfo}
 
 
     begin
@@ -1574,9 +1567,7 @@ unit pexpr;
                ((token<>EQUAL) or accept_equal) then
                 begin
                     oldt:=token;
-{$ifdef UseTokenInfo}
                     filepos:=tokenpos;
-{$endif UseTokenInfo}
 
                     consume(token);
 {                    if pred_level=high(Toperator_precedence) then }
@@ -1585,9 +1576,7 @@ unit pexpr;
                     else
                         p2:=sub_expr(succ(pred_level),true);
                     p1:=gennode(tok2node[oldt],p1,p2);
-{$ifdef UseTokenInfo}
                     set_tree_filepos(p1,filepos);
-{$endif UseTokenInfo}
 
                 end
             else
@@ -1613,20 +1602,16 @@ unit pexpr;
       var
          p1,p2 : ptree;
          oldafterassignment : boolean;
-{$ifdef UseTokenInfo}
          oldp1 : ptree;
          filepos : tfileposinfo;
-{$endif UseTokenInfo}
 
       begin
          oldafterassignment:=afterassignment;
          p1:=sub_expr(opcompare,true);
          if token in [ASSIGNMENT,_PLUSASN,_MINUSASN,_STARASN,_SLASHASN] then
            afterassignment:=true;
-{$ifdef UseTokenInfo}
          filepos:=tokenpos;
          oldp1:=p1;
-{$endif UseTokenInfo}
          case token of
             POINTPOINT : begin
                             consume(POINTPOINT);
@@ -1679,10 +1664,8 @@ unit pexpr;
                          end;
          end;
          afterassignment:=oldafterassignment;
-{$ifdef UseTokenInfo}
          if p1<>oldp1 then
            set_tree_filepos(p1,filepos);
-{$endif UseTokenInfo}
          expr:=p1;
       end;
 
@@ -1732,7 +1715,17 @@ unit pexpr;
 end.
 {
   $Log$
-  Revision 1.14  1998-05-11 13:07:56  peter
+  Revision 1.15  1998-05-20 09:42:35  pierre
+    + UseTokenInfo now default
+    * unit in interface uses and implementation uses gives error now
+    * only one error for unknown symbol (uses lastsymknown boolean)
+      the problem came from the label code !
+    + first inlined procedures and function work
+      (warning there might be allowed cases were the result is still wrong !!)
+    * UseBrower updated gives a global list of all position of all used symbols
+      with switch -gb
+
+  Revision 1.14  1998/05/11 13:07:56  peter
     + $ifdef NEWPPU for the new ppuformat
     + $define GDB not longer required
     * removed all warnings and stripped some log comments

compiler/pmodules.pas

@@ -274,7 +274,7 @@ unit pmodules;
          insertinternsyms(p);
       end;
 
-    procedure load_ppu(hp : pmodule;compile_system : boolean);
+    procedure load_ppu(oldhp,hp : pmodule;compile_system : boolean);
 
       var
          loaded_unit  : pmodule;
@@ -322,7 +322,17 @@ unit pmodules;
                   if not(hp^.sources_avail) then
                    Message1(unit_f_cant_compile_unit,hp^.unitname^)
                   else
-                   compile(hp^.mainsource^,compile_system);
+                   begin
+{$ifdef TEST_TEMPCLOSE}
+                      if assigned(oldhp^.current_inputfile) then
+                        oldhp^.current_inputfile^.tempclose;
+{$endif TEST_TEMPCLOSE}
+                      compile(hp^.mainsource^,compile_system);
+{$ifdef TEST_TEMPCLOSE}
+                      if not oldhp^.compiled then
+                        oldhp^.current_inputfile^.tempreopen;
+{$endif TEST_TEMPCLOSE}
+                   end;
                   exit;
                 end;
 
@@ -336,8 +346,10 @@ unit pmodules;
             hp^.symtable:=new(punitsymtable,load(hp^.unitname^));
 
           { if this is the system unit insert the intern symbols }
+            make_ref:=false;
             if compile_system then
               insertinternsyms(psymtable(hp^.symtable));
+            make_ref:=true;
           end;
 
        { now only read the implementation part }
@@ -389,7 +401,17 @@ unit pmodules;
                    if not(hp^.sources_avail) then
                     Message1(unit_f_cant_compile_unit,hp^.unitname^)
                    else
-                    compile(hp^.mainsource^,compile_system);
+                    begin
+{$ifdef TEST_TEMPCLOSE}
+                       if assigned(oldhp^.current_inputfile) then
+                         oldhp^.current_inputfile^.tempclose;
+{$endif TEST_TEMPCLOSE}
+                       compile(hp^.mainsource^,compile_system);
+{$ifdef TEST_TEMPCLOSE}
+                       if not oldhp^.compiled then
+                         oldhp^.current_inputfile^.tempreopen;
+{$endif TEST_TEMPCLOSE}
+                    end;
                    exit;
                 end;
               { setup the map entry for deref }
@@ -407,8 +429,10 @@ unit pmodules;
 
          { if this is the system unit insert the intern }
          { symbols                                      }
+         make_ref:=false;
          if compile_system then
            insertinternsyms(psymtable(hp^.symtable));
+         make_ref:=true;
 
          { now only read the implementation part }
          hp^.in_implementation:=true;
@@ -443,7 +467,15 @@ unit pmodules;
                    if not(hp^.sources_avail) then
                     Message1(unit_f_cant_compile_unit,hp^.unitname^)
                    else
-                     compile(hp^.mainsource^,compile_system);
+                     begin
+{ifdef TEST_TEMPCLOSE}
+                        oldhp^.current_inputfile^.tempclose;
+{endif TEST_TEMPCLOSE}
+                        compile(hp^.mainsource^,compile_system);
+{ifdef TEST_TEMPCLOSE}
+                        oldhp^.current_inputfile^.tempclose;
+{endif TEST_TEMPCLOSE}
+                     end;
                    exit;
                 end; *)
               { read until ibend }
@@ -514,7 +546,17 @@ unit pmodules;
                    if not(hp^.sources_avail) then
                     Message1(unit_f_cant_compile_unit,hp^.unitname^)
                    else
-                    compile(hp^.mainsource^,compile_system);
+                    begin
+{$ifdef TEST_TEMPCLOSE}
+                       if assigned(old_current_module^.current_inputfile) then
+                         old_current_module^.current_inputfile^.tempclose;
+{$endif TEST_TEMPCLOSE}
+                       compile(hp^.mainsource^,compile_system);
+{$ifdef TEST_TEMPCLOSE}
+                      if not old_current_module^.compiled then
+                         old_current_module^.current_inputfile^.tempreopen;
+{$endif TEST_TEMPCLOSE}
+                    end;
                 end
               else
                 begin
@@ -528,7 +570,7 @@ unit pmodules;
 {$else}
                   if hp^.ppufile^.name^<>'' then
 {$endif}
-                    load_ppu(hp,compile_system);
+                    load_ppu(old_current_module,hp,compile_system);
                  { add the files for the linker }
                   addlinkerfiles(hp);
                 end;
@@ -567,11 +609,24 @@ unit pmodules;
                 { we must preserve the unit chain }
                 hp^.next:=nextmodule;
                 if assigned(hp^.ppufile) then
-                 load_ppu(hp,compile_system)
+                 load_ppu(old_current_module,hp,compile_system)
                 else
                  begin
+{$ifdef UseBrowser}
+                    { here we need to remove the names ! }
+                    hp^.sourcefiles.done;
+                    hp^.sourcefiles.init;
+{$endif not UseBrowser}
+{$ifdef TEST_TEMPCLOSE}
+                   if assigned(old_current_module^.current_inputfile) then
+                     old_current_module^.current_inputfile^.tempclose;
+{$endif TEST_TEMPCLOSE}
                    Message1(parser_d_compiling_second_time,hp^.mainsource^);
                    compile(hp^.mainsource^,compile_system);
+{$ifdef TEST_TEMPCLOSE}
+                   if not old_current_module^.compiled then
+                     old_current_module^.current_inputfile^.tempreopen;
+{$endif TEST_TEMPCLOSE}
                  end;
                 current_module^.compiled:=true;
              end;
@@ -841,7 +896,8 @@ unit pmodules;
          }
          { generates static symbol table }
          p:=new(punitsymtable,init(staticsymtable,current_module^.unitname^));
-         refsymtable:=p;
+         { must be done only after _USES !! (PM)
+         refsymtable:=p;}
 
          {Generate a procsym.}
          aktprocsym:=new(Pprocsym,init(current_module^.unitname^+'_init'));
@@ -864,6 +920,8 @@ unit pmodules;
          symtablestack:=unitst^.next;
 
          parse_implementation_uses(unitst);
+         { now we can change refsymtable }
+         refsymtable:=p;
 
          { but reinsert the global symtable as lasts }
          unitst^.next:=symtablestack;
@@ -946,12 +1004,7 @@ unit pmodules;
               pu:=pused_unit(pu^.next);
            end;
          inc(datasize,symtablestack^.datasize);
-
-
-
-      { finish asmlist by adding segment starts }
-
-
+         { finish asmlist by adding segment starts }
          insertsegment;
       end;
 
@@ -1020,6 +1073,9 @@ unit pmodules;
 
          refsymtable:=st;
 
+         { necessary for browser }
+         loaded_units.insert(current_module);
+
          {Insert the symbols of the system unit into the stack of symbol
           tables.}
          symtablestack:=systemunit;
@@ -1081,24 +1137,27 @@ unit pmodules;
 
 
          datasize:=symtablestack^.datasize;
-         symtablestack^.check_forwards;
+         { symtablestack^.check_forwards;
          symtablestack^.allsymbolsused;
-
-
-
-      { finish asmlist by adding segment starts }
-
-
+         done in compile_proc_body }
+         { finish asmlist by adding segment starts }
          insertsegment;
-
-
-
       end;
 
 end.
 {
   $Log$
-  Revision 1.13  1998-05-12 10:47:00  peter
+  Revision 1.14  1998-05-20 09:42:35  pierre
+    + UseTokenInfo now default
+    * unit in interface uses and implementation uses gives error now
+    * only one error for unknown symbol (uses lastsymknown boolean)
+      the problem came from the label code !
+    + first inlined procedures and function work
+      (warning there might be allowed cases were the result is still wrong !!)
+    * UseBrower updated gives a global list of all position of all used symbols
+      with switch -gb
+
+  Revision 1.13  1998/05/12 10:47:00  peter
     * moved printstatus to verb_def
     + V_Normal which is between V_Error and V_Warning and doesn't have a
       prefix like error: warning: and is included in V_Default

compiler/pp.pas

@@ -57,17 +57,17 @@
    { and only one of the two }
    {$ifndef I386}
       {$ifndef M68K}
-        {$fatalerror One of the switches I386 or M68K must be defined}
+        {$fatal One of the switches I386 or M68K must be defined}
       {$endif M68K}
    {$endif I386}
    {$ifdef I386}
       {$ifdef M68K}
-        {$fatalerror ONLY one of the switches I386 or M68K must be defined}
+        {$fatal ONLY one of the switches I386 or M68K must be defined}
       {$endif M68K}
    {$endif I386}
    {$ifdef support_mmx}
      {$ifndef i386}
-       {$fatalerror I386 switch must be on for MMX support}
+       {$fatal I386 switch must be on for MMX support}
      {$endif i386}
    {$endif support_mmx}
 {$endif}
@@ -195,6 +195,13 @@ 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;
@@ -353,7 +360,17 @@ begin
 end.
 {
   $Log$
-  Revision 1.10  1998-05-12 10:47:00  peter
+  Revision 1.11  1998-05-20 09:42:35  pierre
+    + UseTokenInfo now default
+    * unit in interface uses and implementation uses gives error now
+    * only one error for unknown symbol (uses lastsymknown boolean)
+      the problem came from the label code !
+    + first inlined procedures and function work
+      (warning there might be allowed cases were the result is still wrong !!)
+    * UseBrower updated gives a global list of all position of all used symbols
+      with switch -gb
+
+  Revision 1.10  1998/05/12 10:47:00  peter
     * moved printstatus to verb_def
     + V_Normal which is between V_Error and V_Warning and doesn't have a
       prefix like error: warning: and is included in V_Default

compiler/pstatmnt.pas

@@ -569,6 +569,12 @@ unit pstatmnt;
     function _asm_statement : ptree;
 
       begin
+         if (aktprocsym^.definition^.options and poinline)<>0 then
+           Begin
+              Comment(V_Warning,'asm statement inside inline procedure/function not yet supported');
+              Comment(V_Warning,'inlining disabled');
+              aktprocsym^.definition^.options:= aktprocsym^.definition^.options and not poinline;
+           End;
          case aktasmmode of
             I386_ATT : _asm_statement:=ratti386.assemble;
             I386_INTEL : _asm_statement:=rai386.assemble;
@@ -801,15 +807,11 @@ unit pstatmnt;
 
       var
          first,last : ptree;
-{$ifdef UseTokenInfo}
          filepos : tfileposinfo;
-{$endif UseTokenInfo}
 
       begin
          first:=nil;
-{$ifdef UseTokenInfo}
          filepos:=tokenpos;
-{$endif UseTokenInfo}
          consume(_BEGIN);
          inc(statement_level);
 
@@ -845,11 +847,7 @@ unit pstatmnt;
          dec(statement_level);
 
          last:=gensinglenode(blockn,first);
-{$ifdef UseTokenInfo}
          set_tree_filepos(last,filepos);
-{$else UseTokenInfo}
-         set_file_line(first,last);
-{$endif UseTokenInfo}
          statement_block:=last;
       end;
 
@@ -859,17 +857,13 @@ unit pstatmnt;
          p : ptree;
          code : ptree;
          labelnr : plabel;
-{$ifdef UseTokenInfo}
          filepos : tfileposinfo;
-{$endif UseTokenInfo}
 
       label
          ready;
 
       begin
-{$ifdef UseTokenInfo}
          filepos:=tokenpos;
-{$endif UseTokenInfo}
          case token of
             _GOTO : begin
                        if not(cs_support_goto in aktswitches)then
@@ -929,7 +923,9 @@ unit pstatmnt;
               end;
              }
             _EXIT : code:=exit_statement;
-            _ASM : code:=_asm_statement;
+            _ASM : begin
+                      code:=_asm_statement;
+                   end;
          else
            begin
               if (token=INTCONST) or
@@ -938,6 +934,11 @@ unit pstatmnt;
                 (pattern='RESULT'))) then
                 begin
                    getsym(pattern,false);
+                   lastsymknown:=true;
+                   lastsrsym:=srsym;
+                   { it is NOT necessarily the owner
+                     it can be a withsymtable !!! }
+                   lastsrsymtable:=srsymtable;
                    if assigned(srsym) and (srsym^.typ=labelsym) then
                      begin
                         consume(token);
@@ -948,7 +949,7 @@ unit pstatmnt;
 
                         { statement modifies srsym }
                         labelnr:=plabelsym(srsym)^.number;
-
+                        lastsymknown:=false;
                         { the pointer to the following instruction }
                         { isn't a very clean way                   }
 {$ifdef tp}
@@ -965,13 +966,19 @@ unit pstatmnt;
               if not(p^.treetype in [calln,assignn,breakn,inlinen,
                 continuen]) then
                 Message(cg_e_illegal_expression);
+              { specify that we don't use the value returned by the call }
+              { Question : can this be also improtant
+                for inlinen ??
+                it is used for :
+                 - dispose of temp stack space
+                 - dispose on FPU stack }
+              if p^.treetype=calln then
+                p^.return_value_used:=false;
               code:=p;
            end;
          end;
          ready:
-{$ifdef UseTokenInfo}
          set_tree_filepos(code,filepos);
-{$endif UseTokenInfo}
          statement:=code;
       end;
 
@@ -1091,8 +1098,10 @@ unit pstatmnt;
            end;
            { set the framepointer to esp for assembler functions }
            { but only if the are no local variables              }
+           { added no parameter also (PM)                        }
            if ((aktprocsym^.definition^.options and poassembler)<>0) and
-               (aktprocsym^.definition^.localst^.datasize=0) then
+               (aktprocsym^.definition^.localst^.datasize=0) and
+               (aktprocsym^.definition^.parast^.datasize=0) then
                begin
 {$ifdef i386}
                   procinfo.framepointer:=R_ESP;
@@ -1110,7 +1119,17 @@ unit pstatmnt;
 end.
 {
   $Log$
-  Revision 1.10  1998-05-11 13:07:56  peter
+  Revision 1.11  1998-05-20 09:42:35  pierre
+    + UseTokenInfo now default
+    * unit in interface uses and implementation uses gives error now
+    * only one error for unknown symbol (uses lastsymknown boolean)
+      the problem came from the label code !
+    + first inlined procedures and function work
+      (warning there might be allowed cases were the result is still wrong !!)
+    * UseBrower updated gives a global list of all position of all used symbols
+      with switch -gb
+
+  Revision 1.10  1998/05/11 13:07:56  peter
     + $ifdef NEWPPU for the new ppuformat
     + $define GDB not longer required
     * removed all warnings and stripped some log comments

compiler/ra68k.pas

@@ -73,7 +73,7 @@ var
 Implementation
 
 uses
-  globals,AsmUtils,strings,hcodegen,scanner,aasm,
+  files,globals,AsmUtils,strings,hcodegen,scanner,aasm,
   cobjects,verbose,symtable;
 
 
@@ -249,6 +249,9 @@ var
     end;
     { Possiblities for first token in a statement:                }
     {   Local Label, Label, Directive, Prefix or Opcode....       }
+    tokenpos.line:=current_module^.current_inputfile^.line_no;
+    tokenpos.column:=get_current_col;
+    tokenpos.fileindex:=current_module^.current_index;
     if firsttoken and not (c in [newline,#13,'{',';']) then
     begin
 
@@ -2169,7 +2172,17 @@ Begin
 end.
 {
   $Log$
-  Revision 1.2  1998-04-29 10:34:01  pierre
+  Revision 1.3  1998-05-20 09:42:36  pierre
+    + UseTokenInfo now default
+    * unit in interface uses and implementation uses gives error now
+    * only one error for unknown symbol (uses lastsymknown boolean)
+      the problem came from the label code !
+    + first inlined procedures and function work
+      (warning there might be allowed cases were the result is still wrong !!)
+    * UseBrower updated gives a global list of all position of all used symbols
+      with switch -gb
+
+  Revision 1.2  1998/04/29 10:34:01  pierre
     + added some code for ansistring (not complete nor working yet)
     * corrected operator overloading
     * corrected nasm output

compiler/radi386.pas

@@ -32,7 +32,7 @@ unit radi386;
   implementation
 
      uses
-        i386,hcodegen,globals,scanner,aasm,
+        files,i386,hcodegen,globals,scanner,aasm,
         cobjects,symtable,types,verbose,asmutils;
 
     function assemble : ptree;
@@ -73,10 +73,13 @@ unit radi386;
          retstr:=upper(tostr(procinfo.retoffset)+'('+att_reg2str[procinfo.framepointer]+')')
        else
          retstr:='';
-       c:=asmgetchar;
+         c:=asmgetchar;
          code:=new(paasmoutput,init);
          while not(ende) do
            begin
+              tokenpos.line:=current_module^.current_inputfile^.line_no;
+              tokenpos.column:=get_current_col;
+              tokenpos.fileindex:=current_module^.current_index;
               case c of
                  'A'..'Z','a'..'z','_' : begin
                       hs:='';
@@ -236,7 +239,17 @@ unit radi386;
 end.
 {
   $Log$
-  Revision 1.2  1998-04-08 16:58:06  pierre
+  Revision 1.3  1998-05-20 09:42:36  pierre
+    + UseTokenInfo now default
+    * unit in interface uses and implementation uses gives error now
+    * only one error for unknown symbol (uses lastsymknown boolean)
+      the problem came from the label code !
+    + first inlined procedures and function work
+      (warning there might be allowed cases were the result is still wrong !!)
+    * UseBrower updated gives a global list of all position of all used symbols
+      with switch -gb
+
+  Revision 1.2  1998/04/08 16:58:06  pierre
     * several bugfixes
       ADD ADC and AND are also sign extended
       nasm output OK (program still crashes at end

compiler/rai386.pas

@@ -82,7 +82,7 @@ var
 Implementation
 
 Uses
-  aasm,globals,AsmUtils,strings,hcodegen,scanner,
+  files,aasm,globals,AsmUtils,strings,hcodegen,scanner,
   cobjects,verbose,types;
 
 
@@ -350,6 +350,9 @@ var
       c := asmgetchar;
     { Possiblities for first token in a statement:                }
     {   Local Label, Label, Directive, Prefix or Opcode....       }
+    tokenpos.line:=current_module^.current_inputfile^.line_no;
+    tokenpos.column:=get_current_col;
+    tokenpos.fileindex:=current_module^.current_index;
     if firsttoken and not (c in [newline,#13,'{',';']) then
     begin
       firsttoken := FALSE;
@@ -3366,7 +3369,17 @@ Begin
 end.
 {
   $Log$
-  Revision 1.4  1998-04-29 10:34:03  pierre
+  Revision 1.5  1998-05-20 09:42:36  pierre
+    + UseTokenInfo now default
+    * unit in interface uses and implementation uses gives error now
+    * only one error for unknown symbol (uses lastsymknown boolean)
+      the problem came from the label code !
+    + first inlined procedures and function work
+      (warning there might be allowed cases were the result is still wrong !!)
+    * UseBrower updated gives a global list of all position of all used symbols
+      with switch -gb
+
+  Revision 1.4  1998/04/29 10:34:03  pierre
     + added some code for ansistring (not complete nor working yet)
     * corrected operator overloading
     * corrected nasm output

compiler/ratti386.pas

@@ -75,7 +75,7 @@ var
 Implementation
 
 Uses
-  aasm,globals,AsmUtils,strings,hcodegen,scanner,
+  files,aasm,globals,AsmUtils,strings,hcodegen,scanner,
   cobjects,verbose,symtable,types;
 
 type
@@ -327,6 +327,9 @@ const
      c:=asmgetchar;
     { Possiblities for first token in a statement:                }
     {   Local Label, Label, Directive, Prefix or Opcode....       }
+    tokenpos.line:=current_module^.current_inputfile^.line_no;
+    tokenpos.column:=get_current_col;
+    tokenpos.fileindex:=current_module^.current_index;
     if firsttoken and not (c in [newline,#13,'{',';']) then
     begin
       firsttoken := FALSE;
@@ -3678,7 +3681,17 @@ end.
 
 {
   $Log$
-  Revision 1.5  1998-04-29 13:52:23  peter
+  Revision 1.6  1998-05-20 09:42:37  pierre
+    + UseTokenInfo now default
+    * unit in interface uses and implementation uses gives error now
+    * only one error for unknown symbol (uses lastsymknown boolean)
+      the problem came from the label code !
+    + first inlined procedures and function work
+      (warning there might be allowed cases were the result is still wrong !!)
+    * UseBrower updated gives a global list of all position of all used symbols
+      with switch -gb
+
+  Revision 1.5  1998/04/29 13:52:23  peter
     * small optimize fix
 
   Revision 1.4  1998/04/29 10:34:04  pierre

compiler/scanner.pas

@@ -160,15 +160,7 @@ unit scanner;
         preprocstack   : ppreprocstack;
 
 
-{$ifdef UseTokenInfo}
-{    type
-      ttokeninfo = record
-                 token : ttoken;
-                 fi : tfileposinfo;
-                 end;
-      ptokeninfo = ^ttokeninfo; }
       var tokenpos : tfileposinfo;
-{$endif UseTokenInfo}
 
       {public}
         procedure syntaxerror(const s : string);
@@ -659,24 +651,17 @@ unit scanner;
         function yylex : ttoken;
      var
         y    : ttoken;
-{$ifdef UseTokenInfo}
-        fileindex,line,column : longint;
-{$endif UseTokenInfo}
         code : word;
         l    : longint;
         mac  : pmacrosym;
         hp   : pinputfile;
         hp2  : pchar;
-{$ifdef UseTokenInfo}
       label
          exit_label;
-{$endif UseTokenInfo}
      begin
-{$ifdef UseTokenInfo}
-        line:=current_module^.current_inputfile^.line_no;
-        column:=get_current_col;
-        fileindex:=current_module^.current_index;
-{$endif UseTokenInfo}
+        tokenpos.line:=current_module^.current_inputfile^.line_no;
+        tokenpos.column:=get_current_col;
+        tokenpos.fileindex:=current_module^.current_index;
         { 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                 }
@@ -686,39 +671,29 @@ unit scanner;
              if c='.' then
                begin
                   readchar;
-{$ifndef UseTokenInfo}
-                  yylex:=POINTPOINT;
-                  exit;
-               end;
-             yylex:=POINT;
-             exit;
-{$else UseTokenInfo}
                   yylex:=POINTPOINT;
                   goto exit_label;
                end;
              yylex:=POINT;
              goto exit_label;
-{$endif UseTokenInfo}
           end;
 
         repeat
           case c of
            '{' : skipcomment;
-   ' ',#9..#13 : skipspace;
+           ' ',#9..#13 : skipspace;
           else
            break;
           end;
         until false;
 
         lasttokenpos:=longint(inputpointer);
-{$ifdef UseTokenInfo}
-        line:=current_module^.current_inputfile^.line_no;
-        column:=get_current_col;
-        fileindex:=current_module^.current_index;
+        tokenpos.line:=current_module^.current_inputfile^.line_no;
+        tokenpos.column:=get_current_col;
+        tokenpos.fileindex:=current_module^.current_index;
         { will become line:=lasttokenpos ??;}
-{$endif UseTokenInfo}
         case c of
-       '_','A'..'Z',
+           '_','A'..'Z',
            'a'..'z' : begin
                         orgpattern:=readstring;
                         pattern:=upper(orgpattern);
@@ -740,6 +715,9 @@ unit scanner;
                                  hp^.next:=current_module^.current_inputfile;
                                  current_module^.current_inputfile:=hp;
                                  status.currentsource:=current_module^.current_inputfile^.name^;
+                                 { I don't think that we should do that
+                                   because otherwise the file will be searched !! (PM)
+                                   but there is the problem of index !! }
                                  current_module^.sourcefiles.register_file(hp);
                                  current_module^.current_index:=hp^.ref_index;
                                { set an own buffer }
@@ -772,29 +750,17 @@ unit scanner;
                             end;
                            yylex:=ID;
                          end;
-{$ifndef UseTokenInfo}
-                        exit;
-{$else UseTokenInfo}
                         goto exit_label;
-{$endif UseTokenInfo}
                       end;
                 '$' : begin
                          pattern:=readnumber;
                          yylex:=INTCONST;
-{$ifndef UseTokenInfo}
-                         exit;
-{$else UseTokenInfo}
                          goto exit_label;
-{$endif UseTokenInfo}
                       end;
                 '%' : begin
                          pattern:=readnumber;
                          yylex:=INTCONST;
-{$ifndef UseTokenInfo}
-                         exit;
-{$else UseTokenInfo}
                          goto exit_label;
-{$endif UseTokenInfo}
                       end;
            '0'..'9' : begin
                         pattern:=readnumber;
@@ -805,11 +771,7 @@ unit scanner;
                                   begin
                                     s_point:=true;
                                     yylex:=INTCONST;
-{$ifndef UseTokenInfo}
-                                    exit;
-{$else UseTokenInfo}
                                     goto exit_label;
-{$endif UseTokenInfo}
                                   end;
                                  pattern:=pattern+'.';
                                  while c in ['0'..'9'] do
@@ -818,11 +780,7 @@ unit scanner;
                                     readchar;
                                   end;
                                  yylex:=REALNUMBER;
-{$ifndef UseTokenInfo}
-                                 exit;
-{$else UseTokenInfo}
                                  goto exit_label;
-{$endif UseTokenInfo}
                                end;
                      'e','E' : begin
                                  pattern:=pattern+'E';
@@ -840,46 +798,26 @@ unit scanner;
                                     readchar;
                                   end;
                                  yylex:=REALNUMBER;
-{$ifndef UseTokenInfo}
-                                 exit;
-{$else UseTokenInfo}
                                  goto exit_label;
-{$endif UseTokenInfo}
                                end;
                         end;
                         yylex:=INTCONST;
-{$ifndef UseTokenInfo}
-                        exit;
-{$else UseTokenInfo}
                         goto exit_label;
-{$endif UseTokenInfo}
                       end;
                 ';' : begin
                         readchar;
                         yylex:=SEMICOLON;
-{$ifndef UseTokenInfo}
-                        exit;
-{$else UseTokenInfo}
                         goto exit_label;
-{$endif UseTokenInfo}
                       end;
                 '[' : begin
                         readchar;
                         yylex:=LECKKLAMMER;
-{$ifndef UseTokenInfo}
-                        exit;
-{$else UseTokenInfo}
                         goto exit_label;
-{$endif UseTokenInfo}
                       end;
                 ']' : begin
                         readchar;
                         yylex:=RECKKLAMMER;
-{$ifndef UseTokenInfo}
-                        exit;
-{$else UseTokenInfo}
                         goto exit_label;
-{$endif UseTokenInfo}
                       end;
                 '(' : begin
                         readchar;
@@ -894,20 +832,12 @@ unit scanner;
                            exit;
                          end;
                         yylex:=LKLAMMER;
-{$ifndef UseTokenInfo}
-                        exit;
-{$else UseTokenInfo}
                         goto exit_label;
-{$endif UseTokenInfo}
                       end;
                 ')' : begin
                         readchar;
                         yylex:=RKLAMMER;
-{$ifndef UseTokenInfo}
-                        exit;
-{$else UseTokenInfo}
                         goto exit_label;
-{$endif UseTokenInfo}
                       end;
                 '+' : begin
                         readchar;
@@ -915,18 +845,10 @@ unit scanner;
                          begin
                            readchar;
                            yylex:=_PLUSASN;
-{$ifndef UseTokenInfo}
-                           exit;
-{$else UseTokenInfo}
                            goto exit_label;
-{$endif UseTokenInfo}
                          end;
                         yylex:=PLUS;
-{$ifndef UseTokenInfo}
-                        exit;
-{$else UseTokenInfo}
                         goto exit_label;
-{$endif UseTokenInfo}
                       end;
                 '-' : begin
                         readchar;
@@ -934,18 +856,10 @@ unit scanner;
                          begin
                            readchar;
                            yylex:=_MINUSASN;
-{$ifndef UseTokenInfo}
-                           exit;
-{$else UseTokenInfo}
                            goto exit_label;
-{$endif UseTokenInfo}
                          end;
                         yylex:=MINUS;
-{$ifndef UseTokenInfo}
-                        exit;
-{$else UseTokenInfo}
                         goto exit_label;
-{$endif UseTokenInfo}
                       end;
                 ':' : begin
                         readchar;
@@ -953,18 +867,10 @@ unit scanner;
                          begin
                            readchar;
                            yylex:=ASSIGNMENT;
-{$ifndef UseTokenInfo}
-                           exit;
-{$else UseTokenInfo}
                            goto exit_label;
-{$endif UseTokenInfo}
                          end;
                         yylex:=COLON;
-{$ifndef UseTokenInfo}
-                        exit;
-{$else UseTokenInfo}
                         goto exit_label;
-{$endif UseTokenInfo}
                       end;
                 '*' : begin
                         readchar;
@@ -979,11 +885,7 @@ unit scanner;
                          end
                         else
                           yylex:=STAR;
-{$ifndef UseTokenInfo}
-                        exit;
-{$else UseTokenInfo}
                         goto exit_label;
-{$endif UseTokenInfo}
                       end;
                 '/' : begin
                         readchar;
@@ -993,11 +895,7 @@ unit scanner;
                                   begin
                                     readchar;
                                     yylex:=_SLASHASN;
-{$ifndef UseTokenInfo}
-                                    exit;
-{$else UseTokenInfo}
                                     goto exit_label;
-{$endif UseTokenInfo}
                                   end;
                                end;
                          '/' : begin
@@ -1011,20 +909,12 @@ unit scanner;
                                end;
                         end;
                         yylex:=SLASH;
-{$ifndef UseTokenInfo}
-                        exit;
-{$else UseTokenInfo}
                         goto exit_label;
-{$endif UseTokenInfo}
                       end;
            '='      : begin
                         readchar;
                         yylex:=EQUAL;
-{$ifndef UseTokenInfo}
-                        exit;
-{$else UseTokenInfo}
                         goto exit_label;
-{$endif UseTokenInfo}
                       end;
            '.'      : begin
                         readchar;
@@ -1032,19 +922,11 @@ unit scanner;
                          begin
                            readchar;
                            yylex:=POINTPOINT;
-{$ifndef UseTokenInfo}
-                           exit;
-{$else UseTokenInfo}
                            goto exit_label;
-{$endif UseTokenInfo}
                          end
                         else
                          yylex:=POINT;
-{$ifndef UseTokenInfo}
-                        exit;
-{$else UseTokenInfo}
                         goto exit_label;
-{$endif UseTokenInfo}
                       end;
                 '@' : begin
                         readchar;
@@ -1055,20 +937,12 @@ unit scanner;
                          end
                         else
                          yylex:=KLAMMERAFFE;
-{$ifndef UseTokenInfo}
-                        exit;
-{$else UseTokenInfo}
                         goto exit_label;
-{$endif UseTokenInfo}
                       end;
                 ',' : begin
                         readchar;
                         yylex:=COMMA;
-{$ifndef UseTokenInfo}
-                        exit;
-{$else UseTokenInfo}
                         goto exit_label;
-{$endif UseTokenInfo}
                       end;
       '''','#','^' :  begin
                         if c='^' then
@@ -1084,11 +958,7 @@ unit scanner;
                            else
                             begin
                               yylex:=CARET;
-{$ifndef UseTokenInfo}
-                              exit;
-{$else UseTokenInfo}
                               goto exit_label;
-{$endif UseTokenInfo}
                             end;
                          end
                         else
@@ -1135,11 +1005,7 @@ unit scanner;
                          yylex:=CCHAR
                         else
                          yylex:=CSTRING;
-{$ifndef UseTokenInfo}
-                        exit;
-{$else UseTokenInfo}
                         goto exit_label;
-{$endif UseTokenInfo}
                       end;
                 '>' : begin
                         readchar;
@@ -1147,37 +1013,21 @@ unit scanner;
                          '=' : begin
                                  readchar;
                                  yylex:=GTE;
-{$ifndef UseTokenInfo}
-                                 exit;
-{$else UseTokenInfo}
                                  goto exit_label;
-{$endif UseTokenInfo}
                                end;
                          '>' : begin
                                  readchar;
                                  yylex:=_SHR;
-{$ifndef UseTokenInfo}
-                                 exit;
-{$else UseTokenInfo}
                                  goto exit_label;
-{$endif UseTokenInfo}
                                end;
                          '<' : begin { >< is for a symetric diff for sets }
                                  readchar;
                                  yylex:=SYMDIF;
-{$ifndef UseTokenInfo}
-                                 exit;
-{$else UseTokenInfo}
                                  goto exit_label;
-{$endif UseTokenInfo}
                                end;
                         end;
                         yylex:=GT;
-{$ifndef UseTokenInfo}
-                        exit;
-{$else UseTokenInfo}
                         goto exit_label;
-{$endif UseTokenInfo}
                       end;
                 '<' : begin
                         readchar;
@@ -1185,57 +1035,32 @@ unit scanner;
                          '>' : begin
                                  readchar;
                                  yylex:=UNEQUAL;
-{$ifndef UseTokenInfo}
-                                 exit;
-{$else UseTokenInfo}
                                  goto exit_label;
-{$endif UseTokenInfo}
                                end;
                          '=' : begin
                                  readchar;
                                  yylex:=LTE;
-{$ifndef UseTokenInfo}
-                                 exit;
-{$else UseTokenInfo}
                                  goto exit_label;
-{$endif UseTokenInfo}
                                end;
                          '<' : begin
                                  readchar;
                                  yylex:=_SHL;
-{$ifndef UseTokenInfo}
-                                 exit;
-{$else UseTokenInfo}
                                  goto exit_label;
-{$endif UseTokenInfo}
                                end;
                         end;
                         yylex:=LT;
-{$ifndef UseTokenInfo}
-                        exit;
-{$else UseTokenInfo}
                         goto exit_label;
-{$endif UseTokenInfo}
                       end;
                 #26 : begin
                         yylex:=_EOF;
-{$ifndef UseTokenInfo}
-                        exit;
-{$else UseTokenInfo}
                         goto exit_label;
-{$endif UseTokenInfo}
                       end;
            else
             begin
               Message(scan_f_illegal_char);
             end;
            end;
-{$ifdef UseTokenInfo}
-      exit_label:
-        tokenpos.fileindex:=fileindex;
-        tokenpos.line:=line;
-        tokenpos.column:=column;
-{$endif UseTokenInfo}
+       exit_label:
      end;
 
 
@@ -1248,6 +1073,9 @@ unit scanner;
           end
          else
           readchar;
+        tokenpos.line:=current_module^.current_inputfile^.line_no;
+        tokenpos.column:=get_current_col;
+        tokenpos.fileindex:=current_module^.current_index;
          case c of
           '{' : begin
                   skipcomment;
@@ -1326,7 +1154,8 @@ unit scanner;
         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;
+        if assigned(current_module^.current_inputfile) then
+          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; }
@@ -1389,7 +1218,17 @@ unit scanner;
 end.
 {
   $Log$
-  Revision 1.18  1998-05-12 10:47:00  peter
+  Revision 1.19  1998-05-20 09:42:37  pierre
+    + UseTokenInfo now default
+    * unit in interface uses and implementation uses gives error now
+    * only one error for unknown symbol (uses lastsymknown boolean)
+      the problem came from the label code !
+    + first inlined procedures and function work
+      (warning there might be allowed cases were the result is still wrong !!)
+    * UseBrower updated gives a global list of all position of all used symbols
+      with switch -gb
+
+  Revision 1.18  1998/05/12 10:47:00  peter
     * moved printstatus to verb_def
     + V_Normal which is between V_Error and V_Warning and doesn't have a
       prefix like error: warning: and is included in V_Default

compiler/tgeni386.pas

@@ -58,7 +58,12 @@ unit tgeni386;
     procedure setfirsttemp(l : longint);
     function gettempsize : longint;
     function gettempofsize(size : longint) : longint;
+    { special call for inlined procedures }
+    function gettempofsizepersistant(size : longint) : longint;
+    { for parameter func returns }
+    procedure persistanttemptonormal(pos : longint);
     procedure ungettemp(pos : longint;size : longint);
+    procedure ungetpersistanttemp(pos : longint;size : longint);
     procedure gettempofsizereference(l : longint;var ref : treference);
     function istemp(const ref : treference) : boolean;
     procedure ungetiftemp(const ref : treference);
@@ -321,6 +326,7 @@ unit tgeni386;
           next : pfreerecord;
           pos : longint;
           size : longint;
+          persistant : boolean; { used for inlined procedures }
 {$ifdef EXTDEBUG}
           line : longint;
 {$endif}
@@ -348,7 +354,7 @@ unit tgeni386;
            begin
 {$ifdef EXTDEBUG}
               Comment(V_Warning,'temporary assignment of size '
-                       +tostr(templist^.size)+' from '+tostr(templist^.line)+
+                       +tostr(templist^.size)+' from line '+tostr(templist^.line)+
                        +' at pos '+tostr(templist^.pos)+
                        ' not freed at the end of the procedure');
 {$endif}
@@ -378,12 +384,14 @@ unit tgeni386;
     function gettempofsize(size : longint) : longint;
 
       var
-         last,hp : pfreerecord;
+         tl,last,hp : pfreerecord;
+         ofs : longint;
 
       begin
          { this code comes from the heap management of FPC ... }
          if (size mod 4)<>0 then
            size:=size+(4-(size mod 4));
+           ofs:=0;
            if assigned(tmpfreelist) then
              begin
                 last:=nil;
@@ -393,7 +401,7 @@ unit tgeni386;
                      { first fit }
                      if hp^.size>=size then
                        begin
-                          gettempofsize:=hp^.pos;
+                          ofs:=hp^.pos;
                           if hp^.pos-size < maxtemp then
                             maxtemp := hp^.size-size;
                           { the whole block is needed ? }
@@ -410,17 +418,45 @@ unit tgeni386;
                                  tmpfreelist:=nil;
                                dispose(hp);
                             end;
-                          exit;
+                          break;
                        end;
                      last:=hp;
                      hp:=hp^.next;
                   end;
              end;
           { nothing free is big enough : expand temp }
-          gettempofsize:=lastoccupied-size;
-          lastoccupied:=lastoccupied-size;
-          if lastoccupied < maxtemp then
-            maxtemp := lastoccupied;
+          if ofs=0 then
+            begin
+              ofs:=lastoccupied-size;
+              lastoccupied:=lastoccupied-size;
+              if lastoccupied < maxtemp then
+                maxtemp := lastoccupied;
+            end;
+         new(tl);
+         tl^.pos:=ofs;
+         tl^.size:=size;
+         tl^.next:=templist;
+         tl^.persistant:=false;
+         templist:=tl;
+{$ifdef EXTDEBUG}
+         tl^.line:=current_module^.current_inputfile^.line_no;
+{$endif}
+         gettempofsize:=ofs;
+      end;
+
+    function gettempofsizepersistant(size : longint) : longint;
+
+      var
+         l : longint;
+
+      begin
+         l:=gettempofsize(size);
+         templist^.persistant:=true;
+{$ifdef EXTDEBUG}
+         Comment(V_Debug,'temp managment  : call to gettempofsizepersistant()'+
+                     ' with size '+tostr(size)+' returned '+tostr(l));
+{$endif}
+         gettempofsizepersistant:=l;
       end;
 
     function gettempsize : longint;
@@ -434,29 +470,77 @@ unit tgeni386;
 
     procedure gettempofsizereference(l : longint;var ref : treference);
 
-      var
-         tl : pfreerecord;
-
       begin
          { do a reset, because the reference isn't used }
          reset_reference(ref);
          ref.offset:=gettempofsize(l);
          ref.base:=procinfo.framepointer;
-         new(tl);
-         tl^.pos:=ref.offset;
-         tl^.size:=l;
-         tl^.next:=templist;
-         templist:=tl;
-{$ifdef EXTDEBUG}
-         tl^.line:=current_module^.current_inputfile^.line_no;
-{$endif}
       end;
 
     function istemp(const ref : treference) : boolean;
 
       begin
+         { ref.index = R_NO was missing
+           led to problems with local arrays
+           with lower bound > 0 (PM) }
          istemp:=((ref.base=procinfo.framepointer) and
-           (ref.offset<firsttemp));
+           (ref.offset<firsttemp) and (ref.index=R_NO));
+      end;
+
+    procedure persistanttemptonormal(pos : longint);
+
+      var hp : pfreerecord;
+
+      begin
+         hp:=templist;
+         while assigned(hp) do
+           if (hp^.persistant) and (hp^.pos=pos) then
+             begin
+{$ifdef EXTDEBUG}
+                   Comment(V_Debug,'temp managment : persistanttemptonormal()'+
+                     ' at pos '+tostr(pos)+ ' found !');
+{$endif}
+                hp^.persistant:=false;
+                exit;
+             end
+           else
+             hp:=hp^.next;
+{$ifdef EXTDEBUG}
+                   Comment(V_Debug,'temp managment problem : persistanttemptonormal()'+
+                     ' at pos '+tostr(pos)+ ' not found !');
+{$endif}
+      end;
+      
+    procedure ungetpersistanttemp(pos : longint;size : longint);
+      var
+         prev,hp : pfreerecord;
+
+      begin
+         ungettemp(pos,size);
+         prev:=nil;
+         hp:=templist;
+         while assigned(hp) do
+           begin
+              if (hp^.persistant) and (hp^.pos=pos) and (hp^.size=size) then
+                begin
+                   if assigned(prev) then
+                     prev^.next:=hp^.next
+                   else
+                     templist:=hp^.next;
+{$ifdef EXTDEBUG}
+                   Comment(V_Debug,'temp managment  : ungetpersistanttemp()'+
+                     ' at pos '+tostr(pos)+ ' found !');
+{$endif}
+                   dispose(hp);
+                   exit;
+                end;
+              prev:=hp;
+              hp:=hp^.next;
+           end;
+{$ifdef EXTDEBUG}
+       Comment(V_Warning,'temp managment problem : ungetpersistanttemp()'+
+                ' at pos '+tostr(pos)+ ' not found !');
+{$endif}
       end;
 
     procedure ungettemp(pos : longint;size : longint);
@@ -469,6 +553,7 @@ unit tgeni386;
            size:=size+(4-(size mod 4));
          if size = 0 then
            exit;
+
          if pos<=lastoccupied then
            if pos=lastoccupied then
              begin
@@ -493,7 +578,8 @@ unit tgeni386;
            else
              begin
 {$ifdef EXTDEBUG}
-              Comment(V_Warning,'temp managment problem : ungettemp() pos < lastoccupied !');
+              Comment(V_Warning,'temp managment problem : ungettemp()'+
+                'pos '+tostr(pos)+ '< lastoccupied '+tostr(lastoccupied)+' !');
 {$endif}
              end
          else
@@ -564,9 +650,24 @@ unit tgeni386;
               tl:=templist;
               while assigned(tl) do
                 begin
-                   if ref.offset=tl^.pos then
+                   { no release of persistant blocks this way!! }
+                   if tl^.persistant then
+                     if (ref.offset>=tl^.pos) and
+                        (ref.offset<tl^.pos+tl^.size) then
+                       begin
+{$ifdef EXTDEBUG}
+                          Comment(V_Debug,'temp '+
+                            ' at pos '+tostr(ref.offset)+ ' not released because persistant !');
+{$endif}
+                          exit;
+                       end;
+                   if (ref.offset=tl^.pos) then
                      begin
                         ungettemp(ref.offset,tl^.size);
+{$ifdef TEMPDEBUG}
+                   Comment(V_Debug,'temp managment  : ungettemp()'+
+                     ' at pos '+tostr(tl^.pos)+ ' found !');
+{$endif}
                         if assigned(prev) then
                           prev^.next:=tl^.next
                         else
@@ -598,7 +699,17 @@ begin
 end.
 {
   $Log$
-  Revision 1.5  1998-05-11 13:07:58  peter
+  Revision 1.6  1998-05-20 09:42:38  pierre
+    + UseTokenInfo now default
+    * unit in interface uses and implementation uses gives error now
+    * only one error for unknown symbol (uses lastsymknown boolean)
+      the problem came from the label code !
+    + first inlined procedures and function work
+      (warning there might be allowed cases were the result is still wrong !!)
+    * UseBrower updated gives a global list of all position of all used symbols
+      with switch -gb
+
+  Revision 1.5  1998/05/11 13:07:58  peter
     + $ifdef NEWPPU for the new ppuformat
     + $define GDB not longer required
     * removed all warnings and stripped some log comments

compiler/tree.pas

@@ -206,7 +206,7 @@ unit tree;
              calln : (symtableprocentry : pprocsym;
                       symtableproc : psymtable;procdefinition : pprocdef;
                       methodpointer : ptree;
-                      no_check,unit_specific : boolean);
+                      no_check,unit_specific,return_value_used : boolean);
              ordconstn : (value : longint);
              realconstn : (valued : bestreal;labnumber : longint;realtyp : tait);
              fixconstn : (valuef: longint);
@@ -224,7 +224,8 @@ unit tree;
 {$endif UseAnsiString}
              typeconvn : (convtyp : tconverttype;explizit : boolean);
              inlinen : (inlinenumber : longint);
-             procinlinen : (inlineprocdef : pprocdef);
+             procinlinen : (inlineprocdef : pprocdef;
+                            retoffset,para_offset,para_size : longint);
              setconstrn : (constset : pconstset);
              loopn : (t1,t2 : ptree;backward : boolean);
              asmn : (p_asm : paasmoutput);
@@ -283,7 +284,7 @@ unit tree;
     procedure set_current_file_line(_to : ptree);
     procedure set_tree_filepos(p : ptree;const filepos : tfileposinfo);
 {$ifdef extdebug}
-    procedure compare_trees(p1,p2 : ptree);
+    procedure compare_trees(oldp,p : ptree);
     const
        maxfirstpasscount : longint = 0;
 {$endif extdebug}
@@ -345,11 +346,7 @@ unit tree;
          hp^.error:=false;
 
          { we know also the position }
-{$ifdef UseTokenInfo}
          hp^.fileinfo:=tokenpos;
-{$else UseTokenInfo}
-         get_cur_file_pos(hp^.fileinfo);
-{$endif UseTokenInfo}
          hp^.pragmas:=aktswitches;
          getnode:=hp;
       end;
@@ -989,6 +986,7 @@ unit tree;
          p^.symtableproc:=st;
          p^.unit_specific:=false;
          p^.no_check:=false;
+         p^.return_value_used:=true;
          p^.disposetyp := dt_leftright;
          p^.methodpointer:=nil;
          p^.left:=nil;
@@ -1012,7 +1010,7 @@ unit tree;
          p^.registersmmx:=0;
 {$endif SUPPORT_MMX}
          p^.treetype:=calln;
-
+         p^.return_value_used:=true;
          p^.symtableprocentry:=v;
          p^.symtableproc:=st;
          p^.disposetyp:=dt_mbleft_and_method;
@@ -1142,6 +1140,9 @@ unit tree;
          p^.disposetyp:=dt_left;
          p^.treetype:=procinlinen;
          p^.inlineprocdef:=callp^.procdefinition;
+         p^.retoffset:=-4; { less dangerous as zero (PM) }
+         p^.para_offset:=0;
+         p^.para_size:=p^.inlineprocdef^.para_size;
          { copy args }
          p^.left:=getcopy(code);
          p^.registers32:=code^.registers32;
@@ -1175,110 +1176,117 @@ unit tree;
       end;
 
 {$ifdef extdebug}
-    procedure compare_trees(p1,p2 : ptree);
+    procedure compare_trees(oldp,p : ptree);
 
       var
          error_found : boolean;
 
       begin
-         if p1^.error<>p2^.error then
+          if oldp^.resulttype<>p^.resulttype then
+            begin
+               error_found:=true;
+               if is_equal(oldp^.resulttype,p^.resulttype) then
+                 comment(v_debug,'resulttype fields are different but equal')
+               else
+                 comment(v_warning,'resulttype fields are really different');
+            end;
+         if oldp^.treetype<>p^.treetype then
+           begin
+              comment(v_warning,'treetype field different');
+              error_found:=true;
+           end
+         else
+           comment(v_debug,' treetype '+tostr(longint(oldp^.treetype)));
+         if oldp^.error<>p^.error then
            begin
               comment(v_warning,'error field different');
               error_found:=true;
            end;
-         if p1^.disposetyp<>p2^.disposetyp then
+         if oldp^.disposetyp<>p^.disposetyp then
            begin
               comment(v_warning,'disposetyp field different');
               error_found:=true;
            end;
          { is true, if the right and left operand are swaped }
-         if p1^.swaped<>p2^.swaped then
+         if oldp^.swaped<>p^.swaped then
            begin
               comment(v_warning,'swaped field different');
               error_found:=true;
            end;
 
          { the location of the result of this node }
-         if p1^.location.loc<>p2^.location.loc then
+         if oldp^.location.loc<>p^.location.loc then
            begin
               comment(v_warning,'location.loc field different');
               error_found:=true;
            end;
 
           { the number of registers needed to evalute the node }
-          if p1^.registers32<>p2^.registers32 then
+          if oldp^.registers32<>p^.registers32 then
            begin
               comment(v_warning,'registers32 field different');
-              comment(v_warning,tostr(p1^.registers32)+'<>'+tostr(p2^.registers32));
+              comment(v_warning,' old '+tostr(oldp^.registers32)+'<> new '+tostr(p^.registers32));
               error_found:=true;
            end;
-          if p1^.registersfpu<>p2^.registersfpu then
+          if oldp^.registersfpu<>p^.registersfpu then
            begin
               comment(v_warning,'registersfpu field different');
               error_found:=true;
            end;
 {$ifdef SUPPORT_MMX}
-          if p1^.registersmmx<>p2^.registersmmx then
+          if oldp^.registersmmx<>p^.registersmmx then
            begin
               comment(v_warning,'registersmmx field different');
               error_found:=true;
            end;
 {$endif SUPPORT_MMX}
-          if p1^.left<>p2^.left then
+          if oldp^.left<>p^.left then
            begin
               comment(v_warning,'left field different');
               error_found:=true;
            end;
-          if p1^.right<>p2^.right then
+          if oldp^.right<>p^.right then
            begin
               comment(v_warning,'right field different');
               error_found:=true;
            end;
-          if p1^.resulttype<>p2^.resulttype then
-            begin
-               error_found:=true;
-               if is_equal(p1^.resulttype,p2^.resulttype) then
-                 comment(v_debug,'resulttype fields are different but equal')
-               else
-                 comment(v_warning,'resulttype fields are really different');
-            end;
-          if p1^.fileinfo.line<>p2^.fileinfo.line then
+          if oldp^.fileinfo.line<>p^.fileinfo.line then
             begin
                comment(v_warning,'fileinfo.line field different');
                error_found:=true;
             end;
-          if p1^.fileinfo.column<>p2^.fileinfo.column then
+          if oldp^.fileinfo.column<>p^.fileinfo.column then
             begin
                comment(v_warning,'fileinfo.column field different');
                error_found:=true;
             end;
-          if p1^.fileinfo.fileindex<>p2^.fileinfo.fileindex then
+          if oldp^.fileinfo.fileindex<>p^.fileinfo.fileindex then
             begin
                comment(v_warning,'fileinfo.fileindex field different');
                error_found:=true;
             end;
-          if p1^.pragmas<>p2^.pragmas then
+          if oldp^.pragmas<>p^.pragmas then
             begin
                comment(v_warning,'pragmas field different');
                error_found:=true;
             end;
 {$ifdef extdebug}
-          if p1^.firstpasscount<>p2^.firstpasscount then
+          if oldp^.firstpasscount<>p^.firstpasscount then
             begin
                comment(v_warning,'firstpasscount field different');
                error_found:=true;
             end;
 {$endif extdebug}
-          if p1^.treetype=p2^.treetype then
-          case p1^.treetype of
+          if oldp^.treetype=p^.treetype then
+          case oldp^.treetype of
              addn :
              begin
-                if p1^.use_strconcat<>p2^.use_strconcat then
+                if oldp^.use_strconcat<>p^.use_strconcat then
                   begin
                      comment(v_warning,'use_strconcat field different');
                      error_found:=true;
                   end;
-                if p1^.string_typ<>p2^.string_typ then
+                if oldp^.string_typ<>p^.string_typ then
                   begin
                      comment(v_warning,'stringtyp field different');
                      error_found:=true;
@@ -1287,12 +1295,12 @@ unit tree;
              callparan :
              {(is_colon_para : boolean;exact_match_found : boolean);}
              begin
-                if p1^.is_colon_para<>p2^.is_colon_para then
+                if oldp^.is_colon_para<>p^.is_colon_para then
                   begin
                      comment(v_warning,'use_strconcat field different');
                      error_found:=true;
                   end;
-                if p1^.exact_match_found<>p2^.exact_match_found then
+                if oldp^.exact_match_found<>p^.exact_match_found then
                   begin
                      comment(v_warning,'exact_match_found field different');
                      error_found:=true;
@@ -1301,12 +1309,12 @@ unit tree;
              assignn :
              {(assigntyp : tassigntyp;concat_string : boolean);}
              begin
-                if p1^.assigntyp<>p2^.assigntyp then
+                if oldp^.assigntyp<>p^.assigntyp then
                   begin
                      comment(v_warning,'assigntyp field different');
                      error_found:=true;
                   end;
-                if p1^.concat_string<>p2^.concat_string then
+                if oldp^.concat_string<>p^.concat_string then
                   begin
                      comment(v_warning,'concat_string field different');
                      error_found:=true;
@@ -1316,22 +1324,22 @@ unit tree;
              {(symtableentry : psym;symtable : psymtable;
                       is_absolute,is_first : boolean);}
              begin
-                if p1^.symtableentry<>p2^.symtableentry then
+                if oldp^.symtableentry<>p^.symtableentry then
                   begin
                      comment(v_warning,'symtableentry field different');
                      error_found:=true;
                   end;
-                if p1^.symtable<>p2^.symtable then
+                if oldp^.symtable<>p^.symtable then
                   begin
                      comment(v_warning,'symtable field different');
                      error_found:=true;
                   end;
-                if p1^.is_absolute<>p2^.is_absolute then
+                if oldp^.is_absolute<>p^.is_absolute then
                   begin
                      comment(v_warning,'is_absolute field different');
                      error_found:=true;
                   end;
-                if p1^.is_first<>p2^.is_first then
+                if oldp^.is_first<>p^.is_first then
                   begin
                      comment(v_warning,'is_first field different');
                      error_found:=true;
@@ -1343,32 +1351,32 @@ unit tree;
                       methodpointer : ptree;
                       no_check,unit_specific : boolean);}
              begin
-                if p1^.symtableprocentry<>p2^.symtableprocentry then
+                if oldp^.symtableprocentry<>p^.symtableprocentry then
                   begin
                      comment(v_warning,'symtableprocentry field different');
                      error_found:=true;
                   end;
-                if p1^.symtableproc<>p2^.symtableproc then
+                if oldp^.symtableproc<>p^.symtableproc then
                   begin
                      comment(v_warning,'symtableproc field different');
                      error_found:=true;
                   end;
-                if p1^.procdefinition<>p2^.procdefinition then
+                if oldp^.procdefinition<>p^.procdefinition then
                   begin
                      comment(v_warning,'procdefinition field different');
                      error_found:=true;
                   end;
-                if p1^.methodpointer<>p2^.methodpointer then
+                if oldp^.methodpointer<>p^.methodpointer then
                   begin
                      comment(v_warning,'methodpointer field different');
                      error_found:=true;
                   end;
-                if p1^.no_check<>p2^.no_check then
+                if oldp^.no_check<>p^.no_check then
                   begin
                      comment(v_warning,'no_check field different');
                      error_found:=true;
                   end;
-                if p1^.unit_specific<>p2^.unit_specific then
+                if oldp^.unit_specific<>p^.unit_specific then
                   begin
                      error_found:=true;
                      comment(v_warning,'unit_specific field different');
@@ -1376,7 +1384,7 @@ unit tree;
              end;
              ordconstn :
                begin
-                  if p1^.value<>p2^.value then
+                  if oldp^.value<>p^.value then
                   begin
                      comment(v_warning,'value field different');
                      error_found:=true;
@@ -1384,17 +1392,17 @@ unit tree;
                end;
              realconstn :
                begin
-                  if p1^.valued<>p2^.valued then
+                  if oldp^.valued<>p^.valued then
                   begin
                      comment(v_warning,'valued field different');
                      error_found:=true;
                   end;
-                  if p1^.labnumber<>p2^.labnumber then
+                  if oldp^.labnumber<>p^.labnumber then
                   begin
                      comment(v_warning,'labnumber field different');
                      error_found:=true;
                   end;
-                  if p1^.realtyp<>p2^.realtyp then
+                  if oldp^.realtyp<>p^.realtyp then
                   begin
                      comment(v_warning,'realtyp field different');
                      error_found:=true;
@@ -1527,7 +1535,17 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.9  1998-05-12 10:47:00  peter
+  Revision 1.10  1998-05-20 09:42:38  pierre
+    + UseTokenInfo now default
+    * unit in interface uses and implementation uses gives error now
+    * only one error for unknown symbol (uses lastsymknown boolean)
+      the problem came from the label code !
+    + first inlined procedures and function work
+      (warning there might be allowed cases were the result is still wrong !!)
+    * UseBrower updated gives a global list of all position of all used symbols
+      with switch -gb
+
+  Revision 1.9  1998/05/12 10:47:00  peter
     * moved printstatus to verb_def
     + V_Normal which is between V_Error and V_Warning and doesn't have a
       prefix like error: warning: and is included in V_Default