* internal error 10 together with array access fixed. I hope

    that's the final fix.

compiler/cg386cal.pas

@@ -1796,9 +1796,38 @@ implementation
          l : longint;
          ispushed : boolean;
          hregister : tregister;
+         otlabel,oflabel,filenamestring : plabel;
 
       begin
          case p^.inlinenumber of
+            in_assert_x:
+              begin
+                 otlabel:=truelabel;
+                 oflabel:=falselabel;
+                 getlabel(truelabel);
+                 getlabel(falselabel);
+                 getlabel(filenamestring);
+                 secondpass(p^.left);
+                 if codegenerror then
+                   exit;
+                 if cs_do_assertion in aktswitches then
+                   begin
+                      maketojumpbool(p^.left);
+                      emitl(A_LABEL,falselabel);
+                      exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,
+                        p^.fileinfo.line)));
+                      { generate string }
+                      { push string
+                      exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,
+                        p^.fileinfo.line)));
+                      }
+                      emitcall('FPC_DO_ASSERT',true);
+                      emitl(A_LABEL,truelabel);
+
+                   end;
+                 truelabel:=otlabel;
+                 falselabel:=oflabel;
+              end;
             in_lo_word,
             in_hi_word :
               begin
@@ -2261,7 +2290,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.10  1998-07-18 22:54:23  florian
+  Revision 1.11  1998-07-24 22:16:52  florian
+    * internal error 10 together with array access fixed. I hope
+      that's the final fix.
+
+  Revision 1.10  1998/07/18 22:54:23  florian
     * some ansi/wide/longstring support fixed:
        o parameter passing
        o returning as result from functions

compiler/cg386flw.pas

@@ -136,9 +136,9 @@ implementation
               secondpass(p^.right);
            end;
          if assigned(p^.t1) then
-               begin
+           begin
               if assigned(p^.right) then
-                        begin
+                begin
                    getlabel(hl);
                    emitl(A_JMP,hl);
                 end;
@@ -590,7 +590,11 @@ do_jmp:
 end.
 {
   $Log$
-  Revision 1.3  1998-06-25 08:48:08  florian
+  Revision 1.4  1998-07-24 22:16:53  florian
+    * internal error 10 together with array access fixed. I hope
+      that's the final fix.
+
+  Revision 1.3  1998/06/25 08:48:08  florian
     * first version of rtti support
 
   Revision 1.2  1998/06/08 13:13:33  pierre

compiler/cg386ld.pas

@@ -184,17 +184,20 @@ implementation
                                    simple_loadn:=false;
                                    if hregister=R_NO then
                                      hregister:=getregister32;
-                                   if (p^.location.reference.base=procinfo.framepointer) then
+                                   if is_open_array(pvarsym(p^.symtableentry)^.definition) then
                                      begin
-                                        highframepointer:=p^.location.reference.base;
-                                        highoffset:=p^.location.reference.offset;
-                                     end
-                                   else
-                                     begin
-                                        highframepointer:=R_EDI;
-                                        highoffset:=p^.location.reference.offset;
-                                        exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,
-                                          p^.location.reference.base,R_EDI)));
+                                        if (p^.location.reference.base=procinfo.framepointer) then
+                                          begin
+                                             highframepointer:=p^.location.reference.base;
+                                             highoffset:=p^.location.reference.offset;
+                                          end
+                                        else
+                                          begin
+                                             highframepointer:=R_EDI;
+                                             highoffset:=p^.location.reference.offset;
+                                             exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,
+                                               p^.location.reference.base,R_EDI)));
+                                          end;
                                      end;
                                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.location.reference),
                                      hregister)));
@@ -521,7 +524,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.4  1998-06-11 13:58:45  peter
+  Revision 1.5  1998-07-24 22:16:54  florian
+    * internal error 10 together with array access fixed. I hope
+      that's the final fix.
+
+  Revision 1.4  1998/06/11 13:58:45  peter
     * fixed too long line
 
   Revision 1.3  1998/06/09 16:01:35  pierre

compiler/cg386mem.pas

@@ -384,14 +384,14 @@ implementation
                           begin
                              extraoffset:=p^.right^.left^.value;
                              t:=p^.right^.right;
-                                           putnode(p^.right);
+                             putnode(p^.right);
                              putnode(p^.right^.left);
                              p^.right:=t
                           end;
                      end
                    else if (p^.right^.treetype=subn) then
                      begin
-                                    if p^.right^.right^.treetype=ordconstn then
+                        if p^.right^.right^.treetype=ordconstn then
                           begin
                              extraoffset:=p^.right^.right^.value;
                              t:=p^.right^.left;
@@ -402,7 +402,7 @@ implementation
                         else if p^.right^.left^.treetype=ordconstn then
                           begin
                              extraoffset:=p^.right^.left^.value;
-                                           t:=p^.right^.right;
+                             t:=p^.right^.right;
                              putnode(p^.right);
                              putnode(p^.right^.left);
                              p^.right:=t
@@ -418,105 +418,105 @@ implementation
               pushed:=maybe_push(p^.right^.registers32,p);
               secondpass(p^.right);
               if pushed then restore(p);
-                case p^.right^.location.loc of
-                   LOC_REGISTER:
-                     begin
-                        ind:=p^.right^.location.register;
-                        case p^.right^.resulttype^.size of
-                           1:
-                             begin
-                                hr:=reg8toreg32(ind);
-                                emit_reg_reg(A_MOVZX,S_BL,ind,hr);
-                                ind:=hr;
-                             end;
-                           2:
-                             begin
-                                hr:=reg16toreg32(ind);
-                                emit_reg_reg(A_MOVZX,S_WL,ind,hr);
-                                 ind:=hr;
-                             end;
-                        end;
-                     end;
-                   LOC_CREGISTER:
-                     begin
-                        ind:=getregister32;
-                        case p^.right^.resulttype^.size of
-                           1:
-                             emit_reg_reg(A_MOVZX,S_BL,p^.right^.location.register,ind);
-                           2:
-                             emit_reg_reg(A_MOVZX,S_WL,p^.right^.location.register,ind);
-                           4:
-                             emit_reg_reg(A_MOV,S_L,p^.right^.location.register,ind);
-                        end;
-                     end;
-                   LOC_FLAGS:
-                     begin
-                        ind:=getregister32;
-                        exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.right^.location.resflags],S_B,reg32toreg8(ind))));
-                        emit_reg_reg(A_MOVZX,S_BL,reg32toreg8(ind),ind);
-                     end
-                   else
-                      begin
-                         del_reference(p^.right^.location.reference);
-                         ind:=getregister32;
-                         { Booleans are stored in an 8 bit memory location, so
-                           the use of MOVL is not correct }
-                         case p^.right^.resulttype^.size of
-                           1:
-                             tai:=new(pai386,op_ref_reg(A_MOVZX,S_BL,newreference(p^.right^.location.reference),ind));
-                           2:
-                             tai:=new(Pai386,op_ref_reg(A_MOVZX,S_WL,newreference(p^.right^.location.reference),ind));
-                           4:
-                             tai:=new(Pai386,op_ref_reg(A_MOV,S_L,newreference(p^.right^.location.reference),ind));
-                         end;
-                         exprasmlist^.concat(tai);
+              case p^.right^.location.loc of
+                 LOC_REGISTER:
+                   begin
+                      ind:=p^.right^.location.register;
+                      case p^.right^.resulttype^.size of
+                         1:
+                           begin
+                              hr:=reg8toreg32(ind);
+                              emit_reg_reg(A_MOVZX,S_BL,ind,hr);
+                              ind:=hr;
+                           end;
+                         2:
+                           begin
+                              hr:=reg16toreg32(ind);
+                              emit_reg_reg(A_MOVZX,S_WL,ind,hr);
+                              ind:=hr;
+                           end;
                       end;
-                end;
-              { produce possible range check code: }
-              if cs_rangechecking in aktswitches  then
-                begin
-                   if p^.left^.resulttype^.deftype=arraydef then
-                     begin
-                        hp:=new_reference(R_NO,0);
-                        parraydef(p^.left^.resulttype)^.genrangecheck;
-                        hp^.symbol:=stringdup('R_'+tostr(parraydef(p^.left^.resulttype)^.rangenr));
-                        exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,ind,hp)));
-                     end;
-                end;
-              if p^.location.reference.index=R_NO then
-                begin
-                   p^.location.reference.index:=ind;
-                   calc_emit_mul;
-                end
-              else
-                begin
-                   if p^.location.reference.base=R_NO then
-                     begin
-                        case p^.location.reference.scalefactor of
-                           2 : exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,1,p^.location.reference.index)));
-                           4 : exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,2,p^.location.reference.index)));
-                           8 : exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,3,p^.location.reference.index)));
-                        end;
-                        calc_emit_mul;
-                        p^.location.reference.base:=p^.location.reference.index;
-                        p^.location.reference.index:=ind;
-                     end
-                   else
-                     begin
-                        exprasmlist^.concat(new(pai386,op_ref_reg(
-                          A_LEA,S_L,newreference(p^.location.reference),
-                          p^.location.reference.index)));
-                        ungetregister32(p^.location.reference.base);
-                        { the symbol offset is loaded,               }
-                        { so release the symbol name and set symbol  }
-                        { to nil                                     }
-                        stringdispose(p^.location.reference.symbol);
-                        p^.location.reference.offset:=0;
-                        calc_emit_mul;
-                        p^.location.reference.base:=p^.location.reference.index;
-                        p^.location.reference.index:=ind;
-                     end;
-                end;
+                   end;
+                 LOC_CREGISTER:
+                   begin
+                      ind:=getregister32;
+                      case p^.right^.resulttype^.size of
+                         1:
+                           emit_reg_reg(A_MOVZX,S_BL,p^.right^.location.register,ind);
+                         2:
+                           emit_reg_reg(A_MOVZX,S_WL,p^.right^.location.register,ind);
+                         4:
+                           emit_reg_reg(A_MOV,S_L,p^.right^.location.register,ind);
+                      end;
+                   end;
+                 LOC_FLAGS:
+                   begin
+                      ind:=getregister32;
+                      exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.right^.location.resflags],S_B,reg32toreg8(ind))));
+                      emit_reg_reg(A_MOVZX,S_BL,reg32toreg8(ind),ind);
+                   end
+                 else
+                    begin
+                       del_reference(p^.right^.location.reference);
+                       ind:=getregister32;
+                       { Booleans are stored in an 8 bit memory location, so
+                         the use of MOVL is not correct }
+                       case p^.right^.resulttype^.size of
+                         1:
+                           tai:=new(pai386,op_ref_reg(A_MOVZX,S_BL,newreference(p^.right^.location.reference),ind));
+                         2:
+                           tai:=new(Pai386,op_ref_reg(A_MOVZX,S_WL,newreference(p^.right^.location.reference),ind));
+                         4:
+                           tai:=new(Pai386,op_ref_reg(A_MOV,S_L,newreference(p^.right^.location.reference),ind));
+                       end;
+                       exprasmlist^.concat(tai);
+                    end;
+              end;
+            { produce possible range check code: }
+            if cs_rangechecking in aktswitches  then
+              begin
+                 if p^.left^.resulttype^.deftype=arraydef then
+                   begin
+                      hp:=new_reference(R_NO,0);
+                      parraydef(p^.left^.resulttype)^.genrangecheck;
+                      hp^.symbol:=stringdup('R_'+tostr(parraydef(p^.left^.resulttype)^.rangenr));
+                      exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,ind,hp)));
+                   end;
+              end;
+            if p^.location.reference.index=R_NO then
+              begin
+                 p^.location.reference.index:=ind;
+                 calc_emit_mul;
+              end
+            else
+              begin
+                 if p^.location.reference.base=R_NO then
+                   begin
+                      case p^.location.reference.scalefactor of
+                         2 : exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,1,p^.location.reference.index)));
+                         4 : exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,2,p^.location.reference.index)));
+                         8 : exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,3,p^.location.reference.index)));
+                      end;
+                      calc_emit_mul;
+                      p^.location.reference.base:=p^.location.reference.index;
+                      p^.location.reference.index:=ind;
+                   end
+                 else
+                   begin
+                      exprasmlist^.concat(new(pai386,op_ref_reg(
+                        A_LEA,S_L,newreference(p^.location.reference),
+                        p^.location.reference.index)));
+                      ungetregister32(p^.location.reference.base);
+                      { the symbol offset is loaded,               }
+                      { so release the symbol name and set symbol  }
+                      { to nil                                     }
+                      stringdispose(p^.location.reference.symbol);
+                      p^.location.reference.offset:=0;
+                      calc_emit_mul;
+                      p^.location.reference.base:=p^.location.reference.index;
+                      p^.location.reference.index:=ind;
+                   end;
+              end;
              if p^.memseg then
                p^.location.reference.segment:=R_FS;
            end;
@@ -579,7 +579,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.3  1998-06-25 08:48:09  florian
+  Revision 1.4  1998-07-24 22:16:55  florian
+    * internal error 10 together with array access fixed. I hope
+      that's the final fix.
+
+  Revision 1.3  1998/06/25 08:48:09  florian
     * first version of rtti support
 
   Revision 1.2  1998/06/08 13:13:35  pierre

compiler/innr.inc

@@ -55,10 +55,15 @@ const
    in_exclude_x_y = 38;
    in_break = 39;
    in_continue = 40;
+   in_assert_x = 41;
 
 {
   $Log$
-  Revision 1.4  1998-05-01 16:38:44  florian
+  Revision 1.5  1998-07-24 22:16:57  florian
+    * internal error 10 together with array access fixed. I hope
+      that's the final fix.
+
+  Revision 1.4  1998/05/01 16:38:44  florian
     * handling of private and protected fixed
     + change_keywords_to_tp implemented to remove
       keywords which aren't supported by tp

compiler/pass_1.pas

@@ -1944,7 +1944,7 @@ unit pass_1;
          if not((p^.left^.treetype=ordconstn) and
             (p^.right^.treetype=ordconstn)) then
            Message(cg_e_illegal_expression);
-         { upper limit must be greater or equalt than lower limit }
+         { upper limit must be greater or equal than lower limit }
          { not if u32bit }
          if (p^.left^.value>p^.right^.value) and
             (( p^.left^.value<0) or (p^.right^.value>=0)) then
@@ -1956,6 +1956,19 @@ unit pass_1;
            Message(sym_e_type_mismatch);
       end;
 
+      {
+      begin
+         p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
+         if p^.right^.treetype<>ordconstn then
+           begin
+              case p^.right^.location.loc of
+                 LOC_MEM,LOC_REFERENCE,
+                 LOC_CREGISTER,LOC_FLAGS:
+                   inc(p^.registers32);
+              end;
+           end;
+      end;
+      }
     procedure firstvecn(var p : ptree);
 
       var
@@ -1980,17 +1993,17 @@ unit pass_1;
                 Message(sym_e_type_mismatch);
            end;
          { Never convert a boolean or a char !}
-                 { maybe type conversion }
-                 if (p^.right^.resulttype^.deftype<>enumdef) and
-                  not ((p^.right^.resulttype^.deftype=orddef) and
-                  (Porddef(p^.right^.resulttype)^.typ in [bool8bit,bool16bit,bool32bit,uchar])) then
-                        begin
-                                p^.right:=gentypeconvnode(p^.right,s32bitdef);
-                                { once more firstpass }
-                                {?? It's better to only firstpass when the tree has
-                                 changed, isn't it ?}
-                                firstpass(p^.right);
-                        end;
+         { maybe type conversion }
+         if (p^.right^.resulttype^.deftype<>enumdef) and
+          not ((p^.right^.resulttype^.deftype=orddef) and
+          (Porddef(p^.right^.resulttype)^.typ in [bool8bit,bool16bit,bool32bit,uchar])) then
+                begin
+                        p^.right:=gentypeconvnode(p^.right,s32bitdef);
+                        { once more firstpass }
+                        {?? It's better to only firstpass when the tree has
+                         changed, isn't it ?}
+                        firstpass(p^.right);
+                end;
          if codegenerror then
            exit;
 
@@ -2010,23 +2023,54 @@ unit pass_1;
                   exit;
                 p^.resulttype:=parraydef(harr)^.definition
              end
+           else if p^.left^.resulttype^.deftype=stringdef then
+             begin
+                { indexed access to strings }
+                case pstringdef(p^.left^.resulttype)^.string_typ of
+                   {
+                   st_widestring : p^.resulttype:=cwchardef;
+                   }
+                   st_ansistring : p^.resulttype:=cchardef;
+                   st_longstring : p^.resulttype:=cchardef;
+                   st_shortstring : p^.resulttype:=cchardef;
+                end;
+             end
            else
-           { indexed access to arrays }
-             p^.resulttype:=cchardef;
-
+             Message(sym_e_type_mismatch);
          { the register calculation is easy if a const index is used }
          if p^.right^.treetype=ordconstn then
-           p^.registers32:=p^.left^.registers32
+           begin
+              p^.registers32:=p^.left^.registers32
+              {
+              if is_ansistring(p^.left^.
+              }
+           end
          else
            begin
+              { this rules are suboptimal, but they should give }
+              { good results                                    }
               p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
-
-              { not correct, but what works better ? }
+              { need we an extra register when doing the restore ? }
+              if (p^.left^.registers32<=p^.right^.registers32) and
+              { only if the node needs less than 3 registers }
+              { two for the right node and one for the       }
+              { left address                                 }
+                (p^.registers32<3) then
+                inc(p^.registers32);
+
+              { need we an extra register for the index ? }
+              if (p^.right^.location.loc<>LOC_REGISTER)
+              { only if the right node doesn't need a register }
+                and (p^.right^.registers32<1) then
+                inc(p^.registers32);
+
+              { not correct, but what works better ?
               if p^.left^.registers32>0 then
                 p^.registers32:=max(p^.registers32,2)
               else
-              { min. one register }
+                 min. one register
                 p^.registers32:=max(p^.registers32,1);
+              }
            end;
          p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu);
 {$ifdef SUPPORT_MMX}
@@ -5048,7 +5092,11 @@ unit pass_1;
 end.
 {
   $Log$
-  Revision 1.43  1998-07-20 18:40:14  florian
+  Revision 1.44  1998-07-24 22:16:59  florian
+    * internal error 10 together with array access fixed. I hope
+      that's the final fix.
+
+  Revision 1.43  1998/07/20 18:40:14  florian
     * handling of ansi string constants should now work
 
   Revision 1.42  1998/07/20 10:23:01  florian

compiler/switches.pas

@@ -66,7 +66,7 @@ const
   SwitchTable:array['A'..'Z'] of SwitchRec=(
    {A} (typesw:unsupported; setsw:cs_none; proc:nil),
    {B} (typesw:unsupported; setsw:cs_none; proc:nil),
-   {C} (typesw:illegal; setsw:cs_none; proc:nil),
+   {C} (typesw:local; setsw:cs_do_assertion; proc:nil),
    {D} (typesw:unitglobal; setsw:cs_debuginfo; proc:nil),
    {E} (typesw:programglobal; setsw:cs_fp_emulation; proc:nil),
    {F} (typesw:unsupported; setsw:cs_none; proc:nil),
@@ -161,7 +161,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.6  1998-07-18 17:11:13  florian
+  Revision 1.7  1998-07-24 22:17:00  florian
+    * internal error 10 together with array access fixed. I hope
+      that's the final fix.
+
+  Revision 1.6  1998/07/18 17:11:13  florian
     + ansi string constants fixed
     + switch $H partial implemented
 

compiler/tree.pas

@@ -195,7 +195,7 @@ unit tree;
           fileinfo : tfileposinfo;
           pragmas : Tcswitches;
 {$ifdef extdebug}
-        firstpasscount : longint;
+          firstpasscount : longint;
 {$endif extdebug}
           case treetype : ttreetyp of
              addn : (use_strconcat : boolean;string_typ : tstringtype);
@@ -1596,7 +1596,11 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.22  1998-07-20 10:23:05  florian
+  Revision 1.23  1998-07-24 22:17:01  florian
+    * internal error 10 together with array access fixed. I hope
+      that's the final fix.
+
+  Revision 1.22  1998/07/20 10:23:05  florian
     * better ansi string assignement
 
   Revision 1.21  1998/07/14 21:46:56  peter