Răsfoiți Sursa

* the as node again uses a compilerproc
+ (untested) support for interface "as" statements

Jonas Maebe 23 ani în urmă
părinte
comite
ed08ed1ce0
2 a modificat fișierele cu 68 adăugiri și 46 ștergeri
  1. 7 39
      compiler/ncgcnv.pas
  2. 61 7
      compiler/ncnv.pas

+ 7 - 39
compiler/ncgcnv.pas

@@ -474,45 +474,9 @@ interface
 
 
     procedure tcgasnode.pass_2;
-      var
-        pushed : tpushedsaved;
       begin
-        if (right.nodetype=guidconstn) then
-         begin
-{$warning need to push a third parameter}
-           { instance to check }
-           secondpass(left);
-           rg.saveusedregisters(exprasmlist,pushed,all_registers);
-           cg.a_param_loc(exprasmlist,left.location,paramanager.getintparaloc(2));
-           { type information }
-           secondpass(right);
-           cg.a_paramaddr_ref(exprasmlist,right.location.reference,paramanager.getintparaloc(1));
-           location_release(exprasmlist,right.location);
-           { call helper }
-           if is_class(left.resulttype.def) then
-             cg.a_call_name(exprasmlist,'FPC_CLASS_AS_INTF')
-           else
-             cg.a_call_name(exprasmlist,'FPC_INTF_AS');
-           cg.g_maybe_loadself(exprasmlist);
-           rg.restoreusedregisters(exprasmlist,pushed);
-         end
-        else
-         begin
-           { instance to check }
-           secondpass(left);
-           rg.saveusedregisters(exprasmlist,pushed,all_registers);
-           cg.a_param_loc(exprasmlist,left.location,paramanager.getintparaloc(2));
-           { type information }
-           secondpass(right);
-           cg.a_param_loc(exprasmlist,right.location,paramanager.getintparaloc(1));
-           location_release(exprasmlist,right.location);
-           { call helper }
-           cg.a_call_name(exprasmlist,'FPC_DO_AS');
-           cg.g_maybe_loadself(exprasmlist);
-           rg.restoreusedregisters(exprasmlist,pushed);
-         end;
-
-        location_copy(location,left.location);
+        secondpass(call);
+        location_copy(location,call.location);
       end;
 
 
@@ -523,7 +487,11 @@ end.
 
 {
   $Log$
-  Revision 1.25  2002-08-13 18:01:52  carl
+  Revision 1.26  2002-08-20 18:23:32  jonas
+    * the as node again uses a compilerproc
+    + (untested) support for interface "as" statements
+
+  Revision 1.25  2002/08/13 18:01:52  carl
     * rename swatoperands to swapoperands
     + m68k first compilable version (still needs a lot of testing):
         assembler generator, system information , inline

+ 61 - 7
compiler/ncnv.pas

@@ -136,6 +136,10 @@ interface
           constructor create(l,r : tnode);virtual;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
+          function getcopy: tnode;override;
+          destructor destroy; override;
+         protected
+          call: tnode;
        end;
        tasnodeclass = class of tasnode;
 
@@ -1876,6 +1880,15 @@ implementation
 
       begin
          inherited create(asn,l,r);
+         call := nil;
+      end;
+
+
+    destructor tasnode.destroy;
+
+      begin
+        call.free;
+        inherited destroy;
       end;
 
 
@@ -1946,14 +1959,51 @@ implementation
       end;
 
 
+    function tasnode.getcopy: tnode;
+
+      begin
+        result := inherited getcopy;
+        if assigned(call) then
+          tasnode(result).call := call.getcopy
+        else
+          tasnode(result).call := nil;
+      end;
+
+
     function tasnode.pass_1 : tnode;
+
+      var
+        procname: string;
       begin
-        firstpass(left);
-        firstpass(right);
-        if codegenerror then
-         exit;
-        left_right_max;
-        location.loc:=left.location.loc;
+        if not assigned(call) then
+          begin
+            if is_class(left.resulttype.def) and
+               (right.resulttype.def.deftype=classrefdef) then
+              call := ccallnode.createinternres('fpc_do_as',
+                ccallparanode.create(left,ccallparanode.create(right,nil)),
+                resulttype)
+            else
+              begin
+                if is_class(left.resulttype.def) then
+                  procname := 'fpc_class_as_intf'
+                else
+                  procname := 'fpc_intf_as';
+                call := ccallnode.createinternres(procname,
+                   ccallparanode.create(left,ccallparanode.create(right,nil)),
+                   resulttype);
+              end;
+            left := nil;
+            right := nil;
+            firstpass(call);
+            if codegenerror then
+              exit;
+           location.loc:=call.location.loc;
+           registers32:=call.registers32;
+           registersfpu:=call.registersfpu;
+{$ifdef SUPPORT_MMX}
+           registersmmx:=call.registersmmx;
+{$endif SUPPORT_MMX}
+         end;
         result:=nil;
       end;
 
@@ -1965,7 +2015,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.71  2002-08-19 19:36:43  peter
+  Revision 1.72  2002-08-20 18:23:33  jonas
+    * the as node again uses a compilerproc
+    + (untested) support for interface "as" statements
+
+  Revision 1.71  2002/08/19 19:36:43  peter
     * More fixes for cross unit inlining, all tnodes are now implemented
     * Moved pocall_internconst to po_internconst because it is not a
       calling type at all and it conflicted when inlining of these small