+ first revision (incomplete)

compiler/ncginl.pas

@@ -0,0 +1,587 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Florian Klaempfl and Carl Eric Codere
+
+    Generate generic inline nodes
+
+    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 ncginl;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+       node,ninl;
+
+    type
+       tcginlinenode = class(tinlinenode)
+          procedure pass_2;override;
+          { Handle the assert routine }
+          procedure second_assert;virtual;
+          procedure second_sizeoftypeof;virtual;
+          procedure second_length;virtual;
+          procedure second_predsucc;virtual;
+          procedure second_incdec;virtual;
+          procedure second_typeinfo;virtual;
+          procedure second_assigned;virtual;
+          procedure second_includeexclude;virtual;
+          procedure second_pi; virtual;
+          procedure second_arctan_real; virtual;
+          procedure second_abs_real; virtual;
+          procedure second_sqr_real; virtual;
+          procedure second_sqrt_real; virtual;
+          procedure second_ln_real; virtual;
+          procedure second_cos_real; virtual;
+          procedure second_sin_real; virtual;
+       end;
+
+implementation
+
+    uses
+      globtype,systems,
+      cutils,verbose,globals,fmodule,
+      symconst,symdef,defbase,
+      aasmbase,aasmtai,aasmcpu,
+      cginfo,cgbase,pass_1,pass_2,
+      cpubase,paramgr,
+      nbas,ncon,ncal,ncnv,nld,
+      cga,tgobj,ncgutil,cgobj,cg64f32,rgobj,rgcpu;
+
+
+{*****************************************************************************
+                              TCGINLINENODE
+*****************************************************************************}
+
+
+    procedure tcginlinenode.pass_2;
+       var
+         asmop : tasmop;
+         l : longint;
+         oldpushedparasize : longint;
+      begin
+         { save & reset pushedparasize }
+         oldpushedparasize:=pushedparasize;
+         pushedparasize:=0;
+         case inlinenumber of
+            in_assert_x_y:
+              begin
+                 second_Assert;
+              end;
+            in_sizeof_x,
+            in_typeof_x :
+              begin
+                 second_SizeofTypeOf;
+              end;
+            in_length_x :
+              begin
+                 second_Length;
+              end;
+            in_pred_x,
+            in_succ_x:
+              begin
+                 second_PredSucc;
+              end;
+            in_dec_x,
+            in_inc_x :
+              begin
+                second_IncDec;
+              end;
+            in_typeinfo_x:
+               begin
+                  second_TypeInfo;
+               end;
+            in_assigned_x :
+              begin
+                 second_Assigned;
+              end;
+            in_include_x_y,
+            in_exclude_x_y:
+              begin
+                 second_IncludeExclude;
+              end;
+            in_pi:
+              begin
+                second_pi; 
+              end;
+            in_sin_extended:
+              begin
+                second_sin_real;
+              end;
+            in_arctan_extended:
+              begin
+                second_arctan_real;
+              end;
+            in_abs_extended:
+              begin
+                second_abs_real;
+              end;
+            in_sqr_extended:
+              begin
+                second_sqr_real;
+              end;
+            in_sqrt_extended:
+              begin
+                second_sqrt_real;
+              end;
+            in_ln_extended:
+              begin
+                second_ln_real;
+              end;
+            in_cos_extended:
+              begin
+                 second_cos_real;
+              end;
+{$ifdef SUPPORT_MMX}
+            in_mmx_pcmpeqb..in_mmx_pcmpgtw:
+              begin
+                 location_reset(location,LOC_MMXREGISTER,OS_NO);
+                 if left.location.loc=LOC_REGISTER then
+                   begin
+                      {!!!!!!!}
+                   end
+                 else if tcallparanode(left).left.location.loc=LOC_REGISTER then
+                   begin
+                      {!!!!!!!}
+                   end
+                 else
+                   begin
+                      {!!!!!!!}
+                   end;
+              end;
+{$endif SUPPORT_MMX}
+            else internalerror(9);
+         end;
+         { reset pushedparasize }
+         pushedparasize:=oldpushedparasize;
+      end;
+
+
+{*****************************************************************************
+                          ASSERT GENERIC HANDLING
+*****************************************************************************}
+    procedure tcginlinenode.second_Assert;
+     var
+         hp2 : tstringconstnode;
+         otlabel,oflabel{,l1}   : tasmlabel;
+     begin
+       { the node should be removed in the firstpass }
+       if not (cs_do_assertion in aktlocalswitches) then
+          internalerror(7123458);
+       otlabel:=truelabel;
+       oflabel:=falselabel;
+       getlabel(truelabel);
+       getlabel(falselabel);
+       secondpass(tcallparanode(left).left);
+       maketojumpbool(exprasmlist,tcallparanode(left).left,lr_load_regvars);
+       cg.a_label(exprasmlist,falselabel);
+       { erroraddr }
+       cg.a_param_reg(exprasmlist,OS_ADDR,FRAME_POINTER_REG,paramanager.getintparaloc(4));
+       { lineno }
+       cg.a_param_const(exprasmlist,OS_INT,aktfilepos.line,paramanager.getintparaloc(3));
+       { filename string }
+       hp2:=cstringconstnode.createstr(current_module.sourcefiles.get_file_name(aktfilepos.fileindex),st_shortstring);
+       firstpass(hp2);
+       secondpass(hp2);
+       if codegenerror then
+          exit;
+       cg.a_paramaddr_ref(exprasmlist,hp2.location.reference,paramanager.getintparaloc(2));
+       hp2.free;
+       { push msg }
+       secondpass(tcallparanode(tcallparanode(left).right).left);
+       cg.a_paramaddr_ref(exprasmlist,tcallparanode(tcallparanode(left).right).left.location.reference,paramanager.getintparaloc(1));
+       { call }
+       cg.a_call_name(exprasmlist,'FPC_ASSERT');
+       cg.a_label(exprasmlist,truelabel);
+       truelabel:=otlabel;
+       falselabel:=oflabel;
+     end;
+          
+
+{*****************************************************************************
+                          SIZEOF / TYPEOF GENERIC HANDLING
+*****************************************************************************}
+                 
+    { second_handle_ the sizeof and typeof routines }
+    procedure tcginlinenode.second_SizeOfTypeOf;
+      var
+         href : treference;
+         hregister : tregister;      
+      begin
+        location_reset(location,LOC_REGISTER,OS_ADDR);
+        { for both cases load vmt }
+        if left.nodetype=typen then
+          begin
+            hregister:=rg.getaddressregister(exprasmlist);
+            reference_reset_symbol(href,newasmsymbol(tobjectdef(left.resulttype.def).vmt_mangledname),0);
+            cg.a_loadaddr_ref_reg(exprasmlist,href,hregister);
+          end
+        else
+          begin
+            secondpass(left);
+            location_release(exprasmlist,left.location);
+            hregister:=rg.getaddressregister(exprasmlist);
+            { load VMT pointer }
+            inc(left.location.reference.offset,tobjectdef(left.resulttype.def).vmt_offset);
+            cg.a_load_ref_reg(exprasmlist,OS_ADDR,left.location.reference,hregister);
+          end;
+        { in sizeof load size }
+        if inlinenumber=in_sizeof_x then
+           begin
+             reference_reset_base(href,hregister,0);
+             rg.ungetaddressregister(exprasmlist,hregister);
+             hregister:=rg.getregisterint(exprasmlist);
+             cg.a_load_ref_reg(exprasmlist,OS_INT,href,hregister);
+           end;
+        location.register:=hregister;
+     end;
+     
+     
+     
+{*****************************************************************************
+                          LENGTH GENERIC HANDLING
+*****************************************************************************}
+
+    procedure tcginlinenode.second_Length;
+      var
+        lengthlab : tasmlabel;
+        hregister : tregister;
+        href : treference;
+      begin
+        secondpass(left);
+        { length in ansi strings is at offset -8 }
+        if is_ansistring(left.resulttype.def) or
+           is_widestring(left.resulttype.def) then
+            begin
+              location_force_reg(exprasmlist,left.location,OS_ADDR,false);
+              hregister:=left.location.register;
+              getlabel(lengthlab);
+              cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,hregister,lengthlab);
+              reference_reset_base(href,hregister,-8);
+              cg.a_load_ref_reg(exprasmlist,OS_INT,href,hregister);
+              cg.a_label(exprasmlist,lengthlab);
+              location_reset(location,LOC_REGISTER,OS_INT);
+              location.register:=hregister;
+            end
+         else
+            begin
+              location_copy(location,left.location);
+              location.size:=OS_8;
+            end;
+      end;
+
+
+{*****************************************************************************
+                         PRED/SUCC GENERIC HANDLING
+*****************************************************************************}
+
+    procedure tcginlinenode.second_PredSucc;
+      var
+         cgsize : TCGSize;
+         cgop : topcg;      
+      begin
+        secondpass(left);
+        if inlinenumber=in_pred_x then
+           cgop:=OP_SUB
+        else
+           cgop:=OP_ADD;
+        cgsize:=def_cgsize(resulttype.def);
+
+        { we need a value in a register }
+        location_copy(location,left.location);
+        location_force_reg(exprasmlist,location,cgsize,false);
+
+        if cgsize in [OS_64,OS_S64] then
+          cg64.a_op64_const_reg(exprasmlist,cgop,1,
+                      location.register64)
+        else
+          cg.a_op_const_reg(exprasmlist,cgop,1,location.register);
+
+        cg.g_overflowcheck(exprasmlist,self);
+        cg.g_rangecheck(exprasmlist,self,resulttype.def);
+      end;
+
+
+{*****************************************************************************
+                         INC/DEC GENERIC HANDLING
+*****************************************************************************}
+      procedure tcginlinenode.second_IncDec;
+       const
+         addsubop:array[in_inc_x..in_dec_x] of TOpCG=(OP_ADD,OP_SUB);
+        var
+         addvalue : longint;
+         addconstant : boolean;
+         hregisterhi,
+         hregister : tregister;
+         cgsize : tcgsize;
+         pushedregs : tmaybesave;
+        begin
+          { set defaults }
+          addconstant:=true;
+          { load first parameter, must be a reference }
+          secondpass(tcallparanode(left).left);
+          cgsize:=def_cgsize(tcallparanode(left).left.resulttype.def);
+          { get addvalue }
+          case tcallparanode(left).left.resulttype.def.deftype of
+            orddef,
+            enumdef :
+                addvalue:=1;
+            pointerdef :
+               begin
+                 if is_void(tpointerdef(tcallparanode(left).left.resulttype.def).pointertype.def) then
+                   addvalue:=1
+                 else
+                   addvalue:=tpointerdef(tcallparanode(left).left.resulttype.def).pointertype.def.size;
+               end;
+           else
+               internalerror(10081);
+          end;
+          { second_ argument specified?, must be a s32bit in register }
+          if assigned(tcallparanode(left).right) then
+            begin
+              maybe_save(exprasmlist,tcallparanode(tcallparanode(left).right).left.registers32,
+                 tcallparanode(left).left.location,pushedregs);
+              secondpass(tcallparanode(tcallparanode(left).right).left);
+              maybe_restore(exprasmlist,tcallparanode(left).left.location,pushedregs);
+              { when constant, just multiply the addvalue }
+              if is_constintnode(tcallparanode(tcallparanode(left).right).left) then
+                 addvalue:=addvalue*get_ordinal_value(tcallparanode(tcallparanode(left).right).left)
+              else
+                begin
+                  location_force_reg(exprasmlist,tcallparanode(tcallparanode(left).right).left.location,cgsize,false);
+                  hregister:=tcallparanode(tcallparanode(left).right).left.location.register;
+                  hregisterhi:=tcallparanode(tcallparanode(left).right).left.location.registerhigh;
+                  { insert multiply with addvalue if its >1 }
+                  if addvalue>1 then
+                    cg.a_op_const_reg(exprasmlist,OP_IMUL,addvalue,hregister);
+                  addconstant:=false;
+                end;
+            end;
+          { write the add instruction }
+          if addconstant then
+            begin
+              if cgsize in [OS_64,OS_S64] then
+               cg64.a_op64_const_loc(exprasmlist,addsubop[inlinenumber],
+                  addvalue,tcallparanode(left).left.location)
+              else
+               cg.a_op_const_loc(exprasmlist,addsubop[inlinenumber],
+                  addvalue,tcallparanode(left).left.location);
+            end
+           else
+             begin
+               if cgsize in [OS_64,OS_S64] then
+                 cg64.a_op64_reg_loc(exprasmlist,addsubop[inlinenumber],
+                   joinreg64(hregister,hregisterhi),tcallparanode(left).left.location)
+               else
+                 cg.a_op_reg_loc(exprasmlist,addsubop[inlinenumber],
+                   hregister,tcallparanode(left).left.location);
+                 location_release(exprasmlist,tcallparanode(tcallparanode(left).right).left.location);
+             end;
+          cg.g_overflowcheck(exprasmlist,tcallparanode(left).left);
+          cg.g_rangecheck(exprasmlist,tcallparanode(left).left,tcallparanode(left).left.resulttype.def);
+        end;  
+        
+               
+{*****************************************************************************
+                         TYPEINFO GENERIC HANDLING
+*****************************************************************************}
+      procedure tcginlinenode.second_typeinfo;
+        var
+         href : treference;
+        begin
+          location_reset(location,LOC_REGISTER,OS_ADDR);
+          location.register:=rg.getaddressregister(exprasmlist);
+          reference_reset_symbol(href,tstoreddef(ttypenode(tcallparanode(left).left).resulttype.def).get_rtti_label(fullrtti),0);
+          cg.a_loadaddr_ref_reg(exprasmlist,href,location.register);
+        end;  
+        
+
+{*****************************************************************************
+                         ASSIGNED GENERIC HANDLING
+*****************************************************************************}
+      procedure tcginlinenode.second_Assigned;
+        var
+         hreg : tregister;
+         ptrvalidlabel : tasmlabel;
+        begin
+          WriteLN('Entering assigned node!');
+          secondpass(tcallparanode(left).left);
+          location_release(exprasmlist,tcallparanode(left).left.location);
+          hreg := rg.getregisterint(exprasmlist);
+          if (tcallparanode(left).left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+            begin
+              { if pointer is non-nil, and is in register, this directly the value we can use }
+              cg.a_load_reg_reg(exprasmlist, OS_ADDR, tcallparanode(left).left.location.register, hreg);   
+            end
+          else
+            begin
+              getlabel(ptrvalidlabel);
+              cg.a_load_const_reg(exprasmlist, OS_INT, 1, hreg);
+              cg.a_cmp_const_ref_label(exprasmlist, OS_ADDR, OC_NE, 0,
+                  tcallparanode(left).left.location.reference, ptrvalidlabel);
+              cg.a_load_const_reg(exprasmlist, OS_INT, 0, hreg);
+              cg.a_label(exprasmlist,ptrvalidlabel);
+            end;
+          location.register := hreg;  
+          location_reset(location,LOC_REGISTER,OS_INT);
+          WriteLn('Exiting assigned node!');
+        end;
+        
+        
+{*****************************************************************************
+                     INCLUDE/EXCLUDE GENERIC HANDLING
+*****************************************************************************}
+      procedure tcginlinenode.second_IncludeExclude;
+        var
+         scratch_reg : boolean;
+         hregister : tregister;
+         asmop : tasmop;
+         L : longint;
+         pushedregs : TMaybesave;         
+         cgop : topcg;
+         {!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
+        begin
+          location_copy(location,left.location);
+          secondpass(tcallparanode(left).left);
+          if tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn then
+            begin
+              { calculate bit position }
+              l:=1 shl (tordconstnode(tcallparanode(tcallparanode(left).right).left).value mod 32);
+
+              { determine operator }
+              if inlinenumber=in_include_x_y then
+                cgop:=OP_OR
+              else
+                begin
+                  cgop:=OP_AND;
+                  l:=not(l);
+                end;
+              if (tcallparanode(left).left.location.loc=LOC_REFERENCE) then
+                begin
+                  inc(tcallparanode(left).left.location.reference.offset,
+                    (tordconstnode(tcallparanode(tcallparanode(left).right).left).value div 32)*4);
+                  cg.a_op_const_ref(exprasmlist,cgop,OS_INT,l,tcallparanode(left).left.location.reference);
+                  location_release(exprasmlist,tcallparanode(left).left.location);
+                end
+              else
+                { LOC_CREGISTER }
+                begin
+                  cg.a_op_const_reg(exprasmlist,cgop,l,tcallparanode(left).left.location.register);
+                end;
+            end
+          else
+            begin
+              { generate code for the element to set }
+              maybe_save(exprasmlist,tcallparanode(tcallparanode(left).right).left.registers32,
+                        tcallparanode(left).left.location,pushedregs);
+              secondpass(tcallparanode(tcallparanode(left).right).left);
+              maybe_restore(exprasmlist,tcallparanode(left).left.location,pushedregs);
+              { determine asm operator }
+              if inlinenumber=in_include_x_y then
+                 asmop:=A_BTS
+              else
+                 asmop:=A_BTR;
+
+              if tcallparanode(tcallparanode(left).right).left.location.loc in [LOC_CREGISTER,LOC_REGISTER] then
+                { we don't need a mod 32 because this is done automatically  }
+                { by the bts instruction. For proper checking we would       }
+
+                { note: bts doesn't do any mod'ing, that's why we can also use }
+                { it for normalsets! (JM)                                      }
+
+                { need a cmp and jmp, but this should be done by the         }
+                { type cast code which does range checking if necessary (FK) }
+                begin
+                  scratch_reg := FALSE;
+                  WriteLn('HELLO!');
+                  hregister := rg.makeregsize(tcallparanode(tcallparanode(left).right).left.location.register,OS_INT);
+                end
+              else
+                begin
+                  scratch_reg := TRUE;
+                  hregister:=cg.get_scratch_reg_int(exprasmlist);
+                end;
+              cg.a_load_loc_reg(exprasmlist,tcallparanode(tcallparanode(left).right).left.location,hregister);
+              if (tcallparanode(left).left.location.loc=LOC_REFERENCE) then
+                emit_reg_ref(asmop,S_L,hregister,tcallparanode(left).left.location.reference)
+              else
+                emit_reg_reg(asmop,S_L,hregister,tcallparanode(left).left.location.register);
+              if scratch_reg then
+                cg.free_scratch_reg(exprasmlist,hregister);
+            end;
+        end;           
+        
+{*****************************************************************************
+                            FLOAT GENERIC HANDLING
+*****************************************************************************}
+
+{ 
+  These routines all call internal RTL routines, so if they are 
+  called here, they give an internal error
+}  
+    procedure tcginlinenode.second_pi;
+      begin
+        internalerror(20020718);
+      end;
+      
+    procedure tcginlinenode.second_arctan_real;
+      begin
+        internalerror(20020718);
+      end;
+      
+    procedure tcginlinenode.second_abs_real;
+      begin
+        internalerror(20020718);
+      end;
+      
+      
+    procedure tcginlinenode.second_sqr_real;
+      begin
+        internalerror(20020718);
+      end;
+      
+    procedure tcginlinenode.second_sqrt_real;
+      begin
+        internalerror(20020718);
+      end;
+      
+    procedure tcginlinenode.second_ln_real;
+      begin
+        internalerror(20020718);
+      end;
+      
+    procedure tcginlinenode.second_cos_real;
+      begin
+        internalerror(20020718);
+      end;
+      
+    procedure tcginlinenode.second_sin_real;
+      begin
+        internalerror(20020718);
+      end;
+
+begin
+{   cinlinenode:=tcginlinenode;}
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-07-24 04:07:49  carl
+   + first revision (incomplete)
+
+}