cgobj.pas 77 KB

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