+ support for exporting Objective-C classes from dynamic libraries. It works

    the same as for exporting functions/procedures and variables: add the name
    of the class to the "exports" section of the library. By default, classes
    are only visible inside a shared library.

git-svn-id: branches/objc@13765 -

.gitattributes

@@ -8628,6 +8628,10 @@ tests/test/tobjc8a.pp svneol=native#text/plain
 tests/test/tobjc9.pp svneol=native#text/plain
 tests/test/tobjc9a.pp svneol=native#text/plain
 tests/test/tobjc9b.pp svneol=native#text/plain
+tests/test/tobjcl1.pp svneol=native#text/plain
+tests/test/tobjcl2.pp svneol=native#text/plain
+tests/test/tobjcl3.pp svneol=native#text/plain
+tests/test/tobjcl4.pp svneol=native#text/plain
 tests/test/tobject1.pp svneol=native#text/plain
 tests/test/tobject2.pp svneol=native#text/plain
 tests/test/tobject3.pp svneol=native#text/plain
@@ -8940,6 +8944,7 @@ tests/test/units/sysutils/tfloattostr.pp svneol=native#text/plain
 tests/test/units/sysutils/tlocale.pp svneol=native#text/plain
 tests/test/units/sysutils/tsscanf.pp svneol=native#text/plain
 tests/test/units/sysutils/tstrtobool.pp svneol=native#text/plain
+tests/test/uobjcl1.pp svneol=native#text/plain
 tests/test/uprec6.pp svneol=native#text/plain
 tests/test/uprec7.pp svneol=native#text/plain
 tests/test/uprocext1.pp svneol=native#text/plain

compiler/export.pas

@@ -73,6 +73,9 @@ type
 
   procedure exportprocsym(sym: tsym; const s : string; index: longint; options: word);
   procedure exportvarsym(sym: tsym; const s : string; index: longint; options: word);
+  { to export symbols not directly related to a tsym (e.g., the Objective-C
+    rtti) }
+  procedure exportname(const s : string; options: word);
 
   procedure exportallprocdefnames(sym: tprocsym; pd: tprocdef; options: word);
   procedure exportallprocsymnames(ps: tprocsym; options: word);
@@ -122,6 +125,12 @@ procedure exportvarsym(sym: tsym; const s : string; index: longint; options: wor
   end;
 
 
+procedure exportname(const s : string; options: word);
+  begin
+    exportvarsym(nil,s,0,options);
+  end;
+
+
   procedure exportallprocdefnames(sym: tprocsym; pd: tprocdef; options: word);
     var
       item: TCmdStrListItem;

compiler/expunix.pas

@@ -172,7 +172,8 @@ begin
       end
      else
        begin
-         if (hp2.name^<>hp2.sym.mangledname) then
+         if assigned(hp2.sym) and
+            (hp2.name^<>hp2.sym.mangledname) then
            Message2(parser_e_cant_export_var_different_name,hp2.sym.realname,hp2.sym.mangledname)
          else
            exportedsymnames.insert(hp2.name^);

compiler/objcutil.pas

@@ -52,6 +52,9 @@ interface
       signature or field declaration.  }
     function objcchecktype(def: tdef; out founderror: tdef): boolean;
 
+    { Exports all assembler symbols related to the obj-c class }
+    procedure exportobjcclass(def: tobjectdef);
+
 implementation
 
     uses
@@ -806,4 +809,44 @@ end;
       end;
 
 
+{******************************************************************
+                    ObjC class exporting
+*******************************************************************}
+
+    procedure exportobjcclassfields(objccls: tobjectdef);
+    var
+      i: longint;
+      vf: tfieldvarsym;
+      prefix: string;
+    begin
+      prefix:=target_info.cprefix+'OBJC_IVAR_$_'+objccls.objextname^+'.';
+      for i:=0 to objccls.symtable.SymList.Count-1 do
+        if tsym(objccls.symtable.SymList[i]).typ=fieldvarsym then
+          begin
+            vf:=tfieldvarsym(objccls.symtable.SymList[i]);
+            { TODO: package visibility (private_extern) -- must not be exported
+               either}
+            if (vf.visibility<>vis_private) then
+              exportname(prefix+vf.RealName,0);
+          end;
+    end;
+
+
+    procedure exportobjcclass(def: tobjectdef);
+      begin
+        if (target_info.system in system_objc_nfabi) then
+          begin
+            { export class and metaclass symbols }
+            exportname(def.rtti_mangledname(objcclassrtti),0);
+            exportname(def.rtti_mangledname(objcmetartti),0);
+            { export public/protected instance variable offset symbols }
+            exportobjcclassfields(def);
+          end
+        else
+          begin
+             { export the class symbol }
+             exportname('.objc_class_name_'+def.objextname^,0);
+          end;
+      end;
+
 end.

compiler/pexports.pas

@@ -45,6 +45,8 @@ implementation
        { parser }
        scanner,
        pbase,pexpr,
+       { obj-c }
+       objcutil,
        { link }
        gendef,export
        ;
@@ -107,114 +109,136 @@ implementation
                       else
                         InternalProcName:=pd.mangledname;
                     end;
+                  typesym :
+                    begin
+                      if not is_objcclass(ttypesym(srsym).typedef) then
+                        Message(parser_e_illegal_symbol_exported)
+                    end;
                   else
                     Message(parser_e_illegal_symbol_exported)
                 end;
-                if InternalProcName<>'' then
-                 begin
-                   { This is wrong if the first is not
-                     an underline }
-                   if InternalProcName[1]='_' then
-                     delete(InternalProcName,1,1)
-                   else if (target_info.system in [system_i386_win32,system_i386_wdosx,system_arm_wince,system_i386_wince]) and UseDeffileForExports then
+                if (srsym.typ<>typesym) then
+                  begin
+                    if InternalProcName<>'' then
+                     begin
+                       { This is wrong if the first is not
+                         an underline }
+                       if InternalProcName[1]='_' then
+                         delete(InternalProcName,1,1)
+                       else if (target_info.system in [system_i386_win32,system_i386_wdosx,system_arm_wince,system_i386_wince]) and UseDeffileForExports then
+                         begin
+                           Message(parser_e_dlltool_unit_var_problem);
+                           Message(parser_e_dlltool_unit_var_problem2);
+                         end;
+                       if length(InternalProcName)<2 then
+                        Message(parser_e_procname_to_short_for_export);
+                       DefString:=srsym.realname+'='+InternalProcName;
+                     end;
+                    if try_to_consume(_INDEX) then
+                     begin
+                       pt:=comp_expr(true);
+                       if pt.nodetype=ordconstn then
+                        if (Tordconstnode(pt).value<int64(low(index))) or
+                           (Tordconstnode(pt).value>int64(high(index))) then
+                          begin
+                            index:=0;
+                            message(parser_e_range_check_error)
+                          end
+                        else
+                          index:=Tordconstnode(pt).value.svalue
+                       else
+                        begin
+                          index:=0;
+                          consume(_INTCONST);
+                        end;
+                       options:=options or eo_index;
+                       pt.free;
+                       if target_info.system in [system_i386_win32,system_i386_wdosx,system_arm_wince,system_i386_wince] then
+                        DefString:=srsym.realname+'='+InternalProcName+' @ '+tostr(index)
+                       else
+                        DefString:=srsym.realname+'='+InternalProcName; {Index ignored!}
+                     end;
+                    if try_to_consume(_NAME) then
+                     begin
+                       pt:=comp_expr(true);
+                       if pt.nodetype=stringconstn then
+                        hpname:=strpas(tstringconstnode(pt).value_str)
+                       else
+                        begin
+                          consume(_CSTRING);
+                        end;
+                       options:=options or eo_name;
+                       pt.free;
+                       DefString:=hpname+'='+InternalProcName;
+                     end;
+                    if try_to_consume(_RESIDENT) then
                      begin
-                       Message(parser_e_dlltool_unit_var_problem);
-                       Message(parser_e_dlltool_unit_var_problem2);
+                       options:=options or eo_resident;
+                       DefString:=srsym.realname+'='+InternalProcName;{Resident ignored!}
                      end;
-                   if length(InternalProcName)<2 then
-                    Message(parser_e_procname_to_short_for_export);
-                   DefString:=srsym.realname+'='+InternalProcName;
-                 end;
-                if try_to_consume(_INDEX) then
-                 begin
-                   pt:=comp_expr(true);
-                   if pt.nodetype=ordconstn then
-                    if (Tordconstnode(pt).value<int64(low(index))) or
-                       (Tordconstnode(pt).value>int64(high(index))) then
-                      begin
-                        index:=0;
-                        message(parser_e_range_check_error)
-                      end
-                    else
-                      index:=Tordconstnode(pt).value.svalue
-                   else
+                    if (DefString<>'') and UseDeffileForExports then
+                     DefFile.AddExport(DefString);
+                  end;
+                case srsym.typ of
+                  procsym:
                     begin
-                      index:=0;
-                      consume(_INTCONST);
+                      { if no specific name or index was given, then if }
+                      { the procedure has aliases defined export those, }
+                      { otherwise export the name as it appears in the  }
+                      { export section (it doesn't make sense to export }
+                      { the generic mangled name, because the name of   }
+                      { the parent unit is used in that)                }
+                      if ((options and (eo_name or eo_index))=0) and
+                         (tprocdef(tprocsym(srsym).procdeflist[0]).aliasnames.count>1) then
+                        exportallprocsymnames(tprocsym(srsym),options)
+                      else
+                        begin
+                          { there's a name or an index -> export only one name   }
+                          { correct? Or can you export multiple names with the   }
+                          { same index? And/or should we also export the aliases }
+                          { if a name is specified? (JM)                         }
+
+                          if ((options and eo_name)=0) then
+                            { Export names are not mangled on Windows and OS/2 }
+                            if (target_info.system in (system_all_windows+[system_i386_emx, system_i386_os2])) then
+                              hpname:=orgs
+                            { Use set mangled name in case of cdecl/cppdecl/mwpascal }
+                            { and no name specified                                  }
+                            else if (tprocdef(tprocsym(srsym).procdeflist[0]).proccalloption in [pocall_cdecl,pocall_mwpascal]) then
+                              hpname:=target_info.cprefix+tprocsym(srsym).realname
+                            else if (tprocdef(tprocsym(srsym).procdeflist[0]).proccalloption in [pocall_cppdecl]) then
+                              hpname:=target_info.cprefix+tprocdef(tprocsym(srsym).procdeflist[0]).cplusplusmangledname
+                            else
+                              hpname:=orgs;
+
+                          exportprocsym(srsym,hpname,index,options);
+                        end
                     end;
-                   options:=options or eo_index;
-                   pt.free;
-                   if target_info.system in [system_i386_win32,system_i386_wdosx,system_arm_wince,system_i386_wince] then
-                    DefString:=srsym.realname+'='+InternalProcName+' @ '+tostr(index)
-                   else
-                    DefString:=srsym.realname+'='+InternalProcName; {Index ignored!}
-                 end;
-                if try_to_consume(_NAME) then
-                 begin
-                   pt:=comp_expr(true);
-                   if pt.nodetype=stringconstn then
-                    hpname:=strpas(tstringconstnode(pt).value_str)
-                   else
+                  staticvarsym:
                     begin
-                      consume(_CSTRING);
+                      if ((options and eo_name)=0) then
+                        { for "cvar" }
+                        if (vo_has_mangledname in tstaticvarsym(srsym).varoptions) then
+                          hpname:=srsym.mangledname
+                        else
+                          hpname:=orgs;
+                      exportvarsym(srsym,hpname,index,options);
                     end;
-                   options:=options or eo_name;
-                   pt.free;
-                   DefString:=hpname+'='+InternalProcName;
-                 end;
-                if try_to_consume(_RESIDENT) then
-                 begin
-                   options:=options or eo_resident;
-                   DefString:=srsym.realname+'='+InternalProcName;{Resident ignored!}
-                 end;
-                if (DefString<>'') and UseDeffileForExports then
-                 DefFile.AddExport(DefString);
-
-                if srsym.typ=procsym then
-                  begin
-                    { if no specific name or index was given, then if }
-                    { the procedure has aliases defined export those, }
-                    { otherwise export the name as it appears in the  }
-                    { export section (it doesn't make sense to export }
-                    { the generic mangled name, because the name of   }
-                    { the parent unit is used in that)                }
-                    if ((options and (eo_name or eo_index))=0) and
-                       (tprocdef(tprocsym(srsym).procdeflist[0]).aliasnames.count>1) then
-                      exportallprocsymnames(tprocsym(srsym),options)
-                    else
-                      begin
-                        { there's a name or an index -> export only one name   }
-                        { correct? Or can you export multiple names with the   }
-                        { same index? And/or should we also export the aliases }
-                        { if a name is specified? (JM)                         }
-
-                        if ((options and eo_name)=0) then
-                          { Export names are not mangled on Windows and OS/2 }
-                          if (target_info.system in (system_all_windows+[system_i386_emx, system_i386_os2])) then
-                            hpname:=orgs
-                          { Use set mangled name in case of cdecl/cppdecl/mwpascal }
-                          { and no name specified                                  }
-                          else if (tprocdef(tprocsym(srsym).procdeflist[0]).proccalloption in [pocall_cdecl,pocall_mwpascal]) then
-                            hpname:=target_info.cprefix+tprocsym(srsym).realname
-                          else if (tprocdef(tprocsym(srsym).procdeflist[0]).proccalloption in [pocall_cppdecl]) then
-                            hpname:=target_info.cprefix+tprocdef(tprocsym(srsym).procdeflist[0]).cplusplusmangledname
-                          else
-                            hpname:=orgs;
-
-                        exportprocsym(srsym,hpname,index,options);
-                      end
-                  end
-                { can also be errorsym }
-                else if (srsym.typ=staticvarsym) then
-                  begin
-                    if ((options and eo_name)=0) then
-                      { for "cvar" }
-                      if (vo_has_mangledname in tstaticvarsym(srsym).varoptions) then
-                        hpname:=srsym.mangledname
-                      else
-                        hpname:=orgs;
-                    exportvarsym(srsym,hpname,index,options);
-                  end;
+                  typesym:
+                    begin
+                      case ttypesym(srsym).typedef.typ of
+                        objectdef:
+                          case tobjectdef(ttypesym(srsym).typedef).objecttype of
+                            odt_objcclass:
+                              exportobjcclass(tobjectdef(ttypesym(srsym).typedef));
+                            else
+                              internalerror(2009092601);
+                          end;
+                        else
+                          internalerror(2009092602);
+                      end;
+                    end;
+                end
              end
            else
              consume(_ID);

tests/test/tobjcl1.pp

@@ -0,0 +1,17 @@
+{ %target=darwin }
+{ %cpu=powerpc,powerpc64,i386,x86_64,arm }
+{ %recompile }
+{ %norun }
+
+{$mode objfpc}
+{$modeswitch objectivec1}
+
+library tobjcl1;
+
+uses
+  uobjcl1;
+
+exports
+  MyLibObjCClass;
+
+end.

tests/test/tobjcl2.pp

@@ -0,0 +1,52 @@
+{ %target=darwin }
+{ %cpu=powerpc,powerpc64,i386,x86_64,arm }
+{ %NEEDLIBRARY }
+
+{$mode objfpc}
+{$modeswitch objectivec1}
+
+const
+{$ifdef windows}
+  libname='tobjcl1.dll';
+{$else}
+  libname='tobjcl1';
+  {$linklib tobjcl1}
+{$endif}
+
+type
+  MyLibObjCClass = objcclass(NSObject)
+   public
+    fa: byte;
+    function publicfun: byte; message 'publicfun';
+   protected
+    fb: byte;
+    function protectedfun: byte; message 'protectedfun';
+   private
+    fc: byte;
+    function privatefun: byte; message 'privatefun';
+  end; external;
+
+  MyDerivedClass = objcclass(MyLibObjCClass)
+    l: longint;
+    function callprotectedfun: byte; message 'callprotectedfun';
+  end;
+
+
+function MyDerivedClass.callprotectedfun: byte;
+  begin
+    result:=protectedfun;
+  end;
+
+
+var
+  a: MyLibObjCClass;
+begin
+  a:=NSObject(MyDerivedClass.alloc).init;
+  a.fa:=55;
+  a.fb:=66;
+  if a.publicfun<>55 then
+    halt(1);
+  if MyDerivedClass(a).callprotectedfun<>66 then
+    halt(2);
+  a.release;
+end.

tests/test/tobjcl3.pp

@@ -0,0 +1,36 @@
+{ %target=darwin }
+{ %cpu=powerpc64,x86_64,arm }
+{ %NEEDLIBRARY }
+{ %fail }
+
+{$mode objfpc}
+{$modeswitch objectivec1}
+
+const
+{$ifdef windows}
+  libname='tobjcl1.dll';
+{$else}
+  libname='tobjcl1';
+  {$linklib tobjcl1}
+{$endif}
+
+type
+  MyLibObjCClass = objcclass(NSObject)
+   public
+    fa: byte;
+    fb: byte;
+    { this field is declared as private in the real class,
+      and the non-fragile ABI should be sure that this
+      gives a linker error }
+    fc: byte;
+    function publicfun: byte; message 'publicfun';
+    function protectedfun: byte; message 'protectedfun';
+    function privatefun: byte; message 'privatefun';
+  end; external;
+
+var
+  a: MyLibObjCClass;
+begin
+  a:=NSObject(MyLibObjCClass.alloc).init;
+  a.fc:=55;
+end.

tests/test/tobjcl4.pp

@@ -0,0 +1,26 @@
+{ %target=darwin }
+{ %cpu=i386,powerpc,powerpc64,x86_64,arm }
+{ %NEEDLIBRARY }
+{ %fail }
+
+{$mode objfpc}
+{$modeswitch objectivec1}
+
+const
+{$ifdef windows}
+  libname='tobjcl1.dll';
+{$else}
+  libname='tobjcl1';
+  {$linklib tobjcl1}
+{$endif}
+
+type
+  MyHiddenObjcClass=objcclass(NSObject)
+  end; external;
+
+var
+  a: MyHiddenObjcClass;
+begin
+  a:=NSObject(MyHiddenObjcClass.alloc).init;
+  a.release;
+end.

tests/test/uobjcl1.pp

@@ -0,0 +1,45 @@
+{$mode objfpc}
+{$modeswitch objectivec1}
+
+unit uobjcl1;
+
+interface
+
+type
+  MyLibObjCClass = objcclass(NSObject)
+   public
+    fa: byte;
+    function publicfun: byte; message 'publicfun';
+   protected
+    fb: byte;
+    function protectedfun: byte; message 'protectedfun';
+   private
+    fc: byte;
+    function privatefun: byte; message 'privatefun';
+  end;
+  
+ implementation
+ 
+function MyLibObjCClass.publicfun: byte;
+  begin
+    result:=fa;
+  end;
+
+
+function MyLibObjCClass.protectedfun: byte;
+  begin
+    result:=fb;
+  end;
+
+
+function MyLibObjCClass.privatefun: byte;
+  begin
+    result:=fc;
+  end;
+
+type
+  MyHiddenObjcClass = objcclass(NSObject)
+  end;
+
+
+end.