Browse Source

* bug fix for IOCHECK inside a procedure with iocheck modifier
* removed the GPF for unexistant overloading
(firstcall was called with procedinition=nil !)
* changed typen to what Florian proposed
gentypenode(p : pdef) sets the typenodetype field
and resulttype is only set if inside bt_type block !

pierre 27 years ago
parent
commit
6c1766feed
8 changed files with 160 additions and 44 deletions
  1. 10 1
      compiler/cg386cal.pas
  2. 11 2
      compiler/cg386inl.pas
  3. 12 3
      compiler/cg68kcal.pas
  4. 11 2
      compiler/cg68kinl.pas
  5. 46 23
      compiler/pexpr.pas
  6. 24 10
      compiler/tcadd.pas
  7. 14 2
      compiler/tccnv.pas
  8. 32 1
      compiler/tree.pas

+ 10 - 1
compiler/cg386cal.pas

@@ -728,6 +728,7 @@ implementation
             ((p^.procdefinition^.options and povirtualmethod)=0) then
             ((p^.procdefinition^.options and povirtualmethod)=0) then
            begin
            begin
               if ((p^.procdefinition^.options and poiocheck)<>0) and
               if ((p^.procdefinition^.options and poiocheck)<>0) and
+                 ((aktprocsym^.definition^.options and poiocheck)=0) and
                  (cs_check_io in aktlocalswitches) then
                  (cs_check_io in aktlocalswitches) then
                 begin
                 begin
                    getlabel(iolabel);
                    getlabel(iolabel);
@@ -1514,7 +1515,15 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.37  1998-10-21 08:39:57  florian
+  Revision 1.38  1998-10-21 15:12:49  pierre
+    * bug fix for IOCHECK inside a procedure with iocheck modifier
+    * removed the GPF for unexistant overloading
+      (firstcall was called with procedinition=nil !)
+    * changed typen to what Florian proposed
+      gentypenode(p : pdef) sets the typenodetype field
+      and resulttype is only set if inside bt_type block !
+
+  Revision 1.37  1998/10/21 08:39:57  florian
     + ansistring operator +
     + ansistring operator +
     + $h and string[n] for n>255 added
     + $h and string[n] for n>255 added
     * small problem with TP fixed
     * small problem with TP fixed

+ 11 - 2
compiler/cg386inl.pas

@@ -116,7 +116,8 @@ implementation
 
 
         begin
         begin
            { I/O check }
            { I/O check }
-           if cs_check_io in aktlocalswitches then
+           if (cs_check_io in aktlocalswitches) and
+              ((aktprocsym^.definition^.options and poiocheck)=0) then
              begin
              begin
                 getlabel(iolabel);
                 getlabel(iolabel);
                 emitl(A_LABEL,iolabel);
                 emitl(A_LABEL,iolabel);
@@ -955,7 +956,15 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.14  1998-10-20 08:06:40  pierre
+  Revision 1.15  1998-10-21 15:12:50  pierre
+    * bug fix for IOCHECK inside a procedure with iocheck modifier
+    * removed the GPF for unexistant overloading
+      (firstcall was called with procedinition=nil !)
+    * changed typen to what Florian proposed
+      gentypenode(p : pdef) sets the typenodetype field
+      and resulttype is only set if inside bt_type block !
+
+  Revision 1.14  1998/10/20 08:06:40  pierre
     * several memory corruptions due to double freemem solved
     * several memory corruptions due to double freemem solved
       => never use p^.loc.location:=p^.left^.loc.location;
       => never use p^.loc.location:=p^.left^.loc.location;
     + finally I added now by default
     + finally I added now by default

+ 12 - 3
compiler/cg68kcal.pas

@@ -439,8 +439,9 @@ implementation
          { virtual methods too }
          { virtual methods too }
            ((p^.procdefinition^.options and povirtualmethod)=0) then
            ((p^.procdefinition^.options and povirtualmethod)=0) then
            begin
            begin
-              if ((p^.procdefinition^.options and poiocheck)<>0)
-                and (cs_check_io in aktlocalswitches) then
+              if ((p^.procdefinition^.options and poiocheck)<>0) and
+                 ((aktprocsym^.definition^.options and poiocheck)=0) and
+                 (cs_check_io in aktlocalswitches) then
                 begin
                 begin
                        getlabel(iolabel);
                        getlabel(iolabel);
                    emitl(A_LABEL,iolabel);
                    emitl(A_LABEL,iolabel);
@@ -1056,7 +1057,15 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.13  1998-10-20 08:06:45  pierre
+  Revision 1.14  1998-10-21 15:12:51  pierre
+    * bug fix for IOCHECK inside a procedure with iocheck modifier
+    * removed the GPF for unexistant overloading
+      (firstcall was called with procedinition=nil !)
+    * changed typen to what Florian proposed
+      gentypenode(p : pdef) sets the typenodetype field
+      and resulttype is only set if inside bt_type block !
+
+  Revision 1.13  1998/10/20 08:06:45  pierre
     * several memory corruptions due to double freemem solved
     * several memory corruptions due to double freemem solved
       => never use p^.loc.location:=p^.left^.loc.location;
       => never use p^.loc.location:=p^.left^.loc.location;
     + finally I added now by default
     + finally I added now by default

+ 11 - 2
compiler/cg68kinl.pas

@@ -117,7 +117,8 @@ implementation
 
 
         begin
         begin
            { I/O check }
            { I/O check }
-           if cs_check_io in aktlocalswitches then
+           if (cs_check_io in aktlocalswitches) and
+              ((aktprocsym^.definition^.options and poiocheck)=0) then
              begin
              begin
                 getlabel(iolabel);
                 getlabel(iolabel);
                 emitl(A_LABEL,iolabel);
                 emitl(A_LABEL,iolabel);
@@ -897,7 +898,15 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.11  1998-10-16 13:12:47  pierre
+  Revision 1.12  1998-10-21 15:12:53  pierre
+    * bug fix for IOCHECK inside a procedure with iocheck modifier
+    * removed the GPF for unexistant overloading
+      (firstcall was called with procedinition=nil !)
+    * changed typen to what Florian proposed
+      gentypenode(p : pdef) sets the typenodetype field
+      and resulttype is only set if inside bt_type block !
+
+  Revision 1.11  1998/10/16 13:12:47  pierre
     * added vmt_offsets in destructors code also !!!
     * added vmt_offsets in destructors code also !!!
     * vmt_offset code for m68k
     * vmt_offset code for m68k
 
 

+ 46 - 23
compiler/pexpr.pas

@@ -59,7 +59,7 @@ unit pexpr;
 {$endif}
 {$endif}
        ;
        ;
 
 
-    const allow_type : boolean = false;
+    const allow_type : boolean = true;
     
     
     function parse_paras(_colon,in_prop_paras : boolean) : ptree;
     function parse_paras(_colon,in_prop_paras : boolean) : ptree;
 
 
@@ -148,34 +148,40 @@ unit pexpr;
             begin
             begin
               consume(LKLAMMER);
               consume(LKLAMMER);
               in_args:=true;
               in_args:=true;
-              allow_type:=true;
+              {allow_type:=true;}
               p1:=comp_expr(true);
               p1:=comp_expr(true);
-              allow_type:=false;
+              {allow_type:=false;}
               consume(RKLAMMER);
               consume(RKLAMMER);
               pd:=voidpointerdef;
               pd:=voidpointerdef;
               if p1^.treetype=typen then
               if p1^.treetype=typen then
                begin
                begin
-                 if (p1^.resulttype=nil) then
+                 if (p1^.typenodetype=nil) then
                   begin
                   begin
                     Message(type_e_mismatch);
                     Message(type_e_mismatch);
                     statement_syssym:=genzeronode(errorn);
                     statement_syssym:=genzeronode(errorn);
                   end
                   end
                  else
                  else
-                  if p1^.resulttype^.deftype=objectdef then
-                   statement_syssym:=geninlinenode(in_typeof_x,false,p1)
+                  if p1^.typenodetype^.deftype=objectdef then
+                   begin
+                      { we can use resulttype in pass_2 (PM) }
+                      p1^.resulttype:=p1^.typenodetype;
+                      statement_syssym:=geninlinenode(in_typeof_x,false,p1);
+                   end
                  else
                  else
                   begin
                   begin
                     Message(type_e_mismatch);
                     Message(type_e_mismatch);
+                    disposetree(p1);
                     statement_syssym:=genzeronode(errorn);
                     statement_syssym:=genzeronode(errorn);
                   end;
                   end;
                end
                end
-              else
+              else { not a type node }
                begin
                begin
                  Must_be_valid:=false;
                  Must_be_valid:=false;
                  do_firstpass(p1);
                  do_firstpass(p1);
                  if (p1^.resulttype=nil) then
                  if (p1^.resulttype=nil) then
                   begin
                   begin
                     Message(type_e_mismatch);
                     Message(type_e_mismatch);
+                    disposetree(p1);
                     statement_syssym:=genzeronode(errorn)
                     statement_syssym:=genzeronode(errorn)
                   end
                   end
                  else
                  else
@@ -184,7 +190,8 @@ unit pexpr;
                  else
                  else
                   begin
                   begin
                     Message(type_e_mismatch);
                     Message(type_e_mismatch);
-                    statement_syssym:=genzeronode(errorn)
+                    statement_syssym:=genzeronode(errorn);
+                    disposetree(p1);
                   end;
                   end;
                end;
                end;
             end;
             end;
@@ -193,14 +200,14 @@ unit pexpr;
             begin
             begin
               consume(LKLAMMER);
               consume(LKLAMMER);
               in_args:=true;
               in_args:=true;
-              allow_type:=true;
+              {allow_type:=true;}
               p1:=comp_expr(true);
               p1:=comp_expr(true);
-              allow_type:=false;
+              {allow_type:=false; }
               consume(RKLAMMER);
               consume(RKLAMMER);
               pd:=s32bitdef;
               pd:=s32bitdef;
               if p1^.treetype=typen then
               if p1^.treetype=typen then
                begin
                begin
-                 statement_syssym:=genordinalconstnode(p1^.resulttype^.size,pd);
+                 statement_syssym:=genordinalconstnode(p1^.typenodetype^.size,pd);
                  { p1 not needed !}
                  { p1 not needed !}
                  disposetree(p1);
                  disposetree(p1);
                end
                end
@@ -279,10 +286,12 @@ unit pexpr;
             begin
             begin
               consume(LKLAMMER);
               consume(LKLAMMER);
               in_args:=true;
               in_args:=true;
-              allow_type:=true;
+              {allow_type:=true;}
               p1:=comp_expr(true);
               p1:=comp_expr(true);
-              allow_type:=false;
+              {allow_type:=false;}
               do_firstpass(p1);
               do_firstpass(p1);
+              if p1^.treetype=typen then
+                p1^.resulttype:=p1^.typenodetype;
               Must_be_valid:=false;
               Must_be_valid:=false;
               p2:=geninlinenode(l,false,p1);
               p2:=geninlinenode(l,false,p1);
               consume(RKLAMMER);
               consume(RKLAMMER);
@@ -883,7 +892,8 @@ unit pexpr;
                               { nothing else                   }
                               { nothing else                   }
                                if block_type=bt_type then
                                if block_type=bt_type then
                                 begin
                                 begin
-                                  p1:=genzeronode(typen);
+                                  p1:=gentypenode(pd);
+                                  { here we can also set resulttype !! }
                                   p1^.resulttype:=pd;
                                   p1^.resulttype:=pd;
                                   pd:=voiddef;
                                   pd:=voiddef;
                                 end
                                 end
@@ -907,7 +917,7 @@ unit pexpr;
                                        begin
                                        begin
                                          if procinfo._class^.isrelated(pobjectdef(pd)) then
                                          if procinfo._class^.isrelated(pobjectdef(pd)) then
                                           begin
                                           begin
-                                            p1:=genzeronode(typen);
+                                            p1:=gentypenode(pd);
                                             p1^.resulttype:=pd;
                                             p1^.resulttype:=pd;
                                             srsymtable:=pobjectdef(pd)^.publicsyms;
                                             srsymtable:=pobjectdef(pd)^.publicsyms;
                                             sym:=pvarsym(srsymtable^.search(pattern));
                                             sym:=pvarsym(srsymtable^.search(pattern));
@@ -940,7 +950,9 @@ unit pexpr;
                                          { TP allows also @TMenu.Load if Load is only }
                                          { TP allows also @TMenu.Load if Load is only }
                                          { defined in an anchestor class              }
                                          { defined in an anchestor class              }
                                          sym:=pvarsym(search_class_member(pobjectdef(pd),pattern));
                                          sym:=pvarsym(search_class_member(pobjectdef(pd),pattern));
-                                         if not(getaddr) and ((sym^.properties and sp_static)=0) then
+                                         if not assigned(sym) then
+                                           Message1(sym_e_id_no_member,pattern)
+                                         else if not(getaddr) and ((sym^.properties and sp_static)=0) then
                                            Message(sym_e_only_static_in_static)
                                            Message(sym_e_only_static_in_static)
                                          else
                                          else
                                           begin
                                           begin
@@ -955,7 +967,7 @@ unit pexpr;
                                        if (pd^.deftype=objectdef)
                                        if (pd^.deftype=objectdef)
                                          and ((pobjectdef(pd)^.options and oo_is_class)<>0) then
                                          and ((pobjectdef(pd)^.options and oo_is_class)<>0) then
                                          begin
                                          begin
-                                            p1:=genzeronode(typen);
+                                            p1:=gentypenode(pd);
                                             p1^.resulttype:=pd;
                                             p1^.resulttype:=pd;
                                             pd:=new(pclassrefdef,init(pd));
                                             pd:=new(pclassrefdef,init(pd));
                                             p1:=gensinglenode(loadvmtn,p1);
                                             p1:=gensinglenode(loadvmtn,p1);
@@ -967,8 +979,9 @@ unit pexpr;
                                             { (for typeof etc)     }
                                             { (for typeof etc)     }
                                             if allow_type then
                                             if allow_type then
                                               begin
                                               begin
-                                                 p1:=genzeronode(typen);
-                                                 p1^.resulttype:=pd;
+                                                 p1:=gentypenode(pd);
+                                                 { here we must use typenodetype explicitly !! PM
+                                                 p1^.resulttype:=pd; }
                                                  pd:=voiddef;
                                                  pd:=voiddef;
                                               end
                                               end
                                             else
                                             else
@@ -1394,17 +1407,19 @@ unit pexpr;
         _NEW : begin
         _NEW : begin
                  consume(_NEW);
                  consume(_NEW);
                  consume(LKLAMMER);
                  consume(LKLAMMER);
-                 allow_type:=true;
+                 {allow_type:=true;}
                  p1:=factor(false);
                  p1:=factor(false);
-                 allow_type:=false;
+                 {allow_type:=false;}
                  if p1^.treetype<>typen then
                  if p1^.treetype<>typen then
                   begin
                   begin
                     Message(type_e_type_id_expected);
                     Message(type_e_type_id_expected);
+                    disposetree(p1);
                     pd:=generrordef;
                     pd:=generrordef;
                   end
                   end
                  else
                  else
-                  pd:=p1^.resulttype;
+                  pd:=p1^.typenodetype;
                  pd2:=pd;
                  pd2:=pd;
+                 
                  if (pd^.deftype<>pointerdef) or
                  if (pd^.deftype<>pointerdef) or
                     (ppointerdef(pd)^.definition^.deftype<>objectdef) then
                     (ppointerdef(pd)^.definition^.deftype<>objectdef) then
                   begin
                   begin
@@ -1898,7 +1913,15 @@ unit pexpr;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.69  1998-10-20 15:10:19  pierre
+  Revision 1.70  1998-10-21 15:12:54  pierre
+    * bug fix for IOCHECK inside a procedure with iocheck modifier
+    * removed the GPF for unexistant overloading
+      (firstcall was called with procedinition=nil !)
+    * changed typen to what Florian proposed
+      gentypenode(p : pdef) sets the typenodetype field
+      and resulttype is only set if inside bt_type block !
+
+  Revision 1.69  1998/10/20 15:10:19  pierre
     * type ptree only allowed inside expression
     * type ptree only allowed inside expression
       if following sizeof typeof low high or as first arg of new !!
       if following sizeof typeof low high or as first arg of new !!
 
 

+ 24 - 10
compiler/tcadd.pas

@@ -151,16 +151,22 @@ implementation
               end;
               end;
               { we have to convert p^.left and p^.right into
               { we have to convert p^.left and p^.right into
                callparanodes }
                callparanodes }
-              t^.left:=gencallparanode(p^.left,nil);
-              t^.left:=gencallparanode(p^.right,t^.left);
               if t^.symtableprocentry=nil then
               if t^.symtableprocentry=nil then
-               CGMessage(parser_e_operator_not_overloaded);
-              if p^.treetype=unequaln then
-               t:=gensinglenode(notn,t);
-              firstpass(t);
-              putnode(p);
-              p:=t;
-              exit;
+                begin
+                   CGMessage(parser_e_operator_not_overloaded);
+                   putnode(t);
+                end
+              else
+                begin
+                   t^.left:=gencallparanode(p^.left,nil);
+                   t^.left:=gencallparanode(p^.right,t^.left);
+                   if p^.treetype=unequaln then
+                    t:=gensinglenode(notn,t);
+                   firstpass(t);
+                   putnode(p);
+                   p:=t;
+                   exit;
+                end;
            end;
            end;
          no_overload:
          no_overload:
          { compact consts }
          { compact consts }
@@ -939,7 +945,15 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.6  1998-10-20 15:09:24  florian
+  Revision 1.7  1998-10-21 15:12:57  pierre
+    * bug fix for IOCHECK inside a procedure with iocheck modifier
+    * removed the GPF for unexistant overloading
+      (firstcall was called with procedinition=nil !)
+    * changed typen to what Florian proposed
+      gentypenode(p : pdef) sets the typenodetype field
+      and resulttype is only set if inside bt_type block !
+
+  Revision 1.6  1998/10/20 15:09:24  florian
     + binary operators for ansi strings
     + binary operators for ansi strings
 
 
   Revision 1.5  1998/10/20 08:07:05  pierre
   Revision 1.5  1998/10/20 08:07:05  pierre

+ 14 - 2
compiler/tccnv.pas

@@ -556,7 +556,11 @@ implementation
        { if explicite type cast, then run firstpass }
        { if explicite type cast, then run firstpass }
        if p^.explizit then
        if p^.explizit then
          firstpass(p^.left);
          firstpass(p^.left);
-
+       if (p^.left^.treetype=typen) and (p^.left^.resulttype=generrordef) then
+         begin
+            codegenerror:=true;
+            Message(parser_e_no_type_not_allowed_here);
+         end;
        if codegenerror then
        if codegenerror then
          begin
          begin
            p^.resulttype:=generrordef;
            p^.resulttype:=generrordef;
@@ -903,7 +907,15 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.5  1998-10-07 10:38:55  peter
+  Revision 1.6  1998-10-21 15:12:58  pierre
+    * bug fix for IOCHECK inside a procedure with iocheck modifier
+    * removed the GPF for unexistant overloading
+      (firstcall was called with procedinition=nil !)
+    * changed typen to what Florian proposed
+      gentypenode(p : pdef) sets the typenodetype field
+      and resulttype is only set if inside bt_type block !
+
+  Revision 1.5  1998/10/07 10:38:55  peter
     * forgot a firstpass in arrayconstruct2set
     * forgot a firstpass in arrayconstruct2set
 
 
   Revision 1.4  1998/10/05 21:33:32  peter
   Revision 1.4  1998/10/05 21:33:32  peter

+ 32 - 1
compiler/tree.pas

@@ -221,6 +221,7 @@ unit tree;
              stringconstn : (value_str : pstring; lab_str:plabel;stringtype : tstringtype);
              stringconstn : (value_str : pstring; lab_str:plabel;stringtype : tstringtype);
 {$endif UseAnsiString}
 {$endif UseAnsiString}
              typeconvn : (convtyp : tconverttype;explizit : boolean);
              typeconvn : (convtyp : tconverttype;explizit : boolean);
+             typen : (typenodetype : pdef);
              inlinen : (inlinenumber : longint;inlineconst:boolean);
              inlinen : (inlinenumber : longint;inlineconst:boolean);
              procinlinen : (inlineprocdef : pprocdef;
              procinlinen : (inlineprocdef : pprocdef;
                             retoffset,para_offset,para_size : longint);
                             retoffset,para_offset,para_size : longint);
@@ -242,6 +243,7 @@ unit tree;
     function genordinalconstnode(v : longint;def : pdef) : ptree;
     function genordinalconstnode(v : longint;def : pdef) : ptree;
     function genfixconstnode(v : longint;def : pdef) : ptree;
     function genfixconstnode(v : longint;def : pdef) : ptree;
     function gentypeconvnode(node : ptree;t : pdef) : ptree;
     function gentypeconvnode(node : ptree;t : pdef) : ptree;
+    function gentypenode(t : pdef) : ptree;
     function gencallparanode(expr,next : ptree) : ptree;
     function gencallparanode(expr,next : ptree) : ptree;
     function genrealconstnode(v : bestreal) : ptree;
     function genrealconstnode(v : bestreal) : ptree;
     function gencallnode(v : pprocsym;st : psymtable) : ptree;
     function gencallnode(v : pprocsym;st : psymtable) : ptree;
@@ -973,6 +975,27 @@ unit tree;
          gentypeconvnode:=p;
          gentypeconvnode:=p;
       end;
       end;
 
 
+    function gentypenode(t : pdef) : ptree;
+
+      var
+         p : ptree;
+
+      begin
+         p:=getnode;
+         p^.disposetyp:=dt_nothing;
+         p^.treetype:=typen;
+         p^.registers32:=0;
+{         p^.registers16:=0;
+         p^.registers8:=0; }
+         p^.registersfpu:=0;
+{$ifdef SUPPORT_MMX}
+         p^.registersmmx:=0;
+{$endif SUPPORT_MMX}
+         p^.resulttype:=generrordef;
+         p^.typenodetype:=t;
+         gentypenode:=p;
+      end;
+
     function gencallnode(v : pprocsym;st : psymtable) : ptree;
     function gencallnode(v : pprocsym;st : psymtable) : ptree;
 
 
       var
       var
@@ -1620,7 +1643,15 @@ unit tree;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.47  1998-10-20 08:07:07  pierre
+  Revision 1.48  1998-10-21 15:12:59  pierre
+    * bug fix for IOCHECK inside a procedure with iocheck modifier
+    * removed the GPF for unexistant overloading
+      (firstcall was called with procedinition=nil !)
+    * changed typen to what Florian proposed
+      gentypenode(p : pdef) sets the typenodetype field
+      and resulttype is only set if inside bt_type block !
+
+  Revision 1.47  1998/10/20 08:07:07  pierre
     * several memory corruptions due to double freemem solved
     * several memory corruptions due to double freemem solved
       => never use p^.loc.location:=p^.left^.loc.location;
       => never use p^.loc.location:=p^.left^.loc.location;
     + finally I added now by default
     + finally I added now by default