123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968 |
- {
- $Id$
- Copyright (c) 1998-2002 by Florian Klaempfl
- Member of the Free Pascal development team
- This unit implements the code generation for 64 bit int
- arithmethics on 32 bit 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.
- ****************************************************************************
- }
- {# This unit implements the code generation for 64 bit int arithmethics on
- 32 bit processors.
- }
- unit cg64f32;
- {$i fpcdefs.inc}
- interface
- uses
- aasmbase,aasmtai,aasmcpu,
- cpuinfo, cpubase,cpupara,
- cgbase, cgobj,
- node,symtype
- {$ifdef delphi}
- ,dmisc
- {$endif}
- ;
- type
- {# Defines all the methods required on 32-bit processors
- to handle 64-bit integers.
- }
- tcg64f32 = class(tcg64)
- procedure a_reg_alloc(list : taasmoutput;r : tregister64);override;
- procedure a_reg_dealloc(list : taasmoutput;r : tregister64);override;
- procedure a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);override;
- procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);override;
- procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64;delete:boolean);override;
- procedure a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64;delete:boolean);override;
- procedure a_load64_const_reg(list : taasmoutput;value: qword;reg : tregister64);override;
- procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64;delete: boolean);override;
- procedure a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);override;
- procedure a_load64_const_loc(list : taasmoutput;value : qword;const l : tlocation);override;
- procedure a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);override;
- procedure a_load64high_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);override;
- procedure a_load64low_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);override;
- procedure a_load64high_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);override;
- procedure a_load64low_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);override;
- procedure a_load64high_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);override;
- procedure a_load64low_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);override;
- procedure a_op64_ref_reg(list : taasmoutput;op:TOpCG;const ref : treference;reg : tregister64);override;
- procedure a_op64_reg_ref(list : taasmoutput;op:TOpCG;reg : tregister64; const ref: treference);override;
- procedure a_op64_const_loc(list : taasmoutput;op:TOpCG;value : qword;const l: tlocation);override;
- procedure a_op64_reg_loc(list : taasmoutput;op:TOpCG;reg : tregister64;const l : tlocation);override;
- procedure a_op64_loc_reg(list : taasmoutput;op:TOpCG;const l : tlocation;reg : tregister64);override;
- procedure a_op64_const_ref(list : taasmoutput;op:TOpCG;value : qword;const ref : treference);override;
- procedure a_param64_reg(list : taasmoutput;reg : tregister64;const locpara : tparalocation);override;
- procedure a_param64_const(list : taasmoutput;value : qword;const locpara : tparalocation);override;
- procedure a_param64_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);override;
- procedure a_param64_loc(list : taasmoutput;const l : tlocation;const locpara : tparalocation);override;
- {# This routine tries to optimize the a_op64_const_reg operation, by
- removing superfluous opcodes. Returns TRUE if normal processing
- must continue in op64_const_reg, otherwise, everything is processed
- entirely in this routine, by emitting the appropriate 32-bit opcodes.
- }
- function optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : qword; var reg: tregister64): boolean;override;
- procedure g_rangecheck64(list: taasmoutput; const l:tlocation;fromdef,todef: tdef); override;
- end;
- {# Creates a tregister64 record from 2 32 Bit registers. }
- function joinreg64(reglo,reghi : tregister) : tregister64;
- implementation
- uses
- globals,systems,
- verbose,
- symbase,symconst,symdef,defutil,tgobj,paramgr;
- {****************************************************************************
- Helpers
- ****************************************************************************}
- function joinreg64(reglo,reghi : tregister) : tregister64;
- begin
- result.reglo:=reglo;
- result.reghi:=reghi;
- end;
- {****************************************************************************
- TCG64F32
- ****************************************************************************}
- procedure tcg64f32.a_reg_alloc(list : taasmoutput;r : tregister64);
- begin
- list.concat(tai_regalloc.alloc(r.reglo));
- list.concat(tai_regalloc.alloc(r.reghi));
- end;
- procedure tcg64f32.a_reg_dealloc(list : taasmoutput;r : tregister64);
- begin
- list.concat(tai_regalloc.dealloc(r.reglo));
- list.concat(tai_regalloc.dealloc(r.reghi));
- end;
- procedure tcg64f32.a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);
- var
- tmpreg: tregister;
- tmpref: treference;
- begin
- if target_info.endian = endian_big then
- begin
- tmpreg:=reg.reglo;
- reg.reglo:=reg.reghi;
- reg.reghi:=tmpreg;
- end;
- cg.a_load_reg_ref(list,OS_32,OS_32,reg.reglo,ref);
- tmpref := ref;
- inc(tmpref.offset,4);
- cg.a_load_reg_ref(list,OS_32,OS_32,reg.reghi,tmpref);
- end;
- procedure tcg64f32.a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);
- var
- tmpref: treference;
- begin
- if target_info.endian = endian_big then
- swap_qword(value);
- cg.a_load_const_ref(list,OS_32,lo(value),ref);
- tmpref := ref;
- inc(tmpref.offset,4);
- cg.a_load_const_ref(list,OS_32,hi(value),tmpref);
- end;
- procedure tcg64f32.a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64;delete:boolean);
- var
- tmpreg: tregister;
- tmpref: treference;
- got_scratch: boolean;
- begin
- if target_info.endian = endian_big then
- begin
- tmpreg := reg.reglo;
- reg.reglo := reg.reghi;
- reg.reghi := tmpreg;
- end;
- got_scratch:=false;
- tmpref := ref;
- if (tmpref.base=reg.reglo) then
- begin
- tmpreg:=cg.getaddressregister(list);
- got_scratch:=true;
- cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpref.base,tmpreg);
- tmpref.base:=tmpreg;
- end
- else
- { this works only for the i386, thus the i386 needs to override }
- { this method and this method must be replaced by a more generic }
- { implementation FK }
- if (tmpref.index=reg.reglo) then
- begin
- tmpreg:=cg.getaddressregister(list);
- got_scratch:=true;
- cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpref.index,tmpreg);
- tmpref.index:=tmpreg;
- end;
- cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reglo);
- inc(tmpref.offset,4);
- if delete then
- begin
- tg.ungetiftemp(list,tmpref);
- reference_release(list,tmpref);
- end;
- cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reghi);
- if got_scratch then
- cg.ungetregister(list,tmpreg);
- end;
- procedure tcg64f32.a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64;delete:boolean);
- begin
- if delete then
- cg.ungetregister(list,regsrc.reglo);
- cg.a_load_reg_reg(list,OS_32,OS_32,regsrc.reglo,regdst.reglo);
- if delete then
- cg.ungetregister(list,regsrc.reghi);
- cg.a_load_reg_reg(list,OS_32,OS_32,regsrc.reghi,regdst.reghi);
- end;
- procedure tcg64f32.a_load64_const_reg(list : taasmoutput;value : qword;reg : tregister64);
- begin
- cg.a_load_const_reg(list,OS_32,lo(value),reg.reglo);
- cg.a_load_const_reg(list,OS_32,hi(value),reg.reghi);
- end;
- procedure tcg64f32.a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64;delete :boolean);
- begin
- case l.loc of
- LOC_REFERENCE, LOC_CREFERENCE:
- a_load64_ref_reg(list,l.reference,reg,delete);
- LOC_REGISTER,LOC_CREGISTER:
- a_load64_reg_reg(list,l.register64,reg,delete);
- LOC_CONSTANT :
- a_load64_const_reg(list,l.valueqword,reg);
- else
- internalerror(200112292);
- end;
- end;
- procedure tcg64f32.a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);
- begin
- case l.loc of
- LOC_REGISTER,LOC_CREGISTER:
- a_load64_reg_ref(list,l.reg64,ref);
- LOC_CONSTANT :
- a_load64_const_ref(list,l.valueqword,ref);
- else
- internalerror(200203288);
- end;
- end;
- procedure tcg64f32.a_load64_const_loc(list : taasmoutput;value : qword;const l : tlocation);
- begin
- case l.loc of
- LOC_REFERENCE, LOC_CREFERENCE:
- a_load64_const_ref(list,value,l.reference);
- LOC_REGISTER,LOC_CREGISTER:
- a_load64_const_reg(list,value,l.reg64);
- else
- internalerror(200112293);
- end;
- end;
- procedure tcg64f32.a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);
- begin
- case l.loc of
- LOC_REFERENCE, LOC_CREFERENCE:
- a_load64_reg_ref(list,reg,l.reference);
- LOC_REGISTER,LOC_CREGISTER:
- a_load64_reg_reg(list,reg,l.register64,false);
- else
- internalerror(200112293);
- end;
- end;
- procedure tcg64f32.a_load64high_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);
- var
- tmpref: treference;
- begin
- if target_info.endian = endian_big then
- cg.a_load_reg_ref(list,OS_32,OS_32,reg,ref)
- else
- begin
- tmpref := ref;
- inc(tmpref.offset,4);
- cg.a_load_reg_ref(list,OS_32,OS_32,reg,tmpref)
- end;
- end;
- procedure tcg64f32.a_load64low_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);
- var
- tmpref: treference;
- begin
- if target_info.endian = endian_little then
- cg.a_load_reg_ref(list,OS_32,OS_32,reg,ref)
- else
- begin
- tmpref := ref;
- inc(tmpref.offset,4);
- cg.a_load_reg_ref(list,OS_32,OS_32,reg,tmpref)
- end;
- end;
- procedure tcg64f32.a_load64high_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);
- var
- tmpref: treference;
- begin
- if target_info.endian = endian_big then
- cg.a_load_ref_reg(list,OS_32,OS_32,ref,reg)
- else
- begin
- tmpref := ref;
- inc(tmpref.offset,4);
- cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg)
- end;
- end;
- procedure tcg64f32.a_load64low_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);
- var
- tmpref: treference;
- begin
- if target_info.endian = endian_little then
- cg.a_load_ref_reg(list,OS_32,OS_32,ref,reg)
- else
- begin
- tmpref := ref;
- inc(tmpref.offset,4);
- cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg)
- end;
- end;
- procedure tcg64f32.a_load64low_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);
- begin
- case l.loc of
- LOC_REFERENCE,
- LOC_CREFERENCE :
- a_load64low_ref_reg(list,l.reference,reg);
- LOC_REGISTER :
- cg.a_load_reg_reg(list,OS_32,OS_32,l.registerlow,reg);
- LOC_CONSTANT :
- cg.a_load_const_reg(list,OS_32,lo(l.valueqword),reg);
- else
- internalerror(200203244);
- end;
- end;
- procedure tcg64f32.a_load64high_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);
- begin
- case l.loc of
- LOC_REFERENCE,
- LOC_CREFERENCE :
- a_load64high_ref_reg(list,l.reference,reg);
- LOC_REGISTER :
- cg.a_load_reg_reg(list,OS_32,OS_32,l.registerhigh,reg);
- LOC_CONSTANT :
- cg.a_load_const_reg(list,OS_32,hi(l.valueqword),reg);
- else
- internalerror(200203244);
- end;
- end;
- procedure tcg64f32.a_op64_const_loc(list : taasmoutput;op:TOpCG;value : qword;const l: tlocation);
- begin
- case l.loc of
- LOC_REFERENCE, LOC_CREFERENCE:
- a_op64_const_ref(list,op,value,l.reference);
- LOC_REGISTER,LOC_CREGISTER:
- a_op64_const_reg(list,op,value,l.register64);
- else
- internalerror(200203292);
- end;
- end;
- procedure tcg64f32.a_op64_reg_loc(list : taasmoutput;op:TOpCG;reg : tregister64;const l : tlocation);
- begin
- case l.loc of
- LOC_REFERENCE, LOC_CREFERENCE:
- a_op64_reg_ref(list,op,reg,l.reference);
- LOC_REGISTER,LOC_CREGISTER:
- a_op64_reg_reg(list,op,reg,l.register64);
- else
- internalerror(2002032422);
- end;
- end;
- procedure tcg64f32.a_op64_loc_reg(list : taasmoutput;op:TOpCG;const l : tlocation;reg : tregister64);
- begin
- case l.loc of
- LOC_REFERENCE, LOC_CREFERENCE:
- a_op64_ref_reg(list,op,l.reference,reg);
- LOC_REGISTER,LOC_CREGISTER:
- a_op64_reg_reg(list,op,l.register64,reg);
- LOC_CONSTANT :
- a_op64_const_reg(list,op,l.valueqword,reg);
- else
- internalerror(200203242);
- end;
- end;
- procedure tcg64f32.a_op64_ref_reg(list : taasmoutput;op:TOpCG;const ref : treference;reg : tregister64);
- var
- tempreg: tregister64;
- begin
- tempreg.reghi:=cg.getintregister(list,OS_INT);
- tempreg.reglo:=cg.getintregister(list,OS_INT);
- a_load64_ref_reg(list,ref,tempreg,false);
- a_op64_reg_reg(list,op,tempreg,reg);
- cg.ungetregister(list,tempreg.reglo);
- cg.ungetregister(list,tempreg.reghi);
- end;
- procedure tcg64f32.a_op64_reg_ref(list : taasmoutput;op:TOpCG;reg : tregister64; const ref: treference);
- var
- tempreg: tregister64;
- begin
- tempreg.reghi:=cg.getintregister(list,OS_INT);
- tempreg.reglo:=cg.getintregister(list,OS_INT);
- a_load64_ref_reg(list,ref,tempreg,false);
- a_op64_reg_reg(list,op,reg,tempreg);
- a_load64_reg_ref(list,tempreg,ref);
- cg.ungetregister(list,tempreg.reglo);
- cg.ungetregister(list,tempreg.reghi);
- end;
- procedure tcg64f32.a_op64_const_ref(list : taasmoutput;op:TOpCG;value : qword;const ref : treference);
- var
- tempreg: tregister64;
- begin
- tempreg.reghi:=cg.getintregister(list,OS_INT);
- tempreg.reglo:=cg.getintregister(list,OS_INT);
- a_load64_ref_reg(list,ref,tempreg,false);
- a_op64_const_reg(list,op,value,tempreg);
- a_load64_reg_ref(list,tempreg,ref);
- cg.ungetregister(list,tempreg.reglo);
- cg.ungetregister(list,tempreg.reghi);
- end;
- procedure tcg64f32.a_param64_reg(list : taasmoutput;reg : tregister64;const locpara : tparalocation);
- var
- tmplochi,tmploclo: tparalocation;
- begin
- paramanager.splitparaloc64(locpara,tmploclo,tmplochi);
- cg.a_param_reg(list,OS_32,reg.reghi,tmplochi);
- cg.a_param_reg(list,OS_32,reg.reglo,tmploclo);
- end;
- procedure tcg64f32.a_param64_const(list : taasmoutput;value : qword;const locpara : tparalocation);
- var
- tmplochi,tmploclo: tparalocation;
- begin
- paramanager.splitparaloc64(locpara,tmploclo,tmplochi);
- cg.a_param_const(list,OS_32,hi(value),tmplochi);
- cg.a_param_const(list,OS_32,lo(value),tmploclo);
- end;
- procedure tcg64f32.a_param64_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);
- var
- tmprefhi,tmpreflo : treference;
- tmploclo,tmplochi : tparalocation;
- begin
- paramanager.splitparaloc64(locpara,tmploclo,tmplochi);
- tmprefhi:=r;
- tmpreflo:=r;
- if target_info.endian=endian_big then
- inc(tmpreflo.offset,4)
- else
- inc(tmprefhi.offset,4);
- cg.a_param_ref(list,OS_32,tmprefhi,tmplochi);
- cg.a_param_ref(list,OS_32,tmpreflo,tmploclo);
- end;
- procedure tcg64f32.a_param64_loc(list : taasmoutput;const l:tlocation;const locpara : tparalocation);
- begin
- case l.loc of
- LOC_REGISTER,
- LOC_CREGISTER :
- a_param64_reg(list,l.register64,locpara);
- LOC_CONSTANT :
- a_param64_const(list,l.valueqword,locpara);
- LOC_CREFERENCE,
- LOC_REFERENCE :
- a_param64_ref(list,l.reference,locpara);
- else
- internalerror(200203287);
- end;
- end;
- procedure tcg64f32.g_rangecheck64(list : taasmoutput;const l:tlocation;fromdef,todef:tdef);
- var
- neglabel,
- poslabel,
- endlabel: tasmlabel;
- hreg : tregister;
- hdef : torddef;
- opsize : tcgsize;
- oldregisterdef: boolean;
- from_signed,to_signed: boolean;
- got_scratch: boolean;
- temploc : tlocation;
- begin
- from_signed := is_signed(fromdef);
- to_signed := is_signed(todef);
- if not is_64bit(todef) then
- begin
- oldregisterdef := registerdef;
- registerdef := false;
- { get the high dword in a register }
- if l.loc in [LOC_REGISTER,LOC_CREGISTER] then
- begin
- hreg := l.registerhigh;
- got_scratch := false
- end
- else
- begin
- hreg:=cg.getintregister(list,OS_INT);
- got_scratch := true;
- a_load64high_ref_reg(list,l.reference,hreg);
- end;
- objectlibrary.getlabel(poslabel);
- { check high dword, must be 0 (for positive numbers) }
- cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,0,hreg,poslabel);
- { It can also be $ffffffff, but only for negative numbers }
- if from_signed and to_signed then
- begin
- objectlibrary.getlabel(neglabel);
- cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,aword(-1),hreg,neglabel);
- end;
- { !!! freeing of register should happen directly after compare! (JM) }
- if got_scratch then
- cg.ungetregister(list,hreg);
- { For all other values we have a range check error }
- cg.a_call_name(list,'FPC_RANGEERROR');
- { if the high dword = 0, the low dword can be considered a }
- { simple cardinal }
- cg.a_label(list,poslabel);
- hdef:=torddef.create(u32bit,0,cardinal($ffffffff));
- { no use in calling just "g_rangecheck" since that one will }
- { simply call the inherited method too (JM) }
- location_copy(temploc,l);
- temploc.size:=OS_32;
- cg.g_rangecheck(list,temploc,hdef,todef);
- hdef.free;
- if from_signed and to_signed then
- begin
- objectlibrary.getlabel(endlabel);
- cg.a_jmp_always(list,endlabel);
- { if the high dword = $ffffffff, then the low dword (when }
- { considered as a longint) must be < 0 }
- cg.a_label(list,neglabel);
- if l.loc in [LOC_REGISTER,LOC_CREGISTER] then
- begin
- hreg := l.registerlow;
- got_scratch := false
- end
- else
- begin
- hreg:=cg.getintregister(list,OS_INT);
- got_scratch := true;
- a_load64low_ref_reg(list,l.reference,hreg);
- end;
- { get a new neglabel (JM) }
- objectlibrary.getlabel(neglabel);
- cg.a_cmp_const_reg_label(list,OS_32,OC_LT,0,hreg,neglabel);
- { !!! freeing of register should happen directly after compare! (JM) }
- if got_scratch then
- cg.ungetregister(list,hreg);
- cg.a_call_name(list,'FPC_RANGEERROR');
- { if we get here, the 64bit value lies between }
- { longint($80000000) and -1 (JM) }
- cg.a_label(list,neglabel);
- hdef:=torddef.create(s32bit,longint($80000000),-1);
- location_copy(temploc,l);
- temploc.size:=OS_32;
- cg.g_rangecheck(list,temploc,hdef,todef);
- hdef.free;
- cg.a_label(list,endlabel);
- end;
- registerdef := oldregisterdef;
- end
- else
- { todef = 64bit int }
- { no 64bit subranges supported, so only a small check is necessary }
- { if both are signed or both are unsigned, no problem! }
- if (from_signed xor to_signed) and
- { also not if the fromdef is unsigned and < 64bit, since that will }
- { always fit in a 64bit int (todef is 64bit) }
- (from_signed or
- (torddef(fromdef).typ = u64bit)) then
- begin
- { in all cases, there is only a problem if the higest bit is set }
- if l.loc in [LOC_REGISTER,LOC_CREGISTER] then
- begin
- if is_64bit(fromdef) then
- begin
- hreg := l.registerhigh;
- opsize := OS_32;
- end
- else
- begin
- hreg := l.register;
- opsize := def_cgsize(fromdef);
- end;
- got_scratch := false;
- end
- else
- begin
- hreg:=cg.getintregister(list,OS_INT);
- got_scratch := true;
- opsize := def_cgsize(fromdef);
- if opsize in [OS_64,OS_S64] then
- a_load64high_ref_reg(list,l.reference,hreg)
- else
- cg.a_load_ref_reg(list,opsize,OS_INT,l.reference,hreg);
- end;
- objectlibrary.getlabel(poslabel);
- cg.a_cmp_const_reg_label(list,opsize,OC_GTE,0,hreg,poslabel);
- { !!! freeing of register should happen directly after compare! (JM) }
- if got_scratch then
- cg.ungetregister(list,hreg);
- cg.a_call_name(list,'FPC_RANGEERROR');
- cg.a_label(list,poslabel);
- end;
- end;
- function tcg64f32.optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : qword; var reg: tregister64): boolean;
- var
- lowvalue, highvalue : cardinal;
- hreg: tregister;
- begin
- lowvalue := cardinal(a);
- highvalue:= a shr 32;
- { assume it will be optimized out }
- optimize64_op_const_reg := true;
- case op of
- OP_ADD:
- begin
- if a = 0 then
- exit;
- end;
- OP_AND:
- begin
- if lowvalue <> high(cardinal) then
- cg.a_op_const_reg(list,op,OS_32,lowvalue,reg.reglo);
- if highvalue <> high(cardinal) then
- cg.a_op_const_reg(list,op,OS_32,highvalue,reg.reghi);
- { already emitted correctly }
- exit;
- end;
- OP_OR:
- begin
- if lowvalue <> 0 then
- cg.a_op_const_reg(list,op,OS_32,lowvalue,reg.reglo);
- if highvalue <> 0 then
- cg.a_op_const_reg(list,op,OS_32,highvalue,reg.reghi);
- { already emitted correctly }
- exit;
- end;
- OP_SUB:
- begin
- if a = 0 then
- exit;
- end;
- OP_XOR:
- begin
- end;
- OP_SHL:
- begin
- if a = 0 then
- exit;
- { simply clear low-register
- and shift the rest and swap
- registers.
- }
- if (a > 31) then
- begin
- cg.a_load_const_reg(list,OS_32,0,reg.reglo);
- cg.a_op_const_reg(list,OP_SHL,OS_32,a mod 32,reg.reghi);
- { swap the registers }
- hreg := reg.reghi;
- reg.reghi := reg.reglo;
- reg.reglo := hreg;
- exit;
- end;
- end;
- OP_SHR:
- begin
- if a = 0 then exit;
- { simply clear high-register
- and shift the rest and swap
- registers.
- }
- if (a > 31) then
- begin
- cg.a_load_const_reg(list,OS_32,0,reg.reghi);
- cg.a_op_const_reg(list,OP_SHL,OS_32,a mod 32,reg.reglo);
- { swap the registers }
- hreg := reg.reghi;
- reg.reghi := reg.reglo;
- reg.reglo := hreg;
- exit;
- end;
- end;
- OP_IMUL,OP_MUL:
- begin
- if a = 1 then exit;
- end;
- OP_IDIV,OP_DIV:
- begin
- if a = 1 then exit;
- end;
- else
- internalerror(20020817);
- end;
- optimize64_op_const_reg := false;
- end;
- (*
- procedure int64f32_assignment_int64_reg(p : passignmentnode);
- begin
- end;
- begin
- p2_assignment:=@int64f32_assignement_int64;
- *)
- end.
- {
- $Log$
- Revision 1.52 2003-10-10 17:48:13 peter
- * old trgobj moved to x86/rgcpu and renamed to trgx86fpu
- * tregisteralloctor renamed to trgobj
- * removed rgobj from a lot of units
- * moved location_* and reference_* to cgobj
- * first things for mmx register allocation
- Revision 1.51 2003/10/09 21:31:37 daniel
- * Register allocator splitted, ans abstract now
- Revision 1.50 2003/10/01 20:34:48 peter
- * procinfo unit contains tprocinfo
- * cginfo renamed to cgbase
- * moved cgmessage to verbose
- * fixed ppc and sparc compiles
- Revision 1.49 2003/09/03 15:55:00 peter
- * NEWRA branch merged
- Revision 1.48.2.2 2003/08/28 18:35:07 peter
- * tregister changed to cardinal
- Revision 1.48.2.1 2003/08/27 20:23:55 peter
- * remove old ra code
- Revision 1.48 2003/07/02 22:18:04 peter
- * paraloc splitted in callerparaloc,calleeparaloc
- * sparc calling convention updates
- Revision 1.47 2003/06/03 21:11:09 peter
- * cg.a_load_* get a from and to size specifier
- * makeregsize only accepts newregister
- * i386 uses generic tcgnotnode,tcgunaryminus
- Revision 1.46 2003/06/03 13:01:59 daniel
- * Register allocator finished
- Revision 1.45 2003/06/01 21:38:06 peter
- * getregisterfpu size parameter added
- * op_const_reg size parameter added
- * sparc updates
- Revision 1.44 2003/05/14 19:31:37 jonas
- * fixed a_param64_reg
- Revision 1.43 2003/04/27 14:48:09 jonas
- * fixed Florian's quick hack :)
- * fixed small bug 64bit range checking code
- Revision 1.42 2003/04/27 09:10:49 florian
- * quick fix for param64 for intel
- Revision 1.41 2003/04/27 08:23:51 florian
- * fixed parameter passing for 64 bit ints
- Revision 1.40 2003/04/23 20:16:03 peter
- + added currency support based on int64
- + is_64bit for use in cg units instead of is_64bitint
- * removed cgmessage from n386add, replace with internalerrors
- Revision 1.39 2003/04/22 10:09:34 daniel
- + Implemented the actual register allocator
- + Scratch registers unavailable when new register allocator used
- + maybe_save/maybe_restore unavailable when new register allocator used
- Revision 1.38 2003/04/07 08:52:58 jonas
- * fixed compiling error
- Revision 1.37 2003/04/07 08:45:09 jonas
- + generic a_op64_reg_ref implementation
- Revision 1.36 2003/03/28 19:16:56 peter
- * generic constructor working for i386
- * remove fixed self register
- * esi added as address register for i386
- Revision 1.35 2003/02/19 22:00:14 daniel
- * Code generator converted to new register notation
- - Horribily outdated todo.txt removed
- Revision 1.34 2003/01/08 18:43:56 daniel
- * Tregister changed into a record
- Revision 1.33 2003/01/05 13:36:53 florian
- * x86-64 compiles
- + very basic support for float128 type (x86-64 only)
- Revision 1.32 2002/11/25 17:43:16 peter
- * splitted defbase in defutil,symutil,defcmp
- * merged isconvertable and is_equal into compare_defs(_ext)
- * made operator search faster by walking the list only once
- Revision 1.31 2002/10/05 12:43:23 carl
- * fixes for Delphi 6 compilation
- (warning : Some features do not work under Delphi)
- Revision 1.30 2002/09/17 18:54:01 jonas
- * a_load_reg_reg() now has two size parameters: source and dest. This
- allows some optimizations on architectures that don't encode the
- register size in the register name.
- Revision 1.29 2002/09/10 21:24:38 jonas
- * fixed a_param64_ref
- Revision 1.28 2002/09/07 15:25:00 peter
- * old logs removed and tabs fixed
- Revision 1.27 2002/08/19 18:17:47 carl
- + optimize64_op_const_reg implemented (optimizes 64-bit constant opcodes)
- * more fixes to m68k for 64-bit operations
- Revision 1.26 2002/08/17 22:09:43 florian
- * result type handling in tcgcal.pass_2 overhauled
- * better tnode.dowrite
- * some ppc stuff fixed
- Revision 1.25 2002/08/14 18:41:47 jonas
- - remove valuelow/valuehigh fields from tlocation, because they depend
- on the endianess of the host operating system -> difficult to get
- right. Use lo/hi(location.valueqword) instead (remember to use
- valueqword and not value!!)
- Revision 1.24 2002/08/11 14:32:26 peter
- * renamed current_library to objectlibrary
- Revision 1.23 2002/08/11 13:24:11 peter
- * saving of asmsymbols in ppu supported
- * asmsymbollist global is removed and moved into a new class
- tasmlibrarydata that will hold the info of a .a file which
- corresponds with a single module. Added librarydata to tmodule
- to keep the library info stored for the module. In the future the
- objectfiles will also be stored to the tasmlibrarydata class
- * all getlabel/newasmsymbol and friends are moved to the new class
- Revision 1.22 2002/07/28 15:57:15 jonas
- * fixed a_load64_const_reg() for big endian systems
- Revision 1.21 2002/07/20 11:57:52 florian
- * types.pas renamed to defbase.pas because D6 contains a types
- unit so this would conflicts if D6 programms are compiled
- + Willamette/SSE2 instructions to assembler added
- Revision 1.20 2002/07/12 10:14:26 jonas
- * some big-endian fixes
- Revision 1.19 2002/07/11 07:23:17 jonas
- + generic implementations of a_op64_ref_reg() and a_op64_const_ref()
- (only works for processors with >2 scratch registers)
- Revision 1.18 2002/07/10 11:12:44 jonas
- * fixed a_op64_const_loc()
- Revision 1.17 2002/07/07 09:52:32 florian
- * powerpc target fixed, very simple units can be compiled
- * some basic stuff for better callparanode handling, far from being finished
- Revision 1.16 2002/07/01 18:46:21 peter
- * internal linker
- * reorganized aasm layer
- Revision 1.15 2002/07/01 16:23:52 peter
- * cg64 patch
- * basics for currency
- * asnode updates for class and interface (not finished)
- Revision 1.14 2002/05/20 13:30:40 carl
- * bugfix of hdisponen (base must be set, not index)
- * more portability fixes
- Revision 1.13 2002/05/18 13:34:05 peter
- * readded missing revisions
- Revision 1.12 2002/05/16 19:46:35 carl
- + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
- + try to fix temp allocation (still in ifdef)
- + generic constructor calls
- + start of tassembler / tmodulebase class cleanup
- Revision 1.10 2002/05/12 16:53:04 peter
- * moved entry and exitcode to ncgutil and cgobj
- * foreach gets extra argument for passing local data to the
- iterator function
- * -CR checks also class typecasts at runtime by changing them
- into as
- * fixed compiler to cycle with the -CR option
- * fixed stabs with elf writer, finally the global variables can
- be watched
- * removed a lot of routines from cga unit and replaced them by
- calls to cgobj
- * u32bit-s32bit updates for and,or,xor nodes. When one element is
- u32bit then the other is typecasted also to u32bit without giving
- a rangecheck warning/error.
- * fixed pascal calling method with reversing also the high tree in
- the parast, detected by tcalcst3 test
- Revision 1.9 2002/04/25 20:16:38 peter
- * moved more routines from cga/n386util
- Revision 1.8 2002/04/21 15:28:51 carl
- * a_jmp_cond -> a_jmp_always
- Revision 1.7 2002/04/07 13:21:18 carl
- + more documentation
- }
|