+ Mac Object Pascal support

git-svn-id: trunk@387 -

compiler/nobj.pas

@@ -665,6 +665,8 @@ implementation
                                 begin
                                   { new one has not override }
                                   if is_class(_class) and
+                                     { in Macintosh Object Pascal, all methods are virtual/override }
+                                     not(m_mac in aktmodeswitches) and
                                      not(po_overridingmethod in pd.procoptions) then
                                    begin
                                      { we start a new virtual tree, hide the old }

compiler/pdecobj.pas

@@ -214,6 +214,11 @@ implementation
 
         begin
            readobjecttype:=true;
+           { MacPas object model is more like Delphi's than like TP's, but }
+           { uses the object keyword instead of class                      }
+           if (m_mac in aktmodeswitches) and
+              (token = _OBJECT) then
+             token := _CLASS;
            { distinguish classes and objects }
            case token of
               _OBJECT:
@@ -591,6 +596,14 @@ implementation
                     if assigned(pd) then
                      begin
                        parse_object_proc_directives(pd);
+
+                       { all Macintosh Object Pascal methods are virtual/  }
+                       { override; the override part is handled in nobj    }
+                       { this can't be a class method, because macpas mode }
+                       { has no m_class                                    }
+                       if (m_mac in aktmodeswitches) then
+                         include(pd.procoptions,po_virtualmethod);
+
                        handle_calling_convention(pd);
 
                        { add definition to procsym }

compiler/pinline.pas

@@ -82,8 +82,64 @@ implementation
           set_varstate(p,vs_assigned,[])
         else
           set_varstate(p,vs_used,[vsf_must_be_valid]);
+        if (m_mac in aktmodeswitches) and
+           is_class(p.resulttype.def) then
+          begin
+            classh:=tobjectdef(p.resulttype.def);
+
+            if is_new then
+              begin
+                sym:=search_class_member(classh,'CREATE');
+                p2 := cloadvmtaddrnode.create(ctypenode.create(p.resulttype));;
+              end
+            else
+              begin
+                sym:=search_class_member(classh,'FREE');
+                p2 := p;
+             end;
+
+            if not(assigned(sym)) then
+              begin
+                 p.free;
+                 if is_new then
+                   p2.free;
+                 new_dispose_statement := cerrornode.create;
+                 consume_all_until(_RKLAMMER);
+                 consume(_RKLAMMER);
+                 exit;
+              end;
+
+            do_member_read(classh,false,sym,p2,again,[]);
+            
+            { we need the real called method }
+            do_resulttypepass(p2);
+
+            if (p2.nodetype=calln) and
+               assigned(tcallnode(p2).procdefinition) then
+              begin
+                if is_new then
+                  begin
+                    if (tcallnode(p2).procdefinition.proctypeoption<>potype_constructor) then
+                      Message(parser_e_expr_have_to_be_constructor_call);
+                    p2.resulttype:=p.resulttype;
+                    p2:=cassignmentnode.create(p,p2);
+                    resulttypepass(p2);
+                  end
+                else
+                  begin
+                   { Free is not a destructor 
+                    if (tcallnode(p2).procdefinition.proctypeoption<>potype_destructor) then
+                      Message(parser_e_expr_have_to_be_destructor_call);
+                   }
+                  end
+              end
+            else
+              internalerror(2005061202);
+            new_dispose_statement := p2;
+          end
         { constructor,destructor specified }
-        if try_to_consume(_COMMA) then
+        else if not(m_mac in aktmodeswitches) and
+                try_to_consume(_COMMA) then
           begin
             { extended syntax of new and dispose }
             { function styled new is handled in factor }

rtl/inc/macpas.pp

@@ -14,6 +14,8 @@
 
  **********************************************************************}
 
+{$mode objfpc}
+
 unit MacPas;
 
 interface
@@ -38,6 +40,8 @@ function FOUR_CHAR_CODE(literal: string): LongWord; {$ifdef systeminline}inline;
  to emulate the behaviour of mac pascal compilers}
 operator := (s: ShortString) res: LongWord; {$ifdef systeminline}inline;{$endif}
 
+{ Same as the "is" operator }
+Function Member (Instance : TObject; AClass : TClass) : boolean;
 
 implementation
 
@@ -57,4 +61,10 @@ begin
   res := PLongWord(@s[1])^;
 end;
 
+Function Member (Instance : TObject; AClass : TClass) : boolean; {$ifdef systeminline}inline;{$endif}
+begin
+  Result:=Instance is AClass;
+end;
+
+
 end.