Browse Source

* fixed C style array of const
* fixed C array passing
* fixed left to right with high parameters

peter 22 years ago
parent
commit
e248c0ece4
9 changed files with 123 additions and 107 deletions
  1. 13 3
      compiler/cgbase.pas
  2. 6 2
      compiler/cgobj.pas
  3. 9 4
      compiler/ncgcal.pas
  4. 8 2
      compiler/ncgmem.pas
  5. 37 30
      compiler/ncgutil.pas
  6. 9 8
      compiler/paramgr.pas
  7. 26 27
      compiler/pdecsub.pas
  8. 9 2
      compiler/psub.pas
  9. 6 29
      compiler/x86/cgx86.pas

+ 13 - 3
compiler/cgbase.pas

@@ -128,6 +128,10 @@ unit cgbase;
           }
           exception_result_ref :treference;
 
+          {# Holds the reference used to store the original stackpointer
+             after all registers are saved
+          }
+          save_stackptr_ref :treference;
           {# Holds the reference used to store alll saved registers.
 
              This is used on systems which do not have direct stack
@@ -397,6 +401,7 @@ implementation
         reference_reset(exception_env_ref);
         reference_reset(exception_jmp_ref);
         reference_reset(exception_result_ref);
+        reference_reset(save_stackptr_ref);
       end;
 
 
@@ -428,7 +433,7 @@ implementation
            begin
               if paramanager.ret_in_reg(procdef.rettype.def,procdef.proccalloption) then
                 begin
-(* already done in symtable.pas:tlocalsymtable.insertvardata() (JM) 
+(* already done in symtable.pas:tlocalsymtable.insertvardata() (JM)
                    { the space has been set in the local symtable }
                    procinfo.return_offset:=tg.direction*tfuncretsym(procdef.funcretsym).address;
 *)
@@ -443,7 +448,7 @@ implementation
       end;
 
 
-(* already done in symtable.pas:tlocalsymtable.insertvardata() (JM) 
+(* already done in symtable.pas:tlocalsymtable.insertvardata() (JM)
     procedure tprocinfo.set_result_offset;
       begin
          if paramanager.ret_in_reg(procdef.rettype.def,procdef.proccalloption) then
@@ -663,7 +668,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.39  2003-04-05 21:09:31  jonas
+  Revision 1.40  2003-04-22 13:47:08  peter
+    * fixed C style array of const
+    * fixed C array passing
+    * fixed left to right with high parameters
+
+  Revision 1.39  2003/04/05 21:09:31  jonas
     * several ppc/generic result offset related fixes. The "normal" result
       offset seems now to be calculated correctly and a lot of duplicate
       calculations have been removed. Nested functions accessing the parent's

+ 6 - 2
compiler/cgobj.pas

@@ -364,7 +364,6 @@ unit cgobj;
           procedure g_overflowcheck(list: taasmoutput; const p: tnode); virtual; abstract;
 
           procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer);virtual;abstract;
-          procedure g_removevaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer);virtual;abstract;
           {# Emits instructions which should be emitted when entering
              a routine declared as @var(interrupt). The default
              behavior does nothing, should be overriden as required.
@@ -1839,7 +1838,12 @@ finalization
 end.
 {
   $Log$
-  Revision 1.82  2003-04-22 10:09:34  daniel
+  Revision 1.83  2003-04-22 13:47:08  peter
+    * fixed C style array of const
+    * fixed C array passing
+    * fixed left to right with high parameters
+
+  Revision 1.82  2003/04/22 10:09:34  daniel
     + Implemented the actual register allocator
     + Scratch registers unavailable when new register allocator used
     + maybe_save/maybe_restore unavailable when new register allocator used

+ 9 - 4
compiler/ncgcal.pas

@@ -133,8 +133,8 @@ implementation
              else
                push_value_para(exprasmlist,left,calloption,para_offset,para_alignment,paraitem.paraloc);
            end
-         { filter array constructor with c styled args }
-         else if is_array_constructor(left.resulttype.def) and (nf_cargs in left.flags) then
+         { filter array of const c styled args }
+         else if is_array_of_const(left.resulttype.def) and (nf_cargs in left.flags) then
            begin
              { nothing, everything is already pushed }
            end
@@ -1299,7 +1299,7 @@ implementation
     procedure tcgprocinlinenode.pass_2;
        var st : tsymtable;
            oldprocdef : tprocdef;
-           ps, i : longint;
+           savedstackoffset,ps, i : longint;
            oldprocinfo : tprocinfo;
            oldinlining_procedure,
            nostackframe,make_global : boolean;
@@ -1476,7 +1476,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.48  2003-04-22 10:09:34  daniel
+  Revision 1.49  2003-04-22 13:47:08  peter
+    * fixed C style array of const
+    * fixed C array passing
+    * fixed left to right with high parameters
+
+  Revision 1.48  2003/04/22 10:09:34  daniel
     + Implemented the actual register allocator
     + Scratch registers unavailable when new register allocator used
     + maybe_save/maybe_restore unavailable when new register allocator used

+ 8 - 2
compiler/ncgmem.pas

@@ -753,7 +753,8 @@ implementation
                           { range checking for open and dynamic arrays needs
                             runtime code }
                           secondpass(right);
-                          rangecheck_array;
+                          if (cs_check_range in aktlocalswitches) then
+                            rangecheck_array;
                        end;
                   end;
                 stringdef :
@@ -944,7 +945,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.46  2003-04-22 10:09:35  daniel
+  Revision 1.47  2003-04-22 13:47:08  peter
+    * fixed C style array of const
+    * fixed C array passing
+    * fixed left to right with high parameters
+
+  Revision 1.46  2003/04/22 10:09:35  daniel
     + Implemented the actual register allocator
     + Scratch registers unavailable when new register allocator used
     + maybe_save/maybe_restore unavailable when new register allocator used

+ 37 - 30
compiler/ncgutil.pas

@@ -65,9 +65,10 @@ interface
     procedure genentrycode(list : TAAsmoutput;
                            make_global:boolean;
                            stackframe:longint;
-                           var parasize:longint;var nostackframe:boolean;
+                           var parasize:longint;
+                           var nostackframe:boolean;
                            inlined : boolean);
-   procedure genexitcode(list : TAAsmoutput;parasize:longint;nostackframe,inlined:boolean);
+   procedure genexitcode(list : TAAsmoutput;parasize:longint;nostackframe:boolean;inlined:boolean);
    procedure genimplicitunitinit(list : TAAsmoutput);
    procedure genimplicitunitfinal(list : TAAsmoutput);
 
@@ -962,24 +963,6 @@ implementation
       end;
 
 
-    procedure removevalueparas(p : tnamedindexitem;arg:pointer);
-      var
-        href1 : treference;
-        list : taasmoutput;
-      begin
-        list:=taasmoutput(arg);
-        if (tsym(p).typ=varsym) and
-           (tvarsym(p).varspez=vs_value) and
-           (is_open_array(tvarsym(p).vartype.def) or
-            is_array_of_const(tvarsym(p).vartype.def)) and
-           (paramanager.push_addr_param(tvarsym(p).vartype.def,procinfo.procdef.proccalloption)) then
-         begin
-           reference_reset_base(href1,procinfo.framepointer,tvarsym(p).address+procinfo.para_offset);
-           cg.g_removevaluepara_openarray(list,href1,tarraydef(tvarsym(p).vartype.def).elesize);
-         end;
-      end;
-
-
     { generates the code for initialisation of local data }
     procedure initialize_data(p : tnamedindexitem;arg:pointer);
       var
@@ -1313,7 +1296,8 @@ function returns in a register and the caller receives it in an other one}
     procedure genentrycode(list : TAAsmoutput;
                            make_global:boolean;
                            stackframe:longint;
-                           var parasize:longint;var nostackframe:boolean;
+                           var parasize:longint;
+                           var nostackframe:boolean;
                            inlined : boolean);
       var
         hs : string;
@@ -1321,6 +1305,7 @@ function returns in a register and the caller receives it in an other one}
         stackalloclist : taasmoutput;
         hp : tparaitem;
         paraloc : tparalocation;
+        rsp,
         tmpreg : tregister;
         inheriteddesctructorlabel : tasmlabel;
       begin
@@ -1341,6 +1326,18 @@ function returns in a register and the caller receives it in an other one}
          if (po_savestdregs in aktprocdef.procoptions) then
            cg.g_save_standard_registers(list,aktprocdef.usedintregisters);
 
+        { Save stackpointer value }
+        if not inlined and
+           (procinfo.framepointer.number<>NR_STACK_POINTER_REG) and
+           ((po_savestdregs in aktprocdef.procoptions) or
+            (po_saveregisters in aktprocdef.procoptions)) then
+         begin
+           tg.GetTemp(list,POINTER_SIZE,tt_noreuse,procinfo.save_stackptr_ref);
+           rsp.enum:=R_INTREGISTER;
+           rsp.number:=NR_STACK_POINTER_REG;
+           cg.a_load_reg_ref(list,OS_ADDR,rsp,procinfo.save_stackptr_ref);
+         end;
+
         { the actual profile code can clobber some registers,
           therefore if the context must be saved, do it before
           the actual call to the profile code
@@ -1643,7 +1640,7 @@ function returns in a register and the caller receives it in an other one}
       end;
 
 
-   procedure genexitcode(list : TAAsmoutput;parasize:longint;nostackframe,inlined:boolean);
+   procedure genexitcode(list : TAAsmoutput;parasize:longint;nostackframe:boolean;inlined:boolean);
       var
 {$ifdef GDB}
         stabsendlabel : tasmlabel;
@@ -1659,7 +1656,7 @@ function returns in a register and the caller receives it in an other one}
         usesacchi,
         usesself,usesfpu : boolean;
         pd : tprocdef;
-        tmpreg,r  : Tregister;
+        rsp,tmpreg,r  : Tregister;
       begin
         if aktexit2label.is_used and
            ((procinfo.flags and (pi_needs_implicit_finally or pi_uses_exceptions)) <> 0) then
@@ -1857,12 +1854,17 @@ function returns in a register and the caller receives it in an other one}
           end;
 {$endif GDB}
 
-        { remove copies of call by value parameters when there are also
-          registers saved on the stack }
-        if ((po_saveregisters in aktprocdef.procoptions) or
-            (po_savestdregs in aktprocdef.procoptions)) and
-           not(po_assembler in aktprocdef.procoptions) then
-          aktprocdef.parast.foreach_static({$ifndef TP}@{$endif}removevalueparas,list);
+        { Restore stackpointer if it was saved }
+        if not inlined and
+           (procinfo.framepointer.number<>NR_STACK_POINTER_REG) and
+           ((po_savestdregs in aktprocdef.procoptions) or
+            (po_saveregisters in aktprocdef.procoptions)) then
+         begin
+           rsp.enum:=R_INTREGISTER;
+           rsp.number:=NR_STACK_POINTER_REG;
+           cg.a_load_ref_reg(list,OS_ADDR,procinfo.save_stackptr_ref,rsp);
+           tg.UngetTemp(list,procinfo.save_stackptr_ref);
+         end;
 
         { for the save all registers we can simply use a pusha,popa which
           push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
@@ -2046,7 +2048,12 @@ function returns in a register and the caller receives it in an other one}
 end.
 {
   $Log$
-  Revision 1.85  2003-04-22 10:09:35  daniel
+  Revision 1.86  2003-04-22 13:47:08  peter
+    * fixed C style array of const
+    * fixed C array passing
+    * fixed left to right with high parameters
+
+  Revision 1.85  2003/04/22 10:09:35  daniel
     + Implemented the actual register allocator
     + Scratch registers unavailable when new register allocator used
     + maybe_save/maybe_restore unavailable when new register allocator used

+ 9 - 8
compiler/paramgr.pas

@@ -168,17 +168,13 @@ unit paramgr;
           recorddef :
             push_addr_param:=not(calloption in [pocall_cdecl,pocall_cppdecl]) and (def.size>pointer_size);
           arraydef :
-            push_addr_param:=(
-                              not(calloption in [pocall_cdecl,pocall_cppdecl]) and
+            push_addr_param:=(calloption in [pocall_cdecl,pocall_cppdecl]) or
+                             (
                               (tarraydef(def).highrange>=tarraydef(def).lowrange) and
                               (def.size>pointer_size)
                              ) or
                              is_open_array(def) or
-                             { array of const for cdecl are only pushed values }
-                             (
-                              not(calloption in [pocall_cdecl,pocall_cppdecl]) and
-                              is_array_of_const(def)
-                             ) or
+                             is_array_of_const(def) or
                              is_array_constructor(def);
           objectdef :
             push_addr_param:=is_object(def);
@@ -405,7 +401,12 @@ end.
 
 {
    $Log$
-   Revision 1.31  2003-02-02 19:25:54  carl
+   Revision 1.32  2003-04-22 13:47:08  peter
+     * fixed C style array of const
+     * fixed C array passing
+     * fixed left to right with high parameters
+
+   Revision 1.31  2003/02/02 19:25:54  carl
      * Several bugfixes for m68k target (register alloc., opcode emission)
      + VIS target
      + Generic add more complete (still not verified)

+ 26 - 27
compiler/pdecsub.pas

@@ -48,7 +48,7 @@ interface
     procedure parse_proc_directives(var pdflags:word);
 
     procedure handle_calling_convention(sym:tprocsym;def:tabstractprocdef);
-    procedure calc_parasymtable_addresses(def:tprocdef);
+    procedure calc_parasymtable_addresses(pd:tprocdef);
 
     procedure parse_proc_head(options:tproctypeoption);
     procedure parse_proc_dec;
@@ -1711,41 +1711,35 @@ const
       end;
 
 
-    procedure calc_parasymtable_addresses(def:tprocdef);
+    procedure calc_parasymtable_addresses(pd:tprocdef);
       var
-        lastps,
-        ps : tsym;
+        currpara : tparaitem;
         st : tsymtable;
       begin
-        st:=def.parast;
-        if po_leftright in def.procoptions then
+        st:=pd.parast;
+        if po_leftright in pd.procoptions then
          begin
-           { pushed in reversed order, left to right }
-           lastps:=nil;
-           while assigned(st.symindex.first) and (lastps<>tsym(st.symindex.first)) do
+           { pushed from left to right, so the in reverse order
+             on the stack }
+           currpara:=tparaitem(pd.para.last);
+           while assigned(currpara) do
             begin
-              ps:=tsym(st.symindex.first);
-              while assigned(ps.indexnext) and (tsym(ps.indexnext)<>lastps) do
-                ps:=tsym(ps.indexnext);
-              if (ps.typ=varsym) then
-                st.insertvardata(ps);
-              lastps:=ps;
+              if not(assigned(currpara.parasym) and (currpara.parasym.typ=varsym)) then
+                internalerror(200304231);
+              st.insertvardata(currpara.parasym);
+              currpara:=tparaitem(currpara.previous);
             end;
          end
         else
          begin
-           { pushed in normal order, right to left }
-           ps:=tsym(st.symindex.first);
-           while assigned(ps) do
+           { pushed from right to left }
+           currpara:=tparaitem(pd.para.first);
+           while assigned(currpara) do
             begin
-              if (ps.typ=varsym) and
-                 not(vo_is_high_value in tvarsym(ps).varoptions) then
-               begin
-                 st.insertvardata(ps);
-                 if assigned(tvarsym(ps).highvarsym) then
-                   st.insertvardata(tvarsym(ps).highvarsym);
-               end;
-              ps:=tsym(ps.indexnext);
+              if not(assigned(currpara.parasym) and (currpara.parasym.typ=varsym)) then
+                internalerror(200304232);
+              st.insertvardata(currpara.parasym);
+              currpara:=tparaitem(currpara.next);
             end;
          end;
       end;
@@ -2132,7 +2126,12 @@ const
 end.
 {
   $Log$
-  Revision 1.111  2003-04-10 17:57:53  peter
+  Revision 1.112  2003-04-22 13:47:08  peter
+    * fixed C style array of const
+    * fixed C array passing
+    * fixed left to right with high parameters
+
+  Revision 1.111  2003/04/10 17:57:53  peter
     * vs_hidden released
 
   Revision 1.110  2003/03/28 19:16:56  peter

+ 9 - 2
compiler/psub.pas

@@ -125,7 +125,7 @@ implementation
               akttokenpos:=storepos;
 
 (*            already done by
-              symtablestack.insertvardata(aktprocdef.funcretsym); above (JM)              
+              symtablestack.insertvardata(aktprocdef.funcretsym); above (JM)
               procinfo.set_result_offset;
 *)
               { insert result also if support is on }
@@ -226,6 +226,8 @@ implementation
          code:tnode;
          { true when no stackframe is required }
          nostackframe:boolean;
+         { offset where the stackpointer is saved, -1 when not saved }
+         savedstackoffset:longint;
          { number of bytes which have to be cleared by RET }
          parasize:longint;
          { filepositions }
@@ -884,7 +886,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.99  2003-04-22 10:09:35  daniel
+  Revision 1.100  2003-04-22 13:47:08  peter
+    * fixed C style array of const
+    * fixed C array passing
+    * fixed left to right with high parameters
+
+  Revision 1.99  2003/04/22 10:09:35  daniel
     + Implemented the actual register allocator
     + Scratch registers unavailable when new register allocator used
     + maybe_save/maybe_restore unavailable when new register allocator used

+ 6 - 29
compiler/x86/cgx86.pas

@@ -109,7 +109,6 @@ unit cgx86;
 
         { entry/exit code helpers }
         procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer);override;
-        procedure g_removevaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer);override;
         procedure g_interrupt_stackframe_entry(list : taasmoutput);override;
         procedure g_interrupt_stackframe_exit(list : taasmoutput;selfused,accused,acchiused:boolean);override;
         procedure g_profilecode(list : taasmoutput);override;
@@ -1516,33 +1515,6 @@ unit cgx86;
       end;
 
 
-    procedure tcgx86.g_removevaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer);
-      var
-        lenref : treference;
-        power  : longint;
-        r,rsp  : Tregister;
-      begin
-        lenref:=ref;
-        inc(lenref.offset,4);
-        { caluclate size and adjust stack space }
-        rg.getexplicitregisterint(list,NR_EDI);
-        r.enum:=R_INTREGISTER;
-        r.number:=NR_EDI;
-        rsp.enum:=R_INTREGISTER;
-        rsp.number:=NR_ESP;
-        list.concat(Taicpu.op_ref_reg(A_MOV,S_L,lenref,r));
-        list.concat(Taicpu.op_reg(A_INC,S_L,r));
-        if (elesize<>1) then
-         begin
-           if ispowerof2(elesize, power) then
-             list.concat(Taicpu.op_const_reg(A_SHL,S_L,power,r))
-           else
-             list.concat(Taicpu.op_const_reg(A_IMUL,S_L,elesize,r));
-         end;
-        list.concat(Taicpu.op_reg_reg(A_ADD,S_L,r,rsp));
-      end;
-
-
     procedure tcgx86.g_interrupt_stackframe_entry(list : taasmoutput);
 
     var r:Tregister;
@@ -1862,7 +1834,12 @@ unit cgx86;
 end.
 {
   $Log$
-  Revision 1.39  2003-04-22 10:09:35  daniel
+  Revision 1.40  2003-04-22 13:47:08  peter
+    * fixed C style array of const
+    * fixed C array passing
+    * fixed left to right with high parameters
+
+  Revision 1.39  2003/04/22 10:09:35  daniel
     + Implemented the actual register allocator
     + Scratch registers unavailable when new register allocator used
     + maybe_save/maybe_restore unavailable when new register allocator used