+ First working concept of open_array_procedure(Pbyte_var[0..9]);

git-svn-id: trunk@5028 -

compiler/ncal.pas

@@ -184,7 +184,7 @@ implementation
       verbose,globals,
       symconst,defutil,defcmp,
       htypechk,pass_1,
-      ncnv,nld,ninl,nadd,ncon,nmem,
+      ncnv,nld,ninl,nadd,ncon,nmem,nset,
       procinfo,
       cgbase
       ;
@@ -322,11 +322,16 @@ type
 
 
     function gen_high_tree(var p:tnode;paradef:tdef):tnode;
+
+    {When passing an array to an open array, or a string to an open string,
+     some code is needed that generates the high bound of the array. This
+     function returns a tree containing the nodes for it.}
+
       var
         temp: tnode;
         len : integer;
         loadconst : boolean;
-        hightree : tnode;
+        hightree,l,r : tnode;
       begin
         len:=-1;
         loadconst:=true;
@@ -353,17 +358,34 @@ type
                   loadconst:=false;
                   { slice? }
                   if (p.nodetype=inlinen) and (tinlinenode(p).inlinenumber=in_slice_x) then
-                    begin
-                      hightree:=tcallparanode(tcallparanode(tinlinenode(p).left).right).left;
-                      hightree:=caddnode.create(subn,hightree,genintconstnode(1));
-                      tcallparanode(tcallparanode(tinlinenode(p).left).right).left:=nil;
-
-                      temp:=p;
-                      p:=tcallparanode(tinlinenode(p).left).left;
-                      tcallparanode(tinlinenode(temp).left).left:=nil;
-                      temp.free;
+                    with Tcallparanode(Tinlinenode(p).left) do
+                      begin
+                        {Array slice using slice builtin function.}
+                        l:=Tcallparanode(right).left;
+                        hightree:=caddnode.create(subn,l,genintconstnode(1));
+                        Tcallparanode(right).left:=nil;
+
+                        {Remove the inline node.}
+                        temp:=p;
+                        p:=left;
+                        Tcallparanode(tinlinenode(temp).left).left:=nil;
+                        temp.free;
 
-                      resulttypepass(hightree);
+                        resulttypepass(hightree);
+                      end
+                  else if (p.nodetype=vecn) and (Tvecnode(p).right.nodetype=rangen) then
+                    begin
+                      {Array slice using .. operator.}
+                      with Trangenode(Tvecnode(p).right) do
+                        begin
+                          {Because the bounds are also needed to calculate the pointer,
+                           we take copies instead of clearing the original.}
+                          l:=left.getcopy;  {Get lower bound.}
+                          r:=right.getcopy; {Get upper bound.}
+                        end;
+                      {In the procedure the array range is 0..(upper_bound-lower_bound).}
+                      hightree:=caddnode.create(subn,r,l);
+                      resulttypepass(gen_high_tree);
                     end
                   else
                     begin

compiler/ncgmem.pas

@@ -83,7 +83,7 @@ implementation
       symconst,symdef,symsym,symtable,defutil,paramgr,
       aasmbase,aasmtai,aasmdata,
       procinfo,pass_2,parabase,
-      pass_1,nld,ncon,nadd,nutils,
+      pass_1,nld,ncon,nadd,nutils,nset,
       cgutils,cgobj,
       tgobj,ncgutil
       ;
@@ -698,12 +698,13 @@ implementation
               ispowerof2(mulsize div 8,temp))) then
            dec(location.reference.offset,bytemulsize*tarraydef(left.resulttype.def).lowrange);
 
-         if right.nodetype=ordconstn then
-           begin
-              { offset can only differ from 0 if arraydef }
-              case left.resulttype.def.deftype of
-                arraydef :
-                  begin
+         case right.nodetype of
+           ordconstn:
+             begin
+               { offset can only differ from 0 if arraydef }
+               case left.resulttype.def.deftype of
+                 arraydef :
+                   begin
                      if not(is_open_array(left.resulttype.def)) and
                         not(is_array_of_const(left.resulttype.def)) and
                         not(is_dynamic_array(left.resulttype.def)) then
@@ -726,11 +727,11 @@ implementation
                           if (cs_check_range in aktlocalswitches) then
                             rangecheck_array;
                        end;
-                  end;
-                stringdef :
-                  begin
-                    if (cs_check_range in aktlocalswitches) then
-                     begin
+                   end;
+                 stringdef :
+                   begin
+                     if (cs_check_range in aktlocalswitches) then
+                      begin
                        case tstringdef(left.resulttype.def).string_typ of
                          { it's the same for ansi- and wide strings }
                          st_widestring,
@@ -762,14 +763,14 @@ implementation
                               {!!!!!!!!!!!!!!!!!}
                            end;
                        end;
-                     end;
+                      end;
                    end;
-              end;
-              if not(is_packed_array(left.resulttype.def)) or
+               end;
+               if not(is_packed_array(left.resulttype.def)) or
                  ((mulsize mod 8 = 0) and
                   ispowerof2(mulsize div 8,temp)) then
-                begin
-                  inc(location.reference.offset,
+                 begin
+                   inc(location.reference.offset,
                     bytemulsize*tordconstnode(right).value);
                   { don't do this for floats etc.; needed to properly set the }
                   { size for bitpacked arrays (e.g. a bitpacked array of      }
@@ -778,29 +779,44 @@ implementation
                   if is_packed_array(left.resulttype.def) and
                      (tcgsize2size[newsize] <> bytemulsize) then
                     newsize:=int_cgsize(bytemulsize);
-                end
-              else
-                begin
-                  subsetref.ref := location.reference;
-                  subsetref.ref.alignment := left.resulttype.def.alignment;
-                  if not ispowerof2(subsetref.ref.alignment,temp) then
-                    internalerror(2006081212);
-                  alignpow:=temp;
-                  inc(subsetref.ref.offset,((mulsize * (tordconstnode(right).value-tarraydef(left.resulttype.def).lowrange)) shr (3+alignpow)) shl alignpow);
-                  subsetref.bitindexreg := NR_NO;
-                  subsetref.startbit := (mulsize * (tordconstnode(right).value-tarraydef(left.resulttype.def).lowrange)) and ((1 shl (3+alignpow))-1);
-                  subsetref.bitlen := resulttype.def.packedbitsize;
-                  if (left.location.loc = LOC_REFERENCE) then
-                    location.loc := LOC_SUBSETREF
-                  else
-                    location.loc := LOC_CSUBSETREF;
-                  location.sref := subsetref;
-                end;
-           end
-         else
-         { not nodetype=ordconstn }
-           begin
-              if (cs_opt_level1 in aktoptimizerswitches) and
+                 end
+               else
+                 begin
+                   subsetref.ref := location.reference;
+                   subsetref.ref.alignment := left.resulttype.def.alignment;
+                   if not ispowerof2(subsetref.ref.alignment,temp) then
+                     internalerror(2006081212);
+                   alignpow:=temp;
+                   inc(subsetref.ref.offset,((mulsize * (tordconstnode(right).value-tarraydef(left.resulttype.def).lowrange)) shr (3+alignpow)) shl alignpow);
+                   subsetref.bitindexreg := NR_NO;
+                   subsetref.startbit := (mulsize * (tordconstnode(right).value-tarraydef(left.resulttype.def).lowrange)) and ((1 shl (3+alignpow))-1);
+                   subsetref.bitlen := resulttype.def.packedbitsize;
+                   if (left.location.loc = LOC_REFERENCE) then
+                     location.loc := LOC_SUBSETREF
+                   else
+                     location.loc := LOC_CSUBSETREF;
+                   location.sref := subsetref;
+                 end;
+             end;
+           rangen:
+             begin
+               {Pbyte[0..9] syntax.
+                The .. operator by itself does not generate code, it only determines
+                the type of the resulting array. So we immediately call the second past
+                of the lower bound, which determines the address.}
+
+               {Get lower array bound.}
+               secondpass(Trangenode(right).left);
+               {If mulsize = 1, we won't have to modify the index }
+               location_force_reg(current_asmdata.CurrAsmList,
+                                  Trangenode(right).left.location,
+                                  OS_ADDR,
+                                  mulsize=1);
+               update_reference_reg_mul(Trangenode(right).left.location.register,mulsize)
+             end;
+           else
+             { not nodetype in [ordconstn,rangen] }
+             if (cs_opt_level1 in aktoptimizerswitches) and
                  { if we do range checking, we don't }
                  { need that fancy code (it would be }
                  { buggy)                            }
@@ -937,11 +953,11 @@ implementation
                 update_reference_reg_mul(right.location.register,mulsize)
               else
                 update_reference_reg_packed(right.location.register,mulsize);
-           end;
+         end;
 
-        location.size:=newsize;
-        paraloc1.done;
-        paraloc2.done;
+         location.size:=newsize;
+         paraloc1.done;
+         paraloc2.done;
       end;
 
 

compiler/nmem.pas

@@ -699,11 +699,15 @@ implementation
           exit;
 
          { maybe type conversion for the index value, but
-           do not convert enums,booleans,char }
-         if ((right.resulttype.def.deftype<>enumdef) and
-             not(is_char(right.resulttype.def) or is_widechar(right.resulttype.def)) and
-             not(is_boolean(right.resulttype.def))) or
-            (left.resulttype.def.deftype <> arraydef) then
+           do not convert enums,booleans,char
+           and do not convert range nodes }
+         if (right.nodetype<>rangen) and (
+             ((right.resulttype.def.deftype<>enumdef) and
+               not(is_char(right.resulttype.def) or is_widechar(right.resulttype.def)) and
+               not(is_boolean(right.resulttype.def))
+             ) or
+             (left.resulttype.def.deftype <> arraydef) 
+            ) then
            begin
              inserttypeconv(right,sinttype);
            end;
@@ -731,7 +735,10 @@ implementation
                   { convert pointer to array }
                   htype.setdef(tarraydef.create_from_pointer(tpointerdef(left.resulttype.def).pointertype));
                   inserttypeconv(left,htype);
-                  resulttype:=tarraydef(htype.def).elementtype;
+                  if right.nodetype=rangen then
+                    resulttype:=htype
+                  else
+                    resulttype:=tarraydef(htype.def).elementtype;
                 end
                else
                 CGMessage(type_e_array_required);

compiler/pexpr.pas

@@ -858,6 +858,7 @@ implementation
               statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil)));
               consume(_RKLAMMER);
             end;
+(*
           in_get_frame:
             begin
               statement_syssym:=geninlinenode(l,false,nil);
@@ -876,7 +877,7 @@ implementation
                 end;
               statement_syssym:=geninlinenode(l,false,nil);
             end;
-
+*)
           else
             internalerror(15);
 
@@ -1852,10 +1853,11 @@ implementation
                                  { support delphi autoderef }
                                  if (tpointerdef(p1.resulttype.def).pointertype.def.deftype=arraydef) and
                                     (m_autoderef in aktmodeswitches) then
-                                  begin
-                                    p1:=cderefnode.create(p1);
-                                  end;
+                                   p1:=cderefnode.create(p1);
                                  p2:=comp_expr(true);
+                                 if try_to_consume(_POINTPOINT) then
+                                   { Support Pbytevar[0..9] which returns array [0..9].}
+                                   p2:=crangenode.create(p2,comp_expr(true));
                                  p1:=cvecnode.create(p1,p2);
                               end;
                             variantdef: