paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-07 17:30:00 +01:00
Code Issues Packages Projects Releases Wiki Activity

* ansistring fixes

Browse Source
This commit is contained in:
peter 1998-11-04 10:11:36 +00:00
parent 63d4c1f2a1
commit de4cf49059
8 changed files with 128 additions and 97 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
compiler/cg386con.pas
View File

@ -226,19 +226,27 @@ implementation
consts^.concat(new(pai_label,init(l1))); consts^.concat(new(pai_label,init(l1)));
getmem(pc,p^.length+1); getmem(pc,p^.length+1);
move(p^.value_str^,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 } { to overcome this problem we set the length explicitly }
{ with the ending null char } { 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;
end; end;
st_shortstring: st_shortstring:
begin begin
getmem(pc,p^.length+3); { empty strings }
move(p^.value_str^,pc[1],p^.length+1); if p^.length=0 then
pc[0]:=chr(p^.length); consts^.concat(new(pai_const,init_16bit(0)))
{ to overcome this problem we set the length explicitly } else
{ with the ending null char } begin
consts^.concat(new(pai_string,init_length_pchar(pc,p^.length+2))); { 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;
end; end;
{$endif UseAnsiString} {$endif UseAnsiString}
@ -317,7 +325,10 @@ implementation
end. end.
{ {
$Log$ $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 + pass_2 for cg386
* Message() -> CGMessage() for pass_1/pass_2 * Message() -> CGMessage() for pass_1/pass_2

28
compiler/cobjects.pas
View File

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

45
compiler/hcodegen.pas
View File

@ -354,46 +354,18 @@ implementation
end; 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); procedure generate_pascii(a : paasmoutput;hs : pchar;length : longint);
var
real_end,current_begin,current_end : pchar;
c :char;
begin begin
if assigned(hs) then if assigned(hs) then
begin a^.concat(new(pai_string,init_length_pchar(hs,length)));
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;
end; end;
constructor ttemptodestroy.init(const a : treference;p : pdef);
{*****************************************************************************
TTempToDestroy
*****************************************************************************}
constructor ttemptodestroy.init(const a : treference;p : pdef);
begin begin
inherited init; inherited init;
address:=a; address:=a;
@ -404,7 +376,10 @@ end.
{ {
$Log$ $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 + partial disposing of temp. ansistrings
Revision 1.19 1998/10/26 22:58:18 florian Revision 1.19 1998/10/26 22:58:18 florian

9
compiler/pexpr.pas
View File

@ -1890,9 +1890,7 @@ unit pexpr;
do_firstpass(p); do_firstpass(p);
if p^.treetype<>stringconstn then if p^.treetype<>stringconstn then
begin begin
if (p^.treetype=ordconstn) and if (p^.treetype=ordconstn) and is_char(p^.resulttype) then
(p^.resulttype^.deftype=orddef) and
(Porddef(p^.resulttype)^.typ=uchar) then
get_stringconst:=char(p^.value) get_stringconst:=char(p^.value)
else else
Message(cg_e_illegal_expression); Message(cg_e_illegal_expression);
@ -1909,7 +1907,10 @@ unit pexpr;
end. end.
{ {
$Log$ $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 * fixed filedef for typenodetype
Revision 1.70 1998/10/21 15:12:54 pierre Revision 1.70 1998/10/21 15:12:54 pierre

5
compiler/ppheap.pas
View File

@ -35,7 +35,10 @@ unit ppheap;
begin begin
longint(p^):=aktfilepos.line; longint(p^):=aktfilepos.line;
plongint(cardinal(p)+4)^:=aktfilepos.column; 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; end;
begin begin

11
compiler/psystem.pas
View File

@ -90,6 +90,9 @@ begin
p^.insert(new(ptypesym,init('cs32fixed',s32fixeddef))); p^.insert(new(ptypesym,init('cs32fixed',s32fixeddef)));
p^.insert(new(ptypesym,init('byte',u8bitdef))); p^.insert(new(ptypesym,init('byte',u8bitdef)));
p^.insert(new(ptypesym,init('string',cstringdef))); 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('longstring',clongstringdef)));
p^.insert(new(ptypesym,init('ansistring',cansistringdef))); p^.insert(new(ptypesym,init('ansistring',cansistringdef)));
p^.insert(new(ptypesym,init('widestring',cwidestringdef))); 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('SINGLE',new(pfloatdef,init(s32real)))));
p^.insert(new(ptypesym,init('POINTER',new(ppointerdef,init(voiddef))))); p^.insert(new(ptypesym,init('POINTER',new(ppointerdef,init(voiddef)))));
p^.insert(new(ptypesym,init('STRING',cstringdef))); 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('LONGSTRING',clongstringdef)));
p^.insert(new(ptypesym,init('ANSISTRING',cansistringdef))); p^.insert(new(ptypesym,init('ANSISTRING',cansistringdef)));
p^.insert(new(ptypesym,init('WIDESTRING',cwidestringdef))); p^.insert(new(ptypesym,init('WIDESTRING',cwidestringdef)));
@ -235,7 +241,10 @@ end;
end. end.
{ {
$Log$ $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 + assert() support
Revision 1.6 1998/09/24 23:49:17 peter Revision 1.6 1998/09/24 23:49:17 peter

64
compiler/ptconst.pas
View File

@ -54,6 +54,9 @@ unit ptconst;
{$ifdef m68k} {$ifdef m68k}
j : longint; j : longint;
{$endif m68k} {$endif m68k}
{$ifdef useansistring}
len : longint;
{$endif}
p,hp : ptree; p,hp : ptree;
i,l,offset, i,l,offset,
strlength : longint; strlength : longint;
@ -317,7 +320,10 @@ unit ptconst;
strlength:=p^.length; strlength:=p^.length;
datasegment^.concat(new(pai_const,init_8bit(strlength))); datasegment^.concat(new(pai_const,init_8bit(strlength)));
{ this can also handle longer strings } { 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} {$else UseAnsiString}
if length(p^.value_str^)>=def^.size then if length(p^.value_str^)>=def^.size then
begin begin
@ -341,12 +347,12 @@ unit ptconst;
if def^.size>strlength then if def^.size>strlength then
begin begin
getmem(ca,def^.size-strlength); 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,' '); fillchar(ca[0],def^.size-strlength-1,' ');
ca[def^.size-strlength-1]:=#0; ca[def^.size-strlength-1]:=#0;
{$ifdef UseAnsiString} {$ifdef UseAnsiString}
{ this can also handle longer strings } { 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); generate_pascii(datasegment,ca,def^.size-strlength-1);
{$else UseAnsiString} {$else UseAnsiString}
datasegment^.concat(new(pai_string,init_pchar(ca))); datasegment^.concat(new(pai_string,init_pchar(ca)));
@ -356,19 +362,24 @@ unit ptconst;
{$ifdef UseLongString} {$ifdef UseLongString}
st_longstring: st_longstring:
begin begin
if is_constcharnode(p) then
strlength:=1
else
strlength:=p^.length;
{ first write the maximum size } { first write the maximum size }
datasegment^.concat(new(pai_const,init_32bit(p^.length))))); datasegment^.concat(new(pai_const,init_32bit(strlength)))));
{ fill byte } { fill byte }
datasegment^.concat(new(pai_const,init_8bit(0))); datasegment^.concat(new(pai_const,init_8bit(0)));
if p^.treetype=stringconstn then if p^.treetype=stringconstn then
begin begin
{ this can also handle longer strings } getmem(ca,strlength+1);
generate_pascii(consts,p^.value_str,p^.length); move(p^.value_str^,ca^,strlength);
ca[strlength]:=#0;
generate_pascii(consts,ca,strlength);
end end
else if is_constcharnode(p) then else if is_constcharnode(p) then
begin begin
consts^.concat(new(pai_const,init_8bit(p^.value))); consts^.concat(new(pai_const,init_8bit(p^.value)));
strlength:=1;
end end
else Message(cg_e_illegal_expression); else Message(cg_e_illegal_expression);
datasegment^.concat(new(pai_const,init_8bit(0))); datasegment^.concat(new(pai_const,init_8bit(0)));
@ -382,12 +393,16 @@ unit ptconst;
datasegment^.concat(new(pai_const,init_32bit(0))) datasegment^.concat(new(pai_const,init_32bit(0)))
else else
begin begin
if is_constcharnode(p) then
strlength:=1
else
strlength:=p^.length;
getdatalabel(ll); getdatalabel(ll);
datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(ll))))); datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(ll)))));
{ first write the maximum size } { 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 } { 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) } { redondent with maxlength but who knows ... (PM) }
{ third write use count (set to -1 for safety ) } { third write use count (set to -1 for safety ) }
consts^.concat(new(pai_const,init_32bit(-1))); consts^.concat(new(pai_const,init_32bit(-1)));
@ -398,13 +413,14 @@ unit ptconst;
consts^.concat(new(pai_label,init(ll))); consts^.concat(new(pai_label,init(ll)));
if p^.treetype=stringconstn then if p^.treetype=stringconstn then
begin begin
{ this can also handle longer strings } getmem(ca,strlength+1);
generate_pascii(consts,p^.value_str,p^.length); move(p^.value_str^,ca^,strlength);
ca[strlength]:=#0;
generate_pascii(consts,ca,strlength);
end end
else if is_constcharnode(p) then else if is_constcharnode(p) then
begin begin
consts^.concat(new(pai_const,init_8bit(p^.value))); consts^.concat(new(pai_const,init_8bit(p^.value)));
strlength:=1;
end end
else Message(cg_e_illegal_expression); else Message(cg_e_illegal_expression);
consts^.concat(new(pai_const,init_8bit(0))); consts^.concat(new(pai_const,init_8bit(0)));
@ -432,10 +448,23 @@ unit ptconst;
p:=comp_expr(true); p:=comp_expr(true);
do_firstpass(p); do_firstpass(p);
if p^.treetype=stringconstn then 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^ s:=p^.value_str^
else if is_constcharnode(p) then {$endif}
s:=char(byte(p^.value)) end
else Message(cg_e_illegal_expression); else
if is_constcharnode(p) then
s:=char(byte(p^.value))
else
Message(cg_e_illegal_expression);
disposetree(p); disposetree(p);
l:=length(s); l:=length(s);
for i:=Parraydef(def)^.lowrange to Parraydef(def)^.highrange do for i:=Parraydef(def)^.lowrange to Parraydef(def)^.highrange do
@ -620,7 +649,10 @@ unit ptconst;
end. end.
{ {
$Log$ $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 * several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location; => never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default + finally I added now by default

20
compiler/tcadd.pas
View File

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