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

* some ansi/wide/longstring support fixed:

Browse Source 
o parameter passing
     o returning as result from functions
This commit is contained in:
florian 1998-07-18 22:54:23 +00:00
parent 626eb9eb94
commit 206549900f
7 changed files with 250 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
compiler/cg386cal.pas
View File

@ -102,6 +102,7 @@ implementation
r : preference;
s : topsize;
op : tasmop;
begin
{ push from left to right if specified }
if push_from_left_to_right and assigned(p^.right) then
@ -391,8 +392,10 @@ implementation
end;
arraydef,recorddef,stringdef,setdef,objectdef :
begin
{ small set ? }
if ((p^.resulttype^.deftype=setdef) and
{ 32 bit type set ? }
if is_widestring(p^.resulttype) or
is_ansistring(p^.resulttype) or
((p^.resulttype^.deftype=setdef) and
(psetdef(p^.resulttype)^.settype=smallset)) then
begin
inc(pushedparasize,4);
@ -447,8 +450,8 @@ implementation
stackref.base:=procinfo.framepointer;
stackref.offset:=para_offset-pushedparasize;
end;
{ produce copy }
if p^.resulttype^.deftype=stringdef then
{ generate copy }
if is_shortstring(p^.resulttype) then
begin
copystring(stackref,p^.left^.location.reference,
pstringdef(p^.resulttype)^.len);
@ -1551,18 +1554,26 @@ implementation
{ push maximum string length }
push_int(pstringdef(pararesult)^.len);
case pstringdef(pararesult)^.string_typ of
shortstring: emitcall ('READ_TEXT_STRING',true);
ansistring : emitcall ('READ_TEXT_ANSISTRING',true);
longstring : emitcall ('READ_TEXT_LONGSTRING',true);
widestring : emitcall ('READ_TEXT_ANSISTRING',true);
st_shortstring:
emitcall ('READ_TEXT_STRING',true);
st_ansistring:
emitcall ('READ_TEXT_ANSISTRING',true);
st_longstring:
emitcall ('READ_TEXT_LONGSTRING',true);
st_widestring:
emitcall ('READ_TEXT_ANSISTRING',true);
end
end
else
Case pstringdef(Pararesult)^.string_typ of
shortstring: emitcall ('WRITE_TEXT_STRING',true);
ansistring : emitcall ('WRITE_TEXT_ANSISTRING',true);
longstring : emitcall ('WRITE_TEXT_LONGSTRING',true);
widestring : emitcall ('WRITE_TEXT_ANSISTRING',true);
st_shortstring:
emitcall ('WRITE_TEXT_STRING',true);
st_ansistring:
emitcall ('WRITE_TEXT_ANSISTRING',true);
st_longstring:
emitcall ('WRITE_TEXT_LONGSTRING',true);
st_widestring:
emitcall ('WRITE_TEXT_ANSISTRING',true);
end;
end;
pointerdef : begin
@ -2250,7 +2261,12 @@ implementation
end.
{
$Log$
Revision 1.9 1998-07-07 17:40:37 peter
Revision 1.10 1998-07-18 22:54:23 florian
* some ansi/wide/longstring support fixed:
o parameter passing
o returning as result from functions
Revision 1.9 1998/07/07 17:40:37 peter
* packrecords 4 works
* word aligning of parameters

115
compiler/cg386cnv.pas
View File

@ -392,6 +392,110 @@ implementation
begin
{$ifdef UseAnsiString}
{ does anybody know a better solution than this big case statement ? }
{ ok, a proc table woudl do the job }
case pstringdef(p)^.string_typ of
st_shortstring:
case pstringdef(p^.left)^.string_typ of
st_shortstring:
begin
stringdispose(p^.location.reference.symbol);
gettempofsizereference(p^.resulttype^.size,p^.location.reference);
del_reference(p^.left^.location.reference);
copystring(p^.location.reference,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
ungetiftemp(p^.left^.location.reference);
end;
st_longstring:
begin
{!!!!!!!}
internalerror(8888);
end;
st_ansistring:
begin
{!!!!!!!}
internalerror(8888);
end;
st_widestring:
begin
{!!!!!!!}
internalerror(8888);
end;
end;
st_longstring:
case pstringdef(p^.left)^.string_typ of
st_shortstring:
begin
{!!!!!!!}
internalerror(8888);
end;
st_longstring:
begin
{!!!!!!!}
internalerror(8888);
end;
st_ansistring:
begin
{!!!!!!!}
internalerror(8888);
end;
st_widestring:
begin
{!!!!!!!}
internalerror(8888);
end;
end;
st_ansistring:
case pstringdef(p^.left)^.string_typ of
st_shortstring:
begin
{!!!!!!!}
internalerror(8888);
end;
st_longstring:
begin
{!!!!!!!}
internalerror(8888);
end;
st_ansistring:
begin
{!!!!!!!}
internalerror(8888);
end;
st_widestring:
begin
{!!!!!!!}
internalerror(8888);
end;
end;
st_widestring:
case pstringdef(p^.left)^.string_typ of
st_shortstring:
begin
{!!!!!!!}
internalerror(8888);
end;
st_longstring:
begin
{!!!!!!!}
internalerror(8888);
end;
st_ansistring:
begin
{!!!!!!!}
internalerror(8888);
end;
st_widestring:
begin
{!!!!!!!}
internalerror(8888);
end;
end;
end;
{$ifdef dummy}
if is_ansistring(p^.resulttype) and not is_ansistring(p^.left^.resulttype) then
begin
{ call shortstring to ansistring conversion }
@ -414,7 +518,8 @@ implementation
ungetiftemp(p^.left^.location.reference);
end
else
{$endif UseAnsiString}
{$endif dummy}
{$else UseAnsiString}
begin
stringdispose(p^.location.reference.symbol);
gettempofsizereference(p^.resulttype^.size,p^.location.reference);
@ -422,6 +527,7 @@ implementation
copystring(p^.location.reference,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
ungetiftemp(p^.left^.location.reference);
end;
{$endif UseAnsiString}
end;
procedure second_cstring_charpointer(p,hp : ptree;convtyp : tconverttype);
@ -1064,7 +1170,12 @@ implementation
end.
{
$Log$
Revision 1.7 1998-06-12 13:10:34 peter
Revision 1.8 1998-07-18 22:54:24 florian
* some ansi/wide/longstring support fixed:
o parameter passing
o returning as result from functions
Revision 1.7 1998/06/12 13:10:34 peter
* small internalerror nr change
Revision 1.6 1998/06/12 10:43:12 michael

19
compiler/cg386con.pas
View File

@ -38,7 +38,7 @@ implementation
uses
cobjects,verbose,globals,
symtable,aasm,i386,
symtable,aasm,i386,types,
hcodegen,cgai386,temp_gen,tgeni386,cgi386;
{*****************************************************************************
@ -155,6 +155,12 @@ implementation
lastlabel:=pai_label(hp1)^.l
else
begin
{ when changing that code, be careful that }
{ you don't use typed consts, which are }
{ are also written to consts }
{ currently, this is no problem, because }
{ typed consts have no leading length or }
{ they have no trailing zero }
if (hp1^.typ=ait_string) and (lastlabel<>nil) and
(pai_string(hp1)^.len=length(p^.values^)+2) then
begin
@ -194,7 +200,9 @@ implementation
{ we still will have a problem if there is a #0 inside the pchar }
consts^.concat(new(pai_string,init_length_pchar(pc,length(p^.values^)+2)));
{$else UseAnsiString}
if cs_ansistrings in aktswitches then
{ generate an ansi string ? }
if is_ansistring(p^.resulttype) then
begin
concat_constlabel(lastlabel,conststring);
consts^.concat(new(pai_const,init_32bit(p^.length)));
@ -336,7 +344,12 @@ implementation
end.
{
$Log$
Revision 1.6 1998-07-18 17:11:07 florian
Revision 1.7 1998-07-18 22:54:25 florian
* some ansi/wide/longstring support fixed:
o parameter passing
o returning as result from functions
Revision 1.6 1998/07/18 17:11:07 florian
+ ansi string constants fixed
+ switch $H partial implemented

30
compiler/pass_1.pas
View File

@ -469,7 +469,7 @@ unit pass_1;
else
{ nil is compatible with ansi- and wide strings }
if (fromtreetype=niln) and (def_to^.deftype=stringdef)
and (pstringdef(def_to)^.string_typ in [ansistring,widestring]) then
and (pstringdef(def_to)^.string_typ in [st_ansistring,st_widestring]) then
begin
doconv:=tc_equal;
b:=true;
@ -477,7 +477,7 @@ unit pass_1;
else
{ ansi- and wide strings can be assigned to void pointers }
if (def_from^.deftype=stringdef) and
(pstringdef(def_from)^.string_typ in [ansistring,widestring]) and
(pstringdef(def_from)^.string_typ in [st_ansistring,st_widestring]) and
(def_to^.deftype=pointerdef) and
(ppointerdef(def_to)^.definition^.deftype=orddef) and
(porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
@ -2066,8 +2066,12 @@ unit pass_1;
if pstringdef(p^.resulttype)^.string_typ<>
pstringdef(p^.left^.resulttype)^.string_typ then
begin
{ call shortstring_to_ansistring or ansistring_to_shortstring }
procinfo.flags:=procinfo.flags or pi_do_call;
{ trick: secondstringconstn generates a const entry depending on }
{ the result type }
if p^.left^.treetype=stringconstn then
p^.left^.resulttype:=p^.resulttype
else
procinfo.flags:=procinfo.flags or pi_do_call;
end;
{ for simplicity lets first keep all ansistrings
as LOC_MEM, could also become LOC_REGISTER }
@ -2712,8 +2716,8 @@ unit pass_1;
firstpass(p^.left);
must_be_valid:=store_valid;
end;
if not((p^.left^.resulttype^.deftype=stringdef) and
(defcoll^.data^.deftype=stringdef)) and
if not(is_shortstring(p^.left^.resulttype) and
is_shortstring(defcoll^.data)) and
(defcoll^.data^.deftype<>formaldef) then
begin
if (defcoll^.paratyp=vs_var) and
@ -2761,8 +2765,8 @@ unit pass_1;
end;
{ check var strings }
if (cs_strict_var_strings in aktswitches) and
(p^.left^.resulttype^.deftype=stringdef) and
(defcoll^.data^.deftype=stringdef) and
is_shortstring(p^.left^.resulttype) and
is_shortstring(defcoll^.data) and
(defcoll^.paratyp=vs_var) and
not(is_equal(p^.left^.resulttype,defcoll^.data)) then
Message(parser_e_strict_var_string_violation);
@ -2823,15 +2827,14 @@ unit pass_1;
{ all types can be passed to a formaldef }
is_equal:=(def1^.deftype=formaldef) or
(assigned(def2) and types.is_equal(def1,def2))
{$ifdef USEANSISTRING}
{ to support ansi/long/wide strings in a proper way }
{ string and string[10] are assumed as equal }
{ when searching the correct overloaded procedure }
or
(assigned(def1) and assigned(def2) and
(def1^.deftype=stringdef) and (def2^.deftype=stringdef) and
(pstringdef(def1)^.string_typ=pstringdef(def2)^.string_typ)
)
{$endif USEANSISTRING}
;
end;
@ -5043,7 +5046,12 @@ unit pass_1;
end.
{
$Log$
Revision 1.40 1998-07-18 17:11:09 florian
Revision 1.41 1998-07-18 22:54:27 florian
* some ansi/wide/longstring support fixed:
o parameter passing
o returning as result from functions
Revision 1.40 1998/07/18 17:11:09 florian
+ ansi string constants fixed
+ switch $H partial implemented

16
compiler/ptconst.pas
View File

@ -162,13 +162,12 @@ unit ptconst;
begin
getlabel(ll);
datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(ll)))));
datasegment^.concat(new(pai_label,init(ll)));
{ insert string at the begin }
consts^.concat(new(pai_label,init(ll)));
if p^.treetype=stringconstn then
datasegment^.concat(new(pai_string,init(p^.values^+#0)))
consts^.concat(new(pai_string,init(p^.values^+#0)))
else
if is_constcharnode(p) then
datasegment^.concat(new(pai_string,init(char(byte(p^.value))+#0)))
consts^.concat(new(pai_string,init(char(byte(p^.value))+#0)))
else
Message(cg_e_illegal_expression);
{ insert label }
@ -255,7 +254,7 @@ unit ptconst;
end else
{$endif UseLongString}
{$ifdef UseAnsiString}
if pstringdef(def)^.string_typ=ansistring then
if pstringdef(def)^.string_typ=st_ansistring then
begin
{$ifdef debug}
datasegment^.concat(new(pai_asm_comment,init('Header of ansistring')));
@ -451,7 +450,12 @@ unit ptconst;
end.
{
$Log$
Revision 1.6 1998-06-08 22:59:52 peter
Revision 1.7 1998-07-18 22:54:29 florian
* some ansi/wide/longstring support fixed:
o parameter passing
o returning as result from functions
Revision 1.6 1998/06/08 22:59:52 peter
* smartlinking works for win32
* some defines to exclude some compiler parts

59
compiler/symdef.inc
View File

@ -306,7 +306,7 @@
begin
tdef.init;
string_typ:=shortstring;
string_typ:=st_shortstring;
deftype:=stringdef;
len:=l;
savesize:=len+1;
@ -316,7 +316,7 @@
begin
tdef.load;
string_typ:=shortstring;
string_typ:=st_shortstring;
deftype:=stringdef;
len:=readbyte;
savesize:=len+1;
@ -326,7 +326,7 @@
begin
tdef.init;
string_typ:=longstring;
string_typ:=st_longstring;
deftype:=stringdef;
len:=l;
savesize:=Sizeof(pointer);
@ -337,7 +337,7 @@
begin
tdef.load;
deftype:=stringdef;
string_typ:=longstring;
string_typ:=st_longstring;
len:=readlong;
savesize:=Sizeof(pointer);
end;
@ -346,7 +346,7 @@
begin
tdef.init;
string_typ:=ansistring;
string_typ:=st_ansistring;
deftype:=stringdef;
len:=l;
savesize:=sizeof(pointer);
@ -357,7 +357,7 @@
begin
tdef.load;
deftype:=stringdef;
string_typ:=ansistring;
string_typ:=st_ansistring;
len:=readlong;
savesize:=sizeof(pointer);
end;
@ -366,7 +366,7 @@
begin
tdef.init;
string_typ:=widestring;
string_typ:=st_widestring;
deftype:=stringdef;
len:=l;
savesize:=sizeof(pointer);
@ -377,7 +377,7 @@
begin
tdef.load;
deftype:=stringdef;
string_typ:=ansistring;
string_typ:=st_ansistring;
len:=readlong;
savesize:=sizeof(pointer);
end;
@ -402,16 +402,20 @@
end;
{$endif}
tdef.write;
if string_typ=shortstring then
if string_typ=st_shortstring then
writebyte(len)
else
writelong(len);
{$ifndef OLDPPU}
case string_typ of
shortstring : current_ppu^.writeentry(ibstringdef);
longstring : current_ppu^.writeentry(iblongstringdef);
ansistring : current_ppu^.writeentry(ibansistringdef);
widestring : current_ppu^.writeentry(ibwidestringdef);
st_shortstring:
current_ppu^.writeentry(ibstringdef);
st_longstring:
current_ppu^.writeentry(iblongstringdef);
st_ansistring:
current_ppu^.writeentry(ibansistringdef);
st_widestring:
current_ppu^.writeentry(ibwidestringdef);
end;
{$endif}
end;
@ -422,7 +426,8 @@
bytest,charst,longst : string;
begin
case string_typ of
shortstring : begin
st_shortstring:
begin
charst := typeglobalnumber('char');
{ this is what I found in stabs.texinfo but
gdb 4.12 for go32 doesn't understand that !! }
@ -435,7 +440,8 @@
+';1;'+tostr(len)+';'+charst+',8,'+tostr(len*8)+';;');
{$EndIf}
end;
longstring : begin
st_longstring:
begin
charst := typeglobalnumber('char');
{ this is what I found in stabs.texinfo but
gdb 4.12 for go32 doesn't understand that !! }
@ -449,11 +455,13 @@
+';1;'+tostr(len)+';'+charst+',40,'+tostr(len*8)+';;');
{$EndIf}
end;
ansistring : begin
st_ansistring:
begin
{ an ansi string looks like a pchar easy !! }
stabstring:=strpnew('*'+typeglobalnumber('char'));
end;
widestring : begin
st_widestring:
begin
{ an ansi string looks like a pchar easy !! }
stabstring:=strpnew('*'+typeglobalnumber('char'));
end;
@ -468,7 +476,7 @@
function tstringdef.needs_rtti : boolean;
begin
needs_rtti:=string_typ in [ansistring,widestring];
needs_rtti:=string_typ in [st_ansistring,st_widestring];
end;
procedure tstringdef.generate_rtti;
@ -476,20 +484,20 @@
begin
inherited generate_rtti;
case string_typ of
ansistring:
st_ansistring:
begin
rttilist^.concat(new(pai_const,init_8bit(10)));
end;
widestring:
st_widestring:
begin
rttilist^.concat(new(pai_const,init_8bit(11)));
end;
longstring:
st_longstring:
begin
rttilist^.concat(new(pai_const,init_8bit(9)));
rttilist^.concat(new(pai_const,init_32bit(len)));
end;
shortstring:
st_shortstring:
begin
rttilist^.concat(new(pai_const,init_8bit(8)));
rttilist^.concat(new(pai_const,init_32bit(len)));
@ -2658,7 +2666,12 @@
{
$Log$
Revision 1.19 1998-07-14 14:47:05 peter
Revision 1.20 1998-07-18 22:54:30 florian
* some ansi/wide/longstring support fixed:
o parameter passing
o returning as result from functions
Revision 1.19 1998/07/14 14:47:05 peter
* released NEWINPUT
Revision 1.18 1998/07/10 10:51:04 peter

44
compiler/types.pas
View File

@ -185,28 +185,28 @@ unit types;
function is_ansistring(p : pdef) : boolean;
begin
is_ansistring:=(p^.deftype=stringdef) and
(pstringdef(p)^.string_typ=ansistring);
(pstringdef(p)^.string_typ=st_ansistring);
end;
{ true if o is an long string def }
function is_longstring(p : pdef) : boolean;
begin
is_longstring:=(p^.deftype=stringdef) and
(pstringdef(p)^.string_typ=longstring);
(pstringdef(p)^.string_typ=st_longstring);
end;
{ true if o is an wide string def }
function is_widestring(p : pdef) : boolean;
begin
is_widestring:=(p^.deftype=stringdef) and
(pstringdef(p)^.string_typ=widestring);
(pstringdef(p)^.string_typ=st_widestring);
end;
{ true if o is an short string def }
function is_shortstring(p : pdef) : boolean;
begin
is_shortstring:=(p^.deftype=stringdef) and
(pstringdef(p)^.string_typ=shortstring);
(pstringdef(p)^.string_typ=st_shortstring);
end;
{ true if the return value is in accumulator (EAX for i386), D0 for 68k }
@ -214,6 +214,7 @@ unit types;
begin
ret_in_acc:=(def^.deftype in [orddef,pointerdef,enumdef,classrefdef]) or
((def^.deftype=stringdef) and (pstringdef(def)^.string_typ in [st_ansistring,st_widestring])) or
((def^.deftype=procvardef) and ((pprocvardef(def)^.options and pomethodpointer)=0)) or
((def^.deftype=objectdef) and pobjectdef(def)^.isclass) or
((def^.deftype=setdef) and (psetdef(def)^.settype=smallset)) or
@ -224,19 +225,21 @@ unit types;
function ret_in_param(def : pdef) : boolean;
begin
ret_in_param:=(def^.deftype in [arraydef,recorddef,stringdef]) or
((def^.deftype=procvardef) and ((pprocvardef(def)^.options and pomethodpointer)<>0)) or
((def^.deftype=objectdef) and ((pobjectdef(def)^.options and oois_class)=0)) or
((def^.deftype=setdef) and (psetdef(def)^.settype<>smallset));
ret_in_param:=(def^.deftype in [arraydef,recorddef]) or
((def^.deftype=stringdef) and (pstringdef(def)^.string_typ in [st_shortstring,st_longstring])) or
((def^.deftype=procvardef) and ((pprocvardef(def)^.options and pomethodpointer)<>0)) or
((def^.deftype=objectdef) and ((pobjectdef(def)^.options and oois_class)=0)) or
((def^.deftype=setdef) and (psetdef(def)^.settype<>smallset));
end;
{ true if a const parameter is too large to copy }
function dont_copy_const_param(def : pdef) : boolean;
begin
dont_copy_const_param:=(def^.deftype in [arraydef,stringdef,objectdef,formaldef,recorddef]) or
((def^.deftype=procvardef) and ((pprocvardef(def)^.options and pomethodpointer)<>0)) or
((def^.deftype=setdef) and (psetdef(def)^.settype<>smallset));
dont_copy_const_param:=(def^.deftype in [arraydef,objectdef,formaldef,recorddef]) or
((def^.deftype=stringdef) and (pstringdef(def)^.string_typ in [st_shortstring,st_longstring])) or
((def^.deftype=procvardef) and ((pprocvardef(def)^.options and pomethodpointer)<>0)) or
((def^.deftype=setdef) and (psetdef(def)^.settype<>smallset));
end;
procedure testrange(def : pdef;l : longint);
@ -437,11 +440,13 @@ unit types;
begin
case porddef(def1)^.typ of
u8bit,u16bit,u32bit,
s8bit,s16bit,s32bit : b:=((porddef(def1)^.typ=porddef(def2)^.typ) and
(porddef(def1)^.low=porddef(def2)^.low) and
(porddef(def1)^.high=porddef(def2)^.high));
uvoid,uchar,
bool8bit,bool16bit,bool32bit : b:=(porddef(def1)^.typ=porddef(def2)^.typ);
s8bit,s16bit,s32bit:
b:=((porddef(def1)^.typ=porddef(def2)^.typ) and
(porddef(def1)^.low=porddef(def2)^.low) and
(porddef(def1)^.high=porddef(def2)^.high));
uvoid,uchar,
bool8bit,bool16bit,bool32bit:
b:=(porddef(def1)^.typ=porddef(def2)^.typ);
end;
end
else
@ -853,7 +858,12 @@ unit types;
end.
{
$Log$
Revision 1.14 1998-06-12 14:50:50 peter
Revision 1.15 1998-07-18 22:54:32 florian
* some ansi/wide/longstring support fixed:
o parameter passing
o returning as result from functions
Revision 1.14 1998/06/12 14:50:50 peter
* removed the tree dependency to types.pas
* long_fil.pas support (not fully tested yet)