Browse Source

* some errors fix to get more stuff compilable

florian 25 years ago
parent
commit
426905c464
5 changed files with 105 additions and 49 deletions
  1. 29 4
      compiler/ncal.pas
  2. 19 9
      compiler/ncon.pas
  3. 27 20
      compiler/nflw.pas
  4. 13 3
      compiler/nodeh.inc
  5. 17 13
      compiler/pass_1.pas

+ 29 - 4
compiler/ncal.pas

@@ -53,12 +53,15 @@ interface
           destructor destroy;override;
           destructor destroy;override;
           function pass_1 : tnode;override;
           function pass_1 : tnode;override;
           procedure gen_high_tree(openstring:boolean);
           procedure gen_high_tree(openstring:boolean);
+          { tcallparanode doesn't use pass_1 }
+          { tcallnode takes care of this     }
+          procedure firstcallparan(defcoll : pparaitem;do_count : boolean);virtual;
        end;
        end;
 
 
        tprocinlinenode = class(tnode)
        tprocinlinenode = class(tnode)
           inlinetree : tnode;
           inlinetree : tnode;
           inlineprocsym : pprocsym;
           inlineprocsym : pprocsym;
-          retoffset,para_offset,para_size : longint
+          retoffset,para_offset,para_size : longint;
           function pass_1 : tnode;override;
           function pass_1 : tnode;override;
        end;
        end;
 
 
@@ -74,6 +77,25 @@ interface
 
 
   implementation
   implementation
 
 
+    uses
+      cutils,globtype,systems,
+      cobjects,verbose,globals,
+      symconst,aasm,types,
+      htypechk,pass_1,cpubase
+{$ifdef newcg}
+      ,cgbase
+      ,tgobj
+{$else newcg}
+      ,hcodegen
+{$ifdef i386}
+      ,tgeni386
+{$endif}
+{$ifdef m68k}
+      ,tgen68k
+{$endif m68k}
+{$endif newcg}
+      ;
+
     function gencallnode(v : pprocsym;st : psymtable) : tnode;
     function gencallnode(v : pprocsym;st : psymtable) : tnode;
 
 
       begin
       begin
@@ -92,7 +114,7 @@ interface
          p : tnode;
          p : tnode;
 
 
       begin
       begin
-         p:=create.cprocinlinenode(callp,code);
+         p:=cprocinlinenode.create(callp,code);
          genprocinlinenode:=p;
          genprocinlinenode:=p;
       end;
       end;
 
 
@@ -115,7 +137,7 @@ interface
          inherited destroy;
          inherited destroy;
       end;
       end;
 
 
-    procedure firstcallparan(var p : ptree;defcoll : pparaitem;do_count : boolean);
+    procedure tcallparanode.firstcallparan(defcoll : pparaitem;do_count : boolean);
       var
       var
         old_get_para_resulttype : boolean;
         old_get_para_resulttype : boolean;
         old_array_constructor : boolean;
         old_array_constructor : boolean;
@@ -1434,7 +1456,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.4  2000-09-24 20:17:44  florian
+  Revision 1.5  2000-09-24 21:15:34  florian
+    * some errors fix to get more stuff compilable
+
+  Revision 1.4  2000/09/24 20:17:44  florian
     * more conversion work done
     * more conversion work done
 
 
   Revision 1.3  2000/09/24 15:06:19  peter
   Revision 1.3  2000/09/24 15:06:19  peter

+ 19 - 9
compiler/ncon.pas

@@ -27,7 +27,7 @@ unit ncon;
 interface
 interface
 
 
     uses
     uses
-      node;
+      globtype,node,aasm,cpuinfo,symconst;
 
 
     type
     type
        trealconstnode = class(tnode)
        trealconstnode = class(tnode)
@@ -59,14 +59,14 @@ interface
           value_str : pchar;
           value_str : pchar;
           length : longint;
           length : longint;
           lab_str : pasmlabel;
           lab_str : pasmlabel;
-          stringtype : tstringtype
+          stringtype : tstringtype;
           // !!!!!!! needs at least create, getcopy, destroy
           // !!!!!!! needs at least create, getcopy, destroy
           function pass_1 : tnode;override;
           function pass_1 : tnode;override;
        end;
        end;
 
 
        tsetconstnode = class(tnode)
        tsetconstnode = class(tnode)
           value_set : pconstset;
           value_set : pconstset;
-          lab_set : pasmlabel
+          lab_set : pasmlabel;
           // !!!!!!! needs at least create,  getcopy
           // !!!!!!! needs at least create,  getcopy
           function pass_1 : tnode;override;
           function pass_1 : tnode;override;
        end;
        end;
@@ -80,15 +80,16 @@ implementation
 
 
     uses
     uses
       cobjects,verbose,globals,systems,
       cobjects,verbose,globals,systems,
-      symconst,symtable,aasm,types,
+      symtable,types,
       hcodegen,pass_1,cpubase;
       hcodegen,pass_1,cpubase;
 
 
 {*****************************************************************************
 {*****************************************************************************
                              TREALCONSTNODE
                              TREALCONSTNODE
 *****************************************************************************}
 *****************************************************************************}
 
 
-    function tpointerconstnode.pass_1 : tnode;
+    function trealconstnode.pass_1 : tnode;
       begin
       begin
+         pass_1:=nil;
          if (value_real=1.0) or (value_real=0.0) then
          if (value_real=1.0) or (value_real=0.0) then
            begin
            begin
               location.loc:=LOC_FPU;
               location.loc:=LOC_FPU;
@@ -103,8 +104,9 @@ implementation
                              TFIXCONSTNODE
                              TFIXCONSTNODE
 *****************************************************************************}
 *****************************************************************************}
 
 
-    function tpointerconstnode.pass_1 : tnode;
+    function tfixconstnode.pass_1 : tnode;
       begin
       begin
+         pass_1:=nil;
          location.loc:=LOC_MEM;
          location.loc:=LOC_MEM;
       end;
       end;
 
 
@@ -113,8 +115,9 @@ implementation
                               TORDCONSTNODE
                               TORDCONSTNODE
 *****************************************************************************}
 *****************************************************************************}
 
 
-    function tpointerconstnode.pass_1 : tnode;
+    function tordconstnode.pass_1 : tnode;
       begin
       begin
+         pass_1:=nil;
          location.loc:=LOC_MEM;
          location.loc:=LOC_MEM;
       end;
       end;
 
 
@@ -125,6 +128,7 @@ implementation
 
 
     function tpointerconstnode.pass_1 : tnode;
     function tpointerconstnode.pass_1 : tnode;
       begin
       begin
+         pass_1:=nil;
          location.loc:=LOC_MEM;
          location.loc:=LOC_MEM;
       end;
       end;
 
 
@@ -135,6 +139,7 @@ implementation
 
 
     function tstringconstnode.pass_1 : tnode;
     function tstringconstnode.pass_1 : tnode;
       begin
       begin
+         pass_1:=nil;
 {        if cs_ansistrings in aktlocalswitches then
 {        if cs_ansistrings in aktlocalswitches then
           resulttype:=cansistringdef
           resulttype:=cansistringdef
          else
          else
@@ -159,6 +164,7 @@ implementation
 
 
     function tsetconstnode.pass_1 : tnode;
     function tsetconstnode.pass_1 : tnode;
       begin
       begin
+         pass_1:=nil;
          location.loc:=LOC_MEM;
          location.loc:=LOC_MEM;
       end;
       end;
 
 
@@ -168,6 +174,7 @@ implementation
 
 
     function tnilnode.pass_1 : tnode;
     function tnilnode.pass_1 : tnode;
       begin
       begin
+        pass_1:=nil;
         resulttype:=voidpointerdef;
         resulttype:=voidpointerdef;
         location.loc:=LOC_MEM;
         location.loc:=LOC_MEM;
       end;
       end;
@@ -175,10 +182,13 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.2  2000-09-24 15:06:19  peter
+  Revision 1.3  2000-09-24 21:15:34  florian
+    * some errors fix to get more stuff compilable
+
+  Revision 1.2  2000/09/24 15:06:19  peter
     * use defines.inc
     * use defines.inc
 
 
   Revision 1.1  2000/09/22 21:44:48  florian
   Revision 1.1  2000/09/22 21:44:48  florian
     + initial revision
     + initial revision
 
 
-}
+}

+ 27 - 20
compiler/nflw.pas

@@ -122,7 +122,7 @@ implementation
     uses
     uses
       globtype,systems,
       globtype,systems,
       cutils,cobjects,verbose,globals,
       cutils,cobjects,verbose,globals,
-      symconst,types,htypechk,pass_1
+      symconst,types,htypechk,pass_1,ncon,nmem
 {$ifdef newcg}
 {$ifdef newcg}
       ,tgobj
       ,tgobj
       ,tgcpu
       ,tgcpu
@@ -368,7 +368,7 @@ implementation
          if left.nodetype=ordconstn then
          if left.nodetype=ordconstn then
            begin
            begin
               { optimize }
               { optimize }
-              if left.value=1 then
+              if tordconstnode(left).value=1 then
                 begin
                 begin
                    left.free;
                    left.free;
                    hp:=right;
                    hp:=right;
@@ -388,7 +388,7 @@ implementation
                    right.free;
                    right.free;
                    { we cannot set p to nil !!! }
                    { we cannot set p to nil !!! }
                    if assigned(hp) then
                    if assigned(hp) then
-                     pass_1:=hp;
+                     pass_1:=hp
                    else
                    else
                      pass_1:=cnothingnode.create;
                      pass_1:=cnothingnode.create;
                 end;
                 end;
@@ -405,7 +405,7 @@ implementation
     constructor tfornode.create(l,r,_t1,_t2 : tnode;back : boolean);
     constructor tfornode.create(l,r,_t1,_t2 : tnode;back : boolean);
 
 
       begin
       begin
-         inherited create(forn,l,r,_t1_,t2);
+         inherited create(forn,l,r,_t1,_t2);
          if back then
          if back then
            include(flags,nf_backward);
            include(flags,nf_backward);
       end;
       end;
@@ -421,11 +421,15 @@ implementation
          old_t_times:=t_times;
          old_t_times:=t_times;
          if not(cs_littlesize in aktglobalswitches) then
          if not(cs_littlesize in aktglobalswitches) then
            t_times:=t_times*8;
            t_times:=t_times*8;
-         { save counter var }
-         t2:=left.left.getcopy;
 
 
-         if left.treetype<>assignn then
-           CGMessage(cg_e_illegal_expression);
+         if left.nodetype<>assignn then
+           begin
+              CGMessage(cg_e_illegal_expression);
+              exit;
+           end;
+         { save counter var }
+         { tbinarynode should be tassignnode! }
+         t2:=tbinarynode(left).left.getcopy;
 
 
 {$ifdef newcg}
 {$ifdef newcg}
          tg.cleartempgen;
          tg.cleartempgen;
@@ -433,7 +437,7 @@ implementation
          cleartempgen;
          cleartempgen;
 {$endif newcg}
 {$endif newcg}
          firstpass(left);
          firstpass(left);
-         set_varstate(left,false);
+         left.set_varstate(false);
 
 
 {$ifdef newcg}
 {$ifdef newcg}
          tg.cleartempgen;
          tg.cleartempgen;
@@ -447,8 +451,8 @@ implementation
              exit;
              exit;
           end;
           end;
 
 
-         registers32:=t1^.registers32;
-         registersfpu:=t1^.registersfpu;
+         registers32:=t1.registers32;
+         registersfpu:=t1.registersfpu;
 {$ifdef SUPPORT_MMX}
 {$ifdef SUPPORT_MMX}
          registersmmx:=left.registersmmx;
          registersmmx:=left.registersmmx;
 {$endif SUPPORT_MMX}
 {$endif SUPPORT_MMX}
@@ -468,14 +472,14 @@ implementation
          cleartempgen;
          cleartempgen;
 {$endif newcg}
 {$endif newcg}
          firstpass(t2);
          firstpass(t2);
-         set_varstate(t2,true);
+         t2.set_varstate(true);
          if codegenerror then
          if codegenerror then
           exit;
           exit;
 
 
          { Check count var, record fields are also allowed in tp7 }
          { Check count var, record fields are also allowed in tp7 }
          hp:=t2;
          hp:=t2;
-         while (hp.treetype=subscriptn) do
-          hp:=hp.left;
+         while (hp.nodetype=subscriptn) do
+          hp:=tsubscriptnode(hp).left;
          { we need a simple loadn, but the load must be in a global symtable or
          { we need a simple loadn, but the load must be in a global symtable or
            in the same lexlevel }
            in the same lexlevel }
          if (hp.treetype=funcretn) or
          if (hp.treetype=funcretn) or
@@ -506,7 +510,7 @@ implementation
          cleartempgen;
          cleartempgen;
 {$endif newcg}
 {$endif newcg}
          firstpass(right);
          firstpass(right);
-         set_varstate(right,true);
+         right.set_varstate(true);
          if right.treetype<>ordconstn then
          if right.treetype<>ordconstn then
            begin
            begin
               right:=gentypeconvnode(right,t2^.resulttype);
               right:=gentypeconvnode(right,t2^.resulttype);
@@ -639,7 +643,7 @@ implementation
                  ((left.resulttype^.deftype<>objectdef) or
                  ((left.resulttype^.deftype<>objectdef) or
                   not(pobjectdef(left.resulttype)^.is_class)) then
                   not(pobjectdef(left.resulttype)^.is_class)) then
                 CGMessage(type_e_mismatch);
                 CGMessage(type_e_mismatch);
-              set_varstate(left,true);
+              left.set_varstate(left);
               if codegenerror then
               if codegenerror then
                exit;
                exit;
               { insert needed typeconvs for addr,frame }
               { insert needed typeconvs for addr,frame }
@@ -751,7 +755,7 @@ implementation
          aktexceptblock:=left;
          aktexceptblock:=left;
          firstpass(left);
          firstpass(left);
          aktexceptblock:=oldexceptblock;
          aktexceptblock:=oldexceptblock;
-         set_varstate(left,true);
+         left.set_varstate(true);
 {$ifdef newcg}
 {$ifdef newcg}
          tg.cleartempgen;
          tg.cleartempgen;
 {$else newcg}
 {$else newcg}
@@ -761,7 +765,7 @@ implementation
          aktexceptblock:=right;
          aktexceptblock:=right;
          firstpass(right);
          firstpass(right);
          aktexceptblock:=oldexceptblock;
          aktexceptblock:=oldexceptblock;
-         set_varstate(right,true);
+         right.set_varstate(true);
          if codegenerror then
          if codegenerror then
            exit;
            exit;
          left_right_max(p);
          left_right_max(p);
@@ -842,10 +846,13 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.2  2000-09-24 15:06:19  peter
+  Revision 1.3  2000-09-24 21:15:34  florian
+    * some errors fix to get more stuff compilable
+
+  Revision 1.2  2000/09/24 15:06:19  peter
     * use defines.inc
     * use defines.inc
 
 
   Revision 1.1  2000/09/22 22:46:03  florian
   Revision 1.1  2000/09/22 22:46:03  florian
     + initial revision
     + initial revision
 
 
-}
+}

+ 13 - 3
compiler/nodeh.inc

@@ -168,7 +168,6 @@
        { this will be used mainly for the newcg }
        { this will be used mainly for the newcg }
        tnodeflags = (
        tnodeflags = (
          nf_needs_truefalselabel,
          nf_needs_truefalselabel,
-         nf_callunique,
          nf_swapable,    { tbinop operands can be swaped }
          nf_swapable,    { tbinop operands can be swaped }
          nf_swaped,      { tbinop operands are swaped    }
          nf_swaped,      { tbinop operands are swaped    }
          nf_error,
          nf_error,
@@ -187,7 +186,15 @@
 
 
          { flags used by loop nodes }
          { flags used by loop nodes }
          nf_backward,  { set if it is a for ... downto ... do loop }
          nf_backward,  { set if it is a for ... downto ... do loop }
-         nf_varstate   { do we need to parse childs to set var state }
+         nf_varstate,  { do we need to parse childs to set var state }
+
+         { taddrnode }
+         nf_procvarload,
+
+         { tvecnode }
+         nf_memindex,
+         nf_memseg,
+         nf_callunique
          );
          );
 
 
        tnodeflagset = set of tnodeflags;
        tnodeflagset = set of tnodeflags;
@@ -303,7 +310,10 @@
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.3  2000-09-22 21:45:36  florian
+  Revision 1.4  2000-09-24 21:15:34  florian
+    * some errors fix to get more stuff compilable
+
+  Revision 1.3  2000/09/22 21:45:36  florian
     * some updates e.g. getcopy added
     * some updates e.g. getcopy added
 
 
   Revision 1.2  2000/09/20 21:52:38  florian
   Revision 1.2  2000/09/20 21:52:38  florian

+ 17 - 13
compiler/pass_1.pas

@@ -425,7 +425,7 @@ implementation
       globtype,systems,
       globtype,systems,
       cutils,cobjects,verbose,globals,
       cutils,cobjects,verbose,globals,
       aasm,symtable,types,
       aasm,symtable,types,
-      htypechk,
+      htypechk,nflw,
       cpubase,cpuasm
       cpubase,cpuasm
 {$ifdef newcg}
 {$ifdef newcg}
       ,cgbase
       ,cgbase
@@ -538,12 +538,12 @@ implementation
 
 
     function tblocknode.pass_1 : tnode;
     function tblocknode.pass_1 : tnode;
       var
       var
-         hp : tnode;
+         hp : tstatementnode;
          count : longint;
          count : longint;
       begin
       begin
          pass_1:=nil;
          pass_1:=nil;
          count:=0;
          count:=0;
-         hp:=left;
+         hp:=tstatementnode(left);
          while assigned(hp) do
          while assigned(hp) do
            begin
            begin
               if cs_regalloc in aktglobalswitches then
               if cs_regalloc in aktglobalswitches then
@@ -555,18 +555,19 @@ implementation
                      result types !!! }
                      result types !!! }
                    if ret_in_acc(procinfo^.returntype.def) and
                    if ret_in_acc(procinfo^.returntype.def) and
                       assigned(hp.left) and
                       assigned(hp.left) and
-                      assigned(hp.left.right) and
-                      (hp.left.right.treetype=exitn) and
-                      (hp.right.treetype=assignn) and
-                      (hp.right.left.treetype=funcretn) then
+                      assigned(tstatementnode(hp.left).right) and
+                      (tstatementnode(hp.left).right.nodetype=exitn) and
+                      (hp.right.nodetype=assignn) and
+                      { !!!! this tbinarynode should be tassignmentnode }
+                      (tbinarynode(hp.right).left.nodetype=funcretn) then
                       begin
                       begin
-                         if assigned(hp.left.right.left) then
+                         if assigned(texitnode(tstatmentnode(hp.left).right).left) then
                            CGMessage(cg_n_inefficient_code)
                            CGMessage(cg_n_inefficient_code)
                          else
                          else
                            begin
                            begin
                               hp.left.right.left:=hp.right.right;
                               hp.left.right.left:=hp.right.right;
                               hp.right.right:=nil;
                               hp.right.right:=nil;
-                              disposetree(hp.right);
+                              hp.right.free;
                               hp.right:=nil;
                               hp.right:=nil;
                            end;
                            end;
                       end
                       end
@@ -581,7 +582,7 @@ implementation
                      begin
                      begin
                         { use correct line number }
                         { use correct line number }
                         aktfilepos:=hp.left.fileinfo;
                         aktfilepos:=hp.left.fileinfo;
-                        disposetree(hp.left);
+                        hp.left.free;
                         hp.left:=nil;
                         hp.left:=nil;
                         CGMessage(cg_w_unreachable_code);
                         CGMessage(cg_w_unreachable_code);
                         { old lines }
                         { old lines }
@@ -675,7 +676,7 @@ implementation
            not_first:=false;
            not_first:=false;
 {$endif extdebug}
 {$endif extdebug}
 
 
-         if not nf_error in p.flags then
+         if not(nf_error in p.flags) then
            begin
            begin
               codegenerror:=false;
               codegenerror:=false;
               aktfilepos:=p.fileinfo;
               aktfilepos:=p.fileinfo;
@@ -733,7 +734,10 @@ end.
 {$endif cg11}
 {$endif cg11}
 {
 {
   $Log$
   $Log$
-  Revision 1.4  2000-09-24 15:06:21  peter
+  Revision 1.5  2000-09-24 21:15:34  florian
+    * some errors fix to get more stuff compilable
+
+  Revision 1.4  2000/09/24 15:06:21  peter
     * use defines.inc
     * use defines.inc
 
 
   Revision 1.3  2000/09/19 23:09:07  pierre
   Revision 1.3  2000/09/19 23:09:07  pierre
@@ -742,4 +746,4 @@ end.
   Revision 1.2  2000/07/13 11:32:44  michael
   Revision 1.2  2000/07/13 11:32:44  michael
   + removed logs
   + removed logs
 
 
-}
+}