*** empty log message ***

compiler/htypechk.pas

@@ -108,7 +108,7 @@ interface
 
     { Register Allocation }
     procedure make_not_regable(p : tnode);
-    procedure calcregisters(p : tnode;r32,fpu,mmx : word);
+    procedure calcregisters(p : tbinarynode;r32,fpu,mmx : word);
 
     { subroutine handling }
     procedure test_protected_sym(sym : psym);
@@ -161,7 +161,8 @@ implementation
        globtype,systems,
        cutils,cobjects,verbose,globals,
        symconst,
-       types,pass_1,cpubase,
+       types,pass_1,cpubase,ncnv,nld,
+       nmem,ncal,
 {$ifdef newcg}
        cgbase
 {$else}
@@ -796,21 +797,21 @@ implementation
     { marks an lvalue as "unregable" }
     procedure make_not_regable(p : tnode);
       begin
-         case p.treetype of
+         case p.nodetype of
             typeconvn :
-              make_not_regable(p.left);
+              make_not_regable(ttypeconvnode(p).left);
             loadn :
-              if p.symtableentry^.typ=varsym then
-                pvarsym(p.symtableentry)^.varoptions:=pvarsym(p.symtableentry)^.varoptions-[vo_regable,vo_fpuregable];
+              if tloadnode(p).symtableentry^.typ=varsym then
+                pvarsym(tloadnode(p).symtableentry)^.varoptions:=pvarsym(tloadnode(p).symtableentry)^.varoptions-[vo_regable,vo_fpuregable];
          end;
       end;
 
 
     { calculates the needed registers for a binary operator }
-    procedure calcregisters(p : tnode;r32,fpu,mmx : word);
+    procedure calcregisters(p : tbinarynode;r32,fpu,mmx : word);
 
       begin
-         left_right_max(p);
+         p.left_right_max;
 
       { Only when the difference between the left and right registers < the
         wanted registers allocate the amount of registers }
@@ -819,12 +820,12 @@ implementation
          begin
            if assigned(p.right) then
             begin
-              if (abs(p.left^.registers32-p.right^.registers32)<r32) then
+              if (abs(p.left.registers32-p.right.registers32)<r32) then
                inc(p.registers32,r32);
-              if (abs(p.left^.registersfpu-p.right^.registersfpu)<fpu) then
+              if (abs(p.left.registersfpu-p.right.registersfpu)<fpu) then
                inc(p.registersfpu,fpu);
 {$ifdef SUPPORT_MMX}
-              if (abs(p.left^.registersmmx-p.right^.registersmmx)<mmx) then
+              if (abs(p.left.registersmmx-p.right.registersmmx)<mmx) then
                inc(p.registersmmx,mmx);
 {$endif SUPPORT_MMX}
               { the following is a little bit guessing but I think }
@@ -833,21 +834,21 @@ implementation
               { and return a mem location, but the current node    }
               { doesn't use an integer register we get probably    }
               { trouble when restoring a node                      }
-              if (p.left^.registers32=p.right^.registers32) and
-                 (p.registers32=p.left^.registers32) and
+              if (p.left.registers32=p.right.registers32) and
+                 (p.registers32=p.left.registers32) and
                  (p.registers32>0) and
-                (p.left^.location.loc in [LOC_REFERENCE,LOC_MEM]) and
-                (p.right^.location.loc in [LOC_REFERENCE,LOC_MEM]) then
+                (p.left.location.loc in [LOC_REFERENCE,LOC_MEM]) and
+                (p.right.location.loc in [LOC_REFERENCE,LOC_MEM]) then
                 inc(p.registers32);
             end
            else
             begin
-              if (p.left^.registers32<r32) then
+              if (p.left.registers32<r32) then
                inc(p.registers32,r32);
-              if (p.left^.registersfpu<fpu) then
+              if (p.left.registersfpu<fpu) then
                inc(p.registersfpu,fpu);
 {$ifdef SUPPORT_MMX}
-              if (p.left^.registersmmx<mmx) then
+              if (p.left.registersmmx<mmx) then
                inc(p.registersmmx,mmx);
 {$endif SUPPORT_MMX}
             end;
@@ -883,15 +884,15 @@ implementation
 
     procedure test_protected(p : tnode);
       begin
-        case p.treetype of
-         loadn : test_protected_sym(p.symtableentry);
-     typeconvn : test_protected(p.left);
-        derefn : test_protected(p.left);
+        case p.nodetype of
+         loadn : test_protected_sym(tloadnode(p).symtableentry);
+     typeconvn : test_protected(ttypeconvnode(p).left);
+        derefn : test_protected(tderefnode(p).left);
     subscriptn : begin
                  { test_protected(p.left);
                    Is a field of a protected var
                    also protected ???  PM }
-                   test_protected_sym(p.vs);
+                   test_protected_sym(tsubscriptnode(p).vs);
                  end;
         end;
       end;
@@ -900,11 +901,11 @@ implementation
      var
         v : boolean;
      begin
-        case p.treetype of
+        case p.nodetype of
          loadn :
-           v:=(p.symtableentry^.typ in [typedconstsym,varsym]);
+           v:=(tloadnode(p).symtableentry^.typ in [typedconstsym,varsym]);
          typeconvn :
-           v:=valid_for_formal_var(p.left);
+           v:=valid_for_formal_var(ttypeconvnode(p).left);
          derefn,
          subscriptn,
          vecn,
@@ -912,12 +913,12 @@ implementation
          selfn :
            v:=true;
          calln : { procvars are callnodes first }
-           v:=assigned(p.right) and not assigned(p.left);
+           v:=assigned(tcallnode(p).right) and not assigned(tcallnode(p).left);
          addrn :
            begin
              { addrn is not allowed as this generate a constant value,
                but a tp procvar are allowed (PFV) }
-             if p.procvarload then
+             if nf_procvarload in p.flags then
               v:=true
              else
               v:=false;
@@ -928,20 +929,20 @@ implementation
         valid_for_formal_var:=v;
      end;
 
-   function  valid_for_formal_const(p : ptree) : boolean;
+   function  valid_for_formal_const(p : tnode) : boolean;
      var
         v : boolean;
      begin
         { p must have been firstpass'd before }
         { accept about anything but not a statement ! }
-        case p.treetype of
+        case p.nodetype of
           calln,
           statementn,
           addrn :
            begin
              { addrn is not allowed as this generate a constant value,
                but a tp procvar are allowed (PFV) }
-             if p.procvarload then
+             if nf_procvarload in p.flags then
               v:=true
              else
               v:=false;
@@ -952,20 +953,20 @@ implementation
         valid_for_formal_const:=v;
      end;
 
-    function is_procsym_load(p:Ptree):boolean;
+    function is_procsym_load(p:tnode):boolean;
       begin
-         is_procsym_load:=((p.treetype=loadn) and (p.symtableentry^.typ=procsym)) or
-                          ((p.treetype=addrn) and (p.left^.treetype=loadn)
-                          and (p.left^.symtableentry^.typ=procsym)) ;
+         is_procsym_load:=((p.nodetype=loadn) and (tloadnode(p).symtableentry^.typ=procsym)) or
+                          ((p.nodetype=addrn) and (taddrnode(p).left.nodetype=loadn)
+                          and (tloadnode(taddrnode(p).left).symtableentry^.typ=procsym)) ;
       end;
 
    { change a proc call to a procload for assignment to a procvar }
    { this can only happen for proc/function without arguments }
-    function is_procsym_call(p:Ptree):boolean;
+    function is_procsym_call(p:tnode):boolean;
       begin
-        is_procsym_call:=(p.treetype=calln) and (p.left=nil) and
-             (((p.symtableprocentry^.typ=procsym) and (p.right=nil)) or
-             ((p.right<>nil) and (p.right^.symtableprocentry^.typ=varsym)));
+        is_procsym_call:=(p.nodetype=calln) and (tcallnode(p).left=nil) and
+             (((tcallnode(p).symtableprocentry^.typ=procsym) and (tcallnode(p).right=nil)) or
+             (assigned(tcallnode(p).right) and (tcallnode(tcallnode(p).right).symtableprocentry^.typ=varsym)));
       end;
 
 
@@ -1021,17 +1022,17 @@ implementation
          begin
            { property allowed? calln has a property check itself }
            if (not allowprop) and
-              (hp.isproperty) and
-              (hp.treetype<>calln) then
+              (nf_isproperty in hp.flags) and
+              (hp.nodetype<>calln) then
             begin
               CGMessagePos(hp.fileinfo,type_e_argument_cant_be_assigned);
               exit;
             end;
-           case hp.treetype of
+           case hp.nodetype of
              derefn :
                begin
                  gotderef:=true;
-                 hp:=hp.left;
+                 hp:=tderefnode(hp).left;
                end;
              typeconvn :
                begin
@@ -1046,19 +1047,19 @@ implementation
                      begin
                        { pointer -> array conversion is done then we need to see it
                          as a deref, because a ^ is then not required anymore }
-                       if (hp.left^.resulttype^.deftype=pointerdef) then
+                       if (ttypeconvnode(hp).left.resulttype^.deftype=pointerdef) then
                         gotderef:=true;
                      end;
                  end;
-                 hp:=hp.left;
+                 hp:=ttypeconvnode(hp).left;
                end;
              vecn,
              asn :
-               hp:=hp.left;
+               hp:=tunarynode(hp).left;
              subscriptn :
                begin
                  gotsubscript:=true;
-                 hp:=hp.left;
+                 hp:=tsubscriptnode(hp).left;
                end;
              subn,
              addn :
@@ -1075,7 +1076,7 @@ implementation
              addrn :
                begin
                  if not(gotderef) and
-                    not(hp.procvarload) then
+                    not(nf_procvarload in hp.flags) then
                   CGMessagePos(hp.fileinfo,type_e_no_assign_to_addr);
                  exit;
                end;
@@ -1102,7 +1103,7 @@ implementation
                    3. property is allowed }
                  if (gotpointer and gotderef) or
                     (gotclass and (gotsubscript or gotwith)) or
-                    (hp.isproperty and allowprop) then
+                    ((nf_isproperty in hp.flags) and allowprop) then
                   valid_for_assign:=true
                  else
                   CGMessagePos(hp.fileinfo,type_e_argument_cant_be_assigned);
@@ -1110,32 +1111,32 @@ implementation
                end;
              loadn :
                begin
-                 case hp.symtableentry^.typ of
+                 case tloadnode(hp).symtableentry^.typ of
                    absolutesym,
                    varsym :
                      begin
-                       if (pvarsym(hp.symtableentry)^.varspez=vs_const) then
+                       if (pvarsym(tloadnode(hp).symtableentry)^.varspez=vs_const) then
                         begin
                           { allow p^:= constructions with p is const parameter }
                           if gotderef then
                            valid_for_assign:=true
                           else
-                           CGMessagePos(hp.fileinfo,type_e_no_assign_to_const);
+                           CGMessagePos(tloadnode(hp).fileinfo,type_e_no_assign_to_const);
                           exit;
                         end;
                        { Are we at a with symtable, then we need to process the
                          withrefnode also to check for maybe a const load }
-                       if (hp.symtable^.symtabletype=withsymtable) then
+                       if (tloadnode(hp).symtable^.symtabletype=withsymtable) then
                         begin
                           { continue with processing the withref node }
-                          hp:=ptree(pwithsymtable(hp.symtable)^.withrefnode);
+                          hp:=tnode(pwithsymtable(tloadnode(hp).symtable)^.withrefnode);
                           gotwith:=true;
                         end
                        else
                         begin
                           { set the assigned flag for varsyms }
-                          if (pvarsym(hp.symtableentry)^.varstate=vs_declared) then
-                           pvarsym(hp.symtableentry)^.varstate:=vs_assigned;
+                          if (pvarsym(tloadnode(hp).symtableentry)^.varstate=vs_declared) then
+                           pvarsym(tloadnode(hp).symtableentry)^.varstate:=vs_assigned;
                           valid_for_assign:=true;
                           exit;
                         end;
@@ -2172,7 +2173,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.8  2000-09-27 18:14:31  florian
+  Revision 1.9  2000-09-28 19:49:51  florian
+  *** empty log message ***
+
+  Revision 1.8  2000/09/27 18:14:31  florian
     * fixed a lot of syntax errors in the n*.pas stuff
 
   Revision 1.7  2000/09/26 20:06:13  florian

compiler/nadd.pas

@@ -157,7 +157,7 @@ implementation
         if porddef(left.resulttype)^.typ>porddef(right.resulttype)^.typ then
          begin
            right:=gentypeconvnode(right,porddef(left.resulttype));
-           ttypeconvnode(right).convtyp:=tc_bool_2_int;
+           ttypeconvnode(right).convtype:=tc_bool_2_int;
            include(right.flags,nf_explizit);
            firstpass(right);
          end
@@ -165,7 +165,7 @@ implementation
          if porddef(left.resulttype)^.typ<porddef(right.resulttype)^.typ then
           begin
             left:=gentypeconvnode(left,porddef(right.resulttype));
-            ttypeconvnode(left).convtyp:=tc_bool_2_int;
+            ttypeconvnode(left).convtype:=tc_bool_2_int;
             include(left.flags,nf_explizit);
             firstpass(left);
           end;
@@ -488,14 +488,14 @@ implementation
                      if left.location.loc=LOC_FLAGS then
                        begin
                           left:=gentypeconvnode(left,porddef(left.resulttype));
-                          left.convtyp:=tc_bool_2_int;
+                          left.convtype:=tc_bool_2_int;
                           left.explizit:=true;
                           firstpass(left);
                        end;
                      if right.location.loc=LOC_FLAGS then
                        begin
                           right:=gentypeconvnode(right,porddef(right.resulttype));
-                          right.convtyp:=tc_bool_2_int;
+                          right.convtype:=tc_bool_2_int;
                           right.explizit:=true;
                           firstpass(right);
                        end;
@@ -1316,7 +1316,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.9  2000-09-27 21:33:22  florian
+  Revision 1.10  2000-09-28 19:49:52  florian
+  *** empty log message ***
+
+  Revision 1.9  2000/09/27 21:33:22  florian
     * finally nadd.pas compiles
 
   Revision 1.8  2000/09/27 20:25:44  florian

compiler/ncal.pas

@@ -51,7 +51,6 @@ interface
           { constructor                                             }
           constructor create(expr,next : tnode);virtual;
           destructor destroy;override;
-          function pass_1 : tnode;override;
           procedure gen_high_tree(openstring:boolean);
           { tcallparanode doesn't use pass_1 }
           { tcallnode takes care of this     }
@@ -150,7 +149,6 @@ interface
 {$endif def extdebug}
         {convtyp     : tconverttype;}
       begin
-         firstcallparan:=nil;
          inc(parsing_para_level);
 {$ifdef extdebug}
          if do_count then
@@ -162,9 +160,9 @@ interface
          if assigned(right) then
            begin
               if defcoll=nil then
-                right.firstcallparan(nil,do_count)
+                tcallparanode(right).firstcallparan(nil,do_count)
               else
-                right.firstcallparan(pparaitem(defcoll^.next),do_count);
+                tcallparanode(right).firstcallparan(pparaitem(defcoll^.next),do_count);
               registers32:=right.registers32;
               registersfpu:=right.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -206,14 +204,14 @@ interface
                     if assigned(aktcallprocsym) and
                        (pocall_cdecl in aktcallprocsym^.definition^.proccalloptions) and
                        (po_external in aktcallprocsym^.definition^.procoptions) then
-                      left.cargs:=true;
+                      include(left.flags,nf_cargs);
                     { force variant array }
-                    left.forcevaria:=true;
+                    include(left.flags,nf_forcevaria);
                   end
                  else
                   begin
-                    left.novariaallowed:=true;
-                    left.constructdef:=parraydef(defcoll^.paratype.def)^.elementtype.def;
+                    include(left.flags,nf_novariaallowed);
+                    tarrayconstructnode(left).constructdef:=parraydef(defcoll^.paratype.def)^.elementtype.def;
                   end;
                end;
 
@@ -221,7 +219,7 @@ interface
                begin
                  { not completly proper, but avoids some warnings }
                  if (defcoll^.paratyp=vs_var) then
-                   set_funcret_is_valid(left);
+                   left.set_funcret_is_valid;
 
                  { protected has nothing to do with read/write
                  if (defcoll^.paratyp=vs_var) then
@@ -252,7 +250,7 @@ interface
                 CGMessagePos(left.fileinfo,type_e_argument_cant_be_assigned);
               { generate the high() value tree }
               if push_high_param(defcoll^.paratype.def) then
-                gen_high_tree(p,is_open_string(defcoll^.paratype.def));
+                gen_high_tree(is_open_string(defcoll^.paratype.def));
               if not(is_shortstring(left.resulttype) and
                      is_shortstring(defcoll^.paratype.def)) and
                      (defcoll^.paratype.def^.deftype<>formaldef) then
@@ -355,7 +353,7 @@ interface
                    { Causes problems with const ansistrings if also }
                    { done for vs_const (JM)                         }
                    if defcoll^.paratyp = vs_var then
-                     set_unique(left);
+                     left.set_unique;
                    make_not_regable(left);
                 end;
 
@@ -437,7 +435,7 @@ interface
                    end
                  else
                    begin
-                     hightree:=gennode(subn,geninlinenode(in_length_string,false,getcopy(left)),
+                     hightree:=caddnode.create(subn,geninlinenode(in_length_string,false,left.getcopy),
                                                genordinalconstnode(1,s32bitdef));
                      firstpass(hightree);
                      hightree:=gentypeconvnode(hightree,s32bitdef);
@@ -526,11 +524,11 @@ interface
              the specified value matches the range }
              or
              (
-              (left.treetype=ordconstn) and
+              (left.nodetype=ordconstn) and
               is_integer(resulttype) and
               is_integer(def) and
-              (left.value>=porddef(def)^.low) and
-              (left.value<=porddef(def)^.high)
+              (tordconstnode(left).value>=porddef(def)^.low) and
+              (tordconstnode(left).value<=porddef(def)^.high)
              )
            { to support ansi/long/wide strings in a proper way }
            { string and string[10] are assumed as equal }
@@ -542,12 +540,12 @@ interface
              )
              or
              (
-              (left.treetype=stringconstn) and
+              (left.nodetype=stringconstn) and
               (is_ansistring(resulttype) and is_pchar(def))
              )
              or
              (
-              (left.treetype=ordconstn) and
+              (left.nodetype=ordconstn) and
               (is_char(resulttype) and (is_shortstring(def) or is_ansistring(def)))
              )
            { set can also be a not yet converted array constructor }
@@ -560,8 +558,8 @@ interface
              or
              (
               (m_tp_procvar in aktmodeswitches) and
-              (def^.deftype=procvardef) and (left.treetype=calln) and
-              (proc_to_procvar_equal(pprocdef(left.procdefinition),pprocvardef(def)))
+              (def^.deftype=procvardef) and (left.nodetype=calln) and
+              (proc_to_procvar_equal(pprocdef(tcallnode(left).procdefinition),pprocvardef(def)))
              )
              ;
         end;
@@ -625,19 +623,19 @@ interface
               { calculate the type of the parameters }
               if assigned(left) then
                 begin
-                   firstcallparan(left,nil,false);
+                   tcallparanode(left).firstcallparan(nil,false);
                    if codegenerror then
                      goto errorexit;
                 end;
               firstpass(right);
-              set_varstate(right,true);
+              right.set_varstate(true);
 
               { check the parameters }
               pdc:=pparaitem(pprocvardef(right.resulttype)^.para^.first);
               pt:=left;
               while assigned(pdc) and assigned(pt) do
                 begin
-                   pt:=pt.right;
+                   pt:=tcallparanode(pt).right;
                    pdc:=pparaitem(pdc^.next);
                 end;
               if assigned(pt) or assigned(pdc) then
@@ -649,7 +647,7 @@ interface
               { insert type conversions }
               if assigned(left) then
                 begin
-                   firstcallparan(left,pparaitem(pprocvardef(right.resulttype)^.para^.first),true);
+                   tcallparanode(left).firstcallparan(pparaitem(pprocvardef(right.resulttype)^.para^.first),true);
                    if codegenerror then
                      goto errorexit;
                 end;
@@ -665,7 +663,7 @@ interface
               { determine the type of the parameters }
               if assigned(left) then
                 begin
-                   firstcallparan(left,nil,false);
+                   tcallparanode(left).firstcallparan(nil,false);
                    if codegenerror then
                      goto errorexit;
                 end;
@@ -705,7 +703,7 @@ interface
                    while assigned(pt) do
                      begin
                         inc(paralength);
-                        pt:=pt.right;
+                        pt:=tcallparanode(pt).right;
                      end;
 
                    { link all procedures which have the same # of parameters }
@@ -742,7 +740,7 @@ interface
                           if (symtableprocentry^.owner^.symtabletype=objectsymtable) and
                              (pobjectdef(symtableprocentry^.owner^.defowner)^.is_class) then
                            hpt:=genloadmethodcallnode(pprocsym(symtableprocentry),symtableproc,
-                                 getcopy(methodpointer))
+                                 methodpointer.getcopy)
                           else
                            hpt:=genloadcallnode(pprocsym(symtableprocentry),symtableproc);
                           firstpass(hpt);
@@ -783,7 +781,7 @@ interface
                                begin
                                   if hp^.nextpara^.paratype.def=pt.resulttype then
                                     begin
-                                       pt.exact_match_found:=true;
+                                       include(pt.flags,nf_exact_match_found);
                                        hp^.nextpara^.argconvtyp:=act_exact;
                                     end
                                   else
@@ -794,10 +792,10 @@ interface
                                begin
                                  hp^.nextpara^.argconvtyp:=act_convertable;
                                  hp^.nextpara^.convertlevel:=isconvertable(pt.resulttype,hp^.nextpara^.paratype.def,
-                                     hcvt,pt.left.treetype,false);
+                                     hcvt,tcallparanode(pt).left.nodetype,false);
                                  case hp^.nextpara^.convertlevel of
-                                  1 : pt.convlevel1found:=true;
-                                  2 : pt.convlevel2found:=true;
+                                  1 : include(pt.flags,nf_convlevel1found);
+                                  2 : include(pt.flags,nf_convlevel2found);
                                  end;
                                end;
 
@@ -856,7 +854,7 @@ interface
                           end;
                         { load next parameter or quit loop if no procs left }
                         if assigned(procs) then
-                          pt:=pt.right
+                          pt:=tcallparanode(pt).right
                         else
                           break;
                      end;
@@ -965,7 +963,7 @@ interface
                                   hp^.nextpara:=pparaitem(hp^.nextpara^.next);
                                   hp:=hp^.next;
                                end;
-                             pt:=pt.right;
+                             pt:=tcallparanode(pt).right;
                           end;
                      end;
 
@@ -984,7 +982,7 @@ interface
                         pt:=left;
                         while assigned(pt) do
                           begin
-                             if pt.exact_match_found then
+                             if nf_exact_match_found in pt.flags then
                                begin
                                  hp:=procs;
                                  procs:=nil;
@@ -1009,7 +1007,7 @@ interface
                                   hp^.nextpara:=pparaitem(hp^.nextpara^.next);
                                   hp:=hp^.next;
                                end;
-                             pt:=pt.right;
+                             pt:=tcallparanode(pt).right;
                           end;
                      end;
 
@@ -1031,7 +1029,7 @@ interface
                         while assigned(pt) do
                           begin
                             bestord:=nil;
-                            if (pt.left.treetype=ordconstn) and
+                            if (tcallparanode(pt).left.nodetype=ordconstn) and
                                is_integer(pt.resulttype) then
                              begin
                                hp:=procs;
@@ -1078,7 +1076,7 @@ interface
                                hp^.nextpara:=pparaitem(hp^.nextpara^.next);
                                hp:=hp^.next;
                              end;
-                            pt:=pt.right;
+                            pt:=tcallparanode(pt).right;
                           end;
                      end;
 
@@ -1100,7 +1098,8 @@ interface
                         pt:=left;
                         while assigned(pt) do
                           begin
-                             if pt.convlevel1found and pt.convlevel2found then
+                             if (nf_convlevel1found in pt.flags) and
+                               (nf_convlevel2found in pt.flags) then
                                begin
                                  hp:=procs;
                                  procs:=nil;
@@ -1126,7 +1125,7 @@ interface
                                   hp^.nextpara:=pparaitem(hp^.nextpara^.next);
                                   hp:=hp^.next;
                                end;
-                             pt:=pt.right;
+                             pt:=tcallparanode(pt).right;
                           end;
                      end;
 
@@ -1168,7 +1167,7 @@ interface
                      (procdefinition^._class=nil) then
                      begin
                         { not ok for extended }
-                        case methodpointer^.treetype of
+                        case methodpointer^.nodetype of
                            typen,hnewn : fatalerror(no_para_match);
                         end;
                         methodpointer.free;
@@ -1179,19 +1178,20 @@ interface
 
               is_const:=(pocall_internconst in procdefinition^.proccalloptions) and
                         ((block_type=bt_const) or
-                         (assigned(left) and (left.left.treetype in [realconstn,ordconstn])));
+                         (assigned(left) and (tcallparanode(left).left.nodetype in [realconstn,ordconstn])));
               { handle predefined procedures }
               if (pocall_internproc in procdefinition^.proccalloptions) or is_const then
                 begin
                    if assigned(left) then
                      begin
                      { settextbuf needs two args }
-                       if assigned(left.right) then
+                       if assigned(tcallparanode(left).right) then
                          pt:=geninlinenode(pprocdef(procdefinition)^.extnumber,is_const,left)
                        else
                          begin
-                           pt:=geninlinenode(pprocdef(procdefinition)^.extnumber,is_const,left.left);
-                           left.left:=nil;
+                           pt:=geninlinenode(pprocdef(procdefinition)^.extnumber,is_const,
+                             tcallparanode(left).left);
+                           tcallparanode(left).left:=nil;
                            left.free;
                          end;
                      end
@@ -1211,13 +1211,13 @@ interface
                 begin
                    if assigned(methodpointer) then
                      CGMessage(cg_e_unable_inline_object_methods);
-                   if assigned(right) and (right.treetype<>procinlinen) then
+                   if assigned(right) and (right.nodetype<>procinlinen) then
                      CGMessage(cg_e_unable_inline_procvar);
-                   { treetype:=procinlinen; }
+                   { nodetype:=procinlinen; }
                    if not assigned(right) then
                      begin
                         if assigned(pprocdef(procdefinition)^.code) then
-                          inlinecode:=genprocinlinenode(p,ptree(pprocdef(procdefinition)^.code))
+                          inlinecode:=genprocinlinenode(self,tnode(pprocdef(procdefinition)^.code))
                         else
                           CGMessage(cg_e_no_code_for_inline_stored);
                         if assigned(inlinecode) then
@@ -1256,9 +1256,7 @@ interface
 
               { work trough all parameters to insert the type conversions }
               if assigned(left) then
-                begin
-                   firstcallparan(left,pparaitem(procdefinition^.para^.first),true);
-                end;
+                tcallparanode(left).firstcallparan(pparaitem(procdefinition^.para^.first),true);
 {$ifndef newcg}
 {$ifdef i386}
               incrementregisterpushed(pprocdef(procdefinition)^.usedregisters);
@@ -1281,13 +1279,13 @@ interface
                 begin
                    { extra handling of classes }
                    { methodpointer should be assigned! }
-                   if assigned(methodpointer) and assigned(methodpointer^.resulttype) and
-                     (methodpointer^.resulttype^.deftype=classrefdef) then
+                   if assigned(methodpointer) and assigned(methodpointer.resulttype) and
+                     (methodpointer.resulttype^.deftype=classrefdef) then
                      begin
                         location.loc:=LOC_REGISTER;
                         registers32:=1;
                         { the result type depends on the classref }
-                        resulttype:=pclassrefdef(methodpointer^.resulttype)^.pointertype.def;
+                        resulttype:=pclassrefdef(methodpointer.resulttype)^.pointertype.def;
                      end
                   { a object constructor returns the result with the flags }
                    else
@@ -1339,7 +1337,7 @@ interface
          { if this is a call to a method calc the registers }
          if (methodpointer<>nil) then
            begin
-              case methodpointer^.treetype of
+              case methodpointer.nodetype of
                 { but only, if this is not a supporting node }
                 typen: ;
                 { we need one register for new return value PM }
@@ -1348,8 +1346,8 @@ interface
                 else
                   begin
                      if (procdefinition^.proctypeoption in [potype_constructor,potype_destructor]) and
-                        assigned(symtable) and (symtable^.symtabletype=withsymtable) and
-                        not pwithsymtable(symtable)^.direct_with then
+                        assigned(symtableproc) and (symtableproc^.symtabletype=withsymtable) and
+                        not pwithsymtable(symtableproc)^.direct_with then
                        begin
                           CGmessage(cg_e_cannot_call_cons_dest_inside_with);
                        end; { Is accepted by Delphi !! }
@@ -1359,22 +1357,22 @@ interface
                      { R.Assign is not a constructor !!! }
                      { but for R^.Assign, R must be valid !! }
                      if (procdefinition^.proctypeoption=potype_constructor) or
-                        ((methodpointer^.treetype=loadn) and
-                        (not(oo_has_virtual in pobjectdef(methodpointer^.resulttype)^.objectoptions))) then
+                        ((methodpointer.nodetype=loadn) and
+                        (not(oo_has_virtual in pobjectdef(methodpointer.resulttype)^.objectoptions))) then
                        method_must_be_valid:=false
                      else
                        method_must_be_valid:=true;
                      firstpass(methodpointer);
-                     set_varstate(methodpointer,method_must_be_valid);
+                     methodpointer.set_varstate(method_must_be_valid);
                      { The object is already used ven if it is called once }
-                     if (methodpointer^.treetype=loadn) and
-                        (methodpointer^.symtableentry^.typ=varsym) then
-                       pvarsym(methodpointer^.symtableentry)^.varstate:=vs_used;
+                     if (methodpointer.nodetype=loadn) and
+                        (tloadnode(methodpointer).symtableentry^.typ=varsym) then
+                       pvarsym(tloadnode(methodpointer).symtableentry)^.varstate:=vs_used;
 
-                     registersfpu:=max(methodpointer^.registersfpu,registersfpu);
-                     registers32:=max(methodpointer^.registers32,registers32);
+                     registersfpu:=max(methodpointer.registersfpu,registersfpu);
+                     registers32:=max(methodpointer.registers32,registers32);
 {$ifdef SUPPORT_MMX}
-                     registersmmx:=max(methodpointer^.registersmmx,registersmmx);
+                     registersmmx:=max(methodpointer.registersmmx,registersmmx);
 {$endif SUPPORT_MMX}
                   end;
               end;
@@ -1414,11 +1412,11 @@ interface
                             TPROCINLINENODE
  ****************************************************************************}
 
-    constructor tprocinlinenode.create(callp,code : tnode) : tnode;
+    constructor tprocinlinenode.create(callp,code : tnode);
 
       begin
          inherited create(procinlinen);
-         inlineprocsym:=callp.symtableprocentry;
+         inlineprocsym:=tcallnode(callp).symtableprocentry;
          retoffset:=-4; { less dangerous as zero (PM) }
          para_offset:=0;
       {$IFDEF NEWST}
@@ -1443,6 +1441,21 @@ interface
       {$ENDIF NEWST}
       end;
 
+    function tprocinlinenode.getcopy : tnode;
+
+      var
+         n : tprocinlinenode;
+
+      begin
+         n:=tprocinlinenode(inherited getcopy);
+         n.inlinetree:=inlinetree.getcopy;
+         n.inlineprocsym:=inlineprocsym;
+         n.retoffset:=retoffset;
+         n.para_offset:=para_offset;
+         n.para_size:=para_size;
+         getcopy:=n;
+      end;
+
     function tprocinlinenode.pass_1 : tnode;
       begin
         pass_1:=nil;
@@ -1459,7 +1472,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.6  2000-09-27 18:14:31  florian
+  Revision 1.7  2000-09-28 19:49:52  florian
+  *** empty log message ***
+
+  Revision 1.6  2000/09/27 18:14:31  florian
     * fixed a lot of syntax errors in the n*.pas stuff
 
   Revision 1.5  2000/09/24 21:15:34  florian

compiler/ncnv.pas

@@ -31,7 +31,7 @@ interface
 
     type
        ttypeconvnode = class(tunarynode)
-          convtyp : tconverttype;
+          convtype : tconverttype;
           constructor create(node : tnode;t : pdef);virtual;
           function getcopy : tnode;override;
           function pass_1 : tnode;override;
@@ -77,7 +77,7 @@ interface
        casnode : class of tasnode;
        cisnode : class of tisnode;
 
-    function gentypeconvnode(node : tnode;t : pdef) : tnode;
+    function gentypeconvnode(node : tnode;t : pdef) : ttypeconvnode;
     procedure arrayconstructor_to_set(var p : tarrayconstructnode);
 
 implementation
@@ -95,6 +95,12 @@ implementation
       htypechk,pass_1,cpubase;
 
 
+    function gentypeconvnode(node : tnode;t : pdef) : ttypeconvnode;
+
+      begin
+         gentypeconvnode:=ctypeconvnode.create(node,t);
+      end;
+
 {*****************************************************************************
                     Array constructor to Set Conversion
 *****************************************************************************}
@@ -305,7 +311,7 @@ implementation
                buildp:=caddnode.create(addn,buildp,p4);
             { load next and dispose current node }
               p2:=p;
-              p:=tarrayconstrucnode(p.right);
+              p:=tarrayconstructnode(p.right);
               tarrayconstructnode(p2).right:=nil;
               p2.free;
             end;
@@ -331,6 +337,29 @@ implementation
                            TTYPECONVNODE
 *****************************************************************************}
 
+
+    constructor ttypeconvnode.create(node : tnode;t : pdef);
+
+      begin
+         inherited create(typeconvn,node);
+         convtype:=tc_not_possible;
+         resulttype:=t;
+         set_file_line(node);
+      end;
+
+
+    function ttypeconvnode.getcopy : tnode;
+
+      var
+         n : ttypeconvnode;
+
+      begin
+         n:=ttypeconvnode(inherited getcopy);
+         n.convtype:=convtype;
+         getcopy:=n;
+      end;
+
+
     function ttypeconvnode.first_int_to_int : tnode;
       begin
         first_int_to_int:=nil;
@@ -777,7 +806,7 @@ implementation
                  psetdef(resulttype)^.settype:=normset
                end
               else
-               convtyp:=tc_load_smallset;
+               convtype:=tc_load_smallset;
               exit;
             end
            else
@@ -802,7 +831,7 @@ implementation
             exit;
          end;
 
-       if isconvertable(left.resulttype,resulttype,convtyp,left.nodetype,nf_explizit in flags)=0 then
+       if isconvertable(left.resulttype,resulttype,convtype,left.nodetype,nf_explizit in flags)=0 then
          begin
            {Procedures have a resulttype of voiddef and functions of their
            own resulttype. They will therefore always be incompatible with
@@ -860,14 +889,14 @@ implementation
                     if (left.nodetype<>addrn) then
                       aprocdef:=pprocsym(tloadnode(left).symtableentry)^.definition;
                   end;
-                 convtyp:=tc_proc_2_procvar;
+                 convtype:=tc_proc_2_procvar;
                  { Now check if the procedure we are going to assign to
                    the procvar,  is compatible with the procvar's type }
                  if assigned(aprocdef) then
                   begin
                     if not proc_to_procvar_equal(aprocdef,pprocvardef(resulttype)) then
                      CGMessage2(type_e_incompatible_types,aprocdef^.typename,resulttype^.typename);
-                    pass_1:=call_helper(convtyp);
+                    pass_1:=call_helper(convtype);
                   end
                  else
                   CGMessage2(type_e_incompatible_types,left.resulttype^.typename,resulttype^.typename);
@@ -886,20 +915,20 @@ implementation
               if is_integer(resulttype) and
                  is_boolean(left.resulttype) then
                begin
-                  convtyp:=tc_bool_2_int;
-                  pass_1:=call_helper(convtyp);
+                  convtype:=tc_bool_2_int;
+                  pass_1:=call_helper(convtype);
                   exit;
                end;
               { ansistring to pchar }
               if is_pchar(resulttype) and
                  is_ansistring(left.resulttype) then
                begin
-                 convtyp:=tc_ansistring_2_pchar;
-                 pass_1:=call_helper(convtyp);
+                 convtype:=tc_ansistring_2_pchar;
+                 pass_1:=call_helper(convtype);
                  exit;
                end;
               { do common tc_equal cast }
-              convtyp:=tc_equal;
+              convtype:=tc_equal;
 
               { enum to ordinal will always be s32bit }
               if (left.resulttype^.deftype=enumdef) and
@@ -914,7 +943,7 @@ implementation
                   end
                  else
                   begin
-                    if isconvertable(s32bitdef,resulttype,convtyp,ordconstn,false)=0 then
+                    if isconvertable(s32bitdef,resulttype,convtype,ordconstn,false)=0 then
                       CGMessage2(type_e_incompatible_types,left.resulttype^.typename,resulttype^.typename);
                   end;
                end
@@ -933,7 +962,7 @@ implementation
                    end
                   else
                    begin
-                     if IsConvertable(left.resulttype,s32bitdef,convtyp,ordconstn,false)=0 then
+                     if IsConvertable(left.resulttype,s32bitdef,convtype,ordconstn,false)=0 then
                        CGMessage2(type_e_incompatible_types,left.resulttype^.typename,resulttype^.typename);
                    end;
                 end
@@ -962,7 +991,7 @@ implementation
                     end
                    else
                     begin
-                      if IsConvertable(left.resulttype,u8bitdef,convtyp,ordconstn,false)=0 then
+                      if IsConvertable(left.resulttype,u8bitdef,convtype,ordconstn,false)=0 then
                         CGMessage2(type_e_incompatible_types,left.resulttype^.typename,resulttype^.typename);
                     end;
                  end
@@ -981,7 +1010,7 @@ implementation
                     end
                    else
                     begin
-                      if IsConvertable(u8bitdef,resulttype,convtyp,ordconstn,false)=0 then
+                      if IsConvertable(u8bitdef,resulttype,convtype,ordconstn,false)=0 then
                         CGMessage2(type_e_incompatible_types,left.resulttype^.typename,resulttype^.typename);
                     end;
                  end
@@ -1046,8 +1075,8 @@ implementation
              pass_1:=hp;
              exit;
           end;
-        if convtyp<>tc_equal then
-          pass_1:=call_helper(convtyp);
+        if convtype<>tc_equal then
+          pass_1:=call_helper(convtype);
       end;
 
 
@@ -1142,7 +1171,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.4  2000-09-27 18:14:31  florian
+  Revision 1.5  2000-09-28 19:49:52  florian
+  *** empty log message ***
+
+  Revision 1.4  2000/09/27 18:14:31  florian
     * fixed a lot of syntax errors in the n*.pas stuff
 
   Revision 1.3  2000/09/26 20:06:13  florian

compiler/ncon.pas

@@ -119,6 +119,7 @@ interface
     function is_constresourcestringnode(p : tnode) : boolean;
     function str_length(p : tnode) : longint;
     function is_emptyset(p : tnode):boolean;
+    function genconstsymtree(p : pconstsym) : tnode;
 
 implementation
 
@@ -131,6 +132,7 @@ implementation
          genordinalconstnode:=cordconstnode.create(v,def);
       end;
 
+
     function genintconstnode(v : TConstExprInt) : tordconstnode;
 
       var
@@ -145,36 +147,43 @@ implementation
            genintconstnode:=genordinalconstnode(v,cs64bitdef);
       end;
 
+
     function genpointerconstnode(v : tpointerord;def : pdef) : tpointerconstnode;
       begin
          genpointerconstnode:=cpointerconstnode.create(v,def);
       end;
 
+
     function genenumnode(v : penumsym) : tordconstnode;
       begin
          genenumnode:=cordconstnode.create(v^.value,v^.definition);
       end;
 
+
     function gensetconstnode(s : pconstset;settype : psetdef) : tsetconstnode;
       begin
          gensetconstnode:=csetconstnode.create(s,settype);
       end;
 
+
     function genrealconstnode(v : bestreal;def : pdef) : trealconstnode;
       begin
          genrealconstnode:=crealconstnode.create(v,def);
       end;
 
+
     function genfixconstnode(v : longint;def : pdef) : tfixconstnode;
       begin
          genfixconstnode:=cfixconstnode.create(v,def);
       end;
 
+
     function genstringconstnode(const s : string;st:tstringtype) : tstringconstnode;
       begin
          genstringconstnode:=cstringconstnode.createstr(s,st);
       end;
 
+
     function genpcharconstnode(s : pchar;length : longint) : tstringconstnode;
       begin
          genpcharconstnode:=cstringconstnode.createpchar(s,length);
@@ -210,12 +219,14 @@ implementation
          is_constcharnode:=(p.nodetype=ordconstn) and is_char(p.resulttype);
       end;
 
+
     function is_constrealnode(p : tnode) : boolean;
 
       begin
          is_constrealnode:=(p.nodetype=realconstn);
       end;
 
+
     function is_constboolnode(p : tnode) : boolean;
 
       begin
@@ -234,9 +245,10 @@ implementation
     function str_length(p : tnode) : longint;
 
       begin
-         str_length:=tstrconstnode(p).length;
+         str_length:=tstringconstnode(p).len;
       end;
 
+
     function is_emptyset(p : tnode):boolean;
 
       var
@@ -252,6 +264,49 @@ implementation
       end;
 
 
+    function genconstsymtree(p : pconstsym) : tnode;
+      var
+        p1  : tnode;
+        len : longint;
+        pc  : pchar;
+      begin
+        p1:=nil;
+        case p^.consttyp of
+          constint :
+            p1:=genordinalconstnode(p^.value,s32bitdef);
+          conststring :
+            begin
+              len:=p^.len;
+              if not(cs_ansistrings in aktlocalswitches) and (len>255) then
+               len:=255;
+              getmem(pc,len+1);
+              move(pchar(tpointerord(p^.value))^,pc^,len);
+              pc[len]:=#0;
+              p1:=genpcharconstnode(pc,len);
+            end;
+          constchar :
+            p1:=genordinalconstnode(p^.value,cchardef);
+          constreal :
+            p1:=genrealconstnode(pbestreal(tpointerord(p^.value))^,bestrealdef^);
+          constbool :
+            p1:=genordinalconstnode(p^.value,booldef);
+          constset :
+            p1:=gensetconstnode(pconstset(tpointerord(p^.value)),psetdef(p^.consttype.def));
+          constord :
+            p1:=genordinalconstnode(p^.value,p^.consttype.def);
+          constpointer :
+            p1:=genpointerconstnode(p^.value,p^.consttype.def);
+          constnil :
+            p1:=cnilnode.create;
+          constresourcestring:
+            begin
+              p1:=genloadnode(pvarsym(p),pvarsym(p)^.owner);
+              p1.resulttype:=cansistringdef;
+            end;
+        end;
+        genconstsymtree:=p1;
+      end;
+
 {*****************************************************************************
                              TREALCONSTNODE
 *****************************************************************************}
@@ -561,7 +616,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.6  2000-09-27 20:25:44  florian
+  Revision 1.7  2000-09-28 19:49:52  florian
+  *** empty log message ***
+
+  Revision 1.6  2000/09/27 20:25:44  florian
     * more stuff fixed
 
   Revision 1.5  2000/09/27 18:14:31  florian

compiler/nflw.pas

@@ -38,7 +38,7 @@ interface
           function getcopy : tnode;override;
        end;
 
-       tlabelednode = class(tnode)
+       tlabelednode = class(tunarynode)
           labelnr : pasmlabel;
           exceptionblock : tnode;
           labsym : plabelsym;
@@ -76,7 +76,9 @@ interface
        end;
 
        traisenode = class(tbinarynode)
+          frametree : tnode;
           constructor create;virtual;
+          function getcopy : tnode;override;
           function pass_1 : tnode;override;
        end;
 
@@ -95,7 +97,6 @@ interface
           excepttype : pobjectdef;
           constructor create;virtual;
           function pass_1 : tnode;override;
-          destructor destroy;override;
           function getcopy : tnode;override;
        end;
 
@@ -122,7 +123,8 @@ implementation
     uses
       globtype,systems,
       cutils,cobjects,verbose,globals,
-      symconst,types,htypechk,pass_1,ncon,nmem
+      symconst,types,htypechk,pass_1,
+      ncon,nmem,nld,ncnv
 {$ifdef newcg}
       ,tgobj
       ,tgcpu
@@ -482,26 +484,26 @@ implementation
           hp:=tsubscriptnode(hp).left;
          { we need a simple loadn, but the load must be in a global symtable or
            in the same lexlevel }
-         if (hp.treetype=funcretn) or
-            ((hp.treetype=loadn) and
-             ((hp.symtable^.symtablelevel<=1) or
-              (hp.symtable^.symtablelevel=lexlevel))) then
+         if (hp.nodetype=funcretn) or
+            ((hp.nodetype=loadn) and
+             ((tloadnode(hp).symtable^.symtablelevel<=1) or
+              (tloadnode(hp).symtable^.symtablelevel=lexlevel))) then
           begin
-            if hp.symtableentry^.typ=varsym then
-              pvarsym(hp.symtableentry)^.varstate:=vs_used;
-            if (not(is_ordinal(t2^.resulttype)) or is_64bitint(t2^.resulttype)) then
+            if tloadnode(hp).symtableentry^.typ=varsym then
+              pvarsym(tloadnode(hp).symtableentry)^.varstate:=vs_used;
+            if (not(is_ordinal(t2.resulttype)) or is_64bitint(t2.resulttype)) then
               CGMessagePos(hp.fileinfo,type_e_ordinal_expr_expected);
           end
          else
           CGMessagePos(hp.fileinfo,cg_e_illegal_count_var);
 
-         if t2^.registers32>registers32 then
-           registers32:=t2^.registers32;
-         if t2^.registersfpu>registersfpu then
-           registersfpu:=t2^.registersfpu;
+         if t2.registers32>registers32 then
+           registers32:=t2.registers32;
+         if t2.registersfpu>registersfpu then
+           registersfpu:=t2.registersfpu;
 {$ifdef SUPPORT_MMX}
-         if t2^.registersmmx>registersmmx then
-           registersmmx:=t2^.registersmmx;
+         if t2.registersmmx>registersmmx then
+           registersmmx:=t2.registersmmx;
 {$endif SUPPORT_MMX}
 
 {$ifdef newcg}
@@ -511,9 +513,9 @@ implementation
 {$endif newcg}
          firstpass(right);
          right.set_varstate(true);
-         if right.treetype<>ordconstn then
+         if right.nodetype<>ordconstn then
            begin
-              right:=gentypeconvnode(right,t2^.resulttype);
+              right:=gentypeconvnode(right,t2.resulttype);
 {$ifdef newcg}
               tg.cleartempgen;
 {$else newcg}
@@ -548,7 +550,7 @@ implementation
 
     function texitnode.pass_1 : tnode;
       var
-         pt : tnode;
+         pt : tfuncretnode;
       begin
          pass_1:=nil;
          resulttype:=voiddef;
@@ -563,10 +565,10 @@ implementation
               firstpass(left);
               if ret_in_param(procinfo^.returntype.def) or procinfo^.no_fast_exit then
                 begin
-                  pt:=genzeronode(funcretn);
-                  pt^.rettype.setdef(procinfo^.returntype.def);
-                  pt^.funcretprocinfo:=procinfo;
-                  left:=gennode(assignn,pt,left);
+                  pt:=cfuncretnode.create;
+                  pt.rettype.setdef(procinfo^.returntype.def);
+                  pt.funcretprocinfo:=procinfo;
+                  left:=cassignmentnode.create(pt,left);
                   firstpass(left);
                 end;
               registers32:=left.registers32;
@@ -629,6 +631,19 @@ implementation
     constructor traisenode.create;
 
       begin
+         inherited create(raisen,nil,nil);
+         frametree:=nil;
+      end;
+
+    function traisenode.getcopy : tnode;
+
+      var
+         n : traisenode;
+
+      begin
+         n:=traisenode(inherited getcopy);
+         n.frametree:=frametree;
+         getcopy:=n;
       end;
 
     function traisenode.pass_1 : tnode;
@@ -643,7 +658,7 @@ implementation
                  ((left.resulttype^.deftype<>objectdef) or
                   not(pobjectdef(left.resulttype)^.is_class)) then
                 CGMessage(type_e_mismatch);
-              left.set_varstate(left);
+              left.set_varstate(true);
               if codegenerror then
                exit;
               { insert needed typeconvs for addr,frame }
@@ -665,7 +680,7 @@ implementation
                      exit;
                   end;
                end;
-              left_right_max(p);
+              left_right_max;
            end;
       end;
 
@@ -720,10 +735,10 @@ implementation
               aktexceptblock:=t1;
               firstpass(t1);
               aktexceptblock:=oldexceptblock;
-              registers32:=max(registers32,t1^.registers32);
-              registersfpu:=max(registersfpu,t1^.registersfpu);
+              registers32:=max(registers32,t1.registers32);
+              registersfpu:=max(registersfpu,t1.registersfpu);
 {$ifdef SUPPORT_MMX}
-              registersmmx:=max(registersmmx,t1^.registersmmx);
+              registersmmx:=max(registersmmx,t1.registersmmx);
 {$endif SUPPORT_MMX}
            end;
       end;
@@ -768,7 +783,7 @@ implementation
          right.set_varstate(true);
          if codegenerror then
            exit;
-         left_right_max(p);
+         left_right_max;
       end;
 
 
@@ -779,6 +794,20 @@ implementation
     constructor tonnode.create;
 
       begin
+         inherited create(onn,nil,nil);
+         exceptsymtable:=nil;
+         excepttype:=nil;
+      end;
+
+    function tonnode.getcopy : tnode;
+
+      var
+         n : tonnode;
+
+      begin
+         n:=tonnode(inherited getcopy);
+         n.exceptsymtable:=exceptsymtable;
+         n.excepttype:=excepttype;
       end;
 
     function tonnode.pass_1 : tnode;
@@ -846,7 +875,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.3  2000-09-24 21:15:34  florian
+  Revision 1.4  2000-09-28 19:49:52  florian
+  *** empty log message ***
+
+  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

compiler/ninl.pas

@@ -27,7 +27,7 @@ unit ninl;
 interface
 
     uses
-       node;
+       node,htypechk;
 
     {$i innr.inc}
 
@@ -50,7 +50,7 @@ implementation
       cobjects,verbose,globals,systems,
       globtype,
       symconst,symtable,aasm,types,
-      pass_1,htypechk,
+      pass_1,
       ncal,ncon,ncnv,nadd,nld,
       cpubase
 {$ifdef newcg}
@@ -110,7 +110,7 @@ implementation
          dowrite,
          file_is_typed : boolean;
 
-      procedure do_lowhigh(adef : pdef);
+      function do_lowhigh(adef : pdef) : tnode;
 
         var
            v : longint;
@@ -126,7 +126,7 @@ implementation
                     v:=porddef(adef)^.high;
                   hp:=genordinalconstnode(v,adef);
                   firstpass(hp);
-                  pass_1:=hp;
+                  do_lowhigh:=hp;
                end;
              enumdef:
                begin
@@ -135,7 +135,7 @@ implementation
                     while enum^.nextenum<>nil do
                       enum:=enum^.nextenum;
                   hp:=genenumnode(enum);
-                  pass_1:=hp;
+                  do_lowhigh:=hp;
                end;
            else
              internalerror(87);
@@ -193,7 +193,7 @@ implementation
                 tcallparanode(left).firstcallparan(nil,false)
               else
                 firstpass(left);
-              left_right_max(self);
+              left_max;
               set_location(location,left.location);
            end;
          inc(parsing_para_level);
@@ -511,7 +511,7 @@ implementation
                                begin
                                   hp:=gentypeconvnode(left,u8bitdef);
                                   left:=nil;
-                                  ttypeconvnode(hp).convtyp:=tc_bool_2_int;
+                                  ttypeconvnode(hp).convtype:=tc_bool_2_int;
                                   include(hp.flags,nf_explizit);
                                   firstpass(hp);
                                   pass_1:=hp;
@@ -879,7 +879,7 @@ implementation
                        tcallparanode(left).firstcallparan(nil,true);
                        left.set_varstate(true);
                        { calc registers }
-                       left_right_max(self);
+                       left_max;
                        if extra_register then
                          inc(registers32);
                     end;
@@ -930,7 +930,7 @@ implementation
                   tcallparanode(left).firstcallparan(nil,true);
                   left.set_varstate(false);
                   { remove warning when result is passed }
-                  set_funcret_is_valid(tcallparanode(left).left);
+                  tcallparanode(left).left.set_funcret_is_valid;
                   tcallparanode(left).right:=hp;
                   tcallparanode(tcallparanode(left).right).firstcallparan(nil,true);
                   tcallparanode(left).right.set_varstate(true);
@@ -1015,7 +1015,7 @@ implementation
                     exit;
                   tcallparanode(left).firstcallparan(nil,true);
                   { calc registers }
-                  left_right_max(self);
+                  left_max;
                end;
 
              in_val_x :
@@ -1063,7 +1063,7 @@ implementation
                   if codegenerror then
                     exit;
                   { remove warning when result is passed }
-                  set_funcret_is_valid(tcallparanode(hpp).left);
+                  tcallparanode(hpp).left.set_funcret_is_valid;
                   tcallparanode(hpp).right := hp;
                   if valid_for_assign(tcallparanode(hpp).left,false) then
                    begin
@@ -1088,7 +1088,7 @@ implementation
                      firstpass(hp);
                    end;
                   { calc registers }
-                  left_right_max(self);
+                  left_max;
 
                   { val doesn't calculate the registers really }
                   { correct, we need one register extra   (FK) }
@@ -1112,7 +1112,7 @@ implementation
                       registersmmx:=left.registersmmx;
 {$endif SUPPORT_MMX}
                       { remove warning when result is passed }
-                      set_funcret_is_valid(tcallparanode(left).left);
+                      tcallparanode(left).left.set_funcret_is_valid;
                       { first param must be var }
                       valid_for_assign(tcallparanode(left).left,false);
                       { check type }
@@ -1152,13 +1152,15 @@ implementation
                        case left.resulttype^.deftype of
                           orddef,enumdef:
                             begin
-                               do_lowhigh(left.resulttype);
-                               firstpass(p);
+                               hp:=do_lowhigh(left.resulttype);
+                               firstpass(hp);
+                               pass_1:=hp;
                             end;
                           setdef:
                             begin
-                               do_lowhigh(Psetdef(left.resulttype)^.elementtype.def);
-                               firstpass(p);
+                               hp:=do_lowhigh(Psetdef(left.resulttype)^.elementtype.def);
+                               firstpass(hp);
+                               pass_1:=hp;
                             end;
                          arraydef:
                             begin
@@ -1364,7 +1366,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.4  2000-09-28 16:34:47  florian
+  Revision 1.5  2000-09-28 19:49:52  florian
+  *** empty log message ***
+
+  Revision 1.4  2000/09/28 16:34:47  florian
   *** empty log message ***
 
   Revision 1.3  2000/09/27 21:33:22  florian

compiler/nld.pas

@@ -599,7 +599,7 @@ implementation
       procedure postprocess(t : tnode);
 
         begin
-           calcregisters(t,0,0,0);
+           calcregisters(tbinarynode(t),0,0,0);
            { looks a little bit dangerous to me            }
            { len-1 gives problems with is_open_array if len=0, }
            { is_open_array checks now for isconstructor (FK)   }
@@ -769,7 +769,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.3  2000-09-27 18:14:31  florian
+  Revision 1.4  2000-09-28 19:49:52  florian
+  *** empty log message ***
+
+  Revision 1.3  2000/09/27 18:14:31  florian
     * fixed a lot of syntax errors in the n*.pas stuff
 
   Revision 1.2  2000/09/25 15:37:14  florian

compiler/nmem.pas

@@ -130,7 +130,7 @@ implementation
       globtype,systems,
       cutils,cobjects,verbose,globals,
       symconst,aasm,types,
-      htypechk,pass_1,ncal,nld
+      htypechk,pass_1,ncal,nld,ncon,ncnv
 {$ifdef newcg}
       ,cgbase
 {$else newcg}
@@ -157,7 +157,7 @@ implementation
          !!!!!!!!! fixme
          p:=getnode;
          disposetyp:=dt_with;
-         treetype:=withn;
+         nodetype:=withn;
          left:=l;
          right:=r;
          registers32:=0;
@@ -443,16 +443,16 @@ implementation
                        { we need to process the parameters reverse so they are inserted
                          in the correct right2left order (PFV) }
                        hp2:=pparaitem(hp3^.para^.last);
-                       while assigned(hp2^.) do
+                       while assigned(hp2) do
                          begin
                             pprocvardef(resulttype)^.concatpara(hp2^.paratype,hp2^.paratyp,hp2^.defaultvalue);
-                            hp2^.:=pparaitem(hp2^.previous);
+                            hp2:=pparaitem(hp2^.previous);
                          end;
                     end
                   else
                     resulttype:=voidpointerdef;
 
-                  disposetree(left);
+                  left.free;
                   left:=hp;
                 end
               else
@@ -460,11 +460,11 @@ implementation
                   firstpass(left);
                   { what are we getting the address from an absolute sym? }
                   hp:=left;
-                  while assigned(hp) and (hp.treetype in [vecn,derefn,subscriptn]) do
-                   hp:=hp.left;
-                  if assigned(hp) and (hp.treetype=loadn) and
-                     ((hp.symtableentry^.typ=absolutesym) and
-                      pabsolutesym(hp.symtableentry)^.absseg) then
+                  while assigned(hp) and (hp.nodetype in [vecn,derefn,subscriptn]) do
+                   hp:=tunarynode(hp).left;
+                  if assigned(hp) and (hp.nodetype=loadn) and
+                     ((tloadnode(hp).symtableentry^.typ=absolutesym) and
+                      pabsolutesym(tloadnode(hp).symtableentry)^.absseg) then
                    begin
                      if not(cs_typed_addresses in aktlocalswitches) then
                        resulttype:=voidfarpointerdef
@@ -483,7 +483,7 @@ implementation
          firstpass(left);
          { this is like the function addr }
          inc(parsing_para_level);
-         set_varstate(left,false);
+         left.set_varstate(false);
          dec(parsing_para_level);
          if codegenerror then
            exit;
@@ -532,7 +532,7 @@ implementation
          make_not_regable(left);
          firstpass(left);
          inc(parsing_para_level);
-         set_varstate(left,false);
+         left.set_varstate(false);
          dec(parsing_para_level);
          if resulttype=nil then
            resulttype:=voidpointerdef;
@@ -570,7 +570,7 @@ implementation
       begin
          pass_1:=nil;
          firstpass(left);
-         set_varstate(left,true);
+         left.set_varstate(true);
          if codegenerror then
            begin
              resulttype:=generrordef;
@@ -595,11 +595,12 @@ implementation
                             TSUBSCRIPTNODE
 *****************************************************************************}
 
-    constructor tsubscriptnode.create(varsym : pvarsym;l : tnode);
+    constructor tsubscriptnode.create(varsym : psym;l : tnode);
 
       begin
          inherited create(subscriptn,l);
-         vs:=varsym;
+         { vs should be changed to psym! }
+         vs:=pvarsym(varsym);
       end;
 
     function tsubscriptnode.getcopy : tnode;
@@ -728,11 +729,11 @@ implementation
              CGMessage(type_e_array_required);
 
          { the register calculation is easy if a const index is used }
-         if right.treetype=ordconstn then
+         if right.nodetype=ordconstn then
            begin
 {$ifdef consteval}
               { constant evaluation }
-              if (left.treetype=loadn) and
+              if (left.nodetype=loadn) and
                  (left.symtableentry^.typ=typedconstsym) then
                begin
                  tcsym:=ptypedconstsym(left.symtableentry);
@@ -839,7 +840,7 @@ implementation
       begin
          p:=twithnode(inherited getcopy);
          p.withsymtable:=withsymtable;
-         p.tablecount:=count;
+         p.tablecount:=tablecount;
          p.withreference:=withreference;
       end;
 
@@ -859,24 +860,23 @@ implementation
                symtable:=withsymtable;
                for i:=1 to tablecount do
                  begin
-                    if (left.treetype=loadn) and
-                       (left.symtable=aktprocsym^.definition^.localst) then
+                    if (left.nodetype=loadn) and
+                       (tloadnode(left).symtable=aktprocsym^.definition^.localst) then
                       symtable^.direct_with:=true;
-                    symtable^.withnode:=p;
+                    symtable^.withnode:=self;
                     symtable:=pwithsymtable(symtable^.next);
                   end;
                firstpass(right);
                if codegenerror then
                  exit;
 
-               left_right_max(p);
+               left_right_max;
                resulttype:=voiddef;
             end
          else
            begin
               { optimization }
-              disposetree(p);
-              p:=nil;
+              pass_1:=nil;
            end;
       end;
 
@@ -884,7 +884,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.3  2000-09-25 15:37:14  florian
+  Revision 1.4  2000-09-28 19:49:52  florian
+  *** empty log message ***
+
+  Revision 1.3  2000/09/25 15:37:14  florian
     * more fixes
 
   Revision 1.2  2000/09/25 15:05:25  florian

compiler/node.inc

@@ -36,7 +36,7 @@
          fileinfo:=aktfilepos;
          localswitches:=aktlocalswitches;
          resulttype:=nil;
-         registersint:=0;
+         registers32:=0;
          registersfpu:=0;
 {$ifdef SUPPORT_MMX}
          registersmmx:=0;
@@ -196,17 +196,16 @@
       begin
          { this is quite tricky because we need a node of the current }
          { node type and not one of tnode!                            }
-         p:=classtype.createforcopy;
+         p:=tnode(classtype).createforcopy;
          p.nodetype:=nodetype;
          p.location:=location;
-         p.varstateset:=varstateset;
          p.parent:=parent;
          p.flags:=flags;
-         p.registers32:=registers32
+         p.registers32:=registers32;
          p.registersfpu:=registersfpu;
 {$ifdef SUPPORT_MMX}
          p.registersmmx:=registersmmx;
-         p.registerskni:=registerskni
+         p.registerskni:=registerskni;
 {$endif SUPPORT_MMX}
          p.resulttype:=resulttype;
          p.fileinfo:=fileinfo;
@@ -260,7 +259,7 @@
       begin
          case nodetype of
             funcretn:
-              if is_first_funcret in flags) then
+              if nf_is_first_funcret in flags then
                 pprocinfo(tfuncretnode(self).funcretprocinfo)^.funcret_state:=vs_assigned;
             vecn,typeconvn,subscriptn{,derefn}:
               if assigned(tunarynode(self).left) then
@@ -417,7 +416,7 @@
            left.isequal(tunarynode(p).left);
       end;
 
-    function.tunarynode.getcopy : tnode;
+    function tunarynode.getcopy : tnode;
 
       var
          p : tunarynode;
@@ -439,6 +438,16 @@
       end;
 {$endif}
 
+    procedure tunarynode.left_max;
+
+      begin
+         registers32:=left.registers32;
+         registersfpu:=left.registersfpu;
+{$ifdef SUPPORT_MMX}
+         registersmmx:=left.registersmmx;
+{$endif SUPPORT_MMX}
+      end;
+
     procedure tunarynode.concattolist(l : plinkedlist);
 
       begin
@@ -515,7 +524,7 @@
            right.isequal(tbinarynode(p).right);
       end;
 
-    function.tbinarynode.getcopy : tnode;
+    function tbinarynode.getcopy : tnode;
 
       var
          p : tbinarynode;
@@ -591,6 +600,7 @@
                begin
                   CGMessage(parser_e_operator_not_overloaded);
                   t.free;
+                  t:=nil;
                end
              else
                begin
@@ -601,9 +611,6 @@
                     t:=cnotnode.create(t);
 
                   firstpass(t);
-
-                  putnode(p);
-                  p:=t;
                end;
           end;
       end;
@@ -666,7 +673,10 @@
       end;
 {
   $Log$
-  Revision 1.5  2000-09-27 18:14:31  florian
+  Revision 1.6  2000-09-28 19:49:52  florian
+  *** empty log message ***
+
+  Revision 1.5  2000/09/27 18:14:31  florian
     * fixed a lot of syntax errors in the n*.pas stuff
 
   Revision 1.4  2000/09/26 20:06:13  florian

compiler/node.pas

@@ -35,14 +35,18 @@ interface
 implementation
 
     uses
-       htypechk,ncal,hcodegen,verbose,nmat,pass_1,nld;
+       htypechk,ncal,hcodegen,verbose,nmat,
+       pass_1,nld,symconst,cutils;
 
     {$I node.inc}
 
 end.
 {
   $Log$
-  Revision 1.5  2000-09-27 18:14:31  florian
+  Revision 1.6  2000-09-28 19:49:52  florian
+  *** empty log message ***
+
+  Revision 1.5  2000/09/27 18:14:31  florian
     * fixed a lot of syntax errors in the n*.pas stuff
 
   Revision 1.4  2000/09/24 15:06:19  peter

compiler/nodeh.inc

@@ -213,7 +213,8 @@
          nf_inlineconst,
 
          { general }
-         nf_isproperty  { 30th }
+         nf_isproperty,  { 30th }
+         nf_varstateset
        );
 
        tnodeflagset = set of tnodeflags;
@@ -311,6 +312,7 @@
           procedure det_temp;override;
           function docompare(p : tnode) : boolean;override;
           function getcopy : tnode;override;
+          procedure left_max;
        end;
 
        pbinarynode = ^tbinarynode;
@@ -336,7 +338,10 @@
 
 {
   $Log$
-  Revision 1.9  2000-09-27 18:14:31  florian
+  Revision 1.10  2000-09-28 19:49:52  florian
+  *** empty log message ***
+
+  Revision 1.9  2000/09/27 18:14:31  florian
     * fixed a lot of syntax errors in the n*.pas stuff
 
   Revision 1.8  2000/09/26 20:06:13  florian

compiler/pass_1.pas

@@ -561,24 +561,24 @@ implementation
                       { !!!! this tbinarynode should be tassignmentnode }
                       (tbinarynode(hp.right).left.nodetype=funcretn) then
                       begin
-                         if assigned(texitnode(tstatmentnode(hp.left).right).left) then
+                         if assigned(texitnode(tstatementnode(hp.left).right).left) then
                            CGMessage(cg_n_inefficient_code)
                          else
                            begin
-                              hp.left.right.left:=hp.right.right;
-                              hp.right.right:=nil;
+                              texitnode(tstatementnode(hp.left).right).left:=tstatementnode(hp.right).right;
+                              tstatementnode(hp.right).right:=nil;
                               hp.right.free;
                               hp.right:=nil;
                            end;
                       end
                    { warning if unreachable code occurs and elimate this }
-                   else if (hp.right.treetype in
+                   else if (hp.right.nodetype in
                      [exitn,breakn,continuen,goton]) and
                      { statement node (JM) }
                      assigned(hp.left) and
                      { kind of statement! (JM) }
-                     assigned(hp.left.right) and
-                     (hp.left.right.treetype<>labeln) then
+                     assigned(tstatementnode(hp.left).right) and
+                     (tstatementnode(hp.left).right.nodetype<>labeln) then
                      begin
                         { use correct line number }
                         aktfilepos:=hp.left.fileinfo;
@@ -613,7 +613,7 @@ implementation
               else
                 hp.registers32:=0;
 
-              if hp.registers32>p^.registers32 then
+              if hp.registers32>registers32 then
                 registers32:=hp.registers32;
               if hp.registersfpu>registersfpu then
                 registersfpu:=hp.registersfpu;
@@ -622,7 +622,7 @@ implementation
                 registersmmx:=hp.registersmmx;
 {$endif}
               inc(count);
-              hp:=hp.left;
+              hp:=tstatementnode(hp.left);
            end;
       end;
 
@@ -631,6 +631,13 @@ implementation
                              TASMNODE
 *****************************************************************************}
 
+    constructor tasmnode.create;
+
+      begin
+         inherited create(asmn);
+      end;
+
+
     function tasmnode.pass_1 : tnode;
       begin
          pass_1:=nil;
@@ -641,7 +648,7 @@ implementation
                             Global procedures
 *****************************************************************************}
 
-    procedure firstpass(var p : pnode);
+    procedure firstpass(var p : tnode);
 
       var
          oldcodegenerror  : boolean;
@@ -656,14 +663,14 @@ implementation
       begin
 {$ifdef extdebug}
          inc(total_of_firstpass);
-         if (p^.firstpasscount>0) and only_one_pass then
+         if (p.firstpasscount>0) and only_one_pass then
            exit;
 {$endif extdebug}
          oldcodegenerror:=codegenerror;
          oldpos:=aktfilepos;
          oldlocalswitches:=aktlocalswitches;
 {$ifdef extdebug}
-         if p^.firstpasscount>0 then
+         if p.firstpasscount>0 then
            begin
               move(p^,str1[1],sizeof(ttree));
               str1[0]:=char(sizeof(ttree));
@@ -705,13 +712,13 @@ implementation
               if str1<>str2 then
                 begin
                    comment(v_debug,'tree changed after first counting pass '
-                     +tostr(longint(p^.treetype)));
+                     +tostr(longint(p.treetype)));
                    compare_trees(oldp,p);
                 end;
               dispose(oldp);
            end;
          if count_ref then
-           inc(p^.firstpasscount);
+           inc(p.firstpasscount);
 {$endif extdebug}
       end;
 
@@ -734,7 +741,10 @@ end.
 {$endif cg11}
 {
   $Log$
-  Revision 1.5  2000-09-24 21:15:34  florian
+  Revision 1.6  2000-09-28 19:49:52  florian
+  *** empty log message ***
+
+  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