paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 14:09:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixes for ansistrings

Browse Source
This commit is contained in:
peter 1998-11-16 10:18:07 +00:00
parent d626ddb757
commit 59c75c7410
3 changed files with 78 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
compiler/pdecl.pas
View File

@ -559,27 +559,19 @@ unit pdecl;
consume(RECKKLAMMER); consume(RECKKLAMMER);
if p^.value>255 then if p^.value>255 then
d:=new(pstringdef,longinit(p^.value)) d:=new(pstringdef,longinit(p^.value))
else if p^.value<>255 then else
d:=new(pstringdef,shortinit(p^.value)) if p^.value<>255 then
{$ifndef GDB} d:=new(pstringdef,shortinit(p^.value))
else d:=new(pstringdef,shortinit(255)); else
{$else GDB} d:=cshortstringdef;
else d:=globaldef('STRING');
{$endif GDB}
disposetree(p); disposetree(p);
end end
{ should string without suffix be an ansistring also
in ansistring mode ?? (PM) Yes!!! (FK) }
else else
begin begin
if cs_ansistrings in aktlocalswitches then if cs_ansistrings in aktlocalswitches then
d:=new(pstringdef,ansiinit(0)) d:=cansistringdef
else else
{$ifndef GDB} d:=cshortstringdef;
d:=new(pstringdef,shortinit(255));
{$else GDB}
d:=globaldef('STRING');
{$endif GDB}
end; end;
stringtype:=d; stringtype:=d;
end; end;
@ -2094,7 +2086,10 @@ unit pdecl;
end. end.
{ {
$Log$ $Log$
Revision 1.81 1998-11-13 15:40:22 pierre Revision 1.82 1998-11-16 10:18:07 peter
* fixes for ansistrings
Revision 1.81 1998/11/13 15:40:22 pierre
+ added -Se in Makefile cvstest target + added -Se in Makefile cvstest target
+ lexlevel cleanup + lexlevel cleanup
normal_function_level main_program_level and unit_init_level defined normal_function_level main_program_level and unit_init_level defined

35
compiler/psystem.pas
View File

@ -69,9 +69,8 @@ procedure insert_intern_types(p : psymtable);
{ {
all the types inserted into the system unit all the types inserted into the system unit
} }
var
booleandef : pdef;
{$ifdef GDB} {$ifdef GDB}
var
{ several defs to simulate more or less C++ objects for GDB } { several defs to simulate more or less C++ objects for GDB }
vmtdef : precdef; vmtdef : precdef;
pvmtdef : ppointerdef; pvmtdef : ppointerdef;
@ -100,9 +99,9 @@ begin
p^.insert(new(ptypesym,init('char_pointer',charpointerdef))); p^.insert(new(ptypesym,init('char_pointer',charpointerdef)));
p^.insert(new(ptypesym,init('file',cfiledef))); p^.insert(new(ptypesym,init('file',cfiledef)));
{$ifdef i386} {$ifdef i386}
p^.insert(new(ptypesym,init('REAL',new(pfloatdef,init(s64real))))); p^.insert(new(ptypesym,init('REAL',c64floatdef)));
p^.insert(new(ptypesym,init('EXTENDED',s80floatdef)));
p^.insert(new(ptypesym,init('COMP',new(pfloatdef,init(s64bit))))); p^.insert(new(ptypesym,init('COMP',new(pfloatdef,init(s64bit)))));
p^.insert(new(ptypesym,init('EXTENDED',new(pfloatdef,init(s80real)))));
{$endif} {$endif}
{$ifdef m68k} {$ifdef m68k}
{ internal definitions } { internal definitions }
@ -112,40 +111,33 @@ begin
if (cs_fp_emulation) in aktmoduleswitches then if (cs_fp_emulation) in aktmoduleswitches then
p^.insert(new(ptypesym,init('DOUBLE',new(pfloatdef,init(s32real))))) p^.insert(new(ptypesym,init('DOUBLE',new(pfloatdef,init(s32real)))))
else else
p^.insert(new(ptypesym,init('DOUBLE',new(pfloatdef,init(s64real))))); p^.insert(new(ptypesym,init('DOUBLE',c64floatdef)));
if (cs_fp_emulation) in aktmoduleswitches then if (cs_fp_emulation) in aktmoduleswitches then
p^.insert(new(ptypesym,init('EXTENDED',new(pfloatdef,init(s32real))))) p^.insert(new(ptypesym,init('EXTENDED',new(pfloatdef,init(s32real)))))
else else
p^.insert(new(ptypesym,init('EXTENDED',new(pfloatdef,init(s80real))))); p^.insert(new(ptypesym,init('EXTENDED',s80floatdef)));
{ p^.insert(new(ptypesym,init('COMP',new(pfloatdef,init(s32real)))));} { p^.insert(new(ptypesym,init('COMP',new(pfloatdef,init(s32real)))));}
{$endif} {$endif}
p^.insert(new(ptypesym,init('SINGLE',new(pfloatdef,init(s32real))))); p^.insert(new(ptypesym,init('SINGLE',new(pfloatdef,init(s32real)))));
p^.insert(new(ptypesym,init('POINTER',new(ppointerdef,init(voiddef))))); p^.insert(new(ptypesym,init('POINTER',voidpointerdef)));
p^.insert(new(ptypesym,init('STRING',cshortstringdef))); p^.insert(new(ptypesym,init('STRING',cshortstringdef)));
p^.insert(new(ptypesym,init('SHORTSTRING',cshortstringdef))); p^.insert(new(ptypesym,init('SHORTSTRING',cshortstringdef)));
p^.insert(new(ptypesym,init('LONGSTRING',clongstringdef))); p^.insert(new(ptypesym,init('LONGSTRING',clongstringdef)));
p^.insert(new(ptypesym,init('ANSISTRING',cansistringdef))); p^.insert(new(ptypesym,init('ANSISTRING',cansistringdef)));
p^.insert(new(ptypesym,init('WIDESTRING',cwidestringdef))); p^.insert(new(ptypesym,init('WIDESTRING',cwidestringdef)));
booleandef:=new(porddef,init(bool8bit,0,1)); p^.insert(new(ptypesym,init('BOOLEAN',booldef)));
p^.insert(new(ptypesym,init('BOOLEAN',booleandef))); p^.insert(new(ptypesym,init('BYTEBOOL',booldef)));
p^.insert(new(ptypesym,init('BYTEBOOL',booleandef)));
p^.insert(new(ptypesym,init('WORDBOOL',new(porddef,init(bool16bit,0,1))))); p^.insert(new(ptypesym,init('WORDBOOL',new(porddef,init(bool16bit,0,1)))));
p^.insert(new(ptypesym,init('LONGBOOL',new(porddef,init(bool32bit,0,1))))); p^.insert(new(ptypesym,init('LONGBOOL',new(porddef,init(bool32bit,0,1)))));
p^.insert(new(ptypesym,init('CHAR',new(porddef,init(uchar,0,255))))); p^.insert(new(ptypesym,init('CHAR',cchardef)));
p^.insert(new(ptypesym,init('TEXT',new(pfiledef,init(ft_text,nil))))); p^.insert(new(ptypesym,init('TEXT',new(pfiledef,init(ft_text,nil)))));
p^.insert(new(ptypesym,init('CARDINAL',new(porddef,init(u32bit,0,$ffffffff))))); p^.insert(new(ptypesym,init('CARDINAL',u32bitdef)));
p^.insert(new(ptypesym,init('FIXED',new(pfloatdef,init(f32bit))))); p^.insert(new(ptypesym,init('FIXED',new(pfloatdef,init(f32bit)))));
p^.insert(new(ptypesym,init('FIXED16',new(pfloatdef,init(f16bit))))); p^.insert(new(ptypesym,init('FIXED16',new(pfloatdef,init(f16bit)))));
p^.insert(new(ptypesym,init('TYPEDFILE',new(pfiledef,init(ft_typed,voiddef))))); p^.insert(new(ptypesym,init('TYPEDFILE',new(pfiledef,init(ft_typed,voiddef)))));
{ !!!!! {$ifdef GDB}
p^.insert(new(ptypesym,init('COMP',new(porddef,init(s64bit,0,0)))));
p^.insert(new(ptypesym,init('SINGLE',new(porddef,init(s32real,0,0)))));
p^.insert(new(ptypesym,init('EXTENDED',new(porddef,init(s80real,0,0)))));
p^.insert(new(ptypesym,init('FILE',new(pfiledef,init(ft_untyped,nil)))));
}
{ Add a type for virtual method tables in lowercase } { Add a type for virtual method tables in lowercase }
{ so it isn't reachable! } { so it isn't reachable! }
{$ifdef GDB}
vmtsymtable:=new(psymtable,init(recordsymtable)); vmtsymtable:=new(psymtable,init(recordsymtable));
vmtdef:=new(precdef,init(vmtsymtable)); vmtdef:=new(precdef,init(vmtsymtable));
pvmtdef:=new(ppointerdef,init(vmtdef)); pvmtdef:=new(ppointerdef,init(vmtdef));
@ -240,7 +232,10 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.10 1998-11-09 11:44:36 peter Revision 1.11 1998-11-16 10:18:09 peter
* fixes for ansistrings
Revision 1.10 1998/11/09 11:44:36 peter
+ va_list for printf support + va_list for printf support
Revision 1.9 1998/11/05 12:02:54 peter Revision 1.9 1998/11/05 12:02:54 peter

75
compiler/tccal.pas
View File

@ -248,32 +248,43 @@ implementation
regi : tregister; regi : tregister;
store_valid, old_count_ref : boolean; store_valid, old_count_ref : boolean;
{ types.is_equal can't handle a formaldef ! } { check if the resulttype from tree p is equal with def, needed
function is_equal(def1,def2 : pdef) : boolean; for stringconstn and formaldef }
function is_equal(p:ptree;def:pdef) : boolean;
begin begin
{ safety check } { safety check }
if not (assigned(def1) or assigned(def2)) then if not (assigned(def) or assigned(p^.resulttype)) then
begin begin
is_equal:=false; is_equal:=false;
exit; exit;
end; end;
{ all types can be passed to a formaldef } { all types can be passed to a formaldef }
is_equal:=(def1^.deftype=formaldef) or is_equal:=(def^.deftype=formaldef) or
(types.is_equal(def1,def2)) (types.is_equal(p^.resulttype,def))
{ to support ansi/long/wide strings in a proper way } { to support ansi/long/wide strings in a proper way }
{ string and string[10] are assumed as equal } { string and string[10] are assumed as equal }
{ when searching the correct overloaded procedure } { when searching the correct overloaded procedure }
or or
( (
(def1^.deftype=stringdef) and (def2^.deftype=stringdef) and (def^.deftype=stringdef) and (p^.resulttype^.deftype=stringdef) and
(pstringdef(def1)^.string_typ=pstringdef(def2)^.string_typ) (pstringdef(def)^.string_typ=pstringdef(p^.resulttype)^.string_typ)
)
or
(
(p^.left^.treetype=stringconstn) and
(is_ansistring(p^.resulttype) and is_pchar(def))
)
or
(
(p^.left^.treetype=ordconstn) and
(is_char(p^.resulttype) and (is_shortstring(def) or is_ansistring(def)))
) )
{ set can also be a not yet converted array constructor } { set can also be a not yet converted array constructor }
or or
( (
(def1^.deftype=setdef) and (def2^.deftype=arraydef) and (def^.deftype=setdef) and (p^.resulttype^.deftype=arraydef) and
(parraydef(def2)^.IsConstructor) and not(parraydef(def2)^.IsVariant) (parraydef(p^.resulttype)^.IsConstructor) and not(parraydef(p^.resulttype)^.IsVariant)
) )
; ;
end; end;
@ -483,7 +494,7 @@ implementation
hp:=procs; hp:=procs;
while assigned(hp) do while assigned(hp) do
begin begin
if is_equal(hp^.nextpara^.data,pt^.resulttype) then if is_equal(pt,hp^.nextpara^.data) then
begin begin
if hp^.nextpara^.data=pt^.resulttype then if hp^.nextpara^.data=pt^.resulttype then
begin begin
@ -503,7 +514,7 @@ implementation
if exactmatch then if exactmatch then
begin begin
{ the first .... } { the first .... }
while (assigned(procs)) and not(is_equal(procs^.nextpara^.data,pt^.resulttype)) do while (assigned(procs)) and not(is_equal(pt,procs^.nextpara^.data)) do
begin begin
hp:=procs^.next; hp:=procs^.next;
dispose(procs); dispose(procs);
@ -513,7 +524,7 @@ implementation
hp:=procs; hp:=procs;
while (assigned(hp)) and assigned(hp^.next) do while (assigned(hp)) and assigned(hp^.next) do
begin begin
if not(is_equal(hp^.next^.nextpara^.data,pt^.resulttype)) then if not(is_equal(pt,hp^.next^.nextpara^.data)) then
begin begin
hp2:=hp^.next^.next; hp2:=hp^.next^.next;
dispose(hp^.next); dispose(hp^.next);
@ -611,7 +622,7 @@ implementation
hp:=procs; hp:=procs;
while assigned(hp) do while assigned(hp) do
begin begin
if not is_equal(hp^.nextpara^.data,pt^.resulttype) then if not is_equal(pt,hp^.nextpara^.data) then
begin begin
def_to:=hp^.nextpara^.data; def_to:=hp^.nextpara^.data;
if ((def_from^.deftype=orddef) and (def_to^.deftype=orddef)) and if ((def_from^.deftype=orddef) and (def_to^.deftype=orddef)) and
@ -673,25 +684,40 @@ implementation
pt:=pt^.right; pt:=pt^.right;
end; end;
end; end;
{ reset nextpara for all procs left }
hp:=procs;
while assigned(hp) do
begin
hp^.nextpara:=hp^.firstpara;
hp:=hp^.next;
end;
{ let's try to eliminate equal is exact is there } { let's try to eliminate equal is exact is there }
{if assigned(procs^.next) then if assigned(procs^.next) then
begin begin
pt:=p^.left; pt:=p^.left;
while assigned(pt) do while assigned(pt) do
begin begin
if pt^.exact_match_found then if pt^.exact_match_found then
begin begin
hp:=procs; while assigned(procs) and (procs^.nextpara^.data<>pt^.resulttype) do
while (assigned(procs)) and (procs^.nextpara^.data<>pt^.resulttype) do begin
begin hp:=procs^.next;
hp:=procs^.next; dispose(procs);
dispose(procs); procs:=hp;
procs:=hp; end;
end; end;
{ update nextpara for all procedures }
hp:=procs;
while assigned(hp) do
begin
hp^.nextpara:=hp^.nextpara^.next;
hp:=hp^.next;
end; end;
pt:=pt^.right; pt:=pt^.right;
end; end;
end; } end;
if assigned(procs^.next) then if assigned(procs^.next) then
begin begin
@ -941,7 +967,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.11 1998-11-10 10:09:17 peter Revision 1.12 1998-11-16 10:18:10 peter
* fixes for ansistrings
Revision 1.11 1998/11/10 10:09:17 peter
* va_list -> array of const * va_list -> array of const
Revision 1.10 1998/11/09 11:44:41 peter Revision 1.10 1998/11/09 11:44:41 peter