* $calling directive and -Cc commandline patch added

from Pavel Ozerski
This commit is contained in:
peter 2001-10-23 21:49:42 +00:00
parent 717e8b5796
commit 17d62feebe
10 changed files with 243 additions and 159 deletions

View File

@ -159,6 +159,8 @@ interface
initasmmode : tasmmode; initasmmode : tasmmode;
initinterfacetype : tinterfacetypes; initinterfacetype : tinterfacetypes;
initoutputformat : tasm; initoutputformat : tasm;
initdefproccall : TDefProcCall;
{ current state values } { current state values }
aktglobalswitches : tglobalswitches; aktglobalswitches : tglobalswitches;
aktmoduleswitches : tmoduleswitches; aktmoduleswitches : tmoduleswitches;
@ -177,6 +179,7 @@ interface
aktasmmode : tasmmode; aktasmmode : tasmmode;
aktinterfacetype : tinterfacetypes; aktinterfacetype : tinterfacetypes;
aktoutputformat : tasm; aktoutputformat : tasm;
aktdefproccall : TDefProcCall;
{ Memory sizes } { Memory sizes }
heapsize, heapsize,
@ -263,6 +266,7 @@ interface
procedure FreeEnvPChar(p:pchar); procedure FreeEnvPChar(p:pchar);
Function SetCompileMode(const s:string; changeInit: boolean):boolean; Function SetCompileMode(const s:string; changeInit: boolean):boolean;
function SetAktProcCall(const s:string; changeInit: boolean):boolean;
procedure InitGlobals; procedure InitGlobals;
procedure DoneGlobals; procedure DoneGlobals;
@ -1142,6 +1146,38 @@ implementation
end; end;
function SetAktProcCall(const s:string; changeInit:boolean):boolean;
const
DefProcCallName : array[TDefProcCall] of string[12] = (
'CDECL',
'CPPDECL',
'FAR16',
'FPCCALL',
'INLINE',
'PASCAL',
'POPSTACK',
'REGISTER',
'SAFECALL',
'STDCALL',
'SYSTEM'
);
var
t : TDefProcCall;
begin
SetAktProcCall:=false;
for t:=low(TDefProcCall) to high(TDefProcCall) do
if DefProcCallName[t]=s then
begin
AktDefProcCall:=t;
SetAktProcCall:=true;
break;
end;
if changeinit then
InitDefProcCall:=AktDefProcCall;
end;
{ '('D1:'00000000-'D2:'0000-'D3:'0000-'D4:'0000-000000000000)' } { '('D1:'00000000-'D2:'0000-'D3:'0000-'D4:'0000-000000000000)' }
function string2guid(const s: string; var GUID: TGUID): boolean; function string2guid(const s: string; var GUID: TGUID): boolean;
function ishexstr(const hs: string): boolean; function ishexstr(const hs: string): boolean;
@ -1387,6 +1423,7 @@ implementation
{$endif m68k} {$endif m68k}
{$endif i386} {$endif i386}
initinterfacetype:=it_interfacecom; initinterfacetype:=it_interfacecom;
initdefproccall:=dpc_fpccall;
initdefines:=TStringList.Create; initdefines:=TStringList.Create;
{ memory sizes, will be overriden by parameter or default for target { memory sizes, will be overriden by parameter or default for target
@ -1412,7 +1449,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.47 2001-10-21 12:33:05 peter Revision 1.48 2001-10-23 21:49:42 peter
* $calling directive and -Cc commandline patch added
from Pavel Ozerski
Revision 1.47 2001/10/21 12:33:05 peter
* array access for properties added * array access for properties added
Revision 1.46 2001/10/20 20:30:20 peter Revision 1.46 2001/10/20 20:30:20 peter

View File

@ -163,6 +163,21 @@ interface
bt_general,bt_type,bt_const,bt_except 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
);
type type
stringid = string[maxidlen]; stringid = string[maxidlen];
@ -208,7 +223,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.16 2001-10-20 20:30:21 peter Revision 1.17 2001-10-23 21:49:42 peter
* $calling directive and -Cc commandline patch added
from Pavel Ozerski
Revision 1.16 2001/10/20 20:30:21 peter
* read only typed const support, switch $J- * read only typed const support, switch $J-
Revision 1.15 2001/09/17 21:29:11 peter Revision 1.15 2001/09/17 21:29:11 peter

View File

@ -75,7 +75,7 @@ uses
dos, dos,
{$endif Delphi} {$endif Delphi}
version, version,
cutils,cmsgs cutils,cmsgs,symsym
{$ifdef BrowserLog} {$ifdef BrowserLog}
,browlog ,browlog
{$endif BrowserLog} {$endif BrowserLog}
@ -429,6 +429,12 @@ begin
Begin Begin
case more[j] of case more[j] of
'a' : Message2(option_obsolete_switch_use_new,'-Ca','-Or'); 'a' : Message2(option_obsolete_switch_use_new,'-Ca','-Or');
'c' :
begin
if not SetAktProcCall(upper(copy(more,j+1,length(more)-j)),true) then
IllegalPara(opt);
break;
end;
'h' : 'h' :
begin begin
val(copy(more,j+1,length(more)-j),heapsize,code); val(copy(more,j+1,length(more)-j),heapsize,code);
@ -1620,7 +1626,11 @@ finalization
end. end.
{ {
$Log$ $Log$
Revision 1.60 2001-09-17 21:29:12 peter Revision 1.61 2001-10-23 21:49:42 peter
* $calling directive and -Cc commandline patch added
from Pavel Ozerski
Revision 1.60 2001/09/17 21:29:12 peter
* merged netbsd, fpu-overflow from fixes branch * merged netbsd, fpu-overflow from fixes branch
Revision 1.59 2001/09/12 12:46:54 marco Revision 1.59 2001/09/12 12:46:54 marco

View File

@ -65,7 +65,7 @@ implementation
{ and no function header } { and no function header }
testcurobject:=0; testcurobject:=0;
{ a long time, this was forgotten } { Symtable }
aktprocsym:=nil; aktprocsym:=nil;
current_module:=nil; current_module:=nil;
@ -275,6 +275,7 @@ implementation
oldaktinterfacetype: tinterfacetypes; oldaktinterfacetype: tinterfacetypes;
oldaktmodeswitches : tmodeswitches; oldaktmodeswitches : tmodeswitches;
old_compiled_module : tmodule; old_compiled_module : tmodule;
oldaktdefproccall : tdefproccall;
{ will only be increased once we start parsing blocks in the } { will only be increased once we start parsing blocks in the }
{ implementation, so doesn't need to be saved/restored (JM) } { implementation, so doesn't need to be saved/restored (JM) }
{ oldexceptblockcounter : integer; } { oldexceptblockcounter : integer; }
@ -304,6 +305,7 @@ implementation
oldrefsymtable:=refsymtable; oldrefsymtable:=refsymtable;
oldprocprefix:=procprefix; oldprocprefix:=procprefix;
oldaktprocsym:=aktprocsym; oldaktprocsym:=aktprocsym;
oldaktdefproccall:=aktdefproccall;
move(overloaded_operators,oldoverloaded_operators,sizeof(toverloaded_operators)); move(overloaded_operators,oldoverloaded_operators,sizeof(toverloaded_operators));
{ save scanner state } { save scanner state }
oldc:=c; oldc:=c;
@ -355,7 +357,7 @@ implementation
{ oldexceptblockcounter:=exceptblockcounter; } { oldexceptblockcounter:=exceptblockcounter; }
{$ifdef newcg} {$ifdef newcg}
oldcg:=cg; oldcg:=cg;
{$endif newcg} {$endif newcg}
{$ifdef GDB} {$ifdef GDB}
store_dbx:=dbx_counter; store_dbx:=dbx_counter;
dbx_counter:=nil; dbx_counter:=nil;
@ -369,6 +371,7 @@ implementation
systemunit:=nil; systemunit:=nil;
refsymtable:=nil; refsymtable:=nil;
aktprocsym:=nil; aktprocsym:=nil;
aktdefproccall:=initdefproccall;
procprefix:=''; procprefix:='';
registerdef:=true; registerdef:=true;
statement_level:=0; statement_level:=0;
@ -534,6 +537,7 @@ implementation
refsymtable:=oldrefsymtable; refsymtable:=oldrefsymtable;
symtablestack:=oldsymtablestack; symtablestack:=oldsymtablestack;
defaultsymtablestack:=olddefaultsymtablestack; defaultsymtablestack:=olddefaultsymtablestack;
aktdefproccall:=oldaktdefproccall;
aktprocsym:=oldaktprocsym; aktprocsym:=oldaktprocsym;
procprefix:=oldprocprefix; procprefix:=oldprocprefix;
move(oldoverloaded_operators,overloaded_operators,sizeof(toverloaded_operators)); move(oldoverloaded_operators,overloaded_operators,sizeof(toverloaded_operators));
@ -621,7 +625,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.23 2001-10-16 15:10:35 jonas Revision 1.24 2001-10-23 21:49:42 peter
* $calling directive and -Cc commandline patch added
from Pavel Ozerski
Revision 1.23 2001/10/16 15:10:35 jonas
* fixed goto/label/try bugs * fixed goto/label/try bugs
Revision 1.22 2001/08/26 13:36:43 florian Revision 1.22 2001/08/26 13:36:43 florian

View File

@ -1017,6 +1017,13 @@ begin
end; 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; procedure pd_reintroduce;
begin begin
Message1(parser_w_proc_directive_ignored,'REINTRODUCE'); Message1(parser_w_proc_directive_ignored,'REINTRODUCE');
@ -1138,7 +1145,7 @@ type
end; end;
const const
{Should contain the number of procedure directives we support.} {Should contain the number of procedure directives we support.}
num_proc_directives=34; num_proc_directives=36;
proc_direcdata:array[1..num_proc_directives] of proc_dir_rec= proc_direcdata:array[1..num_proc_directives] of proc_dir_rec=
( (
( (
@ -1184,7 +1191,7 @@ const
pocall : [pocall_cdecl,pocall_clearstack]; pocall : [pocall_cdecl,pocall_clearstack];
pooption : [po_savestdregs]; pooption : [po_savestdregs];
mutexclpocall : [pocall_cppdecl,pocall_internproc, mutexclpocall : [pocall_cppdecl,pocall_internproc,
pocall_leftright,pocall_inline]; pocall_leftright,pocall_inline,pocall_far16,pocall_fpccall];
mutexclpotype : []; mutexclpotype : [];
mutexclpo : [po_assembler,po_external] mutexclpo : [po_assembler,po_external]
),( ),(
@ -1223,6 +1230,17 @@ const
mutexclpocall : [pocall_internproc,pocall_inline]; mutexclpocall : [pocall_internproc,pocall_inline];
mutexclpotype : []; mutexclpotype : [];
mutexclpo : [] mutexclpo : []
),(
idtok:_FAR16;
pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_far16;
pocall : [pocall_far16];
pooption : [];
mutexclpocall : [pocall_internproc,pocall_cdecl,pocall_cppdecl,
pocall_clearstack,pocall_inline,
pocall_safecall,pocall_leftright,pocall_fpccall];
mutexclpotype : [];
mutexclpo : [po_external]
),( ),(
idtok:_FORWARD; idtok:_FORWARD;
pd_flags : pd_implemen+pd_notobjintf; pd_flags : pd_implemen+pd_notobjintf;
@ -1232,6 +1250,17 @@ const
mutexclpocall : [pocall_internproc,pocall_inline]; mutexclpocall : [pocall_internproc,pocall_inline];
mutexclpotype : []; mutexclpotype : [];
mutexclpo : [po_external] mutexclpo : [po_external]
),(
idtok:_FPCCALL;
pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
handler : nil;
pocall : [pocall_fpccall];
pooption : [];
mutexclpocall : [pocall_cdecl,pocall_cppdecl,
pocall_clearstack,pocall_inline,
pocall_safecall,pocall_leftright,pocall_far16];
mutexclpotype : [];
mutexclpo : []
),( ),(
idtok:_INLINE; idtok:_INLINE;
pd_flags : pd_implemen+pd_body+pd_notobjintf; pd_flags : pd_implemen+pd_body+pd_notobjintf;
@ -1256,7 +1285,8 @@ const
handler : {$ifdef FPCPROCVAR}@{$endif}pd_intern; handler : {$ifdef FPCPROCVAR}@{$endif}pd_intern;
pocall : [pocall_internproc]; pocall : [pocall_internproc];
pooption : []; pooption : [];
mutexclpocall : [pocall_inline,pocall_clearstack,pocall_leftright,pocall_cdecl,pocall_cppdecl]; mutexclpocall : [pocall_inline,pocall_clearstack,pocall_leftright,pocall_cdecl,pocall_cppdecl,
pocall_far16,pocall_fpccall];
mutexclpotype : [potype_constructor,potype_destructor,potype_operator]; 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]
),( ),(
@ -1266,7 +1296,8 @@ const
pocall : []; pocall : [];
pooption : [po_interrupt]; pooption : [po_interrupt];
mutexclpocall : [pocall_internproc,pocall_cdecl,pocall_cppdecl, mutexclpocall : [pocall_internproc,pocall_cdecl,pocall_cppdecl,
pocall_clearstack,pocall_leftright,pocall_inline]; pocall_clearstack,pocall_leftright,pocall_inline,
pocall_far16,pocall_fpccall];
mutexclpotype : [potype_constructor,potype_destructor,potype_operator]; mutexclpotype : [potype_constructor,potype_destructor,potype_operator];
mutexclpo : [po_external] mutexclpo : [po_external]
),( ),(
@ -1322,7 +1353,7 @@ const
pooption : []; pooption : [];
mutexclpocall : [pocall_internproc,pocall_cdecl,pocall_cppdecl, mutexclpocall : [pocall_internproc,pocall_cdecl,pocall_cppdecl,
pocall_clearstack,pocall_leftright,pocall_inline, pocall_clearstack,pocall_leftright,pocall_inline,
pocall_safecall]; pocall_safecall,pocall_far16,pocall_fpccall];
mutexclpotype : []; mutexclpotype : [];
mutexclpo : [po_external] mutexclpo : [po_external]
),( ),(
@ -1349,7 +1380,8 @@ const
handler : {$ifdef FPCPROCVAR}@{$endif}pd_register; handler : {$ifdef FPCPROCVAR}@{$endif}pd_register;
pocall : [pocall_register]; pocall : [pocall_register];
pooption : []; pooption : [];
mutexclpocall : [pocall_leftright,pocall_cdecl,pocall_internproc,pocall_cppdecl]; mutexclpocall : [pocall_leftright,pocall_cdecl,pocall_internproc,pocall_cppdecl,
pocall_far16,pocall_fpccall];
mutexclpotype : []; mutexclpotype : [];
mutexclpo : [po_external] mutexclpo : [po_external]
),( ),(
@ -1368,7 +1400,7 @@ const
pocall : [pocall_safecall]; pocall : [pocall_safecall];
pooption : [po_savestdregs]; pooption : [po_savestdregs];
mutexclpocall : [pocall_leftright,pocall_cdecl,pocall_cppdecl, mutexclpocall : [pocall_leftright,pocall_cdecl,pocall_cppdecl,
pocall_internproc,pocall_inline]; pocall_internproc,pocall_inline,pocall_far16,pocall_fpccall];
mutexclpotype : []; mutexclpotype : [];
mutexclpo : [po_external] mutexclpo : [po_external]
),( ),(
@ -1396,7 +1428,7 @@ const
pocall : [pocall_stdcall]; pocall : [pocall_stdcall];
pooption : [po_savestdregs]; pooption : [po_savestdregs];
mutexclpocall : [pocall_leftright,pocall_cdecl,pocall_cppdecl, mutexclpocall : [pocall_leftright,pocall_cdecl,pocall_cppdecl,
pocall_inline,pocall_internproc,pocall_safecall]; pocall_inline,pocall_internproc,pocall_safecall,pocall_far16,pocall_fpccall];
mutexclpotype : []; mutexclpotype : [];
mutexclpo : [po_external] mutexclpo : [po_external]
),( ),(
@ -1406,7 +1438,7 @@ const
pocall : [pocall_palmossyscall,pocall_cdecl,pocall_clearstack]; pocall : [pocall_palmossyscall,pocall_cdecl,pocall_clearstack];
pooption : []; pooption : [];
mutexclpocall : [pocall_cdecl,pocall_cppdecl,pocall_inline, mutexclpocall : [pocall_cdecl,pocall_cppdecl,pocall_inline,
pocall_internproc,pocall_leftright]; pocall_internproc,pocall_leftright,pocall_far16,pocall_fpccall];
mutexclpotype : []; mutexclpotype : [];
mutexclpo : [po_external,po_assembler,po_interrupt,po_exports] mutexclpo : [po_external,po_assembler,po_interrupt,po_exports]
),( ),(
@ -1416,7 +1448,7 @@ const
pocall : [pocall_clearstack]; pocall : [pocall_clearstack];
pooption : []; pooption : [];
mutexclpocall : [pocall_leftright,pocall_inline,pocall_cdecl, mutexclpocall : [pocall_leftright,pocall_inline,pocall_cdecl,
pocall_internproc,pocall_cppdecl]; pocall_internproc,pocall_cppdecl,pocall_far16,pocall_fpccall];
mutexclpotype : []; mutexclpotype : [];
mutexclpo : [po_external,po_assembler,po_interrupt] mutexclpo : [po_external,po_assembler,po_interrupt]
),( ),(
@ -1434,7 +1466,8 @@ const
handler : {$ifdef FPCPROCVAR}@{$endif}pd_cppdecl; handler : {$ifdef FPCPROCVAR}@{$endif}pd_cppdecl;
pocall : [pocall_cppdecl,pocall_clearstack]; pocall : [pocall_cppdecl,pocall_clearstack];
pooption : [po_savestdregs]; pooption : [po_savestdregs];
mutexclpocall : [pocall_cdecl,pocall_internproc,pocall_leftright,pocall_inline]; mutexclpocall : [pocall_cdecl,pocall_internproc,pocall_leftright,pocall_inline,
pocall_far16,pocall_fpccall];
mutexclpotype : []; mutexclpotype : [];
mutexclpo : [po_assembler,po_external] mutexclpo : [po_assembler,po_external]
),( ),(
@ -1444,7 +1477,7 @@ const
pocall : []; pocall : [];
pooption : [po_varargs]; pooption : [po_varargs];
mutexclpocall : [pocall_internproc,pocall_stdcall,pocall_register, mutexclpocall : [pocall_internproc,pocall_stdcall,pocall_register,
pocall_leftright,pocall_inline]; pocall_leftright,pocall_inline,pocall_far16,pocall_fpccall];
mutexclpotype : []; mutexclpotype : [];
mutexclpo : [po_assembler,po_interrupt] mutexclpo : [po_assembler,po_interrupt]
),( ),(
@ -1474,17 +1507,17 @@ const
end; end;
function parse_proc_direc(var pdflags:word):boolean; function parse_proc_direc(idtoken:ttoken; var pdflags:word; do_consume:boolean):boolean;//Ozerski 08.10.01
{ {
Parse the procedure directive, returns true if a correct directive is found Parse the procedure directive, returns true if a correct directive is found
} }
var var
p : longint; p : longint;
found : boolean; found : boolean;
name : string; name : stringid;
begin begin
parse_proc_direc:=false; parse_proc_direc:=false;
name:=pattern; name:=tokeninfo^[idtoken].str;
found:=false; found:=false;
{ Hint directive? Then exit immediatly } { Hint directive? Then exit immediatly }
@ -1548,7 +1581,8 @@ const
end; end;
{ consume directive, and turn flag on } { consume directive, and turn flag on }
consume(token); if do_consume then
consume(token);
parse_proc_direc:=true; parse_proc_direc:=true;
{ Check the pd_flags if the directive should be allowed } { Check the pd_flags if the directive should be allowed }
@ -1592,6 +1626,35 @@ const
end; 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 parse_proc_directives(var pdflags:word); procedure parse_proc_directives(var pdflags:word);
{ {
Parse the procedure directives. It does not matter if procedure directives Parse the procedure directives. It does not matter if procedure directives
@ -1599,20 +1662,28 @@ const
} }
var var
res : boolean; res : boolean;
CallModeIsChangedLocally : boolean;
begin begin
CallModeIsChangedLocally:=false;
while token in [_ID,_LECKKLAMMER] do while token in [_ID,_LECKKLAMMER] do
begin begin
if try_to_consume(_LECKKLAMMER) then if try_to_consume(_LECKKLAMMER) then
begin begin
repeat repeat
parse_proc_direc(pdflags); if not CallModeIsChangedLocally then
CallModeIsChangedLocally:=idtoken in CallModeTokens;
parse_proc_direc(idtoken,pdflags,true);
until not try_to_consume(_COMMA); until not try_to_consume(_COMMA);
consume(_RECKKLAMMER); consume(_RECKKLAMMER);
{ we always expect at least '[];' } { we always expect at least '[];' }
res:=true; res:=true;
end end
else else
res:=parse_proc_direc(pdflags); begin
if not CallModeIsChangedLocally then
CallModeIsChangedLocally:=idtoken in CallModeTokens;
res:=parse_proc_direc(idtoken,pdflags,true);
end;
{ A procedure directive normally followed by a semicolon, but in { A procedure directive normally followed by a semicolon, but in
a const section we should stop when _EQUAL is found } a const section we should stop when _EQUAL is found }
if res then if res then
@ -1628,6 +1699,9 @@ const
else else
break; break;
end; end;
{ add default calling convention if none is specified }
if (not CallModeIsChangedLocally) then
parse_proc_direc(CallModeToken[aktdefproccall],pdflags,false);
end; end;
@ -1803,8 +1877,12 @@ const
begin begin
if ad.name<>fd.name then if ad.name<>fd.name then
begin begin
MessagePos3(aktprocsym.definition.fileinfo,parser_e_header_different_var_names, { don't give an error if the default parameter is not
aktprocsym.name,ad.name,fd.name); specified in the implementation }
if ((copy(fd.name,1,3)='def') and
(copy(ad.name,1,3)<>'def')) then
MessagePos3(aktprocsym.definition.fileinfo,parser_e_header_different_var_names,
aktprocsym.name,ad.name,fd.name);
break; break;
end; end;
ad:=tsym(ad.indexnext); ad:=tsym(ad.indexnext);
@ -1924,11 +2002,14 @@ const
end; end;
end; end;
end. end.
{ {
$Log$ $Log$
Revision 1.38 2001-10-01 13:38:44 jonas Revision 1.39 2001-10-23 21:49:42 peter
* $calling directive and -Cc commandline patch added
from Pavel Ozerski
Revision 1.38 2001/10/01 13:38:44 jonas
* allow self parameter for normal procedures again (because Kylix allows * allow self parameter for normal procedures again (because Kylix allows
it too) ("merged") it too) ("merged")

View File

@ -297,9 +297,11 @@ implementation
- in parasymtable - in parasymtable
- in record or object - in record or object
- ... (PM) } - ... (PM) }
if (m_delphi in aktmodeswitches) and (token=_EQUAL) and if (token=_EQUAL) and
not (symtablestack.symtabletype in [parasymtable]) and not(m_tp7 in aktmodeswitches) and
not is_record and not is_object then not(symtablestack.symtabletype in [parasymtable]) and
not is_record and
not is_object then
begin begin
storetokenpos:=akttokenpos; storetokenpos:=akttokenpos;
s:=sc.get(akttokenpos); s:=sc.get(akttokenpos);
@ -309,7 +311,7 @@ implementation
symtablestack.insert(tconstsym); symtablestack.insert(tconstsym);
akttokenpos:=storetokenpos; akttokenpos:=storetokenpos;
consume(_EQUAL); consume(_EQUAL);
readtypedconst(tt,tconstsym,false); readtypedconst(tt,tconstsym,true);
symdone:=true; symdone:=true;
end; end;
{ hint directive } { hint directive }
@ -573,7 +575,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.20 2001-09-30 21:15:48 peter Revision 1.21 2001-10-23 21:49:42 peter
* $calling directive and -Cc commandline patch added
from Pavel Ozerski
Revision 1.20 2001/09/30 21:15:48 peter
* merged absolute support for constants * merged absolute support for constants
Revision 1.19 2001/08/30 20:13:53 peter Revision 1.19 2001/08/30 20:13:53 peter

View File

@ -206,6 +206,18 @@ implementation
end; end;
end; end;
procedure dir_calling;
var
hs : string;
begin
current_scanner.skipspace;
hs:=current_scanner.readid;
if not SetAktProcCall(hs,false) then
Message1(parser_w_unknown_proc_directive_ignored,hs);
end;
procedure dir_assertions; procedure dir_assertions;
begin begin
do_delphiswitch('C'); do_delphiswitch('C');
@ -844,6 +856,7 @@ implementation
AddDirective('ASMMODE',{$ifdef FPCPROCVAR}@{$endif}dir_asmmode); AddDirective('ASMMODE',{$ifdef FPCPROCVAR}@{$endif}dir_asmmode);
AddDirective('ASSERTIONS',{$ifdef FPCPROCVAR}@{$endif}dir_assertions); AddDirective('ASSERTIONS',{$ifdef FPCPROCVAR}@{$endif}dir_assertions);
AddDirective('BOOLEVAL',{$ifdef FPCPROCVAR}@{$endif}dir_booleval); AddDirective('BOOLEVAL',{$ifdef FPCPROCVAR}@{$endif}dir_booleval);
AddDirective('CALLING',{$ifdef FPCPROCVAR}@{$endif}dir_calling);//Ozerski 08.10.2001
AddDirective('COPYRIGHT',{$ifdef FPCPROCVAR}@{$endif}dir_copyright); AddDirective('COPYRIGHT',{$ifdef FPCPROCVAR}@{$endif}dir_copyright);
AddDirective('D',{$ifdef FPCPROCVAR}@{$endif}dir_description); AddDirective('D',{$ifdef FPCPROCVAR}@{$endif}dir_description);
AddDirective('DEBUGINFO',{$ifdef FPCPROCVAR}@{$endif}dir_debuginfo); AddDirective('DEBUGINFO',{$ifdef FPCPROCVAR}@{$endif}dir_debuginfo);
@ -917,7 +930,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.8 2001-09-02 21:18:28 peter Revision 1.9 2001-10-23 21:49:42 peter
* $calling directive and -Cc commandline patch added
from Pavel Ozerski
Revision 1.8 2001/09/02 21:18:28 peter
* split constsym.value in valueord,valueordptr,valueptr. The valueordptr * split constsym.value in valueord,valueordptr,valueptr. The valueordptr
is used for holding target platform pointer values. As those can be is used for holding target platform pointer values. As those can be
bigger than the source platform. bigger than the source platform.

View File

@ -112,21 +112,6 @@ type
sp_hint_platform, sp_hint_platform,
sp_hint_library, sp_hint_library,
sp_has_overloaded sp_has_overloaded
,sp_10
,sp_11
,sp_12
,sp_13
,sp_14
,sp_15
,sp_16
,sp_17
,sp_18
,sp_19
,sp_20
,sp_21
,sp_22
,sp_23
,sp_24
); );
tsymoptions=set of tsymoption; tsymoptions=set of tsymoption;
@ -134,28 +119,6 @@ type
tdefoption=(df_none, tdefoption=(df_none,
df_has_inittable, { init data has been generated } df_has_inittable, { init data has been generated }
df_has_rttitable { rtti data has been generated } df_has_rttitable { rtti data has been generated }
,df_3
,df_4
,df_5
,df_6
,df_7
,df_8
,df_9
,df_10
,df_11
,df_12
,df_13
,df_14
,df_15
,df_16
,df_17
,df_18
,df_19
,df_20
,df_21
,df_22
,df_23
,df_24
); );
tdefoptions=set of tdefoption; tdefoptions=set of tdefoption;
@ -206,18 +169,9 @@ type
pocall_internproc, { Procedure has compiler magic} pocall_internproc, { Procedure has compiler magic}
pocall_internconst, { procedure has constant evaluator intern } pocall_internconst, { procedure has constant evaluator intern }
pocall_cppdecl, { C++ calling conventions } pocall_cppdecl, { C++ calling conventions }
pocall_compilerproc { Procedure is used for internal compiler calls } pocall_compilerproc, { Procedure is used for internal compiler calls }
,pocall_14 pocall_far16, { Far16 for OS/2 }
,pocall_15 pocall_fpccall { FPC default calling }
,pocall_16
,pocall_17
,pocall_18
,pocall_19
,pocall_20
,pocall_21
,pocall_22
,pocall_23
,pocall_24
); );
tproccalloptions=set of tproccalloption; tproccalloptions=set of tproccalloption;
@ -229,24 +183,6 @@ type
potype_constructor, { Procedure is a constructor } potype_constructor, { Procedure is a constructor }
potype_destructor, { Procedure is a destructor } potype_destructor, { Procedure is a destructor }
potype_operator { Procedure defines an operator } potype_operator { Procedure defines an operator }
,potype_7
,potype_8
,potype_9
,potype_10
,potype_11
,potype_12
,potype_13
,potype_14
,potype_15
,potype_16
,potype_17
,potype_18
,potype_19
,potype_20
,potype_21
,potype_22
,potype_23
,potype_24
); );
tproctypeoptions=set of tproctypeoption; tproctypeoptions=set of tproctypeoption;
@ -270,12 +206,6 @@ type
po_saveregisters, { save all registers } po_saveregisters, { save all registers }
po_overload, { procedure is declared with overload directive } po_overload, { procedure is declared with overload directive }
po_varargs { printf like arguments } po_varargs { printf like arguments }
,po_19
,po_20
,po_21
,po_22
,po_23
,po_24
); );
tprocoptions=set of tprocoption; tprocoptions=set of tprocoption;
@ -301,19 +231,6 @@ type
oo_has_msgint, oo_has_msgint,
oo_has_abstract, { the object/class has an abstract method => no instances can be created } oo_has_abstract, { the object/class has an abstract method => no instances can be created }
oo_can_have_published { the class has rtti, i.e. you can publish properties } oo_can_have_published { the class has rtti, i.e. you can publish properties }
,oo_12
,oo_13
,oo_14
,oo_15
,oo_16
,oo_17
,oo_18
,oo_19
,oo_20
,oo_21
,oo_22
,oo_23
,oo_24
); );
tobjectoptions=set of tobjectoption; tobjectoptions=set of tobjectoption;
@ -324,25 +241,6 @@ type
ppo_stored, ppo_stored,
ppo_hasparameters, ppo_hasparameters,
ppo_is_override ppo_is_override
,ppo_6
,ppo_7
,ppo_8
,ppo_9
,ppo_10
,ppo_11
,ppo_12
,ppo_13
,ppo_14
,ppo_15
,ppo_16
,ppo_17
,ppo_18
,ppo_19
,ppo_20
,ppo_21
,ppo_22
,ppo_23
,ppo_24
); );
tpropertyoptions=set of tpropertyoption; tpropertyoptions=set of tpropertyoption;
@ -357,21 +255,6 @@ type
vo_is_local_copy, vo_is_local_copy,
vo_is_const, { variable is declared as const (parameter) and can't be written to } vo_is_const, { variable is declared as const (parameter) and can't be written to }
vo_is_exported vo_is_exported
,vo_10
,vo_11
,vo_12
,vo_13
,vo_14
,vo_15
,vo_16
,vo_17
,vo_18
,vo_19
,vo_20
,vo_21
,vo_22
,vo_23
,vo_24
); );
tvaroptions=set of tvaroption; tvaroptions=set of tvaroption;
@ -461,7 +344,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.25 2001-10-21 12:33:07 peter Revision 1.26 2001-10-23 21:49:43 peter
* $calling directive and -Cc commandline patch added
from Pavel Ozerski
Revision 1.25 2001/10/21 12:33:07 peter
* array access for properties added * array access for properties added
Revision 1.24 2001/10/20 20:30:21 peter Revision 1.24 2001/10/20 20:30:21 peter

View File

@ -337,7 +337,6 @@ interface
const const
current_object_option : tsymoptions = [sp_public]; current_object_option : tsymoptions = [sp_public];
{ rtti and init/final } { rtti and init/final }
procedure generate_rtti(p:tsym); procedure generate_rtti(p:tsym);
procedure generate_inittable(p:tsym); procedure generate_inittable(p:tsym);
@ -369,6 +368,10 @@ implementation
cgbase,cresstr cgbase,cresstr
; ;
{****************************************************************************
Helpers
****************************************************************************}
{**************************************************************************** {****************************************************************************
TSYM (base for all symtypes) TSYM (base for all symtypes)
****************************************************************************} ****************************************************************************}
@ -2487,7 +2490,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.23 2001-10-20 20:30:21 peter Revision 1.24 2001-10-23 21:49:43 peter
* $calling directive and -Cc commandline patch added
from Pavel Ozerski
Revision 1.23 2001/10/20 20:30:21 peter
* read only typed const support, switch $J- * read only typed const support, switch $J-
Revision 1.22 2001/09/19 11:04:42 michael Revision 1.22 2001/09/19 11:04:42 michael

View File

@ -141,6 +141,7 @@ type
_CLASS, _CLASS,
_CONST, _CONST,
_FALSE, _FALSE,
_FAR16,
_INDEX, _INDEX,
_LABEL, _LABEL,
_RAISE, _RAISE,
@ -171,6 +172,7 @@ type
_EXPORTS, _EXPORTS,
_FINALLY, _FINALLY,
_FORWARD, _FORWARD,
_FPCCALL,
_IOCHECK, _IOCHECK,
_LIBRARY, _LIBRARY,
_MESSAGE, _MESSAGE,
@ -364,6 +366,7 @@ const
(str:'CLASS' ;special:false;keyword:m_class;op:NOTOKEN), (str:'CLASS' ;special:false;keyword:m_class;op:NOTOKEN),
(str:'CONST' ;special:false;keyword:m_all;op:NOTOKEN), (str:'CONST' ;special:false;keyword:m_all;op:NOTOKEN),
(str:'FALSE' ;special:false;keyword:m_all;op:NOTOKEN), (str:'FALSE' ;special:false;keyword:m_all;op:NOTOKEN),
(str:'FAR16' ;special:false;keyword:m_none;op:NOTOKEN),
(str:'INDEX' ;special:false;keyword:m_none;op:NOTOKEN), (str:'INDEX' ;special:false;keyword:m_none;op:NOTOKEN),
(str:'LABEL' ;special:false;keyword:m_all;op:NOTOKEN), (str:'LABEL' ;special:false;keyword:m_all;op:NOTOKEN),
(str:'RAISE' ;special:false;keyword:m_class;op:NOTOKEN), (str:'RAISE' ;special:false;keyword:m_class;op:NOTOKEN),
@ -394,6 +397,7 @@ const
(str:'EXPORTS' ;special:false;keyword:m_all;op:NOTOKEN), (str:'EXPORTS' ;special:false;keyword:m_all;op:NOTOKEN),
(str:'FINALLY' ;special:false;keyword:m_class;op:NOTOKEN), (str:'FINALLY' ;special:false;keyword:m_class;op:NOTOKEN),
(str:'FORWARD' ;special:false;keyword:m_none;op:NOTOKEN), (str:'FORWARD' ;special:false;keyword:m_none;op:NOTOKEN),
(str:'FPCCALL' ;special:false;keyword:m_none;op:NOTOKEN),
(str:'IOCHECK' ;special:false;keyword:m_none;op:NOTOKEN), (str:'IOCHECK' ;special:false;keyword:m_none;op:NOTOKEN),
(str:'LIBRARY' ;special:false;keyword:m_all;op:NOTOKEN), (str:'LIBRARY' ;special:false;keyword:m_all;op:NOTOKEN),
(str:'MESSAGE' ;special:false;keyword:m_none;op:NOTOKEN), (str:'MESSAGE' ;special:false;keyword:m_none;op:NOTOKEN),
@ -497,7 +501,11 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.13 2001-08-01 15:07:29 jonas Revision 1.14 2001-10-23 21:49:43 peter
* $calling directive and -Cc commandline patch added
from Pavel Ozerski
Revision 1.13 2001/08/01 15:07:29 jonas
+ "compilerproc" directive support, which turns both the public and mangled + "compilerproc" directive support, which turns both the public and mangled
name to lowercase(declaration_name). This prevents a normal user from name to lowercase(declaration_name). This prevents a normal user from
accessing the routine, but they can still be easily looked up within accessing the routine, but they can still be easily looked up within