cgobj.pas 79 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953
  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. cclasses,aasmbase,aasmtai,aasmcpu,symtable,
  32. cpubase,cpuinfo,
  33. cginfo,
  34. symconst,symbase,symtype,symdef
  35. {$ifdef delphi}
  36. ,dmisc
  37. {$endif}
  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. alignment : talignment;
  50. {************************************************}
  51. { basic routines }
  52. constructor create;
  53. procedure init_register_allocators;virtual;abstract;
  54. procedure done_register_allocators;virtual;abstract;
  55. { returns the tcgsize corresponding with the size of reg }
  56. class function reg_cgsize(const reg: tregister) : tcgsize; virtual;
  57. {# Emit a label to the instruction stream. }
  58. procedure a_label(list : taasmoutput;l : tasmlabel);virtual;
  59. {# Allocates register r by inserting a pai_realloc record }
  60. procedure a_reg_alloc(list : taasmoutput;r : tregister);
  61. {# Deallocates register r by inserting a pa_regdealloc record}
  62. procedure a_reg_dealloc(list : taasmoutput;r : tregister);
  63. {# Pass a parameter, which is located in a register, to a routine.
  64. This routine should push/send the parameter to the routine, as
  65. required by the specific processor ABI and routine modifiers.
  66. This must be overriden for each CPU target.
  67. @param(size size of the operand in the register)
  68. @param(r register source of the operand)
  69. @param(locpara where the parameter will be stored)
  70. }
  71. procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const locpara : tparalocation);virtual;
  72. {# Pass a parameter, which is a constant, to a routine.
  73. A generic version is provided. This routine should
  74. be overriden for optimization purposes if the cpu
  75. permits directly sending this type of parameter.
  76. @param(size size of the operand in constant)
  77. @param(a value of constant to send)
  78. @param(locpara where the parameter will be stored)
  79. }
  80. procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;const locpara : tparalocation);virtual;
  81. {# Pass the value of a parameter, which is located in memory, to a routine.
  82. A generic version is provided. This routine should
  83. be overriden for optimization purposes if the cpu
  84. permits directly sending this type of parameter.
  85. @param(size size of the operand in constant)
  86. @param(r Memory reference of value to send)
  87. @param(locpara where the parameter will be stored)
  88. }
  89. procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const locpara : tparalocation);virtual;
  90. {# Pass the value of a parameter, which can be located either in a register or memory location,
  91. to a routine.
  92. A generic version is provided.
  93. @param(l location of the operand to send)
  94. @param(nr parameter number (starting from one) of routine (from left to right))
  95. @param(locpara where the parameter will be stored)
  96. }
  97. procedure a_param_loc(list : taasmoutput;const l : tlocation;const locpara : tparalocation);
  98. {# Pass the address of a reference to a routine. This routine
  99. will calculate the address of the reference, and pass this
  100. calculated address as a parameter.
  101. A generic version is provided. This routine should
  102. be overriden for optimization purposes if the cpu
  103. permits directly sending this type of parameter.
  104. @param(r reference to get address from)
  105. @param(nr parameter number (starting from one) of routine (from left to right))
  106. }
  107. procedure a_paramaddr_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);virtual;
  108. { Copies a whole memory block to the stack, the locpara must be a memory location }
  109. procedure a_param_copy_ref(list : taasmoutput;size : qword;const r : treference;const locpara : tparalocation);
  110. { Remarks:
  111. * If a method specifies a size you have only to take care
  112. of that number of bits, i.e. load_const_reg with OP_8 must
  113. only load the lower 8 bit of the specified register
  114. the rest of the register can be undefined
  115. if necessary the compiler will call a method
  116. to zero or sign extend the register
  117. * The a_load_XX_XX with OP_64 needn't to be
  118. implemented for 32 bit
  119. processors, the code generator takes care of that
  120. * the addr size is for work with the natural pointer
  121. size
  122. * the procedures without fpu/mm are only for integer usage
  123. * normally the first location is the source and the
  124. second the destination
  125. }
  126. { Copy a parameter to a (temporary) reference }
  127. procedure a_load_param_ref(list : taasmoutput;const locpara : tparalocation;const ref:treference);virtual;
  128. { Copy a parameter to a register }
  129. procedure a_load_param_reg(list : taasmoutput;const locpara : tparalocation;const reg:tregister);virtual;
  130. {# Emits instruction to call the method specified by symbol name.
  131. This routine must be overriden for each new target cpu.
  132. }
  133. procedure a_call_name(list : taasmoutput;const s : string);virtual; abstract;
  134. procedure a_call_ref(list : taasmoutput;const ref : treference);virtual;
  135. procedure a_call_reg(list : taasmoutput;reg : tregister);virtual;abstract;
  136. procedure a_call_loc(list : taasmoutput;const loc:tlocation);
  137. { move instructions }
  138. procedure a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister);virtual; abstract;
  139. procedure a_load_const_ref(list : taasmoutput;size : tcgsize;a : aword;const ref : treference);virtual;
  140. procedure a_load_const_loc(list : taasmoutput;a : aword;const loc : tlocation);
  141. procedure a_load_reg_ref(list : taasmoutput;fromsize,tosize : tcgsize;register : tregister;const ref : treference);virtual; abstract;
  142. procedure a_load_reg_reg(list : taasmoutput;fromsize,tosize : tcgsize;reg1,reg2 : tregister);virtual; abstract;
  143. procedure a_load_reg_loc(list : taasmoutput;fromsize : tcgsize;reg : tregister;const loc: tlocation);
  144. procedure a_load_ref_reg(list : taasmoutput;fromsize,tosize : tcgsize;const ref : treference;register : tregister);virtual; abstract;
  145. procedure a_load_ref_ref(list : taasmoutput;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);virtual;
  146. procedure a_load_loc_reg(list : taasmoutput;tosize: tcgsize; const loc: tlocation; reg : tregister);
  147. procedure a_load_loc_ref(list : taasmoutput;tosize: tcgsize; const loc: tlocation; const ref : treference);
  148. procedure a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);virtual; abstract;
  149. { fpu move instructions }
  150. procedure a_loadfpu_reg_reg(list: taasmoutput; size:tcgsize; reg1, reg2: tregister); virtual; abstract;
  151. procedure a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister); virtual; abstract;
  152. procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); virtual; abstract;
  153. procedure a_loadfpu_loc_reg(list: taasmoutput; const loc: tlocation; const reg: tregister);
  154. procedure a_loadfpu_reg_loc(list: taasmoutput; size: tcgsize; const reg: tregister; const loc: tlocation);
  155. procedure a_paramfpu_reg(list : taasmoutput;size : tcgsize;const r : tregister;const locpara : tparalocation);virtual;
  156. procedure a_paramfpu_ref(list : taasmoutput;size : tcgsize;const ref : treference;const locpara : tparalocation);virtual;
  157. { vector register move instructions }
  158. procedure a_loadmm_reg_reg(list: taasmoutput; reg1, reg2: tregister); virtual; abstract;
  159. procedure a_loadmm_ref_reg(list: taasmoutput; const ref: treference; reg: tregister); virtual; abstract;
  160. procedure a_loadmm_reg_ref(list: taasmoutput; reg: tregister; const ref: treference); virtual; abstract;
  161. procedure a_parammm_reg(list: taasmoutput; reg: tregister); virtual; abstract;
  162. { basic arithmetic operations }
  163. { note: for operators which require only one argument (not, neg), use }
  164. { the op_reg_reg, op_reg_ref or op_reg_loc methods and keep in mind }
  165. { that in this case the *second* operand is used as both source and }
  166. { destination (JM) }
  167. procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; reg: TRegister); virtual; abstract;
  168. procedure a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const ref: TReference); virtual;
  169. procedure a_op_const_loc(list : taasmoutput; Op: TOpCG; a: AWord; const loc: tlocation);
  170. procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); virtual; abstract;
  171. procedure a_op_reg_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; reg: TRegister; const ref: TReference); virtual;
  172. procedure a_op_ref_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); virtual;
  173. procedure a_op_reg_loc(list : taasmoutput; Op: TOpCG; reg: tregister; const loc: tlocation);
  174. procedure a_op_ref_loc(list : taasmoutput; Op: TOpCG; const ref: TReference; const loc: tlocation);
  175. { trinary operations for processors that support them, 'emulated' }
  176. { on others. None with "ref" arguments since I don't think there }
  177. { are any processors that support it (JM) }
  178. procedure a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
  179. size: tcgsize; a: aword; src, dst: tregister); virtual;
  180. procedure a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
  181. size: tcgsize; src1, src2, dst: tregister); virtual;
  182. { comparison operations }
  183. procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
  184. l : tasmlabel);virtual; abstract;
  185. procedure a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference;
  186. l : tasmlabel); virtual;
  187. procedure a_cmp_const_loc_label(list: taasmoutput; size: tcgsize;cmp_op: topcmp; a: aword; const loc: tlocation;
  188. l : tasmlabel);
  189. procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); virtual; abstract;
  190. procedure a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const ref: treference; reg : tregister; l : tasmlabel); virtual;
  191. procedure a_cmp_loc_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const loc: tlocation; reg : tregister; l : tasmlabel);
  192. procedure a_cmp_ref_loc_label(list: taasmoutput; size: tcgsize;cmp_op: topcmp; const ref: treference; const loc: tlocation;
  193. l : tasmlabel);
  194. procedure a_jmp_always(list : taasmoutput;l: tasmlabel); virtual; abstract;
  195. procedure a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); virtual; abstract;
  196. {# Depending on the value to check in the flags, either sets the register reg to one (if the flag is set)
  197. or zero (if the flag is cleared). The size parameter indicates the destination size register.
  198. }
  199. procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: tresflags; reg: TRegister); virtual; abstract;
  200. procedure g_flags2ref(list: taasmoutput; size: TCgSize; const f: tresflags; const ref:TReference); virtual;
  201. {
  202. This routine tries to optimize the const_reg opcode, and should be
  203. called at the start of a_op_const_reg. It returns the actual opcode
  204. to emit, and the constant value to emit. If this routine returns
  205. TRUE, @var(no) instruction should be emitted (.eg : imul reg by 1 )
  206. @param(op The opcode to emit, returns the opcode which must be emitted)
  207. @param(a The constant which should be emitted, returns the constant which must
  208. be emitted)
  209. @param(reg The register to emit the opcode with, returns the register with
  210. which the opcode will be emitted)
  211. }
  212. function optimize_op_const_reg(list: taasmoutput; var op: topcg; var a : aword; var reg: tregister): boolean;virtual;
  213. {#
  214. This routine is used in exception management nodes. It should
  215. save the exception reason currently in the FUNCTION_RETURN_REG. The
  216. save should be done either to a temp (pointed to by href).
  217. or on the stack (pushing the value on the stack).
  218. The size of the value to save is OS_S32. The default version
  219. saves the exception reason to a temp. memory area.
  220. }
  221. procedure g_exception_reason_save(list : taasmoutput; const href : treference);virtual;
  222. {#
  223. This routine is used in exception management nodes. It should
  224. save the exception reason constant. The
  225. save should be done either to a temp (pointed to by href).
  226. or on the stack (pushing the value on the stack).
  227. The size of the value to save is OS_S32. The default version
  228. saves the exception reason to a temp. memory area.
  229. }
  230. procedure g_exception_reason_save_const(list : taasmoutput; const href : treference; a: aword);virtual;
  231. {#
  232. This routine is used in exception management nodes. It should
  233. load the exception reason to the FUNCTION_RETURN_REG. The saved value
  234. should either be in the temp. area (pointed to by href , href should
  235. *NOT* be freed) or on the stack (the value should be popped).
  236. The size of the value to save is OS_S32. The default version
  237. saves the exception reason to a temp. memory area.
  238. }
  239. procedure g_exception_reason_load(list : taasmoutput; const href : treference);virtual;
  240. procedure g_load_parent_framepointer(list:taasmoutput;parentsymtable:tsymtable;reg:tregister);
  241. procedure g_save_parent_framepointer_param(list:taasmoutput);virtual;
  242. procedure g_maybe_testself(list : taasmoutput;reg:tregister);
  243. procedure g_maybe_testvmt(list : taasmoutput;reg:tregister;objdef:tobjectdef);
  244. {# This should emit the opcode to copy len bytes from the source
  245. to destination, if loadref is true, it assumes that it first must load
  246. the source address from the memory location where
  247. source points to.
  248. It must be overriden for each new target processor.
  249. @param(source Source reference of copy)
  250. @param(dest Destination reference of copy)
  251. @param(delsource Indicates if the source reference's resources should be freed)
  252. @param(loadref Is the source reference a pointer to the actual source (TRUE), is it the actual source address (FALSE))
  253. }
  254. procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword;delsource,loadref : boolean);virtual; abstract;
  255. {# This should emit the opcode to a shortrstring from the source
  256. to destination, if loadref is true, it assumes that it first must load
  257. the source address from the memory location where
  258. source points to.
  259. @param(source Source reference of copy)
  260. @param(dest Destination reference of copy)
  261. @param(delsource Indicates if the source reference's resources should be freed)
  262. @param(loadref Is the source reference a pointer to the actual source (TRUE), is it the actual source address (FALSE))
  263. }
  264. procedure g_copyshortstring(list : taasmoutput;const source,dest : treference;len:byte;delsource,loadref : boolean);
  265. procedure g_incrrefcount(list : taasmoutput;t: tdef; const ref: treference;loadref : boolean);
  266. procedure g_decrrefcount(list : taasmoutput;t: tdef; const ref: treference;loadref : boolean);
  267. procedure g_initialize(list : taasmoutput;t : tdef;const ref : treference;loadref : boolean);
  268. procedure g_finalize(list : taasmoutput;t : tdef;const ref : treference;loadref : boolean);
  269. {# Emits the call to the stack checking routine of
  270. the runtime library. The default behavior
  271. does not need to be modified, as it is generic
  272. for all platforms.
  273. @param(stackframesize Number of bytes which will be allocated on the stack)
  274. }
  275. procedure g_stackcheck(list : taasmoutput;stackframesize : longint);virtual;
  276. {# Generates range checking code. It is to note
  277. that this routine does not need to be overriden,
  278. as it takes care of everything.
  279. @param(p Node which contains the value to check)
  280. @param(todef Type definition of node to range check)
  281. }
  282. procedure g_rangecheck(list: taasmoutput; const l:tlocation; fromdef,todef: tdef); virtual;
  283. {# Generates overflow checking code for a node }
  284. procedure g_overflowcheck(list: taasmoutput; const l:tlocation; def:tdef); virtual; abstract;
  285. procedure g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:integer);virtual;abstract;
  286. {# Emits instructions which should be emitted when entering
  287. a routine declared as @var(interrupt). The default
  288. behavior does nothing, should be overriden as required.
  289. }
  290. procedure g_interrupt_stackframe_entry(list : taasmoutput);virtual;
  291. {# Emits instructions which should be emitted when exiting
  292. a routine declared as @var(interrupt). The default
  293. behavior does nothing, should be overriden as required.
  294. }
  295. procedure g_interrupt_stackframe_exit(list : taasmoutput;accused,acchiused:boolean);virtual;
  296. {# Emits instructions when compilation is done in profile
  297. mode (this is set as a command line option). The default
  298. behavior does nothing, should be overriden as required.
  299. }
  300. procedure g_profilecode(list : taasmoutput);virtual;
  301. {# Emits instruction for allocating @var(size) bytes at the stackpointer
  302. @param(size Number of bytes to allocate)
  303. }
  304. procedure g_stackpointer_alloc(list : taasmoutput;size : longint);virtual; abstract;
  305. {# Emits instruction for allocating the locals in entry
  306. code of a routine. This is one of the first
  307. routine called in @var(genentrycode).
  308. @param(localsize Number of bytes to allocate as locals)
  309. }
  310. procedure g_stackframe_entry(list : taasmoutput;localsize : longint);virtual; abstract;
  311. {# Emits instructiona for restoring the frame pointer
  312. at routine exit. For some processors, this routine
  313. may do nothing at all.
  314. }
  315. procedure g_restore_frame_pointer(list : taasmoutput);virtual; abstract;
  316. {# Emits instructions for returning from a subroutine.
  317. Should also restore the stack.
  318. @param(parasize Number of bytes of parameters to deallocate from stack)
  319. }
  320. procedure g_return_from_proc(list : taasmoutput;parasize : aword);virtual; abstract;
  321. {# This routine is called when generating the code for the entry point
  322. of a routine. It should save all registers which are not used in this
  323. routine, and which should be declared as saved in the std_saved_registers
  324. set.
  325. This routine is mainly used when linking to code which is generated
  326. by ABI-compliant compilers (like GCC), to make sure that the reserved
  327. registers of that ABI are not clobbered.
  328. @param(usedinproc Registers which are used in the code of this routine)
  329. }
  330. procedure g_save_standard_registers(list:Taasmoutput;usedinproc:Tsuperregisterset);virtual;abstract;
  331. {# This routine is called when generating the code for the exit point
  332. of a routine. It should restore all registers which were previously
  333. saved in @var(g_save_standard_registers).
  334. @param(usedinproc Registers which are used in the code of this routine)
  335. }
  336. procedure g_restore_standard_registers(list:Taasmoutput;usedinproc:Tsuperregisterset);virtual;abstract;
  337. procedure g_save_all_registers(list : taasmoutput);virtual;abstract;
  338. procedure g_restore_all_registers(list : taasmoutput;accused,acchiused:boolean);virtual;abstract;
  339. end;
  340. {# @abstract(Abstract code generator for 64 Bit operations)
  341. This class implements an abstract code generator class
  342. for 64 Bit operations.
  343. }
  344. tcg64 = class
  345. { Allocates 64 Bit register r by inserting a pai_realloc record }
  346. procedure a_reg_alloc(list : taasmoutput;r : tregister64);virtual;abstract;
  347. { Deallocates 64 Bit register r by inserting a pa_regdealloc record}
  348. procedure a_reg_dealloc(list : taasmoutput;r : tregister64);virtual;abstract;
  349. procedure a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);virtual;abstract;
  350. procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);virtual;abstract;
  351. procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64;delete : boolean);virtual;abstract;
  352. procedure a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64;delete : boolean);virtual;abstract;
  353. procedure a_load64_const_reg(list : taasmoutput;value : qword;reg : tregister64);virtual;abstract;
  354. procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64;delete : boolean);virtual;abstract;
  355. procedure a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);virtual;abstract;
  356. procedure a_load64_const_loc(list : taasmoutput;value : qword;const l : tlocation);virtual;abstract;
  357. procedure a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);virtual;abstract;
  358. procedure a_load64high_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);virtual;abstract;
  359. procedure a_load64low_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);virtual;abstract;
  360. procedure a_load64high_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);virtual;abstract;
  361. procedure a_load64low_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);virtual;abstract;
  362. procedure a_load64high_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);virtual;abstract;
  363. procedure a_load64low_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);virtual;abstract;
  364. procedure a_op64_ref_reg(list : taasmoutput;op:TOpCG;const ref : treference;reg : tregister64);virtual;abstract;
  365. procedure a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);virtual;abstract;
  366. procedure a_op64_reg_ref(list : taasmoutput;op:TOpCG;regsrc : tregister64;const ref : treference);virtual;abstract;
  367. procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;regdst : tregister64);virtual;abstract;
  368. procedure a_op64_const_ref(list : taasmoutput;op:TOpCG;value : qword;const ref : treference);virtual;abstract;
  369. procedure a_op64_const_loc(list : taasmoutput;op:TOpCG;value : qword;const l: tlocation);virtual;abstract;
  370. procedure a_op64_reg_loc(list : taasmoutput;op:TOpCG;reg : tregister64;const l : tlocation);virtual;abstract;
  371. procedure a_op64_loc_reg(list : taasmoutput;op:TOpCG;const l : tlocation;reg64 : tregister64);virtual;abstract;
  372. procedure a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : qword;regsrc,regdst : tregister64);virtual;
  373. procedure a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64);virtual;
  374. procedure a_param64_reg(list : taasmoutput;reg64 : tregister64;const loc : tparalocation);virtual;abstract;
  375. procedure a_param64_const(list : taasmoutput;value : qword;const loc : tparalocation);virtual;abstract;
  376. procedure a_param64_ref(list : taasmoutput;const r : treference;const loc : tparalocation);virtual;abstract;
  377. procedure a_param64_loc(list : taasmoutput;const l : tlocation;const loc : tparalocation);virtual;abstract;
  378. {
  379. This routine tries to optimize the const_reg opcode, and should be
  380. called at the start of a_op64_const_reg. It returns the actual opcode
  381. to emit, and the constant value to emit. If this routine returns
  382. TRUE, @var(no) instruction should be emitted (.eg : imul reg by 1 )
  383. @param(op The opcode to emit, returns the opcode which must be emitted)
  384. @param(a The constant which should be emitted, returns the constant which must
  385. be emitted)
  386. @param(reg The register to emit the opcode with, returns the register with
  387. which the opcode will be emitted)
  388. }
  389. function optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : qword; var reg: tregister64): boolean;virtual;abstract;
  390. { override to catch 64bit rangechecks }
  391. procedure g_rangecheck64(list: taasmoutput; const l:tlocation; fromdef,todef: tdef);virtual;abstract;
  392. end;
  393. var
  394. {# Main code generator class }
  395. cg : tcg;
  396. {# Code generator class for all operations working with 64-Bit operands }
  397. cg64 : tcg64;
  398. implementation
  399. uses
  400. globals,globtype,options,systems,cgbase,
  401. verbose,defutil,paramgr,symsym,
  402. rgobj,cutils;
  403. const
  404. { Please leave this here, this module should NOT use
  405. exprasmlist, the lists are always passed as arguments.
  406. Declaring it as string here results in an error when compiling (PFV) }
  407. exprasmlist = 'error';
  408. {*****************************************************************************
  409. basic functionallity
  410. ******************************************************************************}
  411. constructor tcg.create;
  412. begin
  413. end;
  414. procedure tcg.a_reg_alloc(list : taasmoutput;r : tregister);
  415. begin
  416. list.concat(tai_regalloc.alloc(r));
  417. end;
  418. procedure tcg.a_reg_dealloc(list : taasmoutput;r : tregister);
  419. begin
  420. list.concat(tai_regalloc.dealloc(r));
  421. end;
  422. procedure tcg.a_label(list : taasmoutput;l : tasmlabel);
  423. begin
  424. list.concat(tai_label.create(l));
  425. end;
  426. {*****************************************************************************
  427. for better code generation these methods should be overridden
  428. ******************************************************************************}
  429. procedure tcg.a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const locpara : tparalocation);
  430. var
  431. ref : treference;
  432. begin
  433. case locpara.loc of
  434. LOC_REGISTER,LOC_CREGISTER:
  435. a_load_reg_reg(list,size,locpara.size,r,locpara.register);
  436. LOC_REFERENCE,LOC_CREFERENCE:
  437. begin
  438. if locpara.sp_fixup<>0 then
  439. a_op_const_reg(list,OP_ADD,OS_ADDR,locpara.sp_fixup,NR_STACK_POINTER_REG);
  440. reference_reset(ref);
  441. ref.base:=locpara.reference.index;
  442. ref.offset:=locpara.reference.offset;
  443. a_load_reg_ref(list,size,size,r,ref);
  444. end
  445. else
  446. internalerror(2002071004);
  447. end;
  448. end;
  449. procedure tcg.a_param_const(list : taasmoutput;size : tcgsize;a : aword;const locpara : tparalocation);
  450. var
  451. hr : tregister;
  452. begin
  453. hr:=rg.getregisterint(list,size);
  454. a_load_const_reg(list,size,a,hr);
  455. a_param_reg(list,size,hr,locpara);
  456. rg.ungetregisterint(list,hr);
  457. end;
  458. procedure tcg.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const locpara : tparalocation);
  459. var
  460. hr : tregister;
  461. begin
  462. hr:=rg.getregisterint(list,size);
  463. a_load_ref_reg(list,size,size,r,hr);
  464. a_param_reg(list,size,hr,locpara);
  465. rg.ungetregisterint(list,hr);
  466. end;
  467. procedure tcg.a_param_loc(list : taasmoutput;const l:tlocation;const locpara : tparalocation);
  468. begin
  469. case l.loc of
  470. LOC_REGISTER,
  471. LOC_CREGISTER :
  472. a_param_reg(list,l.size,l.register,locpara);
  473. LOC_CONSTANT :
  474. a_param_const(list,l.size,l.value,locpara);
  475. LOC_CREFERENCE,
  476. LOC_REFERENCE :
  477. a_param_ref(list,l.size,l.reference,locpara);
  478. else
  479. internalerror(2002032211);
  480. end;
  481. end;
  482. procedure tcg.a_paramaddr_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);
  483. var
  484. hr : tregister;
  485. begin
  486. hr:=rg.getaddressregister(list);
  487. a_loadaddr_ref_reg(list,r,hr);
  488. a_param_reg(list,OS_ADDR,hr,locpara);
  489. rg.ungetregisterint(list,hr);
  490. end;
  491. procedure tcg.a_param_copy_ref(list : taasmoutput;size : qword;const r : treference;const locpara : tparalocation);
  492. var
  493. ref : treference;
  494. begin
  495. if not(locpara.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  496. internalerror(2003010901);
  497. if locpara.sp_fixup<>0 then
  498. cg.g_stackpointer_alloc(list,locpara.sp_fixup);
  499. reference_reset_base(ref,locpara.reference.index,locpara.reference.offset);
  500. cg.g_concatcopy(list,r,ref,size,false,false);
  501. end;
  502. procedure tcg.a_load_param_ref(list : taasmoutput;const locpara : tparalocation;const ref:treference);
  503. begin
  504. case locpara.loc of
  505. LOC_CREGISTER,
  506. LOC_REGISTER:
  507. begin
  508. if (locpara.size in [OS_S64,OS_64]) then
  509. begin
  510. {$ifdef cpu64bit}
  511. rg.ungetregisterint(list,locpara.register64);
  512. {$else cpu64bit}
  513. rg.getexplicitregisterint(list,locpara.registerlow);
  514. rg.getexplicitregisterint(list,locpara.registerhigh);
  515. rg.ungetregisterint(list,locpara.registerlow);
  516. rg.ungetregisterint(list,locpara.registerhigh);
  517. {$endif cpu64bit}
  518. cg64.a_load64_reg_ref(list,locpara.register64,ref)
  519. end
  520. else
  521. begin
  522. rg.getexplicitregisterint(list,locpara.register);
  523. rg.ungetregisterint(list,locpara.register);
  524. cg.a_load_reg_ref(list,locpara.size,locpara.size,locpara.register,ref);
  525. end;
  526. end;
  527. LOC_FPUREGISTER,
  528. LOC_CFPUREGISTER:
  529. cg.a_loadfpu_reg_ref(list,locpara.size,locpara.register,ref);
  530. else
  531. internalerror(2002081302);
  532. end;
  533. end;
  534. procedure tcg.a_load_param_reg(list : taasmoutput;const locpara : tparalocation;const reg:tregister);
  535. var
  536. href : treference;
  537. begin
  538. case locpara.loc of
  539. LOC_CREGISTER,
  540. LOC_REGISTER:
  541. begin
  542. if not(locpara.size in [OS_S64,OS_64]) then
  543. begin
  544. rg.getexplicitregisterint(list,locpara.register);
  545. rg.ungetregisterint(list,locpara.register);
  546. rg.getexplicitregisterint(list,reg);
  547. cg.a_load_reg_reg(list,locpara.size,locpara.size,locpara.register,reg)
  548. end
  549. else
  550. internalerror(2003053011);
  551. end;
  552. LOC_CFPUREGISTER,
  553. LOC_FPUREGISTER:
  554. cg.a_loadfpu_reg_reg(list,locpara.size,locpara.register,reg);
  555. LOC_REFERENCE,
  556. LOC_CREFERENCE:
  557. begin
  558. reference_reset_base(href,locpara.reference.index,locpara.reference.offset);
  559. rg.getexplicitregisterint(list,reg);
  560. cg.a_load_ref_reg(list,locpara.size,locpara.size,href,reg);
  561. end;
  562. else
  563. internalerror(2003053010);
  564. end
  565. end;
  566. {****************************************************************************
  567. some generic implementations
  568. ****************************************************************************}
  569. procedure tcg.a_load_ref_ref(list : taasmoutput;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);
  570. var
  571. tmpreg: tregister;
  572. begin
  573. { verify if we have the same reference }
  574. if references_equal(sref,dref) then
  575. exit;
  576. tmpreg:=rg.getregisterint(list,tosize);
  577. a_load_ref_reg(list,fromsize,tosize,sref,tmpreg);
  578. a_load_reg_ref(list,tosize,tosize,tmpreg,dref);
  579. rg.ungetregisterint(list,tmpreg);
  580. end;
  581. procedure tcg.a_load_const_ref(list : taasmoutput;size : tcgsize;a : aword;const ref : treference);
  582. var
  583. tmpreg: tregister;
  584. begin
  585. tmpreg:=rg.getregisterint(list,size);
  586. a_load_const_reg(list,size,a,tmpreg);
  587. a_load_reg_ref(list,size,size,tmpreg,ref);
  588. rg.ungetregisterint(list,tmpreg);
  589. end;
  590. procedure tcg.a_load_const_loc(list : taasmoutput;a : aword;const loc: tlocation);
  591. begin
  592. case loc.loc of
  593. LOC_REFERENCE,LOC_CREFERENCE:
  594. a_load_const_ref(list,loc.size,a,loc.reference);
  595. LOC_REGISTER,LOC_CREGISTER:
  596. a_load_const_reg(list,loc.size,a,loc.register);
  597. else
  598. internalerror(200203272);
  599. end;
  600. end;
  601. procedure tcg.a_load_reg_loc(list : taasmoutput;fromsize : tcgsize;reg : tregister;const loc: tlocation);
  602. begin
  603. case loc.loc of
  604. LOC_REFERENCE,LOC_CREFERENCE:
  605. a_load_reg_ref(list,fromsize,loc.size,reg,loc.reference);
  606. LOC_REGISTER,LOC_CREGISTER:
  607. a_load_reg_reg(list,fromsize,loc.size,reg,loc.register);
  608. else
  609. internalerror(200203271);
  610. end;
  611. end;
  612. procedure tcg.a_load_loc_reg(list : taasmoutput; tosize: tcgsize; const loc: tlocation; reg : tregister);
  613. begin
  614. case loc.loc of
  615. LOC_REFERENCE,LOC_CREFERENCE:
  616. a_load_ref_reg(list,loc.size,tosize,loc.reference,reg);
  617. LOC_REGISTER,LOC_CREGISTER:
  618. a_load_reg_reg(list,loc.size,tosize,loc.register,reg);
  619. LOC_CONSTANT:
  620. a_load_const_reg(list,tosize,loc.value,reg);
  621. else
  622. internalerror(200109092);
  623. end;
  624. end;
  625. procedure tcg.a_load_loc_ref(list : taasmoutput;tosize: tcgsize; const loc: tlocation; const ref : treference);
  626. begin
  627. case loc.loc of
  628. LOC_REFERENCE,LOC_CREFERENCE:
  629. a_load_ref_ref(list,loc.size,tosize,loc.reference,ref);
  630. LOC_REGISTER,LOC_CREGISTER:
  631. a_load_reg_ref(list,loc.size,tosize,loc.register,ref);
  632. LOC_CONSTANT:
  633. a_load_const_ref(list,tosize,loc.value,ref);
  634. else
  635. internalerror(200109302);
  636. end;
  637. end;
  638. procedure tcg.a_call_ref(list : taasmoutput;const ref:treference);
  639. var
  640. tmpreg: tregister;
  641. begin
  642. tmpreg:=rg.getaddressregister(list);
  643. a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,tmpreg);
  644. a_call_reg(list,tmpreg);
  645. rg.ungetaddressregister(list,tmpreg);
  646. end;
  647. procedure tcg.a_call_loc(list : taasmoutput;const loc:tlocation);
  648. begin
  649. case loc.loc of
  650. LOC_REGISTER,LOC_CREGISTER:
  651. cg.a_call_reg(list,loc.register);
  652. LOC_REFERENCE,LOC_CREFERENCE :
  653. cg.a_call_ref(list,loc.reference);
  654. else
  655. internalerror(200203311);
  656. end;
  657. end;
  658. function tcg.optimize_op_const_reg(list: taasmoutput; var op: topcg; var a : aword; var reg:tregister): boolean;
  659. var
  660. powerval : longint;
  661. begin
  662. optimize_op_const_reg := false;
  663. case op of
  664. { or with zero returns same result }
  665. OP_OR : if a = 0 then optimize_op_const_reg := true;
  666. { and with max returns same result }
  667. OP_AND : if (a = high(a)) then optimize_op_const_reg := true;
  668. { division by 1 returns result }
  669. OP_DIV :
  670. begin
  671. if a = 1 then
  672. optimize_op_const_reg := true
  673. else if ispowerof2(int64(a), powerval) then
  674. begin
  675. a := powerval;
  676. op:= OP_SHR;
  677. end;
  678. exit;
  679. end;
  680. OP_IDIV:
  681. begin
  682. if a = 1 then
  683. optimize_op_const_reg := true
  684. else if ispowerof2(int64(a), powerval) then
  685. begin
  686. a := powerval;
  687. op:= OP_SAR;
  688. end;
  689. exit;
  690. end;
  691. OP_MUL,OP_IMUL:
  692. begin
  693. if a = 1 then
  694. optimize_op_const_reg := true
  695. else if ispowerof2(int64(a), powerval) then
  696. begin
  697. a := powerval;
  698. op:= OP_SHL;
  699. end;
  700. exit;
  701. end;
  702. OP_SAR,OP_SHL,OP_SHR:
  703. begin
  704. if a = 0 then
  705. optimize_op_const_reg := true;
  706. exit;
  707. end;
  708. end;
  709. end;
  710. procedure tcg.a_loadfpu_loc_reg(list: taasmoutput; const loc: tlocation; const reg: tregister);
  711. begin
  712. case loc.loc of
  713. LOC_REFERENCE, LOC_CREFERENCE:
  714. a_loadfpu_ref_reg(list,loc.size,loc.reference,reg);
  715. LOC_FPUREGISTER, LOC_CFPUREGISTER:
  716. a_loadfpu_reg_reg(list,loc.size,loc.register,reg);
  717. else
  718. internalerror(200203301);
  719. end;
  720. end;
  721. procedure tcg.a_loadfpu_reg_loc(list: taasmoutput; size: tcgsize; const reg: tregister; const loc: tlocation);
  722. begin
  723. case loc.loc of
  724. LOC_REFERENCE, LOC_CREFERENCE:
  725. a_loadfpu_reg_ref(list,size,reg,loc.reference);
  726. LOC_FPUREGISTER, LOC_CFPUREGISTER:
  727. a_loadfpu_reg_reg(list,size,reg,loc.register);
  728. else
  729. internalerror(48991);
  730. end;
  731. end;
  732. procedure tcg.a_paramfpu_reg(list : taasmoutput;size : tcgsize;const r : tregister;const locpara : tparalocation);
  733. var
  734. ref : treference;
  735. begin
  736. case locpara.loc of
  737. LOC_FPUREGISTER,LOC_CFPUREGISTER:
  738. a_loadfpu_reg_reg(list,size,r,locpara.register);
  739. LOC_REFERENCE,LOC_CREFERENCE:
  740. begin
  741. if locpara.sp_fixup<>0 then
  742. a_op_const_reg(list,OP_ADD,OS_ADDR,locpara.sp_fixup,NR_STACK_POINTER_REG);
  743. reference_reset(ref);
  744. ref.base:=locpara.reference.index;
  745. ref.offset:=locpara.reference.offset;
  746. a_loadfpu_reg_ref(list,size,r,ref);
  747. end
  748. else
  749. internalerror(2002071004);
  750. end;
  751. end;
  752. procedure tcg.a_paramfpu_ref(list : taasmoutput;size : tcgsize;const ref : treference;const locpara : tparalocation);
  753. var
  754. hr : tregister;
  755. begin
  756. hr:=rg.getregisterfpu(list,size);
  757. a_loadfpu_ref_reg(list,size,ref,hr);
  758. a_paramfpu_reg(list,size,hr,locpara);
  759. rg.ungetregisterfpu(list,hr,size);
  760. end;
  761. procedure tcg.a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const ref: TReference);
  762. var
  763. tmpreg: tregister;
  764. begin
  765. tmpreg:=rg.getregisterint(list,size);
  766. a_load_ref_reg(list,size,size,ref,tmpreg);
  767. a_op_const_reg(list,op,size,a,tmpreg);
  768. a_load_reg_ref(list,size,size,tmpreg,ref);
  769. rg.ungetregisterint(list,tmpreg);
  770. end;
  771. procedure tcg.a_op_const_loc(list : taasmoutput; Op: TOpCG; a: AWord; const loc: tlocation);
  772. begin
  773. case loc.loc of
  774. LOC_REGISTER, LOC_CREGISTER:
  775. a_op_const_reg(list,op,loc.size,a,loc.register);
  776. LOC_REFERENCE, LOC_CREFERENCE:
  777. a_op_const_ref(list,op,loc.size,a,loc.reference);
  778. else
  779. internalerror(200109061);
  780. end;
  781. end;
  782. procedure tcg.a_op_reg_ref(list : taasmoutput; Op: TOpCG; size: TCGSize;reg: TRegister; const ref: TReference);
  783. var
  784. tmpreg: tregister;
  785. begin
  786. tmpreg:=rg.getregisterint(list,size);
  787. a_load_ref_reg(list,size,size,ref,tmpreg);
  788. a_op_reg_reg(list,op,size,reg,tmpreg);
  789. a_load_reg_ref(list,size,size,tmpreg,ref);
  790. rg.ungetregisterint(list,tmpreg);
  791. end;
  792. procedure tcg.a_op_ref_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister);
  793. var
  794. tmpreg: tregister;
  795. begin
  796. case op of
  797. OP_NOT,OP_NEG:
  798. { handle it as "load ref,reg; op reg" }
  799. begin
  800. a_load_ref_reg(list,size,size,ref,reg);
  801. a_op_reg_reg(list,op,size,reg,reg);
  802. end;
  803. else
  804. begin
  805. tmpreg:=rg.getregisterint(list,size);
  806. a_load_ref_reg(list,size,size,ref,tmpreg);
  807. a_op_reg_reg(list,op,size,tmpreg,reg);
  808. rg.ungetregisterint(list,tmpreg);
  809. end;
  810. end;
  811. end;
  812. procedure tcg.a_op_reg_loc(list : taasmoutput; Op: TOpCG; reg: tregister; const loc: tlocation);
  813. begin
  814. case loc.loc of
  815. LOC_REGISTER, LOC_CREGISTER:
  816. a_op_reg_reg(list,op,loc.size,reg,loc.register);
  817. LOC_REFERENCE, LOC_CREFERENCE:
  818. a_op_reg_ref(list,op,loc.size,reg,loc.reference);
  819. else
  820. internalerror(200109061);
  821. end;
  822. end;
  823. procedure tcg.a_op_ref_loc(list : taasmoutput; Op: TOpCG; const ref: TReference; const loc: tlocation);
  824. var
  825. tmpreg: tregister;
  826. begin
  827. case loc.loc of
  828. LOC_REGISTER,LOC_CREGISTER:
  829. a_op_ref_reg(list,op,loc.size,ref,loc.register);
  830. LOC_REFERENCE,LOC_CREFERENCE:
  831. begin
  832. tmpreg:=rg.getregisterint(list,loc.size);
  833. a_load_ref_reg(list,loc.size,loc.size,ref,tmpreg);
  834. a_op_reg_ref(list,op,loc.size,tmpreg,loc.reference);
  835. rg.ungetregisterint(list,tmpreg);
  836. end;
  837. else
  838. internalerror(200109061);
  839. end;
  840. end;
  841. procedure tcg.a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
  842. size: tcgsize; a: aword; src, dst: tregister);
  843. begin
  844. a_load_reg_reg(list,size,size,src,dst);
  845. a_op_const_reg(list,op,size,a,dst);
  846. end;
  847. procedure tcg.a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
  848. size: tcgsize; src1, src2, dst: tregister);
  849. var
  850. tmpreg: tregister;
  851. begin
  852. if (dst<>src1) then
  853. begin
  854. a_load_reg_reg(list,size,size,src2,dst);
  855. a_op_reg_reg(list,op,size,src1,dst);
  856. end
  857. else
  858. begin
  859. tmpreg := rg.getregisterint(list,size);
  860. a_load_reg_reg(list,size,size,src2,tmpreg);
  861. a_op_reg_reg(list,op,size,src1,tmpreg);
  862. a_load_reg_reg(list,size,size,tmpreg,dst);
  863. rg.ungetregisterint(list,tmpreg);
  864. end;
  865. end;
  866. procedure tcg.a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference;
  867. l : tasmlabel);
  868. var
  869. tmpreg: tregister;
  870. begin
  871. tmpreg:=rg.getregisterint(list,size);
  872. a_load_ref_reg(list,size,size,ref,tmpreg);
  873. a_cmp_const_reg_label(list,size,cmp_op,a,tmpreg,l);
  874. rg.ungetregisterint(list,tmpreg);
  875. end;
  876. procedure tcg.a_cmp_const_loc_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const loc : tlocation;
  877. l : tasmlabel);
  878. begin
  879. case loc.loc of
  880. LOC_REGISTER,LOC_CREGISTER:
  881. a_cmp_const_reg_label(list,size,cmp_op,a,loc.register,l);
  882. LOC_REFERENCE,LOC_CREFERENCE:
  883. a_cmp_const_ref_label(list,size,cmp_op,a,loc.reference,l);
  884. else
  885. internalerror(200109061);
  886. end;
  887. end;
  888. procedure tcg.a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const ref: treference; reg : tregister; l : tasmlabel);
  889. var
  890. tmpreg: tregister;
  891. begin
  892. tmpreg:=rg.getregisterint(list,size);
  893. a_load_ref_reg(list,size,size,ref,tmpreg);
  894. a_cmp_reg_reg_label(list,size,cmp_op,tmpreg,reg,l);
  895. rg.ungetregisterint(list,tmpreg);
  896. end;
  897. procedure tcg.a_cmp_loc_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const loc: tlocation; reg : tregister; l : tasmlabel);
  898. begin
  899. case loc.loc of
  900. LOC_REGISTER,
  901. LOC_CREGISTER:
  902. a_cmp_reg_reg_label(list,size,cmp_op,loc.register,reg,l);
  903. LOC_REFERENCE,
  904. LOC_CREFERENCE :
  905. a_cmp_ref_reg_label(list,size,cmp_op,loc.reference,reg,l);
  906. LOC_CONSTANT:
  907. a_cmp_const_reg_label(list,size,cmp_op,loc.value,reg,l);
  908. else
  909. internalerror(200203231);
  910. end;
  911. end;
  912. procedure tcg.a_cmp_ref_loc_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;const ref: treference;const loc : tlocation;
  913. l : tasmlabel);
  914. var
  915. tmpreg: tregister;
  916. begin
  917. case loc.loc of
  918. LOC_REGISTER,LOC_CREGISTER:
  919. a_cmp_ref_reg_label(list,size,cmp_op,ref,loc.register,l);
  920. LOC_REFERENCE,LOC_CREFERENCE:
  921. begin
  922. tmpreg := rg.getregisterint(list,size);
  923. a_load_ref_reg(list,size,size,loc.reference,tmpreg);
  924. a_cmp_ref_reg_label(list,size,cmp_op,ref,tmpreg,l);
  925. rg.ungetregisterint(list,tmpreg);
  926. end
  927. else
  928. internalerror(200109061);
  929. end;
  930. end;
  931. class function tcg.reg_cgsize(const reg: tregister) : tcgsize;
  932. begin
  933. reg_cgsize := OS_INT;
  934. end;
  935. procedure tcg.g_load_parent_framepointer(list:taasmoutput;parentsymtable:tsymtable;reg:tregister);
  936. var
  937. href : treference;
  938. i : integer;
  939. begin
  940. { make a reference }
  941. reference_reset_base(href,current_procinfo.framepointer,PARENT_FRAMEPOINTER_OFFSET);
  942. cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,reg);
  943. { walk parents }
  944. i:=current_procinfo.procdef.parast.symtablelevel-1;
  945. while (i>parentsymtable.symtablelevel) do
  946. begin
  947. { make a reference }
  948. reference_reset_base(href,reg,PARENT_FRAMEPOINTER_OFFSET);
  949. cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,reg);
  950. dec(i);
  951. end;
  952. end;
  953. procedure tcg.g_save_parent_framepointer_param(list:taasmoutput);
  954. begin
  955. end;
  956. procedure tcg.g_copyshortstring(list : taasmoutput;const source,dest : treference;len:byte;delsource,loadref : boolean);
  957. var
  958. paraloc1,paraloc2,paraloc3 : tparalocation;
  959. begin
  960. {$ifdef FPC}
  961. {$warning FIX ME!}
  962. {$endif}
  963. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  964. paraloc2:=paramanager.getintparaloc(pocall_default,2);
  965. paraloc3:=paramanager.getintparaloc(pocall_default,3);
  966. paramanager.allocparaloc(list,paraloc3);
  967. a_paramaddr_ref(list,dest,paraloc3);
  968. paramanager.allocparaloc(list,paraloc2);
  969. if loadref then
  970. a_param_ref(list,OS_ADDR,source,paraloc2)
  971. else
  972. a_paramaddr_ref(list,source,paraloc2);
  973. if delsource then
  974. reference_release(list,source);
  975. paramanager.allocparaloc(list,paraloc1);
  976. a_param_const(list,OS_INT,len,paraloc1);
  977. paramanager.freeparaloc(list,paraloc3);
  978. paramanager.freeparaloc(list,paraloc2);
  979. paramanager.freeparaloc(list,paraloc1);
  980. rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
  981. a_call_name(list,'FPC_SHORTSTR_ASSIGN');
  982. rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
  983. end;
  984. procedure tcg.g_incrrefcount(list : taasmoutput;t: tdef; const ref: treference;loadref : boolean);
  985. var
  986. href : treference;
  987. incrfunc : string;
  988. paraloc1,paraloc2 : tparalocation;
  989. begin
  990. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  991. paraloc2:=paramanager.getintparaloc(pocall_default,2);
  992. { These functions should not change the registers (they use
  993. the saveregister proc directive }
  994. if is_interfacecom(t) then
  995. incrfunc:='FPC_INTF_INCR_REF'
  996. else if is_ansistring(t) then
  997. incrfunc:='FPC_ANSISTR_INCR_REF'
  998. else if is_widestring(t) then
  999. incrfunc:='FPC_WIDESTR_INCR_REF'
  1000. else if is_dynamic_array(t) then
  1001. incrfunc:='FPC_DYNARRAY_INCR_REF'
  1002. else
  1003. incrfunc:='';
  1004. { call the special incr function or the generic addref }
  1005. if incrfunc<>'' then
  1006. begin
  1007. { these functions get the pointer by value }
  1008. paramanager.allocparaloc(list,paraloc1);
  1009. a_param_ref(list,OS_ADDR,ref,paraloc1);
  1010. paramanager.freeparaloc(list,paraloc1);
  1011. rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
  1012. a_call_name(list,incrfunc);
  1013. rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
  1014. end
  1015. else
  1016. begin
  1017. reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
  1018. paramanager.allocparaloc(list,paraloc2);
  1019. a_paramaddr_ref(list,href,paraloc2);
  1020. paramanager.allocparaloc(list,paraloc1);
  1021. if loadref then
  1022. a_param_ref(list,OS_ADDR,ref,paraloc1)
  1023. else
  1024. a_paramaddr_ref(list,ref,paraloc1);
  1025. paramanager.freeparaloc(list,paraloc1);
  1026. paramanager.freeparaloc(list,paraloc2);
  1027. rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
  1028. a_call_name(list,'FPC_ADDREF');
  1029. rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
  1030. end;
  1031. end;
  1032. procedure tcg.g_decrrefcount(list : taasmoutput;t: tdef; const ref: treference; loadref:boolean);
  1033. var
  1034. href : treference;
  1035. decrfunc : string;
  1036. needrtti : boolean;
  1037. paraloc1,paraloc2 : tparalocation;
  1038. begin
  1039. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  1040. paraloc2:=paramanager.getintparaloc(pocall_default,2);
  1041. needrtti:=false;
  1042. if is_interfacecom(t) then
  1043. decrfunc:='FPC_INTF_DECR_REF'
  1044. else if is_ansistring(t) then
  1045. decrfunc:='FPC_ANSISTR_DECR_REF'
  1046. else if is_widestring(t) then
  1047. decrfunc:='FPC_WIDESTR_DECR_REF'
  1048. else if is_dynamic_array(t) then
  1049. begin
  1050. decrfunc:='FPC_DYNARRAY_DECR_REF';
  1051. needrtti:=true;
  1052. end
  1053. else
  1054. decrfunc:='';
  1055. { call the special decr function or the generic decref }
  1056. if decrfunc<>'' then
  1057. begin
  1058. if needrtti then
  1059. begin
  1060. reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
  1061. paramanager.allocparaloc(list,paraloc2);
  1062. a_paramaddr_ref(list,href,paraloc2);
  1063. end;
  1064. paramanager.allocparaloc(list,paraloc1);
  1065. if loadref then
  1066. a_param_ref(list,OS_ADDR,ref,paraloc1)
  1067. else
  1068. a_paramaddr_ref(list,ref,paraloc1);
  1069. paramanager.freeparaloc(list,paraloc1);
  1070. if needrtti then
  1071. paramanager.freeparaloc(list,paraloc2);
  1072. rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
  1073. a_call_name(list,decrfunc);
  1074. rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
  1075. end
  1076. else
  1077. begin
  1078. reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
  1079. paramanager.allocparaloc(list,paraloc2);
  1080. a_paramaddr_ref(list,href,paraloc2);
  1081. paramanager.allocparaloc(list,paraloc1);
  1082. if loadref then
  1083. a_param_ref(list,OS_ADDR,ref,paraloc1)
  1084. else
  1085. a_paramaddr_ref(list,ref,paraloc1);
  1086. paramanager.freeparaloc(list,paraloc1);
  1087. paramanager.freeparaloc(list,paraloc2);
  1088. rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
  1089. a_call_name(list,'FPC_DECREF');
  1090. rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
  1091. end;
  1092. end;
  1093. procedure tcg.g_initialize(list : taasmoutput;t : tdef;const ref : treference;loadref : boolean);
  1094. var
  1095. href : treference;
  1096. paraloc1,paraloc2 : tparalocation;
  1097. begin
  1098. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  1099. paraloc2:=paramanager.getintparaloc(pocall_default,2);
  1100. if is_ansistring(t) or
  1101. is_widestring(t) or
  1102. is_interfacecom(t) then
  1103. a_load_const_ref(list,OS_ADDR,0,ref)
  1104. else
  1105. begin
  1106. reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
  1107. paramanager.allocparaloc(list,paraloc2);
  1108. a_paramaddr_ref(list,href,paraloc2);
  1109. paramanager.allocparaloc(list,paraloc1);
  1110. if loadref then
  1111. a_param_ref(list,OS_ADDR,ref,paraloc1)
  1112. else
  1113. a_paramaddr_ref(list,ref,paraloc1);
  1114. paramanager.freeparaloc(list,paraloc1);
  1115. paramanager.freeparaloc(list,paraloc2);
  1116. rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
  1117. a_call_name(list,'FPC_INITIALIZE');
  1118. rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
  1119. end;
  1120. end;
  1121. procedure tcg.g_finalize(list : taasmoutput;t : tdef;const ref : treference;loadref : boolean);
  1122. var
  1123. href : treference;
  1124. paraloc1,paraloc2 : tparalocation;
  1125. begin
  1126. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  1127. paraloc2:=paramanager.getintparaloc(pocall_default,2);
  1128. if is_ansistring(t) or
  1129. is_widestring(t) or
  1130. is_interfacecom(t) then
  1131. g_decrrefcount(list,t,ref,loadref)
  1132. else
  1133. begin
  1134. reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
  1135. paramanager.allocparaloc(list,paraloc2);
  1136. a_paramaddr_ref(list,href,paraloc2);
  1137. paramanager.allocparaloc(list,paraloc1);
  1138. if loadref then
  1139. a_param_ref(list,OS_ADDR,ref,paraloc1)
  1140. else
  1141. a_paramaddr_ref(list,ref,paraloc1);
  1142. paramanager.freeparaloc(list,paraloc1);
  1143. paramanager.freeparaloc(list,paraloc2);
  1144. rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
  1145. a_call_name(list,'FPC_FINALIZE');
  1146. rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
  1147. end;
  1148. end;
  1149. procedure tcg.g_rangecheck(list: taasmoutput; const l:tlocation;fromdef,todef: tdef);
  1150. { generate range checking code for the value at location p. The type }
  1151. { type used is checked against todefs ranges. fromdef (p.resulttype.def) }
  1152. { is the original type used at that location. When both defs are equal }
  1153. { the check is also insert (needed for succ,pref,inc,dec) }
  1154. const
  1155. {$ifdef ver1_0}
  1156. awordsignedmax=high(longint);
  1157. {$else}
  1158. awordsignedmax=high(aword) div 2;
  1159. {$endif}
  1160. var
  1161. neglabel : tasmlabel;
  1162. hreg : tregister;
  1163. lto,hto,
  1164. lfrom,hfrom : TConstExprInt;
  1165. from_signed: boolean;
  1166. begin
  1167. { range checking on and range checkable value? }
  1168. if not(cs_check_range in aktlocalswitches) or
  1169. not(fromdef.deftype in [orddef,enumdef,arraydef]) then
  1170. exit;
  1171. if is_64bit(fromdef) or is_64bit(todef) then
  1172. begin
  1173. cg64.g_rangecheck64(list,l,fromdef,todef);
  1174. exit;
  1175. end;
  1176. { only check when assigning to scalar, subranges are different, }
  1177. { when todef=fromdef then the check is always generated }
  1178. getrange(fromdef,lfrom,hfrom);
  1179. getrange(todef,lto,hto);
  1180. { no range check if from and to are equal and are both longint/dword }
  1181. { (if we have a 32bit processor) or int64/qword, since such }
  1182. { operations can at most cause overflows (JM) }
  1183. { Note that these checks are mostly processor independent, they only }
  1184. { have to be changed once we introduce 64bit subrange types }
  1185. if (fromdef = todef) and
  1186. (fromdef.deftype=orddef) and
  1187. (((sizeof(aword) = 4) and
  1188. (((torddef(fromdef).typ = s32bit) and
  1189. (lfrom = low(longint)) and
  1190. (hfrom = high(longint))) or
  1191. ((torddef(fromdef).typ = u32bit) and
  1192. (lfrom = low(cardinal)) and
  1193. (hfrom = high(cardinal)))))) then
  1194. exit;
  1195. if todef<>fromdef then
  1196. begin
  1197. { if the from-range falls completely in the to-range, no check }
  1198. { is necessary }
  1199. if (lto<=lfrom) and (hto>=hfrom) then
  1200. exit;
  1201. end;
  1202. { generate the rangecheck code for the def where we are going to }
  1203. { store the result }
  1204. { use the trick that }
  1205. { a <= x <= b <=> 0 <= x-a <= b-a <=> unsigned(x-a) <= unsigned(b-a) }
  1206. { To be able to do that, we have to make sure however that either }
  1207. { fromdef and todef are both signed or unsigned, or that we leave }
  1208. { the parts < 0 and > maxlongint out }
  1209. { is_signed now also works for arrays (it checks the rangetype) (JM) }
  1210. from_signed := is_signed(fromdef);
  1211. if from_signed xor is_signed(todef) then
  1212. if from_signed then
  1213. { from is signed, to is unsigned }
  1214. begin
  1215. { if high(from) < 0 -> always range error }
  1216. if (hfrom < 0) or
  1217. { if low(to) > maxlongint also range error }
  1218. (lto > awordsignedmax) then
  1219. begin
  1220. a_call_name(list,'FPC_RANGEERROR');
  1221. exit
  1222. end;
  1223. { from is signed and to is unsigned -> when looking at from }
  1224. { as an unsigned value, it must be < maxlongint (otherwise }
  1225. { it's negative, which is invalid since "to" is unsigned) }
  1226. if hto > awordsignedmax then
  1227. hto := awordsignedmax;
  1228. end
  1229. else
  1230. { from is unsigned, to is signed }
  1231. begin
  1232. if (lfrom > awordsignedmax) or
  1233. (hto < 0) then
  1234. begin
  1235. a_call_name(list,'FPC_RANGEERROR');
  1236. exit
  1237. end;
  1238. { from is unsigned and to is signed -> when looking at to }
  1239. { as an unsigned value, it must be >= 0 (since negative }
  1240. { values are the same as values > maxlongint) }
  1241. if lto < 0 then
  1242. lto := 0;
  1243. end;
  1244. hreg:=rg.getregisterint(list,OS_INT);
  1245. a_load_loc_reg(list,OS_INT,l,hreg);
  1246. a_op_const_reg(list,OP_SUB,OS_INT,aword(lto),hreg);
  1247. objectlibrary.getlabel(neglabel);
  1248. a_cmp_const_reg_label(list,OS_INT,OC_BE,aword(hto-lto),hreg,neglabel);
  1249. { !!! should happen right after the compare (JM) }
  1250. rg.ungetregisterint(list,hreg);
  1251. a_call_name(list,'FPC_RANGEERROR');
  1252. a_label(list,neglabel);
  1253. end;
  1254. procedure tcg.g_stackcheck(list : taasmoutput;stackframesize : longint);
  1255. var
  1256. paraloc1 : tparalocation;
  1257. begin
  1258. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  1259. paramanager.allocparaloc(list,paraloc1);
  1260. a_param_const(list,OS_32,stackframesize,paraloc1);
  1261. paramanager.freeparaloc(list,paraloc1);
  1262. a_call_name(list,'FPC_STACKCHECK');
  1263. end;
  1264. procedure tcg.g_flags2ref(list: taasmoutput; size: TCgSize; const f: tresflags; const ref:TReference);
  1265. var
  1266. tmpreg : tregister;
  1267. begin
  1268. tmpreg:=rg.getregisterint(list,size);
  1269. g_flags2reg(list,size,f,tmpreg);
  1270. a_load_reg_ref(list,size,size,tmpreg,ref);
  1271. rg.ungetregisterint(list,tmpreg);
  1272. end;
  1273. procedure tcg.g_maybe_testself(list : taasmoutput;reg:tregister);
  1274. var
  1275. OKLabel : tasmlabel;
  1276. paraloc1 : tparalocation;
  1277. begin
  1278. if (cs_check_object in aktlocalswitches) or
  1279. (cs_check_range in aktlocalswitches) then
  1280. begin
  1281. objectlibrary.getlabel(oklabel);
  1282. a_cmp_const_reg_label(list,OS_ADDR,OC_NE,0,reg,oklabel);
  1283. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  1284. paramanager.allocparaloc(list,paraloc1);
  1285. a_param_const(list,OS_INT,210,paraloc1);
  1286. paramanager.freeparaloc(list,paraloc1);
  1287. a_call_name(list,'FPC_HANDLEERROR');
  1288. a_label(list,oklabel);
  1289. end;
  1290. end;
  1291. procedure tcg.g_maybe_testvmt(list : taasmoutput;reg:tregister;objdef:tobjectdef);
  1292. var
  1293. hrefvmt : treference;
  1294. paraloc1,paraloc2 : tparalocation;
  1295. begin
  1296. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  1297. paraloc2:=paramanager.getintparaloc(pocall_default,2);
  1298. if (cs_check_object in aktlocalswitches) then
  1299. begin
  1300. reference_reset_symbol(hrefvmt,objectlibrary.newasmsymboldata(objdef.vmt_mangledname),0);
  1301. paramanager.allocparaloc(list,paraloc2);
  1302. a_paramaddr_ref(list,hrefvmt,paraloc2);
  1303. paramanager.allocparaloc(list,paraloc1);
  1304. a_param_reg(list,OS_ADDR,reg,paraloc1);
  1305. paramanager.freeparaloc(list,paraloc1);
  1306. paramanager.freeparaloc(list,paraloc2);
  1307. rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
  1308. a_call_name(list,'FPC_CHECK_OBJECT_EXT');
  1309. rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
  1310. end
  1311. else
  1312. if (cs_check_range in aktlocalswitches) then
  1313. begin
  1314. paramanager.allocparaloc(list,paraloc1);
  1315. a_param_reg(list,OS_ADDR,reg,paraloc1);
  1316. paramanager.freeparaloc(list,paraloc1);
  1317. rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
  1318. a_call_name(list,'FPC_CHECK_OBJECT');
  1319. rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
  1320. end;
  1321. end;
  1322. {*****************************************************************************
  1323. Entry/Exit Code Functions
  1324. *****************************************************************************}
  1325. procedure tcg.g_interrupt_stackframe_entry(list : taasmoutput);
  1326. begin
  1327. end;
  1328. procedure tcg.g_interrupt_stackframe_exit(list : taasmoutput;accused,acchiused:boolean);
  1329. begin
  1330. end;
  1331. procedure tcg.g_profilecode(list : taasmoutput);
  1332. begin
  1333. end;
  1334. procedure tcg.g_exception_reason_save(list : taasmoutput; const href : treference);
  1335. begin
  1336. a_load_reg_ref(list, OS_S32, OS_32, NR_FUNCTION_RETURN_REG, href);
  1337. end;
  1338. procedure tcg.g_exception_reason_save_const(list : taasmoutput; const href : treference; a: aword);
  1339. begin
  1340. a_load_const_ref(list, OS_S32, a, href);
  1341. end;
  1342. procedure tcg.g_exception_reason_load(list : taasmoutput; const href : treference);
  1343. begin
  1344. a_load_ref_reg(list, OS_S32, OS_S32, href, NR_FUNCTION_RETURN_REG);
  1345. end;
  1346. procedure tcg64.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : qword; regsrc,regdst : tregister64);
  1347. begin
  1348. a_load64_reg_reg(list,regsrc,regdst,false);
  1349. a_op64_const_reg(list,op,value,regdst);
  1350. end;
  1351. procedure tcg64.a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64);
  1352. begin
  1353. a_load64_reg_reg(list,regsrc2,regdst,false);
  1354. a_op64_reg_reg(list,op,regsrc1,regdst);
  1355. end;
  1356. initialization
  1357. ;
  1358. finalization
  1359. cg.free;
  1360. cg64.free;
  1361. end.
  1362. {
  1363. $Log$
  1364. Revision 1.121 2003-09-10 08:31:47 marco
  1365. * Patch from Peter for paraloc
  1366. Revision 1.120 2003/09/09 20:59:27 daniel
  1367. * Adding register allocation order
  1368. Revision 1.119 2003/09/07 22:09:34 peter
  1369. * preparations for different default calling conventions
  1370. * various RA fixes
  1371. Revision 1.118 2003/09/03 15:55:00 peter
  1372. * NEWRA branch merged
  1373. Revision 1.117 2003/09/03 11:18:36 florian
  1374. * fixed arm concatcopy
  1375. + arm support in the common compiler sources added
  1376. * moved some generic cg code around
  1377. + tfputype added
  1378. * ...
  1379. Revision 1.116.2.4 2003/08/29 17:28:59 peter
  1380. * next batch of updates
  1381. Revision 1.116.2.3 2003/08/28 18:35:07 peter
  1382. * tregister changed to cardinal
  1383. Revision 1.116.2.2 2003/08/27 20:23:55 peter
  1384. * remove old ra code
  1385. Revision 1.116.2.1 2003/08/27 19:55:54 peter
  1386. * first tregister patch
  1387. Revision 1.116 2003/08/17 16:59:20 jonas
  1388. * fixed regvars so they work with newra (at least for ppc)
  1389. * fixed some volatile register bugs
  1390. + -dnotranslation option for -dnewra, which causes the registers not to
  1391. be translated from virtual to normal registers. Requires support in
  1392. the assembler writer as well, which is only implemented in aggas/
  1393. agppcgas currently
  1394. Revision 1.115 2003/07/23 11:01:14 jonas
  1395. * several rg.allocexplicitregistersint/rg.deallocexplicitregistersint
  1396. pairs round calls to helpers
  1397. Revision 1.114 2003/07/06 17:58:22 peter
  1398. * framepointer fixes for sparc
  1399. * parent framepointer code more generic
  1400. Revision 1.113 2003/07/02 22:18:04 peter
  1401. * paraloc splitted in callerparaloc,calleeparaloc
  1402. * sparc calling convention updates
  1403. Revision 1.112 2003/06/13 21:19:30 peter
  1404. * current_procdef removed, use current_procinfo.procdef instead
  1405. Revision 1.111 2003/06/12 21:11:10 peter
  1406. * ungetregisterfpu gets size parameter
  1407. Revision 1.110 2003/06/12 16:43:07 peter
  1408. * newra compiles for sparc
  1409. Revision 1.109 2003/06/07 18:57:04 jonas
  1410. + added freeintparaloc
  1411. * ppc get/freeintparaloc now check whether the parameter regs are
  1412. properly allocated/deallocated (and get an extra list para)
  1413. * ppc a_call_* now internalerrors if pi_do_call is not yet set
  1414. * fixed lot of missing pi_do_call's
  1415. Revision 1.108 2003/06/06 14:43:02 peter
  1416. * g_copyopenarrayvalue gets length reference
  1417. * don't copy open arrays for cdecl
  1418. Revision 1.107 2003/06/03 21:11:09 peter
  1419. * cg.a_load_* get a from and to size specifier
  1420. * makeregsize only accepts newregister
  1421. * i386 uses generic tcgnotnode,tcgunaryminus
  1422. Revision 1.106 2003/06/03 13:01:59 daniel
  1423. * Register allocator finished
  1424. Revision 1.105 2003/06/01 21:38:06 peter
  1425. * getregisterfpu size parameter added
  1426. * op_const_reg size parameter added
  1427. * sparc updates
  1428. Revision 1.104 2003/06/01 01:02:39 peter
  1429. * generic a_call_ref
  1430. Revision 1.103 2003/05/30 23:57:08 peter
  1431. * more sparc cleanup
  1432. * accumulator removed, splitted in function_return_reg (called) and
  1433. function_result_reg (caller)
  1434. Revision 1.102 2003/05/30 23:49:18 jonas
  1435. * a_load_loc_reg now has an extra size parameter for the destination
  1436. register (properly fixes what I worked around in revision 1.106 of
  1437. ncgutil.pas)
  1438. Revision 1.101 2003/05/30 21:40:00 jonas
  1439. * fixed bug in a_load_loc_ref (the source instead of dest size was passed
  1440. to a_load_reg_ref in case of a register)
  1441. Revision 1.100 2003/05/30 12:36:13 jonas
  1442. * use as little different registers on the ppc until newra is released,
  1443. since every used register must be saved
  1444. Revision 1.99 2003/05/23 14:27:35 peter
  1445. * remove some unit dependencies
  1446. * current_procinfo changes to store more info
  1447. Revision 1.98 2003/05/15 18:58:53 peter
  1448. * removed selfpointer_offset, vmtpointer_offset
  1449. * tvarsym.adjusted_address
  1450. * address in localsymtable is now in the real direction
  1451. * removed some obsolete globals
  1452. Revision 1.97 2003/05/13 19:14:41 peter
  1453. * failn removed
  1454. * inherited result code check moven to pexpr
  1455. Revision 1.96 2003/05/11 21:37:03 peter
  1456. * moved implicit exception frame from ncgutil to psub
  1457. * constructor/destructor helpers moved from cobj/ncgutil to psub
  1458. Revision 1.95 2003/05/09 17:47:02 peter
  1459. * self moved to hidden parameter
  1460. * removed hdisposen,hnewn,selfn
  1461. Revision 1.94 2003/05/01 12:23:46 jonas
  1462. * fix for op_reg_reg_reg in case the destination is the same as the first
  1463. source register
  1464. Revision 1.93 2003/04/29 07:28:52 michael
  1465. + Patch from peter to fix wrong pushing of ansistring function results in open array
  1466. Revision 1.92 2003/04/27 11:21:32 peter
  1467. * aktprocdef renamed to current_procinfo.procdef
  1468. * procinfo renamed to current_procinfo
  1469. * procinfo will now be stored in current_module so it can be
  1470. cleaned up properly
  1471. * gen_main_procsym changed to create_main_proc and release_main_proc
  1472. to also generate a tprocinfo structure
  1473. * fixed unit implicit initfinal
  1474. Revision 1.91 2003/04/27 07:29:50 peter
  1475. * current_procinfo.procdef cleanup, current_procdef is now always nil when parsing
  1476. a new procdef declaration
  1477. * aktprocsym removed
  1478. * lexlevel removed, use symtable.symtablelevel instead
  1479. * implicit init/final code uses the normal genentry/genexit
  1480. * funcret state checking updated for new funcret handling
  1481. Revision 1.90 2003/04/26 20:57:17 florian
  1482. * fixed para locations of fpc_class_new helper call
  1483. Revision 1.89 2003/04/26 17:21:08 florian
  1484. * fixed passing of fpu values by fpu register
  1485. Revision 1.88 2003/04/23 20:16:03 peter
  1486. + added currency support based on int64
  1487. + is_64bit for use in cg units instead of is_64bitint
  1488. * removed cgmessage from n386add, replace with internalerrors
  1489. Revision 1.87 2003/04/23 14:42:07 daniel
  1490. * Further register allocator work. Compiler now smaller with new
  1491. allocator than without.
  1492. * Somebody forgot to adjust ppu version number
  1493. Revision 1.86 2003/04/23 13:20:34 peter
  1494. * fix self passing to fpc_help_fail
  1495. Revision 1.85 2003/04/23 12:35:34 florian
  1496. * fixed several issues with powerpc
  1497. + applied a patch from Jonas for nested function calls (PowerPC only)
  1498. * ...
  1499. Revision 1.84 2003/04/22 14:33:38 peter
  1500. * removed some notes/hints
  1501. Revision 1.83 2003/04/22 13:47:08 peter
  1502. * fixed C style array of const
  1503. * fixed C array passing
  1504. * fixed left to right with high parameters
  1505. Revision 1.82 2003/04/22 10:09:34 daniel
  1506. + Implemented the actual register allocator
  1507. + Scratch registers unavailable when new register allocator used
  1508. + maybe_save/maybe_restore unavailable when new register allocator used
  1509. Revision 1.81 2003/04/06 21:11:23 olle
  1510. * changed newasmsymbol to newasmsymboldata for data symbols
  1511. Revision 1.80 2003/03/28 19:16:56 peter
  1512. * generic constructor working for i386
  1513. * remove fixed self register
  1514. * esi added as address register for i386
  1515. Revision 1.79 2003/03/22 18:07:18 jonas
  1516. + add used scratch registers to usedintbyproc for non-i386
  1517. Revision 1.78 2003/03/11 21:46:24 jonas
  1518. * lots of new regallocator fixes, both in generic and ppc-specific code
  1519. (ppc compiler still can't compile the linux system unit though)
  1520. Revision 1.77 2003/02/19 22:00:14 daniel
  1521. * Code generator converted to new register notation
  1522. - Horribily outdated todo.txt removed
  1523. Revision 1.76 2003/01/31 22:47:48 peter
  1524. * maybe_testself now really uses the passed register
  1525. Revision 1.75 2003/01/30 21:46:35 peter
  1526. * maybe_testvmt added
  1527. Revision 1.74 2003/01/17 12:45:40 daniel
  1528. * Fixed internalerror 200301081 problem
  1529. Revision 1.73 2003/01/13 14:54:34 daniel
  1530. * Further work to convert codegenerator register convention;
  1531. internalerror bug fixed.
  1532. Revision 1.72 2003/01/09 22:00:53 florian
  1533. * fixed some PowerPC issues
  1534. Revision 1.71 2003/01/09 20:41:10 florian
  1535. * fixed broken PowerPC compiler
  1536. Revision 1.70 2003/01/08 18:43:56 daniel
  1537. * Tregister changed into a record
  1538. Revision 1.69 2002/12/24 15:56:50 peter
  1539. * stackpointer_alloc added for adjusting ESP. Win32 needs
  1540. this for the pageprotection
  1541. Revision 1.68 2002/12/20 18:14:04 peter
  1542. * removed some runerror and writeln
  1543. Revision 1.67 2002/12/14 15:02:03 carl
  1544. * maxoperands -> max_operands (for portability in rautils.pas)
  1545. * fix some range-check errors with loadconst
  1546. + add ncgadd unit to m68k
  1547. * some bugfix of a_param_reg with LOC_CREFERENCE
  1548. Revision 1.66 2002/11/25 17:43:16 peter
  1549. * splitted defbase in defutil,symutil,defcmp
  1550. * merged isconvertable and is_equal into compare_defs(_ext)
  1551. * made operator search faster by walking the list only once
  1552. Revision 1.65 2002/11/17 16:27:31 carl
  1553. * document flags2reg
  1554. Revision 1.64 2002/11/16 17:06:28 peter
  1555. * return error 210 for failed self test
  1556. Revision 1.63 2002/11/15 01:58:46 peter
  1557. * merged changes from 1.0.7 up to 04-11
  1558. - -V option for generating bug report tracing
  1559. - more tracing for option parsing
  1560. - errors for cdecl and high()
  1561. - win32 import stabs
  1562. - win32 records<=8 are returned in eax:edx (turned off by default)
  1563. - heaptrc update
  1564. - more info for temp management in .s file with EXTDEBUG
  1565. Revision 1.62 2002/10/16 19:01:43 peter
  1566. + $IMPLICITEXCEPTIONS switch to turn on/off generation of the
  1567. implicit exception frames for procedures with initialized variables
  1568. and for constructors. The default is on for compatibility
  1569. Revision 1.61 2002/10/05 12:43:23 carl
  1570. * fixes for Delphi 6 compilation
  1571. (warning : Some features do not work under Delphi)
  1572. Revision 1.60 2002/10/02 18:20:52 peter
  1573. * Copy() is now internal syssym that calls compilerprocs
  1574. Revision 1.59 2002/09/17 18:54:02 jonas
  1575. * a_load_reg_reg() now has two size parameters: source and dest. This
  1576. allows some optimizations on architectures that don't encode the
  1577. register size in the register name.
  1578. Revision 1.58 2002/09/09 19:29:29 peter
  1579. * fixed dynarr_decr_ref call
  1580. Revision 1.57 2002/09/07 15:25:01 peter
  1581. * old logs removed and tabs fixed
  1582. Revision 1.56 2002/09/01 21:04:47 florian
  1583. * several powerpc related stuff fixed
  1584. Revision 1.55 2002/09/01 17:05:43 florian
  1585. + added abstract tcg.g_removevaluepara_openarray
  1586. Revision 1.54 2002/09/01 12:09:27 peter
  1587. + a_call_reg, a_call_loc added
  1588. * removed exprasmlist references
  1589. Revision 1.53 2002/08/19 18:17:48 carl
  1590. + optimize64_op_const_reg implemented (optimizes 64-bit constant opcodes)
  1591. * more fixes to m68k for 64-bit operations
  1592. Revision 1.52 2002/08/17 22:09:43 florian
  1593. * result type handling in tcgcal.pass_2 overhauled
  1594. * better tnode.dowrite
  1595. * some ppc stuff fixed
  1596. Revision 1.51 2002/08/17 09:23:33 florian
  1597. * first part of procinfo rewrite
  1598. Revision 1.50 2002/08/16 14:24:57 carl
  1599. * issameref() to test if two references are the same (then emit no opcodes)
  1600. + ret_in_reg to replace ret_in_acc
  1601. (fix some register allocation bugs at the same time)
  1602. + save_std_register now has an extra parameter which is the
  1603. usedinproc registers
  1604. Revision 1.49 2002/08/15 08:13:54 carl
  1605. - a_load_sym_ofs_reg removed
  1606. * loadvmt now calls loadaddr_ref_reg instead
  1607. Revision 1.48 2002/08/14 19:26:02 carl
  1608. + routine to optimize opcodes with constants
  1609. Revision 1.47 2002/08/11 14:32:26 peter
  1610. * renamed current_library to objectlibrary
  1611. Revision 1.46 2002/08/11 13:24:11 peter
  1612. * saving of asmsymbols in ppu supported
  1613. * asmsymbollist global is removed and moved into a new class
  1614. tasmlibrarydata that will hold the info of a .a file which
  1615. corresponds with a single module. Added librarydata to tmodule
  1616. to keep the library info stored for the module. In the future the
  1617. objectfiles will also be stored to the tasmlibrarydata class
  1618. * all getlabel/newasmsymbol and friends are moved to the new class
  1619. Revision 1.45 2002/08/10 17:15:20 jonas
  1620. * register parameters are now LOC_CREGISTER instead of LOC_REGISTER
  1621. Revision 1.44 2002/08/09 19:10:05 carl
  1622. - moved new_exception and free_exception to ncgutils
  1623. Revision 1.43 2002/08/05 18:27:48 carl
  1624. + more more more documentation
  1625. + first version include/exclude (can't test though, not enough scratch for i386 :()...
  1626. Revision 1.42 2002/08/04 19:08:21 carl
  1627. + added generic exception support (still does not work!)
  1628. + more documentation
  1629. Revision 1.41 2002/07/30 20:50:43 florian
  1630. * the code generator knows now if parameters are in registers
  1631. Revision 1.40 2002/07/29 21:16:02 florian
  1632. * some more ppc fixes
  1633. Revision 1.39 2002/07/28 15:56:00 jonas
  1634. + tcg64.a_op64_const_reg_reg() and tcg64.a_op64_reg_reg_reg() methods +
  1635. generic implementation
  1636. Revision 1.38 2002/07/27 19:53:51 jonas
  1637. + generic implementation of tcg.g_flags2ref()
  1638. * tcg.flags2xxx() now also needs a size parameter
  1639. Revision 1.37 2002/07/20 11:57:53 florian
  1640. * types.pas renamed to defbase.pas because D6 contains a types
  1641. unit so this would conflicts if D6 programms are compiled
  1642. + Willamette/SSE2 instructions to assembler added
  1643. }