{ $Id$ Copyright (c) 1998-2000 by Jonas Maebe This unit implements the 80x86 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 n386opt; {$i defines.inc} interface uses node, nopt; type ti386addsstringcharoptnode = class(taddsstringcharoptnode) function pass_1: tnode; override; procedure pass_2; override; end; ti386addsstringcsstringoptnode = class(taddsstringcsstringoptnode) { must be duplicated from ti386addnode :( } procedure pass_2; override; end; implementation uses pass_1, types, htypechk, temp_gen, cpubase, cpuasm, cgai386, verbose, tgcpu, aasm, ncnv, ncon, pass_2, symdef; {***************************************************************************** TI386ADDOPTNODE *****************************************************************************} function ti386addsstringcharoptnode.pass_1: tnode; begin pass_1 := nil; { already done before it's created (JM) firstpass(left); firstpass(right); if codegenerror then exit; } { update the curmaxlen field (before converting to a string!) } updatecurmaxlen; if not is_shortstring(left.resulttype) then begin left := gentypeconvnode(left,cshortstringdef); firstpass(left); end; location.loc := LOC_MEM; 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); resulttype := left.resulttype; end; procedure ti386addsstringcharoptnode.pass_2; var l: pasmlabel; href2: preference; href: treference; hreg, lengthreg: tregister; checklength: boolean; begin { first, we have to more or less replicate some code from } { ti386addnode.pass_2 } secondpass(left); if not(istemp(left.location.reference) and (getsizeoftemp(left.location.reference) = 256)) and not(nf_use_strconcat in flags) then begin gettempofsizereference(256,href); copyshortstring(href,left.location.reference,255,false,true); { release the registers } ungetiftemp(left.location.reference); { does not hurt: } clear_location(left.location); left.location.loc:=LOC_MEM; left.location.reference:=href; end; secondpass(right); { special case for string := string + char (JM) } hreg := R_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_MEM] then begin { free the registers of right } del_reference(right.location.reference); { get register for the char } hreg := reg32toreg8(getregister32); emit_ref_reg(A_MOV,S_B, newreference(right.location.reference),hreg); { I don't think a temp char exists, but it won't hurt (JM) } ungetiftemp(right.location.reference); end else hreg := right.location.register; { load the current string length } lengthreg := getregister32; emit_ref_reg(A_MOVZX,S_BL,newreference(left.location.reference),lengthreg); { do we have to check the length ? } if istemp(left.location.reference) then checklength := curmaxlen = 255 else checklength := curmaxlen >= pstringdef(left.resulttype)^.len; if checklength then begin { is it already maximal? } getlabel(l); if istemp(left.location.reference) then emit_const_reg(A_CMP,S_L,255,lengthreg) else emit_const_reg(A_CMP,S_L,pstringdef(left.resulttype)^.len,lengthreg); emitjmp(C_E,l); end; { no, so increase the length and add the new character } href2 := newreference(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 <> R_NO) and (href2^.index <> R_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 } emit_reg_reg(A_ADD,S_L,href2^.base,lengthreg); href2^.base := lengthreg; end else { at least one is still free, so put EDI there } if href2^.base = R_NO then href2^.base := lengthreg else begin href2^.index := lengthreg; href2^.scalefactor := 1; 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) } emit_reg_ref(A_MOV,S_B,hreg,href2); ungetregister(hreg); end else emit_const_ref(A_MOV,S_B,tordconstnode(right).value,href2); { increase the string length } emit_reg(A_INC,S_B,reg32toreg8(lengthreg)); emit_reg_ref(A_MOV,S_B,reg32toreg8(lengthreg), newreference(left.location.reference)); ungetregister32(lengthreg); if checklength then emitlab(l); set_location(location,left.location); end; procedure ti386addsstringcsstringoptnode.pass_2; var href: treference; pushedregs: tpushed; regstopush: byte; begin { first, we have to more or less replicate some code from } { ti386addnode.pass_2 } secondpass(left); if not(istemp(left.location.reference) and (getsizeoftemp(left.location.reference) = 256)) and not(nf_use_strconcat in flags) then begin gettempofsizereference(256,href); copyshortstring(href,left.location.reference,255,false,true); { release the registers } ungetiftemp(left.location.reference); { does not hurt: } clear_location(left.location); left.location.loc:=LOC_MEM; 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 := $ff; remove_non_regvars_from_loc(right.location, regstopush); pushusedregisters(pushedregs,regstopush); { push the maximum possible length of the result } emitpushreferenceaddr(left.location.reference); { the optimizer can more easily put the } { deallocations in the right place if it happens } { too early than when it happens too late (if } { the pushref needs a "lea (..),edi; push edi") } del_reference(right.location.reference); emitpushreferenceaddr(right.location.reference); saveregvars(regstopush); emitcall('FPC_SHORTSTR_CONCAT'); ungetiftemp(right.location.reference); maybe_loadesi; popusedregisters(pushedregs); set_location(location,left.location); end; begin caddsstringcharoptnode := ti386addsstringcharoptnode; caddsstringcsstringoptnode := ti386addsstringcsstringoptnode end. { $Log$ Revision 1.2 2001-01-06 19:12:31 jonas * fixed IE 10 (but code is less efficient now :( ) Revision 1.1 2001/01/04 11:24:19 jonas + initial implementation (still needs to be made more modular) }