n386util.pas 64 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 by Florian Klaempfl
  4. Helper routines for the i386 code generator
  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 n386util;
  19. {$i defines.inc}
  20. interface
  21. uses
  22. symtype,node;
  23. function maybe_push(needed : byte;p : tnode;isint64 : boolean) : boolean;
  24. {$ifdef TEMPS_NOT_PUSH}
  25. function maybe_savetotemp(needed : byte;p : tnode;isint64 : boolean) : boolean;
  26. {$endif TEMPS_NOT_PUSH}
  27. procedure restore(p : tnode;isint64 : boolean);
  28. {$ifdef TEMPS_NOT_PUSH}
  29. procedure restorefromtemp(p : tnode;isint64 : boolean);
  30. {$endif TEMPS_NOT_PUSH}
  31. procedure pushsetelement(p : tnode);
  32. procedure push_value_para(p:tnode;inlined,is_cdecl:boolean;
  33. para_offset:longint;alignment : longint);
  34. procedure loadshortstring(source,dest : tnode);
  35. procedure loadlongstring(p:tbinarynode);
  36. procedure loadansi2short(source,dest : tnode);
  37. procedure loadwide2short(source,dest : tnode);
  38. procedure loadinterfacecom(p: tbinarynode);
  39. procedure maketojumpbool(p : tnode);
  40. procedure emitoverflowcheck(p:tnode);
  41. procedure emitrangecheck(p:tnode;todef:tdef);
  42. procedure firstcomplex(p : tbinarynode);
  43. implementation
  44. uses
  45. globtype,globals,systems,verbose,
  46. cutils,
  47. aasm,cpubase,cpuasm,
  48. symconst,symbase,symdef,symsym,symtable,
  49. {$ifdef GDB}
  50. gdb,
  51. {$endif GDB}
  52. types,
  53. ncon,nld,
  54. pass_1,pass_2,
  55. hcodegen,tgcpu,temp_gen,
  56. cgai386,regvars;
  57. {*****************************************************************************
  58. Emit Push Functions
  59. *****************************************************************************}
  60. function maybe_push(needed : byte;p : tnode;isint64 : boolean) : boolean;
  61. var
  62. pushed : boolean;
  63. {hregister : tregister; }
  64. {$ifdef TEMPS_NOT_PUSH}
  65. href : treference;
  66. {$endif TEMPS_NOT_PUSH}
  67. begin
  68. if p.location.loc = LOC_CREGISTER then
  69. begin
  70. maybe_push := true;
  71. exit;
  72. end;
  73. if needed>usablereg32 then
  74. begin
  75. if (p.location.loc=LOC_REGISTER) then
  76. begin
  77. if isint64 then
  78. begin
  79. {$ifdef TEMPS_NOT_PUSH}
  80. gettempofsizereference(href,8);
  81. p.temp_offset:=href.offset;
  82. href.offset:=href.offset+4;
  83. exprasmList.concat(Taicpu.Op_reg(A_MOV,S_L,p.location.registerhigh,href));
  84. href.offset:=href.offset-4;
  85. {$else TEMPS_NOT_PUSH}
  86. exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,p.location.registerhigh));
  87. {$endif TEMPS_NOT_PUSH}
  88. ungetregister32(p.location.registerhigh);
  89. end
  90. {$ifdef TEMPS_NOT_PUSH}
  91. else
  92. begin
  93. gettempofsizereference(href,4);
  94. p.temp_offset:=href.offset;
  95. end
  96. {$endif TEMPS_NOT_PUSH}
  97. ;
  98. pushed:=true;
  99. {$ifdef TEMPS_NOT_PUSH}
  100. exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,p.location.register,href));
  101. {$else TEMPS_NOT_PUSH}
  102. exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,p.location.register));
  103. {$endif TEMPS_NOT_PUSH}
  104. ungetregister32(p.location.register);
  105. end
  106. else if (p.location.loc in [LOC_MEM,LOC_REFERENCE]) and
  107. ((p.location.reference.base<>R_NO) or
  108. (p.location.reference.index<>R_NO)
  109. ) then
  110. begin
  111. del_reference(p.location.reference);
  112. getexplicitregister32(R_EDI);
  113. emit_ref_reg(A_LEA,S_L,newreference(p.location.reference),R_EDI);
  114. {$ifdef TEMPS_NOT_PUSH}
  115. gettempofsizereference(href,4);
  116. exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,href));
  117. p.temp_offset:=href.offset;
  118. {$else TEMPS_NOT_PUSH}
  119. exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,R_EDI));
  120. {$endif TEMPS_NOT_PUSH}
  121. ungetregister32(R_EDI);
  122. pushed:=true;
  123. end
  124. else pushed:=false;
  125. end
  126. else pushed:=false;
  127. maybe_push:=pushed;
  128. end;
  129. {$ifdef TEMPS_NOT_PUSH}
  130. function maybe_savetotemp(needed : byte;p : tnode;isint64 : boolean) : boolean;
  131. var
  132. pushed : boolean;
  133. href : treference;
  134. begin
  135. if needed>usablereg32 then
  136. begin
  137. if (p^.location.loc=LOC_REGISTER) then
  138. begin
  139. if isint64(p^.resulttype.def) then
  140. begin
  141. gettempofsizereference(href,8);
  142. p^.temp_offset:=href.offset;
  143. href.offset:=href.offset+4;
  144. exprasmList.concat(Taicpu.Op_reg(A_MOV,S_L,p^.location.registerhigh,href));
  145. href.offset:=href.offset-4;
  146. ungetregister32(p^.location.registerhigh);
  147. end
  148. else
  149. begin
  150. gettempofsizereference(href,4);
  151. p^.temp_offset:=href.offset;
  152. end;
  153. pushed:=true;
  154. exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,p^.location.register,href));
  155. ungetregister32(p^.location.register);
  156. end
  157. else if (p^.location.loc in [LOC_MEM,LOC_REFERENCE]) and
  158. ((p^.location.reference.base<>R_NO) or
  159. (p^.location.reference.index<>R_NO)
  160. ) then
  161. begin
  162. del_reference(p^.location.reference);
  163. getexplicitregister32(R_EDI);
  164. emit_ref_reg(A_LEA,S_L,newreference(p^.location.reference),
  165. R_EDI);
  166. gettempofsizereference(href,4);
  167. exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,href));
  168. ungetregister32(R_EDI);
  169. p^.temp_offset:=href.offset;
  170. pushed:=true;
  171. end
  172. else pushed:=false;
  173. end
  174. else pushed:=false;
  175. maybe_push:=pushed;
  176. end;
  177. {$endif TEMPS_NOT_PUSH}
  178. procedure restore(p : tnode;isint64 : boolean);
  179. var
  180. hregister : tregister;
  181. {$ifdef TEMPS_NOT_PUSH}
  182. href : treference;
  183. {$endif TEMPS_NOT_PUSH}
  184. begin
  185. if p.location.loc = LOC_CREGISTER then
  186. begin
  187. load_regvar_reg(exprasmlist,p.location.register);
  188. exit;
  189. end;
  190. hregister:=getregister32;
  191. {$ifdef TEMPS_NOT_PUSH}
  192. reset_reference(href);
  193. href.base:=procinfo^.frame_pointer;
  194. href.offset:=p.temp_offset;
  195. emit_ref_reg(A_MOV,S_L,href,hregister);
  196. {$else TEMPS_NOT_PUSH}
  197. exprasmList.concat(Taicpu.Op_reg(A_POP,S_L,hregister));
  198. {$endif TEMPS_NOT_PUSH}
  199. if (p.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  200. begin
  201. p.location.register:=hregister;
  202. if isint64 then
  203. begin
  204. p.location.registerhigh:=getregister32;
  205. {$ifdef TEMPS_NOT_PUSH}
  206. href.offset:=p.temp_offset+4;
  207. emit_ref_reg(A_MOV,S_L,p.location.registerhigh);
  208. { set correctly for release ! }
  209. href.offset:=p.temp_offset;
  210. {$else TEMPS_NOT_PUSH}
  211. exprasmList.concat(Taicpu.Op_reg(A_POP,S_L,p.location.registerhigh));
  212. {$endif TEMPS_NOT_PUSH}
  213. end;
  214. end
  215. else
  216. begin
  217. reset_reference(p.location.reference);
  218. { any reasons why this was moved into the index register ? }
  219. { normally usage of base register is much better (FK) }
  220. p.location.reference.base:=hregister;
  221. { Why is this done? We can never be sure about p.left
  222. because otherwise secondload fails !!!
  223. set_location(p.left^.location,p.location);}
  224. end;
  225. {$ifdef TEMPS_NOT_PUSH}
  226. ungetiftemp(href);
  227. {$endif TEMPS_NOT_PUSH}
  228. end;
  229. {$ifdef TEMPS_NOT_PUSH}
  230. procedure restorefromtemp(p : tnode;isint64 : boolean);
  231. var
  232. hregister : tregister;
  233. href : treference;
  234. begin
  235. hregister:=getregister32;
  236. reset_reference(href);
  237. href.base:=procinfo^.frame_pointer;
  238. href.offset:=p.temp_offset;
  239. emit_ref_reg(A_MOV,S_L,href,hregister);
  240. if (p.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  241. begin
  242. p.location.register:=hregister;
  243. if isint64 then
  244. begin
  245. p.location.registerhigh:=getregister32;
  246. href.offset:=p.temp_offset+4;
  247. emit_ref_reg(A_MOV,S_L,p.location.registerhigh);
  248. { set correctly for release ! }
  249. href.offset:=p.temp_offset;
  250. end;
  251. end
  252. else
  253. begin
  254. reset_reference(p.location.reference);
  255. p.location.reference.base:=hregister;
  256. { Why is this done? We can never be sure about p^.left
  257. because otherwise secondload fails PM
  258. set_location(p^.left^.location,p^.location);}
  259. end;
  260. ungetiftemp(href);
  261. end;
  262. {$endif TEMPS_NOT_PUSH}
  263. procedure pushsetelement(p : tnode);
  264. var
  265. hr,hr16,hr32 : tregister;
  266. begin
  267. { copy the element on the stack, slightly complicated }
  268. if p.nodetype=ordconstn then
  269. begin
  270. if aktalignment.paraalign=4 then
  271. exprasmList.concat(Taicpu.Op_const(A_PUSH,S_L,tordconstnode(p).value))
  272. else
  273. exprasmList.concat(Taicpu.Op_const(A_PUSH,S_W,tordconstnode(p).value));
  274. end
  275. else
  276. begin
  277. case p.location.loc of
  278. LOC_REGISTER,
  279. LOC_CREGISTER :
  280. begin
  281. hr:=p.location.register;
  282. case hr of
  283. R_EAX,R_EBX,R_ECX,R_EDX,R_EDI,R_ESI,R_ESP :
  284. begin
  285. hr16:=reg32toreg16(hr);
  286. hr32:=hr;
  287. end;
  288. R_AX,R_BX,R_CX,R_DX,R_DI,R_SI,R_SP :
  289. begin
  290. hr16:=hr;
  291. hr32:=reg16toreg32(hr);
  292. end;
  293. R_AL,R_BL,R_CL,R_DL :
  294. begin
  295. hr16:=reg8toreg16(hr);
  296. hr32:=reg8toreg32(hr);
  297. end;
  298. end;
  299. if aktalignment.paraalign=4 then
  300. exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,hr32))
  301. else
  302. exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_W,hr16));
  303. ungetregister32(hr32);
  304. end;
  305. else
  306. begin
  307. { you can't push more bytes than the size of the element, }
  308. { because this may cross a page boundary and you'll get a }
  309. { sigsegv (JM) }
  310. emit_push_mem_size(p.location.reference,1);
  311. del_reference(p.location.reference);
  312. end;
  313. end;
  314. end;
  315. end;
  316. procedure push_value_para(p:tnode;inlined,is_cdecl:boolean;
  317. para_offset:longint;alignment : longint);
  318. var
  319. tempreference : treference;
  320. r : preference;
  321. opsize : topsize;
  322. op : tasmop;
  323. hreg : tregister;
  324. size : longint;
  325. hlabel : tasmlabel;
  326. begin
  327. case p.location.loc of
  328. LOC_REGISTER,
  329. LOC_CREGISTER:
  330. begin
  331. if p.resulttype.def.size=8 then
  332. begin
  333. inc(pushedparasize,8);
  334. if inlined then
  335. begin
  336. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  337. exprasmlist.concat(taicpu.op_reg_ref(A_MOV,S_L,p.location.registerlow,r));
  338. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize+4);
  339. exprasmlist.concat(taicpu.op_reg_ref(A_MOV,S_L,p.location.registerhigh,r));
  340. end
  341. else
  342. begin
  343. exprasmlist.concat(taicpu.op_reg(A_PUSH,S_L,p.location.registerhigh));
  344. exprasmlist.concat(taicpu.op_reg(A_PUSH,S_L,p.location.registerlow));
  345. end;
  346. ungetregister32(p.location.registerhigh);
  347. ungetregister32(p.location.registerlow);
  348. end
  349. else case p.location.register of
  350. R_EAX,R_EBX,R_ECX,R_EDX,R_ESI,
  351. R_EDI,R_ESP,R_EBP :
  352. begin
  353. inc(pushedparasize,4);
  354. if inlined then
  355. begin
  356. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  357. exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,p.location.register,r));
  358. end
  359. else
  360. exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,p.location.register));
  361. ungetregister32(p.location.register);
  362. end;
  363. R_AX,R_BX,R_CX,R_DX,R_SI,R_DI:
  364. begin
  365. if alignment=4 then
  366. begin
  367. opsize:=S_L;
  368. hreg:=reg16toreg32(p.location.register);
  369. inc(pushedparasize,4);
  370. end
  371. else
  372. begin
  373. opsize:=S_W;
  374. hreg:=p.location.register;
  375. inc(pushedparasize,2);
  376. end;
  377. if inlined then
  378. begin
  379. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  380. exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,opsize,hreg,r));
  381. end
  382. else
  383. exprasmList.concat(Taicpu.Op_reg(A_PUSH,opsize,hreg));
  384. ungetregister32(reg16toreg32(p.location.register));
  385. end;
  386. R_AL,R_BL,R_CL,R_DL:
  387. begin
  388. if alignment=4 then
  389. begin
  390. opsize:=S_L;
  391. hreg:=reg8toreg32(p.location.register);
  392. inc(pushedparasize,4);
  393. end
  394. else
  395. begin
  396. opsize:=S_W;
  397. hreg:=reg8toreg16(p.location.register);
  398. inc(pushedparasize,2);
  399. end;
  400. { we must push always 16 bit }
  401. if inlined then
  402. begin
  403. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  404. exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,opsize,hreg,r));
  405. end
  406. else
  407. exprasmList.concat(Taicpu.Op_reg(A_PUSH,opsize,hreg));
  408. ungetregister32(reg8toreg32(p.location.register));
  409. end;
  410. else internalerror(1899);
  411. end;
  412. end;
  413. LOC_FPU:
  414. begin
  415. size:=align(tfloatdef(p.resulttype.def).size,alignment);
  416. inc(pushedparasize,size);
  417. if not inlined then
  418. emit_const_reg(A_SUB,S_L,size,R_ESP);
  419. {$ifdef GDB}
  420. if (cs_debuginfo in aktmoduleswitches) and
  421. (exprasmList.first=exprasmList.last) then
  422. exprasmList.concat(Tai_force_line.Create);
  423. {$endif GDB}
  424. r:=new_reference(R_ESP,0);
  425. floatstoreops(tfloatdef(p.resulttype.def).typ,op,opsize);
  426. { this is the easiest case for inlined !! }
  427. if inlined then
  428. begin
  429. r^.base:=procinfo^.framepointer;
  430. r^.offset:=para_offset-pushedparasize;
  431. end;
  432. exprasmList.concat(Taicpu.Op_ref(op,opsize,r));
  433. dec(fpuvaroffset);
  434. end;
  435. LOC_CFPUREGISTER:
  436. begin
  437. exprasmList.concat(Taicpu.Op_reg(A_FLD,S_NO,
  438. correct_fpuregister(p.location.register,fpuvaroffset)));
  439. size:=align(tfloatdef(p.resulttype.def).size,alignment);
  440. inc(pushedparasize,size);
  441. if not inlined then
  442. emit_const_reg(A_SUB,S_L,size,R_ESP);
  443. {$ifdef GDB}
  444. if (cs_debuginfo in aktmoduleswitches) and
  445. (exprasmList.first=exprasmList.last) then
  446. exprasmList.concat(Tai_force_line.Create);
  447. {$endif GDB}
  448. r:=new_reference(R_ESP,0);
  449. floatstoreops(tfloatdef(p.resulttype.def).typ,op,opsize);
  450. { this is the easiest case for inlined !! }
  451. if inlined then
  452. begin
  453. r^.base:=procinfo^.framepointer;
  454. r^.offset:=para_offset-pushedparasize;
  455. end;
  456. exprasmList.concat(Taicpu.Op_ref(op,opsize,r));
  457. end;
  458. LOC_REFERENCE,LOC_MEM:
  459. begin
  460. tempreference:=p.location.reference;
  461. del_reference(p.location.reference);
  462. case p.resulttype.def.deftype of
  463. enumdef,
  464. orddef :
  465. begin
  466. case p.resulttype.def.size of
  467. 8 : begin
  468. inc(pushedparasize,8);
  469. if inlined then
  470. begin
  471. getexplicitregister32(R_EDI);
  472. emit_ref_reg(A_MOV,S_L,
  473. newreference(tempreference),R_EDI);
  474. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  475. exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
  476. ungetregister32(R_EDI);
  477. getexplicitregister32(R_EDI);
  478. inc(tempreference.offset,4);
  479. emit_ref_reg(A_MOV,S_L,
  480. newreference(tempreference),R_EDI);
  481. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize+4);
  482. exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
  483. ungetregister32(R_EDI);
  484. end
  485. else
  486. begin
  487. inc(tempreference.offset,4);
  488. emit_push_mem(tempreference);
  489. dec(tempreference.offset,4);
  490. emit_push_mem(tempreference);
  491. end;
  492. end;
  493. 4 : begin
  494. inc(pushedparasize,4);
  495. if inlined then
  496. begin
  497. getexplicitregister32(R_EDI);
  498. emit_ref_reg(A_MOV,S_L,
  499. newreference(tempreference),R_EDI);
  500. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  501. exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
  502. ungetregister32(R_EDI);
  503. end
  504. else
  505. emit_push_mem(tempreference);
  506. end;
  507. 1,2 : begin
  508. if alignment=4 then
  509. begin
  510. opsize:=S_L;
  511. hreg:=R_EDI;
  512. inc(pushedparasize,4);
  513. end
  514. else
  515. begin
  516. opsize:=S_W;
  517. hreg:=R_DI;
  518. inc(pushedparasize,2);
  519. end;
  520. if inlined then
  521. begin
  522. getexplicitregister32(R_EDI);
  523. emit_ref_reg(A_MOV,opsize,
  524. newreference(tempreference),hreg);
  525. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  526. exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,opsize,hreg,r));
  527. ungetregister32(R_EDI);
  528. end
  529. else
  530. emit_push_mem_size(tempreference,p.resulttype.def.size);
  531. end;
  532. else
  533. internalerror(234231);
  534. end;
  535. end;
  536. floatdef :
  537. begin
  538. case tfloatdef(p.resulttype.def).typ of
  539. s32real :
  540. begin
  541. inc(pushedparasize,4);
  542. if inlined then
  543. begin
  544. getexplicitregister32(R_EDI);
  545. emit_ref_reg(A_MOV,S_L,
  546. newreference(tempreference),R_EDI);
  547. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  548. exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
  549. ungetregister32(R_EDI);
  550. end
  551. else
  552. emit_push_mem(tempreference);
  553. end;
  554. s64real,
  555. s64comp :
  556. begin
  557. inc(pushedparasize,4);
  558. inc(tempreference.offset,4);
  559. if inlined then
  560. begin
  561. getexplicitregister32(R_EDI);
  562. emit_ref_reg(A_MOV,S_L,
  563. newreference(tempreference),R_EDI);
  564. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  565. exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
  566. ungetregister32(R_EDI);
  567. end
  568. else
  569. emit_push_mem(tempreference);
  570. inc(pushedparasize,4);
  571. dec(tempreference.offset,4);
  572. if inlined then
  573. begin
  574. getexplicitregister32(R_EDI);
  575. emit_ref_reg(A_MOV,S_L,
  576. newreference(tempreference),R_EDI);
  577. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  578. exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
  579. ungetregister32(R_EDI);
  580. end
  581. else
  582. emit_push_mem(tempreference);
  583. end;
  584. s80real :
  585. begin
  586. inc(pushedparasize,4);
  587. if alignment=4 then
  588. inc(tempreference.offset,8)
  589. else
  590. inc(tempreference.offset,6);
  591. if inlined then
  592. begin
  593. getexplicitregister32(R_EDI);
  594. emit_ref_reg(A_MOV,S_L,
  595. newreference(tempreference),R_EDI);
  596. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  597. exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
  598. ungetregister32(R_EDI);
  599. end
  600. else
  601. emit_push_mem(tempreference);
  602. dec(tempreference.offset,4);
  603. inc(pushedparasize,4);
  604. if inlined then
  605. begin
  606. getexplicitregister32(R_EDI);
  607. emit_ref_reg(A_MOV,S_L,
  608. newreference(tempreference),R_EDI);
  609. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  610. exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
  611. ungetregister32(R_EDI);
  612. end
  613. else
  614. emit_push_mem(tempreference);
  615. if alignment=4 then
  616. begin
  617. opsize:=S_L;
  618. hreg:=R_EDI;
  619. inc(pushedparasize,4);
  620. dec(tempreference.offset,4);
  621. end
  622. else
  623. begin
  624. opsize:=S_W;
  625. hreg:=R_DI;
  626. inc(pushedparasize,2);
  627. dec(tempreference.offset,2);
  628. end;
  629. if inlined then
  630. begin
  631. getexplicitregister32(R_EDI);
  632. emit_ref_reg(A_MOV,opsize,
  633. newreference(tempreference),hreg);
  634. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  635. exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,opsize,hreg,r));
  636. ungetregister32(R_EDI);
  637. end
  638. else
  639. exprasmList.concat(Taicpu.Op_ref(A_PUSH,opsize,
  640. newreference(tempreference)));
  641. end;
  642. end;
  643. end;
  644. pointerdef,
  645. procvardef,
  646. classrefdef:
  647. begin
  648. inc(pushedparasize,4);
  649. if inlined then
  650. begin
  651. getexplicitregister32(R_EDI);
  652. emit_ref_reg(A_MOV,S_L,
  653. newreference(tempreference),R_EDI);
  654. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  655. exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
  656. ungetregister32(R_EDI);
  657. end
  658. else
  659. emit_push_mem(tempreference);
  660. end;
  661. arraydef,
  662. recorddef,
  663. stringdef,
  664. setdef,
  665. objectdef :
  666. begin
  667. { even some structured types are 32 bit }
  668. if is_widestring(p.resulttype.def) or
  669. is_ansistring(p.resulttype.def) or
  670. is_smallset(p.resulttype.def) or
  671. ((p.resulttype.def.deftype in [recorddef,arraydef]) and
  672. (
  673. (p.resulttype.def.deftype<>arraydef) or not
  674. (tarraydef(p.resulttype.def).IsConstructor or
  675. tarraydef(p.resulttype.def).isArrayOfConst or
  676. is_open_array(p.resulttype.def))
  677. ) and
  678. (p.resulttype.def.size<=4)
  679. ) or
  680. is_class(p.resulttype.def) or
  681. is_interface(p.resulttype.def) then
  682. begin
  683. if (p.resulttype.def.size>2) or
  684. ((alignment=4) and (p.resulttype.def.size>0)) then
  685. begin
  686. inc(pushedparasize,4);
  687. if inlined then
  688. begin
  689. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  690. concatcopy(tempreference,r^,4,false,false);
  691. end
  692. else
  693. emit_push_mem(tempreference);
  694. end
  695. else
  696. begin
  697. if p.resulttype.def.size>0 then
  698. begin
  699. inc(pushedparasize,2);
  700. if inlined then
  701. begin
  702. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  703. concatcopy(tempreference,r^,2,false,false);
  704. end
  705. else
  706. exprasmList.concat(Taicpu.Op_ref(A_PUSH,S_W,newreference(tempreference)));
  707. end;
  708. end;
  709. end
  710. { call by value open array ? }
  711. else if is_cdecl then
  712. begin
  713. { push on stack }
  714. size:=align(p.resulttype.def.size,alignment);
  715. inc(pushedparasize,size);
  716. emit_const_reg(A_SUB,S_L,size,R_ESP);
  717. r:=new_reference(R_ESP,0);
  718. concatcopy(tempreference,r^,size,false,false);
  719. end
  720. else
  721. internalerror(8954);
  722. end;
  723. else
  724. CGMessage(cg_e_illegal_expression);
  725. end;
  726. end;
  727. LOC_JUMP:
  728. begin
  729. getlabel(hlabel);
  730. if alignment=4 then
  731. begin
  732. opsize:=S_L;
  733. inc(pushedparasize,4);
  734. end
  735. else
  736. begin
  737. opsize:=S_W;
  738. inc(pushedparasize,2);
  739. end;
  740. emitlab(truelabel);
  741. if inlined then
  742. begin
  743. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  744. emit_const_ref(A_MOV,opsize,1,r);
  745. end
  746. else
  747. exprasmList.concat(Taicpu.Op_const(A_PUSH,opsize,1));
  748. emitjmp(C_None,hlabel);
  749. emitlab(falselabel);
  750. if inlined then
  751. begin
  752. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  753. emit_const_ref(A_MOV,opsize,0,r);
  754. end
  755. else
  756. exprasmList.concat(Taicpu.Op_const(A_PUSH,opsize,0));
  757. emitlab(hlabel);
  758. end;
  759. LOC_FLAGS:
  760. begin
  761. if not(R_EAX in unused) then
  762. begin
  763. getexplicitregister32(R_EDI);
  764. emit_reg_reg(A_MOV,S_L,R_EAX,R_EDI);
  765. end;
  766. emit_flag2reg(p.location.resflags,R_AL);
  767. emit_reg_reg(A_MOVZX,S_BW,R_AL,R_AX);
  768. if alignment=4 then
  769. begin
  770. opsize:=S_L;
  771. hreg:=R_EAX;
  772. inc(pushedparasize,4);
  773. end
  774. else
  775. begin
  776. opsize:=S_W;
  777. hreg:=R_AX;
  778. inc(pushedparasize,2);
  779. end;
  780. if inlined then
  781. begin
  782. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  783. exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,opsize,hreg,r));
  784. end
  785. else
  786. exprasmList.concat(Taicpu.Op_reg(A_PUSH,opsize,hreg));
  787. if not(R_EAX in unused) then
  788. begin
  789. emit_reg_reg(A_MOV,S_L,R_EDI,R_EAX);
  790. ungetregister32(R_EDI);
  791. end;
  792. end;
  793. {$ifdef SUPPORT_MMX}
  794. LOC_MMXREGISTER,
  795. LOC_CMMXREGISTER:
  796. begin
  797. inc(pushedparasize,8); { was missing !!! (PM) }
  798. emit_const_reg(
  799. A_SUB,S_L,8,R_ESP);
  800. {$ifdef GDB}
  801. if (cs_debuginfo in aktmoduleswitches) and
  802. (exprasmList.first=exprasmList.last) then
  803. exprasmList.concat(Tai_force_line.Create);
  804. {$endif GDB}
  805. if inlined then
  806. begin
  807. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  808. exprasmList.concat(Taicpu.Op_reg_ref(A_MOVQ,S_NO,
  809. p.location.register,r));
  810. end
  811. else
  812. begin
  813. r:=new_reference(R_ESP,0);
  814. exprasmList.concat(Taicpu.Op_reg_ref(
  815. A_MOVQ,S_NO,p.location.register,r));
  816. end;
  817. end;
  818. {$endif SUPPORT_MMX}
  819. end;
  820. end;
  821. {*****************************************************************************
  822. Emit Functions
  823. *****************************************************************************}
  824. procedure maketojumpbool(p : tnode);
  825. {
  826. produces jumps to true respectively false labels using boolean expressions
  827. }
  828. var
  829. opsize : topsize;
  830. storepos : tfileposinfo;
  831. begin
  832. if nf_error in p.flags then
  833. exit;
  834. storepos:=aktfilepos;
  835. aktfilepos:=p.fileinfo;
  836. if is_boolean(p.resulttype.def) then
  837. begin
  838. load_all_regvars(exprasmlist);
  839. if is_constboolnode(p) then
  840. begin
  841. if tordconstnode(p).value<>0 then
  842. emitjmp(C_None,truelabel)
  843. else
  844. emitjmp(C_None,falselabel);
  845. end
  846. else
  847. begin
  848. opsize:=def_opsize(p.resulttype.def);
  849. case p.location.loc of
  850. LOC_CREGISTER,LOC_REGISTER : begin
  851. emit_reg_reg(A_OR,opsize,p.location.register,
  852. p.location.register);
  853. ungetregister(p.location.register);
  854. emitjmp(C_NZ,truelabel);
  855. emitjmp(C_None,falselabel);
  856. end;
  857. LOC_MEM,LOC_REFERENCE : begin
  858. emit_const_ref(
  859. A_CMP,opsize,0,newreference(p.location.reference));
  860. del_reference(p.location.reference);
  861. emitjmp(C_NZ,truelabel);
  862. emitjmp(C_None,falselabel);
  863. end;
  864. LOC_FLAGS : begin
  865. emitjmp(flag_2_cond[p.location.resflags],truelabel);
  866. emitjmp(C_None,falselabel);
  867. end;
  868. end;
  869. end;
  870. end
  871. else
  872. CGMessage(type_e_mismatch);
  873. aktfilepos:=storepos;
  874. end;
  875. { produces if necessary overflowcode }
  876. procedure emitoverflowcheck(p:tnode);
  877. var
  878. hl : tasmlabel;
  879. begin
  880. if not(cs_check_overflow in aktlocalswitches) then
  881. exit;
  882. getlabel(hl);
  883. if not ((p.resulttype.def.deftype=pointerdef) or
  884. ((p.resulttype.def.deftype=orddef) and
  885. (torddef(p.resulttype.def).typ in [u64bit,u16bit,u32bit,u8bit,uchar,
  886. bool8bit,bool16bit,bool32bit]))) then
  887. emitjmp(C_NO,hl)
  888. else
  889. emitjmp(C_NB,hl);
  890. emitcall('FPC_OVERFLOW');
  891. emitlab(hl);
  892. end;
  893. { produces range check code, while one of the operands is a 64 bit
  894. integer }
  895. procedure emitrangecheck64(p : tnode;todef : tdef);
  896. var
  897. neglabel,
  898. poslabel,
  899. endlabel: tasmlabel;
  900. href : preference;
  901. hreg : tregister;
  902. hdef : torddef;
  903. fromdef : tdef;
  904. opcode : tasmop;
  905. opsize : topsize;
  906. oldregisterdef: boolean;
  907. from_signed,to_signed: boolean;
  908. begin
  909. fromdef:=p.resulttype.def;
  910. from_signed := is_signed(fromdef);
  911. to_signed := is_signed(todef);
  912. if not is_64bitint(todef) then
  913. begin
  914. oldregisterdef := registerdef;
  915. registerdef := false;
  916. { get the high dword in a register }
  917. if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  918. hreg := p.location.registerhigh
  919. else
  920. begin
  921. hreg := getexplicitregister32(R_EDI);
  922. href := newreference(p.location.reference);
  923. inc(href^.offset,4);
  924. emit_ref_reg(A_MOV,S_L,href,hreg);
  925. end;
  926. getlabel(poslabel);
  927. { check high dword, must be 0 (for positive numbers) }
  928. emit_reg_reg(A_TEST,S_L,hreg,hreg);
  929. emitjmp(C_E,poslabel);
  930. { It can also be $ffffffff, but only for negative numbers }
  931. if from_signed and to_signed then
  932. begin
  933. getlabel(neglabel);
  934. emit_const_reg(A_CMP,S_L,longint($ffffffff),hreg);
  935. emitjmp(C_E,neglabel);
  936. end;
  937. if hreg = R_EDI then
  938. ungetregister32(hreg);
  939. { For all other values we have a range check error }
  940. emitcall('FPC_RANGEERROR');
  941. { if the high dword = 0, the low dword can be considered a }
  942. { simple cardinal }
  943. emitlab(poslabel);
  944. hdef:=torddef.create(u32bit,0,longint($ffffffff));
  945. { the real p.resulttype.def is already saved in fromdef }
  946. p.resulttype.def := hdef;
  947. emitrangecheck(p,todef);
  948. hdef.free;
  949. { restore original resulttype.def }
  950. p.resulttype.def := todef;
  951. if from_signed and to_signed then
  952. begin
  953. getlabel(endlabel);
  954. emitjmp(C_None,endlabel);
  955. { if the high dword = $ffffffff, then the low dword (when }
  956. { considered as a longint) must be < 0 }
  957. emitlab(neglabel);
  958. if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  959. hreg := p.location.registerlow
  960. else
  961. begin
  962. hreg := getexplicitregister32(R_EDI);
  963. emit_ref_reg(A_MOV,S_L,
  964. newreference(p.location.reference),hreg);
  965. end;
  966. { get a new neglabel (JM) }
  967. getlabel(neglabel);
  968. emit_reg_reg(A_TEST,S_L,hreg,hreg);
  969. if hreg = R_EDI then
  970. ungetregister32(hreg);
  971. emitjmp(C_L,neglabel);
  972. emitcall('FPC_RANGEERROR');
  973. { if we get here, the 64bit value lies between }
  974. { longint($80000000) and -1 (JM) }
  975. emitlab(neglabel);
  976. hdef:=torddef.create(s32bit,longint($80000000),-1);
  977. p.resulttype.def := hdef;
  978. emitrangecheck(p,todef);
  979. hdef.free;
  980. emitlab(endlabel);
  981. end;
  982. registerdef := oldregisterdef;
  983. p.resulttype.def := fromdef;
  984. { restore p's resulttype.def }
  985. end
  986. else
  987. { todef = 64bit int }
  988. { no 64bit subranges supported, so only a small check is necessary }
  989. { if both are signed or both are unsigned, no problem! }
  990. if (from_signed xor to_signed) and
  991. { also not if the fromdef is unsigned and < 64bit, since that will }
  992. { always fit in a 64bit int (todef is 64bit) }
  993. (from_signed or
  994. (torddef(fromdef).typ = u64bit)) then
  995. begin
  996. { in all cases, there is only a problem if the higest bit is set }
  997. if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  998. if is_64bitint(fromdef) then
  999. hreg := p.location.registerhigh
  1000. else
  1001. hreg := p.location.register
  1002. else
  1003. begin
  1004. hreg := getexplicitregister32(R_EDI);
  1005. case p.resulttype.def.size of
  1006. 1: opsize := S_BL;
  1007. 2: opsize := S_WL;
  1008. 4,8: opsize := S_L;
  1009. end;
  1010. if opsize in [S_BL,S_WL] then
  1011. if from_signed then
  1012. opcode := A_MOVSX
  1013. else opcode := A_MOVZX
  1014. else
  1015. opcode := A_MOV;
  1016. href := newreference(p.location.reference);
  1017. if p.resulttype.def.size = 8 then
  1018. inc(href^.offset,4);
  1019. emit_ref_reg(opcode,opsize,href,hreg);
  1020. end;
  1021. getlabel(poslabel);
  1022. emit_reg_reg(A_TEST,regsize(hreg),hreg,hreg);
  1023. if hreg = R_EDI then
  1024. ungetregister32(hreg);
  1025. emitjmp(C_GE,poslabel);
  1026. emitcall('FPC_RANGEERROR');
  1027. emitlab(poslabel);
  1028. end;
  1029. end;
  1030. { produces if necessary rangecheckcode }
  1031. procedure emitrangecheck(p:tnode;todef:tdef);
  1032. {
  1033. generate range checking code for the value at location t. The
  1034. type used is the checked against todefs ranges. fromdef (p.resulttype.def)
  1035. is the original type used at that location, when both defs are
  1036. equal the check is also insert (needed for succ,pref,inc,dec)
  1037. }
  1038. var
  1039. neglabel : tasmlabel;
  1040. opsize : topsize;
  1041. op : tasmop;
  1042. fromdef : tdef;
  1043. lto,hto,
  1044. lfrom,hfrom : longint;
  1045. is_reg : boolean;
  1046. begin
  1047. { range checking on and range checkable value? }
  1048. if not(cs_check_range in aktlocalswitches) or
  1049. not(todef.deftype in [orddef,enumdef,arraydef]) then
  1050. exit;
  1051. { only check when assigning to scalar, subranges are different,
  1052. when todef=fromdef then the check is always generated }
  1053. fromdef:=p.resulttype.def;
  1054. { no range check if from and to are equal and are both longint/dword or }
  1055. { int64/qword, since such operations can at most cause overflows (JM) }
  1056. if (fromdef = todef) and
  1057. { then fromdef and todef can only be orddefs }
  1058. (((torddef(fromdef).typ = s32bit) and
  1059. (torddef(fromdef).low = longint($80000000)) and
  1060. (torddef(fromdef).high = $7fffffff)) or
  1061. ((torddef(fromdef).typ = u32bit) and
  1062. (torddef(fromdef).low = 0) and
  1063. (torddef(fromdef).high = longint($ffffffff))) or
  1064. is_64bitint(fromdef)) then
  1065. exit;
  1066. if is_64bitint(fromdef) or is_64bitint(todef) then
  1067. begin
  1068. emitrangecheck64(p,todef);
  1069. exit;
  1070. end;
  1071. {we also need lto and hto when checking if we need to use doublebound!
  1072. (JM)}
  1073. getrange(todef,lto,hto);
  1074. if todef<>fromdef then
  1075. begin
  1076. getrange(p.resulttype.def,lfrom,hfrom);
  1077. { first check for not being u32bit, then if the to is bigger than
  1078. from }
  1079. if (lto<hto) and (lfrom<hfrom) and
  1080. (lto<=lfrom) and (hto>=hfrom) then
  1081. exit;
  1082. end;
  1083. { generate the rangecheck code for the def where we are going to
  1084. store the result }
  1085. { get op and opsize }
  1086. opsize:=def2def_opsize(fromdef,u32bittype.def);
  1087. if opsize in [S_B,S_W,S_L] then
  1088. op:=A_MOV
  1089. else
  1090. if is_signed(fromdef) then
  1091. op:=A_MOVSX
  1092. else
  1093. op:=A_MOVZX;
  1094. is_reg:=(p.location.loc in [LOC_REGISTER,LOC_CREGISTER]);
  1095. getexplicitregister32(R_EDI);
  1096. { use the trick that }
  1097. { a <= x <= b <=> 0 <= x-a <= b-a <=> cardinal(x-a) <= cardinal(b-a) }
  1098. { To be able to do that, we have to make sure however that either }
  1099. { fromdef and todef are both signed or unsigned, or that we leave }
  1100. { the parts < 0 and > maxlongint out }
  1101. { is_signed now also works for arrays (it checks the rangetype) (JM) }
  1102. if is_signed(fromdef) xor is_signed(todef) then
  1103. if is_signed(fromdef) then
  1104. { from is signed, to is unsigned }
  1105. begin
  1106. { if high(from) < 0 -> always range error }
  1107. if (hfrom < 0) or
  1108. { if low(to) > maxlongint (== < 0, since we only have }
  1109. { longints here), also range error }
  1110. (lto < 0) then
  1111. begin
  1112. emitcall('FPC_RANGEERROR');
  1113. exit
  1114. end;
  1115. { to is unsigned -> hto < 0 == hto > maxlongint }
  1116. { since from is signed, values > maxlongint are < 0 and must }
  1117. { be rejected }
  1118. if hto < 0 then
  1119. hto := maxlongint;
  1120. end
  1121. else
  1122. { from is unsigned, to is signed }
  1123. begin
  1124. if (lfrom < 0) or
  1125. (hto < 0) then
  1126. begin
  1127. emitcall('FPC_RANGEERROR');
  1128. exit
  1129. end;
  1130. { since from is unsigned, values > maxlongint are < 0 and must }
  1131. { be rejected }
  1132. if lto < 0 then
  1133. lto := 0;
  1134. end;
  1135. if is_reg and
  1136. (opsize = S_L) then
  1137. emit_ref_reg(A_LEA,opsize,new_reference(p.location.register,-lto),
  1138. R_EDI)
  1139. else
  1140. begin
  1141. if is_reg then
  1142. emit_reg_reg(op,opsize,p.location.register,R_EDI)
  1143. else
  1144. emit_ref_reg(op,opsize,newreference(p.location.reference),R_EDI);
  1145. if lto <> 0 then
  1146. emit_const_reg(A_SUB,S_L,lto,R_EDI);
  1147. end;
  1148. emit_const_reg(A_CMP,S_L,hto-lto,R_EDI);
  1149. ungetregister32(R_EDI);
  1150. getlabel(neglabel);
  1151. emitjmp(C_BE,neglabel);
  1152. emitcall('FPC_RANGEERROR');
  1153. emitlab(neglabel);
  1154. end;
  1155. { DO NOT RELY on the fact that the tnode is not yet swaped
  1156. because of inlining code PM }
  1157. procedure firstcomplex(p : tbinarynode);
  1158. var
  1159. hp : tnode;
  1160. begin
  1161. { always calculate boolean AND and OR from left to right }
  1162. if (p.nodetype in [orn,andn]) and
  1163. (p.left.resulttype.def.deftype=orddef) and
  1164. (torddef(p.left.resulttype.def).typ in [bool8bit,bool16bit,bool32bit]) then
  1165. begin
  1166. { p.swaped:=false}
  1167. if nf_swaped in p.flags then
  1168. internalerror(234234);
  1169. end
  1170. else
  1171. if (p.left.registers32<p.right.registers32) and
  1172. { the following check is appropriate, because all }
  1173. { 4 registers are rarely used and it is thereby }
  1174. { achieved that the extra code is being dropped }
  1175. { by exchanging not commutative operators }
  1176. (p.right.registers32<=4) then
  1177. begin
  1178. hp:=p.left;
  1179. p.left:=p.right;
  1180. p.right:=hp;
  1181. if nf_swaped in p.flags then
  1182. exclude(p.flags,nf_swaped)
  1183. else
  1184. include(p.flags,nf_swaped);
  1185. end;
  1186. {else
  1187. p.swaped:=false; do not modify }
  1188. end;
  1189. {*****************************************************************************
  1190. Emit Functions
  1191. *****************************************************************************}
  1192. procedure push_shortstring_length(p:tnode);
  1193. var
  1194. hightree : tnode;
  1195. srsym : tsym;
  1196. begin
  1197. if is_open_string(p.resulttype.def) then
  1198. begin
  1199. srsym:=searchsymonlyin(tloadnode(p).symtable,'high'+tvarsym(tloadnode(p).symtableentry).name);
  1200. hightree:=cloadnode.create(tvarsym(srsym),tloadnode(p).symtable);
  1201. firstpass(hightree);
  1202. secondpass(hightree);
  1203. push_value_para(hightree,false,false,0,4);
  1204. hightree.free;
  1205. hightree:=nil;
  1206. end
  1207. else
  1208. begin
  1209. push_int(tstringdef(p.resulttype.def).len);
  1210. end;
  1211. end;
  1212. {*****************************************************************************
  1213. String functions
  1214. *****************************************************************************}
  1215. procedure loadshortstring(source,dest : tnode);
  1216. {
  1217. Load a string, handles stringdef and orddef (char) types
  1218. }
  1219. var
  1220. href: treference;
  1221. begin
  1222. case source.resulttype.def.deftype of
  1223. stringdef:
  1224. begin
  1225. if (source.nodetype=stringconstn) and
  1226. (str_length(source)=0) then
  1227. emit_const_ref(
  1228. A_MOV,S_B,0,newreference(dest.location.reference))
  1229. else
  1230. begin
  1231. emitpushreferenceaddr(dest.location.reference);
  1232. emitpushreferenceaddr(source.location.reference);
  1233. push_shortstring_length(dest);
  1234. emitcall('FPC_SHORTSTR_COPY');
  1235. maybe_loadself;
  1236. end;
  1237. end;
  1238. orddef:
  1239. begin
  1240. if source.nodetype=ordconstn then
  1241. emit_const_ref(
  1242. A_MOV,S_W,tordconstnode(source).value*256+1,newreference(dest.location.reference))
  1243. else
  1244. begin
  1245. if (source.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  1246. begin
  1247. href := dest.location.reference;
  1248. emit_const_ref(A_MOV,S_B,1,newreference(href));
  1249. inc(href.offset,1);
  1250. emit_reg_ref(A_MOV,S_B,makereg8(source.location.register),
  1251. newreference(href));
  1252. ungetregister(source.location.register);
  1253. end
  1254. else
  1255. { not so elegant (goes better with extra register }
  1256. begin
  1257. { not "movl", because then we may read past the }
  1258. { end of the heap! "movw" would be ok too, but }
  1259. { I don't think that would be faster (JM) }
  1260. getexplicitregister32(R_EDI);
  1261. emit_ref_reg(A_MOVZX,S_BL,newreference(source.location.reference),R_EDI);
  1262. del_reference(source.location.reference);
  1263. emit_const_reg(A_SHL,S_L,8,R_EDI);
  1264. emit_const_reg(A_OR,S_L,1,R_EDI);
  1265. emit_reg_ref(A_MOV,S_W,R_DI,newreference(dest.location.reference));
  1266. ungetregister32(R_EDI);
  1267. end;
  1268. end;
  1269. end;
  1270. else
  1271. CGMessage(type_e_mismatch);
  1272. end;
  1273. end;
  1274. procedure loadlongstring(p:tbinarynode);
  1275. {
  1276. Load a string, handles stringdef and orddef (char) types
  1277. }
  1278. var
  1279. r : preference;
  1280. begin
  1281. case p.right.resulttype.def.deftype of
  1282. stringdef:
  1283. begin
  1284. if (p.right.nodetype=stringconstn) and
  1285. (str_length(p.right)=0) then
  1286. emit_const_ref(A_MOV,S_L,0,newreference(p.left.location.reference))
  1287. else
  1288. begin
  1289. emitpushreferenceaddr(p.left.location.reference);
  1290. emitpushreferenceaddr(p.right.location.reference);
  1291. push_shortstring_length(p.left);
  1292. emitcall('FPC_LONGSTR_COPY');
  1293. maybe_loadself;
  1294. end;
  1295. end;
  1296. orddef:
  1297. begin
  1298. emit_const_ref(A_MOV,S_L,1,newreference(p.left.location.reference));
  1299. r:=newreference(p.left.location.reference);
  1300. inc(r^.offset,4);
  1301. if p.right.nodetype=ordconstn then
  1302. emit_const_ref(A_MOV,S_B,tordconstnode(p.right).value,r)
  1303. else
  1304. begin
  1305. case p.right.location.loc of
  1306. LOC_REGISTER,LOC_CREGISTER:
  1307. begin
  1308. emit_reg_ref(A_MOV,S_B,p.right.location.register,r);
  1309. ungetregister(p.right.location.register);
  1310. end;
  1311. LOC_MEM,LOC_REFERENCE:
  1312. begin
  1313. if not(R_EAX in unused) then
  1314. emit_reg(A_PUSH,S_L,R_EAX);
  1315. emit_ref_reg(A_MOV,S_B,newreference(p.right.location.reference),R_AL);
  1316. emit_reg_ref(A_MOV,S_B,R_AL,r);
  1317. if not(R_EAX in unused) then
  1318. emit_reg(A_POP,S_L,R_EAX);
  1319. del_reference(p.right.location.reference);
  1320. end
  1321. else
  1322. internalerror(20799);
  1323. end;
  1324. end;
  1325. end;
  1326. else
  1327. CGMessage(type_e_mismatch);
  1328. end;
  1329. end;
  1330. procedure loadansi2short(source,dest : tnode);
  1331. var
  1332. pushed : tpushed;
  1333. regs_to_push: byte;
  1334. begin
  1335. { Find out which registers have to be pushed (JM) }
  1336. regs_to_push := $ff;
  1337. remove_non_regvars_from_loc(source.location,regs_to_push);
  1338. { Push them (JM) }
  1339. pushusedregisters(pushed,regs_to_push);
  1340. case source.location.loc of
  1341. LOC_REFERENCE,LOC_MEM:
  1342. begin
  1343. { Now release the location and registers (see cgai386.pas: }
  1344. { loadansistring for more info on the order) (JM) }
  1345. ungetiftemp(source.location.reference);
  1346. del_reference(source.location.reference);
  1347. emit_push_mem(source.location.reference);
  1348. end;
  1349. LOC_REGISTER,LOC_CREGISTER:
  1350. begin
  1351. emit_reg(A_PUSH,S_L,source.location.register);
  1352. { Now release the register (JM) }
  1353. ungetregister32(source.location.register);
  1354. end;
  1355. end;
  1356. push_shortstring_length(dest);
  1357. emitpushreferenceaddr(dest.location.reference);
  1358. saveregvars($ff);
  1359. emitcall('FPC_ANSISTR_TO_SHORTSTR');
  1360. popusedregisters(pushed);
  1361. maybe_loadself;
  1362. end;
  1363. procedure loadwide2short(source,dest : tnode);
  1364. var
  1365. pushed : tpushed;
  1366. regs_to_push: byte;
  1367. begin
  1368. { Find out which registers have to be pushed (JM) }
  1369. regs_to_push := $ff;
  1370. remove_non_regvars_from_loc(source.location,regs_to_push);
  1371. { Push them (JM) }
  1372. pushusedregisters(pushed,regs_to_push);
  1373. case source.location.loc of
  1374. LOC_REFERENCE,LOC_MEM:
  1375. begin
  1376. { Now release the location and registers (see cgai386.pas: }
  1377. { loadansistring for more info on the order) (JM) }
  1378. ungetiftemp(source.location.reference);
  1379. del_reference(source.location.reference);
  1380. emit_push_mem(source.location.reference);
  1381. end;
  1382. LOC_REGISTER,LOC_CREGISTER:
  1383. begin
  1384. emit_reg(A_PUSH,S_L,source.location.register);
  1385. { Now release the register (JM) }
  1386. ungetregister32(source.location.register);
  1387. end;
  1388. end;
  1389. push_shortstring_length(dest);
  1390. emitpushreferenceaddr(dest.location.reference);
  1391. saveregvars($ff);
  1392. emitcall('FPC_WIDESTR_TO_SHORTSTR');
  1393. popusedregisters(pushed);
  1394. maybe_loadself;
  1395. end;
  1396. procedure loadinterfacecom(p: tbinarynode);
  1397. {
  1398. copies an com interface from n.right to n.left, we
  1399. assume, that both sides are com interface, firstassignement have
  1400. to take care of that, an com interface can't be a register variable
  1401. }
  1402. var
  1403. pushed : tpushed;
  1404. ungettemp : boolean;
  1405. begin
  1406. { before pushing any parameter, we have to save all used }
  1407. { registers, but before that we have to release the }
  1408. { registers of that node to save uneccessary pushed }
  1409. { so be careful, if you think you can optimize that code (FK) }
  1410. { nevertheless, this has to be changed, because otherwise the }
  1411. { register is released before it's contents are pushed -> }
  1412. { problems with the optimizer (JM) }
  1413. del_reference(p.left.location.reference);
  1414. ungettemp:=false;
  1415. case p.right.location.loc of
  1416. LOC_REGISTER,LOC_CREGISTER:
  1417. begin
  1418. pushusedregisters(pushed, $ff xor ($80 shr byte(p.right.location.register)));
  1419. exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,p.right.location.register));
  1420. ungetregister32(p.right.location.register);
  1421. end;
  1422. LOC_REFERENCE,LOC_MEM:
  1423. begin
  1424. pushusedregisters(pushed,$ff
  1425. xor ($80 shr byte(p.right.location.reference.base))
  1426. xor ($80 shr byte(p.right.location.reference.index)));
  1427. emit_push_mem(p.right.location.reference);
  1428. del_reference(p.right.location.reference);
  1429. ungettemp:=true;
  1430. end;
  1431. end;
  1432. emitpushreferenceaddr(p.left.location.reference);
  1433. del_reference(p.left.location.reference);
  1434. saveregvars($ff);
  1435. emitcall('FPC_INTF_ASSIGN');
  1436. maybe_loadself;
  1437. popusedregisters(pushed);
  1438. if ungettemp then
  1439. ungetiftemp(p.right.location.reference);
  1440. end;
  1441. end.
  1442. {
  1443. $Log$
  1444. Revision 1.18 2001-07-08 21:00:18 peter
  1445. * various widestring updates, it works now mostly without charset
  1446. mapping supported
  1447. Revision 1.17 2001/07/01 20:16:20 peter
  1448. * alignmentinfo record added
  1449. * -Oa argument supports more alignment settings that can be specified
  1450. per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN
  1451. RECORDMAX,LOCALMIN,LOCALMAX. It is possible to set the mimimum
  1452. required alignment and the maximum usefull alignment. The final
  1453. alignment will be choosen per variable size dependent on these
  1454. settings
  1455. Revision 1.16 2001/04/18 22:02:03 peter
  1456. * registration of targets and assemblers
  1457. Revision 1.15 2001/04/13 01:22:19 peter
  1458. * symtable change to classes
  1459. * range check generation and errors fixed, make cycle DEBUG=1 works
  1460. * memory leaks fixed
  1461. Revision 1.14 2001/04/02 21:20:39 peter
  1462. * resulttype rewrite
  1463. Revision 1.13 2001/03/11 22:58:52 peter
  1464. * getsym redesign, removed the globals srsym,srsymtable
  1465. Revision 1.12 2001/03/04 10:26:56 jonas
  1466. * new rangecheck code now handles conversion between signed and cardinal types correctly
  1467. Revision 1.11 2001/03/03 12:41:22 jonas
  1468. * simplified and optimized range checking code, FPC_BOUNDCHECK is no longer necessary
  1469. Revision 1.10 2000/12/31 11:02:12 jonas
  1470. * optimized loadshortstring a bit
  1471. Revision 1.9 2000/12/25 00:07:33 peter
  1472. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  1473. tlinkedlist objects)
  1474. Revision 1.8 2000/12/11 19:10:19 jonas
  1475. * fixed web bug 1144
  1476. + implemented range checking for 64bit types
  1477. Revision 1.7 2000/12/07 17:19:46 jonas
  1478. * new constant handling: from now on, hex constants >$7fffffff are
  1479. parsed as unsigned constants (otherwise, $80000000 got sign extended
  1480. and became $ffffffff80000000), all constants in the longint range
  1481. become longints, all constants >$7fffffff and <=cardinal($ffffffff)
  1482. are cardinals and the rest are int64's.
  1483. * added lots of longint typecast to prevent range check errors in the
  1484. compiler and rtl
  1485. * type casts of symbolic ordinal constants are now preserved
  1486. * fixed bug where the original resulttype.def wasn't restored correctly
  1487. after doing a 64bit rangecheck
  1488. Revision 1.6 2000/12/05 11:44:34 jonas
  1489. + new integer regvar handling, should be much more efficient
  1490. Revision 1.5 2000/11/29 00:30:49 florian
  1491. * unused units removed from uses clause
  1492. * some changes for widestrings
  1493. Revision 1.4 2000/11/13 14:47:46 jonas
  1494. * support for range checking when converting from 64bit to something
  1495. smaller (32bit, 16bit, 8bit)
  1496. * fixed range checking between longint/cardinal and for array indexing
  1497. with cardinal (values > $7fffffff were considered negative)
  1498. Revision 1.3 2000/11/04 14:25:25 florian
  1499. + merged Attila's changes for interfaces, not tested yet
  1500. Revision 1.2 2000/10/31 22:02:57 peter
  1501. * symtable splitted, no real code changes
  1502. Revision 1.1 2000/10/15 09:33:32 peter
  1503. * moved n386*.pas to i386/ cpu_target dir
  1504. Revision 1.3 2000/10/14 21:52:54 peter
  1505. * fixed memory leaks
  1506. Revision 1.2 2000/10/14 10:14:50 peter
  1507. * moehrendorf oct 2000 rewrite
  1508. Revision 1.1 2000/10/01 19:58:40 peter
  1509. * new file
  1510. }