paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-24 09:21:38 +02:00
Code Issues Packages Projects Releases Wiki Activity

* implicit result variable generation for assembler routines

Browse Source 
* removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
This commit is contained in:
peter 2002-01-24 18:25:48 +00:00
parent c712889047
commit fd2ad837e2
19 changed files with 355 additions and 226 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
compiler/globals.pas
View File

@ -56,9 +56,9 @@ interface
{$endif Splitheap}
delphimodeswitches : tmodeswitches=
[m_delphi,m_tp,m_all,m_class,m_objpas,m_result,m_string_pchar,
[m_delphi,m_all,m_class,m_objpas,m_result,m_string_pchar,
m_pointer_2_procedure,m_autoderef,m_tp_procvar,m_initfinal,m_default_ansistring,
m_out,m_default_para,m_hintdirective];
m_out,m_default_para,m_hintdirective,m_duplicate_names];
fpcmodeswitches : tmodeswitches=
[m_fpc,m_all,m_string_pchar,m_nested_comment,m_repeat_forward,
m_cvar_support,m_initfinal,m_add_pointer];
@ -66,7 +66,7 @@ interface
[m_objfpc,m_fpc,m_all,m_class,m_objpas,m_result,m_string_pchar,m_nested_comment,
m_repeat_forward,m_cvar_support,m_initfinal,m_add_pointer,m_out,m_default_para];
tpmodeswitches : tmodeswitches=
[m_tp7,m_tp,m_all,m_tp_procvar];
[m_tp7,m_all,m_tp_procvar,m_duplicate_names];
gpcmodeswitches : tmodeswitches=
[m_gpc,m_all];
@ -1453,7 +1453,11 @@ begin
end.
{
$Log$
Revision 1.50 2001-12-06 17:57:33 florian
Revision 1.51 2002-01-24 18:25:48 peter
* implicit result variable generation for assembler routines
* removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
Revision 1.50 2001/12/06 17:57:33 florian
+ parasym to tparaitem added
Revision 1.49 2001/10/25 21:22:32 peter

11
compiler/globtype.pas
View File

@ -125,7 +125,7 @@ interface
{ Switches which can be changed by a mode (fpc,tp7,delphi) }
tmodeswitch = (m_none,m_all, { needed for keyword }
{ generic }
m_fpc,m_objfpc,m_delphi,m_tp,m_tp7,m_gpc,
m_fpc,m_objfpc,m_delphi,m_tp7,m_gpc,
{ more specific }
m_class, { delphi class model }
m_objpas, { load objpas unit }
@ -143,7 +143,8 @@ interface
m_default_ansistring, { ansistring turned on by default }
m_out, { support the calling convention OUT }
m_default_para, { support default parameters }
m_hintdirective { support hint directives }
m_hintdirective, { support hint directives }
m_duplicate_names { allow locals/paras to have duplicate names of globals }
);
tmodeswitches = set of tmodeswitch;
@ -245,7 +246,11 @@ implementation
end.
{
$Log$
Revision 1.19 2001-10-25 21:22:32 peter
Revision 1.20 2002-01-24 18:25:48 peter
* implicit result variable generation for assembler routines
* removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
Revision 1.19 2001/10/25 21:22:32 peter
* calling convention rewrite
Revision 1.18 2001/10/24 11:46:06 marco

83
compiler/i386/cga.pas
View File

@ -2677,50 +2677,55 @@ implementation
emitcall('FPC_DO_EXIT');
end;
{ handle return value }
{ handle return value, this is not done for assembler routines when
they didn't reference the result variable }
uses_eax:=false;
uses_edx:=false;
uses_esi:=false;
if not(po_assembler in aktprocdef.procoptions) then
if not(po_assembler in aktprocdef.procoptions) or
(assigned(aktprocdef.funcretsym) and
(tfuncretsym(aktprocdef.funcretsym).refcount>1)) then
begin
if (aktprocdef.proctypeoption<>potype_constructor) then
handle_return_value(inlined,uses_eax,uses_edx)
else
begin
{ successful constructor deletes the zero flag }
{ and returns self in eax }
{ eax must be set to zero if the allocation failed !!! }
getlabel(okexitlabel);
emitjmp(C_NONE,okexitlabel);
emitlab(faillabel);
if is_class(procinfo^._class) then
begin
emit_ref_reg(A_MOV,S_L,new_reference(procinfo^.framepointer,8),R_ESI);
emitcall('FPC_HELP_FAIL_CLASS');
end
else if is_object(procinfo^._class) then
begin
emit_ref_reg(A_MOV,S_L,new_reference(procinfo^.framepointer,12),R_ESI);
getexplicitregister32(R_EDI);
emit_const_reg(A_MOV,S_L,procinfo^._class.vmt_offset,R_EDI);
emitcall('FPC_HELP_FAIL');
ungetregister32(R_EDI);
end
else
Internalerror(200006161);
begin
{ successful constructor deletes the zero flag }
{ and returns self in eax }
{ eax must be set to zero if the allocation failed !!! }
getlabel(okexitlabel);
emitjmp(C_NONE,okexitlabel);
emitlab(faillabel);
if is_class(procinfo^._class) then
begin
emit_ref_reg(A_MOV,S_L,new_reference(procinfo^.framepointer,8),R_ESI);
emitcall('FPC_HELP_FAIL_CLASS');
end
else if is_object(procinfo^._class) then
begin
emit_ref_reg(A_MOV,S_L,new_reference(procinfo^.framepointer,12),R_ESI);
getexplicitregister32(R_EDI);
emit_const_reg(A_MOV,S_L,procinfo^._class.vmt_offset,R_EDI);
emitcall('FPC_HELP_FAIL');
ungetregister32(R_EDI);
end
else
Internalerror(200006161);
emitlab(okexitlabel);
emitlab(okexitlabel);
{ for classes this is done after the call to }
{ AfterConstruction }
if is_object(procinfo^._class) then
begin
exprasmList.concat(Tairegalloc.Alloc(R_EAX));
emit_reg_reg(A_MOV,S_L,R_ESI,R_EAX);
uses_eax:=true;
end;
emit_reg_reg(A_TEST,S_L,R_ESI,R_ESI);
uses_esi:=true;
end;
{ for classes this is done after the call to }
{ AfterConstruction }
if is_object(procinfo^._class) then
begin
exprasmList.concat(Tairegalloc.Alloc(R_EAX));
emit_reg_reg(A_MOV,S_L,R_ESI,R_EAX);
uses_eax:=true;
end;
emit_reg_reg(A_TEST,S_L,R_ESI,R_ESI);
uses_esi:=true;
end;
end;
if aktexit2label.is_used and not aktexit2label.is_set then
emitlab(aktexit2label);
@ -2982,7 +2987,11 @@ implementation
end.
{
$Log$
Revision 1.14 2002-01-19 14:21:17 peter
Revision 1.15 2002-01-24 18:25:53 peter
* implicit result variable generation for assembler routines
* removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
Revision 1.14 2002/01/19 14:21:17 peter
* fixed init/final for value parameters
Revision 1.13 2001/12/30 17:24:45 jonas

58
compiler/i386/ra386.pas
View File

@ -39,7 +39,6 @@ Procedure FWaitWarning;
type
T386Operand=class(TOperand)
Procedure SetCorrectSize(opcode:tasmop);override;
Function SetupResult : boolean;override;
end;
T386Instruction=class(TInstruction)
@ -185,57 +184,6 @@ begin
end;
end;
Function T386Operand.SetupResult:boolean;
var
Res : boolean;
Begin
Res:=inherited setupResult;
{ replace by ref by register if not place was
reserved on stack }
if res and (procinfo^.return_offset=0) then
begin
opr.typ:=OPR_REGISTER;
if is_fpu(aktprocdef.rettype.def) then
begin
opr.reg:=R_ST0;
case tfloatdef(aktprocdef.rettype.def).typ of
s32real : size:=S_FS;
s64real : size:=S_FL;
s80real : size:=S_FX;
s64comp : size:=S_IQ;
else
begin
Message(asmr_e_cannot_use_RESULT_here);
res:=false;
end;
end;
end
else if ret_in_acc(aktprocdef.rettype.def) then
case aktprocdef.rettype.def.size of
1 : begin
opr.reg:=R_AL;
size:=S_B;
end;
2 : begin
opr.reg:=R_AX;
size:=S_W;
end;
3,4 : begin
opr.reg:=R_EAX;
size:=S_L;
end;
else
begin
Message(asmr_e_cannot_use_RESULT_here);
res:=false;
end;
end;
Message1(asmr_h_RESULT_is_reg,reg2str(opr.reg));
end;
SetupResult:=res;
end;
{*****************************************************************************
T386Instruction
@ -683,7 +631,11 @@ end;
end.
{
$Log$
Revision 1.13 2001-11-02 22:58:11 peter
Revision 1.14 2002-01-24 18:25:53 peter
* implicit result variable generation for assembler routines
* removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
Revision 1.13 2001/11/02 22:58:11 peter
* procsym definition rewrite
Revision 1.12 2001/08/26 13:37:01 florian

10
compiler/i386/ra386att.pas
View File

@ -1892,10 +1892,6 @@ Var
Begin
Message1(asmr_d_start_reading,'AT&T');
firsttoken:=TRUE;
if assigned(aktprocdef.funcretsym) and
(is_fpu(aktprocdef.rettype.def) or
ret_in_acc(aktprocdef.rettype.def)) then
tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
{ sets up all opcode and register tables in uppercase }
if not _asmsorted then
Begin
@ -2139,7 +2135,11 @@ finalization
end.
{
$Log$
Revision 1.15 2001-11-02 22:58:11 peter
Revision 1.16 2002-01-24 18:25:53 peter
* implicit result variable generation for assembler routines
* removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
Revision 1.15 2001/11/02 22:58:11 peter
* procsym definition rewrite
Revision 1.14 2001/08/26 13:37:02 florian

10
compiler/i386/ra386int.pas
View File

@ -1847,10 +1847,6 @@ Begin
Message1(asmr_d_start_reading,'intel');
inexpression:=FALSE;
firsttoken:=TRUE;
if assigned(aktprocdef.funcretsym) and
(is_fpu(aktprocdef.rettype.def) or
ret_in_acc(aktprocdef.rettype.def)) then
tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
{ sets up all opcode and register tables in uppercase }
if not _asmsorted then
Begin
@ -1968,7 +1964,11 @@ finalization
end.
{
$Log$
Revision 1.19 2001-11-02 22:58:11 peter
Revision 1.20 2002-01-24 18:25:53 peter
* implicit result variable generation for assembler routines
* removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
Revision 1.19 2001/11/02 22:58:11 peter
* procsym definition rewrite
Revision 1.18 2001/09/17 21:29:14 peter

92
compiler/ncal.pas
View File

@ -780,8 +780,11 @@ implementation
var
i : longint;
found,
is_const : boolean;
bestord : torddef;
srprocsym : tprocsym;
srsymtable : tsymtable;
begin
result:=nil;
@ -878,36 +881,73 @@ implementation
pd:=pd^.next;
end;
{$ifdef CROSSUNIT}
{ when the definition has overload directive set, we search for
overloaded definitions in the other used units unitsymtable. The found
entries are only added to the procs list and not the procsym }
overloaded definitions in the symtablestack. The found
entries are only added to the procs list and not the procsym, because
the list can change in every situation }
if (po_overload in symtableprocentry.defs^.def.procoptions) and
(symtableprocentry.owner.symtabletype<>objectsymtable) then
begin
srpdl:=srsym.defs;
while assigned(srpdl) do
begin
found:=false;
pdl:=aprocsym.defs;
while assigned(pdl) do
begin
if equal_paras(pdl^.def.para,srpdl^.def.para,cp_value_equal_const) then
srsymtable:=symtableprocentry.owner.next;
while assigned(srsymtable) do
begin
found:=true;
break;
if srsymtable.symtabletype in [localsymtable,staticsymtable,globalsymtable] then
begin
srprocsym:=tprocsym(srsymtable.speedsearch(symtableprocentry.name,symtableprocentry.speedvalue));
{ process only visible procsyms }
if assigned(srprocsym) and
(srprocsym.typ=procsym) and
srprocsym.is_visible_for_proc(aktprocdef) then
begin
{ if this procedure doesn't have overload we can stop
searching }
if not(po_overload in srprocsym.defs^.def.procoptions) then
break;
{ process all overloaded definitions }
pd:=srprocsym.defs;
while assigned(pd) do
begin
{ only when the # of parameter are supported by the
procedure }
if (paralength>=pd^.def.minparacount) and
((po_varargs in pd^.def.procoptions) or { varargs }
(paralength<=pd^.def.maxparacount)) then
begin
found:=false;
hp:=procs;
while assigned(hp) do
begin
if equal_paras(hp^.data.para,pd^.def.para,cp_value_equal_const) then
begin
found:=true;
break;
end;
hp:=hp^.next;
end;
if not found then
begin
new(hp);
hp^.data:=pd^.def;
hp^.next:=procs;
hp^.firstpara:=tparaitem(pd^.def.Para.first);
if not(po_varargs in pd^.def.procoptions) then
begin
{ if not all parameters are given, then skip the
default parameters }
for i:=1 to pd^.def.maxparacount-paralength do
hp^.firstpara:=tparaitem(hp^.firstPara.next);
end;
hp^.nextpara:=hp^.firstpara;
procs:=hp;
end;
end;
pd:=pd^.next;
end;
end;
end;
srsymtable:=srsymtable.next;
end;
pdl:=pdl^.next;
end;
if not found then
aprocsym.addprocdef(srpdl^.def);
srpdl:=srpdl^.next;
end;
end;
{$endif CROSSUNIT}
{ no procedures found? then there is something wrong
with the parameter size }
@ -1796,7 +1836,11 @@ begin
end.
{
$Log$
Revision 1.63 2002-01-24 12:33:52 jonas
Revision 1.64 2002-01-24 18:25:48 peter
* implicit result variable generation for assembler routines
* removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
Revision 1.63 2002/01/24 12:33:52 jonas
* adapted ranges of native types to int64 (e.g. high cardinal is no
longer longint($ffffffff), but just $fffffff in psystem)
* small additional fix in 64bit rangecheck code generation for 32 bit

8
compiler/ninl.pas
View File

@ -1299,7 +1299,7 @@ implementation
begin
{ give warning for incompatibility with tp and delphi }
if (inlinenumber in [in_lo_long,in_hi_long,in_lo_qword,in_hi_qword]) and
((m_tp in aktmodeswitches) or
((m_tp7 in aktmodeswitches) or
(m_delphi in aktmodeswitches)) then
CGMessage(type_w_maybe_wrong_hi_lo);
{ constant folding }
@ -2341,7 +2341,11 @@ begin
end.
{
$Log$
Revision 1.68 2002-01-19 11:53:56 peter
Revision 1.69 2002-01-24 18:25:48 peter
* implicit result variable generation for assembler routines
* removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
Revision 1.68 2002/01/19 11:53:56 peter
* constant evaluation for assinged added
Revision 1.67 2001/12/28 14:09:21 jonas

13
compiler/pdecobj.pas
View File

@ -577,7 +577,7 @@ implementation
include(aktclass.objectoptions,oo_has_destructor);
consume(_SEMICOLON);
if not(aktprocdef.Para.empty) then
if not (m_tp in aktmodeswitches) then
if (m_fpc in aktmodeswitches) then
Message(parser_e_no_paras_for_destructor);
{ no return value }
aktprocdef.rettype:=voidtype;
@ -905,9 +905,8 @@ implementation
Message(parser_e_no_local_objects);
storetypecanbeforward:=typecanbeforward;
{ for tp mode don't allow forward types }
if (m_tp in aktmodeswitches) and
not (m_delphi in aktmodeswitches) then
{ for tp7 don't allow forward types }
if (m_tp7 in aktmodeswitches) then
typecanbeforward:=false;
if not(readobjecttype) then
@ -1111,7 +1110,11 @@ implementation
end.
{
$Log$
Revision 1.36 2002-01-06 12:08:15 peter
Revision 1.37 2002-01-24 18:25:48 peter
* implicit result variable generation for assembler routines
* removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
Revision 1.36 2002/01/06 12:08:15 peter
* removed uauto from orddef, use new range_to_basetype generating
the correct ordinal type for a range

8
compiler/pdecsub.pas
View File

@ -538,7 +538,7 @@ implementation
begin
{ when the other symbol is a unit symbol then hide the unit
symbol. Only in tp mode because it's bad programming }
if (m_tp in aktmodeswitches) and
if (m_duplicate_names in aktmodeswitches) and
(aktprocsym.typ=unitsym) then
begin
aktprocsym.owner.rename(aktprocsym.name,'hidden'+aktprocsym.name);
@ -2014,7 +2014,11 @@ const
end.
{
$Log$
Revision 1.45 2002-01-09 07:38:03 michael
Revision 1.46 2002-01-24 18:25:49 peter
* implicit result variable generation for assembler routines
* removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
Revision 1.45 2002/01/09 07:38:03 michael
+ Patch from peter for library imports
Revision 1.44 2002/01/06 21:54:07 peter

12
compiler/pexpr.pas
View File

@ -301,7 +301,7 @@ implementation
do_member_read(false,sym,p2,again)
else
begin
if (m_tp in aktmodeswitches) then
if not(m_fpc in aktmodeswitches) then
do_member_read(false,sym,p2,again)
else
begin
@ -357,7 +357,7 @@ implementation
if (tpointerdef(p.resulttype.def).pointertype.def.deftype=orddef) and
(torddef(tpointerdef(p.resulttype.def).pointertype.def).typ=uvoid) then
begin
if (m_tp in aktmodeswitches) or
if (m_tp7 in aktmodeswitches) or
(m_delphi in aktmodeswitches) then
Message(parser_w_no_new_dispose_on_void_pointers)
else
@ -1189,7 +1189,7 @@ implementation
((tvarsym(sym)=otsym) and ((p^.flags and pi_operator)<>0))) and
(not is_void(p^.procdef.rettype.def)) and
(token<>_LKLAMMER) and
(not ((m_tp in aktmodeswitches) and (afterassignment or in_args)))
(not (not(m_fpc in aktmodeswitches) and (afterassignment or in_args)))
) then
begin
if ((tvarsym(sym)=otsym) and
@ -2483,7 +2483,11 @@ implementation
end.
{
$Log$
Revision 1.54 2002-01-06 21:47:32 peter
Revision 1.55 2002-01-24 18:25:49 peter
* implicit result variable generation for assembler routines
* removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
Revision 1.54 2002/01/06 21:47:32 peter
* removed getprocvar, use only getprocvardef
Revision 1.53 2001/12/31 16:59:42 peter

8
compiler/pmodules.pas
View File

@ -621,7 +621,7 @@ implementation
if (m_delphi in aktmodeswitches) then
current_scanner.def_macro('FPC_DELPHI')
else
if (m_tp in aktmodeswitches) then
if (m_tp7 in aktmodeswitches) then
current_scanner.def_macro('FPC_TP')
else
if (m_objfpc in aktmodeswitches) then
@ -1349,7 +1349,11 @@ implementation
end.
{
$Log$
Revision 1.50 2001-12-09 03:34:58 carl
Revision 1.51 2002-01-24 18:25:49 peter
* implicit result variable generation for assembler routines
* removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
Revision 1.50 2001/12/09 03:34:58 carl
+ Stack checking for solaris
Revision 1.49 2001/11/02 23:16:51 peter

186
compiler/pstatmnt.pas
View File

@ -42,7 +42,7 @@ implementation
cutils,
{ global }
globtype,globals,verbose,
systems,cpuinfo,
systems,cpuinfo,cpuasm,
{ aasm }
cpubase,aasm,
{ symtable }
@ -1044,7 +1044,76 @@ implementation
function assembler_block : tnode;
procedure OptimizeFramePointer(p:tasmnode);
var
hp : tai;
parafixup,
i : longint;
begin
{ replace framepointer with stackpointer }
procinfo^.framepointer:=stack_pointer;
{ set the right value for parameters }
dec(aktprocdef.parast.address_fixup,target_info.size_of_pointer);
dec(procinfo^.para_offset,target_info.size_of_pointer);
{ replace all references to parameters in the instructions,
the parameters can be identified by the parafixup option
that is set. For normal user coded [ebp+4] this field is not
set }
parafixup:=aktprocdef.parast.address_fixup;
hp:=tai(p.p_asm.first);
while assigned(hp) do
begin
if hp.typ=ait_instruction then
begin
{ fixup the references }
for i:=1 to taicpu(hp).ops do
begin
with taicpu(hp).oper[i-1] do
if typ=top_ref then
begin
case ref^.options of
ref_parafixup :
begin
ref^.offsetfixup:=parafixup;
ref^.base:=stack_pointer;
end;
end;
end;
end;
end;
hp:=tai(hp.next);
end;
end;
{$ifdef CHECKFORPUSH}
function UsesPush(p:tasmnode):boolean;
var
hp : tai;
begin
hp:=tai(p.p_asm.first);
while assigned(hp) do
begin
if (hp.typ=ait_instruction) and
(taicpu(hp).opcode=A_PUSH) then
begin
UsesPush:=true;
exit;
end;
hp:=tai(hp.next);
end;
UsesPush:=false;
end;
{$endif CHECKFORPUSH}
var
p : tnode;
haslocals,hasparas : boolean;
begin
{ retrieve info about locals and paras before a result
is inserted in the symtable }
haslocals:=(aktprocdef.localst.datasize>0);
hasparas:=(aktprocdef.parast.datasize>0);
{ temporary space is set, while the BEGIN of the procedure }
if symtablestack.symtabletype=localsymtable then
procinfo^.firsttemp_offset := -symtablestack.datasize
@ -1053,75 +1122,74 @@ implementation
{ assembler code does not allocate }
{ space for the return value }
if not is_void(aktprocdef.rettype.def) then
if not is_void(aktprocdef.rettype.def) then
begin
aktprocdef.funcretsym:=tfuncretsym.create(aktprocsym.name,aktprocdef.rettype);
if ret_in_acc(aktprocdef.rettype.def) then
begin
{ in assembler code the result should be directly in %eax
procinfo^.retoffset:=procinfo^.firsttemp-procinfo^.retdef.size;
procinfo^.firsttemp:=procinfo^.retoffset; }
{$ifndef newcg}
{$ifdef i386}
usedinproc:=usedinproc or ($80 shr byte(R_EAX))
{$else}
{$ifdef POWERPC}
usedinproc:=0;
{$else POWERPC}
usedinproc:=usedinproc + [accumulator];
{$endif POWERPC}
{$endif i386}
{$endif newcg}
end
{
else if not is_fpu(procinfo^.retdef) then
should we allow assembler functions of big elements ?
YES (FK)!!
Message(parser_e_asm_incomp_with_function_return);
}
end;
{ set the framepointer to esp for assembler functions }
{ but only if the are no local variables }
{ added no parameter also (PM) }
{ disable for methods, because self pointer is expected }
{ at -8(%ebp) (JM) }
{ why if se use %esp then self is still at the correct address PM }
if {not(assigned(procinfo^._class)) and}
(po_assembler in aktprocdef.procoptions) and
(aktprocdef.localst.datasize=0) and
(aktprocdef.parast.datasize=0) and
not(ret_in_param(aktprocdef.rettype.def)) then
begin
procinfo^.framepointer:=stack_pointer;
{ set the right value for parameters }
dec(aktprocdef.parast.address_fixup,target_info.size_of_pointer);
dec(procinfo^.para_offset,target_info.size_of_pointer);
end;
{ only insert now in the symtable, otherwise the }
{ "aktprocdef.localst.datasize=0" check above will }
{ always fail (JM) }
if not is_void(aktprocdef.rettype.def) then
begin
{ insert in local symtable }
{ but with another name, so that recursive calls are possible }
symtablestack.insert(aktprocdef.funcretsym);
symtablestack.rename(aktprocdef.funcretsym.name,'$result');
{ set the used flag for the return }
if ret_in_acc(aktprocdef.rettype.def) then
begin
{$ifdef i386}
usedinproc:=usedinproc or ($80 shr byte(R_EAX))
{$else}
{$ifdef POWERPC}
usedinproc:=0;
{$else POWERPC}
usedinproc:=usedinproc + [accumulator];
{$endif POWERPC}
{$endif i386}
end;
end;
{ force the asm statement }
if token<>_ASM then
consume(_ASM);
procinfo^.Flags := procinfo^.Flags Or pi_is_assembler;
assembler_block:=_asm_statement;
{ becuase the END is already read we need to get the
last_endtoken_filepos here (PFV) }
last_endtoken_filepos:=akttokenpos;
end;
{ force the asm statement }
if token<>_ASM then
consume(_ASM);
procinfo^.Flags := procinfo^.Flags Or pi_is_assembler;
p:=_asm_statement;
{ set the framepointer to esp for assembler functions when the
following conditions are met:
- if the are no local variables
- no reference to the result variable (refcount<=1)
- result is not stored as parameter }
if (po_assembler in aktprocdef.procoptions) and
(not haslocals) and
(not hasparas) and
(aktprocdef.owner.symtabletype<>objectsymtable) and
(not assigned(aktprocdef.funcretsym) or
(tfuncretsym(aktprocdef.funcretsym).refcount<=1)) and
not(ret_in_param(aktprocdef.rettype.def))
{$ifdef CHECKFORPUSH}
and not(UsesPush(tasmnode(p)))
{$endif CHECKFORPUSH}
then
OptimizeFramePointer(tasmnode(p));
{ Flag the result as assigned when it is returned in the
accumulator or on the fpu stack }
if assigned(aktprocdef.funcretsym) and
(is_fpu(aktprocdef.rettype.def) or
ret_in_acc(aktprocdef.rettype.def)) then
tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
{ because the END is already read we need to get the
last_endtoken_filepos here (PFV) }
last_endtoken_filepos:=akttokenpos;
assembler_block:=p;
end;
end.
{
$Log$
Revision 1.44 2001-11-09 10:06:56 jonas
Revision 1.45 2002-01-24 18:25:49 peter
* implicit result variable generation for assembler routines
* removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
Revision 1.44 2001/11/09 10:06:56 jonas
* allow recursive calls again in assembler procedure
Revision 1.43 2001/11/02 22:58:05 peter

16
compiler/ptconst.pas
View File

@ -291,7 +291,7 @@ implementation
begin
len:=tstringconstnode(p).len;
{ For tp7 the maximum lentgh can be 255 }
if (m_tp in aktmodeswitches) and
if (m_tp7 in aktmodeswitches) and
(len>255) then
len:=255;
getmem(ca,len+2);
@ -624,7 +624,7 @@ implementation
begin
len:=tstringconstnode(p).len;
{ For tp7 the maximum lentgh can be 255 }
if (m_tp in aktmodeswitches) and
if (m_tp7 in aktmodeswitches) and
(len>255) then
len:=255;
ca:=tstringconstnode(p).value_str;
@ -872,7 +872,7 @@ implementation
end
{ for objects we allow it only if it doesn't contain a vmt }
else if (oo_has_vmt in tobjectdef(t.def).objectoptions) and
not(m_tp in aktmodeswitches) then
(m_fpc in aktmodeswitches) then
Message(parser_e_type_const_not_possible)
else
begin
@ -910,7 +910,7 @@ implementation
Message(parser_e_invalid_record_const);
{ check in VMT needs to be added for TP mode }
if (m_tp in aktmodeswitches) and
if not(m_fpc in aktmodeswitches) and
(oo_has_vmt in tobjectdef(t.def).objectoptions) and
(tobjectdef(t.def).vmt_offset<tvarsym(srsym).address) then
begin
@ -937,7 +937,7 @@ implementation
else break;
end;
end;
if (m_tp in aktmodeswitches) and
if not(m_fpc in aktmodeswitches) and
(oo_has_vmt in tobjectdef(t.def).objectoptions) and
(tobjectdef(t.def).vmt_offset>=aktpos) then
begin
@ -970,7 +970,11 @@ implementation
end.
{
$Log$
Revision 1.40 2002-01-06 21:47:32 peter
Revision 1.41 2002-01-24 18:25:49 peter
* implicit result variable generation for assembler routines
* removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
Revision 1.40 2002/01/06 21:47:32 peter
* removed getprocvar, use only getprocvardef
Revision 1.39 2001/12/06 17:57:38 florian

10
compiler/ptype.pas
View File

@ -218,8 +218,8 @@ implementation
old_object_option:=current_object_option;
current_object_option:=[sp_public];
storetypecanbeforward:=typecanbeforward;
{ for tp mode don't allow forward types }
if m_tp in aktmodeswitches then
{ for tp7 don't allow forward types }
if m_tp7 in aktmodeswitches then
typecanbeforward:=false;
read_var_decs(true,false,false);
consume(_END);
@ -612,7 +612,11 @@ implementation
end.
{
$Log$
Revision 1.33 2002-01-15 16:13:34 jonas
Revision 1.34 2002-01-24 18:25:49 peter
* implicit result variable generation for assembler routines
* removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
Revision 1.33 2002/01/15 16:13:34 jonas
* fixed web bugs 1758 and 1760
Revision 1.32 2002/01/06 12:08:15 peter

16
compiler/rautils.pas
View File

@ -728,8 +728,8 @@ Begin
{ replace by correct offset. }
if (not is_void(aktprocdef.rettype.def)) then
begin
if (procinfo^.return_offset=0) and ((m_tp in aktmodeswitches) or
(m_delphi in aktmodeswitches)) then
if (m_tp7 in aktmodeswitches) and
ret_in_acc(aktprocdef.rettype.def) then
begin
Message(asmr_e_cannot_use_RESULT_here);
exit;
@ -739,6 +739,9 @@ Begin
opr.ref.options:=ref_parafixup;
{ always assume that the result is valid. }
tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
{ increase reference count, this is also used to check
if the result variable is actually used or not }
inc(tfuncretsym(aktprocdef.funcretsym).refcount);
SetupResult:=true;
end
else
@ -806,7 +809,8 @@ Begin
register is still free, and loading it first is also
not possible, because this could break code }
{ Be TP/Delphi compatible in Delphi or TP modes }
if (m_tp in aktmodeswitches) then
if (m_tp7 in aktmodeswitches) or
(m_delphi in aktmodeswitches) then
begin
opr.typ:=OPR_CONSTANT;
opr.val:=tvarsym(sym).address;
@ -1581,7 +1585,11 @@ end;
end.
{
$Log$
Revision 1.25 2001-11-02 22:58:06 peter
Revision 1.26 2002-01-24 18:25:50 peter
* implicit result variable generation for assembler routines
* removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
Revision 1.25 2001/11/02 22:58:06 peter
* procsym definition rewrite
Revision 1.24 2001/09/02 21:18:28 peter

8
compiler/scanner.pas
View File

@ -1981,7 +1981,7 @@ implementation
'%' :
begin
if (m_tp in aktmodeswitches) then
if not(m_fpc in aktmodeswitches) then
Illegal_Char(c)
else
begin
@ -2656,7 +2656,11 @@ exit_label:
end.
{
$Log$
Revision 1.27 2001-10-22 20:25:49 peter
Revision 1.28 2002-01-24 18:25:50 peter
* implicit result variable generation for assembler routines
* removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
Revision 1.27 2001/10/22 20:25:49 peter
* fixed previous commit
Revision 1.26 2001/10/22 19:55:44 peter

12
compiler/symtable.pas
View File

@ -554,7 +554,7 @@ implementation
same name as the function, the function is then hidden for
the user. (Under delphi it can still be accessed using result),
but don't allow hiding of RESULT }
if (m_tp in aktmodeswitches) and
if (m_duplicate_names in aktmodeswitches) and
(hsym.typ=funcretsym) and
not((m_result in aktmodeswitches) and
(hsym.name='RESULT')) then
@ -1195,7 +1195,7 @@ implementation
begin
{ a parameter and the function can have the same
name in TP and Delphi, but RESULT not }
if (m_tp in aktmodeswitches) and
if (m_duplicate_names in aktmodeswitches) and
(sym.typ=funcretsym) and
not((m_result in aktmodeswitches) and
(sym.name='RESULT')) then
@ -1577,7 +1577,7 @@ implementation
{ Delphi you can have a symbol with the same name as the
unit, the unit can then not be accessed anymore using
<unit>.<id>, so we can hide the symbol }
if (m_tp in aktmodeswitches) and
if (m_duplicate_names in aktmodeswitches) and
(hsym.typ=symconst.unitsym) then
hsym.owner.rename(hsym.name,'hidden'+hsym.name)
else
@ -2023,7 +2023,11 @@ implementation
end.
{
$Log$
Revision 1.51 2001-12-31 16:59:43 peter
Revision 1.52 2002-01-24 18:25:50 peter
* implicit result variable generation for assembler routines
* removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
Revision 1.51 2001/12/31 16:59:43 peter
* protected/private symbols parsing fixed
Revision 1.50 2001/11/18 18:43:17 peter

8
compiler/types.pas
View File

@ -1239,7 +1239,7 @@ implementation
end
else
begin
b:=not(m_tp in aktmodeswitches) and
b:=not(m_tp7 in aktmodeswitches) and
not(m_delphi in aktmodeswitches) and
(tarraydef(def1).lowrange=tarraydef(def2).lowrange) and
(tarraydef(def1).highrange=tarraydef(def2).highrange) and
@ -1953,7 +1953,11 @@ implementation
end.
{
$Log$
Revision 1.63 2002-01-24 12:33:53 jonas
Revision 1.64 2002-01-24 18:25:53 peter
* implicit result variable generation for assembler routines
* removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
Revision 1.63 2002/01/24 12:33:53 jonas
* adapted ranges of native types to int64 (e.g. high cardinal is no
longer longint($ffffffff), but just $fffffff in psystem)
* small additional fix in 64bit rangecheck code generation for 32 bit