cgcpu.pas 48 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 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 defines.inc}
  20. interface
  21. uses
  22. cgbase,cgobj,aasm,cpuasm,cpubase,cpuinfo,node,cg64f32,cginfo;
  23. type
  24. tcgppc = class(tcg64f32)
  25. { passing parameters, per default the parameter is pushed }
  26. { nr gives the number of the parameter (enumerated from }
  27. { left to right), this allows to move the parameter to }
  28. { register, if the cpu supports register calling }
  29. { conventions }
  30. procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;nr : longint);override;
  31. procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;nr : longint);override;
  32. procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;nr : longint);override;
  33. procedure a_paramaddr_ref(list : taasmoutput;const r : treference;nr : longint);override;
  34. procedure a_call_name(list : taasmoutput;const s : string);override;
  35. procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister); override;
  36. procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister); override;
  37. procedure a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
  38. size: tcgsize; a: aword; src, dst: tregister); override;
  39. procedure a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
  40. size: tcgsize; src1, src2, dst: tregister); override;
  41. { move instructions }
  42. procedure a_load_const_reg(list : taasmoutput; size: tcgsize; a : aword;reg : tregister);override;
  43. procedure a_load_reg_ref(list : taasmoutput; size: tcgsize; reg : tregister;const ref : treference);override;
  44. procedure a_load_ref_reg(list : taasmoutput;size : tcgsize;const Ref : treference;reg : tregister);override;
  45. procedure a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);override;
  46. procedure a_load_sym_ofs_reg(list: taasmoutput; const sym: tasmsymbol; ofs: longint; reg: tregister); override;
  47. { fpu move instructions }
  48. procedure a_loadfpu_reg_reg(list: taasmoutput; reg1, reg2: tregister); override;
  49. procedure a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister); override;
  50. procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); override;
  51. { comparison operations }
  52. procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
  53. l : tasmlabel);override;
  54. procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
  55. procedure a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); override;
  56. procedure g_flags2reg(list: taasmoutput; const f: TResFlags; reg: TRegister); override;
  57. procedure g_stackframe_entry_sysv(list : taasmoutput;localsize : longint);
  58. procedure g_stackframe_entry_mac(list : taasmoutput;localsize : longint);
  59. procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
  60. procedure g_restore_frame_pointer(list : taasmoutput);override;
  61. procedure g_return_from_proc(list : taasmoutput;parasize : aword); override;
  62. procedure a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);override;
  63. procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);override;
  64. procedure g_overflowcheck(list: taasmoutput; const p: tnode); override;
  65. { find out whether a is of the form 11..00..11b or 00..11...00. If }
  66. { that's the case, we can use rlwinm to do an AND operation }
  67. function get_rlwi_const(a: longint; var l1, l2: longint): boolean;
  68. private
  69. procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
  70. procedure g_return_from_proc_sysv(list : taasmoutput;parasize : aword);
  71. procedure g_return_from_proc_mac(list : taasmoutput;parasize : aword);
  72. { Make sure ref is a valid reference for the PowerPC and sets the }
  73. { base to the value of the index if (base = R_NO). }
  74. procedure fixref(list: taasmoutput; var ref: treference);
  75. { contains the common code of a_load_reg_ref and a_load_ref_reg }
  76. procedure a_load_store(list:taasmoutput;op: tasmop;reg:tregister;
  77. ref: treference);
  78. { creates the correct branch instruction for a given combination }
  79. { of asmcondflags and destination addressing mode }
  80. procedure a_jmp(list: taasmoutput; op: tasmop;
  81. c: tasmcondflag; crval: longint; l: tasmlabel);
  82. end;
  83. const
  84. {
  85. TOpCG2AsmOp: Array[topcg] of TAsmOp = (A_NONE,A_ADD,A_AND,A_DIVWU,
  86. A_DIVW,A_MULLW, A_MULLW, A_NEG,A_NOT,A_OR,
  87. A_SRAW,A_SLW,A_SRW,A_SUB,A_XOR);
  88. }
  89. TOpCG2AsmOpConstLo: Array[topcg] of TAsmOp = (A_NONE,A_ADDI,A_ANDI_,A_DIVWU,
  90. A_DIVW,A_MULLW, A_MULLW, A_NONE,A_NONE,A_ORI,
  91. A_SRAWI,A_SLWI,A_SRWI,A_SUBI,A_XORI);
  92. TOpCG2AsmOpConstHi: Array[topcg] of TAsmOp = (A_NONE,A_ADDIS,A_ANDIS_,
  93. A_DIVWU,A_DIVW, A_MULLW,A_MULLW,A_NONE,A_NONE,
  94. A_ORIS,A_NONE, A_NONE,A_NONE,A_SUBIS,A_XORIS);
  95. TOpCmp2AsmCond: Array[topcmp] of TAsmCondFlag = (C_NONE,C_EQ,C_GT,
  96. C_LT,C_GE,C_LE,C_NE,C_LE,C_NG,C_GE,C_NL);
  97. implementation
  98. uses
  99. globtype,globals,verbose,systems,cutils,symconst,symdef,rgobj;
  100. { parameter passing... Still needs extra support from the processor }
  101. { independent code generator }
  102. procedure tcgppc.a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;nr : longint);
  103. var
  104. ref: treference;
  105. begin
  106. {$ifdef para_sizes_known}
  107. if (nr <= max_param_regs_int) then
  108. a_load_reg_reg(list,size,r,param_regs_int[nr])
  109. else
  110. begin
  111. reset_reference(ref);
  112. ref.base := STACK_POINTER_REG;
  113. ref.offset := LinkageAreaSize+para_size_till_now;
  114. a_load_reg_ref(list,size,reg,ref);
  115. end;
  116. {$endif para_sizes_known}
  117. end;
  118. procedure tcgppc.a_param_const(list : taasmoutput;size : tcgsize;a : aword;nr : longint);
  119. var
  120. ref: treference;
  121. begin
  122. {$ifdef para_sizes_known}
  123. if (nr <= max_param_regs_int) then
  124. a_load_const_reg(list,size,a,param_regs_int[nr])
  125. else
  126. begin
  127. reset_reference(ref);
  128. ref.base := STACK_POINTER_REG;
  129. ref.offset := LinkageAreaSize+para_size_till_now;
  130. a_load_const_ref(list,size,a,ref);
  131. end;
  132. {$endif para_sizes_known}
  133. end;
  134. procedure tcgppc.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;nr : longint);
  135. var
  136. ref: treference;
  137. tmpreg: tregister;
  138. begin
  139. {$ifdef para_sizes_known}
  140. if (nr <= max_param_regs_int) then
  141. a_load_ref_reg(list,size,r,param_regs_int[nr])
  142. else
  143. begin
  144. reset_reference(ref);
  145. ref.base := STACK_POINTER_REG;
  146. ref.offset := LinkageAreaSize+para_size_till_now;
  147. tmpreg := get_scratch_reg(list);
  148. a_load_ref_reg(list,size,r,tmpreg);
  149. a_load_reg_ref(list,size,tmpreg,ref);
  150. free_scratch_reg(list,tmpreg);
  151. end;
  152. {$endif para_sizes_known}
  153. end;
  154. procedure tcgppc.a_paramaddr_ref(list : taasmoutput;const r : treference;nr : longint);
  155. var
  156. ref: treference;
  157. tmpreg: tregister;
  158. begin
  159. {$ifdef para_sizes_known}
  160. if (nr <= max_param_regs_int) then
  161. a_loadaddr_ref_reg(list,size,r,param_regs_int[nr])
  162. else
  163. begin
  164. reset_reference(ref);
  165. ref.base := STACK_POINTER_REG;
  166. ref.offset := LinkageAreaSize+para_size_till_now;
  167. tmpreg := get_scratch_reg(list);
  168. a_loadaddr_ref_reg(list,size,r,tmpreg);
  169. a_load_reg_ref(list,size,tmpreg,ref);
  170. free_scratch_reg(list,tmpreg);
  171. end;
  172. {$endif para_sizes_known}
  173. end;
  174. { calling a code fragment by name }
  175. procedure tcgppc.a_call_name(list : taasmoutput;const s : string);
  176. var
  177. href : treference;
  178. begin
  179. { save our RTOC register value. Only necessary when doing pointer based }
  180. { calls or cross TOC calls, but currently done always }
  181. reference_reset_base(href,STACK_POINTER_REG,LA_RTOC);
  182. list.concat(taicpu.op_reg_ref(A_STW,R_TOC,href));
  183. list.concat(taicpu.op_sym(A_BL,newasmsymbol(s)));
  184. reference_reset_base(href,STACK_POINTER_REG,LA_RTOC);
  185. list.concat(taicpu.op_reg_ref(A_LWZ,R_TOC,href));
  186. end;
  187. {********************** load instructions ********************}
  188. procedure tcgppc.a_load_const_reg(list : taasmoutput; size: TCGSize; a : aword; reg : TRegister);
  189. begin
  190. if (a and $ffff) <> 0 Then
  191. begin
  192. list.concat(taicpu.op_reg_const(A_LI,reg,a and $ffff));
  193. if (longint(a) < low(smallint)) or
  194. (longint(a) > high(smallint)) then
  195. list.concat(taicpu.op_reg_const(A_ADDIS,reg,
  196. (a shr 16)+ord(smallint(a and $ffff) < 0)))
  197. end
  198. else
  199. list.concat(taicpu.op_reg_const(A_LIS,reg,a shr 16));
  200. end;
  201. procedure tcgppc.a_load_reg_ref(list : taasmoutput; size: TCGSize; reg : tregister;const ref : treference);
  202. const
  203. StoreInstr: Array[OS_8..OS_32,boolean, boolean] of TAsmOp =
  204. { indexed? updating?}
  205. (((A_STB,A_STBU),(A_STBX,A_STBUX)),
  206. ((A_STH,A_STHU),(A_STHX,A_STHUX)),
  207. ((A_STW,A_STWU),(A_STWX,A_STWUX)));
  208. var
  209. op: TAsmOp;
  210. ref2: TReference;
  211. begin
  212. ref2 := ref;
  213. FixRef(list,ref2);
  214. if size in [OS_S8..OS_S16] then
  215. { storing is the same for signed and unsigned values }
  216. size := tcgsize(ord(size)-(ord(OS_S8)-ord(OS_8)));
  217. { 64 bit stuff should be handled separately }
  218. if size in [OS_64,OS_S64] then
  219. internalerror(200109236);
  220. op := storeinstr[size,ref2.index<>R_NO,false];
  221. a_load_store(list,op,reg,ref2);
  222. End;
  223. procedure tcgppc.a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref: treference;reg : tregister);
  224. const
  225. LoadInstr: Array[OS_8..OS_S32,boolean, boolean] of TAsmOp =
  226. { indexed? updating?}
  227. (((A_LBZ,A_LBZU),(A_LBZX,A_LBZUX)),
  228. ((A_LHZ,A_LHZU),(A_LHZX,A_LHZUX)),
  229. ((A_LWZ,A_LWZU),(A_LWZX,A_LWZUX)),
  230. { 64bit stuff should be handled separately }
  231. ((A_NONE,A_NONE),(A_NONE,A_NONE)),
  232. { there's no load-byte-with-sign-extend :( }
  233. ((A_LBZ,A_LBZU),(A_LBZX,A_LBZUX)),
  234. ((A_LHA,A_LHAU),(A_LHAX,A_LHAUX)),
  235. ((A_LWZ,A_LWZU),(A_LWZX,A_LWZUX)));
  236. var
  237. op: tasmop;
  238. tmpreg: tregister;
  239. ref2, tmpref: treference;
  240. begin
  241. ref2 := ref;
  242. fixref(list,ref2);
  243. op := loadinstr[size,ref2.index<>R_NO,false];
  244. a_load_store(list,op,reg,ref2);
  245. { sign extend shortint if necessary, since there is no }
  246. { load instruction that does that automatically (JM) }
  247. if size = OS_S8 then
  248. list.concat(taicpu.op_reg_reg(A_EXTSB,reg,reg));
  249. end;
  250. procedure tcgppc.a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);
  251. begin
  252. list.concat(taicpu.op_reg_reg(A_MR,reg2,reg1));
  253. end;
  254. procedure tcgppc.a_load_sym_ofs_reg(list: taasmoutput; const sym: tasmsymbol; ofs: longint; reg: tregister);
  255. begin
  256. { can't use op_sym_ofs_reg because sym+ofs can be > 32767!! }
  257. internalerror(200112293);
  258. end;
  259. procedure tcgppc.a_loadfpu_reg_reg(list: taasmoutput; reg1, reg2: tregister);
  260. begin
  261. list.concat(taicpu.op_reg_reg(A_FMR,reg1,reg2));
  262. end;
  263. procedure tcgppc.a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister);
  264. const
  265. FpuLoadInstr: Array[OS_F32..OS_F64,boolean, boolean] of TAsmOp =
  266. { indexed? updating?}
  267. (((A_LFS,A_LFSU),(A_LFSX,A_LFSUX)),
  268. ((A_LFD,A_LFDU),(A_LFDX,A_LFDUX)));
  269. var
  270. op: tasmop;
  271. ref2: treference;
  272. begin
  273. if not(size in [OS_F32,OS_F64]) then
  274. internalerror(200201121);
  275. ref2 := ref;
  276. fixref(list,ref2);
  277. op := fpuloadinstr[size,ref2.index <> R_NO,false];
  278. a_load_store(list,op,reg,ref2);
  279. end;
  280. procedure tcgppc.a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference);
  281. const
  282. FpuStoreInstr: Array[OS_F32..OS_F64,boolean, boolean] of TAsmOp =
  283. { indexed? updating?}
  284. (((A_STFS,A_STFSU),(A_STFSX,A_STFSUX)),
  285. ((A_STFD,A_STFDU),(A_STFDX,A_STFDUX)));
  286. var
  287. op: tasmop;
  288. ref2: treference;
  289. begin
  290. if not(size in [OS_F32,OS_F64]) then
  291. internalerror(200201122);
  292. ref2 := ref;
  293. fixref(list,ref2);
  294. op := fpustoreinstr[size,ref2.index <> R_NO,false];
  295. a_load_store(list,op,reg,ref2);
  296. end;
  297. procedure tcgppc.a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister);
  298. var
  299. scratch_register: TRegister;
  300. begin
  301. case op of
  302. OP_DIV, OP_IDIV, OP_IMUL, OP_MUL, OP_ADD, OP_AND, OP_OR, OP_SUB,
  303. OP_XOR:
  304. a_op_const_reg_reg(list,op,OS_32,a,reg,reg);
  305. OP_SHL,OP_SHR,OP_SAR:
  306. begin
  307. if (a and 31) <> 0 then
  308. list.concat(taicpu.op_reg_reg_const(
  309. TOpCG2AsmOpConstLo[op],reg,reg,a and 31));
  310. if (a shr 5) <> 0 then
  311. internalError(68991);
  312. end
  313. else internalError(68992);
  314. end;
  315. end;
  316. procedure tcgppc.a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister);
  317. begin
  318. a_op_reg_reg_reg(list,op,OS_32,src,dst,dst);
  319. end;
  320. procedure tcgppc.a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
  321. size: tcgsize; a: aword; src, dst: tregister);
  322. var
  323. l1,l2: longint;
  324. var
  325. oplo, ophi: tasmop;
  326. scratchreg: tregister;
  327. useReg: boolean;
  328. begin
  329. ophi := TOpCG2AsmOpConstHi[op];
  330. oplo := TOpCG2AsmOpConstLo[op];
  331. { constants in a PPC instruction are always interpreted as signed }
  332. { 16bit values, so if the value is between low(smallint) and }
  333. { high(smallint), it's easy }
  334. if (op in [OP_ADD,OP_SUB,OP_AND,OP_OR,OP_XOR]) then
  335. begin
  336. if (longint(a) >= low(smallint)) and
  337. (longint(a) <= high(smallint)) then
  338. begin
  339. list.concat(taicpu.op_reg_reg_const(oplo,dst,src,a));
  340. exit;
  341. end;
  342. { all basic constant instructions also have a shifted form that }
  343. { works only on the highest 16bits, so if low(a) is 0, we can }
  344. { use that one }
  345. if (lo(a) = 0) then
  346. begin
  347. list.concat(taicpu.op_reg_reg_const(ophi,dst,src,hi(a)));
  348. exit;
  349. end;
  350. end;
  351. { otherwise, the instructions we can generate depend on the }
  352. { operation }
  353. useReg := false;
  354. case op of
  355. OP_DIV, OP_IDIV, OP_IMUL, OP_MUL:
  356. if (Op = OP_IMUL) and (longint(a) >= -32768) and
  357. (longint(a) <= 32767) then
  358. list.concat(taicpu.op_reg_reg_const(A_MULLI,dst,src,a))
  359. else
  360. usereg := true;
  361. OP_ADD,OP_SUB:
  362. begin
  363. list.concat(taicpu.op_reg_reg_const(oplo,dst,src,low(a)));
  364. list.concat(taicpu.op_reg_reg_const(ophi,dst,dst,
  365. high(a) + ord(smallint(a) < 0)));
  366. end;
  367. OP_OR:
  368. { try to use rlwimi }
  369. if get_rlwi_const(a,l1,l2) then
  370. begin
  371. if src <> dst then
  372. list.concat(taicpu.op_reg_reg(A_MR,dst,src));
  373. scratchreg := get_scratch_reg(list);
  374. list.concat(taicpu.op_reg_const(A_LI,scratchreg,-1));
  375. list.concat(taicpu.op_reg_reg_const_const_const(A_RLWIMI,dst,
  376. scratchreg,0,l1,l2));
  377. free_scratch_reg(list,scratchreg);
  378. end
  379. else
  380. useReg := true;
  381. OP_AND:
  382. { try to use rlwinm }
  383. if get_rlwi_const(a,l1,l2) then
  384. list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,dst,
  385. src,0,l1,l2))
  386. else
  387. useReg := true;
  388. OP_XOR:
  389. useReg := true;
  390. OP_SHL,OP_SHR,OP_SAR:
  391. begin
  392. if (a and 31) <> 0 Then
  393. list.concat(taicpu.op_reg_reg_const(
  394. TOpCG2AsmOpConstLo[Op],dst,src,a and 31));
  395. if (a shr 5) <> 0 then
  396. internalError(68991);
  397. end
  398. else
  399. internalerror(200109091);
  400. end;
  401. { if all else failed, load the constant in a register and then }
  402. { perform the operation }
  403. if useReg then
  404. begin
  405. scratchreg := get_scratch_reg(list);
  406. a_load_const_reg(list,OS_32,a,scratchreg);
  407. a_op_reg_reg_reg(list,op,OS_32,scratchreg,src,dst);
  408. free_scratch_reg(list,scratchreg);
  409. end;
  410. end;
  411. procedure tcgppc.a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
  412. size: tcgsize; src1, src2, dst: tregister);
  413. const
  414. op_reg_reg_opcg2asmop: array[TOpCG] of tasmop =
  415. (A_NONE,A_ADD,A_AND,A_DIVWU,A_DIVW,A_MULLW,A_MULLW,A_NEG,A_NOT,A_OR,
  416. A_SRAW,A_SLW,A_SRW,A_SUB,A_XOR);
  417. begin
  418. case op of
  419. OP_NEG,OP_NOT:
  420. list.concat(taicpu.op_reg_reg(op_reg_reg_opcg2asmop[op],dst,dst));
  421. else
  422. list.concat(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop[op],dst,src2,src1));
  423. end;
  424. end;
  425. {*************** compare instructructions ****************}
  426. procedure tcgppc.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
  427. l : tasmlabel);
  428. var
  429. p: taicpu;
  430. scratch_register: TRegister;
  431. signed: boolean;
  432. begin
  433. signed := cmp_op in [OC_GT,OC_LT,OC_GTE,OC_LTE];
  434. if signed then
  435. if (longint(a) >= low(smallint)) and (longint(a) <= high(smallint)) Then
  436. list.concat(taicpu.op_reg_reg_const(A_CMPI,R_CR0,reg,a))
  437. else
  438. begin
  439. scratch_register := get_scratch_reg(list);
  440. a_load_const_reg(list,OS_32,a,scratch_register);
  441. list.concat(taicpu.op_reg_reg_reg(A_CMP,R_CR0,reg,scratch_register));
  442. free_scratch_reg(list,scratch_register);
  443. end
  444. else
  445. if (a <= $ffff) then
  446. list.concat(taicpu.op_reg_reg_const(A_CMPLI,R_CR0,reg,a))
  447. else
  448. begin
  449. scratch_register := get_scratch_reg(list);
  450. a_load_const_reg(list,OS_32,a,scratch_register);
  451. list.concat(taicpu.op_reg_reg_reg(A_CMPL,R_CR0,reg,scratch_register));
  452. free_scratch_reg(list,scratch_register);
  453. end;
  454. a_jmp(list,A_BC,TOpCmp2AsmCond[cmp_op],0,l);
  455. end;
  456. procedure tcgppc.a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;
  457. reg1,reg2 : tregister;l : tasmlabel);
  458. var
  459. p: taicpu;
  460. op: tasmop;
  461. begin
  462. if cmp_op in [OC_GT,OC_LT,OC_GTE,OC_LTE] then
  463. op := A_CMP
  464. else op := A_CMPL;
  465. list.concat(taicpu.op_reg_reg_reg(op,R_CR0,reg1,reg2));
  466. a_jmp(list,A_BC,TOpCmp2AsmCond[cmp_op],0,l);
  467. end;
  468. procedure tcgppc.a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
  469. begin
  470. a_jmp(list,A_BC,TOpCmp2AsmCond[cond],0,l);
  471. end;
  472. procedure tcgppc.a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel);
  473. var
  474. c: tasmcond;
  475. begin
  476. c := flags_to_cond(f);
  477. a_jmp(list,A_BC,c.cond,ord(c.cr)-ord(R_CR0),l);
  478. end;
  479. procedure tcgppc.g_flags2reg(list: taasmoutput; const f: TResFlags; reg: TRegister);
  480. var
  481. testbit: byte;
  482. bitvalue: boolean;
  483. begin
  484. { get the bit to extract from the conditional register + its }
  485. { requested value (0 or 1) }
  486. testbit := (ord(f.cr) * 4);
  487. case f.flag of
  488. F_EQ,F_NE:
  489. bitvalue := f.flag = F_EQ;
  490. F_LT,F_GE:
  491. begin
  492. inc(testbit);
  493. bitvalue := f.flag = F_LT;
  494. end;
  495. F_GT,F_LE:
  496. begin
  497. inc(testbit,2);
  498. bitvalue := f.flag = F_GT;
  499. end;
  500. else
  501. internalerror(200112261);
  502. end;
  503. { load the conditional register in the destination reg }
  504. list.concat(taicpu.op_reg(A_MFCR,reg));
  505. { we will move the bit that has to be tested to bit 31 -> rotate }
  506. { left by bitpos+1 (remember, this is big-endian!) }
  507. testbit := (testbit + 1) and 31;
  508. { extract bit }
  509. list.concat(taicpu.op_reg_reg_const_const_const(
  510. A_RLWINM,reg,reg,testbit,31,31));
  511. { if we need the inverse, xor with 1 }
  512. if not bitvalue then
  513. list.concat(taicpu.op_reg_reg_const(A_XORI,reg,reg,1));
  514. end;
  515. (*
  516. procedure tcgppc.g_cond2reg(list: taasmoutput; const f: TAsmCond; reg: TRegister);
  517. var
  518. testbit: byte;
  519. bitvalue: boolean;
  520. begin
  521. { get the bit to extract from the conditional register + its }
  522. { requested value (0 or 1) }
  523. case f.simple of
  524. false:
  525. begin
  526. { we don't generate this in the compiler }
  527. internalerror(200109062);
  528. end;
  529. true:
  530. case f.cond of
  531. C_None:
  532. internalerror(200109063);
  533. C_LT..C_NU:
  534. begin
  535. testbit := (ord(f.cr) - ord(R_CR0))*4;
  536. inc(testbit,AsmCondFlag2BI[f.cond]);
  537. bitvalue := AsmCondFlagTF[f.cond];
  538. end;
  539. C_T,C_F,C_DNZT,C_DNZF,C_DZT,C_DZF:
  540. begin
  541. testbit := f.crbit
  542. bitvalue := AsmCondFlagTF[f.cond];
  543. end;
  544. else
  545. internalerror(200109064);
  546. end;
  547. end;
  548. { load the conditional register in the destination reg }
  549. list.concat(taicpu.op_reg_reg(A_MFCR,reg));
  550. { we will move the bit that has to be tested to bit 31 -> rotate }
  551. { left by bitpos+1 (remember, this is big-endian!) }
  552. if bitpos <> 31 then
  553. inc(bitpos)
  554. else
  555. bitpos := 0;
  556. { extract bit }
  557. list.concat(taicpu.op_reg_reg_const_const_const(
  558. A_RLWINM,reg,reg,bitpos,31,31));
  559. { if we need the inverse, xor with 1 }
  560. if not bitvalue then
  561. list.concat(taicpu.op_reg_reg_const(A_XORI,reg,reg,1));
  562. end;
  563. *)
  564. { *********** entry/exit code and address loading ************ }
  565. procedure tcgppc.g_stackframe_entry(list : taasmoutput;localsize : longint);
  566. begin
  567. case target_info.target of
  568. target_powerpc_macos:
  569. g_stackframe_entry_mac(list,localsize);
  570. target_powerpc_linux:
  571. g_stackframe_entry_sysv(list,localsize)
  572. else
  573. internalerror(2204001);
  574. end;
  575. end;
  576. procedure tcgppc.g_stackframe_entry_sysv(list : taasmoutput;localsize : longint);
  577. { generated the entry code of a procedure/function. Note: localsize is the }
  578. { sum of the size necessary for local variables and the maximum possible }
  579. { combined size of ALL the parameters of a procedure called by the current }
  580. { one }
  581. var regcounter: TRegister;
  582. href : treference;
  583. begin
  584. if (localsize mod 8) <> 0 then internalerror(58991);
  585. { CR and LR only have to be saved in case they are modified by the current }
  586. { procedure, but currently this isn't checked, so save them always }
  587. { following is the entry code as described in "Altivec Programming }
  588. { Interface Manual", bar the saving of AltiVec registers }
  589. a_reg_alloc(list,STACK_POINTER_REG);
  590. a_reg_alloc(list,R_0);
  591. { allocate registers containing reg parameters }
  592. for regcounter := R_3 to R_10 do
  593. a_reg_alloc(list,regcounter);
  594. { save return address... }
  595. list.concat(taicpu.op_reg_reg(A_MFSPR,R_0,R_LR));
  596. { ... in caller's frame }
  597. reference_reset_base(href,STACK_POINTER_REG,4);
  598. list.concat(taicpu.op_reg_ref(A_STW,R_0,href));
  599. a_reg_dealloc(list,R_0);
  600. a_reg_alloc(list,R_11);
  601. { save end of fpr save area }
  602. list.concat(taicpu.op_reg_reg_const(A_ORI,R_11,STACK_POINTER_REG,0));
  603. a_reg_alloc(list,R_12);
  604. { 0 or 8 based on SP alignment }
  605. list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,
  606. R_12,STACK_POINTER_REG,0,28,28));
  607. { add in stack length }
  608. list.concat(taicpu.op_reg_reg_const(A_SUBFIC,R_12,R_12,
  609. -localsize));
  610. { establish new alignment }
  611. list.concat(taicpu.op_reg_reg_reg(A_STWUX,STACK_POINTER_REG,STACK_POINTER_REG,R_12));
  612. a_reg_dealloc(list,R_12);
  613. { save floating-point registers }
  614. { !!! has to be optimized: only save registers that are used }
  615. list.concat(taicpu.op_sym_ofs(A_BL,newasmsymbol('_savefpr_14'),0));
  616. { compute end of gpr save area }
  617. list.concat(taicpu.op_reg_reg_const(A_ADDI,R_11,R_11,-144));
  618. { save gprs and fetch GOT pointer }
  619. { !!! has to be optimized: only save registers that are used }
  620. list.concat(taicpu.op_sym_ofs(A_BL,newasmsymbol('_savegpr_14_go'),0));
  621. a_reg_alloc(list,R_31);
  622. { place GOT ptr in r31 }
  623. list.concat(taicpu.op_reg_reg(A_MFSPR,R_31,R_LR));
  624. { save the CR if necessary ( !!! always done currently ) }
  625. { still need to find out where this has to be done for SystemV
  626. a_reg_alloc(list,R_0);
  627. list.concat(taicpu.op_reg_reg(A_MFSPR,R_0,R_CR);
  628. list.concat(taicpu.op_reg_ref(A_STW,scratch_register,
  629. new_reference(STACK_POINTER_REG,LA_CR)));
  630. a_reg_dealloc(list,R_0); }
  631. { save pointer to incoming arguments }
  632. list.concat(taicpu.op_reg_reg_const(A_ADDI,R_30,R_11,144));
  633. { now comes the AltiVec context save, not yet implemented !!! }
  634. end;
  635. procedure tcgppc.g_stackframe_entry_mac(list : taasmoutput;localsize : longint);
  636. { generated the entry code of a procedure/function. Note: localsize is the }
  637. { sum of the size necessary for local variables and the maximum possible }
  638. { combined size of ALL the parameters of a procedure called by the current }
  639. { one }
  640. var regcounter: TRegister;
  641. href : treference;
  642. begin
  643. if (localsize mod 8) <> 0 then internalerror(58991);
  644. { CR and LR only have to be saved in case they are modified by the current }
  645. { procedure, but currently this isn't checked, so save them always }
  646. { following is the entry code as described in "Altivec Programming }
  647. { Interface Manual", bar the saving of AltiVec registers }
  648. a_reg_alloc(list,STACK_POINTER_REG);
  649. a_reg_alloc(list,R_0);
  650. { allocate registers containing reg parameters }
  651. for regcounter := R_3 to R_10 do
  652. a_reg_alloc(list,regcounter);
  653. { save return address... }
  654. list.concat(taicpu.op_reg_reg(A_MFSPR,R_0,R_LR));
  655. { ... in caller's frame }
  656. reference_reset_base(href,STACK_POINTER_REG,8);
  657. list.concat(taicpu.op_reg_ref(A_STW,R_0,href));
  658. a_reg_dealloc(list,R_0);
  659. { save floating-point registers }
  660. { !!! has to be optimized: only save registers that are used }
  661. list.concat(taicpu.op_sym_ofs(A_BL,newasmsymbol('_savef14'),0));
  662. { save gprs in gpr save area }
  663. { !!! has to be optimized: only save registers that are used }
  664. reference_reset_base(href,STACK_POINTER_REG,-220);
  665. list.concat(taicpu.op_reg_ref(A_STMW,R_13,href));
  666. { save the CR if necessary ( !!! always done currently ) }
  667. a_reg_alloc(list,R_0);
  668. list.concat(taicpu.op_reg_reg(A_MFSPR,R_0,R_CR));
  669. reference_reset_base(href,stack_pointer_reg,LA_CR);
  670. list.concat(taicpu.op_reg_ref(A_STW,R_0,href));
  671. a_reg_dealloc(list,R_0);
  672. { save pointer to incoming arguments }
  673. list.concat(taicpu.op_reg_reg_const(A_ORI,R_31,STACK_POINTER_REG,0));
  674. a_reg_alloc(list,R_12);
  675. { 0 or 8 based on SP alignment }
  676. list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,
  677. R_12,STACK_POINTER_REG,0,28,28));
  678. { add in stack length }
  679. list.concat(taicpu.op_reg_reg_const(A_SUBFIC,R_12,R_12,
  680. -localsize));
  681. { establish new alignment }
  682. list.concat(taicpu.op_reg_reg_reg(A_STWUX,STACK_POINTER_REG,STACK_POINTER_REG,R_12));
  683. a_reg_dealloc(list,R_12);
  684. { now comes the AltiVec context save, not yet implemented !!! }
  685. end;
  686. procedure tcgppc.g_restore_frame_pointer(list : taasmoutput);
  687. begin
  688. { no frame pointer on the PowerPC (maybe there is one in the SystemV ABI?)}
  689. end;
  690. procedure tcgppc.g_return_from_proc(list : taasmoutput;parasize : aword);
  691. begin
  692. case target_info.target of
  693. target_powerpc_macos:
  694. g_return_from_proc_mac(list,parasize);
  695. target_powerpc_linux:
  696. g_return_from_proc_sysv(list,parasize)
  697. else
  698. internalerror(2204001);
  699. end;
  700. end;
  701. procedure tcgppc.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
  702. var tmpreg: tregister;
  703. ref2, tmpref: treference;
  704. begin
  705. ref2 := ref;
  706. FixRef(list,ref2);
  707. if assigned(ref2.symbol) then
  708. { add the symbol's value to the base of the reference, and if the }
  709. { reference doesn't have a base, create one }
  710. begin
  711. tmpreg := get_scratch_reg(list);
  712. reference_reset(tmpref);
  713. tmpref.symbol := ref2.symbol;
  714. tmpref.symaddr := refs_ha;
  715. // tmpref.is_immediate := true;
  716. if ref2.base <> R_NO then
  717. list.concat(taicpu.op_reg_reg_ref(A_ADDIS,tmpreg,
  718. ref2.base,tmpref))
  719. else
  720. list.concat(taicpu.op_reg_ref(A_LIS,tmpreg,tmpref));
  721. ref2.base := tmpreg;
  722. ref2.symaddr := refs_l;
  723. { can be folded with one of the next instructions by the }
  724. { optimizer probably }
  725. list.concat(taicpu.op_reg_reg_ref(A_ADDI,tmpreg,tmpreg,tmpref));
  726. end;
  727. if ref2.offset <> 0 Then
  728. if ref2.base <> R_NO then
  729. a_op_const_reg_reg(list,OP_ADD,OS_32,ref2.offset,ref2.base,r)
  730. { FixRef makes sure that "(ref.index <> R_NO) and (ref.offset <> 0)" never}
  731. { occurs, so now only ref.offset has to be loaded }
  732. else a_load_const_reg(list,OS_32,ref2.offset,r)
  733. else
  734. if ref.index <> R_NO Then
  735. list.concat(taicpu.op_reg_reg_reg(A_ADD,r,ref2.base,ref2.index))
  736. else
  737. if r <> ref2.base then
  738. list.concat(taicpu.op_reg_reg(A_MR,r,ref2.base));
  739. if assigned(ref2.symbol) then
  740. free_scratch_reg(list,tmpreg);
  741. end;
  742. { ************* concatcopy ************ }
  743. procedure tcgppc.g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);
  744. var
  745. t: taicpu;
  746. countreg, tempreg: TRegister;
  747. src, dst: TReference;
  748. lab: tasmlabel;
  749. count, count2: aword;
  750. begin
  751. { make sure source and dest are valid }
  752. src := source;
  753. fixref(list,src);
  754. dst := dest;
  755. fixref(list,dst);
  756. reference_reset(src);
  757. reference_reset(dst);
  758. { load the address of source into src.base }
  759. src.base := get_scratch_reg(list);
  760. if loadref then
  761. a_load_ref_reg(list,OS_32,source,src.base)
  762. else a_loadaddr_ref_reg(list,source,src.base);
  763. if delsource then
  764. reference_release(exprasmlist,source);
  765. { load the address of dest into dst.base }
  766. dst.base := get_scratch_reg(list);
  767. a_loadaddr_ref_reg(list,dest,dst.base);
  768. count := len div 4;
  769. if count > 3 then
  770. { generate a loop }
  771. begin
  772. { the offsets are zero after the a_loadaddress_ref_reg and just }
  773. { have to be set to 4. I put an Inc there so debugging may be }
  774. { easier (should offset be different from zero here, it will be }
  775. { easy to notice in the genreated assembler }
  776. Inc(dst.offset,4);
  777. Inc(src.offset,4);
  778. list.concat(taicpu.op_reg_reg_const(A_SUBI,src.base,src.base,4));
  779. list.concat(taicpu.op_reg_reg_const(A_SUBI,dst.base,dst.base,4));
  780. countreg := get_scratch_reg(list);
  781. a_load_const_reg(list,OS_32,count-1,countreg);
  782. { explicitely allocate R_0 since it can be used safely here }
  783. { (for holding date that's being copied) }
  784. tempreg := R_0;
  785. a_reg_alloc(list,R_0);
  786. getlabel(lab);
  787. a_label(list, lab);
  788. list.concat(taicpu.op_reg_ref(A_LWZU,tempreg,src));
  789. list.concat(taicpu.op_reg_reg_const(A_CMPI,R_CR0,countreg,0));
  790. list.concat(taicpu.op_reg_ref(A_STWU,tempreg,dst));
  791. list.concat(taicpu.op_reg_reg_const(A_SUBI,countreg,countreg,1));
  792. a_jmp(list,A_BC,C_NE,0,lab);
  793. free_scratch_reg(list,countreg);
  794. end
  795. else
  796. { unrolled loop }
  797. begin
  798. tempreg := get_scratch_reg(list);
  799. for count2 := 1 to count do
  800. begin
  801. a_load_ref_reg(list,OS_32,src,tempreg);
  802. a_load_reg_ref(list,OS_32,tempreg,dst);
  803. inc(src.offset,4);
  804. inc(dst.offset,4);
  805. end
  806. end;
  807. { copy the leftovers }
  808. if (len and 2) <> 0 then
  809. begin
  810. a_load_ref_reg(list,OS_16,src,tempreg);
  811. a_load_reg_ref(list,OS_16,tempreg,dst);
  812. inc(src.offset,2);
  813. inc(dst.offset,2);
  814. end;
  815. if (len and 1) <> 0 then
  816. begin
  817. a_load_ref_reg(list,OS_8,src,tempreg);
  818. a_load_reg_ref(list,OS_8,tempreg,dst);
  819. end;
  820. a_reg_dealloc(list,tempreg);
  821. free_scratch_reg(list,src.base);
  822. free_scratch_reg(list,dst.base);
  823. end;
  824. procedure tcgppc.g_overflowcheck(list: taasmoutput; const p: tnode);
  825. var
  826. hl : tasmlabel;
  827. begin
  828. if not(cs_check_overflow in aktlocalswitches) then
  829. exit;
  830. getlabel(hl);
  831. if not ((p.resulttype.def.deftype=pointerdef) or
  832. ((p.resulttype.def.deftype=orddef) and
  833. (torddef(p.resulttype.def).typ in [u64bit,u16bit,u32bit,u8bit,uchar,
  834. bool8bit,bool16bit,bool32bit]))) then
  835. begin
  836. list.concat(taicpu.op_reg(A_MCRXR,R_CR7));
  837. a_jmp(list,A_BC,C_OV,7,hl)
  838. end
  839. else
  840. a_jmp_cond(list,OC_AE,hl);
  841. a_call_name(list,'FPC_OVERFLOW');
  842. a_label(list,hl);
  843. end;
  844. {***************** This is private property, keep out! :) *****************}
  845. procedure tcgppc.g_return_from_proc_sysv(list : taasmoutput;parasize : aword);
  846. var
  847. regcounter: TRegister;
  848. begin
  849. { release parameter registers }
  850. for regcounter := R_3 to R_10 do
  851. a_reg_dealloc(list,regcounter);
  852. { AltiVec context restore, not yet implemented !!! }
  853. { address of gpr save area to r11 }
  854. list.concat(taicpu.op_reg_reg_const(A_ADDI,R_11,R_31,-144));
  855. { restore gprs }
  856. list.concat(taicpu.op_sym_ofs(A_BL,newasmsymbol('_restgpr_14'),0));
  857. { address of fpr save area to r11 }
  858. list.concat(taicpu.op_reg_reg_const(A_ADDI,R_11,R_11,144));
  859. { restore fprs and return }
  860. list.concat(taicpu.op_sym_ofs(A_BL,newasmsymbol('_restfpr_14_x'),0));
  861. end;
  862. procedure tcgppc.g_return_from_proc_mac(list : taasmoutput;parasize : aword);
  863. var
  864. regcounter: TRegister;
  865. href : treference;
  866. begin
  867. { release parameter registers }
  868. for regcounter := R_3 to R_10 do
  869. a_reg_dealloc(list,regcounter);
  870. { AltiVec context restore, not yet implemented !!! }
  871. { restore SP }
  872. list.concat(taicpu.op_reg_reg_const(A_ORI,STACK_POINTER_REG,R_31,0));
  873. { restore gprs }
  874. reference_reset_base(href,STACK_POINTER_REG,-220);
  875. list.concat(taicpu.op_reg_ref(A_LMW,R_13,href));
  876. { restore return address ... }
  877. reference_reset_base(href,STACK_POINTER_REG,8);
  878. list.concat(taicpu.op_reg_ref(A_LWZ,R_0,href));
  879. { ... and return from _restf14 }
  880. list.concat(taicpu.op_sym_ofs(A_B,newasmsymbol('_restf14'),0));
  881. end;
  882. procedure tcgppc.fixref(list: taasmoutput; var ref: treference);
  883. begin
  884. If (ref.base <> R_NO) then
  885. begin
  886. if (ref.index <> R_NO) and
  887. ((ref.offset <> 0) or assigned(ref.symbol)) then
  888. begin
  889. if not assigned(ref.symbol) and
  890. (cardinal(ref.offset-low(smallint)) <=
  891. high(smallint)-low(smallint)) then
  892. begin
  893. list.concat(taicpu.op_reg_reg_const(
  894. A_ADDI,ref.base,ref.base,ref.offset));
  895. ref.offset := 0;
  896. end
  897. else
  898. begin
  899. list.concat(taicpu.op_reg_reg_reg(
  900. A_ADD,ref.base,ref.base,ref.index));
  901. ref.index := R_NO;
  902. end;
  903. end
  904. end
  905. else
  906. begin
  907. ref.base := ref.index;
  908. ref.index := R_NO
  909. end
  910. end;
  911. { find out whether a is of the form 11..00..11b or 00..11...00. If }
  912. { that's the case, we can use rlwinm to do an AND operation }
  913. function tcgppc.get_rlwi_const(a: longint; var l1, l2: longint): boolean;
  914. var
  915. temp, testbit: longint;
  916. compare: boolean;
  917. begin
  918. get_rlwi_const := false;
  919. { start with the lowest bit }
  920. testbit := 1;
  921. { check its value }
  922. compare := boolean(a and testbit);
  923. { find out how long the run of bits with this value is }
  924. { (it's impossible that all bits are 1 or 0, because in that case }
  925. { this function wouldn't have been called) }
  926. l1 := 31;
  927. while (((a and testbit) <> 0) = compare) do
  928. begin
  929. testbit := testbit shl 1;
  930. dec(l1);
  931. end;
  932. { check the length of the run of bits that comes next }
  933. compare := not compare;
  934. l2 := l1;
  935. while (((a and testbit) <> 0) = compare) and
  936. (l2 >= 0) do
  937. begin
  938. testbit := testbit shl 1;
  939. dec(l2);
  940. end;
  941. { and finally the check whether the rest of the bits all have the }
  942. { same value }
  943. compare := not compare;
  944. temp := l2;
  945. if temp >= 0 then
  946. if (a shr (31-temp)) <> ((-ord(compare)) shr (31-temp)) then
  947. exit;
  948. { we have done "not(not(compare))", so compare is back to its }
  949. { initial value. If the lowest bit was 0, a is of the form }
  950. { 00..11..00 and we need "rlwinm reg,reg,0,l2+1,l1", (+1 }
  951. { because l2 now contains the position of the last zero of the }
  952. { first run instead of that of the first 1) so switch l1 and l2 }
  953. { in that case (we will generate "rlwinm reg,reg,0,l1,l2") }
  954. if not compare then
  955. begin
  956. temp := l1;
  957. l1 := l2+1;
  958. l2 := temp;
  959. end
  960. else
  961. { otherwise, l1 currently contains the position of the last }
  962. { zero instead of that of the first 1 of the second run -> +1 }
  963. inc(l1);
  964. { the following is the same as "if l1 = -1 then l1 := 31;" }
  965. l1 := l1 and 31;
  966. l2 := l2 and 31;
  967. get_rlwi_const := true;
  968. end;
  969. procedure tcgppc.a_load_store(list:taasmoutput;op: tasmop;reg:tregister;
  970. ref: treference);
  971. var
  972. tmpreg: tregister;
  973. tmpref: treference;
  974. begin
  975. if assigned(ref.symbol) then
  976. begin
  977. tmpreg := get_scratch_reg(list);
  978. reference_reset(tmpref);
  979. tmpref.symbol := ref.symbol;
  980. tmpref.symaddr := refs_ha;
  981. // tmpref.is_immediate := true;
  982. if ref.base <> R_NO then
  983. list.concat(taicpu.op_reg_reg_ref(A_ADDIS,tmpreg,
  984. ref.base,tmpref))
  985. else
  986. list.concat(taicpu.op_reg_ref(A_LIS,tmpreg,tmpref));
  987. ref.base := tmpreg;
  988. ref.symaddr := refs_l;
  989. end;
  990. list.concat(taicpu.op_reg_ref(op,reg,ref));
  991. if assigned(ref.symbol) then
  992. free_scratch_reg(list,tmpreg);
  993. end;
  994. procedure tcgppc.a_jmp(list: taasmoutput; op: tasmop; c: tasmcondflag;
  995. crval: longint; l: tasmlabel);
  996. var
  997. p: taicpu;
  998. begin
  999. p := taicpu.op_sym(op,newasmsymbol(l.name));
  1000. create_cond_norm(c,crval,p.condition);
  1001. p.is_jmp := true;
  1002. list.concat(p)
  1003. end;
  1004. begin
  1005. cg := tcgppc.create;
  1006. end.
  1007. {
  1008. $Log$
  1009. Revision 1.15 2002-05-14 17:28:10 peter
  1010. * synchronized cpubase between powerpc and i386
  1011. * moved more tables from cpubase to cpuasm
  1012. * tai_align_abstract moved to tainst, cpuasm must define
  1013. the tai_align class now, which may be empty
  1014. Revision 1.14 2002/05/13 19:52:46 peter
  1015. * a ppcppc can be build again
  1016. Revision 1.13 2002/04/20 21:41:51 carl
  1017. * renamed some constants
  1018. Revision 1.12 2002/04/06 18:13:01 jonas
  1019. * several powerpc-related additions and fixes
  1020. Revision 1.11 2002/01/02 14:53:04 jonas
  1021. * fixed small bug in a_jmp_flags
  1022. Revision 1.10 2001/12/30 17:24:48 jonas
  1023. * range checking is now processor independent (part in cgobj, part in
  1024. cg64f32) and should work correctly again (it needed some changes after
  1025. the changes of the low and high of tordef's to int64)
  1026. * maketojumpbool() is now processor independent (in ncgutil)
  1027. * getregister32 is now called getregisterint
  1028. Revision 1.9 2001/12/29 15:28:58 jonas
  1029. * powerpc/cgcpu.pas compiles :)
  1030. * several powerpc-related fixes
  1031. * cpuasm unit is now based on common tainst unit
  1032. + nppcmat unit for powerpc (almost complete)
  1033. Revision 1.8 2001/10/28 14:16:49 jonas
  1034. * small fixes
  1035. Revision 1.7 2001/09/29 21:33:30 jonas
  1036. * small optimization
  1037. Revision 1.6 2001/09/28 20:40:05 jonas
  1038. * several additions, almost complete (only some problems with resflags left)
  1039. Revision 1.5 2001/09/16 10:33:21 jonas
  1040. * some fixes to operations with constants
  1041. Revision 1.3 2001/09/06 15:25:55 jonas
  1042. * changed type of tcg from object to class -> abstract methods are now
  1043. a lot cleaner :)
  1044. + more updates: load_*_loc methods, op_*_* methods, g_flags2reg method
  1045. (if possible with generic implementation and necessary ppc
  1046. implementations)
  1047. * worked a bit further on cgflw, now working on exitnode
  1048. Revision 1.2 2001/09/05 20:21:03 jonas
  1049. * new cgflow based on n386flw with all nodes until forn "translated"
  1050. + a_cmp_loc_*_label methods for tcg
  1051. + base implementatino for a_cmp_ref_*_label methods
  1052. * small bugfixes to powerpc cg
  1053. Revision 1.1 2001/08/26 13:31:04 florian
  1054. * some cg reorganisation
  1055. * some PPC updates
  1056. Revision 1.2 2001/08/26 13:29:33 florian
  1057. * some cg reorganisation
  1058. * some PPC updates
  1059. Revision 1.1 2000/07/13 06:30:12 michael
  1060. + Initial import
  1061. Revision 1.12 2000/04/22 14:25:04 jonas
  1062. * aasm.pas: pai_align instead of pai_align_abstract if cpu <> i386
  1063. + systems.pas: info for macos/ppc
  1064. * new/cgobj.pas: compiles again without newst define
  1065. * new/powerpc/cgcpu: generate different entry/exit code depending on
  1066. whether target_os is MacOs or Linux
  1067. Revision 1.11 2000/01/07 01:14:57 peter
  1068. * updated copyright to 2000
  1069. Revision 1.10 1999/12/24 22:48:10 jonas
  1070. * compiles again
  1071. Revision 1.9 1999/11/05 07:05:56 jonas
  1072. + a_jmp_cond()
  1073. Revision 1.8 1999/10/24 09:22:18 jonas
  1074. + entry/exitcode for SystemV (Linux) and AIX/Mac from the Altivec
  1075. PIM (no AltiVec support yet though)
  1076. * small fix to the a_cmp_* methods
  1077. Revision 1.7 1999/10/20 12:23:24 jonas
  1078. * fixed a_loadaddress_ref_reg (mentioned as ToDo in rev. 1.5)
  1079. * small bugfix in a_load_store
  1080. Revision 1.6 1999/09/15 20:35:47 florian
  1081. * small fix to operator overloading when in MMX mode
  1082. + the compiler uses now fldz and fld1 if possible
  1083. + some fixes to floating point registers
  1084. + some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
  1085. * .... ???
  1086. Revision 1.5 1999/09/03 13:14:11 jonas
  1087. + implemented some parameter passing methods, but they require
  1088. some more helper routines
  1089. * fix for loading symbol addresses (still needs to be done in a_loadaddress)
  1090. * several changes to the way conditional branches are handled
  1091. Revision 1.4 1999/08/26 14:53:41 jonas
  1092. * first implementation of concatcopy (requires 4 scratch regs)
  1093. Revision 1.3 1999/08/25 12:00:23 jonas
  1094. * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
  1095. Revision 1.2 1999/08/18 17:05:57 florian
  1096. + implemented initilizing of data for the new code generator
  1097. so it should compile now simple programs
  1098. Revision 1.1 1999/08/06 16:41:11 jonas
  1099. * PowerPC compiles again, several routines implemented in cgcpu.pas
  1100. * added constant to cpubase of alpha and powerpc for maximum
  1101. number of operands
  1102. }