pinline.pas 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. Generates nodes for routines that need compiler support
  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 pinline;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. symtype,
  23. node,
  24. globals,
  25. cpuinfo;
  26. function new_dispose_statement(is_new:boolean) : tnode;
  27. function new_function : tnode;
  28. function inline_setlength : tnode;
  29. function inline_initialize : tnode;
  30. function inline_finalize : tnode;
  31. function inline_copy : tnode;
  32. implementation
  33. uses
  34. {$ifdef delphi}
  35. SysUtils,
  36. {$endif}
  37. { common }
  38. cutils,
  39. { global }
  40. globtype,tokens,verbose,
  41. systems,
  42. { symtable }
  43. symconst,symdef,symsym,symtable,defutil,
  44. { pass 1 }
  45. pass_1,htypechk,
  46. nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
  47. { parser }
  48. scanner,
  49. pbase,pexpr,
  50. { codegen }
  51. cgbase
  52. ;
  53. function new_dispose_statement(is_new:boolean) : tnode;
  54. var
  55. newstatement : tstatementnode;
  56. temp : ttempcreatenode;
  57. para : tcallparanode;
  58. p,p2 : tnode;
  59. again : boolean; { dummy for do_proc_call }
  60. destructorname : stringid;
  61. sym : tsym;
  62. classh : tobjectdef;
  63. callflag : tnodeflag;
  64. destructorpos,
  65. storepos : tfileposinfo;
  66. begin
  67. consume(_LKLAMMER);
  68. p:=comp_expr(true);
  69. { calc return type }
  70. if is_new then
  71. set_varstate(p,vs_assigned,false)
  72. else
  73. set_varstate(p,vs_used,true);
  74. { constructor,destructor specified }
  75. if try_to_consume(_COMMA) then
  76. begin
  77. { extended syntax of new and dispose }
  78. { function styled new is handled in factor }
  79. { destructors have no parameters }
  80. destructorname:=pattern;
  81. destructorpos:=akttokenpos;
  82. consume(_ID);
  83. if (p.resulttype.def.deftype<>pointerdef) then
  84. begin
  85. Message1(type_e_pointer_type_expected,p.resulttype.def.typename);
  86. p.free;
  87. p:=factor(false);
  88. p.free;
  89. consume(_RKLAMMER);
  90. new_dispose_statement:=cerrornode.create;
  91. exit;
  92. end;
  93. { first parameter must be an object or class }
  94. if tpointerdef(p.resulttype.def).pointertype.def.deftype<>objectdef then
  95. begin
  96. Message(parser_e_pointer_to_class_expected);
  97. p.free;
  98. new_dispose_statement:=factor(false);
  99. consume_all_until(_RKLAMMER);
  100. consume(_RKLAMMER);
  101. exit;
  102. end;
  103. { check, if the first parameter is a pointer to a _class_ }
  104. classh:=tobjectdef(tpointerdef(p.resulttype.def).pointertype.def);
  105. if is_class(classh) then
  106. begin
  107. Message(parser_e_no_new_or_dispose_for_classes);
  108. new_dispose_statement:=factor(false);
  109. consume_all_until(_RKLAMMER);
  110. consume(_RKLAMMER);
  111. exit;
  112. end;
  113. { search cons-/destructor, also in parent classes }
  114. storepos:=akttokenpos;
  115. akttokenpos:=destructorpos;
  116. sym:=search_class_member(classh,destructorname);
  117. akttokenpos:=storepos;
  118. { the second parameter of new/dispose must be a call }
  119. { to a cons-/destructor }
  120. if (not assigned(sym)) or (sym.typ<>procsym) then
  121. begin
  122. if is_new then
  123. Message(parser_e_expr_have_to_be_constructor_call)
  124. else
  125. Message(parser_e_expr_have_to_be_destructor_call);
  126. p.free;
  127. new_dispose_statement:=cerrornode.create;
  128. end
  129. else
  130. begin
  131. { For new(var,constructor) we need to take a copy because
  132. p is also used in the assignmentn below }
  133. if is_new then
  134. p2:=cderefnode.create(p.getcopy)
  135. else
  136. p2:=cderefnode.create(p);
  137. do_resulttypepass(p2);
  138. if is_new then
  139. callflag:=nf_new_call
  140. else
  141. callflag:=nf_dispose_call;
  142. if is_new then
  143. do_member_read(classh,false,sym,p2,again,[callflag])
  144. else
  145. begin
  146. if not(m_fpc in aktmodeswitches) then
  147. do_member_read(classh,false,sym,p2,again,[callflag])
  148. else
  149. begin
  150. p2:=ccallnode.create(nil,tprocsym(sym),sym.owner,p2);
  151. if is_new then
  152. include(p2.flags,nf_new_call)
  153. else
  154. include(p2.flags,nf_dispose_call);
  155. { support dispose(p,done()); }
  156. if try_to_consume(_LKLAMMER) then
  157. begin
  158. if not try_to_consume(_RKLAMMER) then
  159. begin
  160. Message(parser_e_no_paras_for_destructor);
  161. consume_all_until(_RKLAMMER);
  162. consume(_RKLAMMER);
  163. end;
  164. end;
  165. end;
  166. end;
  167. { we need the real called method }
  168. do_resulttypepass(p2);
  169. if p2.nodetype<>calln then
  170. begin
  171. if is_new then
  172. CGMessage(parser_e_expr_have_to_be_constructor_call)
  173. else
  174. CGMessage(parser_e_expr_have_to_be_destructor_call);
  175. end;
  176. if not codegenerror then
  177. begin
  178. if is_new then
  179. begin
  180. if (tcallnode(p2).procdefinition.proctypeoption<>potype_constructor) then
  181. Message(parser_e_expr_have_to_be_constructor_call);
  182. p2.resulttype:=p.resulttype;
  183. p2:=cassignmentnode.create(p,p2);
  184. end
  185. else
  186. begin
  187. if (tcallnode(p2).procdefinition.proctypeoption<>potype_destructor) then
  188. Message(parser_e_expr_have_to_be_destructor_call);
  189. end;
  190. end;
  191. new_dispose_statement:=p2;
  192. end;
  193. end
  194. else
  195. begin
  196. if (p.resulttype.def.deftype<>pointerdef) then
  197. Begin
  198. Message1(type_e_pointer_type_expected,p.resulttype.def.typename);
  199. new_dispose_statement:=cerrornode.create;
  200. end
  201. else
  202. begin
  203. if (tpointerdef(p.resulttype.def).pointertype.def.deftype=objectdef) and
  204. (oo_has_vmt in tobjectdef(tpointerdef(p.resulttype.def).pointertype.def).objectoptions) then
  205. Message(parser_w_use_extended_syntax_for_objects);
  206. if (tpointerdef(p.resulttype.def).pointertype.def.deftype=orddef) and
  207. (torddef(tpointerdef(p.resulttype.def).pointertype.def).typ=uvoid) then
  208. begin
  209. if (m_tp7 in aktmodeswitches) or
  210. (m_delphi in aktmodeswitches) then
  211. Message(parser_w_no_new_dispose_on_void_pointers)
  212. else
  213. Message(parser_e_no_new_dispose_on_void_pointers);
  214. end;
  215. { create statements with call to getmem+initialize or
  216. finalize+freemem }
  217. new_dispose_statement:=internalstatements(newstatement);
  218. if is_new then
  219. begin
  220. { create temp for result }
  221. temp := ctempcreatenode.create_reg(p.resulttype,p.resulttype.def.size,tt_persistent);
  222. addstatement(newstatement,temp);
  223. { create call to fpc_getmem }
  224. para := ccallparanode.create(cordconstnode.create
  225. (tpointerdef(p.resulttype.def).pointertype.def.size,s32inttype,true),nil);
  226. addstatement(newstatement,cassignmentnode.create(
  227. ctemprefnode.create(temp),
  228. ccallnode.createintern('fpc_getmem',para)));
  229. { create call to fpc_initialize }
  230. if tpointerdef(p.resulttype.def).pointertype.def.needs_inittable then
  231. addstatement(newstatement,initialize_data_node(cderefnode.create(ctemprefnode.create(temp))));
  232. { copy the temp to the destination }
  233. addstatement(newstatement,cassignmentnode.create(
  234. p,
  235. ctemprefnode.create(temp)));
  236. { release temp }
  237. addstatement(newstatement,ctempdeletenode.create(temp));
  238. end
  239. else
  240. begin
  241. { create call to fpc_finalize }
  242. if tpointerdef(p.resulttype.def).pointertype.def.needs_inittable then
  243. addstatement(newstatement,finalize_data_node(cderefnode.create(p.getcopy)));
  244. { create call to fpc_freemem }
  245. para := ccallparanode.create(p,nil);
  246. addstatement(newstatement,ccallnode.createintern('fpc_freemem',para));
  247. end;
  248. end;
  249. end;
  250. consume(_RKLAMMER);
  251. end;
  252. function new_function : tnode;
  253. var
  254. newstatement : tstatementnode;
  255. newblock : tblocknode;
  256. temp : ttempcreatenode;
  257. para : tcallparanode;
  258. p1,p2 : tnode;
  259. classh : tobjectdef;
  260. sym : tsym;
  261. again : boolean; { dummy for do_proc_call }
  262. begin
  263. consume(_LKLAMMER);
  264. p1:=factor(false);
  265. if p1.nodetype<>typen then
  266. begin
  267. Message(type_e_type_id_expected);
  268. consume_all_until(_RKLAMMER);
  269. consume(_RKLAMMER);
  270. p1.destroy;
  271. new_function:=cerrornode.create;
  272. exit;
  273. end;
  274. if (p1.resulttype.def.deftype<>pointerdef) then
  275. begin
  276. Message1(type_e_pointer_type_expected,p1.resulttype.def.typename);
  277. consume_all_until(_RKLAMMER);
  278. consume(_RKLAMMER);
  279. p1.destroy;
  280. new_function:=cerrornode.create;
  281. exit;
  282. end;
  283. if try_to_consume(_RKLAMMER) then
  284. begin
  285. if (tpointerdef(p1.resulttype.def).pointertype.def.deftype=objectdef) and
  286. (oo_has_vmt in tobjectdef(tpointerdef(p1.resulttype.def).pointertype.def).objectoptions) then
  287. Message(parser_w_use_extended_syntax_for_objects);
  288. { create statements with call to getmem+initialize }
  289. newblock:=internalstatements(newstatement);
  290. { create temp for result }
  291. temp := ctempcreatenode.create_reg(p1.resulttype,p1.resulttype.def.size,tt_persistent);
  292. addstatement(newstatement,temp);
  293. { create call to fpc_getmem }
  294. para := ccallparanode.create(cordconstnode.create
  295. (tpointerdef(p1.resulttype.def).pointertype.def.size,s32inttype,true),nil);
  296. addstatement(newstatement,cassignmentnode.create(
  297. ctemprefnode.create(temp),
  298. ccallnode.createintern('fpc_getmem',para)));
  299. { create call to fpc_initialize }
  300. if tpointerdef(p1.resulttype.def).pointertype.def.needs_inittable then
  301. begin
  302. para := ccallparanode.create(caddrnode.create(crttinode.create
  303. (tstoreddef(tpointerdef(p1.resulttype.def).pointertype.def),initrtti)),
  304. ccallparanode.create(ctemprefnode.create
  305. (temp),nil));
  306. addstatement(newstatement,ccallnode.createintern('fpc_initialize',para));
  307. end;
  308. { the last statement should return the value as
  309. location and type, this is done be referencing the
  310. temp and converting it first from a persistent temp to
  311. normal temp }
  312. addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
  313. addstatement(newstatement,ctemprefnode.create(temp));
  314. p1.destroy;
  315. p1:=newblock;
  316. end
  317. else
  318. begin
  319. consume(_COMMA);
  320. if tpointerdef(p1.resulttype.def).pointertype.def.deftype<>objectdef then
  321. begin
  322. Message(parser_e_pointer_to_class_expected);
  323. consume_all_until(_RKLAMMER);
  324. consume(_RKLAMMER);
  325. p1.destroy;
  326. new_function:=cerrornode.create;
  327. exit;
  328. end;
  329. classh:=tobjectdef(tpointerdef(p1.resulttype.def).pointertype.def);
  330. { use the objectdef for loading the VMT }
  331. p2:=p1;
  332. p1:=ctypenode.create(tpointerdef(p1.resulttype.def).pointertype);
  333. do_resulttypepass(p1);
  334. { search the constructor also in the symbol tables of
  335. the parents }
  336. afterassignment:=false;
  337. sym:=searchsym_in_class(classh,pattern);
  338. consume(_ID);
  339. do_member_read(classh,false,sym,p1,again,[nf_new_call]);
  340. { we need to know which procedure is called }
  341. do_resulttypepass(p1);
  342. if not(
  343. (p1.nodetype=calln) and
  344. assigned(tcallnode(p1).procdefinition) and
  345. (tcallnode(p1).procdefinition.proctypeoption=potype_constructor)
  346. ) then
  347. Message(parser_e_expr_have_to_be_constructor_call);
  348. { constructors return boolean, update resulttype to return
  349. the pointer to the object }
  350. p1.resulttype:=p2.resulttype;
  351. p2.free;
  352. consume(_RKLAMMER);
  353. end;
  354. new_function:=p1;
  355. end;
  356. function inline_setlength : tnode;
  357. var
  358. paras : tnode;
  359. npara,
  360. ppn : tcallparanode;
  361. dims,
  362. counter : integer;
  363. isarray : boolean;
  364. def : tdef;
  365. destppn : tnode;
  366. newstatement : tstatementnode;
  367. temp : ttempcreatenode;
  368. newblock : tnode;
  369. begin
  370. { for easy exiting if something goes wrong }
  371. result := cerrornode.create;
  372. consume(_LKLAMMER);
  373. paras:=parse_paras(false,false);
  374. consume(_RKLAMMER);
  375. if not assigned(paras) then
  376. begin
  377. CGMessage(parser_e_wrong_parameter_size);
  378. exit;
  379. end;
  380. dims:=0;
  381. if assigned(paras) then
  382. begin
  383. { check type of lengths }
  384. ppn:=tcallparanode(paras);
  385. while assigned(ppn.right) do
  386. begin
  387. set_varstate(ppn.left,vs_used,true);
  388. inserttypeconv(ppn.left,s32inttype);
  389. inc(dims);
  390. ppn:=tcallparanode(ppn.right);
  391. end;
  392. end;
  393. if dims=0 then
  394. begin
  395. CGMessage(parser_e_wrong_parameter_size);
  396. paras.free;
  397. exit;
  398. end;
  399. { last param must be var }
  400. destppn:=ppn.left;
  401. inc(parsing_para_level);
  402. valid_for_var(destppn);
  403. set_varstate(destppn,vs_assigned,false);
  404. dec(parsing_para_level);
  405. { first param must be a string or dynamic array ...}
  406. isarray:=is_dynamic_array(destppn.resulttype.def);
  407. if not((destppn.resulttype.def.deftype=stringdef) or
  408. isarray) then
  409. begin
  410. CGMessage(type_e_mismatch);
  411. paras.free;
  412. exit;
  413. end;
  414. { only dynamic arrays accept more dimensions }
  415. if (dims>1) then
  416. begin
  417. if (not isarray) then
  418. CGMessage(type_e_mismatch)
  419. else
  420. begin
  421. { check if the amount of dimensions is valid }
  422. def := tarraydef(destppn.resulttype.def).elementtype.def;
  423. counter:=dims;
  424. while counter > 1 do
  425. begin
  426. if not(is_dynamic_array(def)) then
  427. begin
  428. CGMessage(parser_e_wrong_parameter_size);
  429. break;
  430. end;
  431. dec(counter);
  432. def := tarraydef(def).elementtype.def;
  433. end;
  434. end;
  435. end;
  436. if isarray then
  437. begin
  438. { create statements with call initialize the arguments and
  439. call fpc_dynarr_setlength }
  440. newblock:=internalstatements(newstatement);
  441. { get temp for array of lengths }
  442. temp := ctempcreatenode.create(s32inttype,dims*s32inttype.def.size,tt_persistent);
  443. addstatement(newstatement,temp);
  444. { load array of lengths }
  445. ppn:=tcallparanode(paras);
  446. counter:=0;
  447. while assigned(ppn.right) do
  448. begin
  449. addstatement(newstatement,cassignmentnode.create(
  450. ctemprefnode.create_offset(temp,counter*s32inttype.def.size),
  451. ppn.left));
  452. ppn.left:=nil;
  453. inc(counter);
  454. ppn:=tcallparanode(ppn.right);
  455. end;
  456. { destppn is also reused }
  457. ppn.left:=nil;
  458. { create call to fpc_dynarr_setlength }
  459. npara:=ccallparanode.create(caddrnode.create
  460. (ctemprefnode.create(temp)),
  461. ccallparanode.create(cordconstnode.create
  462. (counter,s32inttype,true),
  463. ccallparanode.create(caddrnode.create
  464. (crttinode.create(tstoreddef(destppn.resulttype.def),initrtti)),
  465. ccallparanode.create(ctypeconvnode.create_explicit(destppn,voidpointertype),nil))));
  466. addstatement(newstatement,ccallnode.createintern('fpc_dynarray_setlength',npara));
  467. addstatement(newstatement,ctempdeletenode.create(temp));
  468. { we don't need original the callparanodes tree }
  469. paras.free;
  470. end
  471. else
  472. begin
  473. { we can reuse the supplied parameters }
  474. newblock:=ccallnode.createintern(
  475. 'fpc_'+tstringdef(destppn.resulttype.def).stringtypname+'_setlength',paras);
  476. end;
  477. result.free;
  478. result:=newblock;
  479. end;
  480. function inline_initialize : tnode;
  481. var
  482. newblock,
  483. paras : tnode;
  484. npara,
  485. destppn,
  486. ppn : tcallparanode;
  487. begin
  488. { for easy exiting if something goes wrong }
  489. result := cerrornode.create;
  490. consume(_LKLAMMER);
  491. paras:=parse_paras(false,false);
  492. consume(_RKLAMMER);
  493. if not assigned(paras) then
  494. begin
  495. CGMessage(parser_e_wrong_parameter_size);
  496. exit;
  497. end;
  498. ppn:=tcallparanode(paras);
  499. { 2 arguments? }
  500. if assigned(ppn.right) then
  501. begin
  502. CGMessage(parser_e_wrong_parameter_size);
  503. paras.free;
  504. exit;
  505. end;
  506. newblock:=initialize_data_node(ppn.left);
  507. ppn.left:=nil;
  508. paras.free;
  509. result.free;
  510. result:=newblock;
  511. end;
  512. function inline_finalize : tnode;
  513. var
  514. newblock,
  515. paras : tnode;
  516. npara,
  517. destppn,
  518. ppn : tcallparanode;
  519. begin
  520. { for easy exiting if something goes wrong }
  521. result := cerrornode.create;
  522. consume(_LKLAMMER);
  523. paras:=parse_paras(false,false);
  524. consume(_RKLAMMER);
  525. if not assigned(paras) then
  526. begin
  527. CGMessage(parser_e_wrong_parameter_size);
  528. exit;
  529. end;
  530. ppn:=tcallparanode(paras);
  531. { 2 arguments? }
  532. if assigned(ppn.right) then
  533. begin
  534. destppn:=tcallparanode(ppn.right);
  535. { 3 arguments is invalid }
  536. if assigned(destppn.right) then
  537. begin
  538. CGMessage(parser_e_wrong_parameter_size);
  539. paras.free;
  540. exit;
  541. end;
  542. { create call to fpc_finalize_array }
  543. npara:=ccallparanode.create(cordconstnode.create
  544. (destppn.left.resulttype.def.size,s32inttype,true),
  545. ccallparanode.create(ctypeconvnode.create
  546. (ppn.left,s32inttype),
  547. ccallparanode.create(caddrnode.create
  548. (crttinode.create(tstoreddef(destppn.left.resulttype.def),initrtti)),
  549. ccallparanode.create(caddrnode.create
  550. (destppn.left),nil))));
  551. newblock:=ccallnode.createintern('fpc_finalize_array',npara);
  552. destppn.left:=nil;
  553. ppn.left:=nil;
  554. end
  555. else
  556. begin
  557. newblock:=finalize_data_node(ppn.left);
  558. ppn.left:=nil;
  559. end;
  560. paras.free;
  561. result.free;
  562. result:=newblock;
  563. end;
  564. function inline_copy : tnode;
  565. var
  566. copynode,
  567. lowppn,
  568. highppn,
  569. npara,
  570. paras : tnode;
  571. temp : ttempcreatenode;
  572. ppn : tcallparanode;
  573. paradef : tdef;
  574. counter : integer;
  575. newstatement : tstatementnode;
  576. begin
  577. { for easy exiting if something goes wrong }
  578. result := cerrornode.create;
  579. consume(_LKLAMMER);
  580. paras:=parse_paras(false,false);
  581. consume(_RKLAMMER);
  582. if not assigned(paras) then
  583. begin
  584. CGMessage(parser_e_wrong_parameter_size);
  585. exit;
  586. end;
  587. { determine copy function to use based on the first argument,
  588. also count the number of arguments in this loop }
  589. counter:=1;
  590. ppn:=tcallparanode(paras);
  591. while assigned(ppn.right) do
  592. begin
  593. inc(counter);
  594. ppn:=tcallparanode(ppn.right);
  595. end;
  596. paradef:=ppn.left.resulttype.def;
  597. if is_ansistring(paradef) or
  598. (is_chararray(paradef) and
  599. (paradef.size>255)) or
  600. ((cs_ansistrings in aktlocalswitches) and
  601. is_pchar(paradef)) then
  602. copynode:=ccallnode.createintern('fpc_ansistr_copy',paras)
  603. else
  604. if is_widestring(paradef) or
  605. is_widechararray(paradef) or
  606. is_pwidechar(paradef) then
  607. copynode:=ccallnode.createintern('fpc_widestr_copy',paras)
  608. else
  609. if is_char(paradef) then
  610. copynode:=ccallnode.createintern('fpc_char_copy',paras)
  611. else
  612. if is_dynamic_array(paradef) then
  613. begin
  614. { Only allow 1 or 3 arguments }
  615. if (counter<>1) and (counter<>3) then
  616. begin
  617. CGMessage(parser_e_wrong_parameter_size);
  618. exit;
  619. end;
  620. { create statements with call }
  621. copynode:=internalstatements(newstatement);
  622. if (counter=3) then
  623. begin
  624. highppn:=tcallparanode(paras).left.getcopy;
  625. lowppn:=tcallparanode(tcallparanode(paras).right).left.getcopy;
  626. end
  627. else
  628. begin
  629. { use special -1,-1 argument to copy the whole array }
  630. highppn:=cordconstnode.create(-1,s32inttype,false);
  631. lowppn:=cordconstnode.create(-1,s32inttype,false);
  632. end;
  633. { create temp for result, we've to use a temp because a dynarray
  634. type is handled differently from a pointer so we can't
  635. use createinternres() and a function }
  636. temp := ctempcreatenode.create(voidpointertype,voidpointertype.def.size,tt_persistent);
  637. addstatement(newstatement,temp);
  638. { create call to fpc_dynarray_copy }
  639. npara:=ccallparanode.create(highppn,
  640. ccallparanode.create(lowppn,
  641. ccallparanode.create(caddrnode.create
  642. (crttinode.create(tstoreddef(ppn.left.resulttype.def),initrtti)),
  643. ccallparanode.create
  644. (ctypeconvnode.create_explicit(ppn.left,voidpointertype),
  645. ccallparanode.create
  646. (ctemprefnode.create(temp),nil)))));
  647. addstatement(newstatement,ccallnode.createintern('fpc_dynarray_copy',npara));
  648. { convert the temp to normal and return the reference to the
  649. created temp, and convert the type of the temp to the dynarray type }
  650. addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
  651. addstatement(newstatement,ctypeconvnode.create_explicit(ctemprefnode.create(temp),ppn.left.resulttype));
  652. ppn.left:=nil;
  653. paras.free;
  654. end
  655. else
  656. begin
  657. { generic fallback that will give an error if a wrong
  658. type is passed }
  659. copynode:=ccallnode.createintern('fpc_shortstr_copy',paras)
  660. end;
  661. result.free;
  662. result:=copynode;
  663. end;
  664. end.
  665. {
  666. $Log$
  667. Revision 1.29 2004-02-04 18:45:29 jonas
  668. + some more usage of register temps
  669. Revision 1.28 2004/02/03 22:32:54 peter
  670. * renamed xNNbittype to xNNinttype
  671. * renamed registers32 to registersint
  672. * replace some s32bit,u32bit with torddef([su]inttype).def.typ
  673. Revision 1.27 2004/02/03 16:46:51 jonas
  674. + support to store ttempcreate/ref/deletenodes in registers
  675. * put temps for withnodes and some newnodes in registers
  676. Note: this currently only works because calling ungetregister()
  677. multiple times for the same register doesn't matter. We need again
  678. a way to specify that a register is currently a regvar and as such
  679. should not be freed when you call ungetregister() on it.
  680. Revision 1.26 2004/01/22 16:44:35 peter
  681. * fixed allocation of dimension buffer for setlength(dynarr)
  682. Revision 1.25 2003/11/29 16:19:54 peter
  683. * Initialize() added
  684. Revision 1.24 2003/11/10 22:02:52 peter
  685. * cross unit inlining fixed
  686. Revision 1.23 2003/11/04 19:05:03 peter
  687. * fixed initialize call after getmem
  688. Revision 1.22 2003/10/17 14:38:32 peter
  689. * 64k registers supported
  690. * fixed some memory leaks
  691. Revision 1.21 2003/10/08 19:19:45 peter
  692. * set_varstate cleanup
  693. Revision 1.20 2003/10/02 21:15:31 peter
  694. * protected visibility fixes
  695. Revision 1.19 2003/10/01 20:34:49 peter
  696. * procinfo unit contains tprocinfo
  697. * cginfo renamed to cgbase
  698. * moved cgmessage to verbose
  699. * fixed ppc and sparc compiles
  700. Revision 1.18 2003/09/23 17:56:05 peter
  701. * locals and paras are allocated in the code generation
  702. * tvarsym.localloc contains the location of para/local when
  703. generating code for the current procedure
  704. Revision 1.17 2003/08/21 15:10:51 peter
  705. * fixed copy support for array of char,pchar in $H+ mode
  706. * fixed copy support for pwidechar,array of widechar
  707. Revision 1.16 2003/08/10 17:25:23 peter
  708. * fixed some reported bugs
  709. Revision 1.15 2003/05/17 13:30:08 jonas
  710. * changed tt_persistant to tt_persistent :)
  711. * tempcreatenode now doesn't accept a boolean anymore for persistent
  712. temps, but a ttemptype, so you can also create ansistring temps etc
  713. Revision 1.14 2003/05/16 14:33:31 peter
  714. * regvar fixes
  715. Revision 1.13 2003/05/09 17:47:03 peter
  716. * self moved to hidden parameter
  717. * removed hdisposen,hnewn,selfn
  718. Revision 1.12 2002/04/25 20:15:40 florian
  719. * block nodes within expressions shouldn't release the used registers,
  720. fixed using a flag till the new rg is ready
  721. Revision 1.11 2002/11/26 22:59:09 peter
  722. * fix Copy(array,x,y)
  723. Revision 1.10 2002/11/25 17:43:22 peter
  724. * splitted defbase in defutil,symutil,defcmp
  725. * merged isconvertable and is_equal into compare_defs(_ext)
  726. * made operator search faster by walking the list only once
  727. Revision 1.9 2002/10/29 10:01:22 pierre
  728. * fix crash report as webbug 2174
  729. Revision 1.8 2002/10/02 18:20:52 peter
  730. * Copy() is now internal syssym that calls compilerprocs
  731. Revision 1.7 2002/09/07 12:16:03 carl
  732. * second part bug report 1996 fix, testrange in cordconstnode
  733. only called if option is set (also make parsing a tiny faster)
  734. Revision 1.6 2002/07/20 11:57:56 florian
  735. * types.pas renamed to defbase.pas because D6 contains a types
  736. unit so this would conflicts if D6 programms are compiled
  737. + Willamette/SSE2 instructions to assembler added
  738. Revision 1.5 2002/05/18 13:34:12 peter
  739. * readded missing revisions
  740. Revision 1.4 2002/05/16 19:46:43 carl
  741. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  742. + try to fix temp allocation (still in ifdef)
  743. + generic constructor calls
  744. + start of tassembler / tmodulebase class cleanup
  745. Revision 1.2 2002/05/12 16:53:09 peter
  746. * moved entry and exitcode to ncgutil and cgobj
  747. * foreach gets extra argument for passing local data to the
  748. iterator function
  749. * -CR checks also class typecasts at runtime by changing them
  750. into as
  751. * fixed compiler to cycle with the -CR option
  752. * fixed stabs with elf writer, finally the global variables can
  753. be watched
  754. * removed a lot of routines from cga unit and replaced them by
  755. calls to cgobj
  756. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  757. u32bit then the other is typecasted also to u32bit without giving
  758. a rangecheck warning/error.
  759. * fixed pascal calling method with reversing also the high tree in
  760. the parast, detected by tcalcst3 test
  761. Revision 1.1 2002/04/23 19:16:35 peter
  762. * add pinline unit that inserts compiler supported functions using
  763. one or more statements
  764. * moved finalize and setlength from ninl to pinline
  765. }