| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050 | {    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,aasmdata,aasmcpu,       cpubase,cpupara,       cgbase,cgobj,parabase,cgutils,       symtype       ;    type      {# Defines all the methods required on 32-bit processors         to handle 64-bit integers.      }      tcg64f32 = class(tcg64)        procedure a_load64_const_ref(list : TAsmList;value : int64;const ref : treference);override;        procedure a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference);override;        procedure a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64);override;        procedure a_load64_reg_reg(list : TAsmList;regsrc,regdst : tregister64);override;        procedure a_load64_const_reg(list : TAsmList;value: int64;reg : tregister64);override;        procedure a_load64_subsetref_reg(list : TAsmList; const sref: tsubsetreference; destreg: tregister64);override;        procedure a_load64_reg_subsetref(list : TAsmList; fromreg: tregister64; const sref: tsubsetreference);override;        procedure a_load64_const_subsetref(list: TAsmlist; a: int64; const sref: tsubsetreference);override;        procedure a_load64_ref_subsetref(list : TAsmList; const fromref: treference; const sref: tsubsetreference);override;        procedure a_load64_subsetref_subsetref(list: TAsmlist; const fromsref, tosref: tsubsetreference);override;        procedure a_load64_subsetref_ref(list : TAsmList; const sref: tsubsetreference; const destref: treference);override;        procedure a_load64_loc_reg(list : TAsmList;const l : tlocation;reg : tregister64);override;        procedure a_load64_loc_ref(list : TAsmList;const l : tlocation;const ref : treference);override;        procedure a_load64_const_loc(list : TAsmList;value : int64;const l : tlocation);override;        procedure a_load64_reg_loc(list : TAsmList;reg : tregister64;const l : tlocation);override;        procedure a_load64high_reg_ref(list : TAsmList;reg : tregister;const ref : treference);override;        procedure a_load64low_reg_ref(list : TAsmList;reg : tregister;const ref : treference);override;        procedure a_load64high_ref_reg(list : TAsmList;const ref : treference;reg : tregister);override;        procedure a_load64low_ref_reg(list : TAsmList;const ref : treference;reg : tregister);override;        procedure a_load64high_loc_reg(list : TAsmList;const l : tlocation;reg : tregister);override;        procedure a_load64low_loc_reg(list : TAsmList;const l : tlocation;reg : tregister);override;        procedure a_op64_ref_reg(list : TAsmList;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64);override;        procedure a_op64_reg_ref(list : TAsmList;op:TOpCG;size : tcgsize;reg : tregister64; const ref: treference);override;        procedure a_op64_const_loc(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;const l: tlocation);override;        procedure a_op64_reg_loc(list : TAsmList;op:TOpCG;size : tcgsize;reg : tregister64;const l : tlocation);override;        procedure a_op64_loc_reg(list : TAsmList;op:TOpCG;size : tcgsize;const l : tlocation;reg : tregister64);override;        procedure a_op64_const_ref(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;const ref : treference);override;        procedure a_load64_reg_cgpara(list : TAsmList;reg : tregister64;const paraloc : tcgpara);override;        procedure a_load64_const_cgpara(list : TAsmList;value : int64;const paraloc : tcgpara);override;        procedure a_load64_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara);override;        procedure a_load64_loc_cgpara(list : TAsmList;const l : tlocation;const paraloc : tcgpara);override;        procedure a_loadmm_intreg64_reg(list: TAsmList; mmsize: tcgsize; intreg: tregister64; mmreg: tregister);override;        procedure a_loadmm_reg_intreg64(list: TAsmList; mmsize: tcgsize; mmreg: tregister; intreg: tregister64);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: TAsmList; var op: topcg; var a : int64; var reg: tregister64): boolean;override;        procedure g_rangecheck64(list: TAsmList; const l:tlocation;fromdef,todef: tdef); override;      end;  implementation    uses       globtype,systems,constexp,       verbose,cutils,       symbase,symconst,symdef,symtable,defutil,paramgr,       tgobj,hlcgobj;{****************************************************************************                                     Helpers****************************************************************************}    procedure swap64(var q : int64);      begin         q:=(int64(lo(q)) shl 32) or hi(q);      end;    procedure splitparaloc64(const cgpara:tcgpara;var cgparalo,cgparahi:tcgpara);      var        paraloclo,paraloclo2,        paralochi,paralochi2 : pcgparalocation;      begin        if not(cgpara.size in [OS_64,OS_S64]) then          internalerror(200408231);        if not assigned(cgpara.location) then          internalerror(200408201);        { init lo/hi para }        cgparahi.reset;        if cgpara.size=OS_S64 then          cgparahi.size:=OS_S32        else          cgparahi.size:=OS_32;        cgparahi.intsize:=4;        cgparahi.alignment:=cgpara.alignment;        paralochi:=cgparahi.add_location;        cgparalo.reset;        cgparalo.size:=OS_32;        cgparalo.intsize:=4;        cgparalo.alignment:=cgpara.alignment;        paraloclo:=cgparalo.add_location;        case cgpara.locations_count of          4:            begin              { 4 parameter fields? }              { Order for multiple locations is always                  paraloc^ -> high                  paraloc^.next -> low }              if (target_info.endian=ENDIAN_BIG) then                begin                  { paraloc^ -> high }                  move(cgpara.location^,paralochi^,sizeof(paralochi^));                  paralochi^.next:=nil;                  paralochi2:=cgparahi.add_location;                  move(cgpara.location^.next,paralochi2^,sizeof(paralochi2^));                  { paraloc^.next^.next^ -> low }                  move(cgpara.location^.next^.next^,paraloclo^,sizeof(paraloclo^));                  paraloclo^.next:=nil;                  paraloclo2:=cgparalo.add_location;                  move(cgpara.location^.next^.next^.next^,paraloclo2^,sizeof(paraloclo2^));                end              else                begin                  { paraloc^ -> low }                  move(cgpara.location^,paraloclo^,sizeof(paraloclo^));                  paraloclo^.next:=nil;                  paraloclo2:=cgparalo.add_location;                  move(cgpara.location^.next^,paraloclo2^,sizeof(paraloclo2^));                  { paraloc^.next^.next -> high }                  move(cgpara.location^.next^.next^,paralochi^,sizeof(paralochi^));                  paralochi^.next:=nil;                  paralochi2:=cgparahi.add_location;                  move(cgpara.location^.next^.next^.next^,paralochi2^,sizeof(paralochi2^));                end;              { fix size }              paraloclo^.size:=OS_16;              paraloclo2^.size:=OS_16;              paraloclo2^.next:=nil;              paralochi^.size:=OS_16;              paralochi2^.size:=OS_16;              paralochi2^.next:=nil;              if cgpara.size=OS_S64 then                if target_info.endian=ENDIAN_BIG then                  paralochi^.size:=OS_S16                else                  paraloclo2^.size:=OS_S16;            end;          2:            begin              { 2 parameter fields? }              { Order for multiple locations is always                  paraloc^ -> high                  paraloc^.next -> low }              if (target_info.endian=ENDIAN_BIG) then                begin                  { paraloc^ -> high                    paraloc^.next -> low }                  move(cgpara.location^,paralochi^,sizeof(paralochi^));                  move(cgpara.location^.next^,paraloclo^,sizeof(paraloclo^));                end              else                begin                  { paraloc^ -> low                    paraloc^.next -> high }                  move(cgpara.location^,paraloclo^,sizeof(paraloclo^));                  move(cgpara.location^.next^,paralochi^,sizeof(paralochi^));                end;              { fix size }              paraloclo^.size:=cgparalo.size;              paraloclo^.next:=nil;              paralochi^.size:=cgparahi.size;              paralochi^.next:=nil;            end;          1:            begin              { single parameter, this can only be in memory }              if cgpara.location^.loc<>LOC_REFERENCE then                internalerror(200408282);              move(cgpara.location^,paraloclo^,sizeof(paraloclo^));              move(cgpara.location^,paralochi^,sizeof(paralochi^));              { for big endian low is at +4, for little endian high }              if target_info.endian = endian_big then                begin                  inc(cgparalo.location^.reference.offset,4);                  cgparalo.alignment:=newalignment(cgparalo.alignment,4);                end              else                begin                  inc(cgparahi.location^.reference.offset,4);                  cgparahi.alignment:=newalignment(cgparahi.alignment,4);                end;              { fix size }              paraloclo^.size:=cgparalo.size;              paraloclo^.next:=nil;              paralochi^.size:=cgparahi.size;              paralochi^.next:=nil;            end;          else            internalerror(2013051901);        end;      end;{****************************************************************************                                   TCG64F32****************************************************************************}    procedure tcg64f32.a_load64_reg_ref(list : TAsmList;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 : TAsmList;value : int64;const ref : treference);      var        tmpref: treference;      begin        if target_info.endian = endian_big then          swap64(value);        cg.a_load_const_ref(list,OS_32,longint(lo(value)),ref);        tmpref := ref;        inc(tmpref.offset,4);        cg.a_load_const_ref(list,OS_32,longint(hi(value)),tmpref);      end;    procedure tcg64f32.a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64);      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;        tmpref := ref;        if (tmpref.base=reg.reglo) then         begin           tmpreg:=cg.getaddressregister(list);           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);            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);        cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reghi);      end;    procedure tcg64f32.a_load64_reg_reg(list : TAsmList;regsrc,regdst : tregister64);      begin        cg.a_load_reg_reg(list,OS_32,OS_32,regsrc.reglo,regdst.reglo);        cg.a_load_reg_reg(list,OS_32,OS_32,regsrc.reghi,regdst.reghi);      end;    procedure tcg64f32.a_load64_const_reg(list : TAsmList;value : int64;reg : tregister64);      begin        cg.a_load_const_reg(list,OS_32,longint(lo(value)),reg.reglo);        cg.a_load_const_reg(list,OS_32,longint(hi(value)),reg.reghi);      end;    procedure tcg64f32.a_load64_subsetref_reg(list : TAsmList; const sref: tsubsetreference; destreg: tregister64);      var        tmpreg: tregister;        tmpsref: tsubsetreference;      begin        if (sref.bitindexreg <> NR_NO) or           (sref.bitlen <> 64) then          internalerror(2006082310);        if (sref.startbit = 0) then          begin            a_load64_ref_reg(list,sref.ref,destreg);            exit;          end;        if target_info.endian = endian_big then          begin            tmpreg := destreg.reglo;            destreg.reglo := destreg.reghi;            destreg.reghi := tmpreg;          end;        tmpsref:=sref;        if (tmpsref.ref.base=destreg.reglo) then         begin           tmpreg:=cg.getaddressregister(list);           cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpsref.ref.base,tmpreg);           tmpsref.ref.base:=tmpreg;         end        else         if (tmpsref.ref.index=destreg.reglo) then          begin            tmpreg:=cg.getaddressregister(list);            cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpsref.ref.index,tmpreg);            tmpsref.ref.index:=tmpreg;          end;        tmpsref.bitlen:=32;        hlcg.a_load_subsetref_reg(list,u32inttype,u32inttype,tmpsref,destreg.reglo);        inc(tmpsref.ref.offset,4);        hlcg.a_load_subsetref_reg(list,u32inttype,u32inttype,tmpsref,destreg.reghi);      end;    procedure tcg64f32.a_load64_reg_subsetref(list : TAsmList; fromreg: tregister64; const sref: tsubsetreference);      var        tmpreg: tregister;        tmpsref: tsubsetreference;      begin        if (sref.bitindexreg <> NR_NO) or           (sref.bitlen <> 64) then          internalerror(2006082311);        if (sref.startbit = 0) then          begin            a_load64_reg_ref(list,fromreg,sref.ref);            exit;          end;        if target_info.endian = endian_big then          begin            tmpreg:=fromreg.reglo;            fromreg.reglo:=fromreg.reghi;            fromreg.reghi:=tmpreg;          end;        tmpsref:=sref;        tmpsref.bitlen:=32;        hlcg.a_load_reg_subsetref(list,u32inttype,u32inttype,fromreg.reglo,tmpsref);        inc(tmpsref.ref.offset,4);        hlcg.a_load_reg_subsetref(list,u32inttype,u32inttype,fromreg.reghi,tmpsref);      end;    procedure tcg64f32.a_load64_const_subsetref(list: TAsmlist; a: int64; const sref: tsubsetreference);      var        tmpsref: tsubsetreference;      begin        if (sref.bitindexreg <> NR_NO) or           (sref.bitlen <> 64) then          internalerror(2006082312);        if target_info.endian = endian_big then          swap64(a);        tmpsref := sref;        tmpsref.bitlen := 32;        hlcg.a_load_const_subsetref(list,u32inttype,longint(lo(a)),tmpsref);        inc(tmpsref.ref.offset,4);        hlcg.a_load_const_subsetref(list,u32inttype,longint(hi(a)),tmpsref);      end;    procedure tcg64f32.a_load64_subsetref_subsetref(list: TAsmlist; const fromsref, tosref: tsubsetreference);      var        tmpreg64 : tregister64;      begin        tmpreg64.reglo:=cg.getintregister(list,OS_32);        tmpreg64.reghi:=cg.getintregister(list,OS_32);        a_load64_subsetref_reg(list,fromsref,tmpreg64);        a_load64_reg_subsetref(list,tmpreg64,tosref);      end;    procedure tcg64f32.a_load64_subsetref_ref(list : TAsmList; const sref: tsubsetreference; const destref: treference);      var        tmpreg64 : tregister64;      begin        tmpreg64.reglo:=cg.getintregister(list,OS_32);        tmpreg64.reghi:=cg.getintregister(list,OS_32);        a_load64_subsetref_reg(list,sref,tmpreg64);        a_load64_reg_ref(list,tmpreg64,destref);      end;    procedure tcg64f32.a_load64_ref_subsetref(list : TAsmList; const fromref: treference; const sref: tsubsetreference);      var        tmpreg64 : tregister64;      begin        tmpreg64.reglo:=cg.getintregister(list,OS_32);        tmpreg64.reghi:=cg.getintregister(list,OS_32);        a_load64_ref_reg(list,fromref,tmpreg64);        a_load64_reg_subsetref(list,tmpreg64,sref);      end;    procedure tcg64f32.a_load64_loc_reg(list : TAsmList;const l : tlocation;reg : tregister64);      begin        case l.loc of          LOC_REFERENCE, LOC_CREFERENCE:            a_load64_ref_reg(list,l.reference,reg);          LOC_REGISTER,LOC_CREGISTER:            a_load64_reg_reg(list,l.register64,reg);          LOC_CONSTANT :            a_load64_const_reg(list,l.value64,reg);          LOC_SUBSETREF, LOC_CSUBSETREF:            a_load64_subsetref_reg(list,l.sref,reg);          else            internalerror(200112292);        end;      end;    procedure tcg64f32.a_load64_loc_ref(list : TAsmList;const l : tlocation;const ref : treference);      begin        case l.loc of          LOC_REGISTER,LOC_CREGISTER:            a_load64_reg_ref(list,l.register64,ref);          LOC_CONSTANT :            a_load64_const_ref(list,l.value64,ref);          LOC_SUBSETREF, LOC_CSUBSETREF:            a_load64_subsetref_ref(list,l.sref,ref);          else            internalerror(200203288);        end;      end;    procedure tcg64f32.a_load64_const_loc(list : TAsmList;value : int64;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.register64);          LOC_SUBSETREF, LOC_CSUBSETREF:            a_load64_const_subsetref(list,value,l.sref);          else            internalerror(200112293);        end;      end;    procedure tcg64f32.a_load64_reg_loc(list : TAsmList;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);          LOC_SUBSETREF, LOC_CSUBSETREF:            a_load64_reg_subsetref(list,reg,l.sref);          LOC_MMREGISTER, LOC_CMMREGISTER:            a_loadmm_intreg64_reg(list,l.size,reg,l.register);          else            internalerror(200112294);        end;      end;    procedure tcg64f32.a_load64high_reg_ref(list : TAsmList;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 : TAsmList;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 : TAsmList;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 : TAsmList;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 : TAsmList;const l : tlocation;reg : tregister);      begin        case l.loc of          LOC_REFERENCE,          LOC_CREFERENCE :            a_load64low_ref_reg(list,l.reference,reg);          LOC_REGISTER,          LOC_CREGISTER :            cg.a_load_reg_reg(list,OS_32,OS_32,l.register64.reglo,reg);          LOC_CONSTANT :            cg.a_load_const_reg(list,OS_32,longint(lo(l.value64)),reg);          else            internalerror(200203244);        end;      end;    procedure tcg64f32.a_load64high_loc_reg(list : TAsmList;const l : tlocation;reg : tregister);      begin        case l.loc of          LOC_REFERENCE,          LOC_CREFERENCE :            a_load64high_ref_reg(list,l.reference,reg);          LOC_REGISTER,          LOC_CREGISTER :            cg.a_load_reg_reg(list,OS_32,OS_32,l.register64.reghi,reg);          LOC_CONSTANT :            cg.a_load_const_reg(list,OS_32,longint(hi(l.value64)),reg);          else            internalerror(200203244);        end;      end;    procedure tcg64f32.a_op64_const_loc(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;const l: tlocation);      begin        case l.loc of          LOC_REFERENCE, LOC_CREFERENCE:            a_op64_const_ref(list,op,size,value,l.reference);          LOC_REGISTER,LOC_CREGISTER:            a_op64_const_reg(list,op,size,value,l.register64);          else            internalerror(200203292);        end;      end;    procedure tcg64f32.a_op64_reg_loc(list : TAsmList;op:TOpCG;size : tcgsize;reg : tregister64;const l : tlocation);      begin        case l.loc of          LOC_REFERENCE, LOC_CREFERENCE:            a_op64_reg_ref(list,op,size,reg,l.reference);          LOC_REGISTER,LOC_CREGISTER:            a_op64_reg_reg(list,op,size,reg,l.register64);          else            internalerror(2002032422);        end;      end;    procedure tcg64f32.a_op64_loc_reg(list : TAsmList;op:TOpCG;size : tcgsize;const l : tlocation;reg : tregister64);      begin        case l.loc of          LOC_REFERENCE, LOC_CREFERENCE:            a_op64_ref_reg(list,op,size,l.reference,reg);          LOC_REGISTER,LOC_CREGISTER:            a_op64_reg_reg(list,op,size,l.register64,reg);          LOC_CONSTANT :            a_op64_const_reg(list,op,size,l.value64,reg);          else            internalerror(200203242);        end;      end;    procedure tcg64f32.a_op64_ref_reg(list : TAsmList;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64);      var        tempreg: tregister64;      begin        tempreg.reghi:=cg.getintregister(list,OS_32);        tempreg.reglo:=cg.getintregister(list,OS_32);        a_load64_ref_reg(list,ref,tempreg);        a_op64_reg_reg(list,op,size,tempreg,reg);      end;    procedure tcg64f32.a_op64_reg_ref(list : TAsmList;op:TOpCG;size : tcgsize;reg : tregister64; const ref: treference);      var        tempreg: tregister64;      begin        tempreg.reghi:=cg.getintregister(list,OS_32);        tempreg.reglo:=cg.getintregister(list,OS_32);        a_load64_ref_reg(list,ref,tempreg);        a_op64_reg_reg(list,op,size,reg,tempreg);        a_load64_reg_ref(list,tempreg,ref);      end;    procedure tcg64f32.a_op64_const_ref(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;const ref : treference);      var        tempreg: tregister64;      begin        tempreg.reghi:=cg.getintregister(list,OS_32);        tempreg.reglo:=cg.getintregister(list,OS_32);        a_load64_ref_reg(list,ref,tempreg);        a_op64_const_reg(list,op,size,value,tempreg);        a_load64_reg_ref(list,tempreg,ref);      end;    procedure tcg64f32.a_load64_reg_cgpara(list : TAsmList;reg : tregister64;const paraloc : tcgpara);      var        tmplochi,tmploclo: tcgpara;      begin        tmploclo.init;        tmplochi.init;        splitparaloc64(paraloc,tmploclo,tmplochi);        if target_info.endian=endian_big then          begin            { Keep this order of first lo before hi to have              the correct push order for m68k }            cg.a_load_reg_cgpara(list,OS_32,reg.reglo,tmploclo);            cg.a_load_reg_cgpara(list,OS_32,reg.reghi,tmplochi);          end        else          begin            { Keep this order of first hi before lo to have              the correct push order for i386 }            cg.a_load_reg_cgpara(list,OS_32,reg.reghi,tmplochi);            cg.a_load_reg_cgpara(list,OS_32,reg.reglo,tmploclo);          end;        tmploclo.done;        tmplochi.done;      end;    procedure tcg64f32.a_load64_const_cgpara(list : TAsmList;value : int64;const paraloc : tcgpara);      var        tmplochi,tmploclo: tcgpara;      begin        tmploclo.init;        tmplochi.init;        splitparaloc64(paraloc,tmploclo,tmplochi);        if target_info.endian=endian_big then          begin            { Keep this order of first lo before hi to have              the correct push order for m68k }            cg.a_load_const_cgpara(list,OS_32,longint(lo(value)),tmploclo);            cg.a_load_const_cgpara(list,OS_32,longint(hi(value)),tmplochi);          end        else          begin            { Keep this order of first hi before lo to have              the correct push order for i386 }            cg.a_load_const_cgpara(list,OS_32,longint(hi(value)),tmplochi);            cg.a_load_const_cgpara(list,OS_32,longint(lo(value)),tmploclo);          end;        tmploclo.done;        tmplochi.done;      end;    procedure tcg64f32.a_load64_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara);      var        tmprefhi,tmpreflo : treference;        tmploclo,tmplochi : tcgpara;      begin        tmploclo.init;        tmplochi.init;        splitparaloc64(paraloc,tmploclo,tmplochi);        tmprefhi:=r;        tmpreflo:=r;        if target_info.endian=endian_big then          begin            { Keep this order of first lo before hi to have              the correct push order for m68k }            inc(tmpreflo.offset,4);            cg.a_load_ref_cgpara(list,OS_32,tmpreflo,tmploclo);            cg.a_load_ref_cgpara(list,OS_32,tmprefhi,tmplochi);          end        else          begin            { Keep this order of first hi before lo to have              the correct push order for i386 }            inc(tmprefhi.offset,4);            cg.a_load_ref_cgpara(list,OS_32,tmprefhi,tmplochi);            cg.a_load_ref_cgpara(list,OS_32,tmpreflo,tmploclo);          end;        tmploclo.done;        tmplochi.done;      end;    procedure tcg64f32.a_load64_loc_cgpara(list : TAsmList;const l:tlocation;const paraloc : tcgpara);      begin        case l.loc of          LOC_REGISTER,          LOC_CREGISTER :            a_load64_reg_cgpara(list,l.register64,paraloc);          LOC_CONSTANT :            a_load64_const_cgpara(list,l.value64,paraloc);          LOC_CREFERENCE,          LOC_REFERENCE :            a_load64_ref_cgpara(list,l.reference,paraloc);          else            internalerror(200203287);        end;      end;    procedure tcg64f32.a_loadmm_intreg64_reg(list: TAsmList; mmsize: tcgsize; intreg: tregister64; mmreg: tregister);      var        tmpref: treference;      begin        if (tcgsize2size[mmsize]<>8) then          internalerror(2009112501);        tg.gettemp(list,8,8,tt_normal,tmpref);        a_load64_reg_ref(list,intreg,tmpref);        cg.a_loadmm_ref_reg(list,mmsize,mmsize,tmpref,mmreg,mms_movescalar);        tg.ungettemp(list,tmpref);      end;    procedure tcg64f32.a_loadmm_reg_intreg64(list: TAsmList; mmsize: tcgsize; mmreg: tregister; intreg: tregister64);      var        tmpref: treference;      begin        if (tcgsize2size[mmsize]<>8) then          internalerror(2009112502);        tg.gettemp(list,8,8,tt_normal,tmpref);        cg.a_loadmm_reg_ref(list,mmsize,mmsize,mmreg,tmpref,mms_movescalar);        a_load64_ref_reg(list,tmpref,intreg);        tg.ungettemp(list,tmpref);      end;    procedure tcg64f32.g_rangecheck64(list : TAsmList;const l:tlocation;fromdef,todef:tdef);      var        neglabel,        poslabel,        endlabel: tasmlabel;        hreg   : tregister;        hdef   :  torddef;        opsize   : tcgsize;        from_signed,to_signed: boolean;        temploc : tlocation;      begin         from_signed := is_signed(fromdef);         to_signed := is_signed(todef);         if not is_64bit(todef) then           begin             { get the high dword in a register }             if l.loc in [LOC_REGISTER,LOC_CREGISTER] then               begin                 hreg := l.register64.reghi;               end             else               begin                 hreg:=cg.getintregister(list,OS_32);                 a_load64high_ref_reg(list,l.reference,hreg);               end;             current_asmdata.getjumplabel(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                 current_asmdata.getjumplabel(neglabel);                 cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,-1,hreg,neglabel);               end             else               { we do not have dynamic dfa, so avoid a warning below about the unused                 neglabel }               neglabel:=nil;             { For all other values we have a range check error }             cg.a_call_name(list,'fpc_rangeerror',false);             { if the high dword = 0, the low dword can be considered a }             { simple cardinal                                          }             cg.a_label(list,poslabel);             hdef:=corddef.create(u32bit,0,$ffffffff);             location_copy(temploc,l);             temploc.size:=OS_32;             if (temploc.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and                (target_info.endian = endian_big) then               begin                 inc(temploc.reference.offset,4);                 temploc.reference.alignment:=newalignment(temploc.reference.alignment,4);               end;             hlcg.g_rangecheck(list,temploc,hdef,todef);             hdef.owner.deletedef(hdef);             if from_signed and to_signed then               begin                 current_asmdata.getjumplabel(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.register64.reglo;                   end                 else                   begin                     hreg:=cg.getintregister(list,OS_32);                     a_load64low_ref_reg(list,l.reference,hreg);                   end;                 { get a new neglabel (JM) }                 current_asmdata.getjumplabel(neglabel);                 cg.a_cmp_const_reg_label(list,OS_32,OC_LT,0,hreg,neglabel);                 cg.a_call_name(list,'fpc_rangeerror',false);                 { if we get here, the 64bit value lies between }                 { longint($80000000) and -1 (JM)               }                 cg.a_label(list,neglabel);                 hdef:=corddef.create(s32bit,int64(longint($80000000)),int64(-1));                 location_copy(temploc,l);                 temploc.size:=OS_32;                 hlcg.g_rangecheck(list,temploc,hdef,todef);                 hdef.owner.deletedef(hdef);                 cg.a_label(list,endlabel);               end;           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).ordtype = 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.register64.reghi;                       opsize := OS_32;                     end                   else                     begin                       hreg := l.register;                       opsize := def_cgsize(fromdef);                     end;                 end               else                 begin                   hreg:=cg.getintregister(list,OS_32);                   opsize:=OS_32;                   if l.size in [OS_64,OS_S64] then                     a_load64high_ref_reg(list,l.reference,hreg)                   else                     cg.a_load_ref_reg(list,l.size,OS_32,l.reference,hreg);                 end;               current_asmdata.getjumplabel(poslabel);               cg.a_cmp_const_reg_label(list,opsize,OC_GTE,0,hreg,poslabel);               cg.a_call_name(list,'fpc_rangeerror',false);               cg.a_label(list,poslabel);             end;      end;    function tcg64f32.optimize64_op_const_reg(list: TAsmList; var op: topcg; var a : int64; var reg: tregister64): boolean;      var        lowvalue, highvalue : longint;        hreg: tregister;      begin        lowvalue := longint(a);        highvalue:= longint(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 <> -1 then                cg.a_op_const_reg(list,op,OS_32,lowvalue,reg.reglo);              if highvalue <> -1 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;end.
 |