+ better support for switch $H

 + index access to ansi strings added
 + assigment of data (records/arrays) containing ansi strings

compiler/cg386ld.pas

@@ -249,6 +249,8 @@ implementation
          otlabel,hlabel,oflabel : plabel;
          hregister : tregister;
          loc : tloc;
+         r : preference;
+
       begin
          otlabel:=truelabel;
          oflabel:=falselabel;
@@ -362,7 +364,7 @@ implementation
         else case p^.right^.location.loc of
             LOC_REFERENCE,
             LOC_MEM : begin
-                         { handle ordinal constants trimmed }
+                         { extra handling for ordinal constants }
                          if (p^.right^.treetype in [ordconstn,fixconstn]) or
                             (loc=LOC_CREGISTER) then
                            begin
@@ -385,6 +387,39 @@ implementation
                            end
                          else
                            begin
+                              if p^.right^.resulttype^.needs_rtti then
+                                begin
+                                   { this would be a problem }
+                                   if not(p^.left^.resulttype^.needs_rtti) then
+                                     internalerror(3457);
+
+                                   { increment source reference counter }
+                                   new(r);
+                                   reset_reference(r^);
+                                   r^.symbol:=stringdup(lab2str(p^.right^.resulttype^.get_rtti_label));
+                                   emitpushreferenceaddr(exprasmlist,r^);
+
+                                   emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
+                                   exprasmlist^.concat(new(pai386,
+                                     op_csymbol(A_CALL,S_NO,newcsymbol('ADDREF',0))));
+
+                                   if not (cs_compilesystem in aktswitches) then
+                                     concat_external('ADDREF',EXT_NEAR);
+
+                                   { decrement destination reference counter }
+                                   new(r);
+                                   reset_reference(r^);
+                                   r^.symbol:=stringdup(lab2str(p^.left^.resulttype^.get_rtti_label));
+                                   emitpushreferenceaddr(exprasmlist,r^);
+
+                                   emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                                   exprasmlist^.concat(new(pai386,
+                                     op_csymbol(A_CALL,S_NO,newcsymbol('DECREF',0))));
+
+                                   if not (cs_compilesystem in aktswitches) then
+                                     concat_external('DECREF',EXT_NEAR);
+
+                                end;
                               concatcopy(p^.right^.location.reference,
                                 p^.left^.location.reference,p^.left^.resulttype^.size,false);
                               ungetiftemp(p^.right^.location.reference);
@@ -524,7 +559,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.5  1998-07-24 22:16:54  florian
+  Revision 1.6  1998-07-26 21:58:57  florian
+   + better support for switch $H
+   + index access to ansi strings added
+   + assigment of data (records/arrays) containing ansi strings
+
+  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.
 

compiler/cg386mem.pas

@@ -325,11 +325,40 @@ implementation
 
       begin
          secondpass(p^.left);
-         set_location(p^.location,p^.left^.location);
 
-         { in ansistrings S[1] is pchar(S)[0] !! }
-         if is_ansistring(p^.left^.resulttype) then
-           dec(p^.location.reference.offset);
+         { we load the array reference to p^.location }
+
+         { an ansistring needs to be dereferenced }
+         if is_ansistring(p^.left^.resulttype) or
+           is_widestring(p^.left^.resulttype) then
+           begin
+              reset_reference(p^.location.reference);
+              p^.location.loc:=LOC_REFERENCE;
+              del_reference(p^.left^.location.reference);
+              p^.location.reference.base:=getregister32;
+              exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                newreference(p^.left^.location.reference),
+                p^.location.reference.base)));
+              if is_ansistring(p^.left^.resulttype) then
+                begin
+                   { in ansistrings S[1] is pchar(S)[0] !! }
+                   dec(p^.location.reference.offset);
+                   { this is necessary for ansistrings with constant index }
+                   dec(p^.left^.location.reference.offset);
+                end
+              else
+                begin
+                   { in widestrings S[1] is pwchar(S)[0] !! }
+                   dec(p^.location.reference.offset,2);
+                   { this is necessary for ansistrings with constant index }
+                   dec(p^.left^.location.reference.offset,2);
+                   exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,
+                     2,p^.location.reference.base)));
+                end;
+           end
+         else
+           set_location(p^.location,p^.left^.location);
+
          { offset can only differ from 0 if arraydef }
          if p^.left^.resulttype^.deftype=arraydef then
            dec(p^.location.reference.offset,
@@ -340,14 +369,14 @@ implementation
               if (p^.left^.resulttype^.deftype=arraydef) then
                 begin
                    if not(is_open_array(p^.left^.resulttype)) then
-                         begin
+                     begin
                         if (p^.right^.value>parraydef(p^.left^.resulttype)^.highrange) or
                            (p^.right^.value<parraydef(p^.left^.resulttype)^.lowrange) then
                           Message(parser_e_range_check_error);
 
                         dec(p^.left^.location.reference.offset,
                             get_mul_size*parraydef(p^.left^.resulttype)^.lowrange);
-                         end
+                     end
                    else
                      begin
                         { range checking for open arrays }
@@ -579,7 +608,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.4  1998-07-24 22:16:55  florian
+  Revision 1.5  1998-07-26 21:58:58  florian
+   + better support for switch $H
+   + index access to ansi strings added
+   + assigment of data (records/arrays) containing ansi strings
+
+  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.
 

compiler/pass_1.pas

@@ -2040,16 +2040,24 @@ unit pass_1;
          { the register calculation is easy if a const index is used }
          if p^.right^.treetype=ordconstn then
            begin
-              p^.registers32:=p^.left^.registers32
-              {
-              if is_ansistring(p^.left^.
-              }
+              p^.registers32:=p^.left^.registers32;
+
+              { for ansi/wide strings, we need at least one register }
+              if is_ansistring(p^.left^.resulttype) or
+                is_widestring(p^.left^.resulttype) then
+                p^.registers32:=max(p^.registers32,1);
            end
          else
            begin
               { this rules are suboptimal, but they should give }
               { good results                                    }
               p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
+
+              { for ansi/wide strings, we need at least one register }
+              if is_ansistring(p^.left^.resulttype) or
+                is_widestring(p^.left^.resulttype) then
+                p^.registers32:=max(p^.registers32,1);
+
               { 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 }
@@ -5092,7 +5100,12 @@ unit pass_1;
 end.
 {
   $Log$
-  Revision 1.44  1998-07-24 22:16:59  florian
+  Revision 1.45  1998-07-26 21:58:59  florian
+   + better support for switch $H
+   + index access to ansi strings added
+   + assigment of data (records/arrays) containing ansi strings
+
+  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.
 

compiler/pdecl.pas

@@ -486,14 +486,20 @@ unit pdecl;
               disposetree(p);
            end
            { should string without suffix be an ansistring also
-             in ansistring mode ?? (PM) }
+             in ansistring mode ?? (PM) Yes!!! (FK) }
+          else
+            begin
+               if cs_ansistrings in aktswitches then
+                 d:=new(pstringdef,ansiinit(0))
+               else
 {$ifndef GDB}
-                 else d:=new(pstringdef,init(255));
+                 d:=new(pstringdef,init(255));
 {$else GDB}
-                 else d:=globaldef('STRING');
+                 d:=globaldef('STRING');
 {$endif GDB}
-                 stringtype:=d;
-          end;
+            end;
+          stringtype:=d;
+       end;
 
 
     function id_type(var s : string) : pdef;
@@ -518,20 +524,20 @@ unit pdecl;
          getsym(s,true);
          if assigned(srsym) then
            begin
-                  if srsym^.typ=unitsym then
-                        begin
-                           consume(POINT);
-                           getsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
-                           s:=pattern;
-                           consume(ID);
-                        end;
-                  if srsym^.typ<>typesym then
-                        begin
-                           Message(sym_e_type_id_expected);
-                           lasttypesym:=ptypesym(srsym);
-                           id_type:=generrordef;
-                           exit;
-                        end;
+              if srsym^.typ=unitsym then
+                begin
+                   consume(POINT);
+                   getsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
+                   s:=pattern;
+                   consume(ID);
+                end;
+              if srsym^.typ<>typesym then
+                begin
+                   Message(sym_e_type_id_expected);
+                   lasttypesym:=ptypesym(srsym);
+                   id_type:=generrordef;
+                   exit;
+                end;
            end;
          lasttypesym:=ptypesym(srsym);
          id_type:=ptypesym(srsym)^.definition;
@@ -1875,7 +1881,12 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.34  1998-07-20 22:17:15  florian
+  Revision 1.35  1998-07-26 21:59:00  florian
+   + better support for switch $H
+   + index access to ansi strings added
+   + assigment of data (records/arrays) containing ansi strings
+
+  Revision 1.34  1998/07/20 22:17:15  florian
     * hex constants in numeric char (#$54#$43 ...) are now allowed
     * there was a bug in record_var_dec which prevents the used
       of nested variant records (for example drivers.tevent of tv)