* lot of compile updates for cg11

compiler/assemble.pas

@@ -52,7 +52,8 @@ type
     objfile,
     as_bin   : string;
     SmartAsm : boolean;
-    smarthcount : longint;
+    SmartFilesCount,
+    SmartHeaderCount : longint;
     place    : TCutPlace; { special 'end' file for import dir ? }
   {outfile}
     AsmSize,
@@ -80,8 +81,6 @@ type
     procedure WriteAsmList;virtual;
   end;
 
-var
-  SmartLinkFilesCnt : longint;
 
 Procedure GenerateAsm(smart:boolean);
 Procedure OnlyAsm;
@@ -230,7 +229,7 @@ begin
    begin
      if SmartAsm then
       begin
-        if (SmartLinkFilesCnt<=1) then
+        if (SmartFilesCount<=1) then
          Message1(exec_i_assembling_smart,name);
       end
      else
@@ -253,22 +252,22 @@ procedure TAsmList.NextSmartName;
 var
   s : string;
 begin
-  inc(SmartLinkFilesCnt);
-  if SmartLinkFilesCnt>999999 then
+  inc(SmartFilesCount);
+  if SmartFilesCount>999999 then
    Message(asmw_f_too_many_asm_files);
   case place of
     cut_begin :
       begin
-        inc(smarthcount);
-        s:=current_module^.asmprefix^+tostr(smarthcount)+'h';
+        inc(SmartHeaderCount);
+        s:=current_module^.asmprefix^+tostr(SmartHeaderCount)+'h';
       end;
     cut_normal :
-      s:=current_module^.asmprefix^+tostr(smarthcount)+'s';
+      s:=current_module^.asmprefix^+tostr(SmartHeaderCount)+'s';
     cut_end :
-      s:=current_module^.asmprefix^+tostr(smarthcount)+'t';
+      s:=current_module^.asmprefix^+tostr(SmartHeaderCount)+'t';
   end;
-  AsmFile:=Path+FixFileName(s+tostr(SmartLinkFilesCnt)+target_info.asmext);
-  ObjFile:=Path+FixFileName(s+tostr(SmartLinkFilesCnt)+target_info.objext);
+  AsmFile:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.asmext);
+  ObjFile:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.objext);
   { insert in container so it can be cleared after the linking }
   SmartLinkOFiles.Insert(Objfile);
 end;
@@ -470,11 +469,11 @@ begin
   objfile:=current_module^.objfilename^;
   name:=FixFileName(current_module^.modulename^);
   OutCnt:=0;
-  SmartLinkFilesCnt:=0;
+  SmartFilesCount:=0;
   SmartLinkOFiles.Clear;
   place:=cut_normal;
   SmartAsm:=smart;
-  SmartHCount:=0;
+  SmartHeaderCount:=0;
 { Which path will be used ? }
   if SmartAsm then
    begin
@@ -597,7 +596,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.5  2000-09-24 15:06:11  peter
+  Revision 1.6  2000-10-01 19:48:23  peter
+    * lot of compile updates for cg11
+
+  Revision 1.5  2000/09/24 15:06:11  peter
     * use defines.inc
 
   Revision 1.4  2000/08/27 16:11:49  peter

compiler/cgai386.pas

@@ -29,9 +29,7 @@ interface
 
     uses
        cobjects,
-{$ifdef CG11}
-       node,
-{$else}
+{$ifndef CG11}
        tree,
 {$endif}
        cpubase,cpuasm,
@@ -112,20 +110,21 @@ interface
     procedure incrstringref(t : pdef;const ref : treference);
     procedure decrstringref(t : pdef;const ref : treference);
 
-    function maybe_push(needed : byte;p : {$ifdef CG11}tnode{$else}ptree{$endif};isint64 : boolean) : boolean;
     procedure push_int(l : longint);
     procedure emit_push_mem(const ref : treference);
     procedure emitpushreferenceaddr(const ref : treference);
+{$ifndef CG11}
+    function maybe_push(needed : byte;p : {$ifdef CG11}tnode{$else}ptree{$endif};isint64 : boolean) : boolean;
     procedure pushsetelement(p : {$ifdef CG11}tnode{$else}ptree{$endif});
     procedure restore(p : {$ifdef CG11}tnode{$else}ptree{$endif};isint64 : boolean);
     procedure push_value_para(p:{$ifdef CG11}tnode{$else}ptree{$endif};inlined,is_cdecl:boolean;
                               para_offset:longint;alignment : longint);
-
 {$ifdef TEMPS_NOT_PUSH}
     { does the same as restore, but uses temp. space instead of pushing }
     function maybe_push(needed : byte;p : ptree;isint64 : boolean) : boolean;
     procedure restorefromtemp(p : ptree;isint64 : boolean);
 {$endif TEMPS_NOT_PUSH}
+{$endif}
 
     procedure floatload(t : tfloattype;const ref : treference);
     procedure floatstore(t : tfloattype;const ref : treference);
@@ -133,12 +132,14 @@ interface
     procedure floatstoreops(t : tfloattype;var op : tasmop;var s : topsize);
 
     procedure maybe_loadesi;
-    procedure maketojumpbool(p : {$ifdef CG11}tnode{$else}ptree{$endif});
     procedure emitloadord2reg(const location:Tlocation;orddef:Porddef;destreg:Tregister;delloc:boolean);
-    procedure emitoverflowcheck(p:{$ifdef CG11}tnode{$else}ptree{$endif});
-    procedure emitrangecheck(p:{$ifdef CG11}tnode{$else}ptree{$endif};todef:pdef);
     procedure concatcopy(source,dest : treference;size : longint;delsource : boolean;loadref:boolean);
-    procedure firstcomplex(p : {$ifdef CG11}tnode{$else}ptree{$endif});
+{$ifndef CG11}
+    procedure maketojumpbool(p : ptree);
+    procedure emitoverflowcheck(p:ptree);
+    procedure emitrangecheck(p:ptree;todef:pdef);
+    procedure firstcomplex(p : ptree);
+{$endif}
 
     procedure genentrycode(alist : paasmoutput;const proc_names:Tstringcontainer;make_global:boolean;
                            stackframe:longint;
@@ -350,22 +351,6 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
           internalerror(7453984);
       end;
 
-{$ifdef nojmpfix}
-    procedure emitjmp(c : tasmcond;var l : pasmlabel);
-      var
-        ai : Paicpu;
-      begin
-        if c=C_None then
-          exprasmlist^.concat(new(paicpu,op_sym(A_JMP,S_NO,l)))
-        else
-          begin
-            ai:=new(paicpu,op_sym(A_Jcc,S_NO,l));
-            ai^.SetCondition(c);
-            ai^.is_jmp:=true;
-            exprasmlist^.concat(ai);
-          end;
-      end;
-{$else nojmpfix}
     procedure emitjmp(c : tasmcond;var l : pasmlabel);
       var
         ai : Paicpu;
@@ -380,7 +365,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
         ai^.is_jmp:=true;
         exprasmlist^.concat(ai);
       end;
-{$endif nojmpfix}
+
 
     procedure emit_flag2reg(flag:tresflags;hregister:tregister);
       var
@@ -1077,74 +1062,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
                            Emit Push Functions
 *****************************************************************************}
 
-{$ifdef CG11}
-    function maybe_push(needed : byte;p : tnode;isint64 : boolean) : boolean;
-      var
-         pushed : boolean;
-         {hregister : tregister; }
-{$ifdef TEMPS_NOT_PUSH}
-         href : treference;
-{$endif TEMPS_NOT_PUSH}
-      begin
-         if needed>usablereg32 then
-           begin
-              if (p.location.loc=LOC_REGISTER) then
-                begin
-                   if isint64 then
-                     begin
-{$ifdef TEMPS_NOT_PUSH}
-                        gettempofsizereference(href,8);
-                        p.temp_offset:=href.offset;
-                        href.offset:=href.offset+4;
-                        exprasmlist^.concat(new(paicpu,op_reg(A_MOV,S_L,p.location.registerhigh,href)));
-                        href.offset:=href.offset-4;
-{$else TEMPS_NOT_PUSH}
-                        exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,p.location.registerhigh)));
-{$endif TEMPS_NOT_PUSH}
-                        ungetregister32(p^.location.registerhigh);
-                     end
-{$ifdef TEMPS_NOT_PUSH}
-                   else
-                     begin
-                        gettempofsizereference(href,4);
-                        p.temp_offset:=href.offset;
-                     end
-{$endif TEMPS_NOT_PUSH}
-                     ;
-                   pushed:=true;
-{$ifdef TEMPS_NOT_PUSH}
-                   exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,p.location.register,href)));
-{$else TEMPS_NOT_PUSH}
-                   exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,p.location.register)));
-{$endif TEMPS_NOT_PUSH}
-                   ungetregister32(p.location.register);
-                end
-              else if (p.location.loc in [LOC_MEM,LOC_REFERENCE]) and
-                      ((p.location.reference.base<>R_NO) or
-                       (p.location.reference.index<>R_NO)
-                      ) then
-                  begin
-                     del_reference(p.location.reference);
-                     getexplicitregister32(R_EDI);
-                     emit_ref_reg(A_LEA,S_L,newreference(p^.location.reference),R_EDI);
-{$ifdef TEMPS_NOT_PUSH}
-                     gettempofsizereference(href,4);
-                     exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,href)));
-                     p^.temp_offset:=href.offset;
-{$else TEMPS_NOT_PUSH}
-                     exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_EDI)));
-{$endif TEMPS_NOT_PUSH}
-                     ungetregister32(R_EDI);
-                     pushed:=true;
-                  end
-              else pushed:=false;
-           end
-         else pushed:=false;
-         maybe_push:=pushed;
-      end;
-
-{$else CG11}
-
+{$ifndef CG11}
     function maybe_push(needed : byte;p : ptree;isint64 : boolean) : boolean;
       var
          pushed : boolean;
@@ -1210,7 +1128,6 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
          else pushed:=false;
          maybe_push:=pushed;
       end;
-{$endif CG11}
 
 {$ifdef TEMPS_NOT_PUSH}
     function maybe_savetotemp(needed : byte;p : ptree;isint64 : boolean) : boolean;
@@ -1263,6 +1180,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
          maybe_push:=pushed;
       end;
 {$endif TEMPS_NOT_PUSH}
+{$endif CG11}
 
 
     procedure push_int(l : longint);
@@ -1338,7 +1256,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
            end;
         end;
 
-
+{$ifndef CG11}
      procedure pushsetelement(p : ptree);
      {
        copies p a set element on the stack
@@ -1395,8 +1313,9 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
            end;
          end;
       end;
+{$endif CG11}
 
-
+{$ifndef CG11}
     procedure restore(p : ptree;isint64 : boolean);
       var
          hregister :  tregister;
@@ -1443,6 +1362,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
          ungetiftemp(href);
 {$endif TEMPS_NOT_PUSH}
       end;
+{$endif CG11}
 
 {$ifdef TEMPS_NOT_PUSH}
     procedure restorefromtemp(p : ptree;isint64 : boolean);
@@ -1480,6 +1400,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
       end;
 {$endif TEMPS_NOT_PUSH}
 
+{$ifndef CG11}
       procedure push_value_para(p:ptree;inlined,is_cdecl:boolean;
                                 para_offset:longint;alignment : longint);
         var
@@ -1990,7 +1911,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 {$endif SUPPORT_MMX}
           end;
       end;
-
+{$endif CG11}
 
 
 {*****************************************************************************
@@ -2075,70 +1996,353 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
                            Emit Functions
 *****************************************************************************}
 
-    procedure maketojumpbool(p : ptree);
-    {
-      produces jumps to true respectively false labels using boolean expressions
-    }
+    procedure concatcopy(source,dest : treference;size : longint;delsource,loadref : boolean);
+
+      const
+         isizes : array[0..3] of topsize=(S_L,S_B,S_W,S_B);
+         ishr : array[0..3] of byte=(2,0,1,0);
+
       var
-        opsize : topsize;
-        storepos : tfileposinfo;
+         ecxpushed : boolean;
+         helpsize : longint;
+         i : byte;
+         reg8,reg32 : tregister;
+         swap : boolean;
+
+         procedure maybepushecx;
+         begin
+           if not(R_ECX in unused) then
+             begin
+               exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_ECX)));
+               ecxpushed:=true;
+             end
+           else getexplicitregister32(R_ECX);
+         end;
+
       begin
-         if p^.error then
-           exit;
-         storepos:=aktfilepos;
-         aktfilepos:=p^.fileinfo;
-         if is_boolean(p^.resulttype) then
+{$IfNDef regallocfix}
+        If delsource then
+           del_reference(source);
+{$EndIf regallocfix}
+         if (not loadref) and
+            ((size<=8) or
+             (not(cs_littlesize in aktglobalswitches ) and (size<=12))) then
            begin
-              if is_constboolnode(p) then
+              helpsize:=size shr 2;
+              getexplicitregister32(R_EDI);
+              for i:=1 to helpsize do
                 begin
-                   if p^.value<>0 then
-                     emitjmp(C_None,truelabel)
-                   else
-                     emitjmp(C_None,falselabel);
-                end
-              else
+                   emit_ref_reg(A_MOV,S_L,newreference(source),R_EDI);
+{$ifdef regallocfix}
+                   If (size = 4) and delsource then
+                     del_reference(source);
+{$endif regallocfix}
+                   exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,newreference(dest))));
+                   inc(source.offset,4);
+                   inc(dest.offset,4);
+                   dec(size,4);
+                end;
+              if size>1 then
                 begin
-                   opsize:=def_opsize(p^.resulttype);
-                   case p^.location.loc of
-                      LOC_CREGISTER,LOC_REGISTER : begin
-                                        emit_reg_reg(A_OR,opsize,p^.location.register,
-                                          p^.location.register);
-                                        ungetregister(p^.location.register);
-                                        emitjmp(C_NZ,truelabel);
-                                        emitjmp(C_None,falselabel);
-                                     end;
-                      LOC_MEM,LOC_REFERENCE : begin
-                                        emit_const_ref(
-                                          A_CMP,opsize,0,newreference(p^.location.reference));
-                                        del_reference(p^.location.reference);
-                                        emitjmp(C_NZ,truelabel);
-                                        emitjmp(C_None,falselabel);
-                                     end;
-                      LOC_FLAGS : begin
-                                     emitjmp(flag_2_cond[p^.location.resflags],truelabel);
-                                     emitjmp(C_None,falselabel);
-                                  end;
-                   end;
+                   emit_ref_reg(A_MOV,S_W,newreference(source),R_DI);
+{$ifdef regallocfix}
+                   If (size = 2) and delsource then
+                     del_reference(source);
+{$endif regallocfix}
+                   exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_W,R_DI,newreference(dest))));
+                   inc(source.offset,2);
+                   inc(dest.offset,2);
+                   dec(size,2);
+                end;
+              ungetregister32(R_EDI);
+              if size>0 then
+                begin
+                   { and now look for an 8 bit register }
+                   swap:=false;
+                   if R_EAX in unused then reg8:=reg32toreg8(getexplicitregister32(R_EAX))
+                   else if R_EDX in unused then reg8:=reg32toreg8(getexplicitregister32(R_EDX))
+                   else if R_EBX in unused then reg8:=reg32toreg8(getexplicitregister32(R_EBX))
+                   else if R_ECX in unused then reg8:=reg32toreg8(getexplicitregister32(R_ECX))
+                   else
+                      begin
+                         swap:=true;
+                         { we need only to check 3 registers, because }
+                         { one is always not index or base          }
+                         if (dest.base<>R_EAX) and (dest.index<>R_EAX) then
+                           begin
+                              reg8:=R_AL;
+                              reg32:=R_EAX;
+                           end
+                         else if (dest.base<>R_EBX) and (dest.index<>R_EBX) then
+                           begin
+                              reg8:=R_BL;
+                              reg32:=R_EBX;
+                           end
+                         else if (dest.base<>R_ECX) and (dest.index<>R_ECX) then
+                           begin
+                              reg8:=R_CL;
+                              reg32:=R_ECX;
+                           end;
+                      end;
+                   if swap then
+                     { was earlier XCHG, of course nonsense }
+                     begin
+                       getexplicitregister32(R_EDI);
+                       emit_reg_reg(A_MOV,S_L,reg32,R_EDI);
+                     end;
+                   emit_ref_reg(A_MOV,S_B,newreference(source),reg8);
+{$ifdef regallocfix}
+                   If delsource then
+                     del_reference(source);
+{$endif regallocfix}
+                   exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_B,reg8,newreference(dest))));
+                   if swap then
+                     begin
+                       emit_reg_reg(A_MOV,S_L,R_EDI,reg32);
+                       ungetregister32(R_EDI);
+                     end
+                   else
+                     ungetregister(reg8);
                 end;
            end
          else
-           CGMessage(type_e_mismatch);
-         aktfilepos:=storepos;
-      end;
-
+           begin
+              getexplicitregister32(R_EDI);
+              emit_ref_reg(A_LEA,S_L,newreference(dest),R_EDI);
+{$ifdef regallocfix}
+             {is this ok?? (JM)}
+              del_reference(dest);
+{$endif regallocfix}
+              exprasmlist^.concat(new(pairegalloc,alloc(R_ESI)));
+              if loadref then
+                emit_ref_reg(A_MOV,S_L,newreference(source),R_ESI)
+              else
+                begin
+                  emit_ref_reg(A_LEA,S_L,newreference(source),R_ESI);
+{$ifdef regallocfix}
+                  if delsource then
+                    del_reference(source);
+{$endif regallocfix}
+                end;
 
-    { produces if necessary overflowcode }
-    procedure emitoverflowcheck(p:ptree);
-      var
-         hl : pasmlabel;
-      begin
-         if not(cs_check_overflow in aktlocalswitches) then
-          exit;
-         getlabel(hl);
-         if not ((p^.resulttype^.deftype=pointerdef) or
-                ((p^.resulttype^.deftype=orddef) and
-                 (porddef(p^.resulttype)^.typ in [u64bit,u16bit,u32bit,u8bit,uchar,
-                                                  bool8bit,bool16bit,bool32bit]))) then
+              exprasmlist^.concat(new(paicpu,op_none(A_CLD,S_NO)));
+              ecxpushed:=false;
+              if cs_littlesize in aktglobalswitches  then
+                begin
+                   maybepushecx;
+                   emit_const_reg(A_MOV,S_L,size,R_ECX);
+                   exprasmlist^.concat(new(paicpu,op_none(A_REP,S_NO)));
+                   exprasmlist^.concat(new(paicpu,op_none(A_MOVSB,S_NO)));
+                end
+              else
+                begin
+                   helpsize:=size shr 2;
+                   size:=size and 3;
+                   if helpsize>1 then
+                    begin
+                      maybepushecx;
+                      emit_const_reg(A_MOV,S_L,helpsize,R_ECX);
+                      exprasmlist^.concat(new(paicpu,op_none(A_REP,S_NO)));
+                    end;
+                   if helpsize>0 then
+                    exprasmlist^.concat(new(paicpu,op_none(A_MOVSD,S_NO)));
+                   if size>1 then
+                     begin
+                        dec(size,2);
+                        exprasmlist^.concat(new(paicpu,op_none(A_MOVSW,S_NO)));
+                     end;
+                   if size=1 then
+                     exprasmlist^.concat(new(paicpu,op_none(A_MOVSB,S_NO)));
+                end;
+              ungetregister32(R_EDI);
+              exprasmlist^.concat(new(pairegalloc,dealloc(R_ESI)));
+              if ecxpushed then
+                exprasmlist^.concat(new(paicpu,op_reg(A_POP,S_L,R_ECX)))
+              else
+                ungetregister32(R_ECX);
+
+              { loading SELF-reference again }
+              maybe_loadesi;
+           end;
+         if delsource then
+           ungetiftemp(source);
+      end;
+
+
+    procedure emitloadord2reg(const location:Tlocation;orddef:Porddef;
+                              destreg:Tregister;delloc:boolean);
+
+    {A lot smaller and less bug sensitive than the original unfolded loads.}
+
+    var tai:Paicpu;
+        r:Preference;
+
+    begin
+        tai := nil;
+        case location.loc of
+            LOC_REGISTER,LOC_CREGISTER:
+                begin
+                    case orddef^.typ of
+                        u8bit:
+                            tai:=new(paicpu,op_reg_reg(A_MOVZX,S_BL,location.register,destreg));
+                        s8bit:
+                            tai:=new(paicpu,op_reg_reg(A_MOVSX,S_BL,location.register,destreg));
+                        u16bit:
+                            tai:=new(paicpu,op_reg_reg(A_MOVZX,S_WL,location.register,destreg));
+                        s16bit:
+                            tai:=new(paicpu,op_reg_reg(A_MOVSX,S_WL,location.register,destreg));
+                        u32bit,s32bit:
+                            if location.register <> destreg then
+                              tai:=new(paicpu,op_reg_reg(A_MOV,S_L,location.register,destreg));
+                    end;
+                    if delloc then
+                        ungetregister(location.register);
+                end;
+            LOC_MEM,
+            LOC_REFERENCE:
+                begin
+                    if location.reference.is_immediate then
+                     tai:=new(paicpu,op_const_reg(A_MOV,S_L,location.reference.offset,destreg))
+                    else
+                     begin
+                       r:=newreference(location.reference);
+                       case orddef^.typ of
+                         u8bit:
+                            tai:=new(paicpu,op_ref_reg(A_MOVZX,S_BL,r,destreg));
+                         s8bit:
+                            tai:=new(paicpu,op_ref_reg(A_MOVSX,S_BL,r,destreg));
+                         u16bit:
+                            tai:=new(paicpu,op_ref_reg(A_MOVZX,S_WL,r,destreg));
+                         s16bit:
+                            tai:=new(paicpu,op_ref_reg(A_MOVSX,S_WL,r,destreg));
+                         u32bit:
+                            tai:=new(paicpu,op_ref_reg(A_MOV,S_L,r,destreg));
+                         s32bit:
+                            tai:=new(paicpu,op_ref_reg(A_MOV,S_L,r,destreg));
+                       end;
+                     end;
+                    if delloc then
+                        del_reference(location.reference);
+                end
+            else
+                internalerror(6);
+        end;
+        if assigned(tai) then
+          exprasmlist^.concat(tai);
+    end;
+
+    { if necessary ESI is reloaded after a call}
+    procedure maybe_loadesi;
+
+      var
+         hp : preference;
+         p : pprocinfo;
+         i : longint;
+
+      begin
+         if assigned(procinfo^._class) then
+           begin
+              exprasmlist^.concat(new(pairegalloc,alloc(R_ESI)));
+              if lexlevel>normal_function_level then
+                begin
+                   new(hp);
+                   reset_reference(hp^);
+                   hp^.offset:=procinfo^.framepointer_offset;
+                   hp^.base:=procinfo^.framepointer;
+                   emit_ref_reg(A_MOV,S_L,hp,R_ESI);
+                   p:=procinfo^.parent;
+                   for i:=3 to lexlevel-1 do
+                     begin
+                        new(hp);
+                        reset_reference(hp^);
+                        hp^.offset:=p^.framepointer_offset;
+                        hp^.base:=R_ESI;
+                        emit_ref_reg(A_MOV,S_L,hp,R_ESI);
+                        p:=p^.parent;
+                     end;
+                   new(hp);
+                   reset_reference(hp^);
+                   hp^.offset:=p^.selfpointer_offset;
+                   hp^.base:=R_ESI;
+                   emit_ref_reg(A_MOV,S_L,hp,R_ESI);
+                end
+              else
+                begin
+                   new(hp);
+                   reset_reference(hp^);
+                   hp^.offset:=procinfo^.selfpointer_offset;
+                   hp^.base:=procinfo^.framepointer;
+                   emit_ref_reg(A_MOV,S_L,hp,R_ESI);
+                end;
+           end;
+      end;
+
+
+{$ifndef CG11}
+    procedure maketojumpbool(p : ptree);
+    {
+      produces jumps to true respectively false labels using boolean expressions
+    }
+      var
+        opsize : topsize;
+        storepos : tfileposinfo;
+      begin
+         if p^.error then
+           exit;
+         storepos:=aktfilepos;
+         aktfilepos:=p^.fileinfo;
+         if is_boolean(p^.resulttype) then
+           begin
+              if is_constboolnode(p) then
+                begin
+                   if p^.value<>0 then
+                     emitjmp(C_None,truelabel)
+                   else
+                     emitjmp(C_None,falselabel);
+                end
+              else
+                begin
+                   opsize:=def_opsize(p^.resulttype);
+                   case p^.location.loc of
+                      LOC_CREGISTER,LOC_REGISTER : begin
+                                        emit_reg_reg(A_OR,opsize,p^.location.register,
+                                          p^.location.register);
+                                        ungetregister(p^.location.register);
+                                        emitjmp(C_NZ,truelabel);
+                                        emitjmp(C_None,falselabel);
+                                     end;
+                      LOC_MEM,LOC_REFERENCE : begin
+                                        emit_const_ref(
+                                          A_CMP,opsize,0,newreference(p^.location.reference));
+                                        del_reference(p^.location.reference);
+                                        emitjmp(C_NZ,truelabel);
+                                        emitjmp(C_None,falselabel);
+                                     end;
+                      LOC_FLAGS : begin
+                                     emitjmp(flag_2_cond[p^.location.resflags],truelabel);
+                                     emitjmp(C_None,falselabel);
+                                  end;
+                   end;
+                end;
+           end
+         else
+           CGMessage(type_e_mismatch);
+         aktfilepos:=storepos;
+      end;
+
+
+    { produces if necessary overflowcode }
+    procedure emitoverflowcheck(p:ptree);
+      var
+         hl : pasmlabel;
+      begin
+         if not(cs_check_overflow in aktlocalswitches) then
+          exit;
+         getlabel(hl);
+         if not ((p^.resulttype^.deftype=pointerdef) or
+                ((p^.resulttype^.deftype=orddef) and
+                 (porddef(p^.resulttype)^.typ in [u64bit,u16bit,u32bit,u8bit,uchar,
+                                                  bool8bit,bool16bit,bool32bit]))) then
            emitjmp(C_NO,hl)
          else
            emitjmp(C_NB,hl);
@@ -2331,288 +2535,6 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
       end;
 
 
-    procedure concatcopy(source,dest : treference;size : longint;delsource,loadref : boolean);
-
-      const
-         isizes : array[0..3] of topsize=(S_L,S_B,S_W,S_B);
-         ishr : array[0..3] of byte=(2,0,1,0);
-
-      var
-         ecxpushed : boolean;
-         helpsize : longint;
-         i : byte;
-         reg8,reg32 : tregister;
-         swap : boolean;
-
-         procedure maybepushecx;
-         begin
-           if not(R_ECX in unused) then
-             begin
-               exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_ECX)));
-               ecxpushed:=true;
-             end
-           else getexplicitregister32(R_ECX);
-         end;
-
-      begin
-{$IfNDef regallocfix}
-        If delsource then
-           del_reference(source);
-{$EndIf regallocfix}
-         if (not loadref) and
-            ((size<=8) or
-             (not(cs_littlesize in aktglobalswitches ) and (size<=12))) then
-           begin
-              helpsize:=size shr 2;
-              getexplicitregister32(R_EDI);
-              for i:=1 to helpsize do
-                begin
-                   emit_ref_reg(A_MOV,S_L,newreference(source),R_EDI);
-{$ifdef regallocfix}
-                   If (size = 4) and delsource then
-                     del_reference(source);
-{$endif regallocfix}
-                   exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,newreference(dest))));
-                   inc(source.offset,4);
-                   inc(dest.offset,4);
-                   dec(size,4);
-                end;
-              if size>1 then
-                begin
-                   emit_ref_reg(A_MOV,S_W,newreference(source),R_DI);
-{$ifdef regallocfix}
-                   If (size = 2) and delsource then
-                     del_reference(source);
-{$endif regallocfix}
-                   exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_W,R_DI,newreference(dest))));
-                   inc(source.offset,2);
-                   inc(dest.offset,2);
-                   dec(size,2);
-                end;
-              ungetregister32(R_EDI);
-              if size>0 then
-                begin
-                   { and now look for an 8 bit register }
-                   swap:=false;
-                   if R_EAX in unused then reg8:=reg32toreg8(getexplicitregister32(R_EAX))
-                   else if R_EDX in unused then reg8:=reg32toreg8(getexplicitregister32(R_EDX))
-                   else if R_EBX in unused then reg8:=reg32toreg8(getexplicitregister32(R_EBX))
-                   else if R_ECX in unused then reg8:=reg32toreg8(getexplicitregister32(R_ECX))
-                   else
-                      begin
-                         swap:=true;
-                         { we need only to check 3 registers, because }
-                         { one is always not index or base          }
-                         if (dest.base<>R_EAX) and (dest.index<>R_EAX) then
-                           begin
-                              reg8:=R_AL;
-                              reg32:=R_EAX;
-                           end
-                         else if (dest.base<>R_EBX) and (dest.index<>R_EBX) then
-                           begin
-                              reg8:=R_BL;
-                              reg32:=R_EBX;
-                           end
-                         else if (dest.base<>R_ECX) and (dest.index<>R_ECX) then
-                           begin
-                              reg8:=R_CL;
-                              reg32:=R_ECX;
-                           end;
-                      end;
-                   if swap then
-                     { was earlier XCHG, of course nonsense }
-                     begin
-                       getexplicitregister32(R_EDI);
-                       emit_reg_reg(A_MOV,S_L,reg32,R_EDI);
-                     end;
-                   emit_ref_reg(A_MOV,S_B,newreference(source),reg8);
-{$ifdef regallocfix}
-                   If delsource then
-                     del_reference(source);
-{$endif regallocfix}
-                   exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_B,reg8,newreference(dest))));
-                   if swap then
-                     begin
-                       emit_reg_reg(A_MOV,S_L,R_EDI,reg32);
-                       ungetregister32(R_EDI);
-                     end
-                   else
-                     ungetregister(reg8);
-                end;
-           end
-         else
-           begin
-              getexplicitregister32(R_EDI);
-              emit_ref_reg(A_LEA,S_L,newreference(dest),R_EDI);
-{$ifdef regallocfix}
-             {is this ok?? (JM)}
-              del_reference(dest);
-{$endif regallocfix}
-              exprasmlist^.concat(new(pairegalloc,alloc(R_ESI)));
-              if loadref then
-                emit_ref_reg(A_MOV,S_L,newreference(source),R_ESI)
-              else
-                begin
-                  emit_ref_reg(A_LEA,S_L,newreference(source),R_ESI);
-{$ifdef regallocfix}
-                  if delsource then
-                    del_reference(source);
-{$endif regallocfix}
-                end;
-
-              exprasmlist^.concat(new(paicpu,op_none(A_CLD,S_NO)));
-              ecxpushed:=false;
-              if cs_littlesize in aktglobalswitches  then
-                begin
-                   maybepushecx;
-                   emit_const_reg(A_MOV,S_L,size,R_ECX);
-                   exprasmlist^.concat(new(paicpu,op_none(A_REP,S_NO)));
-                   exprasmlist^.concat(new(paicpu,op_none(A_MOVSB,S_NO)));
-                end
-              else
-                begin
-                   helpsize:=size shr 2;
-                   size:=size and 3;
-                   if helpsize>1 then
-                    begin
-                      maybepushecx;
-                      emit_const_reg(A_MOV,S_L,helpsize,R_ECX);
-                      exprasmlist^.concat(new(paicpu,op_none(A_REP,S_NO)));
-                    end;
-                   if helpsize>0 then
-                    exprasmlist^.concat(new(paicpu,op_none(A_MOVSD,S_NO)));
-                   if size>1 then
-                     begin
-                        dec(size,2);
-                        exprasmlist^.concat(new(paicpu,op_none(A_MOVSW,S_NO)));
-                     end;
-                   if size=1 then
-                     exprasmlist^.concat(new(paicpu,op_none(A_MOVSB,S_NO)));
-                end;
-              ungetregister32(R_EDI);
-              exprasmlist^.concat(new(pairegalloc,dealloc(R_ESI)));
-              if ecxpushed then
-                exprasmlist^.concat(new(paicpu,op_reg(A_POP,S_L,R_ECX)))
-              else
-                ungetregister32(R_ECX);
-
-              { loading SELF-reference again }
-              maybe_loadesi;
-           end;
-         if delsource then
-           ungetiftemp(source);
-      end;
-
-
-    procedure emitloadord2reg(const location:Tlocation;orddef:Porddef;
-                              destreg:Tregister;delloc:boolean);
-
-    {A lot smaller and less bug sensitive than the original unfolded loads.}
-
-    var tai:Paicpu;
-        r:Preference;
-
-    begin
-        tai := nil;
-        case location.loc of
-            LOC_REGISTER,LOC_CREGISTER:
-                begin
-                    case orddef^.typ of
-                        u8bit:
-                            tai:=new(paicpu,op_reg_reg(A_MOVZX,S_BL,location.register,destreg));
-                        s8bit:
-                            tai:=new(paicpu,op_reg_reg(A_MOVSX,S_BL,location.register,destreg));
-                        u16bit:
-                            tai:=new(paicpu,op_reg_reg(A_MOVZX,S_WL,location.register,destreg));
-                        s16bit:
-                            tai:=new(paicpu,op_reg_reg(A_MOVSX,S_WL,location.register,destreg));
-                        u32bit,s32bit:
-                            if location.register <> destreg then
-                              tai:=new(paicpu,op_reg_reg(A_MOV,S_L,location.register,destreg));
-                    end;
-                    if delloc then
-                        ungetregister(location.register);
-                end;
-            LOC_MEM,
-            LOC_REFERENCE:
-                begin
-                    if location.reference.is_immediate then
-                     tai:=new(paicpu,op_const_reg(A_MOV,S_L,location.reference.offset,destreg))
-                    else
-                     begin
-                       r:=newreference(location.reference);
-                       case orddef^.typ of
-                         u8bit:
-                            tai:=new(paicpu,op_ref_reg(A_MOVZX,S_BL,r,destreg));
-                         s8bit:
-                            tai:=new(paicpu,op_ref_reg(A_MOVSX,S_BL,r,destreg));
-                         u16bit:
-                            tai:=new(paicpu,op_ref_reg(A_MOVZX,S_WL,r,destreg));
-                         s16bit:
-                            tai:=new(paicpu,op_ref_reg(A_MOVSX,S_WL,r,destreg));
-                         u32bit:
-                            tai:=new(paicpu,op_ref_reg(A_MOV,S_L,r,destreg));
-                         s32bit:
-                            tai:=new(paicpu,op_ref_reg(A_MOV,S_L,r,destreg));
-                       end;
-                     end;
-                    if delloc then
-                        del_reference(location.reference);
-                end
-            else
-                internalerror(6);
-        end;
-        if assigned(tai) then
-          exprasmlist^.concat(tai);
-    end;
-
-    { if necessary ESI is reloaded after a call}
-    procedure maybe_loadesi;
-
-      var
-         hp : preference;
-         p : pprocinfo;
-         i : longint;
-
-      begin
-         if assigned(procinfo^._class) then
-           begin
-              exprasmlist^.concat(new(pairegalloc,alloc(R_ESI)));
-              if lexlevel>normal_function_level then
-                begin
-                   new(hp);
-                   reset_reference(hp^);
-                   hp^.offset:=procinfo^.framepointer_offset;
-                   hp^.base:=procinfo^.framepointer;
-                   emit_ref_reg(A_MOV,S_L,hp,R_ESI);
-                   p:=procinfo^.parent;
-                   for i:=3 to lexlevel-1 do
-                     begin
-                        new(hp);
-                        reset_reference(hp^);
-                        hp^.offset:=p^.framepointer_offset;
-                        hp^.base:=R_ESI;
-                        emit_ref_reg(A_MOV,S_L,hp,R_ESI);
-                        p:=p^.parent;
-                     end;
-                   new(hp);
-                   reset_reference(hp^);
-                   hp^.offset:=p^.selfpointer_offset;
-                   hp^.base:=R_ESI;
-                   emit_ref_reg(A_MOV,S_L,hp,R_ESI);
-                end
-              else
-                begin
-                   new(hp);
-                   reset_reference(hp^);
-                   hp^.offset:=procinfo^.selfpointer_offset;
-                   hp^.base:=procinfo^.framepointer;
-                   emit_ref_reg(A_MOV,S_L,hp,R_ESI);
-                end;
-           end;
-      end;
-
-
    { DO NOT RELY on the fact that the ptree is not yet swaped
      because of inlining code PM }
     procedure firstcomplex(p : ptree);
@@ -2644,6 +2566,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
          {else
            p^.swaped:=false; do not modify }
       end;
+{$endif}
 
 
 {*****************************************************************************
@@ -3966,7 +3889,10 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 end.
 {
   $Log$
-  Revision 1.16  2000-09-30 16:08:45  peter
+  Revision 1.17  2000-10-01 19:48:23  peter
+    * lot of compile updates for cg11
+
+  Revision 1.16  2000/09/30 16:08:45  peter
     * more cg11 updates
 
   Revision 1.15  2000/09/24 15:06:12  peter
@@ -4032,4 +3958,4 @@ end.
   Revision 1.2  2000/07/13 11:32:37  michael
   + removed logs
 
-}
+}

compiler/nadd.pas

@@ -42,8 +42,6 @@ interface
        { specific node types can be created               }
        caddnode : class of taddnode;
 
-    function isbinaryoverloaded(var p : tbinarynode) : boolean;
-
 implementation
 
     uses
@@ -57,89 +55,9 @@ implementation
       hcodegen,
 {$endif newcg}
       htypechk,pass_1,
+      ncal,nmat,ncnv,nld,ncon,nset,
       cpubase;
 
-    function isbinaryoverloaded(var p : tbinarynode) : boolean;
-
-     var
-         rd,ld   : pdef;
-         t : tnode;
-         optoken : ttoken;
-
-      begin
-        isbinaryoverloaded:=false;
-        { overloaded operator ? }
-        { load easier access variables }
-        rd:=p.right.resulttype;
-        ld:=p.left.resulttype;
-        if isbinaryoperatoroverloadable(ld,rd,voiddef,p.nodetype) then
-          begin
-             isbinaryoverloaded:=true;
-             {!!!!!!!!! handle paras }
-             case p.nodetype of
-                { the nil as symtable signs firstcalln that this is
-                  an overloaded operator }
-                addn:
-                  optoken:=_PLUS;
-                subn:
-                  optoken:=_MINUS;
-                muln:
-                  optoken:=_STAR;
-                starstarn:
-                  optoken:=_STARSTAR;
-                slashn:
-                  optoken:=_SLASH;
-                ltn:
-                  optoken:=tokens._lt;
-                gtn:
-                  optoken:=tokens._gt;
-                lten:
-                  optoken:=_lte;
-                gten:
-                  optoken:=_gte;
-                equaln,unequaln :
-                  optoken:=_EQUAL;
-                symdifn :
-                  optoken:=_SYMDIF;
-                modn :
-                  optoken:=_OP_MOD;
-                orn :
-                  optoken:=_OP_OR;
-                xorn :
-                  optoken:=_OP_XOR;
-                andn :
-                  optoken:=_OP_AND;
-                divn :
-                  optoken:=_OP_DIV;
-                shln :
-                  optoken:=_OP_SHL;
-                shrn :
-                  optoken:=_OP_SHR;
-                else
-                  exit;
-             end;
-             t:=gencallnode(overloaded_operators[optoken],nil);
-             { we have to convert p.left and p.right into
-              callparanodes }
-             if tcallnode(t).symtableprocentry=nil then
-               begin
-                  CGMessage(parser_e_operator_not_overloaded);
-                  t.free;
-               end
-             else
-               begin
-                  inc(tcallnode(t).symtableprocentry^.refs);
-                  tcallnode(t).left:=gencallparanode(p.left,nil);
-                  tcallnode(t).left:=gencallparanode(p.right,tcallnode(t).left);
-                  if p.nodetype=unequaln then
-                   t:=cnotnode.create(t);
-                  p.left:=nil;
-                  p.right:=nil;
-                  firstpass(t);
-                  p:=tbinarynode(t);
-               end;
-          end;
-      end;
 
 {*****************************************************************************
                                 TADDNODE
@@ -206,8 +124,8 @@ implementation
            arrayconstructor_to_set(tarrayconstructnode(right));
 
          { both left and right need to be valid }
-         left.set_varstate(true);
-         right.set_varstate(true);
+         set_varstate(left,true);
+         set_varstate(right,true);
 
          { load easier access variables }
          lt:=left.nodetype;
@@ -1314,7 +1232,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.11  2000-09-30 16:08:45  peter
+  Revision 1.12  2000-10-01 19:48:23  peter
+    * lot of compile updates for cg11
+
+  Revision 1.11  2000/09/30 16:08:45  peter
     * more cg11 updates
 
   Revision 1.10  2000/09/28 19:49:52  florian

compiler/ncal.pas

@@ -219,7 +219,7 @@ interface
                begin
                  { not completly proper, but avoids some warnings }
                  if (defcoll^.paratyp=vs_var) then
-                   left.set_funcret_is_valid;
+                   set_funcret_is_valid(left);
 
                  { protected has nothing to do with read/write
                  if (defcoll^.paratyp=vs_var) then
@@ -353,7 +353,7 @@ interface
                    { Causes problems with const ansistrings if also }
                    { done for vs_const (JM)                         }
                    if defcoll^.paratyp = vs_var then
-                     left.set_unique;
+                     set_unique(left);
                    make_not_regable(left);
                 end;
 
@@ -363,7 +363,7 @@ interface
                 make_not_regable(left);
 
               if do_count then
-                left.set_varstate(defcoll^.paratyp <> vs_var);
+                set_varstate(left,defcoll^.paratyp <> vs_var);
                 { must only be done after typeconv PM }
               resulttype:=defcoll^.paratype.def;
            end;
@@ -628,7 +628,7 @@ interface
                      goto errorexit;
                 end;
               firstpass(right);
-              right.set_varstate(true);
+              set_varstate(right,true);
 
               { check the parameters }
               pdc:=pparaitem(pprocvardef(right.resulttype)^.para^.first);
@@ -1363,7 +1363,7 @@ interface
                      else
                        method_must_be_valid:=true;
                      firstpass(methodpointer);
-                     methodpointer.set_varstate(method_must_be_valid);
+                     set_varstate(methodpointer,method_must_be_valid);
                      { The object is already used ven if it is called once }
                      if (methodpointer.nodetype=loadn) and
                         (tloadnode(methodpointer).symtableentry^.typ=varsym) then
@@ -1472,7 +1472,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.7  2000-09-28 19:49:52  florian
+  Revision 1.8  2000-10-01 19:48:24  peter
+    * lot of compile updates for cg11
+
+  Revision 1.7  2000/09/28 19:49:52  florian
   *** empty log message ***
 
   Revision 1.6  2000/09/27 18:14:31  florian

compiler/ncnv.pas

@@ -27,7 +27,9 @@ unit ncnv;
 interface
 
     uses
-       node,symtable,nld;
+       node,
+       symtable,types,
+       nld;
 
     type
        ttypeconvnode = class(tunarynode)
@@ -85,8 +87,8 @@ implementation
    uses
       globtype,systems,tokens,
       cutils,cobjects,verbose,globals,
-      symconst,aasm,types,ncon,ncal,
-      nset,nadd,
+      symconst,aasm,
+      ncon,ncal,nset,nadd,
 {$ifdef newcg}
       cgbase,
 {$else newcg}
@@ -1094,9 +1096,9 @@ implementation
       begin
          pass_1:=nil;
          firstpass(left);
-         left.set_varstate(true);
+         set_varstate(left,true);
          firstpass(right);
-         right.set_varstate(true);
+         set_varstate(right,true);
          if codegenerror then
            exit;
 
@@ -1136,9 +1138,9 @@ implementation
       begin
          pass_1:=nil;
          firstpass(right);
-         right.set_varstate(true);
+         set_varstate(right,true);
          firstpass(left);
-         left.set_varstate(true);
+         set_varstate(left,true);
          if codegenerror then
            exit;
 
@@ -1171,7 +1173,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.5  2000-09-28 19:49:52  florian
+  Revision 1.6  2000-10-01 19:48:24  peter
+    * lot of compile updates for cg11
+
+  Revision 1.5  2000/09/28 19:49:52  florian
   *** empty log message ***
 
   Revision 1.4  2000/09/27 18:14:31  florian

compiler/nflw.pas

@@ -236,7 +236,7 @@ implementation
 {$endif newcg}
 
          firstpass(left);
-         left.set_varstate(true);
+         set_varstate(left,true);
          if codegenerror then
            exit;
          if not is_boolean(left.resulttype) then
@@ -300,7 +300,7 @@ implementation
          cleartempgen;
 {$endif newcg}
          firstpass(left);
-         left.set_varstate(true);
+         set_varstate(left,true);
 
          { Only check type if no error, we can't leave here because
            the right also needs to be firstpassed }
@@ -439,7 +439,7 @@ implementation
          cleartempgen;
 {$endif newcg}
          firstpass(left);
-         left.set_varstate(false);
+         set_varstate(left,false);
 
 {$ifdef newcg}
          tg.cleartempgen;
@@ -474,7 +474,7 @@ implementation
          cleartempgen;
 {$endif newcg}
          firstpass(t2);
-         t2.set_varstate(true);
+         set_varstate(t2,true);
          if codegenerror then
           exit;
 
@@ -512,7 +512,7 @@ implementation
          cleartempgen;
 {$endif newcg}
          firstpass(right);
-         right.set_varstate(true);
+         set_varstate(right,true);
          if right.nodetype<>ordconstn then
            begin
               right:=gentypeconvnode(right,t2.resulttype);
@@ -658,7 +658,7 @@ implementation
                  ((left.resulttype^.deftype<>objectdef) or
                   not(pobjectdef(left.resulttype)^.is_class)) then
                 CGMessage(type_e_mismatch);
-              left.set_varstate(true);
+              set_varstate(left,true);
               if codegenerror then
                exit;
               { insert needed typeconvs for addr,frame }
@@ -770,7 +770,7 @@ implementation
          aktexceptblock:=left;
          firstpass(left);
          aktexceptblock:=oldexceptblock;
-         left.set_varstate(true);
+         set_varstate(left,true);
 {$ifdef newcg}
          tg.cleartempgen;
 {$else newcg}
@@ -780,7 +780,7 @@ implementation
          aktexceptblock:=right;
          firstpass(right);
          aktexceptblock:=oldexceptblock;
-         right.set_varstate(true);
+         set_varstate(right,true);
          if codegenerror then
            exit;
          left_right_max;
@@ -875,7 +875,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.4  2000-09-28 19:49:52  florian
+  Revision 1.5  2000-10-01 19:48:24  peter
+    * lot of compile updates for cg11
+
+  Revision 1.4  2000/09/28 19:49:52  florian
   *** empty log message ***
 
   Revision 1.3  2000/09/24 21:15:34  florian

compiler/ninl.pas

@@ -171,7 +171,7 @@ implementation
            location.loc:=LOC_FPU;
            resulttype:=s80floatdef;
            { redo firstpass for varstate status PM }
-           left.set_varstate(true);
+           set_varstate(left,true);
            if (left.resulttype^.deftype<>floatdef) or
              (pfloatdef(left.resulttype)^.typ<>s80real) then
              begin
@@ -404,7 +404,7 @@ implementation
              in_hi_word:
 
                begin
-                  left.set_varstate(true);
+                  set_varstate(left,true);
                   if registers32<1 then
                     registers32:=1;
                   if inlinenumber in [in_lo_word,in_hi_word] then
@@ -446,7 +446,7 @@ implementation
 
              in_sizeof_x:
                begin
-                 left.set_varstate(false);
+                 set_varstate(left,false);
                  if push_high_param(left.resulttype) then
                   begin
                     getsymonlyin(tloadnode(left).symtable,'high'+pvarsym(tloadnode(left).symtableentry)^.name);
@@ -466,7 +466,7 @@ implementation
 
              in_typeof_x:
                begin
-                  left.set_varstate(false);
+                  set_varstate(left,false);
                   if registers32<1 then
                     registers32:=1;
                   location.loc:=LOC_REGISTER;
@@ -475,7 +475,7 @@ implementation
 
              in_ord_x:
                begin
-                  left.set_varstate(true);
+                  set_varstate(left,true);
                   if (left.nodetype=ordconstn) then
                     begin
                        hp:=genordinalconstnode(tordconstnode(left).value,s32bitdef);
@@ -545,7 +545,7 @@ implementation
 
              in_chr_byte:
                begin
-                  left.set_varstate(true);
+                  set_varstate(left,true);
                   hp:=gentypeconvnode(left,cchardef);
                   left:=nil;
                   include(hp.flags,nf_explizit);
@@ -555,7 +555,7 @@ implementation
 
              in_length_string:
                begin
-                  left.set_varstate(true);
+                  set_varstate(left,true);
                   if is_ansistring(left.resulttype) then
                     resulttype:=s32bitdef
                   else
@@ -600,14 +600,14 @@ implementation
 
              in_assigned_x:
                begin
-                  left.set_varstate(true);
+                  set_varstate(left,true);
                   resulttype:=booldef;
                   location.loc:=LOC_FLAGS;
                end;
 
              in_ofs_x,
              in_seg_x :
-               left.set_varstate(false);
+               set_varstate(left,false);
              in_pred_x,
              in_succ_x:
                begin
@@ -623,7 +623,7 @@ implementation
                          registers32:=1;
                     end;
                   location.loc:=LOC_REGISTER;
-                  left.set_varstate(true);
+                  set_varstate(left,true);
                   if not is_ordinal(resulttype) then
                     CGMessage(type_e_ordinal_expr_expected)
                   else
@@ -651,7 +651,7 @@ implementation
                  if assigned(left) then
                    begin
                       tcallparanode(left).firstcallparan(nil,true);
-                      left.set_varstate(true);
+                      set_varstate(left,true);
                       if codegenerror then
                        exit;
                       { first param must be var }
@@ -708,7 +708,7 @@ implementation
                     begin
                        dowrite:=(inlinenumber in [in_write_x,in_writeln_x]);
                        tcallparanode(left).firstcallparan(nil,true);
-                       left.set_varstate(dowrite);
+                       set_varstate(left,dowrite);
                        { now we can check }
                        hp:=left;
                        while assigned(tcallparanode(hp).right) do
@@ -877,7 +877,7 @@ implementation
                        if codegenerror then
                          exit;
                        tcallparanode(left).firstcallparan(nil,true);
-                       left.set_varstate(true);
+                       set_varstate(left,true);
                        { calc registers }
                        left_max;
                        if extra_register then
@@ -909,7 +909,7 @@ implementation
                begin
                   procinfo^.flags:=procinfo^.flags or pi_do_call;
                   firstpass(left);
-                  left.set_varstate(true);
+                  set_varstate(left,true);
                   resulttype:=voiddef;
                end;
 
@@ -928,12 +928,12 @@ implementation
                   hp:=tcallparanode(left).right;
                   tcallparanode(left).right:=nil;
                   tcallparanode(left).firstcallparan(nil,true);
-                  left.set_varstate(false);
+                  set_varstate(left,false);
                   { remove warning when result is passed }
-                  tcallparanode(left).left.set_funcret_is_valid;
+                  set_funcret_is_valid(tcallparanode(left).left);
                   tcallparanode(left).right:=hp;
                   tcallparanode(tcallparanode(left).right).firstcallparan(nil,true);
-                  tcallparanode(left).right.set_varstate(true);
+                  set_varstate(tcallparanode(left).right,true);
                   hp:=left;
                   { valid string ? }
                   if not assigned(hp) or
@@ -986,7 +986,7 @@ implementation
                   if assigned(hpp) and (nf_is_colon_para in hpp.flags) then
                     begin
                       firstpass(tcallparanode(hpp).left);
-                      tcallparanode(hpp).left.set_varstate(true);
+                      set_varstate(tcallparanode(hpp).left,true);
                       if (not is_integer(tcallparanode(hpp).left.resulttype)) then
                         CGMessage1(type_e_integer_expr_expected,tcallparanode(hpp).left.resulttype^.typename)
                       else
@@ -1001,7 +1001,7 @@ implementation
                              else
                                begin
                                  firstpass(tcallparanode(hpp).left);
-                                 tcallparanode(hpp).left.set_varstate(true);
+                                 set_varstate(tcallparanode(hpp).left,true);
                                  tcallparanode(hpp).left:=gentypeconvnode(tcallparanode(hpp).left,s32bitdef);
                                end;
                            end
@@ -1037,7 +1037,7 @@ implementation
                        tcallparanode(left).right := nil;
                        make_not_regable(tcallparanode(left).left);
                        tcallparanode(left).firstcallparan(nil,true);
-                       tcallparanode(left).set_varstate(false);
+                       set_varstate(left,false);
                        if codegenerror then exit;
                        tcallparanode(left).right := hp;
                      {code has to be a var parameter}
@@ -1058,12 +1058,12 @@ implementation
                   {hpp = destination}
                   make_not_regable(tcallparanode(hpp).left);
                   tcallparanode(hpp).firstcallparan(nil,true);
-                  hpp.set_varstate(false);
+                  set_varstate(hpp,false);
 
                   if codegenerror then
                     exit;
                   { remove warning when result is passed }
-                  tcallparanode(hpp).left.set_funcret_is_valid;
+                  set_funcret_is_valid(tcallparanode(hpp).left);
                   tcallparanode(hpp).right := hp;
                   if valid_for_assign(tcallparanode(hpp).left,false) then
                    begin
@@ -1077,7 +1077,7 @@ implementation
                  {hp = source (String)}
                   { count_ref := false; WHY ?? }
                   tcallparanode(hp).firstcallparan(nil,true);
-                  hp.set_varstate(true);
+                  set_varstate(hp,true);
                   if codegenerror then
                     exit;
                   { if not a stringdef then insert a type conv which
@@ -1105,14 +1105,14 @@ implementation
                  if assigned(left) then
                    begin
                       tcallparanode(left).firstcallparan(nil,true);
-                      left.set_varstate(true);
+                      set_varstate(left,true);
                       registers32:=left.registers32;
                       registersfpu:=left.registersfpu;
 {$ifdef SUPPORT_MMX}
                       registersmmx:=left.registersmmx;
 {$endif SUPPORT_MMX}
                       { remove warning when result is passed }
-                      tcallparanode(left).left.set_funcret_is_valid;
+                      set_funcret_is_valid(tcallparanode(left).left);
                       { first param must be var }
                       valid_for_assign(tcallparanode(left).left,false);
                       { check type }
@@ -1144,7 +1144,7 @@ implementation
              in_low_x,
              in_high_x:
                begin
-                  left.set_varstate(false);
+                  set_varstate(left,false);
                   { this fixes tests\webtbs\tbug879.pp (FK)
                   if left.nodetype in [typen,loadn,subscriptn] then
                     begin
@@ -1319,7 +1319,7 @@ implementation
                  if assigned(left) then
                    begin
                       tcallparanode(left).firstcallparan(nil,true);
-                      left.set_varstate(true);
+                      set_varstate(left,true);
                       registers32:=left.registers32;
                       registersfpu:=left.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -1366,7 +1366,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.5  2000-09-28 19:49:52  florian
+  Revision 1.6  2000-10-01 19:48:24  peter
+    * lot of compile updates for cg11
+
+  Revision 1.5  2000/09/28 19:49:52  florian
   *** empty log message ***
 
   Revision 1.4  2000/09/28 16:34:47  florian

compiler/nld.pas

@@ -391,14 +391,14 @@ implementation
          { must be made unique }
          if assigned(left) then
            begin
-              left.set_unique;
+              set_unique(left);
 
               { set we the function result? }
-              left.set_funcret_is_valid;
+              set_funcret_is_valid(left);
            end;
 
          firstpass(left);
-         left.set_varstate(false);
+         set_varstate(left,false);
          if codegenerror then
            exit;
 
@@ -436,7 +436,7 @@ implementation
            end;
 {$endif i386}
          firstpass(right);
-         right.set_varstate(true);
+         set_varstate(right,true);
          if codegenerror then
            exit;
 
@@ -558,9 +558,9 @@ implementation
     function tarrayconstructorrangenode.pass_1 : tnode;
       begin
         firstpass(left);
-        left.set_varstate(true);
+        set_varstate(left,true);
         firstpass(right);
-        right.set_varstate(true);
+        set_varstate(right,true);
         calcregisters(self,0,0,0);
         resulttype:=left.resulttype;
       end;
@@ -640,7 +640,7 @@ implementation
            while assigned(hp) do
             begin
               firstpass(hp.left);
-              hp.left.set_varstate(true);
+              set_varstate(hp.left,true);
               if (not get_para_resulttype) and
                 (not(nf_novariaallowed in flags)) then
                begin
@@ -769,7 +769,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.4  2000-09-28 19:49:52  florian
+  Revision 1.5  2000-10-01 19:48:24  peter
+    * lot of compile updates for cg11
+
+  Revision 1.4  2000/09/28 19:49:52  florian
   *** empty log message ***
 
   Revision 1.3  2000/09/27 18:14:31  florian

compiler/nmat.pas

@@ -82,9 +82,9 @@ interface
       begin
          pass_1:=nil;
          firstpass(left);
-         right.set_varstate(true);
+         set_varstate(right,true);
          firstpass(right);
-         right.set_varstate(true);
+         set_varstate(right,true);
          if codegenerror then
            exit;
 
@@ -217,9 +217,9 @@ interface
       begin
          pass_1:=nil;
          firstpass(left);
-         left.set_varstate(true);
+         set_varstate(left,true);
          firstpass(right);
-         right.set_varstate(true);
+         set_varstate(right,true);
          if codegenerror then
            exit;
 
@@ -286,7 +286,7 @@ interface
       begin
          pass_1:=nil;
          firstpass(left);
-         left.set_varstate(true);
+         set_varstate(left,true);
          registers32:=left.registers32;
          registersfpu:=left.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -417,7 +417,7 @@ interface
       begin
          pass_1:=nil;
          firstpass(left);
-         left.set_varstate(true);
+         set_varstate(left,true);
          if codegenerror then
            exit;
 
@@ -528,7 +528,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.6  2000-09-27 21:33:22  florian
+  Revision 1.7  2000-10-01 19:48:24  peter
+    * lot of compile updates for cg11
+
+  Revision 1.6  2000/09/27 21:33:22  florian
     * finally nadd.pas compiles
 
   Revision 1.5  2000/09/27 20:25:44  florian

compiler/nmem.pas

@@ -483,7 +483,7 @@ implementation
          firstpass(left);
          { this is like the function addr }
          inc(parsing_para_level);
-         left.set_varstate(false);
+         set_varstate(left,false);
          dec(parsing_para_level);
          if codegenerror then
            exit;
@@ -532,7 +532,7 @@ implementation
          make_not_regable(left);
          firstpass(left);
          inc(parsing_para_level);
-         left.set_varstate(false);
+         set_varstate(left,false);
          dec(parsing_para_level);
          if resulttype=nil then
            resulttype:=voidpointerdef;
@@ -570,7 +570,7 @@ implementation
       begin
          pass_1:=nil;
          firstpass(left);
-         left.set_varstate(true);
+         set_varstate(left,true);
          if codegenerror then
            begin
              resulttype:=generrordef;
@@ -853,8 +853,8 @@ implementation
          if assigned(left) and assigned(right) then
             begin
                firstpass(left);
-               left.unset_varstate;
-               left.set_varstate(true);
+               unset_varstate(left);
+               set_varstate(left,true);
                if codegenerror then
                  exit;
                symtable:=withsymtable;
@@ -884,7 +884,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.4  2000-09-28 19:49:52  florian
+  Revision 1.5  2000-10-01 19:48:24  peter
+    * lot of compile updates for cg11
+
+  Revision 1.4  2000/09/28 19:49:52  florian
   *** empty log message ***
 
   Revision 1.3  2000/09/25 15:37:14  florian

compiler/node.inc

@@ -230,173 +230,6 @@
          fileinfo:=filepos;
       end;
 
-    procedure tnode.unset_varstate;
-
-      begin
-         internalerror(220920002);
-      end;
-
-    procedure tnode.set_varstate(must_be_valid : boolean);
-
-      begin
-         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 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
-                tunarynode(self).left.set_funcret_is_valid;
-         end;
-      end;
-
-
-{$warning FIX ME !!!!!}
-{$ifdef dummy}
-    procedure unset_varstate(p : ptree);
-      begin
-        while assigned(p) do
-         begin
-           p^.varstateset:=false;
-           case p^.treetype of
-             typeconvn,
-             subscriptn,
-             vecn :
-               p:=p^.left;
-             else
-               break;
-           end;
-         end;
-      end;
-
-
-    procedure set_varstate(p : ptree;must_be_valid : boolean);
-
-      begin
-         if not assigned(p) then
-           exit
-         else
-           begin
-             if p^.varstateset then
-               exit;
-              case p^.treetype of
-           typeconvn :
-             if p^.convtyp in
-               [
-                tc_cchar_2_pchar,
-                tc_cstring_2_pchar,
-                tc_array_2_pointer
-               ] then
-               set_varstate(p^.left,false)
-             else if p^.convtyp in
-               [
-                tc_pchar_2_string,
-                tc_pointer_2_array
-               ] then
-               set_varstate(p^.left,true)
-             else
-               set_varstate(p^.left,must_be_valid);
-           subscriptn :
-             set_varstate(p^.left,must_be_valid);
-           vecn:
-             begin
-               if (p^.left^.resulttype^.deftype in [stringdef,arraydef]) then
-                 set_varstate(p^.left,must_be_valid)
-               else
-                 set_varstate(p^.left,true);
-               set_varstate(p^.right,true);
-             end;
-           { do not parse calln }
-           calln : ;
-           callparan:
-             begin
-               set_varstate(p^.left,must_be_valid);
-               set_varstate(p^.right,must_be_valid);
-             end;
-           loadn :
-         if (p^.symtableentry^.typ=varsym) then
-          begin
-            if must_be_valid and p^.is_first then
-              begin
-                if (pvarsym(p^.symtableentry)^.varstate=vs_declared_and_first_found) or
-                   (pvarsym(p^.symtableentry)^.varstate=vs_set_but_first_not_passed) then
-                 if (assigned(pvarsym(p^.symtableentry)^.owner) and
-                    assigned(aktprocsym) and
-                    (pvarsym(p^.symtableentry)^.owner = aktprocsym^.definition^.localst)) then
-                  begin
-                    if p^.symtable^.symtabletype=localsymtable then
-                     CGMessage1(sym_n_uninitialized_local_variable,pvarsym(p^.symtableentry)^.name)
-                    else
-                     CGMessage1(sym_n_uninitialized_variable,pvarsym(p^.symtableentry)^.name);
-                  end;
-              end;
-          if (p^.is_first) then
-           begin
-             if pvarsym(p^.symtableentry)^.varstate=vs_declared_and_first_found then
-             { this can only happen at left of an assignment, no ? PM }
-              if (parsing_para_level=0) and not must_be_valid then
-               pvarsym(p^.symtableentry)^.varstate:=vs_assigned
-              else
-               pvarsym(p^.symtableentry)^.varstate:=vs_used;
-             if pvarsym(p^.symtableentry)^.varstate=vs_set_but_first_not_passed then
-               pvarsym(p^.symtableentry)^.varstate:=vs_used;
-             p^.is_first:=false;
-           end
-         else
-           begin
-             if (pvarsym(p^.symtableentry)^.varstate=vs_assigned) and
-                (must_be_valid or (parsing_para_level>0) or
-                 (p^.resulttype^.deftype=procvardef)) then
-               pvarsym(p^.symtableentry)^.varstate:=vs_used;
-             if (pvarsym(p^.symtableentry)^.varstate=vs_declared_and_first_found) and
-                (must_be_valid or (parsing_para_level>0) or
-                (p^.resulttype^.deftype=procvardef)) then
-               pvarsym(p^.symtableentry)^.varstate:=vs_set_but_first_not_passed;
-           end;
-         end;
-         funcretn:
-         begin
-         { no claim if setting higher return value_str }
-         if must_be_valid and
-            (procinfo=pprocinfo(p^.funcretprocinfo)) and
-            ((procinfo^.funcret_state=vs_declared) or
-            ((p^.is_first_funcret) and
-             (procinfo^.funcret_state=vs_declared_and_first_found))) then
-           begin
-             CGMessage(sym_w_function_result_not_set);
-             { avoid multiple warnings }
-             procinfo^.funcret_state:=vs_assigned;
-           end;
-         if p^.is_first_funcret and not must_be_valid then
-           pprocinfo(p^.funcretprocinfo)^.funcret_state:=vs_assigned;
-         end;
-         else
-           begin
-             {internalerror(565656);}
-           end;
-         end;{case }
-         p^.varstateset:=true;
-      end;
-    end;
-
-{$endif}
 
 {****************************************************************************
                                  TUNARYNODE
@@ -536,86 +369,6 @@
          getcopy:=p;
       end;
 
-    function tbinarynode.isbinaryoverloaded(var t : tnode) : boolean;
-
-     var
-         rd,ld   : pdef;
-         optoken : ttoken;
-
-      begin
-        t:=nil;
-        isbinaryoverloaded:=false;
-        { overloaded operator ? }
-        { load easier access variables }
-        rd:=right.resulttype;
-        ld:=left.resulttype;
-        if isbinaryoperatoroverloadable(ld,rd,voiddef,nodetype) then
-          begin
-             isbinaryoverloaded:=true;
-             {!!!!!!!!! handle paras }
-             case nodetype of
-                { the nil as symtable signs firstcalln that this is
-                  an overloaded operator }
-                addn:
-                  optoken:=_PLUS;
-                subn:
-                  optoken:=_MINUS;
-                muln:
-                  optoken:=_STAR;
-                starstarn:
-                  optoken:=_STARSTAR;
-                slashn:
-                  optoken:=_SLASH;
-                ltn:
-                  optoken:=tokens._lt;
-                gtn:
-                  optoken:=tokens._gt;
-                lten:
-                  optoken:=_lte;
-                gten:
-                  optoken:=_gte;
-                equaln,unequaln :
-                  optoken:=_EQUAL;
-                symdifn :
-                  optoken:=_SYMDIF;
-                modn :
-                  optoken:=_OP_MOD;
-                orn :
-                  optoken:=_OP_OR;
-                xorn :
-                  optoken:=_OP_XOR;
-                andn :
-                  optoken:=_OP_AND;
-                divn :
-                  optoken:=_OP_DIV;
-                shln :
-                  optoken:=_OP_SHL;
-                shrn :
-                  optoken:=_OP_SHR;
-                else
-                  exit;
-             end;
-             t:=gencallnode(overloaded_operators[optoken],nil);
-             { we have to convert p^.left and p^.right into
-              callparanodes }
-             if tcallnode(t).symtableprocentry=nil then
-               begin
-                  CGMessage(parser_e_operator_not_overloaded);
-                  t.free;
-                  t:=nil;
-               end
-             else
-               begin
-                  inc(tcallnode(t).symtableprocentry^.refs);
-                  tcallnode(t).left:=gencallparanode(left,nil);
-                  tcallnode(t).left:=gencallparanode(right,tcallnode(t).left);
-                  if nodetype=unequaln then
-                    t:=cnotnode.create(t);
-
-                  firstpass(t);
-               end;
-          end;
-      end;
 
     procedure tbinarynode.swapleftright;
 
@@ -625,7 +378,8 @@
       begin
          swapp:=right;
          right:=left;
-         left:=swapp;
+         left:=
+         swapp;
          if nf_swaped in flags then
            exclude(flags,nf_swaped)
          else
@@ -675,7 +429,10 @@
       end;
 {
   $Log$
-  Revision 1.7  2000-09-29 15:45:23  florian
+  Revision 1.8  2000-10-01 19:48:24  peter
+    * lot of compile updates for cg11
+
+  Revision 1.7  2000/09/29 15:45:23  florian
     * make cycle fixed
 
   Revision 1.6  2000/09/28 19:49:52  florian
@@ -696,4 +453,4 @@
   Revision 1.1  2000/08/26 12:27:17  florian
     * createial release
 
-}
+}

compiler/node.pas

@@ -27,23 +27,30 @@ unit node;
 interface
 
     uses
-       globtype,globals,cobjects,aasm,cpubase,symtable,
-       tokens;
+       cobjects,
+       globtype,
+       cpubase,
+       aasm,
+       symtable;
 
     {$I nodeh.inc}
 
 implementation
 
     uses
-       htypechk,hcodegen,verbose,
-       pass_1,symconst,cutils;
+       cutils,
+       globals,
+       symconst;
 
     {$I node.inc}
 
 end.
 {
   $Log$
-  Revision 1.7  2000-09-30 16:08:45  peter
+  Revision 1.8  2000-10-01 19:48:24  peter
+    * lot of compile updates for cg11
+
+  Revision 1.7  2000/09/30 16:08:45  peter
     * more cg11 updates
 
   Revision 1.6  2000/09/28 19:49:52  florian

compiler/nodeh.inc

@@ -109,53 +109,6 @@
           loadvmtn
        );
 
-       tconverttype = (
-          tc_equal,
-          tc_not_possible,
-          tc_string_2_string,
-          tc_char_2_string,
-          tc_pchar_2_string,
-          tc_cchar_2_pchar,
-          tc_cstring_2_pchar,
-          tc_ansistring_2_pchar,
-          tc_string_2_chararray,
-          tc_chararray_2_string,
-          tc_array_2_pointer,
-          tc_pointer_2_array,
-          tc_int_2_int,
-          tc_int_2_bool,
-          tc_bool_2_bool,
-          tc_bool_2_int,
-          tc_real_2_real,
-          tc_int_2_real,
-          tc_int_2_fix,
-          tc_real_2_fix,
-          tc_fix_2_real,
-          tc_proc_2_procvar,
-          tc_arrayconstructor_2_set,
-          tc_load_smallset,
-          tc_cord_2_pointer
-       );
-
-      pcaserecord = ^tcaserecord;
-      tcaserecord = record
-          { range }
-          _low,_high : longint;
-
-          { only used by gentreejmp }
-          _at : pasmlabel;
-
-          { label of instruction }
-          statement : pasmlabel;
-
-          { is this the first of an case entry, needed to release statement
-            label (PFV) }
-          firstlabel : boolean;
-
-          { left and right tree node }
-          less,greater : pcaserecord;
-       end;
-
        { all boolean field of ttree are now collected in flags }
        tnodeflags = (
          nf_needs_truefalselabel,
@@ -272,14 +225,7 @@
           function docompare(p : tnode) : boolean;virtual;
           { gets a copy of the node }
           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  }
@@ -325,7 +271,6 @@
           procedure det_temp;override;
           function docompare(p : tnode) : boolean;override;
           procedure swapleftright;
-          function isbinaryoverloaded(var t : tnode) : boolean;
           function getcopy : tnode;override;
           procedure left_right_max;
        end;
@@ -338,7 +283,10 @@
 
 {
   $Log$
-  Revision 1.10  2000-09-28 19:49:52  florian
+  Revision 1.11  2000-10-01 19:48:24  peter
+    * lot of compile updates for cg11
+
+  Revision 1.10  2000/09/28 19:49:52  florian
   *** empty log message ***
 
   Revision 1.9  2000/09/27 18:14:31  florian

compiler/nset.pas

@@ -135,7 +135,7 @@ implementation
       begin
          pass_1:=nil;
          firstpass(left);
-         left.set_varstate(true);
+         set_varstate(left,true);
          if codegenerror then
           exit;
 
@@ -203,7 +203,7 @@ implementation
          resulttype:=booldef;
 
          firstpass(right);
-         right.set_varstate(true);
+         set_varstate(right,true);
          if codegenerror then
           exit;
 
@@ -237,7 +237,7 @@ implementation
            end;
 
          firstpass(left);
-         left.set_varstate(true);
+         set_varstate(left,true);
          if codegenerror then
            exit;
 
@@ -297,9 +297,9 @@ implementation
       begin
          pass_1:=nil;
          firstpass(left);
-         left.set_varstate(true);
+         set_varstate(left,true);
          firstpass(right);
-         right.set_varstate(true);
+         set_varstate(right,true);
          if codegenerror then
            exit;
          { both types must be compatible }
@@ -425,7 +425,7 @@ implementation
          cleartempgen;
 {$endif newcg}
          firstpass(left);
-         left.set_varstate(true);
+         set_varstate(left,true);
          if codegenerror then
            exit;
          registers32:=left.registers32;
@@ -516,7 +516,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.3  2000-09-27 18:14:31  florian
+  Revision 1.4  2000-10-01 19:48:25  peter
+    * lot of compile updates for cg11
+
+  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

compiler/og386.pas

@@ -62,7 +62,8 @@ interface
 
        pobjectoutput = ^tobjectoutput;
        tobjectoutput = object
-         smarthcount : longint;
+         SmartFilesCount,
+         SmartHeaderCount : longint;
          objsmart  : boolean;
          writer    : pobjectwriter;
          path      : pathstr;
@@ -96,8 +97,7 @@ interface
 
     uses
       comphook,
-      cutils,globtype,globals,verbose,fmodule,
-      assemble;
+      cutils,globtype,globals,verbose,fmodule;
 
 
 {****************************************************************************
@@ -160,7 +160,8 @@ interface
 
     constructor tobjectoutput.init(smart:boolean);
       begin
-        smarthcount:=0;
+        SmartFilesCount:=0;
+        SmartHeaderCount:=0;
         objsmart:=smart;
         objfile:=current_module^.objfilename^;
       { Which path will be used ? }
@@ -195,8 +196,8 @@ interface
       var
         s : string;
       begin
-        inc(SmartLinkFilesCnt);
-        if SmartLinkFilesCnt>999999 then
+        inc(SmartFilesCount);
+        if SmartFilesCount>999999 then
          Message(asmw_f_too_many_asm_files);
         if (cs_asm_leave in aktglobalswitches) then
          s:=current_module^.asmprefix^
@@ -205,15 +206,15 @@ interface
         case place of
           cut_begin :
             begin
-              inc(smarthcount);
-              s:=s+tostr(smarthcount)+'h';
+              inc(SmartHeaderCount);
+              s:=s+tostr(SmartHeaderCount)+'h';
             end;
           cut_normal :
-            s:=s+tostr(smarthcount)+'s';
+            s:=s+tostr(SmartHeaderCount)+'s';
           cut_end :
-            s:=s+tostr(smarthcount)+'t';
+            s:=s+tostr(SmartHeaderCount)+'t';
         end;
-        ObjFile:=FixFileName(s+tostr(SmartLinkFilesCnt)+target_info.objext);
+        ObjFile:=FixFileName(s+tostr(SmartFilesCount)+target_info.objext);
       end;
 
 
@@ -284,7 +285,10 @@ interface
 end.
 {
   $Log$
-  Revision 1.6  2000-09-24 15:06:19  peter
+  Revision 1.7  2000-10-01 19:48:25  peter
+    * lot of compile updates for cg11
+
+  Revision 1.6  2000/09/24 15:06:19  peter
     * use defines.inc
 
   Revision 1.5  2000/08/27 16:11:51  peter
@@ -300,4 +304,4 @@ end.
   Revision 1.2  2000/07/13 11:32:43  michael
   + removed logs
 
-}
+}

compiler/parser.pas

@@ -74,6 +74,7 @@ implementation
 
          current_module:=nil;
          compiled_module:=nil;
+         procinfo:=nil;
 
          loaded_units.init;
 
@@ -593,7 +594,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.5  2000-09-24 15:06:20  peter
+  Revision 1.6  2000-10-01 19:48:25  peter
+    * lot of compile updates for cg11
+
+  Revision 1.5  2000/09/24 15:06:20  peter
     * use defines.inc
 
   Revision 1.4  2000/08/27 16:11:51  peter

compiler/pass_1.pas

@@ -373,7 +373,7 @@ implementation
 
 
 end.
-{$else cg11}
+{$else tnode}
 unit pass_1;
 
 {$i defines.inc}
@@ -426,18 +426,19 @@ implementation
       cutils,cobjects,verbose,globals,
       aasm,symtable,types,
       htypechk,
-      cpubase,cpuasm
+      cpubase,cpuasm,
+      nflw
 {$ifdef newcg}
       ,cgbase
       ,tgcpu
 {$else newcg}
       ,hcodegen
-{$ifdef i386}
+  {$ifdef i386}
       ,tgeni386
-{$endif}
-{$ifdef m68k}
+  {$endif}
+  {$ifdef m68k}
       ,tgen68k
-{$endif}
+  {$endif}
 {$endif}
       ;
 
@@ -741,7 +742,10 @@ end.
 {$endif cg11}
 {
   $Log$
-  Revision 1.7  2000-09-30 16:08:45  peter
+  Revision 1.8  2000-10-01 19:48:25  peter
+    * lot of compile updates for cg11
+
+  Revision 1.7  2000/09/30 16:08:45  peter
     * more cg11 updates
 
   Revision 1.6  2000/09/28 19:49:52  florian

compiler/pexpr.pas

@@ -2224,7 +2224,10 @@ _LECKKLAMMER : begin
 end.
 {
   $Log$
-  Revision 1.9  2000-09-24 21:19:50  peter
+  Revision 1.10  2000-10-01 19:48:25  peter
+    * lot of compile updates for cg11
+
+  Revision 1.9  2000/09/24 21:19:50  peter
     * delphi compile fixes
 
   Revision 1.8  2000/09/24 15:06:22  peter
@@ -2250,4 +2253,4 @@ end.
 
   Revision 1.2  2000/07/13 11:32:44  michael
   + removed logs
-}
+}

compiler/pstatmnt.pas

@@ -40,6 +40,7 @@ interface
        globtype,systems,tokens,
        cutils,cobjects,globals,fmodule,verbose,cpuinfo,
        symconst,symtable,aasm,pass_1,types,scanner,
+       htypechk,
 {$ifdef newcg}
        cgbase,
 {$else}
@@ -1375,7 +1376,10 @@ interface
 end.
 {
   $Log$
-  Revision 1.8  2000-09-24 21:19:50  peter
+  Revision 1.9  2000-10-01 19:48:25  peter
+    * lot of compile updates for cg11
+
+  Revision 1.8  2000/09/24 21:19:50  peter
     * delphi compile fixes
 
   Revision 1.7  2000/09/24 15:06:24  peter

compiler/regvars.pas

@@ -28,10 +28,20 @@ interface
 
 uses
   aasm,
-  tree;
-
-procedure assign_regvars(var p: ptree);
+{$ifdef CG11}
+  node
+{$else CG11}
+  tree
+{$endif CG11}
+  ;
+
+{$ifdef CG11}
+procedure assign_regvars(p: tnode);
+procedure load_regvars(asml: paasmoutput; p: tnode);
+{$else CG11}
+procedure assign_regvars(p: ptree);
 procedure load_regvars(asml: paasmoutput; p: ptree);
+{$endif CG11}
 procedure cleanup_regvars(asml: paasmoutput);
 
 implementation
@@ -167,7 +177,296 @@ implementation
       end;
 {$endif i386}
 
-    procedure assign_regvars(var p: ptree);
+{$ifdef CG11}
+    procedure assign_regvars(p: tnode);
+          { register variables }
+    var
+      regvarinfo: pregvarinfo;
+      i: longint;
+    begin
+      { max. optimizations     }
+      { only if no asm is used }
+      { and no try statement   }
+      if (cs_regalloc in aktglobalswitches) and
+         ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
+        begin
+          new(regvarinfo);
+          fillchar(regvarinfo^,sizeof(regvarinfo^),0);
+          aktprocsym^.definition^.regvarinfo := regvarinfo;
+          if (p.registers32<4) then
+            begin
+              parasym:=false;
+              symtablestack^.foreach({$ifdef FPCPROCVAR}@{$endif}searchregvars);
+              { copy parameter into a register ? }
+              parasym:=true;
+              symtablestack^.next^.foreach({$ifdef FPCPROCVAR}@{$endif}searchregvars);
+              { hold needed registers free }
+              for i:=maxvarregs downto maxvarregs-p.registers32+1 do
+                begin
+                  regvarinfo^.regvars[i]:=nil;
+                  regvarinfo^.regvars_para[i] := false;
+                end;
+              { now assign register }
+              for i:=1 to maxvarregs-p.registers32 do
+                begin
+                  if assigned(regvarinfo^.regvars[i]) and
+                    (reg_pushes[varregs[i]] < regvarinfo^.regvars[i]^.refs) then
+                    begin
+                      { register is no longer available for }
+                      { expressions                          }
+                      { search the register which is the most }
+                      { unused                                        }
+                      usableregs:=usableregs-[varregs[i]];
+                      is_reg_var[varregs[i]]:=true;
+                      dec(c_usableregs);
+
+                      { possibly no 32 bit register are needed }
+                      { call by reference/const ? }
+                      if (regvarinfo^.regvars[i]^.varspez=vs_var) or
+                         ((regvarinfo^.regvars[i]^.varspez=vs_const) and
+                           push_addr_param(regvarinfo^.regvars[i]^.vartype.def)) then
+                        begin
+                           regvarinfo^.regvars[i]^.reg:=varregs[i];
+                        end
+                      else
+                       if (regvarinfo^.regvars[i]^.vartype.def^.deftype in [orddef,enumdef]) and
+                          (porddef(regvarinfo^.regvars[i]^.vartype.def)^.size=1) then
+                        begin
+{$ifdef i386}
+                          regvarinfo^.regvars[i]^.reg:=reg32toreg8(varregs[i]);
+{$endif}
+                        end
+                      else
+                       if (regvarinfo^.regvars[i]^.vartype.def^.deftype in [orddef,enumdef]) and
+                          (porddef(regvarinfo^.regvars[i]^.vartype.def)^.size=2) then
+                         begin
+{$ifdef i386}
+                           regvarinfo^.regvars[i]^.reg:=reg32toreg16(varregs[i]);
+{$endif}
+                         end
+                      else
+                        begin
+                          regvarinfo^.regvars[i]^.reg:=varregs[i];
+                        end;
+                      if regvarinfo^.regvars_para[i] then
+                        unused:=unused - [regvarinfo^.regvars[i]^.reg];
+                      { procedure uses this register }
+{$ifdef i386}
+                      usedinproc:=usedinproc or ($80 shr byte(varregs[i]));
+{$endif i386}
+{$ifdef m68k}
+                      usedinproc:=usedinproc or ($800 shr word(varregs[i]));
+{$endif m68k}
+                    end
+                  else
+                    begin
+                      regvarinfo^.regvars[i] := nil;
+                      regvarinfo^.regvars_para[i] := false;
+                    end;
+                end;
+            end;
+            if ((p.registersfpu+1)<maxfpuvarregs) then
+              begin
+                parasym:=false;
+                symtablestack^.foreach({$ifdef FPCPROCVAR}@{$endif}searchfpuregvars);
+{$ifdef dummy}
+                { copy parameter into a register ? }
+                parasym:=true;
+                symtablestack^.next^.foreach({$ifdef FPCPROCVAR}@{$endif}searchregvars);
+{$endif dummy}
+                { hold needed registers free }
+
+                { in non leaf procedures we must be very careful }
+                { with assigning registers             }
+                if aktmaxfpuregisters=-1 then
+                  begin
+                   if (procinfo^.flags and pi_do_call)<>0 then
+                     begin
+                      for i:=maxfpuvarregs downto 2 do
+                      regvarinfo^.fpuregvars[i]:=nil;
+                     end
+                   else
+                     begin
+                      for i:=maxfpuvarregs downto maxfpuvarregs-p.registersfpu do
+                        regvarinfo^.fpuregvars[i]:=nil;
+                     end;
+                  end
+                else
+                  begin
+                    for i:=aktmaxfpuregisters+1 to maxfpuvarregs do
+                      regvarinfo^.fpuregvars[i]:=nil;
+                  end;
+                { now assign register }
+                for i:=1 to maxfpuvarregs do
+                  begin
+                   if assigned(regvarinfo^.fpuregvars[i]) then
+                     begin
+{$ifdef i386}
+                       { reserve place on the FPU stack }
+                       regvarinfo^.fpuregvars[i]^.reg:=correct_fpuregister(R_ST0,i-1);
+{$endif i386}
+{$ifdef m68k}
+                       regvarinfo^.fpuregvars[i]^.reg:=fpuvarregs[i];
+{$endif m68k}
+                     end;
+                  end;
+              end;
+        end;
+    end;
+
+
+    procedure load_regvars(asml: paasmoutput; p: tnode);
+    var
+      i: longint;
+      hr      : preference;
+      regvarinfo: pregvarinfo;
+{$ifdef i386}
+      opsize: topsize;
+      opcode: tasmop;
+      signed: boolean;
+{$endif i386}
+    begin
+      if (cs_regalloc in aktglobalswitches) and
+         ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
+        begin
+          regvarinfo := pregvarinfo(aktprocsym^.definition^.regvarinfo);
+          { can happen when inlining assembler procedures (JM) }
+          if not assigned(regvarinfo) then
+            exit;
+          for i:=1 to maxvarregs do
+            begin
+              { parameter must be load }
+              if regvarinfo^.regvars_para[i] then
+                begin
+{$ifdef i386}
+                  asml^.concat(new(pairegalloc,alloc(reg32(regvarinfo^.regvars[i]^.reg))));
+{$endif i386}
+                  { procinfo is there actual,    }
+                  { because we can't never be in a }
+                  { nested procedure        }
+                  { when loading parameter to reg  }
+                  new(hr);
+                  reset_reference(hr^);
+                  hr^.offset:=pvarsym(regvarinfo^.regvars[i])^.address+procinfo^.para_offset;
+                  hr^.base:=procinfo^.framepointer;
+{$ifdef i386}
+                { zero the regvars because the upper 48bits must be clear }
+                { for 8bits vars when using them with btrl (JM)           }
+                  signed :=
+                    (pvarsym(regvarinfo^.regvars[i])^.vartype.def^.deftype =
+                      orddef) and
+                    is_signed(pvarsym(regvarinfo^.regvars[i])^.vartype.def);
+                  case regsize(regvarinfo^.regvars[i]^.reg) of
+                    S_L:
+                      begin
+                        opsize := S_L;
+                        opcode := A_MOV;
+                      end;
+                    S_W:
+                      begin
+                        opsize := S_WL;
+                        if signed then
+                          opcode := A_MOVSX
+                        else opcode := A_MOVZX;
+                      end;
+                    S_B:
+                      begin
+                        opsize := S_BL;
+                        if signed then
+                          opcode := A_MOVSX
+                        else opcode := A_MOVZX;
+                      end;
+                  end;
+                  asml^.concat(new(paicpu,op_ref_reg(opcode,opsize,
+                    hr,reg32(regvarinfo^.regvars[i]^.reg))));
+{$endif i386}
+{$ifdef m68k}
+                  asml^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize(regvarinfo^.regvars[i]^.reg),
+                    hr,regvarinfo^.regvars[i]^.reg)));
+{$endif m68k}
+                end
+            end;
+          for i:=1 to maxvarregs do
+            begin
+             if assigned(regvarinfo^.regvars[i]) then
+               begin
+{$ifdef i386}
+                if not(regvarinfo^.regvars_para[i]) then
+                  begin
+                    asml^.concat(new(pairegalloc,alloc(reg32(regvarinfo^.regvars[i]^.reg))));
+                    { zero the regvars because the upper 48bits must be clear }
+                    { for 8bits vars when using them with btrl (JM)           }
+                    if (regsize(regvarinfo^.regvars[i]^.reg) in [S_B,S_W]) then
+                      asml^.concat(new(paicpu,op_reg_reg(A_XOR,S_L,
+                        reg32(regvarinfo^.regvars[i]^.reg),
+                        reg32(regvarinfo^.regvars[i]^.reg))));
+                  end;
+{$endif i386}
+                if cs_asm_source in aktglobalswitches then
+                asml^.insert(new(pai_asm_comment,init(strpnew(regvarinfo^.regvars[i]^.name+
+                  ' with weight '+tostr(regvarinfo^.regvars[i]^.refs)+' assigned to register '+
+                  reg2str(regvarinfo^.regvars[i]^.reg)))));
+                if (status.verbosity and v_debug)=v_debug then
+                Message3(cg_d_register_weight,reg2str(regvarinfo^.regvars[i]^.reg),
+                  tostr(regvarinfo^.regvars[i]^.refs),regvarinfo^.regvars[i]^.name);
+               end;
+            end;
+          for i:=1 to maxfpuvarregs do
+            begin
+              if assigned(regvarinfo^.fpuregvars[i]) then
+                begin
+{$ifdef i386}
+                  { reserve place on the FPU stack }
+                  regvarinfo^.fpuregvars[i]^.reg:=correct_fpuregister(R_ST0,i-1);
+                  asml^.concat(new(paicpu,op_none(A_FLDZ,S_NO)));
+{$endif i386}
+{$ifdef dummy}
+                  { parameter must be load }
+                  if regvarinfo^.fpuregvars_para[i] then
+                    begin
+                      { procinfo is there actual,    }
+                      { because we can't never be in a }
+                      { nested procedure        }
+                      { when loading parameter to reg  }
+                      new(hr);
+                      reset_reference(hr^);
+                      hr^.offset:=pvarsym(regvarinfo^.regvars[i])^.address+procinfo^.para_offset;
+                      hr^.base:=procinfo^.framepointer;
+{$ifdef i386}
+                      asml^.concat(new(paicpu,op_ref_reg(A_MOV,regsize(regvarinfo^.regvars[i]^.reg),
+                        hr,regvarinfo^.regvars[i]^.reg)));
+{$endif i386}
+{$ifdef m68k}
+                      asml^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize(regvarinfo^.regvars[i]^.reg),
+                        hr,regvarinfo^.regvars[i]^.reg)));
+{$endif m68k}
+                    end;
+{$endif dummy}
+                end;
+            end;
+          if assigned(p) then
+            if cs_asm_source in aktglobalswitches then
+              asml^.insert(new(pai_asm_comment,init(strpnew(tostr(p.registersfpu)+
+              ' registers on FPU stack used by temp. expressions'))));
+          for i:=1 to maxfpuvarregs do
+            begin
+               if assigned(regvarinfo^.fpuregvars[i]) then
+                 begin
+                    if cs_asm_source in aktglobalswitches then
+                      asml^.insert(new(pai_asm_comment,init(strpnew(regvarinfo^.fpuregvars[i]^.name+
+                        ' with weight '+tostr(regvarinfo^.fpuregvars[i]^.refs)+' assigned to register '+
+                        reg2str(regvarinfo^.fpuregvars[i]^.reg)))));
+                    if (status.verbosity and v_debug)=v_debug then
+                      Message3(cg_d_register_weight,reg2str(regvarinfo^.fpuregvars[i]^.reg),
+                        tostr(regvarinfo^.fpuregvars[i]^.refs),regvarinfo^.fpuregvars[i]^.name);
+                 end;
+            end;
+          if cs_asm_source in aktglobalswitches then
+            asml^.insert(new(pai_asm_comment,init(strpnew('Register variable assignment:'))));
+        end;
+    end;
+{$else CG11}
+    procedure assign_regvars(p: ptree);
           { register variables }
     var
       regvarinfo: pregvarinfo;
@@ -303,7 +602,6 @@ implementation
         end;
     end;
 
-
     procedure load_regvars(asml: paasmoutput; p: ptree);
     var
       i: longint;
@@ -454,6 +752,7 @@ implementation
             asml^.insert(new(pai_asm_comment,init(strpnew('Register variable assignment:'))));
         end;
     end;
+{$endif CG11}
 
 
     procedure cleanup_regvars(asml: paasmoutput);
@@ -483,7 +782,10 @@ end.
 
 {
   $Log$
-  Revision 1.8  2000-09-30 16:08:45  peter
+  Revision 1.9  2000-10-01 19:48:25  peter
+    * lot of compile updates for cg11
+
+  Revision 1.8  2000/09/30 16:08:45  peter
     * more cg11 updates
 
   Revision 1.7  2000/09/30 13:08:16  jonas

compiler/symdef.inc

@@ -2869,8 +2869,13 @@ Const local_symtable_index : longint = $8001;
            dispose(parast,done);
          if assigned(localst) and (localst^.symtabletype<>staticsymtable) then
            dispose(localst,done);
+{$ifdef CG11}
+         if (pocall_inline in proccalloptions) and assigned(code) then
+           tnode(code).free;
+{$else}
          if (pocall_inline in proccalloptions) and assigned(code) then
            disposetree(ptree(code));
+{$endif}
          if assigned(regvarinfo) then
            dispose(pregvarinfo(regvarinfo));
          if (po_msgstr in procoptions) then
@@ -4311,7 +4316,10 @@ Const local_symtable_index : longint = $8001;
 
 {
   $Log$
-  Revision 1.19  2000-09-24 21:19:52  peter
+  Revision 1.20  2000-10-01 19:48:25  peter
+    * lot of compile updates for cg11
+
+  Revision 1.19  2000/09/24 21:19:52  peter
     * delphi compile fixes
 
   Revision 1.18  2000/09/24 15:06:28  peter
@@ -4378,4 +4386,4 @@ Const local_symtable_index : longint = $8001;
   Revision 1.2  2000/07/13 11:32:49  michael
   + removed logs
 
-}
+}

compiler/symtable.pas

@@ -473,7 +473,11 @@ implementation
      version,verbose,
      types,ppu,
      gendef,fmodule,finput
+{$ifdef CG11}
+     ,node
+{$else CG11}
      ,tree
+{$endif CG11}
      ,cresstr
 {$ifdef newcg}
      ,cgbase
@@ -2878,7 +2882,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.8  2000-09-24 15:06:29  peter
+  Revision 1.9  2000-10-01 19:48:25  peter
+    * lot of compile updates for cg11
+
+  Revision 1.8  2000/09/24 15:06:29  peter
     * use defines.inc
 
   Revision 1.7  2000/08/27 16:11:54  peter
@@ -2903,4 +2910,4 @@ end.
   Revision 1.2  2000/07/13 11:32:50  michael
   + removed logs
 
-}
+}

compiler/tree.pas

@@ -332,22 +332,11 @@ unit tree;
        maxfirstpasscount : longint = 0;
 {$endif extdebug}
 
-    { sets the callunique flag, if the node is a vecn, }
-    { takes care of type casts etc.                 }
-    procedure set_unique(p : ptree);
-
-    { sets funcret_is_valid to true, if p contains a funcref node }
-    procedure set_funcret_is_valid(p : ptree);
-
     {
     type
     tvarstaterequire = (vsr_can_be_undefined,vsr_must_be_valid,
       vsr_is_used_after,vsr_must_be_valid_and_is_used_after); }
 
-    { sets varsym varstate field correctly }
-    procedure unset_varstate(p : ptree);
-    procedure set_varstate(p : ptree;must_be_valid : boolean);
-
     { 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;
@@ -1840,163 +1829,6 @@ unit tree;
     end;
 {$endif newoptimizations2}
 
-    procedure set_unique(p : ptree);
-
-      begin
-         if assigned(p) then
-           begin
-              case p^.treetype of
-                 vecn:
-                    p^.callunique:=true;
-                 typeconvn,subscriptn,derefn:
-                    set_unique(p^.left);
-              end;
-           end;
-      end;
-
-    procedure set_funcret_is_valid(p : ptree);
-
-      begin
-         if assigned(p) then
-           begin
-              case p^.treetype of
-                 funcretn:
-                    begin
-                      if p^.is_first_funcret then
-                        pprocinfo(p^.funcretprocinfo)^.funcret_state:=vs_assigned;
-                    end;
-                 vecn,typeconvn,subscriptn{,derefn}:
-                    set_funcret_is_valid(p^.left);
-              end;
-           end;
-      end;
-
-
-    procedure unset_varstate(p : ptree);
-      begin
-        while assigned(p) do
-         begin
-           p^.varstateset:=false;
-           case p^.treetype of
-             typeconvn,
-             subscriptn,
-             vecn :
-               p:=p^.left;
-             else
-               break;
-           end;
-         end;
-      end;
-
-
-    procedure set_varstate(p : ptree;must_be_valid : boolean);
-
-      begin
-         if not assigned(p) then
-           exit
-         else
-           begin
-             if p^.varstateset then
-               exit;
-              case p^.treetype of
-           typeconvn :
-             if p^.convtyp in
-               [
-                tc_cchar_2_pchar,
-                tc_cstring_2_pchar,
-                tc_array_2_pointer
-               ] then
-               set_varstate(p^.left,false)
-             else if p^.convtyp in
-               [
-                tc_pchar_2_string,
-                tc_pointer_2_array
-               ] then
-               set_varstate(p^.left,true)
-             else
-               set_varstate(p^.left,must_be_valid);
-           subscriptn :
-             set_varstate(p^.left,must_be_valid);
-           vecn:
-             begin
-               if (p^.left^.resulttype^.deftype in [stringdef,arraydef]) then
-                 set_varstate(p^.left,must_be_valid)
-               else
-                 set_varstate(p^.left,true);
-               set_varstate(p^.right,true);
-             end;
-           { do not parse calln }
-           calln : ;
-           callparan:
-             begin
-               set_varstate(p^.left,must_be_valid);
-               set_varstate(p^.right,must_be_valid);
-             end;
-           loadn :
-         if (p^.symtableentry^.typ=varsym) then
-          begin
-            if must_be_valid and p^.is_first then
-              begin
-                if (pvarsym(p^.symtableentry)^.varstate=vs_declared_and_first_found) or
-                   (pvarsym(p^.symtableentry)^.varstate=vs_set_but_first_not_passed) then
-                 if (assigned(pvarsym(p^.symtableentry)^.owner) and
-                    assigned(aktprocsym) and
-                    (pvarsym(p^.symtableentry)^.owner = aktprocsym^.definition^.localst)) then
-                  begin
-                    if p^.symtable^.symtabletype=localsymtable then
-                     CGMessage1(sym_n_uninitialized_local_variable,pvarsym(p^.symtableentry)^.name)
-                    else
-                     CGMessage1(sym_n_uninitialized_variable,pvarsym(p^.symtableentry)^.name);
-                  end;
-              end;
-          if (p^.is_first) then
-           begin
-             if pvarsym(p^.symtableentry)^.varstate=vs_declared_and_first_found then
-             { this can only happen at left of an assignment, no ? PM }
-              if (parsing_para_level=0) and not must_be_valid then
-               pvarsym(p^.symtableentry)^.varstate:=vs_assigned
-              else
-               pvarsym(p^.symtableentry)^.varstate:=vs_used;
-             if pvarsym(p^.symtableentry)^.varstate=vs_set_but_first_not_passed then
-               pvarsym(p^.symtableentry)^.varstate:=vs_used;
-             p^.is_first:=false;
-           end
-         else
-           begin
-             if (pvarsym(p^.symtableentry)^.varstate=vs_assigned) and
-                (must_be_valid or (parsing_para_level>0) or
-                 (p^.resulttype^.deftype=procvardef)) then
-               pvarsym(p^.symtableentry)^.varstate:=vs_used;
-             if (pvarsym(p^.symtableentry)^.varstate=vs_declared_and_first_found) and
-                (must_be_valid or (parsing_para_level>0) or
-                (p^.resulttype^.deftype=procvardef)) then
-               pvarsym(p^.symtableentry)^.varstate:=vs_set_but_first_not_passed;
-           end;
-         end;
-         funcretn:
-         begin
-         { no claim if setting higher return value_str }
-         if must_be_valid and
-            (procinfo=pprocinfo(p^.funcretprocinfo)) and
-            ((procinfo^.funcret_state=vs_declared) or
-            ((p^.is_first_funcret) and
-             (procinfo^.funcret_state=vs_declared_and_first_found))) then
-           begin
-             CGMessage(sym_w_function_result_not_set);
-             { avoid multiple warnings }
-             procinfo^.funcret_state:=vs_assigned;
-           end;
-         if p^.is_first_funcret and not must_be_valid then
-           pprocinfo(p^.funcretprocinfo)^.funcret_state:=vs_assigned;
-         end;
-         else
-           begin
-             {internalerror(565656);}
-           end;
-         end;{case }
-         p^.varstateset:=true;
-      end;
-    end;
 
     procedure clear_location(var loc : tlocation);
 
@@ -2149,7 +1981,10 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.10  2000-09-27 18:14:31  florian
+  Revision 1.11  2000-10-01 19:48:25  peter
+    * lot of compile updates for cg11
+
+  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
@@ -2176,4 +2011,4 @@ end.
 
   Revision 1.2  2000/07/13 11:32:52  michael
   + removed logs
-}
+}

compiler/types.pas

@@ -27,10 +27,12 @@ unit types;
 interface
 
     uses
-       cobjects,symtable,cpuinfo
-       {$IFDEF NEWST}
-       ,defs
-       {$ENDIF NEWST};
+       cobjects,
+       cpuinfo,
+{$ifdef CG11}
+       node,
+{$endif}
+       symtable;
 
     type
        tmmxtype = (mmxno,mmxu8bit,mmxs8bit,mmxu16bit,mmxs16bit,
@@ -145,6 +147,47 @@ interface
     { to use on other types                              }
     function is_subequal(def1, def2: pdef): boolean;
 
+{$ifdef CG11}
+     type
+       tconverttype = (
+          tc_equal,
+          tc_not_possible,
+          tc_string_2_string,
+          tc_char_2_string,
+          tc_pchar_2_string,
+          tc_cchar_2_pchar,
+          tc_cstring_2_pchar,
+          tc_ansistring_2_pchar,
+          tc_string_2_chararray,
+          tc_chararray_2_string,
+          tc_array_2_pointer,
+          tc_pointer_2_array,
+          tc_int_2_int,
+          tc_int_2_bool,
+          tc_bool_2_bool,
+          tc_bool_2_int,
+          tc_real_2_real,
+          tc_int_2_real,
+          tc_int_2_fix,
+          tc_real_2_fix,
+          tc_fix_2_real,
+          tc_proc_2_procvar,
+          tc_arrayconstructor_2_set,
+          tc_load_smallset,
+          tc_cord_2_pointer
+       );
+
+    function assignment_overloaded(from_def,to_def : pdef) : pprocdef;
+
+    { Returns:
+       0 - Not convertable
+       1 - Convertable
+       2 - Convertable, but not first choice }
+    function isconvertable(def_from,def_to : pdef;
+             var doconv : tconverttype;fromtreetype : tnodetype;
+             explicit : boolean) : byte;
+{$endif CG11}
+
     { same as is_equal, but with error message if failed }
     function CheckTypes(def1,def2 : pdef) : boolean;
 
@@ -191,13 +234,12 @@ interface
 implementation
 
     uses
-       globtype,globals,htypechk,
-{$ifdef CG11}
-       node,
-{$else}
+       globtype,globals,
+{$ifndef CG11}
+       htypechk,
        tree,
 {$endif}
-       verbose,symconst;
+       verbose,symconst,tokens;
 
     var
        b_needs_init_final : boolean;
@@ -1119,6 +1161,494 @@ implementation
         end; { endif assigned ... }
       end;
 
+{$ifdef CG11}
+    function assignment_overloaded(from_def,to_def : pdef) : pprocdef;
+       var
+          passproc : pprocdef;
+          convtyp : tconverttype;
+       begin
+          assignment_overloaded:=nil;
+          if assigned(overloaded_operators[_ASSIGNMENT]) then
+            passproc:=overloaded_operators[_ASSIGNMENT]^.definition
+          else
+            exit;
+          while passproc<>nil do
+            begin
+              if is_equal(passproc^.rettype.def,to_def) and
+                 (is_equal(pparaitem(passproc^.para^.first)^.paratype.def,from_def) or
+                 (isconvertable(from_def,pparaitem(passproc^.para^.first)^.paratype.def,convtyp,ordconstn,false)=1)) then
+                begin
+                   assignment_overloaded:=passproc;
+                   break;
+                end;
+              passproc:=passproc^.nextoverloaded;
+            end;
+       end;
+
+
+    { Returns:
+       0 - Not convertable
+       1 - Convertable
+       2 - Convertable, but not first choice }
+    function isconvertable(def_from,def_to : pdef;
+             var doconv : tconverttype;fromtreetype : tnodetype;
+             explicit : boolean) : byte;
+
+      { Tbasetype:  uauto,uvoid,uchar,
+                    u8bit,u16bit,u32bit,
+                    s8bit,s16bit,s32,
+                    bool8bit,bool16bit,bool32bit,
+                    u64bit,s64bitint }
+      type
+        tbasedef=(bvoid,bchar,bint,bbool);
+      const
+        basedeftbl:array[tbasetype] of tbasedef =
+          (bvoid,bvoid,bchar,
+           bint,bint,bint,
+           bint,bint,bint,
+           bbool,bbool,bbool,bint,bint,bchar);
+
+        basedefconverts : array[tbasedef,tbasedef] of tconverttype =
+         ((tc_not_possible,tc_not_possible,tc_not_possible,tc_not_possible),
+          (tc_not_possible,tc_equal,tc_not_possible,tc_not_possible),
+          (tc_not_possible,tc_not_possible,tc_int_2_int,tc_int_2_bool),
+          (tc_not_possible,tc_not_possible,tc_bool_2_int,tc_bool_2_bool));
+
+      var
+         b : byte;
+         hd1,hd2 : pdef;
+         hct : tconverttype;
+      begin
+       { safety check }
+         if not(assigned(def_from) and assigned(def_to)) then
+          begin
+            isconvertable:=0;
+            exit;
+          end;
+
+       { tp7 procvar def support, in tp7 a procvar is always called, if the
+         procvar is passed explicit a addrn would be there }
+         if (m_tp_procvar in aktmodeswitches) and
+            (def_from^.deftype=procvardef) and
+            (fromtreetype=loadn) then
+          begin
+            def_from:=pprocvardef(def_from)^.rettype.def;
+          end;
+
+       { we walk the wanted (def_to) types and check then the def_from
+         types if there is a conversion possible }
+         b:=0;
+         case def_to^.deftype of
+           orddef :
+             begin
+               case def_from^.deftype of
+                 orddef :
+                   begin
+                     doconv:=basedefconverts[basedeftbl[porddef(def_from)^.typ],basedeftbl[porddef(def_to)^.typ]];
+                     b:=1;
+                     if (doconv=tc_not_possible) or
+                        ((doconv=tc_int_2_bool) and
+                         (not explicit) and
+                         (not is_boolean(def_from))) or
+                        ((doconv=tc_bool_2_int) and
+                         (not explicit) and
+                         (not is_boolean(def_to))) then
+                       b:=0;
+                   end;
+                 enumdef :
+                   begin
+                     { needed for char(enum) }
+                     if explicit then
+                      begin
+                        doconv:=tc_int_2_int;
+                        b:=1;
+                      end;
+                   end;
+               end;
+             end;
+
+          stringdef :
+             begin
+               case def_from^.deftype of
+                 stringdef :
+                   begin
+                     doconv:=tc_string_2_string;
+                     b:=1;
+                   end;
+                 orddef :
+                   begin
+                   { char to string}
+                     if is_char(def_from) then
+                      begin
+                        doconv:=tc_char_2_string;
+                        b:=1;
+                      end;
+                   end;
+                 arraydef :
+                   begin
+                   { array of char to string, the length check is done by the firstpass of this node }
+                     if is_chararray(def_from) then
+                      begin
+                        doconv:=tc_chararray_2_string;
+                        if (not(cs_ansistrings in aktlocalswitches) and
+                            is_shortstring(def_to)) or
+                           ((cs_ansistrings in aktlocalswitches) and
+                            is_ansistring(def_to)) then
+                         b:=1
+                        else
+                         b:=2;
+                      end;
+                   end;
+                 pointerdef :
+                   begin
+                   { pchar can be assigned to short/ansistrings,
+                     but not in tp7 compatible mode }
+                     if is_pchar(def_from) and not(m_tp7 in aktmodeswitches) then
+                      begin
+                        doconv:=tc_pchar_2_string;
+                        b:=1;
+                      end;
+                   end;
+               end;
+             end;
+
+           floatdef :
+             begin
+               case def_from^.deftype of
+                 orddef :
+                   begin { ordinal to real }
+                     if is_integer(def_from) then
+                       begin
+                          if pfloatdef(def_to)^.typ=f32bit then
+                            doconv:=tc_int_2_fix
+                          else
+                            doconv:=tc_int_2_real;
+                          b:=1;
+                       end;
+                   end;
+                 floatdef :
+                   begin { 2 float types ? }
+                     if pfloatdef(def_from)^.typ=pfloatdef(def_to)^.typ then
+                       doconv:=tc_equal
+                     else
+                       begin
+                          if pfloatdef(def_from)^.typ=f32bit then
+                            doconv:=tc_fix_2_real
+                          else
+                            if pfloatdef(def_to)^.typ=f32bit then
+                              doconv:=tc_real_2_fix
+                            else
+                              doconv:=tc_real_2_real;
+                       end;
+                     b:=1;
+                   end;
+               end;
+             end;
+
+           enumdef :
+             begin
+               if (def_from^.deftype=enumdef) then
+                begin
+                  hd1:=def_from;
+                  while assigned(penumdef(hd1)^.basedef) do
+                   hd1:=penumdef(hd1)^.basedef;
+                  hd2:=def_to;
+                  while assigned(penumdef(hd2)^.basedef) do
+                    hd2:=penumdef(hd2)^.basedef;
+                  if (hd1=hd2) then
+                    begin
+                       b:=1;
+                       { because of packenum they can have different sizes! (JM) }
+                       doconv:=tc_int_2_int;
+                    end;
+                end;
+             end;
+
+           arraydef :
+             begin
+             { open array is also compatible with a single element of its base type }
+               if is_open_array(def_to) and
+                  is_equal(parraydef(def_to)^.elementtype.def,def_from) then
+                begin
+                  doconv:=tc_equal;
+                  b:=1;
+                end
+               else
+                begin
+                  case def_from^.deftype of
+                    arraydef :
+                      begin
+                        { array constructor -> open array }
+                        if is_open_array(def_to) and
+                           is_array_constructor(def_from) then
+                         begin
+                           if is_void(parraydef(def_from)^.elementtype.def) or
+                              is_equal(parraydef(def_to)^.elementtype.def,parraydef(def_from)^.elementtype.def) then
+                            begin
+                              doconv:=tc_equal;
+                              b:=1;
+                            end
+                           else
+                            if isconvertable(parraydef(def_from)^.elementtype.def,
+                                             parraydef(def_to)^.elementtype.def,hct,arrayconstructn,false)<>0 then
+                             begin
+                               doconv:=hct;
+                               b:=2;
+                             end;
+                         end;
+                      end;
+                    pointerdef :
+                      begin
+                        if is_zero_based_array(def_to) and
+                           is_equal(ppointerdef(def_from)^.pointertype.def,parraydef(def_to)^.elementtype.def) then
+                         begin
+                           doconv:=tc_pointer_2_array;
+                           b:=1;
+                         end;
+                      end;
+                    stringdef :
+                      begin
+                        { string to array of char}
+                        if (not(is_special_array(def_to)) or is_open_array(def_to)) and
+                          is_equal(parraydef(def_to)^.elementtype.def,cchardef) then
+                         begin
+                           doconv:=tc_string_2_chararray;
+                           b:=1;
+                         end;
+                      end;
+                  end;
+                end;
+             end;
+
+           pointerdef :
+             begin
+               case def_from^.deftype of
+                 stringdef :
+                   begin
+                     { string constant (which can be part of array constructor)
+                       to zero terminated string constant }
+                     if (fromtreetype in [arrayconstructn,stringconstn]) and
+                        is_pchar(def_to) then
+                      begin
+                        doconv:=tc_cstring_2_pchar;
+                        b:=1;
+                      end;
+                   end;
+                 orddef :
+                   begin
+                     { char constant to zero terminated string constant }
+                     if (fromtreetype=ordconstn) then
+                      begin
+                        if is_equal(def_from,cchardef) and
+                           is_pchar(def_to) then
+                         begin
+                           doconv:=tc_cchar_2_pchar;
+                           b:=1;
+                         end
+                        else
+                         if is_integer(def_from) then
+                          begin
+                            doconv:=tc_cord_2_pointer;
+                            b:=1;
+                          end;
+                      end;
+                   end;
+                 arraydef :
+                   begin
+                     { chararray to pointer }
+                     if is_zero_based_array(def_from) and
+                        is_equal(parraydef(def_from)^.elementtype.def,ppointerdef(def_to)^.pointertype.def) then
+                      begin
+                        doconv:=tc_array_2_pointer;
+                        b:=1;
+                      end;
+                   end;
+                 pointerdef :
+                   begin
+                     { child class pointer can be assigned to anchestor pointers }
+                     if (
+                         (ppointerdef(def_from)^.pointertype.def^.deftype=objectdef) and
+                         (ppointerdef(def_to)^.pointertype.def^.deftype=objectdef) and
+                         pobjectdef(ppointerdef(def_from)^.pointertype.def)^.is_related(
+                           pobjectdef(ppointerdef(def_to)^.pointertype.def))
+                        ) or
+                        { all pointers can be assigned to void-pointer }
+                        is_equal(ppointerdef(def_to)^.pointertype.def,voiddef) or
+                        { in my opnion, is this not clean pascal }
+                        { well, but it's handy to use, it isn't ? (FK) }
+                        is_equal(ppointerdef(def_from)^.pointertype.def,voiddef) then
+                       begin
+                         doconv:=tc_equal;
+                         b:=1;
+                       end;
+                   end;
+                 procvardef :
+                   begin
+                     { procedure variable can be assigned to an void pointer }
+                     { Not anymore. Use the @ operator now.}
+                     if not(m_tp_procvar in aktmodeswitches) and
+                        (ppointerdef(def_to)^.pointertype.def^.deftype=orddef) and
+                        (porddef(ppointerdef(def_to)^.pointertype.def)^.typ=uvoid) then
+                      begin
+                        doconv:=tc_equal;
+                        b:=1;
+                      end;
+                   end;
+                 classrefdef,
+                 objectdef :
+                   begin
+                     { class types and class reference type
+                       can be assigned to void pointers      }
+                     if (
+                         ((def_from^.deftype=objectdef) and pobjectdef(def_from)^.is_class) or
+                         (def_from^.deftype=classrefdef)
+                        ) and
+                        (ppointerdef(def_to)^.pointertype.def^.deftype=orddef) and
+                        (porddef(ppointerdef(def_to)^.pointertype.def)^.typ=uvoid) then
+                       begin
+                         doconv:=tc_equal;
+                         b:=1;
+                       end;
+                   end;
+               end;
+             end;
+
+           setdef :
+             begin
+               { automatic arrayconstructor -> set conversion }
+               if is_array_constructor(def_from) then
+                begin
+                  doconv:=tc_arrayconstructor_2_set;
+                  b:=1;
+                end;
+             end;
+
+           procvardef :
+             begin
+               { proc -> procvar }
+               if (def_from^.deftype=procdef) then
+                begin
+                  doconv:=tc_proc_2_procvar;
+                  if proc_to_procvar_equal(pprocdef(def_from),pprocvardef(def_to)) then
+                   b:=1;
+                end
+               else
+                { for example delphi allows the assignement from pointers }
+                { to procedure variables                                  }
+                if (m_pointer_2_procedure in aktmodeswitches) and
+                  (def_from^.deftype=pointerdef) and
+                  (ppointerdef(def_from)^.pointertype.def^.deftype=orddef) and
+                  (porddef(ppointerdef(def_from)^.pointertype.def)^.typ=uvoid) then
+                begin
+                   doconv:=tc_equal;
+                   b:=1;
+                end
+               else
+               { nil is compatible with procvars }
+                if (fromtreetype=niln) then
+                 begin
+                   doconv:=tc_equal;
+                   b:=1;
+                 end;
+             end;
+
+           objectdef :
+             begin
+               { object pascal objects }
+               if (def_from^.deftype=objectdef) {and
+                  pobjectdef(def_from)^.isclass and pobjectdef(def_to)^.isclass }then
+                begin
+                  doconv:=tc_equal;
+                  if pobjectdef(def_from)^.is_related(pobjectdef(def_to)) then
+                   b:=1;
+                end
+               else
+               { Class specific }
+                if (pobjectdef(def_to)^.is_class) then
+                 begin
+                   { void pointer also for delphi mode }
+                   if (m_delphi in aktmodeswitches) and
+                      is_voidpointer(def_from) then
+                    begin
+                      doconv:=tc_equal;
+                      b:=1;
+                    end
+                   else
+                   { nil is compatible with class instances }
+                    if (fromtreetype=niln) and (pobjectdef(def_to)^.is_class) then
+                     begin
+                       doconv:=tc_equal;
+                       b:=1;
+                     end;
+                 end;
+             end;
+
+           classrefdef :
+             begin
+               { class reference types }
+               if (def_from^.deftype=classrefdef) then
+                begin
+                  doconv:=tc_equal;
+                  if pobjectdef(pclassrefdef(def_from)^.pointertype.def)^.is_related(
+                       pobjectdef(pclassrefdef(def_to)^.pointertype.def)) then
+                   b:=1;
+                end
+               else
+                { nil is compatible with class references }
+                if (fromtreetype=niln) then
+                 begin
+                   doconv:=tc_equal;
+                   b:=1;
+                 end;
+             end;
+
+           filedef :
+             begin
+               { typed files are all equal to the abstract file type
+               name TYPEDFILE in system.pp in is_equal in types.pas
+               the problem is that it sholud be also compatible to FILE
+               but this would leed to a problem for ASSIGN RESET and REWRITE
+               when trying to find the good overloaded function !!
+               so all file function are doubled in system.pp
+               this is not very beautiful !!}
+               if (def_from^.deftype=filedef) and
+                  (
+                   (
+                    (pfiledef(def_from)^.filetyp = ft_typed) and
+                    (pfiledef(def_to)^.filetyp = ft_typed) and
+                    (
+                     (pfiledef(def_from)^.typedfiletype.def = pdef(voiddef)) or
+                     (pfiledef(def_to)^.typedfiletype.def = pdef(voiddef))
+                    )
+                   ) or
+                   (
+                    (
+                     (pfiledef(def_from)^.filetyp = ft_untyped) and
+                     (pfiledef(def_to)^.filetyp = ft_typed)
+                    ) or
+                    (
+                     (pfiledef(def_from)^.filetyp = ft_typed) and
+                     (pfiledef(def_to)^.filetyp = ft_untyped)
+                    )
+                   )
+                  ) then
+                 begin
+                    doconv:=tc_equal;
+                    b:=1;
+                 end
+             end;
+
+           else
+             begin
+             { assignment overwritten ?? }
+               if assignment_overloaded(def_from,def_to)<>nil then
+                b:=2;
+             end;
+         end;
+        isconvertable:=b;
+      end;
+{$endif CG11}
+
     function CheckTypes(def1,def2 : pdef) : boolean;
 
       var
@@ -1148,7 +1678,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.12  2000-09-30 16:08:46  peter
+  Revision 1.13  2000-10-01 19:48:26  peter
+    * lot of compile updates for cg11
+
+  Revision 1.12  2000/09/30 16:08:46  peter
     * more cg11 updates
 
   Revision 1.11  2000/09/24 15:06:32  peter