* moved more routines from cga/n386util

compiler/cg64f32.pas

@@ -22,10 +22,10 @@
 
  ****************************************************************************
 }
-{# This unit implements the code generation for 64 bit int arithmethics on 
+{# This unit implements the code generation for 64 bit int arithmethics on
    32 bit processors. All 32-bit processors should use this class as
    the base code generator class instead of tcg.
-}   
+}
 unit cg64f32;
 
   {$i defines.inc}
@@ -39,7 +39,7 @@ unit cg64f32;
        node,symtype;
 
     type
-      {# Defines all the methods required on 32-bit processors 
+      {# Defines all the methods required on 32-bit processors
          to handle 64-bit integers. All 32-bit processors should
          create derive a class of this type instead of @var(tcg).
       }
@@ -384,10 +384,10 @@ unit cg64f32;
       var
         tmpref: treference;
       begin
-        a_param_ref(list,OS_32,r,nr);
         tmpref := r;
         inc(tmpref.offset,4);
-        a_param_ref(list,OS_32,tmpref,nr+1);
+        a_param_ref(list,OS_32,tmpref,nr);
+        a_param_ref(list,OS_32,r,nr+1);
       end;
 
 
@@ -591,7 +591,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.8  2002-04-21 15:28:51  carl
+  Revision 1.9  2002-04-25 20:16:38  peter
+    * moved more routines from cga/n386util
+
+  Revision 1.8  2002/04/21 15:28:51  carl
   * a_jmp_cond -> a_jmp_always
 
   Revision 1.7  2002/04/07 13:21:18  carl

compiler/cgbase.pas

@@ -41,21 +41,21 @@ unit cgbase;
 
     const
        {# bitmask indicating if the procedure uses asm }
-       pi_uses_asm  = $1;       
+       pi_uses_asm  = $1;
        {# bitmask indicating if the procedure is exported by an unit }
-       pi_is_global = $2;       
+       pi_is_global = $2;
        {# bitmask indicating if the procedure does a call }
-       pi_do_call   = $4;       
+       pi_do_call   = $4;
        {# bitmask indicating if the procedure is an operator   }
-       pi_operator  = $8;       
+       pi_operator  = $8;
        {# bitmask indicating if the procedure is an external C function }
-       pi_c_import  = $10;      
+       pi_c_import  = $10;
        {# bitmask indicating if the procedure has a try statement = no register optimization }
        pi_uses_exceptions = $20;
        {# bitmask indicating if the procedure is declared as @var(assembler), don't optimize}
-       pi_is_assembler = $40;   
+       pi_is_assembler = $40;
        {# bitmask indicating if the procedure contains data which needs to be finalized }
-       pi_needs_implicit_finally = $80; 
+       pi_needs_implicit_finally = $80;
 
     type
        pprocinfo = ^tprocinfo;
@@ -77,7 +77,7 @@ unit cgbase;
           {# parameter offset in stack }
           para_offset : longint;
 
-          {# some collected informations about the procedure 
+          {# some collected informations about the procedure
              see pi_xxxx above                               }
           flags : longint;
 
@@ -449,6 +449,13 @@ implementation
             result := tfloat2tcgsize[tfloatdef(def).typ];
           recorddef :
             result:=int_cgsize(def.size);
+          arraydef :
+            begin
+              if not is_special_array(def) then
+                result := int_cgsize(def.size)
+              else
+                result := OS_NO;
+            end;
           else
             begin
               { undefined size }
@@ -464,9 +471,9 @@ implementation
             result := OS_8;
           2 :
             result := OS_16;
-          4 :
+          3,4 :
             result := OS_32;
-          8 :
+          5..8 :
             result := OS_64;
           else
             result:=OS_NO;
@@ -517,7 +524,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.12  2002-04-21 15:28:06  carl
+  Revision 1.13  2002-04-25 20:16:38  peter
+    * moved more routines from cga/n386util
+
+  Revision 1.12  2002/04/21 15:28:06  carl
   - remove duplicate constants
   - move some constants to cginfo
 

compiler/cgobj.pas

@@ -85,22 +85,11 @@ unit cgobj;
           {************************************************}
           { code generation for subroutine entry/exit code }
 
-          { initilizes data of type t                           }
-          { if is_already_ref is true then the routines assumes }
-          { that r points to the data to initialize             }
-          procedure g_initialize(list : taasmoutput;t : tdef;const ref : treference;is_already_ref : boolean);
-
-          { finalizes data of type t                            }
-          { if is_already_ref is true then the routines assumes }
-          { that r points to the data to finalizes              }
-          procedure g_finalize(list : taasmoutput;t : tdef;const ref : treference;is_already_ref : boolean);
-
           { helper routines }
           procedure g_initialize_data(list : taasmoutput;p : tsym);
           procedure g_incr_data(list : taasmoutput;p : tsym);
           procedure g_finalize_data(list : taasmoutput;p : tnamedindexitem);
           procedure g_copyvalueparas(list : taasmoutput;p : tnamedindexitem);
-          procedure g_finalizetempansistrings(list : taasmoutput);
 
           procedure g_entrycode(alist : TAAsmoutput;make_global:boolean;
                            stackframe:longint;
@@ -110,11 +99,6 @@ unit cgobj;
           procedure g_exitcode(list : taasmoutput;parasize : longint;
             nostackframe,inlined : boolean);
 
-          { string helper routines }
-          procedure g_decrstrref(list : taasmoutput;const ref : treference;t : tdef);
-
-          procedure g_removetemps(list : taasmoutput;p : tlinkedlist);
-
           { passing parameters, per default the parameter is pushed }
           { nr gives the number of the parameter (enumerated from   }
           { left to right), this allows to move the parameter to    }
@@ -202,6 +186,7 @@ unit cgobj;
           procedure a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);virtual; abstract;
           procedure a_load_reg_loc(list : taasmoutput;size : tcgsize;reg : tregister;const loc: tlocation);
           procedure a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister);virtual; abstract;
+          procedure a_load_ref_ref(list : taasmoutput;size : tcgsize;const sref : treference;const dref : treference);virtual;
           procedure a_load_loc_reg(list : taasmoutput;const loc: tlocation; reg : tregister);
           procedure a_load_loc_ref(list : taasmoutput;const loc: tlocation; const ref : treference);
           procedure a_load_sym_ofs_reg(list: taasmoutput; const sym: tasmsymbol; ofs: longint; reg: tregister);virtual; abstract;
@@ -217,6 +202,7 @@ unit cgobj;
           procedure a_loadmm_reg_reg(list: taasmoutput; reg1, reg2: tregister); virtual; abstract;
           procedure a_loadmm_ref_reg(list: taasmoutput; const ref: treference; reg: tregister); virtual; abstract;
           procedure a_loadmm_reg_ref(list: taasmoutput; reg: tregister; const ref: treference); virtual; abstract;
+          procedure a_parammm_reg(list: taasmoutput; reg: tregister); virtual; abstract;
 
           { basic arithmetic operations }
           { note: for operators which require only one argument (not, neg), use }
@@ -295,13 +281,6 @@ unit cgobj;
           }
           procedure g_profilecode(list : taasmoutput);virtual;
 
-          {# Emits the call to the stack checking routine of
-             the runtime library. The default behavior
-             does not need to be modified, as it is generic
-             for all platforms.
-          }
-          procedure g_stackcheck(list : taasmoutput;stackframesize : longint);virtual;
-
           procedure g_maybe_loadself(list : taasmoutput);virtual; abstract;
           {# This should emit the opcode to copy len bytes from the source
              to destination, if loadref is true, it assumes that it first must load
@@ -317,6 +296,30 @@ unit cgobj;
 
           }
           procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword;delsource,loadref : boolean);virtual; abstract;
+          {# This should emit the opcode to a shortrstring from the source
+             to destination, if loadref is true, it assumes that it first must load
+             the source address from the memory location where
+             source points to.
+
+             @param(source Source reference of copy)
+             @param(dest Destination reference of copy)
+             @param(delsource Indicates if the source reference's resources should be freed)
+             @param(loadref Is the source reference a pointer to the actual source (TRUE), is it the actual source address (FALSE))
+
+          }
+          procedure g_copyshortstring(list : taasmoutput;const source,dest : treference;len:byte;delsource,loadref : boolean);
+
+          procedure g_incrrefcount(list : taasmoutput;t: tdef; const ref: treference);
+          procedure g_decrrefcount(list : taasmoutput;t: tdef; const ref: treference);
+          procedure g_initialize(list : taasmoutput;t : tdef;const ref : treference;loadref : boolean);
+          procedure g_finalize(list : taasmoutput;t : tdef;const ref : treference;loadref : boolean);
+
+          {# Emits the call to the stack checking routine of
+             the runtime library. The default behavior
+             does not need to be modified, as it is generic
+             for all platforms.
+          }
+          procedure g_stackcheck(list : taasmoutput;stackframesize : longint);virtual;
 
           {# Generates range checking code. It is to note
              that this routine does not need to be overriden,
@@ -492,124 +495,10 @@ unit cgobj;
          free_scratch_reg(list,hr);
       end;
 
-
-    procedure tcg.g_stackcheck(list : taasmoutput;stackframesize : longint);
-
-      begin
-         a_param_const(list,OS_32,stackframesize,1);
-         a_call_name(list,'FPC_STACKCHECK',0);
-      end;
-
-{*****************************************************************************
-                         String helper routines
-*****************************************************************************}
-
-    procedure tcg.g_removetemps(list : taasmoutput;p : tlinkedlist);
-
-(*
-      var
-         hp : ptemptodestroy;
-         pushedregs : tpushed;
-*)
-
-      begin
-(*
-         hp:=ptemptodestroy(p^.first);
-         if not(assigned(hp)) then
-           exit;
-         tg.pushusedregisters(pushedregs,$ff);
-         while assigned(hp) do
-           begin
-              if is_ansistring(hp^.typ) then
-                begin
-                   g_decrstrref(list,hp^.address,hp^.typ);
-                   tg.ungetiftemp(hp^.address);
-                end;
-              hp:=ptemptodestroy(hp^.next);
-           end;
-         tg.popusedregisters(pushedregs);
-*)
-        runerror(211);
-      end;
-
-    procedure tcg.g_decrstrref(list : taasmoutput;const ref : treference;t : tdef);
-
-{      var
-         pushedregs : tpushedsaved; }
-
-      begin
-(*
-         tg.pushusedregisters(pushedregs,$ff);
-         a_param_ref_addr(list,ref,1);
-         if is_ansistring(t) then
-           a_call_name(list,'FPC_ANSISTR_DECR_REF',0)
-         else if is_widestring(t) then
-           a_call_name(list,'FPC_WIDESTR_DECR_REF',0)
-         else internalerror(58993);
-         tg.popusedregisters(pushedregs);
-*)
-        runerror(211);
-      end;
-
 {*****************************************************************************
                   Code generation for subroutine entry- and exit code
  *****************************************************************************}
 
-    { initilizes data of type t                           }
-    { if is_already_ref is true then the routines assumes }
-    { that r points to the data to initialize             }
-    procedure tcg.g_initialize(list : taasmoutput;t : tdef;const ref : treference;is_already_ref : boolean);
-
-{      var
-         hr : treference; }
-
-      begin
-(*
-         if is_ansistring(t) or
-           is_widestring(t) then
-           a_load_const_ref(list,OS_8,0,ref)
-         else
-           begin
-              reset_reference(hr);
-              hr.symbol:=t^.get_inittable_label;
-              a_param_ref_addr(list,hr,2);
-              if is_already_ref then
-                a_param_ref(list,OS_ADDR,ref,1)
-              else
-                a_param_ref_addr(list,ref,1);
-              a_call_name(list,'FPC_INITIALIZE',0);
-           end;
-*)
-        runerror(211);
-      end;
-
-    procedure tcg.g_finalize(list : taasmoutput;t : tdef;const ref : treference;is_already_ref : boolean);
-
-{      var
-         r : treference; }
-
-      begin
-(*
-         if is_ansistring(t) or
-           is_widestring(t) then
-           begin
-              g_decrstrref(list,ref,t);
-           end
-         else
-           begin
-              reset_reference(r);
-              r.symbol:=t^.get_inittable_label;
-              a_param_ref_addr(list,r,2);
-              if is_already_ref then
-                a_paramaddr_ref(list,ref,1)
-              else
-                a_param_ref_addr(list,ref,1);
-              a_call_name(list,'FPC_FINALIZE',0);
-           end;
-*)
-        runerror(211);
-      end;
-
     { generates the code for initialisation of local data }
     procedure tcg.g_initialize_data(list : taasmoutput;p : tsym);
 
@@ -733,37 +622,7 @@ unit cgobj;
       begin
          cg^.g_copyvalueparas(_list,s);
       end;
-*)
-
-    procedure tcg.g_finalizetempansistrings(list : taasmoutput);
 
-(*
-      var
-         hp : ptemprecord;
-         hr : treference;
-*)
-
-      begin
-(*
-         hp:=tg.templist;
-         while assigned(hp) do
-           begin
-              if hp^.temptype in [tt_ansistring,tt_freeansistring] then
-                begin
-                   procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
-                   reset_reference(hr);
-                   hr.base:=procinfo^.framepointer;
-                   hr.offset:=hp^.pos;
-                   a_param_ref_addr(list,hr,1);
-                   a_call_name(list,'FPC_ANSISTR_DECR_REF',0);
-                end;
-              hp:=hp^.next;
-           end;
-*)
-        runerror(211);
-     end;
-
-(*
     procedure _finalize_data(s : tnamedindexitem);{$ifndef FPC}far;{$endif}
 
       begin
@@ -1185,31 +1044,43 @@ unit cgobj;
  ****************************************************************************}
 
 
-    procedure tcg.a_load_const_ref(list : taasmoutput;size : tcgsize;a : aword;const ref : treference);
+    procedure tcg.a_load_ref_ref(list : taasmoutput;size : tcgsize;const sref : treference;const dref : treference);
 
-    var
-      tmpreg: tregister;
+      var
+        tmpreg: tregister;
 
       begin
+{$ifdef i386}
+        { the following is done with defines to avoid a speed penalty,  }
+        { since all this is only necessary for the 80x86 (because EDI   }
+        { doesn't have an 8bit component which is directly addressable) }
+        if size in [OS_8,OS_S8] then
+          tmpreg := rg.getregisterint(exprasmlist)
+        else
+{$endif i386}
         tmpreg := get_scratch_reg(list);
-        a_load_const_reg(list,size,a,tmpreg);
-        a_load_reg_ref(list,size,tmpreg,ref);
+        tmpreg:=rg.makeregsize(tmpreg,size);
+        a_load_ref_reg(list,size,sref,tmpreg);
+        a_load_reg_ref(list,size,tmpreg,dref);
+{$ifdef i386}
+        if size in [OS_8,OS_S8] then
+          rg.ungetregister(exprasmlist,tmpreg)
+        else
+{$endif i386}
         free_scratch_reg(list,tmpreg);
       end;
 
-    procedure tcg.a_load_loc_reg(list : taasmoutput;const loc: tlocation; reg : tregister);
+
+    procedure tcg.a_load_const_ref(list : taasmoutput;size : tcgsize;a : aword;const ref : treference);
+
+      var
+        tmpreg: tregister;
 
       begin
-        case loc.loc of
-          LOC_REFERENCE,LOC_CREFERENCE:
-            a_load_ref_reg(list,loc.size,loc.reference,reg);
-          LOC_REGISTER,LOC_CREGISTER:
-            a_load_reg_reg(list,loc.size,loc.register,reg);
-          LOC_CONSTANT:
-            a_load_const_reg(list,loc.size,loc.value,reg);
-          else
-            internalerror(200109092);
-        end;
+        tmpreg := get_scratch_reg(list);
+        a_load_const_reg(list,size,a,tmpreg);
+        a_load_reg_ref(list,size,tmpreg,ref);
+        free_scratch_reg(list,tmpreg);
       end;
 
 
@@ -1239,34 +1110,28 @@ unit cgobj;
       end;
 
 
-    procedure tcg.a_load_loc_ref(list : taasmoutput;const loc: tlocation; const ref : treference);
+    procedure tcg.a_load_loc_reg(list : taasmoutput;const loc: tlocation; reg : tregister);
+
+      begin
+        case loc.loc of
+          LOC_REFERENCE,LOC_CREFERENCE:
+            a_load_ref_reg(list,loc.size,loc.reference,reg);
+          LOC_REGISTER,LOC_CREGISTER:
+            a_load_reg_reg(list,loc.size,loc.register,reg);
+          LOC_CONSTANT:
+            a_load_const_reg(list,loc.size,loc.value,reg);
+          else
+            internalerror(200109092);
+        end;
+      end;
 
-      var
-        tmpreg: tregister;
+
+    procedure tcg.a_load_loc_ref(list : taasmoutput;const loc: tlocation; const ref : treference);
 
       begin
         case loc.loc of
           LOC_REFERENCE,LOC_CREFERENCE:
-            begin
-{$ifdef i386}
-              { the following is done with defines to avoid a speed penalty,  }
-              { since all this is only necessary for the 80x86 (because EDI   }
-              { doesn't have an 8bit component which is directly addressable) }
-              if loc.size in [OS_8,OS_S8] then
-                tmpreg := rg.getregisterint(exprasmlist)
-              else
-{$endif i386}
-              tmpreg := get_scratch_reg(list);
-              tmpreg:=rg.makeregsize(tmpreg,loc.size);
-              a_load_ref_reg(list,loc.size,loc.reference,tmpreg);
-              a_load_reg_ref(list,loc.size,tmpreg,ref);
-{$ifdef i386}
-              if loc.size in [OS_8,OS_S8] then
-                rg.ungetregister(exprasmlist,tmpreg)
-              else
-{$endif i386}
-              free_scratch_reg(list,tmpreg);
-            end;
+            a_load_ref_ref(list,loc.size,loc.reference,ref);
           LOC_REGISTER,LOC_CREGISTER:
             a_load_reg_ref(list,loc.size,loc.register,ref);
           LOC_CONSTANT:
@@ -1516,8 +1381,132 @@ unit cgobj;
       end;
 
 
-    procedure tcg.g_rangecheck(list: taasmoutput; const p: tnode;
-        const todef: tdef);
+    function tcg.reg_cgsize(const reg: tregister) : tcgsize;
+      begin
+        reg_cgsize := OS_INT;
+      end;
+
+
+    procedure tcg.g_copyshortstring(list : taasmoutput;const source,dest : treference;len:byte;delsource,loadref : boolean);
+      begin
+        a_paramaddr_ref(list,dest,3);
+        if loadref then
+         a_param_ref(list,OS_ADDR,source,2)
+        else
+         a_paramaddr_ref(list,source,2);
+        if delsource then
+         reference_release(list,source);
+        a_param_const(list,OS_INT,len,1);
+        a_call_name(list,'FPC_SHORTSTR_COPY',0);
+        g_maybe_loadself(list);
+      end;
+
+
+    procedure tcg.g_incrrefcount(list : taasmoutput;t: tdef; const ref: treference);
+      var
+        href : treference;
+        pushedregs : tpushedsaved;
+        decrfunc : string;
+      begin
+         rg.saveusedregisters(list,pushedregs,all_registers);
+         if is_interfacecom(t) then
+          decrfunc:='FPC_INTF_INCR_REF'
+         else if is_ansistring(t) then
+          decrfunc:='FPC_ANSISTR_INCR_REF'
+         else if is_widestring(t) then
+          decrfunc:='FPC_WIDESTR_INCR_REF'
+         else
+          decrfunc:='';
+         { call the special decr function or the generic decref }
+         if decrfunc<>'' then
+          cg.a_param_ref(list,OS_ADDR,ref,1)
+         else
+          begin
+            reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
+            a_paramaddr_ref(list,href,2);
+            a_paramaddr_ref(list,ref,1);
+            decrfunc:='FPC_ADDREF';
+         end;
+        rg.saveregvars(exprasmlist,all_registers);
+        a_call_name(list,decrfunc,0);
+        rg.restoreusedregisters(list,pushedregs);
+      end;
+
+
+    procedure tcg.g_decrrefcount(list : taasmoutput;t: tdef; const ref: treference);
+      var
+        href : treference;
+        pushedregs : tpushedsaved;
+        decrfunc : string;
+      begin
+         rg.saveusedregisters(list,pushedregs,all_registers);
+         if is_interfacecom(t) then
+          decrfunc:='FPC_INTF_DECR_REF'
+         else if is_ansistring(t) then
+          decrfunc:='FPC_ANSISTR_DECR_REF'
+         else if is_widestring(t) then
+          decrfunc:='FPC_WIDESTR_DECR_REF'
+         else
+          decrfunc:='';
+         { call the special decr function or the generic decref }
+         if decrfunc<>'' then
+          cg.a_paramaddr_ref(list,ref,1)
+         else
+          begin
+            reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
+            a_paramaddr_ref(list,href,2);
+            a_paramaddr_ref(list,ref,1);
+            decrfunc:='FPC_DECREF';
+         end;
+        rg.saveregvars(exprasmlist,all_registers);
+        a_call_name(list,decrfunc,0);
+        rg.restoreusedregisters(list,pushedregs);
+      end;
+
+
+    procedure tcg.g_initialize(list : taasmoutput;t : tdef;const ref : treference;loadref : boolean);
+      var
+         href : treference;
+      begin
+         if is_ansistring(t) or
+            is_widestring(t) or
+            is_interfacecom(t) then
+           a_load_const_ref(list,OS_ADDR,0,ref)
+         else
+           begin
+              reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
+              a_paramaddr_ref(list,href,2);
+              if loadref then
+                a_param_ref(list,OS_ADDR,ref,1)
+              else
+                a_paramaddr_ref(list,ref,1);
+              a_call_name(list,'FPC_INITIALIZE',0);
+           end;
+      end;
+
+
+    procedure tcg.g_finalize(list : taasmoutput;t : tdef;const ref : treference;loadref : boolean);
+      var
+         href : treference;
+      begin
+         if is_ansistring(t) or
+            is_widestring(t) or
+            is_interfacecom(t) then
+           g_decrrefcount(list,t,ref)
+         else
+           begin
+              reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
+              a_paramaddr_ref(list,href,2);
+              if loadref then
+                a_param_ref(list,OS_ADDR,ref,1)
+              else
+                a_paramaddr_ref(list,ref,1);
+              a_call_name(list,'FPC_FINALIZE',0);
+           end;
+      end;
+
+
+    procedure tcg.g_rangecheck(list: taasmoutput; const p: tnode;const todef: tdef);
     { generate range checking code for the value at location p. The type     }
     { type used is checked against todefs ranges. fromdef (p.resulttype.def) }
     { is the original type used at that location. When both defs are equal   }
@@ -1633,9 +1622,11 @@ unit cgobj;
       end;
 
 
-    function tcg.reg_cgsize(const reg: tregister) : tcgsize;
+    procedure tcg.g_stackcheck(list : taasmoutput;stackframesize : longint);
+
       begin
-        reg_cgsize := OS_INT;
+         a_param_const(list,OS_32,stackframesize,1);
+         a_call_name(list,'FPC_STACKCHECK',0);
       end;
 
 
@@ -1645,7 +1636,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.17  2002-04-22 16:30:05  peter
+  Revision 1.18  2002-04-25 20:16:38  peter
+    * moved more routines from cga/n386util
+
+  Revision 1.17  2002/04/22 16:30:05  peter
     * fixed @methodpointer
 
   Revision 1.16  2002/04/21 15:25:30  carl

compiler/i386/cga.pas

@@ -35,7 +35,6 @@ interface
  are written into temps for later release PM }
 
     function def_opsize(p1:tdef):topsize;
-    function def2def_opsize(p1,p2:tdef):topsize;
     function def_getreg(p1:tdef):tregister;
 
     procedure emitlab(var l : tasmlabel);
@@ -60,33 +59,17 @@ interface
     procedure emit_sym(i : tasmop;s : topsize;op : tasmsymbol);
     procedure emit_sym_ofs(i : tasmop;s : topsize;op : tasmsymbol;ofs : longint);
     procedure emit_sym_ofs_reg(i : tasmop;s : topsize;op : tasmsymbol;ofs:longint;reg : tregister);
-    procedure emit_sym_ofs_ref(i : tasmop;s : topsize;op : tasmsymbol;ofs:longint;const ref : treference);
 
     procedure emitcall(const routine:string);
 
-    procedure emit_push_mem_size(const t: treference; size: longint);
-
     { remove non regvar registers in loc from regs (in the format }
     { pushusedregisters uses)                                     }
     procedure remove_non_regvars_from_loc(const t: tlocation; var regs: tregisterset);
 
-    procedure emit_pushw_loc(const t:tlocation);
-    procedure emit_push_lea_loc(const t:tlocation;freetemp:boolean);
-
-    procedure copyshortstring(const dref,sref : treference;len : byte;
-                        loadref, del_sref: boolean);
-
-    procedure finalize(t : tdef;const ref : treference;is_already_ref : boolean);
-    procedure incrstringref(t : tdef;const ref : treference);
-    procedure decrstringref(t : tdef;const ref : treference);
-
     procedure push_int(l : longint);
     procedure emit_push_mem(const ref : treference);
     procedure emitpushreferenceaddr(const ref : treference);
 
-    procedure incrcomintfref(t: tdef; const ref: treference);
-    procedure decrcomintfref(t: tdef; const ref: treference);
-
     procedure maybe_loadself;
     procedure emitloadord2reg(const location:Tlocation;orddef:torddef;destreg:Tregister;delloc:boolean);
     procedure concatcopy(source,dest : treference;size : longint;delsource : boolean;loadref:boolean);
@@ -169,42 +152,6 @@ implementation
       end;
 
 
-    function def2def_opsize(p1,p2:tdef):topsize;
-      var
-        o1 : topsize;
-      begin
-        case p1.size of
-         1 : o1:=S_B;
-         2 : o1:=S_W;
-         4 : o1:=S_L;
-         { I don't know if we need it (FK) }
-         8 : o1:=S_L;
-        else
-         internalerror(130820002);
-        end;
-        if assigned(p2) then
-         begin
-           case p2.size of
-            1 : o1:=S_B;
-            2 : begin
-                  if o1=S_B then
-                   o1:=S_BW
-                  else
-                   o1:=S_W;
-                end;
-            4,8:
-              begin
-                 case o1 of
-                    S_B : o1:=S_BL;
-                    S_W : o1:=S_WL;
-                 end;
-              end;
-           end;
-         end;
-        def2def_opsize:=o1;
-      end;
-
-
     function def_getreg(p1:tdef):tregister;
       begin
         def_getreg:=rg.makeregsize(rg.getregisterint(exprasmlist),int_cgsize(p1.size));
@@ -310,11 +257,6 @@ implementation
         exprasmList.concat(Taicpu.Op_sym_ofs_reg(i,s,op,ofs,reg));
       end;
 
-    procedure emit_sym_ofs_ref(i : tasmop;s : topsize;op : tasmsymbol;ofs:longint;const ref : treference);
-      begin
-        exprasmList.concat(Taicpu.Op_sym_ofs_ref(i,s,op,ofs,ref));
-      end;
-
     procedure emitcall(const routine:string);
       begin
         exprasmList.concat(Taicpu.Op_sym(A_CALL,S_NO,newasmsymbol(routine)));
@@ -349,193 +291,8 @@ implementation
       end;
     end;
 
-    procedure emit_pushw_loc(const t:tlocation);
-      var
-        opsize : topsize;
-      begin
-        case t.loc of
-          LOC_REGISTER,
-         LOC_CREGISTER : begin
-                           if aktalignment.paraalign=4 then
-                             exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,rg.makeregsize(t.register,OS_32)))
-                           else
-                             exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_W,rg.makeregsize(t.register,OS_16)));
-                         end;
-         LOC_CONSTANT : begin
-                           if aktalignment.paraalign=4 then
-                            opsize:=S_L
-                           else
-                            opsize:=S_W;
-                           exprasmList.concat(Taicpu.Op_const(A_PUSH,opsize,t.value));
-                         end;
-         LOC_CREFERENCE,
-         LOC_REFERENCE : begin
-                           if aktalignment.paraalign=4 then
-                            opsize:=S_L
-                           else
-                            opsize:=S_W;
-                           exprasmList.concat(Taicpu.Op_ref(A_PUSH,opsize,t.reference));
-                         end;
-        else
-         internalerror(200203213);
-        end;
-        location_release(exprasmlist,t);
-        location_freetemp(exprasmlist,t);
-      end;
-
-
-    procedure emit_push_lea_loc(const t:tlocation;freetemp:boolean);
-      begin
-        case t.loc of
-               LOC_CREFERENCE,
-         LOC_REFERENCE : begin
-                               rg.getexplicitregisterint(exprasmlist,R_EDI);
-                               emit_ref_reg(A_LEA,S_L,t.reference,R_EDI);
-                               exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,R_EDI));
-                               rg.ungetregisterint(exprasmlist,R_EDI);
-                         end;
-        else
-         internalerror(200203218);
-        end;
-                   location_release(exprasmlist,t);
-                   if freetemp then
-                    location_freetemp(exprasmlist,t);
-      end;
-
-    procedure emit_push_mem_size(const t: treference; size: longint);
-
-      var
-        s: topsize;
-
-      begin
-          if size < 4 then
-            begin
-              rg.getexplicitregisterint(exprasmlist,R_EDI);
-              case size of
-                1: s := S_BL;
-                2: s := S_WL;
-                else internalerror(200008071);
-              end;
-              exprasmList.concat(Taicpu.Op_ref_reg(A_MOVZX,s,t,R_EDI));
-              if aktalignment.paraalign=4 then
-                exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,R_EDI))
-              else
-                exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_W,R_DI));
-              rg.ungetregisterint(exprasmlist,R_EDI);
-            end
-      end;
 
 
-{*****************************************************************************
-                           Emit String Functions
-*****************************************************************************}
-
-    procedure incrcomintfref(t: tdef; const ref: treference);
-      var
-        pushedregs : tpushedsaved;
-      begin
-         rg.saveusedregisters(exprasmlist,pushedregs,all_registers);
-         emit_ref(A_PUSH,S_L,ref);
-         rg.saveregvars(exprasmlist,all_registers);
-         if is_interfacecom(t) then
-           emitcall('FPC_INTF_INCR_REF')
-         else
-           internalerror(1859);
-         rg.restoreusedregisters(exprasmlist,pushedregs);
-      end;
-
-
-    procedure decrcomintfref(t: tdef; const ref: treference);
-      var
-        pushedregs : tpushedsaved;
-      begin
-         rg.saveusedregisters(exprasmlist,pushedregs,all_registers);
-         emitpushreferenceaddr(ref);
-         rg.saveregvars(exprasmlist,all_registers);
-         if is_interfacecom(t) then
-           begin
-              emitcall('FPC_INTF_DECR_REF');
-           end
-         else internalerror(1859);
-         rg.restoreusedregisters(exprasmlist,pushedregs);
-      end;
-
-
-    procedure copyshortstring(const dref,sref : treference;len : byte;
-                loadref, del_sref: boolean);
-      begin
-         emitpushreferenceaddr(dref);
-          { if it's deleted right before it's used, the optimizer can move }
-          { the reg deallocations to the right places (JM)                 }
-         if del_sref then
-           reference_release(exprasmlist,sref);
-         if loadref then
-          emit_push_mem(sref)
-         else
-          emitpushreferenceaddr(sref);
-         push_int(len);
-         emitcall('FPC_SHORTSTR_COPY');
-         maybe_loadself;
-      end;
-
-
-{$ifdef unused}
-    procedure copylongstring(const dref,sref : treference;len : longint;loadref:boolean);
-      begin
-         emitpushreferenceaddr(dref);
-         if loadref then
-          emit_push_mem(sref)
-         else
-          emitpushreferenceaddr(sref);
-         push_int(len);
-         rg.saveregvars(exprasmlist,all_registers);
-         emitcall('FPC_LONGSTR_COPY');
-         maybe_loadself;
-      end;
-{$endif unused}
-
-
-    procedure incrstringref(t : tdef;const ref : treference);
-      var
-         pushedregs : tpushedsaved;
-      begin
-         rg.saveusedregisters(exprasmlist,pushedregs,all_registers);
-         emitpushreferenceaddr(ref);
-         rg.saveregvars(exprasmlist,all_registers);
-         if is_ansistring(t) then
-           begin
-              emitcall('FPC_ANSISTR_INCR_REF');
-           end
-         else if is_widestring(t) then
-           begin
-              emitcall('FPC_WIDESTR_INCR_REF');
-           end
-         else internalerror(1859);
-         rg.restoreusedregisters(exprasmlist,pushedregs);
-      end;
-
-
-    procedure decrstringref(t : tdef;const ref : treference);
-
-      var
-         pushedregs : tpushedsaved;
-
-      begin
-         rg.saveusedregisters(exprasmlist,pushedregs,all_registers);
-         emitpushreferenceaddr(ref);
-         rg.saveregvars(exprasmlist,all_registers);
-         if is_ansistring(t) then
-           begin
-              emitcall('FPC_ANSISTR_DECR_REF');
-           end
-         else if is_widestring(t) then
-           begin
-              emitcall('FPC_WIDESTR_DECR_REF');
-           end
-         else internalerror(1859);
-         rg.restoreusedregisters(exprasmlist,pushedregs);
-      end;
-
 {*****************************************************************************
                            Emit Push Functions
 *****************************************************************************}
@@ -952,65 +709,6 @@ implementation
          end;
     end;
 
-    { initilizes data of type t                           }
-    { if is_already_ref is true then the routines assumes }
-    { that r points to the data to initialize             }
-    procedure initialize(t : tdef;const ref : treference;is_already_ref : boolean);
-
-      var
-         hr : treference;
-
-      begin
-         if is_ansistring(t) or
-           is_widestring(t) or
-           is_interfacecom(t) then
-           begin
-              emit_const_ref(A_MOV,S_L,0,ref);
-           end
-         else
-           begin
-              reference_reset(hr);
-              hr.symbol:=tstoreddef(t).get_rtti_label(initrtti);
-              emitpushreferenceaddr(hr);
-              if is_already_ref then
-                exprasmList.concat(Taicpu.Op_ref(A_PUSH,S_L,ref))
-              else
-                emitpushreferenceaddr(ref);
-              emitcall('FPC_INITIALIZE');
-           end;
-      end;
-
-    { finalizes data of type t                            }
-    { if is_already_ref is true then the routines assumes }
-    { that r points to the data to finalizes              }
-    procedure finalize(t : tdef;const ref : treference;is_already_ref : boolean);
-
-      var
-         r : treference;
-
-      begin
-         if is_ansistring(t) or
-            is_widestring(t) then
-           begin
-              decrstringref(t,ref);
-           end
-         else if is_interfacecom(t) then
-           begin
-              decrcomintfref(t,ref);
-           end
-         else
-           begin
-              reference_reset(r);
-              r.symbol:=tstoreddef(t).get_rtti_label(initrtti);
-              emitpushreferenceaddr(r);
-              if is_already_ref then
-                exprasmList.concat(Taicpu.Op_ref(A_PUSH,S_L,ref))
-              else
-                emitpushreferenceaddr(ref);
-              emitcall('FPC_FINALIZE');
-           end;
-      end;
-
 
   { generates the code for initialisation of local data }
   procedure initialize_data(p : tnamedindexitem);
@@ -1036,7 +734,7 @@ implementation
               begin
                  hr.symbol:=newasmsymbol(tvarsym(p).mangledname);
               end;
-            initialize(tvarsym(p).vartype.def,hr,false);
+            cg.g_initialize(exprasmlist,tvarsym(p).vartype.def,hr,false);
          end;
     end;
 
@@ -1064,23 +762,7 @@ implementation
                else
                 hrv.offset:=tvarsym(p).address+procinfo^.para_offset;
 
-               if is_ansistring(tvarsym(p).vartype.def) or
-                  is_widestring(tvarsym(p).vartype.def) then
-                 begin
-                   incrstringref(tvarsym(p).vartype.def,hrv)
-                 end
-               else if is_interfacecom(tvarsym(p).vartype.def) then
-                 begin
-                   incrcomintfref(tvarsym(p).vartype.def,hrv)
-                 end
-               else
-                 begin
-                   reference_reset(hr);
-                   hr.symbol:=tstoreddef(tvarsym(p).vartype.def).get_rtti_label(initrtti);
-                   emitpushreferenceaddr(hr);
-                   emitpushreferenceaddr(hrv);
-                   emitcall('FPC_ADDREF');
-                 end;
+               cg.g_incrrefcount(exprasmlist,tvarsym(p).vartype.def,hrv);
              end
            else if (tvarsym(p).varspez=vs_out) then
              begin
@@ -1089,20 +771,16 @@ implementation
                hrv.offset:=tvarsym(p).address+procinfo^.para_offset;
                rg.getexplicitregisterint(exprasmlist,R_EDI);
                exprasmList.concat(Taicpu.Op_ref_reg(A_MOV,S_L,hrv,R_EDI));
-               reference_reset(hr);
-               hr.base:=R_EDI;
-               initialize(tvarsym(p).vartype.def,hr,false);
+               reference_reset_base(hr,R_EDI,0);
+               cg.g_initialize(exprasmlist,tvarsym(p).vartype.def,hr,false);
              end;
          end;
     end;
 
   { generates the code for decrementing the reference count of parameters }
   procedure final_paras(p : tnamedindexitem);
-
     var
        hrv : treference;
-       hr: treference;
-
     begin
        if (tsym(p).typ=varsym) and
           not is_class(tvarsym(p).vartype.def) and
@@ -1119,23 +797,7 @@ implementation
                else
                 hrv.offset:=tvarsym(p).address+procinfo^.para_offset;
 
-               if is_ansistring(tvarsym(p).vartype.def) or
-                  is_widestring(tvarsym(p).vartype.def) then
-                 begin
-                   decrstringref(tvarsym(p).vartype.def,hrv)
-                 end
-               else if is_interfacecom(tvarsym(p).vartype.def) then
-                 begin
-                   decrcomintfref(tvarsym(p).vartype.def,hrv)
-                 end
-               else
-                 begin
-                   reference_reset(hr);
-                   hr.symbol:=tstoreddef(tvarsym(p).vartype.def).get_rtti_label(initrtti);
-                   emitpushreferenceaddr(hr);
-                   emitpushreferenceaddr(hrv);
-                   emitcall('FPC_DECREF');
-                 end;
+               cg.g_decrrefcount(exprasmlist,tvarsym(p).vartype.def,hrv);
              end;
          end;
     end;
@@ -1165,7 +827,7 @@ implementation
                else
                  hr.symbol:=newasmsymbol(tvarsym(p).mangledname);
             end;
-            finalize(tvarsym(p).vartype.def,hr,false);
+            cg.g_finalize(exprasmlist,tvarsym(p).vartype.def,hr,false);
          end;
     end;
 
@@ -1294,7 +956,7 @@ implementation
             begin
               reference_reset_base(href1,procinfo^.framepointer,tvarsym(p).address+procinfo^.para_offset);
               reference_reset_base(href2,procinfo^.framepointer,-tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup);
-              copyshortstring(href2,href1,tstringdef(tvarsym(p).vartype.def).len,true,false);
+              cg.g_copyshortstring(exprasmlist,href1,href2,tstringdef(tvarsym(p).vartype.def).len,false,true);
             end
            else
             begin
@@ -1582,10 +1244,8 @@ implementation
          (aktprocdef.rettype.def.needs_inittable) then
         begin
            procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
-           reference_reset(r);
-           r.offset:=procinfo^.return_offset;
-           r.base:=procinfo^.framepointer;
-           initialize(aktprocdef.rettype.def,r,ret_in_param(aktprocdef.rettype.def));
+           reference_reset_base(r,procinfo^.framepointer,procinfo^.return_offset);
+           cg.g_initialize(exprasmlist,aktprocdef.rettype.def,r,ret_in_param(aktprocdef.rettype.def));
         end;
 
       { initialisize local data like ansistrings }
@@ -1956,10 +1616,8 @@ implementation
              ((aktprocdef.rettype.def.deftype<>objectdef) or
               not is_class(aktprocdef.rettype.def)) then
              begin
-                reference_reset(hr);
-                hr.offset:=procinfo^.return_offset;
-                hr.base:=procinfo^.framepointer;
-                finalize(aktprocdef.rettype.def,hr,ret_in_param(aktprocdef.rettype.def));
+                reference_reset_base(hr,procinfo^.framepointer,procinfo^.return_offset);
+                cg.g_finalize(exprasmlist,aktprocdef.rettype.def,hr,ret_in_param(aktprocdef.rettype.def));
              end;
 
            emitcall('FPC_RERAISE');
@@ -2301,7 +1959,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.26  2002-04-21 15:29:53  carl
+  Revision 1.27  2002-04-25 20:16:39  peter
+    * moved more routines from cga/n386util
+
+  Revision 1.26  2002/04/21 15:29:53  carl
   * changeregsize -> rg.makeregsize
 
   Revision 1.25  2002/04/20 21:37:07  carl

compiler/i386/cgcpu.pas

@@ -76,6 +76,7 @@ unit cgcpu;
         procedure a_loadmm_reg_reg(list: taasmoutput; reg1, reg2: tregister); override;
         procedure a_loadmm_ref_reg(list: taasmoutput; const ref: treference; reg: tregister); override;
         procedure a_loadmm_reg_ref(list: taasmoutput; reg: tregister; const ref: treference); override;
+        procedure a_parammm_reg(list: taasmoutput; reg: tregister); override;
 
         {  comparison operations }
         procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
@@ -106,13 +107,14 @@ unit cgcpu;
         procedure a_op64_const_ref(list : taasmoutput;op:TOpCG;valuelosrc,valuehisrc:AWord;const ref : treference);override;
 
         procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);override;
+        procedure g_maybe_loadself(list : taasmoutput); override;
 
 
         class function reg_cgsize(const reg: tregister): tcgsize; override;
 
        private
 
-        procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel); 
+        procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
         procedure get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp);
         procedure sizes2load(s1 : tcgsize;s2 : topsize; var op: tasmop; var s3: topsize);
 
@@ -159,9 +161,9 @@ unit cgcpu;
 
 
     { currently does nothing }
-    procedure tcg386.a_jmp_always(list : taasmoutput;l: tasmlabel); 
+    procedure tcg386.a_jmp_always(list : taasmoutput;l: tasmlabel);
      begin
-       a_jmp_cond(list, OC_NONE, l);      
+       a_jmp_cond(list, OC_NONE, l);
      end;
 
     { we implement the following routines because otherwise we can't }
@@ -412,6 +414,16 @@ unit cgcpu;
        end;
 
 
+    procedure tcg386.a_parammm_reg(list: taasmoutput; reg: tregister);
+       var
+         href : treference;
+       begin
+         list.concat(taicpu.op_const_reg(A_SUB,S_L,8,R_ESP));
+         reference_reset_base(href,R_ESP,0);
+         list.concat(taicpu.op_reg_ref(A_MOVQ,S_NO,reg,href));
+       end;
+
+
     procedure tcg386.a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister);
 
       var
@@ -1060,6 +1072,22 @@ unit cgcpu;
       end;
 
 
+    procedure tcg386.g_maybe_loadself(list : taasmoutput);
+      var
+        oldlist: taasmoutput;
+
+      begin
+        if list <> exprasmlist then
+          begin
+            oldlist := exprasmlist;
+            exprasmlist := list;
+          end;
+        cga.maybe_loadself;
+        if list <> exprasmlist then
+          list := oldlist;
+      end;
+
+
     function tcg386.reg_cgsize(const reg: tregister): tcgsize;
       const
         regsize_2_cgsize: array[S_B..S_L] of tcgsize = (OS_8,OS_16,OS_32);
@@ -1199,7 +1227,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.13  2002-04-21 15:31:05  carl
+  Revision 1.14  2002-04-25 20:16:40  peter
+    * moved more routines from cga/n386util
+
+  Revision 1.13  2002/04/21 15:31:05  carl
   * changeregsize -> rg.makeregsize
   + a_jmp_always added
 

compiler/i386/n386add.pas

@@ -356,24 +356,15 @@ interface
                         { the tempstring can also come from a typeconversion }
                         { or a function result, so simply check for a        }
                         { temp of 256 bytes(JM)                                          }
-
                         if not(tg.istemp(left.location.reference) and
                                (tg.getsizeoftemp(left.location.reference) = 256)) and
                            not(nf_use_strconcat in flags) then
                           begin
-
-                             { can only reference be }
-                             { string in register would be funny    }
-                             { therefore produce a temporary string }
-
                              tg.gettempofsizereference(exprasmlist,256,href);
-                             copyshortstring(href,left.location.reference,255,false,true);
-                             { release the registers }
-{                             done by copyshortstring now (JM)           }
-{                             del_reference(left.location.reference); }
-                             tg.ungetiftemp(exprasmlist,left.location.reference);
+                             cg.g_copyshortstring(exprasmlist,left.location.reference,href,255,true,false);
+                             { location is released by copyshortstring }
+                             location_freetemp(exprasmlist,left.location);
 
-                             { does not hurt: }
                              location_reset(left.location,LOC_CREFERENCE,def_cgsize(resulttype.def));
                              left.location.reference:=href;
                           end;
@@ -386,15 +377,14 @@ interface
                         { because emitpushreferenceaddr doesn't need extra }
                         { registers) (JM)                                  }
                         regstopush := all_registers;
-                        remove_non_regvars_from_loc(right.location,
-                          regstopush);
+                        remove_non_regvars_from_loc(right.location,regstopush);
                         rg.saveusedregisters(exprasmlist,pushedregs,regstopush);
-                       { push the maximum possible length of the result }
+                        { push the maximum possible length of the result }
                         emitpushreferenceaddr(left.location.reference);
-                       { the optimizer can more easily put the          }
-                       { deallocations in the right place if it happens }
-                       { too early than when it happens too late (if    }
-                       { the pushref needs a "lea (..),edi; push edi")  }
+                        { the optimizer can more easily put the          }
+                        { deallocations in the right place if it happens }
+                        { too early than when it happens too late (if    }
+                        { the pushref needs a "lea (..),edi; push edi")  }
                         location_release(exprasmlist,right.location);
                         emitpushreferenceaddr(right.location.reference);
                         rg.saveregvars(exprasmlist,regstopush);
@@ -1584,7 +1574,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.33  2002-04-05 15:09:13  jonas
+  Revision 1.34  2002-04-25 20:16:40  peter
+    * moved more routines from cga/n386util
+
+  Revision 1.33  2002/04/05 15:09:13  jonas
     * fixed web bug 1915
 
   Revision 1.32  2002/04/04 19:06:10  peter

compiler/i386/n386cal.pas

@@ -198,7 +198,7 @@ implementation
                  assigned(defcoll.paratype.def) and
                  not is_class(defcoll.paratype.def) and
                  defcoll.paratype.def.needs_inittable then
-                finalize(defcoll.paratype.def,left.location.reference,false);
+                cg.g_finalize(exprasmlist,defcoll.paratype.def,left.location.reference,false);
               inc(pushedparasize,4);
               if inlined then
                 begin
@@ -325,6 +325,7 @@ implementation
          push_size : longint;
 {$endif OPTALIGN}
          pop_allowed : boolean;
+         release_edi : boolean;
          constructorfailed : tasmlabel;
 
       label
@@ -344,12 +345,12 @@ implementation
          if is_widestring(resulttype.def) then
            begin
              tg.gettempwidestringreference(exprasmlist,refcountedtemp);
-             decrstringref(resulttype.def,refcountedtemp);
+             cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp);
            end
          else if is_ansistring(resulttype.def) then
            begin
              tg.gettempansistringreference(exprasmlist,refcountedtemp);
-             decrstringref(resulttype.def,refcountedtemp);
+             cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp);
            end;
 
          if (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_stdcall]) then
@@ -482,37 +483,8 @@ implementation
          else
            pop_esp:=false;
 {$endif OPTALIGN}
-         if (not is_void(resulttype.def)) and
-            ret_in_param(resulttype.def) then
-           begin
-              funcretref.symbol:=nil;
-{$ifdef test_dest_loc}
-              if dest_loc_known and (dest_loc_tree=p) and
-                 (dest_loc.loc in [LOC_REFERENCE,LOC_MEM]) then
-                begin
-                   funcretref:=dest_loc.reference;
-                   if assigned(dest_loc.reference.symbol) then
-                     funcretref.symbol:=stringdup(dest_loc.reference.symbol^);
-                   in_dest_loc:=true;
-                end
-              else
-{$endif test_dest_loc}
-                if inlined then
-                  begin
-                     reference_reset(funcretref);
-                     funcretref.offset:=tg.gettempofsizepersistant(exprasmlist,resulttype.def.size);
-                     funcretref.base:=procinfo^.framepointer;
-{$ifdef extdebug}
-                     Comment(V_debug,'function return value is at offset '
-                                     +tostr(funcretref.offset));
-                     exprasmlist.concat(tai_asm_comment.create(
-                                         strpnew('function return value is at offset '
-                                                 +tostr(funcretref.offset))));
-{$endif extdebug}
-                  end
-                else
-                  tg.gettempofsizereference(exprasmlist,resulttype.def.size,funcretref);
-           end;
+
+         { Push parameters }
          if assigned(params) then
            begin
               { be found elsewhere }
@@ -533,31 +505,66 @@ implementation
                   (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl]),
                   para_alignment,para_offset);
            end;
+
+         { Allocate return value for inlined routines }
          if inlined then
            inlinecode.retoffset:=tg.gettempofsizepersistant(exprasmlist,Align(resulttype.def.size,aktalignment.paraalign));
+
+         { Allocate return value when returned in argument }
          if ret_in_param(resulttype.def) then
            begin
-              { This must not be counted for C code
-                complex return address is removed from stack
-                by function itself !   }
+             if assigned(funcretrefnode) then
+              begin
+                secondpass(funcretrefnode);
+                if codegenerror then
+                 exit;
+                if (funcretrefnode.location.loc<>LOC_REFERENCE) then
+                 internalerror(200204246);
+                funcretref:=funcretrefnode.location.reference;
+              end
+             else
+              begin
+                if inlined then
+                 begin
+                   reference_reset(funcretref);
+                   funcretref.offset:=tg.gettempofsizepersistant(exprasmlist,resulttype.def.size);
+                   funcretref.base:=procinfo^.framepointer;
+{$ifdef extdebug}
+                   Comment(V_debug,'function return value is at offset '
+                                   +tostr(funcretref.offset));
+                   exprasmlist.concat(tai_asm_comment.create(
+                                       strpnew('function return value is at offset '
+                                               +tostr(funcretref.offset))));
+{$endif extdebug}
+                 end
+                else
+                 tg.gettempofsizereference(exprasmlist,resulttype.def.size,funcretref);
+              end;
+
+             { This must not be counted for C code
+               complex return address is removed from stack
+               by function itself !   }
 {$ifdef OLD_C_STACK}
-              inc(pushedparasize,4); { lets try without it PM }
+             inc(pushedparasize,4); { lets try without it PM }
 {$endif not OLD_C_STACK}
-              if inlined then
-                begin
-                   rg.getexplicitregisterint(exprasmlist,R_EDI);
-                   emit_ref_reg(A_LEA,S_L,funcretref,R_EDI);
-                   reference_reset_base(href,procinfo^.framepointer,inlinecode.retoffset);
-                   emit_reg_ref(A_MOV,S_L,R_EDI,href);
-                   rg.ungetregisterint(exprasmlist,R_EDI);
-                end
-              else
-                emitpushreferenceaddr(funcretref);
+             if inlined then
+               begin
+                  hregister:=cg.get_scratch_reg(exprasmlist);
+                  cg.a_loadaddr_ref_reg(exprasmlist,funcretref,hregister);
+                  reference_reset_base(href,procinfo^.framepointer,inlinecode.retoffset);
+                  cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,href);
+                  cg.free_scratch_reg(exprasmlist,hregister);
+               end
+             else
+               cg.a_paramaddr_ref(exprasmlist,funcretref,-1);
            end;
-         { procedure variable ? }
+
+         { procedure variable or normal function call ? }
          if inlined or
-           (right=nil) then
+            (right=nil) then
            begin
+              { Normal function call }
+
               { overloaded operator has no symtable }
               { push self }
               if assigned(symtableproc) and
@@ -912,6 +919,7 @@ implementation
                    { also class methods                       }
                    { Here it is quite tricky because it also depends }
                    { on the methodpointer                        PM }
+                   release_edi:=false;
                    rg.getexplicitregisterint(exprasmlist,R_ESI);
                    if assigned(aktprocdef) then
                      begin
@@ -938,6 +946,7 @@ implementation
                             rg.getexplicitregisterint(exprasmlist,R_EDI);
                             emit_ref_reg(A_MOV,S_L,href,R_EDI);
                             reference_reset_base(href,R_EDI,0);
+                            release_edi:=true;
                          end;
                      end
                    else
@@ -974,7 +983,8 @@ implementation
                           end;
                      end;
                    emit_ref(A_CALL,S_NO,href);
-                   rg.ungetregisterint(exprasmlist,R_EDI);
+                   if release_edi then
+                     rg.ungetregisterint(exprasmlist,R_EDI);
                 end
               else if not inlined then
                 begin
@@ -1290,7 +1300,7 @@ implementation
                 begin
                    { data which must be finalized ? }
                    if (resulttype.def.needs_inittable) then
-                      finalize(resulttype.def,location.reference,false);
+                      cg.g_finalize(exprasmlist,resulttype.def,location.reference,false);
                    { release unused temp }
                    tg.ungetiftemp(exprasmlist,location.reference)
                 end
@@ -1482,7 +1492,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.47  2002-04-21 19:02:07  peter
+  Revision 1.48  2002-04-25 20:16:40  peter
+    * moved more routines from cga/n386util
+
+  Revision 1.47  2002/04/21 19:02:07  peter
     * removed newn and disposen nodes, the code is now directly
       inlined from pexpr
     * -an option that will write the secondpass nodes to the .s file, this

compiler/i386/n386ld.pas

@@ -47,7 +47,7 @@ implementation
 
     uses
       systems,
-      verbose,globals,
+      cutils,verbose,globals,
       symconst,symtype,symdef,symsym,symtable,aasm,types,
       cginfo,cgbase,pass_2,
       nmem,ncon,ncnv,
@@ -64,7 +64,6 @@ implementation
          symtabletype : tsymtabletype;
          i : longint;
          href : treference;
-         s : tasmsymbol;
          newsize : tcgsize;
          popeax : boolean;
       begin
@@ -382,15 +381,12 @@ implementation
 
     procedure ti386assignmentnode.pass_2;
       var
-         regs_to_push: tregisterset;
          otlabel,hlabel,oflabel : tasmlabel;
          fputyp : tfloattype;
-         loc : tloc;
          href : treference;
          ai : taicpu;
          releaseright,
          pushed : boolean;
-         regspushed : tpushedsaved;
          cgsize : tcgsize;
 
       begin
@@ -493,82 +489,58 @@ implementation
              exit;
           end;
 
-        loc:=left.location.loc;
+        releaseright:=true;
 
-        if left.resulttype.def.deftype=stringdef then
+        { shortstring assignments are handled separately }
+        if is_shortstring(left.resulttype.def) then
           begin
-             if is_ansistring(left.resulttype.def) or
-                is_widestring(left.resulttype.def) then
-               begin
-                 { before pushing any parameter, we have to save all used      }
-                 { registers, but before that we have to release the       }
-                 { registers of that node to save uneccessary pushed       }
-                 { so be careful, if you think you can optimize that code (FK) }
-
-                 { nevertheless, this has to be changed, because otherwise the }
-                 { register is released before it's contents are pushed ->     }
-                 { problems with the optimizer (JM)                            }
-                 { Find out which registers have to be pushed (JM) }
-                 regs_to_push := all_registers;
-                 remove_non_regvars_from_loc(right.location,regs_to_push);
-                 remove_non_regvars_from_loc(left.location,regs_to_push);
-                 { And push them (JM) }
-                 rg.saveusedregisters(exprasmlist,regspushed,regs_to_push);
-
-                 location_release(exprasmlist,right.location);
-                 cg.a_param_loc(exprasmlist,right.location,2);
-                 location_release(exprasmlist,left.location);
-                 cg.a_paramaddr_ref(exprasmlist,left.location.reference,1);
-                 rg.saveregvars(exprasmlist,all_registers);
-                 if is_ansistring(left.resulttype.def) then
-                   emitcall('FPC_ANSISTR_ASSIGN')
-                 else
-                   emitcall('FPC_WIDESTR_ASSIGN');
-                 maybe_loadself;
-                 rg.restoreusedregisters(exprasmlist,regspushed);
-                 location_freetemp(exprasmlist,right.location);
-               end
-             else if is_shortstring(left.resulttype.def) and
-                     not (nf_concat_string in flags) then
-               begin
-                 if is_ansistring(right.resulttype.def) then
-                   begin
-                     if (right.nodetype=stringconstn) and
-                        (tstringconstnode(right).len=0) then
+            {
+              we can get here only in the following situations
+              for the right node:
+               - empty constant string
+               - char
+            }
+
+            { empty constant string }
+            if (right.nodetype=stringconstn) and
+               (tstringconstnode(right).len=0) then
+              begin
+                emit_const_ref(A_MOV,S_B,0,left.location.reference);
+              end
+            { char loading }
+            else if is_char(right.resulttype.def) then
+              begin
+                if right.nodetype=ordconstn then
+                  emit_const_ref(A_MOV,S_W,tordconstnode(right).value*256+1,left.location.reference)
+                else
+                  begin
+                     if (right.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
                        begin
-                         emit_const_ref(A_MOV,S_B,0,left.location.reference);
-                         location_release(exprasmlist,left.location);
+                          href := left.location.reference;
+                          emit_const_ref(A_MOV,S_B,1,href);
+                          inc(href.offset,1);
+                          emit_reg_ref(A_MOV,S_B,rg.makeregsize(right.location.register,OS_8),href);
                        end
                      else
-                       loadansi2short(right,left);
-                   end
-                 else
-                   begin
-                      { we do not need destination anymore }
-                      location_release(exprasmlist,left.location);
-                      {del_reference(right.location.reference);
-                       done in loadshortstring }
-                      loadshortstring(right,left);
-                      location_freetemp(exprasmlist,right.location);
-                   end;
-               end
-             else if is_longstring(left.resulttype.def) then
-               begin
-                  internalerror(200105261);
-               end
-             else
-               begin
-                 { its the only thing we have to do }
-                 location_release(exprasmlist,right.location);
-               end
-          end
-        else if is_interfacecom(left.resulttype.def) then
-          begin
-             loadinterfacecom(self);
+                     { not so elegant (goes better with extra register    }
+                       begin
+                          { not "movl", because then we may read past the }
+                          { end of the heap! "movw" would be ok too, but  }
+                          { I don't think that would be faster (JM)       }
+                          rg.getexplicitregisterint(exprasmlist,R_EDI);
+                          emit_ref_reg(A_MOVZX,S_BL,right.location.reference,R_EDI);
+                          emit_const_reg(A_SHL,S_L,8,R_EDI);
+                          emit_const_reg(A_OR,S_L,1,R_EDI);
+                          emit_reg_ref(A_MOV,S_W,R_DI,left.location.reference);
+                          rg.ungetregisterint(exprasmlist,R_EDI);
+                       end;
+                  end;
+              end
+            else
+              internalerror(200204249);
           end
         else
           begin
-            releaseright:=true;
             case right.location.loc of
               LOC_CONSTANT :
                 begin
@@ -581,7 +553,7 @@ implementation
               LOC_REFERENCE,
               LOC_CREFERENCE :
                 begin
-                  case loc of
+                  case left.location.loc of
                     LOC_CREGISTER :
                       begin
                         cgsize:=def_cgsize(left.resulttype.def);
@@ -608,16 +580,12 @@ implementation
                              { this would be a problem }
                              if not(left.resulttype.def.needs_inittable) then
                                internalerror(3457);
-                             { increment source reference counter }
-                             reference_reset_symbol(href,tstoreddef(right.resulttype.def).get_rtti_label(initrtti),0);
-                             cg.a_paramaddr_ref(exprasmlist,href,2);
-                             cg.a_paramaddr_ref(exprasmlist,right.location.reference,1);
-                             emitcall('FPC_ADDREF');
+                             { increment source reference counter, this is
+                               useless for string constants}
+                             if right.nodetype<>stringconstn then
+                              cg.g_incrrefcount(exprasmlist,right.resulttype.def,right.location.reference);
                              { decrement destination reference counter }
-                             reference_reset_symbol(href,tstoreddef(left.resulttype.def).get_rtti_label(initrtti),0);
-                             cg.a_paramaddr_ref(exprasmlist,href,2);
-                             cg.a_paramaddr_ref(exprasmlist,left.location.reference,1);
-                             emitcall('FPC_DECREF');
+                             cg.g_decrrefcount(exprasmlist,left.resulttype.def,left.location.reference);
                           end;
 
                         concatcopy(right.location.reference,
@@ -633,7 +601,7 @@ implementation
               LOC_CMMXREGISTER,
               LOC_MMXREGISTER:
                 begin
-                  if loc=LOC_CMMXREGISTER then
+                  if left.location.loc=LOC_CMMXREGISTER then
                    emit_reg_reg(A_MOVQ,S_NO,right.location.register,left.location.register)
                   else
                    emit_reg_ref(A_MOVQ,S_NO,right.location.register,left.location.reference);
@@ -680,9 +648,8 @@ implementation
                   if codegenerror then
                     exit;
                   cg.a_load_const_loc(exprasmlist,1,left.location);
+                  location_release(exprasmlist,left.location);
                   emitjmp(C_None,hlabel);
-                  if not(left.location.loc in [LOC_CREGISTER{$ifdef SUPPORT_MMX},LOC_CMMXREGISTER{$endif SUPPORT_MMX}]) then
-                   location_release(exprasmlist,left.location);
                   { generate the leftnode for the false case }
                   emitlab(falselabel);
                   pushed:=maybe_push(left.registers32,right,false);
@@ -696,11 +663,11 @@ implementation
                 end;
               LOC_FLAGS :
                 begin
-                  if loc=LOC_CREGISTER then
+                  if left.location.loc=LOC_CREGISTER then
                     cg.g_flags2reg(exprasmlist,right.location.resflags,left.location.register)
                   else
                     begin
-                      if not(loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
+                      if not(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
                        internalerror(200203273);
                       ai:=Taicpu.Op_ref(A_Setcc,S_B,left.location.reference);
                       ai.SetCondition(flags_to_cond(right.location.resflags));
@@ -709,14 +676,12 @@ implementation
                 end;
             end;
 
-           { we don't need the locations anymore. Only for
-             CREGISTER we need to keep the new location available }
-           if releaseright then
-            location_release(exprasmlist,right.location);
-           if not(left.location.loc in [LOC_CREGISTER{$ifdef SUPPORT_MMX},LOC_CMMXREGISTER{$endif SUPPORT_MMX}]) then
-            location_release(exprasmlist,left.location);
          end;
 
+        if releaseright then
+         location_release(exprasmlist,right.location);
+        location_release(exprasmlist,left.location);
+
         truelabel:=otlabel;
         falselabel:=oflabel;
       end;
@@ -779,7 +744,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.38  2002-04-22 16:30:06  peter
+  Revision 1.39  2002-04-25 20:16:40  peter
+    * moved more routines from cga/n386util
+
+  Revision 1.38  2002/04/22 16:30:06  peter
     * fixed @methodpointer
 
   Revision 1.37  2002/04/21 15:36:13  carl

compiler/i386/n386opt.pas

@@ -42,7 +42,7 @@ type
 implementation
 
 uses pass_1, types, htypechk, cginfo, cgbase, cpubase, cga,
-     tgobj, aasm, ncnv, ncon, pass_2, symdef, rgobj;
+     tgobj, aasm, ncnv, ncon, pass_2, symdef, rgobj, cgobj;
 
 
 {*****************************************************************************
@@ -95,10 +95,10 @@ begin
      not(nf_use_strconcat in flags) then
     begin
        tg.gettempofsizereference(exprasmlist,256,href);
-       copyshortstring(href,left.location.reference,255,false,true);
-       { release the registers }
-       tg.ungetiftemp(exprasmlist,left.location.reference);
-       { does not hurt: }
+       cg.g_copyshortstring(exprasmlist,left.location.reference,href,255,true,false);
+       { location is released by copyshortstring }
+       location_freetemp(exprasmlist,left.location);
+       { return temp reference }
        location_reset(left.location,LOC_CREFERENCE,def_cgsize(resulttype.def));
        left.location.reference:=href;
     end;
@@ -203,10 +203,10 @@ begin
      not(nf_use_strconcat in flags) then
     begin
        tg.gettempofsizereference(exprasmlist,256,href);
-       copyshortstring(href,left.location.reference,255,false,true);
+       cg.g_copyshortstring(exprasmlist,left.location.reference,href,255,true,false);
        { release the registers }
-       tg.ungetiftemp(exprasmlist,left.location.reference);
-       { does not hurt: }
+       location_freetemp(exprasmlist,left.location);
+       { return temp reference }
        location_reset(left.location,LOC_CREFERENCE,def_cgsize(resulttype.def));
        left.location.reference:=href;
     end;
@@ -242,7 +242,10 @@ end.
 
 {
   $Log$
-  Revision 1.11  2002-04-21 15:36:40  carl
+  Revision 1.12  2002-04-25 20:16:40  peter
+    * moved more routines from cga/n386util
+
+  Revision 1.11  2002/04/21 15:36:40  carl
   * changeregsize -> rg.makeregsize
 
   Revision 1.10  2002/04/15 19:44:21  peter

compiler/i386/n386set.pas

@@ -510,30 +510,13 @@ implementation
                 end
                else
                 begin
-                  if not(left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
-                    begin
-                      pleftreg := rg.getexplicitregisterint(exprasmlist,R_EDI);
-                      opsize := def2def_opsize(left.resulttype.def,u32bittype.def);
-                      if opsize = S_L then
-                        emit_ref_reg(A_MOV,opsize,left.location.reference,pleftreg)
-                      else
-                        emit_ref_reg(A_MOVZX,opsize,left.location.reference,pleftreg);
-                      location_freetemp(exprasmlist,left.location);
-                      location_release(exprasmlist,left.location);
-                    end
+                  if (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+                    pleftreg:=rg.makeregsize(left.location.register,OS_INT)
                   else
-                    begin
-                      pleftreg := rg.makeregsize(left.location.register,OS_INT);
-                      opsize := def2def_opsize(left.resulttype.def,u32bittype.def);
-                      if opsize <> S_L then
-                       begin
-                         { this will change left, even if it's a LOC_CREGISTER, but }
-                         { that doesn't matter: if left is an 8 bit def, then the   }
-                         { upper 24 bits are undefined, so we can zero them without }
-                         { any problem (JM)                                         }
-                         cg.a_load_reg_reg(exprasmlist,left.location.size,left.location.register,pleftreg);
-                       end;
-                    end;
+                    pleftreg:=rg.getexplicitregisterint(exprasmlist,R_EDI);
+                  cg.a_load_loc_reg(exprasmlist,left.location,pleftreg);
+                  location_freetemp(exprasmlist,left.location);
+                  location_release(exprasmlist,left.location);
                   emit_reg_ref(A_BT,S_L,pleftreg,right.location.reference);
                   rg.ungetregister(exprasmlist,pleftreg);
                   location_release(exprasmlist,right.location);
@@ -1036,7 +1019,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.25  2002-04-21 19:02:07  peter
+  Revision 1.26  2002-04-25 20:16:40  peter
+    * moved more routines from cga/n386util
+
+  Revision 1.25  2002/04/21 19:02:07  peter
     * removed newn and disposen nodes, the code is now directly
       inlined from pexpr
     * -an option that will write the secondpass nodes to the .s file, this

compiler/i386/n386util.pas

@@ -38,14 +38,8 @@ interface
 {$ifdef TEMPS_NOT_PUSH}
     procedure restorefromtemp(p : tnode;isint64 : boolean);
 {$endif TEMPS_NOT_PUSH}
-    procedure pushsetelement(p : tnode);
     procedure push_value_para(p:tnode;inlined,is_cdecl:boolean;
                               para_offset:longint;alignment : longint);
-    procedure loadshortstring(source,dest : tnode);
-    procedure loadlongstring(p:tbinarynode);
-    procedure loadansi2short(source,dest : tnode);
-    procedure loadwide2short(source,dest : tnode);
-    procedure loadinterfacecom(p: tbinarynode);
 
     procedure emitoverflowcheck(p:tnode);
     procedure firstcomplex(p : tbinarynode);
@@ -302,510 +296,172 @@ implementation
 {$endif TEMPS_NOT_PUSH}
 
 
-    procedure pushsetelement(p : tnode);
-      begin
-      { copy the element on the stack, slightly complicated }
-        if p.nodetype=ordconstn then
-         begin
-           if aktalignment.paraalign=4 then
-             exprasmList.concat(Taicpu.Op_const(A_PUSH,S_L,tordconstnode(p).value))
-           else
-             exprasmList.concat(Taicpu.Op_const(A_PUSH,S_W,tordconstnode(p).value));
-         end
-        else
-         begin
-           case p.location.loc of
-             LOC_REGISTER,
-             LOC_CREGISTER :
-               begin
-                 if aktalignment.paraalign=4 then
-                   exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,rg.makeregsize(p.location.register,OS_16)))
-                 else
-                   exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_W,rg.makeregsize(p.location.register,OS_32)));
-                 rg.ungetregisterint(exprasmlist,p.location.register);
-               end;
-           else
-             begin
-               { you can't push more bytes than the size of the element, }
-               { because this may cross a page boundary and you'll get a }
-               { sigsegv (JM)                                            }
-               emit_push_mem_size(p.location.reference,1);
-               reference_release(exprasmlist,p.location.reference);
-             end;
-           end;
-         end;
-      end;
-
     procedure push_value_para(p:tnode;inlined,is_cdecl:boolean;
                                 para_offset:longint;alignment : longint);
       var
         tempreference : treference;
-        r : treference;
-        opsize : topsize;
+        href : treference;
         hreg : tregister;
+        sizetopush,
         size : longint;
-        hlabel : tasmlabel;
         cgsize : tcgsize;
       begin
-        case p.location.loc of
-           LOC_REGISTER,
-           LOC_CREGISTER:
-             begin
-               cgsize:=def_cgsize(p.resulttype.def);
-               if cgsize in [OS_64,OS_S64] then
-                begin
-                  inc(pushedparasize,8);
-                  if inlined then
-                   begin
-                     reference_reset_base(r,procinfo^.framepointer,para_offset-pushedparasize);
-                     tcg64f32(cg).a_load64_loc_ref(exprasmlist,p.location,r);
-                   end
-                  else
-                   tcg64f32(cg).a_param64_loc(exprasmlist,p.location,-1);
-                end
-               else
-                begin
-                  { save old register }
-                  hreg:=p.location.register;
-                  { update register to use to match alignment }
-                  case cgsize of
-                    OS_8,OS_S8 :
-                      begin
-                        if alignment=4 then
-                         cgsize:=OS_32
-                        else
-                         cgsize:=OS_16;
-                      end;
-                    OS_16,OS_S16 :
-                      begin
-                        if alignment=4 then
-                         cgsize:=OS_32;
-                      end;
-                  end;
-                  p.location.register:=rg.makeregsize(p.location.register,cgsize);
-                  inc(pushedparasize,alignment);
-                  if inlined then
-                   begin
-                     reference_reset_base(r,procinfo^.framepointer,para_offset-pushedparasize);
-                     cg.a_load_loc_ref(exprasmlist,p.location,r);
-                   end
-                  else
-                   cg.a_param_loc(exprasmlist,p.location,-1);
-                  { restore old register }
-                  p.location.register:=hreg;
-                end;
-               location_release(exprasmlist,p.location);
-             end;
-           LOC_CONSTANT :
-             begin
-               cgsize:=def_cgsize(p.resulttype.def);
-               if cgsize in [OS_64,OS_S64] then
-                begin
-                  inc(pushedparasize,8);
-                  if inlined then
-                   begin
-                     reference_reset_base(r,procinfo^.framepointer,para_offset-pushedparasize);
-                     tcg64f32(cg).a_load64_loc_ref(exprasmlist,p.location,r);
-                   end
-                  else
-                   tcg64f32(cg).a_param64_loc(exprasmlist,p.location,-1);
-                end
-               else
-                begin
-                  case cgsize of
-                    OS_8,OS_S8 :
-                      begin
-                        if alignment=4 then
-                         cgsize:=OS_32
-                        else
-                         cgsize:=OS_16
-                      end;
-                    OS_16,OS_S16 :
-                      begin
-                        if alignment=4 then
-                         cgsize:=OS_32;
-                      end;
-                  end;
-                  inc(pushedparasize,alignment);
-                  if inlined then
-                   begin
-                     reference_reset_base(r,procinfo^.framepointer,para_offset-pushedparasize);
-                     cg.a_load_loc_ref(exprasmlist,p.location,r);
-                   end
-                  else
-                   cg.a_param_loc(exprasmlist,p.location,-1);
-                end;
-               location_release(exprasmlist,p.location);
-             end;
-           LOC_FPUREGISTER,
-           LOC_CFPUREGISTER:
-             begin
-                size:=align(tfloatdef(p.resulttype.def).size,alignment);
-                inc(pushedparasize,size);
-                if not inlined then
-                 emit_const_reg(A_SUB,S_L,size,R_ESP);
+        { Move flags and jump in register to make it less complex }
+        if p.location.loc in [LOC_FLAGS,LOC_JUMP] then
+         location_force_reg(p.location,def_cgsize(p.resulttype.def),false);
+
+        { Handle Floating point types differently }
+        if p.resulttype.def.deftype=floatdef then
+         begin
+           case p.location.loc of
+             LOC_FPUREGISTER,
+             LOC_CFPUREGISTER:
+               begin
+                  size:=align(tfloatdef(p.resulttype.def).size,alignment);
+                  inc(pushedparasize,size);
+                  if not inlined then
+                   emit_const_reg(A_SUB,S_L,size,R_ESP);
 {$ifdef GDB}
-                if (cs_debuginfo in aktmoduleswitches) and
-                   (exprasmList.first=exprasmList.last) then
-                  exprasmList.concat(Tai_force_line.Create);
+                  if (cs_debuginfo in aktmoduleswitches) and
+                     (exprasmList.first=exprasmList.last) then
+                    exprasmList.concat(Tai_force_line.Create);
 {$endif GDB}
 
-                { this is the easiest case for inlined !! }
-                if inlined then
-                 reference_reset_base(r,procinfo^.framepointer,para_offset-pushedparasize)
-                else
-                 reference_reset_base(r,R_ESP,0);
-
-                cg.a_loadfpu_reg_ref(exprasmlist,
-                  def_cgsize(p.resulttype.def),p.location.register,r);
-             end;
-           LOC_REFERENCE,LOC_CREFERENCE:
-             begin
-                tempreference:=p.location.reference;
-                reference_release(exprasmlist,p.location.reference);
-                case p.resulttype.def.deftype of
-                  enumdef,
-                  orddef :
-                    begin
-                      case p.resulttype.def.size of
-                       8 : begin
-                             inc(pushedparasize,8);
-                             if inlined then
-                               begin
-                                 rg.getexplicitregisterint(exprasmlist,R_EDI);
-                                 emit_ref_reg(A_MOV,S_L,tempreference,R_EDI);
-                                 reference_reset_base(r,procinfo^.framepointer,para_offset-pushedparasize);
-                                 exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
-                                 inc(tempreference.offset,4);
-                                 emit_ref_reg(A_MOV,S_L,tempreference,R_EDI);
-                                 reference_reset_base(r,procinfo^.framepointer,para_offset-pushedparasize+4);
-                                 exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
-                                 rg.ungetregisterint(exprasmlist,R_EDI);
-                               end
-                             else
-                               begin
-                                 inc(tempreference.offset,4);
-                                 emit_push_mem(tempreference);
-                                 dec(tempreference.offset,4);
-                                 emit_push_mem(tempreference);
-                               end;
-                           end;
-                       4 : begin
-                             inc(pushedparasize,4);
-                             if inlined then
-                               begin
-                                 rg.getexplicitregisterint(exprasmlist,R_EDI);
-                                 emit_ref_reg(A_MOV,S_L,tempreference,R_EDI);
-                                 reference_reset_base(r,procinfo^.framepointer,para_offset-pushedparasize);
-                                 exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
-                                 rg.ungetregisterint(exprasmlist,R_EDI);
-                               end
+                  { this is the easiest case for inlined !! }
+                  if inlined then
+                   reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize)
+                  else
+                   reference_reset_base(href,R_ESP,0);
+
+                  cg.a_loadfpu_reg_ref(exprasmlist,
+                    def_cgsize(p.resulttype.def),p.location.register,href);
+               end;
+             LOC_REFERENCE,
+             LOC_CREFERENCE :
+               begin
+                 sizetopush:=align(p.resulttype.def.size,alignment);
+                 tempreference:=p.location.reference;
+                 inc(tempreference.offset,sizetopush);
+                 while (sizetopush>0) do
+                  begin
+                    if sizetopush>=4 then
+                     begin
+                       cgsize:=OS_32;
+                       inc(pushedparasize,4);
+                       dec(tempreference.offset,4);
+                       dec(sizetopush,4);
+                     end
+                    else
+                     begin
+                       cgsize:=OS_16;
+                       inc(pushedparasize,2);
+                       dec(tempreference.offset,2);
+                       dec(sizetopush,2);
+                     end;
+                    if inlined then
+                     begin
+                       reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                       cg.a_load_ref_ref(exprasmlist,cgsize,tempreference,href);
+                     end
+                    else
+                     cg.a_param_ref(exprasmlist,cgsize,tempreference,-1);
+                  end;
+               end;
+             else
+               internalerror(200204243);
+           end;
+         end
+        else
+         begin
+           { call by value open array ? }
+           if is_cdecl and
+              push_addr_param(p.resulttype.def) then
+            begin
+              if not (p.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
+                internalerror(200204241);
+              { push on stack }
+              size:=align(p.resulttype.def.size,alignment);
+              inc(pushedparasize,size);
+              emit_const_reg(A_SUB,S_L,size,R_ESP);
+              reference_reset_base(href,R_ESP,0);
+              cg.g_concatcopy(exprasmlist,p.location.reference,href,size,false,false);
+            end
+           else
+            begin
+              case p.location.loc of
+                LOC_CONSTANT,
+                LOC_REGISTER,
+                LOC_CREGISTER,
+                LOC_REFERENCE,
+                LOC_CREFERENCE :
+                  begin
+                    cgsize:=def_cgsize(p.resulttype.def);
+                    if cgsize in [OS_64,OS_S64] then
+                     begin
+                       inc(pushedparasize,8);
+                       if inlined then
+                        begin
+                          reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                          tcg64f32(cg).a_load64_loc_ref(exprasmlist,p.location,href);
+                        end
+                       else
+                        tcg64f32(cg).a_param64_loc(exprasmlist,p.location,-1);
+                     end
+                    else
+                     begin
+                       case cgsize of
+                         OS_8,OS_S8 :
+                           begin
+                             if alignment=4 then
+                              cgsize:=OS_32
                              else
-                               emit_push_mem(tempreference);
+                              cgsize:=OS_16;
                            end;
-                     1,2 : begin
+                         OS_16,OS_S16 :
+                           begin
                              if alignment=4 then
-                              begin
-                                opsize:=S_L;
-                                hreg:=R_EDI;
-                                inc(pushedparasize,4);
-                              end
-                             else
-                              begin
-                                opsize:=S_W;
-                                hreg:=R_DI;
-                                inc(pushedparasize,2);
-                              end;
-                             if inlined then
-                              begin
-                                rg.getexplicitregisterint(exprasmlist,R_EDI);
-                                emit_ref_reg(A_MOV,opsize,tempreference,hreg);
-                                reference_reset_base(r,procinfo^.framepointer,para_offset-pushedparasize);
-                                exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,opsize,hreg,r));
-                                rg.ungetregisterint(exprasmlist,R_EDI);
-                              end
-                             else
-                              emit_push_mem_size(tempreference,p.resulttype.def.size);
+                              cgsize:=OS_32;
                            end;
-                         else
-                           internalerror(234231);
-                      end;
-                    end;
-                  floatdef :
-                    begin
-                      case tfloatdef(p.resulttype.def).typ of
-                        s32real :
-                          begin
-                             inc(pushedparasize,4);
-                             if inlined then
-                               begin
-                                  rg.getexplicitregisterint(exprasmlist,R_EDI);
-                                  emit_ref_reg(A_MOV,S_L,tempreference,R_EDI);
-                                  reference_reset_base(r,procinfo^.framepointer,para_offset-pushedparasize);
-                                  exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
-                                  rg.ungetregisterint(exprasmlist,R_EDI);
-                               end
-                             else
-                               emit_push_mem(tempreference);
-                          end;
-                        s64real,
-                        s64comp :
-                          begin
-                            inc(pushedparasize,4);
-                            inc(tempreference.offset,4);
-                            if inlined then
-                              begin
-                                 rg.getexplicitregisterint(exprasmlist,R_EDI);
-                                 emit_ref_reg(A_MOV,S_L,tempreference,R_EDI);
-                                 reference_reset_base(r,procinfo^.framepointer,para_offset-pushedparasize);
-                                 exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
-                                 rg.ungetregisterint(exprasmlist,R_EDI);
-                              end
-                            else
-                              emit_push_mem(tempreference);
-                            inc(pushedparasize,4);
-                            dec(tempreference.offset,4);
-                            if inlined then
-                              begin
-                                 rg.getexplicitregisterint(exprasmlist,R_EDI);
-                                 emit_ref_reg(A_MOV,S_L,tempreference,R_EDI);
-                                 reference_reset_base(r,procinfo^.framepointer,para_offset-pushedparasize);
-                                 exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
-                                 rg.ungetregisterint(exprasmlist,R_EDI);
-                              end
-                            else
-                              emit_push_mem(tempreference);
-                          end;
-                        s80real :
-                          begin
-                            inc(pushedparasize,4);
-                            if alignment=4 then
-                              inc(tempreference.offset,8)
-                            else
-                              inc(tempreference.offset,6);
-                            if inlined then
-                              begin
-                                 rg.getexplicitregisterint(exprasmlist,R_EDI);
-                                 emit_ref_reg(A_MOV,S_L,tempreference,R_EDI);
-                                 reference_reset_base(r,procinfo^.framepointer,para_offset-pushedparasize);
-                                 exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
-                                 rg.ungetregisterint(exprasmlist,R_EDI);
-                              end
-                            else
-                              emit_push_mem(tempreference);
-                            dec(tempreference.offset,4);
-                            inc(pushedparasize,4);
-                            if inlined then
-                              begin
-                                 rg.getexplicitregisterint(exprasmlist,R_EDI);
-                                 emit_ref_reg(A_MOV,S_L,tempreference,R_EDI);
-                                 reference_reset_base(r,procinfo^.framepointer,para_offset-pushedparasize);
-                                 exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
-                                 rg.ungetregisterint(exprasmlist,R_EDI);
-                              end
-                            else
-                              emit_push_mem(tempreference);
-                            if alignment=4 then
-                              begin
-                                opsize:=S_L;
-                                hreg:=R_EDI;
-                                inc(pushedparasize,4);
-                                dec(tempreference.offset,4);
-                              end
-                            else
-                              begin
-                                opsize:=S_W;
-                                hreg:=R_DI;
-                                inc(pushedparasize,2);
-                                dec(tempreference.offset,2);
-                              end;
-                            if inlined then
-                              begin
-                                 rg.getexplicitregisterint(exprasmlist,R_EDI);
-                                 emit_ref_reg(A_MOV,opsize,tempreference,hreg);
-                                 reference_reset_base(r,procinfo^.framepointer,para_offset-pushedparasize);
-                                 exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,opsize,hreg,r));
-                                 rg.ungetregisterint(exprasmlist,R_EDI);
-                              end
-                            else
-                              exprasmList.concat(Taicpu.Op_ref(A_PUSH,opsize,tempreference));
+                       end;
+                       { update register to use to match alignment }
+                       if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
+                        begin
+                          hreg:=p.location.register;
+                          p.location.register:=rg.makeregsize(p.location.register,cgsize);
                         end;
-                      end;
-                    end;
-                  pointerdef,
-                  procvardef,
-                  classrefdef:
-                    begin
-                       inc(pushedparasize,4);
+                       inc(pushedparasize,alignment);
                        if inlined then
-                         begin
-                            rg.getexplicitregisterint(exprasmlist,R_EDI);
-                            emit_ref_reg(A_MOV,S_L,tempreference,R_EDI);
-                            reference_reset_base(r,procinfo^.framepointer,para_offset-pushedparasize);
-                            exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
-                            rg.ungetregisterint(exprasmlist,R_EDI);
-                         end
-                       else
-                         emit_push_mem(tempreference);
-                    end;
-                  arraydef,
-                  recorddef,
-                  stringdef,
-                  setdef,
-                  objectdef :
-                    begin
-                       { even some structured types are 32 bit }
-                       if is_widestring(p.resulttype.def) or
-                          is_ansistring(p.resulttype.def) or
-                          is_smallset(p.resulttype.def) or
-                          ((p.resulttype.def.deftype in [recorddef,arraydef]) and
-                           (
-                            (p.resulttype.def.deftype<>arraydef) or not
-                            (tarraydef(p.resulttype.def).IsConstructor or
-                             tarraydef(p.resulttype.def).isArrayOfConst or
-                             is_open_array(p.resulttype.def))
-                           ) and
-                           (p.resulttype.def.size<=4)
-                          ) or
-                          is_class(p.resulttype.def) or
-                          is_interface(p.resulttype.def) then
-                         begin
-                            if (p.resulttype.def.size>2) or
-                               ((alignment=4) and (p.resulttype.def.size>0)) then
-                              begin
-                                inc(pushedparasize,4);
-                                if inlined then
-                                  begin
-                                    reference_reset_base(r,procinfo^.framepointer,para_offset-pushedparasize);
-                                    concatcopy(tempreference,r,4,false,false);
-                                  end
-                                else
-                                  emit_push_mem(tempreference);
-                              end
-                            else
-                              begin
-                                if p.resulttype.def.size>0 then
-                                  begin
-                                    inc(pushedparasize,2);
-                                    if inlined then
-                                      begin
-                                        reference_reset_base(r,procinfo^.framepointer,para_offset-pushedparasize);
-                                        concatcopy(tempreference,r,2,false,false);
-                                      end
-                                    else
-                                      exprasmList.concat(Taicpu.Op_ref(A_PUSH,S_W,tempreference));
-                                  end;
-                              end;
-                         end
-                       { call by value open array ? }
-                       else if is_cdecl then
-                         begin
-                           { push on stack }
-                           size:=align(p.resulttype.def.size,alignment);
-                           inc(pushedparasize,size);
-                           emit_const_reg(A_SUB,S_L,size,R_ESP);
-                           reference_reset_base(r,R_ESP,0);
-                           concatcopy(tempreference,r,size,false,false);
-                         end
+                        begin
+                          reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                          cg.a_load_loc_ref(exprasmlist,p.location,href);
+                        end
                        else
-                         internalerror(8954);
-                    end;
-                  else
-                    CGMessage(cg_e_illegal_expression);
-                end;
-             end;
-           LOC_JUMP:
-             begin
-                getlabel(hlabel);
-                if alignment=4 then
-                 begin
-                   opsize:=S_L;
-                   inc(pushedparasize,4);
-                 end
-                else
-                 begin
-                   opsize:=S_W;
-                   inc(pushedparasize,2);
-                 end;
-                emitlab(truelabel);
-                if inlined then
-                  begin
-                     reference_reset_base(r,procinfo^.framepointer,para_offset-pushedparasize);
-                     emit_const_ref(A_MOV,opsize,1,r);
-                  end
-                else
-                  exprasmList.concat(Taicpu.Op_const(A_PUSH,opsize,1));
-                emitjmp(C_None,hlabel);
-                emitlab(falselabel);
-                if inlined then
-                  begin
-                     reference_reset_base(r,procinfo^.framepointer,para_offset-pushedparasize);
-                     emit_const_ref(A_MOV,opsize,0,r);
-                  end
-                else
-                  exprasmList.concat(Taicpu.Op_const(A_PUSH,opsize,0));
-                emitlab(hlabel);
-             end;
-           LOC_FLAGS:
-             begin
-                if alignment=4 then
-                 begin
-                   opsize:=S_L;
-                   hreg:=R_EAX;
-                   inc(pushedparasize,4);
-                 end
-                else
-                 begin
-                   opsize:=S_W;
-                   hreg:=R_AX;
-                   inc(pushedparasize,2);
-                 end;
-                if not(R_EAX in rg.unusedregsint) then
-                  begin
-                    rg.getexplicitregisterint(exprasmlist,R_EDI);
-                    emit_reg_reg(A_MOV,S_L,R_EAX,R_EDI);
-                  end;
-                cg.g_flags2reg(exprasmlist,p.location.resflags,hreg);
-                if inlined then
-                  begin
-                     reference_reset_base(r,procinfo^.framepointer,para_offset-pushedparasize);
-                     exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,opsize,hreg,r));
-                  end
-                else
-                  exprasmList.concat(Taicpu.Op_reg(A_PUSH,opsize,hreg));
-                if not(R_EAX in rg.unusedregsint) then
-                  begin
-                    emit_reg_reg(A_MOV,S_L,R_EDI,R_EAX);
-                    rg.ungetregisterint(exprasmlist,R_EDI);
+                        cg.a_param_loc(exprasmlist,p.location,-1);
+                       { restore old register }
+                       if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
+                         p.location.register:=hreg;
+                     end;
+                    location_release(exprasmlist,p.location);
                   end;
-             end;
 {$ifdef SUPPORT_MMX}
-           LOC_MMXREGISTER,
-           LOC_CMMXREGISTER:
-             begin
-                inc(pushedparasize,8); { was missing !!! (PM) }
-                emit_const_reg(
-                  A_SUB,S_L,8,R_ESP);
-{$ifdef GDB}
-                if (cs_debuginfo in aktmoduleswitches) and
-                   (exprasmList.first=exprasmList.last) then
-                  exprasmList.concat(Tai_force_line.Create);
-{$endif GDB}
-                if inlined then
+                LOC_MMXREGISTER,
+                LOC_CMMXREGISTER:
                   begin
-                     reference_reset_base(r,procinfo^.framepointer,para_offset-pushedparasize);
-                     exprasmList.concat(Taicpu.Op_reg_ref(A_MOVQ,S_NO,
-                       p.location.register,r));
-                  end
-                else
-                   begin
-                      reference_reset_base(r,R_ESP,0);
-                      exprasmList.concat(Taicpu.Op_reg_ref(
-                        A_MOVQ,S_NO,p.location.register,r));
-                   end;
-             end;
+                     inc(pushedparasize,8);
+                     if inlined then
+                       begin
+                          reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                          cg.a_loadmm_reg_ref(exprasmlist,p.location.register,href);
+                       end
+                     else
+                      cg.a_parammm_reg(exprasmlist,p.location.register);
+                  end;
 {$endif SUPPORT_MMX}
-        end;
+                else
+                  internalerror(200204241);
+              end;
+           end;
+         end;
       end;
 
 {*****************************************************************************
@@ -871,246 +527,13 @@ implementation
            p.swaped:=false; do not modify }
       end;
 
-{*****************************************************************************
-                           Emit Functions
-*****************************************************************************}
-
-    procedure push_shortstring_length(p:tnode);
-      var
-        hightree : tnode;
-        srsym    : tsym;
-      begin
-        if is_open_string(p.resulttype.def) then
-         begin
-           srsym:=searchsymonlyin(tloadnode(p).symtable,'high'+tvarsym(tloadnode(p).symtableentry).name);
-           hightree:=cloadnode.create(tvarsym(srsym),tloadnode(p).symtable);
-           firstpass(hightree);
-           secondpass(hightree);
-           push_value_para(hightree,false,false,0,4);
-           hightree.free;
-           hightree:=nil;
-         end
-        else
-         begin
-           push_int(tstringdef(p.resulttype.def).len);
-         end;
-      end;
-
-{*****************************************************************************
-                           String functions
-*****************************************************************************}
-
-    procedure loadshortstring(source,dest : tnode);
-    {
-      Load a string, handles stringdef and orddef (char) types
-    }
-      var
-        href: treference;
-      begin
-         case source.resulttype.def.deftype of
-            stringdef:
-              begin
-                 if (source.nodetype=stringconstn) and
-                   (str_length(source)=0) then
-                   emit_const_ref(A_MOV,S_B,0,dest.location.reference)
-                 else
-                   begin
-                     emitpushreferenceaddr(dest.location.reference);
-                     emitpushreferenceaddr(source.location.reference);
-                     push_shortstring_length(dest);
-                     emitcall('FPC_SHORTSTR_COPY');
-                     maybe_loadself;
-                   end;
-              end;
-            orddef:
-              begin
-                 if source.nodetype=ordconstn then
-                   emit_const_ref(
-                      A_MOV,S_W,tordconstnode(source).value*256+1,dest.location.reference)
-                 else
-                   begin
-                      if (source.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
-                        begin
-                           href := dest.location.reference;
-                           emit_const_ref(A_MOV,S_B,1,href);
-                           inc(href.offset,1);
-                           emit_reg_ref(A_MOV,S_B,rg.makeregsize(source.location.register,OS_8),href);
-                        end
-                      else
-                      { not so elegant (goes better with extra register    }
-                        begin
-                           { not "movl", because then we may read past the }
-                           { end of the heap! "movw" would be ok too, but  }
-                           { I don't think that would be faster (JM)       }
-                           rg.getexplicitregisterint(exprasmlist,R_EDI);
-                           emit_ref_reg(A_MOVZX,S_BL,source.location.reference,R_EDI);
-                           emit_const_reg(A_SHL,S_L,8,R_EDI);
-                           emit_const_reg(A_OR,S_L,1,R_EDI);
-                           emit_reg_ref(A_MOV,S_W,R_DI,dest.location.reference);
-                           rg.ungetregisterint(exprasmlist,R_EDI);
-                        end;
-                      location_release(exprasmlist,source.location);
-                   end;
-              end;
-         else
-           CGMessage(type_e_mismatch);
-         end;
-      end;
-
-    procedure loadlongstring(p:tbinarynode);
-    {
-      Load a string, handles stringdef and orddef (char) types
-    }
-      var
-         r : treference;
-
-      begin
-         case p.right.resulttype.def.deftype of
-            stringdef:
-              begin
-                 if (p.right.nodetype=stringconstn) and
-                   (str_length(p.right)=0) then
-                   emit_const_ref(A_MOV,S_L,0,p.left.location.reference)
-                 else
-                   begin
-                     emitpushreferenceaddr(p.left.location.reference);
-                     emitpushreferenceaddr(p.right.location.reference);
-                     push_shortstring_length(p.left);
-                     emitcall('FPC_LONGSTR_COPY');
-                     maybe_loadself;
-                   end;
-              end;
-            orddef:
-              begin
-                 emit_const_ref(A_MOV,S_L,1,p.left.location.reference);
-
-                 r:=p.left.location.reference;
-                 inc(r.offset,4);
-
-                 if p.right.nodetype=ordconstn then
-                   emit_const_ref(A_MOV,S_B,tordconstnode(p.right).value,r)
-                 else
-                   begin
-                      case p.right.location.loc of
-                         LOC_REGISTER,LOC_CREGISTER:
-                           emit_reg_ref(A_MOV,S_B,p.right.location.register,r);
-                         LOC_CREFERENCE,LOC_REFERENCE:
-                           begin
-                              if not(R_EAX in rg.unusedregsint) then
-                                emit_reg(A_PUSH,S_L,R_EAX);
-                              emit_ref_reg(A_MOV,S_B,p.right.location.reference,R_AL);
-                              emit_reg_ref(A_MOV,S_B,R_AL,r);
-                              if not(R_EAX in rg.unusedregsint) then
-                                emit_reg(A_POP,S_L,R_EAX);
-                           end
-                         else
-                           internalerror(20799);
-                        end;
-                        location_release(exprasmlist,p.right.location);
-                   end;
-              end;
-         else
-           CGMessage(type_e_mismatch);
-         end;
-      end;
-
-
-    procedure loadansi2short(source,dest : tnode);
-      var
-         pushed : tpushedsaved;
-         regs_to_push: tregisterset;
-      begin
-         { Find out which registers have to be pushed (JM) }
-         regs_to_push := all_registers;
-         remove_non_regvars_from_loc(source.location,regs_to_push);
-         { Push them (JM) }
-         rg.saveusedregisters(exprasmlist,pushed,regs_to_push);
-         location_freetemp(exprasmlist,source.location);
-         location_release(exprasmlist,source.location);
-         cg.a_param_loc(exprasmlist,source.location,1);
-         push_shortstring_length(dest);
-         emitpushreferenceaddr(dest.location.reference);
-         rg.saveregvars(exprasmlist,all_registers);
-         emitcall('FPC_ANSISTR_TO_SHORTSTR');
-         rg.restoreusedregisters(exprasmlist,pushed);
-         maybe_loadself;
-      end;
-
-
-    procedure loadwide2short(source,dest : tnode);
-      var
-         pushed : tpushedsaved;
-         regs_to_push: tregisterset;
-      begin
-         { Find out which registers have to be pushed (JM) }
-         regs_to_push := all_registers;
-         remove_non_regvars_from_loc(source.location,regs_to_push);
-         { Push them (JM) }
-         rg.saveusedregisters(exprasmlist,pushed,regs_to_push);
-         location_freetemp(exprasmlist,source.location);
-         location_release(exprasmlist,source.location);
-         cg.a_param_loc(exprasmlist,source.location,1);
-         push_shortstring_length(dest);
-         emitpushreferenceaddr(dest.location.reference);
-         rg.saveregvars(exprasmlist,all_registers);
-         emitcall('FPC_WIDESTR_TO_SHORTSTR');
-         rg.restoreusedregisters(exprasmlist,pushed);
-         maybe_loadself;
-      end;
-
-
-    procedure loadinterfacecom(p: tbinarynode);
-    {
-      copies an com interface from n.right to n.left, we
-      assume, that both sides are com interface, firstassignement have
-      to take care of that, an com interface can't be a register variable
-    }
-      var
-         pushed : tpushedsaved;
-         ungettemp : boolean;
-      begin
-         { before pushing any parameter, we have to save all used      }
-         { registers, but before that we have to release the       }
-         { registers of that node to save uneccessary pushed       }
-         { so be careful, if you think you can optimize that code (FK) }
-
-         { nevertheless, this has to be changed, because otherwise the }
-         { register is released before it's contents are pushed ->     }
-         { problems with the optimizer (JM)                         }
-         reference_release(exprasmlist,p.left.location.reference);
-         ungettemp:=false;
-         case p.right.location.loc of
-            LOC_REGISTER,LOC_CREGISTER:
-              begin
-                 rg.saveusedregisters(exprasmlist,pushed, all_registers - [p.right.location.register]);
-                 exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,p.right.location.register));
-              end;
-            LOC_REFERENCE,LOC_CREFERENCE:
-              begin
-                 rg.saveusedregisters(exprasmlist,pushed, all_registers
-                   - [p.right.location.reference.base]
-                   - [p.right.location.reference.index]);
-                 emit_push_mem(p.right.location.reference);
-                 ungettemp:=true;
-              end;
-         end;
-         location_release(exprasmlist,p.right.location);
-         emitpushreferenceaddr(p.left.location.reference);
-         location_release(exprasmlist,p.left.location);
-         rg.saveregvars(exprasmlist,all_registers);
-         emitcall('FPC_INTF_ASSIGN');
-         maybe_loadself;
-         rg.restoreusedregisters(exprasmlist,pushed);
-         if ungettemp then
-           location_release(exprasmlist,p.right.location);
-      end;
-
-
-
 end.
 {
   $Log$
-  Revision 1.34  2002-04-21 15:39:41  carl
+  Revision 1.35  2002-04-25 20:16:40  peter
+    * moved more routines from cga/n386util
+
+  Revision 1.34  2002/04/21 15:39:41  carl
   * changeregsize -> rg.makeregsize
 
   Revision 1.33  2002/04/20 21:37:07  carl

compiler/ncnv.pas

@@ -549,9 +549,8 @@ implementation
              stringpara := ccallparanode.create(left,nil);
              left := nil;
 
-             { hen converting to shortstrings, we have to pass high(destination) too }
-             if (tstringdef(resulttype.def).string_typ =
-                  st_shortstring) then
+             { when converting to shortstrings, we have to pass high(destination) too }
+             if (tstringdef(resulttype.def).string_typ = st_shortstring) then
                stringpara.right := ccallparanode.create(cinlinenode.create(
                  in_high_x,false,self.getcopy),nil);
 
@@ -1531,6 +1530,8 @@ implementation
 
 
     function tisnode.det_resulttype:tnode;
+      var
+        paras: tcallparanode;
       begin
          result:=nil;
          resulttypepass(left);
@@ -1556,6 +1557,15 @@ implementation
              end
             else
              CGMessage(type_e_mismatch);
+
+            { call fpc_do_is helper }
+            paras := ccallparanode.create(
+                         left,
+                     ccallparanode.create(
+                         right,nil));
+            result := ccallnode.createintern('fpc_do_is',paras);
+            left := nil;
+            right := nil;
           end
          else if is_interface(right.resulttype.def) then
           begin
@@ -1577,6 +1587,15 @@ implementation
              end
             else
              CGMessage(type_e_mismatch);
+
+            { call fpc_do_is helper }
+            paras := ccallparanode.create(
+                         left,
+                     ccallparanode.create(
+                         right,nil));
+            result := ccallnode.createintern('fpc_do_is',paras);
+            left := nil;
+            right := nil;
           end
          else
           CGMessage(type_e_mismatch);
@@ -1586,27 +1605,14 @@ implementation
 
 
     function tisnode.pass_1 : tnode;
-
-      var
-        paras: tcallparanode;
-
       begin
-         if (right.resulttype.def.deftype=classrefdef) then
-          begin
-            paras := ccallparanode.create(left,ccallparanode.create(right,nil));
-            left := nil;
-            right := nil;
-            result := ccallnode.createintern('fpc_do_is',paras);
-            firstpass(result);
-          end
-         else
-          result:=nil;
+        internalerror(200204254);
+        result:=nil;
       end;
 
     { dummy pass_2, it will never be called, but we need one since }
     { you can't instantiate an abstract class                      }
     procedure tisnode.pass_2;
-
       begin
       end;
 
@@ -1623,6 +1629,8 @@ implementation
 
 
     function tasnode.det_resulttype:tnode;
+      var
+        paras : tcallparanode;
       begin
          result:=nil;
          resulttypepass(right);
@@ -1648,7 +1656,15 @@ implementation
              end
             else
              CGMessage(type_e_mismatch);
-            resulttype:=tclassrefdef(right.resulttype.def).pointertype;
+
+            { call fpc_do_as helper }
+            paras := ccallparanode.create(
+                         left,
+                     ccallparanode.create(
+                         right,nil));
+            result := ccallnode.createinternres('fpc_do_as',paras,tclassrefdef(right.resulttype.def).pointertype);
+            left := nil;
+            right := nil;
           end
          else if is_interface(right.resulttype.def) then
           begin
@@ -1670,7 +1686,15 @@ implementation
              end
             else
              CGMessage(type_e_mismatch);
-            resulttype:=right.resulttype;
+
+            { call fpc_do_as helper }
+            paras := ccallparanode.create(
+                         left,
+                     ccallparanode.create(
+                         right,nil));
+            result := ccallnode.createinternres('fpc_do_as',paras,right.resulttype);
+            left := nil;
+            right := nil;
           end
          else
           CGMessage(type_e_mismatch);
@@ -1678,29 +1702,15 @@ implementation
 
 
     function tasnode.pass_1 : tnode;
-
-      var
-        paras: tcallparanode;
-
       begin
-         if (right.resulttype.def.deftype=classrefdef) then
-          begin
-            paras := ccallparanode.create(left,ccallparanode.create(right,nil));
-            left := nil;
-            right := nil;
-            result := ccallnode.createinternres('fpc_do_as',paras,
-              resulttype);
-            firstpass(result);
-          end
-         else
-          result:=nil;
+        internalerror(200204252);
+        result:=nil;
       end;
 
 
     { dummy pass_2, it will never be called, but we need one since }
     { you can't instantiate an abstract class                      }
     procedure tasnode.pass_2;
-
       begin
       end;
 
@@ -1712,7 +1722,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.53  2002-04-23 19:16:34  peter
+  Revision 1.54  2002-04-25 20:16:38  peter
+    * moved more routines from cga/n386util
+
+  Revision 1.53  2002/04/23 19:16:34  peter
     * add pinline unit that inserts compiler supported functions using
       one or more statements
     * moved finalize and setlength from ninl to pinline

compiler/nld.pas

@@ -124,7 +124,7 @@ implementation
       cutils,verbose,globtype,globals,systems,
       symtable,types,
       htypechk,pass_1,
-      ncnv,nmem,ncal,cpubase,rgobj,cginfo,cgbase
+      ncon,ninl,ncnv,nmem,ncal,cpubase,rgobj,cginfo,cgbase
       ;
 
 
@@ -422,6 +422,7 @@ implementation
     function tassignmentnode.det_resulttype:tnode;
       var
         hp : tnode;
+        useshelper : boolean;
       begin
         result:=nil;
         resulttype:=voidtype;
@@ -446,6 +447,9 @@ implementation
         if is_open_array(left.resulttype.def) then
           CGMessage(type_e_mismatch);
 
+        { test if node can be assigned, properties are allowed }
+        valid_for_assignment(left);
+
         { assigning nil to a dynamic array clears the array }
         if is_dynamic_array(left.resulttype.def) and
            (right.nodetype=niln) then
@@ -458,45 +462,10 @@ implementation
            exit;
          end;
 
-        { some string functions don't need conversion, so treat them separatly }
-        if not (
-                is_shortstring(left.resulttype.def) and
-                (
-                 is_shortstring(right.resulttype.def) or
-                 is_ansistring(right.resulttype.def) or
-                 is_char(right.resulttype.def)
-                )
-               ) then
-         inserttypeconv(right,left.resulttype);
-
-        { test if node can be assigned, properties are allowed }
-        valid_for_assignment(left);
-
-        { check if local proc/func is assigned to procvar }
-        if right.resulttype.def.deftype=procvardef then
-          test_local_to_procvar(tprocvardef(right.resulttype.def),left.resulttype.def);
-      end;
-
-
-    function tassignmentnode.pass_1 : tnode;
-      begin
-         result:=nil;
-
-         firstpass(left);
-         firstpass(right);
-         if codegenerror then
-           exit;
-
-         { some string functions don't need conversion, so treat them separatly }
-         if is_shortstring(left.resulttype.def) and
-            (
-             is_shortstring(right.resulttype.def) or
-             is_ansistring(right.resulttype.def) or
-             is_char(right.resulttype.def)
-            ) then
-          begin
-            { we call STRCOPY }
-            procinfo^.flags:=procinfo^.flags or pi_do_call;
+        { shortstring helpers can do the conversion directly,
+          so treat them separatly }
+        if (is_shortstring(left.resulttype.def)) then
+         begin
             { test for s:=s+anything ... }
             { the problem is for
               s:=s+s+s;
@@ -508,7 +477,8 @@ implementation
             if (cs_UncertainOpts in aktglobalswitches) then
               begin
                 hp := right;
-                while hp.treetype=addn do hp:=hp.left;
+                while hp.treetype=addn do
+                  hp:=hp.left;
                 if equal_trees(left,hp) and
                    not multiple_uses(left,right) then
                   begin
@@ -522,7 +492,69 @@ implementation
                   end;
               end;
 {$endif newoptimizations2}
-          end;
+
+           { insert typeconv, except for chars that are handled in
+             secondpass and except for ansi/wide string that can
+             be converted immediatly }
+           if not(is_char(right.resulttype.def) or
+                  (right.resulttype.def.deftype=stringdef)) then
+             inserttypeconv(right,left.resulttype);
+           if right.resulttype.def.deftype=stringdef then
+            begin
+              useshelper:=true;
+              { convert constant strings to shortstrings. But
+                skip empty constant strings, that will be handled
+                in secondpass }
+              if (right.nodetype=stringconstn) then
+               begin
+                 inserttypeconv(right,left.resulttype);
+                 if (tstringconstnode(right).len=0) then
+                  useshelper:=false;
+               end;
+              if useshelper then
+               begin
+                 hp:=ccallparanode.create
+                         (right,
+                     ccallparanode.create(cinlinenode.create
+                         (in_high_x,false,left.getcopy),nil));
+                 result:=ccallnode.createinternreturn('fpc_'+tstringdef(right.resulttype.def).stringtypname+'_to_shortstr',hp,left);
+                 left:=nil;
+                 right:=nil;
+                 exit;
+               end;
+            end;
+         end
+        else
+         inserttypeconv(right,left.resulttype);
+
+        { call helpers for interface }
+        if is_interfacecom(left.resulttype.def) then
+         begin
+           hp:=ccallparanode.create
+                   (right,
+               ccallparanode.create(caddrnode.create
+                   (left),nil));
+           hp:=ccallparanode.create(right,nil);
+           result:=ccallnode.createintern('fpc_intf_assign',hp);
+           left:=nil;
+           right:=nil;
+           exit;
+         end;
+
+        { check if local proc/func is assigned to procvar }
+        if right.resulttype.def.deftype=procvardef then
+          test_local_to_procvar(tprocvardef(right.resulttype.def),left.resulttype.def);
+      end;
+
+
+    function tassignmentnode.pass_1 : tnode;
+      begin
+         result:=nil;
+
+         firstpass(left);
+         firstpass(right);
+         if codegenerror then
+           exit;
 
          registers32:=left.registers32+right.registers32;
          registersfpu:=max(left.registersfpu,right.registersfpu);
@@ -924,7 +956,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.37  2002-04-23 19:16:34  peter
+  Revision 1.38  2002-04-25 20:16:39  peter
+    * moved more routines from cga/n386util
+
+  Revision 1.37  2002/04/23 19:16:34  peter
     * add pinline unit that inserts compiler supported functions using
       one or more statements
     * moved finalize and setlength from ninl to pinline

compiler/symdef.pas

@@ -2686,6 +2686,7 @@ implementation
 
     function tarraydef.size : longint;
       var
+        newsize,
         cachedsize: TConstExprInt;
       begin
         if IsDynamicArray then
@@ -2708,7 +2709,15 @@ implementation
             Message(sym_e_segment_too_large);
             size := 4
           End
-        Else size:=longint((highrange-lowrange+1)*cachedsize);
+        Else
+          begin
+            newsize:=(int64(highrange)-int64(lowrange)+1)*cachedsize;
+            { prevent an overflow }
+            if newsize>high(longint) then
+             size:=high(longint)
+            else
+             size:=newsize;
+          end
       end;
 
 
@@ -5470,7 +5479,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.74  2002-04-23 19:16:35  peter
+  Revision 1.75  2002-04-25 20:16:39  peter
+    * moved more routines from cga/n386util
+
+  Revision 1.74  2002/04/23 19:16:35  peter
     * add pinline unit that inserts compiler supported functions using
       one or more statements
     * moved finalize and setlength from ninl to pinline

compiler/tainst.pas

@@ -59,6 +59,10 @@ Type
 
 implementation
 
+    uses
+      verbose;
+
+
 {*****************************************************************************
                                  TaiRegAlloc
 *****************************************************************************}
@@ -140,6 +144,8 @@ implementation
 
     procedure tainstruction.loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
       begin
+        if not assigned(s) then
+         internalerror(200204251);
         if opidx>=ops then
          ops:=opidx+1;
         with oper[opidx] do
@@ -150,9 +156,7 @@ implementation
            symofs:=sofs;
            typ:=top_symbol;
          end;
-        { Mark the symbol as used }
-        if assigned(s) then
-         inc(s.refs);
+        inc(s.refs);
       end;
 
 
@@ -242,7 +246,10 @@ end.
 
 {
   $Log$
-  Revision 1.4  2002-04-02 17:11:32  peter
+  Revision 1.5  2002-04-25 20:16:39  peter
+    * moved more routines from cga/n386util
+
+  Revision 1.4  2002/04/02 17:11:32  peter
     * tlocation,treference update
     * LOC_CONSTANT added for better constant handling
     * secondadd splitted in multiple routines

compiler/types.pas

@@ -75,7 +75,7 @@ interface
     {# Returns true, if def defines a signed data type (only for ordinal types) }
     function is_signed(def : tdef) : boolean;
 
-    {# Returns true whether def_from's range is comprised in def_to's if both are 
+    {# Returns true whether def_from's range is comprised in def_to's if both are
       orddefs, false otherwise                                              }
     function is_in_limit(def_from,def_to : tdef) : boolean;
 
@@ -85,9 +85,9 @@ interface
 
     {# Returns true, if p points to a zero based (non special like open or
       dynamic array def).
-      
+
       This is mainly used to see if the array
-      is convertable to a pointer 
+      is convertable to a pointer
     }
     function is_zero_based_array(p : tdef) : boolean;
 
@@ -106,10 +106,10 @@ interface
     {# Returns true, if p points to an array of const }
     function is_array_of_const(p : tdef) : boolean;
 
-    {# Returns true, if p points any kind of special array 
-    
+    {# Returns true, if p points any kind of special array
+
        That is if the array is an open array, a variant
-       array, an array constants constructor, or an 
+       array, an array constants constructor, or an
        array of const.
     }
     function is_special_array(p : tdef) : boolean;
@@ -162,16 +162,16 @@ interface
 
     function push_high_param(def : tdef) : boolean;
 
-    {# Returns true if a parameter is too large to copy and only the address is pushed 
+    {# Returns true if a parameter is too large to copy and only the address is pushed
     }
     function push_addr_param(def : tdef) : boolean;
 
     {# Returns true, if def1 and def2 are semantically the same }
     function is_equal(def1,def2 : tdef) : boolean;
 
-    {# Checks for type compatibility (subgroups of type)  
-       used for case statements... probably missing stuff 
-       to use on other types                              
+    {# Checks for type compatibility (subgroups of type)
+       used for case statements... probably missing stuff
+       to use on other types
     }
     function is_subequal(def1, def2: tdef): boolean;
 
@@ -224,11 +224,11 @@ interface
 
     function equal_constsym(sym1,sym2:tconstsym):boolean;
 
-    {# true, if two parameter lists are equal        
-      if acp is cp_none, all have to match exactly  
-      if acp is cp_value_equal_const call by value  
-      and call by const parameter are assumed as    
-      equal                                         
+    {# true, if two parameter lists are equal
+      if acp is cp_none, all have to match exactly
+      if acp is cp_value_equal_const call by value
+      and call by const parameter are assumed as
+      equal
     }
     { if acp is cp_all the var const or nothing are considered equal }
     type
@@ -249,7 +249,7 @@ interface
     function get_proc_2_procvar_def(p:tprocsym;d:tprocvardef):tprocdef;
 
     {# If @var(l) isn't in the range of def a range check error (if not explicit) is generated and
-      the value is placed within the range 
+      the value is placed within the range
     }
     procedure testrange(def : tdef;var l : tconstexprint;explicit:boolean);
 
@@ -1970,7 +1970,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.68  2002-04-15 19:08:22  carl
+  Revision 1.69  2002-04-25 20:16:39  peter
+    * moved more routines from cga/n386util
+
+  Revision 1.68  2002/04/15 19:08:22  carl
   + target_info.size_of_pointer -> pointer_size
   + some cleanup of unused types/variables