cg386inl.pas 61 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 by Florian Klaempfl
  4. Generate i386 inline nodes
  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 cg386inl;
  19. interface
  20. uses
  21. tree;
  22. procedure secondinline(var p : ptree);
  23. implementation
  24. uses
  25. globtype,systems,
  26. cobjects,verbose,globals,files,
  27. symtable,aasm,types,
  28. hcodegen,temp_gen,pass_1,pass_2,
  29. i386base,i386asm,
  30. cgai386,tgeni386,cg386cal;
  31. {*****************************************************************************
  32. Helpers
  33. *****************************************************************************}
  34. { reverts the parameter list }
  35. var nb_para : integer;
  36. function reversparameter(p : ptree) : ptree;
  37. var
  38. hp1,hp2 : ptree;
  39. begin
  40. hp1:=nil;
  41. nb_para := 0;
  42. while assigned(p) do
  43. begin
  44. { pull out }
  45. hp2:=p;
  46. p:=p^.right;
  47. inc(nb_para);
  48. { pull in }
  49. hp2^.right:=hp1;
  50. hp1:=hp2;
  51. end;
  52. reversparameter:=hp1;
  53. end;
  54. {*****************************************************************************
  55. SecondInLine
  56. *****************************************************************************}
  57. procedure StoreDirectFuncResult(dest:ptree);
  58. var
  59. hp : ptree;
  60. hdef : porddef;
  61. hreg : tregister;
  62. oldregisterdef : boolean;
  63. begin
  64. SecondPass(dest);
  65. if Codegenerror then
  66. exit;
  67. Case dest^.resulttype^.deftype of
  68. floatdef:
  69. floatstore(PFloatDef(dest^.resulttype)^.typ,dest^.location.reference);
  70. orddef:
  71. begin
  72. if porddef(dest^.resulttype)^.typ in [u64bit,s64bitint] then
  73. begin
  74. emit_movq_reg_loc(R_EDX,R_EAX,dest^.location);
  75. end
  76. else
  77. begin
  78. Case dest^.resulttype^.size of
  79. 1 : hreg:=regtoreg8(accumulator);
  80. 2 : hreg:=regtoreg16(accumulator);
  81. 4 : hreg:=accumulator;
  82. End;
  83. emit_mov_reg_loc(hreg,dest^.location);
  84. If (cs_check_range in aktlocalswitches) and
  85. {no need to rangecheck longints or cardinals on 32bit processors}
  86. not((porddef(dest^.resulttype)^.typ = s32bit) and
  87. (porddef(dest^.resulttype)^.low = $80000000) and
  88. (porddef(dest^.resulttype)^.high = $7fffffff)) and
  89. not((porddef(dest^.resulttype)^.typ = u32bit) and
  90. (porddef(dest^.resulttype)^.low = 0) and
  91. (porddef(dest^.resulttype)^.high = $ffffffff)) then
  92. Begin
  93. {do not register this temporary def}
  94. OldRegisterDef := RegisterDef;
  95. RegisterDef := False;
  96. hdef:=nil;
  97. Case PordDef(dest^.resulttype)^.typ of
  98. u8bit,u16bit,u32bit:
  99. begin
  100. new(hdef,init(u32bit,0,$ffffffff));
  101. hreg:=accumulator;
  102. end;
  103. s8bit,s16bit,s32bit:
  104. begin
  105. new(hdef,init(s32bit,$80000000,$7fffffff));
  106. hreg:=accumulator;
  107. end;
  108. end;
  109. { create a fake node }
  110. hp := genzeronode(nothingn);
  111. hp^.location.loc := LOC_REGISTER;
  112. hp^.location.register := hreg;
  113. if assigned(hdef) then
  114. hp^.resulttype:=hdef
  115. else
  116. hp^.resulttype:=dest^.resulttype;
  117. { emit the range check }
  118. emitrangecheck(hp,dest^.resulttype);
  119. hp^.right := nil;
  120. if assigned(hdef) then
  121. Dispose(hdef, Done);
  122. RegisterDef := OldRegisterDef;
  123. disposetree(hp);
  124. End;
  125. end;
  126. End;
  127. else
  128. internalerror(66766766);
  129. end;
  130. end;
  131. procedure secondinline(var p : ptree);
  132. const
  133. {tfloattype = (s32real,s64real,s80real,s64bit,f16bit,f32bit);}
  134. { float_name: array[tfloattype] of string[8]=
  135. ('S32REAL','S64REAL','S80REAL','S64BIT','F16BIT','F32BIT'); }
  136. incdecop:array[in_inc_x..in_dec_x] of tasmop=(A_INC,A_DEC);
  137. addsubop:array[in_inc_x..in_dec_x] of tasmop=(A_ADD,A_SUB);
  138. var
  139. aktfile : treference;
  140. ft : tfiletype;
  141. opsize : topsize;
  142. op,
  143. asmop : tasmop;
  144. pushed : tpushed;
  145. {inc/dec}
  146. addconstant : boolean;
  147. addvalue : longint;
  148. procedure handlereadwrite(doread,doln : boolean);
  149. { produces code for READ(LN) and WRITE(LN) }
  150. procedure loadstream;
  151. const
  152. io:array[boolean] of string[7]=('_OUTPUT','_INPUT');
  153. var
  154. r : preference;
  155. begin
  156. new(r);
  157. reset_reference(r^);
  158. r^.symbol:=newasmsymbol('U_'+upper(target_info.system_unit)+io[doread]);
  159. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,r,R_EDI)))
  160. end;
  161. const
  162. rdwrprefix:array[boolean] of string[15]=('FPC_WRITE_TEXT_','FPC_READ_TEXT_');
  163. var
  164. destpara,
  165. node,hp : ptree;
  166. typedtyp,
  167. pararesult : pdef;
  168. orgfloattype : tfloattype;
  169. has_length : boolean;
  170. dummycoll : tdefcoll;
  171. iolabel : pasmlabel;
  172. npara : longint;
  173. begin
  174. { I/O check }
  175. if (cs_check_io in aktlocalswitches) and
  176. ((aktprocsym^.definition^.options and poiocheck)=0) then
  177. begin
  178. getlabel(iolabel);
  179. emitlab(iolabel);
  180. end
  181. else
  182. iolabel:=nil;
  183. { for write of real with the length specified }
  184. has_length:=false;
  185. hp:=nil;
  186. { reserve temporary pointer to data variable }
  187. aktfile.symbol:=nil;
  188. gettempofsizereference(4,aktfile);
  189. { first state text data }
  190. ft:=ft_text;
  191. { and state a parameter ? }
  192. if p^.left=nil then
  193. begin
  194. { the following instructions are for "writeln;" }
  195. loadstream;
  196. { save @aktfile in temporary variable }
  197. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,newreference(aktfile))));
  198. end
  199. else
  200. begin
  201. { revers paramters }
  202. node:=reversparameter(p^.left);
  203. p^.left := node;
  204. npara := nb_para;
  205. { calculate data variable }
  206. { is first parameter a file type ? }
  207. if node^.left^.resulttype^.deftype=filedef then
  208. begin
  209. ft:=pfiledef(node^.left^.resulttype)^.filetype;
  210. if ft=ft_typed then
  211. typedtyp:=pfiledef(node^.left^.resulttype)^.typed_as;
  212. secondpass(node^.left);
  213. if codegenerror then
  214. exit;
  215. { save reference in temporary variables }
  216. if node^.left^.location.loc<>LOC_REFERENCE then
  217. begin
  218. CGMessage(cg_e_illegal_expression);
  219. exit;
  220. end;
  221. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(node^.left^.location.reference),R_EDI)));
  222. { skip to the next parameter }
  223. node:=node^.right;
  224. end
  225. else
  226. begin
  227. { load stdin/stdout stream }
  228. loadstream;
  229. end;
  230. { save @aktfile in temporary variable }
  231. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,newreference(aktfile))));
  232. if doread then
  233. { parameter by READ gives call by reference }
  234. dummycoll.paratyp:=vs_var
  235. { an WRITE Call by "Const" }
  236. else
  237. dummycoll.paratyp:=vs_const;
  238. { because of secondcallparan, which otherwise attaches }
  239. if ft=ft_typed then
  240. { this is to avoid copy of simple const parameters }
  241. {dummycoll.data:=new(pformaldef,init)}
  242. dummycoll.data:=cformaldef
  243. else
  244. { I think, this isn't a good solution (FK) }
  245. dummycoll.data:=nil;
  246. while assigned(node) do
  247. begin
  248. pushusedregisters(pushed,$ff);
  249. hp:=node;
  250. node:=node^.right;
  251. hp^.right:=nil;
  252. if hp^.is_colon_para then
  253. CGMessage(parser_e_illegal_colon_qualifier);
  254. { when float is written then we need bestreal to be pushed
  255. convert here else we loose the old flaot type }
  256. if (not doread) and
  257. (ft<>ft_typed) and
  258. (hp^.left^.resulttype^.deftype=floatdef) then
  259. begin
  260. orgfloattype:=pfloatdef(hp^.left^.resulttype)^.typ;
  261. hp^.left:=gentypeconvnode(hp^.left,bestrealdef^);
  262. firstpass(hp^.left);
  263. end;
  264. { when read ord,floats are functions, so they need this
  265. parameter as their destination instead of being pushed }
  266. if doread and
  267. (ft<>ft_typed) and
  268. (hp^.resulttype^.deftype in [orddef,floatdef]) then
  269. destpara:=hp^.left
  270. else
  271. begin
  272. if ft=ft_typed then
  273. never_copy_const_param:=true;
  274. { reset data type }
  275. dummycoll.data:=nil;
  276. { create temporary defs for high tree generation }
  277. if doread and (is_shortstring(hp^.resulttype)) then
  278. dummycoll.data:=openshortstringdef
  279. else
  280. if (is_chararray(hp^.resulttype)) then
  281. dummycoll.data:=openchararraydef;
  282. secondcallparan(hp,@dummycoll,false,false,false,0);
  283. if ft=ft_typed then
  284. never_copy_const_param:=false;
  285. end;
  286. hp^.right:=node;
  287. if codegenerror then
  288. exit;
  289. emit_push_mem(aktfile);
  290. if (ft=ft_typed) then
  291. begin
  292. { OK let's try this }
  293. { first we must only allow the right type }
  294. { we have to call blockread or blockwrite }
  295. { but the real problem is that }
  296. { reset and rewrite should have set }
  297. { the type size }
  298. { as recordsize for that file !!!! }
  299. { how can we make that }
  300. { I think that is only possible by adding }
  301. { reset and rewrite to the inline list a call }
  302. { allways read only one record by element }
  303. push_int(typedtyp^.size);
  304. if doread then
  305. emitcall('FPC_TYPED_READ')
  306. else
  307. emitcall('FPC_TYPED_WRITE');
  308. end
  309. else
  310. begin
  311. { save current position }
  312. pararesult:=hp^.left^.resulttype;
  313. { handle possible field width }
  314. { of course only for write(ln) }
  315. if not doread then
  316. begin
  317. { handle total width parameter }
  318. if assigned(node) and node^.is_colon_para then
  319. begin
  320. hp:=node;
  321. node:=node^.right;
  322. hp^.right:=nil;
  323. secondcallparan(hp,@dummycoll,false,false,false,0);
  324. hp^.right:=node;
  325. if codegenerror then
  326. exit;
  327. has_length:=true;
  328. end
  329. else
  330. if pararesult^.deftype<>floatdef then
  331. push_int(0)
  332. else
  333. push_int(-32767);
  334. { a second colon para for a float ? }
  335. if assigned(node) and node^.is_colon_para then
  336. begin
  337. hp:=node;
  338. node:=node^.right;
  339. hp^.right:=nil;
  340. secondcallparan(hp,@dummycoll,false,false,false,0);
  341. hp^.right:=node;
  342. if pararesult^.deftype<>floatdef then
  343. CGMessage(parser_e_illegal_colon_qualifier);
  344. if codegenerror then
  345. exit;
  346. end
  347. else
  348. begin
  349. if pararesult^.deftype=floatdef then
  350. push_int(-1);
  351. end;
  352. { push also the real type for floats }
  353. if pararesult^.deftype=floatdef then
  354. push_int(ord(orgfloattype));
  355. end;
  356. case pararesult^.deftype of
  357. stringdef :
  358. begin
  359. emitcall(rdwrprefix[doread]+pstringdef(pararesult)^.stringtypname);
  360. end;
  361. pointerdef :
  362. begin
  363. if is_pchar(pararesult) then
  364. emitcall(rdwrprefix[doread]+'PCHAR_AS_POINTER')
  365. end;
  366. arraydef :
  367. begin
  368. if is_chararray(pararesult) then
  369. emitcall(rdwrprefix[doread]+'PCHAR_AS_ARRAY')
  370. end;
  371. floatdef :
  372. begin
  373. emitcall(rdwrprefix[doread]+'FLOAT');
  374. if doread then
  375. StoreDirectFuncResult(destpara);
  376. end;
  377. orddef :
  378. begin
  379. case porddef(pararesult)^.typ of
  380. s8bit,s16bit,s32bit :
  381. emitcall(rdwrprefix[doread]+'SINT');
  382. u8bit,u16bit,u32bit :
  383. emitcall(rdwrprefix[doread]+'UINT');
  384. uchar :
  385. emitcall(rdwrprefix[doread]+'CHAR');
  386. s64bitint:
  387. emitcall(rdwrprefix[doread]+'INT64');
  388. u64bit :
  389. emitcall(rdwrprefix[doread]+'QWORD');
  390. bool8bit,
  391. bool16bit,
  392. bool32bit :
  393. emitcall(rdwrprefix[doread]+'BOOLEAN');
  394. end; if doread then
  395. StoreDirectFuncResult(destpara);
  396. end;
  397. end;
  398. end;
  399. { load ESI in methods again }
  400. popusedregisters(pushed);
  401. maybe_loadesi;
  402. end;
  403. end;
  404. { Insert end of writing for textfiles }
  405. if ft=ft_text then
  406. begin
  407. pushusedregisters(pushed,$ff);
  408. emit_push_mem(aktfile);
  409. if doread then
  410. begin
  411. if doln then
  412. emitcall('FPC_READLN_END')
  413. else
  414. emitcall('FPC_READ_END');
  415. end
  416. else
  417. begin
  418. if doln then
  419. emitcall('FPC_WRITELN_END')
  420. else
  421. emitcall('FPC_WRITE_END');
  422. end;
  423. popusedregisters(pushed);
  424. maybe_loadesi;
  425. end;
  426. { Insert IOCheck if set }
  427. if assigned(iolabel) then
  428. begin
  429. { registers are saved in the procedure }
  430. exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,iolabel)));
  431. emitcall('FPC_IOCHECK');
  432. end;
  433. { Freeup all used temps }
  434. ungetiftemp(aktfile);
  435. if assigned(p^.left) then
  436. begin
  437. p^.left:=reversparameter(p^.left);
  438. if npara<>nb_para then
  439. CGMessage(cg_f_internal_error_in_secondinline);
  440. hp:=p^.left;
  441. while assigned(hp) do
  442. begin
  443. if assigned(hp^.left) then
  444. if (hp^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
  445. ungetiftemp(hp^.left^.location.reference);
  446. hp:=hp^.right;
  447. end;
  448. end;
  449. end;
  450. procedure handle_str;
  451. var
  452. hp,node : ptree;
  453. dummycoll : tdefcoll;
  454. is_real,has_length : boolean;
  455. realtype : tfloattype;
  456. procedureprefix : string;
  457. begin
  458. pushusedregisters(pushed,$ff);
  459. node:=p^.left;
  460. is_real:=false;
  461. has_length:=false;
  462. while assigned(node^.right) do node:=node^.right;
  463. { if a real parameter somewhere then call REALSTR }
  464. if (node^.left^.resulttype^.deftype=floatdef) then
  465. begin
  466. is_real:=true;
  467. realtype:=pfloatdef(node^.left^.resulttype)^.typ;
  468. end;
  469. node:=p^.left;
  470. { we have at least two args }
  471. { with at max 2 colon_para in between }
  472. { string arg }
  473. hp:=node;
  474. node:=node^.right;
  475. hp^.right:=nil;
  476. dummycoll.paratyp:=vs_var;
  477. if is_shortstring(hp^.resulttype) then
  478. dummycoll.data:=openshortstringdef
  479. else
  480. dummycoll.data:=hp^.resulttype;
  481. procedureprefix:='FPC_'+pstringdef(hp^.resulttype)^.stringtypname+'_';
  482. secondcallparan(hp,@dummycoll,false,false,false,0);
  483. if codegenerror then
  484. exit;
  485. dummycoll.paratyp:=vs_const;
  486. disposetree(p^.left);
  487. p^.left:=nil;
  488. { second arg }
  489. hp:=node;
  490. node:=node^.right;
  491. hp^.right:=nil;
  492. { if real push real type }
  493. if is_real then
  494. push_int(ord(realtype));
  495. { frac para }
  496. if hp^.is_colon_para and assigned(node) and
  497. node^.is_colon_para then
  498. begin
  499. dummycoll.data:=hp^.resulttype;
  500. secondcallparan(hp,@dummycoll,false
  501. ,false,false,0
  502. );
  503. if codegenerror then
  504. exit;
  505. disposetree(hp);
  506. hp:=node;
  507. node:=node^.right;
  508. hp^.right:=nil;
  509. has_length:=true;
  510. end
  511. else
  512. if is_real then
  513. push_int(-1);
  514. { third arg, length only if is_real }
  515. if hp^.is_colon_para then
  516. begin
  517. dummycoll.data:=hp^.resulttype;
  518. secondcallparan(hp,@dummycoll,false
  519. ,false,false,0
  520. );
  521. if codegenerror then
  522. exit;
  523. disposetree(hp);
  524. hp:=node;
  525. node:=node^.right;
  526. hp^.right:=nil;
  527. end
  528. else
  529. if is_real then
  530. push_int(-32767)
  531. else
  532. push_int(-1);
  533. { Convert float to bestreal }
  534. if is_real then
  535. begin
  536. hp^.left:=gentypeconvnode(hp^.left,bestrealdef^);
  537. firstpass(hp^.left);
  538. end;
  539. { last arg longint or real }
  540. secondcallparan(hp,@dummycoll,false
  541. ,false,false,0
  542. );
  543. if codegenerror then
  544. exit;
  545. if is_real then
  546. emitcall(procedureprefix+'FLOAT')
  547. else
  548. case porddef(hp^.resulttype)^.typ of
  549. u32bit:
  550. emitcall(procedureprefix+'CARDINAL');
  551. u64bit:
  552. emitcall(procedureprefix+'QWORD');
  553. s64bitint:
  554. emitcall(procedureprefix+'INT64');
  555. else
  556. emitcall(procedureprefix+'LONGINT');
  557. end;
  558. disposetree(hp);
  559. popusedregisters(pushed);
  560. end;
  561. {$IfnDef OLDVAL}
  562. Procedure Handle_Val;
  563. var
  564. hp,node, code_para, dest_para : ptree;
  565. hreg: TRegister;
  566. hdef: POrdDef;
  567. procedureprefix : string;
  568. hr, hr2: TReference;
  569. dummycoll : tdefcoll;
  570. has_code, has_32bit_code, oldregisterdef: boolean;
  571. begin
  572. node:=p^.left;
  573. hp:=node;
  574. node:=node^.right;
  575. hp^.right:=nil;
  576. {if we have 3 parameters, we have a code parameter}
  577. has_code := Assigned(node^.right);
  578. has_32bit_code := false;
  579. reset_reference(hr);
  580. hreg := R_NO;
  581. If has_code then
  582. Begin
  583. {code is an orddef, that's checked in tcinl}
  584. code_para := hp;
  585. hp := node;
  586. node := node^.right;
  587. hp^.right := nil;
  588. has_32bit_code := (porddef(code_para^.left^.resulttype)^.typ in [u32bit,s32bit]);
  589. End;
  590. {hp = destination now, save for later use}
  591. dest_para := hp;
  592. {if EAX is already in use, it's a register variable. Since we don't
  593. need another register besides EAX, release the one we got}
  594. If hreg <> R_EAX Then ungetregister32(hreg);
  595. {load and push the address of the destination}
  596. dummycoll.paratyp:=vs_var;
  597. dummycoll.data:=dest_para^.resulttype;
  598. secondcallparan(dest_para,@dummycoll,false,false,false,0);
  599. if codegenerror then
  600. exit;
  601. {save the regvars}
  602. pushusedregisters(pushed,$ff);
  603. {now that we've already pushed the addres of dest_para^.left on the
  604. stack, we can put the real parameters on the stack}
  605. If has_32bit_code Then
  606. Begin
  607. dummycoll.paratyp:=vs_var;
  608. dummycoll.data:=code_para^.resulttype;
  609. secondcallparan(code_para,@dummycoll,false,false,false,0);
  610. if codegenerror then
  611. exit;
  612. Disposetree(code_para);
  613. End
  614. Else
  615. Begin
  616. {only 32bit code parameter is supported, so fake one}
  617. GetTempOfSizeReference(4,hr);
  618. emitpushreferenceaddr(hr);
  619. End;
  620. {node = first parameter = string}
  621. dummycoll.paratyp:=vs_const;
  622. dummycoll.data:=node^.resulttype;
  623. secondcallparan(node,@dummycoll,false,false,false,0);
  624. if codegenerror then
  625. exit;
  626. Case dest_para^.resulttype^.deftype of
  627. floatdef:
  628. procedureprefix := 'FPC_VAL_REAL_';
  629. orddef:
  630. if is_signed(dest_para^.resulttype) then
  631. begin
  632. {if we are converting to a signed number, we have to include the
  633. size of the destination, so the Val function can extend the sign
  634. of the result to allow proper range checking}
  635. exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,dest_para^.resulttype^.size)));
  636. procedureprefix := 'FPC_VAL_SINT_'
  637. end
  638. else
  639. procedureprefix := 'FPC_VAL_UINT_';
  640. End;
  641. emitcall(procedureprefix+pstringdef(node^.resulttype)^.stringtypname);
  642. { before disposing node we need to ungettemp !! PM }
  643. if node^.left^.location.loc in [LOC_REFERENCE,LOC_MEM] then
  644. ungetiftemp(node^.left^.location.reference);
  645. disposetree(node);
  646. p^.left := nil;
  647. {reload esi in case the dest_para/code_para is a class variable or so}
  648. maybe_loadesi;
  649. If (dest_para^.resulttype^.deftype = orddef) Then
  650. Begin
  651. {store the result in a safe place, because EAX may be used by a
  652. register variable}
  653. hreg := getexplicitregister32(R_EAX);
  654. emit_reg_reg(A_MOV,S_L,R_EAX,hreg);
  655. {as of now, hreg now holds the location of the result, if it was
  656. integer}
  657. End;
  658. { restore the register vars}
  659. popusedregisters(pushed);
  660. If has_code and Not(has_32bit_code) Then
  661. {only 16bit code is possible}
  662. Begin
  663. {load the address of the code parameter}
  664. secondpass(code_para^.left);
  665. {move the code to its destination}
  666. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,NewReference(hr),R_EDI)));
  667. emit_mov_reg_loc(R_DI,code_para^.left^.location);
  668. Disposetree(code_para);
  669. End;
  670. {restore the address of the result}
  671. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
  672. {set up hr2 to a refernce with EDI as base register}
  673. reset_reference(hr2);
  674. hr2.base := R_EDI;
  675. {save the function result in the destination variable}
  676. Case dest_para^.left^.resulttype^.deftype of
  677. floatdef:
  678. floatstore(PFloatDef(dest_para^.left^.resulttype)^.typ, hr2);
  679. orddef:
  680. Case PordDef(dest_para^.left^.resulttype)^.typ of
  681. u8bit,s8bit:
  682. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV, S_B,
  683. RegToReg8(hreg),newreference(hr2))));
  684. u16bit,s16bit:
  685. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV, S_W,
  686. RegToReg16(hreg),newreference(hr2))));
  687. u32bit,s32bit:
  688. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV, S_L,
  689. hreg,newreference(hr2))));
  690. {u64bit,s64bitint: ???}
  691. End;
  692. End;
  693. If (cs_check_range in aktlocalswitches) and
  694. (dest_para^.left^.resulttype^.deftype = orddef) and
  695. {the following has to be changed to 64bit checking, once Val
  696. returns 64 bit values (unless a special Val function is created
  697. for that)}
  698. {no need to rangecheck longints or cardinals on 32bit processors}
  699. not((porddef(dest_para^.left^.resulttype)^.typ = s32bit) and
  700. (porddef(dest_para^.left^.resulttype)^.low = $80000000) and
  701. (porddef(dest_para^.left^.resulttype)^.high = $7fffffff)) and
  702. not((porddef(dest_para^.left^.resulttype)^.typ = u32bit) and
  703. (porddef(dest_para^.left^.resulttype)^.low = 0) and
  704. (porddef(dest_para^.left^.resulttype)^.high = $ffffffff)) then
  705. Begin
  706. hp := getcopy(dest_para^.left);
  707. hp^.location.loc := LOC_REGISTER;
  708. hp^.location.register := hreg;
  709. {do not register this temporary def}
  710. OldRegisterDef := RegisterDef;
  711. RegisterDef := False;
  712. Case PordDef(dest_para^.left^.resulttype)^.typ of
  713. u8bit,u16bit,u32bit: new(hdef,init(u32bit,0,$ffffffff));
  714. s8bit,s16bit,s32bit: new(hdef,init(s32bit,$80000000,$7fffffff));
  715. end;
  716. hp^.resulttype := hdef;
  717. emitrangecheck(hp,dest_para^.left^.resulttype);
  718. hp^.right := nil;
  719. Dispose(hp^.resulttype, Done);
  720. RegisterDef := OldRegisterDef;
  721. disposetree(hp);
  722. End;
  723. {dest_para^.right is already nil}
  724. disposetree(dest_para);
  725. UnGetIfTemp(hr);
  726. end;
  727. {$EndIf OLDVAL}
  728. var
  729. r : preference;
  730. hp : ptree;
  731. l : longint;
  732. ispushed : boolean;
  733. hregister : tregister;
  734. otlabel,oflabel : pasmlabel;
  735. oldpushedparasize : longint;
  736. begin
  737. { save & reset pushedparasize }
  738. oldpushedparasize:=pushedparasize;
  739. pushedparasize:=0;
  740. case p^.inlinenumber of
  741. in_assert_x_y:
  742. begin
  743. otlabel:=truelabel;
  744. oflabel:=falselabel;
  745. getlabel(truelabel);
  746. getlabel(falselabel);
  747. secondpass(p^.left^.left);
  748. if cs_do_assertion in aktlocalswitches then
  749. begin
  750. maketojumpbool(p^.left^.left);
  751. emitlab(falselabel);
  752. { erroraddr }
  753. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EBP)));
  754. { lineno }
  755. exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,aktfilepos.line)));
  756. { filename string }
  757. hp:=genstringconstnode(current_module^.sourcefiles^.get_file_name(aktfilepos.fileindex));
  758. secondpass(hp);
  759. if codegenerror then
  760. exit;
  761. emitpushreferenceaddr(hp^.location.reference);
  762. disposetree(hp);
  763. { push msg }
  764. secondpass(p^.left^.right^.left);
  765. emitpushreferenceaddr(p^.left^.right^.left^.location.reference);
  766. { call }
  767. emitcall('FPC_ASSERT');
  768. emitlab(truelabel);
  769. end;
  770. freelabel(truelabel);
  771. freelabel(falselabel);
  772. truelabel:=otlabel;
  773. falselabel:=oflabel;
  774. end;
  775. in_lo_word,
  776. in_hi_word :
  777. begin
  778. secondpass(p^.left);
  779. p^.location.loc:=LOC_REGISTER;
  780. if p^.left^.location.loc<>LOC_REGISTER then
  781. begin
  782. if p^.left^.location.loc=LOC_CREGISTER then
  783. begin
  784. p^.location.register:=reg32toreg16(getregister32);
  785. emit_reg_reg(A_MOV,S_W,p^.left^.location.register,
  786. p^.location.register);
  787. end
  788. else
  789. begin
  790. del_reference(p^.left^.location.reference);
  791. p^.location.register:=reg32toreg16(getregister32);
  792. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_W,newreference(p^.left^.location.reference),
  793. p^.location.register)));
  794. end;
  795. end
  796. else p^.location.register:=p^.left^.location.register;
  797. if p^.inlinenumber=in_hi_word then
  798. exprasmlist^.concat(new(pai386,op_const_reg(A_SHR,S_W,8,p^.location.register)));
  799. p^.location.register:=reg16toreg8(p^.location.register);
  800. end;
  801. in_sizeof_x,
  802. in_typeof_x :
  803. begin
  804. { for both cases load vmt }
  805. if p^.left^.treetype=typen then
  806. begin
  807. p^.location.register:=getregister32;
  808. exprasmlist^.concat(new(pai386,op_sym_ofs_reg(A_MOV,
  809. S_L,newasmsymbol(pobjectdef(p^.left^.resulttype)^.vmt_mangledname),0,
  810. p^.location.register)));
  811. end
  812. else
  813. begin
  814. secondpass(p^.left);
  815. del_reference(p^.left^.location.reference);
  816. p^.location.loc:=LOC_REGISTER;
  817. p^.location.register:=getregister32;
  818. { load VMT pointer }
  819. inc(p^.left^.location.reference.offset,
  820. pobjectdef(p^.left^.resulttype)^.vmt_offset);
  821. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  822. newreference(p^.left^.location.reference),
  823. p^.location.register)));
  824. end;
  825. { in sizeof load size }
  826. if p^.inlinenumber=in_sizeof_x then
  827. begin
  828. new(r);
  829. reset_reference(r^);
  830. r^.base:=p^.location.register;
  831. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,
  832. p^.location.register)));
  833. end;
  834. end;
  835. in_lo_long,
  836. in_hi_long :
  837. begin
  838. secondpass(p^.left);
  839. p^.location.loc:=LOC_REGISTER;
  840. if p^.left^.location.loc<>LOC_REGISTER then
  841. begin
  842. if p^.left^.location.loc=LOC_CREGISTER then
  843. begin
  844. p^.location.register:=getregister32;
  845. emit_reg_reg(A_MOV,S_L,p^.left^.location.register,
  846. p^.location.register);
  847. end
  848. else
  849. begin
  850. del_reference(p^.left^.location.reference);
  851. p^.location.register:=getregister32;
  852. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
  853. p^.location.register)));
  854. end;
  855. end
  856. else p^.location.register:=p^.left^.location.register;
  857. if p^.inlinenumber=in_hi_long then
  858. exprasmlist^.concat(new(pai386,op_const_reg(A_SHR,S_L,16,p^.location.register)));
  859. p^.location.register:=reg32toreg16(p^.location.register);
  860. end;
  861. in_length_string :
  862. begin
  863. secondpass(p^.left);
  864. set_location(p^.location,p^.left^.location);
  865. { length in ansi strings is at offset -8 }
  866. if is_ansistring(p^.left^.resulttype) then
  867. dec(p^.location.reference.offset,8)
  868. { char is always 1, so make it a constant value }
  869. else if is_char(p^.left^.resulttype) then
  870. begin
  871. clear_location(p^.location);
  872. p^.location.loc:=LOC_MEM;
  873. p^.location.reference.is_immediate:=true;
  874. p^.location.reference.offset:=1;
  875. end;
  876. end;
  877. in_pred_x,
  878. in_succ_x:
  879. begin
  880. secondpass(p^.left);
  881. if not (cs_check_overflow in aktlocalswitches) then
  882. if p^.inlinenumber=in_pred_x then
  883. asmop:=A_DEC
  884. else
  885. asmop:=A_INC
  886. else
  887. if p^.inlinenumber=in_pred_x then
  888. asmop:=A_SUB
  889. else
  890. asmop:=A_ADD;
  891. case p^.resulttype^.size of
  892. 4 : opsize:=S_L;
  893. 2 : opsize:=S_W;
  894. 1 : opsize:=S_B;
  895. else
  896. internalerror(10080);
  897. end;
  898. p^.location.loc:=LOC_REGISTER;
  899. if p^.left^.location.loc<>LOC_REGISTER then
  900. begin
  901. p^.location.register:=getregister32;
  902. if (p^.resulttype^.size=2) then
  903. p^.location.register:=reg32toreg16(p^.location.register);
  904. if (p^.resulttype^.size=1) then
  905. p^.location.register:=reg32toreg8(p^.location.register);
  906. if p^.left^.location.loc=LOC_CREGISTER then
  907. emit_reg_reg(A_MOV,opsize,p^.left^.location.register,
  908. p^.location.register)
  909. else
  910. if p^.left^.location.loc=LOC_FLAGS then
  911. emit_flag2reg(p^.left^.location.resflags,p^.location.register)
  912. else
  913. begin
  914. del_reference(p^.left^.location.reference);
  915. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,newreference(p^.left^.location.reference),
  916. p^.location.register)));
  917. end;
  918. end
  919. else p^.location.register:=p^.left^.location.register;
  920. if not (cs_check_overflow in aktlocalswitches) then
  921. exprasmlist^.concat(new(pai386,op_reg(asmop,opsize,
  922. p^.location.register)))
  923. else
  924. exprasmlist^.concat(new(pai386,op_const_reg(asmop,opsize,1,
  925. p^.location.register)));
  926. emitoverflowcheck(p);
  927. emitrangecheck(p,p^.resulttype);
  928. end;
  929. in_dec_x,
  930. in_inc_x :
  931. begin
  932. { set defaults }
  933. addvalue:=1;
  934. addconstant:=true;
  935. { load first parameter, must be a reference }
  936. secondpass(p^.left^.left);
  937. case p^.left^.left^.resulttype^.deftype of
  938. orddef,
  939. enumdef : begin
  940. case p^.left^.left^.resulttype^.size of
  941. 1 : opsize:=S_B;
  942. 2 : opsize:=S_W;
  943. 4 : opsize:=S_L;
  944. end;
  945. end;
  946. pointerdef : begin
  947. opsize:=S_L;
  948. if porddef(ppointerdef(p^.left^.left^.resulttype)^.definition)=voiddef then
  949. addvalue:=1
  950. else
  951. addvalue:=ppointerdef(p^.left^.left^.resulttype)^.definition^.savesize;
  952. end;
  953. else
  954. internalerror(10081);
  955. end;
  956. { second argument specified?, must be a s32bit in register }
  957. if assigned(p^.left^.right) then
  958. begin
  959. secondpass(p^.left^.right^.left);
  960. { when constant, just multiply the addvalue }
  961. if is_constintnode(p^.left^.right^.left) then
  962. addvalue:=addvalue*get_ordinal_value(p^.left^.right^.left)
  963. else
  964. begin
  965. case p^.left^.right^.left^.location.loc of
  966. LOC_REGISTER,
  967. LOC_CREGISTER : hregister:=p^.left^.right^.left^.location.register;
  968. LOC_MEM,
  969. LOC_REFERENCE : begin
  970. del_reference(p^.left^.right^.left^.location.reference);
  971. hregister:=getregister32;
  972. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  973. newreference(p^.left^.right^.left^.location.reference),hregister)));
  974. end;
  975. else
  976. internalerror(10082);
  977. end;
  978. { insert multiply with addvalue if its >1 }
  979. if addvalue>1 then
  980. exprasmlist^.concat(new(pai386,op_const_reg(A_IMUL,opsize,
  981. addvalue,hregister)));
  982. addconstant:=false;
  983. end;
  984. end;
  985. { write the add instruction }
  986. if addconstant then
  987. begin
  988. if (addvalue=1) and not(cs_check_overflow in aktlocalswitches) then
  989. begin
  990. if p^.left^.left^.location.loc=LOC_CREGISTER then
  991. exprasmlist^.concat(new(pai386,op_reg(incdecop[p^.inlinenumber],opsize,
  992. p^.left^.left^.location.register)))
  993. else
  994. exprasmlist^.concat(new(pai386,op_ref(incdecop[p^.inlinenumber],opsize,
  995. newreference(p^.left^.left^.location.reference))))
  996. end
  997. else
  998. begin
  999. if p^.left^.left^.location.loc=LOC_CREGISTER then
  1000. exprasmlist^.concat(new(pai386,op_const_reg(addsubop[p^.inlinenumber],opsize,
  1001. addvalue,p^.left^.left^.location.register)))
  1002. else
  1003. exprasmlist^.concat(new(pai386,op_const_ref(addsubop[p^.inlinenumber],opsize,
  1004. addvalue,newreference(p^.left^.left^.location.reference))));
  1005. end
  1006. end
  1007. else
  1008. begin
  1009. { BUG HERE : detected with nasm :
  1010. hregister is allways 32 bit
  1011. it should be converted to 16 or 8 bit depending on op_size PM }
  1012. { still not perfect :
  1013. if hregister is already a 16 bit reg ?? PM }
  1014. case opsize of
  1015. S_B : hregister:=reg32toreg8(hregister);
  1016. S_W : hregister:=reg32toreg16(hregister);
  1017. end;
  1018. if p^.left^.left^.location.loc=LOC_CREGISTER then
  1019. exprasmlist^.concat(new(pai386,op_reg_reg(addsubop[p^.inlinenumber],opsize,
  1020. hregister,p^.left^.left^.location.register)))
  1021. else
  1022. exprasmlist^.concat(new(pai386,op_reg_ref(addsubop[p^.inlinenumber],opsize,
  1023. hregister,newreference(p^.left^.left^.location.reference))));
  1024. case opsize of
  1025. S_B : hregister:=reg8toreg32(hregister);
  1026. S_W : hregister:=reg16toreg32(hregister);
  1027. end;
  1028. ungetregister32(hregister);
  1029. end;
  1030. emitoverflowcheck(p^.left^.left);
  1031. emitrangecheck(p^.left^.left,p^.left^.left^.resulttype);
  1032. end;
  1033. in_assigned_x :
  1034. begin
  1035. secondpass(p^.left^.left);
  1036. p^.location.loc:=LOC_FLAGS;
  1037. if (p^.left^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  1038. begin
  1039. exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_L,
  1040. p^.left^.left^.location.register,
  1041. p^.left^.left^.location.register)));
  1042. ungetregister32(p^.left^.left^.location.register);
  1043. end
  1044. else
  1045. begin
  1046. exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_L,0,
  1047. newreference(p^.left^.left^.location.reference))));
  1048. del_reference(p^.left^.left^.location.reference);
  1049. end;
  1050. p^.location.resflags:=F_NE;
  1051. end;
  1052. in_reset_typedfile,in_rewrite_typedfile :
  1053. begin
  1054. pushusedregisters(pushed,$ff);
  1055. exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,pfiledef(p^.left^.resulttype)^.typed_as^.size)));
  1056. secondpass(p^.left);
  1057. emitpushreferenceaddr(p^.left^.location.reference);
  1058. if p^.inlinenumber=in_reset_typedfile then
  1059. emitcall('FPC_RESET_TYPED')
  1060. else
  1061. emitcall('FPC_REWRITE_TYPED');
  1062. popusedregisters(pushed);
  1063. end;
  1064. in_write_x :
  1065. handlereadwrite(false,false);
  1066. in_writeln_x :
  1067. handlereadwrite(false,true);
  1068. in_read_x :
  1069. handlereadwrite(true,false);
  1070. in_readln_x :
  1071. handlereadwrite(true,true);
  1072. in_str_x_string :
  1073. begin
  1074. handle_str;
  1075. maybe_loadesi;
  1076. end;
  1077. {$IfnDef OLDVAL}
  1078. in_val_x :
  1079. Begin
  1080. handle_val;
  1081. End;
  1082. {$EndIf OLDVAL}
  1083. in_include_x_y,
  1084. in_exclude_x_y:
  1085. begin
  1086. secondpass(p^.left^.left);
  1087. if p^.left^.right^.left^.treetype=ordconstn then
  1088. begin
  1089. { calculate bit position }
  1090. l:=1 shl (p^.left^.right^.left^.value mod 32);
  1091. { determine operator }
  1092. if p^.inlinenumber=in_include_x_y then
  1093. asmop:=A_OR
  1094. else
  1095. begin
  1096. asmop:=A_AND;
  1097. l:=not(l);
  1098. end;
  1099. if (p^.left^.left^.location.loc=LOC_REFERENCE) then
  1100. begin
  1101. inc(p^.left^.left^.location.reference.offset,(p^.left^.right^.left^.value div 32)*4);
  1102. exprasmlist^.concat(new(pai386,op_const_ref(asmop,S_L,
  1103. l,newreference(p^.left^.left^.location.reference))));
  1104. del_reference(p^.left^.left^.location.reference);
  1105. end
  1106. else
  1107. { LOC_CREGISTER }
  1108. exprasmlist^.concat(new(pai386,op_const_reg(asmop,S_L,
  1109. l,p^.left^.left^.location.register)));
  1110. end
  1111. else
  1112. begin
  1113. { generate code for the element to set }
  1114. ispushed:=maybe_push(p^.left^.right^.left^.registers32,p^.left^.left);
  1115. secondpass(p^.left^.right^.left);
  1116. if ispushed then
  1117. restore(p^.left^.left);
  1118. { determine asm operator }
  1119. if p^.inlinenumber=in_include_x_y then
  1120. asmop:=A_BTS
  1121. else
  1122. asmop:=A_BTR;
  1123. if psetdef(p^.left^.resulttype)^.settype=smallset then
  1124. begin
  1125. if p^.left^.right^.left^.location.loc in [LOC_CREGISTER,LOC_REGISTER] then
  1126. hregister:=p^.left^.right^.left^.location.register
  1127. else
  1128. begin
  1129. hregister:=R_EDI;
  1130. opsize:=def2def_opsize(p^.left^.right^.left^.resulttype,u32bitdef);
  1131. if opsize in [S_B,S_W,S_L] then
  1132. op:=A_MOV
  1133. else
  1134. op:=A_MOVZX;
  1135. exprasmlist^.concat(new(pai386,op_ref_reg(op,opsize,
  1136. newreference(p^.left^.right^.left^.location.reference),R_EDI)));
  1137. end;
  1138. if (p^.left^.left^.location.loc=LOC_REFERENCE) then
  1139. exprasmlist^.concat(new(pai386,op_reg_ref(asmop,S_L,hregister,
  1140. newreference(p^.left^.right^.left^.location.reference))))
  1141. else
  1142. exprasmlist^.concat(new(pai386,op_reg_reg(asmop,S_L,hregister,
  1143. p^.left^.right^.left^.location.register)));
  1144. end
  1145. else
  1146. begin
  1147. pushsetelement(p^.left^.right^.left);
  1148. { normset is allways a ref }
  1149. emitpushreferenceaddr(p^.left^.left^.location.reference);
  1150. if p^.inlinenumber=in_include_x_y then
  1151. emitcall('FPC_SET_SET_BYTE')
  1152. else
  1153. emitcall('FPC_SET_UNSET_BYTE');
  1154. {CGMessage(cg_e_include_not_implemented);}
  1155. end;
  1156. end;
  1157. end;
  1158. else internalerror(9);
  1159. end;
  1160. { reset pushedparasize }
  1161. pushedparasize:=oldpushedparasize;
  1162. end;
  1163. end.
  1164. {
  1165. $Log$
  1166. Revision 1.55 1999-05-27 19:44:13 peter
  1167. * removed oldasm
  1168. * plabel -> pasmlabel
  1169. * -a switches to source writing automaticly
  1170. * assembler readers OOPed
  1171. * asmsymbol automaticly external
  1172. * jumptables and other label fixes for asm readers
  1173. Revision 1.54 1999/05/23 19:55:11 florian
  1174. * qword/int64 multiplication fixed
  1175. + qword/int64 subtraction
  1176. Revision 1.53 1999/05/23 18:42:01 florian
  1177. * better error recovering in typed constants
  1178. * some problems with arrays of const fixed, some problems
  1179. due my previous
  1180. - the location type of array constructor is now LOC_MEM
  1181. - the pushing of high fixed
  1182. - parameter copying fixed
  1183. - zero temp. allocation removed
  1184. * small problem in the assembler writers fixed:
  1185. ref to nil wasn't written correctly
  1186. Revision 1.52 1999/05/21 13:54:50 peter
  1187. * NEWLAB for label as symbol
  1188. Revision 1.51 1999/05/18 21:58:27 florian
  1189. * fixed some bugs related to temp. ansistrings and functions results
  1190. which return records/objects/arrays which need init/final.
  1191. Revision 1.50 1999/05/17 21:57:03 florian
  1192. * new temporary ansistring handling
  1193. Revision 1.49 1999/05/12 15:46:26 pierre
  1194. * handle_str disposetree was badly placed
  1195. Revision 1.48 1999/05/12 00:19:42 peter
  1196. * removed R_DEFAULT_SEG
  1197. * uniform float names
  1198. Revision 1.47 1999/05/06 09:05:13 peter
  1199. * generic write_float and str_float
  1200. * fixed constant float conversions
  1201. Revision 1.46 1999/05/05 16:18:20 jonas
  1202. * changes to handle_val so register vars are pushed/poped only once
  1203. Revision 1.45 1999/05/01 13:24:08 peter
  1204. * merged nasm compiler
  1205. * old asm moved to oldasm/
  1206. Revision 1.44 1999/04/26 18:28:13 peter
  1207. * better read/write array
  1208. Revision 1.43 1999/04/19 09:45:48 pierre
  1209. + cdecl or stdcall push all args with longint size
  1210. * tempansi stuff cleaned up
  1211. Revision 1.42 1999/04/14 09:11:59 peter
  1212. * fixed include
  1213. Revision 1.41 1999/04/08 23:59:49 pierre
  1214. * temp string for val code freed
  1215. Revision 1.40 1999/04/08 15:57:46 peter
  1216. + subrange checking for readln()
  1217. Revision 1.39 1999/04/07 15:31:16 pierre
  1218. * all formaldefs are now a sinlge definition
  1219. cformaldef (this was necessary for double_checksum)
  1220. + small part of double_checksum code
  1221. Revision 1.38 1999/04/05 11:07:26 jonas
  1222. * fixed some typos in the constants of the range checking for Val
  1223. Revision 1.37 1999/04/01 22:07:51 peter
  1224. * universal string names (ansistr instead of stransi) for val/str
  1225. Revision 1.36 1999/04/01 06:21:04 jonas
  1226. * added initialization for has_32bit_code (caused problems with Val statement
  1227. without code parameter)
  1228. Revision 1.35 1999/03/31 20:30:49 michael
  1229. * fixed typo: odlval to oldval
  1230. Revision 1.34 1999/03/31 17:13:09 jonas
  1231. * bugfix for -Ox with internal val code
  1232. * internal val code now requires less free registers
  1233. * internal val code no longer needs a temp var for range checking
  1234. Revision 1.33 1999/03/26 00:24:15 peter
  1235. * last para changed to long for easier pushing with 4 byte aligns
  1236. Revision 1.32 1999/03/26 00:05:26 peter
  1237. * released valintern
  1238. + deffile is now removed when compiling is finished
  1239. * ^( compiles now correct
  1240. + static directive
  1241. * shrd fixed
  1242. Revision 1.31 1999/03/24 23:16:49 peter
  1243. * fixed bugs 212,222,225,227,229,231,233
  1244. Revision 1.30 1999/03/16 17:52:56 jonas
  1245. * changes for internal Val code (do a "make cycle OPT=-dvalintern" to test)
  1246. * in cgi386inl: also range checking for subrange types (compile with "-dreadrangecheck")
  1247. * in cgai386: also small fixes to emitrangecheck
  1248. Revision 1.29 1999/02/25 21:02:27 peter
  1249. * ag386bin updates
  1250. + coff writer
  1251. Revision 1.28 1999/02/22 02:15:11 peter
  1252. * updates for ag386bin
  1253. Revision 1.27 1999/02/17 14:21:40 pierre
  1254. * unused local removed
  1255. Revision 1.26 1999/02/15 11:40:21 pierre
  1256. * pred/succ with overflow check must use ADD DEC !!
  1257. Revision 1.25 1999/02/05 10:56:19 florian
  1258. * in some cases a writeln of temp. ansistrings cause a memory leak, fixed
  1259. Revision 1.24 1999/01/21 22:10:39 peter
  1260. * fixed array of const
  1261. * generic platform independent high() support
  1262. Revision 1.23 1999/01/06 12:23:29 florian
  1263. * str(...) for ansi/long and widestrings fixed
  1264. Revision 1.22 1998/12/11 23:36:07 florian
  1265. + again more stuff for int64/qword:
  1266. - comparision operators
  1267. - code generation for: str, read(ln), write(ln)
  1268. Revision 1.21 1998/12/11 00:02:50 peter
  1269. + globtype,tokens,version unit splitted from globals
  1270. Revision 1.20 1998/11/27 14:50:32 peter
  1271. + open strings, $P switch support
  1272. Revision 1.19 1998/11/26 13:10:40 peter
  1273. * new int - int conversion -dNEWCNV
  1274. * some function renamings
  1275. Revision 1.18 1998/11/24 17:04:27 peter
  1276. * fixed length(char) when char is a variable
  1277. Revision 1.17 1998/11/05 12:02:33 peter
  1278. * released useansistring
  1279. * removed -Sv, its now available in fpc modes
  1280. Revision 1.16 1998/10/22 17:11:13 pierre
  1281. + terminated the include exclude implementation for i386
  1282. * enums inside records fixed
  1283. Revision 1.15 1998/10/21 15:12:50 pierre
  1284. * bug fix for IOCHECK inside a procedure with iocheck modifier
  1285. * removed the GPF for unexistant overloading
  1286. (firstcall was called with procedinition=nil !)
  1287. * changed typen to what Florian proposed
  1288. gentypenode(p : pdef) sets the typenodetype field
  1289. and resulttype is only set if inside bt_type block !
  1290. Revision 1.14 1998/10/20 08:06:40 pierre
  1291. * several memory corruptions due to double freemem solved
  1292. => never use p^.loc.location:=p^.left^.loc.location;
  1293. + finally I added now by default
  1294. that ra386dir translates global and unit symbols
  1295. + added a first field in tsymtable and
  1296. a nextsym field in tsym
  1297. (this allows to obtain ordered type info for
  1298. records and objects in gdb !)
  1299. Revision 1.13 1998/10/13 16:50:02 pierre
  1300. * undid some changes of Peter that made the compiler wrong
  1301. for m68k (I had to reinsert some ifdefs)
  1302. * removed several memory leaks under m68k
  1303. * removed the meory leaks for assembler readers
  1304. * cross compiling shoud work again better
  1305. ( crosscompiling sysamiga works
  1306. but as68k still complain about some code !)
  1307. Revision 1.12 1998/10/08 17:17:12 pierre
  1308. * current_module old scanner tagged as invalid if unit is recompiled
  1309. + added ppheap for better info on tracegetmem of heaptrc
  1310. (adds line column and file index)
  1311. * several memory leaks removed ith help of heaptrc !!
  1312. Revision 1.11 1998/10/05 21:33:15 peter
  1313. * fixed 161,165,166,167,168
  1314. Revision 1.10 1998/10/05 12:32:44 peter
  1315. + assert() support
  1316. Revision 1.8 1998/10/02 10:35:09 peter
  1317. * support for inc(pointer,value) which now increases with value instead
  1318. of 0*value :)
  1319. Revision 1.7 1998/09/21 08:45:07 pierre
  1320. + added vmt_offset in tobjectdef.write for fututre use
  1321. (first steps to have objects without vmt if no virtual !!)
  1322. + added fpu_used field for tabstractprocdef :
  1323. sets this level to 2 if the functions return with value in FPU
  1324. (is then set to correct value at parsing of implementation)
  1325. THIS MIGHT refuse some code with FPU expression too complex
  1326. that were accepted before and even in some cases
  1327. that don't overflow in fact
  1328. ( like if f : float; is a forward that finally in implementation
  1329. only uses one fpu register !!)
  1330. Nevertheless I think that it will improve security on
  1331. FPU operations !!
  1332. * most other changes only for UseBrowser code
  1333. (added symtable references for record and objects)
  1334. local switch for refs to args and local of each function
  1335. (static symtable still missing)
  1336. UseBrowser still not stable and probably broken by
  1337. the definition hash array !!
  1338. Revision 1.6 1998/09/20 12:26:37 peter
  1339. * merged fixes
  1340. Revision 1.5 1998/09/17 09:42:15 peter
  1341. + pass_2 for cg386
  1342. * Message() -> CGMessage() for pass_1/pass_2
  1343. Revision 1.4 1998/09/14 10:43:49 peter
  1344. * all internal RTL functions start with FPC_
  1345. Revision 1.3.2.1 1998/09/20 12:20:07 peter
  1346. * Fixed stack not on 4 byte boundary when doing a call
  1347. Revision 1.3 1998/09/05 23:03:57 florian
  1348. * some fixes to get -Or work:
  1349. - inc/dec didn't take care of CREGISTER
  1350. - register calculcation of inc/dec was wrong
  1351. - var/const parameters get now assigned 32 bit register, but
  1352. const parameters only if they are passed by reference !
  1353. Revision 1.2 1998/09/04 08:41:40 peter
  1354. * updated some error CGMessages
  1355. Revision 1.1 1998/08/31 12:22:14 peter
  1356. * secondinline moved to cg386inl
  1357. Revision 1.19 1998/08/31 08:52:03 peter
  1358. * fixed error 10 with succ() and pref()
  1359. Revision 1.18 1998/08/20 21:36:38 peter
  1360. * fixed 'with object do' bug
  1361. Revision 1.17 1998/08/19 16:07:36 jonas
  1362. * changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
  1363. Revision 1.16 1998/08/18 09:24:36 pierre
  1364. * small warning position bug fixed
  1365. * support_mmx switches splitting was missing
  1366. * rhide error and warning output corrected
  1367. Revision 1.15 1998/08/13 11:00:09 peter
  1368. * fixed procedure<>procedure construct
  1369. Revision 1.14 1998/08/11 14:05:33 peter
  1370. * fixed sizeof(array of char)
  1371. Revision 1.13 1998/08/10 14:49:45 peter
  1372. + localswitches, moduleswitches, globalswitches splitting
  1373. Revision 1.12 1998/07/30 13:30:31 florian
  1374. * final implemenation of exception support, maybe it needs
  1375. some fixes :)
  1376. Revision 1.11 1998/07/24 22:16:52 florian
  1377. * internal error 10 together with array access fixed. I hope
  1378. that's the final fix.
  1379. Revision 1.10 1998/07/18 22:54:23 florian
  1380. * some ansi/wide/longstring support fixed:
  1381. o parameter passing
  1382. o returning as result from functions
  1383. Revision 1.9 1998/07/07 17:40:37 peter
  1384. * packrecords 4 works
  1385. * word aligning of parameters
  1386. Revision 1.8 1998/07/06 15:51:15 michael
  1387. Added length checking for string reading
  1388. Revision 1.7 1998/07/06 14:19:51 michael
  1389. + Added calls for reading/writing ansistrings
  1390. Revision 1.6 1998/07/01 15:28:48 peter
  1391. + better writeln/readln handling, now 100% like tp7
  1392. Revision 1.5 1998/06/25 14:04:17 peter
  1393. + internal inc/dec
  1394. Revision 1.4 1998/06/25 08:48:06 florian
  1395. * first version of rtti support
  1396. Revision 1.3 1998/06/09 16:01:33 pierre
  1397. + added procedure directive parsing for procvars
  1398. (accepted are popstack cdecl and pascal)
  1399. + added C vars with the following syntax
  1400. var C calias 'true_c_name';(can be followed by external)
  1401. reason is that you must add the Cprefix
  1402. which is target dependent
  1403. Revision 1.2 1998/06/08 13:13:29 pierre
  1404. + temporary variables now in temp_gen.pas unit
  1405. because it is processor independent
  1406. * mppc68k.bat modified to undefine i386 and support_mmx
  1407. (which are defaults for i386)
  1408. Revision 1.1 1998/06/05 17:44:10 peter
  1409. * splitted cgi386
  1410. }