pinline.pas 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807
  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. { common }
  35. cutils,
  36. { global }
  37. globtype,tokens,verbose,
  38. systems,
  39. { symtable }
  40. symconst,symdef,symsym,symtable,defutil,
  41. { pass 1 }
  42. pass_1,htypechk,
  43. nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
  44. { parser }
  45. scanner,
  46. pbase,pexpr,
  47. { codegen }
  48. cgbase
  49. ;
  50. function new_dispose_statement(is_new:boolean) : tnode;
  51. var
  52. newstatement : tstatementnode;
  53. temp : ttempcreatenode;
  54. para : tcallparanode;
  55. p,p2 : tnode;
  56. again : boolean; { dummy for do_proc_call }
  57. destructorname : stringid;
  58. sym : tsym;
  59. classh : tobjectdef;
  60. callflag : tcallnodeflag;
  61. destructorpos,
  62. storepos : tfileposinfo;
  63. begin
  64. consume(_LKLAMMER);
  65. p:=comp_expr(true);
  66. { calc return type }
  67. if is_new then
  68. set_varstate(p,vs_assigned,false)
  69. else
  70. set_varstate(p,vs_used,true);
  71. { constructor,destructor specified }
  72. if try_to_consume(_COMMA) then
  73. begin
  74. { extended syntax of new and dispose }
  75. { function styled new is handled in factor }
  76. { destructors have no parameters }
  77. destructorname:=pattern;
  78. destructorpos:=akttokenpos;
  79. consume(_ID);
  80. if (p.resulttype.def.deftype<>pointerdef) then
  81. begin
  82. Message1(type_e_pointer_type_expected,p.resulttype.def.typename);
  83. p.free;
  84. p:=factor(false);
  85. p.free;
  86. consume(_RKLAMMER);
  87. new_dispose_statement:=cerrornode.create;
  88. exit;
  89. end;
  90. { first parameter must be an object or class }
  91. if tpointerdef(p.resulttype.def).pointertype.def.deftype<>objectdef then
  92. begin
  93. Message(parser_e_pointer_to_class_expected);
  94. p.free;
  95. new_dispose_statement:=factor(false);
  96. consume_all_until(_RKLAMMER);
  97. consume(_RKLAMMER);
  98. exit;
  99. end;
  100. { check, if the first parameter is a pointer to a _class_ }
  101. classh:=tobjectdef(tpointerdef(p.resulttype.def).pointertype.def);
  102. if is_class(classh) then
  103. begin
  104. Message(parser_e_no_new_or_dispose_for_classes);
  105. new_dispose_statement:=factor(false);
  106. consume_all_until(_RKLAMMER);
  107. consume(_RKLAMMER);
  108. exit;
  109. end;
  110. { search cons-/destructor, also in parent classes }
  111. storepos:=akttokenpos;
  112. akttokenpos:=destructorpos;
  113. sym:=search_class_member(classh,destructorname);
  114. akttokenpos:=storepos;
  115. { the second parameter of new/dispose must be a call }
  116. { to a cons-/destructor }
  117. if (not assigned(sym)) or (sym.typ<>procsym) then
  118. begin
  119. if is_new then
  120. Message(parser_e_expr_have_to_be_constructor_call)
  121. else
  122. Message(parser_e_expr_have_to_be_destructor_call);
  123. p.free;
  124. new_dispose_statement:=cerrornode.create;
  125. end
  126. else
  127. begin
  128. { For new(var,constructor) we need to take a copy because
  129. p is also used in the assignmentn below }
  130. if is_new then
  131. p2:=cderefnode.create(p.getcopy)
  132. else
  133. p2:=cderefnode.create(p);
  134. do_resulttypepass(p2);
  135. if is_new then
  136. callflag:=cnf_new_call
  137. else
  138. callflag:=cnf_dispose_call;
  139. if is_new then
  140. do_member_read(classh,false,sym,p2,again,[callflag])
  141. else
  142. begin
  143. if not(m_fpc in aktmodeswitches) then
  144. do_member_read(classh,false,sym,p2,again,[callflag])
  145. else
  146. begin
  147. p2:=ccallnode.create(nil,tprocsym(sym),sym.owner,p2,[callflag]);
  148. { support dispose(p,done()); }
  149. if try_to_consume(_LKLAMMER) then
  150. begin
  151. if not try_to_consume(_RKLAMMER) then
  152. begin
  153. Message(parser_e_no_paras_for_destructor);
  154. consume_all_until(_RKLAMMER);
  155. consume(_RKLAMMER);
  156. end;
  157. end;
  158. end;
  159. end;
  160. { we need the real called method }
  161. do_resulttypepass(p2);
  162. if (p2.nodetype=calln) then
  163. begin
  164. if is_new then
  165. begin
  166. if (tcallnode(p2).procdefinition.proctypeoption<>potype_constructor) then
  167. Message(parser_e_expr_have_to_be_constructor_call);
  168. p2.resulttype:=p.resulttype;
  169. p2:=cassignmentnode.create(p,p2);
  170. end
  171. else
  172. begin
  173. if (tcallnode(p2).procdefinition.proctypeoption<>potype_destructor) then
  174. Message(parser_e_expr_have_to_be_destructor_call);
  175. end;
  176. end
  177. else
  178. begin
  179. if is_new then
  180. CGMessage(parser_e_expr_have_to_be_constructor_call)
  181. else
  182. CGMessage(parser_e_expr_have_to_be_destructor_call);
  183. end;
  184. result:=p2;
  185. end;
  186. end
  187. else
  188. begin
  189. if (p.resulttype.def.deftype<>pointerdef) then
  190. Begin
  191. Message1(type_e_pointer_type_expected,p.resulttype.def.typename);
  192. new_dispose_statement:=cerrornode.create;
  193. end
  194. else
  195. begin
  196. if (tpointerdef(p.resulttype.def).pointertype.def.deftype=objectdef) and
  197. (oo_has_vmt in tobjectdef(tpointerdef(p.resulttype.def).pointertype.def).objectoptions) then
  198. Message(parser_w_use_extended_syntax_for_objects);
  199. if (tpointerdef(p.resulttype.def).pointertype.def.deftype=orddef) and
  200. (torddef(tpointerdef(p.resulttype.def).pointertype.def).typ=uvoid) then
  201. begin
  202. if (m_tp7 in aktmodeswitches) or
  203. (m_delphi in aktmodeswitches) then
  204. Message(parser_w_no_new_dispose_on_void_pointers)
  205. else
  206. Message(parser_e_no_new_dispose_on_void_pointers);
  207. end;
  208. { create statements with call to getmem+initialize or
  209. finalize+freemem }
  210. new_dispose_statement:=internalstatements(newstatement);
  211. if is_new then
  212. begin
  213. { create temp for result }
  214. temp := ctempcreatenode.create(p.resulttype,p.resulttype.def.size,tt_persistent,true);
  215. addstatement(newstatement,temp);
  216. { create call to fpc_getmem }
  217. para := ccallparanode.create(cordconstnode.create
  218. (tpointerdef(p.resulttype.def).pointertype.def.size,s32inttype,true),nil);
  219. addstatement(newstatement,cassignmentnode.create(
  220. ctemprefnode.create(temp),
  221. ccallnode.createintern('fpc_getmem',para)));
  222. { create call to fpc_initialize }
  223. if tpointerdef(p.resulttype.def).pointertype.def.needs_inittable then
  224. addstatement(newstatement,initialize_data_node(cderefnode.create(ctemprefnode.create(temp))));
  225. { copy the temp to the destination }
  226. addstatement(newstatement,cassignmentnode.create(
  227. p,
  228. ctemprefnode.create(temp)));
  229. { release temp }
  230. addstatement(newstatement,ctempdeletenode.create(temp));
  231. end
  232. else
  233. begin
  234. { create call to fpc_finalize }
  235. if tpointerdef(p.resulttype.def).pointertype.def.needs_inittable then
  236. addstatement(newstatement,finalize_data_node(cderefnode.create(p.getcopy)));
  237. { create call to fpc_freemem }
  238. para := ccallparanode.create(p,nil);
  239. addstatement(newstatement,ccallnode.createintern('fpc_freemem',para));
  240. end;
  241. end;
  242. end;
  243. consume(_RKLAMMER);
  244. end;
  245. function new_function : tnode;
  246. var
  247. newstatement : tstatementnode;
  248. newblock : tblocknode;
  249. temp : ttempcreatenode;
  250. para : tcallparanode;
  251. p1,p2 : tnode;
  252. classh : tobjectdef;
  253. sym : tsym;
  254. again : boolean; { dummy for do_proc_call }
  255. begin
  256. consume(_LKLAMMER);
  257. p1:=factor(false);
  258. if p1.nodetype<>typen then
  259. begin
  260. Message(type_e_type_id_expected);
  261. consume_all_until(_RKLAMMER);
  262. consume(_RKLAMMER);
  263. p1.destroy;
  264. new_function:=cerrornode.create;
  265. exit;
  266. end;
  267. if (p1.resulttype.def.deftype<>pointerdef) then
  268. begin
  269. Message1(type_e_pointer_type_expected,p1.resulttype.def.typename);
  270. consume_all_until(_RKLAMMER);
  271. consume(_RKLAMMER);
  272. p1.destroy;
  273. new_function:=cerrornode.create;
  274. exit;
  275. end;
  276. if try_to_consume(_RKLAMMER) then
  277. begin
  278. if (tpointerdef(p1.resulttype.def).pointertype.def.deftype=objectdef) and
  279. (oo_has_vmt in tobjectdef(tpointerdef(p1.resulttype.def).pointertype.def).objectoptions) then
  280. Message(parser_w_use_extended_syntax_for_objects);
  281. { create statements with call to getmem+initialize }
  282. newblock:=internalstatements(newstatement);
  283. { create temp for result }
  284. temp := ctempcreatenode.create(p1.resulttype,p1.resulttype.def.size,tt_persistent,true);
  285. addstatement(newstatement,temp);
  286. { create call to fpc_getmem }
  287. para := ccallparanode.create(cordconstnode.create
  288. (tpointerdef(p1.resulttype.def).pointertype.def.size,s32inttype,true),nil);
  289. addstatement(newstatement,cassignmentnode.create(
  290. ctemprefnode.create(temp),
  291. ccallnode.createintern('fpc_getmem',para)));
  292. { create call to fpc_initialize }
  293. if tpointerdef(p1.resulttype.def).pointertype.def.needs_inittable then
  294. begin
  295. para := ccallparanode.create(caddrnode.create_internal(crttinode.create
  296. (tstoreddef(tpointerdef(p1.resulttype.def).pointertype.def),initrtti)),
  297. ccallparanode.create(ctemprefnode.create
  298. (temp),nil));
  299. addstatement(newstatement,ccallnode.createintern('fpc_initialize',para));
  300. end;
  301. { the last statement should return the value as
  302. location and type, this is done be referencing the
  303. temp and converting it first from a persistent temp to
  304. normal temp }
  305. addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
  306. addstatement(newstatement,ctemprefnode.create(temp));
  307. p1.destroy;
  308. p1:=newblock;
  309. end
  310. else
  311. begin
  312. consume(_COMMA);
  313. if tpointerdef(p1.resulttype.def).pointertype.def.deftype<>objectdef then
  314. begin
  315. Message(parser_e_pointer_to_class_expected);
  316. consume_all_until(_RKLAMMER);
  317. consume(_RKLAMMER);
  318. p1.destroy;
  319. new_function:=cerrornode.create;
  320. exit;
  321. end;
  322. classh:=tobjectdef(tpointerdef(p1.resulttype.def).pointertype.def);
  323. { use the objectdef for loading the VMT }
  324. p2:=p1;
  325. p1:=ctypenode.create(tpointerdef(p1.resulttype.def).pointertype);
  326. do_resulttypepass(p1);
  327. { search the constructor also in the symbol tables of
  328. the parents }
  329. afterassignment:=false;
  330. sym:=searchsym_in_class(classh,pattern);
  331. consume(_ID);
  332. do_member_read(classh,false,sym,p1,again,[cnf_new_call]);
  333. { we need to know which procedure is called }
  334. do_resulttypepass(p1);
  335. if not(
  336. (p1.nodetype=calln) and
  337. assigned(tcallnode(p1).procdefinition) and
  338. (tcallnode(p1).procdefinition.proctypeoption=potype_constructor)
  339. ) then
  340. Message(parser_e_expr_have_to_be_constructor_call);
  341. { constructors return boolean, update resulttype to return
  342. the pointer to the object }
  343. p1.resulttype:=p2.resulttype;
  344. p2.free;
  345. consume(_RKLAMMER);
  346. end;
  347. new_function:=p1;
  348. end;
  349. function inline_setlength : tnode;
  350. var
  351. paras : tnode;
  352. npara,
  353. ppn : tcallparanode;
  354. dims,
  355. counter : integer;
  356. isarray : boolean;
  357. def : tdef;
  358. destppn : tnode;
  359. newstatement : tstatementnode;
  360. temp : ttempcreatenode;
  361. newblock : tnode;
  362. begin
  363. { for easy exiting if something goes wrong }
  364. result := cerrornode.create;
  365. consume(_LKLAMMER);
  366. paras:=parse_paras(false,false);
  367. consume(_RKLAMMER);
  368. if not assigned(paras) then
  369. begin
  370. CGMessage(parser_e_wrong_parameter_size);
  371. exit;
  372. end;
  373. dims:=0;
  374. if assigned(paras) then
  375. begin
  376. { check type of lengths }
  377. ppn:=tcallparanode(paras);
  378. while assigned(ppn.right) do
  379. begin
  380. set_varstate(ppn.left,vs_used,true);
  381. inserttypeconv(ppn.left,sinttype);
  382. inc(dims);
  383. ppn:=tcallparanode(ppn.right);
  384. end;
  385. end;
  386. if dims=0 then
  387. begin
  388. CGMessage(parser_e_wrong_parameter_size);
  389. paras.free;
  390. exit;
  391. end;
  392. { last param must be var }
  393. destppn:=ppn.left;
  394. inc(parsing_para_level);
  395. valid_for_var(destppn);
  396. set_varstate(destppn,vs_assigned,false);
  397. dec(parsing_para_level);
  398. { first param must be a string or dynamic array ...}
  399. isarray:=is_dynamic_array(destppn.resulttype.def);
  400. if not((destppn.resulttype.def.deftype=stringdef) or
  401. isarray) then
  402. begin
  403. CGMessage(type_e_mismatch);
  404. paras.free;
  405. exit;
  406. end;
  407. { only dynamic arrays accept more dimensions }
  408. if (dims>1) then
  409. begin
  410. if (not isarray) then
  411. CGMessage(type_e_mismatch)
  412. else
  413. begin
  414. { check if the amount of dimensions is valid }
  415. def := tarraydef(destppn.resulttype.def).elementtype.def;
  416. counter:=dims;
  417. while counter > 1 do
  418. begin
  419. if not(is_dynamic_array(def)) then
  420. begin
  421. CGMessage(parser_e_wrong_parameter_size);
  422. break;
  423. end;
  424. dec(counter);
  425. def := tarraydef(def).elementtype.def;
  426. end;
  427. end;
  428. end;
  429. if isarray then
  430. begin
  431. { create statements with call initialize the arguments and
  432. call fpc_dynarr_setlength }
  433. newblock:=internalstatements(newstatement);
  434. { get temp for array of lengths }
  435. temp := ctempcreatenode.create(sinttype,dims*sinttype.def.size,tt_persistent,false);
  436. addstatement(newstatement,temp);
  437. { load array of lengths }
  438. ppn:=tcallparanode(paras);
  439. counter:=0;
  440. while assigned(ppn.right) do
  441. begin
  442. addstatement(newstatement,cassignmentnode.create(
  443. ctemprefnode.create_offset(temp,counter*sinttype.def.size),
  444. ppn.left));
  445. ppn.left:=nil;
  446. inc(counter);
  447. ppn:=tcallparanode(ppn.right);
  448. end;
  449. { destppn is also reused }
  450. ppn.left:=nil;
  451. { create call to fpc_dynarr_setlength }
  452. npara:=ccallparanode.create(caddrnode.create_internal
  453. (ctemprefnode.create(temp)),
  454. ccallparanode.create(cordconstnode.create
  455. (counter,s32inttype,true),
  456. ccallparanode.create(caddrnode.create_internal
  457. (crttinode.create(tstoreddef(destppn.resulttype.def),initrtti)),
  458. ccallparanode.create(ctypeconvnode.create_internal(destppn,voidpointertype),nil))));
  459. addstatement(newstatement,ccallnode.createintern('fpc_dynarray_setlength',npara));
  460. addstatement(newstatement,ctempdeletenode.create(temp));
  461. { we don't need original the callparanodes tree }
  462. paras.free;
  463. end
  464. else
  465. begin
  466. { we can reuse the supplied parameters }
  467. newblock:=ccallnode.createintern(
  468. 'fpc_'+tstringdef(destppn.resulttype.def).stringtypname+'_setlength',paras);
  469. end;
  470. result.free;
  471. result:=newblock;
  472. end;
  473. function inline_initialize : tnode;
  474. var
  475. newblock,
  476. paras : tnode;
  477. ppn : tcallparanode;
  478. begin
  479. { for easy exiting if something goes wrong }
  480. result := cerrornode.create;
  481. consume(_LKLAMMER);
  482. paras:=parse_paras(false,false);
  483. consume(_RKLAMMER);
  484. if not assigned(paras) then
  485. begin
  486. CGMessage(parser_e_wrong_parameter_size);
  487. exit;
  488. end;
  489. ppn:=tcallparanode(paras);
  490. { 2 arguments? }
  491. if assigned(ppn.right) then
  492. begin
  493. CGMessage(parser_e_wrong_parameter_size);
  494. paras.free;
  495. exit;
  496. end;
  497. newblock:=initialize_data_node(ppn.left);
  498. ppn.left:=nil;
  499. paras.free;
  500. result.free;
  501. result:=newblock;
  502. end;
  503. function inline_finalize : tnode;
  504. var
  505. newblock,
  506. paras : tnode;
  507. npara,
  508. destppn,
  509. ppn : tcallparanode;
  510. begin
  511. { for easy exiting if something goes wrong }
  512. result := cerrornode.create;
  513. consume(_LKLAMMER);
  514. paras:=parse_paras(false,false);
  515. consume(_RKLAMMER);
  516. if not assigned(paras) then
  517. begin
  518. CGMessage(parser_e_wrong_parameter_size);
  519. exit;
  520. end;
  521. ppn:=tcallparanode(paras);
  522. { 2 arguments? }
  523. if assigned(ppn.right) then
  524. begin
  525. destppn:=tcallparanode(ppn.right);
  526. { 3 arguments is invalid }
  527. if assigned(destppn.right) then
  528. begin
  529. CGMessage(parser_e_wrong_parameter_size);
  530. paras.free;
  531. exit;
  532. end;
  533. { create call to fpc_finalize_array }
  534. npara:=ccallparanode.create(cordconstnode.create
  535. (destppn.left.resulttype.def.size,s32inttype,true),
  536. ccallparanode.create(ctypeconvnode.create
  537. (ppn.left,s32inttype),
  538. ccallparanode.create(caddrnode.create_internal
  539. (crttinode.create(tstoreddef(destppn.left.resulttype.def),initrtti)),
  540. ccallparanode.create(caddrnode.create_internal
  541. (destppn.left),nil))));
  542. newblock:=ccallnode.createintern('fpc_finalize_array',npara);
  543. destppn.left:=nil;
  544. ppn.left:=nil;
  545. end
  546. else
  547. begin
  548. newblock:=finalize_data_node(ppn.left);
  549. ppn.left:=nil;
  550. end;
  551. paras.free;
  552. result.free;
  553. result:=newblock;
  554. end;
  555. function inline_copy : tnode;
  556. var
  557. copynode,
  558. lowppn,
  559. highppn,
  560. npara,
  561. paras : tnode;
  562. temp : ttempcreatenode;
  563. ppn : tcallparanode;
  564. paradef : tdef;
  565. counter : integer;
  566. newstatement : tstatementnode;
  567. {$ifdef ansistring_bits}
  568. mode : byte;
  569. {$endif ansistring_bits}
  570. begin
  571. { for easy exiting if something goes wrong }
  572. result := cerrornode.create;
  573. consume(_LKLAMMER);
  574. paras:=parse_paras(false,false);
  575. consume(_RKLAMMER);
  576. if not assigned(paras) then
  577. begin
  578. CGMessage(parser_e_wrong_parameter_size);
  579. exit;
  580. end;
  581. { determine copy function to use based on the first argument,
  582. also count the number of arguments in this loop }
  583. counter:=1;
  584. ppn:=tcallparanode(paras);
  585. while assigned(ppn.right) do
  586. begin
  587. inc(counter);
  588. ppn:=tcallparanode(ppn.right);
  589. end;
  590. paradef:=ppn.left.resulttype.def;
  591. {$ifdef ansistring_bits}
  592. if is_ansistring(paradef) then
  593. case Tstringdef(paradef).string_typ of
  594. st_ansistring16:
  595. mode:=16;
  596. st_ansistring32:
  597. mode:=32;
  598. st_ansistring64:
  599. mode:=64;
  600. end;
  601. if (is_chararray(paradef) and (paradef.size>255)) or
  602. ((cs_ansistrings in aktlocalswitches) and is_pchar(paradef)) then
  603. case aktansistring_bits of
  604. sb_16:
  605. mode:=16;
  606. sb_32:
  607. mode:=32;
  608. sb_64:
  609. mode:=64;
  610. end;
  611. if mode=16 then
  612. copynode:=ccallnode.createintern('fpc_ansistr16_copy',paras)
  613. else if mode=32 then
  614. copynode:=ccallnode.createintern('fpc_ansistr32_copy',paras)
  615. else if mode=64 then
  616. copynode:=ccallnode.createintern('fpc_ansistr64_copy',paras)
  617. {$else}
  618. if is_ansistring(paradef) or
  619. (is_chararray(paradef) and
  620. (paradef.size>255)) or
  621. ((cs_ansistrings in aktlocalswitches) and
  622. is_pchar(paradef)) then
  623. copynode:=ccallnode.createintern('fpc_ansistr_copy',paras)
  624. {$endif}
  625. else
  626. if is_widestring(paradef) or
  627. is_widechararray(paradef) or
  628. is_pwidechar(paradef) then
  629. copynode:=ccallnode.createintern('fpc_widestr_copy',paras)
  630. else
  631. if is_char(paradef) then
  632. copynode:=ccallnode.createintern('fpc_char_copy',paras)
  633. else
  634. if is_dynamic_array(paradef) then
  635. begin
  636. { Only allow 1 or 3 arguments }
  637. if (counter<>1) and (counter<>3) then
  638. begin
  639. CGMessage(parser_e_wrong_parameter_size);
  640. exit;
  641. end;
  642. { create statements with call }
  643. copynode:=internalstatements(newstatement);
  644. if (counter=3) then
  645. begin
  646. highppn:=tcallparanode(paras).left.getcopy;
  647. lowppn:=tcallparanode(tcallparanode(paras).right).left.getcopy;
  648. end
  649. else
  650. begin
  651. { use special -1,-1 argument to copy the whole array }
  652. highppn:=cordconstnode.create(-1,s32inttype,false);
  653. lowppn:=cordconstnode.create(-1,s32inttype,false);
  654. end;
  655. { create typed temp for result so the temp is finalized }
  656. temp := ctempcreatenode.create(ppn.left.resulttype,ppn.left.resulttype.def.size,tt_persistent,false);
  657. addstatement(newstatement,temp);
  658. { create call to fpc_dynarray_copy }
  659. npara:=ccallparanode.create(highppn,
  660. ccallparanode.create(lowppn,
  661. ccallparanode.create(caddrnode.create_internal
  662. (crttinode.create(tstoreddef(ppn.left.resulttype.def),initrtti)),
  663. ccallparanode.create
  664. (ctypeconvnode.create_internal(ppn.left,voidpointertype),
  665. ccallparanode.create
  666. (ctypeconvnode.create_internal(ctemprefnode.create(temp),voidpointertype),nil)))));
  667. addstatement(newstatement,ccallnode.createintern('fpc_dynarray_copy',npara));
  668. { convert the temp to normal and return the reference to the
  669. created temp, and convert the type of the temp to the dynarray type }
  670. addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
  671. addstatement(newstatement,ctemprefnode.create(temp));
  672. ppn.left:=nil;
  673. paras.free;
  674. end
  675. else
  676. begin
  677. { generic fallback that will give an error if a wrong
  678. type is passed }
  679. copynode:=ccallnode.createintern('fpc_shortstr_copy',paras)
  680. end;
  681. result.free;
  682. result:=copynode;
  683. end;
  684. end.
  685. {
  686. $Log$
  687. Revision 1.38 2004-12-05 12:28:11 peter
  688. * procvar handling for tp procvar mode fixed
  689. * proc to procvar moved from addrnode to typeconvnode
  690. * inlininginfo is now allocated only for inline routines that
  691. can be inlined, introduced a new flag po_has_inlining_info
  692. Revision 1.37 2004/11/21 17:54:59 peter
  693. * ttempcreatenode.create_reg merged into .create with parameter
  694. whether a register is allowed
  695. * funcret_paraloc renamed to funcretloc
  696. Revision 1.36 2004/11/02 18:37:08 florian
  697. * dyn. array dimensions are now stored as sinttype so it's target register size dependend
  698. Revision 1.35 2004/11/02 12:55:16 peter
  699. * nf_internal flag for internal inserted typeconvs. This will
  700. supress the generation of warning/hints
  701. Revision 1.34 2004/11/01 10:32:27 peter
  702. * temp for dynarray copy needs to be typed
  703. Revision 1.33 2004/10/15 09:14:17 mazen
  704. - remove $IFDEF DELPHI and related code
  705. - remove $IFDEF FPCPROCVAR and related code
  706. Revision 1.32 2004/06/20 08:55:30 florian
  707. * logs truncated
  708. Revision 1.31 2004/05/23 18:28:41 peter
  709. * methodpointer is loaded into a temp when it was a calln
  710. Revision 1.30 2004/04/29 19:56:37 daniel
  711. * Prepare compiler infrastructure for multiple ansistring types
  712. Revision 1.29 2004/02/04 18:45:29 jonas
  713. + some more usage of register temps
  714. Revision 1.28 2004/02/03 22:32:54 peter
  715. * renamed xNNbittype to xNNinttype
  716. * renamed registers32 to registersint
  717. * replace some s32bit,u32bit with torddef([su]inttype).def.typ
  718. Revision 1.27 2004/02/03 16:46:51 jonas
  719. + support to store ttempcreate/ref/deletenodes in registers
  720. * put temps for withnodes and some newnodes in registers
  721. Note: this currently only works because calling ungetregister()
  722. multiple times for the same register doesn't matter. We need again
  723. a way to specify that a register is currently a regvar and as such
  724. should not be freed when you call ungetregister() on it.
  725. }