n386util.pas 62 KB

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