/compiler/nobjc.pas

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