Browse Source

* more constant expression evaluators

peter 27 years ago
parent
commit
1db43eef4d
3 changed files with 105 additions and 20 deletions
  1. 15 5
      compiler/innr.inc
  2. 18 7
      compiler/tccal.pas
  3. 72 8
      compiler/tcinl.pas

+ 15 - 5
compiler/innr.inc

@@ -63,14 +63,24 @@ const
    in_const_ptr        = 107;
    in_const_swap_word  = 108;
    in_const_swap_long  = 109;
-
+   in_const_pi         = 110;
+   in_const_sqrt       = 111;
+   in_const_arctan     = 112;
+   in_const_cos        = 113;
+   in_const_exp        = 114;
+   in_const_ln         = 115;
+   in_const_sin        = 116;
 {
   $Log$
-  Revision 1.8  1998-09-14 10:44:07  peter
-    * all internal RTL functions start with FPC_
+  Revision 1.9  1998-10-02 09:24:20  peter
+    * more constant expression evaluators
+
+  Revision 1.4  1998/09/14 10:48:17  peter
+    * FPC_ names
+    * Heap manager is now system independent
 
-  Revision 1.7  1998/09/01 17:39:46  peter
-    + internal constant functions
+  Revision 1.3  1998/09/01 17:36:19  peter
+    + internconst
 
 }
 

+ 18 - 7
compiler/tccal.pas

@@ -718,17 +718,25 @@ implementation
                end;{ end of procedure to call determination }
 
               is_const:=((p^.procdefinition^.options and pointernconst)<>0) and
-                         (p^.left^.left^.treetype in [realconstn,ordconstn]);
+                        ((block_type=bt_const) or
+                         (assigned(p^.left) and (p^.left^.left^.treetype in [realconstn,ordconstn])));
               { handle predefined procedures }
               if ((p^.procdefinition^.options and pointernproc)<>0) or is_const then
                 begin
-                   { settextbuf needs two args }
-                   if assigned(p^.left^.right) then
-                     pt:=geninlinenode(pprocdef(p^.procdefinition)^.extnumber,is_const,p^.left)
+                   if assigned(p^.left) then
+                     begin
+                     { settextbuf needs two args }
+                       if assigned(p^.left^.right) then
+                         pt:=geninlinenode(pprocdef(p^.procdefinition)^.extnumber,is_const,p^.left)
+                       else
+                         begin
+                           pt:=geninlinenode(pprocdef(p^.procdefinition)^.extnumber,is_const,p^.left^.left);
+                           putnode(p^.left);
+                         end;
+                     end
                    else
                      begin
-                        pt:=geninlinenode(pprocdef(p^.procdefinition)^.extnumber,is_const,p^.left^.left);
-                        putnode(p^.left);
+                       pt:=geninlinenode(pprocdef(p^.procdefinition)^.extnumber,is_const,nil);
                      end;
                    putnode(p);
                    firstpass(pt);
@@ -913,7 +921,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.5  1998-09-28 11:22:17  pierre
+  Revision 1.6  1998-10-02 09:24:22  peter
+    * more constant expression evaluators
+
+  Revision 1.5  1998/09/28 11:22:17  pierre
    * did not compile for browser
    * merge from fixes
 

+ 72 - 8
compiler/tcinl.pas

@@ -114,10 +114,34 @@ implementation
          { handle intern constant functions in separate case }
          if p^.inlineconst then
           begin
-            isreal:=(p^.left^.treetype=realconstn);
-            vl:=p^.left^.value;
-            vr:=p^.left^.value_real;
-            case p^.inlinenumber of
+            { no parameters? }
+            if not assigned(p^.left) then
+             begin
+               case p^.inlinenumber of
+            in_const_pi : begin
+                            hp:=genrealconstnode(pi);
+                          end;
+               else
+                 internalerror(89);
+               end;
+             end
+            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;
+               case p^.inlinenumber of
          in_const_trunc : begin
                             if isreal then
                              hp:=genordinalconstnode(trunc(vr),s32bitdef)
@@ -178,9 +202,46 @@ implementation
                             else
                              hp:=genordinalconstnode(vl,voidpointerdef);
                           end;
-            else
-              internalerror(88);
-            end;
+          in_const_sqrt : begin
+                            if isreal then
+                             hp:=genrealconstnode(sqrt(vr))
+                            else
+                             hp:=genrealconstnode(sqrt(vl));
+                          end;
+        in_const_arctan : begin
+                            if isreal then
+                             hp:=genrealconstnode(arctan(vr))
+                            else
+                             hp:=genrealconstnode(arctan(vl));
+                          end;
+           in_const_cos : begin
+                            if isreal then
+                             hp:=genrealconstnode(cos(vr))
+                            else
+                             hp:=genrealconstnode(cos(vl));
+                          end;
+           in_const_sin : begin
+                            if isreal then
+                             hp:=genrealconstnode(sin(vr))
+                            else
+                             hp:=genrealconstnode(sin(vl));
+                          end;
+           in_const_exp : begin
+                            if isreal then
+                             hp:=genrealconstnode(exp(vr))
+                            else
+                             hp:=genrealconstnode(exp(vl));
+                          end;
+            in_const_ln : begin
+                            if isreal then
+                             hp:=genrealconstnode(ln(vr))
+                            else
+                             hp:=genrealconstnode(ln(vl));
+                          end;
+               else
+                 internalerror(88);
+               end;
+             end;
             disposetree(p);
             firstpass(hp);
             p:=hp;
@@ -760,7 +821,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.1  1998-09-23 20:42:24  peter
+  Revision 1.2  1998-10-02 09:24:23  peter
+    * more constant expression evaluators
+
+  Revision 1.1  1998/09/23 20:42:24  peter
     * splitted pass_1
 
 }