+ allow regvars to be used inside inlined procs, which required the

    following changes:
      + load regvars in genentrycode/free them in genexitcode (cgai386)
      * moved all regvar related code to new regvars unit
      + added pregvarinfo type to hcodegen
      + added regvarinfo field to tprocinfo (symdef/symdefh)
      * deallocate the regvars of the caller in secondprocinline before
        inlining the called procedure and reallocate them afterwards

compiler/cg386cal.pas

@@ -1376,7 +1376,8 @@ implementation
     procedure secondprocinline(var p : ptree);
        var st : psymtable;
            oldprocsym : pprocsym;
-           para_size : longint;
+           para_size, i : longint;
+           tmpreg: tregister;
            oldprocinfo : pprocinfo;
            oldinlining_procedure,
            nostackframe,make_global : boolean;
@@ -1389,6 +1390,19 @@ implementation
            mangled_length  : longint;
 {$endif GDB}
        begin
+          { deallocate the registers used for the current procedure's regvars }
+          if assigned(aktprocsym^.definition^.regvarinfo) then
+            with pregvarinfo(aktprocsym^.definition^.regvarinfo)^ do
+              for i := 1 to maxvarregs do
+                if assigned(regvars[i]) then
+                  begin
+                    case regsize(regvars[i]^.reg) of
+                      S_B: tmpreg := reg8toreg32(regvars[i]^.reg);
+                      S_W: tmpreg := reg16toreg32(regvars[i]^.reg);
+                      S_L: tmpreg := regvars[i]^.reg;
+                    end;
+                    exprasmlist^.concat(new(pairegalloc,dealloc(tmpreg)));
+                  end;
           oldinlining_procedure:=inlining_procedure;
           oldexitlabel:=aktexitlabel;
           oldexit2label:=aktexit2label;
@@ -1468,7 +1482,7 @@ implementation
           exprasmlist^.concat(new(pai_asm_comment,init(strpnew('End of inlined proc'))));
 {$endif extdebug}
           exprasmlist^.concat(new(Pai_Marker, Init(InlineEnd)));
-
+          
           {we can free the local data now, reset also the fixup address }
           if st^.datasize>0 then
             begin
@@ -1498,6 +1512,22 @@ implementation
           aktexit2label:=oldexit2label;
           quickexitlabel:=oldquickexitlabel;
           inlining_procedure:=oldinlining_procedure;
+
+          { reallocate the registers used for the current procedure's regvars, }
+          { since they may have been used and then deallocated in the inlined  }
+          { procedure (JM)                                                     }
+          if assigned(aktprocsym^.definition^.regvarinfo) then
+            with pregvarinfo(aktprocsym^.definition^.regvarinfo)^ do
+              for i := 1 to maxvarregs do
+                if assigned(regvars[i]) then
+                  begin
+                    case regsize(regvars[i]^.reg) of
+                      S_B: tmpreg := reg8toreg32(regvars[i]^.reg);
+                      S_W: tmpreg := reg16toreg32(regvars[i]^.reg);
+                      S_L: tmpreg := regvars[i]^.reg;
+                    end;
+                    exprasmlist^.concat(new(pairegalloc,alloc(tmpreg)));
+                  end;
        end;
 
 
@@ -1505,7 +1535,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.5  2000-07-27 13:03:35  jonas
+  Revision 1.6  2000-08-03 13:17:26  jonas
+    + allow regvars to be used inside inlined procs, which required  the
+      following changes:
+        + load regvars in genentrycode/free them in genexitcode (cgai386)
+        * moved all regvar related code to new regvars unit
+        + added pregvarinfo type to hcodegen
+        + added regvarinfo field to tprocinfo (symdef/symdefh)
+        * deallocate the regvars of the caller in secondprocinline before
+          inlining the called procedure and reallocate them afterwards
+
+  Revision 1.5  2000/07/27 13:03:35  jonas
     * release alignopts
 
   Revision 1.4  2000/07/21 15:14:01  jonas

compiler/cgai386.pas

@@ -164,7 +164,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 
     uses
        strings,globtype,systems,globals,verbose,files,types,pbase,
-       tgeni386,temp_gen,hcodegen,ppu
+       tgeni386,temp_gen,hcodegen,ppu,regvars
 {$ifdef GDB}
        ,gdb
 {$endif}
@@ -3543,6 +3543,8 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
           if not(cs_littlesize in aktglobalswitches) then
            exprasmlist^.insert(new(pai_align,init(16)));
        end;
+       if inlined then
+         load_regvars(exprasmlist,nil);
       exprasmlist:=oldexprasmlist;
   end;
 
@@ -3960,6 +3962,8 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
               freemem(p,2*mangled_length+50);
           end;
 {$endif GDB}
+       if inlined then
+         cleanup_regvars(exprasmlist);
       exprasmlist:=oldexprasmlist;
   end;
 
@@ -4025,7 +4029,17 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 end.
 {
   $Log$
-  Revision 1.6  2000-08-02 08:05:04  jonas
+  Revision 1.7  2000-08-03 13:17:25  jonas
+    + allow regvars to be used inside inlined procs, which required  the
+      following changes:
+        + load regvars in genentrycode/free them in genexitcode (cgai386)
+        * moved all regvar related code to new regvars unit
+        + added pregvarinfo type to hcodegen
+        + added regvarinfo field to tprocinfo (symdef/symdefh)
+        * deallocate the regvars of the caller in secondprocinline before
+          inlining the called procedure and reallocate them afterwards
+
+  Revision 1.6  2000/08/02 08:05:04  jonas
     * fixed web bug1087
     * allocate R_ECX explicitely if it's used
     (merged from fixes branch)

compiler/hcodegen.pas

@@ -110,6 +110,18 @@ implementation
           constructor init(const a : treference;p : pdef);
        end;
 
+       pregvarinfo = ^tregvarinfo;
+       tregvarinfo = record
+          regvars : array[1..maxvarregs] of pvarsym;
+          regvars_para : array[1..maxvarregs] of boolean;
+          regvars_refs : array[1..maxvarregs] of longint;
+
+          fpuregvars : array[1..maxfpuvarregs] of pvarsym;
+          fpuregvars_para : array[1..maxfpuvarregs] of boolean;
+          fpuregvars_refs : array[1..maxfpuvarregs] of longint;
+       end;
+
+
     var
        { info about the current sub routine }
        procinfo : pprocinfo;
@@ -450,7 +462,17 @@ end.
 
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:41  michael
+  Revision 1.3  2000-08-03 13:17:26  jonas
+    + allow regvars to be used inside inlined procs, which required  the
+      following changes:
+        + load regvars in genentrycode/free them in genexitcode (cgai386)
+        * moved all regvar related code to new regvars unit
+        + added pregvarinfo type to hcodegen
+        + added regvarinfo field to tprocinfo (symdef/symdefh)
+        * deallocate the regvars of the caller in secondprocinline before
+          inlining the called procedure and reallocate them afterwards
+
+  Revision 1.2  2000/07/13 11:32:41  michael
   + removed logs
 
 }

compiler/pass_2.pas

@@ -47,7 +47,7 @@ implementation
      globtype,systems,
      cobjects,comphook,verbose,globals,files,
      symconst,symtable,types,aasm,scanner,
-     pass_1,hcodegen,temp_gen,cpubase,cpuasm
+     pass_1,hcodegen,temp_gen,cpubase,cpuasm,regvars
 {$ifndef newcg}
      ,tcflw
 {$endif newcg}
@@ -460,90 +460,6 @@ implementation
          do_secondpass:=codegenerror;
       end;
 
-    var
-       { the array ranges are overestimated !!!  }
-       { max(maxvarregs,maxfpuvarregs) would be }
-       { enough                                 }
-       regvars : array[1..maxvarregs+maxfpuvarregs] of pvarsym;
-       regvars_para : array[1..maxvarregs+maxfpuvarregs] of boolean;
-       regvars_refs : array[1..maxvarregs+maxfpuvarregs] of longint;
-       parasym : boolean;
-
-    procedure searchregvars(p : pnamedindexobject);
-      var
-         i,j,k : longint;
-      begin
-         if (psym(p)^.typ=varsym) and (vo_regable in pvarsym(p)^.varoptions) then
-           begin
-              j:=pvarsym(p)^.refs;
-              { parameter get a less value }
-              if parasym then
-                begin
-                   if cs_littlesize in aktglobalswitches  then
-                     dec(j,1)
-                   else
-                     dec(j,100);
-                end;
-              { walk through all momentary register variables }
-              for i:=1 to maxvarregs do
-                begin
-                   if ((regvars[i]=nil) or (j>regvars_refs[i])) and (j>0) then
-                     begin
-                        for k:=maxvarregs-1 downto i do
-                          begin
-                             regvars[k+1]:=regvars[k];
-                             regvars_para[k+1]:=regvars_para[k];
-                             regvars_refs[k+1]:=regvars_refs[k];
-                          end;
-                        { calc the new refs
-                        pvarsym(p)^.refs:=j; }
-                        regvars[i]:=pvarsym(p);
-                        regvars_para[i]:=parasym;
-                        regvars_refs[i]:=j;
-                        break;
-                     end;
-                end;
-           end;
-      end;
-
-
-    procedure searchfpuregvars(p : pnamedindexobject);
-      var
-         i,j,k : longint;
-      begin
-         if (psym(p)^.typ=varsym) and (vo_fpuregable in pvarsym(p)^.varoptions) then
-           begin
-              j:=pvarsym(p)^.refs;
-              { parameter get a less value }
-              if parasym then
-                begin
-                   if cs_littlesize in aktglobalswitches  then
-                     dec(j,1)
-                   else
-                     dec(j,100);
-                end;
-              { walk through all momentary register variables }
-              for i:=1 to maxfpuvarregs do
-                begin
-                   if ((regvars[i]=nil) or (j>regvars_refs[i])) and (j>0) then
-                     begin
-                        for k:=maxfpuvarregs-1 downto i do
-                          begin
-                             regvars[k+1]:=regvars[k];
-                             regvars_para[k+1]:=regvars_para[k];
-                             regvars_refs[k+1]:=regvars_refs[k];
-                          end;
-                        { calc the new refs
-                        pvarsym(p)^.refs:=j; }
-                        regvars[i]:=pvarsym(p);
-                        regvars_para[i]:=parasym;
-                        regvars_refs[i]:=j;
-                        break;
-                     end;
-                end;
-           end;
-      end;
-
     procedure clearrefs(p : pnamedindexobject);
 
       begin
@@ -553,12 +469,6 @@ implementation
       end;
 
     procedure generatecode(var p : ptree);
-      var
-         i       : longint;
-         regsize : topsize;
-         hr      : preference;
-      label
-         nextreg;
       begin
          cleartempgen;
          flowcontrol:=[];
@@ -576,260 +486,53 @@ implementation
          symtablestack^.next^.foreach(@clearrefs);
          if not(do_firstpass(p)) then
            begin
-              { max. optimizations     }
-              { only if no asm is used }
-              { and no try statement   }
-              if (cs_regalloc in aktglobalswitches) and
-                ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) and
-                not(pocall_inline in aktprocsym^.definition^.proccalloptions) then
-                begin
-                   { can we omit the stack frame ? }
-                   { conditions:
-                     1. procedure (not main block)
-                     2. no constructor or destructor
-                     3. no call to other procedures
-                     4. no interrupt handler
-                   }
-                   {!!!!!! this doesn work yet, because of problems with
-                     with linux and windows
-                   }
-                   (*
-
-                   if assigned(aktprocsym) then
-                     begin
-                       if not(assigned(procinfo^._class)) and
-                          not(aktprocsym^.definition^.proctypeoption in [potype_constructor,potype_destructor]) and
-                          not(po_interrupt in aktprocsym^.definition^.procoptions) and
-                          ((procinfo^.flags and pi_do_call)=0) and
-                          (lexlevel>=normal_function_level) then
-                       begin
-                         { use ESP as frame pointer }
-                         procinfo^.framepointer:=stack_pointer;
-                         use_esp_stackframe:=true;
-
-                         { calc parameter distance new }
-                         dec(procinfo^.framepointer_offset,4);
-                         dec(procinfo^.selfpointer_offset,4);
-
-                         { is this correct ???}
-                         { retoffset can be negativ for results in eax !! }
-                         { the value should be decreased only if positive }
-                         if procinfo^.retoffset>=0 then
-                           dec(procinfo^.retoffset,4);
-
-                         dec(procinfo^.para_offset,4);
-                         aktprocsym^.definition^.parast^.address_fixup:=procinfo^.para_offset;
-                       end;
-                     end;
-                   *)
-                   if (p^.registers32<4) then
-                     begin
-                        for i:=1 to maxvarregs do
-                          regvars[i]:=nil;
-                        parasym:=false;
-                        symtablestack^.foreach({$ifndef TP}@{$endif}searchregvars);
-                        { copy parameter into a register ? }
-                        parasym:=true;
-                        symtablestack^.next^.foreach({$ifndef TP}@{$endif}searchregvars);
-                        { hold needed registers free }
-                        for i:=maxvarregs downto maxvarregs-p^.registers32+1 do
-                          regvars[i]:=nil;
-                        { now assign register }
-                        for i:=1 to maxvarregs-p^.registers32 do
-                          begin
-                             if assigned(regvars[i]) then
-                               begin
-                                  { it is nonsens, to copy the variable to }
-                                  { a register because we need then much   }
-                                  { too pushes ?                           }
-                                  if reg_pushes[varregs[i]]>=regvars[i]^.refs then
-                                    begin
-                                       regvars[i]:=nil;
-                                       goto nextreg;
-                                    end;
-
-                                  { register is no longer available for }
-                                  { expressions                  }
-                                  { search the register which is the most }
-                                  { unused                              }
-                                  usableregs:=usableregs-[varregs[i]];
-{$ifdef i386}
-                                  procinfo^.aktentrycode^.concat(new(pairegalloc,alloc(varregs[i])));
-{$endif i386}
-                                  is_reg_var[varregs[i]]:=true;
-                                  dec(c_usableregs);
-
-                                  { possibly no 32 bit register are needed }
-                                  { call by reference/const ? }
-                                  if (regvars[i]^.varspez=vs_var) or
-                                     ((regvars[i]^.varspez=vs_const) and
-                                       push_addr_param(regvars[i]^.vartype.def)) then
-                                    begin
-                                       regvars[i]^.reg:=varregs[i];
-                                       regsize:=S_L;
-                                    end
-                                  else
-                                   if (regvars[i]^.vartype.def^.deftype in [orddef,enumdef]) and
-                                      (porddef(regvars[i]^.vartype.def)^.size=1) then
-                                    begin
-{$ifdef i386}
-                                       regvars[i]^.reg:=reg32toreg8(varregs[i]);
-{$endif}
-                                       regsize:=S_B;
-                                    end
-                                  else
-                                   if (regvars[i]^.vartype.def^.deftype in [orddef,enumdef]) and
-                                      (porddef(regvars[i]^.vartype.def)^.size=2) then
-                                    begin
-{$ifdef i386}
-                                       regvars[i]^.reg:=reg32toreg16(varregs[i]);
-{$endif}
-                                       regsize:=S_W;
-                                    end
-                                  else
-                                    begin
-                                       regvars[i]^.reg:=varregs[i];
-                                       regsize:=S_L;
-                                    end;
-                                  { parameter must be load }
-                                  if regvars_para[i] then
-                                    begin
-                                       { procinfo is there actual,      }
-                                       { because we can't never be in a }
-                                       { nested procedure              }
-                                       { when loading parameter to reg  }
-                                       new(hr);
-                                       reset_reference(hr^);
-                                       hr^.offset:=pvarsym(regvars[i])^.address+procinfo^.para_offset;
-                                       hr^.base:=procinfo^.framepointer;
-{$ifdef i386}
-                                       procinfo^.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOV,regsize,
-                                         hr,regvars[i]^.reg)));
-{$endif i386}
-{$ifdef m68k}
-                                       procinfo^.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize,
-                                         hr,regvars[i]^.reg)));
-{$endif m68k}
-                                       unused:=unused - [regvars[i]^.reg];
-                                    end;
-                                  { procedure uses this register }
-{$ifdef i386}
-                                  usedinproc:=usedinproc or ($80 shr byte(varregs[i]));
-{$endif i386}
-{$ifdef m68k}
-                                  usedinproc:=usedinproc or ($800 shr word(varregs[i]));
-{$endif m68k}
-                               end;
-                             nextreg:
-                               { dummy }
-                               regsize:=S_W;
-                          end;
-                        for i:=1 to maxvarregs do
-                          begin
-                             if assigned(regvars[i]) then
-                               begin
-                                  if cs_asm_source in aktglobalswitches then
-                                    procinfo^.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(regvars[i]^.name+
-                                      ' with weight '+tostr(regvars[i]^.refs)+' assigned to register '+
-                                      reg2str(regvars[i]^.reg)))));
-                                  if (status.verbosity and v_debug)=v_debug then
-                                    Message3(cg_d_register_weight,reg2str(regvars[i]^.reg),
-                                      tostr(regvars[i]^.refs),regvars[i]^.name);
-                               end;
-                          end;
-                     end;
-                   if ((p^.registersfpu+1)<maxfpuvarregs) then
-                     begin
-                        for i:=1 to maxfpuvarregs do
-                          regvars[i]:=nil;
-                        parasym:=false;
-                        symtablestack^.foreach({$ifndef TP}@{$endif}searchfpuregvars);
-{$ifdef dummy}
-                        { copy parameter into a register ? }
-                        parasym:=true;
-                        symtablestack^.next^.foreach({$ifndef TP}@{$endif}searchregvars);
-{$endif dummy}
-                        { hold needed registers free }
-
-                        { in non leaf procedures we must be very careful }
-                        { with assigning registers                       }
-                        if aktmaxfpuregisters=-1 then
-                          begin
-                             if (procinfo^.flags and pi_do_call)<>0 then
-                               begin
-                                  for i:=maxfpuvarregs downto 2 do
-                                    regvars[i]:=nil;
-                               end
-                             else
-                               begin
-                                  for i:=maxfpuvarregs downto maxfpuvarregs-p^.registersfpu do
-                                    regvars[i]:=nil;
-                               end;
-                          end
-                        else
-                          begin
-                             for i:=aktmaxfpuregisters+1 to maxfpuvarregs do
-                                regvars[i]:=nil;
-                          end;
-                        { now assign register }
-                        for i:=1 to maxfpuvarregs do
-                          begin
-                             if assigned(regvars[i]) then
-                               begin
-{$ifdef i386}
-                                  { reserve place on the FPU stack }
-                                  regvars[i]^.reg:=correct_fpuregister(R_ST0,i-1);
-                                  procinfo^.aktentrycode^.concat(new(paicpu,op_none(A_FLDZ,S_NO)));
-                                  { ... and clean it up }
-                                  procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_FSTP,S_NO,R_ST0)));
-{$endif i386}
-{$ifdef m68k}
-                                  regvars[i]^.reg:=fpuvarregs[i];
-{$endif m68k}
-{$ifdef dummy}
-                                  { parameter must be load }
-                                  if regvars_para[i] then
-                                    begin
-                                       { procinfo is there actual,      }
-                                       { because we can't never be in a }
-                                       { nested procedure              }
-                                       { when loading parameter to reg  }
-                                       new(hr);
-                                       reset_reference(hr^);
-                                       hr^.offset:=pvarsym(regvars[i])^.address+procinfo^.para_offset;
-                                       hr^.base:=procinfo^.framepointer;
-{$ifdef i386}
-                                       procinfo^.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOV,regsize,
-                                         hr,regvars[i]^.reg)));
-{$endif i386}
-{$ifdef m68k}
-                                       procinfo^.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize,
-                                         hr,regvars[i]^.reg)));
-{$endif m68k}
-                                    end;
-{$endif dummy}
-                               end;
-                          end;
-                       if cs_asm_source in aktglobalswitches then
-                         procinfo^.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(tostr(p^.registersfpu)+
-                         ' registers on FPU stack used by temp. expressions'))));
-                        for i:=1 to maxfpuvarregs do
-                          begin
-                             if assigned(regvars[i]) then
-                               begin
-                                  if cs_asm_source in aktglobalswitches then
-                                    procinfo^.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(regvars[i]^.name+
-                                      ' with weight '+tostr(regvars[i]^.refs)+' assigned to register '+
-                                      reg2str(regvars[i]^.reg)))));
-                                  if (status.verbosity and v_debug)=v_debug then
-                                    Message3(cg_d_register_weight,reg2str(regvars[i]^.reg),
-                                      tostr(regvars[i]^.refs),regvars[i]^.name);
-                               end;
-                          end;
-                        if cs_asm_source in aktglobalswitches then
-                          procinfo^.aktentrycode^.insert(new(pai_asm_comment,init(strpnew('Register variable assignment:'))));
-                     end;
-                end;
+             if (cs_regalloc in aktglobalswitches) and
+                ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
+               begin
+			           { can we omit the stack frame ? }
+			           { conditions:
+			             1. procedure (not main block)
+			             2. no constructor or destructor
+			             3. no call to other procedures
+			             4. no interrupt handler
+			           }
+			           {!!!!!! this doesn work yet, because of problems with
+			              with linux and windows
+			           }
+			           (*
+			           if assigned(aktprocsym) then
+			             begin
+			               if not(assigned(procinfo^._class)) and
+			                  not(aktprocsym^.definition^.proctypeoption in [potype_constructor,potype_destructor]) and
+			                  not(po_interrupt in aktprocsym^.definition^.procoptions) and
+			                  ((procinfo^.flags and pi_do_call)=0) and
+			                  (lexlevel>=normal_function_level) then
+			                 begin
+			                  { use ESP as frame pointer }
+			                   procinfo^.framepointer:=stack_pointer;
+			                   use_esp_stackframe:=true;
+
+			                  { calc parameter distance new }
+			                   dec(procinfo^.framepointer_offset,4);
+			                   dec(procinfo^.selfpointer_offset,4);
+
+			                  { is this correct ???}
+			                  { retoffset can be negativ for results in eax !! }
+			                  { the value should be decreased only if positive }
+			                   if procinfo^.retoffset>=0 then
+			                     dec(procinfo^.retoffset,4);
+
+			                   dec(procinfo^.para_offset,4);
+			                   aktprocsym^.definition^.parast^.address_fixup:=procinfo^.para_offset;
+			                 end;
+			             end;
+			            *)
+			          end;
+              { process register variable stuff (JM) }
+              assign_regvars(p);
+              load_regvars(procinfo^.aktentrycode,p);
+              cleanup_regvars(procinfo^.aktexitcode);
+              
               if assigned(aktprocsym) and
                  (pocall_inline in aktprocsym^.definition^.proccalloptions) then
                 make_const_global:=true;
@@ -846,7 +549,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.4  2000-08-03 11:15:42  jonas
+  Revision 1.5  2000-08-03 13:17:25  jonas
+    + allow regvars to be used inside inlined procs, which required  the
+      following changes:
+        + load regvars in genentrycode/free them in genexitcode (cgai386)
+        * moved all regvar related code to new regvars unit
+        + added pregvarinfo type to hcodegen
+        + added regvarinfo field to tprocinfo (symdef/symdefh)
+        * deallocate the regvars of the caller in secondprocinline before
+          inlining the called procedure and reallocate them afterwards
+
+  Revision 1.4  2000/08/03 11:15:42  jonas
     - disable regvars for inlined procedures (merged from fixes branch)
 
   Revision 1.3  2000/07/21 15:14:02  jonas

compiler/regvars.pas

@@ -0,0 +1,423 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Florian Klaempfl and Jonas Maebe
+
+    This unit handles register variable allocation
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+{$ifdef TP}
+  {$E+,F+,N+}
+{$endif}
+
+unit regvars;
+
+interface
+
+uses aasm, tree;
+
+procedure assign_regvars(var p: ptree);
+procedure load_regvars(asml: paasmoutput; p: ptree);
+procedure cleanup_regvars(asml: paasmoutput);
+
+implementation
+
+   uses
+     globtype,systems,comphook,
+     cobjects,verbose,globals,
+     symconst,symtable,types,
+     hcodegen,temp_gen,cpubase,cpuasm
+{$ifndef newcg}
+     ,tcflw
+{$endif newcg}
+{$ifdef GDB}
+     ,gdb
+{$endif}
+{$ifdef i386}
+     ,tgeni386,cgai386
+
+{$endif}
+{$ifdef m68k}
+     ,tgen68k,cga68k
+{$endif}
+     ;
+
+     type
+       pregvarinfo = ^tregvarinfo;
+       tregvarinfo = record
+          regvars : array[1..maxvarregs] of pvarsym;
+          regvars_para : array[1..maxvarregs] of boolean;
+          regvars_refs : array[1..maxvarregs] of longint;
+
+          fpuregvars : array[1..maxfpuvarregs] of pvarsym;
+          fpuregvars_para : array[1..maxfpuvarregs] of boolean;
+          fpuregvars_refs : array[1..maxfpuvarregs] of longint;
+       end;
+
+
+    var
+      parasym : boolean;
+
+    procedure searchregvars(p : pnamedindexobject);
+      var
+         i,j,k : longint;
+      begin
+         if (psym(p)^.typ=varsym) and (vo_regable in pvarsym(p)^.varoptions) then
+           begin
+              j:=pvarsym(p)^.refs;
+              { parameter get a less value }
+              if parasym then
+                begin
+                   if cs_littlesize in aktglobalswitches  then
+                     dec(j,1)
+                   else
+                     dec(j,100);
+                end;
+              { walk through all momentary register variables }
+              for i:=1 to maxvarregs do
+                begin
+                  with pregvarinfo(aktprocsym^.definition^.regvarinfo)^ do
+                   if ((regvars[i]=nil) or (j>regvars_refs[i])) and (j>0) then
+                     begin
+                        for k:=maxvarregs-1 downto i do
+                          begin
+                             regvars[k+1]:=regvars[k];
+                             regvars_para[k+1]:=regvars_para[k];
+                             regvars_refs[k+1]:=regvars_refs[k];
+                          end;
+                        { calc the new refs
+                        pvarsym(p)^.refs:=j; }
+                        regvars[i]:=pvarsym(p);
+                        regvars_para[i]:=parasym;
+                        regvars_refs[i]:=j;
+                        break;
+                     end;
+                end;
+           end;
+      end;
+
+
+    procedure searchfpuregvars(p : pnamedindexobject);
+      var
+         i,j,k : longint;
+      begin
+         if (psym(p)^.typ=varsym) and (vo_fpuregable in pvarsym(p)^.varoptions) then
+           begin
+              j:=pvarsym(p)^.refs;
+              { parameter get a less value }
+              if parasym then
+                begin
+                   if cs_littlesize in aktglobalswitches  then
+                     dec(j,1)
+                   else
+                     dec(j,100);
+                end;
+              { walk through all momentary register variables }
+              for i:=1 to maxfpuvarregs do
+                begin
+                  with pregvarinfo(aktprocsym^.definition^.regvarinfo)^ do
+                   if ((fpuregvars[i]=nil) or (j>fpuregvars_refs[i])) and (j>0) then
+                     begin
+                        for k:=maxfpuvarregs-1 downto i do
+                          begin
+                             fpuregvars[k+1]:=fpuregvars[k];
+                             fpuregvars_para[k+1]:=fpuregvars_para[k];
+                             fpuregvars_refs[k+1]:=fpuregvars_refs[k];
+                          end;
+                        { calc the new refs
+                        pvarsym(p)^.refs:=j; }
+                        fpuregvars[i]:=pvarsym(p);
+                        fpuregvars_para[i]:=parasym;
+                        fpuregvars_refs[i]:=j;
+                        break;
+                     end;
+                end;
+           end;
+      end;
+
+    procedure assign_regvars(var p: ptree);
+          { register variables }
+    var
+      regvarinfo: pregvarinfo;
+      i: longint;
+    begin
+      { max. optimizations     }
+      { only if no asm is used }
+      { and no try statement   }
+      if (cs_regalloc in aktglobalswitches) and
+         ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
+        begin
+          new(regvarinfo);
+          fillchar(regvarinfo^,sizeof(regvarinfo^),0);
+          aktprocsym^.definition^.regvarinfo := regvarinfo;
+          if (p^.registers32<4) then
+            begin
+              parasym:=false;
+              symtablestack^.foreach({$ifndef TP}@{$endif}searchregvars);
+              { copy parameter into a register ? }
+              parasym:=true;
+              symtablestack^.next^.foreach({$ifndef TP}@{$endif}searchregvars);
+              { hold needed registers free }
+              for i:=maxvarregs downto maxvarregs-p^.registers32+1 do
+                begin
+                  regvarinfo^.regvars[i]:=nil;
+                  regvarinfo^.regvars_para[i] := false;
+                end;
+              { now assign register }
+              for i:=1 to maxvarregs-p^.registers32 do
+                begin
+                  if assigned(regvarinfo^.regvars[i]) and 
+                    (reg_pushes[varregs[i]] < regvarinfo^.regvars[i]^.refs) then
+                    begin
+                      { register is no longer available for }
+                      { expressions                          }
+                      { search the register which is the most }
+                      { unused                                        }
+                      usableregs:=usableregs-[varregs[i]];
+                      is_reg_var[varregs[i]]:=true;
+                      dec(c_usableregs);
+
+                      { possibly no 32 bit register are needed }
+                      { call by reference/const ? }
+                      if (regvarinfo^.regvars[i]^.varspez=vs_var) or
+                         ((regvarinfo^.regvars[i]^.varspez=vs_const) and
+                           push_addr_param(regvarinfo^.regvars[i]^.vartype.def)) then
+                        begin
+                           regvarinfo^.regvars[i]^.reg:=varregs[i];
+                        end
+                      else
+                       if (regvarinfo^.regvars[i]^.vartype.def^.deftype in [orddef,enumdef]) and
+                          (porddef(regvarinfo^.regvars[i]^.vartype.def)^.size=1) then
+                        begin
+{$ifdef i386}
+                          regvarinfo^.regvars[i]^.reg:=reg32toreg8(varregs[i]);
+{$endif}
+                        end
+                      else
+                       if (regvarinfo^.regvars[i]^.vartype.def^.deftype in [orddef,enumdef]) and
+                          (porddef(regvarinfo^.regvars[i]^.vartype.def)^.size=2) then
+                         begin
+{$ifdef i386}
+                           regvarinfo^.regvars[i]^.reg:=reg32toreg16(varregs[i]);
+{$endif}
+                         end
+                      else
+                        begin
+                          regvarinfo^.regvars[i]^.reg:=varregs[i];
+                        end;
+                      if regvarinfo^.regvars_para[i] then
+                        unused:=unused - [regvarinfo^.regvars[i]^.reg];
+                      { procedure uses this register }
+{$ifdef i386}
+                      usedinproc:=usedinproc or ($80 shr byte(varregs[i]));
+{$endif i386}
+{$ifdef m68k}
+                      usedinproc:=usedinproc or ($800 shr word(varregs[i]));
+{$endif m68k}
+                    end
+                  else
+                    begin
+                      regvarinfo^.regvars[i] := nil;
+                      regvarinfo^.regvars_para[i] := false;
+                    end;
+                end;
+            end;
+            if ((p^.registersfpu+1)<maxfpuvarregs) then
+              begin
+                parasym:=false;
+                symtablestack^.foreach({$ifndef TP}@{$endif}searchfpuregvars);
+{$ifdef dummy}
+                { copy parameter into a register ? }
+                parasym:=true;
+                symtablestack^.next^.foreach({$ifndef TP}@{$endif}searchregvars);
+{$endif dummy}
+                { hold needed registers free }
+
+                { in non leaf procedures we must be very careful }
+                { with assigning registers             }
+                if aktmaxfpuregisters=-1 then
+                  begin
+                   if (procinfo^.flags and pi_do_call)<>0 then
+                     begin
+                      for i:=maxfpuvarregs downto 2 do
+                      regvarinfo^.fpuregvars[i]:=nil;
+                     end
+                   else
+                     begin
+                      for i:=maxfpuvarregs downto maxfpuvarregs-p^.registersfpu do
+                        regvarinfo^.fpuregvars[i]:=nil;
+                     end;
+                  end
+                else
+                  begin
+                    for i:=aktmaxfpuregisters+1 to maxfpuvarregs do
+                      regvarinfo^.fpuregvars[i]:=nil;
+                  end;
+                { now assign register }
+                for i:=1 to maxfpuvarregs do
+                  begin
+                   if assigned(regvarinfo^.fpuregvars[i]) then
+                     begin
+{$ifdef i386}
+                       { reserve place on the FPU stack }
+                       regvarinfo^.fpuregvars[i]^.reg:=correct_fpuregister(R_ST0,i-1);
+{$endif i386}
+{$ifdef m68k}
+                       regvarinfo^.fpuregvars[i]^.reg:=fpuvarregs[i];
+{$endif m68k}
+                     end;
+                  end;
+              end;
+        end;
+    end;
+
+
+    procedure load_regvars(asml: paasmoutput; p: ptree);
+    var
+      i: longint;
+      hr      : preference;
+      regvarinfo: pregvarinfo;
+    begin
+      if (cs_regalloc in aktglobalswitches) and
+         ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
+        begin
+          regvarinfo := pregvarinfo(aktprocsym^.definition^.regvarinfo);
+          for i:=1 to maxvarregs do
+            begin
+              { parameter must be load }
+              if regvarinfo^.regvars_para[i] then
+                begin
+{$ifdef i386}
+                  asml^.concat(new(pairegalloc,alloc(varregs[i])));
+{$endif i386}
+                  { procinfo is there actual,    }
+                  { because we can't never be in a }
+                  { nested procedure        }
+                  { when loading parameter to reg  }
+                  new(hr);
+                  reset_reference(hr^);
+                  hr^.offset:=pvarsym(regvarinfo^.regvars[i])^.address+procinfo^.para_offset;
+                  hr^.base:=procinfo^.framepointer;
+{$ifdef i386}
+                  asml^.concat(new(paicpu,op_ref_reg(A_MOV,regsize(regvarinfo^.regvars[i]^.reg),
+                    hr,regvarinfo^.regvars[i]^.reg)));
+{$endif i386}
+{$ifdef m68k}
+                  asml^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize(regvarinfo^.regvars[i]^.reg),
+                    hr,regvarinfo^.regvars[i]^.reg)));
+{$endif m68k}
+                end;
+            end;
+          for i:=1 to maxvarregs do
+            begin
+             if assigned(regvarinfo^.regvars[i]) then
+               begin
+                if cs_asm_source in aktglobalswitches then
+                asml^.insert(new(pai_asm_comment,init(strpnew(regvarinfo^.regvars[i]^.name+
+                  ' with weight '+tostr(regvarinfo^.regvars[i]^.refs)+' assigned to register '+
+                  reg2str(regvarinfo^.regvars[i]^.reg)))));
+                if (status.verbosity and v_debug)=v_debug then
+                Message3(cg_d_register_weight,reg2str(regvarinfo^.regvars[i]^.reg),
+                  tostr(regvarinfo^.regvars[i]^.refs),regvarinfo^.regvars[i]^.name);
+               end;
+            end;
+          for i:=1 to maxfpuvarregs do
+            begin
+              if assigned(regvarinfo^.fpuregvars[i]) then
+                begin
+{$ifdef i386}
+                  { reserve place on the FPU stack }
+                  regvarinfo^.fpuregvars[i]^.reg:=correct_fpuregister(R_ST0,i-1);
+                  asml^.concat(new(paicpu,op_none(A_FLDZ,S_NO)));
+{$endif i386}
+{$ifdef dummy}
+                  { parameter must be load }
+                  if regvarinfo^.fpuregvars_para[i] then
+                    begin
+                      { procinfo is there actual,    }
+                      { because we can't never be in a }
+                      { nested procedure        }
+                      { when loading parameter to reg  }
+                      new(hr);
+                      reset_reference(hr^);
+                      hr^.offset:=pvarsym(regvarinfo^.regvars[i])^.address+procinfo^.para_offset;
+                      hr^.base:=procinfo^.framepointer;
+{$ifdef i386}
+                      asml^.concat(new(paicpu,op_ref_reg(A_MOV,regsize(regvarinfo^.regvars[i]^.reg),
+                        hr,regvarinfo^.regvars[i]^.reg)));
+{$endif i386}
+{$ifdef m68k}
+                      asml^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize(regvarinfo^.regvars[i]^.reg),
+                        hr,regvarinfo^.regvars[i]^.reg)));
+{$endif m68k}
+                    end;
+{$endif dummy}
+                end;
+            end;
+          if assigned(p) then
+            if cs_asm_source in aktglobalswitches then
+              asml^.insert(new(pai_asm_comment,init(strpnew(tostr(p^.registersfpu)+
+              ' registers on FPU stack used by temp. expressions'))));
+          for i:=1 to maxfpuvarregs do
+            begin
+               if assigned(regvarinfo^.fpuregvars[i]) then
+                 begin
+                    if cs_asm_source in aktglobalswitches then
+                      asml^.insert(new(pai_asm_comment,init(strpnew(regvarinfo^.fpuregvars[i]^.name+
+                        ' with weight '+tostr(regvarinfo^.fpuregvars[i]^.refs)+' assigned to register '+
+                        reg2str(regvarinfo^.fpuregvars[i]^.reg)))));
+                    if (status.verbosity and v_debug)=v_debug then
+                      Message3(cg_d_register_weight,reg2str(regvarinfo^.fpuregvars[i]^.reg),
+                        tostr(regvarinfo^.fpuregvars[i]^.refs),regvarinfo^.fpuregvars[i]^.name);
+                 end;
+            end;
+          if cs_asm_source in aktglobalswitches then
+            asml^.insert(new(pai_asm_comment,init(strpnew('Register variable assignment:'))));
+        end;
+    end;
+
+
+    procedure cleanup_regvars(asml: paasmoutput);
+    var
+      i: longint;
+    begin
+    {$ifdef i386}
+      if (cs_regalloc in aktglobalswitches) and
+         ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
+        with pregvarinfo(aktprocsym^.definition^.regvarinfo)^ do
+        for i:=1 to maxfpuvarregs do
+          if assigned(fpuregvars[i]) then
+            { ... and clean it up }
+            asml^.concat(new(paicpu,op_reg(A_FSTP,S_NO,R_ST0)));
+    {$endif i386}
+    end;
+
+end.
+
+{
+  $Log$
+  Revision 1.1  2000-08-03 13:17:25  jonas
+    + allow regvars to be used inside inlined procs, which required  the
+      following changes:
+        + load regvars in genentrycode/free them in genexitcode (cgai386)
+        * moved all regvar related code to new regvars unit
+        + added pregvarinfo type to hcodegen
+        + added regvarinfo field to tprocinfo (symdef/symdefh)
+        * deallocate the regvars of the caller in secondprocinline before
+          inlining the called procedure and reallocate them afterwards
+
+}

compiler/symdef.inc

@@ -2631,6 +2631,7 @@
          interfacedef:=false;
          _class := nil;
          code:=nil;
+         regvarinfo := nil;
          count:=false;
          is_used:=false;
       end;
@@ -2670,6 +2671,8 @@
          localst:=nil;
          forwarddef:=false;
          interfacedef:=false;
+         code := nil;
+         regvarinfo := nil;
          lastref:=nil;
          lastwritten:=nil;
          defref:=nil;
@@ -2849,6 +2852,8 @@ Const local_symtable_index : longint = $8001;
            dispose(localst,done);
          if (pocall_inline in proccalloptions) and assigned(code) then
            disposetree(ptree(code));
+         if assigned(regvarinfo) then
+           dispose(pregvarinfo(regvarinfo));
          if (po_msgstr in procoptions) then
            strdispose(messageinf.str);
          if
@@ -4188,7 +4193,17 @@ Const local_symtable_index : longint = $8001;
 
 {
   $Log$
-  Revision 1.4  2000-08-02 19:49:59  peter
+  Revision 1.5  2000-08-03 13:17:26  jonas
+    + allow regvars to be used inside inlined procs, which required  the
+      following changes:
+        + load regvars in genentrycode/free them in genexitcode (cgai386)
+        * moved all regvar related code to new regvars unit
+        + added pregvarinfo type to hcodegen
+        + added regvarinfo field to tprocinfo (symdef/symdefh)
+        * deallocate the regvars of the caller in secondprocinline before
+          inlining the called procedure and reallocate them afterwards
+
+  Revision 1.4  2000/08/02 19:49:59  peter
     * first things for default parameters
 
   Revision 1.3  2000/07/13 12:08:27  michael

compiler/symdefh.inc

@@ -415,6 +415,8 @@
           { it's a tree, but this not easy to handle }
           { used for inlined procs                   }
           code : pointer;
+          { info about register variables (JM) }
+          regvarinfo: pointer;
           { true, if the procedure is only declared }
           { (forward procedure) }
           forwarddef,
@@ -535,7 +537,17 @@
 
 {
   $Log$
-  Revision 1.4  2000-08-02 19:49:59  peter
+  Revision 1.5  2000-08-03 13:17:26  jonas
+    + allow regvars to be used inside inlined procs, which required  the
+      following changes:
+        + load regvars in genentrycode/free them in genexitcode (cgai386)
+        * moved all regvar related code to new regvars unit
+        + added pregvarinfo type to hcodegen
+        + added regvarinfo field to tprocinfo (symdef/symdefh)
+        * deallocate the regvars of the caller in secondprocinline before
+          inlining the called procedure and reallocate them afterwards
+
+  Revision 1.4  2000/08/02 19:49:59  peter
     * first things for default parameters
 
   Revision 1.3  2000/07/13 12:08:27  michael