* move constant folding into det_resulttype

compiler/nadd.pas

@@ -76,10 +76,20 @@ implementation
 
     function taddnode.det_resulttype:tnode;
       var
-         hp    : tnode;
+         hp,t    : tnode;
          lt,rt   : tnodetype;
          rd,ld   : pdef;
          htype   : ttype;
+         ot      : tnodetype;
+         concatstrings : boolean;
+         resultset : pconstset;
+         i       : longint;
+         b       : boolean;
+         s1,s2   : pchar;
+         l1,l2   : longint;
+         rv,lv   : tconstexprint;
+         rvd,lvd : bestreal;
+
       begin
          result:=nil;
 
@@ -113,6 +123,310 @@ implementation
             rd:=right.resulttype.def;
           end;
 
+         { both are int constants }
+         if (((is_constintnode(left) and is_constintnode(right)) or
+              (is_constboolnode(left) and is_constboolnode(right) and
+               (nodetype in [ltn,lten,gtn,gten,equaln,unequaln,andn,xorn,orn])))) or
+            { support pointer arithmetics on constants (JM) }
+            ((lt = pointerconstn) and is_constintnode(right) and
+             (nodetype in [addn,subn])) or
+            ((lt = pointerconstn) and (rt = pointerconstn) and
+             (nodetype in [ltn,lten,gtn,gten,equaln,unequaln,subn])) then
+           begin
+              { when comparing/substracting  pointers, make sure they are }
+              { of the same  type (JM)                                    }
+              if (lt = pointerconstn) and (rt = pointerconstn) then
+               begin
+                 if not(cs_extsyntax in aktmoduleswitches) and
+                    not(nodetype in [equaln,unequaln]) then
+                   CGMessage(type_e_mismatch)
+                 else
+                   if (nodetype <> subn) and
+                      is_voidpointer(rd) then
+                     inserttypeconv(right,left.resulttype)
+                   else if (nodetype <> subn) and
+                           is_voidpointer(ld) then
+                     inserttypeconv(left,right.resulttype)
+                   else if not(is_equal(ld,rd)) then
+                     CGMessage(type_e_mismatch);
+                end
+              else if (lt=ordconstn) and (rt=ordconstn) then
+                begin
+                  { make left const type the biggest, this type will be used
+                    for orn,andn,xorn }
+                  if rd^.size>ld^.size then
+                    inserttypeconv(left,right.resulttype);
+                end;
+
+              { load values }
+              if (lt = ordconstn) then
+                lv:=tordconstnode(left).value
+              else
+                lv:=tpointerconstnode(left).value;
+              if (rt = ordconstn) then
+                rv:=tordconstnode(right).value
+              else
+                rv:=tpointerconstnode(right).value;
+              if (lt = pointerconstn) and
+                 (rt <> pointerconstn) then
+                rv := rv * ppointerdef(left.resulttype.def)^.pointertype.def^.size;
+              if (rt = pointerconstn) and
+                 (lt <> pointerconstn) then
+                lv := lv * ppointerdef(right.resulttype.def)^.pointertype.def^.size;
+              case nodetype of
+                addn :
+                  if (lt <> pointerconstn) then
+                    t := genintconstnode(lv+rv)
+                  else
+                    t := cpointerconstnode.create(lv+rv,left.resulttype);
+                subn :
+                  if (lt <> pointerconstn) or (rt = pointerconstn) then
+                    t := genintconstnode(lv-rv)
+                  else
+                    t := cpointerconstnode.create(lv-rv,left.resulttype);
+                muln :
+                  t:=genintconstnode(lv*rv);
+                xorn :
+                  t:=cordconstnode.create(lv xor rv,left.resulttype);
+                orn :
+                  t:=cordconstnode.create(lv or rv,left.resulttype);
+                andn :
+                  t:=cordconstnode.create(lv and rv,left.resulttype);
+                ltn :
+                  t:=cordconstnode.create(ord(lv<rv),booltype);
+                lten :
+                  t:=cordconstnode.create(ord(lv<=rv),booltype);
+                gtn :
+                  t:=cordconstnode.create(ord(lv>rv),booltype);
+                gten :
+                  t:=cordconstnode.create(ord(lv>=rv),booltype);
+                equaln :
+                  t:=cordconstnode.create(ord(lv=rv),booltype);
+                unequaln :
+                  t:=cordconstnode.create(ord(lv<>rv),booltype);
+                slashn :
+                  begin
+                    { int/int becomes a real }
+                    if int(rv)=0 then
+                     begin
+                       Message(parser_e_invalid_float_operation);
+                       t:=crealconstnode.create(0,pbestrealtype^);
+                     end
+                    else
+                     t:=crealconstnode.create(int(lv)/int(rv),pbestrealtype^);
+                  end;
+                else
+                  CGMessage(type_e_mismatch);
+              end;
+              resulttypepass(t);
+              result:=t;
+              exit;
+           end;
+
+       { both real constants ? }
+         if (lt=realconstn) and (rt=realconstn) then
+           begin
+              lvd:=trealconstnode(left).value_real;
+              rvd:=trealconstnode(right).value_real;
+              case nodetype of
+                 addn :
+                   t:=crealconstnode.create(lvd+rvd,pbestrealtype^);
+                 subn :
+                   t:=crealconstnode.create(lvd-rvd,pbestrealtype^);
+                 muln :
+                   t:=crealconstnode.create(lvd*rvd,pbestrealtype^);
+                 starstarn,
+                 caretn :
+                   begin
+                     if lvd<0 then
+                      begin
+                        Message(parser_e_invalid_float_operation);
+                        t:=crealconstnode.create(0,pbestrealtype^);
+                      end
+                     else if lvd=0 then
+                       t:=crealconstnode.create(1.0,pbestrealtype^)
+                     else
+                       t:=crealconstnode.create(exp(ln(lvd)*rvd),pbestrealtype^);
+                   end;
+                 slashn :
+                   begin
+                     if rvd=0 then
+                      begin
+                        Message(parser_e_invalid_float_operation);
+                        t:=crealconstnode.create(0,pbestrealtype^);
+                      end
+                     else
+                      t:=crealconstnode.create(lvd/rvd,pbestrealtype^);
+                   end;
+                 ltn :
+                   t:=cordconstnode.create(ord(lvd<rvd),booltype);
+                 lten :
+                   t:=cordconstnode.create(ord(lvd<=rvd),booltype);
+                 gtn :
+                   t:=cordconstnode.create(ord(lvd>rvd),booltype);
+                 gten :
+                   t:=cordconstnode.create(ord(lvd>=rvd),booltype);
+                 equaln :
+                   t:=cordconstnode.create(ord(lvd=rvd),booltype);
+                 unequaln :
+                   t:=cordconstnode.create(ord(lvd<>rvd),booltype);
+                 else
+                   CGMessage(type_e_mismatch);
+              end;
+              resulttypepass(t);
+              result:=t;
+              exit;
+           end;
+
+       { concating strings ? }
+         concatstrings:=false;
+         s1:=nil;
+         s2:=nil;
+         if (lt=ordconstn) and (rt=ordconstn) and
+            is_char(ld) and is_char(rd) then
+           begin
+              s1:=strpnew(char(byte(tordconstnode(left).value)));
+              s2:=strpnew(char(byte(tordconstnode(right).value)));
+              l1:=1;
+              l2:=1;
+              concatstrings:=true;
+           end
+         else
+           if (lt=stringconstn) and (rt=ordconstn) and is_char(rd) then
+           begin
+              s1:=tstringconstnode(left).getpcharcopy;
+              l1:=tstringconstnode(left).len;
+              s2:=strpnew(char(byte(tordconstnode(right).value)));
+              l2:=1;
+              concatstrings:=true;
+           end
+         else
+           if (lt=ordconstn) and (rt=stringconstn) and is_char(ld) then
+           begin
+              s1:=strpnew(char(byte(tordconstnode(left).value)));
+              l1:=1;
+              s2:=tstringconstnode(right).getpcharcopy;
+              l2:=tstringconstnode(right).len;
+              concatstrings:=true;
+           end
+         else if (lt=stringconstn) and (rt=stringconstn) then
+           begin
+              s1:=tstringconstnode(left).getpcharcopy;
+              l1:=tstringconstnode(left).len;
+              s2:=tstringconstnode(right).getpcharcopy;
+              l2:=tstringconstnode(right).len;
+              concatstrings:=true;
+           end;
+         if concatstrings then
+           begin
+              case nodetype of
+                 addn :
+                   t:=cstringconstnode.createpchar(concatansistrings(s1,s2,l1,l2),l1+l2);
+                 ltn :
+                   t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<0),booltype);
+                 lten :
+                   t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<=0),booltype);
+                 gtn :
+                   t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>0),booltype);
+                 gten :
+                   t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>=0),booltype);
+                 equaln :
+                   t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)=0),booltype);
+                 unequaln :
+                   t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<>0),booltype);
+              end;
+              ansistringdispose(s1,l1);
+              ansistringdispose(s2,l2);
+              resulttypepass(t);
+              result:=t;
+              exit;
+           end;
+
+         { set constant evaluation }
+         if (right.nodetype=setconstn) and
+            not assigned(tsetconstnode(right).left) and
+            (left.nodetype=setconstn) and
+            not assigned(tsetconstnode(left).left) then
+           begin
+              new(resultset);
+              case nodetype of
+                 addn :
+                   begin
+                      for i:=0 to 31 do
+                        resultset^[i]:=tsetconstnode(right).value_set^[i] or tsetconstnode(left).value_set^[i];
+                      t:=csetconstnode.create(resultset,left.resulttype);
+                   end;
+                 muln :
+                   begin
+                      for i:=0 to 31 do
+                        resultset^[i]:=tsetconstnode(right).value_set^[i] and tsetconstnode(left).value_set^[i];
+                      t:=csetconstnode.create(resultset,left.resulttype);
+                   end;
+                 subn :
+                   begin
+                      for i:=0 to 31 do
+                        resultset^[i]:=tsetconstnode(left).value_set^[i] and not(tsetconstnode(right).value_set^[i]);
+                      t:=csetconstnode.create(resultset,left.resulttype);
+                   end;
+                 symdifn :
+                   begin
+                      for i:=0 to 31 do
+                        resultset^[i]:=tsetconstnode(left).value_set^[i] xor tsetconstnode(right).value_set^[i];
+                      t:=csetconstnode.create(resultset,left.resulttype);
+                   end;
+                 unequaln :
+                   begin
+                      b:=true;
+                      for i:=0 to 31 do
+                       if tsetconstnode(right).value_set^[i]=tsetconstnode(left).value_set^[i] then
+                        begin
+                          b:=false;
+                          break;
+                        end;
+                      t:=cordconstnode.create(ord(b),booltype);
+                   end;
+                 equaln :
+                   begin
+                      b:=true;
+                      for i:=0 to 31 do
+                       if tsetconstnode(right).value_set^[i]<>tsetconstnode(left).value_set^[i] then
+                        begin
+                          b:=false;
+                          break;
+                        end;
+                      t:=cordconstnode.create(ord(b),booltype);
+                   end;
+                 lten :
+                   begin
+                     b := true;
+                     For i := 0 to 31 Do
+                       If (tsetconstnode(right).value_set^[i] And tsetconstnode(left).value_set^[i]) <>
+                           tsetconstnode(left).value_set^[i] Then
+                         Begin
+                           b := false;
+                           Break
+                         End;
+                     t := cordconstnode.create(ord(b),booltype);
+                   End;
+                 gten :
+                   Begin
+                     b := true;
+                     For i := 0 to 31 Do
+                       If (tsetconstnode(left).value_set^[i] And tsetconstnode(right).value_set^[i]) <>
+                           tsetconstnode(right).value_set^[i] Then
+                         Begin
+                           b := false;
+                           Break
+                         End;
+                     t := cordconstnode.create(ord(b),booltype);
+                   End;
+              end;
+              dispose(resultset);
+              resulttypepass(t);
+              result:=t;
+              exit;
+           end;
+
          { allow operator overloading }
          hp:=self;
          if isbinaryoverloaded(hp) then
@@ -147,7 +461,62 @@ implementation
                    inserttypeconv(left,right.resulttype);
                    ttypeconvnode(left).convtype:=tc_bool_2_int;
                    include(left.flags,nf_explizit);
-                 end
+                 end;
+                case nodetype of
+                  xorn,
+                  ltn,
+                  lten,
+                  gtn,
+                  gten,
+                  andn,
+                  orn:
+                    begin
+                    end;
+                  unequaln,
+                  equaln:
+                    begin
+                      if not(cs_full_boolean_eval in aktlocalswitches) then
+                       begin
+                         { Remove any compares with constants }
+                         if (left.nodetype=ordconstn) then
+                          begin
+                            hp:=right;
+                            b:=(tordconstnode(left).value<>0);
+                            ot:=nodetype;
+                            left.free;
+                            left:=nil;
+                            right:=nil;
+                            if (not(b) and (ot=equaln)) or
+                               (b and (ot=unequaln)) then
+                             begin
+                               hp:=cnotnode.create(hp);
+                               resulttypepass(hp);
+                             end;
+                            result:=hp;
+                            exit;
+                          end;
+                         if (right.nodetype=ordconstn) then
+                          begin
+                            hp:=left;
+                            b:=(tordconstnode(right).value<>0);
+                            ot:=nodetype;
+                            right.free;
+                            right:=nil;
+                            left:=nil;
+                            if (not(b) and (ot=equaln)) or
+                               (b and (ot=unequaln)) then
+                             begin
+                               hp:=cnotnode.create(hp);
+                               resulttypepass(hp);
+                             end;
+                            result:=hp;
+                            exit;
+                          end;
+                       end;
+                    end;
+                  else
+                    CGMessage(type_e_mismatch);
+                end;
               end
              { Both are chars? }
              else if is_char(rd) and is_char(ld) then
@@ -538,341 +907,50 @@ implementation
              Comment(V_Warning,'Generic conversion to s32bit');
 {$endif}
              inserttypeconv(right,s32bittype);
-             inserttypeconv(left,s32bittype);
-           end;
-
-         { set resulttype if not already done }
-         if not assigned(resulttype.def) then
-          begin
-             case nodetype of
-                ltn,lten,gtn,gten,equaln,unequaln :
-                  resulttype:=booltype;
-                slashn :
-                  resulttype:=pbestrealtype^;
-                addn:
-                  begin
-                    { for strings, return is always a 255 char string }
-                    if is_shortstring(left.resulttype.def) then
-                     resulttype:=cshortstringtype
-                    else
-                     resulttype:=left.resulttype;
-                  end;
-                else
-                  resulttype:=left.resulttype;
-             end;
-          end;
-      end;
-
-
-    function taddnode.pass_1 : tnode;
-
-      var
-         t,hp    : tnode;
-         ot,
-         lt,rt   : tnodetype;
-         rv,lv   : tconstexprint;
-         rvd,lvd : bestreal;
-         rd,ld   : pdef;
-         concatstrings : boolean;
-
-         { to evalute const sets }
-         resultset : pconstset;
-         i : longint;
-         b : boolean;
-         s1,s2 : pchar;
-         l1,l2 : longint;
-
-      begin
-         result:=nil;
-         { first do the two subtrees }
-         firstpass(left);
-         firstpass(right);
-         if codegenerror then
-           exit;
-
-         { load easier access variables }
-         rd:=right.resulttype.def;
-         ld:=left.resulttype.def;
-         rt:=right.nodetype;
-         lt:=left.nodetype;
-
-         { both are int constants }
-         if (((is_constintnode(left) and is_constintnode(right)) or
-              (is_constboolnode(left) and is_constboolnode(right) and
-               (nodetype in [ltn,lten,gtn,gten,equaln,unequaln,andn,xorn,orn])))) or
-            { support pointer arithmetics on constants (JM) }
-            ((lt = pointerconstn) and is_constintnode(right) and
-             (nodetype in [addn,subn])) or
-            ((lt = pointerconstn) and (rt = pointerconstn) and
-             (nodetype in [ltn,lten,gtn,gten,equaln,unequaln,subn])) then
-           begin
-              if (lt = ordconstn) then
-                lv:=tordconstnode(left).value
-              else
-                lv:=tpointerconstnode(left).value;
-              if (rt = ordconstn) then
-                rv:=tordconstnode(right).value
-              else
-                rv:=tpointerconstnode(right).value;
-              if (lt = pointerconstn) and
-                 (rt <> pointerconstn) then
-                rv := rv * ppointerdef(left.resulttype.def)^.pointertype.def^.size;
-              if (rt = pointerconstn) and
-                 (lt <> pointerconstn) then
-                lv := lv * ppointerdef(right.resulttype.def)^.pointertype.def^.size;
-              case nodetype of
-                addn :
-                  if (lt <> pointerconstn) then
-                    t := cordconstnode.create(lv+rv,resulttype)
-                  else
-                    t := cpointerconstnode.create(lv+rv,resulttype);
-                subn :
-                  if (lt <> pointerconstn) or (rt = pointerconstn) then
-                    t := cordconstnode.create(lv-rv,resulttype)
-                  else
-                    t := cpointerconstnode.create(lv-rv,resulttype);
-                muln :
-                  t:=cordconstnode.create(lv*rv,resulttype);
-                xorn :
-                  t:=cordconstnode.create(lv xor rv,resulttype);
-                orn :
-                  t:=cordconstnode.create(lv or rv,resulttype);
-                andn :
-                  t:=cordconstnode.create(lv and rv,resulttype);
-                ltn :
-                  t:=cordconstnode.create(ord(lv<rv),resulttype);
-                lten :
-                  t:=cordconstnode.create(ord(lv<=rv),resulttype);
-                gtn :
-                  t:=cordconstnode.create(ord(lv>rv),resulttype);
-                gten :
-                  t:=cordconstnode.create(ord(lv>=rv),resulttype);
-                equaln :
-                  t:=cordconstnode.create(ord(lv=rv),resulttype);
-                unequaln :
-                  t:=cordconstnode.create(ord(lv<>rv),resulttype);
+             inserttypeconv(left,s32bittype);
+           end;
+
+         { set resulttype if not already done }
+         if not assigned(resulttype.def) then
+          begin
+             case nodetype of
+                ltn,lten,gtn,gten,equaln,unequaln :
+                  resulttype:=booltype;
                 slashn :
+                  resulttype:=pbestrealtype^;
+                addn:
                   begin
-                    { int/int becomes a real }
-                    if int(rv)=0 then
-                     begin
-                       Message(parser_e_invalid_float_operation);
-                       t:=crealconstnode.create(0,resulttype);
-                     end
+                    { for strings, return is always a 255 char string }
+                    if is_shortstring(left.resulttype.def) then
+                     resulttype:=cshortstringtype
                     else
-                     t:=crealconstnode.create(int(lv)/int(rv),resulttype);
+                     resulttype:=left.resulttype;
                   end;
                 else
-                  CGMessage(type_e_mismatch);
-              end;
-              firstpass(t);
-              result:=t;
-              exit;
-           end;
+                  resulttype:=left.resulttype;
+             end;
+          end;
+      end;
 
-       { both real constants ? }
-         if (lt=realconstn) and (rt=realconstn) then
-           begin
-              lvd:=trealconstnode(left).value_real;
-              rvd:=trealconstnode(right).value_real;
-              case nodetype of
-                 addn :
-                   t:=crealconstnode.create(lvd+rvd,pbestrealtype^);
-                 subn :
-                   t:=crealconstnode.create(lvd-rvd,pbestrealtype^);
-                 muln :
-                   t:=crealconstnode.create(lvd*rvd,pbestrealtype^);
-                 starstarn,
-                 caretn :
-                   begin
-                     if lvd<0 then
-                      begin
-                        Message(parser_e_invalid_float_operation);
-                        t:=crealconstnode.create(0,pbestrealtype^);
-                      end
-                     else if lvd=0 then
-                       t:=crealconstnode.create(1.0,pbestrealtype^)
-                     else
-                       t:=crealconstnode.create(exp(ln(lvd)*rvd),pbestrealtype^);
-                   end;
-                 slashn :
-                   begin
-                     if rvd=0 then
-                      begin
-                        Message(parser_e_invalid_float_operation);
-                        t:=crealconstnode.create(0,pbestrealtype^);
-                      end
-                     else
-                      t:=crealconstnode.create(lvd/rvd,pbestrealtype^);
-                   end;
-                 ltn :
-                   t:=cordconstnode.create(ord(lvd<rvd),booltype);
-                 lten :
-                   t:=cordconstnode.create(ord(lvd<=rvd),booltype);
-                 gtn :
-                   t:=cordconstnode.create(ord(lvd>rvd),booltype);
-                 gten :
-                   t:=cordconstnode.create(ord(lvd>=rvd),booltype);
-                 equaln :
-                   t:=cordconstnode.create(ord(lvd=rvd),booltype);
-                 unequaln :
-                   t:=cordconstnode.create(ord(lvd<>rvd),booltype);
-                 else
-                   CGMessage(type_e_mismatch);
-              end;
-              firstpass(t);
-              result:=t;
-              exit;
-           end;
 
-       { concating strings ? }
-         concatstrings:=false;
-         s1:=nil;
-         s2:=nil;
-         if (lt=ordconstn) and (rt=ordconstn) and
-            is_char(ld) and is_char(rd) then
-           begin
-              s1:=strpnew(char(byte(tordconstnode(left).value)));
-              s2:=strpnew(char(byte(tordconstnode(right).value)));
-              l1:=1;
-              l2:=1;
-              concatstrings:=true;
-           end
-         else
-           if (lt=stringconstn) and (rt=ordconstn) and is_char(rd) then
-           begin
-              s1:=tstringconstnode(left).getpcharcopy;
-              l1:=tstringconstnode(left).len;
-              s2:=strpnew(char(byte(tordconstnode(right).value)));
-              l2:=1;
-              concatstrings:=true;
-           end
-         else
-           if (lt=ordconstn) and (rt=stringconstn) and is_char(ld) then
-           begin
-              s1:=strpnew(char(byte(tordconstnode(left).value)));
-              l1:=1;
-              s2:=tstringconstnode(right).getpcharcopy;
-              l2:=tstringconstnode(right).len;
-              concatstrings:=true;
-           end
-         else if (lt=stringconstn) and (rt=stringconstn) then
-           begin
-              s1:=tstringconstnode(left).getpcharcopy;
-              l1:=tstringconstnode(left).len;
-              s2:=tstringconstnode(right).getpcharcopy;
-              l2:=tstringconstnode(right).len;
-              concatstrings:=true;
-           end;
-         if concatstrings then
-           begin
-              case nodetype of
-                 addn :
-                   t:=cstringconstnode.createpchar(concatansistrings(s1,s2,l1,l2),l1+l2);
-                 ltn :
-                   t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<0),booltype);
-                 lten :
-                   t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<=0),booltype);
-                 gtn :
-                   t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>0),booltype);
-                 gten :
-                   t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>=0),booltype);
-                 equaln :
-                   t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)=0),booltype);
-                 unequaln :
-                   t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<>0),booltype);
-              end;
-              ansistringdispose(s1,l1);
-              ansistringdispose(s2,l2);
-              firstpass(t);
-              result:=t;
-              exit;
-           end;
+    function taddnode.pass_1 : tnode;
+      var
+         hp      : tnode;
+         lt,rt   : tnodetype;
+         rd,ld   : pdef;
+      begin
+         result:=nil;
+         { first do the two subtrees }
+         firstpass(left);
+         firstpass(right);
+         if codegenerror then
+           exit;
 
-         { set constant evaluation }
-         if (right.nodetype=setconstn) and
-            not assigned(tsetconstnode(right).left) and
-            (left.nodetype=setconstn) and
-            not assigned(tsetconstnode(left).left) then
-           begin
-              new(resultset);
-              case nodetype of
-                 addn :
-                   begin
-                      for i:=0 to 31 do
-                        resultset^[i]:=tsetconstnode(right).value_set^[i] or tsetconstnode(left).value_set^[i];
-                      t:=csetconstnode.create(resultset,left.resulttype);
-                   end;
-                 muln :
-                   begin
-                      for i:=0 to 31 do
-                        resultset^[i]:=tsetconstnode(right).value_set^[i] and tsetconstnode(left).value_set^[i];
-                      t:=csetconstnode.create(resultset,left.resulttype);
-                   end;
-                 subn :
-                   begin
-                      for i:=0 to 31 do
-                        resultset^[i]:=tsetconstnode(left).value_set^[i] and not(tsetconstnode(right).value_set^[i]);
-                      t:=csetconstnode.create(resultset,left.resulttype);
-                   end;
-                 symdifn :
-                   begin
-                      for i:=0 to 31 do
-                        resultset^[i]:=tsetconstnode(left).value_set^[i] xor tsetconstnode(right).value_set^[i];
-                      t:=csetconstnode.create(resultset,left.resulttype);
-                   end;
-                 unequaln :
-                   begin
-                      b:=true;
-                      for i:=0 to 31 do
-                       if tsetconstnode(right).value_set^[i]=tsetconstnode(left).value_set^[i] then
-                        begin
-                          b:=false;
-                          break;
-                        end;
-                      t:=cordconstnode.create(ord(b),booltype);
-                   end;
-                 equaln :
-                   begin
-                      b:=true;
-                      for i:=0 to 31 do
-                       if tsetconstnode(right).value_set^[i]<>tsetconstnode(left).value_set^[i] then
-                        begin
-                          b:=false;
-                          break;
-                        end;
-                      t:=cordconstnode.create(ord(b),booltype);
-                   end;
-                 lten :
-                   begin
-                     b := true;
-                     For i := 0 to 31 Do
-                       If (tsetconstnode(right).value_set^[i] And tsetconstnode(left).value_set^[i]) <>
-                           tsetconstnode(left).value_set^[i] Then
-                         Begin
-                           b := false;
-                           Break
-                         End;
-                     t := cordconstnode.create(ord(b),booltype);
-                   End;
-                 gten :
-                   Begin
-                     b := true;
-                     For i := 0 to 31 Do
-                       If (tsetconstnode(left).value_set^[i] And tsetconstnode(right).value_set^[i]) <>
-                           tsetconstnode(right).value_set^[i] Then
-                         Begin
-                           b := false;
-                           Break
-                         End;
-                     t := cordconstnode.create(ord(b),booltype);
-                   End;
-              end;
-              dispose(resultset);
-              firstpass(t);
-              result:=t;
-              exit;
-           end;
+         { load easier access variables }
+         rd:=right.resulttype.def;
+         ld:=left.resulttype.def;
+         rt:=right.nodetype;
+         lt:=left.nodetype;
 
          { int/int gives real/real! }
          if nodetype=slashn then
@@ -894,71 +972,20 @@ implementation
            { 2 booleans ? }
              if is_boolean(ld) and is_boolean(rd) then
               begin
-                if (cs_full_boolean_eval in aktlocalswitches) or
-                   (nodetype in [xorn,ltn,lten,gtn,gten]) then
-                  begin
-                     if (left.location.loc in [LOC_JUMP,LOC_FLAGS]) and
-                        (left.location.loc in [LOC_JUMP,LOC_FLAGS]) then
-                       calcregisters(self,2,0,0)
-                     else
-                       calcregisters(self,1,0,0);
-                  end
+                if not(cs_full_boolean_eval in aktlocalswitches) and
+                   (nodetype in [andn,orn]) then
+                 begin
+                   calcregisters(self,0,0,0);
+                   location.loc:=LOC_JUMP;
+                 end
                 else
-                  case nodetype of
-                    andn,
-                    orn:
-                      begin
-                        calcregisters(self,0,0,0);
-                        location.loc:=LOC_JUMP;
-                      end;
-                    unequaln,
-                    equaln:
-                      begin
-                        { Remove any compares with constants }
-                        if (left.nodetype=ordconstn) then
-                         begin
-                           hp:=right;
-                           b:=(tordconstnode(left).value<>0);
-                           ot:=nodetype;
-                           left.free;
-                           left:=nil;
-                           right:=nil;
-                           if (not(b) and (ot=equaln)) or
-                              (b and (ot=unequaln)) then
-                            begin
-                              hp:=cnotnode.create(hp);
-                              firstpass(hp);
-                            end;
-                           result:=hp;
-                           exit;
-                         end;
-                        if (right.nodetype=ordconstn) then
-                         begin
-                           hp:=left;
-                           b:=(tordconstnode(right).value<>0);
-                           ot:=nodetype;
-                           right.free;
-                           right:=nil;
-                           left:=nil;
-
-                           if (not(b) and (ot=equaln)) or
-                              (b and (ot=unequaln)) then
-                            begin
-                              hp:=cnotnode.create(hp);
-                              firstpass(hp);
-                            end;
-                           result:=hp;
-                           exit;
-                         end;
-                        if (left.location.loc in [LOC_JUMP,LOC_FLAGS]) and
-                           (left.location.loc in [LOC_JUMP,LOC_FLAGS]) then
-                          calcregisters(self,2,0,0)
-                        else
-                          calcregisters(self,1,0,0);
-                      end;
-                  else
-                    CGMessage(type_e_mismatch);
-                  end;
+                 begin
+                   if (left.location.loc in [LOC_JUMP,LOC_FLAGS]) and
+                      (left.location.loc in [LOC_JUMP,LOC_FLAGS]) then
+                     calcregisters(self,2,0,0)
+                   else
+                     calcregisters(self,1,0,0);
+                 end;
               end
              else
              { Both are chars? only convert to shortstrings for addn }
@@ -1170,7 +1197,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.23  2001-04-02 21:20:30  peter
+  Revision 1.24  2001-04-04 22:42:39  peter
+    * move constant folding into det_resulttype
+
+  Revision 1.23  2001/04/02 21:20:30  peter
     * resulttype rewrite
 
   Revision 1.22  2001/02/04 11:12:17  jonas

compiler/ncal.pas

@@ -1268,6 +1268,16 @@ implementation
          { ensure that the result type is set }
          resulttype:=procdefinition^.rettype;
 
+         { constructors return their current class type, not the type where the
+           constructor is declared, this can be different because of inheritance }
+         if (procdefinition^.proctypeoption=potype_constructor) then
+           begin
+             if assigned(methodpointer) and
+                assigned(methodpointer.resulttype.def) and
+                (methodpointer.resulttype.def^.deftype=classrefdef) then
+               resulttype:=pclassrefdef(methodpointer.resulttype.def)^.pointertype;
+           end;
+
          { insert type conversions }
          if assigned(left) then
           tcallparanode(left).insert_typeconv(tparaitem(procdefinition^.Para.first),true);
@@ -1388,13 +1398,12 @@ implementation
                 begin
                    { extra handling of classes }
                    { methodpointer should be assigned! }
-                   if assigned(methodpointer) and assigned(methodpointer.resulttype.def) and
-                     (methodpointer.resulttype.def^.deftype=classrefdef) then
+                   if assigned(methodpointer) and
+                      assigned(methodpointer.resulttype.def) and
+                      (methodpointer.resulttype.def^.deftype=classrefdef) then
                      begin
                         location.loc:=LOC_REGISTER;
                         registers32:=1;
-                        { the result type depends on the classref }
-                        resulttype:=pclassrefdef(methodpointer.resulttype.def)^.pointertype;
                      end
                   { a object constructor returns the result with the flags }
                    else
@@ -1604,7 +1613,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.25  2001-04-02 21:20:30  peter
+  Revision 1.26  2001-04-04 22:42:39  peter
+    * move constant folding into det_resulttype
+
+  Revision 1.25  2001/04/02 21:20:30  peter
     * resulttype rewrite
 
   Revision 1.24  2001/03/12 12:47:46  michael

compiler/ncnv.pas

@@ -40,6 +40,15 @@ interface
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
           function docompare(p: tnode) : boolean; override;
+       private
+          function resulttype_cord_to_pointer : tnode;
+          function resulttype_string_to_string : tnode;
+          function resulttype_char_to_string : tnode;
+          function resulttype_int_to_real : tnode;
+          function resulttype_real_to_real : tnode;
+          function resulttype_cchar_to_pchar : tnode;
+          function resulttype_arrayconstructor_to_set : tnode;
+          function resulttype_call_helper(c : tconverttype) : tnode;
        protected
           function first_int_to_int : tnode;virtual;
           function first_cstring_to_pchar : tnode;virtual;
@@ -218,10 +227,9 @@ implementation
                  p.left:=nil;
                  p3:=nil;
                end;
-              {$warning todo: firstpass}
-              firstpass(p2);
+              resulttypepass(p2);
               if assigned(p3) then
-               firstpass(p3);
+               resulttypepass(p3);
               if codegenerror then
                break;
               case p2.resulttype.def^.deftype of
@@ -382,11 +390,11 @@ implementation
       end;
 
 
-    function ttypeconvnode.first_cord_to_pointer : tnode;
+    function ttypeconvnode.resulttype_cord_to_pointer : tnode;
       var
         t : tnode;
       begin
-        first_cord_to_pointer:=nil;
+        result:=nil;
         if left.nodetype=ordconstn then
           begin
             { check if we have a valid pointer constant (JM) }
@@ -406,260 +414,86 @@ implementation
               else
                 internalerror(2001020801);
             t:=cpointerconstnode.create(tpointerord(tordconstnode(left).value),resulttype);
-            firstpass(t);
-            first_cord_to_pointer:=t;
-            exit;
+            resulttypepass(t);
+            result:=t;
           end
-        else
-          internalerror(432472389);
-      end;
-
-
-    function ttypeconvnode.first_int_to_int : tnode;
-      begin
-        first_int_to_int:=nil;
-        if (left.location.loc<>LOC_REGISTER) and
-           (resulttype.def^.size>left.resulttype.def^.size) then
-           location.loc:=LOC_REGISTER;
-        if is_64bitint(resulttype.def) then
-          registers32:=max(registers32,2)
-        else
-          registers32:=max(registers32,1);
-      end;
-
-
-    function ttypeconvnode.first_cstring_to_pchar : tnode;
-      begin
-         first_cstring_to_pchar:=nil;
-         registers32:=1;
-         location.loc:=LOC_REGISTER;
-      end;
-
-
-    function ttypeconvnode.first_string_to_chararray : tnode;
-      begin
-         first_string_to_chararray:=nil;
-         registers32:=1;
-         location.loc:=LOC_REGISTER;
+         else
+          internalerror(200104023);
       end;
 
 
-    function ttypeconvnode.first_string_to_string : tnode;
+    function ttypeconvnode.resulttype_string_to_string : tnode;
       begin
-         first_string_to_string:=nil;
-         if pstringdef(resulttype.def)^.string_typ<>
-            pstringdef(left.resulttype.def)^.string_typ then
-           begin
-              if left.nodetype=stringconstn then
-                begin
-                   tstringconstnode(left).st_type:=pstringdef(resulttype.def)^.string_typ;
-                   tstringconstnode(left).resulttype:=resulttype;
-                   { remove typeconv node }
-                   first_string_to_string:=left;
-                   left:=nil;
-                   exit;
-                end
-              else
-                procinfo^.flags:=procinfo^.flags or pi_do_call;
-           end;
-         { for simplicity lets first keep all ansistrings
-           as LOC_MEM, could also become LOC_REGISTER }
-         if pstringdef(resulttype.def)^.string_typ in [st_ansistring,st_widestring] then
-           { we may use ansistrings so no fast exit here }
-           procinfo^.no_fast_exit:=true;
-         location.loc:=LOC_MEM;
+         result:=nil;
+         if left.nodetype=stringconstn then
+          begin
+             tstringconstnode(left).st_type:=pstringdef(resulttype.def)^.string_typ;
+             tstringconstnode(left).resulttype:=resulttype;
+             result:=left;
+             left:=nil;
+          end;
       end;
 
 
-    function ttypeconvnode.first_char_to_string : tnode;
+    function ttypeconvnode.resulttype_char_to_string : tnode;
       var
          hp : tstringconstnode;
       begin
-         first_char_to_string:=nil;
+         result:=nil;
          if left.nodetype=ordconstn then
            begin
               hp:=cstringconstnode.createstr(chr(tordconstnode(left).value),st_default);
               hp.st_type:=pstringdef(resulttype.def)^.string_typ;
-              firstpass(hp);
-              first_char_to_string:=hp;
-           end
-         else
-           location.loc:=LOC_MEM;
-      end;
-
-
-    function ttypeconvnode.first_nothing : tnode;
-      begin
-         first_nothing:=nil;
-         location.loc:=LOC_MEM;
-      end;
-
-
-    function ttypeconvnode.first_array_to_pointer : tnode;
-      begin
-         first_array_to_pointer:=nil;
-         if registers32<1 then
-           registers32:=1;
-         location.loc:=LOC_REGISTER;
+              resulttypepass(hp);
+              result:=hp;
+           end;
       end;
 
 
-    function ttypeconvnode.first_int_to_real : tnode;
+    function ttypeconvnode.resulttype_int_to_real : tnode;
       var
         t : trealconstnode;
       begin
-        first_int_to_real:=nil;
+        result:=nil;
         if left.nodetype=ordconstn then
          begin
            t:=crealconstnode.create(tordconstnode(left).value,resulttype);
-           firstpass(t);
-           first_int_to_real:=t;
+           resulttypepass(t);
+           result:=t;
            exit;
          end;
-        if registersfpu<1 then
-         registersfpu:=1;
-        location.loc:=LOC_FPU;
       end;
 
 
-    function ttypeconvnode.first_real_to_real : tnode;
+    function ttypeconvnode.resulttype_real_to_real : tnode;
       var
         t : tnode;
       begin
-         first_real_to_real:=nil;
+         result:=nil;
          if left.nodetype=realconstn then
            begin
              t:=crealconstnode.create(trealconstnode(left).value_real,resulttype);
-             firstpass(t);
-             first_real_to_real:=t;
-             exit;
+             resulttypepass(t);
+             result:=t;
            end;
-        { comp isn't a floating type }
-{$ifdef i386}
-         if (pfloatdef(resulttype.def)^.typ=s64comp) and
-            (pfloatdef(left.resulttype.def)^.typ<>s64comp) and
-            not (nf_explizit in flags) then
-           CGMessage(type_w_convert_real_2_comp);
-{$endif}
-         if registersfpu<1 then
-           registersfpu:=1;
-         location.loc:=LOC_FPU;
       end;
 
 
-    function ttypeconvnode.first_pointer_to_array : tnode;
+    function ttypeconvnode.resulttype_cchar_to_pchar : tnode;
       begin
-         first_pointer_to_array:=nil;
-         if registers32<1 then
-           registers32:=1;
-         location.loc:=LOC_REFERENCE;
-      end;
-
-
-    function ttypeconvnode.first_chararray_to_string : tnode;
-      begin
-         first_chararray_to_string:=nil;
-         { the only important information is the location of the }
-         { result                                               }
-         { other stuff is done by firsttypeconv           }
-         location.loc:=LOC_MEM;
-      end;
-
-
-    function ttypeconvnode.first_cchar_to_pchar : tnode;
-      begin
-         first_cchar_to_pchar:=nil;
+         result:=nil;
          inserttypeconv(left,cshortstringtype);
          { evaluate again, reset resulttype so the convert_typ
            will be calculated again }
-         det_resulttype;
-         first_cchar_to_pchar:=pass_1;
+         result:=det_resulttype;
       end;
 
 
-    function ttypeconvnode.first_bool_to_int : tnode;
-      begin
-         first_bool_to_int:=nil;
-         { byte(boolean) or word(wordbool) or longint(longbool) must
-         be accepted for var parameters }
-         if (nf_explizit in flags) and
-            (left.resulttype.def^.size=resulttype.def^.size) and
-            (left.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
-           exit;
-         location.loc:=LOC_REGISTER;
-         if registers32<1 then
-           registers32:=1;
-      end;
-
-
-    function ttypeconvnode.first_int_to_bool : tnode;
-      begin
-         first_int_to_bool:=nil;
-         { byte(boolean) or word(wordbool) or longint(longbool) must
-         be accepted for var parameters }
-         if (nf_explizit in flags) and
-            (left.resulttype.def^.size=resulttype.def^.size) and
-            (left.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
-           exit;
-         location.loc:=LOC_REGISTER;
-         { need if bool to bool !!
-           not very nice !!
-         insertypeconv(left,s32bittype);
-         left.explizit:=true;
-         firstpass(left);  }
-         if registers32<1 then
-           registers32:=1;
-      end;
-
-
-    function ttypeconvnode.first_bool_to_bool : tnode;
-      begin
-         first_bool_to_bool:=nil;
-         location.loc:=LOC_REGISTER;
-         if registers32<1 then
-           registers32:=1;
-      end;
-
-
-    function ttypeconvnode.first_proc_to_procvar : tnode;
-      begin
-         first_proc_to_procvar:=nil;
-         if (left.location.loc<>LOC_REFERENCE) then
-           CGMessage(cg_e_illegal_expression);
-         registers32:=left.registers32;
-         if registers32<1 then
-           registers32:=1;
-         location.loc:=LOC_REGISTER;
-      end;
-
-
-    function ttypeconvnode.first_load_smallset : tnode;
-      begin
-         first_load_smallset:=nil;
-      end;
-
-
-    function ttypeconvnode.first_pchar_to_string : tnode;
-      begin
-         first_pchar_to_string:=nil;
-         location.loc:=LOC_REFERENCE;
-      end;
-
-
-    function ttypeconvnode.first_ansistring_to_pchar : tnode;
-      begin
-         first_ansistring_to_pchar:=nil;
-         location.loc:=LOC_REGISTER;
-         if registers32<1 then
-           registers32:=1;
-      end;
-
-
-    function ttypeconvnode.first_arrayconstructor_to_set : tnode;
+    function ttypeconvnode.resulttype_arrayconstructor_to_set : tnode;
       var
         hp : tnode;
       begin
-        first_arrayconstructor_to_set:=nil;
+        result:=nil;
         if left.nodetype<>arrayconstructorn then
          internalerror(5546);
       { remove typeconv node }
@@ -668,64 +502,56 @@ implementation
       { create a set constructor tree }
         arrayconstructor_to_set(tarrayconstructornode(hp));
       { now resulttypepass the set }
-        firstpass(hp);
-        first_arrayconstructor_to_set:=hp;
+        resulttypepass(hp);
+        result:=hp;
       end;
 
-    function ttypeconvnode.first_class_to_intf : tnode;
-
-      begin
-         first_class_to_intf:=nil;
-         location.loc:=LOC_REFERENCE;
-         if registers32<1 then
-           registers32:=1;
-      end;
 
-    function ttypeconvnode.first_call_helper(c : tconverttype) : tnode;
+    function ttypeconvnode.resulttype_call_helper(c : tconverttype) : tnode;
 
       const
-         firstconvert : array[tconverttype] of pointer = (
-           @ttypeconvnode.first_nothing, {equal}
-           @ttypeconvnode.first_nothing, {not_possible}
-           @ttypeconvnode.first_string_to_string,
-           @ttypeconvnode.first_char_to_string,
-           @ttypeconvnode.first_pchar_to_string,
-           @ttypeconvnode.first_cchar_to_pchar,
-           @ttypeconvnode.first_cstring_to_pchar,
-           @ttypeconvnode.first_ansistring_to_pchar,
-           @ttypeconvnode.first_string_to_chararray,
-           @ttypeconvnode.first_chararray_to_string,
-           @ttypeconvnode.first_array_to_pointer,
-           @ttypeconvnode.first_pointer_to_array,
-           @ttypeconvnode.first_int_to_int,
-           @ttypeconvnode.first_int_to_bool,
-           @ttypeconvnode.first_bool_to_bool,
-           @ttypeconvnode.first_bool_to_int,
-           @ttypeconvnode.first_real_to_real,
-           @ttypeconvnode.first_int_to_real,
-           @ttypeconvnode.first_proc_to_procvar,
-           @ttypeconvnode.first_arrayconstructor_to_set,
-           @ttypeconvnode.first_load_smallset,
-           @ttypeconvnode.first_cord_to_pointer,
-           @ttypeconvnode.first_nothing,
-           @ttypeconvnode.first_nothing,
-           @ttypeconvnode.first_class_to_intf
+         resulttypeconvert : array[tconverttype] of pointer = (
+          {equal} nil,
+          {not_possible} nil,
+          { string_2_string } @ttypeconvnode.resulttype_string_to_string,
+          { char_2_string } @ttypeconvnode.resulttype_char_to_string,
+          { pchar_2_string } nil,
+          { cchar_2_pchar } @ttypeconvnode.resulttype_cchar_to_pchar,
+          { cstring_2_pchar } nil,
+          { ansistring_2_pchar } nil,
+          { string_2_chararray } nil,
+          { chararray_2_string } nil,
+          { array_2_pointer } nil,
+          { pointer_2_array } nil,
+          { int_2_int } nil,
+          { int_2_bool } nil,
+          { bool_2_bool } nil,
+          { bool_2_int } nil,
+          { real_2_real } @ttypeconvnode.resulttype_real_to_real,
+          { int_2_real } @ttypeconvnode.resulttype_int_to_real,
+          { proc_2_procvar } nil,
+          { arrayconstructor_2_set } @ttypeconvnode.resulttype_arrayconstructor_to_set,
+          { load_smallset } nil,
+          { cord_2_pointer } @ttypeconvnode.resulttype_cord_to_pointer,
+          { intf_2_string } nil,
+          { intf_2_guid } nil,
+          { class_2_intf } nil
          );
       type
          tprocedureofobject = function : tnode of object;
-
       var
          r : packed record
                 proc : pointer;
                 obj : pointer;
              end;
-
       begin
+         result:=nil;
          { this is a little bit dirty but it works }
          { and should be quite portable too        }
-         r.proc:=firstconvert[c];
+         r.proc:=resulttypeconvert[c];
          r.obj:=self;
-         first_call_helper:=tprocedureofobject(r){$ifdef FPC}();{$endif FPC}
+         if assigned(r.proc) then
+          result:=tprocedureofobject(r){$ifdef FPC}();{$endif FPC}
       end;
 
 
@@ -784,8 +610,6 @@ implementation
              exit;
           end;
 
-        {$WARNING Todo: remove firstpass}
-        firstpass(left);
         if isconvertable(left.resulttype.def,resulttype.def,convtype,left.nodetype,nf_explizit in flags)=0 then
          begin
            {Procedures have a resulttype.def of voiddef and functions of their
@@ -1025,6 +849,277 @@ implementation
              result:=hp;
              exit;
           end;
+
+        { now call the resulttype helper to do constant folding }
+        result:=resulttype_call_helper(convtype);
+      end;
+
+
+    function ttypeconvnode.first_cord_to_pointer : tnode;
+      begin
+        result:=nil;
+        internalerror(200104043);
+      end;
+
+
+    function ttypeconvnode.first_int_to_int : tnode;
+      begin
+        first_int_to_int:=nil;
+        if (left.location.loc<>LOC_REGISTER) and
+           (resulttype.def^.size>left.resulttype.def^.size) then
+           location.loc:=LOC_REGISTER;
+        if is_64bitint(resulttype.def) then
+          registers32:=max(registers32,2)
+        else
+          registers32:=max(registers32,1);
+      end;
+
+
+    function ttypeconvnode.first_cstring_to_pchar : tnode;
+      begin
+         first_cstring_to_pchar:=nil;
+         registers32:=1;
+         location.loc:=LOC_REGISTER;
+      end;
+
+
+    function ttypeconvnode.first_string_to_chararray : tnode;
+      begin
+         first_string_to_chararray:=nil;
+         registers32:=1;
+         location.loc:=LOC_REGISTER;
+      end;
+
+
+    function ttypeconvnode.first_string_to_string : tnode;
+      begin
+         first_string_to_string:=nil;
+         if pstringdef(resulttype.def)^.string_typ<>
+            pstringdef(left.resulttype.def)^.string_typ then
+           begin
+             procinfo^.flags:=procinfo^.flags or pi_do_call;
+           end;
+         { for simplicity lets first keep all ansistrings
+           as LOC_MEM, could also become LOC_REGISTER }
+         if pstringdef(resulttype.def)^.string_typ in [st_ansistring,st_widestring] then
+           { we may use ansistrings so no fast exit here }
+           procinfo^.no_fast_exit:=true;
+         location.loc:=LOC_MEM;
+      end;
+
+
+    function ttypeconvnode.first_char_to_string : tnode;
+      begin
+         first_char_to_string:=nil;
+         location.loc:=LOC_MEM;
+      end;
+
+
+    function ttypeconvnode.first_nothing : tnode;
+      begin
+         first_nothing:=nil;
+         location.loc:=LOC_MEM;
+      end;
+
+
+    function ttypeconvnode.first_array_to_pointer : tnode;
+      begin
+         first_array_to_pointer:=nil;
+         if registers32<1 then
+           registers32:=1;
+         location.loc:=LOC_REGISTER;
+      end;
+
+
+    function ttypeconvnode.first_int_to_real : tnode;
+      begin
+        first_int_to_real:=nil;
+        if registersfpu<1 then
+         registersfpu:=1;
+        location.loc:=LOC_FPU;
+      end;
+
+
+    function ttypeconvnode.first_real_to_real : tnode;
+      begin
+         first_real_to_real:=nil;
+        { comp isn't a floating type }
+{$ifdef i386}
+         if (pfloatdef(resulttype.def)^.typ=s64comp) and
+            (pfloatdef(left.resulttype.def)^.typ<>s64comp) and
+            not (nf_explizit in flags) then
+           CGMessage(type_w_convert_real_2_comp);
+{$endif}
+         if registersfpu<1 then
+           registersfpu:=1;
+         location.loc:=LOC_FPU;
+      end;
+
+
+    function ttypeconvnode.first_pointer_to_array : tnode;
+      begin
+         first_pointer_to_array:=nil;
+         if registers32<1 then
+           registers32:=1;
+         location.loc:=LOC_REFERENCE;
+      end;
+
+
+    function ttypeconvnode.first_chararray_to_string : tnode;
+      begin
+         first_chararray_to_string:=nil;
+         { the only important information is the location of the }
+         { result                                               }
+         { other stuff is done by firsttypeconv           }
+         location.loc:=LOC_MEM;
+      end;
+
+
+    function ttypeconvnode.first_cchar_to_pchar : tnode;
+      begin
+         first_cchar_to_pchar:=nil;
+         internalerror(200104021);
+      end;
+
+
+    function ttypeconvnode.first_bool_to_int : tnode;
+      begin
+         first_bool_to_int:=nil;
+         { byte(boolean) or word(wordbool) or longint(longbool) must
+         be accepted for var parameters }
+         if (nf_explizit in flags) and
+            (left.resulttype.def^.size=resulttype.def^.size) and
+            (left.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
+           exit;
+         location.loc:=LOC_REGISTER;
+         if registers32<1 then
+           registers32:=1;
+      end;
+
+
+    function ttypeconvnode.first_int_to_bool : tnode;
+      begin
+         first_int_to_bool:=nil;
+         { byte(boolean) or word(wordbool) or longint(longbool) must
+         be accepted for var parameters }
+         if (nf_explizit in flags) and
+            (left.resulttype.def^.size=resulttype.def^.size) and
+            (left.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
+           exit;
+         location.loc:=LOC_REGISTER;
+         { need if bool to bool !!
+           not very nice !!
+         insertypeconv(left,s32bittype);
+         left.explizit:=true;
+         firstpass(left);  }
+         if registers32<1 then
+           registers32:=1;
+      end;
+
+
+    function ttypeconvnode.first_bool_to_bool : tnode;
+      begin
+         first_bool_to_bool:=nil;
+         location.loc:=LOC_REGISTER;
+         if registers32<1 then
+           registers32:=1;
+      end;
+
+
+    function ttypeconvnode.first_proc_to_procvar : tnode;
+      begin
+         first_proc_to_procvar:=nil;
+         if (left.location.loc<>LOC_REFERENCE) then
+           CGMessage(cg_e_illegal_expression);
+         registers32:=left.registers32;
+         if registers32<1 then
+           registers32:=1;
+         location.loc:=LOC_REGISTER;
+      end;
+
+
+    function ttypeconvnode.first_load_smallset : tnode;
+      begin
+         first_load_smallset:=nil;
+      end;
+
+
+    function ttypeconvnode.first_pchar_to_string : tnode;
+      begin
+         first_pchar_to_string:=nil;
+         location.loc:=LOC_REFERENCE;
+      end;
+
+
+    function ttypeconvnode.first_ansistring_to_pchar : tnode;
+      begin
+         first_ansistring_to_pchar:=nil;
+         location.loc:=LOC_REGISTER;
+         if registers32<1 then
+           registers32:=1;
+      end;
+
+
+    function ttypeconvnode.first_arrayconstructor_to_set : tnode;
+      begin
+        first_arrayconstructor_to_set:=nil;
+        internalerror(200104022);
+      end;
+
+    function ttypeconvnode.first_class_to_intf : tnode;
+
+      begin
+         first_class_to_intf:=nil;
+         location.loc:=LOC_REFERENCE;
+         if registers32<1 then
+           registers32:=1;
+      end;
+
+    function ttypeconvnode.first_call_helper(c : tconverttype) : tnode;
+
+      const
+         firstconvert : array[tconverttype] of pointer = (
+           @ttypeconvnode.first_nothing, {equal}
+           @ttypeconvnode.first_nothing, {not_possible}
+           @ttypeconvnode.first_string_to_string,
+           @ttypeconvnode.first_char_to_string,
+           @ttypeconvnode.first_pchar_to_string,
+           @ttypeconvnode.first_cchar_to_pchar,
+           @ttypeconvnode.first_cstring_to_pchar,
+           @ttypeconvnode.first_ansistring_to_pchar,
+           @ttypeconvnode.first_string_to_chararray,
+           @ttypeconvnode.first_chararray_to_string,
+           @ttypeconvnode.first_array_to_pointer,
+           @ttypeconvnode.first_pointer_to_array,
+           @ttypeconvnode.first_int_to_int,
+           @ttypeconvnode.first_int_to_bool,
+           @ttypeconvnode.first_bool_to_bool,
+           @ttypeconvnode.first_bool_to_int,
+           @ttypeconvnode.first_real_to_real,
+           @ttypeconvnode.first_int_to_real,
+           @ttypeconvnode.first_proc_to_procvar,
+           @ttypeconvnode.first_arrayconstructor_to_set,
+           @ttypeconvnode.first_load_smallset,
+           @ttypeconvnode.first_cord_to_pointer,
+           @ttypeconvnode.first_nothing,
+           @ttypeconvnode.first_nothing,
+           @ttypeconvnode.first_class_to_intf
+         );
+      type
+         tprocedureofobject = function : tnode of object;
+
+      var
+         r : packed record
+                proc : pointer;
+                obj : pointer;
+             end;
+
+      begin
+         { this is a little bit dirty but it works }
+         { and should be quite portable too        }
+         r.proc:=firstconvert[c];
+         r.obj:=self;
+         first_call_helper:=tprocedureofobject(r){$ifdef FPC}();{$endif FPC}
       end;
 
 
@@ -1200,7 +1295,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.22  2001-04-02 21:20:30  peter
+  Revision 1.23  2001-04-04 22:42:39  peter
+    * move constant folding into det_resulttype
+
+  Revision 1.22  2001/04/02 21:20:30  peter
     * resulttype rewrite
 
   Revision 1.21  2001/03/08 17:44:47  jonas

compiler/nld.pas

@@ -164,6 +164,8 @@ implementation
          p1 : tnode;
       begin
          result:=nil;
+
+         { optimize simple with loadings }
          if (symtable^.symtabletype=withsymtable) and
             (pwithsymtable(symtable)^.direct_with) and
             (symtableentry^.typ=varsym) then
@@ -312,6 +314,7 @@ implementation
           (symtable = tloadnode(p).symtable);
       end;
 
+
 {*****************************************************************************
                              TASSIGNMENTNODE
 *****************************************************************************}
@@ -440,6 +443,7 @@ implementation
           (assigntype = tassignmentnode(p).assigntype);
       end;
 
+
 {*****************************************************************************
                                  TFUNCRETNODE
 *****************************************************************************}
@@ -451,6 +455,7 @@ implementation
          funcretprocinfo:=p;
       end;
 
+
     function tfuncretnode.getcopy : tnode;
       var
          n : tfuncretnode;
@@ -460,12 +465,14 @@ implementation
          getcopy:=n;
       end;
 
+
     function tfuncretnode.det_resulttype:tnode;
       begin
         result:=nil;
         resulttype:=pprocinfo(funcretprocinfo)^.returntype;
       end;
 
+
     function tfuncretnode.pass_1 : tnode;
       begin
          result:=nil;
@@ -475,6 +482,7 @@ implementation
            registers32:=1;
       end;
 
+
     function tfuncretnode.docompare(p: tnode): boolean;
       begin
         docompare :=
@@ -482,6 +490,7 @@ implementation
           (funcretprocinfo = tfuncretnode(p).funcretprocinfo);
       end;
 
+
 {*****************************************************************************
                            TARRAYCONSTRUCTORRANGENODE
 *****************************************************************************}
@@ -519,23 +528,22 @@ implementation
 *****************************************************************************}
 
     constructor tarrayconstructornode.create(l,r : tnode);
-
       begin
          inherited create(arrayconstructorn,l,r);
          constructortype.reset;
       end;
 
-    function tarrayconstructornode.getcopy : tnode;
 
+    function tarrayconstructornode.getcopy : tnode;
       var
          n : tarrayconstructornode;
-
       begin
          n:=tarrayconstructornode(inherited getcopy);
          n.constructortype:=constructortype;
          result:=n;
       end;
 
+
     function tarrayconstructornode.det_resulttype:tnode;
       var
         htype : ttype;
@@ -544,6 +552,7 @@ implementation
         varia : boolean;
       begin
         result:=nil;
+
       { are we allowing array constructor? Then convert it to a set }
         if not allow_array_constructor then
          begin
@@ -553,6 +562,7 @@ implementation
            result:=hp;
            exit;
          end;
+
       { only pass left tree, right tree contains next construct if any }
         htype:=constructortype;
         len:=0;
@@ -589,43 +599,12 @@ implementation
 
     function tarrayconstructornode.pass_1 : tnode;
       var
-        htype : ttype;
         thp,
         chp,
         hp : tarrayconstructornode;
-        len : longint;
-        varia : boolean;
-
-      procedure postprocess(t : tnode);
-
-        begin
-           calcregisters(tbinarynode(t),0,0,0);
-           { looks a little bit dangerous to me            }
-           { len-1 gives problems with is_open_array if len=0, }
-           { is_open_array checks now for isconstructor (FK)   }
-           { if no type is set then we set the type to voiddef to overcome a
-           0 addressing }
-           if not assigned(htype.def) then
-             htype:=voidtype;
-           { skip if already done ! (PM) }
-           if not assigned(t.resulttype.def) or
-              (t.resulttype.def^.deftype<>arraydef) or
-              not parraydef(t.resulttype.def)^.IsConstructor or
-              (parraydef(t.resulttype.def)^.lowrange<>0) or
-              (parraydef(t.resulttype.def)^.highrange<>len-1) then
-             t.resulttype.setdef(new(parraydef,init(0,len-1,s32bittype)));
-
-           parraydef(t.resulttype.def)^.elementtype:=htype;
-           parraydef(t.resulttype.def)^.IsConstructor:=true;
-           parraydef(t.resulttype.def)^.IsVariant:=varia;
-           t.location.loc:=LOC_MEM;
-        end;
       begin
         result:=nil;
       { only pass left tree, right tree contains next construct if any }
-        htype:=constructortype;
-        len:=0;
-        varia:=false;
         if assigned(left) then
          begin
            hp:=self;
@@ -633,8 +612,8 @@ implementation
             begin
               firstpass(hp.left);
               set_varstate(hp.left,true);
-              if (not get_para_resulttype) and
-                (not(nf_novariaallowed in flags)) then
+              { Insert typeconvs for array of const }
+              if parraydef(resulttype.def)^.IsVariant then
                begin
                  case hp.left.resulttype.def^.deftype of
                    enumdef :
@@ -676,23 +655,6 @@ implementation
                      CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def^.typename);
                  end;
                end;
-              if (htype.def=nil) then
-               htype:=hp.left.resulttype
-              else
-               begin
-                 if ((nf_novariaallowed in flags) or (not varia)) and
-                    (not is_equal(htype.def,hp.left.resulttype.def)) then
-                  begin
-                    { if both should be equal try inserting a conversion }
-                    if nf_novariaallowed in flags then
-                     begin
-                       hp.left:=ctypeconvnode.create(hp.left,htype);
-                       firstpass(hp.left);
-                     end;
-                    varia:=true;
-                  end;
-               end;
-              inc(len);
               hp:=tarrayconstructornode(hp.right);
             end;
          { swap the tree for cargs }
@@ -711,14 +673,17 @@ implementation
                end;
               include(chp.flags,nf_cargs);
               include(chp.flags,nf_cargswap);
-              postprocess(chp);
+              calcregisters(chp,0,0,0);
+              chp.location.loc:=LOC_MEM;
               result:=chp;
               exit;
             end;
          end;
-         postprocess(self);
+        calcregisters(self,0,0,0);
+        location.loc:=LOC_MEM;
       end;
 
+
     function tarrayconstructornode.docompare(p: tnode): boolean;
       begin
         docompare :=
@@ -732,23 +697,25 @@ implementation
 *****************************************************************************}
 
     constructor ttypenode.create(t : ttype);
-
       begin
          inherited create(typen);
          restype:=t;
       end;
 
+
     function ttypenode.det_resulttype:tnode;
       begin
         result:=nil;
         resulttype:=restype;
       end;
 
+
     function ttypenode.pass_1 : tnode;
       begin
          result:=nil;
       end;
 
+
     function ttypenode.docompare(p: tnode): boolean;
       begin
         docompare :=
@@ -765,7 +732,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.11  2001-04-02 21:20:31  peter
+  Revision 1.12  2001-04-04 22:42:40  peter
+    * move constant folding into det_resulttype
+
+  Revision 1.11  2001/04/02 21:20:31  peter
     * resulttype rewrite
 
   Revision 1.10  2000/12/31 11:14:10  jonas

compiler/nmat.pas

@@ -83,6 +83,7 @@ implementation
       var
          t : tnode;
          rd,ld : pdef;
+         rv,lv : tconstexprint;
       begin
          result:=nil;
          resulttypepass(left);
@@ -92,6 +93,31 @@ implementation
          if codegenerror then
            exit;
 
+         { constant folding }
+         if is_constintnode(left) and is_constintnode(right) then
+           begin
+              rv:=tordconstnode(right).value;
+              lv:=tordconstnode(left).value;
+
+              { check for division by zero }
+              if (rv=0) then
+               begin
+                 Message(parser_e_division_by_zero);
+                 { recover }
+                 rv:=1;
+               end;
+
+              case nodetype of
+                modn:
+                  t:=genintconstnode(lv mod rv);
+                divn:
+                  t:=genintconstnode(lv div rv);
+              end;
+              resulttypepass(t);
+              result:=t;
+              exit;
+           end;
+
          { allow operator overloading }
          t:=self;
          if isbinaryoverloaded(t) then
@@ -166,8 +192,6 @@ implementation
     function tmoddivnode.pass_1 : tnode;
       var
          t : tnode;
-         rv,lv : tconstexprint;
-
       begin
          result:=nil;
          firstpass(left);
@@ -175,30 +199,6 @@ implementation
          if codegenerror then
            exit;
 
-         if is_constintnode(left) and is_constintnode(right) then
-           begin
-              rv:=tordconstnode(right).value;
-              lv:=tordconstnode(left).value;
-
-              { check for division by zero }
-              if (rv=0) then
-               begin
-                 Message(parser_e_division_by_zero);
-                 { recover }
-                 rv:=1;
-               end;
-
-              case nodetype of
-                modn:
-                  t:=genintconstnode(lv mod rv);
-                divn:
-                  t:=genintconstnode(lv div rv);
-              end;
-              firstpass(t);
-              result:=t;
-              exit;
-           end;
-
          { 64bit }
          if (left.resulttype.def^.deftype=orddef) and (right.resulttype.def^.deftype=orddef) and
             (is_64bitint(left.resulttype.def) or is_64bitint(right.resulttype.def)) then
@@ -232,6 +232,20 @@ implementation
          if codegenerror then
            exit;
 
+         { constant folding }
+         if is_constintnode(left) and is_constintnode(right) then
+           begin
+              case nodetype of
+                 shrn:
+                   t:=genintconstnode(tordconstnode(left).value shr tordconstnode(right).value);
+                 shln:
+                   t:=genintconstnode(tordconstnode(left).value shl tordconstnode(right).value);
+              end;
+              resulttypepass(t);
+              result:=t;
+              exit;
+           end;
+
          { allow operator overloading }
          t:=self;
          if isbinaryoverloaded(t) then
@@ -265,19 +279,6 @@ implementation
          if codegenerror then
            exit;
 
-         if is_constintnode(left) and is_constintnode(right) then
-           begin
-              case nodetype of
-                 shrn:
-                   t:=genintconstnode(tordconstnode(left).value shr tordconstnode(right).value);
-                 shln:
-                   t:=genintconstnode(tordconstnode(left).value shl tordconstnode(right).value);
-              end;
-              firstpass(t);
-              result:=t;
-              exit;
-           end;
-
          { 64 bit ints have their own shift handling }
          if not(is_64bitint(left.resulttype.def)) then
           regs:=1
@@ -311,8 +312,24 @@ implementation
          set_varstate(left,true);
          if codegenerror then
            exit;
-         resulttype:=left.resulttype;
 
+         { constant folding }
+         if is_constintnode(left) then
+           begin
+              tordconstnode(left).value:=-tordconstnode(left).value;
+              result:=left;
+              left:=nil;
+              exit;
+           end;
+         if is_constrealnode(left) then
+           begin
+              trealconstnode(left).value_real:=-trealconstnode(left).value_real;
+              result:=left;
+              left:=nil;
+              exit;
+           end;
+
+         resulttype:=left.resulttype;
          if (left.resulttype.def^.deftype=floatdef) then
            begin
            end
@@ -371,21 +388,6 @@ implementation
          if codegenerror then
            exit;
 
-         if is_constintnode(left) then
-           begin
-              t:=cordconstnode.create(-tordconstnode(left).value,resulttype);
-              firstpass(t);
-              result:=t;
-              exit;
-           end;
-         if is_constrealnode(left) then
-           begin
-              t:=crealconstnode.create(-trealconstnode(left).value_real,resulttype);
-              firstpass(t);
-              result:=t;
-              exit;
-           end;
-
          registers32:=left.registers32;
          registersfpu:=left.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -436,6 +438,7 @@ implementation
       var
          t : tnode;
          notdef : pprocdef;
+         v : tconstexprint;
       begin
          result:=nil;
          resulttypepass(left);
@@ -443,6 +446,29 @@ implementation
          if codegenerror then
            exit;
 
+         { constant folding }
+         if (left.nodetype=ordconstn) then
+           begin
+              if is_boolean(left.resulttype.def) then
+                { here we do a boolean(byte(..)) type cast because }
+                { boolean(<int64>) is buggy in 1.00                }
+                t:=cordconstnode.create(byte(not(boolean(byte(tordconstnode(left).value)))),left.resulttype)
+              else
+                begin
+                  v:=tordconstnode(left).value;
+                  case left.resulttype.def^.size of
+                    1 : v:=(not(v and $ff)) and $ff;
+                    2 : v:=(not(v and $ffff)) and $ffff;
+                    4 : v:=(not(v and $ffffffff)) and $ffffffff;
+                    8 : v:=not(v);
+                  end;
+                  t:=cordconstnode.create(v,left.resulttype);
+                end;
+              resulttypepass(t);
+              result:=t;
+              exit;
+           end;
+
          resulttype:=left.resulttype;
          if is_boolean(resulttype.def) then
            begin
@@ -460,8 +486,6 @@ implementation
              end
          else if is_integer(left.resulttype.def) then
            begin
-              if (porddef(left.resulttype.def)^.typ <> u32bit) then
-                inserttypeconv(left,s32bittype);
            end
          else
            begin
@@ -494,25 +518,10 @@ implementation
       begin
          result:=nil;
          firstpass(left);
-         set_varstate(left,true);
          if codegenerror then
            exit;
 
-         if (left.nodetype=ordconstn) then
-           begin
-              if is_boolean(left.resulttype.def) then
-                { here we do a boolena(byte(..)) type cast because }
-                { boolean(<int64>) is buggy in 1.00                }
-                t:=cordconstnode.create(byte(not(boolean(byte(tordconstnode(left).value)))),left.resulttype)
-              else
-                t:=cordconstnode.create(not(tordconstnode(left).value),left.resulttype);
-              firstpass(t);
-              result:=t;
-              exit;
-           end;
-
          location.loc:=left.location.loc;
-         resulttype:=left.resulttype;
          registers32:=left.registers32;
 {$ifdef SUPPORT_MMX}
          registersmmx:=left.registersmmx;
@@ -569,7 +578,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.17  2001-04-02 21:20:31  peter
+  Revision 1.18  2001-04-04 22:42:40  peter
+    * move constant folding into det_resulttype
+
+  Revision 1.17  2001/04/02 21:20:31  peter
     * resulttype rewrite
 
   Revision 1.16  2001/03/20 18:11:03  jonas