Browse Source

* some Delphi incompatibilities fixed:
- out, dispose and new can be used as idenfiers now
- const p = apointerype(nil); is supported now
+ support for const p = apointertype(pointer(1234)); added

florian 24 years ago
parent
commit
3c5793d8c6
6 changed files with 120 additions and 58 deletions
  1. 36 11
      compiler/ncnv.pas
  2. 8 2
      compiler/pdecobj.pas
  3. 12 3
      compiler/pdecsub.pas
  4. 23 15
      compiler/pexpr.pas
  5. 32 24
      compiler/pstatmnt.pas
  6. 9 3
      compiler/tokens.pas

+ 36 - 11
compiler/ncnv.pas

@@ -712,15 +712,15 @@ implementation
                    end;
                    end;
                 end
                 end
 
 
-              { nil to ordinal node }
-              else if is_ordinal(resulttype.def) and
-                (left.nodetype=niln) then
-                begin
-                   hp:=cordconstnode.create(0,resulttype);
-                   resulttypepass(hp);
-                   result:=hp;
-                   exit;
-                end
+               { nil to ordinal node }
+               else if (left.nodetype=niln) and is_ordinal(resulttype.def) then
+                  begin
+                     hp:=cordconstnode.create(0,resulttype);
+                     resulttypepass(hp);
+                     result:=hp;
+                     exit;
+                  end
+
               { constant pointer to ordinal }
               { constant pointer to ordinal }
               else if is_ordinal(resulttype.def) and
               else if is_ordinal(resulttype.def) and
                 (left.nodetype=pointerconstn) then
                 (left.nodetype=pointerconstn) then
@@ -750,7 +750,7 @@ implementation
                     end;
                     end;
                  end
                  end
 
 
-              { Are we char to ordinal }
+              { char to ordinal }
               else
               else
                 if is_char(left.resulttype.def) and
                 if is_char(left.resulttype.def) and
                    is_ordinal(resulttype.def) then
                    is_ordinal(resulttype.def) then
@@ -827,6 +827,25 @@ implementation
              exit;
              exit;
           end;
           end;
 
 
+        { fold nil to any pointer type }
+        if (left.nodetype=niln) and (resulttype.def.deftype=pointerdef) then
+          begin
+             hp:=cnilnode.create;
+             hp.resulttype:=resulttype;
+             resulttypepass(hp);
+             result:=hp;
+             exit;
+          end;
+
+        { further, pointerconstn to any pointer is folded too }
+        if (left.nodetype=pointerconstn) and (resulttype.def.deftype=pointerdef) then
+          begin
+             left.resulttype:=resulttype;
+             result:=left;
+             left:=nil;
+             exit;
+          end;
+
         { now call the resulttype helper to do constant folding }
         { now call the resulttype helper to do constant folding }
         result:=resulttype_call_helper(convtype);
         result:=resulttype_call_helper(convtype);
       end;
       end;
@@ -1272,7 +1291,13 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.25  2001-04-13 22:20:58  peter
+  Revision 1.26  2001-05-04 15:52:03  florian
+    * some Delphi incompatibilities fixed:
+       - out, dispose and new can be used as idenfiers now
+       - const p = apointerype(nil); is supported now
+    + support for const p = apointertype(pointer(1234)); added
+
+  Revision 1.25  2001/04/13 22:20:58  peter
     * remove wrongly placed first_call_helper
     * remove wrongly placed first_call_helper
 
 
   Revision 1.24  2001/04/13 01:22:08  peter
   Revision 1.24  2001/04/13 01:22:08  peter

+ 8 - 2
compiler/pdecobj.pas

@@ -152,7 +152,7 @@ implementation
                             consume(_CONST);
                             consume(_CONST);
                             varspez:=vs_const;
                             varspez:=vs_const;
                          end
                          end
-                       else if token=_OUT then
+                       else if (idtoken=_OUT) and (m_out in aktmodeswitches) then
                          begin
                          begin
                             consume(_OUT);
                             consume(_OUT);
                             varspez:=vs_out;
                             varspez:=vs_out;
@@ -1039,7 +1039,13 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.24  2001-04-21 15:36:00  peter
+  Revision 1.25  2001-05-04 15:52:03  florian
+    * some Delphi incompatibilities fixed:
+       - out, dispose and new can be used as idenfiers now
+       - const p = apointerype(nil); is supported now
+    + support for const p = apointertype(pointer(1234)); added
+
+  Revision 1.24  2001/04/21 15:36:00  peter
     * check for type block when parsing class of
     * check for type block when parsing class of
 
 
   Revision 1.23  2001/04/21 13:37:16  peter
   Revision 1.23  2001/04/21 13:37:16  peter

+ 12 - 3
compiler/pdecsub.pas

@@ -125,8 +125,11 @@ implementation
             if try_to_consume(_CONST) then
             if try_to_consume(_CONST) then
               varspez:=vs_const
               varspez:=vs_const
           else
           else
-            if try_to_consume(_OUT) then
-              varspez:=vs_out
+            if (idtoken=_OUT) and (m_out in aktmodeswitches) then
+              begin
+                 consume(_OUT);
+                 varspez:=vs_out
+              end
           else
           else
               varspez:=vs_value;
               varspez:=vs_value;
           inserthigh:=false;
           inserthigh:=false;
@@ -1847,7 +1850,13 @@ const
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.21  2001-04-18 22:01:57  peter
+  Revision 1.22  2001-05-04 15:52:03  florian
+    * some Delphi incompatibilities fixed:
+       - out, dispose and new can be used as idenfiers now
+       - const p = apointerype(nil); is supported now
+    + support for const p = apointertype(pointer(1234)); added
+
+  Revision 1.21  2001/04/18 22:01:57  peter
     * registration of targets and assemblers
     * registration of targets and assemblers
 
 
   Revision 1.20  2001/04/13 20:05:16  peter
   Revision 1.20  2001/04/13 20:05:16  peter

+ 23 - 15
compiler/pexpr.pas

@@ -1676,19 +1676,7 @@ implementation
         again:=false;
         again:=false;
         if token=_ID then
         if token=_ID then
          begin
          begin
-           factor_read_id(p1,again);
-
-           if again then
-            begin
-              check_tokenpos;
-
-              { handle post fix operators }
-              postfixoperators(p1,again);
-            end;
-         end
-        else
-         case token of
-           _NEW :
+           if idtoken=_NEW then
              begin
              begin
                consume(_NEW);
                consume(_NEW);
                consume(_LKLAMMER);
                consume(_LKLAMMER);
@@ -1761,8 +1749,22 @@ implementation
                    consume(_RKLAMMER);
                    consume(_RKLAMMER);
                  end;
                  end;
                postfixoperators(p1,again);
                postfixoperators(p1,again);
-             end;
+             end
+           else
+             begin
+                factor_read_id(p1,again);
 
 
+                if again then
+                  begin
+                     check_tokenpos;
+
+                     { handle post fix operators }
+                     postfixoperators(p1,again);
+                  end;
+             end;
+         end
+        else
+         case token of
            _SELF :
            _SELF :
              begin
              begin
                again:=true;
                again:=true;
@@ -2320,7 +2322,13 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.30  2001-04-14 14:07:10  peter
+  Revision 1.31  2001-05-04 15:52:03  florian
+    * some Delphi incompatibilities fixed:
+       - out, dispose and new can be used as idenfiers now
+       - const p = apointerype(nil); is supported now
+    + support for const p = apointertype(pointer(1234)); added
+
+  Revision 1.30  2001/04/14 14:07:10  peter
     * moved more code from pass_1 to det_resulttype
     * moved more code from pass_1 to det_resulttype
 
 
   Revision 1.29  2001/04/13 23:50:24  peter
   Revision 1.29  2001/04/13 23:50:24  peter

+ 32 - 24
compiler/pstatmnt.pas

@@ -1043,9 +1043,6 @@ implementation
              code:=while_statement;
              code:=while_statement;
            _FOR :
            _FOR :
              code:=for_statement;
              code:=for_statement;
-           _NEW,
-           _DISPOSE :
-             code:=new_dispose_statement;
            _WITH :
            _WITH :
              code:=with_statement;
              code:=with_statement;
            _TRY :
            _TRY :
@@ -1073,28 +1070,33 @@ implementation
              Message(scan_f_end_of_file);
              Message(scan_f_end_of_file);
          else
          else
            begin
            begin
-              p:=expr;
+              if (idtoken=_NEW) or (idtoken=_DISPOSE) then
+                code:=new_dispose_statement
+              else
+                begin
+                   p:=expr;
 
 
-              if p.nodetype=labeln then
-               begin
-                 { the pointer to the following instruction }
-                 { isn't a very clean way                   }
-                 tlabelnode(p).left:=statement{$ifdef FPCPROCVAR}(){$endif};
-                 { be sure to have left also resulttypepass }
-                 resulttypepass(tlabelnode(p).left);
-               end;
+                   if p.nodetype=labeln then
+                    begin
+                      { the pointer to the following instruction }
+                      { isn't a very clean way                   }
+                      tlabelnode(p).left:=statement{$ifdef FPCPROCVAR}(){$endif};
+                      { be sure to have left also resulttypepass }
+                      resulttypepass(tlabelnode(p).left);
+                    end;
 
 
-              if not(p.nodetype in [calln,assignn,breakn,inlinen,continuen,labeln]) then
-                Message(cg_e_illegal_expression);
-              { specify that we don't use the value returned by the call }
-              { Question : can this be also improtant
-                for inlinen ??
-                it is used for :
-                 - dispose of temp stack space
-                 - dispose on FPU stack }
-              if p.nodetype=calln then
-                exclude(p.flags,nf_return_value_used);
-              code:=p;
+                   if not(p.nodetype in [calln,assignn,breakn,inlinen,continuen,labeln]) then
+                     Message(cg_e_illegal_expression);
+                   { specify that we don't use the value returned by the call }
+                   { Question : can this be also improtant
+                     for inlinen ??
+                     it is used for :
+                      - dispose of temp stack space
+                      - dispose on FPU stack }
+                   if p.nodetype=calln then
+                     exclude(p.flags,nf_return_value_used);
+                   code:=p;
+                end;
            end;
            end;
          end;
          end;
          if assigned(code) then
          if assigned(code) then
@@ -1220,7 +1222,13 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.28  2001-04-21 12:03:11  peter
+  Revision 1.29  2001-05-04 15:52:04  florian
+    * some Delphi incompatibilities fixed:
+       - out, dispose and new can be used as idenfiers now
+       - const p = apointerype(nil); is supported now
+    + support for const p = apointertype(pointer(1234)); added
+
+  Revision 1.28  2001/04/21 12:03:11  peter
     * m68k updates merged from fixes branch
     * m68k updates merged from fixes branch
 
 
   Revision 1.27  2001/04/18 22:01:57  peter
   Revision 1.27  2001/04/18 22:01:57  peter

+ 9 - 3
compiler/tokens.pas

@@ -319,10 +319,10 @@ const
       (str:'FAR'           ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'FAR'           ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'FOR'           ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'FOR'           ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'MOD'           ;special:false;keyword:m_all;op:_OP_MOD),
       (str:'MOD'           ;special:false;keyword:m_all;op:_OP_MOD),
-      (str:'NEW'           ;special:false;keyword:m_all;op:NOTOKEN),
+      (str:'NEW'           ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'NIL'           ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'NIL'           ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'NOT'           ;special:false;keyword:m_all;op:_OP_NOT),
       (str:'NOT'           ;special:false;keyword:m_all;op:_OP_NOT),
-      (str:'OUT'           ;special:false;keyword:m_out;op:NOTOKEN),
+      (str:'OUT'           ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'SET'           ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'SET'           ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'SHL'           ;special:false;keyword:m_all;op:_OP_SHL),
       (str:'SHL'           ;special:false;keyword:m_all;op:_OP_SHL),
       (str:'SHR'           ;special:false;keyword:m_all;op:_OP_SHR),
       (str:'SHR'           ;special:false;keyword:m_all;op:_OP_SHR),
@@ -478,7 +478,13 @@ end;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.8  2001-03-22 22:35:43  florian
+  Revision 1.9  2001-05-04 15:52:04  florian
+    * some Delphi incompatibilities fixed:
+       - out, dispose and new can be used as idenfiers now
+       - const p = apointerype(nil); is supported now
+    + support for const p = apointertype(pointer(1234)); added
+
+  Revision 1.8  2001/03/22 22:35:43  florian
     + support for type a = (a=1); in Delphi mode added
     + support for type a = (a=1); in Delphi mode added
     + procedure p(); in Delphi mode supported
     + procedure p(); in Delphi mode supported
     + on isn't keyword anymore, it can be used as
     + on isn't keyword anymore, it can be used as