* removed a lot of errors

compiler/ncal.pas

@@ -2,7 +2,6 @@
     $Id$
     Copyright (c) 1998-2000 by Florian Klaempfl
 
-    Type checking and register allocation for add nodes
 
     This program is free software; you can redistribute it and/or modify
     it under the terms of the GNU General Public License as published by
@@ -37,16 +36,57 @@ unit ncal;
           { the definition of the procedure to call }
           procdefinition : pabstractprocdef;
           methodpointer : tnode;
-          constructor create(v : pprocsym;st : psymtable);
+          { only the processor specific nodes need to override this }
+          { constructor                                             }
+          constructor create(v : pprocsym;st : psymtable);virtual;
        end;
 
+       tcallparanode = class(tbinarynode)
+          hightree : tnode;
+          { only the processor specific nodes need to override this }
+          { constructor                                             }
+          constructor create(expr,next : tnode);virtual;
+          destructor destroy;override;
+       end;
+
+    function gencallparanode(expr,next : tnode) : tnode;
     function gencallnode(v : pprocsym;st : psymtable) : tnode;
 
     var
        ccallnode : class of tcallnode;
+       ccallparanode : class of tcallparanode;
 
   implementation
 
+{****************************************************************************
+                             TCALLPARANODE
+ ****************************************************************************}
+
+    function gencallparanode(expr,next : tnode) : tnode;
+
+      begin
+         gencallparanode:=ccallparanode.create(expr,next);
+      end;
+
+    constructor tcallparanode.create(expr,next : tnode);
+
+      begin
+         inherited create(callparan,expr,next);
+         hightree:=nil;
+         expr.set_file_line(self);
+      end;
+
+    destructor tcallparanode.destroy;
+
+      begin
+         hightree.free;
+         inherited destroy;
+      end;
+
+{****************************************************************************
+                                 TCALLNODE
+ ****************************************************************************}
+
     function gencallnode(v : pprocsym;st : psymtable) : tnode;
 
       begin
@@ -66,10 +106,14 @@ unit ncal;
 
 begin
    ccallnode:=tcallnode;
+   ccallparanode:=tcallparanode;
 end.
 {
   $Log$
-  Revision 1.1  2000-09-20 20:52:16  florian
+  Revision 1.2  2000-09-20 21:52:38  florian
+    * removed a lot of errors
+
+  Revision 1.1  2000/09/20 20:52:16  florian
     * initial revision
 
 }

compiler/node.inc

@@ -25,11 +25,11 @@
                                  TNODE
  ****************************************************************************}
 
-    constructor tnode.init(tt : tnodetype);
+    constructor tnode.create(tt : tnodetype);
 
       begin
-         inherited init;
-         treetype:=tt;
+         inherited create;
+         nodetype:=tt;
          { this allows easier error tracing }
          location.loc:=LOC_INVALID;
          { save local info }
@@ -44,7 +44,7 @@
          flags:=[];
       end;
 
-    destructor tnode.done;
+    destructor tnode.destroy;
 
       begin
          { reference info }
@@ -57,7 +57,7 @@
 {$endif EXTDEBUG}
       end;
 
-    procedure tnode.pass_1;
+    function tnode.pass_1 : tnode;
 
       begin
          if not(assigned(resulttype)) then
@@ -66,36 +66,19 @@
          det_temp;
       end;
 
-    procedure tnode.det_resulttype;
-
-      begin
-         abstract;
-      end;
-
-    procedure tnode.det_temp;
-
-      begin
-         abstract;
-      end;
-
-    procedure tnode.secondpass;
-
-      begin
-         abstract;
-      end;
-
     procedure tnode.concattolist(l : plinkedlist);
 
       begin
-         l^.concat(@self);
+{$ifdef newcg}
+         l^.concat(self);
+{$endif newcg}
       end;
 
-    function tnode.ischild(p : pnode) : boolean;
+    function tnode.ischild(p : tnode) : boolean;
 
       begin
          ischild:=false;
       end;
-
 {$ifdef EXTDEBUG}
     procedure tnode.dowrite;
 
@@ -186,36 +169,49 @@
       end;
 {$endif EXTDEBUG}
 
-    function tnode.isequal(p : node) : boolean;
+    function tnode.isequal(p : tnode) : boolean;
 
       begin
-         isequal:=assigned(p) and (p^.nodetype=nodetype) and
-           (flags*flagsequal=p^.flags*flagsequal) and
+         isequal:=assigned(p) and (p.nodetype=nodetype) and
+           (flags*flagsequal=p.flags*flagsequal) and
            docompare(p);
       end;
 
-    function tnode.docompare(p : pnode) : boolean;
+    function tnode.docompare(p : tnode) : boolean;
 
       begin
          docompare:=true;
       end;
 
+    procedure tnode.set_file_line(from : tnode);
+
+      begin
+         if assigned(from) then
+           fileinfo:=from.fileinfo;
+      end;
+
+    procedure tnode.set_tree_filepos(const filepos : tfileposinfo);
+
+      begin
+         fileinfo:=filepos;
+      end;
+
 {****************************************************************************
                                  TUNARYNODE
  ****************************************************************************}
 
-    constructor tunarynode.init(tt : tnodetype;l : pnode);
+    constructor tunarynode.create(tt : tnodetype;l : tnode);
 
       begin
-         inherited init(tt);
+         inherited create(tt);
          left:=l;
       end;
 
-    function tunarynode.docompare(p : pnode) : boolean;
+    function tunarynode.docompare(p : tnode) : boolean;
 
       begin
          docompare:=(inherited docompare(p)) and
-           left^.isequal(p^.left);
+           left.isequal(tunarynode(p).left);
       end;
 
 {$ifdef extdebug}
@@ -233,12 +229,12 @@
     procedure tunarynode.concattolist(l : plinkedlist);
 
       begin
-         left^.parent:=@self;
-         left^.concattolist(l);
+         left.parent:=self;
+         left.concattolist(l);
          inherited concattolist(l);
       end;
 
-    function tunarynode.ischild(p : pnode) : boolean;
+    function tunarynode.ischild(p : tnode) : boolean;
 
       begin
          ischild:=p=left;
@@ -247,23 +243,23 @@
     procedure tunarynode.det_resulttype;
 
       begin
-         left^.det_resulttype;
+         left.det_resulttype;
       end;
 
     procedure tunarynode.det_temp;
 
       begin
-         left^.det_temp;
+         left.det_temp;
       end;
 
 {****************************************************************************
                             TBINARYNODE
  ****************************************************************************}
 
-    constructor tbinarynode.init(tt : tnodetype;l,r : pnode);
+    constructor tbinarynode.create(tt : tnodetype;l,r : tnode);
 
       begin
-         inherited init(tt,l);
+         inherited create(tt,l);
          right:=r
       end;
 
@@ -272,14 +268,14 @@
       begin
          { we could change that depending on the number of }
          { required registers                              }
-         left^.parent:=@self;
-         left^.concattolist(l);
-         left^.parent:=@self;
-         left^.concattolist(l);
+         left.parent:=self;
+         left.concattolist(l);
+         left.parent:=self;
+         left.concattolist(l);
          inherited concattolist(l);
       end;
 
-    function tbinarynode.ischild(p : pnode) : boolean;
+    function tbinarynode.ischild(p : tnode) : boolean;
 
       begin
          ischild:=(p=right) or (p=right);
@@ -288,45 +284,146 @@
     procedure tbinarynode.det_resulttype;
 
       begin
-         left^.det_resulttype;
-         right^.det_resulttype;
+         left.det_resulttype;
+         right.det_resulttype;
       end;
 
     procedure tbinarynode.det_temp;
 
       begin
-         left^.det_temp;
-         right^.det_temp;
+         left.det_temp;
+         right.det_temp;
+      end;
+
+    function tbinarynode.docompare(p : tnode) : boolean;
+
+      begin
+         docompare:=left.isequal(tbinarynode(p).left) and
+           right.isequal(tbinarynode(p).right);
+      end;
+
+    function tbinarynode.isbinaryoverloaded(var t : tnode) : boolean;
+
+     var
+         rd,ld   : pdef;
+         optoken : ttoken;
+
+      begin
+        t:=nil;
+        isbinaryoverloaded:=false;
+        { overloaded operator ? }
+        { load easier access variables }
+        rd:=right.resulttype;
+        ld:=left.resulttype;
+        if isbinaryoperatoroverloadable(ld,rd,voiddef,nodetype) then
+          begin
+             isbinaryoverloaded:=true;
+             {!!!!!!!!! handle paras }
+             case nodetype of
+                { the nil as symtable signs firstcalln that this is
+                  an overloaded operator }
+                addn:
+                  optoken:=_PLUS;
+                subn:
+                  optoken:=_MINUS;
+                muln:
+                  optoken:=_STAR;
+                starstarn:
+                  optoken:=_STARSTAR;
+                slashn:
+                  optoken:=_SLASH;
+                ltn:
+                  optoken:=tokens._lt;
+                gtn:
+                  optoken:=tokens._gt;
+                lten:
+                  optoken:=_lte;
+                gten:
+                  optoken:=_gte;
+                equaln,unequaln :
+                  optoken:=_EQUAL;
+                symdifn :
+                  optoken:=_SYMDIF;
+                modn :
+                  optoken:=_OP_MOD;
+                orn :
+                  optoken:=_OP_OR;
+                xorn :
+                  optoken:=_OP_XOR;
+                andn :
+                  optoken:=_OP_AND;
+                divn :
+                  optoken:=_OP_DIV;
+                shln :
+                  optoken:=_OP_SHL;
+                shrn :
+                  optoken:=_OP_SHR;
+                else
+                  exit;
+             end;
+             t:=gencallnode(overloaded_operators[optoken],nil);
+             { we have to convert p^.left and p^.right into
+              callparanodes }
+             if tcallnode(t).symtableprocentry=nil then
+               begin
+                  CGMessage(parser_e_operator_not_overloaded);
+                  t.free;
+               end
+             else
+               begin
+                  inc(tcallnode(t).symtableprocentry^.refs);
+                  tcallnode(t).left:=gencallparanode(left,nil);
+                  tcallnode(t).left:=gencallparanode(right,tcallnode(t).left);
+                  if nodetype=unequaln then
+                    t:=cnotnode.create(t);
+
+                  firstpass(t);
+
+                  putnode(p);
+                  p:=t;
+               end;
+          end;
       end;
 
-    function tbinarynode.docompare(p : pnode) : boolean;
+    procedure tbinarynode.swapleftright;
+
+      var
+         swapp : tnode;
 
       begin
-         docompare:=left^.isequal(p^.left) and
-           right^.isequal(p^.right);
+         swapp:=right;
+         right:=left;
+         left:=swapp;
+         if nf_swaped in flags then
+           exclude(flags,nf_swaped)
+         else
+           include(flags,nf_swaped);
       end;
 
 {****************************************************************************
                             TBINOPYNODE
  ****************************************************************************}
 
-    constructor tbinopnode.init(tt : tnodetype;l,r : pnode);
+    constructor tbinopnode.create(tt : tnodetype;l,r : tnode);
 
       begin
-         inherited init(tt,l,r);
+         inherited create(tt,l,r);
       end;
 
-    function tbinopnode.docompare(p : pnode) : boolean;
+    function tbinopnode.docompare(p : tnode) : boolean;
 
       begin
          docompare:=(inherited docompare(p)) or
            ((nf_swapable in flags) and
-            left^.isequal(p^.right) and
-            right^.isequal(p^.left));
+            left.isequal(tbinopnode(p).right) and
+            right.isequal(tbinopnode(p).left));
       end;
 {
   $Log$
-  Revision 1.1  2000-08-26 12:27:17  florian
-    * initial release
+  Revision 1.2  2000-09-20 21:52:38  florian
+    * removed a lot of errors
+
+  Revision 1.1  2000/08/26 12:27:17  florian
+    * createial release
 
 }

compiler/node.pas

@@ -24,16 +24,25 @@ unit node;
 
   interface
 
+    uses
+       globtype,globals,cobjects,aasm,cpubase,symtable,
+       tokens;
+
     {$I nodeh.inc}
 
   implementation
 
+    uses
+       htypechk,ncal,hcodegen,verbose;
+
     {$I node.inc}
 
 end.
 {
   $Log$
-  Revision 1.1  2000-08-26 12:27:35  florian
-    * initial release
+  Revision 1.2  2000-09-20 21:52:38  florian
+    * removed a lot of errors
 
+  Revision 1.1  2000/08/26 12:27:35  florian
+    * initial release
 }

compiler/nodeh.inc

@@ -171,7 +171,19 @@
          nf_callunique,
          nf_swapable,    { tbinop operands can be swaped }
          nf_swaped,      { tbinop operands are swaped    }
-         nf_error
+         nf_error,
+
+         { flags used by tcallnode }
+         nf_no_check,
+         nf_unit_specific,
+         nf_return_value_used,
+         nf_static_call,
+
+         { flags used by tcallparanode }
+         nf_exact_match_found,
+         nf_convlevel1found,
+         nf_convlevel2found,
+         nf_is_colon_para
          );
 
        tnodeflagset = set of tnodeflags;
@@ -179,7 +191,7 @@
     const
        { contains the flags which must be equal for the equality }
        { of nodes                                                }
-       flagsequal : tnodeflagset = [nf_error];
+       flagsequal : tnodeflagset = [nf_error,nf_static_call];
 
     type
        { later (for the newcg) tnode will inherit from tlinkedlist_item }
@@ -191,7 +203,7 @@
           varstateset : boolean;
           { the parent node of this is node    }
           { this field is set by concattolist  }
-          parent : pnode;
+          parent : tnode;
           { there are some properties about the node stored }
           flags : tnodeflagset;
           { the number of registers needed to evalute the node }
@@ -206,8 +218,8 @@
           firstpasscount : longint;
 {$endif extdebug}
           list : paasmoutput;
-          constructor init(tt : tnodetype);virtual;
-          destructor done;virtual;
+          constructor create(tt : tnodetype);virtual;
+          destructor destroy;virtual;
 
           { the 1.1 code generator may override pass_1 }
           { and it need not to implement det_* then    }
@@ -215,12 +227,12 @@
           { 2.0: runs det_resulttype and det_temp                           }
           function pass_1 : tnode;virtual;
           { dermines the resulttype of the node }
-          procedure det_resulttype;virtual;
+          procedure det_resulttype;virtual;abstract;
           { dermines the number of necessary temp. locations to evaluate
             the node }
-          procedure det_temp;virtual;
+          procedure det_temp;virtual;abstract;
 
-          procedure secondpass;virtual;
+          procedure pass_2;virtual;abstract;
 
           { comparing of nodes }
           function isequal(p : tnode) : boolean;
@@ -234,45 +246,55 @@
 {$endif EXTDEBUG}
           procedure concattolist(l : plinkedlist);virtual;
           function ischild(p : tnode) : boolean;virtual;
+          procedure set_file_line(from : tnode);
+          procedure set_tree_filepos(const filepos : tfileposinfo);
        end;
 
        { this node is the anchestor for all nodes with at least   }
        { one child, you have to use it if you want to use         }
        { true- and falselabel                                     }
-       tparentnode = class(tnode);
-          falselabel,truelabel : plabel;
+       tparentnode = class(tnode)
+          falselabel,truelabel : pasmlabel;
        end;
 
        punarynode = ^tunarynode;
        tunarynode = class(tparentnode)
           left : tnode;
 {$ifdef extdebug}
-          procedure dowrite;virtual;
+          procedure dowrite;override;
 {$endif extdebug}
-          constructor init(tt : tnodetype;l : tnode);virtual
-          procedure concattolist(l : plinkedlist);virtual;
-          function ischild(p : tnode) : boolean;virtual;
-          procedure det_resulttype;virtual;
-          procedure det_temp;virtual;
+          constructor create(tt : tnodetype;l : tnode);virtual;
+          procedure concattolist(l : plinkedlist);override;
+          function ischild(p : tnode) : boolean;override;
+          procedure det_resulttype;override;
+          procedure det_temp;override;
+          function docompare(p : tnode) : boolean;override;
        end;
 
        pbinarynode = ^tbinarynode;
        tbinarynode = class(tunarynode)
           right : tnode;
-          constructor init(tt : tnodetype;l,r : pnode);virtual;
-          procedure concattolist(l : plinkedlist);virtual;
-          function ischild(p : pnode) : boolean;virtual;
-          procedure det_resulttype;virtual;
-          procedure det_temp;virtual;
+          constructor create(tt : tnodetype;l,r : tnode);virtual;
+          procedure concattolist(l : plinkedlist);override;
+          function ischild(p : tnode) : boolean;override;
+          procedure det_resulttype;override;
+          procedure det_temp;override;
+          function docompare(p : tnode) : boolean;override;
+          procedure swapleftright;
+          function isbinaryoverloaded(var t : tnode) : boolean;
        end;
 
        pbinopnode = ^tbinopnode;
        tbinopnode = class(tbinarynode)
-          constructor init(tt : tnodetype;l,r : pnode);virtual;
+          constructor create(tt : tnodetype;l,r : tnode);virtual;
+          function docompare(p : tnode) : boolean;override;
        end;
 {
   $Log$
-  Revision 1.1  2000-08-26 12:27:04  florian
+  Revision 1.2  2000-09-20 21:52:38  florian
+    * removed a lot of errors
+
+  Revision 1.1  2000/08/26 12:27:04  florian
     * initial release
 
-}
+}