diff --git a/compiler/cg386con.pas b/compiler/cg386con.pas
index 0e2fa05faf..e9bbea08b1 100644
--- a/compiler/cg386con.pas
+++ b/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
diff --git a/compiler/cobjects.pas b/compiler/cobjects.pas
index 67aee6acf3..f85f2557bd 100644
--- a/compiler/cobjects.pas
+++ b/compiler/cobjects.pas
@@ -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
diff --git a/compiler/hcodegen.pas b/compiler/hcodegen.pas
index afcca30f76..3e173baa9e 100644
--- a/compiler/hcodegen.pas
+++ b/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
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index 7072c05f4c..91ad36c800 100644
--- a/compiler/pexpr.pas
+++ b/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
diff --git a/compiler/ppheap.pas b/compiler/ppheap.pas
index c33a655c32..81610cb933 100644
--- a/compiler/ppheap.pas
+++ b/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.
-
+
diff --git a/compiler/psystem.pas b/compiler/psystem.pas
index c95c2c8caf..e345c2d561 100644
--- a/compiler/psystem.pas
+++ b/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
diff --git a/compiler/ptconst.pas b/compiler/ptconst.pas
index 85a5592d1e..a561cf56df 100644
--- a/compiler/ptconst.pas
+++ b/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
diff --git a/compiler/tcadd.pas b/compiler/tcadd.pas
index 5eec94d7ee..0baacd7d80 100644
--- a/compiler/tcadd.pas
+++ b/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