mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-14 10:20:21 +02:00
* ansistring fixes
This commit is contained in:
peter
parent
63d4c1f2a1
commit
de4cf49059
@ -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
|
||||
|
||||
|
||||
@ -269,12 +269,10 @@ unit cobjects;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
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;
|
||||
|
||||
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user