/compiler/nobjc.pas

https://github.com/slibre/freepascal · Pascal · 169 lines · 106 code · 26 blank · 37 comment · 8 complexity · d6d3a866d76af6135f968fd7a4f577e6 MD5 · raw file

  1. {
  2. Copyright (c) 2009 by Jonas Maebe
  3. This unit implements Objective-C nodes
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. { @abstract(This unit implements Objective-C nodes)
  18. This unit contains various nodes to implement Objective-Pascal and to
  19. interface with the Objective-C runtime.
  20. }
  21. unit nobjc;
  22. {$i fpcdefs.inc}
  23. interface
  24. uses
  25. node;
  26. type
  27. tobjcselectornode = class(tunarynode)
  28. public
  29. constructor create(formethod: tnode);
  30. function pass_typecheck: tnode;override;
  31. function pass_1: tnode;override;
  32. end;
  33. tobjcselectornodeclass = class of tobjcselectornode;
  34. tobjcprotocolnode = class(tunarynode)
  35. public
  36. constructor create(forprotocol: tnode);
  37. function pass_typecheck: tnode;override;
  38. function pass_1: tnode;override;
  39. end;
  40. tobjcprotocolnodeclass = class of tobjcprotocolnode;
  41. var
  42. cobjcselectornode : tobjcselectornodeclass;
  43. cobjcprotocolnode : tobjcprotocolnodeclass;
  44. implementation
  45. uses
  46. sysutils,
  47. globtype,globals,cclasses,systems,
  48. verbose,pass_1,
  49. defutil,
  50. symtype,symtable,symdef,symconst,symsym,
  51. paramgr,
  52. nutils,
  53. nbas,nld,ncnv,ncon,ncal,nmem,
  54. objcutil,
  55. cgbase;
  56. {*****************************************************************************
  57. TOBJCSELECTORNODE
  58. *****************************************************************************}
  59. constructor tobjcselectornode.create(formethod: tnode);
  60. begin
  61. inherited create(objcselectorn,formethod);
  62. end;
  63. function tobjcselectornode.pass_typecheck: tnode;
  64. var
  65. len: longint;
  66. s: shortstring;
  67. begin
  68. if not(m_objectivec1 in current_settings.modeswitches) then
  69. Message(parser_f_modeswitch_objc_required);
  70. result:=nil;
  71. typecheckpass(left);
  72. { argument can be
  73. a) an objc method
  74. b) a pchar, zero-based chararray or ansistring
  75. }
  76. case left.nodetype of
  77. loadn:
  78. begin
  79. if (left.resultdef.typ=procdef) and
  80. (po_objc in tprocdef(left.resultdef).procoptions) then
  81. begin
  82. { ok }
  83. end
  84. else
  85. CGMessage1(type_e_expected_objc_method_but_got,left.resultdef.typename);
  86. end;
  87. stringconstn:
  88. begin
  89. if not objcvalidselectorname(tstringconstnode(left).value_str,
  90. tstringconstnode(left).len) then
  91. begin
  92. len:=tstringconstnode(left).len;
  93. if (len>255) then
  94. len:=255;
  95. setlength(s,len);
  96. move(tstringconstnode(left).value_str^,s[1],len);
  97. CGMessage1(type_e_invalid_objc_selector_name,s);
  98. exit;
  99. end;
  100. end
  101. else
  102. CGMessage(type_e_expected_objc_method);
  103. end;
  104. resultdef:=objc_seltype;
  105. end;
  106. function tobjcselectornode.pass_1: tnode;
  107. begin
  108. result:=nil;
  109. expectloc:=LOC_CREFERENCE;
  110. end;
  111. {*****************************************************************************
  112. TOBJPROTOCOLNODE
  113. *****************************************************************************}
  114. constructor tobjcprotocolnode.create(forprotocol: tnode);
  115. begin
  116. inherited create(objcprotocoln,forprotocol);
  117. end;
  118. function tobjcprotocolnode.pass_typecheck: tnode;
  119. begin
  120. if not(m_objectivec1 in current_settings.modeswitches) then
  121. Message(parser_f_modeswitch_objc_required);
  122. result:=nil;
  123. typecheckpass(left);
  124. if (left.nodetype<>typen) then
  125. MessagePos(left.fileinfo,type_e_type_id_expected)
  126. else if not is_objcprotocol(left.resultdef) then
  127. MessagePos2(left.fileinfo,type_e_incompatible_types,left.resultdef.typename,'ObjCProtocol');
  128. resultdef:=objc_protocoltype;
  129. end;
  130. function tobjcprotocolnode.pass_1: tnode;
  131. begin
  132. result:=ccallnode.createinternresfromunit('OBJC','OBJC_GETPROTOCOL',
  133. ccallparanode.create(cstringconstnode.createstr(tobjectdef(left.resultdef).objextname^),nil),
  134. resultdef
  135. );
  136. typecheckpass(result);
  137. end;
  138. end.