* More fixes for cross unit inlining, all tnodes are now implemented

  * Moved pocall_internconst to po_internconst because it is not a
    calling type at all and it conflicted when inlining of these small
    functions was requested

compiler/aasmbase.pas

@@ -184,6 +184,7 @@ interface
          function  newasmsymboltype(const s : string;_bind:TAsmSymBind;_typ:TAsmsymtype) : tasmsymbol;
          function  getasmsymbol(const s : string) : tasmsymbol;
          function  renameasmsymbol(const sold, snew : string):tasmsymbol;
+         function  newasmlabel(nr:longint;is_addr,is_data:boolean) : tasmlabel;
          {# create a new assembler label }
          procedure getlabel(var l : tasmlabel);
          { make l as a new label and flag is_addr }
@@ -665,9 +666,9 @@ implementation
          begin
            if not assigned(asmsymbolidx) then
              internalerror(200208072);
-           if longint(pointer(s))>=asmsymbolppuidx then
+           if (longint(pointer(s))<1) or (longint(pointer(s))>asmsymbolppuidx) then
              internalerror(200208073);
-           s:=asmsymbolidx^[longint(pointer(s))];
+           s:=asmsymbolidx^[longint(pointer(s))-1];
          end;
       end;
 
@@ -809,6 +810,21 @@ implementation
       end;
 
 
+    function  TAsmLibraryData.newasmlabel(nr:longint;is_addr,is_data:boolean) : tasmlabel;
+      var
+        hp : tasmlabel;
+      begin
+        if is_addr then
+         hp:=tasmlabel.createaddr(nr)
+        else if is_data then
+         hp:=tasmlabel.createdata(nr)
+        else
+         hp:=tasmlabel.create(nr);
+        symbolsearch.insert(hp);
+        newasmlabel:=hp;
+      end;
+
+
     procedure TAsmLibraryData.getlabel(var l : tasmlabel);
       begin
         l:=tasmlabel.create(nextlabelnr);
@@ -843,7 +859,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.7  2002-08-18 20:06:23  peter
+  Revision 1.8  2002-08-19 19:36:42  peter
+    * More fixes for cross unit inlining, all tnodes are now implemented
+    * Moved pocall_internconst to po_internconst because it is not a
+      calling type at all and it conflicted when inlining of these small
+      functions was requested
+
+  Revision 1.7  2002/08/18 20:06:23  peter
     * inlining is now also allowed in interface
     * renamed write/load to ppuwrite/ppuload
     * tnode storing in ppu

compiler/aasmtai.pas

@@ -467,7 +467,7 @@ uses
              internalerror(200208182);
            if not assigned(aiclass[t]) then
              internalerror(200208183);
-writeln('taiload: ',taitypestr[t]);
+           //writeln('taiload: ',taitypestr[t]);
            { generate tai of the correct class }
            ppuloadai:=aiclass[t].ppuload(t,ppufile);
          end
@@ -484,7 +484,7 @@ writeln('taiload: ',taitypestr[t]);
          begin
            { type, read by ppuloadnode }
            ppufile.putbyte(byte(n.typ));
-writeln('taiwrite: ',taitypestr[n.typ]);
+           //writeln('taiwrite: ',taitypestr[n.typ]);
            n.ppuwrite(ppufile);
          end
         else
@@ -513,11 +513,6 @@ writeln('taiwrite: ',taitypestr[n.typ]);
 
     procedure tai.ppuwrite(ppufile:tcompilerppufile);
       begin
-        { marker, read by tailoadnode }
-        ppufile.putbyte(pputaimarker);
-        { type, read by tailoadnode }
-        ppufile.putbyte(byte(typ));
-        { read by tai.ppuload }
         ppufile.putposinfo(fileinfo);
       end;
 
@@ -1036,7 +1031,6 @@ writeln('taiwrite: ',taitypestr[n.typ]);
       begin
         inherited ppuload(t,ppufile);
         l:=tasmlabel(ppufile.getasmsymbol);
-        l.is_set:=true;
         is_global:=boolean(ppufile.getbyte);
       end;
 
@@ -1052,6 +1046,7 @@ writeln('taiwrite: ',taitypestr[n.typ]);
     procedure tai_label.derefimpl;
       begin
         objectlibrary.DerefAsmsymbol(l);
+        l.is_set:=true;
       end;
 
 
@@ -1467,6 +1462,7 @@ writeln('taiwrite: ',taitypestr[n.typ]);
 {$ifdef i386}
         ppufile.putbyte(byte(segprefix));
 {$endif i386}
+        ppufile.putbyte(byte(is_jmp));
       end;
 
 
@@ -1552,7 +1548,13 @@ writeln('taiwrite: ',taitypestr[n.typ]);
 end.
 {
   $Log$
-  Revision 1.7  2002-08-18 20:06:23  peter
+  Revision 1.8  2002-08-19 19:36:42  peter
+    * More fixes for cross unit inlining, all tnodes are now implemented
+    * Moved pocall_internconst to po_internconst because it is not a
+      calling type at all and it conflicted when inlining of these small
+      functions was requested
+
+  Revision 1.7  2002/08/18 20:06:23  peter
     * inlining is now also allowed in interface
     * renamed write/load to ppuwrite/ppuload
     * tnode storing in ppu

compiler/fppu.pas

@@ -461,7 +461,7 @@ uses
     procedure tppumodule.putasmsymbol_in_idx(s:tnamedindexitem;arg:pointer);
       begin
         if tasmsymbol(s).ppuidx<>-1 then
-         librarydata.asmsymbolidx^[tasmsymbol(s).ppuidx]:=tasmsymbol(s);
+         librarydata.asmsymbolidx^[tasmsymbol(s).ppuidx-1]:=tasmsymbol(s);
       end;
 
 
@@ -469,9 +469,11 @@ uses
       var
         s : tasmsymbol;
         i : longint;
+        asmsymtype : byte;
       begin
         { get an ordered list of all symbols to put in the ppu }
         getmem(librarydata.asmsymbolidx,librarydata.asmsymbolppuidx*sizeof(pointer));
+        fillchar(librarydata.asmsymbolidx^,librarydata.asmsymbolppuidx*sizeof(pointer),0);
         librarydata.symbolsearch.foreach({$ifdef FPCPROCVAR}@{$endif}putasmsymbol_in_idx,nil);
         { write the number of symbols }
         ppufile.putlongint(librarydata.asmsymbolppuidx);
@@ -481,7 +483,23 @@ uses
            s:=librarydata.asmsymbolidx^[i-1];
            if not assigned(s) then
             internalerror(200208071);
-           ppufile.putstring(s.name);
+           asmsymtype:=1;
+           if s.Classtype=tasmlabel then
+            begin
+              if tasmlabel(s).is_addr then
+               asmsymtype:=4
+              else if tasmlabel(s).typ=AT_DATA then
+               asmsymtype:=3
+              else
+               asmsymtype:=2;
+            end;
+           ppufile.putbyte(asmsymtype);
+           case asmsymtype of
+             1 :
+               ppufile.putstring(s.name);
+             2 :
+               ppufile.putlongint(tasmlabel(s).labelnr);
+           end;
            ppufile.putbyte(byte(s.defbind));
            ppufile.putbyte(byte(s.typ));
          end;
@@ -670,21 +688,41 @@ uses
 
     procedure tppumodule.readasmsymbols;
       var
+        labelnr,
         i     : longint;
         name  : string;
         bind  : TAsmSymBind;
         typ   : TAsmSymType;
+        asmsymtype : byte;
       begin
         librarydata.asmsymbolppuidx:=ppufile.getlongint;
         if librarydata.asmsymbolppuidx>0 then
          begin
            getmem(librarydata.asmsymbolidx,librarydata.asmsymbolppuidx*sizeof(pointer));
+           fillchar(librarydata.asmsymbolidx^,librarydata.asmsymbolppuidx*sizeof(pointer),0);
            for i:=1 to librarydata.asmsymbolppuidx do
             begin
-              name:=ppufile.getstring;
+              asmsymtype:=ppufile.getbyte;
+              case asmsymtype of
+                1 :
+                  name:=ppufile.getstring;
+                2..4 :
+                  labelnr:=ppufile.getlongint;
+                else
+                  internalerror(200208192);
+              end;
               bind:=tasmsymbind(ppufile.getbyte);
               typ:=tasmsymtype(ppufile.getbyte);
-              librarydata.asmsymbolidx^[i-1]:=librarydata.newasmsymboltype(name,bind,typ);
+              case asmsymtype of
+                1 :
+                 librarydata.asmsymbolidx^[i-1]:=librarydata.newasmsymboltype(name,bind,typ);
+                2 :
+                 librarydata.asmsymbolidx^[i-1]:=librarydata.newasmlabel(labelnr,false,false);
+                3 :
+                 librarydata.asmsymbolidx^[i-1]:=librarydata.newasmlabel(labelnr,true,false);
+                4 :
+                 librarydata.asmsymbolidx^[i-1]:=librarydata.newasmlabel(labelnr,false,true);
+              end;
             end;
          end;
       end;
@@ -740,6 +778,7 @@ uses
     procedure tppumodule.load_implementation;
       var
         b : byte;
+        oldobjectlibrary : tasmlibrarydata;
       begin
          { read implementation part }
          repeat
@@ -755,9 +794,12 @@ uses
          until false;
 
          { we can now derefence all pointers to the implementation parts }
+         oldobjectlibrary:=objectlibrary;
+         objectlibrary:=librarydata;
          tstoredsymtable(globalsymtable).derefimpl;
          if assigned(localsymtable) then
            tstoredsymtable(localsymtable).derefimpl;
+         objectlibrary:=oldobjectlibrary;
       end;
 
 
@@ -1275,7 +1317,13 @@ uses
 end.
 {
   $Log$
-  Revision 1.22  2002-08-18 19:58:28  peter
+  Revision 1.23  2002-08-19 19:36:42  peter
+    * More fixes for cross unit inlining, all tnodes are now implemented
+    * Moved pocall_internconst to po_internconst because it is not a
+      calling type at all and it conflicted when inlining of these small
+      functions was requested
+
+  Revision 1.22  2002/08/18 19:58:28  peter
     * more current_scanner fixes
 
   Revision 1.21  2002/08/15 15:09:41  carl

compiler/globals.pas

@@ -1169,7 +1169,6 @@ implementation
          'FAR16',
          'FPCCALL',
          'INLINE',
-         '', { internconst }
          '', { internproc }
          '', { palmossyscall }
          'PASCAL',
@@ -1480,7 +1479,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.64  2002-08-12 15:08:39  carl
+  Revision 1.65  2002-08-19 19:36:42  peter
+    * More fixes for cross unit inlining, all tnodes are now implemented
+    * Moved pocall_internconst to po_internconst because it is not a
+      calling type at all and it conflicted when inlining of these small
+      functions was requested
+
+  Revision 1.64  2002/08/12 15:08:39  carl
     + stab register indexes for powerpc (moved from gdb to cpubase)
     + tprocessor enumeration moved to cpuinfo
     + linker in target_info is now a class

compiler/globtype.pas

@@ -134,7 +134,6 @@ interface
          pocall_far16,         { Far16 for OS/2 }
          pocall_fpccall,       { FPC default calling }
          pocall_inline,        { Procedure is an assembler macro }
-         pocall_internconst,   { procedure has constant evaluator intern }
          pocall_internproc,    { Procedure has compiler magic}
          pocall_palmossyscall, { procedure is a PalmOS system call }
          pocall_pascal,        { pascal standard left to right }
@@ -153,7 +152,6 @@ interface
            'Far16',
            'FPCCall',
            'Inline',
-           'InternConst',
            'InternProc',
            'PalmOSSysCall',
            'Pascal',
@@ -209,7 +207,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.30  2002-08-12 15:08:39  carl
+  Revision 1.31  2002-08-19 19:36:42  peter
+    * More fixes for cross unit inlining, all tnodes are now implemented
+    * Moved pocall_internconst to po_internconst because it is not a
+      calling type at all and it conflicted when inlining of these small
+      functions was requested
+
+  Revision 1.30  2002/08/12 15:08:39  carl
     + stab register indexes for powerpc (moved from gdb to cpubase)
     + tprocessor enumeration moved to cpuinfo
     + linker in target_info is now a class

compiler/ncal.pas

@@ -32,7 +32,7 @@ interface
        {$ifdef state_tracking}
        nstate,
        {$endif state_tracking}
-       symbase,symtype,symsym,symdef,symtable;
+       symbase,symtype,symppu,symsym,symdef,symtable;
 
     type
        tcallnode = class(tbinarynode)
@@ -62,6 +62,9 @@ interface
           constructor createinternres(const name: string; params: tnode; const res: ttype);
           constructor createinternreturn(const name: string; params: tnode; returnnode : tnode);
           destructor destroy;override;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure derefimpl;override;
           function  getcopy : tnode;override;
           procedure insertintolist(l : tnodelist);override;
           function  pass_1 : tnode;override;
@@ -89,6 +92,9 @@ interface
           { constructor                                             }
           constructor create(expr,next : tnode);virtual;
           destructor destroy;override;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure derefimpl;override;
           function getcopy : tnode;override;
           procedure insertintolist(l : tnodelist);override;
           procedure gen_high_tree(openstring:boolean);
@@ -107,9 +113,13 @@ interface
           inlinetree : tnode;
           inlineprocdef : tprocdef;
           retoffset,para_offset,para_size : longint;
-          constructor create(callp,code : tnode);virtual;
+          constructor create(p:tprocdef);virtual;
           destructor destroy;override;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure derefimpl;override;
           function getcopy : tnode;override;
+          function det_resulttype : tnode;override;
           procedure insertintolist(l : tnodelist);override;
           function pass_1 : tnode;override;
           function docompare(p: tnode): boolean; override;
@@ -240,6 +250,31 @@ implementation
          inherited destroy;
       end;
 
+
+    constructor tcallparanode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        ppufile.getsmallset(callparaflags);
+        hightree:=ppuloadnode(ppufile);
+      end;
+
+
+    procedure tcallparanode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putsmallset(callparaflags);
+        ppuwritenode(ppufile,hightree);
+      end;
+
+
+    procedure tcallparanode.derefimpl;
+      begin
+        inherited derefimpl;
+        if assigned(hightree) then
+          hightree.derefimpl;
+      end;
+
+
     function tcallparanode.getcopy : tnode;
 
       var
@@ -704,6 +739,43 @@ implementation
       end;
 
 
+    constructor tcallnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        symtableprocentry:=tprocsym(ppufile.getderef);
+{$warning FIXME: No withsymtable support}
+        symtableproc:=nil;
+        procdefinition:=tprocdef(ppufile.getderef);
+        restypeset:=boolean(ppufile.getbyte);
+        methodpointer:=ppuloadnode(ppufile);
+        funcretrefnode:=ppuloadnode(ppufile);
+      end;
+
+
+    procedure tcallnode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putderef(symtableprocentry);
+        ppufile.putderef(procdefinition);
+        ppufile.putbyte(byte(restypeset));
+        ppuwritenode(ppufile,methodpointer);
+        ppuwritenode(ppufile,funcretrefnode);
+      end;
+
+
+    procedure tcallnode.derefimpl;
+      begin
+        inherited derefimpl;
+        resolvesym(pointer(symtableprocentry));
+        symtableproc:=symtableprocentry.owner;
+        resolvedef(pointer(procdefinition));
+        if assigned(methodpointer) then
+          methodpointer.derefimpl;
+        if assigned(funcretrefnode) then
+          funcretrefnode.derefimpl;
+      end;
+
+
     procedure tcallnode.set_procvar(procvar:tnode);
       begin
         right:=procvar;
@@ -1470,7 +1542,7 @@ implementation
            end;
 
           { handle predefined procedures }
-          is_const:=(procdefinition.proccalloption=pocall_internconst) and
+          is_const:=(po_internconst in procdefinition.procoptions) and
                     ((block_type in [bt_const,bt_type]) or
                      (assigned(left) and (tcallparanode(left).left.nodetype in [realconstn,ordconstn])));
           if (procdefinition.proccalloption=pocall_internproc) or is_const then
@@ -1617,7 +1689,7 @@ implementation
                    if not assigned(right) then
                      begin
                         if assigned(tprocdef(procdefinition).code) then
-                          inlinecode:=cprocinlinenode.create(self,tnode(tprocdef(procdefinition).code))
+                          inlinecode:=cprocinlinenode.create(tprocdef(procdefinition))
                         else
                           CGMessage(cg_e_no_code_for_inline_stored);
                         if assigned(inlinecode) then
@@ -1830,28 +1902,22 @@ implementation
                             TPROCINLINENODE
  ****************************************************************************}
 
-    constructor tprocinlinenode.create(callp,code : tnode);
+    constructor tprocinlinenode.create(p:tprocdef);
 
       begin
          inherited create(procinlinen);
-         inlineprocdef:=tcallnode(callp).symtableprocentry.defs^.def;
+         inlineprocdef:=p;
          retoffset:=-POINTER_SIZE; { less dangerous as zero (PM) }
          para_offset:=0;
-         para_size:=inlineprocdef.para_size(target_info.alignment.paraalign);
-         if paramanager.ret_in_param(inlineprocdef.rettype.def) then
-           inc(para_size,POINTER_SIZE);
-         { copy args }
-         if assigned(code) then
-           inlinetree:=code.getcopy
-         else inlinetree := nil;
-         registers32:=code.registers32;
-         registersfpu:=code.registersfpu;
-{$ifdef SUPPORT_MMX}
-         registersmmx:=code.registersmmx;
-{$endif SUPPORT_MMX}
-         resulttype:=inlineprocdef.rettype;
+         para_size:=0;
+         { copy inlinetree }
+         if assigned(p.code) then
+           inlinetree:=p.code.getcopy
+         else
+           inlinetree:=nil;
       end;
 
+
     destructor tprocinlinenode.destroy;
       begin
         if assigned(inlinetree) then
@@ -1859,6 +1925,35 @@ implementation
         inherited destroy;
       end;
 
+
+    constructor tprocinlinenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        inlineprocdef:=tprocdef(ppufile.getderef);
+        inlinetree:=ppuloadnode(ppufile);
+        retoffset:=-POINTER_SIZE; { less dangerous as zero (PM) }
+        para_offset:=0;
+        para_size:=0;
+      end;
+
+
+    procedure tprocinlinenode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putderef(inlineprocdef);
+        ppuwritenode(ppufile,inlinetree);
+      end;
+
+
+    procedure tprocinlinenode.derefimpl;
+      begin
+        inherited derefimpl;
+        if assigned(inlinetree) then
+          inlinetree.derefimpl;
+        resolvedef(pointer(inlineprocdef));
+      end;
+
+
     function tprocinlinenode.getcopy : tnode;
 
       var
@@ -1866,11 +1961,11 @@ implementation
 
       begin
          n:=tprocinlinenode(inherited getcopy);
+         n.inlineprocdef:=inlineprocdef;
          if assigned(inlinetree) then
            n.inlinetree:=inlinetree.getcopy
          else
            n.inlinetree:=nil;
-         n.inlineprocdef:=inlineprocdef;
          n.retoffset:=retoffset;
          n.para_offset:=para_offset;
          n.para_size:=para_size;
@@ -1882,13 +1977,29 @@ implementation
       begin
       end;
 
+
+    function tprocinlinenode.det_resulttype : tnode;
+      begin
+         resulttype:=inlineprocdef.rettype;
+         { retrieve info from inlineprocdef }
+         retoffset:=-POINTER_SIZE; { less dangerous as zero (PM) }
+         para_offset:=0;
+         para_size:=inlineprocdef.para_size(target_info.alignment.paraalign);
+         if paramanager.ret_in_param(inlineprocdef.rettype.def) then
+           inc(para_size,POINTER_SIZE);
+         result:=nil;
+      end;
+
+
     function tprocinlinenode.pass_1 : tnode;
       begin
+        firstpass(inlinetree);
+        registers32:=inlinetree.registers32;
+        registersfpu:=inlinetree.registersfpu;
+{$ifdef SUPPORT_MMX}
+        registersmmx:=inlinetree.registersmmx;
+{$endif SUPPORT_MMX}
         result:=nil;
-        { left contains the code in tree form }
-        { but it has already been firstpassed }
-        { so firstpass(left); does not seem required }
-        { might be required later if we change the arg handling !! }
       end;
 
     function tprocinlinenode.docompare(p: tnode): boolean;
@@ -1906,7 +2017,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.86  2002-08-17 22:09:44  florian
+  Revision 1.87  2002-08-19 19:36:42  peter
+    * More fixes for cross unit inlining, all tnodes are now implemented
+    * Moved pocall_internconst to po_internconst because it is not a
+      calling type at all and it conflicted when inlining of these small
+      functions was requested
+
+  Revision 1.86  2002/08/17 22:09:44  florian
     * result type handling in tcgcal.pass_2 overhauled
     * better tnode.dowrite
     * some ppc stuff fixed

compiler/ncgcal.pas

@@ -1405,11 +1405,17 @@ implementation
           inlineexitcode:=TAAsmoutput.Create;
           ps:=para_size;
           make_global:=false; { to avoid warning }
+          aktfilepos.line:=0;
+          aktfilepos.column:=0;
+          aktfilepos.fileindex:=0;
           genentrycode(inlineentrycode,make_global,0,ps,nostackframe,true);
           if po_assembler in aktprocdef.procoptions then
             inlineentrycode.insert(Tai_marker.Create(asmblockstart));
           exprasmList.concatlist(inlineentrycode);
           secondpass(inlinetree);
+          aktfilepos.line:=0;
+          aktfilepos.column:=0;
+          aktfilepos.fileindex:=0;
           genexitcode(inlineexitcode,0,false,true);
           if po_assembler in aktprocdef.procoptions then
             inlineexitcode.concat(Tai_marker.Create(asmblockend));
@@ -1469,7 +1475,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.12  2002-08-18 20:06:23  peter
+  Revision 1.13  2002-08-19 19:36:42  peter
+    * More fixes for cross unit inlining, all tnodes are now implemented
+    * Moved pocall_internconst to po_internconst because it is not a
+      calling type at all and it conflicted when inlining of these small
+      functions was requested
+
+  Revision 1.12  2002/08/18 20:06:23  peter
     * inlining is now also allowed in interface
     * renamed write/load to ppuwrite/ppuload
     * tnode storing in ppu

compiler/ncgflw.pas

@@ -602,7 +602,7 @@ do_jmp:
 
        begin
          load_all_regvars(exprasmlist);
-         cg.a_jmp_always(exprasmlist,labelnr)
+         cg.a_jmp_always(exprasmlist,labsym.lab)
        end;
 
 
@@ -1225,7 +1225,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.36  2002-08-15 15:15:55  carl
+  Revision 1.37  2002-08-19 19:36:43  peter
+    * More fixes for cross unit inlining, all tnodes are now implemented
+    * Moved pocall_internconst to po_internconst because it is not a
+      calling type at all and it conflicted when inlining of these small
+      functions was requested
+
+  Revision 1.36  2002/08/15 15:15:55  carl
     * jmpbuf size allocation for exceptions is now cpu specific (as it should)
     * more generic nodes for maths
     * several fixes for better m68k support

compiler/ncnv.pas

@@ -28,7 +28,7 @@ interface
 
     uses
        node,
-       symtype,defbase,
+       symtype,symppu,defbase,
        nld;
 
     type
@@ -37,6 +37,9 @@ interface
           convtype : tconverttype;
           constructor create(node : tnode;const t : ttype);virtual;
           constructor create_explicit(node : tnode;const t : ttype);
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure derefimpl;override;
           function getcopy : tnode;override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
@@ -483,6 +486,29 @@ implementation
       end;
 
 
+    constructor ttypeconvnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        ppufile.gettype(totype);
+        convtype:=tconverttype(ppufile.getbyte);
+      end;
+
+
+    procedure ttypeconvnode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.puttype(totype);
+        ppufile.putbyte(byte(convtype));
+      end;
+
+
+    procedure ttypeconvnode.derefimpl;
+      begin
+        inherited derefimpl;
+        totype.resolve;
+      end;
+
+
     function ttypeconvnode.getcopy : tnode;
 
       var
@@ -1357,13 +1383,13 @@ implementation
     function ttypeconvnode.first_int_to_real: tnode;
       var
         fname: string[19];
-        typname : string[12];  
+        typname : string[12];
       begin
         { Get the type name  }
         {  Normally the typename should be one of the following:
             single, double - carl
-        }    
-        typname := lower(pbestrealtype^.def.gettypename);   
+        }
+        typname := lower(pbestrealtype^.def.gettypename);
         { converting a 64bit integer to a float requires a helper }
         if is_64bitint(left.resulttype.def) then
           begin
@@ -1939,7 +1965,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.70  2002-08-17 09:23:36  florian
+  Revision 1.71  2002-08-19 19:36:43  peter
+    * More fixes for cross unit inlining, all tnodes are now implemented
+    * Moved pocall_internconst to po_internconst because it is not a
+      calling type at all and it conflicted when inlining of these small
+      functions was requested
+
+  Revision 1.70  2002/08/17 09:23:36  florian
     * first part of procinfo rewrite
 
   Revision 1.69  2002/08/14 19:26:55  carl

compiler/nflw.pas

@@ -28,8 +28,9 @@ unit nflw;
 interface
 
     uses
-       node,aasmbase,aasmtai,aasmcpu,cpubase,
-       symbase,symdef,symsym;
+       node,cpubase,
+       aasmbase,aasmtai,aasmcpu,
+       symppu,symtype,symbase,symdef,symsym;
 
     type
        tloopnode = class(tbinarynode)
@@ -37,6 +38,9 @@ interface
           constructor create(tt : tnodetype;l,r,_t1,_t2 : tnode);virtual;
           destructor destroy;override;
           function getcopy : tnode;override;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure derefimpl;override;
           procedure insertintolist(l : tnodelist);override;
 {$ifdef extdebug}
           procedure _dowrite;override;
@@ -49,7 +53,7 @@ interface
           function det_resulttype:tnode;override;
           function pass_1 : tnode;override;
 {$ifdef state_tracking}
-	  function track_state_pass(exec_known:boolean):boolean;override;
+          function track_state_pass(exec_known:boolean):boolean;override;
 {$endif}
        end;
        twhilerepeatnodeclass = class of twhilerepeatnode;
@@ -90,10 +94,12 @@ interface
        tcontinuenodeclass = class of tcontinuenode;
 
        tgotonode = class(tnode)
-          labelnr : tasmlabel;
           labsym : tlabelsym;
           exceptionblock : integer;
           constructor create(p : tlabelsym);virtual;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure derefimpl;override;
           function getcopy : tnode;override;
           function det_resulttype:tnode;override;
           function pass_1 : tnode;override;
@@ -107,6 +113,9 @@ interface
           exceptionblock : integer;
           constructor createcase(p : tasmlabel;l:tnode);virtual;
           constructor create(p : tlabelsym;l:tnode);virtual;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure derefimpl;override;
           function getcopy : tnode;override;
           function det_resulttype:tnode;override;
           function pass_1 : tnode;override;
@@ -117,6 +126,9 @@ interface
        traisenode = class(tbinarynode)
           frametree : tnode;
           constructor create(l,taddr,tframe:tnode);virtual;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure derefimpl;override;
           function getcopy : tnode;override;
           procedure insertintolist(l : tnodelist);override;
           function det_resulttype:tnode;override;
@@ -144,6 +156,7 @@ interface
           excepttype : tobjectdef;
           constructor create(l,r:tnode);virtual;
           destructor destroy;override;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           function det_resulttype:tnode;override;
           function pass_1 : tnode;override;
           function getcopy : tnode;override;
@@ -199,12 +212,12 @@ implementation
          case t of
             ifn:
                p:=cifnode.create(l,r,n1);
-	    whilerepeatn:
-    	       if back then
-	          {Repeat until.}	
-        	  p:=cwhilerepeatnode.create(l,r,n1,false,true)
-	       else
-	          {While do.}
+            whilerepeatn:
+               if back then
+                  {Repeat until.}
+                  p:=cwhilerepeatnode.create(l,r,n1,false,true)
+               else
+                  {While do.}
                   p:=cwhilerepeatnode.create(l,r,n1,true,false);
             forn:
                p:=cfornode.create(l,r,n1,nil,back);
@@ -233,6 +246,33 @@ implementation
          inherited destroy;
       end;
 
+
+    constructor tloopnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        t1:=ppuloadnode(ppufile);
+        t2:=ppuloadnode(ppufile);
+      end;
+
+
+    procedure tloopnode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppuwritenode(ppufile,t1);
+        ppuwritenode(ppufile,t2);
+      end;
+
+
+    procedure tloopnode.derefimpl;
+      begin
+        inherited derefimpl;
+        if assigned(t1) then
+          t1.derefimpl;
+        if assigned(t2) then
+          t2.derefimpl;
+      end;
+
+
     function tloopnode.getcopy : tnode;
 
       var
@@ -281,11 +321,11 @@ implementation
     constructor Twhilerepeatnode.create(l,r,_t1:Tnode;tab,cn:boolean);
 
     begin
-	inherited create(whilerepeatn,l,r,_t1,nil);
-	if tab then
-	    include(flags,nf_testatbegin);
-	if cn then
-	    include(flags,nf_checknegate);
+        inherited create(whilerepeatn,l,r,_t1,nil);
+        if tab then
+            include(flags,nf_testatbegin);
+        if cn then
+            include(flags,nf_checknegate);
     end;
 
     function twhilerepeatnode.det_resulttype:tnode;
@@ -296,16 +336,16 @@ implementation
          resulttype:=voidtype;
 
          resulttypepass(left);
-	 {A not node can be removed.}
-	 if left.nodetype=notn then
-	    begin
-		t:=Tunarynode(left);
-		left:=Tunarynode(left).left;
-		t.left:=nil;
-		t.destroy;
-		{Symdif operator, in case you are wondering:}
-		flags:=flags >< [nf_checknegate];
-	    end;
+         {A not node can be removed.}
+         if left.nodetype=notn then
+            begin
+                t:=Tunarynode(left);
+                left:=Tunarynode(left).left;
+                t.left:=nil;
+                t.destroy;
+                {Symdif operator, in case you are wondering:}
+                flags:=flags >< [nf_checknegate];
+            end;
          { loop instruction }
          if assigned(right) then
            resulttypepass(right);
@@ -366,88 +406,88 @@ implementation
     function Twhilerepeatnode.track_state_pass(exec_known:boolean):boolean;
 
     var condition:Tnode;
-	code:Tnode;
-	done:boolean;
-	value:boolean;
-	change:boolean;
-	firsttest:boolean;
-	factval:Tnode;
+        code:Tnode;
+        done:boolean;
+        value:boolean;
+        change:boolean;
+        firsttest:boolean;
+        factval:Tnode;
 
     begin
-	track_state_pass:=false;
-	done:=false;
-	firsttest:=true;
-	{For repeat until statements, first do a pass through the code.}
-	if not(nf_testatbegin in flags) then
-	    begin
-		code:=right.getcopy;
-		if code.track_state_pass(exec_known) then
-		    track_state_pass:=true;
-		code.destroy;
-	    end;
-	repeat
-	    condition:=left.getcopy;
-	    code:=right.getcopy;
-	    change:=condition.track_state_pass(exec_known);
-	    factval:=aktstate.find_fact(left);
-	    if factval<>nil then
-		begin
-		    condition.destroy;
-		    condition:=factval.getcopy;
-		    change:=true;
-		end;
-	    if change then
-		begin
-		    track_state_pass:=true;
-		    {Force new resulttype pass.}
-		    condition.resulttype.def:=nil;
-		    do_resulttypepass(condition);
-		end;
-	    if is_constboolnode(condition) then
-		begin
-		    {Try to turn a while loop into a repeat loop.}
-		    if firsttest then
-			exclude(flags,testatbegin);
-		    value:=(Tordconstnode(condition).value<>0) xor checknegate;
-		    if value then
-			begin
-			    if code.track_state_pass(exec_known) then
-				track_state_pass:=true;
-			end
-		    else
-		        done:=true;
-		end
-	    else
-		begin
-		    {Remove any modified variables from the state.}
-		    code.track_state_pass(false);
-		    done:=true;
-		end;
-	    code.destroy;
-	    condition.destroy;
-	    firsttest:=false;
-	until done;
-	{The loop condition is also known, for example:
-	 while i<10 do
-	    begin
-	        ...
-	    end;
-	
-	 When the loop is done, we do know that i<10 = false.
-	}
-	condition:=left.getcopy;
+        track_state_pass:=false;
+        done:=false;
+        firsttest:=true;
+        {For repeat until statements, first do a pass through the code.}
+        if not(nf_testatbegin in flags) then
+            begin
+                code:=right.getcopy;
+                if code.track_state_pass(exec_known) then
+                    track_state_pass:=true;
+                code.destroy;
+            end;
+        repeat
+            condition:=left.getcopy;
+            code:=right.getcopy;
+            change:=condition.track_state_pass(exec_known);
+            factval:=aktstate.find_fact(left);
+            if factval<>nil then
+                begin
+                    condition.destroy;
+                    condition:=factval.getcopy;
+                    change:=true;
+                end;
+            if change then
+                begin
+                    track_state_pass:=true;
+                    {Force new resulttype pass.}
+                    condition.resulttype.def:=nil;
+                    do_resulttypepass(condition);
+                end;
+            if is_constboolnode(condition) then
+                begin
+                    {Try to turn a while loop into a repeat loop.}
+                    if firsttest then
+                        exclude(flags,testatbegin);
+                    value:=(Tordconstnode(condition).value<>0) xor checknegate;
+                    if value then
+                        begin
+                            if code.track_state_pass(exec_known) then
+                                track_state_pass:=true;
+                        end
+                    else
+                        done:=true;
+                end
+            else
+                begin
+                    {Remove any modified variables from the state.}
+                    code.track_state_pass(false);
+                    done:=true;
+                end;
+            code.destroy;
+            condition.destroy;
+            firsttest:=false;
+        until done;
+        {The loop condition is also known, for example:
+         while i<10 do
+            begin
+                ...
+            end;
+
+         When the loop is done, we do know that i<10 = false.
+        }
+        condition:=left.getcopy;
         if condition.track_state_pass(exec_known) then
-	    begin
-		track_state_pass:=true;
-		{Force new resulttype pass.}
-    		condition.resulttype.def:=nil;
-		do_resulttypepass(condition);
-	    end;
-	if not is_constboolnode(condition) then
-	    aktstate.store_fact(condition,
-	     cordconstnode.create(byte(checknegate),booltype))
-	else
-	    condition.destroy;
+            begin
+                track_state_pass:=true;
+                {Force new resulttype pass.}
+                condition.resulttype.def:=nil;
+                do_resulttypepass(condition);
+            end;
+        if not is_constboolnode(condition) then
+            aktstate.store_fact(condition,
+             cordconstnode.create(byte(checknegate),booltype))
+        else
+            condition.destroy;
     end;
 {$endif}
 
@@ -579,7 +619,7 @@ implementation
          inherited create(forn,l,r,_t1,_t2);
          if back then
            include(flags,nf_backward);
-	 include(flags,nf_testatbegin);
+         include(flags,nf_testatbegin);
       end;
 
 
@@ -590,20 +630,20 @@ implementation
          result:=nil;
          resulttype:=voidtype;
 
-											  											
+
          if left.nodetype<>assignn then
            begin
               CGMessage(cg_e_illegal_expression);
               exit;
            end;
 
-	 {Can we spare the first comparision?}
+         {Can we spare the first comparision?}
          if (right.nodetype=ordconstn) and (Tassignmentnode(left).right.nodetype=ordconstn) then
-    	    if not(((nf_backward in flags) and
+            if not(((nf_backward in flags) and
              (Tordconstnode(Tassignmentnode(left).right).value>=Tordconstnode(right).value))
              or (not(nf_backward in flags) and
              (Tordconstnode(Tassignmentnode(left).right).value<=Tordconstnode(right).value))) then
-	        exclude(flags,nf_testatbegin);
+                exclude(flags,nf_testatbegin);
 
          { save counter var }
          t2:=tassignmentnode(left).left.getcopy;
@@ -829,7 +869,29 @@ implementation
         inherited create(goton);
         exceptionblock:=aktexceptblock;
         labsym:=p;
-        labelnr:=p.lab;
+      end;
+
+
+    constructor tgotonode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        labsym:=tlabelsym(ppufile.getderef);
+        exceptionblock:=ppufile.getbyte;
+      end;
+
+
+    procedure tgotonode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putderef(labsym);
+        ppufile.putbyte(exceptionblock);
+      end;
+
+
+    procedure tgotonode.derefimpl;
+      begin
+        inherited derefimpl;
+        resolvesym(pointer(labsym));
       end;
 
 
@@ -860,7 +922,6 @@ implementation
         p : tgotonode;
      begin
         p:=tgotonode(inherited getcopy);
-        p.labelnr:=labelnr;
         p.labsym:=labsym;
         p.exceptionblock:=exceptionblock;
         result:=p;
@@ -898,6 +959,32 @@ implementation
       end;
 
 
+    constructor tlabelnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        labsym:=tlabelsym(ppufile.getderef);
+        labelnr:=tasmlabel(ppufile.getasmsymbol);
+        exceptionblock:=ppufile.getbyte;
+      end;
+
+
+    procedure tlabelnode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putderef(labsym);
+        ppufile.putasmsymbol(labelnr);
+        ppufile.putbyte(exceptionblock);
+      end;
+
+
+    procedure tlabelnode.derefimpl;
+      begin
+        inherited derefimpl;
+        resolvesym(pointer(labsym));
+        objectlibrary.derefasmsymbol(labelnr);
+      end;
+
+
     function tlabelnode.det_resulttype:tnode;
       begin
         result:=nil;
@@ -953,6 +1040,28 @@ implementation
       end;
 
 
+    constructor traisenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        frametree:=ppuloadnode(ppufile);
+      end;
+
+
+    procedure traisenode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppuwritenode(ppufile,frametree);
+      end;
+
+
+    procedure traisenode.derefimpl;
+      begin
+        inherited derefimpl;
+        if assigned(frametree) then
+          frametree.derefimpl;
+      end;
+
+
     function traisenode.getcopy : tnode;
       var
          n : traisenode;
@@ -1136,6 +1245,14 @@ implementation
       end;
 
 
+    constructor tonnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        exceptsymtable:=nil;
+        excepttype:=nil;
+      end;
+
+
     function tonnode.getcopy : tnode;
       var
          n : tonnode;
@@ -1244,7 +1361,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.46  2002-08-17 22:09:46  florian
+  Revision 1.47  2002-08-19 19:36:43  peter
+    * More fixes for cross unit inlining, all tnodes are now implemented
+    * Moved pocall_internconst to po_internconst because it is not a
+      calling type at all and it conflicted when inlining of these small
+      functions was requested
+
+  Revision 1.46  2002/08/17 22:09:46  florian
     * result type handling in tcgcal.pass_2 overhauled
     * better tnode.dowrite
     * some ppc stuff fixed

compiler/ninl.pas

@@ -27,7 +27,7 @@ unit ninl;
 interface
 
     uses
-       node,htypechk,cpuinfo;
+       node,htypechk,cpuinfo,symppu;
 
     {$i compinnr.inc}
 
@@ -35,6 +35,8 @@ interface
        tinlinenode = class(tunarynode)
           inlinenumber : byte;
           constructor create(number : byte;is_const:boolean;l : tnode);virtual;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
           function getcopy : tnode;override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
@@ -96,6 +98,20 @@ implementation
       end;
 
 
+    constructor tinlinenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        inlinenumber:=ppufile.getbyte;
+      end;
+
+
+    procedure tinlinenode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putbyte(inlinenumber);
+      end;
+
+
     function tinlinenode.getcopy : tnode;
       var
          n : tinlinenode;
@@ -2346,7 +2362,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.83  2002-08-02 07:44:31  jonas
+  Revision 1.84  2002-08-19 19:36:43  peter
+    * More fixes for cross unit inlining, all tnodes are now implemented
+    * Moved pocall_internconst to po_internconst because it is not a
+      calling type at all and it conflicted when inlining of these small
+      functions was requested
+
+  Revision 1.83  2002/08/02 07:44:31  jonas
     * made assigned() handling generic
     * add nodes now can also evaluate constant expressions at compile time
       that contain nil nodes

compiler/nld.pas

@@ -696,6 +696,7 @@ implementation
 
     procedure tfuncretnode.derefimpl;
       begin
+        inherited derefimpl;
         resolvesym(pointer(funcretsym));
       end;
 
@@ -996,6 +997,7 @@ implementation
 
     procedure ttypenode.derefimpl;
       begin
+        inherited derefimpl;
         restype.resolve;
       end;
 
@@ -1060,6 +1062,7 @@ implementation
 
     procedure trttinode.derefimpl;
       begin
+        inherited derefimpl;
         resolvedef(pointer(rttidef));
       end;
 
@@ -1117,7 +1120,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.52  2002-08-18 20:06:23  peter
+  Revision 1.53  2002-08-19 19:36:43  peter
+    * More fixes for cross unit inlining, all tnodes are now implemented
+    * Moved pocall_internconst to po_internconst because it is not a
+      calling type at all and it conflicted when inlining of these small
+      functions was requested
+
+  Revision 1.52  2002/08/18 20:06:23  peter
     * inlining is now also allowed in interface
     * renamed write/load to ppuwrite/ppuload
     * tnode storing in ppu

compiler/nmem.pas

@@ -28,7 +28,7 @@ interface
 
     uses
        node,
-       symtype,symdef,symsym,symtable,
+       symtype,symppu,symdef,symsym,symtable,
        cpubase;
 
     type
@@ -42,6 +42,9 @@ interface
        thnewnode = class(tnode)
           objtype : ttype;
           constructor create(t:ttype);virtual;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure derefimpl;override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
        end;
@@ -57,6 +60,10 @@ interface
        taddrnode = class(tunarynode)
           getprocvardef : tprocvardef;
           constructor create(l : tnode);virtual;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure derefimpl;override;
+          function getcopy : tnode;override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
        end;
@@ -79,6 +86,9 @@ interface
        tsubscriptnode = class(tunarynode)
           vs : tvarsym;
           constructor create(varsym : tsym;l : tnode);virtual;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure derefimpl;override;
           function getcopy : tnode;override;
           function pass_1 : tnode;override;
           function docompare(p: tnode): boolean; override;
@@ -96,6 +106,9 @@ interface
        tselfnode = class(tnode)
           classdef : tdef; { objectdef or classrefdef }
           constructor create(_class : tdef);virtual;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure derefimpl;override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
        end;
@@ -107,6 +120,8 @@ interface
           withreference : treference;
           constructor create(symtable : twithsymtable;l,r : tnode;count : longint);virtual;
           destructor destroy;override;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
           function getcopy : tnode;override;
           function pass_1 : tnode;override;
           function docompare(p: tnode): boolean; override;
@@ -173,6 +188,27 @@ implementation
       end;
 
 
+    constructor thnewnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        ppufile.gettype(objtype);
+      end;
+
+
+    procedure thnewnode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.puttype(objtype);
+      end;
+
+
+    procedure thnewnode.derefimpl;
+      begin
+        inherited derefimpl;
+        objtype.resolve;
+      end;
+
+
     function thnewnode.det_resulttype:tnode;
       begin
         result:=nil;
@@ -242,6 +278,40 @@ implementation
 
       begin
          inherited create(addrn,l);
+         getprocvardef:=nil;
+      end;
+
+
+    constructor taddrnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        getprocvardef:=tprocvardef(ppufile.getderef);
+      end;
+
+
+    procedure taddrnode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putderef(getprocvardef);
+      end;
+
+
+    procedure taddrnode.derefimpl;
+      begin
+        inherited derefimpl;
+        resolvedef(pointer(getprocvardef));
+      end;
+
+
+    function taddrnode.getcopy : tnode;
+
+      var
+         p : taddrnode;
+
+      begin
+         p:=taddrnode(inherited getcopy);
+         p.getprocvardef:=getprocvardef;
+         getcopy:=p;
       end;
 
 
@@ -528,6 +598,27 @@ implementation
          vs:=tvarsym(varsym);
       end;
 
+    constructor tsubscriptnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        vs:=tvarsym(ppufile.getderef);
+      end;
+
+
+    procedure tsubscriptnode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putderef(vs);
+      end;
+
+
+    procedure tsubscriptnode.derefimpl;
+      begin
+        inherited derefimpl;
+        resolvesym(pointer(vs));
+      end;
+
+
     function tsubscriptnode.getcopy : tnode;
 
       var
@@ -755,6 +846,27 @@ implementation
          classdef:=_class;
       end;
 
+    constructor tselfnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        classdef:=tdef(ppufile.getderef);
+      end;
+
+
+    procedure tselfnode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putderef(classdef);
+      end;
+
+
+    procedure tselfnode.derefimpl;
+      begin
+        inherited derefimpl;
+        resolvedef(pointer(classdef));
+      end;
+
+
     function tselfnode.det_resulttype:tnode;
       begin
         result:=nil;
@@ -807,6 +919,20 @@ implementation
       end;
 
 
+    constructor twithnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        internalerror(200208192);
+      end;
+
+
+    procedure twithnode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        internalerror(200208193);
+      end;
+
+
     function twithnode.getcopy : tnode;
 
       var
@@ -894,7 +1020,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.35  2002-07-23 09:51:23  daniel
+  Revision 1.36  2002-08-19 19:36:43  peter
+    * More fixes for cross unit inlining, all tnodes are now implemented
+    * Moved pocall_internconst to po_internconst because it is not a
+      calling type at all and it conflicted when inlining of these small
+      functions was requested
+
+  Revision 1.35  2002/07/23 09:51:23  daniel
   * Tried to make Tprocsym.defs protected. I didn't succeed but the cleanups
     are worth comitting.
 

compiler/node.pas

@@ -468,7 +468,7 @@ implementation
          begin
            if not assigned(nodeclass[t]) then
              internalerror(200208153);
-writeln('load: ',nodetype2str[t]);
+           //writeln('load: ',nodetype2str[t]);
            { generate node of the correct class }
            ppuloadnode:=nodeclass[t].ppuload(t,ppufile);
          end
@@ -485,7 +485,7 @@ writeln('load: ',nodetype2str[t]);
         if assigned(n) then
          begin
            ppufile.putbyte(byte(n.nodetype));
-writeln('write: ',nodetype2str[n.nodetype]);
+           //writeln('write: ',nodetype2str[n.nodetype]);
            n.ppuwrite(ppufile);
          end
         else
@@ -972,7 +972,13 @@ writeln('write: ',nodetype2str[n.nodetype]);
 end.
 {
   $Log$
-  Revision 1.37  2002-08-18 20:06:24  peter
+  Revision 1.38  2002-08-19 19:36:44  peter
+    * More fixes for cross unit inlining, all tnodes are now implemented
+    * Moved pocall_internconst to po_internconst because it is not a
+      calling type at all and it conflicted when inlining of these small
+      functions was requested
+
+  Revision 1.37  2002/08/18 20:06:24  peter
     * inlining is now also allowed in interface
     * renamed write/load to ppuwrite/ppuload
     * tnode storing in ppu

compiler/nset.pas

@@ -27,7 +27,9 @@ unit nset;
 interface
 
     uses
-       node,globals,aasmbase,aasmtai;
+       node,globals,
+       aasmbase,aasmtai,
+       symppu;
 
     type
       pcaserecord = ^tcaserecord;
@@ -75,6 +77,9 @@ interface
           elseblock : tnode;
           constructor create(l,r : tnode;n : pcaserecord);virtual;
           destructor destroy;override;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure derefimpl;override;
           function getcopy : tnode;override;
           procedure insertintolist(l : tnodelist);override;
           function det_resulttype:tnode;override;
@@ -198,22 +203,22 @@ implementation
                 pes:=tenumsym(tenumdef(psd.elementtype.def).firstenum);
                 while assigned(pes) do
                   begin
-		{$ifdef oldset}
-		    pcs^[pes.value div 8]:=pcs^[pes.value div 8] or (1 shl (pes.value mod 8));
-		{$else}
-		    include(pcs^,pes.value);
-		{$endif}
+                {$ifdef oldset}
+                    pcs^[pes.value div 8]:=pcs^[pes.value div 8] or (1 shl (pes.value mod 8));
+                {$else}
+                    include(pcs^,pes.value);
+                {$endif}
                     pes:=pes.nextenum;
                   end;
               end;
             orddef :
               begin
                 for i:=torddef(psd.elementtype.def).low to torddef(psd.elementtype.def).high do
-		{$ifdef oldset}
+                {$ifdef oldset}
                     pcs^[i div 8]:=pcs^[i div 8] or (1 shl (i mod 8));
-		{$else}
-		    include(pcs^,i);
-		{$endif}
+                {$else}
+                    include(pcs^,i);
+                {$endif}
               end;
           end;
           createsetconst:=pcs;
@@ -276,11 +281,11 @@ implementation
          { constant evaluation }
          if (left.nodetype=ordconstn) and (right.nodetype=setconstn) then
           begin
-	{$ifdef oldset}
-	    t:=cordconstnode.create(byte(tordconstnode(left).value in byteset(tsetconstnode(right).value_set^)),booltype);
-	{$else}
+        {$ifdef oldset}
+            t:=cordconstnode.create(byte(tordconstnode(left).value in byteset(tsetconstnode(right).value_set^)),booltype);
+        {$else}
             t:=cordconstnode.create(byte(tordconstnode(left).value in Tsetconstnode(right).value_set^),booltype);
-	{$endif}
+        {$endif}
             resulttypepass(t);
             result:=t;
             exit;
@@ -446,6 +451,65 @@ implementation
          copycaserecord:=n;
       end;
 
+
+    procedure ppuwritecaserecord(ppufile:tcompilerppufile;p : pcaserecord);
+      var
+        b : byte;
+      begin
+        ppufile.putexprint(p^._low);
+        ppufile.putexprint(p^._high);
+        ppufile.putasmsymbol(p^._at);
+        ppufile.putasmsymbol(p^.statement);
+        ppufile.putbyte(byte(p^.firstlabel));
+        b:=0;
+        if assigned(p^.greater) then
+         b:=b or 1;
+        if assigned(p^.less) then
+         b:=b or 2;
+        ppufile.putbyte(b);
+        if assigned(p^.greater) then
+          ppuwritecaserecord(ppufile,p^.greater);
+        if assigned(p^.less) then
+          ppuwritecaserecord(ppufile,p^.less);
+      end;
+
+
+    function ppuloadcaserecord(ppufile:tcompilerppufile):pcaserecord;
+      var
+        b : byte;
+        p : pcaserecord;
+      begin
+        new(p);
+        p^._low:=ppufile.getexprint;
+        p^._high:=ppufile.getexprint;
+        p^._at:=tasmlabel(ppufile.getasmsymbol);
+        p^.statement:=tasmlabel(ppufile.getasmsymbol);
+        p^.firstlabel:=boolean(ppufile.getbyte);
+        b:=ppufile.getbyte;
+        if (b and 1)=1 then
+         p^.greater:=ppuloadcaserecord(ppufile)
+        else
+         p^.greater:=nil;
+        if (b and 2)=2 then
+         p^.less:=ppuloadcaserecord(ppufile)
+        else
+         p^.less:=nil;
+        ppuloadcaserecord:=p;
+      end;
+
+
+    procedure ppuderefcaserecord(p : pcaserecord);
+      begin
+         objectlibrary.derefasmsymbol(p^._at);
+         objectlibrary.derefasmsymbol(p^.statement);
+         if assigned(p^.greater) then
+           ppuderefcaserecord(p^.greater);
+         if assigned(p^.less) then
+           ppuderefcaserecord(p^.less);
+      end;
+
+
+
 {*****************************************************************************
                               TCASENODE
 *****************************************************************************}
@@ -467,6 +531,31 @@ implementation
       end;
 
 
+    constructor tcasenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        elseblock:=ppuloadnode(ppufile);
+        nodes:=ppuloadcaserecord(ppufile);
+      end;
+
+
+    procedure tcasenode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppuwritenode(ppufile,elseblock);
+        ppuwritecaserecord(ppufile,nodes);
+      end;
+
+
+    procedure tcasenode.derefimpl;
+      begin
+        inherited derefimpl;
+        if assigned(elseblock) then
+          elseblock.derefimpl;
+        ppuderefcaserecord(nodes);
+      end;
+
+
     function tcasenode.det_resulttype : tnode;
       begin
         result:=nil;
@@ -559,7 +648,10 @@ implementation
            p.elseblock:=elseblock.getcopy
          else
            p.elseblock:=nil;
-         p.nodes:=copycaserecord(nodes);
+         if assigned(nodes) then
+           p.nodes:=copycaserecord(nodes)
+         else
+           p.nodes:=nil;
          getcopy:=p;
       end;
 
@@ -597,7 +689,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.31  2002-08-17 09:23:38  florian
+  Revision 1.32  2002-08-19 19:36:44  peter
+    * More fixes for cross unit inlining, all tnodes are now implemented
+    * Moved pocall_internconst to po_internconst because it is not a
+      calling type at all and it conflicted when inlining of these small
+      functions was requested
+
+  Revision 1.31  2002/08/17 09:23:38  florian
     * first part of procinfo rewrite
 
   Revision 1.30  2002/07/23 13:19:40  jonas

compiler/pass_2.pas

@@ -179,7 +179,14 @@ implementation
             curptree:=@p;
             p^.usableregs:=usablereg32;
 {$endif TEMPREGDEBUG}
-            aktfilepos:=p.fileinfo;
+            if inlining_procedure then
+             begin
+               aktfilepos.line:=0;
+               aktfilepos.column:=0;
+               aktfilepos.fileindex:=0;
+             end
+            else
+             aktfilepos:=p.fileinfo;
             aktlocalswitches:=p.localswitches;
             codegenerror:=false;
 {$ifdef EXTDEBUG}
@@ -330,7 +337,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.36  2002-08-18 20:06:24  peter
+  Revision 1.37  2002-08-19 19:36:44  peter
+    * More fixes for cross unit inlining, all tnodes are now implemented
+    * Moved pocall_internconst to po_internconst because it is not a
+      calling type at all and it conflicted when inlining of these small
+      functions was requested
+
+  Revision 1.36  2002/08/18 20:06:24  peter
     * inlining is now also allowed in interface
     * renamed write/load to ppuwrite/ppuload
     * tnode storing in ppu

compiler/pdecsub.pas

@@ -1114,8 +1114,8 @@ const
       idtok:_INTERNCONST;
       pd_flags : pd_implemen+pd_body+pd_notobjintf;
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_intern;
-      pocall   : pocall_internconst;
-      pooption : [];
+      pocall   : pocall_none;
+      pooption : [po_internconst];
       mutexclpocall : [];
       mutexclpotype : [potype_operator];
       mutexclpo     : []
@@ -1774,11 +1774,15 @@ const
                     end;
 
                    { internconst or internproc only need to be defined once }
-                   if (hd.proccalloption in [pocall_internconst,pocall_internproc]) then
+                   if (hd.proccalloption=pocall_internproc) then
                     aprocdef.proccalloption:=hd.proccalloption
                    else
-                    if (aprocdef.proccalloption in [pocall_internconst,pocall_internproc]) then
+                    if (aprocdef.proccalloption=pocall_internproc) then
                      hd.proccalloption:=aprocdef.proccalloption;
+                   if (po_internconst in hd.procoptions) then
+                    include(aprocdef.procoptions,po_internconst)
+                   else if (po_internconst in aprocdef.procoptions) then
+                    include(hd.procoptions,po_internconst);
 
                    { Check calling convention }
                    if (hd.proccalloption<>aprocdef.proccalloption) then
@@ -1957,7 +1961,13 @@ const
 end.
 {
   $Log$
-  Revision 1.65  2002-08-18 20:06:24  peter
+  Revision 1.66  2002-08-19 19:36:44  peter
+    * More fixes for cross unit inlining, all tnodes are now implemented
+    * Moved pocall_internconst to po_internconst because it is not a
+      calling type at all and it conflicted when inlining of these small
+      functions was requested
+
+  Revision 1.65  2002/08/18 20:06:24  peter
     * inlining is now also allowed in interface
     * renamed write/load to ppuwrite/ppuload
     * tnode storing in ppu

compiler/symconst.pas

@@ -191,7 +191,8 @@ type
     po_overload,          { procedure is declared with overload directive }
     po_varargs,           { printf like arguments }
     po_leftright,         { push arguments from left to right }
-    po_clearstack         { caller clears the stack }
+    po_clearstack,        { caller clears the stack }
+    po_internconst        { procedure has constant evaluator intern }
   );
   tprocoptions=set of tprocoption;
 
@@ -334,7 +335,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.33  2002-07-01 16:23:54  peter
+  Revision 1.34  2002-08-19 19:36:44  peter
+    * More fixes for cross unit inlining, all tnodes are now implemented
+    * Moved pocall_internconst to po_internconst because it is not a
+      calling type at all and it conflicted when inlining of these small
+      functions was requested
+
+  Revision 1.33  2002/07/01 16:23:54  peter
     * cg64 patch
     * basics for currency
     * asnode updates for class and interface (not finished)

compiler/utils/ppudump.pp

@@ -516,7 +516,6 @@ type
     pocall_far16,         { Far16 for OS/2 }
     pocall_fpccall,       { FPC default calling }
     pocall_inline,        { Procedure is an assembler macro }
-    pocall_internconst,   { procedure has constant evaluator intern }
     pocall_internproc,    { Procedure has compiler magic}
     pocall_palmossyscall, { procedure is a PalmOS system call }
     pocall_pascal,        { pascal standard left to right }
@@ -553,7 +552,10 @@ type
     po_savestdregs,       { save std regs cdecl and stdcall need that ! }
     po_saveregisters,     { save all registers }
     po_overload,          { procedure is declared with overload directive }
-    po_varargs            { printf like arguments }
+    po_varargs,           { printf like arguments }
+    po_leftright,         { push arguments from left to right }
+    po_clearstack,        { caller clears the stack }
+    po_internconst        { procedure has constant evaluator intern }
   );
   tprocoptions=set of tprocoption;
 function read_abstract_proc_def:tproccalloption;
@@ -578,7 +580,6 @@ const
      'Far16',
      'FPCCall',
      'Inline',
-     'InternConst',
      'InternProc',
      'PalmOSSysCall',
      'Pascal',
@@ -596,7 +597,7 @@ const
      (mask:potype_destructor;  str:'Destructor'),
      (mask:potype_operator;    str:'Operator')
   );
-  procopts=18;
+  procopts=21;
   procopt : array[1..procopts] of tprocopt=(
      (mask:po_classmethod;     str:'ClassMethod'),
      (mask:po_virtualmethod;   str:'VirtualMethod'),
@@ -615,7 +616,10 @@ const
      (mask:po_savestdregs;     str:'SaveStdRegs'),
      (mask:po_saveregisters;   str:'SaveRegisters'),
      (mask:po_overload;        str:'Overload'),
-     (mask:po_varargs;         str:'VarArgs')
+     (mask:po_varargs;         str:'VarArgs'),
+     (mask:po_leftright;       str:'LeftRight'),
+     (mask:po_clearstack;      str:'ClearStack'),
+     (mask:po_internconst;     str:'InternConst')
   );
   tvarspez : array[0..3] of string[5]=('Value','Const','Var  ','Out  ');
 var
@@ -1824,7 +1828,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.27  2002-08-15 15:15:56  carl
+  Revision 1.28  2002-08-19 19:36:44  peter
+    * More fixes for cross unit inlining, all tnodes are now implemented
+    * Moved pocall_internconst to po_internconst because it is not a
+      calling type at all and it conflicted when inlining of these small
+      functions was requested
+
+  Revision 1.27  2002/08/15 15:15:56  carl
     * jmpbuf size allocation for exceptions is now cpu specific (as it should)
     * more generic nodes for maths
     * several fixes for better m68k support