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

* released useansistring

Browse Source 
* removed -Sv, its now available in fpc modes
This commit is contained in:
peter 1998-11-05 12:02:30 +00:00
parent c1b6f90bcf
commit 3037445491
21 changed files with 255 additions and 430 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

112
compiler/cg386cnv.pas
View File

@ -391,14 +391,9 @@ implementation
end;
procedure second_string_string(p,hp : ptree;convtyp : tconverttype);
{$ifdef UseAnsiString}
var
pushed : tpushed;
{$endif UseAnsiString}
begin
{$ifdef UseAnsiString}
{ does anybody know a better solution than this big case statement ? }
{ ok, a proc table would do the job }
case pstringdef(p^.resulttype)^.string_typ of
@ -508,43 +503,10 @@ implementation
end;
end;
end;
{$ifdef dummy}
if is_ansistring(p^.resulttype) and not is_ansistring(p^.left^.resulttype) then
begin
{ call shortstring to ansistring conversion }
{ result is in register }
del_reference(p^.left^.location.reference);
{!!!!
copyshortstringtoansistring(p^.location,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
}
ungetiftemp(p^.left^.location.reference);
end
else if not is_ansistring(p^.resulttype) and is_ansistring(p^.left^.resulttype) then
begin
{ call ansistring to shortstring conversion }
{ result is in mem }
stringdispose(p^.location.reference.symbol);
gettempofsizereference(p^.resulttype^.size,p^.location.reference);
if p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE] then
del_reference(p^.left^.location.reference);
copyansistringtoshortstring(p^.location.reference,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
ungetiftemp(p^.left^.location.reference);
end
else
{$endif dummy}
{$else UseAnsiString}
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;
{$endif UseAnsiString}
end;
procedure second_cstring_charpointer(p,hp : ptree;convtyp : tconverttype);
procedure second_cstring_charpointer(p,hp : ptree;convtyp : tconverttype);
begin
clear_location(p^.location);
p^.location.loc:=LOC_REGISTER;
@ -554,14 +516,14 @@ implementation
p^.location.register)));
end;
procedure second_string_chararray(p,hp : ptree;convtyp : tconverttype);
procedure second_string_chararray(p,hp : ptree;convtyp : tconverttype);
begin
inc(p^.location.reference.offset);
end;
procedure second_array_to_pointer(p,hp : ptree;convtyp : tconverttype);
procedure second_array_to_pointer(p,hp : ptree;convtyp : tconverttype);
begin
del_reference(p^.left^.location.reference);
clear_location(p^.location);
@ -571,8 +533,8 @@ implementation
p^.location.register)));
end;
procedure second_pointer_to_array(p,hp : ptree;convtyp : tconverttype);
procedure second_pointer_to_array(p,hp : ptree;convtyp : tconverttype);
begin
clear_location(p^.location);
p^.location.loc:=LOC_REFERENCE;
@ -597,13 +559,12 @@ implementation
end;
end;
{ generates the code for the type conversion from an array of char }
{ to a string }
procedure second_chararray_to_string(p,hp : ptree;convtyp : tconverttype);
var
l : longint;
begin
{ this is a type conversion which copies the data, so we can't }
{ return a reference }
@ -634,8 +595,8 @@ implementation
dec(p^.location.reference.offset);
end;
procedure second_char_to_string(p,hp : ptree;convtyp : tconverttype);
procedure second_char_to_string(p,hp : ptree;convtyp : tconverttype);
begin
clear_location(p^.location);
p^.location.loc:=LOC_MEM;
@ -650,12 +611,11 @@ implementation
p^.right:=nil;
end;
procedure second_int_real(p,hp : ptree;convtyp : tconverttype);
procedure second_int_real(p,hp : ptree;convtyp : tconverttype);
var
r : preference;
hregister : tregister;
begin
{ for u32bit a solution is to push $0 and to load a comp }
{ does this first, it destroys maybe EDI }
@ -705,13 +665,11 @@ implementation
p^.location.loc:=LOC_FPU;
end;
procedure second_real_fix(p,hp : ptree;convtyp : tconverttype);
procedure second_real_fix(p,hp : ptree;convtyp : tconverttype);
var
{hs : string;}
rreg : tregister;
ref : treference;
begin
{ real must be on fpu stack }
if (p^.left^.location.loc<>LOC_FPU) then
@ -745,8 +703,8 @@ implementation
p^.location.register:=rreg;
end;
procedure second_float_float(p,hp : ptree;convtyp : tconverttype);
procedure second_float_float(p,hp : ptree;convtyp : tconverttype);
begin
case p^.left^.location.loc of
LOC_FPU : ;
@ -763,13 +721,13 @@ implementation
p^.location.loc:=LOC_FPU;
end;
procedure second_fix_real(p,hp : ptree;convtyp : tconverttype);
var popeax,popebx,popecx,popedx : boolean;
procedure second_fix_real(p,hp : ptree;convtyp : tconverttype);
var
popeax,popebx,popecx,popedx : boolean;
startreg : tregister;
hl : plabel;
r : treference;
begin
if (p^.left^.location.loc=LOC_REGISTER) or
(p^.left^.location.loc=LOC_CREGISTER) then
@ -841,12 +799,10 @@ implementation
p^.location.loc:=LOC_FPU;
end;
procedure second_int_fix(p,hp : ptree;convtyp : tconverttype);
var
{hs : string;}
hregister : tregister;
begin
if (p^.left^.location.loc=LOC_REGISTER) then
hregister:=p^.left^.location.register
@ -878,26 +834,25 @@ implementation
end;
procedure second_proc_to_procvar(p,hp : ptree;convtyp : tconverttype);
begin
clear_location(p^.location);
p^.location.loc:=LOC_REGISTER;
del_reference(hp^.location.reference);
p^.location.register:=getregister32;
exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
procedure second_proc_to_procvar(p,hp : ptree;convtyp : tconverttype);
begin
clear_location(p^.location);
p^.location.loc:=LOC_REGISTER;
del_reference(hp^.location.reference);
p^.location.register:=getregister32;
exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
newreference(hp^.location.reference),p^.location.register)));
end;
end;
procedure second_bool_to_int(p,hp : ptree;convtyp : tconverttype);
procedure second_bool_to_int(p,hp : ptree;convtyp : tconverttype);
var
oldtruelabel,oldfalselabel,hlabel : plabel;
hregister : tregister;
newsize,
opsize : topsize;
op : tasmop;
begin
begin
oldtruelabel:=truelabel;
oldfalselabel:=falselabel;
getlabel(truelabel);
@ -1001,13 +956,13 @@ implementation
freelabel(falselabel);
truelabel:=oldtruelabel;
falselabel:=oldfalselabel;
end;
end;
procedure second_int_to_bool(p,hp : ptree;convtyp : tconverttype);
var
procedure second_int_to_bool(p,hp : ptree;convtyp : tconverttype);
var
hregister : tregister;
begin
begin
clear_location(p^.location);
p^.location.loc:=LOC_REGISTER;
del_reference(hp^.location.reference);
@ -1041,7 +996,7 @@ implementation
else
internalerror(10064);
end;
end;
end;
procedure second_load_smallset(p,hp : ptree;convtyp : tconverttype);
@ -1062,12 +1017,11 @@ implementation
p^.location.reference:=href;
end;
procedure second_ansistring_to_pchar(p,hp : ptree;convtyp : tconverttype);
procedure second_ansistring_to_pchar(p,hp : ptree;convtyp : tconverttype);
var
l1,l2 : plabel;
hr : preference;
begin
clear_location(p^.location);
p^.location.loc:=LOC_REGISTER;
@ -1160,10 +1114,12 @@ implementation
end;
end;
procedure second_nothing(p,hp : ptree;convtyp : tconverttype);
begin
end;
{****************************************************************************
SecondTypeConv
****************************************************************************}
@ -1330,7 +1286,11 @@ implementation
end.
{
$Log$
Revision 1.30 1998-10-27 11:12:45 peter
Revision 1.31 1998-11-05 12:02:30 peter
* released useansistring
* removed -Sv, its now available in fpc modes
Revision 1.30 1998/10/27 11:12:45 peter
* fixed char_to_string which did not set the .loc
Revision 1.29 1998/10/26 15:18:41 peter

26
compiler/cg386con.pas
View File

@ -137,9 +137,7 @@ implementation
procedure secondstringconst(var p : ptree);
var
hp1 : pai;
{$ifdef UseAnsiString}
l1,
{$endif}
lastlabel : plabel;
pc : pchar;
same_string : boolean;
@ -163,22 +161,12 @@ implementation
{ currently, this is no problem, because }
{ typed consts have no leading length or }
{ they have no trailing zero }
{$ifdef UseAnsiString}
if (hp1^.typ=ait_string) and (lastlabel<>nil) and
(pai_string(hp1)^.len=p^.length+2) then
{$else UseAnsiString}
if (hp1^.typ=ait_string) and (lastlabel<>nil) and
(pai_string(hp1)^.len=length(p^.value_str^)+2) then
{$endif UseAnsiString}
begin
same_string:=true;
{$ifndef UseAnsiString}
for i:=0 to length(p^.value_str^) do
if pai_string(hp1)^.str[i]<>p^.value_str^[i] then
{$else}
for i:=0 to p^.length do
if pai_string(hp1)^.str[i]<>p^.value_str[i] then
{$endif}
begin
same_string:=false;
break;
@ -202,13 +190,6 @@ implementation
if (cs_smartlink in aktmoduleswitches) then
consts^.concat(new(pai_cut,init));
consts^.concat(new(pai_label,init(lastlabel)));
{$ifndef UseAnsiString}
getmem(pc,length(p^.value_str^)+3);
move(p^.value_str^,pc^,length(p^.value_str^)+1);
pc[length(p^.value_str^)+1]:=#0;
{ 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^.value_str^)+2)));
{$else UseAnsiString}
{ generate an ansi string ? }
case p^.stringtype of
st_ansistring:
@ -249,7 +230,6 @@ implementation
end;
end;
end;
{$endif UseAnsiString}
end;
end;
clear_reference(p^.location.reference);
@ -325,7 +305,11 @@ implementation
end.
{
$Log$
Revision 1.16 1998-11-04 21:07:43 michael
Revision 1.17 1998-11-05 12:02:32 peter
* released useansistring
* removed -Sv, its now available in fpc modes
Revision 1.16 1998/11/04 21:07:43 michael
* undid peters change. Constant ansistrings should end on null too cd ..
Revision 1.15 1998/11/04 10:11:36 peter

10
compiler/cg386inl.pas
View File

@ -498,7 +498,7 @@ implementation
,false,0
);
disposetree(hp);
if codegenerror then
exit;
@ -687,10 +687,8 @@ implementation
secondpass(p^.left);
set_location(p^.location,p^.left^.location);
{ length in ansi strings is at offset -8 }
{$ifdef UseAnsiString}
if is_ansistring(p^.left^.resulttype) then
dec(p^.location.reference.offset,8);
{$endif UseAnsiString}
end;
in_pred_x,
in_succ_x:
@ -964,7 +962,11 @@ implementation
end.
{
$Log$
Revision 1.16 1998-10-22 17:11:13 pierre
Revision 1.17 1998-11-05 12:02:33 peter
* released useansistring
* removed -Sv, its now available in fpc modes
Revision 1.16 1998/10/22 17:11:13 pierre
+ terminated the include exclude implementation for i386
* enums inside records fixed

11
compiler/cg386ld.pas
View File

@ -339,7 +339,6 @@ implementation
{$endif test_dest_loc}
if p^.left^.resulttype^.deftype=stringdef then
begin
{$ifdef UseAnsiString}
if is_ansistring(p^.left^.resulttype) then
begin
{ the source and destinations are released
@ -349,16 +348,12 @@ implementation
loadansistring(p);
end
else
{$endif UseAnsiString}
if is_shortstring(p^.left^.resulttype) and
not (p^.concat_string) then
begin
{$ifdef UseAnsiString}
if is_ansistring(p^.right^.resulttype) then
loadansi2short(p^.right,p^.left)
else
{$endif UseAnsiString}
begin
{ we do not need destination anymore }
del_reference(p^.left^.location.reference);
@ -733,7 +728,11 @@ implementation
end.
{
$Log$
Revision 1.24 1998-10-14 08:47:14 pierre
Revision 1.25 1998-11-05 12:02:35 peter
* released useansistring
* removed -Sv, its now available in fpc modes
Revision 1.24 1998/10/14 08:47:14 pierre
* bugs in secondfuncret for result in subprocedures removed
Revision 1.23 1998/10/06 17:16:44 pierre

42
compiler/cg68kcnv.pas
View File

@ -446,13 +446,10 @@ implementation
procedure second_string_string(p,hp : ptree;convtyp : tconverttype);
{$ifdef UseAnsiString}
var
pushed : tpushed;
{$endif UseAnsiString}
begin
{$ifdef UseAnsiString}
{ does anybody know a better solution than this big case statement ? }
{ ok, a proc table would do the job }
case pstringdef(p)^.string_typ of
@ -563,39 +560,6 @@ implementation
end;
end;
end;
{$ifdef dummy}
if is_ansistring(p^.resulttype) and not is_ansistring(p^.left^.resulttype) then
begin
{ call shortstring to ansistring conversion }
{ result is in register }
del_reference(p^.left^.location.reference);
{!!!!
copyshortstringtoansistring(p^.location,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
}
ungetiftemp(p^.left^.location.reference);
end
else if not is_ansistring(p^.resulttype) and is_ansistring(p^.left^.resulttype) then
begin
{ call ansistring to shortstring conversion }
{ result is in mem }
stringdispose(p^.location.reference.symbol);
gettempofsizereference(p^.resulttype^.size,p^.location.reference);
if p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE] then
del_reference(p^.left^.location.reference);
copyansistringtoshortstring(p^.location.reference,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
ungetiftemp(p^.left^.location.reference);
end
else
{$endif dummy}
{$else UseAnsiString}
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;
{$endif UseAnsiString}
end;
procedure second_cstring_charpointer(p,hp : ptree;convtyp : tconverttype);
@ -1398,7 +1362,11 @@ implementation
end.
{
$Log$
Revision 1.10 1998-10-15 12:41:17 pierre
Revision 1.11 1998-11-05 12:02:36 peter
* released useansistring
* removed -Sv, its now available in fpc modes
Revision 1.10 1998/10/15 12:41:17 pierre
* last memory leaks found when compiler
a native atari compiler fixed

46
compiler/cg68kcon.pas
View File

@ -137,9 +137,7 @@ implementation
procedure secondstringconst(var p : ptree);
var
hp1 : pai;
{$ifdef UseAnsiString}
l1,
{$endif}
lastlabel : plabel;
pc : pchar;
same_string : boolean;
@ -163,22 +161,12 @@ implementation
{ currently, this is no problem, because }
{ typed consts have no leading length or }
{ they have no trailing zero }
{$ifdef UseAnsiString}
if (hp1^.typ=ait_string) and (lastlabel<>nil) and
(pai_string(hp1)^.len=p^.length+2) then
{$else UseAnsiString}
if (hp1^.typ=ait_string) and (lastlabel<>nil) and
(pai_string(hp1)^.len=length(p^.value_str^)+2) then
{$endif UseAnsiString}
begin
same_string:=true;
{$ifndef UseAnsiString}
for i:=0 to length(p^.value_str^) do
if pai_string(hp1)^.str[i]<>p^.value_str^[i] then
{$else}
for i:=0 to p^.length do
if pai_string(hp1)^.str[i]<>p^.value_str[i] then
{$endif}
begin
same_string:=false;
break;
@ -202,13 +190,6 @@ implementation
if (cs_smartlink in aktmoduleswitches) then
consts^.concat(new(pai_cut,init));
consts^.concat(new(pai_label,init(lastlabel)));
{$ifndef UseAnsiString}
getmem(pc,length(p^.value_str^)+3);
move(p^.value_str^,pc^,length(p^.value_str^)+1);
pc[length(p^.value_str^)+1]:=#0;
{ 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^.value_str^)+2)));
{$else UseAnsiString}
{ generate an ansi string ? }
case p^.stringtype of
st_ansistring:
@ -226,6 +207,7 @@ 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)));
@ -233,15 +215,21 @@ implementation
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}
end;
end;
clear_reference(p^.location.reference);
@ -317,7 +305,11 @@ implementation
end.
{
$Log$
Revision 1.2 1998-09-07 18:45:56 peter
Revision 1.3 1998-11-05 12:02:37 peter
* released useansistring
* removed -Sv, its now available in fpc modes
Revision 1.2 1998/09/07 18:45:56 peter
* update smartlinking, uses getdatalabel
* renamed ptree.value vars to value_str,value_real,value_set

10
compiler/cg68kinl.pas
View File

@ -449,7 +449,7 @@ implementation
dummycoll.paratyp:=vs_const;
disposetree(hp);
p^.left:=nil;
{ second arg }
hp:=node;
node:=node^.right;
@ -660,10 +660,8 @@ implementation
secondpass(p^.left);
set_location(p^.location,p^.left^.location);
{ length in ansi strings is at offset -8 }
{$ifdef UseAnsiString}
if is_ansistring(p^.left^.resulttype) then
dec(p^.location.reference.offset,8);
{$endif UseAnsiString}
end;
in_pred_x,
in_succ_x:
@ -900,7 +898,11 @@ implementation
end.
{
$Log$
Revision 1.13 1998-10-22 17:11:14 pierre
Revision 1.14 1998-11-05 12:02:38 peter
* released useansistring
* removed -Sv, its now available in fpc modes
Revision 1.13 1998/10/22 17:11:14 pierre
+ terminated the include exclude implementation for i386
* enums inside records fixed

2
compiler/msgidx.inc
View File

@ -475,6 +475,7 @@ type tmsgconst=(
option_too_less_endif,
option_no_debug_support,
option_no_debug_support_recompile_fpc,
option_obsolete_switch,
option_logo_start,
option_logo_end,
option_info_start,
@ -544,7 +545,6 @@ type tmsgconst=(
ol053,
ol054,
ol055,
ol056,
ol057,
ol058,
ol059,

71
compiler/msgtxt.inc
View File

@ -490,123 +490,124 @@ const msgtxt : array[0..00094,1..240] of char=(
'F_open conditional at the end of the file'#000+
'W_Debug information generation is not supported by this executable'#000+
'H_Try recompiling with -dGDB'#000+
'Free Pascal Compiler version $','FPCVER [$FPCDATE] for $FPCTARGET'#000+
'W_You are using the obsolete s','witch $1'#000+
'Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET'#000+
'Copyright (c) 1993-98 by Florian Klaempfl'#000+
'Free Pascal Compiler version $FPCVER'#000+
#000+
'Compiler Date : $FPCDATE'#000+
'Compiler Target: $FPCTARGET'#000+
#000+
'This program comes under the GNU General Public Licence'#000+
'For more informa','tion read COPYING.FPC'#000+
'This program comes under the GNU ','General Public Licence'#000+
'For more information read COPYING.FPC'#000+
#000+
'Report bugs,suggestions etc to:'#000+
' fpc-devel@mail.tolna.hungary.net'#000+
'**0*_+ switch option on, - off'#000+
'**1a_the compiler doesn'#039't delete the generated assembler file'#000+
'**2al_list sourcecode lines in assembler fi','le'#000+
'**0*_put + after a boolean switch option to enable it, - to disable it'+
#000+
'**1a_the compiler doesn'#039't ','delete the generated assembler file'#000+
'**2al_list sourcecode lines in assembler file'#000+
'*t1b_use EMS'#000+
'**1B_build all modules'#000+
'**1C_code generation options'#000+
'3*2CD_create dynamic library'#000+
'**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#000+
'**2Ci_IO-checking'#000+
'**2Ci_IO-che','cking'#000+
'**2Cn_omit linking stage'#000+
'**2Co_check overflow of integer operations'#000+
'**2Cr','_range checking'#000+
'**2Cr_range checking'#000+
'**2Cs<n>_set stack size to <n>'#000+
'**2Ct_stack checking'#000+
'3*2CS_create static library'#000+
'3*2Cx_use smartlinking'#000+
'**1d<x>_defines the symbol <x>'#000+
'*O1D_generate a DEF file'#000+
'*O1D_genera','te a DEF file'#000+
'*O2Dd<x>_set description to <x>'#000+
'*O2Dw_PM application'#000+
'**1e<x>_set ','path to executable'#000+
'**1e<x>_set path to executable'#000+
'**1E_same as -Cn'#000+
'**1F_set file names and paths'#000+
'**2FD<x>_sets the directory where to search for compiler utilities'#000+
'**2Fe<x>_redirect error output to <x>'#000+
'**2Fe<x>_redirect error outp','ut to <x>'#000+
'**2FE<x>_set exe/unit output path to <x>'#000+
'*L2Fg<x>_same as -Fl'#000+
'**2Fi<x','>_adds <x> to include path'#000+
'**2Fi<x>_adds <x> to include path'#000+
'**2Fl<x>_adds <x> to library path'#000+
'*L2FL<x>_uses <x> as dynamic linker'#000+
'**2Fo<x>_adds <x> to object path'#000+
'**2Fr<x>_load error message file <x>'#000+
'**2Fr<x>_load error message fil','e <x>'#000+
'**2Fu<x>_adds <x> to unit path'#000+
'**2FU<x>_set unit output path to <x>, over','rides -FE'#000+
'**2FU<x>_set unit output path to <x>, overrides -FE'#000+
'*g1g_generate debugger information'#000+
'*g2gg_use gsym'#000+
'*g2gd_use dbx'#000+
'**1i_information'#000+
'**1I<x>_adds <x> to include path'#000+
'**1k<x>_Pass <x> to the linker'#000+
'**1l_write logo'#000+
'**1l_w','rite logo'#000+
'**1n_don'#039't read the default config file'#000+
'**1o<x>_change the name of th','e executable produced to <x>'#000+
'**1o<x>_change the name of the executable produced to <x>'#000+
'**1pg_generate profile code for gprof'#000+
'*L1P_use pipes instead of creating temporary assembler files'#000+
'**1S_syntax options'#000+
'**2S2_switch some Delphi 2 extensions on'#000+
'**2S2_switch ','some Delphi 2 extensions on'#000+
'**2Sc_supports operators like C (*=,+=,/= and -=)'#000+
'*','*2Sd_tries to be Delphi compatible'#000+
'**2Sd_tries to be Delphi compatible'#000+
'**2Se_compiler stops after the first error'#000+
'**2Sg_allow LABEL and GOTO'#000+
'**2Si_support C++ stlyed INLINE'#000+
'**2Sm_support macros like C (global)'#000+
'**2Sm_support macros lik','e C (global)'#000+
'**2So_tries to be TP/BP 7.0 compatible'#000+
'**2Sp_tries to be gpc compa','tible'#000+
'**2Sp_tries to be gpc compatible'#000+
'**2Ss_constructor name must be init (destructor must be done)'#000+
'**2St_allow static keyword in objects'#000+
'**2Sv_allow variable directives (cvar,external,public,export)'#000+
'**1s_don'#039't call assembler and linker (only with -a)'#000+
'**1u<x>_undefines th','e symbol <x>'#000+
'**1','u<x>_undefines the symbol <x>'#000+
'**1U_unit options'#000+
'**2Un_don'#039't check the unit name'#000+
'**2Up<x>_same as -Fu<x>'#000+
'**2Us_compile a system unit'#000+
'**1v<x>_Be verbose. <x> is a combination of the following letters :'#000+
'**2*_e : Show errors (default) d : Show debug info'#000,+
'**2*_e : Show errors (default) d :',' Show debug info'#000+
'**2*_w : Show warnings u : Show unit info'#000+
'**2*_n : Show notes t : Show tried/used files'#000+
'**2*_h : Show hints m : Show defined macros'#000+
'**2*_i : Show general info p : Show compiled proce','dures'#000+
'**2*_i : Show general info p : Sh','ow compiled procedures'#000+
'**2*_l : Show linenumbers c : Show conditionals'#000+
'**2*_a : Show everything 0 : Show nothing (except errors)'#000+
'**2*_b : Show all procedure r : Rhide/GCC compatibility mode'#000+
'**2*_ declarations if an error ',' x : Executable info (Win32 only'+
'**2*_ declarati','ons if an error x : Executable info (Win32 only'+
')'#000+
'**2*_ occurs'#000+
'**1X_executable options'#000+
'*L2Xc_link with the c library'#000+
'**2XD_link with dynamic libraries (defines FPC_LINK_DYNAMIC)'#000+
'**2Xs_strip all symbols from executable'#000+
'**2XS_link with static libraries (','defines FPC_LINK_STATIC)'#000+
'**2XS_link with s','tatic libraries (defines FPC_LINK_STATIC)'#000+
'**0*_Processor specific options:'#000+
'3*1A<x>_output format'#000+
'3*2Ao_coff file using GNU AS'#000+
'3*2Anasmcoff_coff file using Nasm'#000+
'3*2Anasmelf_elf32 (linux) file using Nasm'#000+
'3*2Anasmobj_obj file using Nasm'#000+
'3*2Amasm_obj using Masm',' (Mircosoft)'#000+
'3*2Ama','sm_obj using Masm (Mircosoft)'#000+
'3*2Atasm_obj using Tasm (Borland)'#000+
'3*1R<x>_assembler reading style'#000+
'3*2Ratt_read AT&T style assembler'#000+
'3*2Rintel_read Intel style assembler'#000+
'3*2Rdirect_copy assembler text directly to assembler file'#000+
'3*1O<x>_optimizations'#000+
'3*2Og_gene','rate smaller code'#000+
'3*1O<x>_optimiz','ations'#000+
'3*2Og_generate smaller code'#000+
'3*2OG_generate faster code (default)'#000+
'3*2Or_keep certain variables in registers (still BUGGY!!!)'#000+
'3*2Ou_enable uncertain optimizations (see docs)'#000+
'3*2O1_level 1 optimizations (quick optimizations)'#000+
'3*2O2_level 2 optimizations ','(-O1 + slower optimizations)'#000+
'3*2O2_level',' 2 optimizations (-O1 + slower optimizations)'#000+
'3*2O3_level 3 optimizations (same as -O2u)'#000+
'3*2Op_target processor'#000+
'3*3Op1_set target processor to 386/486'#000+
'3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#000+
'3*3Op3_set target processor to PPro/PII/c6x86/K6 (t','m)'#000+
'3*3Op3_set target processor to PPr','o/PII/c6x86/K6 (tm)'#000+
'3*1T<x>_Target operating system'#000+
'3*2TGO32V1_version 1 of DJ Delorie DOS extender'#000+
'3*2TGO32V2_version 2 of DJ Delorie DOS extender'#000+
@ -614,7 +615,7 @@ const msgtxt : array[0..00094,1..240] of char=(
'3*2TOS2_OS/2 2.x'#000+
'3*2TWin32_Windows 32 Bit'#000+
'6*1A<x>_output format'#000+
'6*2Ao_Unix o-file using GNU A','S'#000+
'6*2Ao_Unix o','-file using GNU AS'#000+
'6*2Agas_GNU Motorola assembler'#000+
'6*2Amit_MIT Syntax (old GAS)'#000+
'6*2Amot_Standard Motorola assembler'#000+
@ -622,15 +623,15 @@ const msgtxt : array[0..00094,1..240] of char=(
'6*2Oa_turn on the optimizer'#000+
'6*2Og_generate smaller code'#000+
'6*2OG_generate faster code (default)'#000+
'6*2Ox_optimize maximum (still ','BUGGY!!!)'#000+
'6*2Ox_optimiz','e maximum (still BUGGY!!!)'#000+
'6*2O2_set target processor to a MC68020+'#000+
'6*1R<x>_assembler reading style'#000+
'6*2RMOT_read motorola style assembler'#000+
'6*1T<x>_Target operating system'#000+
'6*2TAMIGA_Commodore Amiga'#000+
'6*2TATARI_Atari ST/STe/TT'#000+
'6*2TMACOS_Macintosh m68k'#000+
'6*2TLINUX_','Linux-68k'#000+
'6*2TMACOS_Macintos','h m68k'#000+
'6*2TLINUX_Linux-68k'#000+
'**1*_'#000+
'**1?_shows this help'#000+
'**1h_shows this help without waiting'#000

50
compiler/pdecl.pas
View File

@ -117,9 +117,7 @@ unit pdecl;
old_block_type : tblock_type;
ps : pconstset;
pd : pbestreal;
{$ifdef USEANSISTRING}
sp : pstring;
{$endif USEANSISTRING}
begin
consume(_CONST);
old_block_type:=block_type;
@ -152,27 +150,27 @@ unit pdecl;
else internalerror(111);
end;
stringconstn:
{value_str is disposed with p so I need a copy !}
{$ifdef USEANSISTRING} begin
begin
{ value_str is disposed with p so I need a copy }
getmem(sp,p^.length+1);
move(p^.value_str^,sp^[1],p^.length);
sp^[0]:=chr(p^.length);
symtablestack^.insert(new(pconstsym,init(name,conststring,longint(sp),nil)));
end;
{$else USEANSISTRING}
symtablestack^.insert(new(pconstsym,init(name,conststring,longint(stringdup(p^.value_str^)),nil)));
{$endif USEANSISTRING}
realconstn : begin
new(pd);
pd^:=p^.value_real;
symtablestack^.insert(new(pconstsym,init(name,constreal,longint(pd),nil)));
end;
setconstn : begin
new(ps);
ps^:=p^.value_set^;
symtablestack^.insert(new(pconstsym,init(name,constset,longint(ps),p^.resulttype)));
end;
else Message(cg_e_illegal_expression);
realconstn :
begin
new(pd);
pd^:=p^.value_real;
symtablestack^.insert(new(pconstsym,init(name,constreal,longint(pd),nil)));
end;
setconstn :
begin
new(ps);
ps^:=p^.value_set^;
symtablestack^.insert(new(pconstsym,init(name,constset,longint(ps),p^.resulttype)));
end;
else
Message(cg_e_illegal_expression);
end;
tokenpos:=storetokenpos;
consume(SEMICOLON);
@ -392,7 +390,7 @@ unit pdecl;
if not symdone and (token=ID) then
begin
{ Check for C Variable declarations }
if (cs_support_c_var in aktmoduleswitches) and
if (m_cvar_support in aktmodeswitches) and
not(is_record or is_object) and
(idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) then
begin
@ -558,9 +556,9 @@ unit pdecl;
if p^.value>255 then
d:=new(pstringdef,longinit(p^.value))
else if p^.value<>255 then
d:=new(pstringdef,init(p^.value))
d:=new(pstringdef,shortinit(p^.value))
{$ifndef GDB}
else d:=new(pstringdef,init(255));
else d:=new(pstringdef,shortinit(255));
{$else GDB}
else d:=globaldef('STRING');
{$endif GDB}
@ -574,7 +572,7 @@ unit pdecl;
d:=new(pstringdef,ansiinit(0))
else
{$ifndef GDB}
d:=new(pstringdef,init(255));
d:=new(pstringdef,shortinit(255));
{$else GDB}
d:=globaldef('STRING');
{$endif GDB}
@ -1128,7 +1126,7 @@ unit pdecl;
{ all classes must have a vmt !! at offset zero }
if (aktclass^.options and oo_hasvmt)=0 then
aktclass^.insertvmt;
object_dec:=aktclass;
exit;
end;
@ -2088,7 +2086,11 @@ unit pdecl;
end.
{
$Log$
Revision 1.78 1998-10-27 13:45:33 pierre
Revision 1.79 1998-11-05 12:02:51 peter
* released useansistring
* removed -Sv, its now available in fpc modes
Revision 1.78 1998/10/27 13:45:33 pierre
* classes get a vmt allways
* better error info (tried to remove
several error strings introduced by the tpexcept handling)

12
compiler/pexpr.pas
View File

@ -357,7 +357,7 @@ unit pexpr;
break;
end;
consume(RKLAMMER);
pd:=cstringdef;
pd:=cshortstringdef;
statement_syssym:=p2;
end;
@ -1896,18 +1896,18 @@ unit pexpr;
Message(cg_e_illegal_expression);
end
else
{$ifdef UseAnsiString}
get_stringconst:=strpas(p^.value_str);
{$else UseAnsiString}
get_stringconst:=p^.value_str^;
{$endif UseAnsiString}
disposetree(p);
end;
end.
{
$Log$
Revision 1.72 1998-11-04 10:11:41 peter
Revision 1.73 1998-11-05 12:02:52 peter
* released useansistring
* removed -Sv, its now available in fpc modes
Revision 1.72 1998/11/04 10:11:41 peter
* ansistring fixes
Revision 1.71 1998/10/22 23:57:29 peter

14
compiler/pp.pas
View File

@ -249,10 +249,10 @@ end;
begin
oldexit:=exitproc;
exitproc:=@myexit;
{$ifndef TP}
{$ifndef UseAnsiString}
heapblocks:=true;
{$endif not UseAnsiString}
{$ifdef fpc}
{$ifndef autoobjpas}
heapblocks:=true;
{$endif}
{$endif}
{$ifdef UseOverlay}
InitOverlay;
@ -263,7 +263,11 @@ begin
end.
{
$Log$
Revision 1.34 1998-10-14 11:28:24 florian
Revision 1.35 1998-11-05 12:02:53 peter
* released useansistring
* removed -Sv, its now available in fpc modes
Revision 1.34 1998/10/14 11:28:24 florian
* emitpushreferenceaddress gets now the asmlist as parameter
* m68k version compiles with -duseansistrings

22
compiler/psystem.pas
View File

@ -89,10 +89,8 @@ begin
p^.insert(new(ptypesym,init('s80real',s80floatdef)));
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('string',cshortstringdef)));
p^.insert(new(ptypesym,init('shortstring',cshortstringdef)));
p^.insert(new(ptypesym,init('longstring',clongstringdef)));
p^.insert(new(ptypesym,init('ansistring',cansistringdef)));
p^.insert(new(ptypesym,init('widestring',cwidestringdef)));
@ -122,10 +120,8 @@ begin
{$endif}
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('STRING',cshortstringdef)));
p^.insert(new(ptypesym,init('SHORTSTRING',cshortstringdef)));
p^.insert(new(ptypesym,init('LONGSTRING',clongstringdef)));
p^.insert(new(ptypesym,init('ANSISTRING',cansistringdef)));
p^.insert(new(ptypesym,init('WIDESTRING',cwidestringdef)));
@ -175,7 +171,7 @@ procedure readconstdefs;
begin
s32bitdef:=porddef(globaldef('longint'));
u32bitdef:=porddef(globaldef('ulong'));
cstringdef:=pstringdef(globaldef('string'));
cshortstringdef:=pstringdef(globaldef('shortstring'));
clongstringdef:=pstringdef(globaldef('longstring'));
cansistringdef:=pstringdef(globaldef('ansistring'));
cwidestringdef:=pstringdef(globaldef('widestring'));
@ -214,7 +210,7 @@ begin
s32bitdef:=new(porddef,init(s32bit,$80000000,$7fffffff));
booldef:=new(porddef,init(bool8bit,0,1));
cchardef:=new(porddef,init(uchar,0,255));
cstringdef:=new(pstringdef,init(255));
cshortstringdef:=new(pstringdef,shortinit(255));
{ should we give a length to the default long and ansi string definition ?? }
clongstringdef:=new(pstringdef,longinit(-1));
cansistringdef:=new(pstringdef,ansiinit(-1));
@ -241,7 +237,11 @@ end;
end.
{
$Log$
Revision 1.8 1998-11-04 10:11:44 peter
Revision 1.9 1998-11-05 12:02:54 peter
* released useansistring
* removed -Sv, its now available in fpc modes
Revision 1.8 1998/11/04 10:11:44 peter
* ansistring fixes
Revision 1.7 1998/10/05 12:32:48 peter

31
compiler/ptconst.pas
View File

@ -54,9 +54,7 @@ unit ptconst;
{$ifdef m68k}
j : longint;
{$endif m68k}
{$ifdef useansistring}
len : longint;
{$endif}
p,hp : ptree;
i,l,offset,
strlength : longint;
@ -313,7 +311,6 @@ unit ptconst;
begin
if p^.treetype=stringconstn then
begin
{$ifdef UseAnsiString}
if p^.length>=def^.size then
strlength:=def^.size-1
else
@ -324,18 +321,6 @@ unit ptconst;
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
strlength:=def^.size-1;
generate_ascii(datasegment,char(strlength)+copy(p^.value_str^,1,strlength));
end
else
begin
strlength:=length(p^.value_str^);
generate_ascii(datasegment,char(strlength)+p^.value_str^);
end;
{$endif UseAnsiString}
end
else if is_constcharnode(p) then
begin
@ -351,12 +336,8 @@ unit ptconst;
{ 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 }
generate_pascii(datasegment,ca,def^.size-strlength-1);
{$else UseAnsiString}
datasegment^.concat(new(pai_string,init_pchar(ca)));
{$endif UseAnsiString}
end;
end;
{$ifdef UseLongString}
@ -385,7 +366,6 @@ unit ptconst;
datasegment^.concat(new(pai_const,init_8bit(0)));
end;
{$endif UseLongString}
{$ifdef UseAnsiString}
st_ansistring:
begin
{ an empty ansi string is nil! }
@ -426,7 +406,6 @@ unit ptconst;
consts^.concat(new(pai_const,init_8bit(0)));
end;
end;
{$endif UseAnsiString}
end;
disposetree(p);
end;
@ -449,16 +428,12 @@ unit ptconst;
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^
{$endif}
end
else
if is_constcharnode(p) then
@ -649,7 +624,11 @@ unit ptconst;
end.
{
$Log$
Revision 1.23 1998-11-04 10:11:45 peter
Revision 1.24 1998-11-05 12:02:55 peter
* released useansistring
* removed -Sv, its now available in fpc modes
Revision 1.23 1998/11/04 10:11:45 peter
* ansistring fixes
Revision 1.22 1998/10/20 08:06:56 pierre

12
compiler/symdef.inc
View File

@ -167,7 +167,7 @@
st^.registerdef(@self);
end;
end;
procedure tdef.write;
begin
@ -416,7 +416,7 @@
TSTRINGDEF
****************************************************************************}
constructor tstringdef.init(l : byte);
constructor tstringdef.shortinit(l : byte);
begin
tdef.init;
string_typ:=st_shortstring;
@ -426,7 +426,7 @@
end;
constructor tstringdef.load;
constructor tstringdef.shortload;
begin
tdef.load;
string_typ:=st_shortstring;
@ -3200,7 +3200,11 @@
{
$Log$
Revision 1.66 1998-10-26 22:58:22 florian
Revision 1.67 1998-11-05 12:02:56 peter
* released useansistring
* removed -Sv, its now available in fpc modes
Revision 1.66 1998/10/26 22:58:22 florian
* new introduded problem with classes fix, the parent class wasn't set
correct, if the class was defined forward before

10
compiler/symdefh.inc
View File

@ -414,8 +414,8 @@
tstringdef = object(tdef)
string_typ : tstringtype;
len : longint;
constructor init(l : byte);
constructor load;
constructor shortinit(l : byte);
constructor shortload;
constructor longinit(l : longint);
constructor longload;
constructor ansiinit(l : longint);
@ -483,7 +483,11 @@
{
$Log$
Revision 1.6 1998-10-22 17:11:23 pierre
Revision 1.7 1998-11-05 12:02:59 peter
* released useansistring
* removed -Sv, its now available in fpc modes
Revision 1.6 1998/10/22 17:11:23 pierre
+ terminated the include exclude implementation for i386
* enums inside records fixed

94
compiler/tcadd.pas
View File

@ -82,12 +82,8 @@ implementation
i : longint;
b : boolean;
convdone : boolean;
{$ifndef UseAnsiString}
s1,s2:^string;
{$else UseAnsiString}
s1,s2 : pchar;
l1,l2 : longint;
{$endif UseAnsiString}
{ this totally forgets to set the pi_do_call flag !! }
label
@ -262,66 +258,41 @@ implementation
{ concating strings ? }
concatstrings:=false;
{$ifdef UseAnsiString}
s1:=nil;
s2:=nil;
{$else UseAnsiString}
new(s1);
new(s2);
{$endif UseAnsiString}
if (lt=ordconstn) and (rt=ordconstn) and
is_char(ld) and is_char(rd) then
begin
{$ifdef UseAnsiString}
s1:=strpnew(char(byte(p^.left^.value)));
s2:=strpnew(char(byte(p^.right^.value)));
l1:=1;
l2:=1;
{$else UseAnsiString}
s1^:=char(byte(p^.left^.value));
s2^:=char(byte(p^.right^.value));
{$endif UseAnsiString}
concatstrings:=true;
end
else
if (lt=stringconstn) and (rt=ordconstn) and is_char(rd) then
begin
{$ifdef UseAnsiString}
s1:=getpcharcopy(p^.left);
l1:=p^.left^.length;
s2:=strpnew(char(byte(p^.right^.value)));
l2:=1;
{$else UseAnsiString}
s1^:=p^.left^.value_str^;
s2^:=char(byte(p^.right^.value));
{$endif UseAnsiString}
concatstrings:=true;
end
else
if (lt=ordconstn) and (rt=stringconstn) and is_char(ld) then
begin
{$ifdef UseAnsiString}
s1:=strpnew(char(byte(p^.left^.value)));
l1:=1;
s2:=getpcharcopy(p^.right);
l2:=p^.right^.length;
{$else UseAnsiString}
s1^:=char(byte(p^.left^.value));
s2^:=p^.right^.value_str^;
{$endif UseAnsiString}
concatstrings:=true;
end
else if (lt=stringconstn) and (rt=stringconstn) then
begin
{$ifdef UseAnsiString}
s1:=getpcharcopy(p^.left);
l1:=p^.left^.length;
s2:=getpcharcopy(p^.right);
l2:=p^.right^.length;
{$else UseAnsiString}
s1^:=p^.left^.value_str^;
s2^:=p^.right^.value_str^;
{$endif UseAnsiString}
concatstrings:=true;
end;
@ -329,47 +300,28 @@ implementation
if concatstrings then
begin
case p^.treetype of
{$ifndef UseAnsiString}
addn : t:=genstringconstnode(s1^+s2^);
ltn : t:=genordinalconstnode(byte(s1^<s2^),booldef);
lten : t:=genordinalconstnode(byte(s1^<=s2^),booldef);
gtn : t:=genordinalconstnode(byte(s1^>s2^),booldef);
gten : t:=genordinalconstnode(byte(s1^>=s2^),booldef);
equaln : t:=genordinalconstnode(byte(s1^=s2^),booldef);
unequaln : t:=genordinalconstnode(byte(s1^<>s2^),booldef);
{$else UseAnsiString}
addn : t:=genpcharconstnode(
concatansistrings(s1,s2,l1,l2),l1+l2);
ltn : t:=genordinalconstnode(
byte(compareansistrings(s1,s2,l1,l2)<0),booldef);
lten : t:=genordinalconstnode(
byte(compareansistrings(s1,s2,l1,l2)<=0),booldef);
gtn : t:=genordinalconstnode(
byte(compareansistrings(s1,s2,l1,l2)>0),booldef);
gten : t:=genordinalconstnode(
byte(compareansistrings(s1,s2,l1,l2)>=0),booldef);
equaln : t:=genordinalconstnode(
byte(compareansistrings(s1,s2,l1,l2)=0),booldef);
unequaln : t:=genordinalconstnode(
byte(compareansistrings(s1,s2,l1,l2)<>0),booldef);
{$endif UseAnsiString}
addn :
t:=genpcharconstnode(concatansistrings(s1,s2,l1,l2),l1+l2);
ltn :
t:=genordinalconstnode(byte(compareansistrings(s1,s2,l1,l2)<0),booldef);
lten :
t:=genordinalconstnode(byte(compareansistrings(s1,s2,l1,l2)<=0),booldef);
gtn :
t:=genordinalconstnode(byte(compareansistrings(s1,s2,l1,l2)>0),booldef);
gten :
t:=genordinalconstnode(byte(compareansistrings(s1,s2,l1,l2)>=0),booldef);
equaln :
t:=genordinalconstnode(byte(compareansistrings(s1,s2,l1,l2)=0),booldef);
unequaln :
t:=genordinalconstnode(byte(compareansistrings(s1,s2,l1,l2)<>0),booldef);
end;
{$ifdef UseAnsiString}
ansistringdispose(s1,l1);
ansistringdispose(s2,l2);
{$else UseAnsiString}
dispose(s1);
dispose(s2);
{$endif UseAnsiString}
disposetree(p);
firstpass(t);
p:=t;
exit;
end;
{$ifndef UseAnsiString}
dispose(s1);
dispose(s2);
{$endif UseAnsiString}
{ if both are orddefs then check sub types }
if (ld^.deftype=orddef) and (rd^.deftype=orddef) then
@ -424,9 +376,9 @@ implementation
begin
if p^.treetype=addn then
begin
p^.left:=gentypeconvnode(p^.left,cstringdef);
p^.left:=gentypeconvnode(p^.left,cshortstringdef);
firstpass(p^.left);
p^.right:=gentypeconvnode(p^.right,cstringdef);
p^.right:=gentypeconvnode(p^.right,cshortstringdef);
firstpass(p^.right);
{ here we call STRCOPY }
procinfo.flags:=procinfo.flags or pi_do_call;
@ -502,10 +454,10 @@ implementation
else
begin
if not(is_shortstring(rd)) then
p^.right:=gentypeconvnode(p^.right,cstringdef);
p^.right:=gentypeconvnode(p^.right,cshortstringdef);
if not(is_shortstring(ld)) then
p^.left:=gentypeconvnode(p^.left,cstringdef);
p^.resulttype:=cstringdef;
p^.left:=gentypeconvnode(p^.left,cshortstringdef);
p^.resulttype:=cshortstringdef;
{ this is only for add, the comparisaion is handled later }
p^.location.loc:=LOC_MEM;
end;
@ -950,7 +902,7 @@ implementation
(p^.right^.resulttype^.deftype=stringdef) then
begin
if not assigned(p^.resulttype) then
p^.resulttype:=cstringdef
p^.resulttype:=cshortstringdef
{ the rest is done before }
end
else
@ -966,7 +918,11 @@ implementation
end.
{
$Log$
Revision 1.10 1998-11-04 10:11:46 peter
Revision 1.11 1998-11-05 12:03:02 peter
* released useansistring
* removed -Sv, its now available in fpc modes
Revision 1.10 1998/11/04 10:11:46 peter
* ansistring fixes
Revision 1.9 1998/10/25 23:32:04 peter

8
compiler/tccnv.pas
View File

@ -428,7 +428,7 @@ implementation
procedure first_cchar_charpointer(var p : ptree);
begin
p^.left:=gentypeconvnode(p^.left,cstringdef);
p^.left:=gentypeconvnode(p^.left,cshortstringdef);
{ convert constant char to constant string }
firstpass(p^.left);
{ evalute tree }
@ -913,7 +913,11 @@ implementation
end.
{
$Log$
Revision 1.7 1998-10-23 11:58:27 florian
Revision 1.8 1998-11-05 12:03:03 peter
* released useansistring
* removed -Sv, its now available in fpc modes
Revision 1.7 1998/10/23 11:58:27 florian
* better code generation for s:=s+[b] if b is in the range of
a small set and s is also a small set

8
compiler/tccon.pas
View File

@ -87,7 +87,7 @@ implementation
if cs_ansistrings in aktlocalswitches then
p^.resulttype:=cansistringdef
else
p^.resulttype:=cstringdef;
p^.resulttype:=cshortstringdef;
p^.location.loc:=LOC_MEM;
end;
@ -116,7 +116,11 @@ implementation
end.
{
$Log$
Revision 1.1 1998-09-23 20:42:24 peter
Revision 1.2 1998-11-05 12:03:04 peter
* released useansistring
* removed -Sv, its now available in fpc modes
Revision 1.1 1998/09/23 20:42:24 peter
* splitted pass_1
}

16
compiler/tcinl.pas
View File

@ -358,11 +358,9 @@ implementation
end;
in_length_string:
begin
{$ifdef UseAnsiString}
if is_ansistring(p^.left^.resulttype) then
p^.resulttype:=s32bitdef
else
{$endif UseAnsiString}
p^.resulttype:=u8bitdef;
{ wer don't need string conversations here }
if (p^.left^.treetype=typeconvn) and
@ -376,11 +374,7 @@ implementation
{ evaluates length of constant strings direct }
if (p^.left^.treetype=stringconstn) then
begin
{$ifdef UseAnsiString}
hp:=genordinalconstnode(p^.left^.length,s32bitdef);
{$else UseAnsiString}
hp:=genordinalconstnode(length(p^.left^.value_str^),s32bitdef);
{$endif UseAnsiString}
disposetree(p);
firstpass(hp);
p:=hp;
@ -561,7 +555,7 @@ implementation
(parraydef(hp^.left^.resulttype)^.lowrange<>0) and
(parraydef(hp^.left^.resulttype)^.definition^.deftype=orddef) and
(porddef(parraydef(hp^.left^.resulttype)^.definition)^.typ=uchar) then
hp^.left:=gentypeconvnode(hp^.left,cstringdef)
hp^.left:=gentypeconvnode(hp^.left,cshortstringdef)
else
CGMessage(type_e_cant_read_write_type);
end;
@ -838,7 +832,7 @@ implementation
if is_boolean(p^.left^.resulttype) then
begin
{ must always be a string }
p^.left^.right^.left:=gentypeconvnode(p^.left^.right^.left,cstringdef);
p^.left^.right^.left:=gentypeconvnode(p^.left^.right^.left,cshortstringdef);
firstpass(p^.left^.right^.left);
end
else
@ -860,7 +854,11 @@ implementation
end.
{
$Log$
Revision 1.5 1998-10-20 11:16:47 pierre
Revision 1.6 1998-11-05 12:03:05 peter
* released useansistring
* removed -Sv, its now available in fpc modes
Revision 1.5 1998/10/20 11:16:47 pierre
+ length(c) where C is a char is allways 1
Revision 1.4 1998/10/06 20:49:11 peter

78
compiler/tree.pas
View File

@ -215,11 +215,7 @@ unit tree;
funcretn : (funcretprocinfo : pointer;retdef : pdef);
subscriptn : (vs : pvarsym);
vecn : (memindex,memseg:boolean;callunique : boolean);
{$ifdef UseAnsiString}
stringconstn : (value_str : pchar;length : longint; lab_str : plabel;stringtype : tstringtype);
{$else UseAnsiString}
stringconstn : (value_str : pstring; lab_str:plabel;stringtype : tstringtype);
{$endif UseAnsiString}
typeconvn : (convtyp : tconverttype;explizit : boolean);
typen : (typenodetype : pdef);
inlinen : (inlinenumber : longint;inlineconst:boolean);
@ -251,12 +247,10 @@ unit tree;
{ allow pchar or string for defining a pchar node }
function genstringconstnode(const s : string) : ptree;
{$ifdef UseAnsiString}
{ length is required for ansistrings }
function genpcharconstnode(s : pchar;length : longint) : ptree;
{ helper routine for conststring node }
function getpcharcopy(p : ptree) : pchar;
{$endif UseAnsiString}
function genzeronode(t : ttreetyp) : ptree;
function geninlinenode(number : longint;is_const:boolean;l : ptree) : ptree;
@ -338,11 +332,7 @@ unit tree;
asmn : if assigned(p^.p_asm) then
dispose(p^.p_asm,done);
stringconstn : begin
{$ifndef UseAnsiString}
stringdispose(p^.value_str);
{$else UseAnsiString}
ansistringdispose(p^.value_str,p^.length);
{$endif UseAnsiString}
end;
setconstn : begin
if assigned(p^.value_set) then
@ -411,12 +401,8 @@ unit tree;
{ now check treetype }
case p^.treetype of
stringconstn : begin
{$ifdef UseAnsiString}
hp^.value_str:=getpcharcopy(p);
hp^.length:=p^.length;
{$else UseAnsiString}
hp^.value_str:=stringdup(p^.value_str^);
{$endif UseAnsiString}
end;
setconstn : begin
new(hp^.value_set);
@ -455,7 +441,7 @@ unit tree;
var
symt : psymtable;
i : longint;
begin
if not(assigned(p)) then
exit;
@ -770,9 +756,7 @@ unit tree;
var
p : ptree;
{$ifdef UseAnsiString}
l : longint;
{$endif UseAnsiString}
begin
p:=getnode;
p^.disposetyp:=dt_nothing;
@ -784,43 +768,43 @@ unit tree;
{$ifdef SUPPORT_MMX}
p^.registersmmx:=0;
{$endif SUPPORT_MMX}
p^.resulttype:=cstringdef;
{$ifdef UseAnsiString}
l:=length(s);
p^.length:=l;
{ stringdup write even past a #0 }
getmem(p^.value_str,l+1);
move(s[1],p^.value_str^,l);
p^.value_str[l]:=#0;
{$else UseAnsiString}
p^.value_str:=stringdup(s);
{$endif UseAnsiString}
p^.lab_str:=nil;
p^.stringtype:=st_shortstring;
if cs_ansistrings in aktlocalswitches then
begin
p^.stringtype:=st_ansistring;
p^.resulttype:=cansistringdef;
end
else
begin
p^.stringtype:=st_shortstring;
p^.resulttype:=cshortstringdef;
end;
genstringconstnode:=p;
end;
{$ifdef UseAnsiString}
function getpcharcopy(p : ptree) : pchar;
var
pc : pchar;
begin
pc:=nil;
getmem(pc,p^.length+1);
{ Peter can you change that ? }
if pc=nil then
Message(general_f_no_memory_left);
move(p^.value_str^,pc^,p^.length+1);
getpcharcopy:=pc;
end;
function genpcharconstnode(s : pchar;length : longint) : ptree;
function genpcharconstnode(s : pchar;length : longint) : ptree;
var
p : ptree;
begin
p:=getnode;
p^.disposetyp:=dt_nothing;
@ -832,13 +816,13 @@ unit tree;
{$ifdef SUPPORT_MMX}
p^.registersmmx:=0;
{$endif SUPPORT_MMX}
p^.resulttype:=cstringdef;
p^.resulttype:=cshortstringdef;
p^.length:=length;
p^.value_str:=s;
p^.lab_str:=nil;
genpcharconstnode:=p;
end;
{$endif UseAnsiString}
function gensinglenode(t : ttreetyp;l : ptree) : ptree;
@ -1440,28 +1424,6 @@ unit tree;
error_found:=true;
end;
end;
(*realconstn : (valued : bestreal;labnumber : longint;realtyp : tait);
fixconstn : (valuef: longint);
funcretn : (funcretprocinfo : pointer;retdef : pdef);
subscriptn : (vs : pvarsym);
vecn : (memindex,memseg:boolean);
{ stringconstn : (length : longint; value_str : pstring;labstrnumber : longint); }
{ string const can be longer then 255 with ansistring !! }
{$ifdef UseAnsiString}
stringconstn : (value_str : pchar;length : longint; labstrnumber : longint);
{$else UseAnsiString}
stringconstn : (value_str : pstring; labstrnumber : longint);
{$endif UseAnsiString}
typeconvn : (convtyp : tconverttype;explizit : boolean);
inlinen : (inlinenumber : longint);
procinlinen : (inlineprocdef : pprocdef);
setconstrn : (constset : pconstset);
loopn : (t1,t2 : ptree;backward : boolean);
asmn : (p_asm : paasmoutput);
casen : (nodes : pcaserecord;elseblock : ptree);
labeln,goton : (labelnr : plabel);
withn : (withsymtable : psymtable;tablecount : longint);
end; *)
end;
if not error_found then
comment(v_warning,'did not find difference in trees');
@ -1632,18 +1594,18 @@ unit tree;
function str_length(p : ptree) : longint;
begin
{$ifdef UseAnsiString}
str_length:=p^.length;
{$else UseAnsiString}
str_length:=length(p^.value_str^);
{$endif UseAnsiString}
end;
end.
{
$Log$
Revision 1.48 1998-10-21 15:12:59 pierre
Revision 1.49 1998-11-05 12:03:07 peter
* released useansistring
* removed -Sv, its now available in fpc modes
Revision 1.48 1998/10/21 15:12:59 pierre
* bug fix for IOCHECK inside a procedure with iocheck modifier
* removed the GPF for unexistant overloading
(firstcall was called with procedinition=nil !)