mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2026-01-06 02:50:44 +01:00
* Prepare compiler infrastructure for multiple ansistring types
This commit is contained in:
daniel
parent
53ec165e68
commit
b721e5872c
@ -1535,7 +1535,20 @@ implementation
|
||||
if is_interfacecom(t) then
|
||||
incrfunc:='FPC_INTF_INCR_REF'
|
||||
else if is_ansistring(t) then
|
||||
incrfunc:='FPC_ANSISTR_INCR_REF'
|
||||
{$ifdef ansistring_bits}
|
||||
begin
|
||||
case Tstringdef(t).string_typ of
|
||||
st_ansistring16:
|
||||
incrfunc:='FPC_ANSISTR16_INCR_REF';
|
||||
st_ansistring32:
|
||||
incrfunc:='FPC_ANSISTR32_INCR_REF';
|
||||
st_ansistring64:
|
||||
incrfunc:='FPC_ANSISTR64_INCR_REF';
|
||||
end;
|
||||
end
|
||||
{$else}
|
||||
incrfunc:='FPC_ANSISTR_INCR_REF'
|
||||
{$endif}
|
||||
else if is_widestring(t) then
|
||||
incrfunc:='FPC_WIDESTR_INCR_REF'
|
||||
else if is_dynamic_array(t) then
|
||||
@ -1586,7 +1599,20 @@ implementation
|
||||
if is_interfacecom(t) then
|
||||
decrfunc:='FPC_INTF_DECR_REF'
|
||||
else if is_ansistring(t) then
|
||||
decrfunc:='FPC_ANSISTR_DECR_REF'
|
||||
{$ifdef ansistring_bits}
|
||||
begin
|
||||
case Tstringdef(t).string_typ of
|
||||
st_ansistring16:
|
||||
decrfunc:='FPC_ANSISTR16_DECR_REF';
|
||||
st_ansistring32:
|
||||
decrfunc:='FPC_ANSISTR32_DECR_REF';
|
||||
st_ansistring64:
|
||||
decrfunc:='FPC_ANSISTR64_DECR_REF';
|
||||
end;
|
||||
end
|
||||
{$else}
|
||||
decrfunc:='FPC_ANSISTR_DECR_REF'
|
||||
{$endif}
|
||||
else if is_widestring(t) then
|
||||
decrfunc:='FPC_WIDESTR_DECR_REF'
|
||||
else if is_dynamic_array(t) then
|
||||
@ -2111,7 +2137,10 @@ finalization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.162 2004-04-18 07:52:43 florian
|
||||
Revision 1.163 2004-04-29 19:56:36 daniel
|
||||
* Prepare compiler infrastructure for multiple ansistring types
|
||||
|
||||
Revision 1.162 2004/04/18 07:52:43 florian
|
||||
* fixed web bug 3048: comparision of dyn. arrays
|
||||
|
||||
Revision 1.161 2004/03/06 20:35:19 florian
|
||||
|
||||
@ -506,13 +506,21 @@ implementation
|
||||
);
|
||||
end;
|
||||
|
||||
{$ifdef ansistring_bits}
|
||||
{ true if p is an ansi string def }
|
||||
function is_ansistring(p : tdef) : boolean;
|
||||
begin
|
||||
is_ansistring:=(p.deftype=stringdef) and
|
||||
(tstringdef(p).string_typ in [st_ansistring16,st_ansistring32,st_ansistring64]);
|
||||
end;
|
||||
{$else}
|
||||
{ true if p is an ansi string def }
|
||||
function is_ansistring(p : tdef) : boolean;
|
||||
begin
|
||||
is_ansistring:=(p.deftype=stringdef) and
|
||||
(tstringdef(p).string_typ=st_ansistring);
|
||||
end;
|
||||
|
||||
{$endif}
|
||||
|
||||
{ true if p is an long string def }
|
||||
function is_longstring(p : tdef) : boolean;
|
||||
@ -886,7 +894,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.12 2004-03-29 14:44:10 peter
|
||||
Revision 1.13 2004-04-29 19:56:36 daniel
|
||||
* Prepare compiler infrastructure for multiple ansistring types
|
||||
|
||||
Revision 1.12 2004/03/29 14:44:10 peter
|
||||
* fixes to previous constant integer commit
|
||||
|
||||
Revision 1.11 2004/03/23 22:34:49 peter
|
||||
|
||||
@ -193,6 +193,9 @@ interface
|
||||
Initsetalloc, {0=fixed, 1 =var}
|
||||
{$ENDIF}
|
||||
initpackenum : shortint;
|
||||
{$ifdef ansistring_bits}
|
||||
initansistring_bits: Tstringbits;
|
||||
{$endif}
|
||||
initalignment : talignmentinfo;
|
||||
initoptprocessor,
|
||||
initspecificoptprocessor : tprocessors;
|
||||
@ -215,6 +218,9 @@ interface
|
||||
{$ENDIF}
|
||||
aktpackrecords,
|
||||
aktpackenum : longint;
|
||||
{$ifdef ansistring_bits}
|
||||
aktansistring_bits : Tstringbits;
|
||||
{$endif}
|
||||
aktmaxfpuregisters : longint;
|
||||
aktalignment : talignmentinfo;
|
||||
aktoptprocessor,
|
||||
@ -1897,7 +1903,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.127 2004-04-28 15:19:03 florian
|
||||
Revision 1.128 2004-04-29 19:56:36 daniel
|
||||
* Prepare compiler infrastructure for multiple ansistring types
|
||||
|
||||
Revision 1.127 2004/04/28 15:19:03 florian
|
||||
+ syscall directive support for MorphOS added
|
||||
|
||||
Revision 1.126 2004/03/14 20:08:37 peter
|
||||
|
||||
@ -167,6 +167,9 @@ interface
|
||||
);
|
||||
tproccalloptions = set of tproccalloption;
|
||||
|
||||
{$ifdef ansistring_bits}
|
||||
Tstringbits=(sb_16,sb_32,sb_64);
|
||||
{$endif}
|
||||
|
||||
const
|
||||
proccalloptionStr : array[tproccalloption] of string[14]=('',
|
||||
@ -239,7 +242,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.52 2004-04-28 15:19:03 florian
|
||||
Revision 1.53 2004-04-29 19:56:36 daniel
|
||||
* Prepare compiler infrastructure for multiple ansistring types
|
||||
|
||||
Revision 1.52 2004/04/28 15:19:03 florian
|
||||
+ syscall directive support for MorphOS added
|
||||
|
||||
Revision 1.51 2004/04/04 18:46:09 olle
|
||||
|
||||
@ -1005,9 +1005,35 @@ implementation
|
||||
else if is_ansistring(rd) or is_ansistring(ld) then
|
||||
begin
|
||||
if not(is_ansistring(rd)) then
|
||||
inserttypeconv(right,cansistringtype);
|
||||
begin
|
||||
{$ifdef ansistring_bits}
|
||||
case Tstringdef(ld).string_typ of
|
||||
st_ansistring16:
|
||||
inserttypeconv(right,cansistringtype16);
|
||||
st_ansistring32:
|
||||
inserttypeconv(right,cansistringtype32);
|
||||
st_ansistring64:
|
||||
inserttypeconv(right,cansistringtype64);
|
||||
end;
|
||||
{$else}
|
||||
inserttypeconv(right,cansistringtype);
|
||||
{$endif}
|
||||
end;
|
||||
if not(is_ansistring(ld)) then
|
||||
inserttypeconv(left,cansistringtype);
|
||||
begin
|
||||
{$ifdef ansistring_bits}
|
||||
case Tstringdef(rd).string_typ of
|
||||
st_ansistring16:
|
||||
inserttypeconv(left,cansistringtype16);
|
||||
st_ansistring32:
|
||||
inserttypeconv(left,cansistringtype32);
|
||||
st_ansistring64:
|
||||
inserttypeconv(left,cansistringtype64);
|
||||
end;
|
||||
{$else}
|
||||
inserttypeconv(left,cansistringtype);
|
||||
{$endif}
|
||||
end;
|
||||
end
|
||||
else if is_longstring(rd) or is_longstring(ld) then
|
||||
begin
|
||||
@ -1926,7 +1952,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.116 2004-04-18 07:52:43 florian
|
||||
Revision 1.117 2004-04-29 19:56:37 daniel
|
||||
* Prepare compiler infrastructure for multiple ansistring types
|
||||
|
||||
Revision 1.116 2004/04/18 07:52:43 florian
|
||||
* fixed web bug 3048: comparision of dyn. arrays
|
||||
|
||||
Revision 1.115 2004/03/29 14:44:10 peter
|
||||
|
||||
@ -126,7 +126,11 @@ interface
|
||||
location.register:=cg.getaddressregister(exprasmlist);
|
||||
cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,location.register);
|
||||
end;
|
||||
{$ifdef ansistring_bits}
|
||||
st_ansistring16,st_ansistring32,st_ansistring64 :
|
||||
{$else}
|
||||
st_ansistring :
|
||||
{$endif}
|
||||
begin
|
||||
if (left.nodetype=stringconstn) and
|
||||
(str_length(left)=0) then
|
||||
@ -535,7 +539,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.56 2004-03-02 00:36:33 olle
|
||||
Revision 1.57 2004-04-29 19:56:37 daniel
|
||||
* Prepare compiler infrastructure for multiple ansistring types
|
||||
|
||||
Revision 1.56 2004/03/02 00:36:33 olle
|
||||
* big transformation of Tai_[const_]Symbol.Create[data]name*
|
||||
|
||||
Revision 1.55 2004/02/27 10:21:05 florian
|
||||
|
||||
@ -222,8 +222,11 @@ implementation
|
||||
i,mylength : longint;
|
||||
begin
|
||||
{ for empty ansistrings we could return a constant 0 }
|
||||
if (st_type in [st_ansistring,st_widestring]) and
|
||||
(len=0) then
|
||||
{$ifdef ansistring_bits}
|
||||
if (st_type in [st_ansistring16,st_ansistring32,st_ansistring64,st_widestring]) and (len=0) then
|
||||
{$else}
|
||||
if (st_type in [st_ansistring,st_widestring]) and (len=0) then
|
||||
{$endif}
|
||||
begin
|
||||
location_reset(location,LOC_CONSTANT,OS_ADDR);
|
||||
location.value:=0;
|
||||
@ -282,7 +285,55 @@ implementation
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
{$ifdef ansistring_bits}
|
||||
st_ansistring16:
|
||||
begin
|
||||
{ before the string the following sequence must be found:
|
||||
<label>
|
||||
constsymbol <datalabel>
|
||||
const32 <len>
|
||||
const32 <len>
|
||||
const32 -1
|
||||
we must then return <label> to reuse
|
||||
}
|
||||
hp2:=tai(lastlabelhp.previous);
|
||||
if assigned(hp2) and
|
||||
(hp2.typ=ait_const_16bit) and
|
||||
(tai_const(hp2).value=aword(-1)) and
|
||||
assigned(hp2.previous) and
|
||||
(tai(hp2.previous).typ=ait_const_16bit) and
|
||||
(tai_const(hp2.previous).value=len) and
|
||||
assigned(hp2.previous.previous) and
|
||||
(tai(hp2.previous.previous).typ=ait_const_16bit) and
|
||||
(tai_const(hp2.previous.previous).value=len) and
|
||||
assigned(hp2.previous.previous.previous) and
|
||||
(tai(hp2.previous.previous.previous).typ=ait_const_symbol) and
|
||||
assigned(hp2.previous.previous.previous.previous) and
|
||||
(tai(hp2.previous.previous.previous.previous).typ=ait_label) then
|
||||
begin
|
||||
lastlabel:=tai_label(hp2.previous.previous.previous.previous).l;
|
||||
same_string:=true;
|
||||
j:=0;
|
||||
if len>0 then
|
||||
begin
|
||||
for i:=0 to len-1 do
|
||||
begin
|
||||
if tai_string(hp1).str[j]<>value_str[i] then
|
||||
begin
|
||||
same_string:=false;
|
||||
break;
|
||||
end;
|
||||
inc(j);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
{$endif}
|
||||
{$ifdef ansistring_bits}
|
||||
st_ansistring32,
|
||||
{$else}
|
||||
st_ansistring,
|
||||
{$endif}
|
||||
st_widestring :
|
||||
begin
|
||||
{ before the string the following sequence must be found:
|
||||
@ -325,6 +376,50 @@ implementation
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
{$ifdef ansistring_bits}
|
||||
st_ansistring64:
|
||||
begin
|
||||
{ before the string the following sequence must be found:
|
||||
<label>
|
||||
constsymbol <datalabel>
|
||||
const32 <len>
|
||||
const32 <len>
|
||||
const32 -1
|
||||
we must then return <label> to reuse
|
||||
}
|
||||
hp2:=tai(lastlabelhp.previous);
|
||||
if assigned(hp2) and
|
||||
(hp2.typ=ait_const_64bit) and
|
||||
(tai_const(hp2).value=aword(-1)) and
|
||||
assigned(hp2.previous) and
|
||||
(tai(hp2.previous).typ=ait_const_64bit) and
|
||||
(tai_const(hp2.previous).value=len) and
|
||||
assigned(hp2.previous.previous) and
|
||||
(tai(hp2.previous.previous).typ=ait_const_64bit) and
|
||||
(tai_const(hp2.previous.previous).value=len) and
|
||||
assigned(hp2.previous.previous.previous) and
|
||||
(tai(hp2.previous.previous.previous).typ=ait_const_symbol) and
|
||||
assigned(hp2.previous.previous.previous.previous) and
|
||||
(tai(hp2.previous.previous.previous.previous).typ=ait_label) then
|
||||
begin
|
||||
lastlabel:=tai_label(hp2.previous.previous.previous.previous).l;
|
||||
same_string:=true;
|
||||
j:=0;
|
||||
if len>0 then
|
||||
begin
|
||||
for i:=0 to len-1 do
|
||||
begin
|
||||
if tai_string(hp1).str[j]<>value_str[i] then
|
||||
begin
|
||||
same_string:=false;
|
||||
break;
|
||||
end;
|
||||
inc(j);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
{$endif}
|
||||
end;
|
||||
{ found ? }
|
||||
if same_string then
|
||||
@ -349,7 +444,8 @@ implementation
|
||||
Consts.concat(Tai_label.Create(lastlabel));
|
||||
{ generate an ansi string ? }
|
||||
case st_type of
|
||||
st_ansistring:
|
||||
{$ifdef ansistring_bits}
|
||||
st_ansistring16:
|
||||
begin
|
||||
{ an empty ansi string is nil! }
|
||||
if len=0 then
|
||||
@ -374,6 +470,59 @@ implementation
|
||||
lab_str:=l2;
|
||||
end;
|
||||
end;
|
||||
{$endif}
|
||||
{$ifdef ansistring_bits}st_ansistring32:{$else}st_ansistring:{$endif}
|
||||
begin
|
||||
{ an empty ansi string is nil! }
|
||||
if len=0 then
|
||||
Consts.concat(Tai_const.Create_ptr(0))
|
||||
else
|
||||
begin
|
||||
objectlibrary.getdatalabel(l1);
|
||||
objectlibrary.getdatalabel(l2);
|
||||
Consts.concat(Tai_label.Create(l2));
|
||||
Consts.concat(Tai_const_symbol.Create(l1));
|
||||
Consts.concat(Tai_const.Create_32bit(len));
|
||||
Consts.concat(Tai_const.Create_32bit(len));
|
||||
Consts.concat(Tai_const.Create_32bit(Cardinal(-1)));
|
||||
Consts.concat(Tai_label.Create(l1));
|
||||
getmem(pc,len+2);
|
||||
move(value_str^,pc^,len);
|
||||
pc[len]:=#0;
|
||||
{ to overcome this problem we set the length explicitly }
|
||||
{ with the ending null char }
|
||||
Consts.concat(Tai_string.Create_length_pchar(pc,len+1));
|
||||
{ return the offset of the real string }
|
||||
lab_str:=l2;
|
||||
end;
|
||||
end;
|
||||
{$ifdef ansistring_bits}
|
||||
st_ansistring64:
|
||||
begin
|
||||
{ an empty ansi string is nil! }
|
||||
if len=0 then
|
||||
Consts.concat(Tai_const.Create_ptr(0))
|
||||
else
|
||||
begin
|
||||
objectlibrary.getdatalabel(l1);
|
||||
objectlibrary.getdatalabel(l2);
|
||||
Consts.concat(Tai_label.Create(l2));
|
||||
Consts.concat(Tai_const_symbol.Create(l1));
|
||||
Consts.concat(Tai_const.Create_32bit(len));
|
||||
Consts.concat(Tai_const.Create_32bit(len));
|
||||
Consts.concat(Tai_const.Create_32bit(Cardinal(-1)));
|
||||
Consts.concat(Tai_label.Create(l1));
|
||||
getmem(pc,len+2);
|
||||
move(value_str^,pc^,len);
|
||||
pc[len]:=#0;
|
||||
{ to overcome this problem we set the length explicitly }
|
||||
{ with the ending null char }
|
||||
Consts.concat(Tai_string.Create_length_pchar(pc,len+1));
|
||||
{ return the offset of the real string }
|
||||
lab_str:=l2;
|
||||
end;
|
||||
end;
|
||||
{$endif}
|
||||
st_widestring:
|
||||
begin
|
||||
{ an empty wide string is nil! }
|
||||
@ -578,7 +727,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.39 2004-03-18 17:29:40 peter
|
||||
Revision 1.40 2004-04-29 19:56:37 daniel
|
||||
* Prepare compiler infrastructure for multiple ansistring types
|
||||
|
||||
Revision 1.39 2004/03/18 17:29:40 peter
|
||||
* fix overflow
|
||||
|
||||
Revision 1.38 2004/03/16 16:19:44 peter
|
||||
|
||||
@ -715,13 +715,15 @@ implementation
|
||||
vtClass = 8;
|
||||
vtWideChar = 9;
|
||||
vtPWideChar = 10;
|
||||
vtAnsiString = 11;
|
||||
vtAnsiString32 = 11;
|
||||
vtCurrency = 12;
|
||||
vtVariant = 13;
|
||||
vtInterface = 14;
|
||||
vtWideString = 15;
|
||||
vtInt64 = 16;
|
||||
vtQWord = 17;
|
||||
vtAnsiString16 = 18;
|
||||
vtAnsiString64 = 19;
|
||||
|
||||
procedure tcgarrayconstructornode.pass_2;
|
||||
var
|
||||
@ -835,10 +837,24 @@ implementation
|
||||
end
|
||||
else
|
||||
if is_ansistring(lt) then
|
||||
{$ifdef ansistring_bits}
|
||||
begin
|
||||
case Tstringdef(lt).string_typ of
|
||||
st_ansistring16:
|
||||
vtype:=vtAnsiString16;
|
||||
st_ansistring32:
|
||||
vtype:=vtAnsiString32;
|
||||
st_ansistring64:
|
||||
vtype:=vtAnsiString64;
|
||||
end;
|
||||
freetemp:=false;
|
||||
end
|
||||
{$else}
|
||||
begin
|
||||
vtype:=vtAnsiString;
|
||||
freetemp:=false;
|
||||
end
|
||||
{$endif}
|
||||
else
|
||||
if is_widestring(lt) then
|
||||
begin
|
||||
@ -926,7 +942,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.114 2004-03-02 17:32:12 florian
|
||||
Revision 1.115 2004-04-29 19:56:37 daniel
|
||||
* Prepare compiler infrastructure for multiple ansistring types
|
||||
|
||||
Revision 1.114 2004/03/02 17:32:12 florian
|
||||
* make cycle fixed
|
||||
+ pic support for darwin
|
||||
+ support of importing vars from shared libs on darwin implemented
|
||||
|
||||
@ -604,6 +604,7 @@ implementation
|
||||
if nf_callunique in flags then
|
||||
internalerror(200304236);
|
||||
|
||||
{DM!!!!!}
|
||||
case left.location.loc of
|
||||
LOC_REGISTER,
|
||||
LOC_CREGISTER :
|
||||
@ -700,7 +701,11 @@ implementation
|
||||
case tstringdef(left.resulttype.def).string_typ of
|
||||
{ it's the same for ansi- and wide strings }
|
||||
st_widestring,
|
||||
{$ifdef ansistring_bits}
|
||||
st_ansistring16,st_ansistring32,st_ansistring64:
|
||||
{$else}
|
||||
st_ansistring:
|
||||
{$endif}
|
||||
begin
|
||||
paraloc1:=paramanager.getintparaloc(pocall_default,1);
|
||||
paraloc2:=paramanager.getintparaloc(pocall_default,2);
|
||||
@ -834,7 +839,11 @@ implementation
|
||||
case tstringdef(left.resulttype.def).string_typ of
|
||||
{ it's the same for ansi- and wide strings }
|
||||
st_widestring,
|
||||
{$ifdef ansistring_bits}
|
||||
st_ansistring16,st_ansistring32,st_ansistring64:
|
||||
{$else}
|
||||
st_ansistring:
|
||||
{$endif}
|
||||
begin
|
||||
paraloc1:=paramanager.getintparaloc(pocall_default,1);
|
||||
paraloc2:=paramanager.getintparaloc(pocall_default,2);
|
||||
@ -882,7 +891,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.90 2004-04-21 17:39:40 jonas
|
||||
Revision 1.91 2004-04-29 19:56:37 daniel
|
||||
* Prepare compiler infrastructure for multiple ansistring types
|
||||
|
||||
Revision 1.90 2004/04/21 17:39:40 jonas
|
||||
- disabled with-symtable debugging code since it was broken and
|
||||
at the same time confused the register allocator and therefore also
|
||||
the optimizer. May be fixed in the future using dwarf support
|
||||
|
||||
@ -632,8 +632,14 @@ implementation
|
||||
if left.nodetype=stringconstn then
|
||||
begin
|
||||
{ convert ascii 2 unicode }
|
||||
{$ifdef ansistring_bits}
|
||||
if (tstringdef(resulttype.def).string_typ=st_widestring) and
|
||||
(tstringconstnode(left).st_type in [st_ansistring16,st_ansistring32,
|
||||
st_ansistring64,st_shortstring,st_longstring]) then
|
||||
{$else}
|
||||
if (tstringdef(resulttype.def).string_typ=st_widestring) and
|
||||
(tstringconstnode(left).st_type in [st_ansistring,st_shortstring,st_longstring]) then
|
||||
{$endif}
|
||||
begin
|
||||
initwidestring(pw);
|
||||
ascii2unicode(tstringconstnode(left).value_str,tstringconstnode(left).len,pw);
|
||||
@ -642,8 +648,14 @@ implementation
|
||||
end
|
||||
else
|
||||
{ convert unicode 2 ascii }
|
||||
{$ifdef ansistring_bits}
|
||||
if (tstringconstnode(left).st_type=st_widestring) and
|
||||
(tstringdef(resulttype.def).string_typ in [st_ansistring16,st_ansistring32,
|
||||
st_ansistring64,st_shortstring,st_longstring]) then
|
||||
{$else}
|
||||
if (tstringconstnode(left).st_type=st_widestring) and
|
||||
(tstringdef(resulttype.def).string_typ in [st_ansistring,st_shortstring,st_longstring]) then
|
||||
{$endif}
|
||||
begin
|
||||
pw:=pcompilerwidestring(tstringconstnode(left).value_str);
|
||||
getmem(pc,getlengthwidestring(pw)+1);
|
||||
@ -2402,7 +2414,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.143 2004-03-23 22:34:49 peter
|
||||
Revision 1.144 2004-04-29 19:56:37 daniel
|
||||
* Prepare compiler infrastructure for multiple ansistring types
|
||||
|
||||
Revision 1.143 2004/03/23 22:34:49 peter
|
||||
* constants ordinals now always have a type assigned
|
||||
* integer constants have the smallest type, unsigned prefered over
|
||||
signed
|
||||
|
||||
@ -599,7 +599,18 @@ implementation
|
||||
if st=st_default then
|
||||
begin
|
||||
if cs_ansistrings in aktlocalswitches then
|
||||
{$ifdef ansistring_bits}
|
||||
case aktansistring_bits of
|
||||
sb_16:
|
||||
st_type:=st_ansistring16;
|
||||
sb_32:
|
||||
st_type:=st_ansistring32;
|
||||
sb_64:
|
||||
st_type:=st_ansistring64;
|
||||
end
|
||||
{$else}
|
||||
st_type:=st_ansistring
|
||||
{$endif}
|
||||
else
|
||||
st_type:=st_shortstring;
|
||||
end
|
||||
@ -626,7 +637,18 @@ implementation
|
||||
value_str:=s;
|
||||
if (cs_ansistrings in aktlocalswitches) or
|
||||
(len>255) then
|
||||
st_type:=st_ansistring
|
||||
{$ifdef ansistring_bits}
|
||||
case aktansistring_bits of
|
||||
sb_16:
|
||||
st_type:=st_ansistring16;
|
||||
sb_32:
|
||||
st_type:=st_ansistring32;
|
||||
sb_64:
|
||||
st_type:=st_ansistring64;
|
||||
end
|
||||
{$else}
|
||||
st_type:=st_ansistring
|
||||
{$endif}
|
||||
else
|
||||
st_type:=st_shortstring;
|
||||
lab_str:=nil;
|
||||
@ -704,8 +726,17 @@ implementation
|
||||
case st_type of
|
||||
st_shortstring :
|
||||
resulttype:=cshortstringtype;
|
||||
{$ifdef ansistring_bits}
|
||||
st_ansistring16:
|
||||
resulttype:=cansistringtype16;
|
||||
st_ansistring32:
|
||||
resulttype:=cansistringtype32;
|
||||
st_ansistring64:
|
||||
resulttype:=cansistringtype64;
|
||||
{$else}
|
||||
st_ansistring :
|
||||
resulttype:=cansistringtype;
|
||||
{$endif}
|
||||
st_widestring :
|
||||
resulttype:=cwidestringtype;
|
||||
st_longstring :
|
||||
@ -716,7 +747,11 @@ implementation
|
||||
function tstringconstnode.pass_1 : tnode;
|
||||
begin
|
||||
result:=nil;
|
||||
{$ifdef ansistring_bits}
|
||||
if (st_type in [st_ansistring16,st_ansistring32,st_ansistring64,st_widestring]) and
|
||||
{$else}
|
||||
if (st_type in [st_ansistring,st_widestring]) and
|
||||
{$endif}
|
||||
(len=0) then
|
||||
expectloc:=LOC_CONSTANT
|
||||
else
|
||||
@ -934,7 +969,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.60 2004-03-23 22:34:49 peter
|
||||
Revision 1.61 2004-04-29 19:56:37 daniel
|
||||
* Prepare compiler infrastructure for multiple ansistring types
|
||||
|
||||
Revision 1.60 2004/03/23 22:34:49 peter
|
||||
* constants ordinals now always have a type assigned
|
||||
* integer constants have the smallest type, unsigned prefered over
|
||||
signed
|
||||
|
||||
@ -236,7 +236,20 @@ implementation
|
||||
constsym:
|
||||
begin
|
||||
if tconstsym(symtableentry).consttyp=constresourcestring then
|
||||
resulttype:=cansistringtype
|
||||
begin
|
||||
{$ifdef ansistring_bits}
|
||||
case aktansistring_bits of
|
||||
sb_16:
|
||||
resulttype:=cansistringtype16;
|
||||
sb_32:
|
||||
resulttype:=cansistringtype32;
|
||||
sb_64:
|
||||
resulttype:=cansistringtype64;
|
||||
end;
|
||||
{$else}
|
||||
resulttype:=cansistringtype
|
||||
{$endif}
|
||||
end
|
||||
else
|
||||
internalerror(22799);
|
||||
end;
|
||||
@ -469,11 +482,11 @@ implementation
|
||||
hp:=ccallparanode.create(tbinarynode(right).right,
|
||||
ccallparanode.create(left,nil));
|
||||
if is_char(tbinarynode(right).right.resulttype.def) then
|
||||
result:=ccallnode.createintern('fpc_ansistr_append_char',hp)
|
||||
result:=ccallnode.createintern('fpc_'+Tstringdef(left.resulttype.def).stringtypname+'_append_char',hp)
|
||||
else if is_shortstring(tbinarynode(right).right.resulttype.def) then
|
||||
result:=ccallnode.createintern('fpc_ansistr_append_shortstring',hp)
|
||||
result:=ccallnode.createintern('fpc_'+Tstringdef(left.resulttype.def).stringtypname+'_append_shortstring',hp)
|
||||
else
|
||||
result:=ccallnode.createintern('fpc_ansistr_append_ansistring',hp);
|
||||
result:=ccallnode.createintern('fpc_'+Tstringdef(left.resulttype.def).stringtypname+'_append_ansistring',hp);
|
||||
tbinarynode(right).right:=nil;
|
||||
left:=nil;
|
||||
exit;
|
||||
@ -1124,7 +1137,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.125 2004-03-02 17:32:12 florian
|
||||
Revision 1.126 2004-04-29 19:56:37 daniel
|
||||
* Prepare compiler infrastructure for multiple ansistring types
|
||||
|
||||
Revision 1.125 2004/03/02 17:32:12 florian
|
||||
* make cycle fixed
|
||||
+ pic support for darwin
|
||||
+ support of importing vars from shared libs on darwin implemented
|
||||
|
||||
@ -727,7 +727,11 @@ implementation
|
||||
case tstringdef(left.resulttype.def).string_typ of
|
||||
st_widestring :
|
||||
resulttype:=cwidechartype;
|
||||
{$ifdef ansistring_bits}
|
||||
st_ansistring16,st_ansistring32,st_ansistring64 :
|
||||
{$else}
|
||||
st_ansistring :
|
||||
{$endif}
|
||||
resulttype:=cchartype;
|
||||
st_longstring :
|
||||
resulttype:=cchartype;
|
||||
@ -977,7 +981,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.82 2004-03-29 14:42:52 peter
|
||||
Revision 1.83 2004-04-29 19:56:37 daniel
|
||||
* Prepare compiler infrastructure for multiple ansistring types
|
||||
|
||||
Revision 1.82 2004/03/29 14:42:52 peter
|
||||
* variant array support
|
||||
|
||||
Revision 1.81 2004/03/18 16:19:03 peter
|
||||
|
||||
@ -142,7 +142,18 @@ implementation
|
||||
else
|
||||
begin
|
||||
if cs_ansistrings in aktlocalswitches then
|
||||
{$ifdef ansistring_bits}
|
||||
case aktansistring_bits of
|
||||
sb_16:
|
||||
t:=cansistringtype16;
|
||||
sb_32:
|
||||
t:=cansistringtype32;
|
||||
sb_64:
|
||||
t:=cansistringtype64;
|
||||
end
|
||||
{$else}
|
||||
t:=cansistringtype
|
||||
{$endif}
|
||||
else
|
||||
t:=cshortstringtype;
|
||||
end;
|
||||
@ -1341,7 +1352,18 @@ implementation
|
||||
begin
|
||||
p1:=cloadnode.create(srsym,srsymtable);
|
||||
do_resulttypepass(p1);
|
||||
{$ifdef ansistring_bits}
|
||||
case aktansistring_bits of
|
||||
sb_16:
|
||||
p1.resulttype:=cansistringtype16;
|
||||
sb_32:
|
||||
p1.resulttype:=cansistringtype32;
|
||||
sb_64:
|
||||
p1.resulttype:=cansistringtype64;
|
||||
end;
|
||||
{$else}
|
||||
p1.resulttype:=cansistringtype;
|
||||
{$endif}
|
||||
end;
|
||||
constguid :
|
||||
p1:=cguidconstnode.create(pguid(tconstsym(srsym).value.valueptr)^);
|
||||
@ -2399,7 +2421,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.153 2004-04-12 18:59:32 florian
|
||||
Revision 1.154 2004-04-29 19:56:37 daniel
|
||||
* Prepare compiler infrastructure for multiple ansistring types
|
||||
|
||||
Revision 1.153 2004/04/12 18:59:32 florian
|
||||
* small x86_64 fixes
|
||||
|
||||
Revision 1.152 2004/03/29 14:42:52 peter
|
||||
|
||||
@ -633,6 +633,7 @@ implementation
|
||||
paradef : tdef;
|
||||
counter : integer;
|
||||
newstatement : tstatementnode;
|
||||
mode : byte;
|
||||
begin
|
||||
{ for easy exiting if something goes wrong }
|
||||
result := cerrornode.create;
|
||||
@ -656,12 +657,40 @@ implementation
|
||||
ppn:=tcallparanode(ppn.right);
|
||||
end;
|
||||
paradef:=ppn.left.resulttype.def;
|
||||
{$ifdef ansistring_bits}
|
||||
if is_ansistring(paradef) then
|
||||
case Tstringdef(paradef).string_typ of
|
||||
st_ansistring16:
|
||||
mode:=16;
|
||||
st_ansistring32:
|
||||
mode:=32;
|
||||
st_ansistring64:
|
||||
mode:=64;
|
||||
end;
|
||||
if (is_chararray(paradef) and (paradef.size>255)) or
|
||||
((cs_ansistrings in aktlocalswitches) and is_pchar(paradef)) then
|
||||
case aktansistring_bits of
|
||||
sb_16:
|
||||
mode:=16;
|
||||
sb_32:
|
||||
mode:=32;
|
||||
sb_64:
|
||||
mode:=64;
|
||||
end;
|
||||
if mode=16 then
|
||||
copynode:=ccallnode.createintern('fpc_ansistr16_copy',paras)
|
||||
else if mode=32 then
|
||||
copynode:=ccallnode.createintern('fpc_ansistr32_copy',paras)
|
||||
else if mode=64 then
|
||||
copynode:=ccallnode.createintern('fpc_ansistr64_copy',paras)
|
||||
{$else}
|
||||
if is_ansistring(paradef) or
|
||||
(is_chararray(paradef) and
|
||||
(paradef.size>255)) or
|
||||
((cs_ansistrings in aktlocalswitches) and
|
||||
is_pchar(paradef)) then
|
||||
copynode:=ccallnode.createintern('fpc_ansistr_copy',paras)
|
||||
{$endif}
|
||||
else
|
||||
if is_widestring(paradef) or
|
||||
is_widechararray(paradef) or
|
||||
@ -734,7 +763,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.29 2004-02-04 18:45:29 jonas
|
||||
Revision 1.30 2004-04-29 19:56:37 daniel
|
||||
* Prepare compiler infrastructure for multiple ansistring types
|
||||
|
||||
Revision 1.29 2004/02/04 18:45:29 jonas
|
||||
+ some more usage of register temps
|
||||
|
||||
Revision 1.28 2004/02/03 22:32:54 peter
|
||||
|
||||
@ -44,7 +44,11 @@ type
|
||||
{$endif Test_Double_checksum}
|
||||
|
||||
const
|
||||
{$ifdef ansistring_bits}
|
||||
CurrentPPUVersion=41;
|
||||
{$else}
|
||||
CurrentPPUVersion=40;
|
||||
{$endif}
|
||||
|
||||
{ buffer sizes }
|
||||
maxentrysize = 1024;
|
||||
@ -111,7 +115,13 @@ const
|
||||
ibfloatdef = 52;
|
||||
ibclassrefdef = 53;
|
||||
iblongstringdef = 54;
|
||||
{$ifdef ansistring_bits}
|
||||
ibansistring16def = 58;
|
||||
ibansistring32def = 55;
|
||||
ibansistring64def = 59;
|
||||
{$else}
|
||||
ibansistringdef = 55;
|
||||
{$endif}
|
||||
ibwidestringdef = 56;
|
||||
ibvariantdef = 57;
|
||||
{implementation/objectdata}
|
||||
@ -1042,7 +1052,10 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.47 2004-03-23 22:34:49 peter
|
||||
Revision 1.48 2004-04-29 19:56:37 daniel
|
||||
* Prepare compiler infrastructure for multiple ansistring types
|
||||
|
||||
Revision 1.47 2004/03/23 22:34:49 peter
|
||||
* constants ordinals now always have a type assigned
|
||||
* integer constants have the smallest type, unsigned prefered over
|
||||
signed
|
||||
|
||||
@ -151,7 +151,13 @@ implementation
|
||||
addtype('FarPointer',voidfarpointertype);
|
||||
addtype('ShortString',cshortstringtype);
|
||||
addtype('LongString',clongstringtype);
|
||||
{$ifdef ansistring_bits}
|
||||
addtype('AnsiString',cansistringtype16);
|
||||
addtype('AnsiString',cansistringtype32);
|
||||
addtype('AnsiString',cansistringtype64);
|
||||
{$else}
|
||||
addtype('AnsiString',cansistringtype);
|
||||
{$endif}
|
||||
addtype('WideString',cwidestringtype);
|
||||
addtype('Boolean',booltype);
|
||||
addtype('ByteBool',booltype);
|
||||
@ -186,7 +192,13 @@ implementation
|
||||
addtype('$widechar',cwidechartype);
|
||||
addtype('$shortstring',cshortstringtype);
|
||||
addtype('$longstring',clongstringtype);
|
||||
{$ifdef ansistring_bits}
|
||||
addtype('$ansistring16',cansistringtype16);
|
||||
addtype('$ansistring32',cansistringtype32);
|
||||
addtype('$ansistring64',cansistringtype64);
|
||||
{$else}
|
||||
addtype('$ansistring',cansistringtype);
|
||||
{$endif}
|
||||
addtype('$widestring',cwidestringtype);
|
||||
addtype('$openshortstring',openshortstringtype);
|
||||
addtype('$boolean',booltype);
|
||||
@ -259,7 +271,13 @@ implementation
|
||||
loadtype('widechar',cwidechartype);
|
||||
loadtype('shortstring',cshortstringtype);
|
||||
loadtype('longstring',clongstringtype);
|
||||
{$ifdef ansistring_bits}
|
||||
loadtype('ansistring16',cansistringtype16);
|
||||
loadtype('ansistring32',cansistringtype32);
|
||||
loadtype('ansistring64',cansistringtype64);
|
||||
{$else}
|
||||
loadtype('ansistring',cansistringtype);
|
||||
{$endif}
|
||||
loadtype('widestring',cwidestringtype);
|
||||
loadtype('openshortstring',openshortstringtype);
|
||||
loadtype('openchararray',openchararraytype);
|
||||
@ -316,7 +334,13 @@ implementation
|
||||
cshortstringtype.setdef(tstringdef.createshort(255));
|
||||
{ should we give a length to the default long and ansi string definition ?? }
|
||||
clongstringtype.setdef(tstringdef.createlong(-1));
|
||||
{$ifdef ansistring_bits}
|
||||
cansistringtype16.setdef(tstringdef.createansi(-1,sb_16));
|
||||
cansistringtype32.setdef(tstringdef.createansi(-1,sb_32));
|
||||
cansistringtype64.setdef(tstringdef.createansi(-1,sb_64));
|
||||
{$else}
|
||||
cansistringtype.setdef(tstringdef.createansi(-1));
|
||||
{$endif}
|
||||
cwidestringtype.setdef(tstringdef.createwide(-1));
|
||||
{ length=0 for shortstring is open string (needed for readln(string) }
|
||||
openshortstringtype.setdef(tstringdef.createshort(0));
|
||||
@ -512,7 +536,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.67 2004-03-23 22:34:49 peter
|
||||
Revision 1.68 2004-04-29 19:56:37 daniel
|
||||
* Prepare compiler infrastructure for multiple ansistring types
|
||||
|
||||
Revision 1.67 2004/03/23 22:34:49 peter
|
||||
* constants ordinals now always have a type assigned
|
||||
* integer constants have the smallest type, unsigned prefered over
|
||||
signed
|
||||
|
||||
@ -583,7 +583,38 @@ implementation
|
||||
curconstSegment.concat(Tai_string.Create_length_pchar(ca,t.def.size-strlength-1));
|
||||
end;
|
||||
end;
|
||||
st_ansistring:
|
||||
{$ifdef ansistrings_bits}
|
||||
st_ansistring16:
|
||||
begin
|
||||
{ an empty ansi string is nil! }
|
||||
if (strlength=0) then
|
||||
curconstSegment.concat(Tai_const.Create_ptr(0))
|
||||
else
|
||||
begin
|
||||
objectlibrary.getdatalabel(ll);
|
||||
curconstSegment.concat(Tai_const_symbol.Create(ll));
|
||||
{ the actual structure starts at -12 from start label - CEC }
|
||||
Consts.concat(tai_align.create(const_align(pointer_size)));
|
||||
{ first write the maximum size }
|
||||
Consts.concat(Tai_const.Create_16bit(strlength));
|
||||
{ second write the real length }
|
||||
Consts.concat(Tai_const.Create_16bit(strlength));
|
||||
{ redondent with maxlength but who knows ... (PM) }
|
||||
{ third write use count (set to -1 for safety ) }
|
||||
Consts.concat(Tai_const.Create_16bit(Cardinal(-1)));
|
||||
Consts.concat(Tai_label.Create(ll));
|
||||
getmem(ca,strlength+2);
|
||||
move(strval^,ca^,strlength);
|
||||
{ The terminating #0 to be stored in the .data section (JM) }
|
||||
ca[strlength]:=#0;
|
||||
{ End of the PChar. The memory has to be allocated because in }
|
||||
{ tai_string.done, there is a freemem(len+1) (JM) }
|
||||
ca[strlength+1]:=#0;
|
||||
Consts.concat(Tai_string.Create_length_pchar(ca,strlength+1));
|
||||
end;
|
||||
end;
|
||||
{$endif}
|
||||
{$ifdef ansistring_bits}st_ansistring32{$else}st_ansistring{$endif}:
|
||||
begin
|
||||
{ an empty ansi string is nil! }
|
||||
if (strlength=0) then
|
||||
@ -612,6 +643,37 @@ implementation
|
||||
Consts.concat(Tai_string.Create_length_pchar(ca,strlength+1));
|
||||
end;
|
||||
end;
|
||||
{$ifdef ansistring_bits}
|
||||
st_ansistring64:
|
||||
begin
|
||||
{ an empty ansi string is nil! }
|
||||
if (strlength=0) then
|
||||
curconstSegment.concat(Tai_const.Create_ptr(0))
|
||||
else
|
||||
begin
|
||||
objectlibrary.getdatalabel(ll);
|
||||
curconstSegment.concat(Tai_const_symbol.Create(ll));
|
||||
{ the actual structure starts at -12 from start label - CEC }
|
||||
Consts.concat(tai_align.create(const_align(pointer_size)));
|
||||
{ first write the maximum size }
|
||||
Consts.concat(Tai_const.Create_64bit(strlength));
|
||||
{ second write the real length }
|
||||
Consts.concat(Tai_const.Create_64bit(strlength));
|
||||
{ redondent with maxlength but who knows ... (PM) }
|
||||
{ third write use count (set to -1 for safety ) }
|
||||
Consts.concat(Tai_const.Create_64bit(Cardinal(-1)));
|
||||
Consts.concat(Tai_label.Create(ll));
|
||||
getmem(ca,strlength+2);
|
||||
move(strval^,ca^,strlength);
|
||||
{ The terminating #0 to be stored in the .data section (JM) }
|
||||
ca[strlength]:=#0;
|
||||
{ End of the PChar. The memory has to be allocated because in }
|
||||
{ tai_string.done, there is a freemem(len+1) (JM) }
|
||||
ca[strlength+1]:=#0;
|
||||
Consts.concat(Tai_string.Create_length_pchar(ca,strlength+1));
|
||||
end;
|
||||
end;
|
||||
{$endif}
|
||||
st_widestring:
|
||||
begin
|
||||
{ an empty ansi string is nil! }
|
||||
@ -1028,7 +1090,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.83 2004-04-11 10:44:23 peter
|
||||
Revision 1.84 2004-04-29 19:56:37 daniel
|
||||
* Prepare compiler infrastructure for multiple ansistring types
|
||||
|
||||
Revision 1.83 2004/04/11 10:44:23 peter
|
||||
* block_type is bt_const when parsing typed consts
|
||||
|
||||
Revision 1.82 2004/03/18 11:43:57 olle
|
||||
|
||||
@ -44,7 +44,11 @@ const
|
||||
tkSString = 7;
|
||||
tkString = tkSString;
|
||||
tkLString = 8;
|
||||
{$ifdef ansistring_bits}
|
||||
tkA32String = 9;
|
||||
{$else}
|
||||
tkAString = 9;
|
||||
{$endif}
|
||||
tkWString = 10;
|
||||
tkVariant = 11;
|
||||
tkArray = 12;
|
||||
@ -58,6 +62,10 @@ const
|
||||
tkQWord = 20;
|
||||
tkDynArray = 21;
|
||||
tkInterfaceCorba = 22;
|
||||
{$ifdef ansistring_bits}
|
||||
tkA16string = 23;
|
||||
tkA64string = 24;
|
||||
{$endif}
|
||||
|
||||
otSByte = 0;
|
||||
otUByte = 1;
|
||||
@ -162,7 +170,16 @@ type
|
||||
|
||||
{ string types }
|
||||
tstringtype = (st_default,
|
||||
st_shortstring, st_longstring, st_ansistring, st_widestring
|
||||
st_shortstring,
|
||||
st_longstring,
|
||||
{$ifndef ansistring_bits}
|
||||
st_ansistring,
|
||||
{$else}
|
||||
st_ansistring16,
|
||||
st_ansistring32,
|
||||
st_ansistring64,
|
||||
{$endif}
|
||||
st_widestring
|
||||
);
|
||||
|
||||
{ set types }
|
||||
@ -407,7 +424,10 @@ initialization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.80 2004-04-28 15:19:03 florian
|
||||
Revision 1.81 2004-04-29 19:56:37 daniel
|
||||
* Prepare compiler infrastructure for multiple ansistring types
|
||||
|
||||
Revision 1.80 2004/04/28 15:19:03 florian
|
||||
+ syscall directive support for MorphOS added
|
||||
|
||||
Revision 1.79 2004/04/18 15:22:24 florian
|
||||
|
||||
@ -625,8 +625,13 @@ interface
|
||||
constructor loadshort(ppufile:tcompilerppufile);
|
||||
constructor createlong(l : longint);
|
||||
constructor loadlong(ppufile:tcompilerppufile);
|
||||
{$ifdef ansistring_bits}
|
||||
constructor createansi(l:longint;bits:Tstringbits);
|
||||
constructor loadansi(ppufile:tcompilerppufile;bits:Tstringbits);
|
||||
{$else}
|
||||
constructor createansi(l : longint);
|
||||
constructor loadansi(ppufile:tcompilerppufile);
|
||||
{$endif}
|
||||
constructor createwide(l : longint);
|
||||
constructor loadwide(ppufile:tcompilerppufile);
|
||||
function getcopy : tstoreddef;override;
|
||||
@ -736,7 +741,13 @@ interface
|
||||
s32fixedtype, { pointer to type of temp. fixed }
|
||||
cshortstringtype, { pointer to type of short string const }
|
||||
clongstringtype, { pointer to type of long string const }
|
||||
{$ifdef ansistring_bits}
|
||||
cansistringtype16, { pointer to type of ansi string const }
|
||||
cansistringtype32, { pointer to type of ansi string const }
|
||||
cansistringtype64, { pointer to type of ansi string const }
|
||||
{$else}
|
||||
cansistringtype, { pointer to type of ansi string const }
|
||||
{$endif}
|
||||
cwidestringtype, { pointer to type of wide string const }
|
||||
openshortstringtype, { pointer to type of an open shortstring,
|
||||
needed for readln() }
|
||||
@ -1302,8 +1313,40 @@ implementation
|
||||
savesize:=POINTER_SIZE;
|
||||
end;
|
||||
|
||||
{$ifdef ansistring_bits}
|
||||
constructor tstringdef.createansi(l:longint;bits:Tstringbits);
|
||||
begin
|
||||
inherited create;
|
||||
case bits of
|
||||
sb_16:
|
||||
string_typ:=st_ansistring16;
|
||||
sb_32:
|
||||
string_typ:=st_ansistring32;
|
||||
sb_64:
|
||||
string_typ:=st_ansistring64;
|
||||
end;
|
||||
deftype:=stringdef;
|
||||
len:=l;
|
||||
savesize:=POINTER_SIZE;
|
||||
end;
|
||||
|
||||
constructor tstringdef.createansi(l : longint);
|
||||
constructor tstringdef.loadansi(ppufile:tcompilerppufile;bits:Tstringbits);
|
||||
begin
|
||||
inherited ppuloaddef(ppufile);
|
||||
deftype:=stringdef;
|
||||
case bits of
|
||||
sb_16:
|
||||
string_typ:=st_ansistring16;
|
||||
sb_32:
|
||||
string_typ:=st_ansistring32;
|
||||
sb_64:
|
||||
string_typ:=st_ansistring64;
|
||||
end;
|
||||
len:=ppufile.getlongint;
|
||||
savesize:=POINTER_SIZE;
|
||||
end;
|
||||
{$else}
|
||||
constructor tstringdef.createansi(l:longint);
|
||||
begin
|
||||
inherited create;
|
||||
string_typ:=st_ansistring;
|
||||
@ -1312,8 +1355,8 @@ implementation
|
||||
savesize:=POINTER_SIZE;
|
||||
end;
|
||||
|
||||
|
||||
constructor tstringdef.loadansi(ppufile:tcompilerppufile);
|
||||
|
||||
begin
|
||||
inherited ppuloaddef(ppufile);
|
||||
deftype:=stringdef;
|
||||
@ -1321,7 +1364,7 @@ implementation
|
||||
len:=ppufile.getlongint;
|
||||
savesize:=POINTER_SIZE;
|
||||
end;
|
||||
|
||||
{$endif}
|
||||
|
||||
constructor tstringdef.createwide(l : longint);
|
||||
begin
|
||||
@ -1354,10 +1397,17 @@ implementation
|
||||
|
||||
|
||||
function tstringdef.stringtypname:string;
|
||||
{$ifdef ansistring_bits}
|
||||
const
|
||||
typname:array[tstringtype] of string[9]=('',
|
||||
'shortstr','longstr','ansistr16','ansistr32','ansistr64','widestr'
|
||||
);
|
||||
{$else}
|
||||
const
|
||||
typname:array[tstringtype] of string[8]=('',
|
||||
'shortstr','longstr','ansistr','widestr'
|
||||
);
|
||||
{$endif}
|
||||
begin
|
||||
stringtypname:=typname[string_typ];
|
||||
end;
|
||||
@ -1384,7 +1434,13 @@ implementation
|
||||
case string_typ of
|
||||
st_shortstring : ppufile.writeentry(ibshortstringdef);
|
||||
st_longstring : ppufile.writeentry(iblongstringdef);
|
||||
{$ifdef ansistring_bits}
|
||||
st_ansistring16 : ppufile.writeentry(ibansistring16def);
|
||||
st_ansistring32 : ppufile.writeentry(ibansistring32def);
|
||||
st_ansistring64 : ppufile.writeentry(ibansistring64def);
|
||||
{$else}
|
||||
st_ansistring : ppufile.writeentry(ibansistringdef);
|
||||
{$endif}
|
||||
st_widestring : ppufile.writeentry(ibwidestringdef);
|
||||
end;
|
||||
end;
|
||||
@ -1423,7 +1479,11 @@ implementation
|
||||
[tostr(len+5),longst,tostr(len),charst,tostr(len*8),bytest]);
|
||||
{$EndIf}
|
||||
end;
|
||||
{$ifdef ansistring_bits}
|
||||
st_ansistring16,st_ansistring32,st_ansistring64:
|
||||
{$else}
|
||||
st_ansistring:
|
||||
{$endif}
|
||||
begin
|
||||
{ an ansi string looks like a pchar easy !! }
|
||||
charst:=tstoreddef(cchartype.def).numberstring;
|
||||
@ -1459,7 +1519,11 @@ implementation
|
||||
tstoreddef(u32inttype.def).concatstabto(asmlist);
|
||||
{$EndIf}
|
||||
end;
|
||||
{$ifdef ansistring_bits}
|
||||
st_ansistring16,st_ansistring32,st_ansistring64:
|
||||
{$else}
|
||||
st_ansistring:
|
||||
{$endif}
|
||||
tstoreddef(cchartype.def).concatstabto(asmlist);
|
||||
st_widestring:
|
||||
tstoreddef(cwidechartype.def).concatstabto(asmlist);
|
||||
@ -1471,14 +1535,24 @@ implementation
|
||||
|
||||
function tstringdef.needs_inittable : boolean;
|
||||
begin
|
||||
{$ifdef ansistring_bits}
|
||||
needs_inittable:=string_typ in [st_ansistring16,st_ansistring32,st_ansistring64,st_widestring];
|
||||
{$else}
|
||||
needs_inittable:=string_typ in [st_ansistring,st_widestring];
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
|
||||
function tstringdef.gettypename : string;
|
||||
{$ifdef ansistring_bits}
|
||||
const
|
||||
names : array[tstringtype] of string[20] = ('',
|
||||
'shortstring','longstring','ansistring16','ansistring32','ansistring64','widestring');
|
||||
{$else}
|
||||
const
|
||||
names : array[tstringtype] of string[20] = ('',
|
||||
'ShortString','LongString','AnsiString','WideString');
|
||||
{$endif}
|
||||
begin
|
||||
gettypename:=names[string_typ];
|
||||
end;
|
||||
@ -1487,11 +1561,29 @@ implementation
|
||||
procedure tstringdef.write_rtti_data(rt:trttitype);
|
||||
begin
|
||||
case string_typ of
|
||||
{$ifdef ansistring_bits}
|
||||
st_ansistring16:
|
||||
begin
|
||||
rttiList.concat(Tai_const.Create_8bit(tkA16String));
|
||||
write_rtti_name;
|
||||
end;
|
||||
st_ansistring32:
|
||||
begin
|
||||
rttiList.concat(Tai_const.Create_8bit(tkA32String));
|
||||
write_rtti_name;
|
||||
end;
|
||||
st_ansistring64:
|
||||
begin
|
||||
rttiList.concat(Tai_const.Create_8bit(tkA64String));
|
||||
write_rtti_name;
|
||||
end;
|
||||
{$else}
|
||||
st_ansistring:
|
||||
begin
|
||||
rttiList.concat(Tai_const.Create_8bit(tkAString));
|
||||
write_rtti_name;
|
||||
end;
|
||||
{$endif}
|
||||
st_widestring:
|
||||
begin
|
||||
rttiList.concat(Tai_const.Create_8bit(tkWString));
|
||||
@ -6073,7 +6165,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.234 2004-04-18 15:22:24 florian
|
||||
Revision 1.235 2004-04-29 19:56:37 daniel
|
||||
* Prepare compiler infrastructure for multiple ansistring types
|
||||
|
||||
Revision 1.234 2004/04/18 15:22:24 florian
|
||||
+ location support for arguments, currently PowerPC/MorphOS only
|
||||
|
||||
Revision 1.233 2004/03/23 22:34:49 peter
|
||||
|
||||
@ -310,7 +310,13 @@ implementation
|
||||
ibprocdef : hp:=tprocdef.ppuload(ppufile);
|
||||
ibshortstringdef : hp:=tstringdef.loadshort(ppufile);
|
||||
iblongstringdef : hp:=tstringdef.loadlong(ppufile);
|
||||
{$ifdef ansistring_bits}
|
||||
ibansistring16def : hp:=tstringdef.loadansi(ppufile,sb_16);
|
||||
ibansistring32def : hp:=tstringdef.loadansi(ppufile,sb_32);
|
||||
ibansistring64def : hp:=tstringdef.loadansi(ppufile,sb_64);
|
||||
{$else}
|
||||
ibansistringdef : hp:=tstringdef.loadansi(ppufile);
|
||||
{$endif}
|
||||
ibwidestringdef : hp:=tstringdef.loadwide(ppufile);
|
||||
ibrecorddef : hp:=trecorddef.ppuload(ppufile);
|
||||
ibobjectdef : hp:=tobjectdef.ppuload(ppufile);
|
||||
@ -2302,7 +2308,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.144 2004-03-14 20:08:37 peter
|
||||
Revision 1.145 2004-04-29 19:56:37 daniel
|
||||
* Prepare compiler infrastructure for multiple ansistring types
|
||||
|
||||
Revision 1.144 2004/03/14 20:08:37 peter
|
||||
* packrecords fixed for settings from $PACKRECORDS
|
||||
* default packrecords now uses value 0 and uses info from aligment
|
||||
structure only, initpackrecords removed
|
||||
|
||||
Loading…
Reference in New Issue
Block a user