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

+ support for bitpacked records, except for:

Browse Source 
* rtti
    * typed constants

git-svn-id: trunk@4489 -
This commit is contained in:
Jonas Maebe 2006-08-23 15:44:13 +00:00
parent 37a9ce25d5
commit 1f42ee201b
31 changed files with 1222 additions and 279 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
.gitattributes vendored
View File

@ -6143,6 +6143,7 @@ tests/test/tpara1.pp svneol=native#text/plain
tests/test/tpara2.pp svneol=native#text/plain
tests/test/tparray1.pp svneol=native#text/plain
tests/test/tparray10.pp svneol=native#text/plain
tests/test/tparray11.pp svneol=native#text/plain
tests/test/tparray2.pp svneol=native#text/plain
tests/test/tparray3.pp svneol=native#text/plain
tests/test/tparray4.pp svneol=native#text/plain
@ -6152,6 +6153,14 @@ tests/test/tparray7.pp svneol=native#text/plain
tests/test/tparray8.pp svneol=native#text/plain
tests/test/tparray9.pp svneol=native#text/plain
tests/test/tpftch1.pp svneol=native#text/plain
tests/test/tprec1.pp svneol=native#text/plain
tests/test/tprec2.pp svneol=native#text/plain
tests/test/tprec3.pp svneol=native#text/plain
tests/test/tprec4.pp svneol=native#text/plain
tests/test/tprec5.pp svneol=native#text/plain
tests/test/tprec6.pp svneol=native#text/plain
tests/test/tprec7.pp svneol=native#text/plain
tests/test/tprec8.pp svneol=native#text/plain
tests/test/tprocext.pp svneol=native#text/plain
tests/test/tprocvar1.pp svneol=native#text/plain
tests/test/tprocvar2.pp svneol=native#text/plain
@ -6274,6 +6283,8 @@ tests/test/units/sysutils/execedbya.pp svneol=native#text/plain
tests/test/units/sysutils/extractquote.pp svneol=native#text/plain
tests/test/units/sysutils/tsscanf.pp svneol=native#text/plain
tests/test/units/sysutils/tstrtobool.pp svneol=native#text/plain
tests/test/uprec6.pp svneol=native#text/plain
tests/test/uprec7.pp svneol=native#text/plain
tests/test/uprocext1.pp svneol=native#text/plain
tests/test/uprocext2.pp svneol=native#text/plain
tests/test/utasout.pp svneol=native#text/plain

145
compiler/cg64f32.pas
View File

@ -47,11 +47,21 @@ unit cg64f32;
procedure a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64);override;
procedure a_load64_reg_reg(list : TAsmList;regsrc,regdst : tregister64);override;
procedure a_load64_const_reg(list : TAsmList;value: int64;reg : tregister64);override;
procedure a_load64_subsetref_reg(list : TAsmList; const sref: tsubsetreference; destreg: tregister64);override;
procedure a_load64_reg_subsetref(list : TAsmList; fromreg: tregister64; const sref: tsubsetreference);override;
procedure a_load64_const_subsetref(list: TAsmlist; a: int64; const sref: tsubsetreference);override;
procedure a_load64_ref_subsetref(list : TAsmList; const fromref: treference; const sref: tsubsetreference);override;
procedure a_load64_subsetref_subsetref(list: TAsmlist; const fromsref, tosref: tsubsetreference);override;
procedure a_load64_subsetref_ref(list : TAsmList; const sref: tsubsetreference; const destref: treference);override;
procedure a_load64_loc_reg(list : TAsmList;const l : tlocation;reg : tregister64);override;
procedure a_load64_loc_ref(list : TAsmList;const l : tlocation;const ref : treference);override;
procedure a_load64_const_loc(list : TAsmList;value : int64;const l : tlocation);override;
procedure a_load64_reg_loc(list : TAsmList;reg : tregister64;const l : tlocation);override;
procedure a_load64high_reg_ref(list : TAsmList;reg : tregister;const ref : treference);override;
procedure a_load64low_reg_ref(list : TAsmList;reg : tregister;const ref : treference);override;
procedure a_load64high_ref_reg(list : TAsmList;const ref : treference;reg : tregister);override;
@ -258,6 +268,133 @@ unit cg64f32;
end;
procedure tcg64f32.a_load64_subsetref_reg(list : TAsmList; const sref: tsubsetreference; destreg: tregister64);
var
tmpreg: tregister;
tmpsref: tsubsetreference;
begin
if (sref.bitindexreg <> NR_NO) or
(sref.bitlen <> 64) then
internalerror(2006082310);
if (sref.startbit = 0) then
begin
a_load64_ref_reg(list,sref.ref,destreg);
exit;
end;
if target_info.endian = endian_big then
begin
tmpreg := destreg.reglo;
destreg.reglo := destreg.reghi;
destreg.reghi := tmpreg;
end;
tmpsref:=sref;
if (tmpsref.ref.base=destreg.reglo) then
begin
tmpreg:=cg.getaddressregister(list);
cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpsref.ref.base,tmpreg);
tmpsref.ref.base:=tmpreg;
end
else
if (tmpsref.ref.index=destreg.reglo) then
begin
tmpreg:=cg.getaddressregister(list);
cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpsref.ref.index,tmpreg);
tmpsref.ref.index:=tmpreg;
end;
tmpsref.bitlen:=32;
cg.a_load_subsetref_reg(list,OS_32,OS_32,tmpsref,destreg.reglo);
inc(tmpsref.ref.offset,4);
cg.a_load_subsetref_reg(list,OS_32,OS_32,tmpsref,destreg.reghi);
end;
procedure tcg64f32.a_load64_reg_subsetref(list : TAsmList; fromreg: tregister64; const sref: tsubsetreference);
var
tmpreg: tregister;
tmpsref: tsubsetreference;
begin
if (sref.bitindexreg <> NR_NO) or
(sref.bitlen <> 64) then
internalerror(2006082311);
if (sref.startbit = 0) then
begin
a_load64_reg_ref(list,fromreg,sref.ref);
exit;
end;
if target_info.endian = endian_big then
begin
tmpreg:=fromreg.reglo;
fromreg.reglo:=fromreg.reghi;
fromreg.reghi:=tmpreg;
end;
tmpsref:=sref;
tmpsref.bitlen:=32;
cg.a_load_reg_subsetref(list,OS_32,OS_32,fromreg.reglo,tmpsref);
inc(tmpsref.ref.offset,4);
cg.a_load_reg_subsetref(list,OS_32,OS_32,fromreg.reghi,tmpsref);
end;
procedure tcg64f32.a_load64_const_subsetref(list: TAsmlist; a: int64; const sref: tsubsetreference);
var
tmpsref: tsubsetreference;
begin
if (sref.bitindexreg <> NR_NO) or
(sref.bitlen <> 64) then
internalerror(2006082312);
if target_info.endian = endian_big then
swap64(a);
tmpsref := sref;
tmpsref.bitlen := 32;
cg.a_load_const_subsetref(list,OS_32,aint(lo(a)),tmpsref);
inc(tmpsref.ref.offset,4);
cg.a_load_const_subsetref(list,OS_32,aint(hi(a)),tmpsref);
end;
procedure tcg64f32.a_load64_subsetref_subsetref(list: TAsmlist; const fromsref, tosref: tsubsetreference);
var
tmpreg64 : tregister64;
begin
tmpreg64.reglo:=cg.getintregister(list,OS_32);
tmpreg64.reghi:=cg.getintregister(list,OS_32);
a_load64_subsetref_reg(list,fromsref,tmpreg64);
a_load64_reg_subsetref(list,tmpreg64,tosref);
end;
procedure tcg64f32.a_load64_subsetref_ref(list : TAsmList; const sref: tsubsetreference; const destref: treference);
var
tmpreg64 : tregister64;
begin
tmpreg64.reglo:=cg.getintregister(list,OS_32);
tmpreg64.reghi:=cg.getintregister(list,OS_32);
a_load64_subsetref_reg(list,sref,tmpreg64);
a_load64_reg_ref(list,tmpreg64,destref);
end;
procedure tcg64f32.a_load64_ref_subsetref(list : TAsmList; const fromref: treference; const sref: tsubsetreference);
var
tmpreg64 : tregister64;
begin
tmpreg64.reglo:=cg.getintregister(list,OS_32);
tmpreg64.reghi:=cg.getintregister(list,OS_32);
a_load64_ref_reg(list,fromref,tmpreg64);
a_load64_reg_subsetref(list,tmpreg64,sref);
end;
procedure tcg64f32.a_load64_loc_reg(list : TAsmList;const l : tlocation;reg : tregister64);
begin
@ -268,6 +405,8 @@ unit cg64f32;
a_load64_reg_reg(list,l.register64,reg);
LOC_CONSTANT :
a_load64_const_reg(list,l.value64,reg);
LOC_SUBSETREF, LOC_CSUBSETREF:
a_load64_subsetref_reg(list,l.sref,reg);
else
internalerror(200112292);
end;
@ -281,6 +420,8 @@ unit cg64f32;
a_load64_reg_ref(list,l.register64,ref);
LOC_CONSTANT :
a_load64_const_ref(list,l.value64,ref);
LOC_SUBSETREF, LOC_CSUBSETREF:
a_load64_subsetref_ref(list,l.sref,ref);
else
internalerror(200203288);
end;
@ -295,6 +436,8 @@ unit cg64f32;
a_load64_const_ref(list,value,l.reference);
LOC_REGISTER,LOC_CREGISTER:
a_load64_const_reg(list,value,l.register64);
LOC_SUBSETREF, LOC_CSUBSETREF:
a_load64_const_subsetref(list,value,l.sref);
else
internalerror(200112293);
end;
@ -309,6 +452,8 @@ unit cg64f32;
a_load64_reg_ref(list,reg,l.reference);
LOC_REGISTER,LOC_CREGISTER:
a_load64_reg_reg(list,reg,l.register64);
LOC_SUBSETREF, LOC_CSUBSETREF:
a_load64_reg_subsetref(list,reg,l.sref);
else
internalerror(200112293);
end;

102
compiler/cgobj.pas
View File

@ -474,6 +474,16 @@ unit cgobj;
procedure a_load64_const_loc(list : TAsmList;value : int64;const l : tlocation);virtual;abstract;
procedure a_load64_reg_loc(list : TAsmList;reg : tregister64;const l : tlocation);virtual;abstract;
procedure a_load64_subsetref_reg(list : TAsmList; const sref: tsubsetreference; destreg: tregister64);virtual;abstract;
procedure a_load64_reg_subsetref(list : TAsmList; fromreg: tregister64; const sref: tsubsetreference);virtual;abstract;
procedure a_load64_const_subsetref(list: TAsmlist; a: int64; const sref: tsubsetreference);virtual;abstract;
procedure a_load64_ref_subsetref(list : TAsmList; const fromref: treference; const sref: tsubsetreference);virtual;abstract;
procedure a_load64_subsetref_subsetref(list: TAsmlist; const fromsref, tosref: tsubsetreference); virtual;abstract;
procedure a_load64_subsetref_ref(list : TAsmList; const sref: tsubsetreference; const destref: treference); virtual;abstract;
procedure a_load64_loc_subsetref(list : TAsmList; const l: tlocation; const sref : tsubsetreference);
procedure a_load64_subsetref_loc(list: TAsmlist; const sref: tsubsetreference; const l: tlocation);
procedure a_load64high_reg_ref(list : TAsmList;reg : tregister;const ref : treference);virtual;abstract;
procedure a_load64low_reg_ref(list : TAsmList;reg : tregister;const ref : treference);virtual;abstract;
procedure a_load64high_ref_reg(list : TAsmList;const ref : treference;reg : tregister);virtual;abstract;
@ -494,6 +504,11 @@ unit cgobj;
procedure a_op64_const_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);virtual;
procedure a_op64_reg_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);virtual;
procedure a_op64_const_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; a : int64; const sref: tsubsetreference);
procedure a_op64_reg_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; reg: tregister64; const sref: tsubsetreference);
procedure a_op64_ref_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; const ref: treference; const sref: tsubsetreference);
procedure a_op64_subsetref_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; const ssref,dsref: tsubsetreference);
procedure a_param64_reg(list : TAsmList;reg64 : tregister64;const loc : TCGPara);virtual;abstract;
procedure a_param64_const(list : TAsmList;value : int64;const loc : TCGPara);virtual;abstract;
procedure a_param64_ref(list : TAsmList;const r : treference;const loc : TCGPara);virtual;abstract;
@ -1085,7 +1100,14 @@ implementation
var
intloadsize: aint;
begin
intloadsize := sref.ref.alignment;
intloadsize := packedbitsloadsize(sref.bitlen);
{$ifdef cpurequiresproperalignment}
{ may need to be split into several smaller loads/stores }
if intloadsize <> sref.ref.alignment then
internalerror(2006082011);
{$endif cpurequiresproperalignment}
if (intloadsize = 0) then
internalerror(2006081310);
@ -3111,6 +3133,53 @@ implementation
end;
procedure tcg64.a_op64_const_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; a : int64; const sref: tsubsetreference);
var
tmpreg64 : tregister64;
begin
tmpreg64.reglo:=cg.getintregister(list,OS_32);
tmpreg64.reghi:=cg.getintregister(list,OS_32);
a_load64_subsetref_reg(list,sref,tmpreg64);
a_op64_const_reg(list,op,size,a,tmpreg64);
a_load64_reg_subsetref(list,tmpreg64,sref);
end;
procedure tcg64.a_op64_reg_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; reg: tregister64; const sref: tsubsetreference);
var
tmpreg64 : tregister64;
begin
tmpreg64.reglo:=cg.getintregister(list,OS_32);
tmpreg64.reghi:=cg.getintregister(list,OS_32);
a_load64_subsetref_reg(list,sref,tmpreg64);
a_op64_reg_reg(list,op,size,reg,tmpreg64);
a_load64_reg_subsetref(list,tmpreg64,sref);
end;
procedure tcg64.a_op64_ref_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; const ref: treference; const sref: tsubsetreference);
var
tmpreg64 : tregister64;
begin
tmpreg64.reglo:=cg.getintregister(list,OS_32);
tmpreg64.reghi:=cg.getintregister(list,OS_32);
a_load64_subsetref_reg(list,sref,tmpreg64);
a_op64_ref_reg(list,op,size,ref,tmpreg64);
a_load64_reg_subsetref(list,tmpreg64,sref);
end;
procedure tcg64.a_op64_subsetref_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; const ssref,dsref: tsubsetreference);
var
tmpreg64 : tregister64;
begin
tmpreg64.reglo:=cg.getintregister(list,OS_32);
tmpreg64.reghi:=cg.getintregister(list,OS_32);
a_load64_subsetref_reg(list,ssref,tmpreg64);
a_op64_reg_subsetref(list,op,size,tmpreg64,dsref);
end;
procedure tcg64.a_op64_const_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);
begin
a_op64_const_reg_reg(list,op,size,value,regsrc,regdst);
@ -3125,6 +3194,37 @@ implementation
end;
procedure tcg64.a_load64_loc_subsetref(list : TAsmList;const l: tlocation; const sref : tsubsetreference);
begin
case l.loc of
LOC_REFERENCE, LOC_CREFERENCE:
a_load64_ref_subsetref(list,l.reference,sref);
LOC_REGISTER,LOC_CREGISTER:
a_load64_reg_subsetref(list,l.register64,sref);
LOC_CONSTANT :
a_load64_const_subsetref(list,l.value64,sref);
LOC_SUBSETREF,LOC_CSUBSETREF:
a_load64_subsetref_subsetref(list,l.sref,sref);
else
internalerror(2006082210);
end;
end;
procedure tcg64.a_load64_subsetref_loc(list: TAsmlist; const sref: tsubsetreference; const l: tlocation);
begin
case l.loc of
LOC_REFERENCE, LOC_CREFERENCE:
a_load64_subsetref_ref(list,sref,l.reference);
LOC_REGISTER,LOC_CREGISTER:
a_load64_subsetref_reg(list,sref,l.register64);
LOC_SUBSETREF,LOC_CSUBSETREF:
a_load64_subsetref_subsetref(list,sref,l.sref);
else
internalerror(2006082211);
end;
end;
{$endif cpu64bit}

23
compiler/cutils.pas
View File

@ -57,6 +57,7 @@ interface
function used_align(varalign,minalign,maxalign:shortint):shortint;
function size_2_align(len : longint) : shortint;
function packedbitsloadsize(bitlen: int64) : int64;
procedure Replace(var s:string;s1:string;const s2:string);
procedure Replace(var s:AnsiString;s1:string;const s2:string);
procedure ReplaceCase(var s:string;const s1,s2:string);
@ -269,6 +270,28 @@ uses
end;
function packedbitsloadsize(bitlen: int64) : int64;
begin
case bitlen of
1,2,4,8:
result := 1;
{ 10 bits can never be split over 3 bytes via 1-8-1, because it }
{ always starts at a multiple of 10 bits. Same for the others. }
3,5,7,9,10,12,16:
result := 2;
{$ifdef cpu64bit}
11,13,14,15,17..26,28,32:
result := 4;
else
result := 8;
{$else cpu64bit}
else
result := 4;
{$endif cpu64bit}
end;
end;
function used_align(varalign,minalign,maxalign:shortint):shortint;
begin
{ varalign : minimum alignment required for the variable

12
compiler/defutil.pas
View File

@ -126,6 +126,9 @@ interface
{# Returns true if p is a bitpacked array }
function is_packed_array(p: tdef) : boolean;
{# Returns true if p is a bitpacked record }
function is_packed_record_or_object(p: tdef) : boolean;
{# Returns true if p is a char array def }
function is_chararray(p : tdef) : boolean;
@ -581,6 +584,15 @@ implementation
end;
{ true if p is bit packed record def }
function is_packed_record_or_object(p: tdef) : boolean;
begin
is_packed_record_or_object :=
(p.deftype in [recorddef,objectdef]) and
(tabstractrecorddef(p).is_packed);
end;
{ true if p is a char array def }
function is_chararray(p : tdef) : boolean;
begin

4
compiler/msg/errore.msg
View File

@ -1330,7 +1330,7 @@ type_w_double_c_varargs=04059_W_Converting constant real value to double for C v
% this from happening, add an explicit typecast around the constant.
type_e_class_or_cominterface_type_expected=04060_E_Class or COM interface type expected, but got "$1"
% Some operators like the AS operator are only appliable to classes or COM interfaces.
type_e_no_const_packed_array=04061_E_Constant packed arrays are not supported
type_e_no_const_packed_array=04061_E_Constant packed arrays are not yet supported
% You cannot declare a (bit)packed array as a typed constant.
type_e_got_expected_packed_array=04062_E_Incompatible type for arg no. $1: Got "$2" expected "(Bit)Packed Array"
% The compiler expects a (bit)packed array as the specified parameter
@ -1338,6 +1338,8 @@ type_e_got_expected_unpacked_array=04063_E_Incompatible type for arg no. $1: Got
% The compiler expects a regular (i.e., not packed) array as the specified parameter
type_e_no_packed_inittable=04064_E_Elements of packed arrays cannot be of a type which need to be initialised
% Support for packed arrays of types that need initialization (such as ansistrings, or records which contain ansistrings) is not yet implemented.
type_e_no_const_packed_record=04065_E_Constant packed records and objects are not yet supported
% You cannot declare a (bit)packed array as a typed constant at this time.
% \end{description}
#
# Symtable

5
compiler/msgidx.inc
View File

@ -369,6 +369,7 @@ const
type_e_got_expected_packed_array=04062;
type_e_got_expected_unpacked_array=04063;
type_e_no_packed_inittable=04064;
type_e_no_const_packed_record=04065;
sym_e_id_not_found=05000;
sym_f_internal_error_in_symtablestack=05001;
sym_e_duplicate_id=05002;
@ -693,9 +694,9 @@ const
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 40910;
MsgTxtSize = 40980;
MsgIdxMax : array[1..20] of longint=(
24,80,223,65,62,47,101,22,135,60,
24,80,223,66,62,47,101,22,135,60,
41,1,1,1,1,1,1,1,1,1
);

412
compiler/msgtxt.inc
View File

@ -406,353 +406,355 @@ const msgtxt : array[0..000170,1..240] of char=(
'04059_W_Converting constant real value to double for C variable argume'+
'nt, add explicit typecast to prevent this.'#000+
'04060_E_Class or COM interface type expected, but got "$1"'#000+
'04061_E_Constant packed arrays are not supp','orted'#000+
'04061_E_Constant packed arrays are not yet ','supported'#000+
'04062_E_Incompatible type for arg no. $1: Got "$2" expected "(Bit)Pack'+
'ed Array"'#000+
'04063_E_Incompatible type for arg no. $1: Got "$2" expected "(not pack'+
'ed) Array"'#000+
'04064_E_Elements of packed arrays cannot be of a type which need to be'+
' in','itialised'#000+
'04064_E_Elements of packed arrays cannot be of a type which need to b',
'e initialised'#000+
'04065_E_Constant packed records and objects are not yet supported'#000+
'05000_E_Identifier not found "$1"'#000+
'05001_F_Internal Error in SymTableStack()'#000+
'05002_E_Duplicate identifier "$1"'#000+
'05003_H_Identifier already defined in $1 at line $2'#000+
'05003_H_Identifier already defined in $1 at line $','2'#000+
'05004_E_Unknown identifier "$1"'#000+
'05005_E_Forward declaration not solv','ed "$1"'#000+
'05005_E_Forward declaration not solved "$1"'#000+
'05007_E_Error in type definition'#000+
'05009_E_Forward type not resolved "$1"'#000+
'05010_E_Only static variables can be used in static methods or outside'+
' methods'#000+
'05012_F_record or class type expected'#000+
'05013_E_Instances of classes or objects wit','h an abstract method are '+
'not allowed'#000+
'05012_F_rec','ord or class type expected'#000+
'05013_E_Instances of classes or objects with an abstract method are no'+
't allowed'#000+
'05014_W_Label not defined "$1"'#000+
'05015_E_Label used but not defined "$1"'#000+
'05016_E_Illegal label declaration'#000+
'05017_E_GOTO and LABEL are not supported (use switch -Sg)'#000+
'05017_E_GOTO and LABEL are n','ot supported (use switch -Sg)'#000+
'05018_E_Label not found'#000+
'05019_E_identifi','er isn'#039't a label'#000+
'05019_E_identifier isn'#039't a label'#000+
'05020_E_label already defined'#000+
'05021_E_illegal type declaration of set elements'#000+
'05022_E_Forward class definition not resolved "$1"'#000+
'05023_H_Unit "$1" not used in $2'#000+
'05023_H_Unit "$1" not u','sed in $2'#000+
'05024_H_Parameter "$1" not used'#000+
'05025_N_Local variable "$1" ','not used'#000+
'05025_N_Local variable "$1" not used'#000+
'05026_H_Value parameter "$1" is assigned but never used'#000+
'05027_N_Local variable "$1" is assigned but never used'#000+
'05028_H_Local $1 "$2" is not used'#000+
'05029_N_Private field "$1.$2" is never used'#000+
'05030_N_Private field "$1.$2" is assigned ','but never used'#000+
'05029_N_Private ','field "$1.$2" is never used'#000+
'05030_N_Private field "$1.$2" is assigned but never used'#000+
'05031_N_Private method "$1.$2" never used'#000+
'05032_E_Set type expected'#000+
'05033_W_Function result does not seem to be set'#000+
'05034_W_Type "$1" is not aligned correctly in current record for C'#000+
'05035_E_Unknown record field identifier "$','1"'#000+
'05034_W_Type "$1" is not aligned correc','tly in current record for C'#000+
'05035_E_Unknown record field identifier "$1"'#000+
'05036_W_Local variable "$1" does not seem to be initialized'#000+
'05037_W_Variable "$1" does not seem to be initialized'#000+
'05038_E_identifier idents no member "$1"'#000+
'05039_H_Found declaration: $1'#000+
'05039_H_Foun','d declaration: $1'#000+
'05040_E_Data element too large'#000+
'05042_E_No matching i','mplementation for interface method "$1" found'#000+
'05042_E_No matching implementation for interface method "$1" found'#000+
'05043_W_Symbol "$1" is deprecated'#000+
'05044_W_Symbol "$1" is not portable'#000+
'05055_W_Symbol "$1" is not implemented'#000+
'05056_E_Can'#039't create unique type from this type'#000+
'05057_H_Local variable "$1" does not ','seem to be initialized'#000+
'05056_E_Can'#039't c','reate unique type from this type'#000+
'05057_H_Local variable "$1" does not seem to be initialized'#000+
'05058_H_Variable "$1" does not seem to be initialized'#000+
'05059_W_Function result variable does not seem to initialized'#000+
'05060_H_Function result variable does not seem to be initialized'#000+
'05061_W_Variable "$1" read but nowhe','re assigned'#000+
'05060_H_Function result variabl','e does not seem to be initialized'#000+
'05061_W_Variable "$1" read but nowhere assigned'#000+
'06009_E_Parameter list size exceeds 65535 bytes'#000+
'06012_E_File types must be var parameters'#000+
'06013_E_The use of a far pointer isn'#039't allowed there'#000+
'06015_E_EXPORT declared functions can'#039't be called'#000+
'06016_W_Possible illegal call of co','nstructor or destructor'#000+
'06015_E_EXPORT ','declared functions can'#039't be called'#000+
'06016_W_Possible illegal call of constructor or destructor'#000+
'06017_N_Inefficient code'#000+
'06018_W_unreachable code'#000+
'06020_E_Abstract methods can'#039't be called directly'#000+
'06027_DL_Register $1 weight $2 $3'#000+
'06029_DL_Stack frame is omitted'#000+
'06029_DL_Sta','ck frame is omitted'#000+
'06031_E_Object or class methods can'#039't be inline.'#000+
'0','6032_E_Procvar calls cannot be inline.'#000+
'06032_E_Procvar calls cannot be inline.'#000+
'06033_E_No code for inline procedure stored'#000+
'06035_E_Element zero of an ansi/wide- or longstring can'#039't be acces'+
'sed, use (set)length instead'#000+
'06037_E_Constructors or destructors can not be called inside a',' '#039'w'+
'ith'#039' clause'#000+
'sed, use (set)length ','instead'#000+
'06037_E_Constructors or destructors can not be called inside a '#039'wi'+
'th'#039' clause'#000+
'06038_E_Cannot call message handler methods directly'#000+
'06039_E_Jump in or outside of an exception block'#000+
'06040_E_Control flow statements aren'#039't allowed in a finally block'#000+
'06040_E_Control flow statements aren'#039't allowed in a f','inally bloc'+
'k'#000+
'06041_W_Parameters size exceeds limit for certain cpu'#039's'#000+
'0','6042_W_Local variable size exceed limit for certain cpu'#039's'#000+
'06042_W_Local variable size exceed limit for certain cpu'#039's'#000+
'06043_E_Local variables size exceeds supported limit'#000+
'06044_E_BREAK not allowed'#000+
'06045_E_CONTINUE not allowed'#000+
'06046_F_Unknown compilerproc "$1". Check if you use the correct run ti'+
'me l','ibrary.'#000+
'0604','6_F_Unknown compilerproc "$1". Check if you use the correct run '+
'time library.'#000+
'07000_DL_Starting $1 styled assembler parsing'#000+
'07001_DL_Finished $1 styled assembler parsing'#000+
'07002_E_Non-label pattern contains @'#000+
'07004_E_Error building record offset'#000+
'07004_E_Error building record off','set'#000+
'07005_E_OFFSET used without identifier'#000+
'07006_E_TYPE used without i','dentifier'#000+
'07006_E_TYPE used without identifier'#000+
'07007_E_Cannot use local variable or parameters here'#000+
'07008_E_need to use OFFSET here'#000+
'07009_E_need to use $ here'#000+
'07010_E_Cannot use multiple relocatable symbols'#000+
'07010_E_Cannot use multiple relocatable symbols'#000,
'07011_E_Relocatable symbol can only be added'#000+
'07012_E_Invalid constant ','expression'#000+
'07012_E_Invalid constant expression'#000+
'07013_E_Relocatable symbol is not allowed'#000+
'07014_E_Invalid reference syntax'#000+
'07015_E_You can not reach $1 from that code'#000+
'07016_E_Local symbols/labels aren'#039't allowed as references'#000+
'07016_E_Local symbols/labels aren'#039't allo','wed as references'#000+
'07017_E_Invalid base and index register usage'#000+
'07018_','W_Possible error in object field handling'#000+
'07018_W_Possible error in object field handling'#000+
'07019_E_Wrong scale factor specified'#000+
'07020_E_Multiple index register usage'#000+
'07021_E_Invalid operand type'#000+
'07022_E_Invalid string as opcode operand: $1'#000+
'07022_E_Invalid string a','s opcode operand: $1'#000+
'07023_W_@CODE and @DATA not supported'#000+
'07024_E_Nul','l label references are not allowed'#000+
'07024_E_Null label references are not allowed'#000+
'07025_E_Divide by zero in asm evaluator'#000+
'07026_E_Illegal expression'#000+
'07027_E_escape sequence ignored: $1'#000+
'07028_E_Invalid symbol reference'#000+
'07028_E_Invalid symbol reference',#000+
'07029_W_Fwait can cause emulation problems with emu387'#000+
'07030_W_$1 wit','hout operand translated into $1P'#000+
'07030_W_$1 without operand translated into $1P'#000+
'07031_W_ENTER instruction is not supported by Linux kernel'#000+
'07032_W_Calling an overload function in assembler'#000+
'07033_E_Unsupported symbol type for operand'#000+
'07033_E_Unsupported symbol t','ype for operand'#000+
'07034_E_Constant value out of bounds'#000+
'07035_E_Error con','verting decimal $1'#000+
'07035_E_Error converting decimal $1'#000+
'07036_E_Error converting octal $1'#000+
'07037_E_Error converting binary $1'#000+
'07038_E_Error converting hexadecimal $1'#000+
'07039_H_$1 translated to $2'#000+
'07040_W_$1 is associated to an overloaded function'#000+
'07041_E_Cannot use SELF outside a',' method'#000+
'07040_W_$1 is ','associated to an overloaded function'#000+
'07041_E_Cannot use SELF outside a method'#000+
'07042_E_Cannot use OLDEBP outside a nested procedure'#000+
'07043_W_Procedures can'#039't return any value in asm code'#000+
'07044_E_SEG not supported'#000+
'07045_E_Size suffix and destination or source size do not match'#000+
'07046_W_Size suffix and destination',' or source size do not match'#000+
'07045_E_Size suffix and desti','nation or source size do not match'#000+
'07046_W_Size suffix and destination or source size do not match'#000+
'07047_E_Assembler syntax error'#000+
'07048_E_Invalid combination of opcode and operands'#000+
'07049_E_Assembler syntax error in operand'#000+
'07050_E_Assembler syntax error in constant'#000+
'07050_E_Assembler',' syntax error in constant'#000+
'07051_E_Invalid String expression'#000+
'07052_W_co','nstant with symbol $1 for address which is not on a pointe'+
'r'#000+
'07052_W_constant with symbol $1 for address which is not on a pointer'#000+
'07053_E_Unrecognized opcode $1'#000+
'07054_E_Invalid or missing opcode'#000+
'07055_E_Invalid combination of prefix and opcode: $1'#000+
'07055_E_Invalid combination of prefix and opc','ode: $1'#000+
'07056_E_Invalid combination of override and opcode: $1'#000+
'07057_E','_Too many operands on line'#000+
'07057_E_Too many operands on line'#000+
'07058_W_NEAR ignored'#000+
'07059_W_FAR ignored'#000+
'07060_E_Duplicate local symbol $1'#000+
'07061_E_Undefined local symbol $1'#000+
'07062_E_Unknown label identifier $1'#000+
'07062_E_Unknown label identifier $','1'#000+
'07063_E_Invalid register name'#000+
'07064_E_Invalid floating point registe','r name'#000+
'07064_E_Invalid floating point register name'#000+
'07066_W_Modulo not supported'#000+
'07067_E_Invalid floating point constant $1'#000+
'07068_E_Invalid floating point expression'#000+
'07069_E_Wrong symbol type'#000+
'07070_E_Cannot index a local var or parameter with a register'#000+
'07071_E_Invalid segment overrid','e expression'#000+
'07070_E_Cannot index a ','local var or parameter with a register'#000+
'07071_E_Invalid segment override expression'#000+
'07072_W_Identifier $1 supposed external'#000+
'07073_E_Strings not allowed as constants'#000+
'07074_No type of variable specified'#000+
'07075_E_assembler code not returned to text section'#000+
'07075_E_assembler code not returned to t','ext section'#000+
'07076_E_Not a directive or local symbol $1'#000+
'07077_E_Using a',' defined name as a local label'#000+
'07077_E_Using a defined name as a local label'#000+
'07078_E_Dollar token is used without an identifier'#000+
'07079_W_32bit constant created for address'#000+
'07080_N_.align is target specific, use .balign or .p2align'#000+
'07080_N_.align is target specific, use .balig','n or .p2align'#000+
'07081_E_Can'#039't access fields directly for parameters'#000+
'0708','2_E_Can'#039't access fields of objects/classes directly'#000+
'07082_E_Can'#039't access fields of objects/classes directly'#000+
'07083_E_No size specified and unable to determine the size of the oper'+
'ands'#000+
'07084_E_Cannot use RESULT in this function'#000+
'07084_E_Cannot use RESULT in this function'#000,
'07086_W_"$1" without operand translated into "$1 %st,%st(1)"'#000+
'07087_W_"','$1 %st(n)" translated into "$1 %st,%st(n)"'#000+
'07087_W_"$1 %st(n)" translated into "$1 %st,%st(n)"'#000+
'07088_W_"$1 %st(n)" translated into "$1 %st(n),%st"'#000+
'07089_E_Char < not allowed here'#000+
'07090_E_Char > not allowed here'#000+
'07093_W_ALIGN not supported'#000+
'07093_W_ALI','GN not supported'#000+
'07094_E_Inc and Dec cannot be together'#000+
'07095_E_Invali','d reglist for movem'#000+
'07095_E_Invalid reglist for movem'#000+
'07096_E_Reglist invalid for opcode'#000+
'07097_E_Higher cpu mode required ($1)'#000+
'07098_W_No size specified and unable to determine the size of the oper'+
'ands, using DWORD as default'#000+
'07099_E_Syntax error while trying to parse a shi','fter operand'#000+
'ands, u','sing DWORD as default'#000+
'07099_E_Syntax error while trying to parse a shifter operand'#000+
'07100_E_Address of packed component is not at a byte boundary'#000+
'08000_F_Too many assembler files'#000+
'08001_F_Selected assembler output not supported'#000+
'08002_F_Comp not supported'#000+
'08002_F_Comp n','ot supported'#000+
'08003_F_Direct not support for binary writers'#000+
'08004_E_All','ocating of data is only allowed in bss section'#000+
'08004_E_Allocating of data is only allowed in bss section'#000+
'08005_F_No binary writer selected'#000+
'08006_E_Asm: Opcode $1 not in table'#000+
'08007_E_Asm: $1 invalid combination of opcode and operands'#000+
'08007_E_Asm: $1 invalid combination of opcode and ope','rands'#000+
'08008_E_Asm: 16 Bit references not supported'#000+
'08009_E_Asm: Invali','d effective address'#000+
'08009_E_Asm: Invalid effective address'#000+
'08010_E_Asm: Immediate or reference expected'#000+
'08011_E_Asm: $1 value exceeds bounds $2'#000+
'08012_E_Asm: Short jump is out of range $1'#000+
'08013_E_Asm: Undefined label $1'#000+
'08013_E_Asm: Undefined',' label $1'#000+
'08014_E_Asm: Comp type not supported for this target'#000+
'08015_E','_Asm: Extended type not supported for this target'#000+
'08015_E_Asm: Extended type not supported for this target'#000+
'08016_E_Asm: Duplicate label $1'#000+
'08017_E_Asm: Redefined label $1'#000+
'08018_E_Asm: First defined here'#000+
'08019_E_Asm: Invalid register $1'#000+
'08019_E_Asm: Invalid reg','ister $1'#000+
'08020_E_Asm: 16 or 32 Bit references not supported'#000+
'08021_E_As','m: 64 Bit operands not supported'#000+
'08021_E_Asm: 64 Bit operands not supported'#000+
'09000_W_Source operating system redefined'#000+
'09001_I_Assembling (pipe) $1'#000+
'09002_E_Can'#039't create assembler file: $1'#000+
'09003_E_Can'#039't create object file: $1'#000+
'09003_E_Can'#039't create objec','t file: $1'#000+
'09004_E_Can'#039't create archive file: $1'#000+
'09005_E_Assembler $1 ','not found, switching to external assembling'#000+
'09005_E_Assembler $1 not found, switching to external assembling'#000+
'09006_T_Using assembler: $1'#000+
'09007_E_Error while assembling exitcode $1'#000+
'09008_E_Can'#039't call the assembler, error $1 switching to external a'+
'ssembling'#000+
'09008_E_Can'#039't call the assembler, error $1 switching to',' external'+
' assembling'#000+
'09009_I_Assembling $1'#000+
'09010_I_Assembling with sma','rtlinking $1'#000+
'09010_I_Assembling with smartlinking $1'#000+
'09011_W_Object $1 not found, Linking may fail !'#000+
'09012_W_Library $1 not found, Linking may fail !'#000+
'09013_E_Error while linking'#000+
'09014_E_Can'#039't call the linker, switching to external linking'#000+
'09014_E_Can'#039't call the linker, s','witching to external linking'#000+
'09015_I_Linking $1'#000+
'09016_E_Util $1 not fo','und, switching to external linking'#000+
'09016_E_Util $1 not found, switching to external linking'#000+
'09017_T_Using util $1'#000+
'09018_E_Creation of Executables not supported'#000+
'09019_E_Creation of Dynamic/Shared Libraries not supported'#000+
'09020_I_Closing script $1'#000+
'09021_E_resource compiler not found, switching to ex','ternal mode'#000+
'09020_I_','Closing script $1'#000+
'09021_E_resource compiler not found, switching to external mode'#000+
'09022_I_Compiling resource $1'#000+
'09023_T_unit $1 can'#039't be statically linked, switching to smart lin'+
'king'#000+
'09024_T_unit $1 can'#039't be smart linked, switching to static linking'+
#000+
'09025_T_unit $1 can'#039't be shared linked, switching to static ','link'+
'ing'#000+
'09024_T_unit $1 can'#039't be smart linked, switching to stati','c linki'+
'ng'#000+
'09025_T_unit $1 can'#039't be shared linked, switching to static linkin'+
'g'#000+
'09026_E_unit $1 can'#039't be smart or static linked'#000+
'09027_E_unit $1 can'#039't be shared or static linked'#000+
'09028_D_Calling resource compiler "$1" with "$2" as command line'#000+
'09028_D_Calling resource compiler "$1" with "$2" as command line'#000,
'09128_F_Can'#039't post process executable $1'#000+
'09129_F_Can'#039't open executable',' $1'#000+
'09129_F_Can'#039't open executable $1'#000+
'09130_X_Size of Code: $1 bytes'#000+
'09131_X_Size of initialized data: $1 bytes'#000+
'09132_X_Size of uninitialized data: $1 bytes'#000+
'09133_X_Stack space reserved: $1 bytes'#000+
'09134_X_Stack space committed: $1 bytes'#000+
'09134_X_','Stack space committed: $1 bytes'#000+
'10000_T_Unitsearch: $1'#000+
'10001_T_PPU Loa','ding $1'#000+
'10001_T_PPU Loading $1'#000+
'10002_U_PPU Name: $1'#000+
'10003_U_PPU Flags: $1'#000+
'10004_U_PPU Crc: $1'#000+
'10005_U_PPU Time: $1'#000+
'10006_U_PPU File too short'#000+
'10007_U_PPU Invalid Header (no PPU at the begin)'#000+
'10008_U_PPU Invalid Version $1'#000+
'10009_U_PPU is compiled for another proce','ssor'#000+
'10','008_U_PPU Invalid Version $1'#000+
'10009_U_PPU is compiled for another processor'#000+
'10010_U_PPU is compiled for an other target'#000+
'10011_U_PPU Source: $1'#000+
'10012_U_Writing $1'#000+
'10013_F_Can'#039't Write PPU-File'#000+
'10014_F_Error reading PPU-File'#000+
'10015_F_unexpected end of PPU-File'#000+
'10015_F_unexpected ','end of PPU-File'#000+
'10016_F_Invalid PPU-File entry: $1'#000+
'10017_F_PPU Dbx cou','nt problem'#000+
'10017_F_PPU Dbx count problem'#000+
'10018_E_Illegal unit name: $1'#000+
'10019_F_Too much units'#000+
'10020_F_Circular unit reference between $1 and $2'#000+
'10021_F_Can'#039't compile unit $1, no sources available'#000+
'10022_F_Can'#039't find unit $1'#000+
'1002','2_F_Can'#039't find unit $1'#000+
'10023_W_Unit $1 was not found but $2 exists'#000+
'100','24_F_Unit $1 searched but $2 found'#000+
'10024_F_Unit $1 searched but $2 found'#000+
'10025_W_Compiling the system unit requires the -Us switch'#000+
'10026_F_There were $1 errors compiling module, stopping'#000+
'10027_U_Load from $1 ($2) unit $3'#000+
'10027_U_Load from $1 ','($2) unit $3'#000+
'10028_U_Recompiling $1, checksum changed for $2'#000+
'10029_U_R','ecompiling $1, source found only'#000+
'10029_U_Recompiling $1, source found only'#000+
'10030_U_Recompiling unit, static lib is older than ppufile'#000+
'10031_U_Recompiling unit, shared lib is older than ppufile'#000+
'10032_U_Recompiling unit, obj and asm are older than ppufile'#000+
'10033_U_Recompiling unit, ob','j is older than asm'#000+
'10032_U_Recompiling',' unit, obj and asm are older than ppufile'#000+
'10033_U_Recompiling unit, obj is older than asm'#000+
'10034_U_Parsing interface of $1'#000+
'10035_U_Parsing implementation of $1'#000+
'10036_U_Second load for unit $1'#000+
'10037_U_PPU Check file $1 time $2'#000+
'10040_W_Can'#039't recompile unit $1, but found modifed include files'#000+
'10041_H_File $1 is n','ewer than Release PPU file $2'#000+
'10040_W_Can'#039't r','ecompile unit $1, but found modifed include files'+
#000+
'10041_H_File $1 is newer than Release PPU file $2'#000+
'10042_U_Using a unit which was not compiled with correct FPU mode'#000+
'10043_U_Loading interface units from $1'#000+
'10044_U_Loading implementation units from $1'#000+
'10044_U_Loading implementation uni','ts from $1'#000+
'10045_U_Interface CRC changed for unit $1'#000+
'10046_U_Implement','ation CRC changed for unit $1'#000+
'10046_U_Implementation CRC changed for unit $1'#000+
'10047_U_Finished compiling unit $1'#000+
'10048_U_Add dependency of $1 to $2'#000+
'10049_U_No reload, is caller: $1'#000+
'10050_U_No reload, already in second compile: $1'#000+
'10050_U_No reload, already in second ','compile: $1'#000+
'10051_U_Flag for reload: $1'#000+
'10052_U_Forced reloading'#000+
'10053','_U_Previous state of $1: $2'#000+
'10053_U_Previous state of $1: $2'#000+
'10054_U_Already compiling $1, setting second compile'#000+
'10055_U_Loading unit $1'#000+
'10056_U_Finished loading unit $1'#000+
'10057_U_Registering new unit $1'#000+
'10057_U_Registering new unit $1'#000,
'10058_U_Re-resolving unit $1'#000+
'10059_U_Skipping re-resolving unit $1, st','ill loading used units'#000+
'10059_U_Skipping re-resolving unit $1, still loading used units'#000+
'11000_O_$1 [options] <inputfile> [options]'#000+
'11001_W_Only one source file supported'#000+
'11002_W_DEF file can be created only for OS/2'#000+
'11003_E_nested response files are not supported'#000+
'11004_F_No source file name in command li','ne'#000+
'11003_E_nested resp','onse files are not supported'#000+
'11004_F_No source file name in command line'#000+
'11005_N_No option inside $1 config file'#000+
'11006_E_Illegal parameter: $1'#000+
'11007_H_-? writes help pages'#000+
'11008_F_Too many config files nested'#000+
'11009_F_Unable to open file $1'#000+
'11009_F_Unable to open file $1'#000,
'11010_D_Reading further options from $1'#000+
'11011_W_Target is already set ','to: $1'#000+
'11011_W_Target is already set to: $1'#000+
'11012_W_Shared libs not supported on DOS platform, reverting to static'+
#000+
'11013_F_too many IF(N)DEFs'#000+
'11014_F_too many ENDIFs'#000+
'11015_F_open conditional at the end of the file'#000+
'11016_W_Debug information generation is not supported by this e','xecut'+
'able'#000+
'11015_F_open conditional at the end of th','e file'#000+
'11016_W_Debug information generation is not supported by this executab'+
'le'#000+
'11017_H_Try recompiling with -dGDB'#000+
'11018_W_You are using the obsolete switch $1'#000+
'11019_W_You are using the obsolete switch $1, please use $2'#000+
'11020_N_Switching assembler to default source writing assembler'#000+
'11021_W_Assembler output s','elected "$1" is not compatible with "$2"'#000+
'11020_N_Switching as','sembler to default source writing assembler'#000+
'11021_W_Assembler output selected "$1" is not compatible with "$2"'#000+
'11022_W_"$1" assembler use forced'#000+
'11026_T_Reading options from file $1'#000+
'11027_T_Reading options from environment $1'#000+
'11028_D_Handling option "$1"'#000+
'11028_D_Handli','ng option "$1"'#000+
'11029__*** press enter ***'#000+
'11030_H_Start of reading con','fig file $1'#000+
'11030_H_Start of reading config file $1'#000+
'11031_H_End of reading config file $1'#000+
'11032_D_interpreting option "$1"'#000+
'11036_D_interpreting firstpass option "$1"'#000+
'11033_D_interpreting file option "$1"'#000+
'11034_D_Reading config file "$1"'#000+
'11034_','D_Reading config file "$1"'#000+
'11035_D_found source file name "$1"'#000+
'11039_E','_Unknown code page'#000+
'11039_E_Unknown code page'#000+
'11040_F_Config file $1 is a directory'#000+
'11023_Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPC'+
'CPU'#010+
'Copyright (c) 1993-2006 by Florian Klaempfl'#000+
'Copyright (c) 1993-2006 by Florian Klae','mpfl'#000+
'11024_Free Pascal Compiler version $FPCVERSION'#010+
#010+
'Compiler Date ',' : $FPCDATE'#010+
'Compiler Date : $FPCDATE'#010+
'Compiler CPU Target: $FPCCPU'#010+
#010+
'Supported targets:'#010+
@ -762,176 +764,176 @@ const msgtxt : array[0..000170,1..240] of char=(
' $INSTRUCTIONSETS'#010+
#010+
'Supported FPU instruction sets:'#010+
' $FPUINSTRUCTIONSETS'#010+
' $FPUINST','RUCTIONSETS'#010+
#010+
'Supported Optimizations:'#010+
' $OPTIMIZATIONS'#010+
#010+
'This program c','omes under the GNU General Public Licence'#010+
'This program comes under the GNU General Public Licence'#010+
'For more information read COPYING.FPC'#010+
#010+
'Report bugs,suggestions etc to:'#010+
' bugs@freepascal.org'#000+
'11025_**0*_put + after a boolean switch option to enable it, - to disa'+
'ble it'#010+
'**1a_the comp','iler doesn'#039't delete the generated assembler file'#010+
'11025_**0*_put + aft','er a boolean switch option to enable it, - to di'+
'sable it'#010+
'**1a_the compiler doesn'#039't delete the generated assembler file'#010+
'**2al_list sourcecode lines in assembler file'#010+
'**2an_list node info in assembler file'#010+
'*L2ap_use pipes instead of creating temporary assembler files'#010+
'**2ar_list register allocation/release info ','in assembler file'#010+
'*L2ap_use pipes instead of creating ','temporary assembler files'#010+
'**2ar_list register allocation/release info in assembler file'#010+
'**2at_list temp allocation/release info in assembler file'#010+
'**1A<x>_output format:'#010+
'**2Adefault_use default assembler'#010+
'3*2Aas_assemble using GNU AS'#010+
'3*2Anasmcoff_coff (Go32v2) file using Nasm'#010+
'3*2Anasmelf_elf32 (Linux) file usin','g Nasm'#010+
'3*2Anasm','coff_coff (Go32v2) file using Nasm'#010+
'3*2Anasmelf_elf32 (Linux) file using Nasm'#010+
'3*2Anasmwin32_Win32 object file using Nasm'#010+
'3*2Anasmwdosx_Win32/WDOSX object file using Nasm'#010+
'3*2Awasm_obj file using Wasm (Watcom)'#010+
'3*2Anasmobj_obj file using Nasm'#010+
'3*2Amasm_obj file using Masm (Microsoft)'#010+
'3*2Atasm_obj file using Tasm (','Borland)'#010+
'3','*2Amasm_obj file using Masm (Microsoft)'#010+
'3*2Atasm_obj file using Tasm (Borland)'#010+
'3*2Aelf_elf32 (Linux) using internal writer'#010+
'3*2Acoff_coff (Go32v2) using internal writer'#010+
'3*2Apecoff_pecoff (Win32) using internal writer'#010+
'4*2Aas_assemble using GNU AS'#010+
'4*2Aas_assemble using GN','U AS'#010+
'6*2Aas_Unix o-file using GNU AS'#010+
'6*2Agas_GNU Motorola assembler'#010+
'6*','2Amit_MIT Syntax (old GAS)'#010+
'6*2Amit_MIT Syntax (old GAS)'#010+
'6*2Amot_Standard Motorola assembler'#010+
'A*2Aas_assemble using GNU AS'#010+
'P*2Aas_assemble using GNU AS'#010+
'S*2Aas_assemble using GNU AS'#010+
'**1b_generate browser info'#010+
'**1b_generate browse','r info'#010+
'**2bl_generate local symbol info'#010+
'**1B_build all modules'#010+
'**1C<x>','_code generation options:'#010+
'**1C<x>_code generation options:'#010+
'**2Cc<x>_set default calling convention to <x>'#010+
'**2CD_create also dynamic library (not supported)'#010+
'**2Ce_Compilation with emulated floating point opcodes'#010+
'**2Cf<x>_Select fpu instruction set to use, see fpc -i for pos','sible '+
'values'#010+
'**2Ce_Compilation with emulated floating point ','opcodes'#010+
'**2Cf<x>_Select fpu instruction set to use, see fpc -i for possible va'+
'lues'#010+
'**2Cg_Generate PIC code'#010+
'**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#010+
'**2Ci_IO-checking'#010+
'**2Cn_omit linking stage'#010+
'**2Co_check overflow of integer operations'#010+
'**2Co_check overflow of integer operat','ions'#010+
'**2Cp<x>_select instruction set, see fpc -i for possible values'#010+
'*','*2Cr_range checking'#010+
'**2Cr_range checking'#010+
'**2CR_verify object method call validity'#010+
'**2Cs<n>_set stack size to <n>'#010+
'**2Ct_stack checking'#010+
'**2CX_create also smartlinked library'#010+
'**1d<x>_defines the symbol <x>'#010+
'**1d<x>_defines the',' symbol <x>'#010+
'**1D_generate a DEF file'#010+
'**2Dd<x>_set description to <x>'#010+
'*','*2Dv<x>_set DLL version to <x>'#010+
'**2Dv<x>_set DLL version to <x>'#010+
'*O2Dw_PM application'#010+
'**1e<x>_set path to executable'#010+
'**1E_same as -Cn'#010+
'**1F<x>_set file names and paths:'#010+
'**2Fa<x>[,y]_for a program load first units <x> and [y] before uses is'+
' parsed'#010+
'**2Fc<x>_sets input codepage',' to <x>'#010+
'**2Fa<x>[,y]_for a program load firs','t units <x> and [y] before uses '+
'is parsed'#010+
'**2Fc<x>_sets input codepage to <x>'#010+
'**2FD<x>_sets the directory where to search for compiler utilities'#010+
'**2Fe<x>_redirect error output to <x>'#010+
'**2FE<x>_set exe/unit output path to <x>'#010+
'**2Fi<x>_adds <x> to include path'#010+
'**2Fi<x>_adds <x','> to include path'#010+
'**2Fl<x>_adds <x> to library path'#010+
'**2FL<x>_uses <x> ','as dynamic linker'#010+
'**2FL<x>_uses <x> as dynamic linker'#010+
'**2Fo<x>_adds <x> to object path'#010+
'**2Fr<x>_load error message file <x>'#010+
'**2Fu<x>_adds <x> to unit path'#010+
'**2FU<x>_set unit output path to <x>, overrides -FE'#010+
'**2FU<x>_set unit output path to <x>, overrides -FE',#010+
'*g1g_generate debugger information:'#010+
'*g2gc_generate checks for pointer','s'#010+
'*g2gc_generate checks for pointers'#010+
'*g2gd_use dbx'#010+
'*g2gg_use gsym'#010+
'*g2gh_use heap trace unit (for memory leak debugging)'#010+
'*g2gl_use line info unit to show more info for backtraces'#010+
'*g2gt_trash local variables (to detect uninitialized uses)'#010+
'*g2gv_generates programs traceable wit','h valgrind'#010+
'*g2gt_trash local variables',' (to detect uninitialized uses)'#010+
'*g2gv_generates programs traceable with valgrind'#010+
'*g2gw_generate dwarf debugging info'#010+
'**1i_information'#010+
'**2iD_return compiler date'#010+
'**2iV_return compiler version'#010+
'**2iW_return full compiler version'#010+
'**2iSO_return compiler OS'#010+
'**2iSO_return ','compiler OS'#010+
'**2iSP_return compiler processor'#010+
'**2iTO_return target OS'#010+
'*','*2iTP_return target processor'#010+
'**2iTP_return target processor'#010+
'**1I<x>_adds <x> to include path'#010+
'**1k<x>_Pass <x> to the linker'#010+
'**1l_write logo'#010+
'**1M<x>_set language mode to <x>'#010+
'**2Mfpc_free pascal dialect (default)'#010+
'**2Mfpc_free pascal dialect',' (default)'#010+
'**2Mobjfpc_switch some Delphi 2 extensions on'#010+
'**2Mdelphi_tr','ies to be Delphi compatible'#010+
'**2Mdelphi_tries to be Delphi compatible'#010+
'**2Mtp_tries to be TP/BP 7.0 compatible'#010+
'**2Mgpc_tries to be gpc compatible'#010+
'**2Mmacpas_tries to be compatible to the macintosh pascal dialects'#010+
'**2Mmacpas_tries to be compatible to the macintosh pascal dialects'#010,
'**1n_don'#039't read the default config file'#010+
'**1N<x>_node tree optimization','s'#010+
'**1N<x>_node tree optimizations'#010+
'**2Nu_unroll loops'#010+
'**1o<x>_change the name of the executable produced to <x>'#010+
'**1O<x>_optimizations:'#010+
'**2O-_disable optimizations'#010+
'**2O1_level 1 optimizations (quick and debugger friendly)'#010+
'**2O2_level 2 optimizations (-O1 + quick optimizatio','ns)'#010+
'**2O1_level 1 optimizations (quick and d','ebugger friendly)'#010+
'**2O2_level 2 optimizations (-O1 + quick optimizations)'#010+
'**2O3_level 3 optimizations (-O2 + slow optimizations)'#010+
'**2Oa<x>=<y>_set alignment'#010+
'**2Oo[NO]<x>_enable or disable optimizations, see fpc -i for possible '+
'values'#010+
'**2Op<x>_set target cpu for optimizing, see fpc -i for possible values'+
#010+
'**2Os_','generate smaller code'#010+
'**2Op<x','>_set target cpu for optimizing, see fpc -i for possible valu'+
'es'#010+
'**2Os_generate smaller code'#010+
'**1pg_generate profile code for gprof (defines FPC_PROFILE)'#010+
'**1R<x>_assembler reading style:'#010+
'**2Rdefault_use default assembler'#010+
'3*2Ratt_read AT&T style assembler'#010+
'3*2Ratt_read AT&T sty','le assembler'#010+
'3*2Rintel_read Intel style assembler'#010+
'6*2RMOT_read motorol','a style assembler'#010+
'6*2RMOT_read motorola style assembler'#010+
'**1S<x>_syntax options:'#010+
'**2S2_same as -Mobjfpc'#010+
'**2Sc_supports operators like C (*=,+=,/= and -=)'#010+
'**2Sa_include assertion code.'#010+
'**2Sd_same as -Mdelphi'#010+
'**2Se<x>_error options. <x> is a combination of the following:'#010+
'**3*_<n> ',': compiler stops after the <n> errors (default is 1)'#010+
'**','2Se<x>_error options. <x> is a combination of the following:'#010+
'**3*_<n> : compiler stops after the <n> errors (default is 1)'#010+
'**3*_w : compiler stops also after warnings'#010+
'**3*_n : compiler stops also after notes'#010+
'**3*_h : compiler stops also after hints'#010+
'**3*_h : compiler stops also aft','er hints'#010+
'**2Sg_allow LABEL and GOTO'#010+
'**2Sh_Use ansistrings'#010+
'**2Si_suppor','t C++ styled INLINE'#010+
'**2Si_support C++ styled INLINE'#010+
'**2Sk_load fpcylix unit'#010+
'**2SI<x>_set interface style to <x>'#010+
'**3SIcom_COM compatible interface (default)'#010+
'**3SIcorba_CORBA compatible interface'#010+
'**2Sm_support macros like C (global)'#010+
'**2Sm_su','pport macros like C (global)'#010+
'**2So_same as -Mtp'#010+
'**2Sp_same as -Mgpc'#010+
'**','2Ss_constructor name must be init (destructor must be done)'#010+
'**2Ss_constructor name must be init (destructor must be done)'#010+
'**2St_allow static keyword in objects'#010+
'**1s_don'#039't call assembler and linker'#010+
'**2sh_Generate script to link on host'#010+
'**2sh_Generate script to link on ho','st'#010+
'**2st_Generate script to link on target'#010+
'**2sr_Skip register allocat','ion phase (use with -alr)'#010+
'**2sr_Skip register allocation phase (use with -alr)'#010+
'**1T<x>_Target operating system:'#010+
'3*2Temx_OS/2 via EMX (including EMX/RSX extender)'#010+
'3*2Tfreebsd_FreeBSD'#010+
'3*2Tgo32v2_Version 2 of DJ Delorie DOS extender'#010+
'3*2Tgo32v2_Version 2 of DJ Delorie DOS ex','tender'#010+
'3*2Tlinux_Linux'#010+
'3*2Tnetbsd_NetBSD'#010+
'3*2Tnetware_Novell Netware Mo','dule (clib)'#010+
'3*2Tnetware_Novell Netware Module (clib)'#010+
'3*2Tnetwlibc_Novell Netware Module (libc)'#010+
'3*2Topenbsd_OpenBSD'#010+
'3*2Tos2_OS/2 / eComStation'#010+
'3*2Tsunos_SunOS/Solaris'#010+
'3*2Twatcom_Watcom compatible DOS extender'#010+
'3*2Twdosx_WDOSX DOS extender'#010+
'3*2','Twdosx_WDOSX DOS extender'#010+
'3*2Twin32_Windows 32 Bit'#010+
'3*2Twince_Windows C','E'#010+
'3*2Twince_Windows CE'#010+
'4*2Tlinux_Linux'#010+
'6*2Tamiga_Commodore Amiga'#010+
'6*2Tatari_Atari ST/STe/TT'#010+
@ -939,59 +941,59 @@ const msgtxt : array[0..000170,1..240] of char=(
'6*2Tmacos_Macintosh m68k (not supported)'#010+
'6*2Tpalmos_PalmOS'#010+
'A*2Tlinux_Linux'#010+
'A*2Twince_Windows CE'#010+
'A*2T','wince_Windows CE'#010+
'P*2Tamiga_AmigaOS on PowerPC'#010+
'P*2Tdarwin_Darwin and Ma','cOS X on PowerPC'#010+
'P*2Tdarwin_Darwin and MacOS X on PowerPC'#010+
'P*2Tlinux_Linux on PowerPC'#010+
'P*2Tmacos_MacOS (classic) on PowerPC'#010+
'P*2Tmorphos_MorphOS'#010+
'S*2Tlinux_Linux'#010+
'**1u<x>_undefines the symbol <x>'#010+
'**1U_unit options:'#010+
'**2Un_don'#039't check the unit name'#010+
'*','*2Un_don'#039't check the unit name'#010+
'**2Ur_generate release unit files'#010+
'**2Us','_compile a system unit'#010+
'**2Us_compile a system unit'#010+
'**1v<x>_Be verbose. <x> is a combination of the following letters:'#010+
'**2*_e : Show errors (default) 0 : Show nothing (except errors)'#010+
'**2*_w : Show warnings u : Show unit info'#010+
'**2*_n : Show notes ',' t : Show tried/used files'#010+
'**2*_w : S','how warnings u : Show unit info'#010+
'**2*_n : Show notes t : Show tried/used files'#010+
'**2*_h : Show hints c : Show conditionals'#010+
'**2*_i : Show general info d : Show debug info'#010+
'**2*_l : Show linenumbers r : Rhide/GCC compatibility mode'#010+
'**2*_a : Show e','verything x : Executable info (Win32 only'+
')'#010+
'**2*_b : Write file names messages with full path'#010+
'**2*_v : write fpcdebug.txt with p : Write tree.log with parse tre'+
'**2*_l : Show l','inenumbers r : Rhide/GCC compatibility mod'+
'e'#010+
'**2*_a : Show everything x : Executable info (Win32 only)'#010+
'**2*_b : Write file names messages with full path'#010+
'**2*_v : write fpcdebug.txt with p : Write tree.log with pars','e t'+
'ree'#010+
'**2*_ lots of debugging info'#010+
'3*1W<x>_Win32-like target optio','ns'#010+
'3*1W<x>_Win32-like target options'#010+
'3*2WB_Create a relocatable image'#010+
'3*2WB<x>_Set Image base to Hexadecimal <x> value'#010+
'3*2WC_Specify console type application'#010+
'3*2WD_Use DEFFILE to export functions of DLL or EXE'#010+
'3*2WD_Use DEFFILE to export functions of DLL o','r EXE'#010+
'3*2WF_Specify full-screen type application (OS/2 only)'#010+
'3*2WG_Spe','cify graphic type application'#010+
'3*2WG_Specify graphic type application'#010+
'3*2WN_Do not generate relocation code (necessary for debugging)'#010+
'3*2WR_Generate relocation code'#010+
'P*2WC_Specify console type application (MacOS only)'#010+
'P*2WC_Specify console type application (MacOS',' only)'#010+
'P*2WG_Specify graphic type application (MacOS only)'#010+
'P*2WT_Speci','fy tool type application (MPW tool, MacOS only)'#010+
'P*2WT_Specify tool type application (MPW tool, MacOS only)'#010+
'**1X_executable options:'#010+
'**2Xc_pass --shared to the linker (Unix only)'#010+
'**2Xd_don'#039't use standard library search path (needed for cross com'+
'pile)'#010+
'**2Xd_don'#039't use standard library search path (neede','d for cross c'+
'ompile)'#010+
'**2Xe_use external linker'#010+
'**2XD_try to link units',' dynamic (defines FPC_LINK_DYNAMIC)'#010+
'**2XD_try to link units dynamic (defines FPC_LINK_DYNAMIC)'#010+
'**2Xi_use internal linker'#010+
'**2Xm_generate link map'#010+
'**2XM<x>_set the name of the '#039'main'#039' program routine (default i'+
's '#039'main'#039')'#010+
'**2XP<x>_prepend the binutils names with the prefix <x>'#010+
'**2Xr<x>_set libr','ary search path to <x> (needed for cross compile)'#010+
'**2','XP<x>_prepend the binutils names with the prefix <x>'#010+
'**2Xr<x>_set library search path to <x> (needed for cross compile)'#010+
'**2Xs_strip all symbols from executable'#010+
'**2XS_try to link units static (default) (defines FPC_LINK_STATIC)'#010+
'**2Xt_link with static libraries (-static is passed to linker)'#010+
'**2XX_try to link un','its smart (defines FPC_LINK_SMART)'#010+
'**2Xt_link wi','th static libraries (-static is passed to linker)'#010+
'**2XX_try to link units smart (defines FPC_LINK_SMART)'#010+
'**1*_'#010+
'**1?_shows this help'#010+
'**1h_shows this help without waiting'#000

30
compiler/ncgld.pas
View File

@ -616,7 +616,12 @@ implementation
cg.a_load_ref_subsetreg(current_asmdata.CurrAsmList,right.location.size,left.location.size,right.location.reference,left.location.sreg);
LOC_SUBSETREF,
LOC_CSUBSETREF:
cg.a_load_ref_subsetref(current_asmdata.CurrAsmList,right.location.size,left.location.size,right.location.reference,left.location.sref);
{$ifndef cpu64bit}
if right.location.size in [OS_64,OS_S64] then
cg64.a_load64_ref_subsetref(current_asmdata.CurrAsmList,right.location.reference,left.location.sref)
else
{$endif cpu64bit}
cg.a_load_ref_subsetref(current_asmdata.CurrAsmList,right.location.size,left.location.size,right.location.reference,left.location.sref);
else
internalerror(200203284);
end;
@ -692,6 +697,11 @@ implementation
LOC_SUBSETREF,
LOC_CSUBSETREF:
begin
{$ifndef cpu64bit}
if right.location.size in [OS_64,OS_S64] then
cg64.a_load64_subsetref_loc(current_asmdata.CurrAsmList,right.location.sref,left.location)
else
{$endif cpu64bit}
cg.a_load_subsetref_loc(current_asmdata.CurrAsmList,
right.location.size,right.location.sref,left.location);
end;
@ -709,13 +719,19 @@ implementation
LOC_FLAGS :
begin
{This can be a wordbool or longbool too, no?}
if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
cg.g_flags2reg(current_asmdata.CurrAsmList,def_cgsize(left.resulttype.def),right.location.resflags,left.location.register)
else
begin
if not(left.location.loc = LOC_REFERENCE) then
internalerror(200203273);
case left.location.loc of
LOC_REGISTER,LOC_CREGISTER:
cg.g_flags2reg(current_asmdata.CurrAsmList,def_cgsize(left.resulttype.def),right.location.resflags,left.location.register);
LOC_REFERENCE:
cg.g_flags2ref(current_asmdata.CurrAsmList,def_cgsize(left.resulttype.def),right.location.resflags,left.location.reference);
LOC_SUBSETREG,LOC_SUBSETREF:
begin
r:=cg.getintregister(current_asmdata.CurrAsmList,def_cgsize(left.resulttype.def));
cg.g_flags2reg(current_asmdata.CurrAsmList,def_cgsize(left.resulttype.def),right.location.resflags,r);
cg.a_load_reg_loc(current_asmdata.CurrAsmList,def_cgsize(left.resulttype.def),r,left.location);
end;
else
internalerror(200203273);
end;
end;
{$endif cpuflags}

66
compiler/ncgmem.pas
View File

@ -238,6 +238,7 @@ implementation
procedure tcgsubscriptnode.pass_2;
var
paraloc1 : tcgpara;
sref: tsubsetreference;
begin
secondpass(left);
if codegenerror then
@ -325,11 +326,22 @@ implementation
location.size:=def_cgsize(resulttype.def);
location.sreg.subsetreg := left.location.register;
location.sreg.subsetregsize := left.location.size;
if (target_info.endian = ENDIAN_BIG) then
location.sreg.startbit := (tcgsize2size[location.sreg.subsetregsize] - tcgsize2size[location.size] - vs.fieldoffset) * 8
if not is_packed_record_or_object(left.resulttype.def) then
begin
if (target_info.endian = ENDIAN_BIG) then
location.sreg.startbit := (tcgsize2size[location.sreg.subsetregsize] - tcgsize2size[location.size] - vs.fieldoffset) * 8
else
location.sreg.startbit := (vs.fieldoffset * 8);
location.sreg.bitlen := tcgsize2size[location.size] * 8;
end
else
location.sreg.startbit := (vs.fieldoffset * 8);
location.sreg.bitlen := tcgsize2size[location.size] * 8;
begin
location.sreg.bitlen := resulttype.def.packedbitsize;
if (target_info.endian = ENDIAN_BIG) then
location.sreg.startbit := (tcgsize2size[location.sreg.subsetregsize]*8 - location.sreg.bitlen) - vs.fieldoffset
else
location.sreg.startbit := vs.fieldoffset;
end;
end;
end;
LOC_SUBSETREG,
@ -349,14 +361,44 @@ implementation
if (location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
begin
inc(location.reference.offset,vs.fieldoffset);
{$ifdef SUPPORT_UNALIGNED}
{ packed? }
if (vs.owner.defowner.deftype in [recorddef,objectdef]) and
(tabstractrecordsymtable(vs.owner).usefieldalignment=1) then
location.reference.alignment:=1;
{$endif SUPPORT_UNALIGNED}
if not is_packed_record_or_object(left.resulttype.def) then
begin
inc(location.reference.offset,vs.fieldoffset);
{$ifdef SUPPORT_UNALIGNED}
{ packed? }
{$warning unalignment check does not work since usefieldalignment is not stored in ppu}
if (vs.owner.defowner.deftype in [recorddef,objectdef]) and
(tabstractrecordsymtable(vs.owner).usefieldalignment=1) then
location.reference.alignment:=1;
{$endif SUPPORT_UNALIGNED}
end
else if (vs.fieldoffset mod 8 = 0) and
(resulttype.def.packedbitsize mod 8 = 0) and
{ is different in case of e.g. packenum 2 and an enum }
{ which fits in 8 bits }
(resulttype.def.size*8 = resulttype.def.packedbitsize) then
begin
inc(location.reference.offset,vs.fieldoffset div 8);
if (resulttype.def.size*8 <> resulttype.def.packedbitsize) then
internalerror(2006082013);
{ packed records always have an alignment of 1 }
location.reference.alignment:=1;
end
else
begin
sref.ref:=location.reference;
sref.ref.alignment:=1;
sref.bitindexreg:=NR_NO;
inc(sref.ref.offset,vs.fieldoffset div 8);
sref.startbit:=vs.fieldoffset mod 8;
sref.bitlen:=resulttype.def.packedbitsize;
if (left.location.loc=LOC_REFERENCE) then
location.loc:=LOC_SUBSETREF
else
location.loc:=LOC_CSUBSETREF;
location.sref:=sref;
end;
{ also update the size of the location }
location.size:=def_cgsize(resulttype.def);
end;

6
compiler/ncgutil.pas
View File

@ -580,17 +580,17 @@ implementation
{ MSB first in memory and e.g. byte(word_var) should }
{ return the second byte in this case (JM) }
if (target_info.endian = ENDIAN_BIG) and
(l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
(l.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_SUBSETREF,LOC_CSUBSETREF]) then
inc(l.reference.offset,TCGSize2Size[l.size]-TCGSize2Size[dst_size]);
{$ifdef x86}
if not (l.loc in [LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF]) then
if not (l.loc in [LOC_SUBSETREG,LOC_CSUBSETREG]) then
l.size:=dst_size;
{$endif x86}
end;
cg.a_load_loc_reg(list,dst_size,l,hregister);
if (TCGSize2Size[dst_size]<TCGSize2Size[l.size])
{$ifdef x86}
and (l.loc in [LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF])
and (l.loc in [LOC_SUBSETREG,LOC_CSUBSETREG])
{$endif x86}
then
l.size:=dst_size;

2
compiler/pdecvar.pas
View File

@ -1307,6 +1307,8 @@ implementation
UnionDef:=trecorddef.create(unionsymtable);
uniondef.isunion:=true;
startvarrecsize:=UnionSymtable.datasize;
{ align the bitpacking to the next byte }
UnionSymtable.datasize:=startvarrecsize;
startvarrecalign:=UnionSymtable.fieldalignment;
startpadalign:=Unionsymtable.padalignment;
symtablestack.push(UnionSymtable);

5
compiler/powerpc/nppcmat.pas
View File

@ -674,7 +674,10 @@ end;
location_copy(location,left.location);
inverse_flags(location.resflags);
end;
LOC_REGISTER, LOC_CREGISTER, LOC_REFERENCE, LOC_CREFERENCE :
LOC_REGISTER, LOC_CREGISTER,
LOC_REFERENCE, LOC_CREFERENCE,
LOC_SUBSETREG, LOC_CSUBSETREG,
LOC_SUBSETREF, LOC_CSUBSETREF:
begin
location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(left.resulttype.def),true);
current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_CMPWI,left.location.register,0));

2
compiler/ppu.pas
View File

@ -43,7 +43,7 @@ type
{$endif Test_Double_checksum}
const
CurrentPPUVersion=60;
CurrentPPUVersion=61;
{ buffer sizes }
maxentrysize = 1024;

8
compiler/ptconst.pas
View File

@ -776,8 +776,11 @@ implementation
{ reads a typed constant record }
recorddef:
begin
{ packed record }
if is_packed_record_or_object(t.def) then
Message(type_e_no_const_packed_record)
{ KAZ }
if (trecorddef(t.def)=rec_tguid) and
else if (trecorddef(t.def)=rec_tguid) and
((token=_CSTRING) or (token=_CCHAR) or (token=_ID)) then
begin
p:=comp_expr(true);
@ -925,6 +928,9 @@ implementation
else if (oo_has_vmt in tobjectdef(t.def).objectoptions) and
(m_fpc in aktmodeswitches) then
Message(parser_e_type_const_not_possible)
{ packed object }
else if is_packed_record_or_object(t.def) then
Message(type_e_no_const_packed_record)
else
begin
consume(_LKLAMMER);

5
compiler/ptype.pas
View File

@ -708,7 +708,10 @@ implementation
else
begin
oldaktpackrecords:=aktpackrecords;
aktpackrecords:=1;
if not bitpacking then
aktpackrecords:=1
else
aktpackrecords:=bit_alignment;
if token in [_CLASS,_OBJECT] then
tt.setdef(object_dec(name,genericdef,genericlist,nil))
else

3
compiler/symconst.pas
View File

@ -30,7 +30,8 @@ uses
const
def_alignment = 4;
C_alignment = -1;
C_alignment = -1;
bit_alignment = -2;
{ if you change one of the following contants, }
{ you have also to change the typinfo unit}

30
compiler/symdef.pas
View File

@ -187,6 +187,7 @@ interface
function getsymtable(t:tgetsymtable):tsymtable;override;
procedure buildderefimpl;override;
procedure derefimpl;override;
function is_packed:boolean;
end;
trecorddef = class(tabstractrecorddef)
@ -2634,23 +2635,7 @@ implementation
else if not (ado_IsBitPacked in arrayoptions) then
alignment:=size_2_align(elesize)
else
case elepackedbitsize of
1,2,4,8:
alignment := 1;
{ 10 bits can never be split over 3 bytes via 1-8-1, because it }
{ always starts at a multiple of 10 bits. Same for the others. }
3,5,7,9,10,12,16:
alignment := 2;
{$ifdef cpu64bit}
11,13,14,15,17..26,28,32:
alignment := 4;
else
alignment := 8;
{$else cpu64bit}
else
alignment := 4;
{$endif cpu64bit}
end;
alignment:=packedbitsloadsize(elepackedbitsize);
end;
@ -2753,6 +2738,11 @@ implementation
end;
function tabstractrecorddef.is_packed:boolean;
begin
result:=tabstractrecordsymtable(symtable).is_packed;
end;
procedure tabstractrecorddef.count_field_rtti(sym : tnamedindexitem;arg:pointer);
begin
if (FRTTIType=fullrtti) or
@ -2918,6 +2908,12 @@ implementation
procedure trecorddef.write_rtti_data(rt:trttitype);
begin
if is_packed then
begin
current_asmdata.asmlists[al_rtti].concat(tai_const.create_8bit(tkUnknown));
write_rtti_name;
exit;
end;
current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkrecord));
write_rtti_name;
{$ifdef cpurequiresproperalignment}

10
compiler/symsym.pas
View File

@ -146,6 +146,7 @@ interface
procedure buildderef;override;
procedure deref;override;
function getsize : longint;
function getpackedbitsize : longint;
function is_regvar(refpara: boolean):boolean;
procedure trigger_notifications(what:Tnotification_flag);
function register_notification(flags:Tnotification_flags;
@ -1280,6 +1281,15 @@ implementation
end;
function tabstractvarsym.getpackedbitsize : longint;
begin
{ bitpacking is only done for ordinals }
if not is_ordinal(vartype.def) then
internalerror(2006082010);
result:=vartype.def.packedbitsize;
end;
function tabstractvarsym.is_regvar(refpara: boolean):boolean;
begin
{ Register variables are not allowed in the following cases:

146
compiler/symtable.pas
View File

@ -81,7 +81,6 @@ interface
tabstractrecordsymtable = class(tstoredsymtable)
public
datasize : aint;
usefieldalignment, { alignment to use for fields (PACKRECORDS value), C_alignment is C style }
recordalignment, { alignment required when inserting this record }
fieldalignment, { alignment current alignment used when fields are inserted }
@ -96,6 +95,17 @@ interface
procedure insertfield(sym:tfieldvarsym);
procedure addalignmentpadding;
procedure insertdef(def:tdefentry);override;
function is_packed: boolean;
protected
procedure setdatasize(val: aint);
_datasize : aint;
{ size in bits of the data in case of bitpacked record. Only important during construction, }
{ no need to save in/restore from ppu file. datasize is always (databitsize+7) div 8. }
databitsize : aint;
{ bitpacked? -> all fieldvarsym offsets are in bits instead of bytes }
packed_record: boolean;
public
property datasize : aint read _datasize write setdatasize;
end;
trecordsymtable = class(tabstractrecordsymtable)
@ -280,7 +290,7 @@ implementation
{ target }
systems,
{ symtable }
symutil,defcmp,
symutil,defcmp,defutil,
{ module }
fmodule,
{ codegen }
@ -817,16 +827,21 @@ implementation
constructor tabstractrecordsymtable.create(const n:string;usealign:shortint);
begin
inherited create(n);
datasize:=0;
_datasize:=0;
databitsize:=0;
recordalignment:=1;
usefieldalignment:=usealign;
packed_record:=usealign=bit_alignment;
padalignment:=1;
{ recordalign C_alignment means C record packing, that starts
with an alignment of 1 }
if usealign=C_alignment then
fieldalignment:=1
else
fieldalignment:=usealign;
case usealign of
C_alignment,
bit_alignment:
fieldalignment:=1
else
fieldalignment:=usealign;
end;
end;
@ -834,6 +849,8 @@ implementation
var
storesymtable : tsymtable;
begin
packed_record:=boolean(ppufile.getbyte);
storesymtable:=aktrecordsymtable;
aktrecordsymtable:=self;
@ -848,6 +865,8 @@ implementation
oldtyp : byte;
storesymtable : tsymtable;
begin
ppufile.putbyte(byte(packed_record));
storesymtable:=aktrecordsymtable;
aktrecordsymtable:=self;
oldtyp:=ppufile.entrytyp;
@ -917,6 +936,40 @@ implementation
l:=sym.getsize;
vardef:=sym.vartype.def;
varalign:=vardef.alignment;
if (usefieldalignment=bit_alignment) then
begin
{ bitpacking only happens for ordinals, the rest is aligned at }
{ 1 byte (compatible with GPC/GCC) }
if is_ordinal(vardef) then
begin
sym.fieldoffset:=databitsize;
databitsize:=high(aint);
l:=sym.getpackedbitsize;
end
else
begin
databitsize:=_datasize*8;
sym.fieldoffset:=databitsize;
l:=l*8;
end;
{ bit packed records are limited to high(aint) bits }
{ instead of bytes to avoid double precision }
{ arithmetic in offset calculations }
if (int64(l)+sym.fieldoffset)>high(aint) then
begin
Message(sym_e_segment_too_large);
_datasize:=high(aint);
databitsize:=high(aint);
end
else
begin
databitsize:=sym.fieldoffset+l;
_datasize:=(databitsize+7) div 8;
end;
{ rest is not applicable }
exit;
end;
{ Calc the alignment size for C style records }
if (usefieldalignment=C_alignment) then
begin
@ -946,15 +999,17 @@ implementation
end;
if varalign=0 then
varalign:=size_2_align(l);
varalignfield:=used_align(varalign,aktalignment.recordalignmin,fieldalignment);
sym.fieldoffset:=align(datasize,varalignfield);
if (usefieldalignment<> bit_alignment) then
varalignfield:=used_align(varalign,aktalignment.recordalignmin,fieldalignment);
sym.fieldoffset:=align(_datasize,varalignfield);
if (int64(l)+sym.fieldoffset)>high(aint) then
begin
Message(sym_e_segment_too_large);
datasize:=high(aint);
_datasize:=high(aint);
end
else
datasize:=sym.fieldoffset+l;
_datasize:=sym.fieldoffset+l;
{ Calc alignment needed for this record }
if (usefieldalignment=C_alignment) then
varalignrecord:=used_align(varalign,aktalignment.recordalignmin,aktalignment.maxCrecordalign)
@ -963,7 +1018,7 @@ implementation
varalignrecord:=used_align(varalign,aktalignment.recordalignmin,aktalignment.recordalignmax)
else
begin
{ packrecords is set explicit, ignore recordalignmax limit }
{ packrecords is set explicitly, ignore recordalignmax limit }
varalignrecord:=used_align(varalign,aktalignment.recordalignmin,usefieldalignment);
end;
recordalignment:=max(recordalignment,varalignrecord);
@ -988,7 +1043,7 @@ implementation
padalignment:=fieldalignment
else
padalignment:=recordalignment;
datasize:=align(datasize,padalignment);
_datasize:=align(_datasize,padalignment);
end;
@ -1003,6 +1058,18 @@ implementation
end;
function tabstractrecordsymtable.is_packed: boolean;
begin
result:=packed_record;
end;
procedure tabstractrecordsymtable.setdatasize(val: aint);
begin
_datasize:=val;
databitsize:=val*8;
end;
{****************************************************************************
TRecordSymtable
****************************************************************************}
@ -1027,9 +1094,10 @@ implementation
storesize,storealign : longint;
begin
{ copy symbols }
storesize:=datasize;
storesize:=_datasize;
storealign:=fieldalignment;
datasize:=offset;
_datasize:=offset;
databitsize:=offset*8;
ps:=tsym(unionst.symindex.first);
while assigned(ps) do
begin
@ -1042,18 +1110,44 @@ implementation
ps.right:=nil;
{ add to this record }
ps.owner:=self;
datasize:=tfieldvarsym(ps).fieldoffset+offset;
if (usefieldalignment=bit_alignment) then
begin
{ bit packed records are limited to high(aint) bits }
{ instead of bytes to avoid double precision }
{ arithmetic in offset calculations }
if (databitsize)>high(aint) then
begin
Message(sym_e_segment_too_large);
_datasize:=high(aint);
databitsize:=high(aint);
end
else
begin
databitsize:=tfieldvarsym(ps).fieldoffset+offset*8;
_datasize:=(databitsize+7) div 8;
end;
tfieldvarsym(ps).fieldoffset:=databitsize;
end
else
begin
_datasize:=tfieldvarsym(ps).fieldoffset+offset;
if _datasize>high(aint) then
begin
Message(sym_e_segment_too_large);
_datasize:=high(aint);
end;
{ update address }
tfieldvarsym(ps).fieldoffset:=_datasize;
{ update alignment of this record }
varalign:=tfieldvarsym(ps).vartype.def.alignment;
if varalign=0 then
varalign:=size_2_align(tfieldvarsym(ps).getsize);
varalignrecord:=used_align(varalign,aktalignment.recordalignmin,fieldalignment);
recordalignment:=max(recordalignment,varalignrecord);
end;
symindex.insert(ps);
symsearch.insert(ps);
{ update address }
tfieldvarsym(ps).fieldoffset:=datasize;
{ update alignment of this record }
varalign:=tfieldvarsym(ps).vartype.def.alignment;
if varalign=0 then
varalign:=size_2_align(tfieldvarsym(ps).getsize);
varalignrecord:=used_align(varalign,aktalignment.recordalignmin,fieldalignment);
recordalignment:=max(recordalignment,varalignrecord);
{ next }
ps:=nps;
@ -1070,7 +1164,7 @@ implementation
defindex.insert(pd);
pd:=npd;
end;
datasize:=storesize;
_datasize:=storesize;
fieldalignment:=storealign;
end;

26
tests/test/tparray11.pp Normal file
View File

@ -0,0 +1,26 @@
{$bitpacking on}
{ from gpc testsuite (sam7.pas) }
Program Sam7;
Var
foo: array [ 'a'..'f' ] of Boolean = ( false, false, true, false, false, false );
bar: packed array [ 42..47 ] of Boolean;
baz: array [ '0'..'5' ] of Boolean;
i: Integer;
begin
pack ( foo, 'a', bar );
unpack ( bar, baz, '0' );
for i:= 0 to 5 do
if bar [ 42 + i ] <> baz [ chr ( ord('0')+ i ) ] then
foo [ 'c' ]:= false;
if foo [ 'c' ] and bar [ 44 ] then
writeln ( 'OK' )
else
begin
writeln ( 'failed ', foo [ 'c' ], ' ', bar [ 44 ] );
halt(1);
end;
end.

39
tests/test/tprec1.pp Normal file
View File

@ -0,0 +1,39 @@
{$bitpacking on}
type
tenum = (ea,eb,ec,ed,ee,ef,eg,eh);
tr = packed record
a: 0..3; // 2 bits
w: word; // 16 bits;
b: 0..31; // 5 bits;
c: boolean; // 1 bit
d: 0..31; // 5 bits
e: tenum; // 3 bits
end;
procedure t(var r2: tr);
var
r: tr;
begin
r.a := 2;
r.w := 32768;
r.b := 23;
r.c := true;
r.d := 5;
r.e := ed;
r2 := r;
end;
var
r: tr;
begin
t(r);
if (r.a <> 2) or
(r.w <> 32768) or
(r.b <> 23) or
(not r.c) or
(r.d <> 5) or
(r.e <> ed) then
halt(1);
end.

33
tests/test/tprec2.pp Normal file
View File

@ -0,0 +1,33 @@
{$bitpacking on}
type
tenum = (ea,eb,ec,ed,ee,ef,eg,eh);
tr = packed record
a: byte; // 2 bits
w: word; // 16 bits;
b: 0..31; // 5 bits;
e: tenum; // 3 bits
end;
procedure t(var r2: tr);
var
r: tr;
begin
r.a := 2;
r.w := 32768;
r.b := 23;
r.e := ed;
r2 := r;
end;
var
r: tr;
begin
t(r);
if (r.a <> 2) or
(r.w <> 32768) or
(r.b <> 23) or
(r.e <> ed) then
halt(1);
end.

36
tests/test/tprec3.pp Normal file
View File

@ -0,0 +1,36 @@
{$bitpacking on}
type
tenum = (ea,eb,ec,ed,ee,ef,eg,eh);
tr = packed record
a: 0..3; // 2 bits
i: int64;
c: boolean; // 1 bit
d: 0..31; // 5 bits
e: tenum; // 3 bits
end;
procedure t(var r2: tr);
var
r: tr;
begin
r.a := 2;
r.i := 12345678901234567890;
r.c := true;
r.d := 5;
r.e := ed;
r2 := r;
end;
var
r: tr;
begin
t(r);
if (r.a <> 2) or
(r.i <> 12345678901234567890) or
(not r.c) or
(r.d <> 5) or
(r.e <> ed) then
halt(1);
end.

162
tests/test/tprec4.pp Normal file
View File

@ -0,0 +1,162 @@
{$bitpacking on}
{ from the GPC test suite (sam9.pas) }
program sam9;
type
e1 = (
enum000,
enum001,
enum002,
enum003,
enum004,
enum005,
enum006,
enum007,
enum008,
enum009,
enum010,
enum011,
enum012,
enum013,
enum014,
enum015,
enum016,
enum017,
enum018,
enum019,
enum020,
enum021,
enum022,
enum023,
enum024,
enum025,
enum026,
enum027,
enum028,
enum029,
enum030,
enum031,
enum032,
enum033,
enum034,
enum035,
enum036,
enum037,
enum038,
enum039,
enum040,
enum041,
enum042,
enum043,
enum044,
enum045,
enum046,
enum047,
enum048,
enum049,
enum050,
enum051,
enum052,
enum053,
enum054,
enum055,
enum056,
enum057,
enum058,
enum059,
enum060,
enum061,
enum062,
enum063,
enum064,
enum065,
enum066,
enum067,
enum068,
enum069,
enum070,
enum071,
enum072,
enum073,
enum074,
enum075,
enum076,
enum077,
enum078,
enum079,
enum080,
enum081,
enum082,
enum083,
enum084,
enum085,
enum086,
enum087,
enum088,
enum089,
enum090,
enum091,
enum092,
enum093,
enum094,
enum095,
enum096,
enum097,
enum098,
enum099,
enum100,
enum101,
enum102,
enum103,
enum104,
enum105,
enum106,
enum107,
enum108,
enum109,
enum110,
enum111,
enum112,
enum113,
enum114,
enum115,
enum116,
enum117,
enum118,
enum119,
enum120,
enum121,
enum122,
enum123,
enum124,
enum125,
enum126,
enum127,
enum128 { Remove this and it works !}
);
r1 = 0 .. 128;
t1 = packed record { has to be packed }
case integer of
1: (f1: e1);
2: (f2: r1);
end;
var
v1: t1;
procedure foo;
begin
v1.f1 := enum000;
v1.f2 := 127;
v1.f2 := 128;
end;
begin
foo;
if v1.f1 <> enum128 then
halt(1);
end.

32
tests/test/tprec5.pp Normal file
View File

@ -0,0 +1,32 @@
{$bitpacking on}
program sam8;
{ from the gpc testsuite (sam8.pas) }
{
Using a subrange type in a packed recrod seems to break passing the type
by reference
}
type
t1 = 0..100; {Has to be subrange}
r1 = packed record { Has to be packed }
f1 : t1;
end;
procedure proc1(var a1: t1); { Has to be var }
begin
if a1 = 42 then writeln ('OK') else writeln ('failed')
end;
procedure proc2(var a1: t1); { Also has to be var }
begin
proc1(a1);
end;
var a1 : t1;
begin
a1 := 42;
proc2 (a1)
end.

28
tests/test/tprec6.pp Normal file
View File

@ -0,0 +1,28 @@
{ from gpc testsuite (martin3.pas) }
Program PackedAssignTest;
Uses uprec6;
Var I,J:Integer;
APackedBoolean:TPackedBoolean;
Begin
writeln(sizeof(APackedBoolean[0]));
writeln(sizeof(APackedBoolean[1]));
// writeln(ptruint(@APackedBoolean[1])-ptruint(@APackedBoolean[0]));
// writeln(ptruint(@APackedBoolean[2])-ptruint(@APackedBoolean[1]));
// writeln(ptruint(@APackedBoolean[3])-ptruint(@APackedBoolean[2]));
for I := 1 to MaxA do
for J := 1 to MaxB do
APackedBoolean[I, J] := J = I + 1;
ARecord.C:=99;
ARecord.D:=100;
ARecord.PackedBoolean:=APackedBoolean;
for I := 1 to MaxA do
for J := 1 to MaxB do
if ARecord.PackedBoolean[I, J] <> (J = I + 1) then
Begin
WriteLn ('failed ', I, ' ', J);
Halt(1);
end;
if (ARecord.D = 100) and (ARecord.C = 99) then WriteLn ('OK') else begin WriteLn ('failed 2'); halt(2) end;
end.

20
tests/test/tprec7.pp Normal file
View File

@ -0,0 +1,20 @@
Program PackedAssignTest;
Uses uprec7;
Var BRecord:TRecord;
begin
if SizeOf (BRecord) <> s then
begin
WriteLn ('failed 1');
Halt
end;
BRecord := ARecord;
with BRecord do
if (a or not b or not c or not d or e or not f or g or h or not i)then
begin
WriteLn ('failed 2');
Halt(1);
end;
WriteLn ('OK')
end.

58
tests/test/tprec8.pp Normal file
View File

@ -0,0 +1,58 @@
{$bitpacking on}
type
tenum = (ea,eb,ec,ed,ee,ef,eg,eh);
tr = packed record
a: 0..3; // 2 bits
i: int64;
c: boolean; // 1 bit
d: 0..31; // 5 bits
e: tenum; // 3 bits
case byte of
0: (g: 0..7);
1: (h: 0..65536; k: boolean);
2: (j: boolean);
end;
procedure t(var r2: tr);
var
r: tr;
begin
r.a := 2;
r.i := 12345678901234567890;
r.c := true;
r.d := 5;
r.e := ed;
r2 := r;
end;
var
r: tr;
b: byte;
begin
b := 0;
t(r);
if (r.a <> 2) or
(r.i <> 12345678901234567890) or
(not r.c) or
(r.d <> 5) or
(r.e <> ed) then
halt(1);
r.g := 5;
if (r.g <> 5) then
halt(1);
r.h := 65535;
if (r.h <> 65535) then
halt(1);
r.k := true;
if not (r.k) then
halt(1);
r.j := false;
if r.j then
halt(1);
if b <> 0 then
halt(1);
if sizeof(tr) <> 13 then
halt(2);
end.

22
tests/test/uprec6.pp Normal file
View File

@ -0,0 +1,22 @@
{$bitpacking+}
{ from gpc testsuite (martin3u.pas) }
Unit uprec6;
Interface
Const MaxA=5;
MaxB=62;
Type TPackedBoolean=Packed Array[1..MaxA] of Packed Array[1..MaxB] of Boolean;
TRecord = Record
C:Integer;
PackedBoolean:TPackedBoolean;
D:Integer;
End;
Var ARecord:TRecord;
Implementation
End.

18
tests/test/uprec7.pp Normal file
View File

@ -0,0 +1,18 @@
{ from GPC testsuite (martin3v.pas) }
{$bitpacking on}
Unit uprec7;
Interface
Type TRecord = packed Record
a, b, c, d, e, f, g, h, i: Boolean
end;
Var ARecord:TRecord = (False, True, True, True, False, True, False, False, True);
s: Integer;
Implementation
Begin
s := SizeOf (TRecord)
end.