瀏覽代碼

+ generic set handling

carl 23 年之前
父節點
當前提交
63e0f03f63
共有 3 個文件被更改,包括 48 次插入35 次删除
  1. 5 2
      compiler/i386/cpunode.pas
  2. 9 1
      compiler/i386/n386cal.pas
  3. 34 32
      compiler/i386/n386set.pas

+ 5 - 2
compiler/i386/cpunode.pas

@@ -29,7 +29,7 @@ unit cpunode;
   implementation
 
     uses
-       ncgbas,ncgflw,ncgcnv,ncgld,ncgmem,ncgcon,
+       ncgbas,ncgflw,ncgcnv,ncgld,ncgmem,ncgcon,ncgset,
        n386add,n386cal,n386con,n386cnv,n386flw,n386mat,n386mem,
        n386set,n386inl,n386opt,
        { this not really a node }
@@ -38,7 +38,10 @@ unit cpunode;
 end.
 {
   $Log$
-  Revision 1.13  2002-05-18 13:34:22  peter
+  Revision 1.14  2002-07-06 20:27:26  carl
+  + generic set handling
+
+  Revision 1.13  2002/05/18 13:34:22  peter
     * readded missing revisions
 
   Revision 1.12  2002/05/16 19:46:50  carl

+ 9 - 1
compiler/i386/n386cal.pas

@@ -1110,6 +1110,11 @@ implementation
             (aktprocdef.proctypeoption=potype_constructor) then
            begin
              emitjmp(C_Z,faillabel);
+{$ifdef TEST_GENERIC}             
+{ should be moved to generic version! }
+             reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset);
+             cg.a_load_ref_reg(exprasmlist, OS_ADDR, href, SELF_POINTER_REG);
+{$endif}             
            end;
 
          { call to AfterConstruction? }
@@ -1475,7 +1480,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.56  2002-07-01 18:46:31  peter
+  Revision 1.57  2002-07-06 20:27:26  carl
+  + generic set handling
+
+  Revision 1.56  2002/07/01 18:46:31  peter
     * internal linker
     * reorganized aasm layer
 

+ 34 - 32
compiler/i386/n386set.pas

@@ -27,15 +27,13 @@ unit n386set;
 interface
 
     uses
-       node,nset;
+       node,nset,pass_1;
 
     type
-       ti386setelementnode = class(tsetelementnode)
-          procedure pass_2;override;
-       end;
 
        ti386innode = class(tinnode)
           procedure pass_2;override;
+          function pass_1 : tnode;override;
        end;
        ti386casenode = class(tcasenode)
           procedure pass_2;override;
@@ -56,39 +54,39 @@ implementation
      const
        bytes2Sxx:array[1..8] of Topsize=(S_B,S_W,S_NO,S_L,S_NO,S_NO,S_NO,S_Q);
 
+
+
 {*****************************************************************************
-                          TI386SETELEMENTNODE
+                              TI386INNODE
 *****************************************************************************}
 
-    procedure ti386setelementnode.pass_2;
-       var
-         pushedregs : tmaybesave;
-       begin
-       { load first value in 32bit register }
-         secondpass(left);
-         if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
-           location_force_reg(exprasmlist,left.location,OS_32,false);
+    function ti386innode.pass_1 : tnode;
+      begin
+         result:=nil;
+         { this is the only difference from the generic version }
+         location.loc:=LOC_FLAGS;
+         
+         firstpass(right);
+         firstpass(left);
+         if codegenerror then
+           exit;
 
-       { also a second value ? }
-         if assigned(right) then
+         left_right_max;
+         { this is not allways true due to optimization }
+         { but if we don't set this we get problems with optimizing self code }
+         if tsetdef(right.resulttype.def).settype<>smallset then
+           procinfo^.flags:=procinfo^.flags or pi_do_call
+         else
            begin
-             maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
-             secondpass(right);
-             if codegenerror then
-               exit;
-             maybe_restore(exprasmlist,left.location,pushedregs);
-             if right.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
-              location_force_reg(exprasmlist,right.location,OS_32,false);
+              { a smallset needs maybe an misc. register }
+              if (left.nodetype<>ordconstn) and
+                not(right.location.loc in [LOC_CREGISTER,LOC_REGISTER]) and
+                (right.registers32<1) then
+                inc(registers32);
            end;
+      end;
+      
 
-         { we doesn't modify the left side, we check only the type }
-         location_copy(location,left.location);
-       end;
-
-
-{*****************************************************************************
-                              TI386INNODE
-*****************************************************************************}
 
     procedure ti386innode.pass_2;
        type
@@ -1011,13 +1009,17 @@ implementation
 
 
 begin
-   csetelementnode:=ti386setelementnode;
+{$ifndef TEST_GENERIC}
    cinnode:=ti386innode;
+{$endif}   
    ccasenode:=ti386casenode;
 end.
 {
   $Log$
-  Revision 1.32  2002-07-01 18:46:33  peter
+  Revision 1.33  2002-07-06 20:27:26  carl
+  + generic set handling
+
+  Revision 1.32  2002/07/01 18:46:33  peter
     * internal linker
     * reorganized aasm layer