浏览代码

* removed some more routines from cga
* moved location_force_reg/mem to ncgutil
* moved arrayconstructnode secondpass to ncgld

peter 23 年之前
父节点
当前提交
8d0751ff97

+ 6 - 102
compiler/i386/cga.pas

@@ -64,9 +64,6 @@ interface
 
     procedure emitcall(const routine:string);
 
-    procedure emit_mov_ref_reg64(r : treference;rl,rh : tregister);
-    procedure emit_lea_loc_ref(const t:tlocation;const ref:treference;freetemp:boolean);
-    procedure emit_lea_loc_reg(const t:tlocation;reg:tregister;freetemp:boolean);
     procedure emit_push_mem_size(const t: treference; size: longint);
 
     { remove non regvar registers in loc from regs (in the format }
@@ -75,7 +72,6 @@ interface
 
     procedure emit_pushw_loc(const t:tlocation);
     procedure emit_push_lea_loc(const t:tlocation;freetemp:boolean);
-    procedure emit_to_mem(var t:tlocation;def:tdef);
 
     procedure copyshortstring(const dref,sref : treference;len : byte;
                         loadref, del_sref: boolean);
@@ -331,20 +327,6 @@ implementation
       end;
 
 
-    procedure emit_lea_loc_reg(const t:tlocation;reg:tregister;freetemp:boolean);
-      begin
-        case t.loc of
-               LOC_CREFERENCE,
-         LOC_REFERENCE : begin
-                               emit_ref_reg(A_LEA,S_L,t.reference,reg);
-                           if freetemp then
-                            tg.ungetiftemp(exprasmlist,t.reference);
-                         end;
-        else
-          internalerror(200203211);
-        end;
-      end;
-
     procedure remove_non_regvars_from_loc(const t: tlocation; var regs: tregisterset);
     begin
       case t.loc of
@@ -402,25 +384,6 @@ implementation
       end;
 
 
-    procedure emit_lea_loc_ref(const t:tlocation;const ref:treference;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_ref(A_MOV,S_L,R_EDI,ref));
-                               rg.ungetregisterint(exprasmlist,R_EDI);
-                         end;
-        else
-         internalerror(200203212);
-        end;
-                   location_release(exprasmlist,t);
-                   if freetemp then
-                    location_freetemp(exprasmlist,t);
-      end;
-
-
     procedure emit_push_lea_loc(const t:tlocation;freetemp:boolean);
       begin
         case t.loc of
@@ -463,70 +426,6 @@ implementation
       end;
 
 
-    procedure emit_to_mem(var t:tlocation;def:tdef);
-
-      var
-         r : treference;
-
-      begin
-        case t.loc of
-               LOC_FPUREGISTER, LOC_CFPUREGISTER :
-                 begin
-                   tg.gettempofsizereference(exprasmlist,10,r);
-                   cg.a_loadfpu_reg_ref(exprasmlist,
-                     def_cgsize(def),t.register,r);
-                   t.reference := r;
-                 end;
-               LOC_REGISTER:
-                 begin
-                    if is_64bitint(def) then
-                      begin
-                         tg.gettempofsizereference(exprasmlist,8,r);
-                         emit_reg_ref(A_MOV,S_L,t.registerlow,r);
-                         inc(r.offset,4);
-                         emit_reg_ref(A_MOV,S_L,t.registerhigh,r);
-                         dec(r.offset,4);
-                         t.reference:=r;
-                      end
-                    else
-                      internalerror(1405001);
-                 end;
-               LOC_CREFERENCE,
-         LOC_REFERENCE : ;
-         else
-         internalerror(200203219);
-        end;
-        t.loc:=LOC_CREFERENCE;
-      end;
-
-
-    procedure emit_mov_ref_reg64(r : treference;rl,rh : tregister);
-
-      var
-         hr : treference;
-
-      begin
-         { if we load a 64 bit reference, we must be careful because }
-         { we could overwrite the registers of the reference by      }
-         { accident                                                  }
-         rg.getexplicitregisterint(exprasmlist,R_EDI);
-         if r.base=rl then
-           begin
-              emit_reg_reg(A_MOV,S_L,r.base, R_EDI);
-              r.base:=R_EDI;
-           end
-         else if r.index=rl then
-           begin
-              emit_reg_reg(A_MOV,S_L,r.index,R_EDI);
-              r.index:=R_EDI;
-           end;
-         emit_ref_reg(A_MOV,S_L,r,rl);
-         hr:=r;
-         inc(hr.offset,4);
-         emit_ref_reg(A_MOV,S_L, hr,rh);
-         rg.ungetregisterint(exprasmlist,R_EDI);
-      end;
-
 {*****************************************************************************
                            Emit String Functions
 *****************************************************************************}
@@ -2402,7 +2301,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.23  2002-04-15 19:44:20  peter
+  Revision 1.24  2002-04-19 15:39:34  peter
+    * removed some more routines from cga
+    * moved location_force_reg/mem to ncgutil
+    * moved arrayconstructnode secondpass to ncgld
+
+  Revision 1.23  2002/04/15 19:44:20  peter
     * fixed stackcheck that would be called recursively when a stack
       error was found
     * generic changeregsize(reg,size) for i386 register resizing

+ 9 - 4
compiler/i386/cpunode.pas

@@ -29,8 +29,8 @@ unit cpunode;
   implementation
 
     uses
-       ncgbas,ncgflw,ncgcnv,ncgmem,ncgcon,
-       n386ld,n386add,n386cal,n386con,n386flw,n386mat,n386mem,
+       ncgbas,ncgflw,ncgcnv,ncgld,ncgmem,ncgcon,
+       n386ld,n386add,n386cal,n386con,n386cnv,n386flw,n386mat,n386mem,
        n386set,n386inl,n386opt,
        { this not really a node }
        n386obj, rgcpu;
@@ -38,7 +38,12 @@ unit cpunode;
 end.
 {
   $Log$
-  Revision 1.8  2002-03-31 20:26:38  jonas
+  Revision 1.9  2002-04-19 15:39:35  peter
+    * removed some more routines from cga
+    * moved location_force_reg/mem to ncgutil
+    * moved arrayconstructnode secondpass to ncgld
+
+  Revision 1.8  2002/03/31 20:26:38  jonas
     + a_loadfpu_* and a_loadmm_* methods in tcg
     * register allocation is now handled by a class and is mostly processor
       independent (+rgobj.pas and i386/rgcpu.pas)
@@ -94,4 +99,4 @@ end.
   Revision 1.1  2000/10/14 10:14:47  peter
     * moehrendorf oct 2000 rewrite
 
-}
+}

+ 48 - 94
compiler/i386/n386cnv.pas

@@ -27,12 +27,12 @@ unit n386cnv;
 interface
 
     uses
-      node,ncnv,ncgcnv,types;
+      node,ncgcnv,types;
 
     type
        ti386typeconvnode = class(tcgtypeconvnode)
          protected
-          procedure second_int_to_int;override;
+         { procedure second_int_to_int;override; }
          { procedure second_string_to_string;override; }
          { procedure second_cstring_to_pchar;override; }
          { procedure second_string_to_chararray;override; }
@@ -51,51 +51,28 @@ interface
          { procedure second_pchar_to_string;override; }
          { procedure second_class_to_intf;override;  }
          { procedure second_char_to_char;override; }
-          procedure pass_2;override;
-          procedure second_call_helper(c : tconverttype);
+{$ifdef TESTOBJEXT2}
+          procedure checkobject;override;
+{$endif TESTOBJEXT2}
+          procedure second_call_helper(c : tconverttype);override;
        end;
 
+
 implementation
 
    uses
       verbose,systems,
       symconst,symdef,aasm,
       cginfo,cgbase,pass_2,
-      ncon,ncal,
+      ncon,ncal,ncnv,
       cpubase,
-      cgobj,cga,tgobj,rgobj,rgcpu,n386util;
+      cgobj,cga,tgobj,rgobj,rgcpu,ncgutil;
 
 
 {*****************************************************************************
                              SecondTypeConv
 *****************************************************************************}
 
-    procedure ti386typeconvnode.second_int_to_int;
-      var
-        newsize : tcgsize;
-      begin
-        newsize:=def_cgsize(resulttype.def);
-
-        { insert range check if not explicit conversion }
-        if not(nf_explizit in flags) then
-          cg.g_rangecheck(exprasmlist,left,resulttype.def);
-
-        { is the result size smaller ? }
-        if resulttype.def.size<>left.resulttype.def.size then
-          begin
-            { reuse the left location by default }
-            location_copy(location,left.location);
-            location_force_reg(location,newsize,false);
-          end
-        else
-          begin
-            { no special loading is required, reuse current location }
-            location_copy(location,left.location);
-            location.size:=newsize;
-          end;
-      end;
-
-
     procedure ti386typeconvnode.second_int_to_real;
 
       var
@@ -297,13 +274,42 @@ implementation
          falselabel:=oldfalselabel;
        end;
 
+{$ifdef TESTOBJEXT2}
+    procedure ti386typeconvnode.checkobject;
+      var
+         r : preference;
+         nillabel : plabel;
+       begin
+         new(r);
+         reset_reference(r^);
+         if p^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
+          r^.base:=p^.location.register
+         else
+           begin
+              rg.getexplicitregisterint(exprasmlist,R_EDI);
+              emit_mov_loc_reg(p^.location,R_EDI);
+              r^.base:=R_EDI;
+           end;
+         { NIL must be accepted !! }
+         emit_reg_reg(A_OR,S_L,r^.base,r^.base);
+         rg.ungetregisterint(exprasmlist,R_EDI);
+         getlabel(nillabel);
+         emitjmp(C_E,nillabel);
+         { this is one point where we need vmt_offset (PM) }
+         r^.offset:= tobjectdef(tpointerdef(p^.resulttype.def).definition).vmt_offset;
+         rg.getexplicitregisterint(exprasmlist,R_EDI);
+         emit_ref_reg(A_MOV,S_L,r,R_EDI);
+         emit_sym(A_PUSH,S_L,
+           newasmsymbol(tobjectdef(tpointerdef(p^.resulttype.def).definition).vmt_mangledname));
+         emit_reg(A_PUSH,S_L,R_EDI);
+         rg.ungetregister32(exprasmlist,R_EDI);
+         emitcall('FPC_CHECK_OBJECT_EXT');
+         emitlab(nillabel);
+       end;
+{$endif TESTOBJEXT2}
 
-{****************************************************************************
-                           TI386TYPECONVNODE
-****************************************************************************}
 
     procedure ti386typeconvnode.second_call_helper(c : tconverttype);
-
       const
          secondconvert : array[tconverttype] of pointer = (
            @second_nothing, {equal}
@@ -353,69 +359,17 @@ implementation
          tprocedureofobject(r){$ifdef FPC}();{$endif FPC}
       end;
 
-    procedure ti386typeconvnode.pass_2;
-{$ifdef TESTOBJEXT2}
-      var
-         r : preference;
-         nillabel : plabel;
-{$endif TESTOBJEXT2}
-      begin
-        { the boolean routines can be called with LOC_JUMP and
-          call secondpass themselves in the helper }
-        if not(convtype in [tc_bool_2_int,tc_bool_2_bool,tc_int_2_bool]) then
-         begin
-           secondpass(left);
-           if codegenerror then
-            exit;
-         end;
-
-        second_call_helper(convtype);
-
-{$ifdef TESTOBJEXT2}
-                  { Check explicit conversions to objects pointers !! }
-                     if p^.explizit and
-                        (p^.resulttype.def.deftype=pointerdef) and
-                        (tpointerdef(p^.resulttype.def).definition.deftype=objectdef) and not
-                        (tobjectdef(tpointerdef(p^.resulttype.def).definition).isclass) and
-                        ((tobjectdef(tpointerdef(p^.resulttype.def).definition).options and oo_hasvmt)<>0) and
-                        (cs_check_range in aktlocalswitches) then
-                       begin
-                          new(r);
-                          reset_reference(r^);
-                          if p^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
-                           r^.base:=p^.location.register
-                          else
-                            begin
-                               rg.getexplicitregisterint(exprasmlist,R_EDI);
-                               emit_mov_loc_reg(p^.location,R_EDI);
-                               r^.base:=R_EDI;
-                            end;
-                          { NIL must be accepted !! }
-                          emit_reg_reg(A_OR,S_L,r^.base,r^.base);
-                          rg.ungetregisterint(exprasmlist,R_EDI);
-                          getlabel(nillabel);
-                          emitjmp(C_E,nillabel);
-                          { this is one point where we need vmt_offset (PM) }
-                          r^.offset:= tobjectdef(tpointerdef(p^.resulttype.def).definition).vmt_offset;
-                          rg.getexplicitregisterint(exprasmlist,R_EDI);
-                          emit_ref_reg(A_MOV,S_L,r,R_EDI);
-                          emit_sym(A_PUSH,S_L,
-                            newasmsymbol(tobjectdef(tpointerdef(p^.resulttype.def).definition).vmt_mangledname));
-                          emit_reg(A_PUSH,S_L,R_EDI);
-                          rg.ungetregister32(exprasmlist,R_EDI);
-                          emitcall('FPC_CHECK_OBJECT_EXT');
-                          emitlab(nillabel);
-                       end;
-{$endif TESTOBJEXT2}
-      end;
-
-
 begin
    ctypeconvnode:=ti386typeconvnode;
 end.
 {
   $Log$
-  Revision 1.34  2002-04-15 19:44:21  peter
+  Revision 1.35  2002-04-19 15:39:35  peter
+    * removed some more routines from cga
+    * moved location_force_reg/mem to ncgutil
+    * moved arrayconstructnode secondpass to ncgld
+
+  Revision 1.34  2002/04/15 19:44:21  peter
     * fixed stackcheck that would be called recursively when a stack
       error was found
     * generic changeregsize(reg,size) for i386 register resizing

+ 6 - 3
compiler/i386/n386inl.pas

@@ -58,8 +58,6 @@ implementation
            ('S32REAL','S64REAL','S80REAL','S64BIT','F16BIT','F32BIT'); }
          addsubop:array[in_inc_x..in_dec_x] of TOpCG=(OP_ADD,OP_SUB);
        var
-         opsize : topsize;
-         op,
          asmop : tasmop;
          pushed : tpushedsaved;
          {inc/dec}
@@ -593,7 +591,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.36  2002-04-15 19:44:21  peter
+  Revision 1.37  2002-04-19 15:39:35  peter
+    * removed some more routines from cga
+    * moved location_force_reg/mem to ncgutil
+    * moved arrayconstructnode secondpass to ncgld
+
+  Revision 1.36  2002/04/15 19:44:21  peter
     * fixed stackcheck that would be called recursively when a stack
       error was found
     * generic changeregsize(reg,size) for i386 register resizing

+ 7 - 214
compiler/i386/n386ld.pas

@@ -42,9 +42,6 @@ interface
           procedure pass_2;override;
        end;
 
-       ti386arrayconstructornode = class(tarrayconstructornode)
-          procedure pass_2;override;
-       end;
 
 implementation
 
@@ -55,7 +52,7 @@ implementation
       cginfo,cgbase,pass_2,
       nmem,ncon,ncnv,
       cpubase,cpuasm,
-      cga,tgobj,n386cnv,n386util,regvars,cgobj,cg64f32,rgobj,rgcpu;
+      cga,tgobj,n386util,ncgutil,regvars,cgobj,cg64f32,rgobj,rgcpu;
 
 {*****************************************************************************
                              SecondLoad
@@ -773,223 +770,19 @@ implementation
            end;
       end;
 
-
-{*****************************************************************************
-                           SecondArrayConstruct
-*****************************************************************************}
-
-      const
-        vtInteger    = 0;
-        vtBoolean    = 1;
-        vtChar       = 2;
-        vtExtended   = 3;
-        vtString     = 4;
-        vtPointer    = 5;
-        vtPChar      = 6;
-        vtObject     = 7;
-        vtClass      = 8;
-        vtWideChar   = 9;
-        vtPWideChar  = 10;
-        vtAnsiString = 11;
-        vtCurrency   = 12;
-        vtVariant    = 13;
-        vtInterface  = 14;
-        vtWideString = 15;
-        vtInt64      = 16;
-        vtQWord      = 17;
-
-    procedure ti386arrayconstructornode.pass_2;
-      var
-        hp    : tarrayconstructornode;
-        href  : treference;
-        lt    : tdef;
-        vaddr : boolean;
-        vtype : longint;
-        freetemp,
-        dovariant : boolean;
-        elesize : longint;
-      begin
-        dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant;
-        if dovariant then
-         elesize:=8
-        else
-         elesize:=tarraydef(resulttype.def).elesize;
-        if not(nf_cargs in flags) then
-         begin
-           location_reset(location,LOC_REFERENCE,OS_NO);
-           { Allocate always a temp, also if no elements are required, to
-             be sure that location is valid (PFV) }
-            if tarraydef(resulttype.def).highrange=-1 then
-              tg.gettempofsizereference(exprasmlist,elesize,location.reference)
-            else
-              tg.gettempofsizereference(exprasmlist,(tarraydef(resulttype.def).highrange+1)*elesize,location.reference);
-            href:=location.reference;
-         end;
-        hp:=self;
-        while assigned(hp) do
-         begin
-           if assigned(hp.left) then
-            begin
-              freetemp:=true;
-              secondpass(hp.left);
-              if codegenerror then
-               exit;
-              if dovariant then
-               begin
-                 { find the correct vtype value }
-                 vtype:=$ff;
-                 vaddr:=false;
-                 lt:=hp.left.resulttype.def;
-                 case lt.deftype of
-                   enumdef,
-                   orddef :
-                     begin
-                       if is_64bitint(lt) then
-                         begin
-                            case torddef(lt).typ of
-                               s64bit:
-                                 vtype:=vtInt64;
-                               u64bit:
-                                 vtype:=vtQWord;
-                            end;
-                            freetemp:=false;
-                            vaddr:=true;
-                         end
-                       else if (lt.deftype=enumdef) or
-                         is_integer(lt) then
-                         vtype:=vtInteger
-                       else
-                         if is_boolean(lt) then
-                           vtype:=vtBoolean
-                         else
-                           if (lt.deftype=orddef) and (torddef(lt).typ=uchar) then
-                             vtype:=vtChar;
-                     end;
-                   floatdef :
-                     begin
-                       vtype:=vtExtended;
-                       vaddr:=true;
-                       freetemp:=false;
-                     end;
-                   procvardef,
-                   pointerdef :
-                     begin
-                       if is_pchar(lt) then
-                         vtype:=vtPChar
-                       else
-                         vtype:=vtPointer;
-                     end;
-                   classrefdef :
-                     vtype:=vtClass;
-                   objectdef :
-                     begin
-                       vtype:=vtObject;
-                     end;
-                   stringdef :
-                     begin
-                       if is_shortstring(lt) then
-                        begin
-                          vtype:=vtString;
-                          vaddr:=true;
-                          freetemp:=false;
-                        end
-                       else
-                        if is_ansistring(lt) then
-                         begin
-                           vtype:=vtAnsiString;
-                           freetemp:=false;
-                         end
-                       else
-                        if is_widestring(lt) then
-                         begin
-                           vtype:=vtWideString;
-                           freetemp:=false;
-                         end;
-                     end;
-                 end;
-                 if vtype=$ff then
-                   internalerror(14357);
-                 { write C style pushes or an pascal array }
-                 if nf_cargs in flags then
-                  begin
-                    if vaddr then
-                     begin
-                       emit_to_mem(hp.left.location,hp.left.resulttype.def);
-                       emit_push_lea_loc(hp.left.location,freetemp);
-                       location_release(exprasmlist,hp.left.location);
-                     end
-                    else
-                     cg.a_param_loc(exprasmlist,hp.left.location,-1);
-                    inc(pushedparasize,4);
-                  end
-                 else
-                  begin
-                    { write changing field update href to the next element }
-                    inc(href.offset,4);
-                    if vaddr then
-                     begin
-                       emit_to_mem(hp.left.location,hp.left.resulttype.def);
-                       emit_lea_loc_ref(hp.left.location,href,freetemp);
-                     end
-                    else
-                     begin
-                       location_release(exprasmlist,left.location);
-                       cg.a_load_loc_ref(exprasmlist,hp.left.location,href);
-                     end;
-                    { update href to the vtype field and write it }
-                    dec(href.offset,4);
-                    emit_const_ref(A_MOV,S_L,vtype,href);
-                    { goto next array element }
-                    inc(href.offset,8);
-                  end;
-               end
-              else
-              { normal array constructor of the same type }
-               begin
-                 case elesize of
-                   1,2,4 :
-                     begin
-                       location_release(exprasmlist,left.location);
-                       cg.a_load_loc_ref(exprasmlist,hp.left.location,href);
-                     end;
-                   8 :
-                     begin
-                       if hp.left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
-                        begin
-                          emit_reg_ref(A_MOV,S_L,hp.left.location.registerlow,href);
-                          { update href to the high bytes and write it }
-                          inc(href.offset,4);
-                          emit_reg_ref(A_MOV,S_L,hp.left.location.registerhigh,href);
-                          dec(href.offset,4)
-                        end
-                       else
-                        concatcopy(hp.left.location.reference,href,elesize,freetemp,false);
-                     end;
-                   else
-                     begin
-                       { concatcopy only supports reference }
-                       if not(hp.left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
-                        internalerror(200108012);
-                       concatcopy(hp.left.location.reference,href,elesize,freetemp,false);
-                     end;
-                 end;
-                 inc(href.offset,elesize);
-               end;
-            end;
-           { load next entry }
-           hp:=tarrayconstructornode(hp.right);
-         end;
-      end;
-
 begin
    cloadnode:=ti386loadnode;
    cassignmentnode:=ti386assignmentnode;
    cfuncretnode:=ti386funcretnode;
-   carrayconstructornode:=ti386arrayconstructornode;
 end.
 {
   $Log$
-  Revision 1.35  2002-04-15 19:44:21  peter
+  Revision 1.36  2002-04-19 15:39:35  peter
+    * removed some more routines from cga
+    * moved location_force_reg/mem to ncgutil
+    * moved arrayconstructnode secondpass to ncgld
+
+  Revision 1.35  2002/04/15 19:44:21  peter
     * fixed stackcheck that would be called recursively when a stack
       error was found
     * generic changeregsize(reg,size) for i386 register resizing

+ 7 - 2
compiler/i386/n386mem.pas

@@ -62,7 +62,7 @@ implementation
       cginfo,cgbase,pass_2,
       pass_1,nld,ncon,nadd,
       cpubase,
-      cgobj,cga,tgobj,n386util,rgobj;
+      cgobj,cga,tgobj,rgobj,ncgutil,n386util;
 
 {*****************************************************************************
                             TI386NEWNODE
@@ -663,7 +663,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.25  2002-04-15 19:12:09  carl
+  Revision 1.26  2002-04-19 15:39:35  peter
+    * removed some more routines from cga
+    * moved location_force_reg/mem to ncgutil
+    * moved arrayconstructnode secondpass to ncgld
+
+  Revision 1.25  2002/04/15 19:12:09  carl
   + target_info.size_of_pointer -> pointer_size
   + some cleanup of unused types/variables
   * move several constants from cpubase to their specific units

+ 8 - 3
compiler/i386/n386set.pas

@@ -50,7 +50,7 @@ implementation
       cginfo,cgbase,pass_2,
       ncon,
       cpubase,
-      cga,cgobj,tgobj,n386util,regvars,rgobj;
+      cga,cgobj,tgobj,ncgutil,n386util,regvars,rgobj;
 
      const
        bytes2Sxx:array[1..8] of Topsize=(S_B,S_W,S_NO,S_L,S_NO,S_NO,S_NO,S_Q);
@@ -898,7 +898,7 @@ implementation
          { determines the size of the operand }
          opsize:=bytes2Sxx[left.resulttype.def.size];
          { copy the case expression to a register }
-         location_force_reg(left.location,left.location.size,false);
+         location_force_reg(left.location,def_cgsize(left.resulttype.def),false);
          hregister:=left.location.register;
          if isjump then
           begin
@@ -1030,7 +1030,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.22  2002-04-15 19:44:21  peter
+  Revision 1.23  2002-04-19 15:39:35  peter
+    * removed some more routines from cga
+    * moved location_force_reg/mem to ncgutil
+    * moved arrayconstructnode secondpass to ncgld
+
+  Revision 1.22  2002/04/15 19:44:21  peter
     * fixed stackcheck that would be called recursively when a stack
       error was found
     * generic changeregsize(reg,size) for i386 register resizing

+ 8 - 151
compiler/i386/n386util.pas

@@ -29,8 +29,6 @@ interface
     uses
       symtype,node,cpubase,cginfo;
 
-    procedure location_force_reg(var l:tlocation;size:TCGSize;maybeconst:boolean);
-
     function maybe_push(needed : byte;p : tnode;isint64 : boolean) : boolean;
     function maybe_pushfpu(needed : byte;p : tnode) : boolean;
 {$ifdef TEMPS_NOT_PUSH}
@@ -63,158 +61,12 @@ implementation
        gdb,
 {$endif GDB}
        types,
-       ncon,nld,
+       ncgutil,ncon,nld,
        pass_1,pass_2,
        cgbase,tgobj,
        cga,regvars,cgobj,cg64f32,rgobj,rgcpu,cgcpu;
 
 
-    procedure location_force_reg(var l:tlocation;size:TCGSize;maybeconst:boolean);
-      var
-        hregister,
-        hregisterhi : tregister;
-        hl : tasmlabel;
-      begin
-        { release previous location before demanding a new register }
-        if (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
-         begin
-           location_freetemp(exprasmlist,l);
-           location_release(exprasmlist,l);
-         end;
-        { handle transformations to 64bit separate }
-        if size in [OS_64,OS_S64] then
-         begin
-           if not (l.size in [OS_64,OS_S64]) then
-            begin
-              { load a smaller size to OS_64 }
-              if l.loc=LOC_REGISTER then
-               hregister:=Changeregsize(l.registerlow,S_L)
-              else
-               hregister:=rg.getregisterint(exprasmlist);
-              { load value in low register }
-              case l.loc of
-                LOC_FLAGS :
-                  cg.g_flags2reg(exprasmlist,l.resflags,hregister);
-                LOC_JUMP :
-                  begin
-                    cg.a_label(exprasmlist,truelabel);
-                    cg.a_load_const_reg(exprasmlist,OS_32,1,hregister);
-                    getlabel(hl);
-                    cg.a_jmp_cond(exprasmlist,OC_NONE,hl);
-                    cg.a_label(exprasmlist,falselabel);
-                    cg.a_load_const_reg(exprasmlist,OS_32,0,hregister);
-                    cg.a_label(exprasmlist,hl);
-                  end;
-                else
-                  cg.a_load_loc_reg(exprasmlist,l,hregister);
-              end;
-              { reset hi part, take care of the signed bit of the current value }
-              hregisterhi:=rg.getregisterint(exprasmlist);
-              if (size=OS_S64) and
-                 (l.size in [OS_S8,OS_S16,OS_S32]) then
-               begin
-                 if l.loc=LOC_CONSTANT then
-                  begin
-                    if (longint(l.value)<0) then
-                     cg.a_load_const_reg(exprasmlist,OS_32,$ffffffff,hregisterhi)
-                    else
-                     cg.a_load_const_reg(exprasmlist,OS_32,0,hregisterhi);
-                  end
-                 else
-                  begin
-                    cg.a_load_reg_reg(exprasmlist,OS_32,hregister,hregisterhi);
-                    cg.a_op_const_reg(exprasmlist,OP_SAR,31,hregisterhi);
-                  end;
-               end
-              else
-               cg.a_load_const_reg(exprasmlist,OS_32,0,hregisterhi);
-              location_reset(l,LOC_REGISTER,size);
-              l.registerlow:=hregister;
-              l.registerhigh:=hregisterhi;
-            end
-           else
-            begin
-              { 64bit to 64bit }
-              if (l.loc=LOC_REGISTER) or
-                 ((l.loc=LOC_CREGISTER) and maybeconst) then
-               begin
-                 hregister:=l.registerlow;
-                 hregisterhi:=l.registerhigh;
-               end
-              else
-               begin
-                 hregister:=rg.getregisterint(exprasmlist);
-                 hregisterhi:=rg.getregisterint(exprasmlist);
-               end;
-              { load value in new register }
-              tcg64f32(cg).a_load64_loc_reg(exprasmlist,l,hregister,hregisterhi);
-              location_reset(l,LOC_REGISTER,size);
-              l.registerlow:=hregister;
-              l.registerhigh:=hregisterhi;
-            end;
-         end
-        else
-         begin
-           { transformations to 32bit or smaller }
-           if l.loc=LOC_REGISTER then
-            begin
-              { if the previous was 64bit release the high register }
-              if l.size in [OS_64,OS_S64] then
-               begin
-                 rg.ungetregisterint(exprasmlist,l.registerhigh);
-                 l.registerhigh:=R_NO;
-               end;
-              hregister:=l.register;
-            end
-           else
-            begin
-              { get new register }
-              if (l.loc=LOC_CREGISTER) and
-                 maybeconst and
-                 (TCGSize2Size[size]=TCGSize2Size[l.size]) then
-               hregister:=l.register
-              else
-               hregister:=rg.getregisterint(exprasmlist);
-            end;
-{$ifdef i386}
-           hregister:=Changeregsize(hregister,TCGSize2Opsize[size]);
-{$endif i386}
-           { load value in new register }
-           case l.loc of
-             LOC_FLAGS :
-               cg.g_flags2reg(exprasmlist,l.resflags,hregister);
-             LOC_JUMP :
-               begin
-                 cg.a_label(exprasmlist,truelabel);
-                 cg.a_load_const_reg(exprasmlist,size,1,hregister);
-                 getlabel(hl);
-                 cg.a_jmp_cond(exprasmlist,OC_NONE,hl);
-                 cg.a_label(exprasmlist,falselabel);
-                 cg.a_load_const_reg(exprasmlist,size,0,hregister);
-                 cg.a_label(exprasmlist,hl);
-               end;
-             else
-               begin
-                 { load_loc_reg can only handle size >= l.size, when the
-                   new size is smaller then we need to adjust the size
-                   of the orignal and maybe recalculate l.register for i386 }
-                 if (TCGSize2Size[size]<TCGSize2Size[l.size]) then
-                  begin
-{$ifdef i386}
-                    if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
-                     l.register:=Changeregsize(l.register,TCGSize2Opsize[size]);
-{$endif i386}
-                    l.size:=size;
-                  end;
-                 cg.a_load_loc_reg(exprasmlist,l,hregister);
-               end;
-           end;
-           location_reset(l,LOC_REGISTER,size);
-           l.register:=hregister;
-         end;
-      end;
-
-
 {*****************************************************************************
                            Emit Push Functions
 *****************************************************************************}
@@ -296,7 +148,7 @@ implementation
            begin
              if p.location.loc = LOC_FPUREGISTER then
                begin
-                 emit_to_mem(p.location,p.resulttype.def);
+                 location_force_mem(p.location);
                  maybe_pushfpu:=true;
                end
              else
@@ -1260,7 +1112,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.31  2002-04-15 19:44:21  peter
+  Revision 1.32  2002-04-19 15:39:35  peter
+    * removed some more routines from cga
+    * moved location_force_reg/mem to ncgutil
+    * moved arrayconstructnode secondpass to ncgld
+
+  Revision 1.31  2002/04/15 19:44:21  peter
     * fixed stackcheck that would be called recursively when a stack
       error was found
     * generic changeregsize(reg,size) for i386 register resizing

+ 73 - 5
compiler/ncgcnv.pas

@@ -28,10 +28,11 @@ unit ncgcnv;
 interface
 
     uses
-       node,ncnv;
+       node,ncnv,types;
 
     type
        tcgtypeconvnode = class(ttypeconvnode)
+         procedure second_int_to_int;override;
          procedure second_cstring_to_pchar;override;
          procedure second_string_to_chararray;override;
          procedure second_array_to_pointer;override;
@@ -46,6 +47,11 @@ interface
          procedure second_class_to_intf;override;
          procedure second_char_to_char;override;
          procedure second_nothing;override;
+{$ifdef TESTOBJEXT2}
+         procedure checkobject;virtual;
+{$endif TESTOBJEXT2}
+         procedure second_call_helper(c : tconverttype);virtual;abstract;
+         procedure pass_2;override;
        end;
 
   implementation
@@ -58,13 +64,37 @@ interface
       pass_2,
       cginfo,cgbase,
       cga,cgobj,cgcpu,
-{$ifdef i386}
-      n386util,
-{$endif i386}
+      ncgutil,
       tgobj,rgobj
       ;
 
 
+    procedure tcgtypeconvnode.second_int_to_int;
+      var
+        newsize : tcgsize;
+      begin
+        newsize:=def_cgsize(resulttype.def);
+
+        { insert range check if not explicit conversion }
+        if not(nf_explizit in flags) then
+          cg.g_rangecheck(exprasmlist,left,resulttype.def);
+
+        { is the result size smaller ? }
+        if resulttype.def.size<>left.resulttype.def.size then
+          begin
+            { reuse the left location by default }
+            location_copy(location,left.location);
+            location_force_reg(location,newsize,false);
+          end
+        else
+          begin
+            { no special loading is required, reuse current location }
+            location_copy(location,left.location);
+            location.size:=newsize;
+          end;
+      end;
+
+
     procedure tcgtypeconvnode.second_cstring_to_pchar;
 
       var
@@ -365,13 +395,51 @@ interface
       end;
 
 
+{$ifdef TESTOBJEXT2}
+    procedure tcgtypeconvnode.checkobject;
+      begin
+        { no checking by default }
+      end;
+{$endif TESTOBJEXT2}
+
+
+    procedure tcgtypeconvnode.pass_2;
+      begin
+        { the boolean routines can be called with LOC_JUMP and
+          call secondpass themselves in the helper }
+        if not(convtype in [tc_bool_2_int,tc_bool_2_bool,tc_int_2_bool]) then
+         begin
+           secondpass(left);
+           if codegenerror then
+            exit;
+         end;
+
+        second_call_helper(convtype);
+
+{$ifdef TESTOBJEXT2}
+         { Check explicit conversions to objects pointers !! }
+         if p^.explizit and
+            (p^.resulttype.def.deftype=pointerdef) and
+            (tpointerdef(p^.resulttype.def).definition.deftype=objectdef) and not
+            (tobjectdef(tpointerdef(p^.resulttype.def).definition).isclass) and
+            ((tobjectdef(tpointerdef(p^.resulttype.def).definition).options and oo_hasvmt)<>0) and
+            (cs_check_range in aktlocalswitches) then
+           checkobject;
+{$endif TESTOBJEXT2}
+      end;
+
 begin
   ctypeconvnode := tcgtypeconvnode;
 end.
 
 {
   $Log$
-  Revision 1.9  2002-04-15 19:44:19  peter
+  Revision 1.10  2002-04-19 15:39:34  peter
+    * removed some more routines from cga
+    * moved location_force_reg/mem to ncgutil
+    * moved arrayconstructnode secondpass to ncgld
+
+  Revision 1.9  2002/04/15 19:44:19  peter
     * fixed stackcheck that would be called recursively when a stack
       error was found
     * generic changeregsize(reg,size) for i386 register resizing

+ 268 - 0
compiler/ncgld.pas

@@ -0,0 +1,268 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Florian Klaempfl
+
+    Generate assembler for nodes that handle loads and assignments which
+    are the same for all (most) processors
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit ncgld;
+
+{$i defines.inc}
+
+interface
+
+    uses
+      node,nld;
+
+    type
+       tcgarrayconstructornode = class(tarrayconstructornode)
+          procedure pass_2;override;
+       end;
+
+implementation
+
+    uses
+      systems,
+      verbose,globals,
+      symconst,symtype,symdef,symsym,symtable,aasm,types,
+      cginfo,cgbase,pass_2,
+      cpubase,cpuasm,
+      cga,tgobj,ncgutil,regvars,cgobj,cg64f32,rgobj,rgcpu;
+
+{*****************************************************************************
+                           SecondArrayConstruct
+*****************************************************************************}
+
+      const
+        vtInteger    = 0;
+        vtBoolean    = 1;
+        vtChar       = 2;
+        vtExtended   = 3;
+        vtString     = 4;
+        vtPointer    = 5;
+        vtPChar      = 6;
+        vtObject     = 7;
+        vtClass      = 8;
+        vtWideChar   = 9;
+        vtPWideChar  = 10;
+        vtAnsiString = 11;
+        vtCurrency   = 12;
+        vtVariant    = 13;
+        vtInterface  = 14;
+        vtWideString = 15;
+        vtInt64      = 16;
+        vtQWord      = 17;
+
+    procedure tcgarrayconstructornode.pass_2;
+      var
+        hp    : tarrayconstructornode;
+        href  : treference;
+        lt    : tdef;
+        vaddr : boolean;
+        vtype : longint;
+        freetemp,
+        dovariant : boolean;
+        elesize : longint;
+        tmpreg  : tregister;
+      begin
+        dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant;
+        if dovariant then
+         elesize:=8
+        else
+         elesize:=tarraydef(resulttype.def).elesize;
+        if not(nf_cargs in flags) then
+         begin
+           location_reset(location,LOC_REFERENCE,OS_NO);
+           { Allocate always a temp, also if no elements are required, to
+             be sure that location is valid (PFV) }
+            if tarraydef(resulttype.def).highrange=-1 then
+              tg.gettempofsizereference(exprasmlist,elesize,location.reference)
+            else
+              tg.gettempofsizereference(exprasmlist,(tarraydef(resulttype.def).highrange+1)*elesize,location.reference);
+            href:=location.reference;
+         end;
+        hp:=self;
+        while assigned(hp) do
+         begin
+           if assigned(hp.left) then
+            begin
+              freetemp:=true;
+              secondpass(hp.left);
+              if codegenerror then
+               exit;
+              if dovariant then
+               begin
+                 { find the correct vtype value }
+                 vtype:=$ff;
+                 vaddr:=false;
+                 lt:=hp.left.resulttype.def;
+                 case lt.deftype of
+                   enumdef,
+                   orddef :
+                     begin
+                       if is_64bitint(lt) then
+                         begin
+                            case torddef(lt).typ of
+                               s64bit:
+                                 vtype:=vtInt64;
+                               u64bit:
+                                 vtype:=vtQWord;
+                            end;
+                            freetemp:=false;
+                            vaddr:=true;
+                         end
+                       else if (lt.deftype=enumdef) or
+                         is_integer(lt) then
+                         vtype:=vtInteger
+                       else
+                         if is_boolean(lt) then
+                           vtype:=vtBoolean
+                         else
+                           if (lt.deftype=orddef) and (torddef(lt).typ=uchar) then
+                             vtype:=vtChar;
+                     end;
+                   floatdef :
+                     begin
+                       vtype:=vtExtended;
+                       vaddr:=true;
+                       freetemp:=false;
+                     end;
+                   procvardef,
+                   pointerdef :
+                     begin
+                       if is_pchar(lt) then
+                         vtype:=vtPChar
+                       else
+                         vtype:=vtPointer;
+                     end;
+                   classrefdef :
+                     vtype:=vtClass;
+                   objectdef :
+                     begin
+                       vtype:=vtObject;
+                     end;
+                   stringdef :
+                     begin
+                       if is_shortstring(lt) then
+                        begin
+                          vtype:=vtString;
+                          vaddr:=true;
+                          freetemp:=false;
+                        end
+                       else
+                        if is_ansistring(lt) then
+                         begin
+                           vtype:=vtAnsiString;
+                           freetemp:=false;
+                         end
+                       else
+                        if is_widestring(lt) then
+                         begin
+                           vtype:=vtWideString;
+                           freetemp:=false;
+                         end;
+                     end;
+                 end;
+                 if vtype=$ff then
+                   internalerror(14357);
+                 { write C style pushes or an pascal array }
+                 if nf_cargs in flags then
+                  begin
+                    if vaddr then
+                     begin
+                       location_force_mem(hp.left.location);
+                       cg.a_paramaddr_ref(exprasmlist,hp.left.location.reference,-1);
+                       location_release(exprasmlist,hp.left.location);
+                       if freetemp then
+                        location_freetemp(exprasmlist,hp.left.location);
+                     end
+                    else
+                     cg.a_param_loc(exprasmlist,hp.left.location,-1);
+                    inc(pushedparasize,4);
+                  end
+                 else
+                  begin
+                    { write changing field update href to the next element }
+                    inc(href.offset,4);
+                    if vaddr then
+                     begin
+                       location_force_mem(hp.left.location);
+                       tmpreg:=cg.get_scratch_reg(exprasmlist);
+                       cg.a_loadaddr_ref_reg(exprasmlist,hp.left.location.reference,tmpreg);
+                       cg.a_load_reg_ref(exprasmlist,cg.reg_cgsize(tmpreg),tmpreg,href);
+                       cg.free_scratch_reg(exprasmlist,tmpreg);
+                       location_release(exprasmlist,hp.left.location);
+                       if freetemp then
+                        location_freetemp(exprasmlist,hp.left.location);
+                     end
+                    else
+                     begin
+                       location_release(exprasmlist,left.location);
+                       cg.a_load_loc_ref(exprasmlist,hp.left.location,href);
+                     end;
+                    { update href to the vtype field and write it }
+                    dec(href.offset,4);
+                    emit_const_ref(A_MOV,S_L,vtype,href);
+                    { goto next array element }
+                    inc(href.offset,8);
+                  end;
+               end
+              else
+              { normal array constructor of the same type }
+               begin
+                 case elesize of
+                   1,2,4 :
+                     begin
+                       location_release(exprasmlist,left.location);
+                       cg.a_load_loc_ref(exprasmlist,hp.left.location,href);
+                     end;
+                   8 :
+                     begin
+                       if hp.left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
+                        tcg64f32(cg).a_load64_loc_ref(exprasmlist,hp.left.location,href)
+                       else
+                        cg.g_concatcopy(exprasmlist,hp.left.location.reference,href,elesize,freetemp,false);
+                     end;
+                   else
+                     begin
+                       { concatcopy only supports reference }
+                       if not(hp.left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
+                        internalerror(200108012);
+                       cg.g_concatcopy(exprasmlist,hp.left.location.reference,href,elesize,freetemp,false);
+                     end;
+                 end;
+                 inc(href.offset,elesize);
+               end;
+            end;
+           { load next entry }
+           hp:=tarrayconstructornode(hp.right);
+         end;
+      end;
+
+begin
+   carrayconstructornode:=tcgarrayconstructornode;
+end.
+{
+  $Log$
+  Revision 1.1  2002-04-19 15:39:34  peter
+    * removed some more routines from cga
+    * moved location_force_reg/mem to ncgutil
+    * moved arrayconstructnode secondpass to ncgld
+
+}

+ 199 - 3
compiler/ncgutil.pas

@@ -27,11 +27,16 @@ unit ncgutil;
 interface
 
     uses
-      node;
+      node,
+      cginfo,
+      cpubase;
 
     type
       tloadregvars = (lr_dont_load_regvars, lr_load_regvars);
 
+    procedure location_force_reg(var l:tlocation;size:TCGSize;maybeconst:boolean);
+    procedure location_force_mem(var l:tlocation);
+
 {$ifdef TEMPS_NOT_PUSH}
     function maybe_savetotemp(needed : byte;p : tnode;isint64 : boolean) : boolean;
     procedure restorefromtemp(p : tnode;isint64 : boolean);
@@ -46,8 +51,194 @@ implementation
     types,
     aasm,cgbase,regvars,
     ncon,
-    cpubase,tgobj,cpuinfo,cginfo,cgobj,cgcpu,rgobj,cg64f32;
+    tgobj,cpuinfo,cgobj,cgcpu,rgobj,cg64f32;
+
 
+{*****************************************************************************
+                                     TLocation
+*****************************************************************************}
+
+    procedure location_force_reg(var l:tlocation;size:TCGSize;maybeconst:boolean);
+      var
+        hregister,
+        hregisterhi : tregister;
+        hl : tasmlabel;
+      begin
+        { release previous location before demanding a new register }
+        if (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
+         begin
+           location_freetemp(exprasmlist,l);
+           location_release(exprasmlist,l);
+         end;
+        { handle transformations to 64bit separate }
+        if size in [OS_64,OS_S64] then
+         begin
+           if not (l.size in [OS_64,OS_S64]) then
+            begin
+              { load a smaller size to OS_64 }
+              if l.loc=LOC_REGISTER then
+               hregister:=Changeregsize(l.registerlow,S_L)
+              else
+               hregister:=rg.getregisterint(exprasmlist);
+              { load value in low register }
+              case l.loc of
+                LOC_FLAGS :
+                  cg.g_flags2reg(exprasmlist,l.resflags,hregister);
+                LOC_JUMP :
+                  begin
+                    cg.a_label(exprasmlist,truelabel);
+                    cg.a_load_const_reg(exprasmlist,OS_32,1,hregister);
+                    getlabel(hl);
+                    cg.a_jmp_cond(exprasmlist,OC_NONE,hl);
+                    cg.a_label(exprasmlist,falselabel);
+                    cg.a_load_const_reg(exprasmlist,OS_32,0,hregister);
+                    cg.a_label(exprasmlist,hl);
+                  end;
+                else
+                  cg.a_load_loc_reg(exprasmlist,l,hregister);
+              end;
+              { reset hi part, take care of the signed bit of the current value }
+              hregisterhi:=rg.getregisterint(exprasmlist);
+              if (size=OS_S64) and
+                 (l.size in [OS_S8,OS_S16,OS_S32]) then
+               begin
+                 if l.loc=LOC_CONSTANT then
+                  begin
+                    if (longint(l.value)<0) then
+                     cg.a_load_const_reg(exprasmlist,OS_32,$ffffffff,hregisterhi)
+                    else
+                     cg.a_load_const_reg(exprasmlist,OS_32,0,hregisterhi);
+                  end
+                 else
+                  begin
+                    cg.a_load_reg_reg(exprasmlist,OS_32,hregister,hregisterhi);
+                    cg.a_op_const_reg(exprasmlist,OP_SAR,31,hregisterhi);
+                  end;
+               end
+              else
+               cg.a_load_const_reg(exprasmlist,OS_32,0,hregisterhi);
+              location_reset(l,LOC_REGISTER,size);
+              l.registerlow:=hregister;
+              l.registerhigh:=hregisterhi;
+            end
+           else
+            begin
+              { 64bit to 64bit }
+              if (l.loc=LOC_REGISTER) or
+                 ((l.loc=LOC_CREGISTER) and maybeconst) then
+               begin
+                 hregister:=l.registerlow;
+                 hregisterhi:=l.registerhigh;
+               end
+              else
+               begin
+                 hregister:=rg.getregisterint(exprasmlist);
+                 hregisterhi:=rg.getregisterint(exprasmlist);
+               end;
+              { load value in new register }
+              tcg64f32(cg).a_load64_loc_reg(exprasmlist,l,hregister,hregisterhi);
+              location_reset(l,LOC_REGISTER,size);
+              l.registerlow:=hregister;
+              l.registerhigh:=hregisterhi;
+            end;
+         end
+        else
+         begin
+           { transformations to 32bit or smaller }
+           if l.loc=LOC_REGISTER then
+            begin
+              { if the previous was 64bit release the high register }
+              if l.size in [OS_64,OS_S64] then
+               begin
+                 rg.ungetregisterint(exprasmlist,l.registerhigh);
+                 l.registerhigh:=R_NO;
+               end;
+              hregister:=l.register;
+            end
+           else
+            begin
+              { get new register }
+              if (l.loc=LOC_CREGISTER) and
+                 maybeconst and
+                 (TCGSize2Size[size]=TCGSize2Size[l.size]) then
+               hregister:=l.register
+              else
+               hregister:=rg.getregisterint(exprasmlist);
+            end;
+{$ifdef i386}
+           hregister:=Changeregsize(hregister,TCGSize2Opsize[size]);
+{$endif i386}
+           { load value in new register }
+           case l.loc of
+             LOC_FLAGS :
+               cg.g_flags2reg(exprasmlist,l.resflags,hregister);
+             LOC_JUMP :
+               begin
+                 cg.a_label(exprasmlist,truelabel);
+                 cg.a_load_const_reg(exprasmlist,size,1,hregister);
+                 getlabel(hl);
+                 cg.a_jmp_cond(exprasmlist,OC_NONE,hl);
+                 cg.a_label(exprasmlist,falselabel);
+                 cg.a_load_const_reg(exprasmlist,size,0,hregister);
+                 cg.a_label(exprasmlist,hl);
+               end;
+             else
+               begin
+                 { load_loc_reg can only handle size >= l.size, when the
+                   new size is smaller then we need to adjust the size
+                   of the orignal and maybe recalculate l.register for i386 }
+                 if (TCGSize2Size[size]<TCGSize2Size[l.size]) then
+                  begin
+{$ifdef i386}
+                    if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+                     l.register:=Changeregsize(l.register,TCGSize2Opsize[size]);
+{$endif i386}
+                    l.size:=size;
+                  end;
+                 cg.a_load_loc_reg(exprasmlist,l,hregister);
+               end;
+           end;
+           location_reset(l,LOC_REGISTER,size);
+           l.register:=hregister;
+         end;
+      end;
+
+
+    procedure location_force_mem(var l:tlocation);
+      var
+        r : treference;
+      begin
+        case l.loc of
+          LOC_FPUREGISTER,
+          LOC_CFPUREGISTER :
+            begin
+              cg.a_loadfpu_reg_ref(exprasmlist,l.size,l.register,r);
+              location_reset(l,LOC_REFERENCE,l.size);
+              l.reference:=r;
+            end;
+          LOC_CONSTANT,
+          LOC_REGISTER,
+          LOC_CREGISTER :
+            begin
+              tg.gettempofsizereference(exprasmlist,TCGSize2Size[l.size],r);
+              if l.size in [OS_64,OS_S64] then
+               tcg64f32(cg).a_load64_loc_ref(exprasmlist,l,r)
+              else
+               cg.a_load_loc_ref(exprasmlist,l,r);
+              location_reset(l,LOC_REFERENCE,l.size);
+              l.reference:=r;
+            end;
+          LOC_CREFERENCE,
+          LOC_REFERENCE : ;
+          else
+            internalerror(200203219);
+        end;
+      end;
+
+
+{*****************************************************************************
+                                 SaveToTemp
+*****************************************************************************}
 
 {$ifdef TEMPS_NOT_PUSH}
     function maybe_savetotemp(needed : byte;p : tnode;isint64 : boolean) : boolean;
@@ -213,7 +404,12 @@ end.
 
 {
   $Log$
-  Revision 1.7  2002-04-15 18:58:47  carl
+  Revision 1.8  2002-04-19 15:39:34  peter
+    * removed some more routines from cga
+    * moved location_force_reg/mem to ncgutil
+    * moved arrayconstructnode secondpass to ncgld
+
+  Revision 1.7  2002/04/15 18:58:47  carl
   + target_info.size_of_pointer -> pointer_Size
 
   Revision 1.6  2002/04/06 18:10:42  jonas