cgcpu.pas 52 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518
  1. {******************************************************************************
  2. $Id$
  3. Copyright (c) 1998-2000 by Florian Klaempfl
  4. This program is free software;you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation;either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY;without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program;if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. *****************************************************************************}
  16. UNIT cgcpu;
  17. {This unit implements the code generator for the SPARC architecture}
  18. {$INCLUDE fpcdefs.inc}
  19. INTERFACE
  20. USES
  21. cginfo,cgbase,cgobj,cg64f32,
  22. aasmbase,aasmtai,aasmcpu,
  23. cpubase,cpuinfo,cpupara,
  24. node,symconst;
  25. TYPE
  26. TCgSparc=CLASS(tcg)
  27. {This method is used to pass a parameter, which is located in a register, to a
  28. routine. It should give the parameter to the routine, as required by the
  29. specific processor ABI. It is overriden for each CPU target.
  30. Size : is the size of the operand in the register
  31. r : is the register source of the operand
  32. LocPara : is the location where the parameter will be stored}
  33. procedure a_param_reg(list:TAasmOutput;sz:tcgsize;r:tregister;const LocPara:TParaLocation);override;
  34. {passes a parameter which is a constant to a function}
  35. procedure a_param_const(list:TAasmOutput;size:tcgsize;a:aword;CONST LocPara:TParaLocation);override;
  36. procedure a_param_ref(list:TAasmOutput;sz:tcgsize;CONST r:TReference;CONST LocPara:TParaLocation);override;
  37. procedure a_paramaddr_ref(list:TAasmOutput;CONST r:TReference;CONST LocPara:TParaLocation);override;
  38. procedure a_call_name(list:TAasmOutput;CONST s:string);override;
  39. procedure a_call_ref(list:TAasmOutput;CONST ref:TReference);override;
  40. procedure a_call_reg(list:TAasmOutput;Reg:TRegister);override;
  41. {Branch Instruction}
  42. procedure a_jmp_always(List:TAasmOutput;l:TAsmLabel);override;
  43. {General purpose instyructions}
  44. procedure a_op_const_reg(list:TAasmOutput;Op:TOpCG;a:AWord;reg:TRegister);override;
  45. procedure a_op_const_ref(list:TAasmOutput;Op:TOpCG;size:TCGSize;a:AWord;CONST ref:TReference);override;
  46. procedure a_op_reg_reg(list:TAasmOutput;Op:TOpCG;size:TCGSize;src, dst:TRegister);override;
  47. procedure a_op_ref_reg(list:TAasmOutput;Op:TOpCG;size:TCGSize;CONST ref:TReference;reg:TRegister);override;
  48. procedure a_op_reg_ref(list:TAasmOutput;Op:TOpCG;size:TCGSize;reg:TRegister;CONST ref:TReference);override;
  49. procedure a_op_const_reg_reg(list:TAasmOutput;op:TOpCg;size:tcgsize;a:aword;src, dst:tregister);override;
  50. procedure a_op_reg_reg_reg(list:TAasmOutput;op:TOpCg;size:tcgsize;src1, src2, dst:tregister);override;
  51. { move instructions }
  52. procedure a_load_const_reg(list:TAasmOutput;size:tcgsize;a:aword;reg:tregister);override;
  53. procedure a_load_const_ref(list:TAasmOutput;size:tcgsize;a:aword;CONST ref:TReference);override;
  54. procedure a_load_reg_ref(list:TAasmOutput;size:tcgsize;reg:tregister;CONST ref:TReference);override;
  55. procedure a_load_ref_reg(list:TAasmOutput;size:tcgsize;CONST ref:TReference;reg:tregister);override;
  56. procedure a_load_reg_reg(list:TAasmOutput;fromsize,tosize:tcgsize;reg1,reg2:tregister);override;
  57. procedure a_loadaddr_ref_reg(list:TAasmOutput;CONST ref:TReference;r:tregister);override;
  58. { fpu move instructions }
  59. procedure a_loadfpu_reg_reg(list:TAasmOutput;reg1, reg2:tregister);override;
  60. procedure a_loadfpu_ref_reg(list:TAasmOutput;size:tcgsize;CONST ref:TReference;reg:tregister);override;
  61. procedure a_loadfpu_reg_ref(list:TAasmOutput;size:tcgsize;reg:tregister;CONST ref:TReference);override;
  62. { vector register move instructions }
  63. procedure a_loadmm_reg_reg(list:TAasmOutput;reg1, reg2:tregister);override;
  64. procedure a_loadmm_ref_reg(list:TAasmOutput;CONST ref:TReference;reg:tregister);override;
  65. procedure a_loadmm_reg_ref(list:TAasmOutput;reg:tregister;CONST ref:TReference);override;
  66. procedure a_parammm_reg(list:TAasmOutput;reg:tregister);override;
  67. { comparison operations }
  68. procedure a_cmp_const_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;a:aword;reg:tregister;l:tasmlabel);override;
  69. procedure a_cmp_const_ref_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;a:aword;CONST ref:TReference;l:tasmlabel);override;
  70. procedure a_cmp_reg_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;reg1,reg2:tregister;l:tasmlabel);override;
  71. procedure a_cmp_ref_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;CONST ref:TReference;reg:tregister;l:tasmlabel);override;
  72. procedure a_jmp_cond(list:TAasmOutput;cond:TOpCmp;l:tasmlabel);{ override;}
  73. procedure a_jmp_flags(list:TAasmOutput;CONST f:TResFlags;l:tasmlabel);override;
  74. procedure g_flags2reg(list:TAasmOutput;Size:TCgSize;CONST f:tresflags;reg:TRegister);override;
  75. procedure g_overflowCheck(List:TAasmOutput;const p:TNode);override;
  76. procedure g_stackframe_entry(list:TAasmOutput;localsize:LongInt);override;
  77. procedure g_restore_all_registers(list:TAasmOutput;selfused,accused,acchiused:boolean);override;
  78. procedure g_restore_frame_pointer(list:TAasmOutput);override;
  79. procedure g_restore_standard_registers(list:taasmoutput;usedinproc:tregisterset);override;
  80. procedure g_return_from_proc(list:TAasmOutput;parasize:aword);override;
  81. procedure g_save_all_registers(list : taasmoutput);override;
  82. procedure g_save_standard_registers(list : taasmoutput; usedinproc : tregisterset);override;
  83. procedure g_concatcopy(list:TAasmOutput;CONST source,dest:TReference;len:aword;delsource,loadref:boolean);override;
  84. class function reg_cgsize(CONST reg:tregister):tcgsize;override;
  85. PRIVATE
  86. function IsSimpleRef(const ref:treference):boolean;
  87. procedure sizes2load(s1:tcgsize;s2:topsize;var op:tasmop;var s3:topsize);
  88. procedure floatload(list:TAasmOutput;t:tcgsize;CONST ref:TReference);
  89. procedure floatstore(list:TAasmOutput;t:tcgsize;CONST ref:TReference);
  90. procedure floatloadops(t:tcgsize;var op:tasmop;var s:topsize);
  91. procedure floatstoreops(t:tcgsize;var op:tasmop;var s:topsize);
  92. END;
  93. TCg64Sparc=class(tcg64f32)
  94. procedure a_op64_ref_reg(list:TAasmOutput;op:TOpCG;CONST ref:TReference;reg:TRegister64);override;
  95. procedure a_op64_reg_reg(list:TAasmOutput;op:TOpCG;regsrc,regdst:TRegister64);override;
  96. procedure a_op64_const_reg(list:TAasmOutput;op:TOpCG;value:qWord;regdst:TRegister64);override;
  97. procedure a_op64_const_ref(list:TAasmOutput;op:TOpCG;value:qWord;CONST ref:TReference);override;
  98. procedure get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp);
  99. END;
  100. CONST
  101. TOpCG2AsmOp:ARRAY[topcg]OF TAsmOp=(A_NONE,A_ADD,A_AND,A_UDIV,A_SDIV,A_UMUL, A_SMUL, A_NEG,A_NOT,A_OR,A_not,A_not,A_not,A_SUB,A_XOR);
  102. TOpCmp2AsmCond:ARRAY[topcmp]OF TAsmCond=(C_NONE,C_E,C_G,C_L,C_GE,C_LE,C_NE,C_BE,C_B,C_AE,C_A);
  103. TCGSize2OpSize:ARRAY[tcgsize]OF TOpSize=(S_NO,S_B,S_W,S_SW,S_SW,S_B,S_W,S_SW,S_SW,S_FS,S_FD,S_FQ,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO);
  104. IMPLEMENTATION
  105. USES
  106. globtype,globals,verbose,systems,cutils,
  107. symdef,symsym,defutil,paramgr,
  108. rgobj,tgobj,rgcpu,cpupi;
  109. procedure TCgSparc.a_param_reg(list:TAasmOutput;sz:tcgsize;r:tregister;const LocPara:TParaLocation);
  110. var
  111. r2:Tregister;
  112. begin
  113. r2.enum:=R_G0;
  114. with list,LocPara do
  115. case Loc of
  116. LOC_REGISTER:
  117. case Sz of
  118. OS_8,OS_S8:
  119. Concat(taicpu.op_Reg_Const_Reg(A_AND,r,$FF,Register));
  120. OS_16,OS_S16:
  121. begin
  122. Concat(taicpu.op_Reg_Reg_Reg(A_AND,r,r2,Register));
  123. {This will put 00...00111 in the hiest 22 bits of the reg}
  124. Concat(taicpu.op_Reg_Const_Reg(A_SETHI,Register,$7,Register));
  125. end;
  126. OS_32,OS_S32:
  127. if r.enum<>Register.enum
  128. then
  129. Concat(taicpu.op_Reg_Reg_Reg(A_OR,r,r2,Register));
  130. else
  131. InternalError(2002032212);
  132. end;
  133. else
  134. InternalError(2002101002);
  135. end;
  136. end;
  137. procedure TCgSparc.a_param_const(list:TAasmOutput;size:tcgsize;a:aword;CONST LocPara:TParaLocation);
  138. var
  139. Ref:TReference;
  140. begin
  141. with List do
  142. case locpara.loc of
  143. LOC_REGISTER,LOC_CREGISTER:
  144. a_load_const_reg(list,size,a,locpara.register);
  145. LOC_REFERENCE:
  146. begin
  147. reference_reset(ref);
  148. ref.base:=locpara.reference.index;
  149. ref.offset:=locpara.reference.offset;
  150. a_load_const_ref(list,size,a,ref);
  151. end;
  152. else
  153. InternalError(2002122200);
  154. end;
  155. if locpara.sp_fixup<>0
  156. then
  157. InternalError(2002122201);
  158. end;
  159. procedure TCgSparc.a_param_ref(list:TAasmOutput;sz:TCgSize;const r:TReference;const LocPara:TParaLocation);
  160. var
  161. ref: treference;
  162. tmpreg:TRegister;
  163. begin
  164. with LocPara do
  165. case locpara.loc of
  166. LOC_REGISTER,LOC_CREGISTER:
  167. a_load_ref_reg(list,sz,r,Register);
  168. LOC_REFERENCE:
  169. begin
  170. {Code conventions need the parameters being allocated in %o6+92. See
  171. comment on g_stack_frame}
  172. if locpara.sp_fixup<92
  173. then
  174. InternalError(2002081104);
  175. reference_reset(ref);
  176. ref.base:=locpara.reference.index;
  177. ref.offset:=locpara.reference.offset;
  178. tmpreg := get_scratch_reg_int(list);
  179. a_load_ref_reg(list,sz,r,tmpreg);
  180. a_load_reg_ref(list,sz,tmpreg,ref);
  181. free_scratch_reg(list,tmpreg);
  182. end;
  183. LOC_FPUREGISTER,LOC_CFPUREGISTER:
  184. case sz of
  185. OS_32:
  186. a_loadfpu_ref_reg(list,OS_F32,r,locpara.register);
  187. OS_64:
  188. a_loadfpu_ref_reg(list,OS_F64,r,locpara.register);
  189. else
  190. internalerror(2002072801);
  191. end;
  192. else
  193. internalerror(2002081103);
  194. end;
  195. end;
  196. procedure TCgSparc.a_paramaddr_ref(list:TAasmOutput;CONST r:TReference;CONST LocPara:TParaLocation);
  197. VAR
  198. tmpreg:TRegister;
  199. BEGIN
  200. IF r.segment.enum<>R_NO
  201. THEN
  202. CGMessage(cg_e_cant_use_far_pointer_there);
  203. IF(r.base.enum=R_NO)AND(r.index.enum=R_NO)
  204. THEN
  205. list.concat(Taicpu.Op_sym_ofs(A_LD,S_SW,r.symbol,r.offset))
  206. ELSE IF(r.base.enum=R_NO)AND(r.index.enum<>R_NO)AND
  207. (r.offset=0)AND(r.scalefactor=0)AND(r.symbol=nil)
  208. THEN
  209. list.concat(Taicpu.Op_reg(A_LD,r.index))
  210. ELSE IF(r.base.enum<>R_NO)AND(r.index.enum=R_NO)AND
  211. (r.offset=0)AND(r.symbol=nil)
  212. THEN
  213. list.concat(Taicpu.Op_reg(A_LD,r.base))
  214. ELSE
  215. BEGIN
  216. tmpreg:=get_scratch_reg_address(list);
  217. a_loadaddr_ref_reg(list,r,tmpreg);
  218. list.concat(taicpu.op_reg(A_LD,tmpreg));
  219. free_scratch_reg(list,tmpreg);
  220. END;
  221. END;
  222. procedure TCgSparc.a_call_name(list:TAasmOutput;CONST s:string);
  223. BEGIN
  224. WITH List,objectlibrary DO
  225. BEGIN
  226. concat(taicpu.op_sym(A_CALL,S_SW,newasmsymbol(s)));
  227. concat(taicpu.op_none(A_NOP));
  228. END;
  229. END;
  230. procedure TCgSparc.a_call_ref(list:TAasmOutput;CONST ref:TReference);
  231. begin
  232. list.concat(taicpu.op_ref(A_CALL,ref));
  233. list.concat(taicpu.op_none(A_NOP));
  234. end;
  235. procedure TCgSparc.a_call_reg(list:TAasmOutput;Reg:TRegister);
  236. begin
  237. list.concat(taicpu.op_reg(A_JMPL,reg));
  238. if target_info.system=system_sparc_linux
  239. then
  240. list.concat(taicpu.op_none(A_NOP));
  241. procinfo.flags:=procinfo.flags or pi_do_call;
  242. end;
  243. {********************** branch instructions ********************}
  244. procedure TCgSparc.a_jmp_always(List:TAasmOutput;l:TAsmLabel);
  245. begin
  246. List.Concat(TAiCpu.op_sym(A_BA,S_NO,objectlibrary.newasmsymbol(l.name)));
  247. end;
  248. {********************** load instructions ********************}
  249. procedure TCgSparc.a_load_const_reg(list:TAasmOutput;size:TCGSize;a:aword;reg:TRegister);
  250. var r:Tregister;
  251. BEGIN
  252. r.enum:=R_G0;
  253. WITH List DO
  254. IF a<>0
  255. THEN{R_G0 is usually set to zero, so we use it}
  256. Concat(taicpu.op_reg_const_reg(A_OR,r,a,reg))
  257. ELSE{The is no A_MOV in sparc, that's why we use A_OR with help of R_G0}
  258. Concat(taicpu.op_reg_reg_reg(A_OR,r,r,reg));
  259. END;
  260. procedure TCgSparc.a_load_const_ref(list:TAasmOutput;size:tcgsize;a:aword;CONST ref:TReference);
  261. var r:Tregister;
  262. BEGIN
  263. r.enum:=R_G0;
  264. WITH List DO
  265. IF a=0
  266. THEN
  267. Concat(taicpu.op_reg_ref(A_ST,r,Ref))
  268. ELSE
  269. BEGIN
  270. r.enum:=R_G1;
  271. a_load_const_reg(list,size,a,r);
  272. a_load_reg_ref(list,size,r,Ref);
  273. END;
  274. END;
  275. procedure TCgSparc.a_load_reg_ref(list:TAasmOutput;size:TCGSize;reg:tregister;const Ref:TReference);
  276. var
  277. op:tasmop;
  278. begin
  279. case size of
  280. { signed integer registers }
  281. OS_S8:
  282. Op:=A_STB;{Store Signed Byte}
  283. OS_S16:
  284. Op:=A_STH;{Store Signed Halfword}
  285. OS_S32:
  286. Op:=A_ST;{Store Word}
  287. OS_S64:
  288. Op:=A_STD;{Store Double Word}
  289. { unsigned integer registers }
  290. //A_STSTUB;{Store-Store Unsigned Byte}
  291. OS_8:
  292. Op:=A_STB;{Store Unsigned Bye}
  293. OS_16:
  294. Op:=A_STH;{Store Unsigned Halfword}
  295. OS_32:
  296. Op:=A_ST;{Store Word}
  297. OS_64:
  298. Op:=A_STD;{Store Double Word}
  299. { floating-point real registers }
  300. OS_F32:
  301. Op:=A_STF;{Store Floating-point word}
  302. //A_STFSR
  303. OS_F64:
  304. Op:=A_STDF;{Store Double Floating-point word}
  305. //A_STC;{Store Coprocessor}
  306. //A_STCSR;
  307. //A_STDC;{Store Double Coprocessor}
  308. else
  309. InternalError(2002122100);
  310. end;
  311. with list do
  312. concat(taicpu.op_reg_ref(op,reg,ref));
  313. end;
  314. procedure TCgSparc.a_load_ref_reg(list:TAasmOutput;size:TCgSize;const ref:TReference;reg:tregister);
  315. var
  316. op:tasmop;
  317. begin
  318. case size of
  319. { signed integer registers }
  320. OS_S8:
  321. Op:=A_LDSB;{Load Signed Byte}
  322. OS_S16:
  323. Op:=A_LDSH;{Load Signed Halfword}
  324. OS_S32:
  325. Op:=A_LD;{Load Word}
  326. OS_S64:
  327. Op:=A_LDD;{Load Double Word}
  328. { unsigned integer registers }
  329. //A_LDSTUB;{Load-Store Unsigned Byte}
  330. OS_8:
  331. Op:=A_LDUB;{Load Unsigned Bye}
  332. OS_16:
  333. Op:=A_LDUH;{Load Unsigned Halfword}
  334. OS_32:
  335. Op:=A_LD;{Load Word}
  336. OS_64:
  337. Op:=A_LDD;{Load Double Word}
  338. { floating-point real registers }
  339. OS_F32:
  340. Op:=A_LDF;{Load Floating-point word}
  341. //A_LDFSR
  342. OS_F64:
  343. Op:=A_LDDF;{Load Double Floating-point word}
  344. //A_LDC;{Load Coprocessor}
  345. //A_LDCSR;
  346. //A_LDDC;{Load Double Coprocessor}
  347. else
  348. InternalError(2002122100);
  349. end;
  350. with list do
  351. concat(taicpu.op_ref_reg(op,ref,reg));
  352. end;
  353. procedure TCgSparc.a_load_reg_reg(list:TAasmOutput;fromsize,tosize:tcgsize;reg1,reg2:tregister);
  354. var
  355. op:tasmop;
  356. s:topsize;
  357. r:Tregister;
  358. begin
  359. r.enum:=R_G0;
  360. if(reg1.enum<>reg2.enum)or
  361. (tcgsize2size[tosize]<tcgsize2size[fromsize])or
  362. ((tcgsize2size[tosize] = tcgsize2size[fromsize])and
  363. (tosize <> fromsize)and
  364. not(fromsize in [OS_32,OS_S32]))
  365. then
  366. with list do
  367. case fromsize of
  368. OS_8,OS_S8,OS_16,OS_S16,OS_32,OS_S32:
  369. concat(taicpu.op_reg_reg_reg(A_OR,r,reg1,reg2));
  370. else internalerror(2002090901);
  371. end;
  372. end;
  373. { all fpu load routines expect that R_ST[0-7] means an fpu regvar and }
  374. { R_ST means "the current value at the top of the fpu stack" (JM) }
  375. procedure TCgSparc.a_loadfpu_reg_reg(list:TAasmOutput;reg1, reg2:tregister);
  376. begin
  377. { if NOT (reg1 IN [R_F0..R_F31]) then
  378. begin
  379. list.concat(taicpu.op_reg(A_NONE,S_NO,
  380. trgcpu(rg).correct_fpuregister(reg1,trgcpu(rg).fpuvaroffset)));
  381. inc(trgcpu(rg).fpuvaroffset);
  382. end;
  383. if NOT (reg2 IN [R_F0..R_F31]) then
  384. begin
  385. list.concat(taicpu.op_reg(A_JMPL,S_NO,
  386. trgcpu(rg).correct_fpuregister(reg2,trgcpu(rg).fpuvaroffset)));
  387. dec(trgcpu(rg).fpuvaroffset);
  388. end;}
  389. end;
  390. procedure TCgSparc.a_loadfpu_ref_reg(list:TAasmOutput;size:tcgsize;CONST ref:TReference;reg:tregister);
  391. begin
  392. floatload(list,size,ref);
  393. { if (reg <> R_ST) then
  394. a_loadfpu_reg_reg(list,R_ST,reg);}
  395. end;
  396. procedure TCgSparc.a_loadfpu_reg_ref(list:TAasmOutput;size:tcgsize;reg:tregister;CONST ref:TReference);
  397. begin
  398. { if reg <> R_ST then
  399. a_loadfpu_reg_reg(list,reg,R_ST);}
  400. floatstore(list,size,ref);
  401. end;
  402. procedure TCgSparc.a_loadmm_reg_reg(list:TAasmOutput;reg1, reg2:tregister);
  403. begin
  404. // list.concat(taicpu.op_reg_reg(A_NONEQ,S_NO,reg1,reg2));
  405. end;
  406. procedure TCgSparc.a_loadmm_ref_reg(list:TAasmOutput;CONST ref:TReference;reg:tregister);
  407. begin
  408. // list.concat(taicpu.op_ref_reg(A_NONEQ,S_NO,ref,reg));
  409. end;
  410. procedure TCgSparc.a_loadmm_reg_ref(list:TAasmOutput;reg:tregister;CONST ref:TReference);
  411. begin
  412. // list.concat(taicpu.op_reg_ref(A_NONEQ,S_NO,reg,ref));
  413. end;
  414. procedure TCgSparc.a_parammm_reg(list:TAasmOutput;reg:tregister);
  415. VAR
  416. href:TReference;
  417. BEGIN
  418. // list.concat(taicpu.op_const_reg(A_SUB,S_SW,8,R_RSP));
  419. // reference_reset_base(href,R_ESP,0);
  420. // list.concat(taicpu.op_reg_ref(A_NONEQ,S_NO,reg,href));
  421. END;
  422. procedure TCgSparc.a_op_const_reg(list:TAasmOutput;Op:TOpCG;a:AWord;reg:TRegister);
  423. var
  424. opcode:tasmop;
  425. power:LongInt;
  426. begin
  427. (* Case Op of
  428. OP_DIV, OP_IDIV:
  429. Begin
  430. if ispowerof2(a,power) then
  431. begin
  432. case op of
  433. OP_DIV:
  434. opcode := A_SHR;
  435. OP_IDIV:
  436. opcode := A_SAR;
  437. end;
  438. list.concat(taicpu.op_const_reg(opcode,S_SW,power,
  439. reg));
  440. exit;
  441. end;
  442. { the rest should be handled specifically in the code }
  443. { generator because of the silly register usage restraints }
  444. internalerror(200109224);
  445. End;
  446. OP_MUL,OP_IMUL:
  447. begin
  448. if not(cs_check_overflow in aktlocalswitches) and
  449. ispowerof2(a,power) then
  450. begin
  451. list.concat(taicpu.op_const_reg(A_SHL,S_SW,power,
  452. reg));
  453. exit;
  454. end;
  455. if op = OP_IMUL then
  456. list.concat(taicpu.op_const_reg(A_IMUL,S_SW,
  457. a,reg))
  458. else
  459. { OP_MUL should be handled specifically in the code }
  460. { generator because of the silly register usage restraints }
  461. internalerror(200109225);
  462. end;
  463. OP_ADD, OP_AND, OP_OR, OP_SUB, OP_XOR:
  464. if not(cs_check_overflow in aktlocalswitches) and
  465. (a = 1) and
  466. (op in [OP_ADD,OP_SUB]) then
  467. if op = OP_ADD then
  468. list.concat(taicpu.op_reg(A_INC,S_SW,reg))
  469. else
  470. list.concat(taicpu.op_reg(A_DEC,S_SW,reg))
  471. else if (a = 0) then
  472. if (op <> OP_AND) then
  473. exit
  474. else
  475. list.concat(taicpu.op_const_reg(A_NONE,S_SW,0,reg))
  476. else if (a = high(aword)) and
  477. (op in [OP_AND,OP_OR,OP_XOR]) then
  478. begin
  479. case op of
  480. OP_AND:
  481. exit;
  482. OP_OR:
  483. list.concat(taicpu.op_const_reg(A_NONE,S_SW,high(aword),reg));
  484. OP_XOR:
  485. list.concat(taicpu.op_reg(A_NOT,S_SW,reg));
  486. end
  487. end
  488. else
  489. list.concat(taicpu.op_const_reg(TOpCG2AsmOp[op],S_SW,
  490. a,reg));
  491. OP_SHL,OP_SHR,OP_SAR:
  492. begin
  493. if (a and 31) <> 0 Then
  494. list.concat(taicpu.op_const_reg(
  495. TOpCG2AsmOp[op],S_SW,a and 31,reg));
  496. if (a shr 5) <> 0 Then
  497. internalerror(68991);
  498. end
  499. else internalerror(68992);
  500. end;*)
  501. end;
  502. procedure TCgSparc.a_op_const_ref(list:TAasmOutput;Op:TOpCG;size:TCGSize;a:AWord;CONST ref:TReference);
  503. var
  504. opcode:tasmop;
  505. power:LongInt;
  506. begin
  507. (* Case Op of
  508. OP_DIV, OP_IDIV:
  509. Begin
  510. if ispowerof2(a,power) then
  511. begin
  512. case op of
  513. OP_DIV:
  514. opcode := A_SHR;
  515. OP_IDIV:
  516. opcode := A_SAR;
  517. end;
  518. list.concat(taicpu.op_const_ref(opcode,
  519. TCgSize2OpSize[size],power,ref));
  520. exit;
  521. end;
  522. { the rest should be handled specifically in the code }
  523. { generator because of the silly register usage restraints }
  524. internalerror(200109231);
  525. End;
  526. OP_MUL,OP_IMUL:
  527. begin
  528. if not(cs_check_overflow in aktlocalswitches) and
  529. ispowerof2(a,power) then
  530. begin
  531. list.concat(taicpu.op_const_ref(A_SHL,TCgSize2OpSize[size],
  532. power,ref));
  533. exit;
  534. end;
  535. { can't multiply a memory location directly with a CONSTant }
  536. if op = OP_IMUL then
  537. inherited a_op_const_ref(list,op,size,a,ref)
  538. else
  539. { OP_MUL should be handled specifically in the code }
  540. { generator because of the silly register usage restraints }
  541. internalerror(200109232);
  542. end;
  543. OP_ADD, OP_AND, OP_OR, OP_SUB, OP_XOR:
  544. if not(cs_check_overflow in aktlocalswitches) and
  545. (a = 1) and
  546. (op in [OP_ADD,OP_SUB]) then
  547. if op = OP_ADD then
  548. list.concat(taicpu.op_ref(A_INC,TCgSize2OpSize[size],ref))
  549. else
  550. list.concat(taicpu.op_ref(A_DEC,TCgSize2OpSize[size],ref))
  551. else if (a = 0) then
  552. if (op <> OP_AND) then
  553. exit
  554. else
  555. a_load_const_ref(list,size,0,ref)
  556. else if (a = high(aword)) and
  557. (op in [OP_AND,OP_OR,OP_XOR]) then
  558. begin
  559. case op of
  560. OP_AND:
  561. exit;
  562. OP_OR:
  563. list.concat(taicpu.op_const_ref(A_NONE,TCgSize2OpSize[size],high(aword),ref));
  564. OP_XOR:
  565. list.concat(taicpu.op_ref(A_NOT,TCgSize2OpSize[size],ref));
  566. end
  567. end
  568. else
  569. list.concat(taicpu.op_const_ref(TOpCG2AsmOp[op],
  570. TCgSize2OpSize[size],a,ref));
  571. OP_SHL,OP_SHR,OP_SAR:
  572. begin
  573. if (a and 31) <> 0 Then
  574. list.concat(taicpu.op_const_ref(
  575. TOpCG2AsmOp[op],TCgSize2OpSize[size],a and 31,ref));
  576. if (a shr 5) <> 0 Then
  577. internalerror(68991);
  578. end
  579. else internalerror(68992);
  580. end;*)
  581. end;
  582. procedure TCgSparc.a_op_reg_reg(list:TAasmOutput;Op:TOpCG;size:TCGSize;src, dst:TRegister);
  583. var
  584. regloadsize:tcgsize;
  585. dstsize:topsize;
  586. tmpreg:tregister;
  587. popecx:boolean;
  588. begin
  589. (* dstsize := S_Q{makeregsize(dst,size)};
  590. case op of
  591. OP_NEG,OP_NOT:
  592. begin
  593. if src <> R_NO then
  594. internalerror(200112291);
  595. list.concat(taicpu.op_reg(TOpCG2AsmOp[op],dstsize,dst));
  596. end;
  597. OP_MUL,OP_DIV,OP_IDIV:
  598. { special stuff, needs separate handling inside code }
  599. { generator }
  600. internalerror(200109233);
  601. OP_SHR,OP_SHL,OP_SAR:
  602. begin
  603. tmpreg := R_NO;
  604. { we need cl to hold the shift count, so if the destination }
  605. { is ecx, save it to a temp for now }
  606. if dst in [R_ECX,R_CX,R_CL] then
  607. begin
  608. case S_SW of
  609. S_B:regloadsize := OS_8;
  610. S_W:regloadsize := OS_16;
  611. else regloadsize := OS_32;
  612. end;
  613. tmpreg := get_scratch_reg(list);
  614. a_load_reg_reg(list,regloadsize,OS_32,src,tmpreg);
  615. end;
  616. if not(src in [R_ECX,R_CX,R_CL]) then
  617. begin
  618. { is ecx still free (it's also free if it was allocated }
  619. { to dst, since we've moved dst somewhere else already) }
  620. if not((dst = R_ECX) or
  621. ((R_ECX in rg.unusedregsint) and
  622. { this will always be true, it's just here to }
  623. { allocate ecx }
  624. (rg.getexplicitregisterint(list,R_ECX) = R_ECX))) then
  625. begin
  626. list.concat(taicpu.op_reg(A_NONE,S_SW,R_ECX));
  627. popecx := true;
  628. end;
  629. a_load_reg_reg(list,OS_8,OS_8,(src),R_CL);
  630. end
  631. else
  632. src := R_CL;
  633. { do the shift }
  634. if tmpreg = R_NO then
  635. list.concat(taicpu.op_reg_reg(TOpCG2AsmOp[op],dstsize,
  636. R_CL,dst))
  637. else
  638. begin
  639. list.concat(taicpu.op_reg_reg(TOpCG2AsmOp[op],S_SW,
  640. R_CL,tmpreg));
  641. { move result back to the destination }
  642. a_load_reg_reg(list,OS_32,OS_32,tmpreg,R_ECX);
  643. free_scratch_reg(list,tmpreg);
  644. end;
  645. if popecx then
  646. list.concat(taicpu.op_reg(A_POP,S_SW,R_ECX))
  647. else if not (dst in [R_ECX,R_CX,R_CL]) then
  648. rg.ungetregisterint(list,R_ECX);
  649. end;
  650. else
  651. begin
  652. if S_SW <> dstsize then
  653. internalerror(200109226);
  654. list.concat(taicpu.op_reg_reg(TOpCG2AsmOp[op],dstsize,
  655. src,dst));
  656. end;
  657. end;*)
  658. end;
  659. procedure TCgSparc.a_op_ref_reg(list:TAasmOutput;Op:TOpCG;size:TCGSize;CONST ref:TReference;reg:TRegister);
  660. var
  661. opsize:topsize;
  662. begin
  663. (* case op of
  664. OP_NEG,OP_NOT,OP_IMUL:
  665. begin
  666. inherited a_op_ref_reg(list,op,size,ref,reg);
  667. end;
  668. OP_MUL,OP_DIV,OP_IDIV:
  669. { special stuff, needs separate handling inside code }
  670. { generator }
  671. internalerror(200109239);
  672. else
  673. begin
  674. opsize := S_Q{makeregsize(reg,size)};
  675. list.concat(taicpu.op_ref_reg(TOpCG2AsmOp[op],opsize,ref,reg));
  676. end;
  677. end;*)
  678. end;
  679. procedure TCgSparc.a_op_reg_ref(list:TAasmOutput;Op:TOpCG;size:TCGSize;reg:TRegister;CONST ref:TReference);
  680. var
  681. opsize:topsize;
  682. begin
  683. (* case op of
  684. OP_NEG,OP_NOT:
  685. begin
  686. if reg <> R_NO then
  687. internalerror(200109237);
  688. list.concat(taicpu.op_ref(TOpCG2AsmOp[op],tcgsize2opsize[size],ref));
  689. end;
  690. OP_IMUL:
  691. begin
  692. { this one needs a load/imul/store, which is the default }
  693. inherited a_op_ref_reg(list,op,size,ref,reg);
  694. end;
  695. OP_MUL,OP_DIV,OP_IDIV:
  696. { special stuff, needs separate handling inside code }
  697. { generator }
  698. internalerror(200109238);
  699. else
  700. begin
  701. opsize := tcgsize2opsize[size];
  702. list.concat(taicpu.op_reg_ref(TOpCG2AsmOp[op],opsize,reg,ref));
  703. end;
  704. end;*)
  705. end;
  706. procedure TCgSparc.a_op_const_reg_reg(list:TAasmOutput;op:TOpCg;
  707. size:tcgsize;a:aword;src, dst:tregister);
  708. var
  709. tmpref:TReference;
  710. power:LongInt;
  711. opsize:topsize;
  712. begin
  713. opsize := S_SW;
  714. if (opsize <> S_SW) or
  715. not (size in [OS_32,OS_S32]) then
  716. begin
  717. inherited a_op_const_reg_reg(list,op,size,a,src,dst);
  718. exit;
  719. end;
  720. { if we get here, we have to do a 32 bit calculation, guaranteed }
  721. Case Op of
  722. OP_DIV, OP_IDIV, OP_MUL, OP_AND, OP_OR, OP_XOR, OP_SHL, OP_SHR,
  723. OP_SAR:
  724. { can't do anything special for these }
  725. inherited a_op_const_reg_reg(list,op,size,a,src,dst);
  726. OP_IMUL:
  727. begin
  728. if not(cs_check_overflow in aktlocalswitches) and
  729. ispowerof2(a,power) then
  730. { can be done with a shift }
  731. inherited a_op_const_reg_reg(list,op,size,a,src,dst);
  732. list.concat(taicpu.op_reg_const_reg(A_SMUL,src,a,dst));
  733. end;
  734. OP_ADD, OP_SUB:
  735. if (a = 0) then
  736. a_load_reg_reg(list,size,size,src,dst)
  737. else
  738. begin
  739. reference_reset(tmpref);
  740. tmpref.base := src;
  741. tmpref.offset := LongInt(a);
  742. if op = OP_SUB then
  743. tmpref.offset := -tmpref.offset;
  744. list.concat(taicpu.op_ref_reg(A_NONE,tmpref,dst));
  745. end
  746. else internalerror(200112302);
  747. end;
  748. end;
  749. procedure TCgSparc.a_op_reg_reg_reg(list:TAasmOutput;op:TOpCg;
  750. size:tcgsize;src1, src2, dst:tregister);
  751. var
  752. tmpref:TReference;
  753. opsize:topsize;
  754. begin
  755. opsize := S_SW;
  756. if (opsize <> S_SW) or
  757. (S_SW <> S_SW) or
  758. not (size in [OS_32,OS_S32]) then
  759. begin
  760. inherited a_op_reg_reg_reg(list,op,size,src1,src2,dst);
  761. exit;
  762. end;
  763. { if we get here, we have to do a 32 bit calculation, guaranteed }
  764. Case Op of
  765. OP_DIV, OP_IDIV, OP_MUL, OP_AND, OP_OR, OP_XOR, OP_SHL, OP_SHR,
  766. OP_SAR,OP_SUB,OP_NOT,OP_NEG:
  767. { can't do anything special for these }
  768. inherited a_op_reg_reg_reg(list,op,size,src1,src2,dst);
  769. OP_IMUL:
  770. list.concat(taicpu.op_reg_reg_reg(A_SMUL,src1,src2,dst));
  771. OP_ADD:
  772. begin
  773. reference_reset(tmpref);
  774. tmpref.base := src1;
  775. tmpref.index := src2;
  776. tmpref.scalefactor := 1;
  777. list.concat(taicpu.op_ref_reg(A_NONE,tmpref,dst));
  778. end
  779. else internalerror(200112303);
  780. end;
  781. end;
  782. {*************** compare instructructions ****************}
  783. procedure TCgSparc.a_cmp_const_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;a:aword;reg:tregister;
  784. l:tasmlabel);
  785. begin
  786. if (a = 0) then
  787. list.concat(taicpu.op_reg_reg(A_CMP,reg,reg))
  788. else
  789. list.concat(taicpu.op_const_reg(A_CMP,a,reg));
  790. a_jmp_cond(list,cmp_op,l);
  791. end;
  792. procedure TCgSparc.a_cmp_const_ref_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;a:aword;const ref:TReference;l:tasmlabel);
  793. begin
  794. with List do
  795. begin
  796. Concat(taicpu.op_const(A_LD,a));
  797. Concat(taicpu.op_ref(A_CMP,ref));
  798. end;
  799. a_jmp_cond(list,cmp_op,l);
  800. end;
  801. procedure TCgSparc.a_cmp_reg_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;
  802. reg1,reg2:tregister;l:tasmlabel);
  803. begin
  804. { if regsize(reg1) <> S_SW then
  805. internalerror(200109226);
  806. list.concat(taicpu.op_reg_reg(A_CMP,regsize(reg1),reg1,reg2));
  807. a_jmp_cond(list,cmp_op,l);}
  808. end;
  809. procedure TCgSparc.a_cmp_ref_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;CONST ref:TReference;reg:tregister;l:tasmlabel);
  810. var
  811. TempReg:TRegister;
  812. begin
  813. TempReg:=cg.get_scratch_reg_int(List);
  814. a_load_ref_reg(list,OS_32,Ref,TempReg);
  815. list.concat(taicpu.op_reg_reg(A_SUBcc,TempReg,Reg));
  816. a_jmp_cond(list,cmp_op,l);
  817. cg.free_scratch_reg(exprasmlist,TempReg);
  818. end;
  819. procedure TCgSparc.a_jmp_cond(list:TAasmOutput;cond:TOpCmp;l:tasmlabel);
  820. var
  821. ai:taicpu;
  822. begin
  823. if cond=OC_None then
  824. ai := Taicpu.Op_sym(A_JMPL,S_NO,l)
  825. else
  826. begin
  827. ai:=Taicpu.Op_sym(A_JMPL,S_NO,l);
  828. ai.SetCondition(TOpCmp2AsmCond[cond]);
  829. end;
  830. ai.is_jmp:=true;
  831. list.concat(ai);
  832. end;
  833. procedure TCgSparc.a_jmp_flags(list:TAasmOutput;CONST f:TResFlags;l:tasmlabel);
  834. var
  835. ai:taicpu;
  836. begin
  837. ai := Taicpu.op_sym(A_JMPL,S_NO,l);
  838. ai.SetCondition(flags_to_cond(f));
  839. ai.is_jmp := true;
  840. list.concat(ai);
  841. end;
  842. procedure TCgSparc.g_flags2reg(list:TAasmOutput;Size:TCgSize;CONST f:tresflags;reg:TRegister);
  843. VAR
  844. ai:taicpu;
  845. r,hreg:tregister;
  846. BEGIN
  847. r.enum:=R_PSR;
  848. hreg := rg.makeregsize(reg,OS_8);
  849. ai:=Taicpu.Op_reg_reg(A_RDPSR,r,hreg);
  850. ai.SetCondition(flags_to_cond(f));
  851. list.concat(ai);
  852. IF hreg.enum<>reg.enum
  853. THEN
  854. a_load_reg_reg(list,OS_32,OS_32,hreg,reg);
  855. END;
  856. procedure TCgSparc.g_overflowCheck(List:TAasmOutput;const p:TNode);
  857. var
  858. hl:TAsmLabel;
  859. r:Tregister;
  860. begin
  861. r.enum:=R_NONE;
  862. if not(cs_check_overflow in aktlocalswitches)
  863. then
  864. exit;
  865. objectlibrary.getlabel(hl);
  866. if not((p.resulttype.def.deftype=pointerdef) or
  867. ((p.resulttype.def.deftype=orddef) and
  868. (torddef(p.resulttype.def).typ in [u64bit,u16bit,u32bit,u8bit,uchar,
  869. bool8bit,bool16bit,bool32bit])))
  870. then
  871. begin
  872. list.concat(taicpu.op_reg(A_NONE,r));
  873. a_jmp_always(list,hl)
  874. end
  875. else
  876. a_jmp_cond(list,OC_NONE,hl);
  877. a_call_name(list,'FPC_OVERFLOW');
  878. a_label(list,hl);
  879. end;
  880. { *********** entry/exit code and address loading ************ }
  881. procedure TCgSparc.g_stackframe_entry(list:TAasmOutput;LocalSize:LongInt);
  882. var
  883. href:TReference;
  884. r:Tregister;
  885. i:integer;
  886. again:tasmlabel;
  887. begin
  888. {Althogh the SPARC architecture require only word alignment, software
  889. convention and the operating system require every stack frame to be double word
  890. aligned}
  891. LocalSize:=(LocalSize+7)and $FFFFFFF8;
  892. {Execute the SAVE instruction to get a new register window and create a new
  893. stack frame. In the "SAVE %i6,size,%i6" the first %i6 is related to the state
  894. before execution of the SAVE instrucion so it is the caller %i6, when the %i6
  895. after execution of that instruction is the called function stack pointer}
  896. r.enum:=stack_pointer_reg;
  897. with list do
  898. concat(Taicpu.Op_reg_const_reg(A_SAVE,r,-LocalSize,r));
  899. end;
  900. procedure TCgSparc.g_restore_all_registers(list:TaasmOutput;selfused,accused,acchiused:boolean);
  901. begin
  902. {$warning FIX ME TCgSparc.g_restore_all_registers}
  903. end;
  904. procedure TCgSparc.g_restore_frame_pointer(list:TAasmOutput);
  905. begin
  906. {This function intontionally does nothing as frame pointer is restored in the
  907. delay slot of the return instrucion done in g_return_from_proc}
  908. end;
  909. procedure TCgSparc.g_restore_standard_registers(list:taasmoutput;usedinproc:tregisterset);
  910. begin
  911. {$WARNING FIX ME TCgSparc.g_restore_standard_registers}
  912. end;
  913. procedure TCgSparc.g_return_from_proc(list:TAasmOutput;parasize:aword);
  914. var r,r2:Tregister;
  915. begin
  916. {According to the SPARC ABI, the stack is cleared using the RESTORE instruction
  917. which is genereted in the g_restore_frame_pointer. Notice that SPARC has no
  918. RETURN instruction and that JMPL is used instead. The JMPL instrucion have one
  919. delay slot, so an inversion is possible such as
  920. JMPL %i7+8,%g0
  921. RESTORE %g0,0,%g0
  922. If no inversion we can use just
  923. RESTORE %g0,0,%g0
  924. JMPL %i7+8,%g0
  925. NOP}
  926. with list do
  927. begin
  928. {Return address is computed by adding 8 to the CALL address saved onto %i6}
  929. r.enum:=R_G0;
  930. r2.enum:=R_I7;
  931. concat(Taicpu.Op_caddr_reg(A_JMPL,r,8,r));
  932. {We use trivial restore in the delay slot of the JMPL instruction, as we
  933. already set result onto %i0}
  934. concat(Taicpu.Op_reg_const_reg(A_RESTORE,r,0,r));
  935. end
  936. end;
  937. procedure TCgSparc.g_save_all_registers(list : taasmoutput);
  938. begin
  939. {$warning FIX ME TCgSparc.g_save_all_registers}
  940. end;
  941. procedure TCgSparc.g_save_standard_registers(list : taasmoutput; usedinproc : tregisterset);
  942. begin
  943. {$warning FIX ME tcgppc.g_save_standard_registers}
  944. end;
  945. procedure TCgSparc.a_loadaddr_ref_reg(list:TAasmOutput;CONST ref:TReference;r:tregister);
  946. begin
  947. // list.concat(taicpu.op_ref_reg(A_LEA,S_SW,ref,r));
  948. end;
  949. { ************* 64bit operations ************ }
  950. procedure TCg64Sparc.get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp);
  951. begin
  952. case op of
  953. OP_ADD :
  954. begin
  955. op1:=A_ADD;
  956. op2:=A_ADD;
  957. end;
  958. OP_SUB :
  959. begin
  960. op1:=A_SUB;
  961. op2:=A_SUB;
  962. end;
  963. OP_XOR :
  964. begin
  965. op1:=A_XOR;
  966. op2:=A_XOR;
  967. end;
  968. OP_OR :
  969. begin
  970. op1:=A_OR;
  971. op2:=A_OR;
  972. end;
  973. OP_AND :
  974. begin
  975. op1:=A_AND;
  976. op2:=A_AND;
  977. end;
  978. else
  979. internalerror(200203241);
  980. end;
  981. end;
  982. procedure TCg64Sparc.a_op64_ref_reg(list:TAasmOutput;op:TOpCG;CONST ref:TReference;reg:TRegister64);
  983. var
  984. op1,op2:TAsmOp;
  985. tempref:TReference;
  986. begin
  987. get_64bit_ops(op,op1,op2);
  988. list.concat(taicpu.op_ref_reg(op1,ref,reg.reglo));
  989. tempref:=ref;
  990. inc(tempref.offset,4);
  991. list.concat(taicpu.op_ref_reg(op2,tempref,reg.reghi));
  992. end;
  993. procedure TCg64Sparc.a_op64_reg_reg(list:TAasmOutput;op:TOpCG;regsrc,regdst:TRegister64);
  994. var
  995. op1,op2:TAsmOp;
  996. begin
  997. get_64bit_ops(op,op1,op2);
  998. list.concat(taicpu.op_reg_reg(op1,regsrc.reglo,regdst.reglo));
  999. list.concat(taicpu.op_reg_reg(op2,regsrc.reghi,regdst.reghi));
  1000. end;
  1001. procedure TCg64Sparc.a_op64_const_reg(list:TAasmOutput;op:TOpCG;value:qWord;regdst:TRegister64);
  1002. var
  1003. op1,op2:TAsmOp;
  1004. begin
  1005. case op of
  1006. OP_AND,OP_OR,OP_XOR:
  1007. WITH cg DO
  1008. begin
  1009. a_op_const_reg(list,op,Lo(Value),regdst.reglo);
  1010. a_op_const_reg(list,op,Hi(Value),regdst.reghi);
  1011. end;
  1012. OP_ADD, OP_SUB:
  1013. begin
  1014. {can't use a_op_const_ref because this may use dec/inc}
  1015. get_64bit_ops(op,op1,op2);
  1016. list.concat(taicpu.op_const_reg(op1,Lo(Value),regdst.reglo));
  1017. list.concat(taicpu.op_const_reg(op2,Hi(Value),regdst.reghi));
  1018. end;
  1019. else
  1020. internalerror(200204021);
  1021. end;
  1022. end;
  1023. procedure TCg64Sparc.a_op64_const_ref(list:TAasmOutput;op:TOpCG;value:qWord;const ref:TReference);
  1024. var
  1025. op1,op2:TAsmOp;
  1026. tempref:TReference;
  1027. begin
  1028. case op of
  1029. OP_AND,OP_OR,OP_XOR:
  1030. with cg do
  1031. begin
  1032. a_op_const_ref(list,op,OS_32,Lo(Value),ref);
  1033. tempref:=ref;
  1034. inc(tempref.offset,4);
  1035. a_op_const_ref(list,op,OS_32,Hi(Value),tempref);
  1036. end;
  1037. OP_ADD, OP_SUB:
  1038. begin
  1039. get_64bit_ops(op,op1,op2);
  1040. { can't use a_op_const_ref because this may use dec/inc}
  1041. { list.concat(taicpu.op_const_ref(op1,Lo(Value),ref));
  1042. tempref:=ref;
  1043. inc(tempref.offset,4);
  1044. list.concat(taicpu.op_const_ref(op2,S_SW,Hi(Value),tempref));}
  1045. InternalError(2002102101);
  1046. end;
  1047. else
  1048. internalerror(200204022);
  1049. end;
  1050. end;
  1051. { ************* concatcopy ************ }
  1052. procedure TCgSparc.g_concatcopy(list:taasmoutput;const source,dest:treference;len:aword;delsource,loadref:boolean);
  1053. var
  1054. countreg: TRegister;
  1055. src, dst: TReference;
  1056. lab: tasmlabel;
  1057. count, count2: aword;
  1058. orgsrc, orgdst: boolean;
  1059. r:Tregister;
  1060. begin
  1061. {$ifdef extdebug}
  1062. if len > high(longint)
  1063. then
  1064. internalerror(2002072704);
  1065. {$endif extdebug}
  1066. { make sure short loads are handled as optimally as possible }
  1067. if not loadref then
  1068. if (len <= 8) and
  1069. (byte(len) in [1,2,4,8]) then
  1070. begin
  1071. if len < 8 then
  1072. begin
  1073. a_load_ref_ref(list,int_cgsize(len),source,dest);
  1074. if delsource then
  1075. reference_release(list,source);
  1076. end
  1077. else
  1078. begin
  1079. r.enum:=R_F0;
  1080. a_reg_alloc(list,r);
  1081. a_loadfpu_ref_reg(list,OS_F64,source,r);
  1082. if delsource then
  1083. reference_release(list,source);
  1084. a_loadfpu_reg_ref(list,OS_F64,r,dest);
  1085. a_reg_dealloc(list,r);
  1086. end;
  1087. exit;
  1088. end;
  1089. reference_reset(src);
  1090. reference_reset(dst);
  1091. { load the address of source into src.base }
  1092. if loadref then
  1093. begin
  1094. src.base := get_scratch_reg_address(list);
  1095. a_load_ref_reg(list,OS_32,source,src.base);
  1096. orgsrc := false;
  1097. end
  1098. else if not issimpleref(source) or
  1099. ((source.index.enum <> R_NO) and
  1100. ((source.offset + longint(len)) > high(smallint))) then
  1101. begin
  1102. src.base := get_scratch_reg_address(list);
  1103. a_loadaddr_ref_reg(list,source,src.base);
  1104. orgsrc := false;
  1105. end
  1106. else
  1107. begin
  1108. src := source;
  1109. orgsrc := true;
  1110. end;
  1111. if not orgsrc and delsource then
  1112. reference_release(list,source);
  1113. { load the address of dest into dst.base }
  1114. if not issimpleref(dest) or
  1115. ((dest.index.enum <> R_NO) and
  1116. ((dest.offset + longint(len)) > high(smallint))) then
  1117. begin
  1118. dst.base := get_scratch_reg_address(list);
  1119. a_loadaddr_ref_reg(list,dest,dst.base);
  1120. orgdst := false;
  1121. end
  1122. else
  1123. begin
  1124. dst := dest;
  1125. orgdst := true;
  1126. end;
  1127. count := len div 8;
  1128. if count > 4 then
  1129. { generate a loop }
  1130. begin
  1131. { the offsets are zero after the a_loadaddress_ref_reg and just }
  1132. { have to be set to 8. I put an Inc there so debugging may be }
  1133. { easier (should offset be different from zero here, it will be }
  1134. { easy to notice in the generated assembler }
  1135. inc(dst.offset,8);
  1136. inc(src.offset,8);
  1137. list.concat(taicpu.op_reg_const_reg(A_SUB,src.base,8,src.base));
  1138. list.concat(taicpu.op_reg_const_reg(A_SUB,dst.base,8,dst.base));
  1139. countreg := get_scratch_reg_int(list);
  1140. a_load_const_reg(list,OS_32,count,countreg);
  1141. { explicitely allocate R_O0 since it can be used safely here }
  1142. { (for holding date that's being copied) }
  1143. r.enum:=R_F0;
  1144. a_reg_alloc(list,r);
  1145. objectlibrary.getlabel(lab);
  1146. a_label(list, lab);
  1147. list.concat(taicpu.op_reg_const_reg(A_SUB,countreg,1,countreg));
  1148. list.concat(taicpu.op_reg_ref(A_LDF,r,src));
  1149. list.concat(taicpu.op_reg_ref(A_STD,r,dst));
  1150. //a_jmp(list,A_BC,C_NE,0,lab);
  1151. free_scratch_reg(list,countreg);
  1152. a_reg_dealloc(list,r);
  1153. len := len mod 8;
  1154. end;
  1155. count := len div 8;
  1156. if count > 0 then
  1157. { unrolled loop }
  1158. begin
  1159. r.enum:=R_F0;
  1160. a_reg_alloc(list,r);
  1161. for count2 := 1 to count do
  1162. begin
  1163. a_loadfpu_ref_reg(list,OS_F64,src,r);
  1164. a_loadfpu_reg_ref(list,OS_F64,r,dst);
  1165. inc(src.offset,8);
  1166. inc(dst.offset,8);
  1167. end;
  1168. a_reg_dealloc(list,r);
  1169. len := len mod 8;
  1170. end;
  1171. if (len and 4) <> 0 then
  1172. begin
  1173. r.enum:=R_O0;
  1174. a_reg_alloc(list,r);
  1175. a_load_ref_reg(list,OS_32,src,r);
  1176. a_load_reg_ref(list,OS_32,r,dst);
  1177. inc(src.offset,4);
  1178. inc(dst.offset,4);
  1179. a_reg_dealloc(list,r);
  1180. end;
  1181. { copy the leftovers }
  1182. if (len and 2) <> 0 then
  1183. begin
  1184. r.enum:=R_O0;
  1185. a_reg_alloc(list,r);
  1186. a_load_ref_reg(list,OS_16,src,r);
  1187. a_load_reg_ref(list,OS_16,r,dst);
  1188. inc(src.offset,2);
  1189. inc(dst.offset,2);
  1190. a_reg_dealloc(list,r);
  1191. end;
  1192. if (len and 1) <> 0 then
  1193. begin
  1194. r.enum:=R_O0;
  1195. a_reg_alloc(list,r);
  1196. a_load_ref_reg(list,OS_8,src,r);
  1197. a_load_reg_ref(list,OS_8,r,dst);
  1198. a_reg_dealloc(list,r);
  1199. end;
  1200. if orgsrc then
  1201. begin
  1202. if delsource then
  1203. reference_release(list,source);
  1204. end
  1205. else
  1206. free_scratch_reg(list,src.base);
  1207. if not orgdst then
  1208. free_scratch_reg(list,dst.base);
  1209. end;
  1210. function TCgSparc.reg_cgsize(CONST reg:tregister):tcgsize;
  1211. begin
  1212. result:=OS_32;
  1213. end;
  1214. {***************** This is private property, keep out! :) *****************}
  1215. function TCgSparc.IsSimpleRef(const ref:treference):boolean;
  1216. begin
  1217. if(ref.base.enum=R_NONE)and(ref.index.enum <> R_NO)
  1218. then
  1219. InternalError(2002100804);
  1220. result :=not(assigned(ref.symbol))and
  1221. (((ref.index.enum = R_NO) and
  1222. (ref.offset >= low(smallint)) and
  1223. (ref.offset <= high(smallint))) or
  1224. ((ref.index.enum <> R_NO) and
  1225. (ref.offset = 0)));
  1226. end;
  1227. procedure TCgSparc.sizes2load(s1:tcgsize;s2:topsize;var op:tasmop;var s3:topsize);
  1228. begin
  1229. case s2 of
  1230. S_B:
  1231. if S1 in [OS_8,OS_S8]
  1232. then
  1233. s3 := S_B
  1234. else
  1235. internalerror(200109221);
  1236. S_W:
  1237. case s1 of
  1238. OS_8,OS_S8:
  1239. s3 := S_B;
  1240. OS_16,OS_S16:
  1241. s3 := S_H;
  1242. else
  1243. internalerror(200109222);
  1244. end;
  1245. S_SW:
  1246. case s1 of
  1247. OS_8,OS_S8:
  1248. s3 := S_B;
  1249. OS_16,OS_S16:
  1250. s3 := S_H;
  1251. OS_32,OS_S32:
  1252. s3 := S_W;
  1253. else
  1254. internalerror(200109223);
  1255. end;
  1256. else internalerror(200109227);
  1257. end;
  1258. if s3 in [S_B,S_W,S_SW]
  1259. then
  1260. op := A_LD
  1261. { else if s3=S_DW
  1262. then
  1263. op:=A_LDD
  1264. else if s3 in [OS_8,OS_16,OS_32]
  1265. then
  1266. op := A_NONE}
  1267. else
  1268. op := A_NONE;
  1269. end;
  1270. procedure TCgSparc.floatloadops(t:tcgsize;VAR op:tasmop;VAR s:topsize);
  1271. BEGIN
  1272. (* case t of
  1273. OS_F32:begin
  1274. op:=A_FLD;
  1275. s:=S_FS;
  1276. end;
  1277. OS_F64:begin
  1278. op:=A_FLD;
  1279. { ???? }
  1280. s:=S_FL;
  1281. end;
  1282. OS_F80:begin
  1283. op:=A_FLD;
  1284. s:=S_FX;
  1285. end;
  1286. OS_C64:begin
  1287. op:=A_FILD;
  1288. s:=S_IQ;
  1289. end;
  1290. else internalerror(17);
  1291. end;*)
  1292. END;
  1293. procedure TCgSparc.floatload(list:TAasmOutput;t:tcgsize;CONST ref:TReference);
  1294. VAR
  1295. op:tasmop;
  1296. s:topsize;
  1297. BEGIN
  1298. floatloadops(t,op,s);
  1299. list.concat(Taicpu.Op_ref(op,ref));
  1300. { inc(trgcpu(rg).fpuvaroffset);}
  1301. END;
  1302. procedure TCgSparc.floatstoreops(t:tcgsize;var op:tasmop;var s:topsize);
  1303. BEGIN
  1304. { case t of
  1305. OS_F32:begin
  1306. op:=A_FSTP;
  1307. s:=S_FS;
  1308. end;
  1309. OS_F64:begin
  1310. op:=A_FSTP;
  1311. s:=S_FL;
  1312. end;
  1313. OS_F80:begin
  1314. op:=A_FSTP;
  1315. s:=S_FX;
  1316. end;
  1317. OS_C64:begin
  1318. op:=A_FISTP;
  1319. s:=S_IQ;
  1320. end;
  1321. else
  1322. internalerror(17);
  1323. end;}
  1324. end;
  1325. procedure TCgSparc.floatstore(list:TAasmOutput;t:tcgsize;CONST ref:TReference);
  1326. VAR
  1327. op:tasmop;
  1328. s:topsize;
  1329. BEGIN
  1330. floatstoreops(t,op,s);
  1331. list.concat(Taicpu.Op_ref(op,ref));
  1332. { dec(trgcpu(rg).fpuvaroffset);}
  1333. END;
  1334. BEGIN
  1335. cg:=TCgSparc.Create;
  1336. cg64:=TCg64Sparc.Create;
  1337. END.
  1338. {
  1339. $Log$
  1340. Revision 1.37 2003-02-05 21:48:34 mazen
  1341. * fixing run time errors related to unimplemented abstract methods in CG
  1342. + giving empty emplementations for some RTL functions
  1343. Revision 1.36 2003/01/22 22:30:03 mazen
  1344. - internal errors rmoved from a_loar_reg_reg when reg sizes differs from 32
  1345. Revision 1.35 2003/01/20 22:21:36 mazen
  1346. * many stuff related to RTL fixed
  1347. Revision 1.34 2003/01/08 18:43:58 daniel
  1348. * Tregister changed into a record
  1349. Revision 1.33 2003/01/07 22:03:40 mazen
  1350. * adding unequaln node support to sparc compiler
  1351. Revision 1.32 2003/01/06 22:51:47 mazen
  1352. * fixing bugs related to load_reg_ref
  1353. Revision 1.31 2003/01/05 21:32:35 mazen
  1354. * fixing several bugs compiling the RTL
  1355. Revision 1.30 2003/01/05 13:36:53 florian
  1356. * x86-64 compiles
  1357. + very basic support for float128 type (x86-64 only)
  1358. Revision 1.29 2002/12/25 20:59:49 mazen
  1359. - many emitXXX removed from cga.pas in order to remove that file.
  1360. Revision 1.28 2002/12/22 19:26:31 mazen
  1361. * many internal errors related to unimplemented nodes are fixed
  1362. Revision 1.27 2002/12/21 23:21:47 mazen
  1363. + added support for the shift nodes
  1364. + added debug output on screen with -an command line option
  1365. Revision 1.26 2002/11/25 19:21:49 mazen
  1366. * fixed support of nSparcInline
  1367. Revision 1.25 2002/11/25 17:43:28 peter
  1368. * splitted defbase in defutil,symutil,defcmp
  1369. * merged isconvertable and is_equal into compare_defs(_ext)
  1370. * made operator search faster by walking the list only once
  1371. Revision 1.24 2002/11/17 17:49:09 mazen
  1372. + return_result_reg and function_result_reg are now used, in all plateforms, to pass functions result between called function and its caller. See the explanation of each one
  1373. Revision 1.23 2002/11/10 19:07:46 mazen
  1374. * SPARC calling mechanism almost OK (as in GCC./mppcsparc )
  1375. Revision 1.22 2002/11/06 11:31:24 mazen
  1376. * op_reg_reg_reg don't need any more a TOpSize parameter
  1377. Revision 1.21 2002/11/05 16:15:00 mazen
  1378. *** empty log message ***
  1379. Revision 1.20 2002/11/03 20:22:40 mazen
  1380. * parameter handling updated
  1381. Revision 1.19 2002/10/28 20:59:17 mazen
  1382. * TOpSize values changed S_L --> S_SW
  1383. Revision 1.18 2002/10/22 13:43:01 mazen
  1384. - cga.pas redueced to an empty unit
  1385. Revision 1.17 2002/10/20 19:01:38 mazen
  1386. + op_raddr_reg and op_caddr_reg added to fix functions prologue
  1387. Revision 1.16 2002/10/13 21:46:07 mazen
  1388. * assembler output format fixed
  1389. Revision 1.15 2002/10/11 13:35:14 mazen
  1390. *** empty log message ***
  1391. Revision 1.14 2002/10/10 19:57:51 mazen
  1392. * Just to update repsitory
  1393. Revision 1.13 2002/10/10 15:10:39 mazen
  1394. * Internal error fixed, but usually i386 parameter model used
  1395. Revision 1.12 2002/10/08 17:17:03 mazen
  1396. *** empty log message ***
  1397. Revision 1.11 2002/10/07 20:33:04 mazen
  1398. word alignement modified in g_stack_frame
  1399. Revision 1.10 2002/10/04 21:57:42 mazen
  1400. * register allocation for parameters now done in cpupara, but InternalError(200109223) in cgcpu.pas:1053 is still not fixed du to location_force problem in ncgutils.pas:419
  1401. Revision 1.9 2002/10/02 22:20:28 mazen
  1402. + out registers allocator for the first 6 scalar parameters which must be passed into %o0..%o5
  1403. Revision 1.8 2002/10/01 21:35:58 mazen
  1404. + procedures exiting prologue added and stack frame now restored in the delay slot of the return (JMPL) instruction
  1405. Revision 1.7 2002/10/01 21:06:29 mazen
  1406. attinst.inc --> strinst.inc
  1407. Revision 1.6 2002/10/01 17:41:50 florian
  1408. * fixed log and id
  1409. }