cgobj.pas 104 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. Member of the Free Pascal development team
  5. This unit implements the basic code generator object
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2 of the License, or
  9. (at your option) any later version.
  10. This program is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. GNU General Public License for more details.
  14. You should have received a copy of the GNU General Public License
  15. along with this program; if not, write to the Free Software
  16. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17. ****************************************************************************
  18. }
  19. {# @abstract(Abstract code generator unit)
  20. Abstreact code generator unit. This contains the base class
  21. to implement for all new supported processors.
  22. WARNING: None of the routines implemented in these modules,
  23. or their descendants, should use the temp. allocator, as
  24. these routines may be called inside genentrycode, and the
  25. stack frame is already setup!
  26. }
  27. unit cgobj;
  28. {$i fpcdefs.inc}
  29. interface
  30. uses
  31. {$ifdef delphi}
  32. dmisc,
  33. {$endif}
  34. cclasses,
  35. cpubase,cpuinfo,cgbase,
  36. aasmbase,aasmtai,aasmcpu,
  37. symconst,symbase,symtype,symdef,symtable,rgobj
  38. ;
  39. type
  40. talignment = (AM_NATURAL,AM_NONE,AM_2BYTE,AM_4BYTE,AM_8BYTE);
  41. {# @abstract(Abstract code generator)
  42. This class implements an abstract instruction generator. Some of
  43. the methods of this class are generic, while others must
  44. be overriden for all new processors which will be supported
  45. by Free Pascal. For 32-bit processors, the base class
  46. sould be @link(tcg64f32) and not @var(tcg).
  47. }
  48. tcg = class
  49. public
  50. alignment : talignment;
  51. rg : array[tregistertype] of trgobj;
  52. t_times:cardinal;
  53. {$ifdef flowgraph}
  54. aktflownode:word;
  55. {$endif}
  56. {************************************************}
  57. { basic routines }
  58. constructor create;
  59. {# Initialize the register allocators needed for the codegenerator.}
  60. procedure init_register_allocators;virtual;
  61. {# Clean up the register allocators needed for the codegenerator.}
  62. procedure done_register_allocators;virtual;
  63. {$ifdef flowgraph}
  64. procedure init_flowgraph;
  65. procedure done_flowgraph;
  66. {$endif}
  67. {# Gets a register suitable to do integer operations on.}
  68. function getintregister(list:Taasmoutput;size:Tcgsize):Tregister;virtual;
  69. {# Gets a register suitable to do integer operations on.}
  70. function getaddressregister(list:Taasmoutput):Tregister;virtual;
  71. function getfpuregister(list:Taasmoutput;size:Tcgsize):Tregister;virtual;
  72. function getmmregister(list:Taasmoutput;size:Tcgsize):Tregister;virtual;
  73. function getflagregister(list:Taasmoutput;size:Tcgsize):Tregister;virtual;abstract;
  74. {Does the generic cg need SIMD registers, like getmmxregister? Or should
  75. the cpu specific child cg object have such a method?}
  76. procedure ungetregister(list:Taasmoutput;r:Tregister);virtual;
  77. procedure ungetreference(list:Taasmoutput;const r:Treference);virtual;
  78. procedure add_reg_instruction(instr:Tai;r:tregister);virtual;
  79. procedure add_move_instruction(instr:Taicpu);virtual;
  80. function uses_registers(rt:Tregistertype):boolean;virtual;
  81. {# Get a specific register.}
  82. procedure getexplicitregister(list:Taasmoutput;r:Tregister);virtual;
  83. {# Get multiple registers specified.}
  84. procedure allocexplicitregisters(list:Taasmoutput;rt:Tregistertype;r:Tcpuregisterset);virtual;
  85. {# Free multiple registers specified.}
  86. procedure deallocexplicitregisters(list:Taasmoutput;rt:Tregistertype;r:Tcpuregisterset);virtual;
  87. procedure do_register_allocation(list:Taasmoutput;headertai:tai);virtual;
  88. function makeregsize(reg:Tregister;size:Tcgsize):Tregister;
  89. {# Returns the tcgsize corresponding with the size of reg.}
  90. class function reg_cgsize(const reg: tregister) : tcgsize; virtual;
  91. {# Emit a label to the instruction stream. }
  92. procedure a_label(list : taasmoutput;l : tasmlabel);virtual;
  93. {# Allocates register r by inserting a pai_realloc record }
  94. procedure a_reg_alloc(list : taasmoutput;r : tregister);
  95. {# Deallocates register r by inserting a pa_regdealloc record}
  96. procedure a_reg_dealloc(list : taasmoutput;r : tregister);
  97. {# Pass a parameter, which is located in a register, to a routine.
  98. This routine should push/send the parameter to the routine, as
  99. required by the specific processor ABI and routine modifiers.
  100. This must be overriden for each CPU target.
  101. @param(size size of the operand in the register)
  102. @param(r register source of the operand)
  103. @param(locpara where the parameter will be stored)
  104. }
  105. procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const locpara : tparalocation);virtual;
  106. {# Pass a parameter, which is a constant, to a routine.
  107. A generic version is provided. This routine should
  108. be overriden for optimization purposes if the cpu
  109. permits directly sending this type of parameter.
  110. @param(size size of the operand in constant)
  111. @param(a value of constant to send)
  112. @param(locpara where the parameter will be stored)
  113. }
  114. procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;const locpara : tparalocation);virtual;
  115. {# Pass the value of a parameter, which is located in memory, to a routine.
  116. A generic version is provided. This routine should
  117. be overriden for optimization purposes if the cpu
  118. permits directly sending this type of parameter.
  119. @param(size size of the operand in constant)
  120. @param(r Memory reference of value to send)
  121. @param(locpara where the parameter will be stored)
  122. }
  123. procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const locpara : tparalocation);virtual;
  124. {# Pass the value of a parameter, which can be located either in a register or memory location,
  125. to a routine.
  126. A generic version is provided.
  127. @param(l location of the operand to send)
  128. @param(nr parameter number (starting from one) of routine (from left to right))
  129. @param(locpara where the parameter will be stored)
  130. }
  131. procedure a_param_loc(list : taasmoutput;const l : tlocation;const locpara : tparalocation);
  132. {# Pass the address of a reference to a routine. This routine
  133. will calculate the address of the reference, and pass this
  134. calculated address as a parameter.
  135. A generic version is provided. This routine should
  136. be overriden for optimization purposes if the cpu
  137. permits directly sending this type of parameter.
  138. @param(r reference to get address from)
  139. @param(nr parameter number (starting from one) of routine (from left to right))
  140. }
  141. procedure a_paramaddr_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);virtual;
  142. { Copies a whole memory block to the stack, the locpara must be a memory location }
  143. procedure a_param_copy_ref(list : taasmoutput;size : qword;const r : treference;const locpara : tparalocation);
  144. { Remarks:
  145. * If a method specifies a size you have only to take care
  146. of that number of bits, i.e. load_const_reg with OP_8 must
  147. only load the lower 8 bit of the specified register
  148. the rest of the register can be undefined
  149. if necessary the compiler will call a method
  150. to zero or sign extend the register
  151. * The a_load_XX_XX with OP_64 needn't to be
  152. implemented for 32 bit
  153. processors, the code generator takes care of that
  154. * the addr size is for work with the natural pointer
  155. size
  156. * the procedures without fpu/mm are only for integer usage
  157. * normally the first location is the source and the
  158. second the destination
  159. }
  160. { Copy a parameter to a (temporary) reference }
  161. procedure a_loadany_param_ref(list : taasmoutput;const locpara : tparalocation;const ref:treference;shuffle : pmmshuffle);virtual;
  162. { Copy a parameter to a register }
  163. procedure a_loadany_param_reg(list : taasmoutput;const locpara : tparalocation;const reg:tregister;shuffle : pmmshuffle);virtual;
  164. {# Emits instruction to call the method specified by symbol name.
  165. This routine must be overriden for each new target cpu.
  166. There is no a_call_ref because loading the reference will use
  167. a temp register on most cpu's resulting in conflicts with the
  168. registers used for the parameters (PFV)
  169. }
  170. procedure a_call_name(list : taasmoutput;const s : string);virtual; abstract;
  171. procedure a_call_reg(list : taasmoutput;reg : tregister);virtual;abstract;
  172. { move instructions }
  173. procedure a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister);virtual; abstract;
  174. procedure a_load_const_ref(list : taasmoutput;size : tcgsize;a : aword;const ref : treference);virtual;
  175. procedure a_load_const_loc(list : taasmoutput;a : aword;const loc : tlocation);
  176. procedure a_load_reg_ref(list : taasmoutput;fromsize,tosize : tcgsize;register : tregister;const ref : treference);virtual; abstract;
  177. procedure a_load_reg_reg(list : taasmoutput;fromsize,tosize : tcgsize;reg1,reg2 : tregister);virtual; abstract;
  178. procedure a_load_reg_loc(list : taasmoutput;fromsize : tcgsize;reg : tregister;const loc: tlocation);
  179. procedure a_load_ref_reg(list : taasmoutput;fromsize,tosize : tcgsize;const ref : treference;register : tregister);virtual; abstract;
  180. procedure a_load_ref_ref(list : taasmoutput;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);virtual;
  181. procedure a_load_loc_reg(list : taasmoutput;tosize: tcgsize; const loc: tlocation; reg : tregister);
  182. procedure a_load_loc_ref(list : taasmoutput;tosize: tcgsize; const loc: tlocation; const ref : treference);
  183. procedure a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);virtual; abstract;
  184. { fpu move instructions }
  185. procedure a_loadfpu_reg_reg(list: taasmoutput; size:tcgsize; reg1, reg2: tregister); virtual; abstract;
  186. procedure a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister); virtual; abstract;
  187. procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); virtual; abstract;
  188. procedure a_loadfpu_loc_reg(list: taasmoutput; const loc: tlocation; const reg: tregister);
  189. procedure a_loadfpu_reg_loc(list: taasmoutput; size: tcgsize; const reg: tregister; const loc: tlocation);
  190. procedure a_paramfpu_reg(list : taasmoutput;size : tcgsize;const r : tregister;const locpara : tparalocation);virtual;
  191. procedure a_paramfpu_ref(list : taasmoutput;size : tcgsize;const ref : treference;const locpara : tparalocation);virtual;
  192. { vector register move instructions }
  193. procedure a_loadmm_reg_reg(list: taasmoutput; fromsize, tosize : tcgsize;reg1, reg2: tregister;shuffle : pmmshuffle); virtual; abstract;
  194. procedure a_loadmm_ref_reg(list: taasmoutput; fromsize, tosize : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); virtual; abstract;
  195. procedure a_loadmm_reg_ref(list: taasmoutput; fromsize, tosize : tcgsize;reg: tregister; const ref: treference;shuffle : pmmshuffle); virtual; abstract;
  196. procedure a_loadmm_loc_reg(list: taasmoutput; size: tcgsize; const loc: tlocation; const reg: tregister;shuffle : pmmshuffle);
  197. procedure a_loadmm_reg_loc(list: taasmoutput; size: tcgsize; const reg: tregister; const loc: tlocation;shuffle : pmmshuffle);
  198. procedure a_parammm_reg(list: taasmoutput; size: tcgsize; reg: tregister;const locpara : tparalocation;shuffle : pmmshuffle); virtual;
  199. procedure a_parammm_ref(list: taasmoutput; size: tcgsize; const ref: treference;const locpara : tparalocation;shuffle : pmmshuffle); virtual;
  200. procedure a_parammm_loc(list: taasmoutput; const loc: tlocation; const locpara : tparalocation;shuffle : pmmshuffle); virtual;
  201. procedure a_opmm_reg_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;src,dst: tregister;shuffle : pmmshuffle); virtual;abstract;
  202. procedure a_opmm_ref_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); virtual;
  203. procedure a_opmm_loc_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;const loc: tlocation; reg: tregister;shuffle : pmmshuffle); virtual;
  204. procedure a_opmm_reg_ref(list: taasmoutput; Op: TOpCG; size : tcgsize;reg: tregister;const ref: treference; shuffle : pmmshuffle); virtual;
  205. { basic arithmetic operations }
  206. { note: for operators which require only one argument (not, neg), use }
  207. { the op_reg_reg, op_reg_ref or op_reg_loc methods and keep in mind }
  208. { that in this case the *second* operand is used as both source and }
  209. { destination (JM) }
  210. procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; reg: TRegister); virtual; abstract;
  211. procedure a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const ref: TReference); virtual;
  212. procedure a_op_const_loc(list : taasmoutput; Op: TOpCG; a: AWord; const loc: tlocation);
  213. procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); virtual; abstract;
  214. procedure a_op_reg_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; reg: TRegister; const ref: TReference); virtual;
  215. procedure a_op_ref_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); virtual;
  216. procedure a_op_reg_loc(list : taasmoutput; Op: TOpCG; reg: tregister; const loc: tlocation);
  217. procedure a_op_ref_loc(list : taasmoutput; Op: TOpCG; const ref: TReference; const loc: tlocation);
  218. { trinary operations for processors that support them, 'emulated' }
  219. { on others. None with "ref" arguments since I don't think there }
  220. { are any processors that support it (JM) }
  221. procedure a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
  222. size: tcgsize; a: aword; src, dst: tregister); virtual;
  223. procedure a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
  224. size: tcgsize; src1, src2, dst: tregister); virtual;
  225. { comparison operations }
  226. procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
  227. l : tasmlabel);virtual; abstract;
  228. procedure a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference;
  229. l : tasmlabel); virtual;
  230. procedure a_cmp_const_loc_label(list: taasmoutput; size: tcgsize;cmp_op: topcmp; a: aword; const loc: tlocation;
  231. l : tasmlabel);
  232. procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); virtual; abstract;
  233. procedure a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const ref: treference; reg : tregister; l : tasmlabel); virtual;
  234. procedure a_cmp_loc_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const loc: tlocation; reg : tregister; l : tasmlabel);
  235. procedure a_cmp_ref_loc_label(list: taasmoutput; size: tcgsize;cmp_op: topcmp; const ref: treference; const loc: tlocation;
  236. l : tasmlabel);
  237. procedure a_jmp_always(list : taasmoutput;l: tasmlabel); virtual; abstract;
  238. procedure a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); virtual; abstract;
  239. {# Depending on the value to check in the flags, either sets the register reg to one (if the flag is set)
  240. or zero (if the flag is cleared). The size parameter indicates the destination size register.
  241. }
  242. procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: tresflags; reg: TRegister); virtual; abstract;
  243. procedure g_flags2ref(list: taasmoutput; size: TCgSize; const f: tresflags; const ref:TReference); virtual;
  244. {
  245. This routine tries to optimize the const_reg opcode, and should be
  246. called at the start of a_op_const_reg. It returns the actual opcode
  247. to emit, and the constant value to emit. If this routine returns
  248. TRUE, @var(no) instruction should be emitted (.eg : imul reg by 1 )
  249. @param(op The opcode to emit, returns the opcode which must be emitted)
  250. @param(a The constant which should be emitted, returns the constant which must
  251. be emitted)
  252. @param(reg The register to emit the opcode with, returns the register with
  253. which the opcode will be emitted)
  254. }
  255. function optimize_op_const_reg(list: taasmoutput; var op: topcg; var a : aword; var reg: tregister): boolean;virtual;
  256. {#
  257. This routine is used in exception management nodes. It should
  258. save the exception reason currently in the FUNCTION_RETURN_REG. The
  259. save should be done either to a temp (pointed to by href).
  260. or on the stack (pushing the value on the stack).
  261. The size of the value to save is OS_S32. The default version
  262. saves the exception reason to a temp. memory area.
  263. }
  264. procedure g_exception_reason_save(list : taasmoutput; const href : treference);virtual;
  265. {#
  266. This routine is used in exception management nodes. It should
  267. save the exception reason constant. The
  268. save should be done either to a temp (pointed to by href).
  269. or on the stack (pushing the value on the stack).
  270. The size of the value to save is OS_S32. The default version
  271. saves the exception reason to a temp. memory area.
  272. }
  273. procedure g_exception_reason_save_const(list : taasmoutput; const href : treference; a: aword);virtual;
  274. {#
  275. This routine is used in exception management nodes. It should
  276. load the exception reason to the FUNCTION_RETURN_REG. The saved value
  277. should either be in the temp. area (pointed to by href , href should
  278. *NOT* be freed) or on the stack (the value should be popped).
  279. The size of the value to save is OS_S32. The default version
  280. saves the exception reason to a temp. memory area.
  281. }
  282. procedure g_exception_reason_load(list : taasmoutput; const href : treference);virtual;
  283. procedure g_maybe_testself(list : taasmoutput;reg:tregister);
  284. procedure g_maybe_testvmt(list : taasmoutput;reg:tregister;objdef:tobjectdef);
  285. {# This should emit the opcode to copy len bytes from the source
  286. to destination, if loadref is true, it assumes that it first must load
  287. the source address from the memory location where
  288. source points to.
  289. It must be overriden for each new target processor.
  290. @param(source Source reference of copy)
  291. @param(dest Destination reference of copy)
  292. @param(delsource Indicates if the source reference's resources should be freed)
  293. @param(loadref Is the source reference a pointer to the actual source (TRUE), is it the actual source address (FALSE))
  294. }
  295. procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword;delsource,loadref : boolean);virtual; abstract;
  296. {# This should emit the opcode to a shortrstring from the source
  297. to destination, if loadref is true, it assumes that it first must load
  298. the source address from the memory location where
  299. source points to.
  300. @param(source Source reference of copy)
  301. @param(dest Destination reference of copy)
  302. @param(delsource Indicates if the source reference's resources should be freed)
  303. @param(loadref Is the source reference a pointer to the actual source (TRUE), is it the actual source address (FALSE))
  304. }
  305. procedure g_copyshortstring(list : taasmoutput;const source,dest : treference;len:byte;delsource,loadref : boolean);
  306. procedure g_incrrefcount(list : taasmoutput;t: tdef; const ref: treference;loadref : boolean);
  307. procedure g_decrrefcount(list : taasmoutput;t: tdef; const ref: treference;loadref : boolean);
  308. procedure g_initialize(list : taasmoutput;t : tdef;const ref : treference;loadref : boolean);
  309. procedure g_finalize(list : taasmoutput;t : tdef;const ref : treference;loadref : boolean);
  310. {# Generates range checking code. It is to note
  311. that this routine does not need to be overriden,
  312. as it takes care of everything.
  313. @param(p Node which contains the value to check)
  314. @param(todef Type definition of node to range check)
  315. }
  316. procedure g_rangecheck(list: taasmoutput; const l:tlocation; fromdef,todef: tdef); virtual;
  317. {# Generates overflow checking code for a node }
  318. procedure g_overflowcheck(list: taasmoutput; const l:tlocation; def:tdef); virtual; abstract;
  319. procedure g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:aword);virtual;
  320. procedure g_releasevaluepara_openarray(list : taasmoutput;const ref:treference);virtual;
  321. {# Emits instructions which should be emitted when entering
  322. a routine declared as @var(interrupt). The default
  323. behavior does nothing, should be overriden as required.
  324. }
  325. procedure g_interrupt_stackframe_entry(list : taasmoutput);virtual;
  326. {# Emits instructions which should be emitted when exiting
  327. a routine declared as @var(interrupt). The default
  328. behavior does nothing, should be overriden as required.
  329. }
  330. procedure g_interrupt_stackframe_exit(list : taasmoutput;accused,acchiused:boolean);virtual;
  331. {# Emits instructions when compilation is done in profile
  332. mode (this is set as a command line option). The default
  333. behavior does nothing, should be overriden as required.
  334. }
  335. procedure g_profilecode(list : taasmoutput);virtual;
  336. {# Emits instruction for allocating @var(size) bytes at the stackpointer
  337. @param(size Number of bytes to allocate)
  338. }
  339. procedure g_stackpointer_alloc(list : taasmoutput;size : longint);virtual; abstract;
  340. {# Emits instruction for allocating the locals in entry
  341. code of a routine. This is one of the first
  342. routine called in @var(genentrycode).
  343. @param(localsize Number of bytes to allocate as locals)
  344. }
  345. procedure g_stackframe_entry(list : taasmoutput;localsize : longint);virtual; abstract;
  346. {# Emits instructiona for restoring the frame pointer
  347. at routine exit. For some processors, this routine
  348. may do nothing at all.
  349. }
  350. procedure g_restore_frame_pointer(list : taasmoutput);virtual; abstract;
  351. {# Emits instructions for returning from a subroutine.
  352. Should also restore the stack.
  353. @param(parasize Number of bytes of parameters to deallocate from stack)
  354. }
  355. procedure g_return_from_proc(list : taasmoutput;parasize : aword);virtual; abstract;
  356. {# This routine is called when generating the code for the entry point
  357. of a routine. It should save all registers which are not used in this
  358. routine, and which should be declared as saved in the std_saved_registers
  359. set.
  360. This routine is mainly used when linking to code which is generated
  361. by ABI-compliant compilers (like GCC), to make sure that the reserved
  362. registers of that ABI are not clobbered.
  363. @param(usedinproc Registers which are used in the code of this routine)
  364. }
  365. procedure g_save_standard_registers(list:Taasmoutput);virtual;abstract;
  366. {# This routine is called when generating the code for the exit point
  367. of a routine. It should restore all registers which were previously
  368. saved in @var(g_save_standard_registers).
  369. @param(usedinproc Registers which are used in the code of this routine)
  370. }
  371. procedure g_restore_standard_registers(list:Taasmoutput);virtual;abstract;
  372. procedure g_save_all_registers(list : taasmoutput);virtual;abstract;
  373. procedure g_restore_all_registers(list : taasmoutput;const funcretparaloc:tparalocation);virtual;abstract;
  374. end;
  375. {# @abstract(Abstract code generator for 64 Bit operations)
  376. This class implements an abstract code generator class
  377. for 64 Bit operations.
  378. }
  379. tcg64 = class
  380. { Allocates 64 Bit register r by inserting a pai_realloc record }
  381. procedure a_reg_alloc(list : taasmoutput;r : tregister64);virtual;abstract;
  382. { Deallocates 64 Bit register r by inserting a pa_regdealloc record}
  383. procedure a_reg_dealloc(list : taasmoutput;r : tregister64);virtual;abstract;
  384. procedure a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);virtual;abstract;
  385. procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);virtual;abstract;
  386. procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);virtual;abstract;
  387. procedure a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64);virtual;abstract;
  388. procedure a_load64_const_reg(list : taasmoutput;value : qword;reg : tregister64);virtual;abstract;
  389. procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64);virtual;abstract;
  390. procedure a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);virtual;abstract;
  391. procedure a_load64_const_loc(list : taasmoutput;value : qword;const l : tlocation);virtual;abstract;
  392. procedure a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);virtual;abstract;
  393. procedure a_load64high_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);virtual;abstract;
  394. procedure a_load64low_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);virtual;abstract;
  395. procedure a_load64high_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);virtual;abstract;
  396. procedure a_load64low_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);virtual;abstract;
  397. procedure a_load64high_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);virtual;abstract;
  398. procedure a_load64low_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);virtual;abstract;
  399. procedure a_op64_ref_reg(list : taasmoutput;op:TOpCG;const ref : treference;reg : tregister64);virtual;abstract;
  400. procedure a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);virtual;abstract;
  401. procedure a_op64_reg_ref(list : taasmoutput;op:TOpCG;regsrc : tregister64;const ref : treference);virtual;abstract;
  402. procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;regdst : tregister64);virtual;abstract;
  403. procedure a_op64_const_ref(list : taasmoutput;op:TOpCG;value : qword;const ref : treference);virtual;abstract;
  404. procedure a_op64_const_loc(list : taasmoutput;op:TOpCG;value : qword;const l: tlocation);virtual;abstract;
  405. procedure a_op64_reg_loc(list : taasmoutput;op:TOpCG;reg : tregister64;const l : tlocation);virtual;abstract;
  406. procedure a_op64_loc_reg(list : taasmoutput;op:TOpCG;const l : tlocation;reg64 : tregister64);virtual;abstract;
  407. procedure a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : qword;regsrc,regdst : tregister64);virtual;
  408. procedure a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64);virtual;
  409. procedure a_param64_reg(list : taasmoutput;reg64 : tregister64;const loc : tparalocation);virtual;abstract;
  410. procedure a_param64_const(list : taasmoutput;value : qword;const loc : tparalocation);virtual;abstract;
  411. procedure a_param64_ref(list : taasmoutput;const r : treference;const loc : tparalocation);virtual;abstract;
  412. procedure a_param64_loc(list : taasmoutput;const l : tlocation;const loc : tparalocation);virtual;abstract;
  413. {
  414. This routine tries to optimize the const_reg opcode, and should be
  415. called at the start of a_op64_const_reg. It returns the actual opcode
  416. to emit, and the constant value to emit. If this routine returns
  417. TRUE, @var(no) instruction should be emitted (.eg : imul reg by 1 )
  418. @param(op The opcode to emit, returns the opcode which must be emitted)
  419. @param(a The constant which should be emitted, returns the constant which must
  420. be emitted)
  421. @param(reg The register to emit the opcode with, returns the register with
  422. which the opcode will be emitted)
  423. }
  424. function optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : qword; var reg: tregister64): boolean;virtual;abstract;
  425. { override to catch 64bit rangechecks }
  426. procedure g_rangecheck64(list: taasmoutput; const l:tlocation; fromdef,todef: tdef);virtual;abstract;
  427. end;
  428. procedure reference_release(list: taasmoutput; const ref : treference);
  429. { tlocation handling }
  430. procedure location_reset(var l : tlocation;lt:TCGLoc;lsize:TCGSize);
  431. procedure location_release(list: taasmoutput; const l : tlocation);
  432. procedure location_freetemp(list: taasmoutput; const l : tlocation);
  433. procedure location_copy(var destloc:tlocation; const sourceloc : tlocation);
  434. procedure location_swap(var destloc,sourceloc : tlocation);
  435. var
  436. {# Main code generator class }
  437. cg : tcg;
  438. {# Code generator class for all operations working with 64-Bit operands }
  439. cg64 : tcg64;
  440. implementation
  441. uses
  442. globals,globtype,options,systems,
  443. verbose,defutil,paramgr,
  444. tgobj,cutils,
  445. cgutils;
  446. const
  447. { Please leave this here, this module should NOT use
  448. exprasmlist, the lists are always passed as arguments.
  449. Declaring it as string here results in an error when compiling (PFV) }
  450. exprasmlist = 'error';
  451. {*****************************************************************************
  452. basic functionallity
  453. ******************************************************************************}
  454. constructor tcg.create;
  455. begin
  456. end;
  457. function Tcg.makeregsize(reg:Tregister;size:Tcgsize):Tregister;
  458. var
  459. subreg:Tsubregister;
  460. begin
  461. subreg:=cgsize2subreg(size);
  462. result:=reg;
  463. setsubreg(result,subreg);
  464. end;
  465. {*****************************************************************************
  466. register allocation
  467. ******************************************************************************}
  468. procedure tcg.init_register_allocators;
  469. begin
  470. fillchar(rg,sizeof(rg),0);
  471. add_reg_instruction_hook:={$ifdef FPCPROCVAR}@{$endif}add_reg_instruction;
  472. end;
  473. procedure tcg.done_register_allocators;
  474. begin
  475. { Safety }
  476. fillchar(rg,sizeof(rg),0);
  477. add_reg_instruction_hook:=nil;
  478. end;
  479. {$ifdef flowgraph}
  480. procedure Tcg.init_flowgraph;
  481. begin
  482. aktflownode:=0;
  483. end;
  484. procedure Tcg.done_flowgraph;
  485. begin
  486. end;
  487. {$endif}
  488. function tcg.getintregister(list:Taasmoutput;size:Tcgsize):Tregister;
  489. begin
  490. if not assigned(rg[R_INTREGISTER]) then
  491. internalerror(200312122);
  492. result:=rg[R_INTREGISTER].getregister(list,cgsize2subreg(size));
  493. end;
  494. function tcg.getfpuregister(list:Taasmoutput;size:Tcgsize):Tregister;
  495. begin
  496. if not assigned(rg[R_FPUREGISTER]) then
  497. internalerror(200312123);
  498. result:=rg[R_FPUREGISTER].getregister(list,cgsize2subreg(size));
  499. end;
  500. function tcg.getmmregister(list:Taasmoutput;size:Tcgsize):Tregister;
  501. begin
  502. if not assigned(rg[R_MMREGISTER]) then
  503. internalerror(200312124);
  504. result:=rg[R_MMREGISTER].getregister(list,cgsize2subreg(size));
  505. end;
  506. function tcg.getaddressregister(list:Taasmoutput):Tregister;
  507. begin
  508. if assigned(rg[R_ADDRESSREGISTER]) then
  509. result:=rg[R_ADDRESSREGISTER].getregister(list,R_SUBWHOLE)
  510. else
  511. begin
  512. if not assigned(rg[R_INTREGISTER]) then
  513. internalerror(200312121);
  514. result:=rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
  515. end;
  516. end;
  517. procedure tcg.getexplicitregister(list:Taasmoutput;r:Tregister);
  518. begin
  519. if not assigned(rg[getregtype(r)]) then
  520. internalerror(200312125);
  521. rg[getregtype(r)].getexplicitregister(list,r);
  522. end;
  523. procedure tcg.ungetregister(list:Taasmoutput;r:Tregister);
  524. begin
  525. if not assigned(rg[getregtype(r)]) then
  526. internalerror(200312126);
  527. rg[getregtype(r)].ungetregister(list,r);
  528. end;
  529. procedure tcg.ungetreference(list:Taasmoutput;const r:Treference);
  530. begin
  531. if r.base<>NR_NO then
  532. ungetregister(list,r.base);
  533. if r.index<>NR_NO then
  534. ungetregister(list,r.index);
  535. end;
  536. procedure tcg.allocexplicitregisters(list:Taasmoutput;rt:Tregistertype;r:Tcpuregisterset);
  537. begin
  538. if assigned(rg[rt]) then
  539. rg[rt].allocexplicitregisters(list,r)
  540. else
  541. internalerror(200310092);
  542. end;
  543. procedure tcg.deallocexplicitregisters(list:Taasmoutput;rt:Tregistertype;r:Tcpuregisterset);
  544. begin
  545. if assigned(rg[rt]) then
  546. rg[rt].deallocexplicitregisters(list,r)
  547. else
  548. internalerror(200310093);
  549. end;
  550. function tcg.uses_registers(rt:Tregistertype):boolean;
  551. begin
  552. if assigned(rg[rt]) then
  553. result:=rg[rt].uses_registers
  554. else
  555. result:=false;
  556. end;
  557. procedure tcg.add_reg_instruction(instr:Tai;r:tregister);
  558. var
  559. rt : tregistertype;
  560. begin
  561. rt:=getregtype(r);
  562. { Only add it when a register allocator is configured.
  563. No IE can be generated, because the VMT is written
  564. without a valid rg[] }
  565. if assigned(rg[rt]) then
  566. rg[rt].add_reg_instruction(instr,r);
  567. end;
  568. procedure tcg.add_move_instruction(instr:Taicpu);
  569. var
  570. rt : tregistertype;
  571. begin
  572. rt:=getregtype(instr.oper[O_MOV_SOURCE]^.reg);
  573. if assigned(rg[rt]) then
  574. rg[rt].add_move_instruction(instr)
  575. else
  576. internalerror(200310095);
  577. end;
  578. procedure tcg.do_register_allocation(list:Taasmoutput;headertai:tai);
  579. var
  580. rt : tregistertype;
  581. begin
  582. for rt:=low(tregistertype) to high(tregistertype) do
  583. begin
  584. if assigned(rg[rt]) then
  585. rg[rt].do_register_allocation(list,headertai);
  586. end;
  587. end;
  588. procedure tcg.a_reg_alloc(list : taasmoutput;r : tregister);
  589. begin
  590. list.concat(tai_regalloc.alloc(r));
  591. end;
  592. procedure tcg.a_reg_dealloc(list : taasmoutput;r : tregister);
  593. begin
  594. list.concat(tai_regalloc.dealloc(r));
  595. end;
  596. procedure tcg.a_label(list : taasmoutput;l : tasmlabel);
  597. begin
  598. list.concat(tai_label.create(l));
  599. end;
  600. {*****************************************************************************
  601. for better code generation these methods should be overridden
  602. ******************************************************************************}
  603. procedure tcg.a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const locpara : tparalocation);
  604. var
  605. ref : treference;
  606. begin
  607. case locpara.loc of
  608. LOC_REGISTER,LOC_CREGISTER:
  609. a_load_reg_reg(list,size,locpara.size,r,locpara.register);
  610. LOC_REFERENCE,LOC_CREFERENCE:
  611. begin
  612. reference_reset(ref);
  613. ref.base:=locpara.reference.index;
  614. ref.offset:=locpara.reference.offset;
  615. a_load_reg_ref(list,size,locpara.size,r,ref);
  616. end
  617. else
  618. internalerror(2002071004);
  619. end;
  620. end;
  621. procedure tcg.a_param_const(list : taasmoutput;size : tcgsize;a : aword;const locpara : tparalocation);
  622. var
  623. ref : treference;
  624. begin
  625. case locpara.loc of
  626. LOC_REGISTER,LOC_CREGISTER:
  627. a_load_const_reg(list,locpara.size,a,locpara.register);
  628. LOC_REFERENCE,LOC_CREFERENCE:
  629. begin
  630. reference_reset(ref);
  631. ref.base:=locpara.reference.index;
  632. ref.offset:=locpara.reference.offset;
  633. a_load_const_ref(list,locpara.size,a,ref);
  634. end
  635. else
  636. internalerror(2002071004);
  637. end;
  638. end;
  639. procedure tcg.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const locpara : tparalocation);
  640. var
  641. ref : treference;
  642. begin
  643. case locpara.loc of
  644. LOC_REGISTER,LOC_CREGISTER:
  645. a_load_ref_reg(list,size,locpara.size,r,locpara.register);
  646. LOC_REFERENCE,LOC_CREFERENCE:
  647. begin
  648. reference_reset(ref);
  649. ref.base:=locpara.reference.index;
  650. ref.offset:=locpara.reference.offset;
  651. a_load_ref_ref(list,size,locpara.size,r,ref);
  652. end
  653. else
  654. internalerror(2002071004);
  655. end;
  656. end;
  657. procedure tcg.a_param_loc(list : taasmoutput;const l:tlocation;const locpara : tparalocation);
  658. begin
  659. case l.loc of
  660. LOC_REGISTER,
  661. LOC_CREGISTER :
  662. a_param_reg(list,l.size,l.register,locpara);
  663. LOC_CONSTANT :
  664. a_param_const(list,l.size,l.value,locpara);
  665. LOC_CREFERENCE,
  666. LOC_REFERENCE :
  667. a_param_ref(list,l.size,l.reference,locpara);
  668. else
  669. internalerror(2002032211);
  670. end;
  671. end;
  672. procedure tcg.a_paramaddr_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);
  673. var
  674. hr : tregister;
  675. begin
  676. hr:=getaddressregister(list);
  677. a_loadaddr_ref_reg(list,r,hr);
  678. ungetregister(list,hr);
  679. a_param_reg(list,OS_ADDR,hr,locpara);
  680. end;
  681. procedure tcg.a_param_copy_ref(list : taasmoutput;size : qword;const r : treference;const locpara : tparalocation);
  682. var
  683. ref : treference;
  684. begin
  685. if not(locpara.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  686. internalerror(2003010901);
  687. reference_reset_base(ref,locpara.reference.index,locpara.reference.offset);
  688. g_concatcopy(list,r,ref,size,false,false);
  689. end;
  690. procedure tcg.a_loadany_param_ref(list : taasmoutput;const locpara : tparalocation;const ref:treference;shuffle : pmmshuffle);
  691. begin
  692. case locpara.loc of
  693. LOC_CREGISTER,
  694. LOC_REGISTER:
  695. begin
  696. {$ifndef cpu64bit}
  697. if (locpara.size in [OS_S64,OS_64]) then
  698. begin
  699. getexplicitregister(list,locpara.registerlow);
  700. getexplicitregister(list,locpara.registerhigh);
  701. ungetregister(list,locpara.registerlow);
  702. ungetregister(list,locpara.registerhigh);
  703. cg64.a_load64_reg_ref(list,locpara.register64,ref)
  704. end
  705. else
  706. {$endif cpu64bit}
  707. begin
  708. getexplicitregister(list,locpara.register);
  709. ungetregister(list,locpara.register);
  710. a_load_reg_ref(list,locpara.size,locpara.size,locpara.register,ref);
  711. end;
  712. end;
  713. LOC_MMREGISTER,
  714. LOC_CMMREGISTER:
  715. begin
  716. getexplicitregister(list,locpara.register);
  717. ungetregister(list,locpara.register);
  718. a_loadmm_reg_ref(list,locpara.size,locpara.size,locpara.register,ref,shuffle);
  719. end;
  720. LOC_FPUREGISTER,
  721. LOC_CFPUREGISTER:
  722. begin
  723. getexplicitregister(list,locpara.register);
  724. ungetregister(list,locpara.register);
  725. a_loadfpu_reg_ref(list,locpara.size,locpara.register,ref);
  726. end;
  727. else
  728. internalerror(2002081302);
  729. end;
  730. end;
  731. procedure tcg.a_loadany_param_reg(list : taasmoutput;const locpara : tparalocation;const reg:tregister;shuffle : pmmshuffle);
  732. var
  733. href : treference;
  734. begin
  735. case locpara.loc of
  736. LOC_CREGISTER,
  737. LOC_REGISTER:
  738. begin
  739. if not(locpara.size in [OS_S64,OS_64]) then
  740. begin
  741. getexplicitregister(list,locpara.register);
  742. ungetregister(list,locpara.register);
  743. {
  744. This is now a normal imaginary register, allocated the usual way (JM)
  745. getexplicitregister(list,reg);
  746. }
  747. a_load_reg_reg(list,locpara.size,locpara.size,locpara.register,reg)
  748. end
  749. else
  750. internalerror(2003053011);
  751. end;
  752. LOC_CFPUREGISTER,
  753. LOC_FPUREGISTER:
  754. begin
  755. getexplicitregister(list,locpara.register);
  756. ungetregister(list,locpara.register);
  757. {
  758. This is now a normal imaginary register, allocated the usual way (JM)
  759. getexplicitregister(list,reg);
  760. }
  761. a_loadfpu_reg_reg(list,locpara.size,locpara.register,reg);
  762. end;
  763. LOC_MMREGISTER,
  764. LOC_CMMREGISTER:
  765. begin
  766. getexplicitregister(list,locpara.register);
  767. ungetregister(list,locpara.register);
  768. {
  769. This is now a normal imaginary register, allocated the usual way (JM)
  770. getexplicitregister(list,reg);
  771. }
  772. a_loadmm_reg_reg(list,locpara.size,locpara.size,locpara.register,reg,shuffle);
  773. end;
  774. LOC_REFERENCE,
  775. LOC_CREFERENCE:
  776. begin
  777. reference_reset_base(href,locpara.reference.index,locpara.reference.offset);
  778. {
  779. This is now a normal imaginary register, allocated the usual way (JM)
  780. getexplicitregister(list,reg);
  781. }
  782. a_load_ref_reg(list,locpara.size,locpara.size,href,reg);
  783. end;
  784. else
  785. internalerror(2003053010);
  786. end
  787. end;
  788. {****************************************************************************
  789. some generic implementations
  790. ****************************************************************************}
  791. procedure tcg.a_load_ref_ref(list : taasmoutput;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);
  792. var
  793. tmpreg: tregister;
  794. begin
  795. { verify if we have the same reference }
  796. if references_equal(sref,dref) then
  797. exit;
  798. tmpreg:=getintregister(list,tosize);
  799. a_load_ref_reg(list,fromsize,tosize,sref,tmpreg);
  800. a_load_reg_ref(list,tosize,tosize,tmpreg,dref);
  801. ungetregister(list,tmpreg);
  802. end;
  803. procedure tcg.a_load_const_ref(list : taasmoutput;size : tcgsize;a : aword;const ref : treference);
  804. var
  805. tmpreg: tregister;
  806. begin
  807. tmpreg:=getintregister(list,size);
  808. a_load_const_reg(list,size,a,tmpreg);
  809. a_load_reg_ref(list,size,size,tmpreg,ref);
  810. ungetregister(list,tmpreg);
  811. end;
  812. procedure tcg.a_load_const_loc(list : taasmoutput;a : aword;const loc: tlocation);
  813. begin
  814. case loc.loc of
  815. LOC_REFERENCE,LOC_CREFERENCE:
  816. a_load_const_ref(list,loc.size,a,loc.reference);
  817. LOC_REGISTER,LOC_CREGISTER:
  818. a_load_const_reg(list,loc.size,a,loc.register);
  819. else
  820. internalerror(200203272);
  821. end;
  822. end;
  823. procedure tcg.a_load_reg_loc(list : taasmoutput;fromsize : tcgsize;reg : tregister;const loc: tlocation);
  824. begin
  825. case loc.loc of
  826. LOC_REFERENCE,LOC_CREFERENCE:
  827. a_load_reg_ref(list,fromsize,loc.size,reg,loc.reference);
  828. LOC_REGISTER,LOC_CREGISTER:
  829. a_load_reg_reg(list,fromsize,loc.size,reg,loc.register);
  830. else
  831. internalerror(200203271);
  832. end;
  833. end;
  834. procedure tcg.a_load_loc_reg(list : taasmoutput; tosize: tcgsize; const loc: tlocation; reg : tregister);
  835. begin
  836. case loc.loc of
  837. LOC_REFERENCE,LOC_CREFERENCE:
  838. a_load_ref_reg(list,loc.size,tosize,loc.reference,reg);
  839. LOC_REGISTER,LOC_CREGISTER:
  840. a_load_reg_reg(list,loc.size,tosize,loc.register,reg);
  841. LOC_CONSTANT:
  842. a_load_const_reg(list,tosize,loc.value,reg);
  843. else
  844. internalerror(200109092);
  845. end;
  846. end;
  847. procedure tcg.a_load_loc_ref(list : taasmoutput;tosize: tcgsize; const loc: tlocation; const ref : treference);
  848. begin
  849. case loc.loc of
  850. LOC_REFERENCE,LOC_CREFERENCE:
  851. a_load_ref_ref(list,loc.size,tosize,loc.reference,ref);
  852. LOC_REGISTER,LOC_CREGISTER:
  853. a_load_reg_ref(list,loc.size,tosize,loc.register,ref);
  854. LOC_CONSTANT:
  855. a_load_const_ref(list,tosize,loc.value,ref);
  856. else
  857. internalerror(200109302);
  858. end;
  859. end;
  860. function tcg.optimize_op_const_reg(list: taasmoutput; var op: topcg; var a : aword; var reg:tregister): boolean;
  861. var
  862. powerval : longint;
  863. begin
  864. optimize_op_const_reg := false;
  865. case op of
  866. { or with zero returns same result }
  867. OP_OR : if a = 0 then optimize_op_const_reg := true;
  868. { and with max returns same result }
  869. OP_AND : if (a = high(a)) then optimize_op_const_reg := true;
  870. { division by 1 returns result }
  871. OP_DIV :
  872. begin
  873. if a = 1 then
  874. optimize_op_const_reg := true
  875. else if ispowerof2(int64(a), powerval) then
  876. begin
  877. a := powerval;
  878. op:= OP_SHR;
  879. end;
  880. exit;
  881. end;
  882. OP_IDIV:
  883. begin
  884. if a = 1 then
  885. optimize_op_const_reg := true
  886. else if ispowerof2(int64(a), powerval) then
  887. begin
  888. a := powerval;
  889. op:= OP_SAR;
  890. end;
  891. exit;
  892. end;
  893. OP_MUL,OP_IMUL:
  894. begin
  895. if a = 1 then
  896. optimize_op_const_reg := true
  897. else if ispowerof2(int64(a), powerval) then
  898. begin
  899. a := powerval;
  900. op:= OP_SHL;
  901. end;
  902. exit;
  903. end;
  904. OP_SAR,OP_SHL,OP_SHR:
  905. begin
  906. if a = 0 then
  907. optimize_op_const_reg := true;
  908. exit;
  909. end;
  910. end;
  911. end;
  912. procedure tcg.a_loadfpu_loc_reg(list: taasmoutput; const loc: tlocation; const reg: tregister);
  913. begin
  914. case loc.loc of
  915. LOC_REFERENCE, LOC_CREFERENCE:
  916. a_loadfpu_ref_reg(list,loc.size,loc.reference,reg);
  917. LOC_FPUREGISTER, LOC_CFPUREGISTER:
  918. a_loadfpu_reg_reg(list,loc.size,loc.register,reg);
  919. else
  920. internalerror(200203301);
  921. end;
  922. end;
  923. procedure tcg.a_loadfpu_reg_loc(list: taasmoutput; size: tcgsize; const reg: tregister; const loc: tlocation);
  924. begin
  925. case loc.loc of
  926. LOC_REFERENCE, LOC_CREFERENCE:
  927. a_loadfpu_reg_ref(list,size,reg,loc.reference);
  928. LOC_FPUREGISTER, LOC_CFPUREGISTER:
  929. a_loadfpu_reg_reg(list,size,reg,loc.register);
  930. else
  931. internalerror(48991);
  932. end;
  933. end;
  934. procedure tcg.a_paramfpu_reg(list : taasmoutput;size : tcgsize;const r : tregister;const locpara : tparalocation);
  935. var
  936. ref : treference;
  937. begin
  938. case locpara.loc of
  939. LOC_FPUREGISTER,LOC_CFPUREGISTER:
  940. a_loadfpu_reg_reg(list,size,r,locpara.register);
  941. LOC_REFERENCE,LOC_CREFERENCE:
  942. begin
  943. reference_reset(ref);
  944. ref.base:=locpara.reference.index;
  945. ref.offset:=locpara.reference.offset;
  946. a_loadfpu_reg_ref(list,size,r,ref);
  947. end
  948. else
  949. internalerror(2002071004);
  950. end;
  951. end;
  952. procedure tcg.a_paramfpu_ref(list : taasmoutput;size : tcgsize;const ref : treference;const locpara : tparalocation);
  953. var
  954. href : treference;
  955. begin
  956. case locpara.loc of
  957. LOC_FPUREGISTER,LOC_CFPUREGISTER:
  958. a_loadfpu_ref_reg(list,size,ref,locpara.register);
  959. LOC_REFERENCE,LOC_CREFERENCE:
  960. begin
  961. reference_reset(href);
  962. href.base:=locpara.reference.index;
  963. href.offset:=locpara.reference.offset;
  964. { concatcopy should choose the best way to copy the data }
  965. g_concatcopy(list,ref,href,tcgsize2size[size],false,false);
  966. end
  967. else
  968. internalerror(200402201);
  969. end;
  970. end;
  971. procedure tcg.a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const ref: TReference);
  972. var
  973. tmpreg: tregister;
  974. begin
  975. tmpreg:=getintregister(list,size);
  976. a_load_ref_reg(list,size,size,ref,tmpreg);
  977. a_op_const_reg(list,op,size,a,tmpreg);
  978. a_load_reg_ref(list,size,size,tmpreg,ref);
  979. ungetregister(list,tmpreg);
  980. end;
  981. procedure tcg.a_op_const_loc(list : taasmoutput; Op: TOpCG; a: AWord; const loc: tlocation);
  982. begin
  983. case loc.loc of
  984. LOC_REGISTER, LOC_CREGISTER:
  985. a_op_const_reg(list,op,loc.size,a,loc.register);
  986. LOC_REFERENCE, LOC_CREFERENCE:
  987. a_op_const_ref(list,op,loc.size,a,loc.reference);
  988. else
  989. internalerror(200109061);
  990. end;
  991. end;
  992. procedure tcg.a_op_reg_ref(list : taasmoutput; Op: TOpCG; size: TCGSize;reg: TRegister; const ref: TReference);
  993. var
  994. tmpreg: tregister;
  995. begin
  996. tmpreg:=getintregister(list,size);
  997. a_load_ref_reg(list,size,size,ref,tmpreg);
  998. a_op_reg_reg(list,op,size,reg,tmpreg);
  999. a_load_reg_ref(list,size,size,tmpreg,ref);
  1000. ungetregister(list,tmpreg);
  1001. end;
  1002. procedure tcg.a_op_ref_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister);
  1003. var
  1004. tmpreg: tregister;
  1005. begin
  1006. case op of
  1007. OP_NOT,OP_NEG:
  1008. { handle it as "load ref,reg; op reg" }
  1009. begin
  1010. a_load_ref_reg(list,size,size,ref,reg);
  1011. a_op_reg_reg(list,op,size,reg,reg);
  1012. end;
  1013. else
  1014. begin
  1015. tmpreg:=getintregister(list,size);
  1016. a_load_ref_reg(list,size,size,ref,tmpreg);
  1017. a_op_reg_reg(list,op,size,tmpreg,reg);
  1018. ungetregister(list,tmpreg);
  1019. end;
  1020. end;
  1021. end;
  1022. procedure tcg.a_op_reg_loc(list : taasmoutput; Op: TOpCG; reg: tregister; const loc: tlocation);
  1023. begin
  1024. case loc.loc of
  1025. LOC_REGISTER, LOC_CREGISTER:
  1026. a_op_reg_reg(list,op,loc.size,reg,loc.register);
  1027. LOC_REFERENCE, LOC_CREFERENCE:
  1028. a_op_reg_ref(list,op,loc.size,reg,loc.reference);
  1029. else
  1030. internalerror(200109061);
  1031. end;
  1032. end;
  1033. procedure tcg.a_op_ref_loc(list : taasmoutput; Op: TOpCG; const ref: TReference; const loc: tlocation);
  1034. var
  1035. tmpreg: tregister;
  1036. begin
  1037. case loc.loc of
  1038. LOC_REGISTER,LOC_CREGISTER:
  1039. a_op_ref_reg(list,op,loc.size,ref,loc.register);
  1040. LOC_REFERENCE,LOC_CREFERENCE:
  1041. begin
  1042. tmpreg:=getintregister(list,loc.size);
  1043. a_load_ref_reg(list,loc.size,loc.size,ref,tmpreg);
  1044. a_op_reg_ref(list,op,loc.size,tmpreg,loc.reference);
  1045. ungetregister(list,tmpreg);
  1046. end;
  1047. else
  1048. internalerror(200109061);
  1049. end;
  1050. end;
  1051. procedure Tcg.a_op_const_reg_reg(list:Taasmoutput;op:Topcg;size:Tcgsize;
  1052. a:aword;src,dst:Tregister);
  1053. begin
  1054. a_load_reg_reg(list,size,size,src,dst);
  1055. a_op_const_reg(list,op,size,a,dst);
  1056. end;
  1057. procedure tcg.a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
  1058. size: tcgsize; src1, src2, dst: tregister);
  1059. var
  1060. tmpreg: tregister;
  1061. begin
  1062. if (dst<>src1) then
  1063. begin
  1064. a_load_reg_reg(list,size,size,src2,dst);
  1065. a_op_reg_reg(list,op,size,src1,dst);
  1066. end
  1067. else
  1068. begin
  1069. tmpreg:=getintregister(list,size);
  1070. a_load_reg_reg(list,size,size,src2,tmpreg);
  1071. a_op_reg_reg(list,op,size,src1,tmpreg);
  1072. a_load_reg_reg(list,size,size,tmpreg,dst);
  1073. ungetregister(list,tmpreg);
  1074. end;
  1075. end;
  1076. procedure tcg.a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference;
  1077. l : tasmlabel);
  1078. var
  1079. tmpreg: tregister;
  1080. begin
  1081. tmpreg:=getintregister(list,size);
  1082. a_load_ref_reg(list,size,size,ref,tmpreg);
  1083. a_cmp_const_reg_label(list,size,cmp_op,a,tmpreg,l);
  1084. ungetregister(list,tmpreg);
  1085. end;
  1086. procedure tcg.a_cmp_const_loc_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const loc : tlocation;
  1087. l : tasmlabel);
  1088. begin
  1089. case loc.loc of
  1090. LOC_REGISTER,LOC_CREGISTER:
  1091. a_cmp_const_reg_label(list,size,cmp_op,a,loc.register,l);
  1092. LOC_REFERENCE,LOC_CREFERENCE:
  1093. a_cmp_const_ref_label(list,size,cmp_op,a,loc.reference,l);
  1094. else
  1095. internalerror(200109061);
  1096. end;
  1097. end;
  1098. procedure tcg.a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const ref: treference; reg : tregister; l : tasmlabel);
  1099. var
  1100. tmpreg: tregister;
  1101. begin
  1102. tmpreg:=getintregister(list,size);
  1103. a_load_ref_reg(list,size,size,ref,tmpreg);
  1104. a_cmp_reg_reg_label(list,size,cmp_op,tmpreg,reg,l);
  1105. ungetregister(list,tmpreg);
  1106. end;
  1107. procedure tcg.a_cmp_loc_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const loc: tlocation; reg : tregister; l : tasmlabel);
  1108. begin
  1109. case loc.loc of
  1110. LOC_REGISTER,
  1111. LOC_CREGISTER:
  1112. a_cmp_reg_reg_label(list,size,cmp_op,loc.register,reg,l);
  1113. LOC_REFERENCE,
  1114. LOC_CREFERENCE :
  1115. a_cmp_ref_reg_label(list,size,cmp_op,loc.reference,reg,l);
  1116. LOC_CONSTANT:
  1117. a_cmp_const_reg_label(list,size,cmp_op,loc.value,reg,l);
  1118. else
  1119. internalerror(200203231);
  1120. end;
  1121. end;
  1122. procedure tcg.a_cmp_ref_loc_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;const ref: treference;const loc : tlocation;
  1123. l : tasmlabel);
  1124. var
  1125. tmpreg: tregister;
  1126. begin
  1127. case loc.loc of
  1128. LOC_REGISTER,LOC_CREGISTER:
  1129. a_cmp_ref_reg_label(list,size,cmp_op,ref,loc.register,l);
  1130. LOC_REFERENCE,LOC_CREFERENCE:
  1131. begin
  1132. tmpreg:=getintregister(list,size);
  1133. a_load_ref_reg(list,size,size,loc.reference,tmpreg);
  1134. a_cmp_ref_reg_label(list,size,cmp_op,ref,tmpreg,l);
  1135. ungetregister(list,tmpreg);
  1136. end
  1137. else
  1138. internalerror(200109061);
  1139. end;
  1140. end;
  1141. procedure tcg.a_loadmm_loc_reg(list: taasmoutput; size: tcgsize; const loc: tlocation; const reg: tregister;shuffle : pmmshuffle);
  1142. begin
  1143. case loc.loc of
  1144. LOC_MMREGISTER,LOC_CMMREGISTER:
  1145. a_loadmm_reg_reg(list,loc.size,size,loc.register,reg,shuffle);
  1146. LOC_REFERENCE,LOC_CREFERENCE:
  1147. a_loadmm_ref_reg(list,loc.size,size,loc.reference,reg,shuffle);
  1148. else
  1149. internalerror(200310121);
  1150. end;
  1151. end;
  1152. procedure tcg.a_loadmm_reg_loc(list: taasmoutput; size: tcgsize; const reg: tregister; const loc: tlocation;shuffle : pmmshuffle);
  1153. begin
  1154. case loc.loc of
  1155. LOC_MMREGISTER,LOC_CMMREGISTER:
  1156. a_loadmm_reg_reg(list,size,loc.size,reg,loc.register,shuffle);
  1157. LOC_REFERENCE,LOC_CREFERENCE:
  1158. a_loadmm_reg_ref(list,size,loc.size,reg,loc.reference,shuffle);
  1159. else
  1160. internalerror(200310122);
  1161. end;
  1162. end;
  1163. procedure tcg.a_parammm_reg(list: taasmoutput; size: tcgsize; reg: tregister;const locpara : tparalocation;shuffle : pmmshuffle);
  1164. var
  1165. ref : treference;
  1166. begin
  1167. case locpara.loc of
  1168. LOC_MMREGISTER,LOC_CMMREGISTER:
  1169. a_loadmm_reg_reg(list,size,locpara.size,reg,locpara.register,shuffle);
  1170. LOC_REFERENCE,LOC_CREFERENCE:
  1171. begin
  1172. reference_reset(ref);
  1173. ref.base:=locpara.reference.index;
  1174. ref.offset:=locpara.reference.offset;
  1175. a_loadmm_reg_ref(list,size,locpara.size,reg,ref,shuffle);
  1176. end
  1177. else
  1178. internalerror(200310123);
  1179. end;
  1180. end;
  1181. procedure tcg.a_parammm_ref(list: taasmoutput; size: tcgsize;const ref: treference;const locpara : tparalocation;shuffle : pmmshuffle);
  1182. var
  1183. hr : tregister;
  1184. hs : tmmshuffle;
  1185. begin
  1186. hr:=getmmregister(list,locpara.size);
  1187. a_loadmm_ref_reg(list,size,locpara.size,ref,hr,shuffle);
  1188. if realshuffle(shuffle) then
  1189. begin
  1190. hs:=shuffle^;
  1191. removeshuffles(hs);
  1192. a_parammm_reg(list,locpara.size,hr,locpara,@hs);
  1193. end
  1194. else
  1195. a_parammm_reg(list,locpara.size,hr,locpara,shuffle);
  1196. ungetregister(list,hr);
  1197. end;
  1198. procedure tcg.a_parammm_loc(list: taasmoutput;const loc: tlocation; const locpara : tparalocation;shuffle : pmmshuffle);
  1199. begin
  1200. case loc.loc of
  1201. LOC_MMREGISTER,LOC_CMMREGISTER:
  1202. a_parammm_reg(list,loc.size,loc.register,locpara,shuffle);
  1203. LOC_REFERENCE,LOC_CREFERENCE:
  1204. a_parammm_ref(list,loc.size,loc.reference,locpara,shuffle);
  1205. else
  1206. internalerror(200310123);
  1207. end;
  1208. end;
  1209. procedure tcg.a_opmm_ref_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle);
  1210. var
  1211. hr : tregister;
  1212. hs : tmmshuffle;
  1213. begin
  1214. hr:=getmmregister(list,size);
  1215. a_loadmm_ref_reg(list,size,size,ref,hr,shuffle);
  1216. if realshuffle(shuffle) then
  1217. begin
  1218. hs:=shuffle^;
  1219. removeshuffles(hs);
  1220. a_opmm_reg_reg(list,op,size,hr,reg,@hs);
  1221. end
  1222. else
  1223. a_opmm_reg_reg(list,op,size,hr,reg,shuffle);
  1224. ungetregister(list,hr);
  1225. end;
  1226. procedure tcg.a_opmm_reg_ref(list: taasmoutput; Op: TOpCG; size : tcgsize;reg: tregister; const ref: treference; shuffle : pmmshuffle);
  1227. var
  1228. hr : tregister;
  1229. hs : tmmshuffle;
  1230. begin
  1231. hr:=getmmregister(list,size);
  1232. a_loadmm_ref_reg(list,size,size,ref,hr,shuffle);
  1233. if realshuffle(shuffle) then
  1234. begin
  1235. hs:=shuffle^;
  1236. removeshuffles(hs);
  1237. a_opmm_reg_reg(list,op,size,reg,hr,@hs);
  1238. a_loadmm_reg_ref(list,size,size,hr,ref,@hs);
  1239. end
  1240. else
  1241. begin
  1242. a_opmm_reg_reg(list,op,size,reg,hr,shuffle);
  1243. a_loadmm_reg_ref(list,size,size,hr,ref,shuffle);
  1244. end;
  1245. ungetregister(list,hr);
  1246. end;
  1247. procedure tcg.a_opmm_loc_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;const loc: tlocation; reg: tregister;shuffle : pmmshuffle);
  1248. begin
  1249. case loc.loc of
  1250. LOC_CMMREGISTER,LOC_MMREGISTER:
  1251. a_opmm_reg_reg(list,op,size,loc.register,reg,shuffle);
  1252. LOC_CREFERENCE,LOC_REFERENCE:
  1253. a_opmm_ref_reg(list,op,size,loc.reference,reg,shuffle);
  1254. else
  1255. internalerror(200312232);
  1256. end;
  1257. end;
  1258. class function tcg.reg_cgsize(const reg: tregister) : tcgsize;
  1259. begin
  1260. reg_cgsize := OS_INT;
  1261. end;
  1262. procedure tcg.g_copyshortstring(list : taasmoutput;const source,dest : treference;len:byte;delsource,loadref : boolean);
  1263. var
  1264. paraloc1,paraloc2,paraloc3 : tparalocation;
  1265. begin
  1266. {$ifdef FPC}
  1267. {$warning FIX ME!}
  1268. {$endif}
  1269. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  1270. paraloc2:=paramanager.getintparaloc(pocall_default,2);
  1271. paraloc3:=paramanager.getintparaloc(pocall_default,3);
  1272. paramanager.allocparaloc(list,paraloc3);
  1273. a_paramaddr_ref(list,dest,paraloc3);
  1274. paramanager.allocparaloc(list,paraloc2);
  1275. if loadref then
  1276. a_param_ref(list,OS_ADDR,source,paraloc2)
  1277. else
  1278. a_paramaddr_ref(list,source,paraloc2);
  1279. if delsource then
  1280. reference_release(list,source);
  1281. paramanager.allocparaloc(list,paraloc1);
  1282. a_param_const(list,OS_INT,len,paraloc1);
  1283. paramanager.freeparaloc(list,paraloc3);
  1284. paramanager.freeparaloc(list,paraloc2);
  1285. paramanager.freeparaloc(list,paraloc1);
  1286. allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1287. a_call_name(list,'FPC_SHORTSTR_ASSIGN');
  1288. deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1289. end;
  1290. procedure tcg.g_incrrefcount(list : taasmoutput;t: tdef; const ref: treference;loadref : boolean);
  1291. var
  1292. href : treference;
  1293. incrfunc : string;
  1294. paraloc1,paraloc2 : tparalocation;
  1295. begin
  1296. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  1297. paraloc2:=paramanager.getintparaloc(pocall_default,2);
  1298. { These functions should not change the registers (they use
  1299. the saveregister proc directive }
  1300. if is_interfacecom(t) then
  1301. incrfunc:='FPC_INTF_INCR_REF'
  1302. else if is_ansistring(t) then
  1303. incrfunc:='FPC_ANSISTR_INCR_REF'
  1304. else if is_widestring(t) then
  1305. incrfunc:='FPC_WIDESTR_INCR_REF'
  1306. else if is_dynamic_array(t) then
  1307. incrfunc:='FPC_DYNARRAY_INCR_REF'
  1308. else
  1309. incrfunc:='';
  1310. { call the special incr function or the generic addref }
  1311. if incrfunc<>'' then
  1312. begin
  1313. { these functions get the pointer by value }
  1314. paramanager.allocparaloc(list,paraloc1);
  1315. a_param_ref(list,OS_ADDR,ref,paraloc1);
  1316. paramanager.freeparaloc(list,paraloc1);
  1317. allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1318. a_call_name(list,incrfunc);
  1319. deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1320. end
  1321. else
  1322. begin
  1323. reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
  1324. paramanager.allocparaloc(list,paraloc2);
  1325. a_paramaddr_ref(list,href,paraloc2);
  1326. paramanager.allocparaloc(list,paraloc1);
  1327. if loadref then
  1328. a_param_ref(list,OS_ADDR,ref,paraloc1)
  1329. else
  1330. a_paramaddr_ref(list,ref,paraloc1);
  1331. paramanager.freeparaloc(list,paraloc1);
  1332. paramanager.freeparaloc(list,paraloc2);
  1333. allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1334. a_call_name(list,'FPC_ADDREF');
  1335. deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1336. end;
  1337. end;
  1338. procedure tcg.g_decrrefcount(list : taasmoutput;t: tdef; const ref: treference; loadref:boolean);
  1339. var
  1340. hreg : tregister;
  1341. href : treference;
  1342. decrfunc : string;
  1343. needrtti : boolean;
  1344. paraloc1,paraloc2 : tparalocation;
  1345. begin
  1346. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  1347. paraloc2:=paramanager.getintparaloc(pocall_default,2);
  1348. needrtti:=false;
  1349. if is_interfacecom(t) then
  1350. decrfunc:='FPC_INTF_DECR_REF'
  1351. else if is_ansistring(t) then
  1352. decrfunc:='FPC_ANSISTR_DECR_REF'
  1353. else if is_widestring(t) then
  1354. decrfunc:='FPC_WIDESTR_DECR_REF'
  1355. else if is_dynamic_array(t) then
  1356. begin
  1357. decrfunc:='FPC_DYNARRAY_DECR_REF';
  1358. needrtti:=true;
  1359. end
  1360. else
  1361. decrfunc:='';
  1362. { call the special decr function or the generic decref }
  1363. if decrfunc<>'' then
  1364. begin
  1365. if needrtti then
  1366. begin
  1367. reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
  1368. paramanager.allocparaloc(list,paraloc2);
  1369. a_paramaddr_ref(list,href,paraloc2);
  1370. end;
  1371. paramanager.allocparaloc(list,paraloc1);
  1372. if loadref then
  1373. a_param_ref(list,OS_ADDR,ref,paraloc1)
  1374. else
  1375. a_paramaddr_ref(list,ref,paraloc1);
  1376. paramanager.freeparaloc(list,paraloc1);
  1377. if needrtti then
  1378. paramanager.freeparaloc(list,paraloc2);
  1379. allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1380. a_call_name(list,decrfunc);
  1381. deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1382. end
  1383. else
  1384. begin
  1385. reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
  1386. paramanager.allocparaloc(list,paraloc2);
  1387. a_paramaddr_ref(list,href,paraloc2);
  1388. paramanager.allocparaloc(list,paraloc1);
  1389. if loadref then
  1390. a_param_ref(list,OS_ADDR,ref,paraloc1)
  1391. else
  1392. a_paramaddr_ref(list,ref,paraloc1);
  1393. paramanager.freeparaloc(list,paraloc1);
  1394. paramanager.freeparaloc(list,paraloc2);
  1395. allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1396. a_call_name(list,'FPC_DECREF');
  1397. deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1398. end;
  1399. { Temp locations need always to be reset to 0 }
  1400. if tg.istemp(ref) then
  1401. begin
  1402. if loadref then
  1403. begin
  1404. hreg:=getaddressregister(list);
  1405. a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,hreg);
  1406. reference_reset_base(href,hreg,0);
  1407. a_load_const_ref(list,OS_ADDR,0,href);
  1408. ungetregister(list,hreg);
  1409. end
  1410. else
  1411. a_load_const_ref(list,OS_ADDR,0,ref);
  1412. end;
  1413. end;
  1414. procedure tcg.g_initialize(list : taasmoutput;t : tdef;const ref : treference;loadref : boolean);
  1415. var
  1416. href : treference;
  1417. paraloc1,paraloc2 : tparalocation;
  1418. begin
  1419. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  1420. paraloc2:=paramanager.getintparaloc(pocall_default,2);
  1421. if is_ansistring(t) or
  1422. is_widestring(t) or
  1423. is_interfacecom(t) then
  1424. a_load_const_ref(list,OS_ADDR,0,ref)
  1425. else
  1426. begin
  1427. reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
  1428. paramanager.allocparaloc(list,paraloc2);
  1429. a_paramaddr_ref(list,href,paraloc2);
  1430. paramanager.allocparaloc(list,paraloc1);
  1431. if loadref then
  1432. a_param_ref(list,OS_ADDR,ref,paraloc1)
  1433. else
  1434. a_paramaddr_ref(list,ref,paraloc1);
  1435. paramanager.freeparaloc(list,paraloc1);
  1436. paramanager.freeparaloc(list,paraloc2);
  1437. allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1438. a_call_name(list,'FPC_INITIALIZE');
  1439. deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1440. end;
  1441. end;
  1442. procedure tcg.g_finalize(list : taasmoutput;t : tdef;const ref : treference;loadref : boolean);
  1443. var
  1444. hreg : tregister;
  1445. href : treference;
  1446. paraloc1,paraloc2 : tparalocation;
  1447. begin
  1448. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  1449. paraloc2:=paramanager.getintparaloc(pocall_default,2);
  1450. if is_ansistring(t) or
  1451. is_widestring(t) or
  1452. is_interfacecom(t) then
  1453. begin
  1454. g_decrrefcount(list,t,ref,loadref);
  1455. { Temp locations are already reset to 0 }
  1456. if not tg.istemp(ref) then
  1457. begin
  1458. if loadref then
  1459. begin
  1460. hreg:=getaddressregister(list);
  1461. a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,hreg);
  1462. reference_reset_base(href,hreg,0);
  1463. a_load_const_ref(list,OS_ADDR,0,href);
  1464. ungetregister(list,hreg);
  1465. end
  1466. else
  1467. a_load_const_ref(list,OS_ADDR,0,ref);
  1468. end;
  1469. end
  1470. else
  1471. begin
  1472. reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
  1473. paramanager.allocparaloc(list,paraloc2);
  1474. a_paramaddr_ref(list,href,paraloc2);
  1475. paramanager.allocparaloc(list,paraloc1);
  1476. if loadref then
  1477. a_param_ref(list,OS_ADDR,ref,paraloc1)
  1478. else
  1479. a_paramaddr_ref(list,ref,paraloc1);
  1480. paramanager.freeparaloc(list,paraloc1);
  1481. paramanager.freeparaloc(list,paraloc2);
  1482. allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1483. a_call_name(list,'FPC_FINALIZE');
  1484. deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1485. end;
  1486. end;
  1487. procedure tcg.g_rangecheck(list: taasmoutput; const l:tlocation;fromdef,todef: tdef);
  1488. { generate range checking code for the value at location p. The type }
  1489. { type used is checked against todefs ranges. fromdef (p.resulttype.def) }
  1490. { is the original type used at that location. When both defs are equal }
  1491. { the check is also insert (needed for succ,pref,inc,dec) }
  1492. const
  1493. {$ifdef ver1_0}
  1494. awordsignedmax=high(longint);
  1495. {$else}
  1496. awordsignedmax=high(aword) div 2;
  1497. {$endif}
  1498. var
  1499. neglabel : tasmlabel;
  1500. hreg : tregister;
  1501. lto,hto,
  1502. lfrom,hfrom : TConstExprInt;
  1503. from_signed: boolean;
  1504. begin
  1505. { range checking on and range checkable value? }
  1506. if not(cs_check_range in aktlocalswitches) or
  1507. not(fromdef.deftype in [orddef,enumdef,arraydef]) then
  1508. exit;
  1509. if is_64bit(fromdef) or is_64bit(todef) then
  1510. begin
  1511. cg64.g_rangecheck64(list,l,fromdef,todef);
  1512. exit;
  1513. end;
  1514. { only check when assigning to scalar, subranges are different, }
  1515. { when todef=fromdef then the check is always generated }
  1516. getrange(fromdef,lfrom,hfrom);
  1517. getrange(todef,lto,hto);
  1518. { no range check if from and to are equal and are both longint/dword }
  1519. { (if we have a 32bit processor) or int64/qword, since such }
  1520. { operations can at most cause overflows (JM) }
  1521. { Note that these checks are mostly processor independent, they only }
  1522. { have to be changed once we introduce 64bit subrange types }
  1523. {$warning range check still s32bit}
  1524. if (fromdef = todef) and
  1525. (fromdef.deftype=orddef) and
  1526. (((sizeof(aword) = 4) and
  1527. (((torddef(fromdef).typ = s32bit) and
  1528. (lfrom = low(longint)) and
  1529. (hfrom = high(longint))) or
  1530. ((torddef(fromdef).typ = u32bit) and
  1531. (lfrom = low(cardinal)) and
  1532. (hfrom = high(cardinal)))))) then
  1533. exit;
  1534. if todef<>fromdef then
  1535. begin
  1536. { if the from-range falls completely in the to-range, no check }
  1537. { is necessary }
  1538. if (lto<=lfrom) and (hto>=hfrom) then
  1539. exit;
  1540. end;
  1541. { generate the rangecheck code for the def where we are going to }
  1542. { store the result }
  1543. { use the trick that }
  1544. { a <= x <= b <=> 0 <= x-a <= b-a <=> unsigned(x-a) <= unsigned(b-a) }
  1545. { To be able to do that, we have to make sure however that either }
  1546. { fromdef and todef are both signed or unsigned, or that we leave }
  1547. { the parts < 0 and > maxlongint out }
  1548. { is_signed now also works for arrays (it checks the rangetype) (JM) }
  1549. from_signed := is_signed(fromdef);
  1550. if from_signed xor is_signed(todef) then
  1551. if from_signed then
  1552. { from is signed, to is unsigned }
  1553. begin
  1554. { if high(from) < 0 -> always range error }
  1555. if (hfrom < 0) or
  1556. { if low(to) > maxlongint also range error }
  1557. (lto > awordsignedmax) then
  1558. begin
  1559. a_call_name(list,'FPC_RANGEERROR');
  1560. exit
  1561. end;
  1562. { from is signed and to is unsigned -> when looking at from }
  1563. { as an unsigned value, it must be < maxlongint (otherwise }
  1564. { it's negative, which is invalid since "to" is unsigned) }
  1565. if hto > awordsignedmax then
  1566. hto := awordsignedmax;
  1567. end
  1568. else
  1569. { from is unsigned, to is signed }
  1570. begin
  1571. if (lfrom > awordsignedmax) or
  1572. (hto < 0) then
  1573. begin
  1574. a_call_name(list,'FPC_RANGEERROR');
  1575. exit
  1576. end;
  1577. { from is unsigned and to is signed -> when looking at to }
  1578. { as an unsigned value, it must be >= 0 (since negative }
  1579. { values are the same as values > maxlongint) }
  1580. if lto < 0 then
  1581. lto := 0;
  1582. end;
  1583. hreg:=getintregister(list,OS_INT);
  1584. a_load_loc_reg(list,OS_INT,l,hreg);
  1585. a_op_const_reg(list,OP_SUB,OS_INT,aword(lto),hreg);
  1586. objectlibrary.getlabel(neglabel);
  1587. a_cmp_const_reg_label(list,OS_INT,OC_BE,aword(hto-lto),hreg,neglabel);
  1588. { !!! should happen right after the compare (JM) }
  1589. ungetregister(list,hreg);
  1590. a_call_name(list,'FPC_RANGEERROR');
  1591. a_label(list,neglabel);
  1592. end;
  1593. procedure tcg.g_flags2ref(list: taasmoutput; size: TCgSize; const f: tresflags; const ref:TReference);
  1594. var
  1595. tmpreg : tregister;
  1596. begin
  1597. tmpreg:=getintregister(list,size);
  1598. g_flags2reg(list,size,f,tmpreg);
  1599. a_load_reg_ref(list,size,size,tmpreg,ref);
  1600. ungetregister(list,tmpreg);
  1601. end;
  1602. procedure tcg.g_maybe_testself(list : taasmoutput;reg:tregister);
  1603. var
  1604. OKLabel : tasmlabel;
  1605. paraloc1 : tparalocation;
  1606. begin
  1607. if (cs_check_object in aktlocalswitches) or
  1608. (cs_check_range in aktlocalswitches) then
  1609. begin
  1610. objectlibrary.getlabel(oklabel);
  1611. a_cmp_const_reg_label(list,OS_ADDR,OC_NE,0,reg,oklabel);
  1612. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  1613. paramanager.allocparaloc(list,paraloc1);
  1614. a_param_const(list,OS_INT,210,paraloc1);
  1615. paramanager.freeparaloc(list,paraloc1);
  1616. a_call_name(list,'FPC_HANDLEERROR');
  1617. a_label(list,oklabel);
  1618. end;
  1619. end;
  1620. procedure tcg.g_maybe_testvmt(list : taasmoutput;reg:tregister;objdef:tobjectdef);
  1621. var
  1622. hrefvmt : treference;
  1623. paraloc1,paraloc2 : tparalocation;
  1624. begin
  1625. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  1626. paraloc2:=paramanager.getintparaloc(pocall_default,2);
  1627. if (cs_check_object in aktlocalswitches) then
  1628. begin
  1629. reference_reset_symbol(hrefvmt,objectlibrary.newasmsymbol(objdef.vmt_mangledname,AB_EXTERNAL,AT_DATA),0);
  1630. paramanager.allocparaloc(list,paraloc2);
  1631. a_paramaddr_ref(list,hrefvmt,paraloc2);
  1632. paramanager.allocparaloc(list,paraloc1);
  1633. a_param_reg(list,OS_ADDR,reg,paraloc1);
  1634. paramanager.freeparaloc(list,paraloc1);
  1635. paramanager.freeparaloc(list,paraloc2);
  1636. { No register saving needed, saveregisters is used }
  1637. allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1638. a_call_name(list,'FPC_CHECK_OBJECT_EXT');
  1639. deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1640. end
  1641. else
  1642. if (cs_check_range in aktlocalswitches) then
  1643. begin
  1644. paramanager.allocparaloc(list,paraloc1);
  1645. a_param_reg(list,OS_ADDR,reg,paraloc1);
  1646. paramanager.freeparaloc(list,paraloc1);
  1647. { No register saving needed, saveregisters is used }
  1648. allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1649. a_call_name(list,'FPC_CHECK_OBJECT');
  1650. deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1651. end;
  1652. end;
  1653. {*****************************************************************************
  1654. Entry/Exit Code Functions
  1655. *****************************************************************************}
  1656. procedure tcg.g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:aword);
  1657. var
  1658. sizereg,sourcereg,destreg : tregister;
  1659. paraloc1,paraloc2,paraloc3 : tparalocation;
  1660. begin
  1661. { because ppc abi doesn't support dynamic stack allocation properly
  1662. open array value parameters are copied onto the heap
  1663. }
  1664. { allocate two registers for len and source }
  1665. sizereg:=getintregister(list,OS_INT);
  1666. sourcereg:=getintregister(list,OS_ADDR);
  1667. destreg:=getintregister(list,OS_ADDR);
  1668. { calculate necessary memory }
  1669. a_load_ref_reg(list,OS_INT,OS_INT,lenref,sizereg);
  1670. a_op_const_reg(list,OP_ADD,OS_INT,1,sizereg);
  1671. a_op_const_reg(list,OP_MUL,OS_INT,elesize,sizereg);
  1672. { load source }
  1673. a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,sourcereg);
  1674. { do getmem call }
  1675. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  1676. paramanager.allocparaloc(list,paraloc1);
  1677. a_param_reg(list,OS_INT,sizereg,paraloc1);
  1678. paramanager.freeparaloc(list,paraloc1);
  1679. allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1680. a_call_name(list,'FPC_GETMEM');
  1681. deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1682. a_load_reg_reg(list,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,destreg);
  1683. a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,ref);
  1684. { do move call }
  1685. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  1686. paraloc2:=paramanager.getintparaloc(pocall_default,2);
  1687. paraloc3:=paramanager.getintparaloc(pocall_default,3);
  1688. { load size }
  1689. paramanager.allocparaloc(list,paraloc3);
  1690. a_param_reg(list,OS_INT,sizereg,paraloc3);
  1691. { load destination }
  1692. paramanager.allocparaloc(list,paraloc2);
  1693. a_param_reg(list,OS_ADDR,destreg,paraloc2);
  1694. { load source }
  1695. paramanager.allocparaloc(list,paraloc1);
  1696. a_param_reg(list,OS_ADDR,sourcereg,paraloc1);
  1697. paramanager.freeparaloc(list,paraloc3);
  1698. paramanager.freeparaloc(list,paraloc2);
  1699. paramanager.freeparaloc(list,paraloc1);
  1700. allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1701. a_call_name(list,'FPC_MOVE');
  1702. deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1703. { release used registers }
  1704. ungetregister(list,sizereg);
  1705. ungetregister(list,sourcereg);
  1706. ungetregister(list,destreg);
  1707. end;
  1708. procedure tcg.g_releasevaluepara_openarray(list : taasmoutput;const ref:treference);
  1709. var
  1710. paraloc : tparalocation;
  1711. begin
  1712. { do move call }
  1713. paraloc:=paramanager.getintparaloc(pocall_default,1);
  1714. { load source }
  1715. paramanager.allocparaloc(list,paraloc);
  1716. a_param_ref(list,OS_ADDR,ref,paraloc);
  1717. paramanager.freeparaloc(list,paraloc);
  1718. allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1719. a_call_name(list,'FPC_FREEMEM');
  1720. deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1721. end;
  1722. procedure tcg.g_interrupt_stackframe_entry(list : taasmoutput);
  1723. begin
  1724. end;
  1725. procedure tcg.g_interrupt_stackframe_exit(list : taasmoutput;accused,acchiused:boolean);
  1726. begin
  1727. end;
  1728. procedure tcg.g_profilecode(list : taasmoutput);
  1729. begin
  1730. end;
  1731. procedure tcg.g_exception_reason_save(list : taasmoutput; const href : treference);
  1732. begin
  1733. a_load_reg_ref(list, OS_S32, OS_32, NR_FUNCTION_RETURN_REG, href);
  1734. end;
  1735. procedure tcg.g_exception_reason_save_const(list : taasmoutput; const href : treference; a: aword);
  1736. begin
  1737. a_load_const_ref(list, OS_S32, a, href);
  1738. end;
  1739. procedure tcg.g_exception_reason_load(list : taasmoutput; const href : treference);
  1740. begin
  1741. a_load_ref_reg(list, OS_S32, OS_S32, href, NR_FUNCTION_RETURN_REG);
  1742. end;
  1743. {*****************************************************************************
  1744. TCG64
  1745. *****************************************************************************}
  1746. procedure tcg64.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : qword; regsrc,regdst : tregister64);
  1747. begin
  1748. a_load64_reg_reg(list,regsrc,regdst);
  1749. a_op64_const_reg(list,op,value,regdst);
  1750. end;
  1751. procedure tcg64.a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64);
  1752. begin
  1753. a_load64_reg_reg(list,regsrc2,regdst);
  1754. a_op64_reg_reg(list,op,regsrc1,regdst);
  1755. end;
  1756. {****************************************************************************
  1757. TReference
  1758. ****************************************************************************}
  1759. procedure reference_release(list: taasmoutput; const ref : treference);
  1760. begin
  1761. cg.ungetreference(list,ref);
  1762. end;
  1763. {****************************************************************************
  1764. TLocation
  1765. ****************************************************************************}
  1766. procedure location_reset(var l : tlocation;lt:TCGLoc;lsize:TCGSize);
  1767. begin
  1768. FillChar(l,sizeof(tlocation),0);
  1769. l.loc:=lt;
  1770. l.size:=lsize;
  1771. {$ifdef arm}
  1772. if l.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
  1773. l.reference.signindex:=1;
  1774. {$endif arm}
  1775. end;
  1776. procedure location_release(list: taasmoutput; const l : tlocation);
  1777. begin
  1778. case l.loc of
  1779. LOC_REGISTER,LOC_CREGISTER :
  1780. begin
  1781. cg.ungetregister(list,l.register);
  1782. {$ifndef cpu64bit}
  1783. if l.size in [OS_64,OS_S64] then
  1784. cg.ungetregister(list,l.registerhigh);
  1785. {$endif cpu64bit}
  1786. end;
  1787. LOC_FPUREGISTER,LOC_CFPUREGISTER :
  1788. cg.ungetregister(list,l.register);
  1789. LOC_CREFERENCE,LOC_REFERENCE :
  1790. cg.ungetreference(list, l.reference);
  1791. end;
  1792. end;
  1793. procedure location_freetemp(list:taasmoutput; const l : tlocation);
  1794. begin
  1795. if (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  1796. tg.ungetiftemp(list,l.reference);
  1797. end;
  1798. procedure location_copy(var destloc:tlocation; const sourceloc : tlocation);
  1799. begin
  1800. destloc:=sourceloc;
  1801. end;
  1802. procedure location_swap(var destloc,sourceloc : tlocation);
  1803. var
  1804. swapl : tlocation;
  1805. begin
  1806. swapl := destloc;
  1807. destloc := sourceloc;
  1808. sourceloc := swapl;
  1809. end;
  1810. initialization
  1811. ;
  1812. finalization
  1813. cg.free;
  1814. cg64.free;
  1815. end.
  1816. {
  1817. $Log$
  1818. Revision 1.160 2004-03-02 00:36:33 olle
  1819. * big transformation of Tai_[const_]Symbol.Create[data]name*
  1820. Revision 1.159 2004/02/27 10:21:05 florian
  1821. * top_symbol killed
  1822. + refaddr to treference added
  1823. + refsymbol to treference added
  1824. * top_local stuff moved to an extra record to save memory
  1825. + aint introduced
  1826. * tppufile.get/putint64/aint implemented
  1827. Revision 1.158 2004/02/20 22:16:34 florian
  1828. * handling of float parameters passed in mm registers fixed
  1829. Revision 1.157 2004/02/12 15:54:03 peter
  1830. * make extcycle is working again
  1831. Revision 1.156 2004/02/08 18:08:59 jonas
  1832. * fixed regvars support. Needs -doldregvars to activate. Only tested with
  1833. ppc, other processors should however only require maxregvars and
  1834. maxfpuregvars constants in cpubase.pas. Remember to take scratch-
  1835. registers into account when defining that value.
  1836. Revision 1.155 2004/02/04 22:01:13 peter
  1837. * first try to get cpupara working for x86_64
  1838. Revision 1.154 2004/02/03 22:32:53 peter
  1839. * renamed xNNbittype to xNNinttype
  1840. * renamed registers32 to registersint
  1841. * replace some s32bit,u32bit with torddef([su]inttype).def.typ
  1842. Revision 1.153 2004/01/31 17:45:17 peter
  1843. * Change several $ifdef i386 to x86
  1844. * Change several OS_32 to OS_INT/OS_ADDR
  1845. Revision 1.152 2004/01/22 22:12:21 peter
  1846. * g_finalize needs to reset to nil after decr_ref
  1847. * support loadref in decr_ref reset to nil
  1848. Revision 1.151 2004/01/21 22:13:20 peter
  1849. * decrrefcount resets temps to nil
  1850. Revision 1.150 2004/01/21 21:01:34 peter
  1851. * fixed stackchecking for register calling
  1852. Revision 1.149 2004/01/20 12:59:36 florian
  1853. * common addnode code for x86-64 and i386
  1854. Revision 1.148 2004/01/12 22:11:38 peter
  1855. * use localalign info for alignment for locals and temps
  1856. * sparc fpu flags branching added
  1857. * moved powerpc copy_valye_openarray to generic
  1858. Revision 1.147 2004/01/11 23:56:19 daniel
  1859. * Experiment: Compress strings to save memory
  1860. Did not save a single byte of mem; clearly the core size is boosted by
  1861. temporary memory usage...
  1862. Revision 1.146 2003/12/26 14:02:30 peter
  1863. * sparc updates
  1864. * use registertype in spill_register
  1865. Revision 1.145 2003/12/26 13:19:16 florian
  1866. * rtl and compiler compile with -Cfsse2
  1867. Revision 1.144 2003/12/24 00:10:02 florian
  1868. - delete parameter in cg64 methods removed
  1869. Revision 1.143 2003/12/23 14:38:07 florian
  1870. + second_floataddsse implemented
  1871. Revision 1.142 2003/12/22 19:00:17 florian
  1872. * fixed some x86-64 issues
  1873. Revision 1.141 2003/12/21 19:42:42 florian
  1874. * fixed ppc inlining stuff
  1875. * fixed wrong unit writing
  1876. + added some sse stuff
  1877. Revision 1.140 2003/12/15 21:39:39 florian
  1878. * improved register allocation of generic a_param_const and a_param_ref
  1879. Revision 1.139 2003/12/15 21:25:48 peter
  1880. * reg allocations for imaginary register are now inserted just
  1881. before reg allocation
  1882. * tregister changed to enum to allow compile time check
  1883. * fixed several tregister-tsuperregister errors
  1884. Revision 1.138 2003/12/12 17:16:17 peter
  1885. * rg[tregistertype] added in tcg
  1886. Revision 1.137 2003/12/06 22:11:47 jonas
  1887. + allocate volatile registers around calls to procedures declared with
  1888. "saveregisters" on non-x86 processors
  1889. Revision 1.136 2003/12/06 01:15:22 florian
  1890. * reverted Peter's alloctemp patch; hopefully properly
  1891. Revision 1.135 2003/12/03 23:13:19 peter
  1892. * delayed paraloc allocation, a_param_*() gets extra parameter
  1893. if it needs to allocate temp or real paralocation
  1894. * optimized/simplified int-real loading
  1895. Revision 1.134 2003/11/05 23:05:13 florian
  1896. * elesize of g_copyvaluepara_openarray changed
  1897. + g_releaesvaluepara_openarray added
  1898. Revision 1.133 2003/10/19 01:34:30 florian
  1899. * some ppc stuff fixed
  1900. * memory leak fixed
  1901. Revision 1.132 2003/10/17 15:25:18 florian
  1902. * fixed more ppc stuff
  1903. Revision 1.131 2003/10/17 14:38:32 peter
  1904. * 64k registers supported
  1905. * fixed some memory leaks
  1906. Revision 1.130 2003/10/13 01:23:13 florian
  1907. * some ideas for mm support implemented
  1908. Revision 1.129 2003/10/11 16:06:42 florian
  1909. * fixed some MMX<->SSE
  1910. * started to fix ppc, needs an overhaul
  1911. + stabs info improve for spilling, not sure if it works correctly/completly
  1912. - MMX_SUPPORT removed from Makefile.fpc
  1913. Revision 1.128 2003/10/10 17:48:13 peter
  1914. * old trgobj moved to x86/rgcpu and renamed to trgx86fpu
  1915. * tregisteralloctor renamed to trgobj
  1916. * removed rgobj from a lot of units
  1917. * moved location_* and reference_* to cgobj
  1918. * first things for mmx register allocation
  1919. Revision 1.127 2003/10/09 21:31:37 daniel
  1920. * Register allocator splitted, ans abstract now
  1921. Revision 1.126 2003/10/01 20:34:48 peter
  1922. * procinfo unit contains tprocinfo
  1923. * cginfo renamed to cgbase
  1924. * moved cgmessage to verbose
  1925. * fixed ppc and sparc compiles
  1926. Revision 1.125 2003/09/28 17:55:03 peter
  1927. * parent framepointer changed to hidden parameter
  1928. * tloadparentfpnode added
  1929. Revision 1.124 2003/09/28 13:40:13 peter
  1930. * a_call_ref removed
  1931. Revision 1.123 2003/09/25 21:26:24 peter
  1932. * remove obsolete tparalocation.sp_fixup
  1933. Revision 1.122 2003/09/23 20:37:16 peter
  1934. * fpc_check_object(_ext) has saveregisters and doesn't need
  1935. saving of registers
  1936. Revision 1.121 2003/09/10 08:31:47 marco
  1937. * Patch from Peter for paraloc
  1938. Revision 1.120 2003/09/09 20:59:27 daniel
  1939. * Adding register allocation order
  1940. Revision 1.119 2003/09/07 22:09:34 peter
  1941. * preparations for different default calling conventions
  1942. * various RA fixes
  1943. Revision 1.118 2003/09/03 15:55:00 peter
  1944. * NEWRA branch merged
  1945. Revision 1.117 2003/09/03 11:18:36 florian
  1946. * fixed arm concatcopy
  1947. + arm support in the common compiler sources added
  1948. * moved some generic cg code around
  1949. + tfputype added
  1950. * ...
  1951. Revision 1.116.2.4 2003/08/29 17:28:59 peter
  1952. * next batch of updates
  1953. Revision 1.116.2.3 2003/08/28 18:35:07 peter
  1954. * tregister changed to cardinal
  1955. Revision 1.116.2.2 2003/08/27 20:23:55 peter
  1956. * remove old ra code
  1957. Revision 1.116.2.1 2003/08/27 19:55:54 peter
  1958. * first tregister patch
  1959. Revision 1.116 2003/08/17 16:59:20 jonas
  1960. * fixed regvars so they work with newra (at least for ppc)
  1961. * fixed some volatile register bugs
  1962. + -dnotranslation option for -dnewra, which causes the registers not to
  1963. be translated from virtual to normal registers. Requires support in
  1964. the assembler writer as well, which is only implemented in aggas/
  1965. agppcgas currently
  1966. Revision 1.115 2003/07/23 11:01:14 jonas
  1967. * several rg.allocexplicitregistersint/rg.deallocexplicitregistersint
  1968. pairs round calls to helpers
  1969. Revision 1.114 2003/07/06 17:58:22 peter
  1970. * framepointer fixes for sparc
  1971. * parent framepointer code more generic
  1972. Revision 1.113 2003/07/02 22:18:04 peter
  1973. * paraloc splitted in callerparaloc,calleeparaloc
  1974. * sparc calling convention updates
  1975. Revision 1.112 2003/06/13 21:19:30 peter
  1976. * current_procdef removed, use current_procinfo.procdef instead
  1977. Revision 1.111 2003/06/12 21:11:10 peter
  1978. * ungetregisterfpu gets size parameter
  1979. Revision 1.110 2003/06/12 16:43:07 peter
  1980. * newra compiles for sparc
  1981. Revision 1.109 2003/06/07 18:57:04 jonas
  1982. + added freeintparaloc
  1983. * ppc get/freeintparaloc now check whether the parameter regs are
  1984. properly allocated/deallocated (and get an extra list para)
  1985. * ppc a_call_* now internalerrors if pi_do_call is not yet set
  1986. * fixed lot of missing pi_do_call's
  1987. Revision 1.108 2003/06/06 14:43:02 peter
  1988. * g_copyopenarrayvalue gets length reference
  1989. * don't copy open arrays for cdecl
  1990. Revision 1.107 2003/06/03 21:11:09 peter
  1991. * cg.a_load_* get a from and to size specifier
  1992. * makeregsize only accepts newregister
  1993. * i386 uses generic tcgnotnode,tcgunaryminus
  1994. Revision 1.106 2003/06/03 13:01:59 daniel
  1995. * Register allocator finished
  1996. Revision 1.105 2003/06/01 21:38:06 peter
  1997. * getregisterfpu size parameter added
  1998. * op_const_reg size parameter added
  1999. * sparc updates
  2000. Revision 1.104 2003/06/01 01:02:39 peter
  2001. * generic a_call_ref
  2002. Revision 1.103 2003/05/30 23:57:08 peter
  2003. * more sparc cleanup
  2004. * accumulator removed, splitted in function_return_reg (called) and
  2005. function_result_reg (caller)
  2006. Revision 1.102 2003/05/30 23:49:18 jonas
  2007. * a_load_loc_reg now has an extra size parameter for the destination
  2008. register (properly fixes what I worked around in revision 1.106 of
  2009. ncgutil.pas)
  2010. Revision 1.101 2003/05/30 21:40:00 jonas
  2011. * fixed bug in a_load_loc_ref (the source instead of dest size was passed
  2012. to a_load_reg_ref in case of a register)
  2013. Revision 1.100 2003/05/30 12:36:13 jonas
  2014. * use as little different registers on the ppc until newra is released,
  2015. since every used register must be saved
  2016. Revision 1.99 2003/05/23 14:27:35 peter
  2017. * remove some unit dependencies
  2018. * current_procinfo changes to store more info
  2019. Revision 1.98 2003/05/15 18:58:53 peter
  2020. * removed selfpointer_offset, vmtpointer_offset
  2021. * tvarsym.adjusted_address
  2022. * address in localsymtable is now in the real direction
  2023. * removed some obsolete globals
  2024. Revision 1.97 2003/05/13 19:14:41 peter
  2025. * failn removed
  2026. * inherited result code check moven to pexpr
  2027. Revision 1.96 2003/05/11 21:37:03 peter
  2028. * moved implicit exception frame from ncgutil to psub
  2029. * constructor/destructor helpers moved from cobj/ncgutil to psub
  2030. Revision 1.95 2003/05/09 17:47:02 peter
  2031. * self moved to hidden parameter
  2032. * removed hdisposen,hnewn,selfn
  2033. Revision 1.94 2003/05/01 12:23:46 jonas
  2034. * fix for op_reg_reg_reg in case the destination is the same as the first
  2035. source register
  2036. Revision 1.93 2003/04/29 07:28:52 michael
  2037. + Patch from peter to fix wrong pushing of ansistring function results in open array
  2038. Revision 1.92 2003/04/27 11:21:32 peter
  2039. * aktprocdef renamed to current_procinfo.procdef
  2040. * procinfo renamed to current_procinfo
  2041. * procinfo will now be stored in current_module so it can be
  2042. cleaned up properly
  2043. * gen_main_procsym changed to create_main_proc and release_main_proc
  2044. to also generate a tprocinfo structure
  2045. * fixed unit implicit initfinal
  2046. Revision 1.91 2003/04/27 07:29:50 peter
  2047. * current_procinfo.procdef cleanup, current_procdef is now always nil when parsing
  2048. a new procdef declaration
  2049. * aktprocsym removed
  2050. * lexlevel removed, use symtable.symtablelevel instead
  2051. * implicit init/final code uses the normal genentry/genexit
  2052. * funcret state checking updated for new funcret handling
  2053. Revision 1.90 2003/04/26 20:57:17 florian
  2054. * fixed para locations of fpc_class_new helper call
  2055. Revision 1.89 2003/04/26 17:21:08 florian
  2056. * fixed passing of fpu values by fpu register
  2057. Revision 1.88 2003/04/23 20:16:03 peter
  2058. + added currency support based on int64
  2059. + is_64bit for use in cg units instead of is_64bitint
  2060. * removed cgmessage from n386add, replace with internalerrors
  2061. Revision 1.87 2003/04/23 14:42:07 daniel
  2062. * Further register allocator work. Compiler now smaller with new
  2063. allocator than without.
  2064. * Somebody forgot to adjust ppu version number
  2065. Revision 1.86 2003/04/23 13:20:34 peter
  2066. * fix self passing to fpc_help_fail
  2067. Revision 1.85 2003/04/23 12:35:34 florian
  2068. * fixed several issues with powerpc
  2069. + applied a patch from Jonas for nested function calls (PowerPC only)
  2070. * ...
  2071. Revision 1.84 2003/04/22 14:33:38 peter
  2072. * removed some notes/hints
  2073. Revision 1.83 2003/04/22 13:47:08 peter
  2074. * fixed C style array of const
  2075. * fixed C array passing
  2076. * fixed left to right with high parameters
  2077. Revision 1.82 2003/04/22 10:09:34 daniel
  2078. + Implemented the actual register allocator
  2079. + Scratch registers unavailable when new register allocator used
  2080. + maybe_save/maybe_restore unavailable when new register allocator used
  2081. Revision 1.81 2003/04/06 21:11:23 olle
  2082. * changed newasmsymbol to newasmsymboldata for data symbols
  2083. Revision 1.80 2003/03/28 19:16:56 peter
  2084. * generic constructor working for i386
  2085. * remove fixed self register
  2086. * esi added as address register for i386
  2087. Revision 1.79 2003/03/22 18:07:18 jonas
  2088. + add used scratch registers to usedintbyproc for non-i386
  2089. Revision 1.78 2003/03/11 21:46:24 jonas
  2090. * lots of new regallocator fixes, both in generic and ppc-specific code
  2091. (ppc compiler still can't compile the linux system unit though)
  2092. Revision 1.77 2003/02/19 22:00:14 daniel
  2093. * Code generator converted to new register notation
  2094. - Horribily outdated todo.txt removed
  2095. Revision 1.76 2003/01/31 22:47:48 peter
  2096. * maybe_testself now really uses the passed register
  2097. Revision 1.75 2003/01/30 21:46:35 peter
  2098. * maybe_testvmt added
  2099. Revision 1.74 2003/01/17 12:45:40 daniel
  2100. * Fixed internalerror 200301081 problem
  2101. Revision 1.73 2003/01/13 14:54:34 daniel
  2102. * Further work to convert codegenerator register convention;
  2103. internalerror bug fixed.
  2104. Revision 1.72 2003/01/09 22:00:53 florian
  2105. * fixed some PowerPC issues
  2106. Revision 1.71 2003/01/09 20:41:10 florian
  2107. * fixed broken PowerPC compiler
  2108. Revision 1.70 2003/01/08 18:43:56 daniel
  2109. * Tregister changed into a record
  2110. Revision 1.69 2002/12/24 15:56:50 peter
  2111. * stackpointer_alloc added for adjusting ESP. Win32 needs
  2112. this for the pageprotection
  2113. Revision 1.68 2002/12/20 18:14:04 peter
  2114. * removed some runerror and writeln
  2115. Revision 1.67 2002/12/14 15:02:03 carl
  2116. * maxoperands -> max_operands (for portability in rautils.pas)
  2117. * fix some range-check errors with loadconst
  2118. + add ncgadd unit to m68k
  2119. * some bugfix of a_param_reg with LOC_CREFERENCE
  2120. Revision 1.66 2002/11/25 17:43:16 peter
  2121. * splitted defbase in defutil,symutil,defcmp
  2122. * merged isconvertable and is_equal into compare_defs(_ext)
  2123. * made operator search faster by walking the list only once
  2124. Revision 1.65 2002/11/17 16:27:31 carl
  2125. * document flags2reg
  2126. Revision 1.64 2002/11/16 17:06:28 peter
  2127. * return error 210 for failed self test
  2128. Revision 1.63 2002/11/15 01:58:46 peter
  2129. * merged changes from 1.0.7 up to 04-11
  2130. - -V option for generating bug report tracing
  2131. - more tracing for option parsing
  2132. - errors for cdecl and high()
  2133. - win32 import stabs
  2134. - win32 records<=8 are returned in eax:edx (turned off by default)
  2135. - heaptrc update
  2136. - more info for temp management in .s file with EXTDEBUG
  2137. Revision 1.62 2002/10/16 19:01:43 peter
  2138. + $IMPLICITEXCEPTIONS switch to turn on/off generation of the
  2139. implicit exception frames for procedures with initialized variables
  2140. and for constructors. The default is on for compatibility
  2141. Revision 1.61 2002/10/05 12:43:23 carl
  2142. * fixes for Delphi 6 compilation
  2143. (warning : Some features do not work under Delphi)
  2144. Revision 1.60 2002/10/02 18:20:52 peter
  2145. * Copy() is now internal syssym that calls compilerprocs
  2146. Revision 1.59 2002/09/17 18:54:02 jonas
  2147. * a_load_reg_reg() now has two size parameters: source and dest. This
  2148. allows some optimizations on architectures that don't encode the
  2149. register size in the register name.
  2150. Revision 1.58 2002/09/09 19:29:29 peter
  2151. * fixed dynarr_decr_ref call
  2152. Revision 1.57 2002/09/07 15:25:01 peter
  2153. * old logs removed and tabs fixed
  2154. Revision 1.56 2002/09/01 21:04:47 florian
  2155. * several powerpc related stuff fixed
  2156. Revision 1.55 2002/09/01 17:05:43 florian
  2157. + added abstract tcg.g_removevaluepara_openarray
  2158. Revision 1.54 2002/09/01 12:09:27 peter
  2159. + a_call_reg, a_call_loc added
  2160. * removed exprasmlist references
  2161. Revision 1.53 2002/08/19 18:17:48 carl
  2162. + optimize64_op_const_reg implemented (optimizes 64-bit constant opcodes)
  2163. * more fixes to m68k for 64-bit operations
  2164. Revision 1.52 2002/08/17 22:09:43 florian
  2165. * result type handling in tcgcal.pass_2 overhauled
  2166. * better tnode.dowrite
  2167. * some ppc stuff fixed
  2168. Revision 1.51 2002/08/17 09:23:33 florian
  2169. * first part of procinfo rewrite
  2170. Revision 1.50 2002/08/16 14:24:57 carl
  2171. * issameref() to test if two references are the same (then emit no opcodes)
  2172. + ret_in_reg to replace ret_in_acc
  2173. (fix some register allocation bugs at the same time)
  2174. + save_std_register now has an extra parameter which is the
  2175. usedinproc registers
  2176. Revision 1.49 2002/08/15 08:13:54 carl
  2177. - a_load_sym_ofs_reg removed
  2178. * loadvmt now calls loadaddr_ref_reg instead
  2179. Revision 1.48 2002/08/14 19:26:02 carl
  2180. + routine to optimize opcodes with constants
  2181. Revision 1.47 2002/08/11 14:32:26 peter
  2182. * renamed current_library to objectlibrary
  2183. Revision 1.46 2002/08/11 13:24:11 peter
  2184. * saving of asmsymbols in ppu supported
  2185. * asmsymbollist global is removed and moved into a new class
  2186. tasmlibrarydata that will hold the info of a .a file which
  2187. corresponds with a single module. Added librarydata to tmodule
  2188. to keep the library info stored for the module. In the future the
  2189. objectfiles will also be stored to the tasmlibrarydata class
  2190. * all getlabel/newasmsymbol and friends are moved to the new class
  2191. Revision 1.45 2002/08/10 17:15:20 jonas
  2192. * register parameters are now LOC_CREGISTER instead of LOC_REGISTER
  2193. Revision 1.44 2002/08/09 19:10:05 carl
  2194. - moved new_exception and free_exception to ncgutils
  2195. Revision 1.43 2002/08/05 18:27:48 carl
  2196. + more more more documentation
  2197. + first version include/exclude (can't test though, not enough scratch for i386 :()...
  2198. Revision 1.42 2002/08/04 19:08:21 carl
  2199. + added generic exception support (still does not work!)
  2200. + more documentation
  2201. Revision 1.41 2002/07/30 20:50:43 florian
  2202. * the code generator knows now if parameters are in registers
  2203. Revision 1.40 2002/07/29 21:16:02 florian
  2204. * some more ppc fixes
  2205. Revision 1.39 2002/07/28 15:56:00 jonas
  2206. + tcg64.a_op64_const_reg_reg() and tcg64.a_op64_reg_reg_reg() methods +
  2207. generic implementation
  2208. Revision 1.38 2002/07/27 19:53:51 jonas
  2209. + generic implementation of tcg.g_flags2ref()
  2210. * tcg.flags2xxx() now also needs a size parameter
  2211. Revision 1.37 2002/07/20 11:57:53 florian
  2212. * types.pas renamed to defbase.pas because D6 contains a types
  2213. unit so this would conflicts if D6 programms are compiled
  2214. + Willamette/SSE2 instructions to assembler added
  2215. }