tcinl.pas 38 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 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 tcinl;
  19. interface
  20. uses
  21. tree;
  22. procedure firstinline(var p : ptree);
  23. implementation
  24. uses
  25. cobjects,verbose,globals,systems,
  26. symtable,aasm,types,
  27. hcodegen,htypechk,pass_1,
  28. tccal,tcld
  29. {$ifdef i386}
  30. ,i386,tgeni386
  31. {$endif}
  32. {$ifdef m68k}
  33. ,m68k,tgen68k
  34. {$endif}
  35. ;
  36. {*****************************************************************************
  37. FirstInLine
  38. *****************************************************************************}
  39. procedure firstinline(var p : ptree);
  40. var
  41. vl : longint;
  42. vr : bestreal;
  43. hp,hpp : ptree;
  44. store_count_ref,
  45. isreal,
  46. dowrite,
  47. store_valid,
  48. file_is_typed : boolean;
  49. procedure do_lowhigh(adef : pdef);
  50. var
  51. v : longint;
  52. enum : penumsym;
  53. begin
  54. case Adef^.deftype of
  55. orddef:
  56. begin
  57. if p^.inlinenumber=in_low_x then
  58. v:=porddef(Adef)^.low
  59. else
  60. v:=porddef(Adef)^.high;
  61. hp:=genordinalconstnode(v,adef);
  62. firstpass(hp);
  63. disposetree(p);
  64. p:=hp;
  65. end;
  66. enumdef:
  67. begin
  68. enum:=Penumdef(Adef)^.first;
  69. if p^.inlinenumber=in_high_x then
  70. while enum^.next<>nil do
  71. enum:=enum^.next;
  72. hp:=genenumnode(enum);
  73. disposetree(p);
  74. p:=hp;
  75. end
  76. end;
  77. end;
  78. begin
  79. store_valid:=must_be_valid;
  80. store_count_ref:=count_ref;
  81. count_ref:=false;
  82. if not (p^.inlinenumber in [in_read_x,in_readln_x,in_sizeof_x,
  83. in_typeof_x,in_ord_x,in_str_x_string,
  84. in_reset_typedfile,in_rewrite_typedfile]) then
  85. must_be_valid:=true
  86. else
  87. must_be_valid:=false;
  88. { if we handle writeln; p^.left contains no valid address }
  89. if assigned(p^.left) then
  90. begin
  91. if p^.left^.treetype=callparan then
  92. firstcallparan(p^.left,nil)
  93. else
  94. firstpass(p^.left);
  95. left_right_max(p);
  96. set_location(p^.location,p^.left^.location);
  97. end;
  98. { handle intern constant functions in separate case }
  99. if p^.inlineconst then
  100. begin
  101. { no parameters? }
  102. if not assigned(p^.left) then
  103. begin
  104. case p^.inlinenumber of
  105. in_const_pi : begin
  106. hp:=genrealconstnode(pi);
  107. end;
  108. else
  109. internalerror(89);
  110. end;
  111. end
  112. else
  113. { process constant expression with parameter }
  114. begin
  115. if not(p^.left^.treetype in [realconstn,ordconstn]) then
  116. begin
  117. CGMessage(cg_e_illegal_expression);
  118. vl:=0;
  119. vr:=0;
  120. isreal:=false;
  121. end
  122. else
  123. begin
  124. isreal:=(p^.left^.treetype=realconstn);
  125. vl:=p^.left^.value;
  126. vr:=p^.left^.value_real;
  127. end;
  128. case p^.inlinenumber of
  129. in_const_trunc : begin
  130. if isreal then
  131. hp:=genordinalconstnode(trunc(vr),s32bitdef)
  132. else
  133. hp:=genordinalconstnode(trunc(vl),s32bitdef);
  134. end;
  135. in_const_round : begin
  136. if isreal then
  137. hp:=genordinalconstnode(round(vr),s32bitdef)
  138. else
  139. hp:=genordinalconstnode(round(vl),s32bitdef);
  140. end;
  141. in_const_frac : begin
  142. if isreal then
  143. hp:=genrealconstnode(frac(vr))
  144. else
  145. hp:=genrealconstnode(frac(vl));
  146. end;
  147. in_const_int : begin
  148. if isreal then
  149. hp:=genrealconstnode(int(vr))
  150. else
  151. hp:=genrealconstnode(int(vl));
  152. end;
  153. in_const_abs : begin
  154. if isreal then
  155. hp:=genrealconstnode(abs(vr))
  156. else
  157. hp:=genordinalconstnode(abs(vl),p^.left^.resulttype);
  158. end;
  159. in_const_sqr : begin
  160. if isreal then
  161. hp:=genrealconstnode(sqr(vr))
  162. else
  163. hp:=genordinalconstnode(sqr(vl),p^.left^.resulttype);
  164. end;
  165. in_const_odd : begin
  166. if isreal then
  167. CGMessage(type_e_integer_expr_expected)
  168. else
  169. hp:=genordinalconstnode(byte(odd(vl)),booldef);
  170. end;
  171. in_const_swap_word : begin
  172. if isreal then
  173. CGMessage(type_e_integer_expr_expected)
  174. else
  175. hp:=genordinalconstnode((vl and $ff) shl 8+(vl shr 8),p^.left^.resulttype);
  176. end;
  177. in_const_swap_long : begin
  178. if isreal then
  179. CGMessage(type_e_mismatch)
  180. else
  181. hp:=genordinalconstnode((vl and $ffff) shl 16+(vl shr 16),p^.left^.resulttype);
  182. end;
  183. in_const_ptr : begin
  184. if isreal then
  185. CGMessage(type_e_mismatch)
  186. else
  187. hp:=genordinalconstnode(vl,voidpointerdef);
  188. end;
  189. in_const_sqrt : begin
  190. if isreal then
  191. hp:=genrealconstnode(sqrt(vr))
  192. else
  193. hp:=genrealconstnode(sqrt(vl));
  194. end;
  195. in_const_arctan : begin
  196. if isreal then
  197. hp:=genrealconstnode(arctan(vr))
  198. else
  199. hp:=genrealconstnode(arctan(vl));
  200. end;
  201. in_const_cos : begin
  202. if isreal then
  203. hp:=genrealconstnode(cos(vr))
  204. else
  205. hp:=genrealconstnode(cos(vl));
  206. end;
  207. in_const_sin : begin
  208. if isreal then
  209. hp:=genrealconstnode(sin(vr))
  210. else
  211. hp:=genrealconstnode(sin(vl));
  212. end;
  213. in_const_exp : begin
  214. if isreal then
  215. hp:=genrealconstnode(exp(vr))
  216. else
  217. hp:=genrealconstnode(exp(vl));
  218. end;
  219. in_const_ln : begin
  220. if isreal then
  221. hp:=genrealconstnode(ln(vr))
  222. else
  223. hp:=genrealconstnode(ln(vl));
  224. end;
  225. else
  226. internalerror(88);
  227. end;
  228. end;
  229. disposetree(p);
  230. firstpass(hp);
  231. p:=hp;
  232. end
  233. else
  234. begin
  235. case p^.inlinenumber of
  236. in_lo_long,in_hi_long,
  237. in_lo_word,in_hi_word:
  238. begin
  239. if p^.registers32<1 then
  240. p^.registers32:=1;
  241. if p^.inlinenumber in [in_lo_word,in_hi_word] then
  242. p^.resulttype:=u8bitdef
  243. else
  244. p^.resulttype:=u16bitdef;
  245. p^.location.loc:=LOC_REGISTER;
  246. if not is_integer(p^.left^.resulttype) then
  247. CGMessage(type_e_mismatch)
  248. else
  249. begin
  250. if p^.left^.treetype=ordconstn then
  251. begin
  252. case p^.inlinenumber of
  253. in_lo_word : hp:=genordinalconstnode(p^.left^.value and $ff,p^.left^.resulttype);
  254. in_hi_word : hp:=genordinalconstnode(p^.left^.value shr 8,p^.left^.resulttype);
  255. in_lo_long : hp:=genordinalconstnode(p^.left^.value and $ffff,p^.left^.resulttype);
  256. in_hi_long : hp:=genordinalconstnode(p^.left^.value shr 16,p^.left^.resulttype);
  257. end;
  258. disposetree(p);
  259. firstpass(hp);
  260. p:=hp;
  261. end;
  262. end;
  263. end;
  264. in_sizeof_x:
  265. begin
  266. if p^.registers32<1 then
  267. p^.registers32:=1;
  268. p^.resulttype:=s32bitdef;
  269. p^.location.loc:=LOC_REGISTER;
  270. end;
  271. in_typeof_x:
  272. begin
  273. if p^.registers32<1 then
  274. p^.registers32:=1;
  275. p^.location.loc:=LOC_REGISTER;
  276. p^.resulttype:=voidpointerdef;
  277. end;
  278. in_ord_x:
  279. begin
  280. if (p^.left^.treetype=ordconstn) then
  281. begin
  282. hp:=genordinalconstnode(p^.left^.value,s32bitdef);
  283. disposetree(p);
  284. p:=hp;
  285. firstpass(p);
  286. end
  287. else
  288. begin
  289. if (p^.left^.resulttype^.deftype=orddef) then
  290. if (porddef(p^.left^.resulttype)^.typ in [uchar,bool8bit]) then
  291. begin
  292. if porddef(p^.left^.resulttype)^.typ=bool8bit then
  293. begin
  294. hp:=gentypeconvnode(p^.left,u8bitdef);
  295. putnode(p);
  296. p:=hp;
  297. p^.convtyp:=tc_bool_2_int;
  298. p^.explizit:=true;
  299. firstpass(p);
  300. end
  301. else
  302. begin
  303. hp:=gentypeconvnode(p^.left,u8bitdef);
  304. putnode(p);
  305. p:=hp;
  306. p^.explizit:=true;
  307. firstpass(p);
  308. end;
  309. end
  310. { can this happen ? }
  311. else if (porddef(p^.left^.resulttype)^.typ=uvoid) then
  312. CGMessage(type_e_mismatch)
  313. else
  314. { all other orddef need no transformation }
  315. begin
  316. hp:=p^.left;
  317. putnode(p);
  318. p:=hp;
  319. end
  320. else if (p^.left^.resulttype^.deftype=enumdef) then
  321. begin
  322. hp:=gentypeconvnode(p^.left,s32bitdef);
  323. putnode(p);
  324. p:=hp;
  325. p^.explizit:=true;
  326. firstpass(p);
  327. end
  328. else
  329. begin
  330. { can anything else be ord() ?}
  331. CGMessage(type_e_mismatch);
  332. end;
  333. end;
  334. end;
  335. in_chr_byte:
  336. begin
  337. hp:=gentypeconvnode(p^.left,cchardef);
  338. putnode(p);
  339. p:=hp;
  340. p^.explizit:=true;
  341. firstpass(p);
  342. end;
  343. in_length_string:
  344. begin
  345. {$ifdef UseAnsiString}
  346. if is_ansistring(p^.left^.resulttype) then
  347. p^.resulttype:=s32bitdef
  348. else
  349. {$endif UseAnsiString}
  350. p^.resulttype:=u8bitdef;
  351. { wer don't need string conversations here }
  352. if (p^.left^.treetype=typeconvn) and
  353. (p^.left^.left^.resulttype^.deftype=stringdef) then
  354. begin
  355. hp:=p^.left^.left;
  356. putnode(p^.left);
  357. p^.left:=hp;
  358. end;
  359. { evaluates length of constant strings direct }
  360. if (p^.left^.treetype=stringconstn) then
  361. begin
  362. {$ifdef UseAnsiString}
  363. hp:=genordinalconstnode(p^.left^.length,s32bitdef);
  364. {$else UseAnsiString}
  365. hp:=genordinalconstnode(length(p^.left^.value_str^),s32bitdef);
  366. {$endif UseAnsiString}
  367. disposetree(p);
  368. firstpass(hp);
  369. p:=hp;
  370. end
  371. { length of char is one allways }
  372. else if (p^.left^.treetype=ordconstn) then
  373. if (porddef(p^.left^.resulttype)^.typ=uchar) then
  374. begin
  375. hp:=genordinalconstnode(1,s32bitdef);
  376. disposetree(p);
  377. firstpass(hp);
  378. p:=hp;
  379. end
  380. else
  381. CGMessage(type_e_mismatch);
  382. ;
  383. end;
  384. in_assigned_x:
  385. begin
  386. p^.resulttype:=booldef;
  387. p^.location.loc:=LOC_FLAGS;
  388. end;
  389. in_pred_x,
  390. in_succ_x:
  391. begin
  392. inc(p^.registers32);
  393. p^.resulttype:=p^.left^.resulttype;
  394. p^.location.loc:=LOC_REGISTER;
  395. if not is_ordinal(p^.resulttype) then
  396. CGMessage(type_e_ordinal_expr_expected)
  397. else
  398. begin
  399. if (p^.resulttype^.deftype=enumdef) and
  400. (penumdef(p^.resulttype)^.has_jumps) then
  401. CGMessage(type_e_succ_and_pred_enums_with_assign_not_possible)
  402. else
  403. if p^.left^.treetype=ordconstn then
  404. begin
  405. if p^.inlinenumber=in_succ_x then
  406. hp:=genordinalconstnode(p^.left^.value+1,p^.left^.resulttype)
  407. else
  408. hp:=genordinalconstnode(p^.left^.value-1,p^.left^.resulttype);
  409. disposetree(p);
  410. firstpass(hp);
  411. p:=hp;
  412. end;
  413. end;
  414. end;
  415. in_inc_x,
  416. in_dec_x:
  417. begin
  418. p^.resulttype:=voiddef;
  419. if assigned(p^.left) then
  420. begin
  421. firstcallparan(p^.left,nil);
  422. if codegenerror then
  423. exit;
  424. { first param must be var }
  425. if is_constnode(p^.left^.left) then
  426. CGMessage(type_e_variable_id_expected);
  427. { check type }
  428. if (p^.left^.resulttype^.deftype in [enumdef,pointerdef]) or
  429. is_ordinal(p^.left^.resulttype) then
  430. begin
  431. { two paras ? }
  432. if assigned(p^.left^.right) then
  433. begin
  434. { insert a type conversion }
  435. { the second param is always longint }
  436. p^.left^.right^.left:=gentypeconvnode(p^.left^.right^.left,s32bitdef);
  437. { check the type conversion }
  438. firstpass(p^.left^.right^.left);
  439. { need we an additional register ? }
  440. if not(is_constintnode(p^.left^.right^.left)) and
  441. (p^.left^.right^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) and
  442. (p^.left^.right^.left^.registers32<1) then
  443. inc(p^.registers32);
  444. if assigned(p^.left^.right^.right) then
  445. CGMessage(cg_e_illegal_expression);
  446. end;
  447. end
  448. else
  449. CGMessage(type_e_ordinal_expr_expected);
  450. end
  451. else
  452. CGMessage(type_e_mismatch);
  453. end;
  454. in_read_x,
  455. in_readln_x,
  456. in_write_x,
  457. in_writeln_x :
  458. begin
  459. { needs a call }
  460. procinfo.flags:=procinfo.flags or pi_do_call;
  461. p^.resulttype:=voiddef;
  462. { we must know if it is a typed file or not }
  463. { but we must first do the firstpass for it }
  464. file_is_typed:=false;
  465. if assigned(p^.left) then
  466. begin
  467. firstcallparan(p^.left,nil);
  468. { now we can check }
  469. hp:=p^.left;
  470. while assigned(hp^.right) do
  471. hp:=hp^.right;
  472. { if resulttype is not assigned, then automatically }
  473. { file is not typed. }
  474. if assigned(hp) and assigned(hp^.resulttype) then
  475. Begin
  476. if (hp^.resulttype^.deftype=filedef) and
  477. (pfiledef(hp^.resulttype)^.filetype=ft_typed) then
  478. begin
  479. file_is_typed:=true;
  480. { test the type }
  481. hpp:=p^.left;
  482. while (hpp<>hp) do
  483. begin
  484. if (hpp^.left^.treetype=typen) then
  485. CGMessage(type_e_cant_read_write_type);
  486. if not is_equal(hpp^.resulttype,pfiledef(hp^.resulttype)^.typed_as) then
  487. CGMessage(type_e_mismatch);
  488. hpp:=hpp^.right;
  489. end;
  490. end;
  491. end; { endif assigned(hp) }
  492. { insert type conversions for write(ln) }
  493. if (not file_is_typed) then
  494. begin
  495. dowrite:=(p^.inlinenumber in [in_write_x,in_writeln_x]);
  496. hp:=p^.left;
  497. while assigned(hp) do
  498. begin
  499. if (hp^.left^.treetype=typen) then
  500. CGMessage(type_e_cant_read_write_type);
  501. if assigned(hp^.left^.resulttype) then
  502. begin
  503. isreal:=false;
  504. case hp^.left^.resulttype^.deftype of
  505. filedef : begin
  506. { only allowed as first parameter }
  507. if assigned(hp^.right) then
  508. CGMessage(type_e_cant_read_write_type);
  509. end;
  510. stringdef : ;
  511. pointerdef : begin
  512. if not is_equal(ppointerdef(hp^.left^.resulttype)^.definition,cchardef) then
  513. CGMessage(type_e_cant_read_write_type);
  514. end;
  515. floatdef : begin
  516. isreal:=true;
  517. end;
  518. orddef : begin
  519. case porddef(hp^.left^.resulttype)^.typ of
  520. uchar,
  521. u32bit,s32bit : ;
  522. u8bit,s8bit,
  523. u16bit,s16bit : if dowrite then
  524. hp^.left:=gentypeconvnode(hp^.left,s32bitdef);
  525. bool8bit,
  526. bool16bit,bool32bit : if dowrite then
  527. hp^.left:=gentypeconvnode(hp^.left,booldef)
  528. else
  529. CGMessage(type_e_cant_read_write_type);
  530. else
  531. CGMessage(type_e_cant_read_write_type);
  532. end;
  533. end;
  534. arraydef : begin
  535. if not((parraydef(hp^.left^.resulttype)^.lowrange=0) and
  536. is_equal(parraydef(hp^.left^.resulttype)^.definition,cchardef)) then
  537. begin
  538. { but we convert only if the first index<>0,
  539. because in this case we have a ASCIIZ string }
  540. if dowrite and
  541. (parraydef(hp^.left^.resulttype)^.lowrange<>0) and
  542. (parraydef(hp^.left^.resulttype)^.definition^.deftype=orddef) and
  543. (porddef(parraydef(hp^.left^.resulttype)^.definition)^.typ=uchar) then
  544. hp^.left:=gentypeconvnode(hp^.left,cstringdef)
  545. else
  546. CGMessage(type_e_cant_read_write_type);
  547. end;
  548. end;
  549. else
  550. CGMessage(type_e_cant_read_write_type);
  551. end;
  552. { some format options ? }
  553. (* commented
  554. because supposes reverse order of parameters
  555. PM
  556. hpp:=hp^.right;
  557. if assigned(hpp) and hpp^.is_colon_para then
  558. begin
  559. if (not is_integer(hpp^.resulttype)) then
  560. CGMessage(type_e_integer_expr_expected)
  561. else
  562. hpp^.left:=gentypeconvnode(hpp^.left,s32bitdef);
  563. hpp:=hpp^.right;
  564. if assigned(hpp) and hpp^.is_colon_para then
  565. begin
  566. if isreal then
  567. begin
  568. if (not is_integer(hpp^.resulttype)) then
  569. CGMessage(type_e_integer_expr_expected)
  570. else
  571. hpp^.left:=gentypeconvnode(hpp^.left,s32bitdef);
  572. end
  573. else
  574. CGMessage(parser_e_illegal_colon_qualifier);
  575. end;
  576. end; *)
  577. end;
  578. hp:=hp^.right;
  579. end;
  580. end;
  581. { pass all parameters again for the typeconversions }
  582. if codegenerror then
  583. exit;
  584. must_be_valid:=true;
  585. firstcallparan(p^.left,nil);
  586. { calc registers }
  587. left_right_max(p);
  588. end;
  589. end;
  590. in_settextbuf_file_x :
  591. begin
  592. { warning here p^.left is the callparannode
  593. not the argument directly }
  594. { p^.left^.left is text var }
  595. { p^.left^.right^.left is the buffer var }
  596. { firstcallparan(p^.left,nil);
  597. already done in firstcalln }
  598. { now we know the type of buffer }
  599. getsymonlyin(systemunit,'SETTEXTBUF');
  600. hp:=gencallnode(pprocsym(srsym),systemunit);
  601. hp^.left:=gencallparanode(
  602. genordinalconstnode(p^.left^.left^.resulttype^.size,s32bitdef),p^.left);
  603. putnode(p);
  604. p:=hp;
  605. firstpass(p);
  606. end;
  607. { the firstpass of the arg has been done in firstcalln ? }
  608. in_reset_typedfile,in_rewrite_typedfile :
  609. begin
  610. procinfo.flags:=procinfo.flags or pi_do_call;
  611. { to be sure the right definition is loaded }
  612. p^.left^.resulttype:=nil;
  613. firstload(p^.left);
  614. p^.resulttype:=voiddef;
  615. end;
  616. in_str_x_string :
  617. begin
  618. procinfo.flags:=procinfo.flags or pi_do_call;
  619. p^.resulttype:=voiddef;
  620. if assigned(p^.left) then
  621. begin
  622. hp:=p^.left^.right;
  623. { first pass just the string for first local use }
  624. must_be_valid:=false;
  625. count_ref:=true;
  626. p^.left^.right:=nil;
  627. firstcallparan(p^.left,nil);
  628. must_be_valid:=true;
  629. p^.left^.right:=hp;
  630. firstcallparan(p^.left^.right,nil);
  631. hp:=p^.left;
  632. { valid string ? }
  633. if not assigned(hp) or
  634. (hp^.left^.resulttype^.deftype<>stringdef) or
  635. (hp^.right=nil) or
  636. (hp^.left^.location.loc<>LOC_REFERENCE) then
  637. CGMessage(cg_e_illegal_expression);
  638. { !!!! check length of string }
  639. while assigned(hp^.right) do
  640. hp:=hp^.right;
  641. { check and convert the first param }
  642. if hp^.is_colon_para then
  643. CGMessage(cg_e_illegal_expression);
  644. isreal:=false;
  645. case hp^.resulttype^.deftype of
  646. orddef : begin
  647. case porddef(hp^.left^.resulttype)^.typ of
  648. u32bit,s32bit : ;
  649. u8bit,s8bit,
  650. u16bit,s16bit : hp^.left:=gentypeconvnode(hp^.left,s32bitdef);
  651. else
  652. CGMessage(type_e_integer_or_real_expr_expected);
  653. end;
  654. end;
  655. floatdef : begin
  656. isreal:=true;
  657. end;
  658. else
  659. CGMessage(type_e_integer_or_real_expr_expected);
  660. end;
  661. { some format options ? }
  662. hpp:=p^.left^.right;
  663. if assigned(hpp) and hpp^.is_colon_para then
  664. begin
  665. if (not is_integer(hpp^.resulttype)) then
  666. CGMessage(type_e_integer_expr_expected)
  667. else
  668. hpp^.left:=gentypeconvnode(hpp^.left,s32bitdef);
  669. hpp:=hpp^.right;
  670. if assigned(hpp) and hpp^.is_colon_para then
  671. begin
  672. if isreal then
  673. begin
  674. if (not is_integer(hpp^.resulttype)) then
  675. CGMessage(type_e_integer_expr_expected)
  676. else
  677. hpp^.left:=gentypeconvnode(hpp^.left,s32bitdef);
  678. end
  679. else
  680. CGMessage(parser_e_illegal_colon_qualifier);
  681. end;
  682. end;
  683. { for first local use }
  684. must_be_valid:=false;
  685. count_ref:=true;
  686. end
  687. else
  688. CGMessage(parser_e_illegal_parameter_list);
  689. { pass all parameters again for the typeconversions }
  690. if codegenerror then
  691. exit;
  692. must_be_valid:=true;
  693. firstcallparan(p^.left,nil);
  694. { calc registers }
  695. left_right_max(p);
  696. end;
  697. in_include_x_y,
  698. in_exclude_x_y:
  699. begin
  700. p^.resulttype:=voiddef;
  701. if assigned(p^.left) then
  702. begin
  703. firstcallparan(p^.left,nil);
  704. p^.registers32:=p^.left^.registers32;
  705. p^.registersfpu:=p^.left^.registersfpu;
  706. {$ifdef SUPPORT_MMX}
  707. p^.registersmmx:=p^.left^.registersmmx;
  708. {$endif SUPPORT_MMX}
  709. { first param must be var }
  710. if (p^.left^.left^.location.loc<>LOC_REFERENCE) and
  711. (p^.left^.left^.location.loc<>LOC_CREGISTER) then
  712. CGMessage(cg_e_illegal_expression);
  713. { check type }
  714. if (p^.left^.resulttype^.deftype=setdef) then
  715. begin
  716. { two paras ? }
  717. if assigned(p^.left^.right) then
  718. begin
  719. { insert a type conversion }
  720. { to the type of the set elements }
  721. p^.left^.right^.left:=gentypeconvnode(
  722. p^.left^.right^.left,
  723. psetdef(p^.left^.resulttype)^.setof);
  724. { check the type conversion }
  725. firstpass(p^.left^.right^.left);
  726. { only three parameters are allowed }
  727. if assigned(p^.left^.right^.right) then
  728. CGMessage(cg_e_illegal_expression);
  729. end;
  730. end
  731. else
  732. CGMessage(type_e_mismatch);
  733. end
  734. else
  735. CGMessage(type_e_mismatch);
  736. end;
  737. in_low_x,in_high_x:
  738. begin
  739. if p^.left^.treetype in [typen,loadn] then
  740. begin
  741. case p^.left^.resulttype^.deftype of
  742. orddef,enumdef:
  743. begin
  744. do_lowhigh(p^.left^.resulttype);
  745. firstpass(p);
  746. end;
  747. setdef:
  748. begin
  749. do_lowhigh(Psetdef(p^.left^.resulttype)^.setof);
  750. firstpass(p);
  751. end;
  752. arraydef:
  753. begin
  754. if is_open_array(p^.left^.resulttype) then
  755. begin
  756. if p^.inlinenumber=in_low_x then
  757. begin
  758. hp:=genordinalconstnode(Parraydef(p^.left^.resulttype)^.lowrange,s32bitdef);
  759. disposetree(p);
  760. p:=hp;
  761. firstpass(p);
  762. end
  763. else
  764. begin
  765. p^.resulttype:=s32bitdef;
  766. p^.registers32:=max(1,
  767. p^.registers32);
  768. p^.location.loc:=LOC_REGISTER;
  769. end;
  770. end
  771. else
  772. begin
  773. if p^.inlinenumber=in_low_x then
  774. hp:=genordinalconstnode(Parraydef(p^.left^.resulttype)^.lowrange,s32bitdef)
  775. else
  776. hp:=genordinalconstnode(Parraydef(p^.left^.resulttype)^.highrange,s32bitdef);
  777. disposetree(p);
  778. p:=hp;
  779. firstpass(p);
  780. end;
  781. end;
  782. stringdef:
  783. begin
  784. if p^.inlinenumber=in_low_x then
  785. hp:=genordinalconstnode(0,u8bitdef)
  786. else
  787. hp:=genordinalconstnode(Pstringdef(p^.left^.resulttype)^.len,u8bitdef);
  788. disposetree(p);
  789. p:=hp;
  790. firstpass(p);
  791. end;
  792. else
  793. CGMessage(type_e_mismatch);
  794. end;
  795. end
  796. else
  797. CGMessage(type_e_varid_or_typeid_expected);
  798. end;
  799. in_assert_x_y :
  800. begin
  801. p^.resulttype:=voiddef;
  802. if assigned(p^.left) then
  803. begin
  804. firstcallparan(p^.left,nil);
  805. p^.registers32:=p^.left^.registers32;
  806. p^.registersfpu:=p^.left^.registersfpu;
  807. {$ifdef SUPPORT_MMX}
  808. p^.registersmmx:=p^.left^.registersmmx;
  809. {$endif SUPPORT_MMX}
  810. { check type }
  811. if is_boolean(p^.left^.resulttype) then
  812. begin
  813. { must always be a string }
  814. p^.left^.right^.left:=gentypeconvnode(p^.left^.right^.left,cstringdef);
  815. firstpass(p^.left^.right^.left);
  816. end
  817. else
  818. CGMessage(type_e_mismatch);
  819. end
  820. else
  821. CGMessage(type_e_mismatch);
  822. end;
  823. else
  824. internalerror(8);
  825. end;
  826. end;
  827. must_be_valid:=store_valid;
  828. count_ref:=store_count_ref;
  829. end;
  830. end.
  831. {
  832. $Log$
  833. Revision 1.5 1998-10-20 11:16:47 pierre
  834. + length(c) where C is a char is allways 1
  835. Revision 1.4 1998/10/06 20:49:11 peter
  836. * m68k compiler compiles again
  837. Revision 1.3 1998/10/05 12:32:49 peter
  838. + assert() support
  839. Revision 1.2 1998/10/02 09:24:23 peter
  840. * more constant expression evaluators
  841. Revision 1.1 1998/09/23 20:42:24 peter
  842. * splitted pass_1
  843. }