cgcpu.pas 100 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. This unit implements the code generator for the PowerPC
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit cgcpu;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. cgbase,cgobj,
  23. aasmbase,aasmcpu,aasmtai,
  24. cpubase,cpuinfo,node,cg64f32,cginfo;
  25. type
  26. tcgppc = class(tcg)
  27. { passing parameters, per default the parameter is pushed }
  28. { nr gives the number of the parameter (enumerated from }
  29. { left to right), this allows to move the parameter to }
  30. { register, if the cpu supports register calling }
  31. { conventions }
  32. procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;const locpara : tparalocation);override;
  33. procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const locpara : tparalocation);override;
  34. procedure a_paramaddr_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);override;
  35. procedure a_call_name(list : taasmoutput;const s : string);override;
  36. procedure a_call_reg(list : taasmoutput;reg: tregister); override;
  37. procedure a_call_ref(list : taasmoutput;const ref : treference);override;
  38. procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister); override;
  39. procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister); override;
  40. procedure a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
  41. size: tcgsize; a: aword; src, dst: tregister); override;
  42. procedure a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
  43. size: tcgsize; src1, src2, dst: tregister); override;
  44. { move instructions }
  45. procedure a_load_const_reg(list : taasmoutput; size: tcgsize; a : aword;reg : tregister);override;
  46. procedure a_load_reg_ref(list : taasmoutput; size: tcgsize; reg : tregister;const ref : treference);override;
  47. procedure a_load_ref_reg(list : taasmoutput;size : tcgsize;const Ref : treference;reg : tregister);override;
  48. procedure a_load_reg_reg(list : taasmoutput;fromsize, tosize : tcgsize;reg1,reg2 : tregister);override;
  49. { fpu move instructions }
  50. procedure a_loadfpu_reg_reg(list: taasmoutput; reg1, reg2: tregister); override;
  51. procedure a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister); override;
  52. procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); override;
  53. { comparison operations }
  54. procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
  55. l : tasmlabel);override;
  56. procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
  57. procedure a_jmp_always(list : taasmoutput;l: tasmlabel); override;
  58. procedure a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); override;
  59. procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: TResFlags; reg: TRegister); override;
  60. procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer);override;
  61. procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
  62. procedure g_return_from_proc(list : taasmoutput;parasize : aword); override;
  63. procedure g_restore_frame_pointer(list : taasmoutput);override;
  64. procedure a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);override;
  65. procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);override;
  66. procedure g_overflowcheck(list: taasmoutput; const p: tnode); override;
  67. { find out whether a is of the form 11..00..11b or 00..11...00. If }
  68. { that's the case, we can use rlwinm to do an AND operation }
  69. function get_rlwi_const(a: aword; var l1, l2: longint): boolean;
  70. procedure g_save_standard_registers(list : taasmoutput; usedinproc : Tsupregset);override;
  71. procedure g_restore_standard_registers(list : taasmoutput; usedinproc : Tsupregset);override;
  72. procedure g_save_all_registers(list : taasmoutput);override;
  73. procedure g_restore_all_registers(list : taasmoutput;accused,acchiused:boolean);override;
  74. procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
  75. private
  76. procedure g_stackframe_entry_sysv(list : taasmoutput;localsize : longint);
  77. procedure g_return_from_proc_sysv(list : taasmoutput;parasize : aword);
  78. procedure g_stackframe_entry_aix(list : taasmoutput;localsize : longint);
  79. procedure g_return_from_proc_aix(list : taasmoutput;parasize : aword);
  80. procedure g_stackframe_entry_mac(list : taasmoutput;localsize : longint);
  81. procedure g_return_from_proc_mac(list : taasmoutput;parasize : aword);
  82. { Make sure ref is a valid reference for the PowerPC and sets the }
  83. { base to the value of the index if (base = R_NO). }
  84. { Returns true if the reference contained a base, index and an }
  85. { offset or symbol, in which case the base will have been changed }
  86. { to a tempreg (which has to be freed by the caller) containing }
  87. { the sum of part of the original reference }
  88. function fixref(list: taasmoutput; var ref: treference): boolean;
  89. { returns whether a reference can be used immediately in a powerpc }
  90. { instruction }
  91. function issimpleref(const ref: treference): boolean;
  92. { contains the common code of a_load_reg_ref and a_load_ref_reg }
  93. procedure a_load_store(list:taasmoutput;op: tasmop;reg:tregister;
  94. ref: treference);
  95. { creates the correct branch instruction for a given combination }
  96. { of asmcondflags and destination addressing mode }
  97. procedure a_jmp(list: taasmoutput; op: tasmop;
  98. c: tasmcondflag; crval: longint; l: tasmlabel);
  99. end;
  100. tcg64fppc = class(tcg64f32)
  101. procedure a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);override;
  102. procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;reg : tregister64);override;
  103. procedure a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : qword;regsrc,regdst : tregister64);override;
  104. procedure a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64);override;
  105. end;
  106. const
  107. TOpCG2AsmOpConstLo: Array[topcg] of TAsmOp = (A_NONE,A_ADDI,A_ANDI_,A_DIVWU,
  108. A_DIVW,A_MULLW, A_MULLW, A_NONE,A_NONE,A_ORI,
  109. A_SRAWI,A_SLWI,A_SRWI,A_SUBI,A_XORI);
  110. TOpCG2AsmOpConstHi: Array[topcg] of TAsmOp = (A_NONE,A_ADDIS,A_ANDIS_,
  111. A_DIVWU,A_DIVW, A_MULLW,A_MULLW,A_NONE,A_NONE,
  112. A_ORIS,A_NONE, A_NONE,A_NONE,A_SUBIS,A_XORIS);
  113. TOpCmp2AsmCond: Array[topcmp] of TAsmCondFlag = (C_NONE,C_EQ,C_GT,
  114. C_LT,C_GE,C_LE,C_NE,C_LE,C_LT,C_GE,C_GT);
  115. implementation
  116. uses
  117. globtype,globals,verbose,systems,cutils,symconst,symdef,symsym,rgobj,tgobj,cpupi;
  118. { parameter passing... Still needs extra support from the processor }
  119. { independent code generator }
  120. procedure tcgppc.a_param_const(list : taasmoutput;size : tcgsize;a : aword;const locpara : tparalocation);
  121. var
  122. ref: treference;
  123. begin
  124. case locpara.loc of
  125. LOC_REGISTER,LOC_CREGISTER:
  126. a_load_const_reg(list,size,a,locpara.register);
  127. LOC_REFERENCE:
  128. begin
  129. reference_reset(ref);
  130. ref.base:=locpara.reference.index;
  131. ref.offset:=locpara.reference.offset;
  132. a_load_const_ref(list,size,a,ref);
  133. end;
  134. else
  135. internalerror(2002081101);
  136. end;
  137. if locpara.sp_fixup<>0 then
  138. internalerror(2002081102);
  139. end;
  140. procedure tcgppc.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const locpara : tparalocation);
  141. var
  142. ref: treference;
  143. tmpreg: tregister;
  144. begin
  145. case locpara.loc of
  146. LOC_REGISTER,LOC_CREGISTER:
  147. a_load_ref_reg(list,size,r,locpara.register);
  148. LOC_REFERENCE:
  149. begin
  150. reference_reset(ref);
  151. ref.base:=locpara.reference.index;
  152. ref.offset:=locpara.reference.offset;
  153. tmpreg := get_scratch_reg_int(list,size);
  154. a_load_ref_reg(list,size,r,tmpreg);
  155. a_load_reg_ref(list,size,tmpreg,ref);
  156. free_scratch_reg(list,tmpreg);
  157. end;
  158. LOC_FPUREGISTER,LOC_CFPUREGISTER:
  159. case size of
  160. OS_F32, OS_F64:
  161. a_loadfpu_ref_reg(list,size,r,locpara.register);
  162. else
  163. internalerror(2002072801);
  164. end;
  165. else
  166. internalerror(2002081103);
  167. end;
  168. if locpara.sp_fixup<>0 then
  169. internalerror(2002081104);
  170. end;
  171. procedure tcgppc.a_paramaddr_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);
  172. var
  173. ref: treference;
  174. tmpreg: tregister;
  175. begin
  176. case locpara.loc of
  177. LOC_REGISTER,LOC_CREGISTER:
  178. a_loadaddr_ref_reg(list,r,locpara.register);
  179. LOC_REFERENCE:
  180. begin
  181. reference_reset(ref);
  182. ref.base := locpara.reference.index;
  183. ref.offset := locpara.reference.offset;
  184. tmpreg := get_scratch_reg_address(list);
  185. a_loadaddr_ref_reg(list,r,tmpreg);
  186. a_load_reg_ref(list,OS_ADDR,tmpreg,ref);
  187. free_scratch_reg(list,tmpreg);
  188. end;
  189. else
  190. internalerror(2002080701);
  191. end;
  192. end;
  193. { calling a procedure by name }
  194. procedure tcgppc.a_call_name(list : taasmoutput;const s : string);
  195. var
  196. href : treference;
  197. begin
  198. { MacOS: The linker on MacOS (PPCLink) inserts a call to glue code,
  199. if it is a cross-TOC call. If so, it also replaces the NOP
  200. with some restore code.}
  201. list.concat(taicpu.op_sym(A_BL,objectlibrary.newasmsymbol(s)));
  202. if target_info.system=system_powerpc_macos then
  203. list.concat(taicpu.op_none(A_NOP));
  204. include(current_procinfo.flags,pi_do_call);
  205. end;
  206. { calling a procedure by address }
  207. procedure tcgppc.a_call_reg(list : taasmoutput;reg: tregister);
  208. var
  209. tmpreg : tregister;
  210. tmpref : treference;
  211. begin
  212. if target_info.system=system_powerpc_macos then
  213. begin
  214. {Generate instruction to load the procedure address from
  215. the transition vector.}
  216. //TODO: Support cross-TOC calls.
  217. tmpreg := get_scratch_reg_int(list,OS_INT);
  218. reference_reset(tmpref);
  219. tmpref.offset := 0;
  220. //tmpref.symaddr := refs_full;
  221. tmpref.base:= reg;
  222. list.concat(taicpu.op_reg_ref(A_LWZ,tmpreg,tmpref));
  223. list.concat(taicpu.op_reg(A_MTCTR,tmpreg));
  224. free_scratch_reg(list,tmpreg);
  225. end
  226. else
  227. list.concat(taicpu.op_reg(A_MTCTR,reg));
  228. list.concat(taicpu.op_none(A_BCTRL));
  229. //if target_info.system=system_powerpc_macos then
  230. // //NOP is not needed here.
  231. // list.concat(taicpu.op_none(A_NOP));
  232. include(current_procinfo.flags,pi_do_call);
  233. //list.concat(tai_comment.create(strpnew('***** a_call_reg')));
  234. end;
  235. { calling a procedure by address }
  236. procedure tcgppc.a_call_ref(list : taasmoutput;const ref : treference);
  237. var
  238. tmpreg : tregister;
  239. tmpref : treference;
  240. begin
  241. tmpreg := get_scratch_reg_int(list,OS_ADDR);
  242. a_load_ref_reg(list,OS_ADDR,ref,tmpreg);
  243. if target_info.system=system_powerpc_macos then
  244. begin
  245. {Generate instruction to load the procedure address from
  246. the transition vector.}
  247. //TODO: Support cross-TOC calls.
  248. reference_reset(tmpref);
  249. tmpref.offset := 0;
  250. //tmpref.symaddr := refs_full;
  251. tmpref.base:= tmpreg;
  252. list.concat(taicpu.op_reg_ref(A_LWZ,tmpreg,tmpref));
  253. end;
  254. list.concat(taicpu.op_reg(A_MTCTR,tmpreg));
  255. free_scratch_reg(list,tmpreg);
  256. list.concat(taicpu.op_none(A_BCTRL));
  257. //if target_info.system=system_powerpc_macos then
  258. // //NOP is not needed here.
  259. // list.concat(taicpu.op_none(A_NOP));
  260. include(current_procinfo.flags,pi_do_call);
  261. //list.concat(tai_comment.create(strpnew('***** a_call_ref')));
  262. end;
  263. {********************** load instructions ********************}
  264. procedure tcgppc.a_load_const_reg(list : taasmoutput; size: TCGSize; a : aword; reg : TRegister);
  265. begin
  266. if not(size in [OS_8,OS_S8,OS_16,OS_S16,OS_32,OS_S32]) then
  267. internalerror(2002090902);
  268. if (longint(a) >= low(smallint)) and
  269. (longint(a) <= high(smallint)) then
  270. list.concat(taicpu.op_reg_const(A_LI,reg,smallint(a)))
  271. else if ((a and $ffff) <> 0) then
  272. begin
  273. list.concat(taicpu.op_reg_const(A_LI,reg,smallint(a and $ffff)));
  274. if ((a shr 16) <> 0) or
  275. (smallint(a and $ffff) < 0) then
  276. list.concat(taicpu.op_reg_reg_const(A_ADDIS,reg,reg,
  277. smallint((a shr 16)+ord(smallint(a and $ffff) < 0))))
  278. end
  279. else
  280. list.concat(taicpu.op_reg_const(A_LIS,reg,smallint(a shr 16)));
  281. end;
  282. procedure tcgppc.a_load_reg_ref(list : taasmoutput; size: TCGSize; reg : tregister;const ref : treference);
  283. const
  284. StoreInstr: Array[OS_8..OS_32,boolean, boolean] of TAsmOp =
  285. { indexed? updating?}
  286. (((A_STB,A_STBU),(A_STBX,A_STBUX)),
  287. ((A_STH,A_STHU),(A_STHX,A_STHUX)),
  288. ((A_STW,A_STWU),(A_STWX,A_STWUX)));
  289. var
  290. op: TAsmOp;
  291. ref2: TReference;
  292. freereg: boolean;
  293. begin
  294. ref2 := ref;
  295. freereg := fixref(list,ref2);
  296. if size in [OS_S8..OS_S16] then
  297. { storing is the same for signed and unsigned values }
  298. size := tcgsize(ord(size)-(ord(OS_S8)-ord(OS_8)));
  299. { 64 bit stuff should be handled separately }
  300. if size in [OS_64,OS_S64] then
  301. internalerror(200109236);
  302. op := storeinstr[tcgsize2unsigned[size],ref2.index.number<>NR_NO,false];
  303. a_load_store(list,op,reg,ref2);
  304. if freereg then
  305. cg.free_scratch_reg(list,ref2.base);
  306. End;
  307. procedure tcgppc.a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref: treference;reg : tregister);
  308. const
  309. LoadInstr: Array[OS_8..OS_S32,boolean, boolean] of TAsmOp =
  310. { indexed? updating?}
  311. (((A_LBZ,A_LBZU),(A_LBZX,A_LBZUX)),
  312. ((A_LHZ,A_LHZU),(A_LHZX,A_LHZUX)),
  313. ((A_LWZ,A_LWZU),(A_LWZX,A_LWZUX)),
  314. { 64bit stuff should be handled separately }
  315. ((A_NONE,A_NONE),(A_NONE,A_NONE)),
  316. { there's no load-byte-with-sign-extend :( }
  317. ((A_LBZ,A_LBZU),(A_LBZX,A_LBZUX)),
  318. ((A_LHA,A_LHAU),(A_LHAX,A_LHAUX)),
  319. ((A_LWZ,A_LWZU),(A_LWZX,A_LWZUX)));
  320. var
  321. op: tasmop;
  322. tmpreg: tregister;
  323. ref2, tmpref: treference;
  324. freereg: boolean;
  325. begin
  326. if not(size in [OS_8,OS_S8,OS_16,OS_S16,OS_32,OS_S32]) then
  327. internalerror(2002090902);
  328. ref2 := ref;
  329. freereg := fixref(list,ref2);
  330. op := loadinstr[size,ref2.index.number<>NR_NO,false];
  331. a_load_store(list,op,reg,ref2);
  332. if freereg then
  333. free_scratch_reg(list,ref2.base);
  334. { sign extend shortint if necessary, since there is no }
  335. { load instruction that does that automatically (JM) }
  336. if size = OS_S8 then
  337. list.concat(taicpu.op_reg_reg(A_EXTSB,reg,reg));
  338. end;
  339. procedure tcgppc.a_load_reg_reg(list : taasmoutput;fromsize, tosize : tcgsize;reg1,reg2 : tregister);
  340. begin
  341. if (reg1.enum<>R_INTREGISTER) or (reg1.number = 0) then
  342. internalerror(200303101);
  343. if (reg2.enum<>R_INTREGISTER) or (reg2.number = 0) then
  344. internalerror(200303102);
  345. if (reg1.number<>reg2.number) or
  346. (tcgsize2size[tosize] < tcgsize2size[fromsize]) or
  347. ((tcgsize2size[tosize] = tcgsize2size[fromsize]) and
  348. (tosize <> fromsize) and
  349. not(fromsize in [OS_32,OS_S32])) then
  350. begin
  351. case tosize of
  352. OS_8:
  353. list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,
  354. reg2,reg1,0,31-8+1,31));
  355. OS_S8:
  356. list.concat(taicpu.op_reg_reg(A_EXTSB,reg2,reg1));
  357. OS_16:
  358. list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,
  359. reg2,reg1,0,31-16+1,31));
  360. OS_S16:
  361. list.concat(taicpu.op_reg_reg(A_EXTSH,reg2,reg1));
  362. OS_32,OS_S32:
  363. list.concat(taicpu.op_reg_reg(A_MR,reg2,reg1));
  364. else internalerror(2002090901);
  365. end;
  366. end;
  367. end;
  368. procedure tcgppc.a_loadfpu_reg_reg(list: taasmoutput; reg1, reg2: tregister);
  369. begin
  370. list.concat(taicpu.op_reg_reg(A_FMR,reg2,reg1));
  371. end;
  372. procedure tcgppc.a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister);
  373. const
  374. FpuLoadInstr: Array[OS_F32..OS_F64,boolean, boolean] of TAsmOp =
  375. { indexed? updating?}
  376. (((A_LFS,A_LFSU),(A_LFSX,A_LFSUX)),
  377. ((A_LFD,A_LFDU),(A_LFDX,A_LFDUX)));
  378. var
  379. op: tasmop;
  380. ref2: treference;
  381. freereg: boolean;
  382. begin
  383. { several functions call this procedure with OS_32 or OS_64 }
  384. { so this makes life easier (FK) }
  385. case size of
  386. OS_32,OS_F32:
  387. size:=OS_F32;
  388. OS_64,OS_F64,OS_C64:
  389. size:=OS_F64;
  390. else
  391. internalerror(200201121);
  392. end;
  393. ref2 := ref;
  394. freereg := fixref(list,ref2);
  395. op := fpuloadinstr[size,ref2.index.number <> NR_NO,false];
  396. a_load_store(list,op,reg,ref2);
  397. if freereg then
  398. cg.free_scratch_reg(list,ref2.base);
  399. end;
  400. procedure tcgppc.a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference);
  401. const
  402. FpuStoreInstr: Array[OS_F32..OS_F64,boolean, boolean] of TAsmOp =
  403. { indexed? updating?}
  404. (((A_STFS,A_STFSU),(A_STFSX,A_STFSUX)),
  405. ((A_STFD,A_STFDU),(A_STFDX,A_STFDUX)));
  406. var
  407. op: tasmop;
  408. ref2: treference;
  409. freereg: boolean;
  410. begin
  411. if not(size in [OS_F32,OS_F64]) then
  412. internalerror(200201122);
  413. ref2 := ref;
  414. freereg := fixref(list,ref2);
  415. op := fpustoreinstr[size,ref2.index.number <> NR_NO,false];
  416. a_load_store(list,op,reg,ref2);
  417. if freereg then
  418. cg.free_scratch_reg(list,ref2.base);
  419. end;
  420. procedure tcgppc.a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister);
  421. var
  422. scratch_register: TRegister;
  423. begin
  424. a_op_const_reg_reg(list,op,OS_32,a,reg,reg);
  425. end;
  426. procedure tcgppc.a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister);
  427. begin
  428. a_op_reg_reg_reg(list,op,OS_32,src,dst,dst);
  429. end;
  430. procedure tcgppc.a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
  431. size: tcgsize; a: aword; src, dst: tregister);
  432. var
  433. l1,l2: longint;
  434. oplo, ophi: tasmop;
  435. scratchreg: tregister;
  436. useReg, gotrlwi: boolean;
  437. procedure do_lo_hi;
  438. begin
  439. list.concat(taicpu.op_reg_reg_const(oplo,dst,src,word(a)));
  440. list.concat(taicpu.op_reg_reg_const(ophi,dst,dst,word(a shr 16)));
  441. end;
  442. begin
  443. if src.enum<>R_INTREGISTER then
  444. internalerror(200303102);
  445. if op = OP_SUB then
  446. begin
  447. {$ifopt q+}
  448. {$q-}
  449. {$define overflowon}
  450. {$endif}
  451. a_op_const_reg_reg(list,OP_ADD,size,aword(-longint(a)),src,dst);
  452. {$ifdef overflowon}
  453. {$q+}
  454. {$undef overflowon}
  455. {$endif}
  456. exit;
  457. end;
  458. ophi := TOpCG2AsmOpConstHi[op];
  459. oplo := TOpCG2AsmOpConstLo[op];
  460. gotrlwi := get_rlwi_const(a,l1,l2);
  461. if (op in [OP_AND,OP_OR,OP_XOR]) then
  462. begin
  463. if (a = 0) then
  464. begin
  465. if op = OP_AND then
  466. list.concat(taicpu.op_reg_const(A_LI,dst,0))
  467. else
  468. a_load_reg_reg(list,size,size,src,dst);
  469. exit;
  470. end
  471. else if (a = high(aword)) then
  472. begin
  473. case op of
  474. OP_OR:
  475. list.concat(taicpu.op_reg_const(A_LI,dst,-1));
  476. OP_XOR:
  477. list.concat(taicpu.op_reg_reg(A_NOT,dst,src));
  478. OP_AND:
  479. a_load_reg_reg(list,size,size,src,dst);
  480. end;
  481. exit;
  482. end
  483. else if (a <= high(word)) and
  484. ((op <> OP_AND) or
  485. not gotrlwi) then
  486. begin
  487. list.concat(taicpu.op_reg_reg_const(oplo,dst,src,word(a)));
  488. exit;
  489. end;
  490. { all basic constant instructions also have a shifted form that }
  491. { works only on the highest 16bits, so if lo(a) is 0, we can }
  492. { use that one }
  493. if (word(a) = 0) and
  494. (not(op = OP_AND) or
  495. not gotrlwi) then
  496. begin
  497. list.concat(taicpu.op_reg_reg_const(ophi,dst,src,word(a shr 16)));
  498. exit;
  499. end;
  500. end
  501. else if (op = OP_ADD) then
  502. if a = 0 then
  503. exit
  504. else if (longint(a) >= low(smallint)) and
  505. (longint(a) <= high(smallint)) then
  506. begin
  507. list.concat(taicpu.op_reg_reg_const(A_ADDI,dst,src,smallint(a)));
  508. exit;
  509. end;
  510. { otherwise, the instructions we can generate depend on the }
  511. { operation }
  512. useReg := false;
  513. case op of
  514. OP_DIV,OP_IDIV:
  515. if (a = 0) then
  516. internalerror(200208103)
  517. else if (a = 1) then
  518. begin
  519. a_load_reg_reg(list,OS_INT,OS_INT,src,dst);
  520. exit
  521. end
  522. else if ispowerof2(a,l1) then
  523. begin
  524. case op of
  525. OP_DIV:
  526. list.concat(taicpu.op_reg_reg_const(A_SRWI,dst,src,l1));
  527. OP_IDIV:
  528. begin
  529. list.concat(taicpu.op_reg_reg_const(A_SRAWI,dst,src,l1));
  530. list.concat(taicpu.op_reg_reg(A_ADDZE,dst,dst));
  531. end;
  532. end;
  533. exit;
  534. end
  535. else
  536. usereg := true;
  537. OP_IMUL, OP_MUL:
  538. if (a = 0) then
  539. begin
  540. list.concat(taicpu.op_reg_const(A_LI,dst,0));
  541. exit
  542. end
  543. else if (a = 1) then
  544. begin
  545. a_load_reg_reg(list,OS_INT,OS_INT,src,dst);
  546. exit
  547. end
  548. else if ispowerof2(a,l1) then
  549. list.concat(taicpu.op_reg_reg_const(A_SLWI,dst,src,l1))
  550. else if (longint(a) >= low(smallint)) and
  551. (longint(a) <= high(smallint)) then
  552. list.concat(taicpu.op_reg_reg_const(A_MULLI,dst,src,smallint(a)))
  553. else
  554. usereg := true;
  555. OP_ADD:
  556. begin
  557. list.concat(taicpu.op_reg_reg_const(oplo,dst,src,smallint(a)));
  558. list.concat(taicpu.op_reg_reg_const(ophi,dst,dst,
  559. smallint((a shr 16) + ord(smallint(a) < 0))));
  560. end;
  561. OP_OR:
  562. { try to use rlwimi }
  563. if gotrlwi and
  564. (src.number = dst.number) then
  565. begin
  566. scratchreg := get_scratch_reg_int(list,OS_INT);
  567. list.concat(taicpu.op_reg_const(A_LI,scratchreg,-1));
  568. list.concat(taicpu.op_reg_reg_const_const_const(A_RLWIMI,dst,
  569. scratchreg,0,l1,l2));
  570. free_scratch_reg(list,scratchreg);
  571. end
  572. else
  573. do_lo_hi;
  574. OP_AND:
  575. { try to use rlwinm }
  576. if gotrlwi then
  577. list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,dst,
  578. src,0,l1,l2))
  579. else
  580. useReg := true;
  581. OP_XOR:
  582. do_lo_hi;
  583. OP_SHL,OP_SHR,OP_SAR:
  584. begin
  585. if (a and 31) <> 0 Then
  586. list.concat(taicpu.op_reg_reg_const(
  587. TOpCG2AsmOpConstLo[Op],dst,src,a and 31))
  588. else
  589. a_load_reg_reg(list,size,size,src,dst);
  590. if (a shr 5) <> 0 then
  591. internalError(68991);
  592. end
  593. else
  594. internalerror(200109091);
  595. end;
  596. { if all else failed, load the constant in a register and then }
  597. { perform the operation }
  598. if useReg then
  599. begin
  600. scratchreg := get_scratch_reg_int(list,OS_INT);
  601. a_load_const_reg(list,OS_32,a,scratchreg);
  602. a_op_reg_reg_reg(list,op,OS_32,scratchreg,src,dst);
  603. free_scratch_reg(list,scratchreg);
  604. end;
  605. end;
  606. procedure tcgppc.a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
  607. size: tcgsize; src1, src2, dst: tregister);
  608. const
  609. op_reg_reg_opcg2asmop: array[TOpCG] of tasmop =
  610. (A_NONE,A_ADD,A_AND,A_DIVWU,A_DIVW,A_MULLW,A_MULLW,A_NEG,A_NOT,A_OR,
  611. A_SRAW,A_SLW,A_SRW,A_SUB,A_XOR);
  612. begin
  613. case op of
  614. OP_NEG,OP_NOT:
  615. list.concat(taicpu.op_reg_reg(op_reg_reg_opcg2asmop[op],dst,dst));
  616. else
  617. list.concat(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop[op],dst,src2,src1));
  618. end;
  619. end;
  620. {*************** compare instructructions ****************}
  621. procedure tcgppc.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
  622. l : tasmlabel);
  623. var
  624. p: taicpu;
  625. scratch_register: TRegister;
  626. signed: boolean;
  627. r:Tregister;
  628. begin
  629. signed := cmp_op in [OC_GT,OC_LT,OC_GTE,OC_LTE];
  630. { in the following case, we generate more efficient code when }
  631. { signed is true }
  632. if (cmp_op in [OC_EQ,OC_NE]) and
  633. (a > $ffff) then
  634. signed := true;
  635. r.enum:=R_CR0;
  636. if signed then
  637. if (longint(a) >= low(smallint)) and (longint(a) <= high(smallint)) Then
  638. list.concat(taicpu.op_reg_reg_const(A_CMPWI,r,reg,longint(a)))
  639. else
  640. begin
  641. scratch_register := get_scratch_reg_int(list,OS_INT);
  642. a_load_const_reg(list,OS_32,a,scratch_register);
  643. list.concat(taicpu.op_reg_reg_reg(A_CMPW,r,reg,scratch_register));
  644. free_scratch_reg(list,scratch_register);
  645. end
  646. else
  647. if (a <= $ffff) then
  648. list.concat(taicpu.op_reg_reg_const(A_CMPLWI,r,reg,a))
  649. else
  650. begin
  651. scratch_register := get_scratch_reg_int(list,OS_32);
  652. a_load_const_reg(list,OS_32,a,scratch_register);
  653. list.concat(taicpu.op_reg_reg_reg(A_CMPLW,r,reg,scratch_register));
  654. free_scratch_reg(list,scratch_register);
  655. end;
  656. a_jmp(list,A_BC,TOpCmp2AsmCond[cmp_op],0,l);
  657. end;
  658. procedure tcgppc.a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;
  659. reg1,reg2 : tregister;l : tasmlabel);
  660. var
  661. p: taicpu;
  662. op: tasmop;
  663. r:Tregister;
  664. begin
  665. if cmp_op in [OC_GT,OC_LT,OC_GTE,OC_LTE] then
  666. op := A_CMPW
  667. else op := A_CMPLW;
  668. r.enum:=R_CR0;
  669. list.concat(taicpu.op_reg_reg_reg(op,r,reg2,reg1));
  670. a_jmp(list,A_BC,TOpCmp2AsmCond[cmp_op],0,l);
  671. end;
  672. procedure tcgppc.g_save_standard_registers(list : taasmoutput; usedinproc : Tsupregset);
  673. begin
  674. {$warning FIX ME}
  675. end;
  676. procedure tcgppc.g_restore_standard_registers(list : taasmoutput; usedinproc : Tsupregset);
  677. begin
  678. {$warning FIX ME}
  679. end;
  680. procedure tcgppc.g_save_all_registers(list : taasmoutput);
  681. begin
  682. {$warning FIX ME}
  683. end;
  684. procedure tcgppc.g_restore_all_registers(list : taasmoutput;accused,acchiused:boolean);
  685. begin
  686. {$warning FIX ME}
  687. end;
  688. procedure tcgppc.a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
  689. begin
  690. a_jmp(list,A_BC,TOpCmp2AsmCond[cond],0,l);
  691. end;
  692. procedure tcgppc.a_jmp_always(list : taasmoutput;l: tasmlabel);
  693. begin
  694. a_jmp(list,A_B,C_None,0,l);
  695. end;
  696. procedure tcgppc.a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel);
  697. var
  698. c: tasmcond;
  699. r:Tregister;
  700. begin
  701. c := flags_to_cond(f);
  702. r.enum:=R_CR0;
  703. a_jmp(list,A_BC,c.cond,ord(c.cr)-ord(r.enum),l);
  704. end;
  705. procedure tcgppc.g_flags2reg(list: taasmoutput; size: TCgSize; const f: TResFlags; reg: TRegister);
  706. var
  707. testbit: byte;
  708. bitvalue: boolean;
  709. begin
  710. { get the bit to extract from the conditional register + its }
  711. { requested value (0 or 1) }
  712. testbit := ((ord(f.cr)-ord(R_CR0)) * 4);
  713. case f.flag of
  714. F_EQ,F_NE:
  715. begin
  716. inc(testbit,2);
  717. bitvalue := f.flag = F_EQ;
  718. end;
  719. F_LT,F_GE:
  720. begin
  721. bitvalue := f.flag = F_LT;
  722. end;
  723. F_GT,F_LE:
  724. begin
  725. inc(testbit);
  726. bitvalue := f.flag = F_GT;
  727. end;
  728. else
  729. internalerror(200112261);
  730. end;
  731. { load the conditional register in the destination reg }
  732. list.concat(taicpu.op_reg(A_MFCR,reg));
  733. { we will move the bit that has to be tested to bit 0 by rotating }
  734. { left }
  735. testbit := (testbit + 1) and 31;
  736. { extract bit }
  737. list.concat(taicpu.op_reg_reg_const_const_const(
  738. A_RLWINM,reg,reg,testbit,31,31));
  739. { if we need the inverse, xor with 1 }
  740. if not bitvalue then
  741. list.concat(taicpu.op_reg_reg_const(A_XORI,reg,reg,1));
  742. end;
  743. (*
  744. procedure tcgppc.g_cond2reg(list: taasmoutput; const f: TAsmCond; reg: TRegister);
  745. var
  746. testbit: byte;
  747. bitvalue: boolean;
  748. begin
  749. { get the bit to extract from the conditional register + its }
  750. { requested value (0 or 1) }
  751. case f.simple of
  752. false:
  753. begin
  754. { we don't generate this in the compiler }
  755. internalerror(200109062);
  756. end;
  757. true:
  758. case f.cond of
  759. C_None:
  760. internalerror(200109063);
  761. C_LT..C_NU:
  762. begin
  763. testbit := (ord(f.cr) - ord(R_CR0))*4;
  764. inc(testbit,AsmCondFlag2BI[f.cond]);
  765. bitvalue := AsmCondFlagTF[f.cond];
  766. end;
  767. C_T,C_F,C_DNZT,C_DNZF,C_DZT,C_DZF:
  768. begin
  769. testbit := f.crbit
  770. bitvalue := AsmCondFlagTF[f.cond];
  771. end;
  772. else
  773. internalerror(200109064);
  774. end;
  775. end;
  776. { load the conditional register in the destination reg }
  777. list.concat(taicpu.op_reg_reg(A_MFCR,reg));
  778. { we will move the bit that has to be tested to bit 31 -> rotate }
  779. { left by bitpos+1 (remember, this is big-endian!) }
  780. if bitpos <> 31 then
  781. inc(bitpos)
  782. else
  783. bitpos := 0;
  784. { extract bit }
  785. list.concat(taicpu.op_reg_reg_const_const_const(
  786. A_RLWINM,reg,reg,bitpos,31,31));
  787. { if we need the inverse, xor with 1 }
  788. if not bitvalue then
  789. list.concat(taicpu.op_reg_reg_const(A_XORI,reg,reg,1));
  790. end;
  791. *)
  792. { *********** entry/exit code and address loading ************ }
  793. procedure tcgppc.g_stackframe_entry(list : taasmoutput;localsize : longint);
  794. begin
  795. case target_info.abi of
  796. abi_powerpc_macos:
  797. g_stackframe_entry_mac(list,localsize);
  798. abi_powerpc_sysv:
  799. g_stackframe_entry_sysv(list,localsize);
  800. abi_powerpc_aix:
  801. g_stackframe_entry_aix(list,localsize);
  802. else
  803. internalerror(2204001);
  804. end;
  805. end;
  806. procedure tcgppc.g_return_from_proc(list : taasmoutput;parasize : aword);
  807. begin
  808. case target_info.abi of
  809. abi_powerpc_macos:
  810. g_return_from_proc_mac(list,parasize);
  811. abi_powerpc_sysv:
  812. g_return_from_proc_sysv(list,parasize);
  813. abi_powerpc_aix:
  814. g_return_from_proc_aix(list,parasize);
  815. else
  816. internalerror(2204001);
  817. end;
  818. end;
  819. procedure tcgppc.g_stackframe_entry_aix(list : taasmoutput;localsize : longint);
  820. begin
  821. g_stackframe_entry_sysv(list,localsize);
  822. end;
  823. procedure tcgppc.g_stackframe_entry_sysv(list : taasmoutput;localsize : longint);
  824. { generated the entry code of a procedure/function. Note: localsize is the }
  825. { sum of the size necessary for local variables and the maximum possible }
  826. { combined size of ALL the parameters of a procedure called by the current }
  827. { one }
  828. var regcounter,firstregfpu,firstreggpr: TRegister;
  829. href,href2 : treference;
  830. usesfpr,usesgpr,gotgot : boolean;
  831. parastart : aword;
  832. offset : aword;
  833. r,r2,rsp:Tregister;
  834. regcounter2: Tsuperregister;
  835. hp: tparaitem;
  836. begin
  837. { we do our own localsize calculation }
  838. localsize:=0;
  839. { CR and LR only have to be saved in case they are modified by the current }
  840. { procedure, but currently this isn't checked, so save them always }
  841. { following is the entry code as described in "Altivec Programming }
  842. { Interface Manual", bar the saving of AltiVec registers }
  843. rsp.enum:=R_INTREGISTER;
  844. rsp.number:=NR_STACK_POINTER_REG;
  845. a_reg_alloc(list,rsp);
  846. r.enum:=R_INTREGISTER;
  847. r.number:=NR_R0;
  848. a_reg_alloc(list,r);
  849. if current_procdef.parast.symtablelevel>1 then
  850. begin
  851. r.enum:=R_INTREGISTER;
  852. r.number:=NR_R11;
  853. a_reg_alloc(list,r);
  854. end;
  855. { allocate registers containing reg parameters }
  856. r.enum := R_INTREGISTER;
  857. for regcounter2 := RS_R3 to RS_R10 do
  858. begin
  859. r.number:=regcounter2 shl 8;
  860. a_reg_alloc(list,r);
  861. end;
  862. usesfpr:=false;
  863. if not (po_assembler in current_procdef.procoptions) then
  864. for regcounter.enum:=R_F14 to R_F31 do
  865. if regcounter.enum in rg.usedbyproc then
  866. begin
  867. usesfpr:= true;
  868. firstregfpu:=regcounter;
  869. break;
  870. end;
  871. usesgpr:=false;
  872. if not (po_assembler in current_procdef.procoptions) then
  873. for regcounter2:=firstsaveintreg to RS_R31 do
  874. begin
  875. if regcounter2 in rg.usedintbyproc then
  876. begin
  877. usesgpr:=true;
  878. firstreggpr.enum := R_INTREGISTER;
  879. firstreggpr.number := regcounter2 shl 8;
  880. break;
  881. end;
  882. end;
  883. { save link register? }
  884. if not (po_assembler in current_procdef.procoptions) then
  885. if (pi_do_call in current_procinfo.flags) then
  886. begin
  887. { save return address... }
  888. r.enum:=R_INTREGISTER;
  889. r.number:=NR_R0;
  890. list.concat(taicpu.op_reg(A_MFLR,r));
  891. { ... in caller's rframe }
  892. reference_reset_base(href,rsp,4);
  893. list.concat(taicpu.op_reg_ref(A_STW,r,href));
  894. a_reg_dealloc(list,r);
  895. end;
  896. { !!! always allocate space for all registers for now !!! }
  897. if not (po_assembler in current_procdef.procoptions) then
  898. { if usesfpr or usesgpr then }
  899. begin
  900. r.enum:=R_INTREGISTER;
  901. r.number:=NR_R12;
  902. a_reg_alloc(list,r);
  903. { save end of fpr save area }
  904. list.concat(taicpu.op_reg_reg(A_MR,r,rsp));
  905. end;
  906. { calculate the size of the locals }
  907. {
  908. if usesgpr then
  909. inc(localsize,((NR_R31-firstreggpr.number) shr 8+1)*4);
  910. if usesfpr then
  911. inc(localsize,(ord(R_F31)-ord(firstregfpu.enum)+1)*8);
  912. }
  913. { !!! always allocate space for all registers for now !!! }
  914. if not (po_assembler in current_procdef.procoptions) then
  915. inc(localsize,(31-13+1)*4+(31-14+1)*8);
  916. { align to 16 bytes }
  917. localsize:=align(localsize,16);
  918. inc(localsize,tg.lasttemp);
  919. localsize:=align(localsize,16);
  920. tppcprocinfo(current_procinfo).localsize:=localsize;
  921. if (localsize <> 0) then
  922. begin
  923. r.enum:=R_INTREGISTER;
  924. r.number:=NR_STACK_POINTER_REG;
  925. if (localsize <= high(smallint)) then
  926. begin
  927. reference_reset_base(href,r,-localsize);
  928. a_load_store(list,A_STWU,r,href);
  929. end
  930. else
  931. begin
  932. reference_reset_base(href,r,0);
  933. href.index := get_scratch_reg_int(list,OS_32);
  934. a_load_const_reg(list,OS_S32,-localsize,href.index);
  935. a_load_store(list,A_STWUX,r,href);
  936. free_scratch_reg(list,href.index);
  937. end;
  938. end;
  939. { no GOT pointer loaded yet }
  940. gotgot:=false;
  941. r.enum := R_INTREGISTER;
  942. r.NUMBER := NR_R12;
  943. if usesfpr then
  944. begin
  945. { save floating-point registers
  946. if (cs_create_pic in aktmoduleswitches) and not(usesgpr) then
  947. begin
  948. a_call_name(objectlibrary.newasmsymbol('_savefpr_'+tostr(ord(firstregfpu)-ord(R_F14)+14)+'_g');
  949. gotgot:=true;
  950. end
  951. else
  952. a_call_name(objectlibrary.newasmsymbol('_savefpr_'+tostr(ord(firstregfpu)-ord(R_F14)+14));
  953. }
  954. reference_reset_base(href,r,-8);
  955. for regcounter.enum:=firstregfpu.enum to R_F31 do
  956. if regcounter.enum in rg.usedbyproc then
  957. begin
  958. a_loadfpu_reg_ref(list,OS_F64,regcounter,href);
  959. dec(href.offset,8);
  960. end;
  961. { compute end of gpr save area }
  962. a_op_const_reg(list,OP_ADD,href.offset+8,r);
  963. end;
  964. { save gprs and fetch GOT pointer }
  965. if usesgpr then
  966. begin
  967. {
  968. if cs_create_pic in aktmoduleswitches then
  969. begin
  970. a_call_name(objectlibrary.newasmsymbol('_savegpr_'+tostr(ord(firstreggpr)-ord(R_14)+14)+'_g');
  971. gotgot:=true;
  972. end
  973. else
  974. a_call_name(objectlibrary.newasmsymbol('_savegpr_'+tostr(ord(firstreggpr)-ord(R_14)+14))
  975. }
  976. reference_reset_base(href,r,-4);
  977. for regcounter2:=firstsaveintreg to RS_R31 do
  978. begin
  979. if regcounter2 in rg.usedintbyproc then
  980. begin
  981. usesgpr:=true;
  982. r.enum := R_INTREGISTER;
  983. r.number := regcounter2 shl 8;
  984. a_load_reg_ref(list,OS_INT,r,href);
  985. dec(href.offset,4);
  986. end;
  987. end;
  988. {
  989. r.enum:=R_INTREGISTER;
  990. r.number:=NR_R12;
  991. reference_reset_base(href,r,-((NR_R31-firstreggpr.number) shr 8+1)*4);
  992. list.concat(taicpu.op_reg_ref(A_STMW,firstreggpr,href));
  993. }
  994. end;
  995. if assigned(current_procdef.parast) then
  996. begin
  997. if not (po_assembler in current_procdef.procoptions) then
  998. begin
  999. { copy memory parameters to local parast }
  1000. r.enum:=R_INTREGISTER;
  1001. r.number:=NR_R12;
  1002. hp:=tparaitem(current_procdef.para.first);
  1003. while assigned(hp) do
  1004. begin
  1005. if (hp.paraloc.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  1006. begin
  1007. reference_reset_base(href,current_procinfo.framepointer,tvarsym(hp.parasym).adjusted_address);
  1008. reference_reset_base(href2,r,hp.paraloc.reference.offset);
  1009. cg.a_load_ref_ref(list,hp.paraloc.size,href2,href);
  1010. end;
  1011. hp := tparaitem(hp.next);
  1012. end;
  1013. end;
  1014. end;
  1015. r.enum:=R_INTREGISTER;
  1016. r.number:=NR_R12;
  1017. if usesfpr or usesgpr then
  1018. a_reg_dealloc(list,r);
  1019. { PIC code support, }
  1020. if cs_create_pic in aktmoduleswitches then
  1021. begin
  1022. { if we didn't get the GOT pointer till now, we've to calculate it now }
  1023. if not(gotgot) then
  1024. begin
  1025. {!!!!!!!!!!!!!}
  1026. end;
  1027. r.enum:=R_INTREGISTER;
  1028. r.number:=NR_R31;
  1029. r2.enum:=R_LR;
  1030. a_reg_alloc(list,r);
  1031. { place GOT ptr in r31 }
  1032. list.concat(taicpu.op_reg_reg(A_MFSPR,r,r2));
  1033. end;
  1034. { save the CR if necessary ( !!! always done currently ) }
  1035. { still need to find out where this has to be done for SystemV
  1036. a_reg_alloc(list,R_0);
  1037. list.concat(taicpu.op_reg_reg(A_MFSPR,R_0,R_CR);
  1038. list.concat(taicpu.op_reg_ref(A_STW,scratch_register,
  1039. new_reference(STACK_POINTER_REG,LA_CR)));
  1040. a_reg_dealloc(list,R_0); }
  1041. { now comes the AltiVec context save, not yet implemented !!! }
  1042. { if we're in a nested procedure, we've to save R11 }
  1043. if current_procdef.parast.symtablelevel>2 then
  1044. begin
  1045. r.enum:=R_INTREGISTER;
  1046. r.number:=NR_R11;
  1047. reference_reset_base(href,rsp,current_procinfo.framepointer_offset);
  1048. list.concat(taicpu.op_reg_ref(A_STW,r,href));
  1049. end;
  1050. end;
  1051. procedure tcgppc.g_return_from_proc_aix(list : taasmoutput;parasize : aword);
  1052. begin
  1053. g_return_from_proc_sysv(list,parasize);
  1054. end;
  1055. procedure tcgppc.g_return_from_proc_sysv(list : taasmoutput;parasize : aword);
  1056. var
  1057. regcounter,firstregfpu,firstreggpr: TRegister;
  1058. href : treference;
  1059. usesfpr,usesgpr,genret : boolean;
  1060. r,r2:Tregister;
  1061. regcounter2:Tsuperregister;
  1062. begin
  1063. { release parameter registers }
  1064. r.enum := R_INTREGISTER;
  1065. for regcounter2 := RS_R3 to RS_R10 do
  1066. begin
  1067. r.number:=regcounter2 shl 8;
  1068. a_reg_dealloc(list,r);
  1069. end;
  1070. { AltiVec context restore, not yet implemented !!! }
  1071. usesfpr:=false;
  1072. if not (po_assembler in current_procdef.procoptions) then
  1073. for regcounter.enum:=R_F14 to R_F31 do
  1074. if regcounter.enum in rg.usedbyproc then
  1075. begin
  1076. usesfpr:=true;
  1077. firstregfpu:=regcounter;
  1078. break;
  1079. end;
  1080. usesgpr:=false;
  1081. if not (po_assembler in current_procdef.procoptions) then
  1082. for regcounter2:=firstsaveintreg to RS_R31 do
  1083. begin
  1084. if regcounter2 in rg.usedintbyproc then
  1085. begin
  1086. usesgpr:=true;
  1087. firstreggpr.enum:=R_INTREGISTER;
  1088. firstreggpr.number:=regcounter2 shl 8;
  1089. break;
  1090. end;
  1091. end;
  1092. { no return (blr) generated yet }
  1093. genret:=true;
  1094. if usesgpr or usesfpr then
  1095. begin
  1096. { address of gpr save area to r11 }
  1097. r.enum:=R_INTREGISTER;
  1098. r.number:=NR_STACK_POINTER_REG;
  1099. r2.enum:=R_INTREGISTER;
  1100. r2.number:=NR_R12;
  1101. a_op_const_reg_reg(list,OP_ADD,OS_ADDR,tppcprocinfo(current_procinfo).localsize,r,r2);
  1102. if usesfpr then
  1103. begin
  1104. reference_reset_base(href,r2,-8);
  1105. for regcounter.enum := firstregfpu.enum to R_F31 do
  1106. if (regcounter.enum in rg.usedbyproc) then
  1107. begin
  1108. a_loadfpu_ref_reg(list,OS_F64,href,regcounter);
  1109. dec(href.offset,8);
  1110. end;
  1111. inc(href.offset,4);
  1112. end
  1113. else
  1114. reference_reset_base(href,r2,-4);
  1115. for regcounter2:=firstsaveintreg to RS_R31 do
  1116. begin
  1117. if regcounter2 in rg.usedintbyproc then
  1118. begin
  1119. usesgpr:=true;
  1120. r.enum := R_INTREGISTER;
  1121. r.number := regcounter2 shl 8;
  1122. a_load_ref_reg(list,OS_INT,href,r);
  1123. dec(href.offset,4);
  1124. end;
  1125. end;
  1126. (*
  1127. reference_reset_base(href,r2,-((NR_R31-ord(firstreggpr.number)) shr 8+1)*4);
  1128. list.concat(taicpu.op_reg_ref(A_LMW,firstreggpr,href));
  1129. *)
  1130. end;
  1131. (*
  1132. { restore fprs and return }
  1133. if usesfpr then
  1134. begin
  1135. { address of fpr save area to r11 }
  1136. r.enum:=R_INTREGISTER;
  1137. r.number:=NR_R12;
  1138. list.concat(taicpu.op_reg_reg_const(A_ADDI,r,r,(ord(R_F31)-ord(firstregfpu.enum)+1)*8));
  1139. {
  1140. if (pi_do_call in current_procinfo.flags) then
  1141. a_call_name(objectlibrary.newasmsymbol('_restfpr_'+tostr(ord(firstregfpu)-ord(R_F14)+14)+
  1142. '_x')
  1143. else
  1144. { leaf node => lr haven't to be restored }
  1145. a_call_name('_restfpr_'+tostr(ord(firstregfpu.enum)-ord(R_F14)+14)+
  1146. '_l');
  1147. genret:=false;
  1148. }
  1149. end;
  1150. *)
  1151. { if we didn't generate the return code, we've to do it now }
  1152. if genret then
  1153. begin
  1154. { adjust r1 }
  1155. r.enum:=R_INTREGISTER;
  1156. r.number:=NR_R1;
  1157. a_op_const_reg(list,OP_ADD,tppcprocinfo(current_procinfo).localsize,r);
  1158. { load link register? }
  1159. if not (po_assembler in current_procdef.procoptions) then
  1160. if (pi_do_call in current_procinfo.flags) then
  1161. begin
  1162. r.enum:=R_INTREGISTER;
  1163. r.number:=NR_STACK_POINTER_REG;
  1164. reference_reset_base(href,r,4);
  1165. r.enum:=R_INTREGISTER;
  1166. r.number:=NR_R0;
  1167. list.concat(taicpu.op_reg_ref(A_LWZ,r,href));
  1168. list.concat(taicpu.op_reg(A_MTLR,r));
  1169. end;
  1170. list.concat(taicpu.op_none(A_BLR));
  1171. end;
  1172. end;
  1173. function save_regs(list : taasmoutput):longint;
  1174. {Generates code which saves used non-volatile registers in
  1175. the save area right below the address the stackpointer point to.
  1176. Returns the actual used save area size.}
  1177. var regcounter,firstregfpu,firstreggpr: TRegister;
  1178. usesfpr,usesgpr: boolean;
  1179. href : treference;
  1180. offset: integer;
  1181. r,r2:Tregister;
  1182. regcounter2: Tsuperregister;
  1183. begin
  1184. usesfpr:=false;
  1185. if not (po_assembler in current_procdef.procoptions) then
  1186. for regcounter.enum:=R_F14 to R_F31 do
  1187. if regcounter.enum in rg.usedbyproc then
  1188. begin
  1189. usesfpr:=true;
  1190. firstregfpu:=regcounter;
  1191. break;
  1192. end;
  1193. usesgpr:=false;
  1194. if not (po_assembler in current_procdef.procoptions) then
  1195. for regcounter2:=firstsaveintreg to RS_R31 do
  1196. begin
  1197. if regcounter2 in rg.usedintbyproc then
  1198. begin
  1199. usesgpr:=true;
  1200. firstreggpr.enum:=R_INTREGISTER;
  1201. firstreggpr.number:=regcounter2 shl 8;
  1202. break;
  1203. end;
  1204. end;
  1205. offset:= 0;
  1206. { save floating-point registers }
  1207. if usesfpr then
  1208. for regcounter.enum := firstregfpu.enum to R_F31 do
  1209. begin
  1210. offset:= offset - 8;
  1211. r.enum:=R_INTREGISTER;
  1212. r.number:=NR_STACK_POINTER_REG;
  1213. reference_reset_base(href, r, offset);
  1214. list.concat(taicpu.op_reg_ref(A_STFD, regcounter, href));
  1215. end;
  1216. (* Optimiztion in the future: a_call_name(list,'_savefXX'); *)
  1217. { save gprs in gpr save area }
  1218. if usesgpr then
  1219. if firstreggpr.enum < R_30 then
  1220. begin
  1221. offset:= offset - 4 * (ord(R_31) - ord(firstreggpr.enum) + 1);
  1222. r.enum:=R_INTREGISTER;
  1223. r.number:=NR_STACK_POINTER_REG;
  1224. reference_reset_base(href,r,offset);
  1225. list.concat(taicpu.op_reg_ref(A_STMW,firstreggpr,href));
  1226. {STMW stores multiple registers}
  1227. end
  1228. else
  1229. begin
  1230. r.enum:=R_INTREGISTER;
  1231. r.number:=NR_STACK_POINTER_REG;
  1232. r2 := firstreggpr;
  1233. convert_register_to_enum(firstreggpr);
  1234. for regcounter.enum := firstreggpr.enum to R_31 do
  1235. begin
  1236. offset:= offset - 4;
  1237. reference_reset_base(href, r, offset);
  1238. list.concat(taicpu.op_reg_ref(A_STW, r2, href));
  1239. inc(r2.number,NR_R1-NR_R0);
  1240. end;
  1241. end;
  1242. { now comes the AltiVec context save, not yet implemented !!! }
  1243. save_regs:= -offset;
  1244. end;
  1245. procedure restore_regs(list : taasmoutput);
  1246. {Generates code which restores used non-volatile registers from
  1247. the save area right below the address the stackpointer point to.}
  1248. var regcounter,firstregfpu,firstreggpr: TRegister;
  1249. usesfpr,usesgpr: boolean;
  1250. href : treference;
  1251. offset: integer;
  1252. r,r2:Tregister;
  1253. regcounter2: Tsuperregister;
  1254. begin
  1255. usesfpr:=false;
  1256. if not (po_assembler in current_procdef.procoptions) then
  1257. for regcounter.enum:=R_F14 to R_F31 do
  1258. if regcounter.enum in rg.usedbyproc then
  1259. begin
  1260. usesfpr:=true;
  1261. firstregfpu:=regcounter;
  1262. break;
  1263. end;
  1264. usesgpr:=false;
  1265. if not (po_assembler in current_procdef.procoptions) then
  1266. for regcounter2:=RS_R13 to RS_R31 do
  1267. begin
  1268. if regcounter2 in rg.usedintbyproc then
  1269. begin
  1270. usesgpr:=true;
  1271. firstreggpr.enum:=R_INTREGISTER;
  1272. firstreggpr.number:=regcounter2 shl 8;
  1273. break;
  1274. end;
  1275. end;
  1276. offset:= 0;
  1277. { restore fp registers }
  1278. if usesfpr then
  1279. for regcounter.enum := firstregfpu.enum to R_F31 do
  1280. begin
  1281. offset:= offset - 8;
  1282. r.enum:=R_INTREGISTER;
  1283. r.number:=NR_STACK_POINTER_REG;
  1284. reference_reset_base(href, r, offset);
  1285. list.concat(taicpu.op_reg_ref(A_LFD, regcounter, href));
  1286. end;
  1287. (* Optimiztion in the future: a_call_name(list,'_restfXX'); *)
  1288. { restore gprs }
  1289. if usesgpr then
  1290. if firstreggpr.enum < R_30 then
  1291. begin
  1292. offset:= offset - 4 * (ord(R_31) - ord(firstreggpr.enum) + 1);
  1293. r.enum:=R_INTREGISTER;
  1294. r.number:=NR_STACK_POINTER_REG;
  1295. reference_reset_base(href,r,offset); //-220
  1296. list.concat(taicpu.op_reg_ref(A_LMW,firstreggpr,href));
  1297. {LMW loads multiple registers}
  1298. end
  1299. else
  1300. begin
  1301. r.enum:=R_INTREGISTER;
  1302. r.number:=NR_STACK_POINTER_REG;
  1303. r2 := firstreggpr;
  1304. convert_register_to_enum(firstreggpr);
  1305. for regcounter.enum := firstreggpr.enum to R_31 do
  1306. begin
  1307. offset:= offset - 4;
  1308. reference_reset_base(href, r, offset);
  1309. list.concat(taicpu.op_reg_ref(A_LWZ, r2, href));
  1310. inc(r2.number,NR_R1-NR_R0);
  1311. end;
  1312. end;
  1313. { now comes the AltiVec context restore, not yet implemented !!! }
  1314. end;
  1315. procedure tcgppc.g_stackframe_entry_mac(list : taasmoutput;localsize : longint);
  1316. { generated the entry code of a procedure/function. Note: localsize is the }
  1317. { sum of the size necessary for local variables and the maximum possible }
  1318. { combined size of ALL the parameters of a procedure called by the current }
  1319. { one }
  1320. const
  1321. macosLinkageAreaSize = 24;
  1322. var regcounter: TRegister;
  1323. href : treference;
  1324. registerSaveAreaSize : longint;
  1325. r,r2,rsp:Tregister;
  1326. regcounter2: Tsuperregister;
  1327. begin
  1328. if (localsize mod 8) <> 0 then internalerror(58991);
  1329. { CR and LR only have to be saved in case they are modified by the current }
  1330. { procedure, but currently this isn't checked, so save them always }
  1331. { following is the entry code as described in "Altivec Programming }
  1332. { Interface Manual", bar the saving of AltiVec registers }
  1333. r.enum:=R_INTREGISTER;
  1334. r.number:=NR_R0;
  1335. rsp.enum:=R_INTREGISTER;
  1336. rsp.number:=NR_STACK_POINTER_REG;
  1337. a_reg_alloc(list,rsp);
  1338. a_reg_alloc(list,r);
  1339. { allocate registers containing reg parameters }
  1340. r.enum := R_INTREGISTER;
  1341. for regcounter2 := RS_R3 to RS_R10 do
  1342. begin
  1343. r.number:=regcounter2 shl 8;
  1344. a_reg_alloc(list,r);
  1345. end;
  1346. {TODO: Allocate fp and altivec parameter registers also}
  1347. { save return address in callers frame}
  1348. r2.enum:=R_LR;
  1349. list.concat(taicpu.op_reg_reg(A_MFSPR,r,r2));
  1350. { ... in caller's frame }
  1351. reference_reset_base(href,rsp,8);
  1352. list.concat(taicpu.op_reg_ref(A_STW,r,href));
  1353. a_reg_dealloc(list,r);
  1354. { save non-volatile registers in callers frame}
  1355. registerSaveAreaSize:= save_regs(list);
  1356. { save the CR if necessary in callers frame ( !!! always done currently ) }
  1357. a_reg_alloc(list,r);
  1358. r2.enum:=R_CR;
  1359. list.concat(taicpu.op_reg_reg(A_MFSPR,r,r2));
  1360. reference_reset_base(href,rsp,LA_CR);
  1361. list.concat(taicpu.op_reg_ref(A_STW,r,href));
  1362. a_reg_dealloc(list,r);
  1363. (*
  1364. { save pointer to incoming arguments }
  1365. list.concat(taicpu.op_reg_reg_const(A_ORI,R_31,STACK_POINTER_REG,0));
  1366. *)
  1367. (*
  1368. a_reg_alloc(list,R_12);
  1369. { 0 or 8 based on SP alignment }
  1370. list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,
  1371. R_12,STACK_POINTER_REG,0,28,28));
  1372. { add in stack length }
  1373. list.concat(taicpu.op_reg_reg_const(A_SUBFIC,R_12,R_12,
  1374. -localsize));
  1375. { establish new alignment }
  1376. list.concat(taicpu.op_reg_reg_reg(A_STWUX,STACK_POINTER_REG,STACK_POINTER_REG,R_12));
  1377. a_reg_dealloc(list,R_12);
  1378. *)
  1379. { allocate stack frame }
  1380. localsize:= align(localsize + macosLinkageAreaSize + registerSaveAreaSize, 16);
  1381. inc(localsize,tg.lasttemp);
  1382. localsize:=align(localsize,16);
  1383. tppcprocinfo(current_procinfo).localsize:=localsize;
  1384. if (localsize <> 0) then
  1385. begin
  1386. r.enum:=R_INTREGISTER;
  1387. r.number:=NR_STACK_POINTER_REG;
  1388. if (localsize <= high(smallint)) then
  1389. begin
  1390. reference_reset_base(href,r,-localsize);
  1391. a_load_store(list,A_STWU,r,href);
  1392. end
  1393. else
  1394. begin
  1395. reference_reset_base(href,r,0);
  1396. href.index := get_scratch_reg_int(list,OS_32);
  1397. a_load_const_reg(list,OS_S32,-localsize,href.index);
  1398. a_load_store(list,A_STWUX,r,href);
  1399. free_scratch_reg(list,href.index);
  1400. end;
  1401. end;
  1402. end;
  1403. procedure tcgppc.g_return_from_proc_mac(list : taasmoutput;parasize : aword);
  1404. var
  1405. regcounter: TRegister;
  1406. href : treference;
  1407. r,r2,rsp:Tregister;
  1408. regcounter2: Tsuperregister;
  1409. begin
  1410. { release parameter registers }
  1411. r.enum := R_INTREGISTER;
  1412. for regcounter2 := RS_R3 to RS_R10 do
  1413. begin
  1414. r.number := regcounter2 shl 8;
  1415. a_reg_dealloc(list,r);
  1416. end;
  1417. {TODO: Release fp and altivec parameter registers also}
  1418. r.enum:=R_INTREGISTER;
  1419. r.number:=NR_R0;
  1420. rsp.enum:=R_INTREGISTER;
  1421. rsp.number:=NR_STACK_POINTER_REG;
  1422. a_reg_alloc(list,r);
  1423. { restore stack pointer }
  1424. reference_reset_base(href,rsp,LA_SP);
  1425. list.concat(taicpu.op_reg_ref(A_LWZ,rsp,href));
  1426. (*
  1427. list.concat(taicpu.op_reg_reg_const(A_ORI,rsp,R_31,0));
  1428. *)
  1429. { restore the CR if necessary from callers frame
  1430. ( !!! always done currently ) }
  1431. reference_reset_base(href,rsp,LA_CR);
  1432. r.enum:=R_INTREGISTER;
  1433. r.number:=NR_R0;
  1434. list.concat(taicpu.op_reg_ref(A_LWZ,r,href));
  1435. r2.enum:=R_CR;
  1436. list.concat(taicpu.op_reg_reg(A_MTSPR,r,r2));
  1437. a_reg_dealloc(list,r);
  1438. (*
  1439. { restore return address from callers frame }
  1440. reference_reset_base(href,STACK_POINTER_REG,8);
  1441. list.concat(taicpu.op_reg_ref(A_LWZ,R_0,href));
  1442. *)
  1443. { restore non-volatile registers from callers frame }
  1444. restore_regs(list);
  1445. (*
  1446. { return to caller }
  1447. list.concat(taicpu.op_reg_reg(A_MTSPR,R_0,R_LR));
  1448. list.concat(taicpu.op_none(A_BLR));
  1449. *)
  1450. { restore return address from callers frame }
  1451. r.enum:=R_INTREGISTER;
  1452. r.number:=NR_R0;
  1453. r2.enum:=R_LR;
  1454. reference_reset_base(href,rsp,8);
  1455. list.concat(taicpu.op_reg_ref(A_LWZ,r,href));
  1456. { return to caller }
  1457. list.concat(taicpu.op_reg_reg(A_MTSPR,r,r2));
  1458. list.concat(taicpu.op_none(A_BLR));
  1459. end;
  1460. procedure tcgppc.g_restore_frame_pointer(list : taasmoutput);
  1461. begin
  1462. { no frame pointer on the PowerPC (maybe there is one in the SystemV ABI?)}
  1463. end;
  1464. procedure tcgppc.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
  1465. var
  1466. ref2, tmpref: treference;
  1467. freereg: boolean;
  1468. r2,tmpreg:Tregister;
  1469. begin
  1470. ref2 := ref;
  1471. freereg := fixref(list,ref2);
  1472. if assigned(ref2.symbol) then
  1473. begin
  1474. if target_info.system = system_powerpc_macos then
  1475. begin
  1476. if ref2.base.number <> NR_NO then
  1477. internalerror(2002103102); //TODO: Implement this if needed
  1478. if macos_direct_globals then
  1479. begin
  1480. reference_reset(tmpref);
  1481. tmpref.offset := ref2.offset;
  1482. tmpref.symbol := ref2.symbol;
  1483. tmpref.symaddr := refs_full;
  1484. tmpref.base.number := NR_NO;
  1485. r2.enum:=R_INTREGISTER;
  1486. r2.number:=NR_RTOC;
  1487. list.concat(taicpu.op_reg_reg_ref(A_ADDI,r,r2,tmpref));
  1488. end
  1489. else
  1490. begin
  1491. reference_reset(tmpref);
  1492. tmpref.symbol := ref2.symbol;
  1493. tmpref.offset := 0; //ref2.offset;
  1494. tmpref.symaddr := refs_full;
  1495. tmpref.base.enum := R_INTREGISTER;
  1496. tmpref.base.number := NR_RTOC;
  1497. if ref2.offset = 0 then
  1498. list.concat(taicpu.op_reg_ref(A_LWZ,r,tmpref))
  1499. else
  1500. begin
  1501. list.concat(taicpu.op_reg_ref(A_LWZ,r,tmpref));
  1502. reference_reset(tmpref);
  1503. tmpref.offset := ref2.offset;
  1504. tmpref.symaddr := refs_full;
  1505. tmpref.base:= r;
  1506. list.concat(taicpu.op_reg_ref(A_LA,r,tmpref));
  1507. (*
  1508. tmpreg := get_scratch_reg_address(list);
  1509. list.concat(taicpu.op_reg_ref(A_LWZ,tmpreg,tmpref));
  1510. reference_reset(tmpref);
  1511. tmpref.offset := ref2.offset;
  1512. tmpref.symaddr := refs_full;
  1513. tmpref.base:= tmpreg;
  1514. list.concat(taicpu.op_reg_ref(A_LA,r,tmpref));
  1515. free_scratch_reg(list,tmpreg);
  1516. *)
  1517. end;
  1518. end;
  1519. //list.concat(tai_comment.create(strpnew('*** a_loadaddr_ref_reg')));
  1520. end
  1521. else
  1522. begin
  1523. { add the symbol's value to the base of the reference, and if the }
  1524. { reference doesn't have a base, create one }
  1525. reference_reset(tmpref);
  1526. tmpref.offset := ref2.offset;
  1527. tmpref.symbol := ref2.symbol;
  1528. tmpref.symaddr := refs_ha;
  1529. if ref2.base .number<> NR_NO then
  1530. begin
  1531. list.concat(taicpu.op_reg_reg_ref(A_ADDIS,r,
  1532. ref2.base,tmpref));
  1533. if freereg then
  1534. begin
  1535. cg.free_scratch_reg(list,ref2.base);
  1536. freereg := false;
  1537. end;
  1538. end
  1539. else
  1540. list.concat(taicpu.op_reg_ref(A_LIS,r,tmpref));
  1541. tmpref.base.number := NR_NO;
  1542. tmpref.symaddr := refs_l;
  1543. { can be folded with one of the next instructions by the }
  1544. { optimizer probably }
  1545. list.concat(taicpu.op_reg_reg_ref(A_ADDI,r,r,tmpref));
  1546. end
  1547. end
  1548. else if ref2.offset <> 0 Then
  1549. if ref2.base.number <> NR_NO then
  1550. a_op_const_reg_reg(list,OP_ADD,OS_32,aword(ref2.offset),ref2.base,r)
  1551. { FixRef makes sure that "(ref.index <> R_NO) and (ref.offset <> 0)" never}
  1552. { occurs, so now only ref.offset has to be loaded }
  1553. else
  1554. a_load_const_reg(list,OS_32,ref2.offset,r)
  1555. else if ref.index.number <> NR_NO Then
  1556. list.concat(taicpu.op_reg_reg_reg(A_ADD,r,ref2.base,ref2.index))
  1557. else if (ref2.base.number <> NR_NO) and
  1558. (r.number <> ref2.base.number) then
  1559. list.concat(taicpu.op_reg_reg(A_MR,r,ref2.base));
  1560. if freereg then
  1561. cg.free_scratch_reg(list,ref2.base);
  1562. end;
  1563. { ************* concatcopy ************ }
  1564. {$ifndef ppc603}
  1565. const
  1566. maxmoveunit = 8;
  1567. {$else ppc603}
  1568. const
  1569. maxmoveunit = 4;
  1570. {$endif ppc603}
  1571. procedure tcgppc.g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);
  1572. var
  1573. countreg: TRegister;
  1574. src, dst: TReference;
  1575. lab: tasmlabel;
  1576. count, count2: aword;
  1577. orgsrc, orgdst: boolean;
  1578. r:Tregister;
  1579. begin
  1580. {$ifdef extdebug}
  1581. if len > high(longint) then
  1582. internalerror(2002072704);
  1583. {$endif extdebug}
  1584. { make sure short loads are handled as optimally as possible }
  1585. if not loadref then
  1586. if (len <= maxmoveunit) and
  1587. (byte(len) in [1,2,4,8]) then
  1588. begin
  1589. if len < 8 then
  1590. begin
  1591. a_load_ref_ref(list,int_cgsize(len),source,dest);
  1592. if delsource then
  1593. begin
  1594. reference_release(list,source);
  1595. tg.ungetiftemp(list,source);
  1596. end;
  1597. end
  1598. else
  1599. begin
  1600. r.enum:=R_F0;
  1601. a_reg_alloc(list,r);
  1602. a_loadfpu_ref_reg(list,OS_F64,source,r);
  1603. if delsource then
  1604. begin
  1605. reference_release(list,source);
  1606. tg.ungetiftemp(list,source);
  1607. end;
  1608. a_loadfpu_reg_ref(list,OS_F64,r,dest);
  1609. a_reg_dealloc(list,r);
  1610. end;
  1611. exit;
  1612. end;
  1613. count := len div maxmoveunit;
  1614. reference_reset(src);
  1615. reference_reset(dst);
  1616. { load the address of source into src.base }
  1617. if loadref then
  1618. begin
  1619. src.base := get_scratch_reg_address(list);
  1620. a_load_ref_reg(list,OS_32,source,src.base);
  1621. orgsrc := false;
  1622. end
  1623. else if (count > 4) or
  1624. not issimpleref(source) or
  1625. ((source.index.number <> NR_NO) and
  1626. ((source.offset + longint(len)) > high(smallint))) then
  1627. begin
  1628. src.base := get_scratch_reg_address(list);
  1629. a_loadaddr_ref_reg(list,source,src.base);
  1630. orgsrc := false;
  1631. end
  1632. else
  1633. begin
  1634. src := source;
  1635. orgsrc := true;
  1636. end;
  1637. if not orgsrc and delsource then
  1638. reference_release(list,source);
  1639. { load the address of dest into dst.base }
  1640. if (count > 4) or
  1641. not issimpleref(dest) or
  1642. ((dest.index.number <> NR_NO) and
  1643. ((dest.offset + longint(len)) > high(smallint))) then
  1644. begin
  1645. dst.base := get_scratch_reg_address(list);
  1646. a_loadaddr_ref_reg(list,dest,dst.base);
  1647. orgdst := false;
  1648. end
  1649. else
  1650. begin
  1651. dst := dest;
  1652. orgdst := true;
  1653. end;
  1654. {$ifndef ppc603}
  1655. if count > 4 then
  1656. { generate a loop }
  1657. begin
  1658. { the offsets are zero after the a_loadaddress_ref_reg and just }
  1659. { have to be set to 8. I put an Inc there so debugging may be }
  1660. { easier (should offset be different from zero here, it will be }
  1661. { easy to notice in the generated assembler }
  1662. inc(dst.offset,8);
  1663. inc(src.offset,8);
  1664. list.concat(taicpu.op_reg_reg_const(A_SUBI,src.base,src.base,8));
  1665. list.concat(taicpu.op_reg_reg_const(A_SUBI,dst.base,dst.base,8));
  1666. countreg := get_scratch_reg_int(list,OS_INT);
  1667. a_load_const_reg(list,OS_32,count,countreg);
  1668. { explicitely allocate R_0 since it can be used safely here }
  1669. { (for holding date that's being copied) }
  1670. r.enum:=R_F0;
  1671. a_reg_alloc(list,r);
  1672. objectlibrary.getlabel(lab);
  1673. a_label(list, lab);
  1674. list.concat(taicpu.op_reg_reg_const(A_SUBIC_,countreg,countreg,1));
  1675. r.enum:=R_F0;
  1676. list.concat(taicpu.op_reg_ref(A_LFDU,r,src));
  1677. list.concat(taicpu.op_reg_ref(A_STFDU,r,dst));
  1678. a_jmp(list,A_BC,C_NE,0,lab);
  1679. free_scratch_reg(list,countreg);
  1680. a_reg_dealloc(list,r);
  1681. len := len mod 8;
  1682. end;
  1683. count := len div 8;
  1684. if count > 0 then
  1685. { unrolled loop }
  1686. begin
  1687. r.enum:=R_F0;
  1688. a_reg_alloc(list,r);
  1689. for count2 := 1 to count do
  1690. begin
  1691. a_loadfpu_ref_reg(list,OS_F64,src,r);
  1692. a_loadfpu_reg_ref(list,OS_F64,r,dst);
  1693. inc(src.offset,8);
  1694. inc(dst.offset,8);
  1695. end;
  1696. a_reg_dealloc(list,r);
  1697. len := len mod 8;
  1698. end;
  1699. if (len and 4) <> 0 then
  1700. begin
  1701. r.enum:=R_INTREGISTER;
  1702. r.number:=NR_R0;
  1703. a_reg_alloc(list,r);
  1704. a_load_ref_reg(list,OS_32,src,r);
  1705. a_load_reg_ref(list,OS_32,r,dst);
  1706. inc(src.offset,4);
  1707. inc(dst.offset,4);
  1708. a_reg_dealloc(list,r);
  1709. end;
  1710. {$else not ppc603}
  1711. if count > 4 then
  1712. { generate a loop }
  1713. begin
  1714. { the offsets are zero after the a_loadaddress_ref_reg and just }
  1715. { have to be set to 4. I put an Inc there so debugging may be }
  1716. { easier (should offset be different from zero here, it will be }
  1717. { easy to notice in the generated assembler }
  1718. inc(dst.offset,4);
  1719. inc(src.offset,4);
  1720. list.concat(taicpu.op_reg_reg_const(A_SUBI,src.base,src.base,4));
  1721. list.concat(taicpu.op_reg_reg_const(A_SUBI,dst.base,dst.base,4));
  1722. countreg := get_scratch_reg_int(list,OS_INT);
  1723. a_load_const_reg(list,OS_32,count,countreg);
  1724. { explicitely allocate R_0 since it can be used safely here }
  1725. { (for holding date that's being copied) }
  1726. r.enum:=R_INTREGISTER;
  1727. r.number:=NR_R0;
  1728. a_reg_alloc(list,r);
  1729. objectlibrary.getlabel(lab);
  1730. a_label(list, lab);
  1731. list.concat(taicpu.op_reg_reg_const(A_SUBIC_,countreg,countreg,1));
  1732. list.concat(taicpu.op_reg_ref(A_LWZU,r,src));
  1733. list.concat(taicpu.op_reg_ref(A_STWU,r,dst));
  1734. a_jmp(list,A_BC,C_NE,0,lab);
  1735. free_scratch_reg(list,countreg);
  1736. a_reg_dealloc(list,r);
  1737. len := len mod 4;
  1738. end;
  1739. count := len div 4;
  1740. if count > 0 then
  1741. { unrolled loop }
  1742. begin
  1743. r.enum:=R_INTREGISTER;
  1744. r.number:=NR_R0;
  1745. a_reg_alloc(list,r);
  1746. for count2 := 1 to count do
  1747. begin
  1748. a_load_ref_reg(list,OS_32,src,r);
  1749. a_load_reg_ref(list,OS_32,r,dst);
  1750. inc(src.offset,4);
  1751. inc(dst.offset,4);
  1752. end;
  1753. a_reg_dealloc(list,r);
  1754. len := len mod 4;
  1755. end;
  1756. {$endif not ppc603}
  1757. { copy the leftovers }
  1758. if (len and 2) <> 0 then
  1759. begin
  1760. r.enum:=R_INTREGISTER;
  1761. r.number:=NR_R0;
  1762. a_reg_alloc(list,r);
  1763. a_load_ref_reg(list,OS_16,src,r);
  1764. a_load_reg_ref(list,OS_16,r,dst);
  1765. inc(src.offset,2);
  1766. inc(dst.offset,2);
  1767. a_reg_dealloc(list,r);
  1768. end;
  1769. if (len and 1) <> 0 then
  1770. begin
  1771. r.enum:=R_INTREGISTER;
  1772. r.number:=NR_R0;
  1773. a_reg_alloc(list,r);
  1774. a_load_ref_reg(list,OS_8,src,r);
  1775. a_load_reg_ref(list,OS_8,r,dst);
  1776. a_reg_dealloc(list,r);
  1777. end;
  1778. if orgsrc then
  1779. begin
  1780. if delsource then
  1781. reference_release(list,source);
  1782. end
  1783. else
  1784. free_scratch_reg(list,src.base);
  1785. if not orgdst then
  1786. free_scratch_reg(list,dst.base);
  1787. if delsource then
  1788. tg.ungetiftemp(list,source);
  1789. end;
  1790. procedure tcgppc.g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer);
  1791. var
  1792. lenref : treference;
  1793. power,len : longint;
  1794. {$ifndef __NOWINPECOFF__}
  1795. again,ok : tasmlabel;
  1796. {$endif}
  1797. r,r2,rsp:Tregister;
  1798. begin
  1799. {$warning !!!! FIX ME !!!!}
  1800. internalerror(200305231);
  1801. {!!!!
  1802. lenref:=ref;
  1803. inc(lenref.offset,4);
  1804. { get stack space }
  1805. r.enum:=R_INTREGISTER;
  1806. r.number:=NR_EDI;
  1807. rsp.enum:=R_INTREGISTER;
  1808. rsp.number:=NR_ESP;
  1809. r2.enum:=R_INTREGISTER;
  1810. rg.getexplicitregisterint(list,NR_EDI);
  1811. list.concat(Taicpu.op_ref_reg(A_MOV,S_L,lenref,r));
  1812. list.concat(Taicpu.op_reg(A_INC,S_L,r));
  1813. if (elesize<>1) then
  1814. begin
  1815. if ispowerof2(elesize, power) then
  1816. list.concat(Taicpu.op_const_reg(A_SHL,S_L,power,r))
  1817. else
  1818. list.concat(Taicpu.op_const_reg(A_IMUL,S_L,elesize,r));
  1819. end;
  1820. {$ifndef __NOWINPECOFF__}
  1821. { windows guards only a few pages for stack growing, }
  1822. { so we have to access every page first }
  1823. if target_info.system=system_i386_win32 then
  1824. begin
  1825. objectlibrary.getlabel(again);
  1826. objectlibrary.getlabel(ok);
  1827. a_label(list,again);
  1828. list.concat(Taicpu.op_const_reg(A_CMP,S_L,winstackpagesize,r));
  1829. a_jmp_cond(list,OC_B,ok);
  1830. list.concat(Taicpu.op_const_reg(A_SUB,S_L,winstackpagesize-4,rsp));
  1831. r2.number:=NR_EAX;
  1832. list.concat(Taicpu.op_reg(A_PUSH,S_L,r));
  1833. list.concat(Taicpu.op_const_reg(A_SUB,S_L,winstackpagesize,r));
  1834. a_jmp_always(list,again);
  1835. a_label(list,ok);
  1836. list.concat(Taicpu.op_reg_reg(A_SUB,S_L,r,rsp));
  1837. rg.ungetregisterint(list,r);
  1838. { now reload EDI }
  1839. rg.getexplicitregisterint(list,NR_EDI);
  1840. list.concat(Taicpu.op_ref_reg(A_MOV,S_L,lenref,r));
  1841. list.concat(Taicpu.op_reg(A_INC,S_L,r));
  1842. if (elesize<>1) then
  1843. begin
  1844. if ispowerof2(elesize, power) then
  1845. list.concat(Taicpu.op_const_reg(A_SHL,S_L,power,r))
  1846. else
  1847. list.concat(Taicpu.op_const_reg(A_IMUL,S_L,elesize,r));
  1848. end;
  1849. end
  1850. else
  1851. {$endif __NOWINPECOFF__}
  1852. list.concat(Taicpu.op_reg_reg(A_SUB,S_L,r,rsp));
  1853. { align stack on 4 bytes }
  1854. list.concat(Taicpu.op_const_reg(A_AND,S_L,$fffffff4,rsp));
  1855. { load destination }
  1856. a_load_reg_reg(list,OS_INT,OS_INT,rsp,r);
  1857. { don't destroy the registers! }
  1858. r2.number:=NR_ECX;
  1859. list.concat(Taicpu.op_reg(A_PUSH,S_L,r2));
  1860. r2.number:=NR_ESI;
  1861. list.concat(Taicpu.op_reg(A_PUSH,S_L,r2));
  1862. { load count }
  1863. r2.number:=NR_ECX;
  1864. a_load_ref_reg(list,OS_INT,lenref,r2);
  1865. { load source }
  1866. r2.number:=NR_ESI;
  1867. a_load_ref_reg(list,OS_INT,ref,r2);
  1868. { scheduled .... }
  1869. r2.number:=NR_ECX;
  1870. list.concat(Taicpu.op_reg(A_INC,S_L,r2));
  1871. { calculate size }
  1872. len:=elesize;
  1873. opsize:=S_B;
  1874. if (len and 3)=0 then
  1875. begin
  1876. opsize:=S_L;
  1877. len:=len shr 2;
  1878. end
  1879. else
  1880. if (len and 1)=0 then
  1881. begin
  1882. opsize:=S_W;
  1883. len:=len shr 1;
  1884. end;
  1885. if ispowerof2(len, power) then
  1886. list.concat(Taicpu.op_const_reg(A_SHL,S_L,power,r2))
  1887. else
  1888. list.concat(Taicpu.op_const_reg(A_IMUL,S_L,len,r2));
  1889. list.concat(Taicpu.op_none(A_REP,S_NO));
  1890. case opsize of
  1891. S_B : list.concat(Taicpu.Op_none(A_MOVSB,S_NO));
  1892. S_W : list.concat(Taicpu.Op_none(A_MOVSW,S_NO));
  1893. S_L : list.concat(Taicpu.Op_none(A_MOVSD,S_NO));
  1894. end;
  1895. rg.ungetregisterint(list,r);
  1896. r2.number:=NR_ESI;
  1897. list.concat(Taicpu.op_reg(A_POP,S_L,r2));
  1898. r2.number:=NR_ECX;
  1899. list.concat(Taicpu.op_reg(A_POP,S_L,r2));
  1900. { patch the new address }
  1901. a_load_reg_ref(list,OS_INT,rsp,ref);
  1902. !!!!}
  1903. end;
  1904. procedure tcgppc.g_overflowcheck(list: taasmoutput; const p: tnode);
  1905. var
  1906. hl : tasmlabel;
  1907. r:Tregister;
  1908. begin
  1909. if not(cs_check_overflow in aktlocalswitches) then
  1910. exit;
  1911. objectlibrary.getlabel(hl);
  1912. if not ((p.resulttype.def.deftype=pointerdef) or
  1913. ((p.resulttype.def.deftype=orddef) and
  1914. (torddef(p.resulttype.def).typ in [u64bit,u16bit,u32bit,u8bit,uchar,
  1915. bool8bit,bool16bit,bool32bit]))) then
  1916. begin
  1917. r.enum:=R_CR7;
  1918. list.concat(taicpu.op_reg(A_MCRXR,r));
  1919. a_jmp(list,A_BC,C_OV,7,hl)
  1920. end
  1921. else
  1922. a_jmp_cond(list,OC_AE,hl);
  1923. a_call_name(list,'FPC_OVERFLOW');
  1924. a_label(list,hl);
  1925. end;
  1926. {***************** This is private property, keep out! :) *****************}
  1927. function tcgppc.issimpleref(const ref: treference): boolean;
  1928. begin
  1929. if (ref.base.number = NR_NO) and
  1930. (ref.index.number <> NR_NO) then
  1931. internalerror(200208101);
  1932. result :=
  1933. not(assigned(ref.symbol)) and
  1934. (((ref.index.number = NR_NO) and
  1935. (ref.offset >= low(smallint)) and
  1936. (ref.offset <= high(smallint))) or
  1937. ((ref.index.number <> NR_NO) and
  1938. (ref.offset = 0)));
  1939. end;
  1940. function tcgppc.fixref(list: taasmoutput; var ref: treference): boolean;
  1941. var
  1942. tmpreg: tregister;
  1943. begin
  1944. result := false;
  1945. if (ref.base.number = NR_NO) then
  1946. ref.base := ref.index;
  1947. if (ref.base.number <> NR_NO) then
  1948. begin
  1949. if (ref.index.number <> NR_NO) and
  1950. ((ref.offset <> 0) or assigned(ref.symbol)) then
  1951. begin
  1952. result := true;
  1953. tmpreg := cg.get_scratch_reg_int(list,OS_INT);
  1954. if not assigned(ref.symbol) and
  1955. (cardinal(ref.offset-low(smallint)) <=
  1956. high(smallint)-low(smallint)) then
  1957. begin
  1958. list.concat(taicpu.op_reg_reg_const(
  1959. A_ADDI,tmpreg,ref.base,ref.offset));
  1960. ref.offset := 0;
  1961. end
  1962. else
  1963. begin
  1964. list.concat(taicpu.op_reg_reg_reg(
  1965. A_ADD,tmpreg,ref.base,ref.index));
  1966. ref.index.number := NR_NO;
  1967. end;
  1968. ref.base := tmpreg;
  1969. end
  1970. end
  1971. else
  1972. if ref.index.number <> NR_NO then
  1973. internalerror(200208102);
  1974. end;
  1975. { find out whether a is of the form 11..00..11b or 00..11...00. If }
  1976. { that's the case, we can use rlwinm to do an AND operation }
  1977. function tcgppc.get_rlwi_const(a: aword; var l1, l2: longint): boolean;
  1978. var
  1979. temp : longint;
  1980. testbit : aword;
  1981. compare: boolean;
  1982. begin
  1983. get_rlwi_const := false;
  1984. if (a = 0) or (a = $ffffffff) then
  1985. exit;
  1986. { start with the lowest bit }
  1987. testbit := 1;
  1988. { check its value }
  1989. compare := boolean(a and testbit);
  1990. { find out how long the run of bits with this value is }
  1991. { (it's impossible that all bits are 1 or 0, because in that case }
  1992. { this function wouldn't have been called) }
  1993. l1 := 31;
  1994. while (((a and testbit) <> 0) = compare) do
  1995. begin
  1996. testbit := testbit shl 1;
  1997. dec(l1);
  1998. end;
  1999. { check the length of the run of bits that comes next }
  2000. compare := not compare;
  2001. l2 := l1;
  2002. while (((a and testbit) <> 0) = compare) and
  2003. (l2 >= 0) do
  2004. begin
  2005. testbit := testbit shl 1;
  2006. dec(l2);
  2007. end;
  2008. { and finally the check whether the rest of the bits all have the }
  2009. { same value }
  2010. compare := not compare;
  2011. temp := l2;
  2012. if temp >= 0 then
  2013. if (a shr (31-temp)) <> ((-ord(compare)) shr (31-temp)) then
  2014. exit;
  2015. { we have done "not(not(compare))", so compare is back to its }
  2016. { initial value. If the lowest bit was 0, a is of the form }
  2017. { 00..11..00 and we need "rlwinm reg,reg,0,l2+1,l1", (+1 }
  2018. { because l2 now contains the position of the last zero of the }
  2019. { first run instead of that of the first 1) so switch l1 and l2 }
  2020. { in that case (we will generate "rlwinm reg,reg,0,l1,l2") }
  2021. if not compare then
  2022. begin
  2023. temp := l1;
  2024. l1 := l2+1;
  2025. l2 := temp;
  2026. end
  2027. else
  2028. { otherwise, l1 currently contains the position of the last }
  2029. { zero instead of that of the first 1 of the second run -> +1 }
  2030. inc(l1);
  2031. { the following is the same as "if l1 = -1 then l1 := 31;" }
  2032. l1 := l1 and 31;
  2033. l2 := l2 and 31;
  2034. get_rlwi_const := true;
  2035. end;
  2036. procedure tcgppc.a_load_store(list:taasmoutput;op: tasmop;reg:tregister;
  2037. ref: treference);
  2038. var
  2039. tmpreg: tregister;
  2040. tmpref: treference;
  2041. r : Tregister;
  2042. begin
  2043. tmpreg.number := NR_NO;
  2044. if assigned(ref.symbol) or
  2045. (cardinal(ref.offset-low(smallint)) >
  2046. high(smallint)-low(smallint)) then
  2047. begin
  2048. if target_info.system = system_powerpc_macos then
  2049. begin
  2050. if ref.base.number <> NR_NO then
  2051. begin
  2052. if macos_direct_globals then
  2053. begin
  2054. {Generates
  2055. add tempreg, ref.base, RTOC
  2056. op reg, symbolplusoffset, tempreg
  2057. which is eqvivalent to the more comprehensive
  2058. addi tempreg, RTOC, symbolplusoffset
  2059. add tempreg, ref.base, tempreg
  2060. op reg, tempreg
  2061. but which saves one instruction.}
  2062. tmpreg := get_scratch_reg_address(list);
  2063. reference_reset(tmpref);
  2064. tmpref.symbol := ref.symbol;
  2065. tmpref.offset := ref.offset;
  2066. tmpref.symaddr := refs_full;
  2067. tmpref.base:= tmpreg;
  2068. r.enum:=R_INTREGISTER;
  2069. r.number:=NR_RTOC;
  2070. list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,
  2071. ref.base,r));
  2072. list.concat(taicpu.op_reg_ref(op,reg,tmpref));
  2073. end
  2074. else
  2075. begin
  2076. tmpreg := get_scratch_reg_address(list);
  2077. reference_reset(tmpref);
  2078. tmpref.symbol := ref.symbol;
  2079. tmpref.offset := ref.offset;
  2080. tmpref.symaddr := refs_full;
  2081. tmpref.base.enum:= R_INTREGISTER;
  2082. tmpref.base.number:= NR_RTOC;
  2083. list.concat(taicpu.op_reg_ref(A_LWZ,tmpreg,tmpref));
  2084. list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,
  2085. ref.base,tmpreg));
  2086. reference_reset(tmpref);
  2087. tmpref.offset := 0;
  2088. tmpref.symaddr := refs_full;
  2089. tmpref.base:= tmpreg;
  2090. list.concat(taicpu.op_reg_ref(op,reg,tmpref));
  2091. end;
  2092. //list.concat(tai_comment.create(strpnew('**** a_load_store 1')));
  2093. end
  2094. else
  2095. begin
  2096. if macos_direct_globals then
  2097. begin
  2098. reference_reset(tmpref);
  2099. tmpref.symbol := ref.symbol;
  2100. tmpref.offset := ref.offset;
  2101. tmpref.symaddr := refs_full;
  2102. tmpref.base.enum:= R_INTREGISTER;
  2103. tmpref.base.number:= NR_RTOC;
  2104. list.concat(taicpu.op_reg_ref(op,reg,tmpref));
  2105. end
  2106. else
  2107. begin
  2108. tmpreg := get_scratch_reg_address(list);
  2109. reference_reset(tmpref);
  2110. tmpref.symbol := ref.symbol;
  2111. tmpref.offset := ref.offset;
  2112. tmpref.symaddr := refs_full;
  2113. tmpref.base.enum:= R_INTREGISTER;
  2114. tmpref.base.number:= NR_RTOC;
  2115. list.concat(taicpu.op_reg_ref(A_LWZ,tmpreg,tmpref));
  2116. reference_reset(tmpref);
  2117. tmpref.offset := 0;
  2118. tmpref.symaddr := refs_full;
  2119. tmpref.base:= tmpreg;
  2120. list.concat(taicpu.op_reg_ref(op,reg,tmpref));
  2121. end;
  2122. //list.concat(tai_comment.create(strpnew('*** a_load_store 2')));
  2123. end;
  2124. end
  2125. else
  2126. begin
  2127. tmpreg := get_scratch_reg_address(list);
  2128. reference_reset(tmpref);
  2129. tmpref.symbol := ref.symbol;
  2130. tmpref.offset := ref.offset;
  2131. tmpref.symaddr := refs_ha;
  2132. if ref.base.number <> NR_NO then
  2133. list.concat(taicpu.op_reg_reg_ref(A_ADDIS,tmpreg,
  2134. ref.base,tmpref))
  2135. else
  2136. list.concat(taicpu.op_reg_ref(A_LIS,tmpreg,tmpref));
  2137. ref.base := tmpreg;
  2138. ref.symaddr := refs_l;
  2139. list.concat(taicpu.op_reg_ref(op,reg,ref));
  2140. end
  2141. end
  2142. else
  2143. list.concat(taicpu.op_reg_ref(op,reg,ref));
  2144. if (tmpreg.number <> NR_NO) then
  2145. free_scratch_reg(list,tmpreg);
  2146. end;
  2147. procedure tcgppc.a_jmp(list: taasmoutput; op: tasmop; c: tasmcondflag;
  2148. crval: longint; l: tasmlabel);
  2149. var
  2150. p: taicpu;
  2151. begin
  2152. p := taicpu.op_sym(op,objectlibrary.newasmsymbol(l.name));
  2153. if op <> A_B then
  2154. create_cond_norm(c,crval,p.condition);
  2155. p.is_jmp := true;
  2156. list.concat(p)
  2157. end;
  2158. procedure tcg64fppc.a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);
  2159. begin
  2160. a_op64_reg_reg_reg(list,op,regsrc,regdst,regdst);
  2161. end;
  2162. procedure tcg64fppc.a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;reg : tregister64);
  2163. begin
  2164. a_op64_const_reg_reg(list,op,value,reg,reg);
  2165. end;
  2166. procedure tcg64fppc.a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64);
  2167. begin
  2168. case op of
  2169. OP_AND,OP_OR,OP_XOR:
  2170. begin
  2171. cg.a_op_reg_reg_reg(list,op,OS_32,regsrc1.reglo,regsrc2.reglo,regdst.reglo);
  2172. cg.a_op_reg_reg_reg(list,op,OS_32,regsrc1.reghi,regsrc2.reghi,regdst.reghi);
  2173. end;
  2174. OP_ADD:
  2175. begin
  2176. list.concat(taicpu.op_reg_reg_reg(A_ADDC,regdst.reglo,regsrc1.reglo,regsrc2.reglo));
  2177. list.concat(taicpu.op_reg_reg_reg(A_ADDE,regdst.reghi,regsrc1.reghi,regsrc2.reghi));
  2178. end;
  2179. OP_SUB:
  2180. begin
  2181. list.concat(taicpu.op_reg_reg_reg(A_SUBC,regdst.reglo,regsrc2.reglo,regsrc1.reglo));
  2182. list.concat(taicpu.op_reg_reg_reg(A_SUBFE,regdst.reghi,regsrc1.reghi,regsrc2.reghi));
  2183. end;
  2184. else
  2185. internalerror(2002072801);
  2186. end;
  2187. end;
  2188. procedure tcg64fppc.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : qword;regsrc,regdst : tregister64);
  2189. const
  2190. ops: array[boolean,1..3] of tasmop = ((A_ADDIC,A_ADDC,A_ADDZE),
  2191. (A_SUBIC,A_SUBC,A_ADDME));
  2192. var
  2193. tmpreg: tregister;
  2194. tmpreg64: tregister64;
  2195. newop: TOpCG;
  2196. issub: boolean;
  2197. begin
  2198. case op of
  2199. OP_AND,OP_OR,OP_XOR:
  2200. begin
  2201. cg.a_op_const_reg_reg(list,op,OS_32,cardinal(value),regsrc.reglo,regdst.reglo);
  2202. cg.a_op_const_reg_reg(list,op,OS_32,value shr 32,regsrc.reghi,
  2203. regdst.reghi);
  2204. end;
  2205. OP_ADD, OP_SUB:
  2206. begin
  2207. if (int64(value) < 0) then
  2208. begin
  2209. if op = OP_ADD then
  2210. op := OP_SUB
  2211. else
  2212. op := OP_ADD;
  2213. int64(value) := -int64(value);
  2214. end;
  2215. if (longint(value) <> 0) then
  2216. begin
  2217. issub := op = OP_SUB;
  2218. if (int64(value) > 0) and
  2219. (int64(value)-ord(issub) <= 32767) then
  2220. begin
  2221. list.concat(taicpu.op_reg_reg_const(ops[issub,1],
  2222. regdst.reglo,regsrc.reglo,longint(value)));
  2223. list.concat(taicpu.op_reg_reg(ops[issub,3],
  2224. regdst.reghi,regsrc.reghi));
  2225. end
  2226. else if ((value shr 32) = 0) then
  2227. begin
  2228. tmpreg := cg.get_scratch_reg_int(list,OS_32);
  2229. cg.a_load_const_reg(list,OS_32,cardinal(value),tmpreg);
  2230. list.concat(taicpu.op_reg_reg_reg(ops[issub,2],
  2231. regdst.reglo,regsrc.reglo,tmpreg));
  2232. cg.free_scratch_reg(list,tmpreg);
  2233. list.concat(taicpu.op_reg_reg(ops[issub,3],
  2234. regdst.reghi,regsrc.reghi));
  2235. end
  2236. else
  2237. begin
  2238. tmpreg64.reglo := cg.get_scratch_reg_int(list,OS_INT);
  2239. tmpreg64.reghi := cg.get_scratch_reg_int(list,OS_INT);
  2240. a_load64_const_reg(list,value,tmpreg64);
  2241. a_op64_reg_reg_reg(list,op,tmpreg64,regsrc,regdst);
  2242. cg.free_scratch_reg(list,tmpreg64.reghi);
  2243. cg.free_scratch_reg(list,tmpreg64.reglo);
  2244. end
  2245. end
  2246. else
  2247. begin
  2248. cg.a_load_reg_reg(list,OS_INT,OS_INT,regsrc.reglo,regdst.reglo);
  2249. cg.a_op_const_reg_reg(list,op,OS_32,value shr 32,regsrc.reghi,
  2250. regdst.reghi);
  2251. end;
  2252. end;
  2253. else
  2254. internalerror(2002072802);
  2255. end;
  2256. end;
  2257. begin
  2258. cg := tcgppc.create;
  2259. cg64 :=tcg64fppc.create;
  2260. end.
  2261. {
  2262. $Log$
  2263. Revision 1.101 2003-05-30 18:52:10 jonas
  2264. * fixed bug with intregvars
  2265. * locapara.loc can also be LOC_CFPUREGISTER -> also fixed
  2266. rcgppc.a_param_ref, which previously got bogus size values
  2267. Revision 1.100 2003/05/29 21:17:27 jonas
  2268. * compile with -dppc603 to not use unaligned float loads in move() and
  2269. g_concatcopy, because the 603 and 604 take an exception for those
  2270. (and netbsd doesn't even handle those in the kernel). There are
  2271. still some of those left that could cause problems though (e.g.
  2272. in the set helpers)
  2273. Revision 1.99 2003/05/29 10:06:09 jonas
  2274. * also free temps in g_concatcopy if delsource is true
  2275. Revision 1.98 2003/05/28 23:58:18 jonas
  2276. * added missing initialization of rg.usedint{in,by}proc
  2277. * ppc now also saves/restores used fpu registers
  2278. * ncgcal doesn't add used registers to usedby/inproc anymore, except for
  2279. i386
  2280. Revision 1.97 2003/05/28 23:18:31 florian
  2281. * started to fix and clean up the sparc port
  2282. Revision 1.96 2003/05/24 11:59:42 jonas
  2283. * fixed integer typeconversion problems
  2284. Revision 1.95 2003/05/23 18:51:26 jonas
  2285. * fixed support for nested procedures and more parameters than those
  2286. which fit in registers (untested/probably not working: calling a
  2287. nested procedure from a deeper nested procedure)
  2288. Revision 1.94 2003/05/20 23:54:00 florian
  2289. + basic darwin support added
  2290. Revision 1.93 2003/05/15 22:14:42 florian
  2291. * fixed last commit, changing lastsaveintreg to r31 caused some strange problems
  2292. Revision 1.92 2003/05/15 21:37:00 florian
  2293. * sysv entry code saves r13 now as well
  2294. Revision 1.91 2003/05/15 19:39:09 florian
  2295. * fixed ppc compiler which was broken by Peter's changes
  2296. Revision 1.90 2003/05/12 18:43:50 jonas
  2297. * fixed g_concatcopy
  2298. Revision 1.89 2003/05/11 20:59:23 jonas
  2299. * fixed bug with large offsets in entrycode
  2300. Revision 1.88 2003/05/11 11:45:08 jonas
  2301. * fixed shifts
  2302. Revision 1.87 2003/05/11 11:07:33 jonas
  2303. * fixed optimizations in a_op_const_reg_reg()
  2304. Revision 1.86 2003/04/27 11:21:36 peter
  2305. * aktprocdef renamed to current_procdef
  2306. * procinfo renamed to current_procinfo
  2307. * procinfo will now be stored in current_module so it can be
  2308. cleaned up properly
  2309. * gen_main_procsym changed to create_main_proc and release_main_proc
  2310. to also generate a tprocinfo structure
  2311. * fixed unit implicit initfinal
  2312. Revision 1.85 2003/04/26 22:56:11 jonas
  2313. * fix to a_op64_const_reg_reg
  2314. Revision 1.84 2003/04/26 16:08:41 jonas
  2315. * fixed g_flags2reg
  2316. Revision 1.83 2003/04/26 15:25:29 florian
  2317. * fixed cmp_reg_reg_reg, cmp operands were emitted in the wrong order
  2318. Revision 1.82 2003/04/25 20:55:34 florian
  2319. * stack frame calculations are now completly done using the code generator
  2320. routines instead of generating directly assembler so also large stack frames
  2321. are handle properly
  2322. Revision 1.81 2003/04/24 11:24:00 florian
  2323. * fixed several issues with nested procedures
  2324. Revision 1.80 2003/04/23 22:18:01 peter
  2325. * fixes to get rtl compiled
  2326. Revision 1.79 2003/04/23 12:35:35 florian
  2327. * fixed several issues with powerpc
  2328. + applied a patch from Jonas for nested function calls (PowerPC only)
  2329. * ...
  2330. Revision 1.78 2003/04/16 09:26:55 jonas
  2331. * assembler procedures now again get a stackframe if they have local
  2332. variables. No space is reserved for a function result however.
  2333. Also, the register parameters aren't automatically saved on the stack
  2334. anymore in assembler procedures.
  2335. Revision 1.77 2003/04/06 16:39:11 jonas
  2336. * don't generate entry/exit code for assembler procedures
  2337. Revision 1.76 2003/03/22 18:01:13 jonas
  2338. * fixed linux entry/exit code generation
  2339. Revision 1.75 2003/03/19 14:26:26 jonas
  2340. * fixed R_TOC bugs introduced by new register allocator conversion
  2341. Revision 1.74 2003/03/13 22:57:45 olle
  2342. * change in a_loadaddr_ref_reg
  2343. Revision 1.73 2003/03/12 22:43:38 jonas
  2344. * more powerpc and generic fixes related to the new register allocator
  2345. Revision 1.72 2003/03/11 21:46:24 jonas
  2346. * lots of new regallocator fixes, both in generic and ppc-specific code
  2347. (ppc compiler still can't compile the linux system unit though)
  2348. Revision 1.71 2003/02/19 22:00:16 daniel
  2349. * Code generator converted to new register notation
  2350. - Horribily outdated todo.txt removed
  2351. Revision 1.70 2003/01/13 17:17:50 olle
  2352. * changed global var access, TOC now contain pointers to globals
  2353. * fixed handling of function pointers
  2354. Revision 1.69 2003/01/09 22:00:53 florian
  2355. * fixed some PowerPC issues
  2356. Revision 1.68 2003/01/08 18:43:58 daniel
  2357. * Tregister changed into a record
  2358. Revision 1.67 2002/12/15 19:22:01 florian
  2359. * fixed some crashes and a rte 201
  2360. Revision 1.66 2002/11/28 10:55:16 olle
  2361. * macos: changing code gen for references to globals
  2362. Revision 1.65 2002/11/07 15:50:23 jonas
  2363. * fixed bctr(l) problems
  2364. Revision 1.64 2002/11/04 18:24:19 olle
  2365. * macos: globals are located in TOC and relative r2, instead of absolute
  2366. Revision 1.63 2002/10/28 22:24:28 olle
  2367. * macos entry/exit: only used registers are saved
  2368. - macos entry/exit: stackptr not saved in r31 anymore
  2369. * macos entry/exit: misc fixes
  2370. Revision 1.62 2002/10/19 23:51:48 olle
  2371. * macos stack frame size computing updated
  2372. + macos epilogue: control register now restored
  2373. * macos prologue and epilogue: fp reg now saved and restored
  2374. Revision 1.61 2002/10/19 12:50:36 olle
  2375. * reorganized prologue and epilogue routines
  2376. Revision 1.60 2002/10/02 21:49:51 florian
  2377. * all A_BL instructions replaced by calls to a_call_name
  2378. Revision 1.59 2002/10/02 13:24:58 jonas
  2379. * changed a_call_* so that no superfluous code is generated anymore
  2380. Revision 1.58 2002/09/17 18:54:06 jonas
  2381. * a_load_reg_reg() now has two size parameters: source and dest. This
  2382. allows some optimizations on architectures that don't encode the
  2383. register size in the register name.
  2384. Revision 1.57 2002/09/10 21:22:25 jonas
  2385. + added some internal errors
  2386. * fixed bug in sysv exit code
  2387. Revision 1.56 2002/09/08 20:11:56 jonas
  2388. * fixed TOpCmp2AsmCond array (some unsigned equivalents were wrong)
  2389. Revision 1.55 2002/09/08 13:03:26 jonas
  2390. * several large offset-related fixes
  2391. Revision 1.54 2002/09/07 17:54:58 florian
  2392. * first part of PowerPC fixes
  2393. Revision 1.53 2002/09/07 15:25:14 peter
  2394. * old logs removed and tabs fixed
  2395. Revision 1.52 2002/09/02 10:14:51 jonas
  2396. + a_call_reg()
  2397. * small fix in a_call_ref()
  2398. Revision 1.51 2002/09/02 06:09:02 jonas
  2399. * fixed range error
  2400. Revision 1.50 2002/09/01 21:04:49 florian
  2401. * several powerpc related stuff fixed
  2402. Revision 1.49 2002/09/01 12:09:27 peter
  2403. + a_call_reg, a_call_loc added
  2404. * removed exprasmlist references
  2405. Revision 1.48 2002/08/31 21:38:02 jonas
  2406. * fixed a_call_ref (it should load ctr, not lr)
  2407. Revision 1.47 2002/08/31 21:30:45 florian
  2408. * fixed several problems caused by Jonas' commit :)
  2409. Revision 1.46 2002/08/31 19:25:50 jonas
  2410. + implemented a_call_ref()
  2411. Revision 1.45 2002/08/18 22:16:14 florian
  2412. + the ppc gas assembler writer adds now registers aliases
  2413. to the assembler file
  2414. Revision 1.44 2002/08/17 18:23:53 florian
  2415. * some assembler writer bugs fixed
  2416. Revision 1.43 2002/08/17 09:23:49 florian
  2417. * first part of procinfo rewrite
  2418. Revision 1.42 2002/08/16 14:24:59 carl
  2419. * issameref() to test if two references are the same (then emit no opcodes)
  2420. + ret_in_reg to replace ret_in_acc
  2421. (fix some register allocation bugs at the same time)
  2422. + save_std_register now has an extra parameter which is the
  2423. usedinproc registers
  2424. Revision 1.41 2002/08/15 08:13:54 carl
  2425. - a_load_sym_ofs_reg removed
  2426. * loadvmt now calls loadaddr_ref_reg instead
  2427. Revision 1.40 2002/08/11 14:32:32 peter
  2428. * renamed current_library to objectlibrary
  2429. Revision 1.39 2002/08/11 13:24:18 peter
  2430. * saving of asmsymbols in ppu supported
  2431. * asmsymbollist global is removed and moved into a new class
  2432. tasmlibrarydata that will hold the info of a .a file which
  2433. corresponds with a single module. Added librarydata to tmodule
  2434. to keep the library info stored for the module. In the future the
  2435. objectfiles will also be stored to the tasmlibrarydata class
  2436. * all getlabel/newasmsymbol and friends are moved to the new class
  2437. Revision 1.38 2002/08/11 11:39:31 jonas
  2438. + powerpc-specific genlinearlist
  2439. Revision 1.37 2002/08/10 17:15:31 jonas
  2440. * various fixes and optimizations
  2441. Revision 1.36 2002/08/06 20:55:23 florian
  2442. * first part of ppc calling conventions fix
  2443. Revision 1.35 2002/08/06 07:12:05 jonas
  2444. * fixed bug in g_flags2reg()
  2445. * and yet more constant operation fixes :)
  2446. Revision 1.34 2002/08/05 08:58:53 jonas
  2447. * fixed compilation problems
  2448. Revision 1.33 2002/08/04 12:57:55 jonas
  2449. * more misc. fixes, mostly constant-related
  2450. }