n386util.pas 62 KB

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