paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 05:59:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

* calling convention rewrite

Browse Source
This commit is contained in:
peter 2001-10-25 21:22:32 +00:00
parent 4b406237ae
commit e37dbf904d
23 changed files with 631 additions and 593 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
compiler/globals.pas
View File

@ -159,7 +159,7 @@ interface
initasmmode : tasmmode;
initinterfacetype : tinterfacetypes;
initoutputformat : tasm;
initdefproccall : TDefProcCall;
initdefproccall : tproccalloption;
{ current state values }
aktglobalswitches : tglobalswitches;
@ -179,7 +179,7 @@ interface
aktasmmode : tasmmode;
aktinterfacetype : tinterfacetypes;
aktoutputformat : tasm;
aktdefproccall : TDefProcCall;
aktdefproccall : tproccalloption;
{ Memory sizes }
heapsize,
@ -1148,24 +1148,27 @@ implementation
function SetAktProcCall(const s:string; changeInit:boolean):boolean;
const
DefProcCallName : array[TDefProcCall] of string[12] = (
DefProcCallName : array[tproccalloption] of string[12] = ('',
'CDECL',
'CPPDECL',
'', { compilerproc }
'FAR16',
'FPCCALL',
'INLINE',
'', { internconst }
'', { internproc }
'', { palmossyscall }
'PASCAL',
'POPSTACK',
'REGISTER',
'SAFECALL',
'STDCALL',
'SYSTEM'
);
var
t : TDefProcCall;
t : tproccalloption;
begin
SetAktProcCall:=false;
for t:=low(TDefProcCall) to high(TDefProcCall) do
for t:=low(tproccalloption) to high(tproccalloption) do
if DefProcCallName[t]=s then
begin
AktDefProcCall:=t;
@ -1423,7 +1426,7 @@ implementation
{$endif m68k}
{$endif i386}
initinterfacetype:=it_interfacecom;
initdefproccall:=dpc_fpccall;
initdefproccall:=pocall_none;
initdefines:=TStringList.Create;
{ memory sizes, will be overriden by parameter or default for target
@ -1449,7 +1452,10 @@ begin
end.
{
$Log$
Revision 1.48 2001-10-23 21:49:42 peter
Revision 1.49 2001-10-25 21:22:32 peter
* calling convention rewrite
Revision 1.48 2001/10/23 21:49:42 peter
* $calling directive and -Cc commandline patch added
from Pavel Ozerski

53
compiler/globtype.pas
View File

@ -163,20 +163,42 @@ interface
bt_general,bt_type,bt_const,bt_except
);
{ Default calling convention }
TDefProcCall = (
dpc_cdecl,
dpc_cppdecl,
dpc_far16,
dpc_fpccall,
dpc_inline,
dpc_pascal,
dpc_popstack,
dpc_register,
dpc_safecall,
dpc_stdcall,
dpc_system
{ calling convention for tprocdef and tprocvardef }
tproccalloption=(pocall_none,
pocall_cdecl, { procedure uses C styled calling }
pocall_cppdecl, { C++ calling conventions }
pocall_compilerproc, { Procedure is used for internal compiler calls }
pocall_far16, { Far16 for OS/2 }
pocall_fpccall, { FPC default calling }
pocall_inline, { Procedure is an assembler macro }
pocall_internconst, { procedure has constant evaluator intern }
pocall_internproc, { Procedure has compiler magic}
pocall_palmossyscall, { procedure is a PalmOS system call }
pocall_pascal, { pascal standard left to right }
pocall_register, { procedure uses register (fastcall) calling }
pocall_safecall, { safe call calling conventions }
pocall_stdcall, { procedure uses stdcall call }
pocall_system { system call }
);
tproccalloptions = set of tproccalloption;
const
proccalloptionStr : array[tproccalloption] of string[14]=('',
'CDecl',
'CPPDecl',
'CompilerProc',
'Far16',
'FPCCall',
'Inline',
'InternConst',
'InternProc',
'PalmOSSysCall',
'Pascal',
'Register',
'SafeCall',
'StdCall',
'System'
);
type
stringid = string[maxidlen];
@ -223,7 +245,10 @@ implementation
end.
{
$Log$
Revision 1.18 2001-10-24 11:46:06 marco
Revision 1.19 2001-10-25 21:22:32 peter
* calling convention rewrite
Revision 1.18 2001/10/24 11:46:06 marco
* Opt Align fix.
Revision 1.17 2001/10/23 21:49:42 peter

11
compiler/i386/cga.pas
View File

@ -2300,7 +2300,7 @@ implementation
{ generate copies of call by value parameters }
if not(po_assembler in aktprocsym.definition.procoptions) and
(([pocall_cdecl,pocall_cppdecl]*aktprocsym.definition.proccalloptions)=[]) then
not(aktprocsym.definition.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_palmossyscall,pocall_system]) then
aktprocsym.definition.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas);
if assigned( aktprocsym.definition.parast) then
@ -2769,7 +2769,7 @@ implementation
{ parameters are limited to 65535 bytes because }
{ ret allows only imm16 }
if (parasize>65535) and not(pocall_clearstack in aktprocsym.definition.proccalloptions) then
if (parasize>65535) and not(po_clearstack in aktprocsym.definition.procoptions) then
CGMessage(cg_e_parasize_too_big);
{ at last, the return is generated }
@ -2795,7 +2795,7 @@ implementation
begin
{Routines with the poclearstack flag set use only a ret.}
{ also routines with parasize=0 }
if (pocall_clearstack in aktprocsym.definition.proccalloptions) then
if (po_clearstack in aktprocsym.definition.procoptions) then
begin
{$ifndef OLD_C_STACK}
{ complex return values are removed from stack in C code PM }
@ -2974,7 +2974,10 @@ implementation
end.
{
$Log$
Revision 1.7 2001-10-20 17:22:57 peter
Revision 1.8 2001-10-25 21:22:41 peter
* calling convention rewrite
Revision 1.7 2001/10/20 17:22:57 peter
* concatcopy could release a wrong reference because the offset was
increased without restoring the original before the release of
a temp

19
compiler/i386/n386cal.pas
View File

@ -309,7 +309,7 @@ implementation
unusedregisters:=unused;
usablecount:=usablereg32;
if ([pocall_cdecl,pocall_cppdecl,pocall_stdcall]*procdefinition.proccalloptions)<>[] then
if (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_stdcall]) then
para_alignment:=4
else
para_alignment:=aktalignment.paraalign;
@ -322,7 +322,7 @@ implementation
params:=left.getcopy
else params := nil;
if (pocall_inline in procdefinition.proccalloptions) then
if (procdefinition.proccalloption=pocall_inline) then
begin
inlined:=true;
inlinecode:=tprocinlinenode(right);
@ -481,13 +481,13 @@ implementation
if not(inlined) and
assigned(right) then
tcallparanode(params).secondcallparan(TParaItem(tabstractprocdef(right.resulttype.def).Para.first),
(pocall_leftright in procdefinition.proccalloptions),inlined,
(([pocall_cdecl,pocall_cppdecl]*procdefinition.proccalloptions)<>[]),
(po_leftright in procdefinition.procoptions),inlined,
(procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl]),
para_alignment,para_offset)
else
tcallparanode(params).secondcallparan(TParaItem(procdefinition.Para.first),
(pocall_leftright in procdefinition.proccalloptions),inlined,
(([pocall_cdecl,pocall_cppdecl]*procdefinition.proccalloptions)<>[]),
(po_leftright in procdefinition.procoptions),inlined,
(procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl]),
para_alignment,para_offset);
end;
if inlined then
@ -1073,7 +1073,7 @@ implementation
{ this was only for normal functions
displaced here so we also get
it to work for procvars PM }
if (not inlined) and (pocall_clearstack in procdefinition.proccalloptions) then
if (not inlined) and (po_clearstack in procdefinition.procoptions) then
begin
{ we also add the pop_size which is included in pushedparasize }
pop_size:=0;
@ -1597,7 +1597,10 @@ begin
end.
{
$Log$
Revision 1.34 2001-10-21 12:33:07 peter
Revision 1.35 2001-10-25 21:22:41 peter
* calling convention rewrite
Revision 1.34 2001/10/21 12:33:07 peter
* array access for properties added
Revision 1.33 2001/09/09 08:50:15 jonas

7
compiler/i386/n386obj.pas
View File

@ -171,7 +171,7 @@ begin
adjustselfvalue(ioffset);
{ case 1 or 2 }
if (pocall_clearstack in procdef.proccalloptions) then
if (po_clearstack in procdef.procoptions) then
begin
if po_virtualmethod in procdef.procoptions then
begin { case 2 }
@ -223,7 +223,10 @@ initialization
end.
{
$Log$
Revision 1.3 2001-09-19 11:04:41 michael
Revision 1.4 2001-10-25 21:22:41 peter
* calling convention rewrite
Revision 1.3 2001/09/19 11:04:41 michael
* Smartlinking with interfaces fixed
* Better smartlinking for rtti and init tables

3
compiler/msg/errore.msg
View File

@ -938,6 +938,9 @@ parser_e_interface_has_no_guid=03180_E_Interface "$1" has no interface identific
% must have a GUID value set.
parser_e_illegal_field_or_method=03181_E_Unknown class field or method identifier "$1"
% Properties must refer to a field or method in the same class.
parser_w_proc_overriding_calling=03182_W_Overriding calling convention "$1" with "$2"
% There are two directives in the procedure declaration that specify a calling
% convention. Only the last directive will be used
% \end{description}
#
# Type Checking

5
compiler/msgidx.inc
View File

@ -260,6 +260,7 @@ const
parser_e_self_call_by_value=03179;
parser_e_interface_has_no_guid=03180;
parser_e_illegal_field_or_method=03181;
parser_w_proc_overriding_calling=03182;
type_e_mismatch=04000;
type_e_incompatible_types=04001;
type_e_not_equal_types=04002;
@ -602,9 +603,9 @@ const
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 33666;
MsgTxtSize = 33719;
MsgIdxMax : array[1..20] of longint=(
17,62,182,38,41,41,98,17,35,42,
17,62,183,38,41,41,98,17,35,42,
30,1,1,1,1,1,1,1,1,1
);

370
compiler/msgtxt.inc
View File

@ -295,364 +295,366 @@ const msgtxt : array[0..000140,1..240] of char=(
'03179_E_Self must be a normal (call-by-value) parameter'#000+
'03180_E_Interface "$1" has n','o interface identification'#000+
'03181_E_Unknown class field or method identifier "$1"'#000+
'03182_W_Overriding calling convention "$1" with "$2"'#000+
'04000_E_Type mismatch'#000+
'04001_E_Incompatible types: got "$1" expected "$2"'#000+
'04002_E_Type mismatch between "$1" and "$2"'#000+
'04002_E_Type mismatch between "$1','" and "$2"'#000+
'04003_E_Type identifier expected'#000+
'04004_E_V','ariable identifier expected'#000+
'04004_E_Variable identifier expected'#000+
'04005_E_Integer expression expected, but got "$1"'#000+
'04006_E_Boolean expression expected, but got "$1"'#000+
'04007_E_Ordinal expression expected'#000+
'04008_E_pointer type expected, but got "$1"'#000+
'04009_E_class type expected, but',' got "$1"'#000+
'04008_E_pointer type ex','pected, but got "$1"'#000+
'04009_E_class type expected, but got "$1"'#000+
'04010_E_Variable or type indentifier expected'#000+
'04011_E_Can'#039't evaluate constant expression'#000+
'04012_E_Set elements are not compatible'#000+
'04013_E_Operation not implemented for sets'#000+
'04014_W_Automatic type conversion from floating type to CO','MP which i'+
'04014','_W_Automatic type conversion from floating type to COMP which i'+
's an integer type'#000+
'04015_H_use DIV instead to get an integer result'#000+
'04016_E_string types doesn'#039't match, because of $V+ mode'#000+
'04017_E_succ or pred on enums with assignments not possible'#000+
'04018_E_Can'#039't read or write variables of this t','ype'#000+
'04017_E_succ or pred on enums with assignments not pos','sible'#000+
'04018_E_Can'#039't read or write variables of this type'#000+
'04019_E_Can'#039't use readln or writeln on typed file'#000+
'04020_E_Can'#039't use read or write on untyped file.'#000+
'04021_E_Type conflict between set elements'#000+
'04022_W_lo/hi(dword/qword) returns the upper/lower word/dword'#000+
'04023_E_Integer or real expressi','on expected'#000+
'04022_W_lo/hi(dword/qword) returns the up','per/lower word/dword'#000+
'04023_E_Integer or real expression expected'#000+
'04024_E_Wrong type "$1" in array constructor'#000+
'04025_E_Incompatible type for arg no. $1: Got "$2", expected "$3"'#000+
'04026_E_Method (variable) and Procedure (variable) are not compatible'#000+
'04027_E_Illegal constant passed to internal mat','h function'#000+
'04026_E_Method (variable) and Procedure (variable) are not compa','tibl'+
'e'#000+
'04027_E_Illegal constant passed to internal math function'#000+
'04028_E_Can'#039't get the address of constants'#000+
'04029_E_Argument can'#039't be assigned to'#000+
'04030_E_Can'#039't assign local procedure/function to procedure variabl'+
'e'#000+
'04031_E_Can'#039't assign values to an address'#000+
'04032_E_Can'#039't assign values to const v','ariable'#000+
'04031_E_Can'#039't assign values',' to an address'#000+
'04032_E_Can'#039't assign values to const variable'#000+
'04033_E_Array type required'#000+
'04034_E_interface type expected, but got "$1"'#000+
'04035_W_Mixing signed expressions and cardinals gives a 64bit result'#000+
'04036_W_Mixing signed expressions and cardinals here may cause a range'+
' check error'#000+
'04037_','E_Typecast has different size ($1 -> $2) in assignment'#000+
'04036_W_Mixing signed expressions an','d cardinals here may cause a ran'+
'ge check error'#000+
'04037_E_Typecast has different size ($1 -> $2) in assignment'#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+
'05004_E_Unknown identif','ier "$1"'#000+
'05003_H_Identifier alr','eady defined in $1 at line $2'#000+
'05004_E_Unknown identifier "$1"'#000+
'05005_E_Forward declaration not solved "$1"'#000+
'05006_F_Identifier type already defined as type'#000+
'05007_E_Error in type definition'#000+
'05008_E_Type identifier not defined'#000+
'05009_E_Forward type not resolved "$1"'#000+
'05010_E_Only static variables c','an be used in static methods or outsi'+
'de methods'#000+
'05009_E_Forward t','ype not resolved "$1"'#000+
'05010_E_Only static variables can be used in static methods or outside'+
' methods'#000+
'05011_E_Invalid call to tvarsym.mangledname()'#000+
'05012_F_record 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+
'05013_E_Instances of classes or objects with an abstrac','t method are '+
'not 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+
'05018_E_Label not found'#000+
'05019_E_identifier isn'#039't a label'#000+
'05019_E_identifier isn'#039't a l','abel'#000+
'05020_E_label already defined'#000+
'05021_E_illegal ty','pe declaration of set elements'#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+
'05024_H_Parameter "$1" not used'#000+
'05025_N_Local variable "$1" not used'#000+
'05026_H_Value parameter "$1" is assigned but never used'#000,
'050','26_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+
'05030_N_Private field "$1.$2" is assigned but never us','ed'#000+
'05031_N_Private method "$1.$2" never used'#000+
'05032_E_','Set type expected'#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+
'05036_W_Local variable "$1" does not seem to be initialized'#000+
'05','037_W_Variable "$1" does not seem to be initialized'#000+
'05036_W_L','ocal 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_B_Found declaration: $1'#000+
'05040_E_Data segment too large (max. 2GB)'#000+
'06000_E_BREAK not allowed'#000+
'06000_E_BREAK not allo','wed'#000+
'06001_E_CONTINUE not allowed'#000+
'06002_E_Expression t','oo complicated - FPU stack overflow'#000+
'06002_E_Expression too complicated - FPU stack overflow'#000+
'06003_E_Illegal expression'#000+
'06004_E_Invalid integer expression'#000+
'06005_E_Illegal qualifier'#000+
'06006_E_High range limit < low range limit'#000+
'06007_E_Illegal counter variable'#000+
'06008_E_Can'#039't determine which overloaded',' function to call'#000+
'06007_E_Illegal coun','ter variable'#000+
'06008_E_Can'#039't determine which overloaded function to call'#000+
'06009_E_Parameter list size exceeds 65535 bytes'#000+
'06010_E_Illegal type conversion'#000+
'06011_D_Conversion between ordinals and pointers is not portable acros'+
's platforms'#000+
'06012_E_File types must be var parameters'#000+
'06013_E_The use of',' a far pointer isn'#039't allowed there'#000+
'06012_E','_File types must be var parameters'#000+
'06013_E_The use of a far pointer isn'#039't allowed there'#000+
'06014_E_illegal call by reference parameters'#000+
'06015_E_EXPORT declared functions can'#039't be called'#000+
'06016_W_Possible illegal call of constructor or destructor (doesn'#039't'+
' match to this context)'#000+
'06017_N_Inefficient',' code'#000+
'06016_W_Possible illegal call of constructor or destructo','r (doesn'#039+
't match to this context)'#000+
'06017_N_Inefficient code'#000+
'06018_W_unreachable code'#000+
'06019_E_procedure call with stackframe ESP/SP'#000+
'06020_E_Abstract methods can'#039't be called directly'#000+
'06021_F_Internal Error in getfloatreg(), allocation failure'#000+
'06021_F_Internal Error in getfloatreg(), allocation failure'#000,
'06022_F_Unknown float type'#000+
'06023_F_SecondVecn() base ','defined twice'#000+
'06023_F_SecondVecn() base defined twice'#000+
'06024_F_Extended cg68k not supported'#000+
'06025_F_32-bit unsigned not supported in MC68000 mode'#000+
'06026_F_Internal Error in secondinline()'#000+
'06027_D_Register $1 weight $2 $3'#000+
'06028_E_Stack limit excedeed in local routine'#000+
'06029_D_Stack f','rame is omitted'#000+
'06028_E_','Stack limit excedeed in local routine'#000+
'06029_D_Stack frame is omitted'#000+
'06031_E_Object or class methods can'#039't be inline.'#000+
'06032_E_Procvar calls can'#039't be inline.'#000+
'06033_E_No code for inline procedure stored'#000+
'06034_E_Direct call of interrupt procedure "$1" is not possible'#000+
'06035_E_Element zero of an a','nsi/wide- or longstring can'#039't be acc'+
'essed, use (set)length instead'#000+
'06034_E_Direct call of interrupt proced','ure "$1" is not possible'#000+
'06035_E_Element zero of an ansi/wide- or longstring can'#039't be acces'+
'sed, use (set)length instead'#000+
'06036_E_Include and exclude not implemented in this case'#000+
'06037_E_Constructors or destructors can not be called inside a '#039'wi'+
'06037_E_Constructors or destructors can not be called inside a ',#039'wi'+
'th'#039' clause'#000+
'06038_E_Cannot call message handler met','hod directly'#000+
'06038_E_Cannot call message handler method 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+
'07000_D_Starting $1 styled assembler parsing'#000+
'07001_D_Finished $1 styled assembler parsing'#000+
'07002_E_Non-label patt','ern contains @'#000+
'07001_D_Finish','ed $1 styled assembler parsing'#000+
'07002_E_Non-label pattern contains @'#000+
'07003_W_Override operator not supported'#000+
'07004_E_Error building record offset'#000+
'07005_E_OFFSET used without identifier'#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+
'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+
'07011_E_Relocatable symbol can only be added'#000+
'07012_E_Invalid constant expression'#000+
'07013_E_Relocatable symbol is not allowed'#000+
'07014_E_Invalid reference syn','tax'#000+
'07013_E_Relocatabl','e 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+
'07017_E_Invalid base and index register usage'#000+
'07018_W_Possible error in object field handling'#000+
'07018_W_Possible error in object fi','eld handling'#000+
'07019_E_Wrong scale factor specified'#000+
'070','20_E_Multiple index register usage'#000+
'07020_E_Multiple index register usage'#000+
'07021_E_Invalid operand type'#000+
'07022_E_Invalid string as opcode operand: $1'#000+
'07023_W_@CODE and @DATA not supported'#000+
'07024_E_Null label references are not allowed'#000+
'07024_E_Null label references are not al','lowed'#000+
'07025_E_Divide by zero in asm evaluator'#000+
'07026_E','_Illegal expression'#000+
'07026_E_Illegal expression'#000+
'07027_E_escape sequence ignored: $1'#000+
'07028_E_Invalid symbol reference'#000+
'07029_W_Fwait can cause emulation problems with emu387'#000+
'07030_W_$1 without operand translated into $1P'#000+
'07031_W_ENTER instruction is not supported by Lin','ux kernel'#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+
'07034_E_Constant value out of bounds'#000+
'07035_E_Error converting decimal $1'#000+
'07036_E_Error converting octal $1'#000+
'07037_E_Error converting bina','ry $1'#000+
'07036_E_Er','ror 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+
'07042_E_Cannot use OLDEBP outside a nested procedure'#000+
'07043_W_Procedures ca','n'#039't return any value in asm code'#000+
'07042_E_Cannot use OL','DEBP 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+
'07046_W_Size suffix and destination or source size do not match'#000,
'07047_E_Assembler syntax error'#000+
'07048_E_Invalid combin','ation of opcode and operands'#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+
'07051_E_Invalid String expression'#000+
'07052_W_constant with symbol $1 for not 32bit address'#000+
'07052_W_constant with symbol $1 for not',' 32bit address'#000+
'07053_E_Unrecognized opcode $1'#000+
'07054_E','_Invalid or missing opcode'#000+
'07054_E_Invalid or missing opcode'#000+
'07055_E_Invalid combination of prefix and opcode: $1'#000+
'07056_E_Invalid combination of override and opcode: $1'#000+
'07057_E_Too many operands on line'#000+
'07058_W_NEAR ignored'#000+
'07058_W_NEAR ignor','ed'#000+
'07059_W_FAR ignored'#000+
'07060_E_Duplicate local symbol',' $1'#000+
'07060_E_Duplicate local symbol $1'#000+
'07061_E_Undefined local symbol $1'#000+
'07062_E_Unknown label identifier $1'#000+
'07063_E_Invalid register name'#000+
'07064_E_Invalid floating point register name'#000+
'07065_E_NOR not supported'#000+
'07066_W_Modulo not supported'#000+
'07067_E_Invalid floating point const','ant $1'#000+
'07066_W_Modu','lo 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 override expression'#000+
'07072_W_Identifier $1 supposed external'#000+
'07073_E_Strings not',' allowed as constants'#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+
'07076_E_Not a directive or local symbol $1'#000+
'07077_E_Using a defined name as a local label'#000+
'07078_E_Dollar token is used without an i','dentifier'#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+
'07081_E_Can'#039't access fields directly for parameters'#000+
'07082_E_Can'#039't access fields of objects/classes directly'#000+
'07083_E_No size spec','ified and unable to determine the size of the op'+
'erands'#000+
'07082_E_Can'#039't access fi','elds 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+
'07085_H_RESULT is register $1'#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+
'07086_W_"$1" without operand translated into "$1 %st,%st(1)','"'#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+
'07091_W_XDEF not supported'#000+
'07092_E_Invalid XDEF syntax'#000+
'07093_W_ALIGN not supported'#000+
'07093_W_ALIGN n','ot supported'#000+
'07094_E_Inc and Dec cannot be together'#000+
'0','7095_E_Invalid reglist for movem'#000+
'07095_E_Invalid reglist for movem'#000+
'07096_E_Reglist invalid for opcode'#000+
'07097_E_68020 mode required'#000+
'08000_F_Too many assembler files'#000+
'08001_F_Selected assembler output not supported'#000+
'08002_F_Comp not supported'#000+
'08003_F_Direct not support for binar','y writers'#000+
'08002_F_Co','mp not supported'#000+
'08003_F_Direct not support for binary writers'#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+
'08008_E_Asm: 16 Bit references not supporte','d'#000+
'08007_E_Asm: $1 invalid combination of opcode and',' operands'#000+
'08008_E_Asm: 16 Bit references not supported'#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+
'08014_E_Asm: Comp type not supported fo','r this target'#000+
'08013_E_Asm: Undef','ined 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+
'08016_E_Asm: Duplicate label $1'#000+
'09000_W_Source operating system redefined'#000+
'09001_I_Assembling (pipe) $1'#000+
'09002_E_Can'#039't create assember file: $1'#000+
'09003_E_Can'#039't create object',' file: $1'#000+
'09002_E_Can'#039't',' create assember file: $1'#000+
'09003_E_Can'#039't create object file: $1'#000+
'09004_E_Can'#039't create archive file: $1'#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'+
'090','08_E_Can'#039't call the assembler, error $1 switching to external'+
' assembling'#000+
'09009_I_Assembling $1'#000+
'09010_I_Assembling smartlink $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+
'09013_E_Error wh','ile linking'#000+
'09014_E_Can'#039't call the linker, switching to external linking'#000+
'09015_I_Linking $1'#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 s','cript $1'#000+
'09019_E_Creation of Dyn','amic/Shared Libraries not supported'#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 static linked, switching to smart linking'+
#000+
'09024_T_unit $1 can'#039't be smart linked, switching to static linking'+
#000+
'090','25_T_unit $1 can'#039't be shared linked, switching to static link'+
'ing'#000+
'09024_T_unit $1 c','an'#039't be smart linked, switching to static 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_F_Can'#039't post process executable $1'#000+
'09028_F_Can'#039't post proces','s executable $1'#000+
'09029_F_Can'#039't open executable $1'#000+
'0903','0_X_Size of Code: $1 bytes'#000+
'09030_X_Size of Code: $1 bytes'#000+
'09031_X_Size of initialized data: $1 bytes'#000+
'09032_X_Size of uninitialized data: $1 bytes'#000+
'09033_X_Stack space reserved: $1 bytes'#000+
'09034_X_Stack space commited: $1 bytes'#000+
'09034_X_Stack space commited: $1 ','bytes'#000+
'10000_T_Unitsearch: $1'#000+
'10001_T_PPU Loading $1'#000+
'1','0002_U_PPU Name: $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+
'10008_U_PPU Invalid Version ','$1'#000+
'10009_U_PPU is compiled for an other processor'#000+
'100','10_U_PPU is compiled for an other target'#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+
'10016_F_Invalid PPU-File entry: $1'#000+
'10017_F_PPU Dbx count probl','em'#000+
'10016_F_I','nvalid PPU-File entry: $1'#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+
'10023_W_Unit $1 was not found but $2 exists'#000+
'10024_F_Uni','t $1 searched but $2 found'#000+
'10','023_W_Unit $1 was not found but $2 exists'#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+
'10028_U_Recompiling $1, checksum changed for $2'#000+
'10029_U_Recompili','ng $1, source found only'#000+
'10028_U_Reco','mpiling $1, checksum changed for $2'#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, obj is old','er than asm'#000+
'10032_U_Recompiling unit, obj and asm are ol','der 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+
'10038_H_Conditional $1 was not set at startup in last compilation of $'+
'2'#000+
'10039_H_Conditional $','1 was set at startup in last compilation of $2'#000+
'10038_H_Conditional $1 was not set at st','artup in last compilation of'+
' $2'#000+
'10039_H_Conditional $1 was set at startup in last compilation of $2'#000+
'10040_W_Can'#039't recompile unit $1, but found modifed include files'#000+
'10041_H_File $1 is newer than Release PPU file $2'#000+
'11000_$1 [options] <inputfile> [options]'#000+
'11001_W_Only one source file supporte','d'#000+
'11000_$1 [options] <input','file> [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 line'#000+
'11005_N_No option inside $1 config file'#000+
'11006_E_Illegal parameter: $1'#000+
'11006_E','_Illegal parameter: $1'#000+
'11007_H_-? writes help pages'#000+
'1','1008_F_Too many config files nested'#000+
'11008_F_Too many config files nested'#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+
'11012_W_Shared libs not supported on DOS platform, reverting to static'+
#000+
'11013_F_too many IF(N)DEF','s'#000+
'11012_W_Shared libs not supported on DOS pl','atform, reverting to stat'+
'ic'#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 executab'+
'le'#000+
'11017_H_Try recompiling with -dGDB'#000+
'11018_E_You are using the obsolete switch $1'#000+
'11019_E_You a','re using the obsolete switch $1, please use $2'#000+
'11018','_E_You are using the obsolete switch $1'#000+
'11019_E_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 selected "$1" is not compatible with "$2"'#000+
'11022_W_"$1" assembler use forced'#000+
'11026_T_Reading options from',' file $1'#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+
'11029__*** press enter ***'#000+
'11023_Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET'#010+
'Copyright (c) 1993-2000 by Florian Klaempfl'#000+
'11024_Free Pascal ','Compiler version $FPCVER'#010+
'Copyright',' (c) 1993-2000 by Florian Klaempfl'#000+
'11024_Free Pascal Compiler version $FPCVER'#010+
#010+
'Compiler Date : $FPCDATE'#010+
'Compiler Target: $FPCTARGET'#010+
@ -661,166 +663,166 @@ const msgtxt : array[0..000140,1..240] of char=(
' $OSTARGETS'#010+
#010+
'This program comes under the GNU General Public Licence'#010+
'For more information read COPYING.FPC'#010+
'For more informat','ion read COPYING.FPC'#010+
#010+
'Report bugs,suggestions etc to:',#010+
'Report bugs,suggestions etc to:'#010+
' bugrep@freepascal.org'#000+
'11025_**0*_put + after a boolean switch option to enable it, - to disa'+
'ble it'#010+
'**1a_the compiler doesn'#039't delete the generated assembler file'#010+
'**2al_list sourcecode lines in assembler file'#010+
'**2ar_list regi','ster allocation/release info in assembler file'#010+
'**2al_li','st sourcecode lines in assembler file'#010+
'**2ar_list register allocation/release info in assembler file'#010+
'**2at_list temp allocation/release info in assembler file'#010+
'**1b_generate browser info'#010+
'**2bl_generate local symbol info'#010+
'**1B_build all modules'#010+
'**1B_build all modules',#010+
'**1C<x>_code generation options:'#010+
'**2CD_create also d','ynamic library (not supported)'#010+
'**2CD_create also dynamic library (not supported)'#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+
'**2Cr_range checking'#010+
'**2Cr_range checki','ng'#010+
'**2Cs<n>_set stack size to <n>'#010+
'**2Ct_stack checkin','g'#010+
'**2Ct_stack checking'#010+
'**2CX_create also smartlinked library'#010+
'**1d<x>_defines the symbol <x>'#010+
'*O1D_generate a DEF file'#010+
'*O2Dd<x>_set description to <x>'#010+
'*O2Dw_PM application'#010+
'**1e<x>_set path to executable'#010+
'**1E_same as -Cn'#010+
'**1E_sa','me as -Cn'#010+
'**1F<x>_set file names and paths:'#010+
'**2FD<x>_','sets the directory where to search for compiler utilities'#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+
'**2Fl<x>_adds <x> to library path'#010+
'*L2FL<x>_uses <x> as dynamic linker',#010+
'**2Fl<x>_adds <x','> to library path'#010+
'*L2FL<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+
'*g1g_generate debugger information:'#010+
'*g1g_generate debugger informatio','n:'#010+
'*g2gg_use gsym'#010+
'*g2gd_use dbx'#010+
'*g2gh_use heap trace ','unit (for memory leak debugging)'#010+
'*g2gh_use heap trace unit (for memory leak debugging)'#010+
'*g2gl_use line info unit to show more info for backtraces'#010+
'*g2gc_generate checks for pointers'#010+
'**1i_information'#010+
'**2iD_return compiler date'#010+
'**2iV_return compiler version'#010+
'**2iV_return comp','iler version'#010+
'**2iSO_return compiler OS'#010+
'**2iSP_return ','compiler processor'#010+
'**2iSP_return compiler processor'#010+
'**2iTO_return target OS'#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+
'**1n_don'#039't read the default config file'#010+
'**1o<x>_change the name of the executable prod','uced to <x>'#010+
'**1n_don'#039't read the default confi','g file'#010+
'**1o<x>_change the name of the executable produced to <x>'#010+
'**1pg_generate profile code for gprof (defines FPC_PROFILE)'#010+
'*L1P_use pipes instead of creating temporary assembler files'#010+
'**1S<x>_syntax options:'#010+
'**2S2_switch some Delphi 2 extensions on'#010+
'**2Sc_supports operators like C (*=,+=,/= ','and -=)'#010+
'**2S2_switch some Delphi 2 ext','ensions on'#010+
'**2Sc_supports operators like C (*=,+=,/= and -=)'#010+
'**2Sa_include assertion code.'#010+
'**2Sd_tries to be Delphi compatible'#010+
'**2Se<x>_compiler stops after the <x> errors (default is 1)'#010+
'**2Sg_allow LABEL and GOTO'#010+
'**2Sh_Use ansistrings'#010+
'**2Si_support C++ styled INLINE'#010+
'**2Sm_support macros like',' C (global)'#010+
'**2S','i_support C++ styled INLINE'#010+
'**2Sm_support macros like C (global)'#010+
'**2So_tries to be TP/BP 7.0 compatible'#010+
'**2Sp_tries to be gpc compatible'#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 (only with -a)'#010+
'**1u','<x>_undefines the symbol <x>'#010+
'**1','s_don'#039't call assembler and linker (only with -a)'#010+
'**1u<x>_undefines the symbol <x>'#010+
'**1U_unit options:'#010+
'**2Un_don'#039't check the unit name'#010+
'**2Ur_generate release unit files'#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) ',' d : Show debug info'#010+
'**1v<x>_Be verbose. <x> is a combination of t','he following letters:'#010+
'**2*_e : Show errors (default) d : Show debug info'#010+
'**2*_w : Show warnings u : Show unit info'#010+
'**2*_n : Show notes t : Show tried/used files'#010+
'**2*_h : Show hints m : Show defined macros'#010+
'**2*_i : Show general info ',' p : Show compiled procedures'#010+
'**2*_h : Show hints m : S','how defined macros'#010+
'**2*_i : Show general info p : Show compiled procedures'#010+
'**2*_l : Show linenumbers c : Show conditionals'#010+
'**2*_a : Show everything 0 : Show nothing (except errors)'#010+
'**2*_b : Show all procedure r : Rhide/GCC compatibility mode'#010+
'**2*_ ','declarations if an error x : Executable info (Win32 only'+
')'#010+
'**2*_b : Show all procedur','e r : Rhide/GCC compatibility mod'+
'e'#010+
'**2*_ declarations if an error x : Executable info (Win32 only)'#010+
'**2*_ occurs'#010+
'**1X_executable options:'#010+
'*L2Xc_link with the c library'#010+
'**2Xs_strip all symbols from executable'#010+
'**2XD_try to link dynamic (defines FPC_LINK_DYNAMIC)'#010+
'**2XS_','try to link static (default) (defines FPC_LINK_STATIC)'#010+
'**2XD_try to li','nk dynamic (defines FPC_LINK_DYNAMIC)'#010+
'**2XS_try to link static (default) (defines FPC_LINK_STATIC)'#010+
'**2XX_try to link smart (defines FPC_LINK_SMART)'#010+
'**0*_Processor specific options:'#010+
'3*1A<x>_output format:'#010+
'3*2Aas_assemble using GNU AS'#010+
'3*2Aasaout_assemble using GNU AS for aou','t (Go32v1)'#010+
'3*2Aas_assemble ','using GNU AS'#010+
'3*2Aasaout_assemble using GNU AS for aout (Go32v1)'#010+
'3*2Anasmcoff_coff (Go32v2) file using Nasm'#010+
'3*2Anasmelf_elf32 (Linux) file using Nasm'#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*2Acoff_coff (Go32v2) using int','ernal writer'#010+
'3*2Atasm_obj file ','using Tasm (Borland)'#010+
'3*2Acoff_coff (Go32v2) using internal writer'#010+
'3*2Apecoff_pecoff (Win32) using internal writer'#010+
'3*1R<x>_assembler reading style:'#010+
'3*2Ratt_read AT&T style assembler'#010+
'3*2Rintel_read Intel style assembler'#010+
'3*2Rdirect_copy assembler text directly to assembler file'#010+
'3*1O<x>_optimizat','ions:'#010+
'3*2Rdirect_copy assemb','ler text directly to assembler file'#010+
'3*1O<x>_optimizations:'#010+
'3*2Og_generate smaller code'#010+
'3*2OG_generate faster code (default)'#010+
'3*2Or_keep certain variables in registers'#010+
'3*2Ou_enable uncertain optimizations (see docs)'#010+
'3*2O1_level 1 optimizations (quick optimizations)'#010+
'3*2O2_level 2 optimizations (','-O1 + slower optimizations)'#010+
'3*2O1_level 1 optimization','s (quick optimizations)'#010+
'3*2O2_level 2 optimizations (-O1 + slower optimizations)'#010+
'3*2O3_level 3 optimizations (-O2 repeatedly, max 5 times)'#010+
'3*2Op<x>_target processor:'#010+
'3*3Op1_set target processor to 386/486'#010+
'3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#010+
'3*3Op3_set target processor to PP','ro/PII/c6x86/K6 (tm)'#010+
'3*3Op2_set target processor to Pent','ium/PentiumMMX (tm)'#010+
'3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)'#010+
'3*1T<x>_Target operating system:'#010+
'3*2TGO32V1_version 1 of DJ Delorie DOS extender'#010+
'3*2TGO32V2_version 2 of DJ Delorie DOS extender'#010+
'3*2TLINUX_Linux'#010+
'3*2Tnetware_Novell Netware Module (experimental)'#010+
'3*2Tnetware_Novell Ne','tware Module (experimental)'#010+
'3*2TOS2_OS/2 2.x'#010+
'3*2TSUNO','S_SunOS/Solaris'#010+
'3*2TSUNOS_SunOS/Solaris'#010+
'3*2TWin32_Windows 32 Bit'#010+
'3*1W<x>_Win32 target options'#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*2WF_Specify full-screen type',' application (OS/2 only)'#010+
'3*2WD_Use DEFFILE to export f','unctions of DLL or EXE'#010+
'3*2WF_Specify full-screen type application (OS/2 only)'#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+
'6*1A<x>_output format'#010+
'6*2Aas_Unix o-file using GNU AS'#010+
'6*2Agas_GNU Motorola assemb','ler'#010+
'6*2Aas','_Unix o-file using GNU AS'#010+
'6*2Agas_GNU Motorola assembler'#010+
'6*2Amit_MIT Syntax (old GAS)'#010+
'6*2Amot_Standard Motorola assembler'#010+
'6*1O_optimizations:'#010+
'6*2Oa_turn on the optimizer'#010+
'6*2Og_generate smaller code'#010+
'6*2OG_generate faster code (default)'#010+
'6*2Ox_optimize maximum (still BUGGY!!!)'#010+
'6*2O2_set target p','rocessor to a MC68020+'#010+
'6*2Ox','_optimize maximum (still BUGGY!!!)'#010+
'6*2O2_set target processor to a MC68020+'#010+
'6*1R<x>_assembler reading style:'#010+
'6*2RMOT_read motorola style assembler'#010+
'6*1T<x>_Target operating system:'#010+
'6*2TAMIGA_Commodore Amiga'#010+
'6*2TATARI_Atari ST/STe/TT'#010+
'6*2TMACOS_Macintosh m68k'#010+
'6*2TMACO','S_Macintosh m68k'#010+
'6*2TLINUX_Linux-68k'#010+
'6*2TPALMOS_PalmO','S'#010+
'6*2TPALMOS_PalmOS'#010+
'**1*_'#010+
'**1?_shows this help'#010+
'**1h_shows this help without waiting'#000

21
compiler/ncal.pas
View File

@ -275,7 +275,7 @@ implementation
if is_array_of_const(defcoll.paratype.def) then
begin
if assigned(aktcallprocsym) and
(([pocall_cppdecl,pocall_cdecl]*aktcallprocsym.definition.proccalloptions)<>[]) and
(aktcallprocsym.definition.proccalloption in [pocall_cppdecl,pocall_cdecl]) and
(po_external in aktcallprocsym.definition.procoptions) then
include(left.flags,nf_cargs);
{ force variant array }
@ -296,7 +296,7 @@ implementation
{ generate the high() value tree }
if not(assigned(aktcallprocsym) and
(([pocall_cppdecl,pocall_cdecl]*aktcallprocsym.definition.proccalloptions)<>[]) and
(aktcallprocsym.definition.proccalloption in [pocall_cppdecl,pocall_cdecl]) and
(po_external in aktcallprocsym.definition.procoptions)) and
push_high_param(defcoll.paratype.def) then
gen_high_tree(is_open_string(defcoll.paratype.def));
@ -1339,10 +1339,10 @@ implementation
end;
{ handle predefined procedures }
is_const:=(pocall_internconst in procdefinition.proccalloptions) and
is_const:=(procdefinition.proccalloption=pocall_internconst) and
((block_type in [bt_const,bt_type]) or
(assigned(left) and (tcallparanode(left).left.nodetype in [realconstn,ordconstn])));
if (pocall_internproc in procdefinition.proccalloptions) or is_const then
if (procdefinition.proccalloption=pocall_internproc) or is_const then
begin
if assigned(left) then
begin
@ -1445,7 +1445,7 @@ implementation
tcallparanode(left).det_registers;
if assigned(procdefinition) and
(pocall_inline in procdefinition.proccalloptions) then
(procdefinition.proccalloption=pocall_inline) then
begin
inlinecode:=right;
if assigned(inlinecode) then
@ -1477,7 +1477,7 @@ implementation
{ calc the correture value for the register }
{ handle predefined procedures }
if (pocall_inline in procdefinition.proccalloptions) then
if (procdefinition.proccalloption=pocall_inline) then
begin
if assigned(methodpointer) then
CGMessage(cg_e_unable_inline_object_methods);
@ -1494,7 +1494,7 @@ implementation
begin
{ consider it has not inlined if called
again inside the args }
exclude(procdefinition.proccalloptions,pocall_inline);
procdefinition.proccalloption:=pocall_fpccall;
firstpass(inlinecode);
inlined:=true;
end;
@ -1646,7 +1646,7 @@ implementation
end;
errorexit:
if inlined then
include(procdefinition.proccalloptions,pocall_inline);
procdefinition.proccalloption:=pocall_inline;
end;
@ -1743,7 +1743,10 @@ begin
end.
{
$Log$
Revision 1.51 2001-10-13 09:01:14 jonas
Revision 1.52 2001-10-25 21:22:33 peter
* calling convention rewrite
Revision 1.51 2001/10/13 09:01:14 jonas
* fixed bug with using procedures as procvar parameters in TP/Delphi mode
Revision 1.50 2001/10/12 16:04:32 peter

7
compiler/ncgbas.pas
View File

@ -204,7 +204,7 @@ interface
begin
{ if the routine is an inline routine, then we must hold a copy
because it can be necessary for inlining later }
if (pocall_inline in aktprocsym.definition.proccalloptions) then
if (aktprocsym.definition.proccalloption=pocall_inline) then
exprasmList.concatlistcopy(p_asm)
else
exprasmList.concatlist(p_asm);
@ -279,7 +279,10 @@ begin
end.
{
$Log$
Revision 1.7 2001-08-26 13:36:39 florian
Revision 1.8 2001-10-25 21:22:35 peter
* calling convention rewrite
Revision 1.7 2001/08/26 13:36:39 florian
* some cg reorganisation
* some PPC updates

7
compiler/nmem.pas
View File

@ -418,7 +418,7 @@ implementation
{ create procvardef }
resulttype.setdef(tprocvardef.create);
tprocvardef(resulttype.def).proctypeoption:=hp3.proctypeoption;
tprocvardef(resulttype.def).proccalloptions:=hp3.proccalloptions;
tprocvardef(resulttype.def).proccalloption:=hp3.proccalloption;
tprocvardef(resulttype.def).procoptions:=hp3.procoptions;
tprocvardef(resulttype.def).rettype:=hp3.rettype;
tprocvardef(resulttype.def).symtablelevel:=hp3.symtablelevel;
@ -982,7 +982,10 @@ begin
end.
{
$Log$
Revision 1.20 2001-09-02 21:12:07 peter
Revision 1.21 2001-10-25 21:22:35 peter
* calling convention rewrite
Revision 1.20 2001/09/02 21:12:07 peter
* move class of definitions into type section for delphi
Revision 1.19 2001/08/26 13:36:42 florian

9
compiler/nobj.pas
View File

@ -636,7 +636,7 @@ implementation
{ the flags have to match }
{ except abstract and override }
{ only if both are virtual !! }
if (procdefcoll^.data.proccalloptions<>hp.proccalloptions) or
if (procdefcoll^.data.proccalloption<>hp.proccalloption) or
(procdefcoll^.data.proctypeoption<>hp.proctypeoption) or
((procdefcoll^.data.procoptions-
[po_abstractmethod,po_overridingmethod,po_assembler,po_overload])<>
@ -988,7 +988,7 @@ implementation
begin
implprocdef:=sym.definition;
while assigned(implprocdef) and not equal_paras(proc.para,implprocdef.para,cp_none) and
(proc.proccalloptions<>implprocdef.proccalloptions) do
(proc.proccalloption<>implprocdef.proccalloption) do
implprocdef:=implprocdef.nextoverloaded;
end;
gintfgetcprocdef:=implprocdef;
@ -1275,7 +1275,10 @@ initialization
end.
{
$Log$
Revision 1.6 2001-10-20 19:28:38 peter
Revision 1.7 2001-10-25 21:22:35 peter
* calling convention rewrite
Revision 1.6 2001/10/20 19:28:38 peter
* interface 2 guid support
* guid constants support

7
compiler/parser.pas
View File

@ -275,7 +275,7 @@ implementation
oldaktinterfacetype: tinterfacetypes;
oldaktmodeswitches : tmodeswitches;
old_compiled_module : tmodule;
oldaktdefproccall : tdefproccall;
oldaktdefproccall : tproccalloption;
{ will only be increased once we start parsing blocks in the }
{ implementation, so doesn't need to be saved/restored (JM) }
{ oldexceptblockcounter : integer; }
@ -625,7 +625,10 @@ implementation
end.
{
$Log$
Revision 1.24 2001-10-23 21:49:42 peter
Revision 1.25 2001-10-25 21:22:35 peter
* calling convention rewrite
Revision 1.24 2001/10/23 21:49:42 peter
* $calling directive and -Cc commandline patch added
from Pavel Ozerski

7
compiler/pass_2.pas
View File

@ -291,7 +291,7 @@ implementation
cleanup_regvars(procinfo^.aktexitcode);
if assigned(aktprocsym) and
(pocall_inline in aktprocsym.definition.proccalloptions) then
(aktprocsym.definition.proccalloption=pocall_inline) then
make_const_global:=true;
do_secondpass(p);
@ -306,7 +306,10 @@ implementation
end.
{
$Log$
Revision 1.18 2001-08-26 13:36:44 florian
Revision 1.19 2001-10-25 21:22:35 peter
* calling convention rewrite
Revision 1.18 2001/08/26 13:36:44 florian
* some cg reorganisation
* some PPC updates

7
compiler/pdecl.pas
View File

@ -213,6 +213,8 @@ implementation
if is_proc_directive(token) then
parse_var_proc_directives(sym);
end;
{ add default calling convention }
handle_calling_convention(nil,tabstractprocdef(tt.def));
end;
if not skipequal then
begin
@ -603,7 +605,10 @@ implementation
end.
{
$Log$
Revision 1.38 2001-10-24 10:26:53 marco
Revision 1.39 2001-10-25 21:22:35 peter
* calling convention rewrite
Revision 1.38 2001/10/24 10:26:53 marco
* Don't parse proc directives after type renaming of procvars
Revision 1.37 2001/10/20 20:30:21 peter

7
compiler/pdecobj.pas
View File

@ -877,7 +877,7 @@ implementation
begin
if is_cppclass(aktclass) then
begin
include(aktprocsym.definition.proccalloptions,pocall_cppdecl);
aktprocsym.definition.proccalloption:=pocall_cppdecl;
aktprocsym.definition.setmangledname(
target_info.Cprefix+aktprocsym.definition.cplusplusmangledname);
end;
@ -1094,7 +1094,10 @@ implementation
end.
{
$Log$
Revision 1.31 2001-10-21 13:10:50 peter
Revision 1.32 2001-10-25 21:22:35 peter
* calling convention rewrite
Revision 1.31 2001/10/21 13:10:50 peter
* better support for indexed properties
Revision 1.30 2001/10/21 12:33:06 peter

513
compiler/pdecsub.pas
View File

@ -46,6 +46,8 @@ interface
procedure parse_proc_directives(var pdflags:word);
procedure handle_calling_convention(sym:tprocsym;def:tabstractprocdef);
procedure parse_proc_head(options:tproctypeoption);
procedure parse_proc_dec;
procedure parse_var_proc_directives(var sym : tsym);
@ -82,6 +84,16 @@ implementation
;
procedure resetvaluepara(p:tnamedindexitem);
begin
if tsym(p).typ=varsym then
with tvarsym(p) do
if copy(name,1,3)='val' then
aktprocsym.definition.parast.symsearch.rename(name,copy(name,4,length(name)));
end;
procedure parameter_dec(aktprocdef:tabstractprocdef);
{
handle_procvar needs the same changes
@ -811,28 +823,11 @@ begin
end;
end;
procedure pd_inline;
begin
if not(cs_support_inline in aktmoduleswitches) then
begin
Message(parser_e_proc_inline_not_supported);
exclude(aktprocsym.definition.proccalloptions,pocall_inline);
end;
end;
procedure pd_forward;
begin
aktprocsym.definition.forwarddef:=true;
end;
procedure pd_stdcall;
begin
end;
procedure pd_safecall;
begin
end;
procedure pd_alias;
begin
consume(_COLON);
@ -842,6 +837,7 @@ end;
procedure pd_asmname;
begin
aktprocsym.definition.setmangledname(target_info.Cprefix+pattern);
aktprocsym.definition.has_mangledname:=true;
if token=_CCHAR then
consume(_CCHAR)
else
@ -866,11 +862,6 @@ begin
{$endif i386}
end;
procedure pd_system;
begin
aktprocsym.definition.setmangledname(aktprocsym.realname);
end;
procedure pd_abstract;
begin
if (po_virtualmethod in aktprocsym.definition.procoptions) then
@ -956,74 +947,6 @@ begin
end;
procedure resetvaluepara(p:tnamedindexitem);
begin
if tsym(p).typ=varsym then
with tvarsym(p) do
if copy(name,1,3)='val' then
aktprocsym.definition.parast.symsearch.rename(name,copy(name,4,length(name)));
end;
procedure pd_cdecl;
begin
if aktprocsym.definition.deftype<>procvardef then
aktprocsym.definition.setmangledname(target_info.Cprefix+aktprocsym.realname);
{ do not copy on local !! }
if (aktprocsym.definition.deftype=procdef) and
assigned(aktprocsym.definition.parast) then
aktprocsym.definition.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}resetvaluepara);
end;
procedure pd_cppdecl;
begin
if aktprocsym.definition.deftype<>procvardef then
aktprocsym.definition.setmangledname(
target_info.Cprefix+aktprocsym.definition.cplusplusmangledname);
{ do not copy on local !! }
if (aktprocsym.definition.deftype=procdef) and
assigned(aktprocsym.definition.parast) then
aktprocsym.definition.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}resetvaluepara);
end;
procedure pd_pascal;
var st,parast : tsymtable;
lastps,ps : tsym;
begin
st:=tparasymtable.create;
parast:=aktprocsym.definition.parast;
lastps:=nil;
while assigned(parast.symindex.first) and (lastps<>tsym(parast.symindex.first)) do
begin
ps:=tsym(parast.symindex.first);
while assigned(ps.indexnext) and (tsym(ps.indexnext)<>lastps) do
ps:=tsym(ps.indexnext);
ps.owner:=st;
{ recalculate the corrected offset }
{ the really_insert_in_data procedure
for parasymtable should only calculateoffset PM }
tstoredsym(ps).insert_in_data;
{ reset the owner correctly }
ps.owner:=parast;
lastps:=ps;
end;
end;
procedure pd_register;
begin
Message1(parser_w_proc_directive_ignored,'REGISTER');
end;
procedure pd_far16;
begin
{ Temporary stub, must be rewritten to support OS/2 far16 }
Message1(parser_w_proc_directive_ignored,'FAR16');
end;
procedure pd_reintroduce;
begin
Message1(parser_w_proc_directive_ignored,'REINTRODUCE');
@ -1109,35 +1032,18 @@ begin
consume(_NAME);
import_name:=get_stringconst;
aktprocsym.definition.setmangledname(import_name);
if target_info.DllScanSupported then
current_module.externals.insert(tExternalsItem.create(import_name));
end
else
begin
{ external shouldn't override the cdecl/system name }
if not (pocall_clearstack in aktprocsym.definition.proccalloptions) then
begin
aktprocsym.definition.setmangledname(aktprocsym.realname);
if target_info.DllScanSupported then
current_module.externals.insert(tExternalsItem.create(aktprocsym.realname));
end;
aktprocsym.definition.has_mangledname:=true;
end;
end;
end;
procedure pd_compilerproc;
begin
aktprocsym.definition.setmangledname(lower(aktprocsym.name));
end;
type
pd_handler=procedure;
proc_dir_rec=record
idtok : ttoken;
pd_flags : longint;
handler : pd_handler;
pocall : tproccalloptions;
pocall : tproccalloption;
pooption : tprocoptions;
mutexclpocall : tproccalloptions;
mutexclpotype : tproctypeoptions;
@ -1152,7 +1058,7 @@ const
idtok:_ABSTRACT;
pd_flags : pd_interface+pd_object+pd_notobjintf;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_abstract;
pocall : [];
pocall : pocall_none;
pooption : [po_abstractmethod];
mutexclpocall : [pocall_internproc,pocall_inline];
mutexclpotype : [potype_constructor,potype_destructor];
@ -1161,7 +1067,7 @@ const
idtok:_ALIAS;
pd_flags : pd_implemen+pd_body+pd_notobjintf;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_alias;
pocall : [];
pocall : pocall_none;
pooption : [];
mutexclpocall : [pocall_inline];
mutexclpotype : [];
@ -1170,16 +1076,16 @@ const
idtok:_ASMNAME;
pd_flags : pd_interface+pd_implemen+pd_notobjintf;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_asmname;
pocall : [pocall_cdecl,pocall_clearstack];
pocall : pocall_cdecl;
pooption : [po_external];
mutexclpocall : [pocall_internproc];
mutexclpocall : [pocall_internproc,pocall_inline];
mutexclpotype : [];
mutexclpo : [po_external]
),(
idtok:_ASSEMBLER;
pd_flags : pd_implemen+pd_body+pd_notobjintf;
handler : nil;
pocall : [];
pocall : pocall_none;
pooption : [po_assembler];
mutexclpocall : [];
mutexclpotype : [];
@ -1187,18 +1093,17 @@ const
),(
idtok:_CDECL;
pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_cdecl;
pocall : [pocall_cdecl,pocall_clearstack];
pooption : [po_savestdregs];
mutexclpocall : [pocall_cppdecl,pocall_internproc,
pocall_leftright,pocall_inline,pocall_far16,pocall_fpccall];
handler : nil;
pocall : pocall_cdecl;
pooption : [];
mutexclpocall : [];
mutexclpotype : [];
mutexclpo : [po_assembler,po_external]
),(
idtok:_DYNAMIC;
pd_flags : pd_interface+pd_object+pd_notobjintf;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_virtual;
pocall : [];
pocall : pocall_none;
pooption : [po_virtualmethod];
mutexclpocall : [pocall_internproc,pocall_inline];
mutexclpotype : [];
@ -1207,7 +1112,7 @@ const
idtok:_EXPORT;
pd_flags : pd_body+pd_global+pd_interface+pd_implemen{??}+pd_notobjintf;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_export;
pocall : [];
pocall : pocall_none;
pooption : [po_exports];
mutexclpocall : [pocall_internproc,pocall_inline];
mutexclpotype : [];
@ -1216,7 +1121,7 @@ const
idtok:_EXTERNAL;
pd_flags : pd_implemen+pd_interface+pd_notobjintf;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_external;
pocall : [];
pocall : pocall_none;
pooption : [po_external];
mutexclpocall : [pocall_internproc,pocall_inline,pocall_palmossyscall];
mutexclpotype : [];
@ -1225,7 +1130,7 @@ const
idtok:_FAR;
pd_flags : pd_implemen+pd_body+pd_interface+pd_procvar+pd_notobjintf;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_far;
pocall : [];
pocall : pocall_none;
pooption : [];
mutexclpocall : [pocall_internproc,pocall_inline];
mutexclpotype : [];
@ -1233,19 +1138,17 @@ const
),(
idtok:_FAR16;
pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_far16;
pocall : [pocall_far16];
handler : nil;
pocall : pocall_far16;
pooption : [];
mutexclpocall : [pocall_internproc,pocall_cdecl,pocall_cppdecl,
pocall_clearstack,pocall_inline,
pocall_safecall,pocall_leftright,pocall_fpccall];
mutexclpocall : [];
mutexclpotype : [];
mutexclpo : [po_external]
mutexclpo : [po_external,po_leftright]
),(
idtok:_FORWARD;
pd_flags : pd_implemen+pd_notobjintf;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_forward;
pocall : [];
pocall : pocall_none;
pooption : [];
mutexclpocall : [pocall_internproc,pocall_inline];
mutexclpotype : [];
@ -1254,27 +1157,25 @@ const
idtok:_FPCCALL;
pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
handler : nil;
pocall : [pocall_fpccall];
pocall : pocall_fpccall;
pooption : [];
mutexclpocall : [pocall_cdecl,pocall_cppdecl,
pocall_clearstack,pocall_inline,
pocall_safecall,pocall_leftright,pocall_far16];
mutexclpocall : [];
mutexclpotype : [];
mutexclpo : []
mutexclpo : [po_leftright]
),(
idtok:_INLINE;
pd_flags : pd_implemen+pd_body+pd_notobjintf;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_inline;
pocall : [pocall_inline];
handler : nil;
pocall : pocall_inline;
pooption : [];
mutexclpocall : [pocall_internproc];
mutexclpocall : [];
mutexclpotype : [potype_constructor,potype_destructor];
mutexclpo : [po_exports,po_external,po_interrupt]
),(
idtok:_INTERNCONST;
pd_flags : pd_implemen+pd_body+pd_notobjintf;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_intern;
pocall : [pocall_internconst];
pocall : pocall_internconst;
pooption : [];
mutexclpocall : [];
mutexclpotype : [potype_operator];
@ -1283,28 +1184,26 @@ const
idtok:_INTERNPROC;
pd_flags : pd_implemen+pd_notobjintf;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_intern;
pocall : [pocall_internproc];
pocall : pocall_internproc;
pooption : [];
mutexclpocall : [pocall_inline,pocall_clearstack,pocall_leftright,pocall_cdecl,pocall_cppdecl,
pocall_far16,pocall_fpccall];
mutexclpocall : [];
mutexclpotype : [potype_constructor,potype_destructor,potype_operator];
mutexclpo : [po_exports,po_external,po_interrupt,po_assembler,po_iocheck]
mutexclpo : [po_exports,po_external,po_interrupt,po_assembler,po_iocheck,po_leftright]
),(
idtok:_INTERRUPT;
pd_flags : pd_implemen+pd_body+pd_notobjintf;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_interrupt;
pocall : [];
pocall : pocall_none;
pooption : [po_interrupt];
mutexclpocall : [pocall_internproc,pocall_cdecl,pocall_cppdecl,
pocall_clearstack,pocall_leftright,pocall_inline,
pocall_far16,pocall_fpccall];
pocall_inline,pocall_pascal,pocall_system,pocall_far16,pocall_fpccall];
mutexclpotype : [potype_constructor,potype_destructor,potype_operator];
mutexclpo : [po_external]
mutexclpo : [po_external,po_leftright,po_clearstack]
),(
idtok:_IOCHECK;
pd_flags : pd_implemen+pd_body+pd_notobjintf;
handler : nil;
pocall : [];
pocall : pocall_none;
pooption : [po_iocheck];
mutexclpocall : [pocall_internproc];
mutexclpotype : [];
@ -1313,7 +1212,7 @@ const
idtok:_MESSAGE;
pd_flags : pd_interface+pd_object+pd_notobjintf;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_message;
pocall : [];
pocall : pocall_none;
pooption : []; { can be po_msgstr or po_msgint }
mutexclpocall : [pocall_inline,pocall_internproc];
mutexclpotype : [potype_constructor,potype_destructor,potype_operator];
@ -1322,7 +1221,7 @@ const
idtok:_NEAR;
pd_flags : pd_implemen+pd_body+pd_procvar+pd_notobjintf;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_near;
pocall : [];
pocall : pocall_none;
pooption : [];
mutexclpocall : [pocall_internproc];
mutexclpotype : [];
@ -1331,7 +1230,7 @@ const
idtok:_OVERLOAD;
pd_flags : pd_implemen+pd_interface+pd_body;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_overload;
pocall : [];
pocall : pocall_none;
pooption : [po_overload];
mutexclpocall : [pocall_internproc];
mutexclpotype : [];
@ -1340,7 +1239,7 @@ const
idtok:_OVERRIDE;
pd_flags : pd_interface+pd_object+pd_notobjintf;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_override;
pocall : [];
pocall : pocall_none;
pooption : [po_overridingmethod,po_virtualmethod];
mutexclpocall : [pocall_inline,pocall_internproc];
mutexclpotype : [];
@ -1348,28 +1247,26 @@ const
),(
idtok:_PASCAL;
pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_pascal;
pocall : [pocall_leftright];
handler : nil;
pocall : pocall_pascal;
pooption : [];
mutexclpocall : [pocall_internproc,pocall_cdecl,pocall_cppdecl,
pocall_clearstack,pocall_leftright,pocall_inline,
pocall_safecall,pocall_far16,pocall_fpccall];
mutexclpocall : [];
mutexclpotype : [];
mutexclpo : [po_external]
),(
idtok:_POPSTACK;
pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
handler : nil;
pocall : [pocall_clearstack];
pooption : [];
mutexclpocall : [pocall_inline,pocall_internproc];
pocall : pocall_none;
pooption : [po_clearstack];
mutexclpocall : [pocall_inline,pocall_internproc,pocall_stdcall];
mutexclpotype : [];
mutexclpo : [po_assembler,po_external]
),(
idtok:_PUBLIC;
pd_flags : pd_implemen+pd_body+pd_global+pd_notobject+pd_notobjintf;
handler : nil;
pocall : [];
pocall : pocall_none;
pooption : [];
mutexclpocall : [pocall_internproc,pocall_inline];
mutexclpotype : [];
@ -1377,18 +1274,17 @@ const
),(
idtok:_REGISTER;
pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_register;
pocall : [pocall_register];
handler : nil;
pocall : pocall_register;
pooption : [];
mutexclpocall : [pocall_leftright,pocall_cdecl,pocall_internproc,pocall_cppdecl,
pocall_far16,pocall_fpccall];
mutexclpocall : [];
mutexclpotype : [];
mutexclpo : [po_external]
),(
idtok:_REINTRODUCE;
pd_flags : pd_interface+pd_object;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_reintroduce;
pocall : [];
pocall : pocall_none;
pooption : [];
mutexclpocall : [];
mutexclpotype : [];
@ -1396,18 +1292,17 @@ const
),(
idtok:_SAFECALL;
pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_safecall;
pocall : [pocall_safecall];
pooption : [po_savestdregs];
mutexclpocall : [pocall_leftright,pocall_cdecl,pocall_cppdecl,
pocall_internproc,pocall_inline,pocall_far16,pocall_fpccall];
handler : nil;
pocall : pocall_safecall;
pooption : [];
mutexclpocall : [];
mutexclpotype : [];
mutexclpo : [po_external]
),(
idtok:_SAVEREGISTERS;
pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar+pd_notobjintf;
handler : nil;
pocall : [];
pocall : pocall_none;
pooption : [po_saveregisters];
mutexclpocall : [pocall_internproc];
mutexclpotype : [];
@ -1416,7 +1311,7 @@ const
idtok:_STATIC;
pd_flags : pd_interface+pd_object+pd_notobjintf;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_static;
pocall : [];
pocall : pocall_none;
pooption : [po_staticmethod];
mutexclpocall : [pocall_inline,pocall_internproc];
mutexclpotype : [potype_constructor,potype_destructor];
@ -1424,38 +1319,35 @@ const
),(
idtok:_STDCALL;
pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_stdcall;
pocall : [pocall_stdcall];
pooption : [po_savestdregs];
mutexclpocall : [pocall_leftright,pocall_cdecl,pocall_cppdecl,
pocall_inline,pocall_internproc,pocall_safecall,pocall_far16,pocall_fpccall];
handler : nil;
pocall : pocall_stdcall;
pooption : [];
mutexclpocall : [];
mutexclpotype : [];
mutexclpo : [po_external]
),(
idtok:_SYSCALL;
pd_flags : pd_interface+pd_implemen+pd_notobjintf;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_syscall;
pocall : [pocall_palmossyscall,pocall_cdecl,pocall_clearstack];
pocall : pocall_palmossyscall;
pooption : [];
mutexclpocall : [pocall_cdecl,pocall_cppdecl,pocall_inline,
pocall_internproc,pocall_leftright,pocall_far16,pocall_fpccall];
mutexclpocall : [];
mutexclpotype : [];
mutexclpo : [po_external,po_assembler,po_interrupt,po_exports]
),(
idtok:_SYSTEM;
pd_flags : pd_implemen+pd_notobjintf;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_system;
pocall : [pocall_clearstack];
handler : nil;
pocall : pocall_system;
pooption : [];
mutexclpocall : [pocall_leftright,pocall_inline,pocall_cdecl,
pocall_internproc,pocall_cppdecl,pocall_far16,pocall_fpccall];
mutexclpocall : [];
mutexclpotype : [];
mutexclpo : [po_external,po_assembler,po_interrupt]
),(
idtok:_VIRTUAL;
pd_flags : pd_interface+pd_object+pd_notobjintf;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_virtual;
pocall : [];
pocall : pocall_none;
pooption : [po_virtualmethod];
mutexclpocall : [pocall_inline,pocall_internproc];
mutexclpotype : [];
@ -1463,28 +1355,27 @@ const
),(
idtok:_CPPDECL;
pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_cppdecl;
pocall : [pocall_cppdecl,pocall_clearstack];
handler : nil;
pocall : pocall_cppdecl;
pooption : [po_savestdregs];
mutexclpocall : [pocall_cdecl,pocall_internproc,pocall_leftright,pocall_inline,
pocall_far16,pocall_fpccall];
mutexclpocall : [];
mutexclpotype : [];
mutexclpo : [po_assembler,po_external]
),(
idtok:_VARARGS;
pd_flags : pd_interface+pd_implemen+pd_procvar;
handler : nil;
pocall : [];
pocall : pocall_none;
pooption : [po_varargs];
mutexclpocall : [pocall_internproc,pocall_stdcall,pocall_register,
pocall_leftright,pocall_inline,pocall_far16,pocall_fpccall];
pocall_inline,pocall_far16,pocall_fpccall];
mutexclpotype : [];
mutexclpo : [po_assembler,po_interrupt]
mutexclpo : [po_assembler,po_interrupt,po_leftright]
),(
idtok:_COMPILERPROC;
pd_flags : pd_interface+pd_implemen+pd_body+pd_notobjintf;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_compilerproc;
pocall : [pocall_compilerproc];
handler : nil;
pocall : pocall_compilerproc;
pooption : [];
mutexclpocall : [];
mutexclpotype : [];
@ -1507,7 +1398,7 @@ const
end;
function parse_proc_direc(idtoken:ttoken; var pdflags:word; do_consume:boolean):boolean;//Ozerski 08.10.01
function parse_proc_direc(var pdflags:word):boolean;
{
Parse the procedure directive, returns true if a correct directive is found
}
@ -1555,13 +1446,25 @@ const
{ Conflicts between directives ? }
if (aktprocsym.definition.proctypeoption in proc_direcdata[p].mutexclpotype) or
((aktprocsym.definition.proccalloptions*proc_direcdata[p].mutexclpocall)<>[]) or
(aktprocsym.definition.proccalloption in proc_direcdata[p].mutexclpocall) or
((aktprocsym.definition.procoptions*proc_direcdata[p].mutexclpo)<>[]) then
begin
Message1(parser_e_proc_dir_conflict,name);
exit;
end;
{ set calling convention }
if proc_direcdata[p].pocall<>pocall_none then
begin
if aktprocsym.definition.proccalloption<>pocall_none then
begin
Message2(parser_w_proc_overriding_calling,
proccalloptionStr[aktprocsym.definition.proccalloption],
proccalloptionStr[proc_direcdata[p].pocall]);
end;
aktprocsym.definition.proccalloption:=proc_direcdata[p].pocall;
end;
if aktprocsym.definition.deftype=procdef then
begin
{ Check if the directive is only for objects }
@ -1581,8 +1484,7 @@ const
end;
{ consume directive, and turn flag on }
if do_consume then
consume(token);
consume(token);
parse_proc_direc:=true;
{ Check the pd_flags if the directive should be allowed }
@ -1612,47 +1514,152 @@ const
pdflags:=pdflags or pd_global;
{ Add the correct flag }
aktprocsym.definition.proccalloptions:=aktprocsym.definition.proccalloptions+proc_direcdata[p].pocall;
aktprocsym.definition.procoptions:=aktprocsym.definition.procoptions+proc_direcdata[p].pooption;
{ Adjust positions of args for cdecl or stdcall }
if (aktprocsym.definition.deftype=procdef) and
(([pocall_cdecl,pocall_cppdecl,pocall_stdcall]*aktprocsym.definition.proccalloptions)<>[]) then
tparasymtable(aktprocsym.definition.parast).set_alignment(target_info.size_of_longint);
{ Call the handler }
if pointer({$ifndef FPCPROCVAR}@{$endif}proc_direcdata[p].handler)<>nil then
proc_direcdata[p].handler{$ifdef FPCPROCVAR}(){$endif};
end;
const
CallModeTokens : set of TToken = [
_CDECL,
_CPPDECL,
_FAR16,
_FPCCALL,
_INLINE,
_PASCAL,
_POPSTACK,
_REGISTER,
_SAFECALL,
_STDCALL,
_SYSTEM
];
CallModeToken : array[TDefProcCall] of TToken = (
_CDECL,
_CPPDECL,
_FAR16,
_FPCCALL,
_INLINE,
_PASCAL,
_POPSTACK,
_REGISTER,
_SAFECALL,
_STDCALL,
_SYSTEM
);
procedure handle_calling_convention(sym:tprocsym;def:tabstractprocdef);
var
st,parast : tsymtable;
lastps,ps : tsym;
begin
{ set the default calling convention }
if def.proccalloption=pocall_none then
def.proccalloption:=aktdefproccall;
case def.proccalloption of
pocall_cdecl :
begin
{ use popstack and save std registers }
include(def.procoptions,po_clearstack);
include(def.procoptions,po_savestdregs);
{ set mangledname }
if (def.deftype=procdef) then
begin
if not tprocdef(def).has_mangledname then
tprocdef(def).setmangledname(target_info.Cprefix+sym.realname);
if not assigned(tprocdef(def).parast) then
internalerror(200110234);
{ do not copy on local !! }
tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}resetvaluepara);
{ Adjust positions of args for cdecl or stdcall }
tparasymtable(tprocdef(def).parast).set_alignment(target_info.size_of_longint);
end;
end;
pocall_cppdecl :
begin
if not assigned(sym) then
internalerror(200110231);
{ use popstack and save std registers }
include(def.procoptions,po_clearstack);
include(def.procoptions,po_savestdregs);
{ set mangledname }
if (def.deftype=procdef) then
begin
if not tprocdef(def).has_mangledname then
tprocdef(def).setmangledname(target_info.Cprefix+tprocdef(def).cplusplusmangledname);
if not assigned(tprocdef(def).parast) then
internalerror(200110235);
{ do not copy on local !! }
tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}resetvaluepara);
{ Adjust positions of args for cdecl or stdcall }
tparasymtable(tprocdef(def).parast).set_alignment(target_info.size_of_longint);
end;
end;
pocall_stdcall :
begin
include(def.procoptions,po_savestdregs);
if (def.deftype=procdef) and
assigned(tprocdef(def).parast) then
begin
{ Adjust positions of args for cdecl or stdcall }
tparasymtable(tprocdef(def).parast).set_alignment(target_info.size_of_longint);
end;
end;
pocall_safecall :
begin
include(def.procoptions,po_savestdregs);
end;
pocall_compilerproc :
begin
if (not assigned(sym)) or
(def.deftype<>procdef) then
internalerror(200110232);
tprocdef(def).setmangledname(lower(sym.name));
end;
pocall_pascal :
begin
include(def.procoptions,po_leftright);
st:=tparasymtable.create;
parast:=tprocdef(def).parast;
lastps:=nil;
while assigned(parast.symindex.first) and (lastps<>tsym(parast.symindex.first)) do
begin
ps:=tsym(parast.symindex.first);
while assigned(ps.indexnext) and (tsym(ps.indexnext)<>lastps) do
ps:=tsym(ps.indexnext);
ps.owner:=st;
{ recalculate the corrected offset }
{ the really_insert_in_data procedure
for parasymtable should only calculateoffset PM }
tstoredsym(ps).insert_in_data;
{ reset the owner correctly }
ps.owner:=parast;
lastps:=ps;
end;
end;
pocall_register :
begin
Message1(parser_w_proc_directive_ignored,'REGISTER');
end;
pocall_far16 :
begin
{ Temporary stub, must be rewritten to support OS/2 far16 }
Message1(parser_w_proc_directive_ignored,'FAR16');
end;
pocall_system :
begin
include(def.procoptions,po_clearstack);
if (not assigned(sym)) or
(def.deftype<>procdef) then
internalerror(200110233);
if not tprocdef(def).has_mangledname then
tprocdef(def).setmangledname(sym.realname);
end;
pocall_palmossyscall :
begin
{ use popstack and save std registers }
include(def.procoptions,po_clearstack);
include(def.procoptions,po_savestdregs);
if (def.deftype=procdef) then
begin
if not assigned(tprocdef(def).parast) then
internalerror(200110236);
{ do not copy on local !! }
tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}resetvaluepara);
{ Adjust positions of args for cdecl or stdcall }
tparasymtable(tprocdef(def).parast).set_alignment(target_info.size_of_longint);
end;
end;
pocall_inline :
begin
if not(cs_support_inline in aktmoduleswitches) then
begin
Message(parser_e_proc_inline_not_supported);
def.proccalloption:=pocall_fpccall;
end;
end;
end;
{ add mangledname to external list }
if (def.deftype=procdef) and
(po_external in def.procoptions) and
target_info.DllScanSupported then
current_module.externals.insert(tExternalsItem.create(tprocdef(def).mangledname));
end;
procedure parse_proc_directives(var pdflags:word);
@ -1662,17 +1669,13 @@ const
}
var
res : boolean;
CallModeIsChangedLocally : boolean;
begin
CallModeIsChangedLocally:=false;
while token in [_ID,_LECKKLAMMER] do
begin
if try_to_consume(_LECKKLAMMER) then
begin
repeat
if not CallModeIsChangedLocally then
CallModeIsChangedLocally:=idtoken in CallModeTokens;
parse_proc_direc(idtoken,pdflags,true);
parse_proc_direc(pdflags);
until not try_to_consume(_COMMA);
consume(_RECKKLAMMER);
{ we always expect at least '[];' }
@ -1680,9 +1683,7 @@ const
end
else
begin
if not CallModeIsChangedLocally then
CallModeIsChangedLocally:=idtoken in CallModeTokens;
res:=parse_proc_direc(idtoken,pdflags,true);
res:=parse_proc_direc(pdflags);
end;
{ A procedure directive normally followed by a semicolon, but in
a const section we should stop when _EQUAL is found }
@ -1699,9 +1700,7 @@ const
else
break;
end;
{ add default calling convention if none is specified }
if (not CallModeIsChangedLocally) then
parse_proc_direc(CallModeToken[aktdefproccall],pdflags,false);
handle_calling_convention(aktprocsym,aktprocsym.definition);
end;
@ -1817,18 +1816,23 @@ const
aktprocsym.definition.fullprocname);
exit;
end;
{ Check calling convention, no check for internconst,internproc which
are only defined in interface or implementation }
if (hd.proccalloptions-[pocall_internconst,pocall_internproc]<>
aktprocsym.definition.proccalloptions-[pocall_internconst,pocall_internproc]) then
{ no check for internconst,internproc which
are only defined in interface or implementation }
if (aktprocsym.definition.proccalloption in [pocall_internconst,pocall_internproc]) then
hd.proccalloption:=aktprocsym.definition.proccalloption
else
if (hd.proccalloption in [pocall_internconst,pocall_internproc]) then
aktprocsym.definition.proccalloption:=hd.proccalloption;
{ Check calling convention }
if (hd.proccalloption<>aktprocsym.definition.proccalloption) then
begin
{ only trigger an error, becuase it doesn't hurt, for delphi check
if the current implementation has no proccalloptions, then
if the current implementation has no proccalloption, then
take the options from the interface }
if (m_delphi in aktmodeswitches) then
begin
if (aktprocsym.definition.proccalloptions=[]) then
aktprocsym.definition.proccalloptions:=hd.proccalloptions
if (aktprocsym.definition.proccalloption=pocall_none) then
aktprocsym.definition.proccalloption:=hd.proccalloption
else
MessagePos(aktprocsym.definition.fileinfo,parser_e_call_convention_dont_match_forward);
end
@ -1902,7 +1906,7 @@ const
by the procdir handlers must be copied here!.}
hd.forwarddef:=false;
hd.hasforward:=true;
hd.proccalloptions:=hd.proccalloptions + aktprocsym.definition.proccalloptions;
hd.proccalloption:=aktprocsym.definition.proccalloption;
hd.procoptions:=hd.procoptions + aktprocsym.definition.procoptions;
if aktprocsym.definition.extnumber=-1 then
aktprocsym.definition.extnumber:=hd.extnumber
@ -1919,7 +1923,7 @@ const
aktprocsym.definition:=hd;
{ for compilerproc defines we need to rename and update the
mangledname }
if (pocall_compilerproc in aktprocsym.definition.proccalloptions) then
if (aktprocsym.definition.proccalloption=pocall_compilerproc) then
begin
{ rename to lowercase so users can't access it }
aktprocsym.owner.rename(aktprocsym.name,lower(aktprocsym.name));
@ -2005,7 +2009,10 @@ const
end.
{
$Log$
Revision 1.39 2001-10-23 21:49:42 peter
Revision 1.40 2001-10-25 21:22:37 peter
* calling convention rewrite
Revision 1.39 2001/10/23 21:49:42 peter
* $calling directive and -Cc commandline patch added
from Pavel Ozerski

9
compiler/pstatmnt.pas
View File

@ -757,11 +757,11 @@ implementation
begin
if not target_asm.allowdirect then
Message(parser_f_direct_assembler_not_allowed);
if (pocall_inline in aktprocsym.definition.proccalloptions) then
if (aktprocsym.definition.proccalloption=pocall_inline) then
Begin
Message1(parser_w_not_supported_for_inline,'direct asm');
Message(parser_w_inlining_disabled);
exclude(aktprocsym.definition.proccalloptions,pocall_inline);
aktprocsym.definition.proccalloption:=pocall_fpccall;
End;
asmstat:=tasmnode(ra386dir.assemble);
end;
@ -1115,7 +1115,10 @@ implementation
end.
{
$Log$
Revision 1.40 2001-10-24 11:51:39 marco
Revision 1.41 2001-10-25 21:22:37 peter
* calling convention rewrite
Revision 1.40 2001/10/24 11:51:39 marco
* Make new/dispose system functions instead of keywords
Revision 1.39 2001/10/17 22:41:04 florian

17
compiler/psub.pas
View File

@ -460,7 +460,7 @@ implementation
{ so no dispose here !! }
if assigned(code) and
not(cs_browser in aktmoduleswitches) and
not(pocall_inline in aktprocsym.definition.proccalloptions) then
(aktprocsym.definition.proccalloption<>pocall_inline) then
begin
if lexlevel>=normal_function_level then
aktprocsym.definition.localst.free;
@ -480,7 +480,7 @@ implementation
{$endif newcg}
{ remove code tree, if not inline procedure }
if assigned(code) and not(pocall_inline in aktprocsym.definition.proccalloptions) then
if assigned(code) and (aktprocsym.definition.proccalloption<>pocall_inline) then
code.free;
{ remove class member symbol tables }
@ -622,14 +622,14 @@ implementation
begin
{ if external is available, then cdecl must also be available }
if (po_external in aktprocsym.definition.procoptions) and
not(pocall_cdecl in aktprocsym.definition.proccalloptions) then
not(aktprocsym.definition.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
Message(parser_e_varargs_need_cdecl_and_external);
end
else
begin
{ both must be defined now }
if not(po_external in aktprocsym.definition.procoptions) or
not(pocall_cdecl in aktprocsym.definition.proccalloptions) then
not(aktprocsym.definition.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
Message(parser_e_varargs_need_cdecl_and_external);
end;
end;
@ -754,11 +754,11 @@ implementation
procedure Not_supported_for_inline(t : ttoken);
begin
if assigned(aktprocsym) and
(pocall_inline in aktprocsym.definition.proccalloptions) then
(aktprocsym.definition.proccalloption=pocall_inline) then
Begin
Message1(parser_w_not_supported_for_inline,tokenstring(t));
Message(parser_w_inlining_disabled);
exclude(aktprocsym.definition.proccalloptions,pocall_inline);
aktprocsym.definition.proccalloption:=pocall_fpccall;
End;
end;
@ -843,7 +843,10 @@ implementation
end.
{
$Log$
Revision 1.39 2001-10-22 21:20:46 peter
Revision 1.40 2001-10-25 21:22:37 peter
* calling convention rewrite
Revision 1.39 2001/10/22 21:20:46 peter
* overloaded functions don't need to be global in kylix
Revision 1.38 2001/10/01 13:38:45 jonas

29
compiler/symconst.pas
View File

@ -155,26 +155,6 @@ type
normset,smallset,varset
);
{ calling convention for tprocdef and tprocvardef }
tproccalloption=(pocall_none,
pocall_clearstack, { Use IBM flat calling convention. (Used by GCC.) }
pocall_leftright, { Push parameters from left to right }
pocall_cdecl, { procedure uses C styled calling }
pocall_register, { procedure uses register (fastcall) calling }
pocall_stdcall, { procedure uses stdcall call }
pocall_safecall, { safe call calling conventions }
pocall_palmossyscall, { procedure is a PalmOS system call }
pocall_system,
pocall_inline, { Procedure is an assembler macro }
pocall_internproc, { Procedure has compiler magic}
pocall_internconst, { procedure has constant evaluator intern }
pocall_cppdecl, { C++ calling conventions }
pocall_compilerproc, { Procedure is used for internal compiler calls }
pocall_far16, { Far16 for OS/2 }
pocall_fpccall { FPC default calling }
);
tproccalloptions=set of tproccalloption;
{ basic type for tprocdef and tprocvardef }
tproctypeoption=(potype_none,
potype_proginit, { Program initialization }
@ -205,7 +185,9 @@ type
po_savestdregs, { save std regs cdecl and stdcall need that ! }
po_saveregisters, { save all registers }
po_overload, { procedure is declared with overload directive }
po_varargs { printf like arguments }
po_varargs, { printf like arguments }
po_leftright, { push arguments from left to right }
po_clearstack { caller clears the stack }
);
tprocoptions=set of tprocoption;
@ -344,7 +326,10 @@ implementation
end.
{
$Log$
Revision 1.26 2001-10-23 21:49:43 peter
Revision 1.27 2001-10-25 21:22:37 peter
* calling convention rewrite
Revision 1.26 2001/10/23 21:49:43 peter
* $calling directive and -Cc commandline patch added
from Pavel Ozerski

80
compiler/symdef.pas
View File

@ -410,7 +410,7 @@ interface
{ saves a definition to the return type }
rettype : ttype;
proctypeoption : tproctypeoption;
proccalloptions : tproccalloptions;
proccalloption : tproccalloption;
procoptions : tprocoptions;
para : tparalinkedlist;
maxparacount,
@ -425,7 +425,6 @@ interface
procedure concatpara(const tt:ttype;vsp : tvarspez;defval:tsym);
function para_size(alignsize:longint) : longint;
function demangled_paras : string;
function proccalloption2str : string;
procedure test_if_fpu_result;
{ debug }
{$ifdef GDB}
@ -502,6 +501,7 @@ interface
{ check the problems of manglednames }
count : boolean;
is_used : boolean;
has_mangledname : boolean;
{ small set which contains the modified registers }
{$ifdef i386}
usedregisters : longint;
@ -2972,7 +2972,7 @@ implementation
minparacount:=0;
maxparacount:=0;
proctypeoption:=potype_none;
proccalloptions:=[];
proccalloption:=pocall_none;
procoptions:=[];
rettype:=voidtype;
symtablelevel:=0;
@ -3047,8 +3047,8 @@ implementation
maxparacount:=0;
ppufile.gettype(rettype);
fpu_used:=ppufile.getbyte;
proctypeoption:=tproctypeoption(ppufile.getlongint);
ppufile.getsmallset(proccalloptions);
proctypeoption:=tproctypeoption(ppufile.getbyte);
proccalloption:=tproccalloption(ppufile.getbyte);
ppufile.getsmallset(procoptions);
count:=ppufile.getword;
savesize:=target_info.size_of_pointer;
@ -3080,8 +3080,8 @@ implementation
if simplify_ppu then
fpu_used:=0;
ppufile.putbyte(fpu_used);
ppufile.putlongint(ord(proctypeoption));
ppufile.putsmallset(proccalloptions);
ppufile.putbyte(ord(proctypeoption));
ppufile.putbyte(ord(proccalloption));
ppufile.putsmallset(procoptions);
ppufile.do_interface_crc:=oldintfcrc;
ppufile.putword(maxparacount);
@ -3192,49 +3192,6 @@ implementation
end;
function tabstractprocdef.proccalloption2str : string;
type
tproccallopt=record
mask : tproccalloption;
str : string[30];
end;
const
proccallopts=13;
proccallopt : array[1..proccallopts] of tproccallopt=(
(mask:pocall_none; str:''),
(mask:pocall_clearstack; str:'ClearStack'),
(mask:pocall_leftright; str:'LeftRight'),
(mask:pocall_cdecl; str:'CDecl'),
(mask:pocall_register; str:'Register'),
(mask:pocall_stdcall; str:'StdCall'),
(mask:pocall_safecall; str:'SafeCall'),
(mask:pocall_palmossyscall;str:'PalmOSSysCall'),
(mask:pocall_system; str:'System'),
(mask:pocall_inline; str:'Inline'),
(mask:pocall_internproc; str:'InternProc'),
(mask:pocall_internconst; str:'InternConst'),
(mask:pocall_cppdecl; str:'CPPDecl')
);
var
s : string;
i : longint;
first : boolean;
begin
s:='';
first:=true;
for i:=1 to proccallopts do
if (proccallopt[i].mask in proccalloptions) then
begin
if first then
first:=false
else
s:=s+';';
s:=s+proccallopt[i].str;
end;
proccalloption2str:=s;
end;
{$ifdef GDB}
function tabstractprocdef.stabstring : pchar;
begin
@ -3262,6 +3219,7 @@ implementation
begin
inherited create;
deftype:=procdef;
has_mangledname:=false;
_mangledname:=nil;
nextoverloaded:=nil;
fileinfo:=aktfilepos;
@ -3329,6 +3287,7 @@ implementation
{$endif POWERPC}
{$endif}
{$endif newcg}
has_mangledname:=true;
_mangledname:=stringdup(ppufile.getstring);
extnumber:=ppufile.getlongint;
@ -3336,7 +3295,7 @@ implementation
_class := tobjectdef(ppufile.getderef);
ppufile.getposinfo(fileinfo);
{ inline stuff }
if (pocall_inline in proccalloptions) then
if proccalloption=pocall_inline then
funcretsym:=tsym(ppufile.getderef)
else
funcretsym:=nil;
@ -3344,7 +3303,7 @@ implementation
parast:=tparasymtable.create;
tparasymtable(parast).load(ppufile);
parast.defowner:=self;
if (pocall_inline in proccalloptions) or
if (proccalloption=pocall_inline) or
((current_module.flags and uf_local_browser)<>0) then
begin
localst:=tlocalsymtable.create;
@ -3385,7 +3344,7 @@ implementation
parast.free;
if assigned(localst) and (localst.symtabletype<>staticsymtable) then
localst.free;
if (pocall_inline in proccalloptions) and assigned(code) then
if (proccalloption=pocall_inline) and assigned(code) then
tnode(code).free;
if assigned(regvarinfo) then
dispose(pregvarinfo(regvarinfo));
@ -3459,7 +3418,7 @@ implementation
on the crc }
oldintfcrc:=ppufile.do_crc;
ppufile.do_crc:=false;
if (pocall_inline in proccalloptions) then
if (proccalloption=pocall_inline) then
ppufile.putderef(funcretsym);
ppufile.do_crc:=oldintfcrc;
@ -3476,7 +3435,7 @@ implementation
{ save localsymtable for inline procedures or when local
browser info is requested, this has no influence on the crc }
if (pocall_inline in proccalloptions) or
if (proccalloption=pocall_inline) or
((current_module.flags and uf_local_browser)<>0) then
begin
oldintfcrc:=ppufile.do_crc;
@ -3947,7 +3906,7 @@ implementation
{ write parameter info. The parameters must be written in reverse order
if this method uses right to left parameter pushing! }
if (pocall_leftright in proccalloptions) then
if (po_leftright in procoptions) then
pdc:=TParaItem(Para.last)
else
pdc:=TParaItem(Para.first);
@ -3967,7 +3926,7 @@ implementation
{ write name of type of current parameter }
tstoreddef(pdc.paratype.def).write_rtti_name;
if (pocall_leftright in proccalloptions) then
if (po_leftright in procoptions) then
pdc:=TParaItem(pdc.previous)
else
pdc:=TParaItem(pdc.next);
@ -3997,7 +3956,7 @@ implementation
s:='<procedure variable type of procedure'+demangled_paras;
if po_methodpointer in procoptions then
s := s+' of object';
gettypename := s+';'+proccalloption2str+'>';
gettypename := s+';'+ProcCallOptionStr[proccalloption]+'>';
end;
@ -5435,7 +5394,10 @@ implementation
end.
{
$Log$
Revision 1.53 2001-10-20 17:21:54 peter
Revision 1.54 2001-10-25 21:22:37 peter
* calling convention rewrite
Revision 1.53 2001/10/20 17:21:54 peter
* fixed size of constset when change from small to normalset
Revision 1.52 2001/10/15 13:16:26 jonas

7
compiler/symsym.pas
View File

@ -895,7 +895,7 @@ implementation
procedure tprocsym.concatstabto(asmlist : taasmoutput);
begin
if (pocall_internproc in definition.proccalloptions) then exit;
if (definition.proccalloption=pocall_internproc) then exit;
if not isstabwritten then
asmList.concat(Tai_stabs.Create(stabstring));
isstabwritten := true;
@ -2490,7 +2490,10 @@ implementation
end.
{
$Log$
Revision 1.24 2001-10-23 21:49:43 peter
Revision 1.25 2001-10-25 21:22:40 peter
* calling convention rewrite
Revision 1.24 2001/10/23 21:49:43 peter
* $calling directive and -Cc commandline patch added
from Pavel Ozerski

7
compiler/types.pas
View File

@ -1102,7 +1102,7 @@ implementation
{ if a method is assigned to a methodpointer }
{ is checked before }
b:=(tprocvardef(def1).proctypeoption=tprocvardef(def2).proctypeoption) and
(tprocvardef(def1).proccalloptions=tprocvardef(def2).proccalloptions) and
(tprocvardef(def1).proccalloption=tprocvardef(def2).proccalloption) and
((tprocvardef(def1).procoptions * po_compatibility_options)=
(tprocvardef(def2).procoptions * po_compatibility_options)) and
is_equal(tprocvardef(def1).rettype.def,tprocvardef(def2).rettype.def) and
@ -1808,7 +1808,10 @@ implementation
end.
{
$Log$
Revision 1.52 2001-10-22 21:21:09 peter
Revision 1.53 2001-10-25 21:22:40 peter
* calling convention rewrite
Revision 1.52 2001/10/22 21:21:09 peter
* allow enum(enum)
Revision 1.51 2001/10/22 15:13:49 jonas