ninl.pas 67 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 by Florian Klaempfl
  4. Type checking and register allocation for 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 ninl;
  19. {$i defines.inc}
  20. interface
  21. uses
  22. node,htypechk;
  23. {$i compinnr.inc}
  24. type
  25. tinlinenode = class(tunarynode)
  26. inlinenumber : byte;
  27. constructor create(number : byte;is_const:boolean;l : tnode);virtual;
  28. function getcopy : tnode;override;
  29. function pass_1 : tnode;override;
  30. function docompare(p: tnode): boolean; override;
  31. end;
  32. var
  33. cinlinenode : class of tinlinenode;
  34. function geninlinenode(number : byte;is_const:boolean;l : tnode) : tinlinenode;
  35. implementation
  36. uses
  37. verbose,globals,systems,
  38. globtype,
  39. symconst,symtype,symdef,symsym,symtable,types,
  40. pass_1,
  41. ncal,ncon,ncnv,nadd,nld,nbas,
  42. cpubase,hcodegen,tgcpu
  43. {$ifdef newcg}
  44. ,cgbase
  45. {$endif newcg}
  46. ;
  47. function geninlinenode(number : byte;is_const:boolean;l : tnode) : tinlinenode;
  48. begin
  49. geninlinenode:=cinlinenode.create(number,is_const,l);
  50. end;
  51. {*****************************************************************************
  52. TINLINENODE
  53. *****************************************************************************}
  54. constructor tinlinenode.create(number : byte;is_const:boolean;l : tnode);
  55. begin
  56. inherited create(inlinen,l);
  57. if is_const then
  58. include(flags,nf_inlineconst);
  59. inlinenumber:=number;
  60. end;
  61. function tinlinenode.getcopy : tnode;
  62. var
  63. n : tinlinenode;
  64. begin
  65. n:=tinlinenode(inherited getcopy);
  66. n.inlinenumber:=inlinenumber;
  67. result:=n;
  68. end;
  69. {$ifdef fpc}
  70. {$maxfpuregisters 0}
  71. {$endif fpc}
  72. function tinlinenode.pass_1 : tnode;
  73. var
  74. vl,vl2,counter : longint;
  75. vr : bestreal;
  76. p1,hp,hpp : tnode;
  77. ppn : tcallparanode;
  78. dummycoll: tparaitem;
  79. {$ifndef NOCOLONCHECK}
  80. frac_para,length_para : tnode;
  81. {$endif ndef NOCOLONCHECK}
  82. extra_register,
  83. isreal,
  84. iswrite,
  85. file_is_typed : boolean;
  86. function do_lowhigh(adef : pdef) : tnode;
  87. var
  88. v : longint;
  89. enum : penumsym;
  90. begin
  91. case Adef^.deftype of
  92. orddef:
  93. begin
  94. if inlinenumber=in_low_x then
  95. v:=porddef(adef)^.low
  96. else
  97. v:=porddef(adef)^.high;
  98. hp:=genordinalconstnode(v,adef);
  99. firstpass(hp);
  100. do_lowhigh:=hp;
  101. end;
  102. enumdef:
  103. begin
  104. enum:=penumsym(Penumdef(Adef)^.firstenum);
  105. if inlinenumber=in_high_x then
  106. while enum^.nextenum<>nil do
  107. enum:=enum^.nextenum;
  108. hp:=genenumnode(enum);
  109. do_lowhigh:=hp;
  110. end;
  111. else
  112. internalerror(87);
  113. end;
  114. end;
  115. function getconstrealvalue : bestreal;
  116. begin
  117. case left.nodetype of
  118. ordconstn:
  119. getconstrealvalue:=tordconstnode(left).value;
  120. realconstn:
  121. getconstrealvalue:=trealconstnode(left).value_real;
  122. else
  123. internalerror(309992);
  124. end;
  125. end;
  126. procedure setconstrealvalue(r : bestreal);
  127. var
  128. hp : tnode;
  129. begin
  130. hp:=genrealconstnode(r,bestrealdef^);
  131. firstpass(hp);
  132. pass_1:=hp;
  133. end;
  134. procedure handleextendedfunction;
  135. begin
  136. location.loc:=LOC_FPU;
  137. resulttype:=s80floatdef;
  138. { redo firstpass for varstate status PM }
  139. set_varstate(left,true);
  140. if (left.resulttype^.deftype<>floatdef) or
  141. (pfloatdef(left.resulttype)^.typ<>s80real) then
  142. begin
  143. left:=gentypeconvnode(left,s80floatdef);
  144. firstpass(left);
  145. end;
  146. registers32:=left.registers32;
  147. registersfpu:=left.registersfpu;
  148. {$ifdef SUPPORT_MMX}
  149. registersmmx:=left.registersmmx;
  150. {$endif SUPPORT_MMX}
  151. end;
  152. begin
  153. result:=nil;
  154. { if we handle writeln; left contains no valid address }
  155. if assigned(left) then
  156. begin
  157. if left.nodetype=callparan then
  158. tcallparanode(left).firstcallparan(nil,false)
  159. else
  160. firstpass(left);
  161. left_max;
  162. set_location(location,left.location);
  163. end;
  164. inc(parsing_para_level);
  165. { handle intern constant functions in separate case }
  166. if nf_inlineconst in flags then
  167. begin
  168. hp:=nil;
  169. { no parameters? }
  170. if not assigned(left) then
  171. begin
  172. case inlinenumber of
  173. in_const_pi :
  174. hp:=genrealconstnode(pi,bestrealdef^);
  175. else
  176. internalerror(89);
  177. end;
  178. end
  179. else
  180. { process constant expression with parameter }
  181. begin
  182. vl:=0;
  183. vl2:=0; { second parameter Ex: ptr(vl,vl2) }
  184. vr:=0;
  185. isreal:=false;
  186. case left.nodetype of
  187. realconstn :
  188. begin
  189. isreal:=true;
  190. vr:=trealconstnode(left).value_real;
  191. end;
  192. ordconstn :
  193. vl:=tordconstnode(left).value;
  194. callparan :
  195. begin
  196. { both exists, else it was not generated }
  197. vl:=tordconstnode(tcallparanode(left).left).value;
  198. vl2:=tordconstnode(tcallparanode(tcallparanode(left).right).left).value;
  199. end;
  200. else
  201. CGMessage(cg_e_illegal_expression);
  202. end;
  203. case inlinenumber of
  204. in_const_trunc :
  205. begin
  206. if isreal then
  207. begin
  208. if (vr>=2147483648.0) or (vr<=-2147483649.0) then
  209. begin
  210. CGMessage(parser_e_range_check_error);
  211. hp:=genordinalconstnode(1,s32bitdef)
  212. end
  213. else
  214. hp:=genordinalconstnode(trunc(vr),s32bitdef)
  215. end
  216. else
  217. hp:=genordinalconstnode(trunc(vl),s32bitdef);
  218. end;
  219. in_const_round :
  220. begin
  221. if isreal then
  222. begin
  223. if (vr>=2147483647.5) or (vr<=-2147483648.5) then
  224. begin
  225. CGMessage(parser_e_range_check_error);
  226. hp:=genordinalconstnode(1,s32bitdef)
  227. end
  228. else
  229. hp:=genordinalconstnode(round(vr),s32bitdef)
  230. end
  231. else
  232. hp:=genordinalconstnode(round(vl),s32bitdef);
  233. end;
  234. in_const_frac :
  235. begin
  236. if isreal then
  237. hp:=genrealconstnode(frac(vr),bestrealdef^)
  238. else
  239. hp:=genrealconstnode(frac(vl),bestrealdef^);
  240. end;
  241. in_const_int :
  242. begin
  243. if isreal then
  244. hp:=genrealconstnode(int(vr),bestrealdef^)
  245. else
  246. hp:=genrealconstnode(int(vl),bestrealdef^);
  247. end;
  248. in_const_abs :
  249. begin
  250. if isreal then
  251. hp:=genrealconstnode(abs(vr),bestrealdef^)
  252. else
  253. hp:=genordinalconstnode(abs(vl),left.resulttype);
  254. end;
  255. in_const_sqr :
  256. begin
  257. if isreal then
  258. hp:=genrealconstnode(sqr(vr),bestrealdef^)
  259. else
  260. hp:=genordinalconstnode(sqr(vl),left.resulttype);
  261. end;
  262. in_const_odd :
  263. begin
  264. if isreal then
  265. CGMessage1(type_e_integer_expr_expected,left.resulttype^.typename)
  266. else
  267. hp:=genordinalconstnode(byte(odd(vl)),booldef);
  268. end;
  269. in_const_swap_word :
  270. begin
  271. if isreal then
  272. CGMessage1(type_e_integer_expr_expected,left.resulttype^.typename)
  273. else
  274. hp:=genordinalconstnode((vl and $ff) shl 8+(vl shr 8),left.resulttype);
  275. end;
  276. in_const_swap_long :
  277. begin
  278. if isreal then
  279. CGMessage(type_e_mismatch)
  280. else
  281. hp:=genordinalconstnode((vl and $ffff) shl 16+(vl shr 16),left.resulttype);
  282. end;
  283. in_const_ptr :
  284. begin
  285. if isreal then
  286. CGMessage(type_e_mismatch)
  287. else
  288. hp:=genordinalconstnode((vl2 shl 4)+vl,voidfarpointerdef);
  289. end;
  290. in_const_sqrt :
  291. begin
  292. if isreal then
  293. begin
  294. if vr<0.0 then
  295. CGMessage(type_e_wrong_math_argument)
  296. else
  297. hp:=genrealconstnode(sqrt(vr),bestrealdef^)
  298. end
  299. else
  300. begin
  301. if vl<0 then
  302. CGMessage(type_e_wrong_math_argument)
  303. else
  304. hp:=genrealconstnode(sqrt(vl),bestrealdef^);
  305. end;
  306. end;
  307. in_const_arctan :
  308. begin
  309. if isreal then
  310. hp:=genrealconstnode(arctan(vr),bestrealdef^)
  311. else
  312. hp:=genrealconstnode(arctan(vl),bestrealdef^);
  313. end;
  314. in_const_cos :
  315. begin
  316. if isreal then
  317. hp:=genrealconstnode(cos(vr),bestrealdef^)
  318. else
  319. hp:=genrealconstnode(cos(vl),bestrealdef^);
  320. end;
  321. in_const_sin :
  322. begin
  323. if isreal then
  324. hp:=genrealconstnode(sin(vr),bestrealdef^)
  325. else
  326. hp:=genrealconstnode(sin(vl),bestrealdef^);
  327. end;
  328. in_const_exp :
  329. begin
  330. if isreal then
  331. hp:=genrealconstnode(exp(vr),bestrealdef^)
  332. else
  333. hp:=genrealconstnode(exp(vl),bestrealdef^);
  334. end;
  335. in_const_ln :
  336. begin
  337. if isreal then
  338. begin
  339. if vr<=0.0 then
  340. CGMessage(type_e_wrong_math_argument)
  341. else
  342. hp:=genrealconstnode(ln(vr),bestrealdef^)
  343. end
  344. else
  345. begin
  346. if vl<=0 then
  347. CGMessage(type_e_wrong_math_argument)
  348. else
  349. hp:=genrealconstnode(ln(vl),bestrealdef^);
  350. end;
  351. end;
  352. else
  353. internalerror(88);
  354. end;
  355. end;
  356. if hp=nil then
  357. hp:=tnode.create(errorn);
  358. firstpass(hp);
  359. result:=hp;
  360. end
  361. else
  362. begin
  363. case inlinenumber of
  364. in_lo_qword,
  365. in_hi_qword,
  366. in_lo_long,
  367. in_hi_long,
  368. in_lo_word,
  369. in_hi_word:
  370. begin
  371. set_varstate(left,true);
  372. if registers32<1 then
  373. registers32:=1;
  374. if inlinenumber in [in_lo_word,in_hi_word] then
  375. resulttype:=u8bitdef
  376. else if inlinenumber in [in_lo_qword,in_hi_qword] then
  377. begin
  378. resulttype:=u32bitdef;
  379. if (m_tp in aktmodeswitches) or
  380. (m_delphi in aktmodeswitches) then
  381. CGMessage(type_w_maybe_wrong_hi_lo);
  382. end
  383. else
  384. begin
  385. resulttype:=u16bitdef;
  386. if (m_tp in aktmodeswitches) or
  387. (m_delphi in aktmodeswitches) then
  388. CGMessage(type_w_maybe_wrong_hi_lo);
  389. end;
  390. location.loc:=LOC_REGISTER;
  391. if not is_integer(left.resulttype) then
  392. CGMessage(type_e_mismatch)
  393. else
  394. begin
  395. if left.nodetype=ordconstn then
  396. begin
  397. case inlinenumber of
  398. in_lo_word : hp:=genordinalconstnode(tordconstnode(left).value and $ff,left.resulttype);
  399. in_hi_word : hp:=genordinalconstnode(tordconstnode(left).value shr 8,left.resulttype);
  400. in_lo_long : hp:=genordinalconstnode(tordconstnode(left).value and $ffff,left.resulttype);
  401. in_hi_long : hp:=genordinalconstnode(tordconstnode(left).value shr 16,left.resulttype);
  402. in_lo_qword : hp:=genordinalconstnode(tordconstnode(left).value and $ffffffff,left.resulttype);
  403. in_hi_qword : hp:=genordinalconstnode(tordconstnode(left).value shr 32,left.resulttype);
  404. end;
  405. firstpass(hp);
  406. result:=hp;
  407. end;
  408. end;
  409. end;
  410. in_sizeof_x:
  411. begin
  412. set_varstate(left,false);
  413. if push_high_param(left.resulttype) then
  414. begin
  415. getsymonlyin(tloadnode(left).symtable,'high'+pvarsym(tloadnode(left).symtableentry)^.name);
  416. hp:=caddnode.create(addn,genloadnode(pvarsym(srsym),tloadnode(left).symtable),
  417. genordinalconstnode(1,s32bitdef));
  418. if (left.resulttype^.deftype=arraydef) and
  419. (parraydef(left.resulttype)^.elesize<>1) then
  420. hp:=caddnode.create(muln,hp,genordinalconstnode(parraydef(left.resulttype)^.elesize,s32bitdef));
  421. firstpass(hp);
  422. result:=hp;
  423. end
  424. else
  425. begin
  426. if registers32<1 then
  427. registers32:=1;
  428. resulttype:=s32bitdef;
  429. location.loc:=LOC_REGISTER;
  430. end;
  431. end;
  432. in_typeof_x:
  433. begin
  434. set_varstate(left,false);
  435. if registers32<1 then
  436. registers32:=1;
  437. location.loc:=LOC_REGISTER;
  438. resulttype:=voidpointerdef;
  439. end;
  440. in_ord_x:
  441. begin
  442. set_varstate(left,true);
  443. if (left.nodetype=ordconstn) then
  444. begin
  445. hp:=genordinalconstnode(tordconstnode(left).value,s32bitdef);
  446. firstpass(hp);
  447. result:=hp;
  448. end
  449. else
  450. begin
  451. { otherwise you get a crash if you try ord on an expression containing }
  452. { an undeclared variable (JM) }
  453. if not assigned(left.resulttype) then
  454. exit;
  455. if (left.resulttype^.deftype=orddef) then
  456. if (porddef(left.resulttype)^.typ in [uchar,uwidechar,bool8bit]) then
  457. case porddef(left.resulttype)^.typ of
  458. uchar:
  459. begin
  460. hp:=gentypeconvnode(left,u8bitdef);
  461. left:=nil;
  462. include(hp.flags,nf_explizit);
  463. firstpass(hp);
  464. result:=hp;
  465. end;
  466. uwidechar:
  467. begin
  468. hp:=gentypeconvnode(left,u16bitdef);
  469. left:=nil;
  470. include(hp.flags,nf_explizit);
  471. firstpass(hp);
  472. result:=hp;
  473. end;
  474. bool8bit:
  475. begin
  476. hp:=gentypeconvnode(left,u8bitdef);
  477. left:=nil;
  478. ttypeconvnode(hp).convtype:=tc_bool_2_int;
  479. include(hp.flags,nf_explizit);
  480. firstpass(hp);
  481. result:=hp;
  482. end
  483. end
  484. { can this happen ? }
  485. else if (porddef(left.resulttype)^.typ=uvoid) then
  486. CGMessage(type_e_mismatch)
  487. else
  488. { all other orddef need no transformation }
  489. begin
  490. hp:=left;
  491. left:=nil;
  492. result:=hp;
  493. end
  494. else if (left.resulttype^.deftype=enumdef) then
  495. begin
  496. hp:=gentypeconvnode(left,s32bitdef);
  497. left:=nil;
  498. include(hp.flags,nf_explizit);
  499. firstpass(hp);
  500. result:=hp;
  501. end
  502. else
  503. begin
  504. { can anything else be ord() ?}
  505. CGMessage(type_e_mismatch);
  506. end;
  507. end;
  508. end;
  509. in_chr_byte:
  510. begin
  511. set_varstate(left,true);
  512. hp:=gentypeconvnode(left,cchardef);
  513. left:=nil;
  514. include(hp.flags,nf_explizit);
  515. firstpass(hp);
  516. result:=hp;
  517. end;
  518. in_length_string:
  519. begin
  520. set_varstate(left,true);
  521. if is_ansistring(left.resulttype) then
  522. resulttype:=s32bitdef
  523. else
  524. resulttype:=u8bitdef;
  525. { we don't need string conversations here }
  526. if (left.nodetype=typeconvn) and
  527. (ttypeconvnode(left).left.resulttype^.deftype=stringdef) then
  528. begin
  529. hp:=ttypeconvnode(left).left;
  530. ttypeconvnode(left).left:=nil;
  531. left.free;
  532. left:=hp;
  533. end;
  534. { check the type, must be string or char }
  535. if (left.resulttype^.deftype<>stringdef) and
  536. (not is_char(left.resulttype)) then
  537. CGMessage(type_e_mismatch);
  538. { evaluates length of constant strings direct }
  539. if (left.nodetype=stringconstn) then
  540. begin
  541. hp:=genordinalconstnode(tstringconstnode(left).len,s32bitdef);
  542. firstpass(hp);
  543. result:=hp;
  544. end
  545. { length of char is one allways }
  546. else if is_constcharnode(left) then
  547. begin
  548. hp:=genordinalconstnode(1,s32bitdef);
  549. firstpass(hp);
  550. result:=hp;
  551. end;
  552. end;
  553. in_typeinfo_x:
  554. begin
  555. resulttype:=voidpointerdef;
  556. location.loc:=LOC_REGISTER;
  557. registers32:=1;
  558. end;
  559. in_assigned_x:
  560. begin
  561. set_varstate(left,true);
  562. resulttype:=booldef;
  563. location.loc:=LOC_FLAGS;
  564. end;
  565. in_ofs_x :
  566. internalerror(2000101001);
  567. in_seg_x :
  568. begin
  569. set_varstate(left,false);
  570. hp:=genordinalconstnode(0,s32bitdef);
  571. firstpass(hp);
  572. result:=hp;
  573. end;
  574. in_pred_x,
  575. in_succ_x:
  576. begin
  577. resulttype:=left.resulttype;
  578. if is_64bitint(resulttype) then
  579. begin
  580. if (registers32<2) then
  581. registers32:=2
  582. end
  583. else
  584. begin
  585. if (registers32<1) then
  586. registers32:=1;
  587. end;
  588. location.loc:=LOC_REGISTER;
  589. set_varstate(left,true);
  590. if not is_ordinal(resulttype) then
  591. CGMessage(type_e_ordinal_expr_expected)
  592. else
  593. begin
  594. if (resulttype^.deftype=enumdef) and
  595. (penumdef(resulttype)^.has_jumps) then
  596. CGMessage(type_e_succ_and_pred_enums_with_assign_not_possible)
  597. else
  598. if left.nodetype=ordconstn then
  599. begin
  600. if inlinenumber=in_succ_x then
  601. hp:=genordinalconstnode(tordconstnode(left).value+1,left.resulttype)
  602. else
  603. hp:=genordinalconstnode(tordconstnode(left).value-1,left.resulttype);
  604. firstpass(hp);
  605. result:=hp;
  606. end;
  607. end;
  608. end;
  609. in_setlength_x:
  610. begin
  611. resulttype:=voiddef;
  612. if assigned(left) then
  613. begin
  614. ppn:=tcallparanode(left);
  615. counter:=0;
  616. { check type }
  617. while assigned(ppn.right) do
  618. begin
  619. ppn.left:=gentypeconvnode(ppn.left,s32bitdef);
  620. firstpass(ppn.left);
  621. if codegenerror then
  622. exit;
  623. inc(counter);
  624. ppn:=tcallparanode(ppn.right);
  625. end;
  626. firstpass(ppn.left);
  627. if codegenerror then
  628. exit;
  629. { last param must be var }
  630. valid_for_assign(ppn.left,false);
  631. set_varstate(ppn.left,true);
  632. { first param must be a string or dynamic array ...}
  633. if not((ppn.left.resulttype^.deftype=stringdef) or
  634. (is_dynamic_array(ppn.left.resulttype))) then
  635. CGMessage(type_e_mismatch);
  636. { only dynamic arrays accept more dimensions }
  637. if (counter>1) and
  638. (not(is_dynamic_array(left.resulttype))) then
  639. CGMessage(type_e_mismatch);
  640. { convert shortstrings to openstring parameters }
  641. { (generate the hightree) (JM) }
  642. if (ppn.left.resulttype^.deftype = stringdef) and
  643. (pstringdef(ppn.left.resulttype)^.string_typ =
  644. st_shortstring) then
  645. begin
  646. dummycoll:=tparaitem.create;
  647. dummycoll.paratyp:=vs_var;
  648. dummycoll.paratype.setdef(openshortstringdef);
  649. tcallparanode(ppn).firstcallparan(dummycoll,false);
  650. if codegenerror then
  651. exit;
  652. end;
  653. end
  654. else
  655. CGMessage(type_e_mismatch);
  656. end;
  657. in_finalize_x:
  658. begin
  659. resulttype:=voiddef;
  660. if assigned(left) and assigned(tcallparanode(left).left) then
  661. begin
  662. firstpass(tcallparanode(left).left);
  663. if codegenerror then
  664. exit;
  665. { first param must be var }
  666. valid_for_assign(tcallparanode(left).left,false);
  667. set_varstate(tcallparanode(left).left,true);
  668. { two parameters? }
  669. if assigned(tcallparanode(left).right) then
  670. begin
  671. { the last parameter must be a longint }
  672. tcallparanode(tcallparanode(left).right).left:=
  673. gentypeconvnode(tcallparanode(tcallparanode(left).right).left,s32bitdef);
  674. firstpass(tcallparanode(tcallparanode(left).right).left);
  675. if codegenerror then
  676. exit;
  677. end;
  678. end
  679. else
  680. CGMessage(type_e_mismatch);
  681. end;
  682. in_inc_x,
  683. in_dec_x:
  684. begin
  685. resulttype:=voiddef;
  686. if assigned(left) then
  687. begin
  688. tcallparanode(left).firstcallparan(nil,true);
  689. set_varstate(left,true);
  690. if codegenerror then
  691. exit;
  692. { first param must be var }
  693. valid_for_assign(tcallparanode(left).left,false);
  694. { check type }
  695. if is_64bitint(left.resulttype) or
  696. { range/overflow checking doesn't work properly }
  697. { with the inc/dec code that's generated (JM) }
  698. ((left.resulttype^.deftype = orddef) and
  699. not(is_char(left.resulttype)) and
  700. not(is_boolean(left.resulttype)) and
  701. (aktlocalswitches *
  702. [cs_check_overflow,cs_check_range] <> [])) then
  703. { convert to simple add (JM) }
  704. begin
  705. { extra parameter? }
  706. if assigned(tcallparanode(left).right) then
  707. begin
  708. { Yes, use for add node }
  709. hpp := tcallparanode(tcallparanode(left).right).left;
  710. tcallparanode(tcallparanode(left).right).left := nil;
  711. if assigned(tcallparanode(tcallparanode(left).right).right) then
  712. CGMessage(cg_e_illegal_expression);
  713. end
  714. else
  715. { no, create constant 1 }
  716. hpp := cordconstnode.create(1,s32bitdef);
  717. { addition/substraction depending on inc/dec }
  718. if inlinenumber = in_inc_x then
  719. hp := caddnode.create(addn,tcallparanode(left).left.getcopy,hpp)
  720. else
  721. hp := caddnode.create(subn,tcallparanode(left).left.getcopy,hpp);
  722. { assign result of addition }
  723. hpp := cassignmentnode.create(tcallparanode(left).left,hp);
  724. tcallparanode(left).left := nil;
  725. { firstpass it }
  726. firstpass(hpp);
  727. { return new node }
  728. pass_1 := hpp;
  729. dec(parsing_para_level);
  730. exit;
  731. end;
  732. if (left.resulttype^.deftype in [enumdef,pointerdef]) or
  733. is_ordinal(left.resulttype) then
  734. begin
  735. { two paras ? }
  736. if assigned(tcallparanode(left).right) then
  737. begin
  738. { insert a type conversion }
  739. { the second param is always longint }
  740. tcallparanode(tcallparanode(left).right).left:=
  741. gentypeconvnode(tcallparanode(tcallparanode(left).right).left,s32bitdef);
  742. { check the type conversion }
  743. firstpass(tcallparanode(tcallparanode(left).right).left);
  744. { need we an additional register ? }
  745. if not(is_constintnode(tcallparanode(tcallparanode(left).right).left)) and
  746. (tcallparanode(tcallparanode(left).right).left.location.loc in [LOC_MEM,LOC_REFERENCE]) and
  747. (tcallparanode(tcallparanode(left).right).left.registers32<=1) then
  748. inc(registers32);
  749. { do we need an additional register to restore the first parameter? }
  750. if tcallparanode(tcallparanode(left).right).left.registers32>=registers32 then
  751. inc(registers32);
  752. if assigned(tcallparanode(tcallparanode(left).right).right) then
  753. CGMessage(cg_e_illegal_expression);
  754. end;
  755. end
  756. else
  757. CGMessage(type_e_ordinal_expr_expected);
  758. end
  759. else
  760. CGMessage(type_e_mismatch);
  761. end;
  762. in_read_x,
  763. in_readln_x,
  764. in_write_x,
  765. in_writeln_x :
  766. begin
  767. { needs a call }
  768. procinfo^.flags:=procinfo^.flags or pi_do_call;
  769. resulttype:=voiddef;
  770. { true, if readln needs an extra register }
  771. extra_register:=false;
  772. { we must know if it is a typed file or not }
  773. { but we must first do the firstpass for it }
  774. file_is_typed:=false;
  775. if assigned(left) then
  776. begin
  777. iswrite:=(inlinenumber in [in_write_x,in_writeln_x]);
  778. tcallparanode(left).firstcallparan(nil,true);
  779. set_varstate(left,iswrite);
  780. { now we can check }
  781. hp:=left;
  782. while assigned(tcallparanode(hp).right) do
  783. hp:=tcallparanode(hp).right;
  784. { if resulttype is not assigned, then automatically }
  785. { file is not typed. }
  786. if assigned(hp) and assigned(hp.resulttype) then
  787. Begin
  788. if (hp.resulttype^.deftype=filedef) then
  789. if (pfiledef(hp.resulttype)^.filetyp=ft_untyped) then
  790. begin
  791. if (inlinenumber in [in_readln_x,in_writeln_x]) then
  792. CGMessage(type_e_no_readln_writeln_for_typed_file)
  793. else
  794. CGMessage(type_e_no_read_write_for_untyped_file);
  795. end
  796. else if (pfiledef(hp.resulttype)^.filetyp=ft_typed) then
  797. begin
  798. file_is_typed:=true;
  799. { test the type }
  800. if (inlinenumber in [in_readln_x,in_writeln_x]) then
  801. CGMessage(type_e_no_readln_writeln_for_typed_file);
  802. hpp:=left;
  803. while (hpp<>hp) do
  804. begin
  805. if (tcallparanode(hpp).left.nodetype=typen) then
  806. CGMessage(type_e_cant_read_write_type);
  807. if not is_equal(hpp.resulttype,pfiledef(hp.resulttype)^.typedfiletype.def) then
  808. CGMessage(type_e_mismatch);
  809. { generate the high() value for the shortstring }
  810. if ((not iswrite) and is_shortstring(tcallparanode(hpp).left.resulttype)) or
  811. (is_chararray(tcallparanode(hpp).left.resulttype)) then
  812. tcallparanode(hpp).gen_high_tree(true);
  813. { read(ln) is call by reference (JM) }
  814. if not iswrite then
  815. make_not_regable(tcallparanode(hpp).left);
  816. hpp:=tcallparanode(hpp).right;
  817. end;
  818. end;
  819. end; { endif assigned(hp) }
  820. { insert type conversions for write(ln) }
  821. if (not file_is_typed) then
  822. begin
  823. hp:=left;
  824. while assigned(hp) do
  825. begin
  826. incrementregisterpushed($ff);
  827. if (tcallparanode(hp).left.nodetype=typen) then
  828. CGMessage(type_e_cant_read_write_type);
  829. if assigned(tcallparanode(hp).left.resulttype) then
  830. begin
  831. isreal:=false;
  832. { support writeln(procvar) }
  833. if (tcallparanode(hp).left.resulttype^.deftype=procvardef) then
  834. begin
  835. p1:=gencallnode(nil,nil);
  836. tcallnode(p1).right:=tcallparanode(hp).left;
  837. p1.resulttype:=pprocvardef(tcallparanode(hp).left.resulttype)^.rettype.def;
  838. firstpass(p1);
  839. tcallparanode(hp).left:=p1;
  840. end;
  841. case tcallparanode(hp).left.resulttype^.deftype of
  842. filedef :
  843. begin
  844. { only allowed as first parameter }
  845. if assigned(tcallparanode(hp).right) then
  846. CGMessage(type_e_cant_read_write_type);
  847. end;
  848. stringdef :
  849. begin
  850. { generate the high() value for the shortstring }
  851. if (not iswrite) and
  852. is_shortstring(tcallparanode(hp).left.resulttype) then
  853. tcallparanode(hp).gen_high_tree(true);
  854. end;
  855. pointerdef :
  856. begin
  857. if not is_pchar(tcallparanode(hp).left.resulttype) then
  858. CGMessage(type_e_cant_read_write_type);
  859. end;
  860. floatdef :
  861. begin
  862. isreal:=true;
  863. end;
  864. orddef :
  865. begin
  866. case porddef(tcallparanode(hp).left.resulttype)^.typ of
  867. uchar,
  868. u32bit,s32bit,
  869. u64bit,s64bit:
  870. ;
  871. u8bit,s8bit,
  872. u16bit,s16bit :
  873. if iswrite then
  874. tcallparanode(hp).left:=gentypeconvnode(tcallparanode(hp).left,s32bitdef);
  875. bool8bit,
  876. bool16bit,
  877. bool32bit :
  878. if iswrite then
  879. tcallparanode(hp).left:=gentypeconvnode(tcallparanode(hp).left,booldef)
  880. else
  881. CGMessage(type_e_cant_read_write_type);
  882. else
  883. CGMessage(type_e_cant_read_write_type);
  884. end;
  885. if not(iswrite) and
  886. not(is_64bitint(tcallparanode(hp).left.resulttype)) then
  887. extra_register:=true;
  888. end;
  889. arraydef :
  890. begin
  891. if is_chararray(tcallparanode(hp).left.resulttype) then
  892. tcallparanode(hp).gen_high_tree(true)
  893. else
  894. CGMessage(type_e_cant_read_write_type);
  895. end;
  896. else
  897. CGMessage(type_e_cant_read_write_type);
  898. end;
  899. { some format options ? }
  900. if cpf_is_colon_para in tcallparanode(hp).callparaflags then
  901. begin
  902. if cpf_is_colon_para in tcallparanode(tcallparanode(hp).right).callparaflags then
  903. begin
  904. frac_para:=hp;
  905. length_para:=tcallparanode(hp).right;
  906. hp:=tcallparanode(hp).right;
  907. hpp:=tcallparanode(hp).right;
  908. end
  909. else
  910. begin
  911. length_para:=hp;
  912. frac_para:=nil;
  913. hpp:=tcallparanode(hp).right;
  914. end;
  915. { can be nil if you use "write(e:0:6)" while e is undeclared (JM) }
  916. if assigned(tcallparanode(hpp).left.resulttype) then
  917. isreal:=(tcallparanode(hpp).left.resulttype^.deftype=floatdef)
  918. else exit;
  919. if (not is_integer(tcallparanode(length_para).left.resulttype)) then
  920. CGMessage1(type_e_integer_expr_expected,tcallparanode(length_para).left.resulttype^.typename)
  921. else
  922. tcallparanode(length_para).left:=gentypeconvnode(tcallparanode(length_para).left,s32bitdef);
  923. if assigned(frac_para) then
  924. begin
  925. if isreal then
  926. begin
  927. if (not is_integer(tcallparanode(frac_para).left.resulttype)) then
  928. CGMessage1(type_e_integer_expr_expected,tcallparanode(frac_para).left.resulttype^.typename)
  929. else
  930. tcallparanode(frac_para).left:=gentypeconvnode(tcallparanode(frac_para).left,s32bitdef);
  931. end
  932. else
  933. CGMessage(parser_e_illegal_colon_qualifier);
  934. end;
  935. { do the checking for the colon'd arg }
  936. hp:=length_para;
  937. end;
  938. end;
  939. hp:=tcallparanode(hp).right;
  940. end;
  941. end;
  942. { pass all parameters again for the typeconversions }
  943. if codegenerror then
  944. exit;
  945. tcallparanode(left).firstcallparan(nil,true);
  946. set_varstate(left,true);
  947. { calc registers }
  948. left_max;
  949. if extra_register then
  950. inc(registers32);
  951. end;
  952. end;
  953. in_settextbuf_file_x :
  954. begin
  955. { warning here left is the callparannode
  956. not the argument directly }
  957. { left.left is text var }
  958. { left.right.left is the buffer var }
  959. { firstcallparan(left,nil);
  960. already done in firstcalln }
  961. { now we know the type of buffer }
  962. getsymonlyin(systemunit,'SETTEXTBUF');
  963. hp:=gencallnode(pprocsym(srsym),systemunit);
  964. tcallnode(hp).left:=gencallparanode(
  965. genordinalconstnode(tcallparanode(left).left.resulttype^.size,s32bitdef),left);
  966. left:=nil;
  967. firstpass(hp);
  968. result:=hp;
  969. end;
  970. { the firstpass of the arg has been done in firstcalln ? }
  971. in_reset_typedfile,
  972. in_rewrite_typedfile :
  973. begin
  974. procinfo^.flags:=procinfo^.flags or pi_do_call;
  975. firstpass(left);
  976. set_varstate(left,true);
  977. resulttype:=voiddef;
  978. end;
  979. in_str_x_string :
  980. begin
  981. procinfo^.flags:=procinfo^.flags or pi_do_call;
  982. resulttype:=voiddef;
  983. { check the amount of parameters }
  984. if not(assigned(left)) or
  985. not(assigned(tcallparanode(left).right)) then
  986. begin
  987. CGMessage(parser_e_wrong_parameter_size);
  988. exit;
  989. end;
  990. { first pass just the string for first local use }
  991. hp:=tcallparanode(left).right;
  992. tcallparanode(left).right:=nil;
  993. tcallparanode(left).firstcallparan(nil,true);
  994. set_varstate(left,false);
  995. { remove warning when result is passed }
  996. set_funcret_is_valid(tcallparanode(left).left);
  997. tcallparanode(left).right:=hp;
  998. tcallparanode(tcallparanode(left).right).firstcallparan(nil,true);
  999. set_varstate(tcallparanode(left).right,true);
  1000. hp:=left;
  1001. { valid string ? }
  1002. if not assigned(hp) or
  1003. (tcallparanode(hp).left.resulttype^.deftype<>stringdef) or
  1004. (tcallparanode(hp).right=nil) then
  1005. CGMessage(cg_e_illegal_expression);
  1006. { we need a var parameter }
  1007. valid_for_assign(tcallparanode(hp).left,false);
  1008. { generate the high() value for the shortstring }
  1009. if is_shortstring(tcallparanode(hp).left.resulttype) then
  1010. tcallparanode(hp).gen_high_tree(true);
  1011. { !!!! check length of string }
  1012. while assigned(tcallparanode(hp).right) do
  1013. hp:=tcallparanode(hp).right;
  1014. if not assigned(tcallparanode(hp).resulttype) then
  1015. exit;
  1016. { check and convert the first param }
  1017. if (cpf_is_colon_para in tcallparanode(hp).callparaflags) or
  1018. not assigned(hp.resulttype) then
  1019. CGMessage(cg_e_illegal_expression);
  1020. isreal:=false;
  1021. case hp.resulttype^.deftype of
  1022. orddef :
  1023. begin
  1024. case porddef(tcallparanode(hp).left.resulttype)^.typ of
  1025. u32bit,s32bit,
  1026. s64bit,u64bit:
  1027. ;
  1028. u8bit,s8bit,
  1029. u16bit,s16bit:
  1030. tcallparanode(hp).left:=gentypeconvnode(tcallparanode(hp).left,s32bitdef);
  1031. else
  1032. CGMessage(type_e_integer_or_real_expr_expected);
  1033. end;
  1034. end;
  1035. floatdef :
  1036. begin
  1037. isreal:=true;
  1038. end;
  1039. else
  1040. CGMessage(type_e_integer_or_real_expr_expected);
  1041. end;
  1042. { some format options ? }
  1043. hpp:=tcallparanode(left).right;
  1044. if assigned(hpp) and (cpf_is_colon_para in tcallparanode(hpp).callparaflags) then
  1045. begin
  1046. firstpass(tcallparanode(hpp).left);
  1047. set_varstate(tcallparanode(hpp).left,true);
  1048. if (not is_integer(tcallparanode(hpp).left.resulttype)) then
  1049. CGMessage1(type_e_integer_expr_expected,tcallparanode(hpp).left.resulttype^.typename)
  1050. else
  1051. tcallparanode(hpp).left:=gentypeconvnode(tcallparanode(hpp).left,s32bitdef);
  1052. hpp:=tcallparanode(hpp).right;
  1053. if assigned(hpp) and (cpf_is_colon_para in tcallparanode(hpp).callparaflags) then
  1054. begin
  1055. if isreal then
  1056. begin
  1057. if (not is_integer(tcallparanode(hpp).left.resulttype)) then
  1058. CGMessage1(type_e_integer_expr_expected,tcallparanode(hpp).left.resulttype^.typename)
  1059. else
  1060. begin
  1061. firstpass(tcallparanode(hpp).left);
  1062. set_varstate(tcallparanode(hpp).left,true);
  1063. tcallparanode(hpp).left:=gentypeconvnode(tcallparanode(hpp).left,s32bitdef);
  1064. end;
  1065. end
  1066. else
  1067. CGMessage(parser_e_illegal_colon_qualifier);
  1068. end;
  1069. end;
  1070. { pass all parameters again for the typeconversions }
  1071. if codegenerror then
  1072. exit;
  1073. tcallparanode(left).firstcallparan(nil,true);
  1074. { calc registers }
  1075. left_max;
  1076. end;
  1077. in_val_x :
  1078. begin
  1079. procinfo^.flags:=procinfo^.flags or pi_do_call;
  1080. resulttype:=voiddef;
  1081. { check the amount of parameters }
  1082. if not(assigned(left)) or
  1083. not(assigned(tcallparanode(left).right)) then
  1084. begin
  1085. CGMessage(parser_e_wrong_parameter_size);
  1086. exit;
  1087. end;
  1088. If Assigned(tcallparanode(tcallparanode(left).right).right) Then
  1089. {there is a "code" parameter}
  1090. Begin
  1091. { first pass just the code parameter for first local use}
  1092. hp := tcallparanode(left).right;
  1093. tcallparanode(left).right := nil;
  1094. make_not_regable(tcallparanode(left).left);
  1095. tcallparanode(left).firstcallparan(nil,true);
  1096. set_varstate(left,false);
  1097. if codegenerror then exit;
  1098. tcallparanode(left).right := hp;
  1099. {code has to be a var parameter}
  1100. if valid_for_assign(tcallparanode(left).left,false) then
  1101. begin
  1102. if (tcallparanode(left).left.resulttype^.deftype <> orddef) or
  1103. not(porddef(tcallparanode(left).left.resulttype)^.typ in
  1104. [u16bit,s16bit,u32bit,s32bit]) then
  1105. CGMessage(type_e_mismatch);
  1106. end;
  1107. hpp := tcallparanode(left).right
  1108. End
  1109. Else hpp := left;
  1110. {now hpp = the destination value tree}
  1111. { first pass just the destination parameter for first local use}
  1112. hp:=tcallparanode(hpp).right;
  1113. tcallparanode(hpp).right:=nil;
  1114. {hpp = destination}
  1115. make_not_regable(tcallparanode(hpp).left);
  1116. tcallparanode(hpp).firstcallparan(nil,true);
  1117. set_varstate(hpp,false);
  1118. if codegenerror then
  1119. exit;
  1120. { remove warning when result is passed }
  1121. set_funcret_is_valid(tcallparanode(hpp).left);
  1122. tcallparanode(hpp).right := hp;
  1123. if valid_for_assign(tcallparanode(hpp).left,false) then
  1124. begin
  1125. If Not((tcallparanode(hpp).left.resulttype^.deftype = floatdef) or
  1126. ((tcallparanode(hpp).left.resulttype^.deftype = orddef) And
  1127. (POrdDef(tcallparanode(hpp).left.resulttype)^.typ in
  1128. [u32bit,s32bit,
  1129. u8bit,s8bit,u16bit,s16bit,s64bit,u64bit]))) Then
  1130. CGMessage(type_e_mismatch);
  1131. end;
  1132. {hp = source (String)}
  1133. { count_ref := false; WHY ?? }
  1134. tcallparanode(hp).firstcallparan(nil,true);
  1135. set_varstate(hp,true);
  1136. if codegenerror then
  1137. exit;
  1138. { if not a stringdef then insert a type conv which
  1139. does the other type checking }
  1140. If (tcallparanode(hp).left.resulttype^.deftype<>stringdef) then
  1141. begin
  1142. tcallparanode(hp).left:=gentypeconvnode(tcallparanode(hp).left,cshortstringdef);
  1143. firstpass(tcallparanode(hp).left);
  1144. end;
  1145. { calc registers }
  1146. left_max;
  1147. { val doesn't calculate the registers really }
  1148. { correct, we need one register extra (FK) }
  1149. if is_64bitint(tcallparanode(hpp).left.resulttype) then
  1150. inc(registers32,2)
  1151. else
  1152. inc(registers32,1);
  1153. end;
  1154. in_include_x_y,
  1155. in_exclude_x_y:
  1156. begin
  1157. resulttype:=voiddef;
  1158. if assigned(left) then
  1159. begin
  1160. tcallparanode(left).firstcallparan(nil,true);
  1161. set_varstate(left,true);
  1162. registers32:=left.registers32;
  1163. registersfpu:=left.registersfpu;
  1164. {$ifdef SUPPORT_MMX}
  1165. registersmmx:=left.registersmmx;
  1166. {$endif SUPPORT_MMX}
  1167. { remove warning when result is passed }
  1168. set_funcret_is_valid(tcallparanode(left).left);
  1169. { first param must be var }
  1170. valid_for_assign(tcallparanode(left).left,false);
  1171. { check type }
  1172. if assigned(left.resulttype) and
  1173. (left.resulttype^.deftype=setdef) then
  1174. begin
  1175. { two paras ? }
  1176. if assigned(tcallparanode(left).right) then
  1177. begin
  1178. { insert a type conversion }
  1179. { to the type of the set elements }
  1180. tcallparanode(tcallparanode(left).right).left:=gentypeconvnode(
  1181. tcallparanode(tcallparanode(left).right).left,
  1182. psetdef(left.resulttype)^.elementtype.def);
  1183. { check the type conversion }
  1184. firstpass(tcallparanode(tcallparanode(left).right).left);
  1185. { only three parameters are allowed }
  1186. if assigned(tcallparanode(tcallparanode(left).right).right) then
  1187. CGMessage(cg_e_illegal_expression);
  1188. end;
  1189. end
  1190. else
  1191. CGMessage(type_e_mismatch);
  1192. end
  1193. else
  1194. CGMessage(type_e_mismatch);
  1195. end;
  1196. in_low_x,
  1197. in_high_x:
  1198. begin
  1199. set_varstate(left,false);
  1200. { this fixes tests\webtbs\tbug879.pp (FK)
  1201. if left.nodetype in [typen,loadn,subscriptn] then
  1202. begin
  1203. }
  1204. case left.resulttype^.deftype of
  1205. orddef,enumdef:
  1206. begin
  1207. hp:=do_lowhigh(left.resulttype);
  1208. firstpass(hp);
  1209. result:=hp;
  1210. end;
  1211. setdef:
  1212. begin
  1213. hp:=do_lowhigh(Psetdef(left.resulttype)^.elementtype.def);
  1214. firstpass(hp);
  1215. result:=hp;
  1216. end;
  1217. arraydef:
  1218. begin
  1219. if inlinenumber=in_low_x then
  1220. begin
  1221. hp:=genordinalconstnode(Parraydef(left.resulttype)^.lowrange,
  1222. Parraydef(left.resulttype)^.rangetype.def);
  1223. firstpass(hp);
  1224. result:=hp;
  1225. end
  1226. else
  1227. begin
  1228. if is_open_array(left.resulttype) or
  1229. is_array_of_const(left.resulttype) then
  1230. begin
  1231. getsymonlyin(tloadnode(left).symtable,'high'+pvarsym(tloadnode(left).symtableentry)^.name);
  1232. hp:=genloadnode(pvarsym(srsym),tloadnode(left).symtable);
  1233. firstpass(hp);
  1234. result:=hp;
  1235. end
  1236. else
  1237. begin
  1238. hp:=genordinalconstnode(Parraydef(left.resulttype)^.highrange,
  1239. Parraydef(left.resulttype)^.rangetype.def);
  1240. firstpass(hp);
  1241. result:=hp;
  1242. end;
  1243. end;
  1244. end;
  1245. stringdef:
  1246. begin
  1247. if inlinenumber=in_low_x then
  1248. begin
  1249. hp:=genordinalconstnode(0,u8bitdef);
  1250. firstpass(hp);
  1251. result:=hp;
  1252. end
  1253. else
  1254. begin
  1255. if is_open_string(left.resulttype) then
  1256. begin
  1257. getsymonlyin(tloadnode(left).symtable,'high'+pvarsym(tloadnode(left).symtableentry)^.name);
  1258. hp:=genloadnode(pvarsym(srsym),tloadnode(left).symtable);
  1259. firstpass(hp);
  1260. result:=hp;
  1261. end
  1262. else
  1263. begin
  1264. hp:=genordinalconstnode(Pstringdef(left.resulttype)^.len,u8bitdef);
  1265. firstpass(hp);
  1266. result:=hp;
  1267. end;
  1268. end;
  1269. end;
  1270. else
  1271. CGMessage(type_e_mismatch);
  1272. end;
  1273. {
  1274. end
  1275. else
  1276. CGMessage(type_e_varid_or_typeid_expected);
  1277. }
  1278. end;
  1279. in_cos_extended:
  1280. begin
  1281. if left.nodetype in [ordconstn,realconstn] then
  1282. setconstrealvalue(cos(getconstrealvalue))
  1283. else
  1284. handleextendedfunction;
  1285. end;
  1286. in_sin_extended:
  1287. begin
  1288. if left.nodetype in [ordconstn,realconstn] then
  1289. setconstrealvalue(sin(getconstrealvalue))
  1290. else
  1291. handleextendedfunction;
  1292. end;
  1293. in_arctan_extended:
  1294. begin
  1295. if left.nodetype in [ordconstn,realconstn] then
  1296. setconstrealvalue(arctan(getconstrealvalue))
  1297. else
  1298. handleextendedfunction;
  1299. end;
  1300. in_pi:
  1301. if block_type=bt_const then
  1302. setconstrealvalue(pi)
  1303. else
  1304. begin
  1305. location.loc:=LOC_FPU;
  1306. resulttype:=s80floatdef;
  1307. end;
  1308. in_abs_extended:
  1309. begin
  1310. if left.nodetype in [ordconstn,realconstn] then
  1311. setconstrealvalue(abs(getconstrealvalue))
  1312. else
  1313. handleextendedfunction;
  1314. end;
  1315. in_sqr_extended:
  1316. begin
  1317. if left.nodetype in [ordconstn,realconstn] then
  1318. setconstrealvalue(sqr(getconstrealvalue))
  1319. else
  1320. handleextendedfunction;
  1321. end;
  1322. in_sqrt_extended:
  1323. begin
  1324. if left.nodetype in [ordconstn,realconstn] then
  1325. begin
  1326. vr:=getconstrealvalue;
  1327. if vr<0.0 then
  1328. begin
  1329. CGMessage(type_e_wrong_math_argument);
  1330. setconstrealvalue(0);
  1331. end
  1332. else
  1333. setconstrealvalue(sqrt(vr));
  1334. end
  1335. else
  1336. handleextendedfunction;
  1337. end;
  1338. in_ln_extended:
  1339. begin
  1340. if left.nodetype in [ordconstn,realconstn] then
  1341. begin
  1342. vr:=getconstrealvalue;
  1343. if vr<=0.0 then
  1344. begin
  1345. CGMessage(type_e_wrong_math_argument);
  1346. setconstrealvalue(0);
  1347. end
  1348. else
  1349. setconstrealvalue(ln(vr));
  1350. end
  1351. else
  1352. handleextendedfunction;
  1353. end;
  1354. {$ifdef SUPPORT_MMX}
  1355. in_mmx_pcmpeqb..in_mmx_pcmpgtw:
  1356. begin
  1357. end;
  1358. {$endif SUPPORT_MMX}
  1359. in_assert_x_y :
  1360. begin
  1361. resulttype:=voiddef;
  1362. if assigned(left) then
  1363. begin
  1364. tcallparanode(left).firstcallparan(nil,true);
  1365. set_varstate(left,true);
  1366. registers32:=left.registers32;
  1367. registersfpu:=left.registersfpu;
  1368. {$ifdef SUPPORT_MMX}
  1369. registersmmx:=left.registersmmx;
  1370. {$endif SUPPORT_MMX}
  1371. { check type }
  1372. if is_boolean(left.resulttype) then
  1373. begin
  1374. { must always be a string }
  1375. tcallparanode(tcallparanode(left).right).left:=
  1376. gentypeconvnode(tcallparanode(tcallparanode(left).right).left,cshortstringdef);
  1377. firstpass(tcallparanode(tcallparanode(left).right).left);
  1378. end
  1379. else
  1380. CGMessage(type_e_mismatch);
  1381. end
  1382. else
  1383. CGMessage(type_e_mismatch);
  1384. { We've checked the whole statement for correctness, now we
  1385. can remove it if assertions are off }
  1386. if not(cs_do_assertion in aktlocalswitches) then
  1387. { we need a valid node, so insert a nothingn }
  1388. result:=cnothingnode.create;
  1389. end;
  1390. else
  1391. internalerror(8);
  1392. end;
  1393. end;
  1394. { generate an error if no resulttype is set }
  1395. if not assigned(resulttype) then
  1396. resulttype:=generrordef;
  1397. { ... also if the node will be replaced }
  1398. if assigned(result) and
  1399. (not assigned(result.resulttype)) then
  1400. result.resulttype:=generrordef;
  1401. dec(parsing_para_level);
  1402. end;
  1403. {$ifdef fpc}
  1404. {$maxfpuregisters default}
  1405. {$endif fpc}
  1406. function tinlinenode.docompare(p: tnode): boolean;
  1407. begin
  1408. docompare :=
  1409. inherited docompare(p) and
  1410. (inlinenumber = tinlinenode(p).inlinenumber);
  1411. end;
  1412. begin
  1413. cinlinenode:=tinlinenode;
  1414. end.
  1415. {
  1416. $Log$
  1417. Revision 1.22 2000-12-31 11:14:10 jonas
  1418. + implemented/fixed docompare() mathods for all nodes (not tested)
  1419. + nopt.pas, nadd.pas, i386/n386opt.pas: optimized nodes for adding strings
  1420. and constant strings/chars together
  1421. * n386add.pas: don't copy temp strings (of size 256) to another temp string
  1422. when adding
  1423. Revision 1.21 2000/12/25 00:07:26 peter
  1424. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  1425. tlinkedlist objects)
  1426. Revision 1.20 2000/12/17 14:35:41 peter
  1427. * fixed crash with val()
  1428. Revision 1.19 2000/11/29 00:30:33 florian
  1429. * unused units removed from uses clause
  1430. * some changes for widestrings
  1431. Revision 1.18 2000/11/12 15:27:22 jonas
  1432. * also don't do conversion for chars/booleans (hopefully final change :/)
  1433. Revision 1.17 2000/11/11 21:08:13 jonas
  1434. * don't do inc/dec to add/sub conversion for enums
  1435. Revision 1.16 2000/11/11 16:18:35 peter
  1436. * ptr returns farpointer
  1437. Revision 1.15 2000/11/11 15:59:07 jonas
  1438. * convert inc/dec to add/sub when range/overflow checking is on
  1439. Revision 1.14 2000/11/09 17:46:54 florian
  1440. * System.TypeInfo fixed
  1441. + System.Finalize implemented
  1442. + some new keywords for interface support added
  1443. Revision 1.13 2000/11/04 16:48:32 florian
  1444. * innr.inc renamed to make compiler compilation easier because the rtl contains
  1445. a file of the same name
  1446. Revision 1.12 2000/10/31 22:02:48 peter
  1447. * symtable splitted, no real code changes
  1448. Revision 1.11 2000/10/26 14:15:06 jonas
  1449. * fixed setlength for shortstrings
  1450. Revision 1.10 2000/10/21 18:16:11 florian
  1451. * a lot of changes:
  1452. - basic dyn. array support
  1453. - basic C++ support
  1454. - some work for interfaces done
  1455. ....
  1456. Revision 1.9 2000/10/15 08:38:46 jonas
  1457. * added missing getcopy for previous addition
  1458. Revision 1.8 2000/10/14 18:27:53 jonas
  1459. * merged fix for inc/dec on 64bit types from tcinl
  1460. Revision 1.7 2000/10/14 10:14:50 peter
  1461. * moehrendorf oct 2000 rewrite
  1462. Revision 1.6 2000/10/01 19:48:24 peter
  1463. * lot of compile updates for cg11
  1464. Revision 1.5 2000/09/28 19:49:52 florian
  1465. *** empty log message ***
  1466. Revision 1.4 2000/09/28 16:34:47 florian
  1467. *** empty log message ***
  1468. Revision 1.3 2000/09/27 21:33:22 florian
  1469. * finally nadd.pas compiles
  1470. Revision 1.2 2000/09/27 20:25:44 florian
  1471. * more stuff fixed
  1472. Revision 1.1 2000/09/26 14:59:34 florian
  1473. * more conversion work done
  1474. }