diff --git a/.gitattributes b/.gitattributes index 39cd006d1f..50d6f19cc8 100644 --- a/.gitattributes +++ b/.gitattributes @@ -149,6 +149,8 @@ compiler/gendef.pas svneol=native#text/plain compiler/generic/cpuinfo.pas svneol=native#text/plain compiler/globals.pas svneol=native#text/plain compiler/globtype.pas svneol=native#text/plain +compiler/hlcg2ll.pas svneol=native#text/plain +compiler/hlcgobj.pas svneol=native#text/plain compiler/html/i386/readme.txt svneol=native#text/plain compiler/html/powerpc/readme.txt svneol=native#text/plain compiler/htypechk.pas svneol=native#text/plain diff --git a/compiler/hlcg2ll.pas b/compiler/hlcg2ll.pas new file mode 100644 index 0000000000..ed557b5004 --- /dev/null +++ b/compiler/hlcg2ll.pas @@ -0,0 +1,1144 @@ +{ + Copyright (c) 1998-2010 by Florian Klaempfl and Jonas Maebe + Member of the Free Pascal development team + + This unit implements the high level code generator object for targets that + only use the low-level code generator + + 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. + + **************************************************************************** +} +{# @abstract(High level code generator to low level) + This class passes the high level code generator methods through to the + low level code generator. +} +unit hlcg2ll; + +{$i fpcdefs.inc} + +{ define hlcginline} + + interface + + uses + cclasses,globtype,constexp, + cpubase,cgbase,cgutils,parabase, + aasmbase,aasmtai,aasmdata,aasmcpu, + symconst,symtype,symdef,rgobj, + node,hlcgobj + ; + + type + {# @abstract(Abstract high level code generator) + This class implements an abstract instruction generator. All + methods of this class are generic and are mapped to low level code + generator methods by default. They have to be overridden for higher + level targets + } + + { thlcg2ll } + + thlcg2ll = class(thlcgobj) + public + {************************************************} + { basic routines } + constructor create; + + {# Gets a register suitable to do integer operations on.} + function getintregister(list:TAsmList;size:tdef):Tregister;override; + {# Gets a register suitable to do integer operations on.} + function getaddressregister(list:TAsmList;size:tdef):Tregister;override; + function getfpuregister(list:TAsmList;size:tdef):Tregister;override; +// we don't have high level defs yet that translate into all mm cgsizes +// function getmmregister(list:TAsmList;size:tdef):Tregister;override; + function getflagregister(list:TAsmList;size:tdef):Tregister;override; + {Does the generic cg need SIMD registers, like getmmxregister? Or should + the cpu specific child cg object have such a method?} + + function uses_registers(rt:Tregistertype):boolean; inline; + + procedure do_register_allocation(list:TAsmList;headertai:tai); inline; + procedure translate_register(var reg : tregister); inline; + + {# Emit a label to the instruction stream. } + procedure a_label(list : TAsmList;l : tasmlabel); inline; + + {# Allocates register r by inserting a pai_realloc record } + procedure a_reg_alloc(list : TAsmList;r : tregister); inline; + {# Deallocates register r by inserting a pa_regdealloc record} + procedure a_reg_dealloc(list : TAsmList;r : tregister); inline; + { Synchronize register, make sure it is still valid } + procedure a_reg_sync(list : TAsmList;r : tregister); inline; + + {# Pass a parameter, which is located in a register, to a routine. + + This routine should push/send the parameter to the routine, as + required by the specific processor ABI and routine modifiers. + It must generate register allocation information for the cgpara in + case it consists of cpuregisters. + + @param(size size of the operand in the register) + @param(r register source of the operand) + @param(cgpara where the parameter will be stored) + } + procedure a_load_reg_cgpara(list : TAsmList;size : tdef;r : tregister;const cgpara : TCGPara);override; + {# Pass a parameter, which is a constant, to a routine. + + A generic version is provided. This routine should + be overridden for optimization purposes if the cpu + permits directly sending this type of parameter. + It must generate register allocation information for the cgpara in + case it consists of cpuregisters. + + @param(size size of the operand in constant) + @param(a value of constant to send) + @param(cgpara where the parameter will be stored) + } + procedure a_load_const_cgpara(list : TAsmList;tosize : tdef;a : aint;const cgpara : TCGPara);override; + {# Pass the value of a parameter, which is located in memory, to a routine. + + A generic version is provided. This routine should + be overridden for optimization purposes if the cpu + permits directly sending this type of parameter. + It must generate register allocation information for the cgpara in + case it consists of cpuregisters. + + @param(size size of the operand in constant) + @param(r Memory reference of value to send) + @param(cgpara where the parameter will be stored) + } + procedure a_load_ref_cgpara(list : TAsmList;size : tdef;const r : treference;const cgpara : TCGPara);override; + {# Pass the value of a parameter, which can be located either in a register or memory location, + to a routine. + + A generic version is provided. + + @param(l location of the operand to send) + @param(nr parameter number (starting from one) of routine (from left to right)) + @param(cgpara where the parameter will be stored) + } + procedure a_load_loc_cgpara(list : TAsmList;size : tdef; const l : tlocation;const cgpara : TCGPara);override; + {# Pass the address of a reference to a routine. This routine + will calculate the address of the reference, and pass this + calculated address as a parameter. + It must generate register allocation information for the cgpara in + case it consists of cpuregisters. + + A generic version is provided. This routine should + be overridden for optimization purposes if the cpu + permits directly sending this type of parameter. + + @param(fromsize type of the reference we are taking the address of) + @param(tosize type of the pointer that we get as a result) + @param(r reference to get address from) + } + procedure a_loadaddr_ref_cgpara(list : TAsmList;fromsize, tosize : tdef;const r : treference;const cgpara : TCGPara);override; + + procedure a_call_name(list : TAsmList;pd : tprocdef;const s : string; weak: boolean);override; + procedure a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister);override; + procedure a_call_ref(list : TAsmList;pd : tabstractprocdef;ref : treference);override; + { same as a_call_name, might be overridden on certain architectures to emit + static calls without usage of a got trampoline } + procedure a_call_name_static(list : TAsmList;pd : tprocdef;const s : string);override; + + { move instructions } + procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : aint;register : tregister);override; + procedure a_load_const_ref(list : TAsmList;tosize : tdef;a : aint;const ref : treference);override; + procedure a_load_const_loc(list : TAsmList;tosize : tdef;a : aint;const loc : tlocation);override; + procedure a_load_reg_ref(list : TAsmList;fromsize, tosize : tdef;register : tregister;const ref : treference);override; + procedure a_load_reg_ref_unaligned(list : TAsmList;fromsize, tosize : tdef;register : tregister;const ref : treference);override; + procedure a_load_reg_reg(list : TAsmList;fromsize, tosize : tdef;reg1,reg2 : tregister);override; + procedure a_load_reg_loc(list : TAsmList;fromsize, tosize : tdef;reg : tregister;const loc: tlocation);override; + procedure a_load_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;register : tregister);override; + procedure a_load_ref_reg_unaligned(list : TAsmList;fromsize, tosize : tdef;const ref : treference;register : tregister);override; + procedure a_load_ref_ref(list : TAsmList;fromsize, tosize : tdef;const sref : treference;const dref : treference);override; + procedure a_load_loc_reg(list : TAsmList;fromsize, tosize : tdef; const loc: tlocation; reg : tregister);override; + procedure a_load_loc_ref(list : TAsmList;fromsize, tosize: tdef; const loc: tlocation; const ref : treference);override; + procedure a_load_loc_subsetreg(list : TAsmList;fromsize, tosize, tosubsetsize: tdef; const loc: tlocation; const sreg : tsubsetregister);override; + procedure a_load_loc_subsetref(list : TAsmList;fromsize, tosize, tosubsetsize: tdef; const loc: tlocation; const sref : tsubsetreference);override; + procedure a_loadaddr_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;r : tregister);override; + + procedure a_load_subsetreg_reg(list : TAsmList; fromsize, fromsubsetsize, tosize: tdef; const sreg: tsubsetregister; destreg: tregister); override; + procedure a_load_reg_subsetreg(list : TAsmList; fromsize, tosize, tosubsetsize: tdef; fromreg: tregister; const sreg: tsubsetregister); override; + procedure a_load_subsetreg_subsetreg(list: TAsmlist; fromsize, fromsubsetsize, tosize, tosubsetsize : tdef; const fromsreg, tosreg: tsubsetregister); override; + procedure a_load_subsetreg_ref(list : TAsmList; fromsize, fromsubsetsize, tosize: tdef; const sreg: tsubsetregister; const destref: treference); override; + procedure a_load_ref_subsetreg(list : TAsmList; fromsize, tosize,tosubsetsize: tdef; const fromref: treference; const sreg: tsubsetregister); override; + procedure a_load_const_subsetreg(list: TAsmlist; tosize, tosubsetsize: tdef; a: aint; const sreg: tsubsetregister); override; + procedure a_load_subsetreg_loc(list: TAsmlist; fromsize, fromsubsetsize, tosize: tdef; const sreg: tsubsetregister; const loc: tlocation); override; + + procedure a_load_subsetref_reg(list : TAsmList; fromsize, fromsubsetsize, tosize: tdef; const sref: tsubsetreference; destreg: tregister); override; + procedure a_load_reg_subsetref(list : TAsmList; fromsize, tosubsetsize, tosize: tdef; fromreg: tregister; const sref: tsubsetreference);override; + procedure a_load_subsetref_subsetref(list: TAsmlist; fromsize, fromsubsetsize, tosize, tosubsetsize : tdef; const fromsref, tosref: tsubsetreference); override; + procedure a_load_subsetref_ref(list : TAsmList; fromsize, fromsubsetsize, tosize: tdef; const sref: tsubsetreference; const destref: treference); override; + procedure a_load_ref_subsetref(list : TAsmList; fromsize, tosize, tosubsetsize: tdef; const fromref: treference; const sref: tsubsetreference); override; + procedure a_load_const_subsetref(list: TAsmlist; tosize, tosubsetsize: tdef; a: aint; const sref: tsubsetreference); override; + procedure a_load_subsetref_loc(list: TAsmlist; fromsize, fromsubsetsize, tosize: tdef; const sref: tsubsetreference; const loc: tlocation); override; + procedure a_load_subsetref_subsetreg(list: TAsmlist; fromsize, fromsubsetsize, tosize, tosubsetsize : tdef; const fromsref: tsubsetreference; const tosreg: tsubsetregister); override; + procedure a_load_subsetreg_subsetref(list: TAsmlist; fromsize, fromsubsetsize, tosize, tosubsetsize : tdef; const fromsreg: tsubsetregister; const tosref: tsubsetreference); override; + + { bit test instructions } + procedure a_bit_test_reg_reg_reg(list : TAsmList; bitnumbersize,valuesize,destsize: tdef;bitnumber,value,destreg: tregister); override; + procedure a_bit_test_const_ref_reg(list: TAsmList; fromsize, destsize: tdef; bitnumber: aint; const ref: treference; destreg: tregister); override; + procedure a_bit_test_const_reg_reg(list: TAsmList; setregsize, destsize: tdef; bitnumber: aint; setreg, destreg: tregister); override; + procedure a_bit_test_const_subsetreg_reg(list: TAsmList; fromsize, fromsubsetsize, destsize: tdef; bitnumber: aint; const setreg: tsubsetregister; destreg: tregister); override; + procedure a_bit_test_reg_ref_reg(list: TAsmList; bitnumbersize, refsize, destsize: tdef; bitnumber: tregister; const ref: treference; destreg: tregister); override; + procedure a_bit_test_reg_loc_reg(list: TAsmList; bitnumbersize, locsize, destsize: tdef; bitnumber: tregister; const loc: tlocation; destreg: tregister);override; + procedure a_bit_test_const_loc_reg(list: TAsmList; locsize, destsize: tdef; bitnumber: aint; const loc: tlocation; destreg: tregister);override; + + { bit set/clear instructions } + procedure a_bit_set_reg_reg(list : TAsmList; doset: boolean; bitnumbersize, destsize: tdef; bitnumber,dest: tregister); override; + procedure a_bit_set_const_ref(list: TAsmList; doset: boolean;destsize: tdef; bitnumber: aint; const ref: treference); override; + procedure a_bit_set_const_reg(list: TAsmList; doset: boolean; destsize: tdef; bitnumber: aint; destreg: tregister); override; + procedure a_bit_set_const_subsetreg(list: TAsmList; doset: boolean; destsize, destsubsetsize: tdef; bitnumber: aint; const destreg: tsubsetregister); override; + procedure a_bit_set_reg_ref(list: TAsmList; doset: boolean; fromsize, tosize: tdef; bitnumber: tregister; const ref: treference); override; + procedure a_bit_set_reg_loc(list: TAsmList; doset: boolean; fromsize, tosize: tdef; bitnumber: tregister; const loc: tlocation);override; + procedure a_bit_set_const_loc(list: TAsmList; doset: boolean; tosize: tdef; bitnumber: aint; const loc: tlocation);override; + + { bit scan instructions } + procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: tdef; src, dst: tregister); override; + + { fpu move instructions } + procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister); override; + procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister); override; + procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference); override; + procedure a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tdef; const ref1,ref2: treference);override; + procedure a_loadfpu_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const reg: tregister);override; + procedure a_loadfpu_reg_loc(list: TAsmList; fromsize, tosize: tdef; const reg: tregister; const loc: tlocation);override; + procedure a_loadfpu_reg_cgpara(list : TAsmList;fromsize: tdef;const r : tregister;const cgpara : TCGPara);override; + procedure a_loadfpu_ref_cgpara(list : TAsmList;fromsize : tdef;const ref : treference;const cgpara : TCGPara);override; + + { vector register move instructions } +// we don't have high level defs yet that translate into all mm cgsizes +{ + procedure a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef;reg1, reg2: tregister;shuffle : pmmshuffle); override; + procedure a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef;const ref: treference; reg: tregister;shuffle : pmmshuffle); override; + procedure a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef;reg: tregister; const ref: treference;shuffle : pmmshuffle); override; + procedure a_loadmm_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const reg: tregister;shuffle : pmmshuffle);override; + procedure a_loadmm_reg_loc(list: TAsmList; fromsize, tosize: tdef; const reg: tregister; const loc: tlocation;shuffle : pmmshuffle);override; + procedure a_loadmm_reg_cgpara(list: TAsmList; fromsize: tdef; reg: tregister;const cgpara : TCGPara;shuffle : pmmshuffle); override; + procedure a_loadmm_ref_cgpara(list: TAsmList; fromsize: tdef; const ref: treference;const cgpara : TCGPara;shuffle : pmmshuffle); override; + procedure a_loadmm_loc_cgpara(list: TAsmList; fromsize: tdef; const loc: tlocation; const cgpara : TCGPara;shuffle : pmmshuffle); override; + procedure a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size : tdef;src,dst: tregister;shuffle : pmmshuffle); override; + procedure a_opmm_ref_reg(list: TAsmList; Op: TOpCG; size : tdef;const ref: treference; reg: tregister;shuffle : pmmshuffle); override; + procedure a_opmm_loc_reg(list: TAsmList; Op: TOpCG; size : tdef;const loc: tlocation; reg: tregister;shuffle : pmmshuffle); override; + procedure a_opmm_reg_ref(list: TAsmList; Op: TOpCG; size : tdef;reg: tregister;const ref: treference; shuffle : pmmshuffle); override; +} +// we don't have high level defs yet that translate into all mm cgsizes +// procedure a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize : tdef; intreg, mmreg: tregister; shuffle: pmmshuffle); override; +// procedure a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize : tdef; mmreg, intreg: tregister; shuffle : pmmshuffle); override; + + { basic arithmetic operations } + { note: for operators which require only one argument (not, neg), use } + { the op_reg_reg, op_reg_ref or op_reg_loc methods and keep in mind } + { that in this case the *second* operand is used as both source and } + { destination (JM) } + procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: tdef; a: Aint; reg: TRegister); override; + procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: tdef; a: Aint; const ref: TReference); override; + procedure a_op_const_subsetreg(list : TAsmList; Op : TOpCG; size, subsetsize : tdef; a : aint; const sreg: tsubsetregister); override; + procedure a_op_const_subsetref(list : TAsmList; Op : TOpCG; size, subsetsize : tdef; a : aint; const sref: tsubsetreference); override; + procedure a_op_const_loc(list : TAsmList; Op: TOpCG; size: tdef; a: Aint; const loc: tlocation);override; + procedure a_op_reg_reg(list : TAsmList; Op: TOpCG; size: tdef; reg1, reg2: TRegister); override; + procedure a_op_reg_ref(list : TAsmList; Op: TOpCG; size: tdef; reg: TRegister; const ref: TReference); override; + procedure a_op_ref_reg(list : TAsmList; Op: TOpCG; size: tdef; const ref: TReference; reg: TRegister); override; + procedure a_op_reg_subsetreg(list: TAsmList; Op: TOpCG; opsize, destsize, destsubsetsize: tdef; reg: TRegister; const sreg: tsubsetregister); override; + procedure a_op_reg_subsetref(list: TAsmList; Op: TOpCG; opsize, destsize, destsubsetsize: tdef; reg: TRegister; const sref: tsubsetreference); override; + procedure a_op_reg_loc(list : TAsmList; Op: TOpCG; size: tdef; reg: tregister; const loc: tlocation);override; + procedure a_op_ref_loc(list : TAsmList; Op: TOpCG; size: tdef; const ref: TReference; const loc: tlocation);override; + + { trinary operations for processors that support them, 'emulated' } + { on others. None with "ref" arguments since I don't think there } + { are any processors that support it (JM) } + procedure a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: aint; src, dst: tregister); override; + procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister); override; + procedure a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: aint; src, dst: tregister;setflags : boolean;var ovloc : tlocation); override; + procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation); override; + + { comparison operations } + procedure a_cmp_const_reg_label(list : TAsmList;size : tdef;cmp_op : topcmp;a : aint;reg : tregister; + l : tasmlabel);override; + procedure a_cmp_const_ref_label(list : TAsmList;size : tdef;cmp_op : topcmp;a : aint;const ref : treference; + l : tasmlabel); override; + procedure a_cmp_const_loc_label(list: TAsmList; size: tdef;cmp_op: topcmp; a: aint; const loc: tlocation; + l : tasmlabel);override; + procedure a_cmp_reg_reg_label(list : TAsmList;size : tdef;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override; + procedure a_cmp_ref_reg_label(list : TAsmList;size : tdef;cmp_op : topcmp; const ref: treference; reg : tregister; l : tasmlabel); override; + procedure a_cmp_reg_ref_label(list : TAsmList;size : tdef;cmp_op : topcmp;reg : tregister; const ref: treference; l : tasmlabel); override; + procedure a_cmp_subsetreg_reg_label(list: TAsmList; fromsize, fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sreg: tsubsetregister; reg: tregister; l: tasmlabel); override; + procedure a_cmp_subsetref_reg_label(list: TAsmList; fromsize, fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sref: tsubsetreference; reg: tregister; l: tasmlabel); override; + + procedure a_cmp_loc_reg_label(list : TAsmList;size : tdef;cmp_op : topcmp; const loc: tlocation; reg : tregister; l : tasmlabel);override; + procedure a_cmp_reg_loc_label(list : TAsmList;size : tdef;cmp_op : topcmp; reg: tregister; const loc: tlocation; l : tasmlabel);override; + procedure a_cmp_ref_loc_label(list: TAsmList; size: tdef;cmp_op: topcmp; const ref: treference; const loc: tlocation; l : tasmlabel);override; + + procedure a_jmp_always(list : TAsmList;l: tasmlabel); override; +{$ifdef cpuflags} + procedure a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); override; + + {# Depending on the value to check in the flags, either sets the register reg to one (if the flag is set) + or zero (if the flag is cleared). The size parameter indicates the destination size register. + } + procedure g_flags2reg(list: TAsmList; size: tdef; const f: tresflags; reg: TRegister); override; + procedure g_flags2ref(list: TAsmList; size: tdef; const f: tresflags; const ref:TReference); override; +{$endif cpuflags} + +// procedure g_maybe_testself(list : TAsmList;reg:tregister); +// procedure g_maybe_testvmt(list : TAsmList;reg:tregister;objdef:tobjectdef); + {# This should emit the opcode to copy len bytes from the source + to destination. + + It must be overridden for each new target processor. + + @param(source Source reference of copy) + @param(dest Destination reference of copy) + + } + procedure g_concatcopy(list : TAsmList;size: tdef; const source,dest : treference);override; + {# This should emit the opcode to copy len bytes from the an unaligned source + to destination. + + It must be overridden for each new target processor. + + @param(source Source reference of copy) + @param(dest Destination reference of copy) + + } + procedure g_concatcopy_unaligned(list : TAsmList;size: tdef; const source,dest : treference);override; + {# This should emit the opcode to a shortrstring from the source + to destination. + + @param(source Source reference of copy) + @param(dest Destination reference of copy) + + } +// procedure g_copyshortstring(list : TAsmList;const source,dest : treference;len:byte); +// procedure g_copyvariant(list : TAsmList;const source,dest : treference); + + procedure g_incrrefcount(list : TAsmList;t: tdef; const ref: treference);override; + procedure g_decrrefcount(list : TAsmList;t: tdef; const ref: treference);override; + procedure g_initialize(list : TAsmList;t : tdef;const ref : treference);override; + procedure g_finalize(list : TAsmList;t : tdef;const ref : treference);override; + + {# Generates range checking code. It is to note + that this routine does not need to be overridden, + as it takes care of everything. + + @param(p Node which contains the value to check) + @param(todef Type definition of node to range check) + } + procedure g_rangecheck(list: TAsmList; const l:tlocation; fromdef,todef: tdef); override; + + {# Generates overflow checking code for a node } + procedure g_overflowcheck(list: TAsmList; const Loc:tlocation; def:tdef); override; + procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;var ovloc : tlocation);override; + +// procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:aint;destreg:tregister);override; +// procedure g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);override; + + {# Emits instructions when compilation is done in profile + mode (this is set as a command line option). The default + behavior does nothing, should be overridden as required. + } + procedure g_profilecode(list : TAsmList);override; + {# Emits instruction for allocating @var(size) bytes at the stackpointer + + @param(size Number of bytes to allocate) + } + procedure g_stackpointer_alloc(list : TAsmList;size : longint);override; + {# Emits instruction for allocating the locals in entry + code of a routine. This is one of the first + routine called in @var(genentrycode). + + @param(localsize Number of bytes to allocate as locals) + } + procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override; + {# Emits instructions for returning from a subroutine. + Should also restore the framepointer and stack. + + @param(parasize Number of bytes of parameters to deallocate from stack) + } + procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);override; + + procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override; + procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: aint);override; + + function g_indirect_sym_load(list:TAsmList;const symname: string; weak: boolean): tregister;override; + { generate a stub which only purpose is to pass control the given external method, + setting up any additional environment before doing so (if required). + + The default implementation issues a jump instruction to the external name. } +// procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string); override; + + procedure location_force_reg(list:TAsmList;var l:tlocation;src_size,dst_size:tdef;maybeconst:boolean);override; + procedure location_force_fpureg(list:TAsmList;var l: tlocation;size: tdef;maybeconst:boolean);override; + procedure location_force_mem(list:TAsmList;var l:tlocation;size:tdef);override; +// procedure location_force_mmregscalar(list:TAsmList;var l: tlocation;size:tdef;maybeconst:boolean);override; +// procedure location_force_mmreg(list:TAsmList;var l: tlocation;size:tdef;maybeconst:boolean);override; + + procedure maketojumpbool(list:TAsmList; p : tnode);override; + end; + + +implementation + + uses + globals,options,systems, + verbose,defutil,paramgr,symsym, + cgobj,tgobj,cutils,procinfo, + ncgutil; + + { thlcg2ll } + + constructor thlcg2ll.create; + begin + end; + + + function thlcg2ll.getintregister(list: TAsmList; size: tdef): Tregister; + begin + result:=cg.getintregister(list,def_cgsize(size)); + end; + + + function thlcg2ll.getaddressregister(list: TAsmList; size: tdef): Tregister; + begin + result:=cg.getaddressregister(list); + end; + + function thlcg2ll.getfpuregister(list: TAsmList; size: tdef): Tregister; + begin + result:=cg.getfpuregister(list,def_cgsize(size)); + end; +(* + function thlcg2ll.getmmregister(list: TAsmList; size: tdef): Tregister; + begin + result:=cg.getmmregister(list,def_cgsize(size)); + end; +*) + function thlcg2ll.getflagregister(list: TAsmList; size: tdef): Tregister; + begin + result:=cg.getflagregister(list,def_cgsize(size)); + end; + + function thlcg2ll.uses_registers(rt: Tregistertype): boolean; + begin + result:=cg.uses_registers(rt); + end; + + procedure thlcg2ll.do_register_allocation(list: TAsmList; headertai: tai); + begin + cg.do_register_allocation(list,headertai); + end; + + procedure thlcg2ll.translate_register(var reg: tregister); + begin + cg.translate_register(reg); + end; + + procedure thlcg2ll.a_label(list: TAsmList; l: tasmlabel); inline; + begin + cg.a_label(list,l); + end; + + procedure thlcg2ll.a_reg_alloc(list: TAsmList; r: tregister); + begin + cg.a_reg_alloc(list,r); + end; + + procedure thlcg2ll.a_reg_dealloc(list: TAsmList; r: tregister); + begin + cg.a_reg_dealloc(list,r); + end; + + procedure thlcg2ll.a_reg_sync(list: TAsmList; r: tregister); + begin + cg.a_reg_sync(list,r); + end; + + procedure thlcg2ll.a_load_reg_cgpara(list: TAsmList; size: tdef; r: tregister; const cgpara: TCGPara); + begin + cg.a_load_reg_cgpara(list,def_cgsize(size),r,cgpara); + end; + + procedure thlcg2ll.a_load_const_cgpara(list: TAsmList; tosize: tdef; a: aint; const cgpara: TCGPara); + begin + cg.a_load_const_cgpara(list,def_cgsize(tosize),a,cgpara); + end; + + procedure thlcg2ll.a_load_ref_cgpara(list: TAsmList; size: tdef; const r: treference; const cgpara: TCGPara); + begin + cg.a_load_ref_cgpara(list,def_cgsize(size),r,cgpara); + end; + + procedure thlcg2ll.a_load_loc_cgpara(list: TAsmList; size: tdef; const l: tlocation; const cgpara: TCGPara); + begin + cg.a_load_loc_cgpara(list,l,cgpara); + end; + + procedure thlcg2ll.a_loadaddr_ref_cgpara(list: TAsmList; fromsize, tosize: tdef; const r: treference; const cgpara: TCGPara); + begin + cg.a_loadaddr_ref_cgpara(list,r,cgpara); + end; + + procedure thlcg2ll.a_call_name(list: TAsmList; pd: tprocdef; const s: string; weak: boolean); + begin + cg.a_call_name(list,s,weak); + end; + + procedure thlcg2ll.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister); + begin + cg.a_call_reg(list,reg); + end; + + procedure thlcg2ll.a_call_ref(list: TAsmList; pd: tabstractprocdef; ref: treference); + begin + cg.a_call_ref(list,ref); + end; + + procedure thlcg2ll.a_call_name_static(list: TAsmList; pd: tprocdef; const s: string); + begin + cg.a_call_name_static(list,s); + end; + + procedure thlcg2ll.a_load_const_reg(list: TAsmList; tosize: tdef; a: aint; register: tregister); + begin + cg.a_load_const_reg(list,def_cgsize(tosize),a,register); + end; + + procedure thlcg2ll.a_load_const_ref(list: TAsmList; tosize: tdef; a: aint; const ref: treference); + begin + cg.a_load_const_ref(list,def_cgsize(tosize),a,ref); + end; + + procedure thlcg2ll.a_load_const_loc(list: TAsmList; tosize: tdef; a: aint; const loc: tlocation); + begin + cg.a_load_const_loc(list,a,loc); + end; + + procedure thlcg2ll.a_load_reg_ref(list: TAsmList; fromsize, tosize: tdef; register: tregister; const ref: treference); + begin + cg.a_load_reg_ref(list,def_cgsize(fromsize),def_cgsize(tosize),register,ref); + end; + + procedure thlcg2ll.a_load_reg_ref_unaligned(list: TAsmList; fromsize, tosize: tdef; register: tregister; const ref: treference); + begin + cg.a_load_reg_ref_unaligned(list,def_cgsize(fromsize),def_cgsize(tosize),register,ref); + end; + + procedure thlcg2ll.a_load_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister); + begin + cg.a_load_reg_reg(list,def_cgsize(fromsize),def_cgsize(tosize),reg1,reg2); + end; + + procedure thlcg2ll.a_load_reg_loc(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const loc: tlocation); + begin + cg.a_load_reg_loc(list,def_cgsize(fromsize),reg,loc); + end; + + procedure thlcg2ll.a_load_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; register: tregister); + begin + cg.a_load_ref_reg(list,def_cgsize(fromsize),def_cgsize(tosize),ref,register); + end; + + procedure thlcg2ll.a_load_ref_reg_unaligned(list: TAsmList; fromsize, tosize: tdef; const ref: treference; register: tregister); + begin + cg.a_load_ref_reg_unaligned(list,def_cgsize(fromsize),def_cgsize(tosize),ref,register); + end; + + procedure thlcg2ll.a_load_ref_ref(list: TAsmList; fromsize, tosize: tdef; const sref: treference; const dref: treference); + begin + cg.a_load_ref_ref(list,def_cgsize(fromsize),def_cgsize(tosize),sref,dref); + end; + + procedure thlcg2ll.a_load_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; reg: tregister); + begin + cg.a_load_loc_reg(list,def_cgsize(tosize),loc,reg); + end; + + procedure thlcg2ll.a_load_loc_ref(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const ref: treference); + begin + cg.a_load_loc_ref(list,def_cgsize(tosize),loc,ref); + end; + + procedure thlcg2ll.a_load_loc_subsetreg(list: TAsmList; fromsize, tosize, tosubsetsize: tdef; const loc: tlocation; const sreg: tsubsetregister); + begin + cg.a_load_loc_subsetreg(list,def_cgsize(tosubsetsize),loc,sreg); + end; + + procedure thlcg2ll.a_load_loc_subsetref(list: TAsmList; fromsize, tosize, tosubsetsize: tdef; const loc: tlocation; const sref: tsubsetreference); + begin + cg.a_load_loc_subsetref(list,def_cgsize(tosubsetsize),loc,sref); + end; + +procedure thlcg2ll.a_loadaddr_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; r: tregister); + begin + cg.a_loadaddr_ref_reg(list,ref,r); + end; + + procedure thlcg2ll.a_load_subsetreg_reg(list: TAsmList; fromsize, fromsubsetsize, tosize: tdef; const sreg: tsubsetregister; destreg: tregister); + begin + cg.a_load_subsetreg_reg(list,def_cgsize(fromsubsetsize),def_cgsize(tosize),sreg,destreg); + end; + + procedure thlcg2ll.a_load_reg_subsetreg(list: TAsmList; fromsize, tosize, tosubsetsize: tdef; fromreg: tregister; const sreg: tsubsetregister); + begin + cg.a_load_reg_subsetreg(list,def_cgsize(fromsize),def_cgsize(tosubsetsize),fromreg,sreg); + end; + + procedure thlcg2ll.a_load_subsetreg_subsetreg(list: TAsmlist; fromsize, fromsubsetsize, tosize, tosubsetsize: tdef; const fromsreg, tosreg: tsubsetregister); + begin + cg.a_load_subsetreg_subsetreg(list,def_cgsize(fromsubsetsize),def_cgsize(tosubsetsize),fromsreg,tosreg); + end; + + procedure thlcg2ll.a_load_subsetreg_ref(list: TAsmList; fromsize, fromsubsetsize, tosize: tdef; const sreg: tsubsetregister; const destref: treference); + begin + cg.a_load_subsetreg_ref(list,def_cgsize(fromsubsetsize),def_cgsize(tosize),sreg,destref); + end; + + procedure thlcg2ll.a_load_ref_subsetreg(list: TAsmList; fromsize, tosize, tosubsetsize: tdef; const fromref: treference; const sreg: tsubsetregister); + begin + cg.a_load_ref_subsetreg(list,def_cgsize(fromsize),def_cgsize(tosubsetsize),fromref,sreg); + end; + + procedure thlcg2ll.a_load_const_subsetreg(list: TAsmlist; tosize, tosubsetsize: tdef; a: aint; const sreg: tsubsetregister); + begin + cg.a_load_const_subsetreg(list,def_cgsize(tosubsetsize),a,sreg); + end; + + procedure thlcg2ll.a_load_subsetreg_loc(list: TAsmlist; fromsize, fromsubsetsize, tosize: tdef; const sreg: tsubsetregister; const loc: tlocation); + begin + cg.a_load_subsetreg_loc(list,def_cgsize(fromsubsetsize),sreg,loc); + end; + + procedure thlcg2ll.a_load_subsetref_reg(list: TAsmList; fromsize, fromsubsetsize, tosize: tdef; const sref: tsubsetreference; destreg: tregister); + begin + cg.a_load_subsetref_reg(list,def_cgsize(fromsubsetsize),def_cgsize(tosize),sref,destreg); + end; + + procedure thlcg2ll.a_load_reg_subsetref(list: TAsmList; fromsize, tosubsetsize, tosize: tdef; fromreg: tregister; const sref: tsubsetreference); + begin + cg.a_load_reg_subsetref(list,def_cgsize(fromsize),def_cgsize(tosubsetsize),fromreg,sref); + end; + + procedure thlcg2ll.a_load_subsetref_subsetref(list: TAsmlist; fromsize, fromsubsetsize, tosize, tosubsetsize: tdef; const fromsref, tosref: tsubsetreference); + begin + cg.a_load_subsetref_subsetref(list,def_cgsize(fromsubsetsize),def_cgsize(tosubsetsize),fromsref,tosref); + end; + + procedure thlcg2ll.a_load_subsetref_ref(list: TAsmList; fromsize, fromsubsetsize, tosize: tdef; const sref: tsubsetreference; const destref: treference); + begin + cg.a_load_subsetref_ref(list,def_cgsize(fromsubsetsize),def_cgsize(tosize),sref,destref); + end; + + procedure thlcg2ll.a_load_ref_subsetref(list: TAsmList; fromsize, tosize, tosubsetsize: tdef; const fromref: treference; const sref: tsubsetreference); + begin + cg.a_load_ref_subsetref(list,def_cgsize(fromsize),def_cgsize(tosubsetsize),fromref,sref); + end; + + procedure thlcg2ll.a_load_const_subsetref(list: TAsmlist; tosize, tosubsetsize: tdef; a: aint; const sref: tsubsetreference); + begin + cg.a_load_const_subsetref(list,def_cgsize(tosubsetsize),a,sref); + end; + + procedure thlcg2ll.a_load_subsetref_loc(list: TAsmlist; fromsize, fromsubsetsize, tosize: tdef; const sref: tsubsetreference; const loc: tlocation); + begin + cg.a_load_subsetref_loc(list,def_cgsize(fromsubsetsize),sref,loc); + end; + + procedure thlcg2ll.a_load_subsetref_subsetreg(list: TAsmlist; fromsize, fromsubsetsize, tosize, tosubsetsize: tdef; const fromsref: tsubsetreference; const tosreg: tsubsetregister); + begin + cg.a_load_subsetref_subsetreg(list,def_cgsize(fromsubsetsize),def_cgsize(tosubsetsize),fromsref,tosreg); + end; + + procedure thlcg2ll.a_load_subsetreg_subsetref(list: TAsmlist; fromsize, fromsubsetsize, tosize, tosubsetsize: tdef; const fromsreg: tsubsetregister; const tosref: tsubsetreference); + begin + cg.a_load_subsetreg_subsetref(list,def_cgsize(fromsubsetsize),def_cgsize(tosubsetsize),fromsreg,tosref); + end; + + procedure thlcg2ll.a_bit_test_reg_reg_reg(list: TAsmList; bitnumbersize, valuesize, destsize: tdef; bitnumber, value, destreg: tregister); + begin + cg.a_bit_test_reg_reg_reg(list,def_cgsize(bitnumbersize),def_cgsize(valuesize),def_cgsize(destsize),bitnumber,value,destreg); + end; + + procedure thlcg2ll.a_bit_test_const_ref_reg(list: TAsmList; fromsize, destsize: tdef; bitnumber: aint; const ref: treference; destreg: tregister); + begin + cg.a_bit_test_const_ref_reg(list,def_cgsize(destsize),bitnumber,ref,destreg); + end; + + procedure thlcg2ll.a_bit_test_const_reg_reg(list: TAsmList; setregsize, destsize: tdef; bitnumber: aint; setreg, destreg: tregister); + begin + cg.a_bit_test_const_reg_reg(list,def_cgsize(setregsize),def_cgsize(destsize),bitnumber,setreg,destreg); + end; + + procedure thlcg2ll.a_bit_test_const_subsetreg_reg(list: TAsmList; fromsize, fromsubsetsize, destsize: tdef; bitnumber: aint; const setreg: tsubsetregister; destreg: tregister); + begin + cg.a_bit_test_const_subsetreg_reg(list,def_cgsize(fromsubsetsize),def_cgsize(destsize),bitnumber,setreg,destreg); + end; + + procedure thlcg2ll.a_bit_test_reg_ref_reg(list: TAsmList; bitnumbersize, refsize, destsize: tdef; bitnumber: tregister; const ref: treference; destreg: tregister); + begin + cg.a_bit_test_reg_ref_reg(list,def_cgsize(bitnumbersize),def_cgsize(destsize),bitnumber,ref,destreg); + end; + + procedure thlcg2ll.a_bit_test_reg_loc_reg(list: TAsmList; bitnumbersize, locsize, destsize: tdef; bitnumber: tregister; const loc: tlocation; destreg: tregister); + begin + cg.a_bit_test_reg_loc_reg(list,def_cgsize(bitnumbersize),def_cgsize(destsize),bitnumber,loc,destreg); + end; + + procedure thlcg2ll.a_bit_test_const_loc_reg(list: TAsmList; locsize, destsize: tdef; bitnumber: aint; const loc: tlocation; destreg: tregister); + begin + cg.a_bit_test_const_loc_reg(list,def_cgsize(destsize),bitnumber,loc,destreg); + end; + + procedure thlcg2ll.a_bit_set_reg_reg(list: TAsmList; doset: boolean; bitnumbersize, destsize: tdef; bitnumber, dest: tregister); + begin + cg.a_bit_set_reg_reg(list,doset,def_cgsize(bitnumbersize),def_cgsize(destsize),bitnumber,dest); + end; + + procedure thlcg2ll.a_bit_set_const_ref(list: TAsmList; doset: boolean; destsize: tdef; bitnumber: aint; const ref: treference); + begin + cg.a_bit_set_const_ref(list,doset,def_cgsize(destsize),bitnumber,ref); + end; + + procedure thlcg2ll.a_bit_set_const_reg(list: TAsmList; doset: boolean; destsize: tdef; bitnumber: aint; destreg: tregister); + begin + cg.a_bit_set_const_reg(list,doset,def_cgsize(destsize),bitnumber,destreg); + end; + + procedure thlcg2ll.a_bit_set_const_subsetreg(list: TAsmList; doset: boolean; destsize, destsubsetsize: tdef; bitnumber: aint; const destreg: tsubsetregister); + begin + cg.a_bit_set_const_subsetreg(list,doset,def_cgsize(destsubsetsize),bitnumber,destreg); + end; + + procedure thlcg2ll.a_bit_set_reg_ref(list: TAsmList; doset: boolean; fromsize, tosize: tdef; bitnumber: tregister; const ref: treference); + begin + cg.a_bit_set_reg_ref(list,doset,def_cgsize(fromsize),bitnumber,ref); + end; + + procedure thlcg2ll.a_bit_set_reg_loc(list: TAsmList; doset: boolean; fromsize, tosize: tdef; bitnumber: tregister; const loc: tlocation); + begin + cg.a_bit_set_reg_loc(list,doset,def_cgsize(fromsize),bitnumber,loc); + end; + + procedure thlcg2ll.a_bit_set_const_loc(list: TAsmList; doset: boolean; tosize: tdef; bitnumber: aint; const loc: tlocation); + begin + cg.a_bit_set_const_loc(list,doset,bitnumber,loc); + end; + + procedure thlcg2ll.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: tdef; src, dst: tregister); + begin + cg.a_bit_scan_reg_reg(list,reverse,def_cgsize(size),src,dst); + end; + + procedure thlcg2ll.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister); + begin + cg.a_loadfpu_reg_reg(list,def_cgsize(fromsize),def_cgsize(tosize),reg1,reg2); + end; + + procedure thlcg2ll.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister); + begin + cg.a_loadfpu_ref_reg(list,def_cgsize(fromsize),def_cgsize(tosize),ref,reg); + end; + + procedure thlcg2ll.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference); + begin + cg.a_loadfpu_reg_ref(list,def_cgsize(fromsize),def_cgsize(tosize),reg,ref); + end; + + procedure thlcg2ll.a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tdef; const ref1, ref2: treference); + begin + cg.a_loadfpu_ref_ref(list,def_cgsize(fromsize),def_cgsize(tosize),ref1,ref2); + end; + + procedure thlcg2ll.a_loadfpu_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const reg: tregister); + begin +{$ifdef extdebug} + if def_cgsize(fromsize)<>loc.size then + internalerror(2010112102); +{$endif} + cg.a_loadfpu_loc_reg(list,def_cgsize(tosize),loc,reg); + end; + + procedure thlcg2ll.a_loadfpu_reg_loc(list: TAsmList; fromsize, tosize: tdef; const reg: tregister; const loc: tlocation); + begin +{$ifdef extdebug} + if def_cgsize(tosize)<>loc.size then + internalerror(2010112101); +{$endif} + cg.a_loadfpu_reg_loc(list,def_cgsize(fromsize),reg,loc); + end; + + procedure thlcg2ll.a_loadfpu_reg_cgpara(list: TAsmList; fromsize: tdef; const r: tregister; const cgpara: TCGPara); + begin + cg.a_loadfpu_reg_cgpara(list,def_cgsize(fromsize),r,cgpara); + end; + + procedure thlcg2ll.a_loadfpu_ref_cgpara(list: TAsmList; fromsize: tdef; const ref: treference; const cgpara: TCGPara); + begin + cg.a_loadfpu_ref_cgpara(list,def_cgsize(fromsize),ref,cgpara); + end; + +(* + procedure thlcg2ll.a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister; shuffle: pmmshuffle); + begin + cg.a_loadmm_reg_reg(list,def_cgsize(fromsize),def_cgsize(tosize),reg1,reg2,shuffle); + end; + + procedure thlcg2ll.a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle); + begin + cg.a_loadmm_ref_reg(list,def_cgsize(fromsize),def_cgsize(tosize),ref,reg,shuffle); + end; + + procedure thlcg2ll.a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle); + begin + cg.a_loadmm_reg_ref(list,def_cgsize(fromsize),def_cgsize(tosize),reg,ref,shuffle); + end; + + procedure thlcg2ll.a_loadmm_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const reg: tregister; shuffle: pmmshuffle); + begin +{$ifdef extdebug} + if def_cgsize(fromsize)<>loc.size then + internalerror(2010112103); +{$endif} + cg.a_loadmm_loc_reg(list,def_cgsize(tosize),loc,reg,shuffle); + end; + + procedure thlcg2ll.a_loadmm_reg_loc(list: TAsmList; fromsize, tosize: tdef; const reg: tregister; const loc: tlocation; shuffle: pmmshuffle); + begin +{$ifdef extdebug} + if def_cgsize(tosize)<>loc.size then + internalerror(2010112104); +{$endif} + cg.a_loadmm_reg_loc(list,def_cgsize(fromsize),reg,loc,shuffle); + end; + + procedure thlcg2ll.a_loadmm_reg_cgpara(list: TAsmList; fromsize: tdef; reg: tregister; const cgpara: TCGPara; shuffle: pmmshuffle); + begin + cg.a_loadmm_reg_cgpara(list,def_cgsize(fromsize),reg,cgpara,shuffle); + end; + + procedure thlcg2ll.a_loadmm_ref_cgpara(list: TAsmList; fromsize: tdef; const ref: treference; const cgpara: TCGPara; shuffle: pmmshuffle); + begin + cg.a_loadmm_ref_cgpara(list,def_cgsize(fromsize),ref,cgpara,shuffle); + end; + + procedure thlcg2ll.a_loadmm_loc_cgpara(list: TAsmList; fromsize: tdef; const loc: tlocation; const cgpara: TCGPara; shuffle: pmmshuffle); + begin +{$ifdef extdebug} + if def_cgsize(fromsize)<>loc.size then + internalerror(2010112105); +{$endif} + cg.a_loadmm_loc_cgpara(list,loc,cgpara,shuffle); + end; + + procedure thlcg2ll.a_opmm_loc_reg(list: TAsmList; Op: TOpCG; size: tdef; const loc: tlocation; reg: tregister; shuffle: pmmshuffle); + begin + cg.a_opmm_loc_reg(list,op,def_cgsize(size),loc,reg,shuffle); + end; +*) + +(* + procedure thlcg2ll.a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize: tdef; intreg, mmreg: tregister; shuffle: pmmshuffle); + begin + cg.a_loadmm_intreg_reg(list,def_cgsize(fromsize),def_cgsize(tosize),intreg,mmreg,shuffle); + end; + + procedure thlcg2ll.a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize: tdef; mmreg, intreg: tregister; shuffle: pmmshuffle); + begin + cg.a_loadmm_reg_intreg(list,def_cgsize(fromsize),def_cgsize(tosize),mmreg,intreg,shuffle); + end; +*) + procedure thlcg2ll.a_op_const_reg(list: TAsmList; Op: TOpCG; size: tdef; a: Aint; reg: TRegister); + begin + cg.a_op_const_reg(list,op,def_cgsize(size),a,reg); + end; + + procedure thlcg2ll.a_op_const_ref(list: TAsmList; Op: TOpCG; size: tdef; a: Aint; const ref: TReference); + begin + cg.a_op_const_ref(list,op,def_cgsize(size),a,ref); + end; + + procedure thlcg2ll.a_op_const_subsetreg(list: TAsmList; Op: TOpCG; size, subsetsize: tdef; a: aint; const sreg: tsubsetregister); + begin + cg.a_op_const_subsetreg(list,op,def_cgsize(size),def_cgsize(subsetsize),a,sreg); + end; + + procedure thlcg2ll.a_op_const_subsetref(list: TAsmList; Op: TOpCG; size, subsetsize: tdef; a: aint; const sref: tsubsetreference); + begin + cg.a_op_const_subsetref(list,op,def_cgsize(size),def_cgsize(subsetsize),a,sref); + end; + + procedure thlcg2ll.a_op_const_loc(list: TAsmList; Op: TOpCG; size: tdef; a: Aint; const loc: tlocation); + begin +{$ifdef extdebug} + if def_cgsize(size)<>loc.size then + internalerror(2010112106); +{$endif} + cg.a_op_const_loc(list,op,a,loc); + end; + + procedure thlcg2ll.a_op_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; reg1, reg2: TRegister); + begin + cg.a_op_reg_reg(list,op,def_cgsize(size),reg1,reg2); + end; + + procedure thlcg2ll.a_op_reg_ref(list: TAsmList; Op: TOpCG; size: tdef; reg: TRegister; const ref: TReference); + begin + cg.a_op_reg_ref(list,op,def_cgsize(size),reg,ref); + end; + + procedure thlcg2ll.a_op_ref_reg(list: TAsmList; Op: TOpCG; size: tdef; const ref: TReference; reg: TRegister); + begin + cg.a_op_ref_reg(list,op,def_cgsize(size),ref,reg); + end; + + procedure thlcg2ll.a_op_reg_subsetreg(list: TAsmList; Op: TOpCG; opsize, destsize, destsubsetsize: tdef; reg: TRegister; const sreg: tsubsetregister); + begin + cg.a_op_reg_subsetreg(list,op,def_cgsize(opsize),def_cgsize(destsubsetsize),reg,sreg); + end; + + procedure thlcg2ll.a_op_reg_subsetref(list: TAsmList; Op: TOpCG; opsize, destsize, destsubsetsize: tdef; reg: TRegister; const sref: tsubsetreference); + begin + cg.a_op_reg_subsetref(list,op,def_cgsize(opsize),def_cgsize(destsubsetsize),reg,sref); + end; + + procedure thlcg2ll.a_op_reg_loc(list: TAsmList; Op: TOpCG; size: tdef; reg: tregister; const loc: tlocation); + begin +{$ifdef extdebug} + if def_cgsize(size)<>loc.size then + internalerror(2010112107); +{$endif} + cg.a_op_reg_loc(list,op,reg,loc) + end; + + procedure thlcg2ll.a_op_ref_loc(list: TAsmList; Op: TOpCG; size: tdef; const ref: TReference; const loc: tlocation); + begin +{$ifdef extdebug} + if def_cgsize(size)<>loc.size then + internalerror(2010112101); +{$endif} + cg.a_op_ref_loc(list,op,ref,loc); + end; + + procedure thlcg2ll.a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: aint; src, dst: tregister); + begin + cg.a_op_const_reg_reg(list,op,def_cgsize(size),a,src,dst); + end; + + procedure thlcg2ll.a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister); + begin + cg.a_op_reg_reg_reg(list,op,def_cgsize(size),src1,src2,dst); + end; + + procedure thlcg2ll.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: aint; src, dst: tregister; setflags: boolean; var ovloc: tlocation); + begin + cg.a_op_const_reg_reg_checkoverflow(list,op,def_cgsize(size),a,src,dst,setflags,ovloc); + end; + + procedure thlcg2ll.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation); + begin + cg.a_op_reg_reg_reg_checkoverflow(list,op,def_cgsize(size),src1,src2,dst,setflags,ovloc); + end; + + procedure thlcg2ll.a_cmp_const_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: aint; reg: tregister; l: tasmlabel); + begin + cg.a_cmp_const_reg_label(list,def_cgsize(size),cmp_op,a,reg,l); + end; + + procedure thlcg2ll.a_cmp_const_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: aint; const ref: treference; l: tasmlabel); + begin + cg.a_cmp_const_ref_label(list,def_cgsize(size),cmp_op,a,ref,l); + end; + + procedure thlcg2ll.a_cmp_const_loc_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: aint; const loc: tlocation; l: tasmlabel); + begin + cg.a_cmp_const_loc_label(list,def_cgsize(size),cmp_op,a,loc,l); + end; + + procedure thlcg2ll.a_cmp_reg_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel); + begin + cg.a_cmp_reg_reg_label(list,def_cgsize(size),cmp_op,reg1,reg2,l); + end; + + procedure thlcg2ll.a_cmp_ref_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; reg: tregister; l: tasmlabel); + begin + cg.a_cmp_ref_reg_label(list,def_cgsize(size),cmp_op,ref,reg,l); + end; + + procedure thlcg2ll.a_cmp_reg_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const ref: treference; l: tasmlabel); + begin + cg.a_cmp_reg_ref_label(list,def_cgsize(size),cmp_op,reg,ref,l); + end; + + procedure thlcg2ll.a_cmp_subsetreg_reg_label(list: TAsmList; fromsize, fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sreg: tsubsetregister; reg: tregister; l: tasmlabel); + begin + cg.a_cmp_subsetreg_reg_label(list,def_cgsize(fromsubsetsize),def_cgsize(cmpsize),cmp_op,sreg,reg,l); + end; + + procedure thlcg2ll.a_cmp_subsetref_reg_label(list: TAsmList; fromsize, fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sref: tsubsetreference; reg: tregister; l: tasmlabel); + begin + cg.a_cmp_subsetref_reg_label(list,def_cgsize(fromsubsetsize),def_cgsize(cmpsize),cmp_op,sref,reg,l); + end; + + procedure thlcg2ll.a_cmp_loc_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; const loc: tlocation; reg: tregister; l: tasmlabel); + begin + cg.a_cmp_loc_reg_label(list,def_cgsize(size),cmp_op,loc,reg,l); + end; + + procedure thlcg2ll.a_cmp_reg_loc_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const loc: tlocation; l: tasmlabel); + begin + cg.a_cmp_reg_loc_label(list,def_cgsize(size),cmp_op,reg,loc,l); + end; + + procedure thlcg2ll.a_cmp_ref_loc_label(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; const loc: tlocation; l: tasmlabel); + begin + cg.a_cmp_ref_loc_label(list,def_cgsize(size),cmp_op,ref,loc,l); + end; + + procedure thlcg2ll.a_jmp_always(list: TAsmList; l: tasmlabel); + begin + cg.a_jmp_always(list,l); + end; + +{$ifdef cpuflags} + procedure thlcg2ll.a_jmp_flags(list: TAsmList; const f: TResFlags; l: tasmlabel); + begin + cg.a_jmp_flags(list,f,l); + end; + + procedure thlcg2ll.g_flags2reg(list: TAsmList; size: tdef; const f: tresflags; reg: TRegister); + begin + cg.g_flags2reg(list,def_cgsize(size),f,reg); + end; + + procedure thlcg2ll.g_flags2ref(list: TAsmList; size: tdef; const f: tresflags; const ref: TReference); + begin + cg.g_flags2ref(list,def_cgsize(size),f,ref); + end; +{$endif cpuflags} + + procedure thlcg2ll.g_concatcopy(list: TAsmList; size: tdef; const source, dest: treference); + begin + cg.g_concatcopy(list,source,dest,size.size); + end; + + procedure thlcg2ll.g_concatcopy_unaligned(list: TAsmList; size: tdef; const source, dest: treference); + begin + cg.g_concatcopy_unaligned(list,source,dest,size.size); + end; + + procedure thlcg2ll.g_incrrefcount(list: TAsmList; t: tdef; const ref: treference); + begin + cg.g_incrrefcount(list,t,ref); + end; + + procedure thlcg2ll.g_decrrefcount(list: TAsmList; t: tdef; const ref: treference); + begin + cg.g_decrrefcount(list,t,ref); + end; + + procedure thlcg2ll.g_initialize(list: TAsmList; t: tdef; const ref: treference); + begin + cg.g_initialize(list,t,ref); + end; + + procedure thlcg2ll.g_finalize(list: TAsmList; t: tdef; const ref: treference); + begin + cg.g_finalize(list,t,ref); + end; + + procedure thlcg2ll.g_rangecheck(list: TAsmList; const l: tlocation; fromdef, todef: tdef); + begin + cg.g_rangecheck(list,l,fromdef,todef); + end; + + procedure thlcg2ll.g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef); + begin + cg.g_overflowcheck(list,loc,def); + end; + + procedure thlcg2ll.g_overflowCheck_loc(List: TAsmList; const Loc: TLocation; def: TDef; var ovloc: tlocation); + begin + cg.g_overflowCheck_loc(list,loc,def,ovloc); + end; + + procedure thlcg2ll.g_profilecode(list: TAsmList); + begin + cg.g_profilecode(list); + end; + + procedure thlcg2ll.g_stackpointer_alloc(list: TAsmList; size: longint); + begin + cg.g_stackpointer_alloc(list,size); + end; + + procedure thlcg2ll.g_proc_entry(list: TAsmList; localsize: longint; nostackframe: boolean); + begin + cg.g_proc_entry(list,localsize,nostackframe); + end; + + procedure thlcg2ll.g_proc_exit(list: TAsmList; parasize: longint; nostackframe: boolean); + begin + cg.g_proc_exit(list,parasize,nostackframe); + end; + + procedure thlcg2ll.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint); + begin + cg.g_intf_wrapper(list,procdef,labelname,ioffset); + end; + + procedure thlcg2ll.g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: aint); + begin + cg.g_adjust_self_value(list,procdef,ioffset); + end; + + function thlcg2ll.g_indirect_sym_load(list: TAsmList; const symname: string; weak: boolean): tregister; + begin + result:=cg.g_indirect_sym_load(list,symname,weak); + end; + + procedure thlcg2ll.location_force_reg(list: TAsmList; var l: tlocation; src_size, dst_size: tdef; maybeconst: boolean); + begin + ncgutil.location_force_reg(list,l,def_cgsize(dst_size),maybeconst); + end; + + procedure thlcg2ll.location_force_fpureg(list: TAsmList; var l: tlocation; size: tdef; maybeconst: boolean); + begin + ncgutil.location_force_fpureg(list,l,maybeconst); + end; + + procedure thlcg2ll.location_force_mem(list: TAsmList; var l: tlocation; size: tdef); + begin + ncgutil.location_force_mem(list,l); + end; +(* + procedure thlcg2ll.location_force_mmregscalar(list: TAsmList; var l: tlocation; size: tdef; maybeconst: boolean); + begin + ncgutil.location_force_mmregscalar(list,l,maybeconst); + end; + + procedure thlcg2ll.location_force_mmreg(list: TAsmList; var l: tlocation; size: tdef; maybeconst: boolean); + begin + ncgutil.location_force_mmreg(list,l,maybeconst); + end; +*) + procedure thlcg2ll.maketojumpbool(list: TAsmList; p: tnode); + begin + { loadregvars parameter is no longer used, should be removed from + ncgutil version as well } + ncgutil.maketojumpbool(list,p,lr_dont_load_regvars); + end; + +end. diff --git a/compiler/hlcgobj.pas b/compiler/hlcgobj.pas new file mode 100644 index 0000000000..bbcad744ca --- /dev/null +++ b/compiler/hlcgobj.pas @@ -0,0 +1,1485 @@ +{ + Copyright (c) 1998-2010 by Florian Klaempfl and Jonas Maebe + Member of the Free Pascal development team + + This unit implements the basic high level code generator object + + 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. + + **************************************************************************** +} +{# @abstract(Abstract code generator unit) + Abstract high level code generator unit. This contains the base class + that either lowers most code to the regular code generator, or that + has to be implemented/overridden for higher level targets (such as LLVM). +} +unit hlcgobj; + +{$i fpcdefs.inc} + +{ define hlcginline} + + interface + + uses + cclasses,globtype,constexp, + cpubase,cgbase,cgutils,parabase, + aasmbase,aasmtai,aasmdata,aasmcpu, + symconst,symtype,symdef,rgobj, + node + ; + + type + {# @abstract(Abstract high level code generator) + This class implements an abstract instruction generator. All + methods of this class are generic and are mapped to low level code + generator methods by default. They have to be overridden for higher + level targets + } + + { thlcgobj } + + thlcgobj = class + public + {************************************************} + { basic routines } + constructor create; + + {# Gets a register suitable to do integer operations on.} + function getintregister(list:TAsmList;size:tdef):Tregister;virtual; + {# Gets a register suitable to do integer operations on.} + function getaddressregister(list:TAsmList;size:tdef):Tregister;virtual; + function getfpuregister(list:TAsmList;size:tdef):Tregister;virtual; +// we don't have high level defs yet that translate into all mm cgsizes +// function getmmregister(list:TAsmList;size:tdef):Tregister;virtual; + function getflagregister(list:TAsmList;size:tdef):Tregister;virtual; + {Does the generic cg need SIMD registers, like getmmxregister? Or should + the cpu specific child cg object have such a method?} + + function uses_registers(rt:Tregistertype):boolean; inline; + + procedure do_register_allocation(list:TAsmList;headertai:tai); inline; + procedure translate_register(var reg : tregister); inline; + + {# Emit a label to the instruction stream. } + procedure a_label(list : TAsmList;l : tasmlabel); inline; + + {# Allocates register r by inserting a pai_realloc record } + procedure a_reg_alloc(list : TAsmList;r : tregister); inline; + {# Deallocates register r by inserting a pa_regdealloc record} + procedure a_reg_dealloc(list : TAsmList;r : tregister); inline; + { Synchronize register, make sure it is still valid } + procedure a_reg_sync(list : TAsmList;r : tregister); inline; + + {# Pass a parameter, which is located in a register, to a routine. + + This routine should push/send the parameter to the routine, as + required by the specific processor ABI and routine modifiers. + It must generate register allocation information for the cgpara in + case it consists of cpuregisters. + + @param(size size of the operand in the register) + @param(r register source of the operand) + @param(cgpara where the parameter will be stored) + } + procedure a_load_reg_cgpara(list : TAsmList;size : tdef;r : tregister;const cgpara : TCGPara);virtual; + {# Pass a parameter, which is a constant, to a routine. + + A generic version is provided. This routine should + be overridden for optimization purposes if the cpu + permits directly sending this type of parameter. + It must generate register allocation information for the cgpara in + case it consists of cpuregisters. + + @param(size size of the operand in constant) + @param(a value of constant to send) + @param(cgpara where the parameter will be stored) + } + procedure a_load_const_cgpara(list : TAsmList;tosize : tdef;a : aint;const cgpara : TCGPara);virtual; + {# Pass the value of a parameter, which is located in memory, to a routine. + + A generic version is provided. This routine should + be overridden for optimization purposes if the cpu + permits directly sending this type of parameter. + It must generate register allocation information for the cgpara in + case it consists of cpuregisters. + + @param(size size of the operand in constant) + @param(r Memory reference of value to send) + @param(cgpara where the parameter will be stored) + } + procedure a_load_ref_cgpara(list : TAsmList;size : tdef;const r : treference;const cgpara : TCGPara);virtual; + {# Pass the value of a parameter, which can be located either in a register or memory location, + to a routine. + + A generic version is provided. + + @param(l location of the operand to send) + @param(nr parameter number (starting from one) of routine (from left to right)) + @param(cgpara where the parameter will be stored) + } + procedure a_load_loc_cgpara(list : TAsmList;size : tdef; const l : tlocation;const cgpara : TCGPara);virtual; + {# Pass the address of a reference to a routine. This routine + will calculate the address of the reference, and pass this + calculated address as a parameter. + It must generate register allocation information for the cgpara in + case it consists of cpuregisters. + + A generic version is provided. This routine should + be overridden for optimization purposes if the cpu + permits directly sending this type of parameter. + + @param(fromsize type of the reference we are taking the address of) + @param(tosize type of the pointer that we get as a result) + @param(r reference to get address from) + } + procedure a_loadaddr_ref_cgpara(list : TAsmList;fromsize, tosize : tdef;const r : treference;const cgpara : TCGPara);virtual; + + { Remarks: + * If a method specifies a size you have only to take care + of that number of bits, i.e. load_const_reg with OP_8 must + only load the lower 8 bit of the specified register + the rest of the register can be undefined + if necessary the compiler will call a method + to zero or sign extend the register + * The a_load_XX_XX with OP_64 needn't to be + implemented for 32 bit + processors, the code generator takes care of that + * the addr size is for work with the natural pointer + size + * the procedures without fpu/mm are only for integer usage + * normally the first location is the source and the + second the destination + } + + {# Emits instruction to call the method specified by symbol name. + This routine must be overridden for each new target cpu. + } + procedure a_call_name(list : TAsmList;pd : tprocdef;const s : string; weak: boolean);virtual;abstract; + procedure a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister);virtual;abstract; + procedure a_call_ref(list : TAsmList;pd : tabstractprocdef;ref : treference);virtual;abstract; + { same as a_call_name, might be overridden on certain architectures to emit + static calls without usage of a got trampoline } + procedure a_call_name_static(list : TAsmList;pd : tprocdef;const s : string);virtual; + + { move instructions } + procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : aint;register : tregister);virtual;abstract; + procedure a_load_const_ref(list : TAsmList;tosize : tdef;a : aint;const ref : treference);virtual; + procedure a_load_const_loc(list : TAsmList;tosize : tdef;a : aint;const loc : tlocation);virtual; + procedure a_load_reg_ref(list : TAsmList;fromsize, tosize : tdef;register : tregister;const ref : treference);virtual;abstract; + procedure a_load_reg_ref_unaligned(list : TAsmList;fromsize, tosize : tdef;register : tregister;const ref : treference);virtual; + procedure a_load_reg_reg(list : TAsmList;fromsize, tosize : tdef;reg1,reg2 : tregister);virtual;abstract; + procedure a_load_reg_loc(list : TAsmList;fromsize, tosize : tdef;reg : tregister;const loc: tlocation);virtual; + procedure a_load_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;register : tregister);virtual;abstract; + procedure a_load_ref_reg_unaligned(list : TAsmList;fromsize, tosize : tdef;const ref : treference;register : tregister);virtual; + procedure a_load_ref_ref(list : TAsmList;fromsize, tosize : tdef;const sref : treference;const dref : treference);virtual; + procedure a_load_loc_reg(list : TAsmList;fromsize, tosize : tdef; const loc: tlocation; reg : tregister);virtual; + procedure a_load_loc_ref(list : TAsmList;fromsize, tosize: tdef; const loc: tlocation; const ref : treference);virtual; + procedure a_load_loc_subsetreg(list : TAsmList;fromsize, tosize, tosubsetsize: tdef; const loc: tlocation; const sreg : tsubsetregister);virtual; + procedure a_load_loc_subsetref(list : TAsmList;fromsize, tosize, tosubsetsize: tdef; const loc: tlocation; const sref : tsubsetreference);virtual; + procedure a_loadaddr_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;r : tregister);virtual;abstract; + + { The subset stuff still need a transformation to thlcgobj } + procedure a_load_subsetreg_reg(list : TAsmList; fromsize, fromsubsetsize, tosize: tdef; const sreg: tsubsetregister; destreg: tregister); virtual; abstract; + procedure a_load_reg_subsetreg(list : TAsmList; fromsize, tosize, tosubsetsize: tdef; fromreg: tregister; const sreg: tsubsetregister); virtual; abstract; + procedure a_load_subsetreg_subsetreg(list: TAsmlist; fromsize, fromsubsetsize, tosize, tosubsetsize : tdef; const fromsreg, tosreg: tsubsetregister); virtual; abstract; + procedure a_load_subsetreg_ref(list : TAsmList; fromsize, fromsubsetsize, tosize: tdef; const sreg: tsubsetregister; const destref: treference); virtual; abstract; + procedure a_load_ref_subsetreg(list : TAsmList; fromsize, tosize,tosubsetsize: tdef; const fromref: treference; const sreg: tsubsetregister); virtual; abstract; + procedure a_load_const_subsetreg(list: TAsmlist; tosize, tosubsetsize: tdef; a: aint; const sreg: tsubsetregister); virtual; abstract; + procedure a_load_subsetreg_loc(list: TAsmlist; fromsize, fromsubsetsize, tosize: tdef; const sreg: tsubsetregister; const loc: tlocation); virtual; + + procedure a_load_subsetref_reg(list : TAsmList; fromsize, fromsubsetsize, tosize: tdef; const sref: tsubsetreference; destreg: tregister); virtual; abstract; + procedure a_load_reg_subsetref(list : TAsmList; fromsize, tosubsetsize, tosize: tdef; fromreg: tregister; const sref: tsubsetreference); virtual; abstract; + procedure a_load_subsetref_subsetref(list: TAsmlist; fromsize, fromsubsetsize, tosize, tosubsetsize : tdef; const fromsref, tosref: tsubsetreference); virtual; abstract; + procedure a_load_subsetref_ref(list : TAsmList; fromsize, fromsubsetsize, tosize: tdef; const sref: tsubsetreference; const destref: treference); virtual; abstract; + procedure a_load_ref_subsetref(list : TAsmList; fromsize, tosize, tosubsetsize: tdef; const fromref: treference; const sref: tsubsetreference); virtual; abstract; + procedure a_load_const_subsetref(list: TAsmlist; tosize, tosubsetsize: tdef; a: aint; const sref: tsubsetreference); virtual; abstract; + procedure a_load_subsetref_loc(list: TAsmlist; fromsize, fromsubsetsize, tosize: tdef; const sref: tsubsetreference; const loc: tlocation); virtual; + procedure a_load_subsetref_subsetreg(list: TAsmlist; fromsize, fromsubsetsize, tosize, tosubsetsize : tdef; const fromsref: tsubsetreference; const tosreg: tsubsetregister); virtual; abstract; + procedure a_load_subsetreg_subsetref(list: TAsmlist; fromsize, fromsubsetsize, tosize, tosubsetsize : tdef; const fromsreg: tsubsetregister; const tosref: tsubsetreference); virtual; abstract; + + { bit test instructions (still need transformation to thlcgobj) } + procedure a_bit_test_reg_reg_reg(list : TAsmList; bitnumbersize,valuesize,destsize: tdef;bitnumber,value,destreg: tregister); virtual; abstract; + procedure a_bit_test_const_ref_reg(list: TAsmList; fromsize, destsize: tdef; bitnumber: aint; const ref: treference; destreg: tregister); virtual; abstract; + procedure a_bit_test_const_reg_reg(list: TAsmList; setregsize, destsize: tdef; bitnumber: aint; setreg, destreg: tregister); virtual; abstract; + procedure a_bit_test_const_subsetreg_reg(list: TAsmList; fromsize, fromsubsetsize, destsize: tdef; bitnumber: aint; const setreg: tsubsetregister; destreg: tregister); virtual; abstract; + procedure a_bit_test_reg_ref_reg(list: TAsmList; bitnumbersize, refsize, destsize: tdef; bitnumber: tregister; const ref: treference; destreg: tregister); virtual; abstract; + procedure a_bit_test_reg_loc_reg(list: TAsmList; bitnumbersize, locsize, destsize: tdef; bitnumber: tregister; const loc: tlocation; destreg: tregister);virtual; + procedure a_bit_test_const_loc_reg(list: TAsmList; locsize, destsize: tdef; bitnumber: aint; const loc: tlocation; destreg: tregister);virtual; + + { bit set/clear instructions (still need transformation to thlcgobj) } + procedure a_bit_set_reg_reg(list : TAsmList; doset: boolean; bitnumbersize, destsize: tdef; bitnumber,dest: tregister); virtual; abstract; + procedure a_bit_set_const_ref(list: TAsmList; doset: boolean;destsize: tdef; bitnumber: aint; const ref: treference); virtual; abstract; + procedure a_bit_set_const_reg(list: TAsmList; doset: boolean; destsize: tdef; bitnumber: aint; destreg: tregister); virtual; abstract; + procedure a_bit_set_const_subsetreg(list: TAsmList; doset: boolean; destsize, destsubsetsize: tdef; bitnumber: aint; const destreg: tsubsetregister); virtual; abstract; + procedure a_bit_set_reg_ref(list: TAsmList; doset: boolean; fromsize, tosize: tdef; bitnumber: tregister; const ref: treference); virtual; abstract; + procedure a_bit_set_reg_loc(list: TAsmList; doset: boolean; fromsize, tosize: tdef; bitnumber: tregister; const loc: tlocation);virtual; + procedure a_bit_set_const_loc(list: TAsmList; doset: boolean; tosize: tdef; bitnumber: aint; const loc: tlocation);virtual; + + { bit scan instructions (still need transformation to thlcgobj) } + procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: tdef; src, dst: tregister); virtual; abstract; + + { fpu move instructions } + procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister); virtual; abstract; + procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister); virtual; abstract; + procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference); virtual; abstract; + procedure a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tdef; const ref1,ref2: treference);virtual; + procedure a_loadfpu_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const reg: tregister);virtual; + procedure a_loadfpu_reg_loc(list: TAsmList; fromsize, tosize: tdef; const reg: tregister; const loc: tlocation);virtual; + procedure a_loadfpu_reg_cgpara(list : TAsmList;fromsize: tdef;const r : tregister;const cgpara : TCGPara);virtual; + procedure a_loadfpu_ref_cgpara(list : TAsmList;fromsize : tdef;const ref : treference;const cgpara : TCGPara);virtual; + + { vector register move instructions } +// we don't have high level defs yet that translate into all mm cgsizes +{ + procedure a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef;reg1, reg2: tregister;shuffle : pmmshuffle); virtual; + procedure a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef;const ref: treference; reg: tregister;shuffle : pmmshuffle); virtual; + procedure a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef;reg: tregister; const ref: treference;shuffle : pmmshuffle); virtual; + procedure a_loadmm_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const reg: tregister;shuffle : pmmshuffle);virtual; + procedure a_loadmm_reg_loc(list: TAsmList; fromsize, tosize: tdef; const reg: tregister; const loc: tlocation;shuffle : pmmshuffle);virtual; + procedure a_loadmm_reg_cgpara(list: TAsmList; fromsize: tdef; reg: tregister;const cgpara : TCGPara;shuffle : pmmshuffle); virtual; + procedure a_loadmm_ref_cgpara(list: TAsmList; fromsize: tdef; const ref: treference;const cgpara : TCGPara;shuffle : pmmshuffle); virtual; + procedure a_loadmm_loc_cgpara(list: TAsmList; fromsize: tdef; const loc: tlocation; const cgpara : TCGPara;shuffle : pmmshuffle); virtual; + procedure a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size : tdef;src,dst: tregister;shuffle : pmmshuffle); virtual; + procedure a_opmm_ref_reg(list: TAsmList; Op: TOpCG; size : tdef;const ref: treference; reg: tregister;shuffle : pmmshuffle); virtual; + procedure a_opmm_loc_reg(list: TAsmList; Op: TOpCG; size : tdef;const loc: tlocation; reg: tregister;shuffle : pmmshuffle); virtual; + procedure a_opmm_reg_ref(list: TAsmList; Op: TOpCG; size : tdef;reg: tregister;const ref: treference; shuffle : pmmshuffle); virtual; +} +// we don't have high level defs yet that translate into all mm cgsizes +// procedure a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize : tdef; intreg, mmreg: tregister; shuffle: pmmshuffle); virtual; +// procedure a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize : tdef; mmreg, intreg: tregister; shuffle : pmmshuffle); virtual; + + { basic arithmetic operations } + { note: for operators which require only one argument (not, neg), use } + { the op_reg_reg, op_reg_ref or op_reg_loc methods and keep in mind } + { that in this case the *second* operand is used as both source and } + { destination (JM) } + procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: tdef; a: Aint; reg: TRegister); virtual; abstract; + procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: tdef; a: Aint; const ref: TReference); virtual; + procedure a_op_const_subsetreg(list : TAsmList; Op : TOpCG; size, subsetsize : tdef; a : aint; const sreg: tsubsetregister); virtual; + procedure a_op_const_subsetref(list : TAsmList; Op : TOpCG; size, subsetsize : tdef; a : aint; const sref: tsubsetreference); virtual; + procedure a_op_const_loc(list : TAsmList; Op: TOpCG; size: tdef; a: Aint; const loc: tlocation);virtual; + procedure a_op_reg_reg(list : TAsmList; Op: TOpCG; size: tdef; reg1, reg2: TRegister); virtual; abstract; + procedure a_op_reg_ref(list : TAsmList; Op: TOpCG; size: tdef; reg: TRegister; const ref: TReference); virtual; + procedure a_op_ref_reg(list : TAsmList; Op: TOpCG; size: tdef; const ref: TReference; reg: TRegister); virtual; + procedure a_op_reg_subsetreg(list: TAsmList; Op: TOpCG; opsize, destsize, destsubsetsize: tdef; reg: TRegister; const sreg: tsubsetregister); virtual; + procedure a_op_reg_subsetref(list: TAsmList; Op: TOpCG; opsize, destsize, destsubsetsize: tdef; reg: TRegister; const sref: tsubsetreference); virtual; + procedure a_op_reg_loc(list : TAsmList; Op: TOpCG; size: tdef; reg: tregister; const loc: tlocation);virtual; + procedure a_op_ref_loc(list : TAsmList; Op: TOpCG; size: tdef; const ref: TReference; const loc: tlocation);virtual; + + { trinary operations for processors that support them, 'emulated' } + { on others. None with "ref" arguments since I don't think there } + { are any processors that support it (JM) } + procedure a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: aint; src, dst: tregister); virtual; + procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister); virtual; + procedure a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: aint; src, dst: tregister;setflags : boolean;var ovloc : tlocation); virtual; abstract; + procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation); virtual; abstract; + + { comparison operations } + procedure a_cmp_const_reg_label(list : TAsmList;size : tdef;cmp_op : topcmp;a : aint;reg : tregister; + l : tasmlabel);virtual; + procedure a_cmp_const_ref_label(list : TAsmList;size : tdef;cmp_op : topcmp;a : aint;const ref : treference; + l : tasmlabel); virtual; + procedure a_cmp_const_loc_label(list: TAsmList; size: tdef;cmp_op: topcmp; a: aint; const loc: tlocation; + l : tasmlabel);virtual; + procedure a_cmp_reg_reg_label(list : TAsmList;size : tdef;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); virtual; abstract; + procedure a_cmp_ref_reg_label(list : TAsmList;size : tdef;cmp_op : topcmp; const ref: treference; reg : tregister; l : tasmlabel); virtual; + procedure a_cmp_reg_ref_label(list : TAsmList;size : tdef;cmp_op : topcmp;reg : tregister; const ref: treference; l : tasmlabel); virtual; + procedure a_cmp_subsetreg_reg_label(list: TAsmList; fromsize, fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sreg: tsubsetregister; reg: tregister; l: tasmlabel); virtual; + procedure a_cmp_subsetref_reg_label(list: TAsmList; fromsize, fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sref: tsubsetreference; reg: tregister; l: tasmlabel); virtual; + + procedure a_cmp_loc_reg_label(list : TAsmList;size : tdef;cmp_op : topcmp; const loc: tlocation; reg : tregister; l : tasmlabel);virtual; + procedure a_cmp_reg_loc_label(list : TAsmList;size : tdef;cmp_op : topcmp; reg: tregister; const loc: tlocation; l : tasmlabel);virtual; + procedure a_cmp_ref_loc_label(list: TAsmList; size: tdef;cmp_op: topcmp; const ref: treference; const loc: tlocation; l : tasmlabel);virtual; + + procedure a_jmp_always(list : TAsmList;l: tasmlabel); virtual;abstract; +{$ifdef cpuflags} + procedure a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); virtual; abstract; + + {# Depending on the value to check in the flags, either sets the register reg to one (if the flag is set) + or zero (if the flag is cleared). The size parameter indicates the destination size register. + } + procedure g_flags2reg(list: TAsmList; size: tdef; const f: tresflags; reg: TRegister); virtual; abstract; + procedure g_flags2ref(list: TAsmList; size: tdef; const f: tresflags; const ref:TReference); virtual; abstract; +{$endif cpuflags} + +// procedure g_maybe_testself(list : TAsmList;reg:tregister); +// procedure g_maybe_testvmt(list : TAsmList;reg:tregister;objdef:tobjectdef); + {# This should emit the opcode to copy len bytes from the source + to destination. + + It must be overridden for each new target processor. + + @param(source Source reference of copy) + @param(dest Destination reference of copy) + + } + procedure g_concatcopy(list : TAsmList;size: tdef; const source,dest : treference);virtual;abstract; + {# This should emit the opcode to copy len bytes from the an unaligned source + to destination. + + It must be overridden for each new target processor. + + @param(source Source reference of copy) + @param(dest Destination reference of copy) + + } + procedure g_concatcopy_unaligned(list : TAsmList;size: tdef; const source,dest : treference);virtual; + {# This should emit the opcode to a shortrstring from the source + to destination. + + @param(source Source reference of copy) + @param(dest Destination reference of copy) + + } +// procedure g_copyshortstring(list : TAsmList;const source,dest : treference;len:byte); +// procedure g_copyvariant(list : TAsmList;const source,dest : treference); + + procedure g_incrrefcount(list : TAsmList;t: tdef; const ref: treference);virtual;abstract; + procedure g_decrrefcount(list : TAsmList;t: tdef; const ref: treference);virtual;abstract; + procedure g_initialize(list : TAsmList;t : tdef;const ref : treference);virtual;abstract; + procedure g_finalize(list : TAsmList;t : tdef;const ref : treference);virtual;abstract; + + {# Generates range checking code. It is to note + that this routine does not need to be overridden, + as it takes care of everything. + + @param(p Node which contains the value to check) + @param(todef Type definition of node to range check) + } + procedure g_rangecheck(list: TAsmList; const l:tlocation; fromdef,todef: tdef); virtual; abstract; + + {# Generates overflow checking code for a node } + procedure g_overflowcheck(list: TAsmList; const Loc:tlocation; def:tdef); virtual; abstract; + procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;var ovloc : tlocation);virtual; abstract; + +// procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:aint;destreg:tregister);virtual; +// procedure g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);virtual; + + {# Emits instructions when compilation is done in profile + mode (this is set as a command line option). The default + behavior does nothing, should be overridden as required. + } + procedure g_profilecode(list : TAsmList);virtual; + {# Emits instruction for allocating @var(size) bytes at the stackpointer + + @param(size Number of bytes to allocate) + } + procedure g_stackpointer_alloc(list : TAsmList;size : longint);virtual; abstract; + {# Emits instruction for allocating the locals in entry + code of a routine. This is one of the first + routine called in @var(genentrycode). + + @param(localsize Number of bytes to allocate as locals) + } + procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);virtual; abstract; + {# Emits instructions for returning from a subroutine. + Should also restore the framepointer and stack. + + @param(parasize Number of bytes of parameters to deallocate from stack) + } + procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);virtual; abstract; + + procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);virtual; abstract; + procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: aint);virtual; abstract; + + function g_indirect_sym_load(list:TAsmList;const symname: string; weak: boolean): tregister;virtual; abstract; + { generate a stub which only purpose is to pass control the given external method, + setting up any additional environment before doing so (if required). + + The default implementation issues a jump instruction to the external name. } +// procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string); virtual; + + procedure location_force_reg(list:TAsmList;var l:tlocation;src_size,dst_size:tdef;maybeconst:boolean);virtual;abstract; + procedure location_force_fpureg(list:TAsmList;var l: tlocation;size: tdef;maybeconst:boolean);virtual;abstract; + procedure location_force_mem(list:TAsmList;var l:tlocation;size:tdef);virtual;abstract; +// procedure location_force_mmregscalar(list:TAsmList;var l: tlocation;size:tdef;maybeconst:boolean);virtual;abstract; +// procedure location_force_mmreg(list:TAsmList;var l: tlocation;size:tdef;maybeconst:boolean);virtual;abstract; + + procedure maketojumpbool(list:TAsmList; p : tnode);virtual;abstract; + end; + + var + {# Main high level code generator class } + hlcg : thlcgobj; + + procedure destroy_hlcodegen; + +implementation + + uses + globals,options,systems, + verbose,defutil,paramgr,symsym, + cgobj,tgobj,cutils,procinfo, + ncgutil; + + + procedure destroy_hlcodegen; + begin + hlcg.free; + hlcg:=nil; + end; + + { thlcgobj } + + constructor thlcgobj.create; + begin + end; + + + function thlcgobj.getintregister(list: TAsmList; size: tdef): Tregister; + begin + result:=cg.getintregister(list,def_cgsize(size)); + end; + + + function thlcgobj.getaddressregister(list: TAsmList; size: tdef): Tregister; + begin + result:=cg.getaddressregister(list); + end; + + function thlcgobj.getfpuregister(list: TAsmList; size: tdef): Tregister; + begin + result:=cg.getfpuregister(list,def_cgsize(size)); + end; +(* + function thlcgobj.getmmregister(list: TAsmList; size: tdef): Tregister; + begin + result:=cg.getmmregister(list,def_cgsize(size)); + end; +*) + function thlcgobj.getflagregister(list: TAsmList; size: tdef): Tregister; + begin + result:=cg.getflagregister(list,def_cgsize(size)); + end; + + function thlcgobj.uses_registers(rt: Tregistertype): boolean; + begin + result:=cg.uses_registers(rt); + end; + + procedure thlcgobj.do_register_allocation(list: TAsmList; headertai: tai); + begin + cg.do_register_allocation(list,headertai); + end; + + procedure thlcgobj.translate_register(var reg: tregister); + begin + cg.translate_register(reg); + end; + + procedure thlcgobj.a_label(list: TAsmList; l: tasmlabel); inline; + begin + cg.a_label(list,l); + end; + + procedure thlcgobj.a_reg_alloc(list: TAsmList; r: tregister); + begin + cg.a_reg_alloc(list,r); + end; + + procedure thlcgobj.a_reg_dealloc(list: TAsmList; r: tregister); + begin + cg.a_reg_dealloc(list,r); + end; + + procedure thlcgobj.a_reg_sync(list: TAsmList; r: tregister); + begin + cg.a_reg_sync(list,r); + end; + + procedure thlcgobj.a_load_reg_cgpara(list: TAsmList; size: tdef; r: tregister; const cgpara: TCGPara); + var + ref: treference; + begin + cgpara.check_simple_location; + paramanager.alloccgpara(list,cgpara); + case cgpara.location^.loc of + LOC_REGISTER,LOC_CREGISTER: + a_load_reg_reg(list,size,cgpara.def,r,cgpara.location^.register); + LOC_REFERENCE,LOC_CREFERENCE: + begin + reference_reset_base(ref,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment); + a_load_reg_ref(list,size,cgpara.def,r,ref); + end; +(* + LOC_MMREGISTER,LOC_CMMREGISTER: + a_loadmm_intreg_reg(list,size,cgpara.def,r,cgpara.location^.register,mms_movescalar); +*) + LOC_FPUREGISTER,LOC_CFPUREGISTER: + begin + tg.GetTemp(list,size.size,size.alignment,tt_normal,ref); + a_load_reg_ref(list,size,size,r,ref); + a_loadfpu_ref_cgpara(list,size,ref,cgpara); + tg.Ungettemp(list,ref); + end + else + internalerror(2010120415); + end; + end; + + procedure thlcgobj.a_load_const_cgpara(list: TAsmList; tosize: tdef; a: aint; const cgpara: TCGPara); + var + ref : treference; + begin + cgpara.check_simple_location; + paramanager.alloccgpara(list,cgpara); + case cgpara.location^.loc of + LOC_REGISTER,LOC_CREGISTER: + a_load_const_reg(list,cgpara.def,a,cgpara.location^.register); + LOC_REFERENCE,LOC_CREFERENCE: + begin + reference_reset_base(ref,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment); + a_load_const_ref(list,cgpara.def,a,ref); + end + else + internalerror(2010120416); + end; + end; + + procedure thlcgobj.a_load_ref_cgpara(list: TAsmList; size: tdef; const r: treference; const cgpara: TCGPara); + var + ref: treference; + begin + cgpara.check_simple_location; + paramanager.alloccgpara(list,cgpara); + case cgpara.location^.loc of + LOC_REGISTER,LOC_CREGISTER: + a_load_ref_reg(list,size,cgpara.def,r,cgpara.location^.register); + LOC_REFERENCE,LOC_CREFERENCE: + begin + reference_reset_base(ref,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment); + a_load_ref_ref(list,size,cgpara.def,r,ref); + end +(* + LOC_MMREGISTER,LOC_CMMREGISTER: + begin + case location^.size of + OS_F32, + OS_F64, + OS_F128: + a_loadmm_ref_reg(list,cgpara.def,cgpara.def,r,location^.register,mms_movescalar); + OS_M8..OS_M128, + OS_MS8..OS_MS128: + a_loadmm_ref_reg(list,cgpara.def,cgpara.def,r,location^.register,nil); + else + internalerror(2010120417); + end; + end +*) + else + internalerror(2010120418); + end; + end; + + procedure thlcgobj.a_load_loc_cgpara(list: TAsmList; size: tdef; const l: tlocation; const cgpara: TCGPara); + begin + case l.loc of + LOC_REGISTER, + LOC_CREGISTER : + a_load_reg_cgpara(list,size,l.register,cgpara); + LOC_CONSTANT : + a_load_const_cgpara(list,size,l.value,cgpara); + LOC_CREFERENCE, + LOC_REFERENCE : + a_load_ref_cgpara(list,size,l.reference,cgpara); + else + internalerror(2010120419); + end; + end; + + procedure thlcgobj.a_loadaddr_ref_cgpara(list: TAsmList; fromsize, tosize: tdef; const r: treference; const cgpara: TCGPara); + var + hr : tregister; + begin + cgpara.check_simple_location; + if cgpara.location^.loc in [LOC_CREGISTER,LOC_REGISTER] then + begin + paramanager.allocparaloc(list,cgpara.location); + a_loadaddr_ref_reg(list,fromsize,tosize,r,cgpara.location^.register) + end + else + begin + hr:=getaddressregister(list,tosize); + a_loadaddr_ref_reg(list,fromsize,tosize,r,hr); + a_load_reg_cgpara(list,tosize,hr,cgpara); + end; + end; + + procedure thlcgobj.a_call_name_static(list: TAsmList; pd: tprocdef; const s: string); + begin + a_call_name(list,pd,s,false); + end; + + procedure thlcgobj.a_load_const_ref(list: TAsmList; tosize: tdef; a: aint; const ref: treference); + var + tmpreg: tregister; + begin + tmpreg:=getintregister(list,tosize); + a_load_const_reg(list,tosize,a,tmpreg); + a_load_reg_ref(list,tosize,tosize,tmpreg,ref); + end; + + procedure thlcgobj.a_load_const_loc(list: TAsmList; tosize: tdef; a: aint; const loc: tlocation); + begin + case loc.loc of + LOC_REFERENCE,LOC_CREFERENCE: + a_load_const_ref(list,tosize,a,loc.reference); + LOC_REGISTER,LOC_CREGISTER: + a_load_const_reg(list,tosize,a,loc.register); + { we don't have enough type information to handle these here + LOC_SUBSETREG,LOC_CSUBSETREG: + a_load_const_subsetreg(list,loc.size,a,loc.sreg); + LOC_SUBSETREF,LOC_CSUBSETREF: + a_load_const_subsetref(list,loc.size,a,loc.sref); + } + else + internalerror(2010120401); + end; + end; + + procedure thlcgobj.a_load_reg_ref_unaligned(list: TAsmList; fromsize, tosize: tdef; register: tregister; const ref: treference); + begin + a_load_reg_ref(list,fromsize,tosize,register,ref); + end; + + procedure thlcgobj.a_load_reg_loc(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const loc: tlocation); + begin + case loc.loc of + LOC_REFERENCE,LOC_CREFERENCE: + a_load_reg_ref(list,fromsize,tosize,reg,loc.reference); + LOC_REGISTER,LOC_CREGISTER: + a_load_reg_reg(list,fromsize,tosize,reg,loc.register); + { we don't have enough type information to handle these here + LOC_SUBSETREG,LOC_CSUBSETREG: + a_load_reg_subsetreg(list,fromsize,tosize,reg,loc.sreg); + LOC_SUBSETREF,LOC_CSUBSETREF: + a_load_reg_subsetref(list,fromsize,loc.size,reg,loc.sref); + LOC_MMREGISTER,LOC_CMMREGISTER: + a_loadmm_intreg_reg(list,fromsize,loc.size,reg,loc.register,mms_movescalar); + } + else + internalerror(2010120402); + end; + end; + + procedure thlcgobj.a_load_ref_reg_unaligned(list: TAsmList; fromsize, tosize: tdef; const ref: treference; register: tregister); + begin + a_load_ref_reg(list,fromsize,tosize,ref,register); + end; + + procedure thlcgobj.a_load_ref_ref(list: TAsmList; fromsize, tosize: tdef; const sref: treference; const dref: treference); + var + tmpreg: tregister; + begin + { verify if we have the same reference } + if references_equal(sref,dref) then + exit; + tmpreg:=getintregister(list,tosize); + a_load_ref_reg(list,fromsize,tosize,sref,tmpreg); + a_load_reg_ref(list,tosize,tosize,tmpreg,dref); + end; + + procedure thlcgobj.a_load_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; reg: tregister); + begin + case loc.loc of + LOC_REFERENCE,LOC_CREFERENCE: + a_load_ref_reg(list,fromsize,tosize,loc.reference,reg); + LOC_REGISTER,LOC_CREGISTER: + a_load_reg_reg(list,fromsize,tosize,loc.register,reg); + LOC_CONSTANT: + a_load_const_reg(list,tosize,loc.value,reg); + { we don't have enough type information to handle these here + LOC_SUBSETREG,LOC_CSUBSETREG: + a_load_subsetreg_reg(list,fromsize,tosize,loc.sreg,reg); + LOC_SUBSETREF,LOC_CSUBSETREF: + a_load_subsetref_reg(list,fromsize,tosize,loc.sref,reg); + } + else + internalerror(2010120201); + end; + end; + + procedure thlcgobj.a_load_loc_ref(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const ref: treference); + begin + case loc.loc of + LOC_REFERENCE,LOC_CREFERENCE: + a_load_ref_ref(list,fromsize,tosize,loc.reference,ref); + LOC_REGISTER,LOC_CREGISTER: + a_load_reg_ref(list,fromsize,tosize,loc.register,ref); + LOC_CONSTANT: + a_load_const_ref(list,tosize,loc.value,ref); + { we don't have enough type information to handle these here + LOC_SUBSETREG,LOC_CSUBSETREG: + a_load_subsetreg_ref(list,loc.size,tosize,loc.sreg,ref); + LOC_SUBSETREF,LOC_CSUBSETREF: + a_load_subsetref_ref(list,loc.size,tosize,loc.sref,ref); + } + else + internalerror(2010120403); + end; + end; + + procedure thlcgobj.a_load_loc_subsetreg(list: TAsmList; fromsize, tosize, tosubsetsize: tdef; const loc: tlocation; const sreg: tsubsetregister); + begin + case loc.loc of + LOC_REFERENCE,LOC_CREFERENCE: + a_load_ref_subsetreg(list,fromsize,tosize,tosubsetsize,loc.reference,sreg); + LOC_REGISTER,LOC_CREGISTER: + a_load_reg_subsetreg(list,fromsize,tosize,tosubsetsize,loc.register,sreg); + LOC_CONSTANT: + a_load_const_subsetreg(list,tosize,tosubsetsize,loc.value,sreg); + { we don't have enough type information to handle these here + LOC_SUBSETREG,LOC_CSUBSETREG: + a_load_subsetreg_subsetreg(list,loc.size,subsetsize,loc.sreg,sreg); + LOC_SUBSETREF,LOC_CSUBSETREF: + a_load_subsetref_subsetreg(list,loc.size,subsetsize,loc.sref,sreg); + } + else + internalerror(2010120404); + end; + end; + + procedure thlcgobj.a_load_loc_subsetref(list: TAsmList; fromsize, tosize, tosubsetsize: tdef; const loc: tlocation; const sref: tsubsetreference); + begin + case loc.loc of + LOC_REFERENCE,LOC_CREFERENCE: + a_load_ref_subsetref(list,fromsize,tosize,tosubsetsize,loc.reference,sref); + LOC_REGISTER,LOC_CREGISTER: + a_load_reg_subsetref(list,fromsize,tosize,tosubsetsize,loc.register,sref); + LOC_CONSTANT: + a_load_const_subsetref(list,tosize,tosubsetsize,loc.value,sref); + { we don't have enough type information to handle these here + LOC_SUBSETREG,LOC_CSUBSETREG: + a_load_subsetreg_subsetref(list,loc.size,subsetsize,loc.sreg,sref); + LOC_SUBSETREF,LOC_CSUBSETREF: + a_load_subsetref_subsetref(list,loc.size,subsetsize,loc.sref,sref); + } + else + internalerror(2010120405); + end; + end; + + procedure thlcgobj.a_load_subsetreg_loc(list: TAsmlist; fromsize, fromsubsetsize, tosize: tdef; const sreg: tsubsetregister; const loc: tlocation); + begin + case loc.loc of + LOC_REFERENCE,LOC_CREFERENCE: + a_load_subsetreg_ref(list,fromsize,fromsubsetsize,tosize,sreg,loc.reference); + LOC_REGISTER,LOC_CREGISTER: + a_load_subsetreg_reg(list,fromsize,fromsubsetsize,tosize,sreg,loc.register); + { we don't have enough type information to handle these here + LOC_SUBSETREG,LOC_CSUBSETREG: + a_load_subsetreg_subsetreg(list,subsetsize,loc.size,sreg,loc.sreg); + LOC_SUBSETREF,LOC_CSUBSETREF: + a_load_subsetreg_subsetref(list,subsetsize,loc.size,sreg,loc.sref); + } + else + internalerror(2010120406); + end; + end; + + procedure thlcgobj.a_load_subsetref_loc(list: TAsmlist; fromsize, fromsubsetsize, tosize: tdef; const sref: tsubsetreference; const loc: tlocation); + begin + case loc.loc of + LOC_REFERENCE,LOC_CREFERENCE: + a_load_subsetref_ref(list,fromsize,fromsubsetsize,tosize,sref,loc.reference); + LOC_REGISTER,LOC_CREGISTER: + a_load_subsetref_reg(list,fromsize,fromsubsetsize,tosize,sref,loc.register); + { we don't have enough type information to handle these here + LOC_SUBSETREG,LOC_CSUBSETREG: + a_load_subsetref_subsetreg(list,subsetsize,loc.size,sref,loc.sreg); + LOC_SUBSETREF,LOC_CSUBSETREF: + a_load_subsetref_subsetref(list,subsetsize,loc.size,sref,loc.sref); + } + else + internalerror(2010120407); + end; + end; + + procedure thlcgobj.a_bit_test_reg_loc_reg(list: TAsmList; bitnumbersize, locsize, destsize: tdef; bitnumber: tregister; const loc: tlocation; destreg: tregister); + var + tmpreg: tregister; + begin + case loc.loc of + LOC_REFERENCE,LOC_CREFERENCE: + a_bit_test_reg_ref_reg(list,bitnumbersize,locsize,destsize,bitnumber,loc.reference,destreg); + LOC_REGISTER,LOC_CREGISTER, + LOC_SUBSETREG,LOC_CSUBSETREG, + LOC_CONSTANT: + begin + case loc.loc of + LOC_REGISTER,LOC_CREGISTER: + tmpreg:=loc.register; + (* we don't have enough type information to handle this here + LOC_SUBSETREG,LOC_CSUBSETREG: + begin + tmpreg:=getintregister(list,loc.size); + a_load_subsetreg_reg(list,loc.size,loc.size,loc.sreg,tmpreg); + end; + *) + LOC_CONSTANT: + begin + tmpreg:=getintregister(list,locsize); + a_load_const_reg(list,locsize,loc.value,tmpreg); + end; + end; + a_bit_test_reg_reg_reg(list,bitnumbersize,locsize,destsize,bitnumber,tmpreg,destreg); + end; + { LOC_SUBSETREF is not possible, because sets are not (yet) bitpacked } + else + internalerror(2010120411); + end; + end; + + procedure thlcgobj.a_bit_test_const_loc_reg(list: TAsmList; locsize, destsize: tdef; bitnumber: aint; const loc: tlocation; destreg: tregister); + begin + case loc.loc of + LOC_REFERENCE,LOC_CREFERENCE: + a_bit_test_const_ref_reg(list,locsize,destsize,bitnumber,loc.reference,destreg); + LOC_REGISTER,LOC_CREGISTER: + a_bit_test_const_reg_reg(list,locsize,destsize,bitnumber,loc.register,destreg); + (* we don't have enough type information to handle this here + LOC_SUBSETREG,LOC_CSUBSETREG: + a_bit_test_const_subsetreg_reg(list,loc.size,destsize,bitnumber,loc.sreg,destreg); + *) + { LOC_SUBSETREF is not possible, because sets are not (yet) bitpacked } + else + internalerror(2010120410); + end; + end; + + procedure thlcgobj.a_bit_set_reg_loc(list: TAsmList; doset: boolean; fromsize, tosize: tdef; bitnumber: tregister; const loc: tlocation); + var + tmpreg: tregister; + begin + case loc.loc of + LOC_REFERENCE: + a_bit_set_reg_ref(list,doset,fromsize,tosize,bitnumber,loc.reference); + LOC_CREGISTER: + a_bit_set_reg_reg(list,doset,fromsize,tosize,bitnumber,loc.register); + (* we don't have enough type information to handle this here + { e.g. a 2-byte set in a record regvar } + LOC_CSUBSETREG: + begin + { hard to do in-place in a generic way, so operate on a copy } + tmpreg:=getintregister(list,loc.size); + a_load_subsetreg_reg(list,loc.size,loc.size,loc.sreg,tmpreg); + a_bit_set_reg_reg(list,doset,bitnumbersize,loc.size,bitnumber,tmpreg); + a_load_reg_subsetreg(list,loc.size,loc.size,tmpreg,loc.sreg); + end; + *) + { LOC_SUBSETREF is not possible, because sets are not (yet) bitpacked } + else + internalerror(2010120408) + end; + end; + + procedure thlcgobj.a_bit_set_const_loc(list: TAsmList; doset: boolean; tosize: tdef; bitnumber: aint; const loc: tlocation); + begin + case loc.loc of + LOC_REFERENCE: + a_bit_set_const_ref(list,doset,tosize,bitnumber,loc.reference); + LOC_CREGISTER: + a_bit_set_const_reg(list,doset,tosize,bitnumber,loc.register); + (* we don't have enough type information to handle this here + LOC_CSUBSETREG: + a_bit_set_const_subsetreg(list,doset,loc.size,bitnumber,loc.sreg); + *) + { LOC_SUBSETREF is not possible, because sets are not (yet) bitpacked } + else + internalerror(2010120409) + end; + end; + + procedure thlcgobj.a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tdef; const ref1, ref2: treference); + var + reg: tregister; + regsize: tdef; + begin + if (fromsize.size>=tosize.size) then + regsize:=fromsize + else + regsize:=tosize; + reg:=getfpuregister(list,regsize); + a_loadfpu_ref_reg(list,fromsize,regsize,ref1,reg); + a_loadfpu_reg_ref(list,regsize,tosize,reg,ref2); + end; + + procedure thlcgobj.a_loadfpu_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const reg: tregister); + begin + case loc.loc of + LOC_REFERENCE, LOC_CREFERENCE: + a_loadfpu_ref_reg(list,fromsize,tosize,loc.reference,reg); + LOC_FPUREGISTER, LOC_CFPUREGISTER: + a_loadfpu_reg_reg(list,fromsize,tosize,loc.register,reg); + else + internalerror(2010120412); + end; + end; + + procedure thlcgobj.a_loadfpu_reg_loc(list: TAsmList; fromsize, tosize: tdef; const reg: tregister; const loc: tlocation); + begin + case loc.loc of + LOC_REFERENCE, LOC_CREFERENCE: + a_loadfpu_reg_ref(list,fromsize,tosize,reg,loc.reference); + LOC_FPUREGISTER, LOC_CFPUREGISTER: + a_loadfpu_reg_reg(list,fromsize,tosize,reg,loc.register); + else + internalerror(2010120413); + end; + end; + + procedure thlcgobj.a_loadfpu_reg_cgpara(list: TAsmList; fromsize: tdef; const r: tregister; const cgpara: TCGPara); + var + ref : treference; + begin + paramanager.alloccgpara(list,cgpara); + case cgpara.location^.loc of + LOC_FPUREGISTER,LOC_CFPUREGISTER: + begin + cgpara.check_simple_location; + a_loadfpu_reg_reg(list,fromsize,cgpara.def,r,cgpara.location^.register); + end; + LOC_REFERENCE,LOC_CREFERENCE: + begin + cgpara.check_simple_location; + reference_reset_base(ref,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment); + a_loadfpu_reg_ref(list,fromsize,cgpara.def,r,ref); + end; + LOC_REGISTER,LOC_CREGISTER: + begin + { paramfpu_ref does the check_simpe_location check here if necessary } + tg.GetTemp(list,fromsize.size,fromsize.alignment,tt_normal,ref); + a_loadfpu_reg_ref(list,fromsize,fromsize,r,ref); + a_loadfpu_ref_cgpara(list,fromsize,ref,cgpara); + tg.Ungettemp(list,ref); + end; + else + internalerror(2010120422); + end; + end; + + procedure thlcgobj.a_loadfpu_ref_cgpara(list: TAsmList; fromsize: tdef; const ref: treference; const cgpara: TCGPara); + var + href : treference; +// hsize: tcgsize; + begin + case cgpara.location^.loc of + LOC_FPUREGISTER,LOC_CFPUREGISTER: + begin + cgpara.check_simple_location; + paramanager.alloccgpara(list,cgpara); + a_loadfpu_ref_reg(list,fromsize,cgpara.def,ref,cgpara.location^.register); + end; + LOC_REFERENCE,LOC_CREFERENCE: + begin + cgpara.check_simple_location; + reference_reset_base(href,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment); + { concatcopy should choose the best way to copy the data } + g_concatcopy(list,fromsize,ref,href); + end; + (* not yet supported + LOC_REGISTER,LOC_CREGISTER: + begin + { force integer size } + hsize:=int_cgsize(tcgsize2size[size]); +{$ifndef cpu64bitalu} + if (hsize in [OS_S64,OS_64]) then + cg64.a_load64_ref_cgpara(list,ref,cgpara) + else +{$endif not cpu64bitalu} + begin + cgpara.check_simple_location; + a_load_ref_cgpara(list,hsize,ref,cgpara) + end; + end + *) + else + internalerror(2010120423); + end; + end; +(* + procedure thlcgobj.a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister; shuffle: pmmshuffle); + begin + cg.a_loadmm_reg_reg(list,def_cgsize(fromsize),def_cgsize(tosize),reg1,reg2,shuffle); + end; + + procedure thlcgobj.a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle); + begin + cg.a_loadmm_ref_reg(list,def_cgsize(fromsize),def_cgsize(tosize),ref,reg,shuffle); + end; + + procedure thlcgobj.a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle); + begin + cg.a_loadmm_reg_ref(list,def_cgsize(fromsize),def_cgsize(tosize),reg,ref,shuffle); + end; + + procedure thlcgobj.a_loadmm_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const reg: tregister; shuffle: pmmshuffle); + begin + case loc.loc of + LOC_MMREGISTER,LOC_CMMREGISTER: + a_loadmm_reg_reg(list,fromsize,tosize,loc.register,reg,shuffle); + LOC_REFERENCE,LOC_CREFERENCE: + a_loadmm_ref_reg(list,fromsize,tosize,loc.reference,reg,shuffle); + LOC_REGISTER,LOC_CREGISTER: + a_loadmm_intreg_reg(list,fromsize,tosize,loc.register,reg,shuffle); + else + internalerror(2010120414); + end; + end; + + procedure thlcgobj.a_loadmm_reg_loc(list: TAsmList; fromsize, tosize: tdef; const reg: tregister; const loc: tlocation; shuffle: pmmshuffle); + begin + case loc.loc of + LOC_MMREGISTER,LOC_CMMREGISTER: + a_loadmm_reg_reg(list,fromsize,tosize,reg,loc.register,shuffle); + LOC_REFERENCE,LOC_CREFERENCE: + a_loadmm_reg_ref(list,fromsize,tosize,reg,loc.reference,shuffle); + else + internalerror(2010120415); + end; + end; + + procedure thlcgobj.a_loadmm_reg_cgpara(list: TAsmList; fromsize: tdef; reg: tregister; const cgpara: TCGPara; shuffle: pmmshuffle); + var + href : treference; + begin + cgpara.check_simple_location; + paramanager.alloccgpara(list,cgpara); + case cgpara.location^.loc of + LOC_MMREGISTER,LOC_CMMREGISTER: + a_loadmm_reg_reg(list,fromsize,cgpara.def,reg,cgpara.location^.register,shuffle); + LOC_REFERENCE,LOC_CREFERENCE: + begin + reference_reset_base(href,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment); + a_loadmm_reg_ref(list,fromsize,cgpara.def,reg,href,shuffle); + end; + LOC_REGISTER,LOC_CREGISTER: + begin + if assigned(shuffle) and + not shufflescalar(shuffle) then + internalerror(2009112510); + a_loadmm_reg_intreg(list,deomsize,cgpara.def,reg,cgpara.location^.register,mms_movescalar); + end + else + internalerror(2010120427); + end; + end; + + procedure thlcgobj.a_loadmm_ref_cgpara(list: TAsmList; fromsize: tdef; const ref: treference; const cgpara: TCGPara; shuffle: pmmshuffle); + var + hr : tregister; + hs : tmmshuffle; + begin + cgpara.check_simple_location; + hr:=cg.getmmregister(list,cgpara.size); + a_loadmm_ref_reg(list,deomsize,cgpara.def,ref,hr,shuffle); + if realshuffle(shuffle) then + begin + hs:=shuffle^; + removeshuffles(hs); + a_loadmm_reg_cgpara(list,cgpara.def,hr,cgpara,@hs); + end + else + a_loadmm_reg_cgpara(list,cgpara.def,hr,cgpara,shuffle); + end; + + procedure thlcgobj.a_loadmm_loc_cgpara(list: TAsmList; fromsize: tdef; const loc: tlocation; const cgpara: TCGPara; shuffle: pmmshuffle); + begin +{$ifdef extdebug} + if def_cgsize(fromsize)<>loc.size then + internalerror(2010112105); +{$endif} + cg.a_loadmm_loc_cgpara(list,loc,cgpara,shuffle); + end; + + procedure thlcgobj.a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; src, dst: tregister; shuffle: pmmshuffle); + begin + cg.a_opmm_reg_reg(list,op,def_cgsize(size),src,dst,shuffle); + end; + + procedure thlcgobj.a_opmm_ref_reg(list: TAsmList; Op: TOpCG; size: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle); + begin + cg.a_opmm_ref_reg(list,op,def_cgsize(size),ref,reg,shuffle) + end; + + procedure thlcgobj.a_opmm_loc_reg(list: TAsmList; Op: TOpCG; size: tdef; const loc: tlocation; reg: tregister; shuffle: pmmshuffle); + begin + cg.a_opmm_loc_reg(list,op,def_cgsize(size),loc,reg,shuffle); + end; + + procedure thlcgobj.a_opmm_reg_ref(list: TAsmList; Op: TOpCG; size: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle); + begin + cg.a_opmm_reg_ref(list,op,def_cgsize(size),reg,ref,shuffle); + end; +*) +(* + procedure thlcgobj.a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize: tdef; intreg, mmreg: tregister; shuffle: pmmshuffle); + begin + cg.a_loadmm_intreg_reg(list,def_cgsize(fromsize),def_cgsize(tosize),intreg,mmreg,shuffle); + end; + + procedure thlcgobj.a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize: tdef; mmreg, intreg: tregister; shuffle: pmmshuffle); + begin + cg.a_loadmm_reg_intreg(list,def_cgsize(fromsize),def_cgsize(tosize),mmreg,intreg,shuffle); + end; +*) + procedure thlcgobj.a_op_const_ref(list: TAsmList; Op: TOpCG; size: tdef; a: Aint; const ref: TReference); + var + tmpreg : tregister; + begin + tmpreg:=getintregister(list,size); + a_load_ref_reg(list,size,size,ref,tmpreg); + a_op_const_reg(list,op,size,a,tmpreg); + a_load_reg_ref(list,size,size,tmpreg,ref); + end; + + procedure thlcgobj.a_op_const_subsetreg(list: TAsmList; Op: TOpCG; size, subsetsize: tdef; a: aint; const sreg: tsubsetregister); + var + tmpreg: tregister; + begin + tmpreg:=getintregister(list,size); + a_load_subsetreg_reg(list,size,subsetsize,size,sreg,tmpreg); + a_op_const_reg(list,op,size,a,tmpreg); + a_load_reg_subsetreg(list,size,size,subsetsize,tmpreg,sreg); + end; + + procedure thlcgobj.a_op_const_subsetref(list: TAsmList; Op: TOpCG; size, subsetsize: tdef; a: aint; const sref: tsubsetreference); + var + tmpreg: tregister; + begin + tmpreg:=getintregister(list,size); + a_load_subsetref_reg(list,size,subsetsize,size,sref,tmpreg); + a_op_const_reg(list,op,size,a,tmpreg); + a_load_reg_subsetref(list,size,size,subsetsize,tmpreg,sref); + end; + + procedure thlcgobj.a_op_const_loc(list: TAsmList; Op: TOpCG; size: tdef; a: Aint; const loc: tlocation); + begin + case loc.loc of + LOC_REGISTER, LOC_CREGISTER: + a_op_const_reg(list,op,size,a,loc.register); + LOC_REFERENCE, LOC_CREFERENCE: + a_op_const_ref(list,op,size,a,loc.reference); + { we don't have enough type information to handle these here + LOC_SUBSETREG, LOC_CSUBSETREG: + a_op_const_subsetreg(list,op,loc.size,loc.size,a,loc.sreg); + LOC_SUBSETREF, LOC_CSUBSETREF: + a_op_const_subsetref(list,op,loc.size,loc.size,a,loc.sref); + } + else + internalerror(2010120428); + end; + end; + + procedure thlcgobj.a_op_reg_ref(list: TAsmList; Op: TOpCG; size: tdef; reg: TRegister; const ref: TReference); + var + tmpreg: tregister; + begin + case op of + OP_NOT,OP_NEG: + { handle it as "load ref,reg; op reg" } + begin + a_load_ref_reg(list,size,size,ref,reg); + a_op_reg_reg(list,op,size,reg,reg); + end; + else + begin + tmpreg:=getintregister(list,size); + a_load_ref_reg(list,size,size,ref,tmpreg); + a_op_reg_reg(list,op,size,tmpreg,reg); + end; + end; + end; + + procedure thlcgobj.a_op_ref_reg(list: TAsmList; Op: TOpCG; size: tdef; const ref: TReference; reg: TRegister); + var + tmpreg: tregister; + begin + case op of + OP_NOT,OP_NEG: + { handle it as "load ref,reg; op reg" } + begin + a_load_ref_reg(list,size,size,ref,reg); + a_op_reg_reg(list,op,size,reg,reg); + end; + else + begin + tmpreg:=getintregister(list,size); + a_load_ref_reg(list,size,size,ref,tmpreg); + a_op_reg_reg(list,op,size,tmpreg,reg); + end; + end; + end; + + procedure thlcgobj.a_op_reg_subsetreg(list: TAsmList; Op: TOpCG; opsize, destsize, destsubsetsize: tdef; reg: TRegister; const sreg: tsubsetregister); + var + tmpreg: tregister; + begin + tmpreg:=getintregister(list,opsize); + a_load_subsetreg_reg(list,destsize,destsubsetsize,opsize,sreg,tmpreg); + a_op_reg_reg(list,op,opsize,reg,tmpreg); + a_load_reg_subsetreg(list,opsize,destsize,destsubsetsize,tmpreg,sreg); + end; + + procedure thlcgobj.a_op_reg_subsetref(list: TAsmList; Op: TOpCG; opsize, destsize, destsubsetsize: tdef; reg: TRegister; const sref: tsubsetreference); + var + tmpreg: tregister; + begin + tmpreg:=getintregister(list,opsize); + a_load_subsetref_reg(list,destsize,destsubsetsize,opsize,sref,tmpreg); + a_op_reg_reg(list,op,opsize,reg,tmpreg); + a_load_reg_subsetref(list,opsize,destsize,destsubsetsize,tmpreg,sref); + end; + + procedure thlcgobj.a_op_reg_loc(list: TAsmList; Op: TOpCG; size: tdef; reg: tregister; const loc: tlocation); + begin + case loc.loc of + LOC_REGISTER, LOC_CREGISTER: + a_op_reg_reg(list,op,size,reg,loc.register); + LOC_REFERENCE, LOC_CREFERENCE: + a_op_reg_ref(list,op,size,reg,loc.reference); + { we don't have enough type information to handle these here + LOC_SUBSETREG, LOC_CSUBSETREG: + a_op_reg_subsetreg(list,op,loc.size,loc.size,reg,loc.sreg); + LOC_SUBSETREF, LOC_CSUBSETREF: + a_op_reg_subsetref(list,op,loc.size,loc.size,reg,loc.sref); + } + else + internalerror(2010120429); + end; + end; + + procedure thlcgobj.a_op_ref_loc(list: TAsmList; Op: TOpCG; size: tdef; const ref: TReference; const loc: tlocation); + var + tmpreg: tregister; + begin + case loc.loc of + LOC_REGISTER,LOC_CREGISTER: + a_op_ref_reg(list,op,size,ref,loc.register); + LOC_REFERENCE,LOC_CREFERENCE: + begin + tmpreg:=getintregister(list,size); + a_load_ref_reg(list,size,size,ref,tmpreg); + a_op_reg_ref(list,op,size,tmpreg,loc.reference); + end; + { we don't have enough type information to handle these here + LOC_SUBSETREG, LOC_CSUBSETREG: + begin + tmpreg:=getintregister(list,loc.size); + a_load_subsetreg_reg(list,loc.size,loc.size,loc.sreg,tmpreg); + a_op_ref_reg(list,op,loc.size,ref,tmpreg); + a_load_reg_subsetreg(list,loc.size,loc.size,tmpreg,loc.sreg); + end; + LOC_SUBSETREF, LOC_CSUBSETREF: + begin + tmpreg:=getintregister(list,loc.size); + a_load_subsetreF_reg(list,loc.size,loc.size,loc.sref,tmpreg); + a_op_ref_reg(list,op,loc.size,ref,tmpreg); + a_load_reg_subsetref(list,loc.size,loc.size,tmpreg,loc.sref); + end; + } + else + internalerror(2010120429); + end; + end; + + procedure thlcgobj.a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: aint; src, dst: tregister); + begin + a_load_reg_reg(list,size,size,src,dst); + a_op_const_reg(list,op,size,a,dst); + end; + + procedure thlcgobj.a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister); + var + tmpreg: tregister; + begin + if (dst<>src1) then + begin + a_load_reg_reg(list,size,size,src2,dst); + a_op_reg_reg(list,op,size,src1,dst); + end + else + begin + { can we do a direct operation on the target register ? } + if op in [OP_ADD,OP_MUL,OP_AND,OP_MOVE,OP_XOR,OP_IMUL,OP_OR] then + a_op_reg_reg(list,op,size,src2,dst) + else + begin + tmpreg:=getintregister(list,size); + a_load_reg_reg(list,size,size,src2,tmpreg); + a_op_reg_reg(list,op,size,src1,tmpreg); + a_load_reg_reg(list,size,size,tmpreg,dst); + end; + end; + end; + + procedure thlcgobj.a_cmp_const_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: aint; reg: tregister; l: tasmlabel); + var + tmpreg: tregister; + begin + tmpreg:=getintregister(list,size); + a_load_const_reg(list,size,a,tmpreg); + a_cmp_reg_reg_label(list,size,cmp_op,tmpreg,reg,l); + end; + + procedure thlcgobj.a_cmp_const_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: aint; const ref: treference; l: tasmlabel); + var + tmpreg: tregister; + begin + tmpreg:=getintregister(list,size); + a_load_ref_reg(list,size,size,ref,tmpreg); + a_cmp_const_reg_label(list,size,cmp_op,a,tmpreg,l); + end; + + procedure thlcgobj.a_cmp_const_loc_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: aint; const loc: tlocation; l: tasmlabel); + var + tmpreg : tregister; + begin + case loc.loc of + LOC_REGISTER,LOC_CREGISTER: + a_cmp_const_reg_label(list,size,cmp_op,a,loc.register,l); + LOC_REFERENCE,LOC_CREFERENCE: + a_cmp_const_ref_label(list,size,cmp_op,a,loc.reference,l); + { we don't have enough type information to handle these here + LOC_SUBSETREG, LOC_CSUBSETREG: + begin + tmpreg:=getintregister(list,size); + a_load_subsetreg_reg(list,loc.size,size,loc.sreg,tmpreg); + a_cmp_const_reg_label(list,size,cmp_op,a,tmpreg,l); + end; + LOC_SUBSETREF, LOC_CSUBSETREF: + begin + tmpreg:=getintregister(list,size); + a_load_subsetref_reg(list,loc.size,size,loc.sref,tmpreg); + a_cmp_const_reg_label(list,size,cmp_op,a,tmpreg,l); + end; + } + else + internalerror(2010120430); + end; + end; + + procedure thlcgobj.a_cmp_ref_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; reg: tregister; l: tasmlabel); + var + tmpreg: tregister; + begin + tmpreg:=getintregister(list,size); + a_load_ref_reg(list,size,size,ref,tmpreg); + a_cmp_reg_reg_label(list,size,cmp_op,tmpreg,reg,l); + end; + + procedure thlcgobj.a_cmp_reg_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const ref: treference; l: tasmlabel); + var + tmpreg: tregister; + begin + tmpreg:=getintregister(list,size); + a_load_ref_reg(list,size,size,ref,tmpreg); + a_cmp_reg_reg_label(list,size,cmp_op,reg,tmpreg,l); + end; + + procedure thlcgobj.a_cmp_subsetreg_reg_label(list: TAsmList; fromsize, fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sreg: tsubsetregister; reg: tregister; l: tasmlabel); + var + tmpreg: tregister; + begin + tmpreg:=getintregister(list,cmpsize); + a_load_subsetreg_reg(list,fromsize,fromsubsetsize,cmpsize,sreg,tmpreg); + a_cmp_reg_reg_label(list,cmpsize,cmp_op,tmpreg,reg,l); + end; + + procedure thlcgobj.a_cmp_subsetref_reg_label(list: TAsmList; fromsize, fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sref: tsubsetreference; reg: tregister; l: tasmlabel); + var + tmpreg: tregister; + begin + tmpreg:=getintregister(list,cmpsize); + a_load_subsetref_reg(list,fromsize,fromsubsetsize,cmpsize,sref,tmpreg); + a_cmp_reg_reg_label(list,cmpsize,cmp_op,tmpreg,reg,l); + end; + + procedure thlcgobj.a_cmp_loc_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; const loc: tlocation; reg: tregister; l: tasmlabel); + begin + case loc.loc of + LOC_REGISTER, + LOC_CREGISTER: + a_cmp_reg_reg_label(list,size,cmp_op,loc.register,reg,l); + LOC_REFERENCE, + LOC_CREFERENCE : + a_cmp_ref_reg_label(list,size,cmp_op,loc.reference,reg,l); + LOC_CONSTANT: + a_cmp_const_reg_label(list,size,cmp_op,loc.value,reg,l); + { we don't have enough type information to handle these here + LOC_SUBSETREG, + LOC_CSUBSETREG: + a_cmp_subsetreg_reg_label(list,loc.size,size,cmp_op,loc.sreg,reg,l); + LOC_SUBSETREF, + LOC_CSUBSETREF: + a_cmp_subsetref_reg_label(list,loc.size,size,cmp_op,loc.sref,reg,l); + } + else + internalerror(2010120431); + end; + end; + + procedure thlcgobj.a_cmp_reg_loc_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const loc: tlocation; l: tasmlabel); + begin + a_cmp_loc_reg_label(list,size,swap_opcmp(cmp_op),loc,reg,l); + end; + + procedure thlcgobj.a_cmp_ref_loc_label(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; const loc: tlocation; l: tasmlabel); + var + tmpreg: tregister; + begin + case loc.loc of + LOC_REGISTER,LOC_CREGISTER: + a_cmp_ref_reg_label(list,size,cmp_op,ref,loc.register,l); + LOC_REFERENCE,LOC_CREFERENCE: + begin + tmpreg:=getintregister(list,size); + a_load_ref_reg(list,size,size,loc.reference,tmpreg); + a_cmp_ref_reg_label(list,size,cmp_op,ref,tmpreg,l); + end; + LOC_CONSTANT: + begin + a_cmp_const_ref_label(list,size,swap_opcmp(cmp_op),loc.value,ref,l); + end + { we don't have enough type information to handle these here + LOC_SUBSETREG, LOC_CSUBSETREG: + begin + tmpreg:=getintregister(list, size); + a_load_ref_reg(list,size,size,loc.reference,tmpreg); + a_cmp_subsetreg_reg_label(list,loc.size,size,swap_opcmp(cmp_op),loc.sreg,tmpreg,l); + end; + LOC_SUBSETREF, LOC_CSUBSETREF: + begin + tmpreg:=getintregister(list, size); + a_load_ref_reg(list,size,size,loc.reference,tmpreg); + a_cmp_subsetref_reg_label(list,loc.size,size,swap_opcmp(cmp_op),loc.sref,tmpreg,l); + end; + } + else + internalerror(2010120432); + end; + end; + + procedure thlcgobj.g_concatcopy_unaligned(list: TAsmList; size: tdef; const source, dest: treference); + begin + g_concatcopy(list,size,source,dest); + end; + + procedure thlcgobj.g_profilecode(list: TAsmList); + begin + end; + +end. diff --git a/compiler/parabase.pas b/compiler/parabase.pas index 047f7f1a7e..9367fe34c9 100644 --- a/compiler/parabase.pas +++ b/compiler/parabase.pas @@ -66,6 +66,7 @@ unit parabase; IntSize : tcgint; { size of the total location in bytes } Alignment : ShortInt; Size : TCGSize; { Size of the parameter included in all locations } + Def : tdef; { Type of the parameter } {$ifdef powerpc} composite: boolean; { under the AIX abi, how certain parameters are passed depends on whether they are composite or not } {$endif powerpc}