ninl.pas 69 KB

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