freepascal.compiler/compiler/ncgopt.pas

{
    $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;


implementation

uses
  globtype,globals,
  pass_1,defutil,htypechk,
  symdef,paramgr,
  aasmbase,aasmtai,
  ncnv, ncon, pass_2,
  cgbase, cpubase,
  tgobj, 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_REFERENCE;
  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);
       location_freetemp(exprasmlist,left.location);
       { return temp reference }
       location_reset(left.location,LOC_REFERENCE,def_cgsize(resulttype.def));
       left.location.reference:=href;
    end;
  secondpass(right);
  { special case for string := string + char (JM) }
  hreg:=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
        { get register for the char }
        hreg := cg.getintregister(exprasmlist,OS_8);
        cg.a_load_ref_reg(exprasmlist,OS_8,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 := cg.getintregister(exprasmlist,OS_INT);
  cg.a_load_ref_reg(exprasmlist,OS_8,OS_INT,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 <> NR_NO) and
     (href2.index <> 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 = NR_NO then
      href2.base := lengthreg
    else
      begin
        href2.index := lengthreg;
{$ifdef x86}
        href2.scalefactor := 1;
{$endif x86}
      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,OS_8,hreg,href2);
    end
  else
    cg.a_load_const_ref(exprasmlist,OS_8,tordconstnode(right).value,href2);
  lengthreg:=cg.makeregsize(exprasmlist,lengthreg,OS_8);
  { increase the string length }
  cg.a_op_const_reg(exprasmlist,OP_ADD,OS_8,1,lengthreg);
  cg.a_load_reg_ref(exprasmlist,OS_8,OS_8,lengthreg,left.location.reference);
  if checklength then
    cg.a_label(exprasmlist,l);
  location_copy(location,left.location);
end;

begin
  caddsstringcharoptnode := tcgaddsstringcharoptnode;
end.

{
  $Log$
  Revision 1.16  2004-10-24 11:44:28  peter
    * small regvar fixes
    * loadref parameter removed from concatcopy,incrrefcount,etc

  Revision 1.15  2004/09/25 14:23:54  peter
    * ungetregister is now only used for cpuregisters, renamed to
      ungetcpuregister
    * renamed (get|unget)explicitregister(s) to ..cpuregister
    * removed location-release/reference_release

  Revision 1.14  2004/06/20 08:55:29  florian
    * logs truncated

  Revision 1.13  2004/05/22 23:34:28  peter
  tai_regalloc.allocation changed to ratype to notify rgobj of register size changes

  Revision 1.12  2004/01/31 17:45:17  peter
    * Change several $ifdef i386 to x86
    * Change several OS_32 to OS_INT/OS_ADDR

}