Przeglądaj źródła

* fixed ptr() with constants

peter 27 lat temu
rodzic
commit
5e21e1981a
3 zmienionych plików z 39 dodań i 19 usunięć
  1. 27 16
      compiler/tcinl.pas
  2. 6 2
      compiler/tree.pas
  3. 6 1
      compiler/types.pas

+ 27 - 16
compiler/tcinl.pas

@@ -50,7 +50,7 @@ implementation
 
     procedure firstinline(var p : ptree);
       var
-         vl      : longint;
+         vl,vl2  : longint;
          vr      : bestreal;
          hp,hpp  : ptree;
          store_count_ref,
@@ -128,19 +128,27 @@ implementation
             else
             { process constant expression with parameter }
              begin
-               if not(p^.left^.treetype in [realconstn,ordconstn]) then
-                begin
-                  CGMessage(cg_e_illegal_expression);
-                  vl:=0;
-                  vr:=0;
-                  isreal:=false;
-                end
-               else
-                begin
-                  isreal:=(p^.left^.treetype=realconstn);
-                  vl:=p^.left^.value;
-                  vr:=p^.left^.value_real;
-                end;
+               vl:=0;
+               vl2:=0; { second parameter Ex: ptr(vl,vl2) }
+               vr:=0;
+               isreal:=false;
+               case p^.left^.treetype of
+                 realconstn :
+                   begin
+                     isreal:=true;
+                     vr:=p^.left^.value_real;
+                   end;
+                 ordconstn :
+                   vl:=p^.left^.value;
+                 callparan :
+                   begin
+                     { both exists, else it was not generated }
+                     vl:=p^.left^.left^.value;
+                     vl2:=p^.left^.right^.left^.value;
+                   end;
+                 else
+                   CGMessage(cg_e_illegal_expression);
+               end;
                case p^.inlinenumber of
          in_const_trunc : begin
                             if isreal then
@@ -200,7 +208,7 @@ implementation
                             if isreal then
                              CGMessage(type_e_mismatch)
                             else
-                             hp:=genordinalconstnode(vl,voidpointerdef);
+                             hp:=genordinalconstnode((vl2 shl 16) or vl,voidpointerdef);
                           end;
           in_const_sqrt : begin
                             if isreal then
@@ -854,7 +862,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  1998-11-05 12:03:05  peter
+  Revision 1.7  1998-11-13 10:15:52  peter
+    * fixed ptr() with constants
+
+  Revision 1.6  1998/11/05 12:03:05  peter
     * released useansistring
     * removed -Sv, its now available in fpc modes
 

+ 6 - 2
compiler/tree.pas

@@ -694,7 +694,8 @@ unit tree;
 {$endif SUPPORT_MMX}
          p^.resulttype:=def;
          p^.value:=v;
-         testrange(p^.resulttype,p^.value);
+         if p^.resulttype^.deftype=orddef then
+          testrange(p^.resulttype,p^.value);
          genordinalconstnode:=p;
       end;
 
@@ -1602,7 +1603,10 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.50  1998-11-10 10:09:20  peter
+  Revision 1.51  1998-11-13 10:15:53  peter
+    * fixed ptr() with constants
+
+  Revision 1.50  1998/11/10 10:09:20  peter
     * va_list -> array of const
 
   Revision 1.49  1998/11/05 12:03:07  peter

+ 6 - 1
compiler/types.pas

@@ -408,6 +408,8 @@ unit types;
                     l:=penumdef(def)^.min;
                     h:=penumdef(def)^.max;
                   end;
+        else
+          internalerror(987);
         end;
       end;
 
@@ -993,7 +995,10 @@ unit types;
 end.
 {
   $Log$
-  Revision 1.36  1998-11-10 10:09:21  peter
+  Revision 1.37  1998-11-13 10:15:50  peter
+    * fixed ptr() with constants
+
+  Revision 1.36  1998/11/10 10:09:21  peter
     * va_list -> array of const
 
   Revision 1.35  1998/10/19 08:55:13  pierre