* fixed a lot of syntax errors in the n*.pas stuff

compiler/nadd.pas

@@ -32,8 +32,7 @@ interface
     type
        taddnode = class(tbinopnode)
           procedure make_bool_equal_size;
-          function firstpass : tnode;override;
-          procedure make_bool_equal_size;
+          function pass_1 : tnode;override;
        end;
 
     var
@@ -43,7 +42,7 @@ interface
        { specific node types can be created               }
        caddnode : class of taddnode;
 
-    function isbinaryoverloaded(var p : pnode) : boolean;
+    function isbinaryoverloaded(var p : tnode) : boolean;
 
 implementation
 
@@ -58,11 +57,12 @@ implementation
       hcodegen,
 {$endif newcg}
       htypechk,pass_1,
-      cpubase,ncnv,ncal,
+      cpubase,ncnv,ncal,nld,
+      ncon
       ;
 
 {*****************************************************************************
-                                FirstAdd
+                                TADDNODE
 *****************************************************************************}
 
 {$ifdef fpc}
@@ -75,16 +75,16 @@ implementation
         if porddef(left.resulttype)^.typ>porddef(right.resulttype)^.typ then
          begin
            right:=gentypeconvnode(right,porddef(left.resulttype));
-           right.convtyp:=tc_bool_2_int;
-           right.explizit:=true;
+           ttypeconvnode(right).convtyp:=tc_bool_2_int;
+           include(right.flags,nf_explizit);
            firstpass(right);
          end
         else
          if porddef(left.resulttype)^.typ<porddef(right.resulttype)^.typ then
           begin
             left:=gentypeconvnode(left,porddef(right.resulttype));
-            left.convtyp:=tc_bool_2_int;
-            left.explizit:=true;
+            ttypeconvnode(left).convtyp:=tc_bool_2_int;
+            include(left.flags,nf_explizit);
             firstpass(left);
           end;
       end;
@@ -94,7 +94,7 @@ implementation
       var
          t,hp    : tnode;
          ot,
-         lt,rt   : ttreetyp;
+         lt,rt   : tnodetype;
          rv,lv   : longint;
          rvd,lvd : bestreal;
          resdef,
@@ -121,17 +121,17 @@ implementation
          { convert array constructors to sets, because there is no other operator
            possible for array constructors }
          if is_array_constructor(left.resulttype) then
-           arrayconstructor_to_set(left);
+           arrayconstructor_to_set(tarrayconstructnode(left));
          if is_array_constructor(right.resulttype) then
-           arrayconstructor_to_set(right);
+           arrayconstructor_to_set(tarrayconstructnode(right));
 
          { both left and right need to be valid }
-         set_varstate(left,true);
-         set_varstate(right,true);
+         left.set_varstate(true);
+         right.set_varstate(true);
 
          { load easier access variables }
-         lt:=left.treetype;
-         rt:=right.treetype;
+         lt:=left.nodetype;
+         rt:=right.nodetype;
          rd:=right.resulttype;
          ld:=left.resulttype;
          convdone:=false;
@@ -140,22 +140,22 @@ implementation
            begin
               pass_1:=hp;
               exit;
-           end
+           end;
          { compact consts }
 
          { convert int consts to real consts, if the }
          { other operand is a real const             }
          if (rt=realconstn) and is_constintnode(left) then
            begin
-              t:=genrealconstnode(left.value,right.resulttype);
-              disposetree(left);
+              t:=genrealconstnode(tordconstnode(left).value,right.resulttype);
+              left.free;
               left:=t;
               lt:=realconstn;
            end;
          if (lt=realconstn) and is_constintnode(right) then
            begin
-              t:=genrealconstnode(right.value,left.resulttype);
-              disposetree(right);
+              t:=genrealconstnode(tordconstnode(right).value,left.resulttype);
+              right.free;
               right:=t;
               rt:=realconstn;
            end;
@@ -165,7 +165,7 @@ implementation
          if ((lt=ordconstn) and (rt=ordconstn)) and
             ((is_constintnode(left) and is_constintnode(right)) or
              (is_constboolnode(left) and is_constboolnode(right) and
-              (treetype in [ltn,lten,gtn,gten,equaln,unequaln,andn,xorn,orn]))) then
+              (nodetype in [ltn,lten,gtn,gten,equaln,unequaln,andn,xorn,orn]))) then
            begin
               { xor, and, or are handled different from arithmetic }
               { operations regarding the result type               }
@@ -176,9 +176,9 @@ implementation
                 resdef:=cs64bitdef
               else
                 resdef:=s32bitdef;
-              lv:=left.value;
-              rv:=right.value;
-              case treetype of
+              lv:=tordconstnode(left).value;
+              rv:=tordconstnode(right).value;
+              case nodetype of
                 addn : t:=genintconstnode(lv+rv);
                 subn : t:=genintconstnode(lv-rv);
                 muln : t:=genintconstnode(lv*rv);
@@ -205,16 +205,16 @@ implementation
               else
                 CGMessage(type_e_mismatch);
               end;
-              pass_1:=t
+              pass_1:=t;
               exit;
            end;
 
        { both real constants ? }
          if (lt=realconstn) and (rt=realconstn) then
            begin
-              lvd:=left.value_real;
-              rvd:=right.value_real;
-              case treetype of
+              lvd:=trealconstnode(left).value_real;
+              rvd:=trealconstnode(right).value_real;
+              case nodetype of
                  addn : t:=genrealconstnode(lvd+rvd,bestrealdef^);
                  subn : t:=genrealconstnode(lvd-rvd,bestrealdef^);
                  muln : t:=genrealconstnode(lvd*rvd,bestrealdef^);
@@ -260,8 +260,8 @@ implementation
          if (lt=ordconstn) and (rt=ordconstn) and
             is_char(ld) and is_char(rd) then
            begin
-              s1:=strpnew(char(byte(left.value)));
-              s2:=strpnew(char(byte(right.value)));
+              s1:=strpnew(char(byte(tordconstnode(left).value)));
+              s2:=strpnew(char(byte(tordconstnode(right).value)));
               l1:=1;
               l2:=1;
               concatstrings:=true;
@@ -271,14 +271,14 @@ implementation
            begin
               s1:=getpcharcopy(left);
               l1:=left.length;
-              s2:=strpnew(char(byte(right.value)));
+              s2:=strpnew(char(byte(tordconstnode(right).value)));
               l2:=1;
               concatstrings:=true;
            end
          else
            if (lt=ordconstn) and (rt=stringconstn) and is_char(ld) then
            begin
-              s1:=strpnew(char(byte(left.value)));
+              s1:=strpnew(char(byte(tordconstnode(left).value)));
               l1:=1;
               s2:=getpcharcopy(right);
               l2:=right.length;
@@ -287,16 +287,16 @@ implementation
          else if (lt=stringconstn) and (rt=stringconstn) then
            begin
               s1:=getpcharcopy(left);
-              l1:=left.length;
+              l1:=tstringconstnode(left).length;
               s2:=getpcharcopy(right);
-              l2:=right.length;
+              l2:=tstringconstnode(right).length;
               concatstrings:=true;
            end;
 
          { I will need to translate all this to ansistrings !!! }
          if concatstrings then
            begin
-              case treetype of
+              case nodetype of
                  addn :
                    t:=genpcharconstnode(concatansistrings(s1,s2,l1,l2),l1+l2);
                  ltn :
@@ -325,7 +325,7 @@ implementation
              if is_boolean(ld) and is_boolean(rd) then
               begin
                 if (cs_full_boolean_eval in aktlocalswitches) or
-                   (treetype in [xorn,ltn,lten,gtn,gten]) then
+                   (nodetype in [xorn,ltn,lten,gtn,gten]) then
                   begin
                      make_bool_equal_size(p);
                      if (left.location.loc in [LOC_JUMP,LOC_FLAGS]) and
@@ -335,7 +335,7 @@ implementation
                        calcregisters(p,1,0,0);
                   end
                 else
-                  case treetype of
+                  case nodetype of
                     andn,
                     orn:
                       begin
@@ -348,11 +348,11 @@ implementation
                       begin
                         make_bool_equal_size(p);
                         { Remove any compares with constants }
-                        if (left.treetype=ordconstn) then
+                        if (left.nodetype=ordconstn) then
                          begin
                            hp:=right;
                            b:=(left.value<>0);
-                           ot:=treetype;
+                           ot:=nodetype;
                            disposetree(left);
                            putnode(p);
                            p:=hp;
@@ -364,11 +364,11 @@ implementation
                             end;
                            exit;
                          end;
-                        if (right.treetype=ordconstn) then
+                        if (right.nodetype=ordconstn) then
                          begin
                            hp:=left;
                            b:=(right.value<>0);
-                           ot:=treetype;
+                           ot:=nodetype;
                            disposetree(right);
                            putnode(p);
                            p:=hp;
@@ -397,7 +397,7 @@ implementation
                 because the resulttype of left = left.resulttype
                 (surprise! :) (JM)
 
-                if treetype in [xorn,unequaln,equaln] then
+                if nodetype in [xorn,unequaln,equaln] then
                   begin
                      if left.location.loc=LOC_FLAGS then
                        begin
@@ -423,7 +423,7 @@ implementation
              { Both are chars? only convert to shortstrings for addn }
               if is_char(rd) and is_char(ld) then
                begin
-                 if treetype=addn then
+                 if nodetype=addn then
                    begin
                      left:=gentypeconvnode(left,cshortstringdef);
                      right:=gentypeconvnode(right,cshortstringdef);
@@ -441,7 +441,7 @@ implementation
               { is there a 64 bit type ? }
              else if ((porddef(rd)^.typ=s64bit) or (porddef(ld)^.typ=s64bit)) and
                { the / operator is handled later }
-               (treetype<>slashn) then
+               (nodetype<>slashn) then
                begin
                   if (porddef(ld)^.typ<>s64bit) then
                     begin
@@ -458,7 +458,7 @@ implementation
                end
              else if ((porddef(rd)^.typ=u64bit) or (porddef(ld)^.typ=u64bit)) and
                { the / operator is handled later }
-               (treetype<>slashn) then
+               (nodetype<>slashn) then
                begin
                   if (porddef(ld)^.typ<>u64bit) then
                     begin
@@ -477,7 +477,7 @@ implementation
               { is there a cardinal? }
               if ((porddef(rd)^.typ=u32bit) or (porddef(ld)^.typ=u32bit)) and
                { the / operator is handled later }
-               (treetype<>slashn) then
+               (nodetype<>slashn) then
                begin
                  { convert constants to u32bit }
 {$ifndef cardinalmulfix}
@@ -514,7 +514,7 @@ implementation
                      { can we make them both unsigned? }
                        if (porddef(ld)^.typ in [u8bit,u16bit]) or
                           (is_constintnode(left) and
-                           (treetype <> subn) and
+                           (nodetype <> subn) and
                            (left.value > 0)) then
                          left:=gentypeconvnode(left,u32bitdef)
                        else
@@ -536,7 +536,7 @@ implementation
                  calcregisters(p,1,0,0);
                  { for unsigned mul we need an extra register }
 {                 registers32:=left.registers32+right.registers32; }
-                 if treetype=muln then
+                 if nodetype=muln then
                   inc(registers32);
                  convdone:=true;
                end;
@@ -548,7 +548,7 @@ implementation
            if (ld^.deftype=setdef) {or is_array_constructor(ld)} then
              begin
              { trying to add a set element? }
-                if (treetype=addn) and (rd^.deftype<>setdef) then
+                if (nodetype=addn) and (rd^.deftype<>setdef) then
                  begin
                    if (rt=setelementn) then
                     begin
@@ -560,7 +560,7 @@ implementation
                  end
                 else
                  begin
-                   if not(treetype in [addn,subn,symdifn,muln,equaln,unequaln
+                   if not(nodetype in [addn,subn,symdifn,muln,equaln,unequaln
 {$IfNDef NoSetInclusion}
                                           ,lten,gten
 {$EndIf NoSetInclusion}
@@ -589,7 +589,7 @@ implementation
                 if (psetdef(ld)^.settype<>smallset) and
                    (psetdef(rd)^.settype=smallset) then
                  begin
-                   if (right.treetype=setconstn) then
+                   if (right.nodetype=setconstn) then
                      begin
                         t:=gensetconstnode(right.value_set,psetdef(left.resulttype));
                         t^.left:=right.left;
@@ -602,13 +602,13 @@ implementation
                  end;
 
                 { do constant evaluation }
-                if (right.treetype=setconstn) and
+                if (right.nodetype=setconstn) and
                    not assigned(right.left) and
-                   (left.treetype=setconstn) and
+                   (left.nodetype=setconstn) and
                    not assigned(left.left) then
                   begin
                      new(resultset);
-                     case treetype of
+                     case nodetype of
                         addn : begin
                                   for i:=0 to 31 do
                                     resultset^[i]:=
@@ -688,7 +688,7 @@ implementation
                  if psetdef(ld)^.settype=smallset then
                   begin
                      { are we adding set elements ? }
-                     if right.treetype=setelementn then
+                     if right.nodetype=setelementn then
                        calcregisters(p,2,0,0)
                      else
                        calcregisters(p,1,0,0);
@@ -769,7 +769,7 @@ implementation
 {$ifdef i386}
                       { shortstring + char handled seperately  (JM) }
                       and (not(cs_optimize in aktglobalswitches) or
-                           (treetype <> addn) or not(is_char(rd)))
+                           (nodetype <> addn) or not(is_char(rd)))
 {$endif i386}
 {$endif newoptimizations2}
                     then
@@ -782,9 +782,9 @@ implementation
                 end;
               { only if there is a type cast we need to do again }
               { the first pass                             }
-              if left.treetype=typeconvn then
+              if left.nodetype=typeconvn then
                 firstpass(left);
-              if right.treetype=typeconvn then
+              if right.nodetype=typeconvn then
                 firstpass(right);
               { here we call STRCONCAT or STRCMP or STRCOPY }
               procinfo^.flags:=procinfo^.flags or pi_do_call;
@@ -811,9 +811,9 @@ implementation
               if ((rd^.deftype=floatdef) and (pfloatdef(rd)^.typ=f32bit)) or
                  ((ld^.deftype=floatdef) and (pfloatdef(ld)^.typ=f32bit)) then
                begin
-                 if not is_integer(rd) or (treetype<>muln) then
+                 if not is_integer(rd) or (nodetype<>muln) then
                    right:=gentypeconvnode(right,s32fixeddef);
-                 if not is_integer(ld) or (treetype<>muln) then
+                 if not is_integer(ld) or (nodetype<>muln) then
                    left:=gentypeconvnode(left,s32fixeddef);
                  firstpass(left);
                  firstpass(right);
@@ -841,7 +841,7 @@ implementation
               { right:=gentypeconvnode(right,ld); }
               { firstpass(right); }
               calcregisters(p,1,0,0);
-              case treetype of
+              case nodetype of
                  equaln,unequaln :
                    begin
                       if is_equal(right.resulttype,voidpointerdef) then
@@ -900,7 +900,7 @@ implementation
               firstpass(right);
               firstpass(left);
               calcregisters(p,1,0,0);
-              case treetype of
+              case nodetype of
                  equaln,unequaln : ;
                  else CGMessage(type_e_mismatch);
               end;
@@ -919,7 +919,7 @@ implementation
               firstpass(right);
               firstpass(left);
               calcregisters(p,1,0,0);
-              case treetype of
+              case nodetype of
                  equaln,unequaln : ;
                  else CGMessage(type_e_mismatch);
               end;
@@ -935,7 +935,7 @@ implementation
               left:=gentypeconvnode(left,rd);
               firstpass(left);
               calcregisters(p,1,0,0);
-              case treetype of
+              case nodetype of
                  equaln,unequaln : ;
                  else CGMessage(type_e_mismatch);
               end;
@@ -950,7 +950,7 @@ implementation
               right:=gentypeconvnode(right,ld);
               firstpass(right);
               calcregisters(p,1,0,0);
-              case treetype of
+              case nodetype of
                  equaln,unequaln : ;
                  else CGMessage(type_e_mismatch);
               end;
@@ -963,7 +963,7 @@ implementation
               left:=gentypeconvnode(left,rd);
               firstpass(left);
               calcregisters(p,1,0,0);
-              case treetype of
+              case nodetype of
                  equaln,unequaln : ;
                  else CGMessage(type_e_mismatch);
               end;
@@ -976,7 +976,7 @@ implementation
               right:=gentypeconvnode(right,ld);
               firstpass(right);
               calcregisters(p,1,0,0);
-              case treetype of
+              case nodetype of
                 equaln,unequaln : ;
               else
                 CGMessage(type_e_mismatch);
@@ -991,7 +991,7 @@ implementation
             begin
               calcregisters(p,1,0,0);
               location.loc:=LOC_REGISTER;
-              case treetype of
+              case nodetype of
                  equaln,unequaln : ;
               else
                 CGMessage(type_e_mismatch);
@@ -1006,7 +1006,7 @@ implementation
             begin
               firstpass(right);
               firstpass(left);
-              case treetype of
+              case nodetype of
                 addn,subn,xorn,orn,andn:
                   ;
                 { mul is a little bit restricted }
@@ -1039,7 +1039,7 @@ implementation
               left:=gentypeconvnode(left,s32bitdef);
               firstpass(left);
               calcregisters(p,1,0,0);
-              if treetype=addn then
+              if nodetype=addn then
                 begin
                   if not(cs_extsyntax in aktmoduleswitches) or
                     (not(is_pchar(ld)) and not(m_add_pointer in aktmodeswitches)) then
@@ -1072,7 +1072,7 @@ implementation
               right:=gentypeconvnode(right,s32bitdef);
               firstpass(right);
               calcregisters(p,1,0,0);
-              case treetype of
+              case nodetype of
                 addn,subn : begin
                               if not(cs_extsyntax in aktmoduleswitches) or
                                  (not(is_pchar(ld)) and not(m_add_pointer in aktmodeswitches)) then
@@ -1098,7 +1098,7 @@ implementation
             begin
               calcregisters(p,1,0,0);
               location.loc:=LOC_REGISTER;
-              case treetype of
+              case nodetype of
                  equaln,unequaln : ;
               else
                 CGMessage(type_e_mismatch);
@@ -1115,7 +1115,7 @@ implementation
                    firstpass(right);
                 end;
               calcregisters(p,1,0,0);
-              case treetype of
+              case nodetype of
                  equaln,unequaln,
                  ltn,lten,gtn,gten : ;
                  else CGMessage(type_e_mismatch);
@@ -1127,7 +1127,7 @@ implementation
          if not convdone then
            begin
               { but an int/int gives real/real! }
-              if treetype=slashn then
+              if nodetype=slashn then
                 begin
                    CGMessage(type_h_use_div_for_int);
                    right:=gentypeconvnode(right,bestrealdef^);
@@ -1163,7 +1163,7 @@ implementation
          { example length(s)+1 gets internal 'longint' type first }
          { if it is a arg it is converted to 'LONGINT' }
          { but a second first pass will reset this to 'longint' }
-         case treetype of
+         case nodetype of
             ltn,lten,gtn,gten,equaln,unequaln:
               begin
                  if (not assigned(resulttype)) or
@@ -1230,7 +1230,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.6  2000-09-24 15:06:19  peter
+  Revision 1.7  2000-09-27 18:14:31  florian
+    * fixed a lot of syntax errors in the n*.pas stuff
+
+  Revision 1.6  2000/09/24 15:06:19  peter
     * use defines.inc
 
   Revision 1.5  2000/09/22 22:42:52  florian
@@ -1249,4 +1252,4 @@ end.
 
   Revision 1.1  2000/08/26 12:24:20  florian
     * initial release
-}
+}

compiler/ncal.pas

@@ -62,6 +62,8 @@ interface
           inlinetree : tnode;
           inlineprocsym : pprocsym;
           retoffset,para_offset,para_size : longint;
+          constructor create(callp,code : tnode);virtual;
+          function getcopy : tnode;override;
           function pass_1 : tnode;override;
        end;
 
@@ -81,7 +83,8 @@ interface
       cutils,globtype,systems,
       cobjects,verbose,globals,
       symconst,aasm,types,
-      htypechk,pass_1,cpubase
+      htypechk,pass_1,cpubase,
+      ncnv,nld,ninl,nadd,ncon
 {$ifdef newcg}
       ,cgbase
       ,tgobj
@@ -147,7 +150,7 @@ interface
 {$endif def extdebug}
         {convtyp     : tconverttype;}
       begin
-         pass_1:=nil;
+         firstcallparan:=nil;
          inc(parsing_para_level);
 {$ifdef extdebug}
          if do_count then
@@ -159,9 +162,9 @@ interface
          if assigned(right) then
            begin
               if defcoll=nil then
-                firstcallparan(right,nil,do_count)
+                right.firstcallparan(nil,do_count)
               else
-                firstcallparan(right,pparaitem(defcoll^.next),do_count);
+                right.firstcallparan(pparaitem(defcoll^.next),do_count);
               registers32:=right.registers32;
               registersfpu:=right.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -191,7 +194,7 @@ interface
               { Do we need arrayconstructor -> set conversion, then insert
                 it here before the arrayconstructor node breaks the tree
                 with its conversions of enum->ord }
-              if (left.treetype=arrayconstructn) and
+              if (left.nodetype=arrayconstructn) and
                  (defcoll^.paratype.def^.deftype=setdef) then
                 left:=gentypeconvnode(left,defcoll^.paratype.def);
 
@@ -233,7 +236,7 @@ interface
                  old_get_para_resulttype:=get_para_resulttype;
                  allow_array_constructor:=true;
                  get_para_resulttype:=false;
-                  if (left.treetype in [arrayconstructn,typeconvn]) then
+                  if (left.nodetype in [arrayconstructn,typeconvn]) then
                    firstpass(left);
                  if not assigned(resulttype) then
                    resulttype:=left.resulttype;
@@ -245,7 +248,7 @@ interface
                 test_local_to_procvar(pprocvardef(left.resulttype),defcoll^.paratype.def);
               { property is not allowed as var parameter }
               if (defcoll^.paratyp in [vs_out,vs_var]) and
-                 (left.isproperty) then
+                 (nf_isproperty in left.flags) then
                 CGMessagePos(left.fileinfo,type_e_argument_cant_be_assigned);
               { generate the high() value tree }
               if push_high_param(defcoll^.paratype.def) then
@@ -362,7 +365,7 @@ interface
                 make_not_regable(left);
 
               if do_count then
-                set_varstate(left,defcoll^.paratyp <> vs_var);
+                left.set_varstate(defcoll^.paratyp <> vs_var);
                 { must only be done after typeconv PM }
               resulttype:=defcoll^.paratype.def;
            end;
@@ -397,8 +400,8 @@ interface
               if is_open_array(left.resulttype) or
                  is_array_of_const(left.resulttype) then
                begin
-                 st:=left.symtable;
-                 getsymonlyin(st,'high'+pvarsym(left.symtableentry)^.name);
+                 st:=tloadnode(left).symtable;
+                 getsymonlyin(st,'high'+pvarsym(tloadnode(left).symtableentry)^.name);
                  hightree:=genloadnode(pvarsym(srsym),st);
                  loadconst:=false;
                end
@@ -415,8 +418,8 @@ interface
                begin
                  if is_open_string(left.resulttype) then
                   begin
-                    st:=left.symtable;
-                    getsymonlyin(st,'high'+pvarsym(left.symtableentry)^.name);
+                    st:=tloadnode(left).symtable;
+                    getsymonlyin(st,'high'+pvarsym(tloadnode(left).symtableentry)^.name);
                     hightree:=genloadnode(pvarsym(srsym),st);
                     loadconst:=false;
                   end
@@ -426,7 +429,7 @@ interface
               else
              { passing a string to an array of char }
                begin
-                 if (left.treetype=stringconstn) then
+                 if (left.nodetype=stringconstn) then
                    begin
                      len:=str_length(left);
                      if len>0 then
@@ -472,7 +475,7 @@ interface
          inherited destroy;
       end;
 
-    procedure firstcalln(var p : ptree);
+    function tcallnode.pass_1 : tnode;
       type
          pprocdefcoll = ^tprocdefcoll;
          tprocdefcoll = record
@@ -507,7 +510,7 @@ interface
 
       { check if the resulttype from tree p is equal with def, needed
         for stringconstn and formaldef }
-      function is_equal(p:ptree;def:pdef) : boolean;
+      function is_equal(p:tnode;def:pdef) : boolean;
 
         begin
            { safety check }
@@ -1456,7 +1459,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.5  2000-09-24 21:15:34  florian
+  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
     * some errors fix to get more stuff compilable
 
   Revision 1.4  2000/09/24 20:17:44  florian

compiler/ncnv.pas

@@ -27,7 +27,7 @@ unit ncnv;
 interface
 
     uses
-       node,symtable;
+       node,symtable,nld;
 
     type
        ttypeconvnode = class(tunarynode)
@@ -78,13 +78,15 @@ interface
        cisnode : class of tisnode;
 
     function gentypeconvnode(node : tnode;t : pdef) : tnode;
+    procedure arrayconstructor_to_set(var p : tarrayconstructnode);
 
 implementation
 
    uses
       globtype,systems,tokens,
       cutils,cobjects,verbose,globals,
-      symconst,aasm,types,ncon,ncal,nld,
+      symconst,aasm,types,ncon,ncal,
+      nset,nadd,
 {$ifdef newcg}
       cgbase,
 {$else newcg}
@@ -97,15 +99,10 @@ implementation
                     Array constructor to Set Conversion
 *****************************************************************************}
 
-    function arrayconstructor_to_set : tnode;
+    procedure arrayconstructor_to_set(var p : tarrayconstructnode);
 
-      begin
-         {$warning FIX ME !!!!!!!}
-         internalerror(2609000);
-       end;
-{$ifdef dummy}
       var
-        constp : tsetconstnode;
+        constp      : tsetconstnode;
         buildp,
         p2,p3,p4    : tnode;
         pd        : pdef;
@@ -115,7 +112,7 @@ implementation
 
         procedure update_constsethi(p:pdef);
         begin
-          if ((deftype=orddef) and
+          if ((p^.deftype=orddef) and
              (porddef(p)^.high>=constsethi)) then
             begin
                constsethi:=porddef(p)^.high;
@@ -130,7 +127,7 @@ implementation
                if constsethi>255 then
                  constsethi:=255;
             end
-          else if ((deftype=enumdef) and
+          else if ((p^.deftype=enumdef) and
             (penumdef(p)^.max>=constsethi)) then
             begin
                if pd=nil then
@@ -167,25 +164,26 @@ implementation
         pd:=nil;
         constsetlo:=0;
         constsethi:=0;
-        constp:=csetconstnode.create(nil);
-        constvalue_set:=constset;
-        buildp:=constp;
-        if assigned(left) then
+        constp:=csetconstnode.create(nil,nil);
+        constp.value_set:=constset;
+        if assigned(p.left) then
          begin
            while assigned(p) do
             begin
               p4:=nil; { will contain the tree to create the set }
             { split a range into p2 and p3 }
-              if left.nodetype=arrayconstructrangen then
+              if p.left.nodetype=arrayconstructrangen then
                begin
-                 p2:=left.left;
-                 p3:=left.right;
+                 p2:=tarrayconstructorrangenode(p.left).left;
+                 p3:=tarrayconstructorrangenode(p.left).right;
+                 tarrayconstructorrangenode(p.left).left:=nil;
+                 tarrayconstructorrangenode(p.left).right:=nil;
                { node is not used anymore }
-                 putnode(left);
+                 p.left.free;
                end
               else
                begin
-                 p2:=left;
+                 p2:=p.left;
                  p3:=nil;
                end;
               firstpass(p2);
@@ -193,11 +191,11 @@ implementation
                firstpass(p3);
               if codegenerror then
                break;
-              case p2^.resulttype^.deftype of
+              case p2.resulttype^.deftype of
                  enumdef,
                  orddef:
                    begin
-                      getrange(p2^.resulttype,lr,hr);
+                      getrange(p2.resulttype,lr,hr);
                       if assigned(p3) then
                        begin
                          { this isn't good, you'll get problems with
@@ -212,17 +210,17 @@ implementation
                           end;
                          }
 
-                         if assigned(pd) and not(is_equal(pd,p3^.resulttype)) then
+                         if assigned(pd) and not(is_equal(pd,p3.resulttype)) then
                            begin
-                              aktfilepos:=p3^.fileinfo;
+                              aktfilepos:=p3.fileinfo;
                               CGMessage(type_e_typeconflict_in_set);
                            end
                          else
                            begin
-                             if (p2^.nodetype=ordconstn) and (p3^.nodetype=ordconstn) then
+                             if (p2.nodetype=ordconstn) and (p3.nodetype=ordconstn) then
                               begin
-                                 if not(is_integer(p3^.resulttype)) then
-                                   pd:=p3^.resulttype
+                                 if not(is_integer(p3.resulttype)) then
+                                   pd:=p3.resulttype
                                  else
                                    begin
                                       p3:=gentypeconvnode(p3,u8bitdef);
@@ -231,18 +229,18 @@ implementation
                                       firstpass(p3);
                                    end;
 
-                                for l:=p2^.value to p3^.value do
+                                for l:=tordconstnode(p2).value to tordconstnode(p3).value do
                                   do_set(l);
-                                disposetree(p3);
-                                disposetree(p2);
+                                p2.free;
+                                p3.free;
                               end
                              else
                               begin
-                                update_constsethi(p2^.resulttype);
+                                update_constsethi(p2.resulttype);
                                 p2:=gentypeconvnode(p2,pd);
                                 firstpass(p2);
 
-                                update_constsethi(p3^.resulttype);
+                                update_constsethi(p3.resulttype);
                                 p3:=gentypeconvnode(p3,pd);
                                 firstpass(p3);
 
@@ -252,29 +250,29 @@ implementation
                                 else
                                   p3:=gentypeconvnode(p3,u8bitdef);
                                 firstpass(p3);
-                                p4:=gennode(setelementn,p2,p3);
+                                p4:=csetelementnode.create(p2,p3);
                               end;
                            end;
                        end
                       else
                        begin
                       { Single value }
-                         if p2^.nodetype=ordconstn then
+                         if p2.nodetype=ordconstn then
                           begin
-                            if not(is_integer(p2^.resulttype)) then
-                              update_constsethi(p2^.resulttype)
+                            if not(is_integer(p2.resulttype)) then
+                              update_constsethi(p2.resulttype)
                             else
                               begin
                                  p2:=gentypeconvnode(p2,u8bitdef);
                                  firstpass(p2);
                               end;
 
-                            do_set(p2^.value);
-                            disposetree(p2);
+                            do_set(tordconstnode(p2).value);
+                            p2.free;
                           end
                          else
                           begin
-                            update_constsethi(p2^.resulttype);
+                            update_constsethi(p2.resulttype);
 
                             if assigned(pd) then
                               p2:=gentypeconvnode(p2,pd)
@@ -282,7 +280,7 @@ implementation
                               p2:=gentypeconvnode(p2,u8bitdef);
                             firstpass(p2);
 
-                            p4:=gennode(setelementn,p2,nil);
+                            p4:=csetelementnode.create(p2,nil);
                           end;
                        end;
                     end;
@@ -293,22 +291,23 @@ implementation
                           not(is_equal(pd,cchardef)) then
                           CGMessage(type_e_typeconflict_in_set)
                         else
-                         for l:=1 to length(pstring(p2^.value_str)^) do
-                          do_set(ord(pstring(p2^.value_str)^[l]));
+                         for l:=1 to length(pstring(tstringconstnode(p2).value_str)^) do
+                          do_set(ord(pstring(tstringconstnode(p2).value_str)^[l]));
                         if pd=nil then
                          pd:=cchardef;
-                        disposetree(p2);
+                        p2.free;
                       end;
               else
                CGMessage(type_e_ordinal_expr_expected);
               end;
             { insert the set creation tree }
               if assigned(p4) then
-               buildp:=gennode(addn,buildp,p4);
+               buildp:=caddnode.create(addn,buildp,p4);
             { load next and dispose current node }
               p2:=p;
-              p:=right;
-              putnode(p2);
+              p:=tarrayconstrucnode(p.right);
+              tarrayconstructnode(p2).right:=nil;
+              p2.free;
             end;
           if (pd=nil) then
             begin
@@ -319,15 +318,14 @@ implementation
         else
          begin
          { empty set [], only remove node }
-           putnode(p);
+           p.free;
          end;
       { set the initial set type }
-        constresulttype:=new(psetdef,init(pd,constsethi));
+        constp.resulttype:=new(psetdef,init(pd,constsethi));
       { set the new tree }
-        p:=buildp;
+        p:=tarrayconstructnode(buildp);
       end;
 
-{$endif dummy}
 
 {*****************************************************************************
                            TTYPECONVNODE
@@ -1144,7 +1142,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.3  2000-09-26 20:06:13  florian
+  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
     * hmm, still a lot of work to get things compilable
 
   Revision 1.2  2000/09/26 14:59:34  florian

compiler/ncon.pas

@@ -416,8 +416,13 @@ implementation
       begin
          inherited create(setconstn,nil);
          resulttype:=settype;
-         new(value_set);
-         value_set^:=s^;
+         if assigned(s) then
+           begin
+              new(value_set);
+              value_set^:=s^;
+           end
+         else
+           value_set:=nil;
       end;
 
     function tsetconstnode.getcopy : tnode;
@@ -427,8 +432,13 @@ implementation
 
       begin
          n:=tsetconstnode(inherited getcopy);
-         new(n.value_set);
-         n.value_set^:=value_set^;
+         if assigned(value_set) then
+           begin
+              new(n.value_set);
+              n.value_set^:=value_set^
+           end
+         else
+           n.value_set:=nil;
          n.lab_set:=lab_set;
          getcopy:=n;
       end;
@@ -467,7 +477,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.4  2000-09-26 14:59:34  florian
+  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 14:59:34  florian
     * more conversion work done
 
   Revision 1.3  2000/09/24 21:15:34  florian

compiler/nld.pas

@@ -33,16 +33,16 @@ interface
        tloadnode = class(tunarynode)
           symtableentry : psym;
           symtable : psymtable;
-          constructor create(v : pvarsym;st : psymtable);virtual;
+          constructor create(v : psym;st : psymtable);virtual;
           function getcopy : tnode;override;
           function pass_1 : tnode;override;
        end;
 
        { different assignment types }
-       tassigntyp = (at_normal,at_plus,at_minus,at_star,at_slash);
+       tassigntype = (at_normal,at_plus,at_minus,at_star,at_slash);
 
        tassignmentnode = class(tbinarynode)
-          assigntyp : tassigntyp;
+          assigntype : tassigntype;
           constructor create(l,r : tnode);virtual;
           function getcopy : tnode;override;
           function pass_1 : tnode;override;
@@ -100,7 +100,7 @@ implementation
       cutils,cobjects,verbose,globtype,globals,systems,
       symconst,aasm,types,
       htypechk,pass_1,
-      ncnv,cpubase
+      ncnv,nmem,cpubase
 {$ifdef newcg}
       ,cgbase
       ,tgobj
@@ -120,12 +120,12 @@ implementation
 
       begin
          n:=cloadnode.create(v,st);
-{$fidef NEWST}
+{$ifdef NEWST}
          n.resulttype:=v^.definition;
 {$else NEWST}
          n.resulttype:=v^.vartype.def;
 {$endif NEWST}
-         genloadnode:=n:
+         genloadnode:=n;
       end;
 
     function genloadcallnode(v: pprocsym;st: psymtable): tloadnode;
@@ -155,8 +155,8 @@ implementation
 {$else NEWST}
          n.resulttype:=v^.definition;
 {$endif NEWST}
-         p^.left:=mp;
-         genloadmethodcallnode:=v;
+         n.left:=mp;
+         genloadmethodcallnode:=n;
       end;
 
 
@@ -184,7 +184,7 @@ implementation
                              TLOADNODE
 *****************************************************************************}
 
-    constructor tloadnode.create(v : pvarsym;st : psymtable);
+    constructor tloadnode.create(v : psym;st : psymtable);
 
       begin
          inherited create(loadn,nil);
@@ -211,11 +211,11 @@ implementation
             (pwithsymtable(symtable)^.direct_with) and
             (symtableentry^.typ=varsym) then
            begin
-              p1:=getcopy(ptree(pwithsymtable(symtable)^.withrefnode));
+              p1:=tnode(pwithsymtable(symtable)^.withrefnode).getcopy;
               p1:=gensubscriptnode(pvarsym(symtableentry),p1);
-              putnode(p);
-              p:=p1;
-              firstpass(p);
+              left:=nil;
+              firstpass(p1);
+              pass_1:=p1;
               exit;
            end;
 
@@ -235,7 +235,7 @@ implementation
               begin
                 symtableentry:=pabsolutesym(symtableentry)^.ref;
                 symtable:=symtableentry^.owner;
-                is_absolute:=true;
+                include(flags,nf_absolute);
               end
              else
               exit;
@@ -243,20 +243,20 @@ implementation
          case symtableentry^.typ of
             funcretsym :
               begin
-                p1:=genzeronode(funcretn);
-                p1.funcretprocinfo:=pprocinfo(pfuncretsym(symtableentry)^.funcretprocinfo);
-                p1.rettype:=pfuncretsym(symtableentry)^.rettype;
+                p1:=cfuncretnode.create;
+                tfuncretnode(p1).funcretprocinfo:=pprocinfo(pfuncretsym(symtableentry)^.funcretprocinfo);
+                tfuncretnode(p1).rettype:=pfuncretsym(symtableentry)^.rettype;
                 firstpass(p1);
                 { if it's refered as absolute then we need to have the
                   type of the absolute instead of the function return,
                   the function return is then also assigned }
-                if is_absolute then
+                if nf_absolute in flags then
                  begin
-                   pprocinfo(p1.funcretprocinfo)^.funcret_state:=vs_assigned;
+                   pprocinfo(tfuncretnode(p1).funcretprocinfo)^.funcret_state:=vs_assigned;
                    p1.resulttype:=resulttype;
                  end;
-                putnode(p);
-                p:=p1;
+                left:=nil;
+                pass_1:=p1;
               end;
             constsym:
               begin
@@ -274,7 +274,7 @@ implementation
             varsym :
                 begin
                 { if it's refered by absolute then it's used }
-                if is_absolute then
+                if nf_absolute in flags then
                  pvarsym(symtableentry)^.varstate:=vs_used
                 else
                  if (resulttype=nil) then
@@ -328,7 +328,7 @@ implementation
                      inc(pvarsym(symtableentry)^.refs,t_times);
                 end;
             typedconstsym :
-                if not is_absolute then
+                if not(nf_absolute in flags) then
                   resulttype:=ptypedconstsym(symtableentry)^.typedconsttype.def;
             procsym :
                 begin
@@ -389,13 +389,16 @@ implementation
 {$endif newoptimizations2}
       begin
          { must be made unique }
-         set_unique(left);
+         if assigned(left) then
+           begin
+              left.set_unique;
 
-         { set we the function result? }
-         set_funcret_is_valid(left);
+              { set we the function result? }
+              left.set_funcret_is_valid;
+           end;
 
          firstpass(left);
-         set_varstate(left,false);
+         left.set_varstate(false);
          if codegenerror then
            exit;
 
@@ -433,7 +436,7 @@ implementation
            end;
 {$endif i386}
          firstpass(right);
-         set_varstate(right,true);
+         right.set_varstate(true);
          if codegenerror then
            exit;
 
@@ -512,9 +515,8 @@ implementation
     constructor tfuncretnode.create;
 
       begin
-         inherited create(tfuncretn);
+         inherited create(funcretn);
          funcretprocinfo:=nil;
-         n.rettype:=nil;
       end;
 
     function tfuncretnode.getcopy : tnode;
@@ -547,19 +549,19 @@ implementation
                            TARRAYCONSTRUCTRANGENODE
 *****************************************************************************}
 
-    constructor tarrayconstructrangenode.create(l,r : tnode);
+    constructor tarrayconstructorrangenode.create(l,r : tnode);
 
       begin
          inherited create(arrayconstructn,l,r);
       end;
 
-    function tarrayconstructrangenode.pass_1 : tnode;
+    function tarrayconstructorrangenode.pass_1 : tnode;
       begin
         firstpass(left);
         left.set_varstate(true);
         firstpass(right);
         right.set_varstate(true);
-        calcregisters(p,0,0,0);
+        calcregisters(self,0,0,0);
         resulttype:=left.resulttype;
       end;
 
@@ -568,14 +570,14 @@ implementation
                             TARRAYCONSTRUCTNODE
 *****************************************************************************}
 
-    constructor tarrayconstrucnode.create(l,r : tnode);
+    constructor tarrayconstructnode.create(l,r : tnode);
 
       begin
-         inherited create(arrayconstructnode,l,r);
+         inherited create(arrayconstructn,l,r);
          constructdef:=nil;
       end;
 
-    function tarrayconstrucnode.getcopy : tnode;
+    function tarrayconstructnode.getcopy : tnode;
 
       var
          n : tarrayconstructnode;
@@ -590,15 +592,42 @@ implementation
         pd : pdef;
         thp,
         chp,
-        hp : tnode;
+        hp : tarrayconstructnode;
         len : longint;
         varia : boolean;
+
+      procedure postprocess(t : tnode);
+
+        begin
+           calcregisters(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)   }
+           { if no type is set then we set the type to voiddef to overcome a
+           0 addressing }
+           if not assigned(pd) then
+             pd:=voiddef;
+           { skip if already done ! (PM) }
+           if not assigned(t.resulttype) or
+              (t.resulttype^.deftype<>arraydef) or
+              not parraydef(t.resulttype)^.IsConstructor or
+              (parraydef(t.resulttype)^.lowrange<>0) or
+              (parraydef(t.resulttype)^.highrange<>len-1) then
+             t.resulttype:=new(parraydef,init(0,len-1,s32bitdef));
+
+           parraydef(t.resulttype)^.elementtype.def:=pd;
+           parraydef(t.resulttype)^.IsConstructor:=true;
+           parraydef(t.resulttype)^.IsVariant:=varia;
+           t.location.loc:=LOC_MEM;
+        end;
       begin
       { are we allowing array constructor? Then convert it to a set }
         if not allow_array_constructor then
          begin
-           arrayconstructor_to_set(p);
-           firstpass(p);
+           hp:=tarrayconstructnode(getcopy);
+           arrayconstructor_to_set(hp);
+           firstpass(hp);
+           pass_1:=hp;
            exit;
          end;
       { only pass left tree, right tree contains next construct if any }
@@ -607,12 +636,13 @@ implementation
         varia:=false;
         if assigned(left) then
          begin
-           hp:=p;
+           hp:=self;
            while assigned(hp) do
             begin
               firstpass(hp.left);
               hp.left.set_varstate(true);
-              if (not get_para_resulttype) and (not novariaallowed) then
+              if (not get_para_resulttype) and
+                (not(nf_novariaallowed in flags)) then
                begin
                  case hp.left.resulttype^.deftype of
                    enumdef :
@@ -636,7 +666,7 @@ implementation
                      end;
                    stringdef :
                      begin
-                       if cargs then
+                       if nf_cargs in flags then
                         begin
                           hp.left:=gentypeconvnode(hp.left,charpointerdef);
                           firstpass(hp.left);
@@ -658,11 +688,11 @@ implementation
                pd:=hp.left.resulttype
               else
                begin
-                 if ((novariaallowed) or (not varia)) and
+                 if ((nf_novariaallowed in flags) or (not varia)) and
                     (not is_equal(pd,hp.left.resulttype)) then
                   begin
                     { if both should be equal try inserting a conversion }
-                    if novariaallowed then
+                    if nf_novariaallowed in flags then
                      begin
                        hp.left:=gentypeconvnode(hp.left,pd);
                        firstpass(hp.left);
@@ -671,44 +701,30 @@ implementation
                   end;
                end;
               inc(len);
-              hp:=hp.right;
+              hp:=tarrayconstructnode(hp.right);
             end;
          { swap the tree for cargs }
-           if cargs and (not cargswap) then
+           if (nf_cargs in flags) and (not(nf_cargswap in flags)) then
             begin
               chp:=nil;
-              hp:=p;
+              { we need a copy here, because self is destroyed }
+              { by firstpass later                             }
+              hp:=tarrayconstructnode(getcopy);
               while assigned(hp) do
                begin
-                 thp:=hp.right;
+                 thp:=tarrayconstructnode(hp.right);
                  hp.right:=chp;
                  chp:=hp;
                  hp:=thp;
                end;
-              p:=chp;
-              cargs:=true;
-              cargswap:=true;
+              include(chp.flags,nf_cargs);
+              include(chp.flags,nf_cargswap);
+              postprocess(chp);
+              pass_1:=chp;
+              exit;
             end;
          end;
-        calcregisters(p,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)   }
-      { if no type is set then we set the type to voiddef to overcome a
-        0 addressing }
-        if not assigned(pd) then
-         pd:=voiddef;
-      { skip if already done ! (PM) }
-        if not assigned(resulttype) or
-           (resulttype^.deftype<>arraydef) or
-           not parraydef(resulttype)^.IsConstructor or
-           (parraydef(resulttype)^.lowrange<>0) or
-           (parraydef(resulttype)^.highrange<>len-1) then
-          resulttype:=new(parraydef,init(0,len-1,s32bitdef));
-        parraydef(resulttype)^.elementtype.def:=pd;
-        parraydef(resulttype)^.IsConstructor:=true;
-        parraydef(resulttype)^.IsVariant:=varia;
-        location.loc:=LOC_MEM;
+         postprocess(self);
       end;
 
 
@@ -753,7 +769,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.2  2000-09-25 15:37:14  florian
+  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
     * more fixes
 
   Revision 1.1  2000/09/25 14:55:05  florian

compiler/node.inc

@@ -243,6 +243,32 @@
          internalerror(220920001);
       end;
 
+    procedure tnode.set_unique;
+
+      begin
+         case nodetype of
+            vecn:
+               include(flags,nf_callunique);
+            typeconvn,subscriptn,derefn:
+              if assigned(tunarynode(self).left) then
+                tunarynode(self).left.set_unique;
+         end;
+      end;
+
+    procedure tnode.set_funcret_is_valid;
+
+      begin
+         case nodetype of
+            funcretn:
+              if is_first_funcret in flags) then
+                pprocinfo(tfuncretnode(self).funcretprocinfo)^.funcret_state:=vs_assigned;
+            vecn,typeconvn,subscriptn{,derefn}:
+              if assigned(tunarynode(self).left) then
+                tunarynode(self).left.set_funcret_is_valid;
+         end;
+      end;
+
+
 {$warning FIX ME !!!!!}
 {$ifdef dummy}
     procedure unset_varstate(p : ptree);
@@ -640,7 +666,10 @@
       end;
 {
   $Log$
-  Revision 1.4  2000-09-26 20:06:13  florian
+  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
     * hmm, still a lot of work to get things compilable
 
   Revision 1.3  2000/09/22 21:45:36  florian

compiler/node.pas

@@ -35,14 +35,17 @@ interface
 implementation
 
     uses
-       htypechk,ncal,hcodegen,verbose,nmat,pass_1;
+       htypechk,ncal,hcodegen,verbose,nmat,pass_1,nld;
 
     {$I node.inc}
 
 end.
 {
   $Log$
-  Revision 1.4  2000-09-24 15:06:19  peter
+  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
     * use defines.inc
 
   Revision 1.3  2000/09/22 21:45:35  florian
@@ -53,4 +56,4 @@ end.
 
   Revision 1.1  2000/08/26 12:27:35  florian
     * initial release
-}
+}

compiler/nodeh.inc

@@ -210,7 +210,10 @@
          nf_explizit,
 
          { tinlinenode }
-         nf_inlineconst
+         nf_inlineconst,
+
+         { general }
+         nf_isproperty  { 30th }
        );
 
        tnodeflagset = set of tnodeflags;
@@ -270,6 +273,12 @@
           function getcopy : tnode;virtual;
           procedure unset_varstate;virtual;
           procedure set_varstate(must_be_valid : boolean);virtual;
+
+          { it would be cleaner to make the following virtual methods }
+          { but this would require an extra vmt entry                 }
+          { so we do some hacking instead ....                        }
+          procedure set_unique;
+          procedure set_funcret_is_valid;
 {$ifdef EXTDEBUG}
           { writes a node for debugging purpose, shouldn't be called }
           { direct, because there is no test for nil, use writenode  }
@@ -321,13 +330,16 @@
 
        pbinopnode = ^tbinopnode;
        tbinopnode = class(tbinarynode)
-          constructor create(tt : tnodetype;l,r : tnode);
+          constructor create(tt : tnodetype;l,r : tnode);virtual;
           function docompare(p : tnode) : boolean;override;
        end;
 
 {
   $Log$
-  Revision 1.8  2000-09-26 20:06:13  florian
+  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
     * hmm, still a lot of work to get things compilable
 
   Revision 1.7  2000/09/26 14:59:34  florian

compiler/nset.pas

@@ -27,7 +27,7 @@ unit nset;
 interface
 
     uses
-       node;
+       node,cpuinfo,aasm;
 
     type
       pcaserecord = ^tcaserecord;
@@ -54,7 +54,7 @@ interface
           function pass_1 : tnode;override;
        end;
 
-       tinnode = class(tbinopnode);
+       tinnode = class(tbinopnode)
           constructor create(l,r : tnode);virtual;
           function pass_1 : tnode;override;
        end;
@@ -66,10 +66,11 @@ interface
 
        tcasenode = class(tbinarynode)
           nodes : pcaserecord;
-          elseblock : ptree;
-          constructor create(l,r : tnode;n : pnodes);virtual;
+          elseblock : tnode;
+          constructor create(l,r : tnode;n : pcaserecord);virtual;
           destructor destroy;override;
           function getcopy : tnode;override;
+          function pass_1 : tnode;override;
        end;
 
     var
@@ -92,9 +93,9 @@ implementation
     uses
       globtype,systems,
       cobjects,verbose,globals,
-      symconst,symtable,aasm,types,
+      symconst,symtable,types,
       htypechk,pass_1,
-      ncnv,ncon,cpubase
+      ncnv,ncon,cpubase,nld
 {$ifdef newcg}
       ,cgbase
       ,tgcpu
@@ -109,7 +110,7 @@ implementation
 {$endif newcg}
       ;
 
-    function gencasenode(l,r : ptree;nodes : pcaserecord) : ptree;
+    function gencasenode(l,r : tnode;nodes : pcaserecord) : tnode;
 
       var
          t : tnode;
@@ -134,7 +135,7 @@ implementation
       begin
          pass_1:=nil;
          firstpass(left);
-         set_varstate(left,true);
+         left.set_varstate(true);
          if codegenerror then
           exit;
 
@@ -145,7 +146,7 @@ implementation
              exit;
           end;
 
-         calcregisters(p,0,0,0);
+         calcregisters(self,0,0,0);
          resulttype:=left.resulttype;
          set_location(location,left.location);
       end;
@@ -165,7 +166,7 @@ implementation
       type
         byteset = set of byte;
       var
-        t : ptree;
+        t : tnode;
         pst : pconstset;
 
     function createsetconst(psd : psetdef) : pconstset;
@@ -202,14 +203,14 @@ implementation
          resulttype:=booldef;
 
          firstpass(right);
-         set_varstate(right,true);
+         right.set_varstate(true);
          if codegenerror then
           exit;
 
          { Convert array constructor first to set }
          if is_array_constructor(right.resulttype) then
           begin
-            arrayconstructor_to_set(right);
+            arrayconstructor_to_set(tarrayconstructnode(right));
             firstpass(right);
             if codegenerror then
              exit;
@@ -217,26 +218,26 @@ implementation
 
          { if right is a typen then the def
          is in typenodetype PM }
-         if right.treetype=typen then
-           right.resulttype:=right.typenodetype;
+         if right.nodetype=typen then
+           right.resulttype:=ttypenode(right).typenodetype;
 
          if right.resulttype^.deftype<>setdef then
            CGMessage(sym_e_set_expected);
          if codegenerror then
            exit;
 
-         if (right.treetype=typen) then
+         if (right.nodetype=typen) then
            begin
              { we need to create a setconstn }
-             pst:=createsetconst(psetdef(right.typenodetype));
-             t:=gensetconstnode(pst,psetdef(right.typenodetype));
+             pst:=createsetconst(psetdef(ttypenode(right).typenodetype));
+             t:=gensetconstnode(pst,psetdef(ttypenode(right).typenodetype));
              dispose(pst);
              right.free;
              right:=t;
            end;
 
          firstpass(left);
-         set_varstate(left,true);
+         left.set_varstate(true);
          if codegenerror then
            exit;
 
@@ -256,15 +257,15 @@ implementation
            exit;
 
          { constant evaulation }
-         if (left.treetype=ordconstn) and (right.treetype=setconstn) then
+         if (left.nodetype=ordconstn) and (right.nodetype=setconstn) then
           begin
-            t:=genordinalconstnode(byte(left.value in byteset(right.value_set^)),booldef);
+            t:=genordinalconstnode(byte(tordconstnode(left).value in byteset(tsetconstnode(right).value_set^)),booldef);
             firstpass(t);
             pass_1:=t;
             exit;
           end;
 
-         left_right_max(p);
+         left_right_max;
          { this is not allways true due to optimization }
          { but if we don't set this we get problems with optimizing self code }
          if psetdef(right.resulttype)^.settype<>smallset then
@@ -272,7 +273,7 @@ implementation
          else
            begin
               { a smallset needs maybe an misc. register }
-              if (left.treetype<>ordconstn) and
+              if (left.nodetype<>ordconstn) and
                 not(right.location.loc in [LOC_CREGISTER,LOC_REGISTER]) and
                 (right.registers32<1) then
                 inc(registers32);
@@ -296,9 +297,9 @@ implementation
       begin
          pass_1:=nil;
          firstpass(left);
-         set_varstate(left,true);
+         left.set_varstate(true);
          firstpass(right);
-         set_varstate(right,true);
+         right.set_varstate(true);
          if codegenerror then
            exit;
          { both types must be compatible }
@@ -306,15 +307,15 @@ implementation
             (isconvertable(left.resulttype,right.resulttype,ct,ordconstn,false)=0) then
            CGMessage(type_e_mismatch);
          { Check if only when its a constant set }
-         if (left.treetype=ordconstn) and (right.treetype=ordconstn) then
+         if (left.nodetype=ordconstn) and (right.nodetype=ordconstn) then
           begin
           { upper limit must be greater or equal than lower limit }
           { not if u32bit }
-            if (left.value>right.value) and
-               (( left.value<0) or (right.value>=0)) then
+            if (tordconstnode(left).value>tordconstnode(right).value) and
+               ((tordconstnode(left).value<0) or (tordconstnode(right).value>=0)) then
               CGMessage(cg_e_upper_lower_than_lower);
           end;
-        left_right_max(p);
+        left_right_max;
         resulttype:=left.resulttype;
         set_location(location,left.location);
       end;
@@ -331,10 +332,10 @@ implementation
       procedure count(p : pcaserecord);
         begin
            inc(_l);
-           if assigned(less) then
-             count(less);
-           if assigned(greater) then
-             count(greater);
+           if assigned(p^.less) then
+             count(p^.less);
+           if assigned(p^.greater) then
+             count(p^.greater);
         end;
 
       begin
@@ -349,9 +350,9 @@ implementation
          hp : pcaserecord;
       begin
          hp:=root;
-         while assigned(hp.greater) do
-           hp:=hp.greater;
-         case_get_max:=hp._high;
+         while assigned(hp^.greater) do
+           hp:=hp^.greater;
+         case_get_max:=hp^._high;
       end;
 
 
@@ -360,18 +361,18 @@ implementation
          hp : pcaserecord;
       begin
          hp:=root;
-         while assigned(hp.less) do
-           hp:=hp.less;
-         case_get_min:=hp._low;
+         while assigned(hp^.less) do
+           hp:=hp^.less;
+         case_get_min:=hp^._low;
       end;
 
     procedure deletecaselabels(p : pcaserecord);
 
       begin
-         if assigned(greater) then
-           deletecaselabels(greater);
-         if assigned(less) then
-           deletecaselabels(less);
+         if assigned(p^.greater) then
+           deletecaselabels(p^.greater);
+         if assigned(p^.less) then
+           deletecaselabels(p^.less);
          dispose(p);
       end;
 
@@ -394,27 +395,27 @@ implementation
                               TCASENODE
 *****************************************************************************}
 
-    constructor tcasenode.create(l,r : tnode;n : pnodes);
+    constructor tcasenode.create(l,r : tnode;n : pcaserecord);
 
       begin
          inherited create(casen,l,r);
          nodes:=n;
          elseblock:=nil;
-         set_file_pos(l);
+         set_file_line(l);
       end;
 
     destructor tcasenode.destroy;
 
       begin
          elseblock.free;
-         deletecaselables(nodes);
+         deletecaselabels(nodes);
          inherited destroy;
       end;
 
     function tcasenode.pass_1 : tnode;
       var
          old_t_times : longint;
-         hp : tnode;
+         hp : tbinarynode;
       begin
          pass_1:=nil;
          { evalutes the case expression }
@@ -424,7 +425,7 @@ implementation
          cleartempgen;
 {$endif newcg}
          firstpass(left);
-         set_varstate(left,true);
+         left.set_varstate(true);
          if codegenerror then
            exit;
          registers32:=left.registers32;
@@ -443,8 +444,8 @@ implementation
               if t_times<1 then
                 t_times:=1;
            end;
-         {   first case }
-         hp:=right;
+         { first case }
+         hp:=tbinarynode(right);
          while assigned(hp) do
            begin
 {$ifdef newcg}
@@ -464,7 +465,7 @@ implementation
                 registersmmx:=hp.right.registersmmx;
 {$endif SUPPORT_MMX}
 
-              hp:=hp.left;
+              hp:=tbinarynode(hp.left);
            end;
 
          { may be handle else tree }
@@ -515,7 +516,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.2  2000-09-24 20:17:44  florian
+  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/24 20:17:44  florian
     * more conversion work done
 
   Revision 1.1  2000/09/24 19:38:39  florian

compiler/tree.pas

@@ -348,8 +348,8 @@ unit tree;
     procedure unset_varstate(p : ptree);
     procedure set_varstate(p : ptree;must_be_valid : boolean);
 
-    { gibt den ordinalen Werten der Node zurueck oder falls sie }
-    { keinen ordinalen Wert hat, wird ein Fehler erzeugt        }
+    { returns the ordinal value of the node, if it hasn't a ord. }
+    { value an error is generated                                }
     function get_ordinal_value(p : ptree) : longint;
 
     function is_constnode(p : ptree) : boolean;
@@ -2149,7 +2149,10 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.9  2000-09-24 15:06:32  peter
+  Revision 1.10  2000-09-27 18:14:31  florian
+    * fixed a lot of syntax errors in the n*.pas stuff
+
+  Revision 1.9  2000/09/24 15:06:32  peter
     * use defines.inc
 
   Revision 1.8  2000/08/27 16:11:55  peter
@@ -2173,4 +2176,4 @@ end.
 
   Revision 1.2  2000/07/13 11:32:52  michael
   + removed logs
-}
+}