+ created from n386opt

compiler/ncgopt.pas

@@ -0,0 +1,257 @@
+{
+    $Id$
+    Copyright (c) 1998-2003 by Jonas Maebe
+
+    This unit implements the generic implementation of optimized 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 ncgopt;
+
+{$i fpcdefs.inc}
+
+interface
+uses node, nopt;
+
+type
+  tcgaddsstringcharoptnode = class(taddsstringcharoptnode)
+     function det_resulttype: tnode; override;
+     function pass_1: tnode; override;
+     procedure pass_2; override;
+  end;
+
+  tcgaddsstringcsstringoptnode = class(taddsstringcsstringoptnode)
+     { must be duplicated from ti386addnode :( }
+     procedure pass_2; override;
+  end;
+
+implementation
+
+uses
+  globtype,
+  pass_1,defutil,htypechk,
+  symdef,paramgr,
+  aasmbase,aasmtai,
+  ncnv, ncon, pass_2,
+  cginfo, cgbase, cpubase,
+  tgobj, rgobj, cgobj, ncgutil;
+
+
+{*****************************************************************************
+                             TCGADDOPTNODE
+*****************************************************************************}
+
+function tcgaddsstringcharoptnode.det_resulttype: tnode;
+begin
+  det_resulttype := nil;
+  resulttypepass(left);
+  resulttypepass(right);
+  if codegenerror then
+    exit;
+  { update the curmaxlen field (before converting to a string!) }
+  updatecurmaxlen;
+  if not is_shortstring(left.resulttype.def) then
+    inserttypeconv(left,cshortstringtype);
+  resulttype:=left.resulttype;
+end;
+
+
+function tcgaddsstringcharoptnode.pass_1: tnode;
+begin
+  pass_1 := nil;
+  firstpass(left);
+  firstpass(right);
+  if codegenerror then
+    exit;
+  expectloc:=LOC_CREFERENCE;
+  if not is_constcharnode(right) then
+    { it's not sure we need the register, but we can't know it here yet }
+    calcregisters(self,2,0,0)
+  else
+    calcregisters(self,1,0,0);
+end;
+
+
+procedure tcgaddsstringcharoptnode.pass_2;
+var
+  l: tasmlabel;
+  href,href2 :  treference;
+  hreg, lengthreg: tregister;
+  checklength: boolean;
+  len : integer;
+begin
+  { first, we have to more or less replicate some code from }
+  { ti386addnode.pass_2                                     }
+  secondpass(left);
+  if not(tg.istemp(left.location.reference) and
+         (tg.sizeoftemp(exprasmlist,left.location.reference) = 256)) and
+     not(nf_use_strconcat in flags) then
+    begin
+       tg.Gettemp(exprasmlist,256,tt_normal,href);
+       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;
+  secondpass(right);
+  { special case for string := string + char (JM) }
+  hreg.enum:=R_INTREGISTER;
+  hreg.number:=NR_NO;
+
+  { we have to load the char before checking the length, because we }
+  { may need registers from the reference                           }
+
+  { is it a constant char? }
+  if not is_constcharnode(right) then
+    { no, make sure it is in a register }
+    if right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
+      begin
+        { free the registers of right }
+        reference_release(exprasmlist,right.location.reference);
+        { get register for the char }
+        hreg := rg.getregisterint(exprasmlist,OS_8);
+        cg.a_load_ref_reg(exprasmlist,OS_8,right.location.reference,hreg);
+        { I don't think a temp char exists, but it won't hurt (JM) }
+        tg.ungetiftemp(exprasmlist,right.location.reference);
+      end
+    else hreg := right.location.register;
+
+  { load the current string length }
+  lengthreg := rg.getregisterint(exprasmlist,OS_INT);
+  cg.a_load_ref_reg(exprasmlist,OS_8,left.location.reference,lengthreg);
+
+  { do we have to check the length ? }
+  if tg.istemp(left.location.reference) then
+    checklength := curmaxlen = 255
+  else
+    checklength := curmaxlen >= tstringdef(left.resulttype.def).len;
+  if checklength then
+    begin
+      { is it already maximal? }
+      objectlibrary.getlabel(l);
+      if tg.istemp(left.location.reference) then
+        len:=255
+      else
+        len:=tstringdef(left.resulttype.def).len;
+      cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_EQ,len,lengthreg,l)
+    end;
+
+  { no, so increase the length and add the new character }
+  href2 := left.location.reference;
+
+  { we need a new reference to store the character }
+  { at the end of the string. Check if the base or }
+  { index register is still free                   }
+  if (href2.base.number <> NR_NO) and
+     (href2.index.number <> NR_NO) then
+    begin
+      { they're not free, so add the base reg to       }
+      { the string length (since the index can         }
+      { have a scalefactor) and use lengthreg as base  }
+      cg.a_op_reg_reg(exprasmlist,OP_ADD,OS_INT,href2.base,lengthreg);
+      href2.base := lengthreg;
+    end
+  else
+    { at least one is still free, so put EDI there }
+    if href2.base.number = NR_NO then
+      href2.base := lengthreg
+    else
+      begin
+        href2.index := lengthreg;
+{$ifdef i386}
+        href2.scalefactor := 1;
+{$endif i386}
+      end;
+  { we need to be one position after the last char }
+  inc(href2.offset);
+  { store the character at the end of the string }
+  if (right.nodetype <> ordconstn) then
+    begin
+      { no new_reference(href2) because it's only }
+      { used once (JM)                            }
+      cg.a_load_reg_ref(exprasmlist,OS_8,hreg,href2);
+      rg.ungetregisterint(exprasmlist,hreg);
+    end
+  else
+    cg.a_load_const_ref(exprasmlist,OS_8,tordconstnode(right).value,href2);
+  lengthreg.number:=(lengthreg.number and not $ff) or R_SUBL;
+  { increase the string length }
+  cg.a_op_const_reg(exprasmlist,OP_ADD,1,lengthreg);
+  cg.a_load_reg_ref(exprasmlist,OS_8,lengthreg,left.location.reference);
+  rg.ungetregisterint(exprasmlist,lengthreg);
+  if checklength then
+    cg.a_label(exprasmlist,l);
+  location_copy(location,left.location);
+end;
+
+procedure tcgaddsstringcsstringoptnode.pass_2;
+var
+  href: treference;
+  pushedregs: tpushedsavedint;
+  regstopush: tsupregset;
+begin
+  { first, we have to more or less replicate some code from }
+  { ti386addnode.pass_2                                     }
+  secondpass(left);
+  if not(tg.istemp(left.location.reference) and
+         (tg.sizeoftemp(exprasmlist,left.location.reference) = 256)) and
+     not(nf_use_strconcat in flags) then
+    begin
+       tg.GetTemp(exprasmlist,256,tt_normal,href);
+       cg.g_copyshortstring(exprasmlist,left.location.reference,href,255,true,false);
+       { release the registers }
+       location_freetemp(exprasmlist,left.location);
+       { return temp reference }
+       location_reset(left.location,LOC_CREFERENCE,def_cgsize(resulttype.def));
+       left.location.reference:=href;
+    end;
+  secondpass(right);
+  { on the right we do not need the register anymore too }
+  { Instead of releasing them already, simply do not }
+  { push them (so the release is in the right place, }
+  { because emitpushreferenceaddr doesn't need extra }
+  { registers) (JM)                                  }
+  regstopush := all_intregisters;
+  remove_non_regvars_from_loc(right.location,regstopush);
+  rg.saveusedintregisters(exprasmlist,pushedregs,regstopush);
+  { push the maximum possible length of the result }
+  cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(2));
+  { 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")  }
+  reference_release(exprasmlist,right.location.reference);
+  cg.a_paramaddr_ref(exprasmlist,right.location.reference,paramanager.getintparaloc(1));
+  rg.saveintregvars(exprasmlist,regstopush);
+  cg.a_call_name(exprasmlist,'FPC_SHORTSTR_CONCAT');
+  tg.ungetiftemp(exprasmlist,right.location.reference);
+  rg.restoreusedintregisters(exprasmlist,pushedregs);
+  location_copy(location,left.location);
+end;
+
+begin
+  caddsstringcharoptnode := tcgaddsstringcharoptnode;
+  caddsstringcsstringoptnode := tcgaddsstringcsstringoptnode
+end.
+
+{
+  $Log$
+  Revision 1.1  2003-04-24 11:20:06  florian
+    + created from n386opt
+}