objcdef.pas 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656
  1. {
  2. Copyright (c) 2010 by Jonas Maebe
  3. This unit implements some Objective-C type helper routines (minimal
  4. unit dependencies, usable in symdef).
  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. {$i fpcdefs.inc}
  19. unit objcdef;
  20. interface
  21. uses
  22. node,
  23. symtype;
  24. { The internals of Objective-C's @encode() functionality: encode a
  25. type into the internal format used by the run time. Returns false
  26. if a type is not representable by the Objective-C run time, and in
  27. that case also the failing definition. }
  28. function objctryencodetype(def: tdef; out encodedtype: ansistring; out founderror: tdef): boolean;
  29. { Check whether a type can be used in an Objective-C method
  30. signature or field declaration. }
  31. function objcchecktype(def: tdef; out founderror: tdef): boolean;
  32. { add type info for def at the end of encodedstr. recordinfostate influences
  33. whether a record-style type will be fully encoded, or just using its
  34. type name. bpacked indicates whether a record/array is bitpacked.
  35. On error, founderror contains the type that triggered the error. }
  36. type
  37. trecordinfostate = (ris_initial, ris_afterpointer, ris_dontprint);
  38. function objcaddencodedtype(def: tdef; recordinfostate: trecordinfostate; bpacked: boolean; var encodedstr: ansistring; out founderror: tdef): boolean;
  39. implementation
  40. uses
  41. globtype,
  42. cutils,cclasses,
  43. verbose,systems,
  44. symtable,symconst,symsym,symdef,
  45. defutil,paramgr;
  46. {******************************************************************
  47. Type encoding
  48. *******************************************************************}
  49. function encoderecst(const recname: ansistring; recst: tabstractrecordsymtable; var encodedstr: ansistring; out founderror: tdef): boolean;
  50. var
  51. variantstarts: tfplist;
  52. i, varindex: longint;
  53. field,
  54. firstfield: tfieldvarsym;
  55. firstfieldvariant,
  56. bpacked: boolean;
  57. begin
  58. result:=false;
  59. bpacked:=recst.fieldalignment=bit_alignment;
  60. { Is the first field already the start of a variant? }
  61. firstfield:=nil;
  62. firstfieldvariant:=false;
  63. for i:=0 to recst.symlist.count-1 do
  64. begin
  65. if (tsym(recst.symlist[i]).typ<>fieldvarsym) then
  66. continue;
  67. field:=tfieldvarsym(recst.symlist[i]);
  68. if not assigned(firstfield) then
  69. firstfield:=field
  70. else if (vo_is_first_field in field.varoptions) then
  71. begin
  72. if (field.fieldoffset=firstfield.fieldoffset) then
  73. firstfieldvariant:=true;
  74. end;
  75. end;
  76. variantstarts:=tfplist.create;
  77. encodedstr:=encodedstr+'{'+recname+'=';
  78. for i:=0 to recst.symlist.count-1 do
  79. begin
  80. if (tsym(recst.symlist[i]).typ<>fieldvarsym) then
  81. continue;
  82. field:=tfieldvarsym(recst.symlist[i]);
  83. { start of a variant part? }
  84. if ((field=firstfield) and
  85. firstfieldvariant) or
  86. ((field<>firstfield) and
  87. (vo_is_first_field in field.varoptions)) then
  88. begin
  89. varindex:=variantstarts.count-1;
  90. if (varindex=-1) or
  91. (tfieldvarsym(variantstarts[varindex]).fieldoffset<field.fieldoffset) then
  92. begin
  93. { new, more deeply nested variant }
  94. encodedstr:=encodedstr+'(?={?=';
  95. variantstarts.add(field);
  96. end
  97. else
  98. begin
  99. { close existing nested variants if any }
  100. while (varindex>=0) and
  101. (tfieldvarsym(variantstarts[varindex]).fieldoffset>field.fieldoffset) do
  102. begin
  103. { close more deeply nested variants }
  104. encodedstr:=encodedstr+'})';
  105. dec(varindex);
  106. end;
  107. if (varindex<0) then
  108. internalerror(2009081805);
  109. if (tfieldvarsym(variantstarts[varindex]).fieldoffset<>field.fieldoffset) then
  110. internalerror(2009081804);
  111. { variant at the same level as a previous one }
  112. variantstarts.count:=varindex+1;
  113. { No need to add this field, it has the same offset as the
  114. previous one at this position. }
  115. if tfieldvarsym(variantstarts[varindex]).fieldoffset<>field.fieldoffset then
  116. internalerror(2009081601);
  117. { close previous variant sub-part and start new one }
  118. encodedstr:=encodedstr+'}{?=';
  119. end
  120. end;
  121. if not objcaddencodedtype(field.vardef,ris_afterpointer,bpacked,encodedstr,founderror) then
  122. exit;
  123. end;
  124. for i:=0 to variantstarts.count-1 do
  125. encodedstr:=encodedstr+'})';
  126. variantstarts.free;
  127. encodedstr:=encodedstr+'}';
  128. result:=true
  129. end;
  130. function objcaddencodedtype(def: tdef; recordinfostate: trecordinfostate; bpacked: boolean; var encodedstr: ansistring; out founderror: tdef): boolean;
  131. var
  132. recname: ansistring;
  133. recdef: trecorddef;
  134. objdef: tobjectdef;
  135. len: aint;
  136. c: char;
  137. newstate: trecordinfostate;
  138. addrpara: boolean;
  139. begin
  140. result:=true;
  141. case def.typ of
  142. stringdef :
  143. begin
  144. case tstringdef(def).stringtype of
  145. st_shortstring:
  146. { include length byte }
  147. encodedstr:=encodedstr+'['+tostr(tstringdef(def).len+1)+'C]';
  148. else
  149. { While we could handle refcounted Pascal strings correctly
  150. when such methods are called from Pascal code, things would
  151. completely break down if they were called from Objective-C
  152. code/reflection since the necessary refcount helper calls
  153. would be missing on the caller side (unless we'd
  154. automatically generate wrappers). }
  155. result:=false;
  156. end;
  157. end;
  158. enumdef,
  159. orddef :
  160. begin
  161. if bpacked and
  162. not is_void(def) then
  163. encodedstr:=encodedstr+'b'+tostr(def.packedbitsize)
  164. else
  165. begin
  166. if is_void(def) then
  167. c:='v'
  168. { in gcc, sizeof(_Bool) = sizeof(char) }
  169. else if is_boolean(def) and
  170. (def.size=1) then
  171. c:='B'
  172. else
  173. begin
  174. case def.size of
  175. 1:
  176. c:='c';
  177. 2:
  178. c:='s';
  179. 4:
  180. c:='i';
  181. 8:
  182. c:='q';
  183. else
  184. internalerror(2009081502);
  185. end;
  186. if not is_signed(def) then
  187. c:=upcase(c);
  188. end;
  189. encodedstr:=encodedstr+c;
  190. end;
  191. end;
  192. pointerdef :
  193. begin
  194. if is_pchar(def) then
  195. encodedstr:=encodedstr+'*'
  196. else if (def=objc_idtype) then
  197. encodedstr:=encodedstr+'@'
  198. else if (def=objc_seltype) then
  199. encodedstr:=encodedstr+':'
  200. else if (def=objc_metaclasstype) then
  201. encodedstr:=encodedstr+'#'
  202. else
  203. begin
  204. encodedstr:=encodedstr+'^';
  205. newstate:=recordinfostate;
  206. if (recordinfostate<ris_dontprint) then
  207. newstate:=succ(newstate);
  208. if not objcaddencodedtype(tpointerdef(def).pointeddef,newstate,false,encodedstr,founderror) then
  209. begin
  210. result:=false;
  211. { report the exact (nested) error defintion }
  212. exit;
  213. end;
  214. end;
  215. end;
  216. floatdef :
  217. begin
  218. case tfloatdef(def).floattype of
  219. s32real:
  220. c:='f';
  221. s64real:
  222. c:='d';
  223. else
  224. begin
  225. c:='!';
  226. result:=false;
  227. end;
  228. end;
  229. encodedstr:=encodedstr+c;
  230. end;
  231. filedef :
  232. result:=false;
  233. recorddef :
  234. begin
  235. if assigned(def.typesym) then
  236. recname:=def.typename
  237. else
  238. recname:='?';
  239. if (recordinfostate<>ris_dontprint) then
  240. begin
  241. if not encoderecst(recname,tabstractrecordsymtable(trecorddef(def).symtable),encodedstr,founderror) then
  242. begin
  243. result:=false;
  244. { report the exact (nested) error defintion }
  245. exit;
  246. end
  247. end
  248. else
  249. encodedstr:=encodedstr+'{'+recname+'}'
  250. end;
  251. variantdef :
  252. begin
  253. recdef:=trecorddef(search_system_type('TVARDATA').typedef);
  254. if (recordinfostate<>ris_dontprint) then
  255. begin
  256. if not encoderecst(recdef.typename,tabstractrecordsymtable(recdef.symtable),encodedstr,founderror) then
  257. begin
  258. result:=false;
  259. { report the exact (nested) error defintion }
  260. exit;
  261. end
  262. end
  263. else
  264. encodedstr:=encodedstr+'{'+recdef.typename+'}';
  265. end;
  266. classrefdef :
  267. begin
  268. encodedstr:=encodedstr+'^';
  269. newstate:=recordinfostate;
  270. if (recordinfostate<>ris_dontprint) then
  271. newstate:=succ(newstate);
  272. if is_objcclassref(def) then
  273. begin
  274. objdef:=tobjectdef(tclassrefdef(def).pointeddef);
  275. if (newstate<>ris_dontprint) then
  276. { anonymous (objc)class definitions do not exist }
  277. begin
  278. if not encoderecst(objdef.objextname^,tabstractrecordsymtable(objdef.symtable),encodedstr,founderror) then
  279. { The fields of an Objective-C class should always be
  280. encodeable. }
  281. internalerror(2009081702);
  282. end
  283. else
  284. encodedstr:=encodedstr+'{'+objdef.objextname^+'}'
  285. end
  286. { Object Pascal classrefdefs point to a vmt, not really useful
  287. to completely write those here. I'm not even sure what the
  288. Objective-C run time uses this information for, since in C you
  289. can have forward struct definitions so not all structs passed
  290. to functions can be written out here either -> treat
  291. classrefdefs the same as such forward-defined structs. }
  292. else
  293. begin
  294. if assigned(def.typesym) then
  295. recname:=def.typename
  296. else
  297. recname:='?';
  298. encodedstr:=encodedstr+'{'+recname;
  299. if (newstate<>ris_dontprint) then
  300. encodedstr:=encodedstr+'=';
  301. encodedstr:=encodedstr+'}'
  302. end;
  303. end;
  304. setdef :
  305. begin
  306. addrpara:=paramanager.push_addr_param(vs_value,def,pocall_cdecl);
  307. if not addrpara then
  308. { encode as an record, they are always passed by value in C. }
  309. encodedstr:=encodedstr+'{?=';
  310. { Encode the set itself as an array. Without an encompassing
  311. record, these are always passed by reference in C. }
  312. encodedstr:=encodedstr+'['+tostr(def.size)+'C]';
  313. if not addrpara then
  314. encodedstr:=encodedstr+'}';
  315. end;
  316. formaldef :
  317. begin
  318. encodedstr:=encodedstr+'^v';
  319. end;
  320. arraydef :
  321. begin
  322. if is_array_of_const(def) then
  323. { do nothing, varargs are ignored in signatures }
  324. else if is_special_array(def) then
  325. result:=false
  326. else
  327. begin
  328. len:=tarraydef(def).highrange-tarraydef(def).lowrange+1;
  329. if is_packed_array(def) then
  330. begin
  331. { convert from bits to bytes for bitpacked arrays }
  332. len:=(len+7) div 8;
  333. { and encode as plain array of bytes }
  334. encodedstr:=encodedstr+'['+tostr(len)+'C]';
  335. end
  336. else
  337. begin
  338. encodedstr:=encodedstr+'['+tostr(len);
  339. { Embedded structured types in the array are printed
  340. in full regardless of the current recordinfostate. }
  341. if not objcaddencodedtype(tarraydef(def).elementdef,ris_initial,false,encodedstr,founderror) then
  342. begin
  343. result:=false;
  344. { report the exact (nested) error defintion }
  345. exit;
  346. end;
  347. encodedstr:=encodedstr+']';
  348. end;
  349. end;
  350. end;
  351. procvardef :
  352. if not(po_is_block in tprocvardef(def).procoptions) then
  353. encodedstr:=encodedstr+'^?'
  354. else
  355. encodedstr:=encodedstr+'@?';
  356. objectdef :
  357. case tobjectdef(def).objecttype of
  358. odt_helper,
  359. odt_class,
  360. odt_object,
  361. odt_cppclass:
  362. begin
  363. newstate:=recordinfostate;
  364. { implicit pointer for classes }
  365. if (tobjectdef(def).objecttype in [odt_class,odt_helper]) then
  366. begin
  367. encodedstr:=encodedstr+'^';
  368. { make all classes opaque, so even if they contain a
  369. reference-counted field there is no problem. Since a
  370. "dereferenced class" object does not exist, this should
  371. not cause problems }
  372. newstate:=ris_dontprint;
  373. end;
  374. if newstate<>ris_dontprint then
  375. begin
  376. if not encoderecst(def.typename,tabstractrecordsymtable(tobjectdef(def).symtable),encodedstr,founderror) then
  377. begin
  378. result:=false;
  379. { report the exact (nested) error defintion }
  380. exit;
  381. end
  382. end
  383. else
  384. encodedstr:=encodedstr+'{'+def.typename+'}'
  385. end;
  386. odt_interfacecom,
  387. odt_interfacecom_property,
  388. odt_interfacecom_function,
  389. odt_dispinterface:
  390. result:=false;
  391. odt_interfacecorba:
  392. encodedstr:=encodedstr+'^{'+def.typename+'=}';
  393. { In Objective-C, the actual types of class instances are
  394. NSObject* etc, and those are encoded as "@". In FPC, to keep
  395. the similarity with Delphi-style Object Pascal, the type is
  396. NSObject and the pointer is implicit. Objective-C's "NSObject"
  397. has "class of NSObject" as equivalent here. }
  398. odt_objcclass,
  399. odt_objcprotocol:
  400. encodedstr:=encodedstr+'@';
  401. else
  402. internalerror(2009081509);
  403. end;
  404. undefineddef,
  405. errordef :
  406. result:=false;
  407. procdef :
  408. { must be done via objcencodemethod() }
  409. internalerror(2009081511);
  410. else
  411. internalerror(2009150812);
  412. end;
  413. if not result then
  414. founderror:=def;
  415. end;
  416. function objctryencodetype(def: tdef; out encodedtype: ansistring; out founderror: tdef): boolean;
  417. begin
  418. result:=objcaddencodedtype(def,ris_initial,false,encodedtype,founderror);
  419. end;
  420. {******************************************************************
  421. ObjC type validity checking
  422. *******************************************************************}
  423. function objcdochecktype(def: tdef; recordinfostate: trecordinfostate; out founderror: tdef): boolean; forward;
  424. function checkrecsttype(recst: tabstractrecordsymtable; recordinfostate: trecordinfostate; out founderror: tdef): boolean;
  425. var
  426. i: longint;
  427. field: tfieldvarsym;
  428. newstate: trecordinfostate;
  429. begin
  430. result:=false;
  431. newstate:=recordinfostate;
  432. { Although we never have to print the type info for nested
  433. records, check them anyway in case we're not after a pointer
  434. since if such records contain refcounted types then they
  435. can cause just as much trouble as if they were a simple
  436. refcounted field. }
  437. if (newstate=ris_afterpointer) then
  438. newstate:=ris_dontprint;
  439. for i:=0 to recst.symlist.count-1 do
  440. begin
  441. if (tsym(recst.symlist[i]).typ<>fieldvarsym) then
  442. continue;
  443. field:=tfieldvarsym(recst.symlist[i]);
  444. if not objcdochecktype(field.vardef,newstate,founderror) then
  445. exit;
  446. end;
  447. result:=true
  448. end;
  449. function objcdochecktype(def: tdef; recordinfostate: trecordinfostate; out founderror: tdef): boolean;
  450. var
  451. recdef: trecorddef;
  452. objdef: tobjectdef;
  453. newstate: trecordinfostate;
  454. begin
  455. result:=true;
  456. case def.typ of
  457. stringdef :
  458. begin
  459. case tstringdef(def).stringtype of
  460. st_shortstring:
  461. ;
  462. else
  463. { While we could handle refcounted Pascal strings correctly
  464. when such methods are called from Pascal code, things would
  465. completely break down if they were called from Objective-C
  466. code/reflection since the necessary refcount helper calls
  467. would be missing on the caller side (unless we'd
  468. automatically generate wrappers). }
  469. result:=false;
  470. end;
  471. end;
  472. enumdef,
  473. orddef :
  474. ;
  475. pointerdef :
  476. begin
  477. newstate:=recordinfostate;
  478. if (recordinfostate<ris_dontprint) then
  479. newstate:=succ(newstate);
  480. if not objcdochecktype(tpointerdef(def).pointeddef,newstate,founderror) then
  481. begin
  482. result:=false;
  483. { report the exact (nested) error defintion }
  484. exit;
  485. end;
  486. end;
  487. floatdef :
  488. begin
  489. case tfloatdef(def).floattype of
  490. s32real,
  491. s64real:
  492. ;
  493. else
  494. result:=false;
  495. end;
  496. end;
  497. filedef :
  498. result:=false;
  499. recorddef :
  500. begin
  501. if (recordinfostate<>ris_dontprint) then
  502. begin
  503. if not checkrecsttype(tabstractrecordsymtable(trecorddef(def).symtable),recordinfostate,founderror) then
  504. begin
  505. result:=false;
  506. { report the exact (nested) error defintion }
  507. exit;
  508. end
  509. end
  510. end;
  511. variantdef :
  512. begin
  513. recdef:=trecorddef(search_system_type('TVARDATA').typedef);
  514. if (recordinfostate<>ris_dontprint) then
  515. begin
  516. if not checkrecsttype(tabstractrecordsymtable(recdef.symtable),recordinfostate,founderror) then
  517. begin
  518. result:=false;
  519. { report the exact (nested) error defintion }
  520. exit;
  521. end
  522. end;
  523. end;
  524. classrefdef:
  525. begin
  526. if is_objcclassref(def) then
  527. begin
  528. objdef:=tobjectdef(tclassrefdef(def).pointeddef);
  529. newstate:=recordinfostate;
  530. if (recordinfostate<ris_dontprint) then
  531. newstate:=succ(newstate);
  532. if (newstate<>ris_dontprint) then
  533. begin
  534. if not checkrecsttype(tabstractrecordsymtable(objdef.symtable),recordinfostate,founderror) then
  535. begin
  536. result:=false;
  537. { report the exact (nested) error defintion }
  538. exit;
  539. end
  540. end
  541. end
  542. end;
  543. setdef,
  544. formaldef :
  545. ;
  546. arraydef :
  547. begin
  548. if is_array_of_const(def) then
  549. { ok, varargs are ignored in signatures }
  550. else if is_special_array(def) then
  551. result:=false
  552. else
  553. begin
  554. if not is_packed_array(def) then
  555. begin
  556. if not objcdochecktype(tarraydef(def).elementdef,ris_initial,founderror) then
  557. begin
  558. result:=false;
  559. { report the exact (nested) error defintion }
  560. exit;
  561. end;
  562. end;
  563. end;
  564. end;
  565. procvardef :
  566. ;
  567. objectdef :
  568. case tobjectdef(def).objecttype of
  569. odt_helper,
  570. odt_class,
  571. odt_object,
  572. odt_cppclass:
  573. begin
  574. newstate:=recordinfostate;
  575. { implicit pointer for classes }
  576. if (tobjectdef(def).objecttype in [odt_class,odt_helper]) then
  577. begin
  578. { make all classes opaque, so even if they contain a
  579. reference-counted field there is no problem. Since a
  580. "dereferenced class" object does not exist, this should
  581. not cause problems }
  582. newstate:=ris_dontprint;
  583. end;
  584. if newstate<>ris_dontprint then
  585. begin
  586. if not checkrecsttype(tabstractrecordsymtable(tobjectdef(def).symtable),newstate,founderror) then
  587. begin
  588. result:=false;
  589. { report the exact (nested) error defintion }
  590. exit;
  591. end
  592. end
  593. end;
  594. odt_interfacecom,
  595. odt_interfacecom_property,
  596. odt_interfacecom_function,
  597. odt_dispinterface:
  598. result:=false;
  599. odt_interfacecorba,
  600. odt_objcclass,
  601. odt_objcprotocol:
  602. ;
  603. else
  604. internalerror(2009081709);
  605. end;
  606. undefineddef,
  607. errordef :
  608. result:=false;
  609. procdef :
  610. result:=false;
  611. else
  612. internalerror(2009170812);
  613. end;
  614. if not result then
  615. founderror:=def;
  616. end;
  617. function objcchecktype(def: tdef; out founderror: tdef): boolean;
  618. begin
  619. result:=objcdochecktype(def,ris_initial,founderror);
  620. end;
  621. end.