浏览代码

* fixed smallset generation from elements, it has never worked before!

peter 27 年之前
父节点
当前提交
5c013220a3
共有 6 个文件被更改,包括 263 次插入179 次删除
  1. 193 146
      compiler/cg386add.pas
  2. 18 21
      compiler/cg386set.pas
  3. 6 3
      compiler/cgi386.pas
  4. 34 4
      compiler/pass_1.pas
  5. 6 3
      compiler/pexpr.pas
  6. 6 2
      compiler/tree.pas

+ 193 - 146
compiler/cg386add.pas

@@ -281,12 +281,9 @@ implementation
 
 
     procedure addset(var p : ptree);
     procedure addset(var p : ptree);
       var
       var
-        right_small,
         cmpop,
         cmpop,
         pushed : boolean;
         pushed : boolean;
-        href2,
         href   : treference;
         href   : treference;
-        swapp  : ptree;
         pushedregs : tpushed;
         pushedregs : tpushed;
       begin
       begin
         cmpop:=false;
         cmpop:=false;
@@ -305,7 +302,6 @@ implementation
           restore(p);
           restore(p);
 
 
         set_location(p^.location,p^.left^.location);
         set_location(p^.location,p^.left^.location);
-        right_small:=(p^.right^.resulttype^.deftype=setdef) and (psetdef(p^.right^.resulttype)^.settype=smallset);
 
 
         { handle operations }
         { handle operations }
         case p^.treetype of
         case p^.treetype of
@@ -330,20 +326,24 @@ implementation
                      pushusedregisters(pushedregs,$ff);
                      pushusedregisters(pushedregs,$ff);
                      href.symbol:=nil;
                      href.symbol:=nil;
                      gettempofsizereference(32,href);
                      gettempofsizereference(32,href);
-                     case p^.right^.treetype of
-                    setelen : begin
-                                concatcopy(p^.left^.location.reference,href,32,false);
-                                pushsetelement(p^.right^.left);
-                                emitpushreferenceaddr(exprasmlist,href);
-                                emitcall('SET_SET_BYTE',true);
-                              end;
-                     rangen : begin
-                                concatcopy(p^.left^.location.reference,href,32,false);
-                                pushsetelement(p^.right^.right);
-                                pushsetelement(p^.right^.left);
-                                emitpushreferenceaddr(exprasmlist,href);
-                                emitcall('SET_SET_RANGE',true);
-                              end;
+                   { add a range or a single element? }
+                     if p^.right^.treetype=setelementn then
+                      begin
+                        concatcopy(p^.left^.location.reference,href,32,false);
+                        if assigned(p^.right^.right) then
+                         begin
+                           pushsetelement(p^.right^.right);
+                           pushsetelement(p^.right^.left);
+                           emitpushreferenceaddr(exprasmlist,href);
+                           emitcall('SET_SET_RANGE',true);
+                         end
+                        else
+                         begin
+                           pushsetelement(p^.right^.left);
+                           emitpushreferenceaddr(exprasmlist,href);
+                           emitcall('SET_SET_BYTE',true);
+                         end;
+                      end
                      else
                      else
                       begin
                       begin
                       { must be an other set }
                       { must be an other set }
@@ -352,7 +352,6 @@ implementation
                         emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
                         emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
                         emitcall('SET_ADD_SETS',true);
                         emitcall('SET_ADD_SETS',true);
                       end;
                       end;
-                     end;
                      maybe_loadesi;
                      maybe_loadesi;
                      popusedregisters(pushedregs);
                      popusedregisters(pushedregs);
                      ungetiftemp(p^.left^.location.reference);
                      ungetiftemp(p^.left^.location.reference);
@@ -364,8 +363,6 @@ implementation
             subn,
             subn,
          symdifn,
          symdifn,
             muln : begin
             muln : begin
-                     if p^.right^.treetype in [rangen,setelen] then
-                      internalerror(45362);
                      del_reference(p^.left^.location.reference);
                      del_reference(p^.left^.location.reference);
                      del_reference(p^.right^.location.reference);
                      del_reference(p^.right^.location.reference);
                      href.symbol:=nil;
                      href.symbol:=nil;
@@ -405,25 +402,22 @@ implementation
       label do_normal;
       label do_normal;
 
 
       var
       var
-         swapp : ptree;
          hregister : tregister;
          hregister : tregister;
+         noswap,
          pushed,mboverflow,cmpop : boolean;
          pushed,mboverflow,cmpop : boolean;
          op : tasmop;
          op : tasmop;
-         pushedregs : tpushed;
          flags : tresflags;
          flags : tresflags;
          otl,ofl : plabel;
          otl,ofl : plabel;
          power : longint;
          power : longint;
-         href : treference;
          opsize : topsize;
          opsize : topsize;
          hl4: plabel;
          hl4: plabel;
 
 
          { true, if unsigned types are compared }
          { true, if unsigned types are compared }
          unsigned : boolean;
          unsigned : boolean;
-
-         { is_in_dest if the result is put directly into }
-         { the resulting refernce or varregister }
          { true, if a small set is handled with the longint code }
          { true, if a small set is handled with the longint code }
          is_set : boolean;
          is_set : boolean;
+         { is_in_dest if the result is put directly into }
+         { the resulting refernce or varregister }
          is_in_dest : boolean;
          is_in_dest : boolean;
          { true, if for sets subtractions the extra not should generated }
          { true, if for sets subtractions the extra not should generated }
          extra_not : boolean;
          extra_not : boolean;
@@ -435,29 +429,35 @@ implementation
       begin
       begin
       { to make it more readable, string and set (not smallset!) have their
       { to make it more readable, string and set (not smallset!) have their
         own procedures }
         own procedures }
-        case p^.left^.resulttype^.deftype of
+         case p^.left^.resulttype^.deftype of
          stringdef : begin
          stringdef : begin
                        addstring(p);
                        addstring(p);
                        exit;
                        exit;
                      end;
                      end;
             setdef : begin
             setdef : begin
-                     { not for smallsets }
+                     { normalsets are handled separate }
                        if not(psetdef(p^.left^.resulttype)^.settype=smallset) then
                        if not(psetdef(p^.left^.resulttype)^.settype=smallset) then
                         begin
                         begin
                           addset(p);
                           addset(p);
                           exit;
                           exit;
                         end;
                         end;
                      end;
                      end;
-        end;
+         end;
 
 
+         { defaults }
          unsigned:=false;
          unsigned:=false;
          is_in_dest:=false;
          is_in_dest:=false;
          extra_not:=false;
          extra_not:=false;
-
+         noswap:=false;
          opsize:=S_L;
          opsize:=S_L;
 
 
+         { are we a (small)set, must be set here because the side can be
+           swapped ! (PFV) }
+         is_set:=(p^.left^.resulttype^.deftype=setdef);
+
          { calculate the operator which is more difficult }
          { calculate the operator which is more difficult }
          firstcomplex(p);
          firstcomplex(p);
+
          { handling boolean expressions extra: }
          { handling boolean expressions extra: }
          if ((p^.left^.resulttype^.deftype=orddef) and
          if ((p^.left^.resulttype^.deftype=orddef) and
             (porddef(p^.left^.resulttype)^.typ in [bool8bit,bool16bit,bool32bit])) or
             (porddef(p^.left^.resulttype)^.typ in [bool8bit,bool16bit,bool32bit])) or
@@ -520,7 +520,7 @@ implementation
          else
          else
            begin
            begin
               { in case of constant put it to the left }
               { in case of constant put it to the left }
-              if p^.left^.treetype=ordconstn then
+              if (p^.left^.treetype=ordconstn) then
                swaptree(p);
                swaptree(p);
               secondpass(p^.left);
               secondpass(p^.left);
               { this will be complicated as
               { this will be complicated as
@@ -572,89 +572,119 @@ implementation
                  (porddef(p^.right^.resulttype)^.typ=u32bit)) or
                  (porddef(p^.right^.resulttype)^.typ=u32bit)) or
 
 
                 { as well as small sets }
                 { as well as small sets }
-                ((p^.left^.resulttype^.deftype=setdef) and
-                 (psetdef(p^.left^.resulttype)^.settype=smallset)
-                ) then
+                 is_set then
                 begin
                 begin
-           do_normal:
+          do_normal:
                    mboverflow:=false;
                    mboverflow:=false;
                    cmpop:=false;
                    cmpop:=false;
                    if (p^.left^.resulttype^.deftype=pointerdef) or
                    if (p^.left^.resulttype^.deftype=pointerdef) or
                       (p^.right^.resulttype^.deftype=pointerdef) or
                       (p^.right^.resulttype^.deftype=pointerdef) or
                       ((p^.left^.resulttype^.deftype=orddef) and
                       ((p^.left^.resulttype^.deftype=orddef) and
-                      (porddef(p^.left^.resulttype)^.typ=u32bit)) or
+                       (porddef(p^.left^.resulttype)^.typ=u32bit)) or
                       ((p^.right^.resulttype^.deftype=orddef) and
                       ((p^.right^.resulttype^.deftype=orddef) and
-                      (porddef(p^.right^.resulttype)^.typ=u32bit)) then
+                       (porddef(p^.right^.resulttype)^.typ=u32bit)) then
                      unsigned:=true;
                      unsigned:=true;
-                   is_set:=p^.resulttype^.deftype=setdef;
                    case p^.treetype of
                    case p^.treetype of
                       addn : begin
                       addn : begin
-                                if is_set then
-                                  begin
-                                     op:=A_OR;
-                                     mboverflow:=false;
-                                     unsigned:=false;
-                                  end
-                                else
-                                  begin
-                                     op:=A_ADD;
-                                     mboverflow:=true;
-                                  end;
+                               if is_set then
+                                begin
+                                { adding elements is not commutative }
+                                  if p^.swaped and (p^.left^.treetype=setelementn) then
+                                   swaptree(p);
+                                { are we adding set elements ? }
+                                  if p^.right^.treetype=setelementn then
+                                   begin
+                                   { no range support for smallsets! }
+                                     if assigned(p^.right^.right) then
+                                      internalerror(43244);
+                                   { bts requires both elements to be registers }
+                                     if p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE] then
+                                      begin
+                                        del_reference(p^.left^.location.reference);
+                                        hregister:=getregister32;
+                                        exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
+                                          newreference(p^.left^.location.reference),hregister)));
+                                        p^.left^.location.loc:=LOC_REGISTER;
+                                        p^.left^.location.register:=hregister;
+                                        set_location(p^.location,p^.left^.location);
+                                      end;
+                                     if p^.right^.location.loc in [LOC_MEM,LOC_REFERENCE] then
+                                      begin
+                                        del_reference(p^.right^.location.reference);
+                                        hregister:=getregister32;
+                                        exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
+                                          newreference(p^.right^.location.reference),hregister)));
+                                        p^.right^.location.loc:=LOC_REGISTER;
+                                        p^.right^.location.register:=hregister;
+                                      end;
+                                     op:=A_BTS;
+                                     noswap:=true;
+                                   end
+                                  else
+                                   op:=A_OR;
+                                  mboverflow:=false;
+                                  unsigned:=false;
+                                end
+                               else
+                                begin
+                                  op:=A_ADD;
+                                  mboverflow:=true;
+                                end;
                              end;
                              end;
-                      symdifn : begin
-                                { the symetric diff is only for sets }
-                                if is_set then
-                                  begin
-                                     op:=A_XOR;
-                                     mboverflow:=false;
-                                     unsigned:=false;
-                                  end
-                                else
-                                  begin
-                                     Message(sym_e_type_mismatch);
-                                  end;
+                   symdifn : begin
+                               { the symetric diff is only for sets }
+                               if is_set then
+                                begin
+                                  op:=A_XOR;
+                                  mboverflow:=false;
+                                  unsigned:=false;
+                                end
+                               else
+                                Message(sym_e_type_mismatch);
                              end;
                              end;
                       muln : begin
                       muln : begin
-                                if is_set then
-                                  begin
-                                     op:=A_AND;
-                                     mboverflow:=false;
-                                     unsigned:=false;
-                                  end
-                                else
-                                  begin
-                                     if unsigned then
-                                       op:=A_MUL
-                                     else
-                                       op:=A_IMUL;
-                                     mboverflow:=true;
-                                  end;
+                               if is_set then
+                                begin
+                                  op:=A_AND;
+                                  mboverflow:=false;
+                                  unsigned:=false;
+                                end
+                               else
+                                begin
+                                  if unsigned then
+                                   op:=A_MUL
+                                  else
+                                   op:=A_IMUL;
+                                  mboverflow:=true;
+                                end;
                              end;
                              end;
                       subn : begin
                       subn : begin
-                                if is_set then
-                                  begin
-                                     op:=A_AND;
-                                     mboverflow:=false;
-                                     unsigned:=false;
-                                     extra_not:=true;
-                                  end
-                                else
-                                  begin
-                                     op:=A_SUB;
-                                     mboverflow:=true;
-                                  end;
+                               if is_set then
+                                begin
+                                  op:=A_AND;
+                                  mboverflow:=false;
+                                  unsigned:=false;
+                                  extra_not:=true;
+                                end
+                               else
+                                begin
+                                  op:=A_SUB;
+                                  mboverflow:=true;
+                                end;
                              end;
                              end;
-                      ltn,lten,gtn,gten,
-                      equaln,unequaln :
-                             begin
-                                op:=A_CMP;
-                                cmpop:=true;
+                  ltn,lten,
+                  gtn,gten,
+           equaln,unequaln : begin
+                               op:=A_CMP;
+                               cmpop:=true;
                              end;
                              end;
                       xorn : op:=A_XOR;
                       xorn : op:=A_XOR;
-                      orn : op:=A_OR;
+                       orn : op:=A_OR;
                       andn : op:=A_AND;
                       andn : op:=A_AND;
-                      else Message(sym_e_type_mismatch);
+                   else
+                     Message(sym_e_type_mismatch);
                    end;
                    end;
+
                    { left and right no register?  }
                    { left and right no register?  }
                    { then one must be demanded    }
                    { then one must be demanded    }
                    if (p^.left^.location.loc<>LOC_REGISTER) and
                    if (p^.left^.location.loc<>LOC_REGISTER) and
@@ -712,7 +742,7 @@ implementation
                      end
                      end
                    else
                    else
                      { if on the right the register then swap }
                      { if on the right the register then swap }
-                     if (p^.right^.location.loc=LOC_REGISTER) then
+                     if not(noswap) and (p^.right^.location.loc=LOC_REGISTER) then
                        begin
                        begin
                           swap_location(p^.location,p^.right^.location);
                           swap_location(p^.location,p^.right^.location);
 
 
@@ -851,25 +881,28 @@ implementation
 
 
                    { only in case of overflow operations }
                    { only in case of overflow operations }
                    { produce overflow code }
                    { produce overflow code }
-                   if mboverflow then
                    { we must put it here directly, because sign of operation }
                    { we must put it here directly, because sign of operation }
                    { is in unsigned VAR!!                                    }
                    { is in unsigned VAR!!                                    }
-                   begin
-                     if cs_check_overflow in aktlocalswitches  then
-                     begin
-                       getlabel(hl4);
-                       if unsigned then
-                        emitl(A_JNB,hl4)
-                       else
-                        emitl(A_JNO,hl4);
-                       emitcall('RE_OVERFLOW',true);
-                       emitl(A_LABEL,hl4);
-                     end;
-                   end;
+                   if mboverflow then
+                    begin
+                      if cs_check_overflow in aktlocalswitches  then
+                       begin
+                         getlabel(hl4);
+                         if unsigned then
+                          emitl(A_JNB,hl4)
+                         else
+                          emitl(A_JNO,hl4);
+                         emitcall('RE_OVERFLOW',true);
+                         emitl(A_LABEL,hl4);
+                       end;
+                    end;
                 end
                 end
-              else if ((p^.left^.resulttype^.deftype=orddef) and
-                 (porddef(p^.left^.resulttype)^.typ=uchar)) then
-                begin
+              else
+
+              { Char type }
+                if ((p^.left^.resulttype^.deftype=orddef) and
+                    (porddef(p^.left^.resulttype)^.typ=uchar)) then
+                 begin
                    case p^.treetype of
                    case p^.treetype of
                       ltn,lten,gtn,gten,
                       ltn,lten,gtn,gten,
                       equaln,unequaln :
                       equaln,unequaln :
@@ -913,10 +946,10 @@ implementation
                       (p^.location.loc<>LOC_REGISTER) then
                       (p^.location.loc<>LOC_REGISTER) then
                      begin
                      begin
                        swap_location(p^.location,p^.right^.location);
                        swap_location(p^.location,p^.right^.location);
-
-                        { newly swapped also set swapped flag }
-                        p^.swaped:=not(p^.swaped);
+                       { newly swapped also set swapped flag }
+                       p^.swaped:=not(p^.swaped);
                      end;
                      end;
+
                    if p^.right^.location.loc<>LOC_REGISTER then
                    if p^.right^.location.loc<>LOC_REGISTER then
                      begin
                      begin
                         if p^.right^.location.loc=LOC_CREGISTER then
                         if p^.right^.location.loc=LOC_CREGISTER then
@@ -939,7 +972,10 @@ implementation
                      end;
                      end;
                    ungetregister32(reg8toreg32(p^.location.register));
                    ungetregister32(reg8toreg32(p^.location.register));
                 end
                 end
-              else if (p^.left^.resulttype^.deftype=floatdef) and
+              else
+
+              { Floating point }
+               if (p^.left^.resulttype^.deftype=floatdef) and
                   (pfloatdef(p^.left^.resulttype)^.typ<>f32bit) then
                   (pfloatdef(p^.left^.resulttype)^.typ<>f32bit) then
                  begin
                  begin
                     { real constants to the left }
                     { real constants to the left }
@@ -1000,42 +1036,50 @@ implementation
                        exprasmlist^.concat(new(pai386,op_reg_reg(op,S_NO,R_ST,R_ST1)))
                        exprasmlist^.concat(new(pai386,op_reg_reg(op,S_NO,R_ST,R_ST1)))
                     else
                     else
                       exprasmlist^.concat(new(pai386,op_none(op,S_NO)));
                       exprasmlist^.concat(new(pai386,op_none(op,S_NO)));
+
                     { on comparison load flags }
                     { on comparison load flags }
                     if cmpop then
                     if cmpop then
-                      begin
-                         if not(R_EAX in unused) then
-                           emit_reg_reg(A_MOV,S_L,R_EAX,R_EDI);
-                         exprasmlist^.concat(new(pai386,op_reg(A_FNSTSW,S_NO,R_AX)));
-                         exprasmlist^.concat(new(pai386,op_none(A_SAHF,S_NO)));
-                         if not(R_EAX in unused) then
-                           emit_reg_reg(A_MOV,S_L,R_EDI,R_EAX);
-                         if p^.swaped then
-                           case p^.treetype of
+                     begin
+                       if not(R_EAX in unused) then
+                         emit_reg_reg(A_MOV,S_L,R_EAX,R_EDI);
+                       exprasmlist^.concat(new(pai386,op_reg(A_FNSTSW,S_NO,R_AX)));
+                       exprasmlist^.concat(new(pai386,op_none(A_SAHF,S_NO)));
+                       if not(R_EAX in unused) then
+                         emit_reg_reg(A_MOV,S_L,R_EDI,R_EAX);
+                       if p^.swaped then
+                        begin
+                          case p^.treetype of
                               equaln : flags:=F_E;
                               equaln : flags:=F_E;
-                              unequaln : flags:=F_NE;
-                              ltn : flags:=F_A;
-                              lten : flags:=F_AE;
-                              gtn : flags:=F_B;
-                              gten : flags:=F_BE;
-                           end
-                         else
-                           case p^.treetype of
+                            unequaln : flags:=F_NE;
+                                 ltn : flags:=F_A;
+                                lten : flags:=F_AE;
+                                 gtn : flags:=F_B;
+                                gten : flags:=F_BE;
+                          end;
+                        end
+                       else
+                        begin
+                          case p^.treetype of
                               equaln : flags:=F_E;
                               equaln : flags:=F_E;
-                              unequaln : flags:=F_NE;
-                              ltn : flags:=F_B;
-                              lten : flags:=F_BE;
-                              gtn : flags:=F_A;
-                              gten : flags:=F_AE;
-                           end;
-                         p^.location.loc:=LOC_FLAGS;
-                         p^.location.resflags:=flags;
-                         cmpop:=false;
-                      end
+                            unequaln : flags:=F_NE;
+                                 ltn : flags:=F_B;
+                                lten : flags:=F_BE;
+                                 gtn : flags:=F_A;
+                                gten : flags:=F_AE;
+                          end;
+                        end;
+                       p^.location.loc:=LOC_FLAGS;
+                       p^.location.resflags:=flags;
+                       cmpop:=false;
+                     end
                     else
                     else
-                      p^.location.loc:=LOC_FPU;
+                     p^.location.loc:=LOC_FPU;
                  end
                  end
 {$ifdef SUPPORT_MMX}
 {$ifdef SUPPORT_MMX}
-               else if is_mmx_able_array(p^.left^.resulttype) then
+               else
+
+               { MMX Arrays }
+                if is_mmx_able_array(p^.left^.resulttype) then
                  begin
                  begin
                    cmpop:=false;
                    cmpop:=false;
                    mmxbase:=mmx_type(p^.left^.resulttype);
                    mmxbase:=mmx_type(p^.left^.resulttype);
@@ -1236,7 +1280,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.7  1998-08-19 14:56:59  peter
+  Revision 1.8  1998-08-28 10:54:18  peter
+    * fixed smallset generation from elements, it has never worked before!
+
+  Revision 1.7  1998/08/19 14:56:59  peter
     * forgot to removed some unused code in addset for set<>set
     * forgot to removed some unused code in addset for set<>set
 
 
   Revision 1.6  1998/08/18 09:24:35  pierre
   Revision 1.6  1998/08/18 09:24:35  pierre

+ 18 - 21
compiler/cg386set.pas

@@ -26,8 +26,7 @@ interface
     uses
     uses
       tree;
       tree;
 
 
-    procedure secondrange(var p : ptree);
-    procedure secondsetele(var p : ptree);
+    procedure secondsetelement(var p : ptree);
     procedure secondin(var p : ptree);
     procedure secondin(var p : ptree);
     procedure secondcase(var p : ptree);
     procedure secondcase(var p : ptree);
 
 
@@ -43,31 +42,26 @@ implementation
        bytes2Sxx:array[1..4] of Topsize=(S_B,S_W,S_NO,S_L);
        bytes2Sxx:array[1..4] of Topsize=(S_B,S_W,S_NO,S_L);
 
 
 {*****************************************************************************
 {*****************************************************************************
-                              SecondRange
+                              SecondSetElement
 *****************************************************************************}
 *****************************************************************************}
 
 
-    procedure secondrange(var p : ptree);
+    procedure secondsetelement(var p : ptree);
        begin
        begin
+       { load first value in 32bit register }
          secondpass(p^.left);
          secondpass(p^.left);
-         secondpass(p^.right);
-         { we doesn't modifiy the left side, we check only the type }
-         set_location(p^.location,p^.left^.location);
-       end;
+         if p^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
+           emit_to_reg32(p^.left^.location.register);
 
 
+       { also a second value ? }
+         if assigned(p^.right) then
+           begin
+             secondpass(p^.right);
+             if p^.right^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
+              emit_to_reg32(p^.right^.location.register);
+           end;
 
 
-{*****************************************************************************
-                              SecondSetEle
-*****************************************************************************}
-
-    procedure secondsetele(var p : ptree);
-       begin
-         secondpass(p^.left);
-         { we doesn't modifiy the left side, we check only the type }
+         { we doesn't modify the left side, we check only the type }
          set_location(p^.location,p^.left^.location);
          set_location(p^.location,p^.left^.location);
-         { return always in 32bit becuase set operations are done with
-           S_L opsize }
-         if p^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
-          emit_to_reg32(p^.location.register);
        end;
        end;
 
 
 
 
@@ -782,7 +776,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.8  1998-08-25 11:51:46  peter
+  Revision 1.9  1998-08-28 10:54:19  peter
+    * fixed smallset generation from elements, it has never worked before!
+
+  Revision 1.8  1998/08/25 11:51:46  peter
     * fixed -15 seen as byte in case
     * fixed -15 seen as byte in case
 
 
   Revision 1.7  1998/08/19 16:07:38  jonas
   Revision 1.7  1998/08/19 16:07:38  jonas

+ 6 - 3
compiler/cgi386.pas

@@ -207,7 +207,7 @@ implementation
        const
        const
          procedures : array[ttreetyp] of secondpassproc =
          procedures : array[ttreetyp] of secondpassproc =
             (secondadd,secondadd,secondadd,secondmoddiv,secondadd,
             (secondadd,secondadd,secondadd,secondmoddiv,secondadd,
-             secondmoddiv,secondassignment,secondload,secondrange,
+             secondmoddiv,secondassignment,secondload,secondnothing,
              secondadd,secondadd,secondadd,secondadd,
              secondadd,secondadd,secondadd,secondadd,
              secondadd,secondadd,secondin,secondadd,
              secondadd,secondadd,secondin,secondadd,
              secondadd,secondshlshr,secondshlshr,secondadd,
              secondadd,secondshlshr,secondshlshr,secondadd,
@@ -219,7 +219,7 @@ implementation
              secondstringconst,secondfuncret,secondselfn,
              secondstringconst,secondfuncret,secondselfn,
              secondnot,secondinline,secondniln,seconderror,
              secondnot,secondinline,secondniln,seconderror,
              secondnothing,secondhnewn,secondhdisposen,secondnewn,
              secondnothing,secondhnewn,secondhdisposen,secondnewn,
-             secondsimplenewdispose,secondsetele,secondsetcons,secondblockn,
+             secondsimplenewdispose,secondsetelement,secondsetcons,secondblockn,
              secondstatement,secondnothing,secondifn,secondbreakn,
              secondstatement,secondnothing,secondifn,secondbreakn,
              secondcontinuen,second_while_repeatn,second_while_repeatn,secondfor,
              secondcontinuen,second_while_repeatn,second_while_repeatn,secondfor,
              secondexitn,secondwith,secondcase,secondlabel,
              secondexitn,secondwith,secondcase,secondlabel,
@@ -506,7 +506,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.49  1998-08-19 16:07:42  jonas
+  Revision 1.50  1998-08-28 10:54:20  peter
+    * fixed smallset generation from elements, it has never worked before!
+
+  Revision 1.49  1998/08/19 16:07:42  jonas
     * changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
     * changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
 
 
   Revision 1.48  1998/08/14 18:18:43  peter
   Revision 1.48  1998/08/14 18:18:43  peter

+ 34 - 4
compiler/pass_1.pas

@@ -729,6 +729,7 @@ unit pass_1;
          rv,lv   : longint;
          rv,lv   : longint;
          rvd,lvd : bestreal;
          rvd,lvd : bestreal;
          rd,ld   : pdef;
          rd,ld   : pdef;
+         tempdef : pdef;
          concatstrings : boolean;
          concatstrings : boolean;
 
 
          { to evalute const sets }
          { to evalute const sets }
@@ -1088,9 +1089,22 @@ unit pass_1;
                   Message(sym_e_type_mismatch);
                   Message(sym_e_type_mismatch);
 
 
                 if ((rd^.deftype=setdef) and not(is_equal(rd,ld))) and
                 if ((rd^.deftype=setdef) and not(is_equal(rd,ld))) and
-                   not((rt in [rangen,setelen]) and is_equal(psetdef(ld)^.setof,rd)) then
+                   not((rt=setelementn) and is_equal(psetdef(ld)^.setof,rd)) then
                   Message(sym_e_set_element_are_not_comp);
                   Message(sym_e_set_element_are_not_comp);
 
 
+                { ranges require normsets }
+                if (psetdef(ld)^.settype=smallset) and
+                   (rt=setelementn) and
+                   assigned(p^.right^.right) then
+                 begin
+                   { generate a temporary normset def }
+                   tempdef:=new(psetdef,init(psetdef(ld)^.setof,255));
+                   p^.left:=gentypeconvnode(p^.left,tempdef);
+                   firstpass(p^.left);
+                   dispose(tempdef,done);
+                   ld:=p^.left^.resulttype;
+                 end;
+
                 { if the destination is not a smallset then insert a typeconv
                 { if the destination is not a smallset then insert a typeconv
                   which loads a smallset into a normal set }
                   which loads a smallset into a normal set }
                 if (psetdef(ld)^.settype<>smallset) and
                 if (psetdef(ld)^.settype<>smallset) and
@@ -1158,7 +1172,7 @@ unit pass_1;
                      exit;
                      exit;
                   end
                   end
                 else
                 else
-                 if psetdef(rd)^.settype=smallset then
+                 if psetdef(ld)^.settype=smallset then
                   begin
                   begin
                      calcregisters(p,1,0,0);
                      calcregisters(p,1,0,0);
                      p^.location.loc:=LOC_REGISTER;
                      p^.location.loc:=LOC_REGISTER;
@@ -2554,7 +2568,10 @@ unit pass_1;
             begin
             begin
             { try to define the set as a normalset if it's a constant set }
             { try to define the set as a normalset if it's a constant set }
               if p^.left^.treetype=setconstrn then
               if p^.left^.treetype=setconstrn then
-               psetdef(p^.left^.resulttype)^.settype:=normset
+               begin
+                 p^.resulttype:=p^.left^.resulttype;
+                 psetdef(p^.resulttype)^.settype:=normset
+               end
               else
               else
                p^.convtyp:=tc_load_smallset;
                p^.convtyp:=tc_load_smallset;
               exit;
               exit;
@@ -4328,6 +4345,16 @@ unit pass_1;
     procedure firstsetele(var p : ptree);
     procedure firstsetele(var p : ptree);
       begin
       begin
          firstpass(p^.left);
          firstpass(p^.left);
+         if codegenerror then
+          exit;
+
+         if assigned(p^.right) then
+          begin
+            firstpass(p^.right);
+            if codegenerror then
+             exit;
+          end;
+
          calcregisters(p,0,0,0);
          calcregisters(p,0,0,0);
          p^.resulttype:=p^.left^.resulttype;
          p^.resulttype:=p^.left^.resulttype;
          set_location(p^.location,p^.left^.location);
          set_location(p^.location,p^.left^.location);
@@ -5253,7 +5280,10 @@ unit pass_1;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.63  1998-08-24 10:05:39  florian
+  Revision 1.64  1998-08-28 10:54:22  peter
+    * fixed smallset generation from elements, it has never worked before!
+
+  Revision 1.63  1998/08/24 10:05:39  florian
     + class types and class reference types are now compatible with void
     + class types and class reference types are now compatible with void
       pointers
       pointers
     + class can be stored now registers, even if a type conversation is applied
     + class can be stored now registers, even if a type conversation is applied

+ 6 - 3
compiler/pexpr.pas

@@ -1075,7 +1075,7 @@ unit pexpr;
                                      else
                                      else
                                       begin
                                       begin
                                         update_constsethi(p3^.resulttype);
                                         update_constsethi(p3^.resulttype);
-                                        p4:=gennode(rangen,p2,p3);
+                                        p4:=gennode(setelementn,p2,p3);
                                       end;
                                       end;
                                    end;
                                    end;
                                end
                                end
@@ -1090,7 +1090,7 @@ unit pexpr;
                                  else
                                  else
                                   begin
                                   begin
                                     update_constsethi(p2^.resulttype);
                                     update_constsethi(p2^.resulttype);
-                                    p4:=gensinglenode(setelen,p2);
+                                    p4:=gennode(setelementn,p2,nil);
                                   end;
                                   end;
                                end;
                                end;
                             end;
                             end;
@@ -1856,7 +1856,10 @@ unit pexpr;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.43  1998-08-23 16:07:24  florian
+  Revision 1.44  1998-08-28 10:54:24  peter
+    * fixed smallset generation from elements, it has never worked before!
+
+  Revision 1.43  1998/08/23 16:07:24  florian
     * internalerror with mod/div fixed
     * internalerror with mod/div fixed
 
 
   Revision 1.42  1998/08/21 14:08:50  pierre
   Revision 1.42  1998/08/21 14:08:50  pierre

+ 6 - 2
compiler/tree.pas

@@ -93,7 +93,7 @@ unit tree;
                    hdisposen,       {The dispose operation with destructor call.}
                    hdisposen,       {The dispose operation with destructor call.}
                    newn,            {The new operation, constructor call.}
                    newn,            {The new operation, constructor call.}
                    simpledisposen,  {The dispose operation.}
                    simpledisposen,  {The dispose operation.}
-                   setelen,         {A set element (i.e. [a,b]).}
+                   setelementn,     {A set element(s) (i.e. [a,b] and also [a..b]).}
                    setconstrn,      {A set constant (i.e. [1,2]).}
                    setconstrn,      {A set constant (i.e. [1,2]).}
                    blockn,          {A block of statements.}
                    blockn,          {A block of statements.}
                    statementn,      {One statement in a block of nodes.}
                    statementn,      {One statement in a block of nodes.}
@@ -720,6 +720,7 @@ unit tree;
          genenumnode:=p;
          genenumnode:=p;
       end;
       end;
 
 
+
     function genrealconstnode(v : bestreal) : ptree;
     function genrealconstnode(v : bestreal) : ptree;
 
 
       var
       var
@@ -1553,7 +1554,10 @@ unit tree;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.31  1998-08-21 14:08:58  pierre
+  Revision 1.32  1998-08-28 10:54:25  peter
+    * fixed smallset generation from elements, it has never worked before!
+
+  Revision 1.31  1998/08/21 14:08:58  pierre
     + TEST_FUNCRET now default (old code removed)
     + TEST_FUNCRET now default (old code removed)
       works also for m68k (at least compiles)
       works also for m68k (at least compiles)