* ansistring fixes

compiler/cg386con.pas

@@ -226,19 +226,27 @@ implementation
                                 consts^.concat(new(pai_label,init(l1)));
                                 getmem(pc,p^.length+1);
                                 move(p^.value_str^,pc^,p^.length+1);
+                                pc[p^.length]:=#0;
                                 { to overcome this problem we set the length explicitly }
                                 { with the ending null char }
-                                consts^.concat(new(pai_string,init_length_pchar(pc,p^.length+1)));
+                                consts^.concat(new(pai_string,init_length_pchar(pc,p^.length)));
                              end;
                         end;
                       st_shortstring:
                         begin
-                           getmem(pc,p^.length+3);
-                           move(p^.value_str^,pc[1],p^.length+1);
-                           pc[0]:=chr(p^.length);
-                           { to overcome this problem we set the length explicitly }
-                           { with the ending null char }
-                           consts^.concat(new(pai_string,init_length_pchar(pc,p^.length+2)));
+                           { empty strings }
+                           if p^.length=0 then
+                            consts^.concat(new(pai_const,init_16bit(0)))
+                           else
+                            begin
+                              { also length and terminating zero }
+                              getmem(pc,p^.length+2);
+                              move(p^.value_str^,pc[1],p^.length+1);
+                              pc[0]:=chr(p^.length);
+                              { to overcome this problem we set the length explicitly }
+                              { with the ending null char }
+                              consts^.concat(new(pai_string,init_length_pchar(pc,p^.length+1)));
+                            end;
                         end;
                    end;
 {$endif UseAnsiString}
@@ -317,7 +325,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.14  1998-09-17 09:42:13  peter
+  Revision 1.15  1998-11-04 10:11:36  peter
+    * ansistring fixes
+
+  Revision 1.14  1998/09/17 09:42:13  peter
     + pass_2 for cg386
     * Message() -> CGMessage() for pass_1/pass_2
 

compiler/cobjects.pas

@@ -269,12 +269,10 @@ unit cobjects;
 
   implementation
 
-    function pchar2pstring(p : pchar) : pstring;
 
+    function pchar2pstring(p : pchar) : pstring;
       var
-         w : word;
-         i : longint;
-
+         w,i : longint;
       begin
          w:=strlen(p);
          for i:=w-1 downto 0 do
@@ -283,22 +281,20 @@ unit cobjects;
          pchar2pstring:=pstring(p);
       end;
 
-    function pstring2pchar(p : pstring) : pchar;
 
+    function pstring2pchar(p : pstring) : pchar;
       var
-         w : word;
-         i : longint;
-
+         w,i : longint;
       begin
-         w:=length(p^[0]);
+         w:=length(p^);
          for i:=1 to w do
            p^[i-1]:=p^[i];
          p^[w]:=#0;
          pstring2pchar:=pchar(p);
       end;
 
-    function lowercase(c : char) : char;
 
+    function lowercase(c : char) : char;
        begin
           case c of
              #65..#90 : c := chr(ord (c) + 32);
@@ -316,6 +312,7 @@ unit cobjects;
           lowercase := c;
        end;
 
+
     function strpnew(const s : string) : pchar;
       var
          p : pchar;
@@ -325,6 +322,7 @@ unit cobjects;
          strpnew:=p;
       end;
 
+
     procedure stringdispose(var p : pstring);
       begin
          if assigned(p) then
@@ -332,6 +330,7 @@ unit cobjects;
          p:=nil;
       end;
 
+
     procedure ansistringdispose(var p : pchar;length : longint);
       begin
          if assigned(p) then
@@ -339,17 +338,17 @@ unit cobjects;
          p:=nil;
       end;
 
-    function stringdup(const s : string) : pstring;
 
+    function stringdup(const s : string) : pstring;
       var
          p : pstring;
-
       begin
          getmem(p,length(s)+1);
          p^:=s;
          stringdup:=p;
       end;
 
+
 {****************************************************************************
                                   TStringQueue
 ****************************************************************************}
@@ -1145,7 +1144,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.15  1998-10-19 18:04:40  peter
+  Revision 1.16  1998-11-04 10:11:37  peter
+    * ansistring fixes
+
+  Revision 1.15  1998/10/19 18:04:40  peter
     + tstringcontainer.init_no_doubles
 
   Revision 1.14  1998/09/18 16:03:37  florian

compiler/hcodegen.pas

@@ -354,46 +354,18 @@ implementation
       end;
 
 
-    function strnew(p : pchar;length : longint) : pchar;
-      var
-         pc : pchar;
-      begin
-         getmem(pc,length);
-         move(p^,pc^,length);
-         strnew:=pc;
-      end;
-
-
-    { concates the ASCII string from pchar to the asmslist a }
     procedure generate_pascii(a : paasmoutput;hs : pchar;length : longint);
-      var
-         real_end,current_begin,current_end : pchar;
-         c :char;
       begin
          if assigned(hs) then
-           begin
-              current_begin:=hs;
-              real_end:=strend(hs);
-              c:=hs[0];
-              while length>32 do
-                begin
-                   { restore the char displaced }
-                   current_begin[0]:=c;
-                   current_end:=current_begin+32;
-                   { store the char for next loop }
-                   c:=current_end[0];
-                   current_end[0]:=#0;
-                   a^.concat(new(pai_string,init_length_pchar(strnew(current_begin,32),32)));
-                   current_begin:=current_end;
-                   length:=length-32;
-                end;
-              current_begin[0]:=c;
-              a^.concat(new(pai_string,init_length_pchar(strnew(current_begin,length),length)));
-           end;
+           a^.concat(new(pai_string,init_length_pchar(hs,length)));
       end;
 
-    constructor ttemptodestroy.init(const a : treference;p : pdef);
 
+{*****************************************************************************
+                              TTempToDestroy
+*****************************************************************************}
+
+    constructor ttemptodestroy.init(const a : treference;p : pdef);
       begin
          inherited init;
          address:=a;
@@ -404,7 +376,10 @@ end.
 
 {
   $Log$
-  Revision 1.20  1998-10-29 15:42:48  florian
+  Revision 1.21  1998-11-04 10:11:38  peter
+    * ansistring fixes
+
+  Revision 1.20  1998/10/29 15:42:48  florian
     + partial disposing of temp. ansistrings
 
   Revision 1.19  1998/10/26 22:58:18  florian

compiler/pexpr.pas

@@ -1890,9 +1890,7 @@ unit pexpr;
       do_firstpass(p);
       if p^.treetype<>stringconstn then
         begin
-          if (p^.treetype=ordconstn) and
-             (p^.resulttype^.deftype=orddef) and
-             (Porddef(p^.resulttype)^.typ=uchar) then
+          if (p^.treetype=ordconstn) and is_char(p^.resulttype) then
             get_stringconst:=char(p^.value)
           else
             Message(cg_e_illegal_expression);
@@ -1909,7 +1907,10 @@ unit pexpr;
 end.
 {
   $Log$
-  Revision 1.71  1998-10-22 23:57:29  peter
+  Revision 1.72  1998-11-04 10:11:41  peter
+    * ansistring fixes
+
+  Revision 1.71  1998/10/22 23:57:29  peter
     * fixed filedef for typenodetype
 
   Revision 1.70  1998/10/21 15:12:54  pierre

compiler/ppheap.pas

@@ -30,16 +30,19 @@ unit ppheap;
 
     uses
        globals,files;
-       
+
     procedure ppextra_info(p : pointer);
       begin
          longint(p^):=aktfilepos.line;
          plongint(cardinal(p)+4)^:=aktfilepos.column;
-         plongint(cardinal(p)+8)^:=current_module^.unit_index*100000+aktfilepos.fileindex;
+         if assigned(current_module) then
+          plongint(cardinal(p)+8)^:=current_module^.unit_index*100000+aktfilepos.fileindex
+         else
+          plongint(cardinal(p)+8)^:=aktfilepos.fileindex
       end;
-      
+
   begin
      set_extra_info(12,ppextra_info);
   end.
-  
+
 

compiler/psystem.pas

@@ -90,6 +90,9 @@ begin
   p^.insert(new(ptypesym,init('cs32fixed',s32fixeddef)));
   p^.insert(new(ptypesym,init('byte',u8bitdef)));
   p^.insert(new(ptypesym,init('string',cstringdef)));
+{$ifdef useansistring}
+  p^.insert(new(ptypesym,init('shortstring',cstringdef)));
+{$endif}
   p^.insert(new(ptypesym,init('longstring',clongstringdef)));
   p^.insert(new(ptypesym,init('ansistring',cansistringdef)));
   p^.insert(new(ptypesym,init('widestring',cwidestringdef)));
@@ -120,6 +123,9 @@ begin
   p^.insert(new(ptypesym,init('SINGLE',new(pfloatdef,init(s32real)))));
   p^.insert(new(ptypesym,init('POINTER',new(ppointerdef,init(voiddef)))));
   p^.insert(new(ptypesym,init('STRING',cstringdef)));
+{$ifdef useansistring}
+  p^.insert(new(ptypesym,init('SHORTSTRING',cstringdef)));
+{$endif}
   p^.insert(new(ptypesym,init('LONGSTRING',clongstringdef)));
   p^.insert(new(ptypesym,init('ANSISTRING',cansistringdef)));
   p^.insert(new(ptypesym,init('WIDESTRING',cwidestringdef)));
@@ -235,7 +241,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.7  1998-10-05 12:32:48  peter
+  Revision 1.8  1998-11-04 10:11:44  peter
+    * ansistring fixes
+
+  Revision 1.7  1998/10/05 12:32:48  peter
     + assert() support
 
   Revision 1.6  1998/09/24 23:49:17  peter

compiler/ptconst.pas

@@ -54,6 +54,9 @@ unit ptconst;
 {$ifdef m68k}
          j : longint;
 {$endif m68k}
+{$ifdef useansistring}
+         len       : longint;
+{$endif}
          p,hp      : ptree;
          i,l,offset,
          strlength : longint;
@@ -317,7 +320,10 @@ unit ptconst;
                              strlength:=p^.length;
                            datasegment^.concat(new(pai_const,init_8bit(strlength)));
                            { this can also handle longer strings }
-                           generate_pascii(datasegment,p^.value_str,strlength);
+                           getmem(ca,strlength+1);
+                           move(p^.value_str^,ca^,strlength);
+                           ca[strlength]:=#0;
+                           generate_pascii(datasegment,ca,strlength);
 {$else UseAnsiString}
                            if length(p^.value_str^)>=def^.size then
                              begin
@@ -341,12 +347,12 @@ unit ptconst;
                       if def^.size>strlength then
                         begin
                            getmem(ca,def^.size-strlength);
+                           { def^.size contains also the leading length, so we }
+                           { we have to subtract one                           }
                            fillchar(ca[0],def^.size-strlength-1,' ');
                            ca[def^.size-strlength-1]:=#0;
 {$ifdef UseAnsiString}
                            { this can also handle longer strings }
-                           { def^.size contains also the leading length, so we }
-                           { we have to subtract one                           }
                            generate_pascii(datasegment,ca,def^.size-strlength-1);
 {$else UseAnsiString}
                            datasegment^.concat(new(pai_string,init_pchar(ca)));
@@ -356,19 +362,24 @@ unit ptconst;
 {$ifdef UseLongString}
                  st_longstring:
                    begin
+                     if is_constcharnode(p) then
+                      strlength:=1
+                     else
+                      strlength:=p^.length;
                      { first write the maximum size }
-                     datasegment^.concat(new(pai_const,init_32bit(p^.length)))));
+                     datasegment^.concat(new(pai_const,init_32bit(strlength)))));
                      { fill byte }
                      datasegment^.concat(new(pai_const,init_8bit(0)));
                      if p^.treetype=stringconstn then
                        begin
-                          { this can also handle longer strings }
-                          generate_pascii(consts,p^.value_str,p^.length);
+                         getmem(ca,strlength+1);
+                         move(p^.value_str^,ca^,strlength);
+                         ca[strlength]:=#0;
+                         generate_pascii(consts,ca,strlength);
                        end
                      else if is_constcharnode(p) then
                        begin
                           consts^.concat(new(pai_const,init_8bit(p^.value)));
-                          strlength:=1;
                        end
                      else Message(cg_e_illegal_expression);
                      datasegment^.concat(new(pai_const,init_8bit(0)));
@@ -382,12 +393,16 @@ unit ptconst;
                         datasegment^.concat(new(pai_const,init_32bit(0)))
                       else
                         begin
+                           if is_constcharnode(p) then
+                            strlength:=1
+                           else
+                            strlength:=p^.length;
                            getdatalabel(ll);
                            datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(ll)))));
                            { first write the maximum size }
-                           consts^.concat(new(pai_const,init_32bit(p^.length)));
+                           consts^.concat(new(pai_const,init_32bit(strlength)));
                            { second write the real length }
-                           consts^.concat(new(pai_const,init_32bit(p^.length)));
+                           consts^.concat(new(pai_const,init_32bit(strlength)));
                            { redondent with maxlength but who knows ... (PM) }
                            { third write use count (set to -1 for safety ) }
                            consts^.concat(new(pai_const,init_32bit(-1)));
@@ -398,13 +413,14 @@ unit ptconst;
                            consts^.concat(new(pai_label,init(ll)));
                            if p^.treetype=stringconstn then
                              begin
-                                { this can also handle longer strings }
-                                generate_pascii(consts,p^.value_str,p^.length);
+                               getmem(ca,strlength+1);
+                               move(p^.value_str^,ca^,strlength);
+                               ca[strlength]:=#0;
+                               generate_pascii(consts,ca,strlength);
                              end
                            else if is_constcharnode(p) then
                              begin
                                 consts^.concat(new(pai_const,init_8bit(p^.value)));
-                                strlength:=1;
                              end
                            else Message(cg_e_illegal_expression);
                            consts^.concat(new(pai_const,init_8bit(0)));
@@ -432,10 +448,23 @@ unit ptconst;
                    p:=comp_expr(true);
                    do_firstpass(p);
                    if p^.treetype=stringconstn then
+                    begin
+{$ifdef useansistring}
+                      if p^.length>255 then
+                       len:=255
+                      else
+                       len:=p^.length;
+                      s[0]:=chr(len);
+                      move(p^.value_str^,s[1],len);
+{$else}
                      s:=p^.value_str^
-                   else if is_constcharnode(p) then
-                     s:=char(byte(p^.value))
-                   else Message(cg_e_illegal_expression);
+{$endif}
+                    end
+                   else
+                     if is_constcharnode(p) then
+                       s:=char(byte(p^.value))
+                   else
+                     Message(cg_e_illegal_expression);
                    disposetree(p);
                    l:=length(s);
                    for i:=Parraydef(def)^.lowrange to Parraydef(def)^.highrange do
@@ -580,7 +609,7 @@ unit ptconst;
                              else
                                symt:=nil;
                           end;
-                        
+
                         if srsym=nil then
                           begin
                              Message1(sym_e_id_not_found,s);
@@ -591,18 +620,18 @@ unit ptconst;
                              { check position }
                              if pvarsym(srsym)^.address<aktpos then
                                Message(parser_e_invalid_record_const);
-     
+
                              { if needed fill }
                              if pvarsym(srsym)^.address>aktpos then
                                for i:=1 to pvarsym(srsym)^.address-aktpos do
                                  datasegment^.concat(new(pai_const,init_8bit(0)));
-     
+
                              { new position }
                              aktpos:=pvarsym(srsym)^.address+pvarsym(srsym)^.definition^.size;
-     
+
                              { read the data }
                              readtypedconst(pvarsym(srsym)^.definition,nil);
-     
+
                              if token=SEMICOLON then
                                consume(SEMICOLON)
                              else break;
@@ -620,7 +649,10 @@ unit ptconst;
 end.
 {
   $Log$
-  Revision 1.22  1998-10-20 08:06:56  pierre
+  Revision 1.23  1998-11-04 10:11:45  peter
+    * ansistring fixes
+
+  Revision 1.22  1998/10/20 08:06:56  pierre
     * several memory corruptions due to double freemem solved
       => never use p^.loc.location:=p^.left^.loc.location;
     + finally I added now by default

compiler/tcadd.pas

@@ -275,7 +275,8 @@ implementation
 {$ifdef UseAnsiString}
               s1:=strpnew(char(byte(p^.left^.value)));
               s2:=strpnew(char(byte(p^.right^.value)));
-              l1:=1;l2:=1;
+              l1:=1;
+              l2:=1;
 {$else UseAnsiString}
               s1^:=char(byte(p^.left^.value));
               s2^:=char(byte(p^.right^.value));
@@ -286,7 +287,6 @@ implementation
            if (lt=stringconstn) and (rt=ordconstn) and is_char(rd) then
            begin
 {$ifdef UseAnsiString}
-              { here there is allways the damn #0 problem !! }
               s1:=getpcharcopy(p^.left);
               l1:=p^.left^.length;
               s2:=strpnew(char(byte(p^.right^.value)));
@@ -297,12 +297,10 @@ implementation
 {$endif UseAnsiString}
               concatstrings:=true;
            end
-         else if (lt=ordconstn) and (rt=stringconstn) and
-           (ld^.deftype=orddef) and
-           (porddef(ld)^.typ=uchar) then
+         else
+           if (lt=ordconstn) and (rt=stringconstn) and is_char(ld) then
            begin
 {$ifdef UseAnsiString}
-              { here there is allways the damn #0 problem !! }
               s1:=strpnew(char(byte(p^.left^.value)));
               l1:=1;
               s2:=getpcharcopy(p^.right);
@@ -368,10 +366,7 @@ implementation
               p:=t;
               exit;
            end;
-{$ifdef UseAnsiString}
-         ansistringdispose(s1,l1);
-         ansistringdispose(s2,l2);
-{$else UseAnsiString}
+{$ifndef UseAnsiString}
          dispose(s1);
          dispose(s2);
 {$endif UseAnsiString}
@@ -971,7 +966,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.9  1998-10-25 23:32:04  peter
+  Revision 1.10  1998-11-04 10:11:46  peter
+    * ansistring fixes
+
+  Revision 1.9  1998/10/25 23:32:04  peter
     * fixed u32bit - s32bit conversion problems
 
   Revision 1.8  1998/10/22 12:12:28  pierre