paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 15:49:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

* removed newn and disposen nodes, the code is now directly

Browse Source 
inlined from pexpr
  * -an option that will write the secondpass nodes to the .s file, this
    requires EXTDEBUG define to actually write the info
  * fixed various internal errors and crashes due recent code changes
This commit is contained in:
peter 2002-04-21 19:02:03 +00:00
parent 5ea6f2b824
commit 6320530bdd
20 changed files with 472 additions and 451 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
compiler/globtype.pas
View File

@ -122,7 +122,7 @@ interface
cs_gdb_dbx,cs_gdb_gsym,cs_gdb_heaptrc,cs_gdb_lineinfo,cs_checkpointer,
{ assembling }
cs_asm_leave,cs_asm_extern,cs_asm_pipe,cs_asm_source,
cs_asm_regalloc,cs_asm_tempalloc,
cs_asm_regalloc,cs_asm_tempalloc,cs_asm_nodes,
{ linking }
cs_link_extern,cs_link_static,cs_link_smart,cs_link_shared,cs_link_deffile,
cs_link_strip,cs_link_staticflag,cs_link_on_target
@ -253,7 +253,14 @@ implementation
end.
{
$Log$
Revision 1.21 2002-03-24 19:05:59 carl
Revision 1.22 2002-04-21 19:02:03 peter
* removed newn and disposen nodes, the code is now directly
inlined from pexpr
* -an option that will write the secondpass nodes to the .s file, this
requires EXTDEBUG define to actually write the info
* fixed various internal errors and crashes due recent code changes
Revision 1.21 2002/03/24 19:05:59 carl
+ patch for SPARC from Mazen NEIFER
Revision 1.20 2002/01/24 18:25:48 peter

16
compiler/i386/n386cal.pas
View File

@ -63,7 +63,7 @@ implementation
cginfo,cgbase,pass_2,
cpubase,
nmem,nld,ncnv,
tainst,cga,cgobj,tgobj,n386ld,n386util,regvars,rgobj,rgcpu,cg64f32,cgcpu;
tainst,cga,cgobj,tgobj,n386ld,n386util,ncgutil,regvars,rgobj,rgcpu,cg64f32,cgcpu;
{*****************************************************************************
TI386CALLPARANODE
@ -133,6 +133,11 @@ implementation
else if assigned(defcoll.paratype.def) and
(defcoll.paratype.def.deftype=formaldef) then
begin
{ allow passing of a constant to a const formaldef }
if (defcoll.paratyp=vs_const) and
(left.location.loc=LOC_CONSTANT) then
location_force_mem(left.location);
{ allow @var }
inc(pushedparasize,4);
if (left.nodetype=addrn) and
@ -1477,7 +1482,14 @@ begin
end.
{
$Log$
Revision 1.46 2002-04-21 15:34:25 carl
Revision 1.47 2002-04-21 19:02:07 peter
* removed newn and disposen nodes, the code is now directly
inlined from pexpr
* -an option that will write the secondpass nodes to the .s file, this
requires EXTDEBUG define to actually write the info
* fixed various internal errors and crashes due recent code changes
Revision 1.46 2002/04/21 15:34:25 carl
* changeregsize -> rg.makeregsize
Revision 1.45 2002/04/15 19:44:21 peter

19
compiler/i386/n386cnv.pas
View File

@ -249,7 +249,15 @@ implementation
end;
LOC_REGISTER,LOC_CREGISTER :
begin
cg.a_op_reg_reg(exprasmlist,OP_OR,left.location.size,left.location.register,left.location.register);
if left.location.size in [OS_64,OS_S64] then
begin
hregister:=cg.get_scratch_reg(exprasmlist);
cg.a_load_reg_reg(exprasmlist,OS_32,left.location.registerlow,hregister);
cg.a_op_reg_reg(exprasmlist,OP_OR,OS_32,left.location.registerhigh,hregister);
cg.free_scratch_reg(exprasmlist,hregister);
end
else
cg.a_op_reg_reg(exprasmlist,OP_OR,left.location.size,left.location.register,left.location.register);
end;
LOC_JUMP :
begin
@ -364,7 +372,14 @@ begin
end.
{
$Log$
Revision 1.36 2002-04-21 15:35:23 carl
Revision 1.37 2002-04-21 19:02:07 peter
* removed newn and disposen nodes, the code is now directly
inlined from pexpr
* -an option that will write the secondpass nodes to the .s file, this
requires EXTDEBUG define to actually write the info
* fixed various internal errors and crashes due recent code changes
Revision 1.36 2002/04/21 15:35:23 carl
* changeregsize -> rg.makeregsize
Revision 1.35 2002/04/19 15:39:35 peter

157
compiler/i386/n386mem.pas
View File

@ -30,18 +30,10 @@ interface
node,nmem,ncgmem;
type
ti386newnode = class(tnewnode)
procedure pass_2;override;
end;
ti386addrnode = class(tcgaddrnode)
procedure pass_2;override;
end;
ti386simplenewdisposenode = class(tsimplenewdisposenode)
procedure pass_2;override;
end;
ti386derefnode = class(tcgderefnode)
procedure pass_2;override;
end;
@ -64,54 +56,6 @@ implementation
cpuinfo,cpubase,
cgobj,cga,tgobj,rgobj,ncgutil,n386util;
{*****************************************************************************
TI386NEWNODE
*****************************************************************************}
procedure ti386newnode.pass_2;
var
pushed : tpushedsaved;
regstopush: tregisterset;
href : treference;
begin
if assigned(left) then
begin
secondpass(left);
location_copy(location,left.location);
end
else
begin
location_reset(location,LOC_REFERENCE,OS_ADDR);
regstopush := all_registers;
remove_non_regvars_from_loc(location,regstopush);
rg.saveusedregisters(exprasmlist,pushed,regstopush);
tg.gettempofsizereference(exprasmlist,pointer_size,location.reference);
{ determines the size of the mem block }
push_int(tpointerdef(resulttype.def).pointertype.def.size);
emit_push_lea_loc(location,false);
rg.saveregvars(exprasmlist,all_registers);
emitcall('FPC_GETMEM');
if tpointerdef(resulttype.def).pointertype.def.needs_inittable then
begin
reference_reset_symbol(href,tstoreddef(tpointerdef(resulttype.def).pointertype.def).get_rtti_label(initrtti),0);
emitpushreferenceaddr(href);
{ push pointer we just allocated, we need to initialize the
data located at that pointer not the pointer self (PFV) }
cg.a_param_loc(exprasmlist,location,1);
emitcall('FPC_INITIALIZE');
end;
rg.restoreusedregisters(exprasmlist,pushed);
{ may be load ESI }
maybe_loadself;
end;
end;
{*****************************************************************************
TI386ADDRNODE
*****************************************************************************}
@ -125,86 +69,6 @@ implementation
location.segment:=left.location.reference.segment;
end;
{*****************************************************************************
TI386SIMPLENEWDISPOSENODE
*****************************************************************************}
procedure ti386simplenewdisposenode.pass_2;
var
regstopush: tregisterset;
pushed : tpushedsaved;
href : treference;
lefttemp: treference;
left_needs_initfinal: boolean;
procedure saveleft;
begin
tg.gettempofsizereference(exprasmlist,pointer_size,lefttemp);
cg.a_load_loc_ref(exprasmlist,left.location,lefttemp);
location_release(exprasmlist,left.location);
end;
begin
secondpass(left);
if codegenerror then
exit;
left_needs_initfinal:=tpointerdef(left.resulttype.def).pointertype.def.needs_inittable;
regstopush := all_registers;
remove_non_regvars_from_loc(left.location,regstopush);
rg.saveusedregisters(exprasmlist,pushed,regstopush);
rg.saveregvars(exprasmlist,all_registers);
{ call the mem handling procedures }
case nodetype of
simpledisposen:
begin
if left_needs_initfinal then
begin
reference_reset_symbol(href,tstoreddef(tpointerdef(left.resulttype.def).pointertype.def).get_rtti_label(initrtti),0);
emitpushreferenceaddr(href);
{ push pointer adress }
cg.a_param_loc(exprasmlist,left.location,1);
{ save left and free its registers }
saveleft;
emitcall('FPC_FINALIZE');
{ push left again as parameter for freemem }
emit_push_mem(lefttemp);
tg.ungetiftemp(exprasmlist,lefttemp);
end
else
begin
cg.a_param_loc(exprasmlist,left.location,1);
location_release(exprasmlist,left.location);
end;
emitcall('FPC_FREEMEM');
end;
simplenewn:
begin
{ determines the size of the mem block }
push_int(tpointerdef(left.resulttype.def).pointertype.def.size);
emit_push_lea_loc(left.location,true);
{ save left and free its registers }
if left_needs_initfinal then
saveleft;
emitcall('FPC_GETMEM');
if left_needs_initfinal then
begin
reference_reset_symbol(href,tstoreddef(tpointerdef(left.resulttype.def).pointertype.def).get_rtti_label(initrtti),0);
emitpushreferenceaddr(href);
emit_push_mem(lefttemp);
tg.ungetiftemp(exprasmlist,lefttemp);
emitcall('FPC_INITIALIZE');
end;
end;
end;
rg.restoreusedregisters(exprasmlist,pushed);
{ may be load ESI }
maybe_loadself;
end;
{*****************************************************************************
TI386DEREFNODE
@ -219,11 +83,11 @@ implementation
if not tpointerdef(left.resulttype.def).is_far and
(cs_gdb_heaptrc in aktglobalswitches) and
(cs_checkpointer in aktglobalswitches) then
begin
emit_reg(
A_PUSH,S_L,location.reference.base);
emitcall('FPC_CHECKPOINTER');
end;
begin
emit_reg(
A_PUSH,S_L,location.reference.base);
emitcall('FPC_CHECKPOINTER');
end;
end;
@ -655,15 +519,20 @@ implementation
begin
cnewnode:=ti386newnode;
csimplenewdisposenode:=ti386simplenewdisposenode;
caddrnode:=ti386addrnode;
cderefnode:=ti386derefnode;
cvecnode:=ti386vecnode;
end.
{
$Log$
Revision 1.27 2002-04-20 21:37:07 carl
Revision 1.28 2002-04-21 19:02:07 peter
* removed newn and disposen nodes, the code is now directly
inlined from pexpr
* -an option that will write the secondpass nodes to the .s file, this
requires EXTDEBUG define to actually write the info
* fixed various internal errors and crashes due recent code changes
Revision 1.27 2002/04/20 21:37:07 carl
+ generic FPC_CHECKPOINTER
+ first parameter offset in stack now portable
* rename some constants

17
compiler/i386/n386set.pas
View File

@ -899,7 +899,13 @@ implementation
opsize:=bytes2Sxx[left.resulttype.def.size];
{ copy the case expression to a register }
location_force_reg(left.location,def_cgsize(left.resulttype.def),false);
hregister:=left.location.register;
if opsize=S_Q then
begin
hregister:=left.location.registerlow;
hregister2:=left.location.registerhigh;
end
else
hregister:=left.location.register;
if isjump then
begin
truelabel:=otl;
@ -1030,7 +1036,14 @@ begin
end.
{
$Log$
Revision 1.24 2002-04-21 15:37:26 carl
Revision 1.25 2002-04-21 19:02:07 peter
* removed newn and disposen nodes, the code is now directly
inlined from pexpr
* -an option that will write the secondpass nodes to the .s file, this
requires EXTDEBUG define to actually write the info
* fixed various internal errors and crashes due recent code changes
Revision 1.24 2002/04/21 15:37:26 carl
* changeregsize -> rg.makeregsize
Revision 1.23 2002/04/19 15:39:35 peter

64
compiler/nbas.pas
View File

@ -81,7 +81,6 @@ interface
{ refs and deletenode can hook to this copy once they get copied too }
hookoncopy : ptempinfo;
ref : treference;
size : longint;
restype : ttype;
valid : boolean;
end;
@ -91,6 +90,7 @@ interface
ttempcreatenode = class(tnode)
size: longint;
tempinfo: ptempinfo;
persistent: boolean;
{ * persistent temps are used in manually written code where the temp }
{ be usable among different statements and where you can manually say }
{ when the temp has to be freed (using a ttempdeletenode) }
@ -103,8 +103,6 @@ interface
function pass_1 : tnode; override;
function det_resulttype: tnode; override;
function docompare(p: tnode): boolean; override;
protected
persistent: boolean;
end;
ttempcreatenodeclass = class of ttempcreatenode;
@ -123,6 +121,9 @@ interface
{ a node which removes a temp }
ttempdeletenode = class(tnode)
constructor create(const temp: ttempcreatenode);
{ this will convert the persistant temp to a normal temp
for returning to the other nodes }
constructor create_normal_temp(const temp: ttempcreatenode);
function getcopy: tnode; override;
function pass_1: tnode; override;
function det_resulttype: tnode; override;
@ -130,6 +131,7 @@ interface
destructor destroy; override;
protected
tempinfo: ptempinfo;
release_to_normal : boolean;
end;
ttempdeletenodeclass = class of ttempdeletenode;
@ -143,6 +145,12 @@ interface
ctemprefnode : ttemprefnodeclass;
ctempdeletenode : ttempdeletenodeclass;
{ Create a blocknode and statement node for multiple statements
generated internally by the parser }
function internalstatements(var laststatement:tstatementnode):tblocknode;
procedure addstatement(var laststatement:tstatementnode;n:tnode);
implementation
uses
@ -153,6 +161,28 @@ implementation
ncal,nflw,rgobj,cgbase
;
{*****************************************************************************
Helpers
*****************************************************************************}
function internalstatements(var laststatement:tstatementnode):tblocknode;
begin
{ create dummy initial statement }
laststatement := cstatementnode.create(nil,cnothingnode.create);
internalstatements := cblocknode.create(laststatement);
end;
procedure addstatement(var laststatement:tstatementnode;n:tnode);
begin
if assigned(laststatement.left) then
internalerror(200204201);
laststatement.left:=cstatementnode.create(nil,n);
laststatement:=tstatementnode(laststatement.left);
end;
{*****************************************************************************
TFIRSTNOTHING
*****************************************************************************}
@ -239,6 +269,7 @@ implementation
firstpass(right);
if codegenerror then
exit;
location.loc:=right.location.loc;
registers32:=right.registers32;
registersfpu:=right.registersfpu;
{$ifdef SUPPORT_MMX}
@ -306,6 +337,11 @@ implementation
(tcallnode(hp.right).procdefinition.proctypeoption=potype_constructor)) and
not(is_void(hp.right.resulttype.def)) then
CGMessage(cg_e_illegal_expression);
{ the resulttype of the block is the last type that is
returned. Normally this is a voidtype. But when the
compiler inserts a block of multiple statements then the
last entry can return a value }
resulttype:=hp.right.resulttype;
end;
hp:=tstatementnode(hp.left);
end;
@ -389,6 +425,7 @@ implementation
if hp.registersmmx>registersmmx then
registersmmx:=hp.registersmmx;
{$endif}
location.loc:=hp.location.loc;
inc(count);
hp:=tstatementnode(hp.left);
end;
@ -456,7 +493,6 @@ implementation
new(tempinfo);
fillchar(tempinfo^,sizeof(tempinfo^),0);
tempinfo^.restype := _restype;
tempinfo^.size := _size;
persistent := _persistent;
end;
@ -470,7 +506,6 @@ implementation
new(n.tempinfo);
fillchar(n.tempinfo^,sizeof(n.tempinfo^),0);
n.tempinfo^.restype := tempinfo^.restype;
n.tempinfo^.size:=size;
{ signal the temprefs that the temp they point to has been copied, }
{ so that if the refs get copied as well, they can hook themselves }
@ -562,6 +597,16 @@ implementation
begin
inherited create(temprefn);
tempinfo := temp.tempinfo;
release_to_normal := false;
if not temp.persistent then
internalerror(200204211);
end;
constructor ttempdeletenode.create_normal_temp(const temp: ttempcreatenode);
begin
inherited create(temprefn);
tempinfo := temp.tempinfo;
release_to_normal := true;
end;
function ttempdeletenode.getcopy: tnode;
@ -620,7 +665,14 @@ begin
end.
{
$Log$
Revision 1.20 2002-04-04 19:05:57 peter
Revision 1.21 2002-04-21 19:02:03 peter
* removed newn and disposen nodes, the code is now directly
inlined from pexpr
* -an option that will write the secondpass nodes to the .s file, this
requires EXTDEBUG define to actually write the info
* fixed various internal errors and crashes due recent code changes
Revision 1.20 2002/04/04 19:05:57 peter
* removed unused units
* use tlocation.size in cg.a_*loc*() routines

24
compiler/ncgbas.pas
View File

@ -94,6 +94,8 @@ interface
begin
rg.cleartempgen;
secondpass(tstatementnode(hp).right);
{ Compiler inserted blocks can return values }
location_copy(location,tstatementnode(hp).right.location);
end;
hp:=tstatementnode(hp).left;
end;
@ -223,7 +225,11 @@ interface
begin
{ do second pass on left node }
if assigned(left) then
secondpass(left);
begin
secondpass(left);
{ Compiler inserted blocks can return values }
location_copy(location,left.location);
end;
end;
{*****************************************************************************
@ -255,7 +261,7 @@ interface
if not tempinfo^.valid then
internalerror(200108231);
{ set the temp's location }
location_reset(location,LOC_REFERENCE,int_cgsize(tempinfo^.size));
location_reset(location,LOC_REFERENCE,def_cgsize(tempinfo^.restype.def));
location.reference := tempinfo^.ref;
end;
@ -265,7 +271,10 @@ interface
procedure tcgtempdeletenode.pass_2;
begin
tg.ungetpersistanttempreference(exprasmlist,tempinfo^.ref);
if release_to_normal then
tg.persistanttemptonormal(tempinfo^.ref.offset)
else
tg.ungetpersistanttempreference(exprasmlist,tempinfo^.ref);
end;
@ -280,7 +289,14 @@ begin
end.
{
$Log$
Revision 1.12 2002-04-04 19:05:57 peter
Revision 1.13 2002-04-21 19:02:03 peter
* removed newn and disposen nodes, the code is now directly
inlined from pexpr
* -an option that will write the secondpass nodes to the .s file, this
requires EXTDEBUG define to actually write the info
* fixed various internal errors and crashes due recent code changes
Revision 1.12 2002/04/04 19:05:57 peter
* removed unused units
* use tlocation.size in cg.a_*loc*() routines

18
compiler/ncgcnv.pas
View File

@ -390,8 +390,15 @@ interface
begin
{ we reuse the old value }
location_copy(location,left.location);
{ Floats should never be returned as LOC_CONSTANT, do the
moving to memory before the new size is set }
if (resulttype.def.deftype=floatdef) and
(location.loc=LOC_CONSTANT) then
location_force_mem(location);
{ but use the new size, but we don't know the size of all arrays }
location.size:=def_cgsize(resulttype.def)
location.size:=def_cgsize(resulttype.def);
end;
@ -434,7 +441,14 @@ end.
{
$Log$
Revision 1.10 2002-04-19 15:39:34 peter
Revision 1.11 2002-04-21 19:02:03 peter
* removed newn and disposen nodes, the code is now directly
inlined from pexpr
* -an option that will write the secondpass nodes to the .s file, this
requires EXTDEBUG define to actually write the info
* fixed various internal errors and crashes due recent code changes
Revision 1.10 2002/04/19 15:39:34 peter
* removed some more routines from cga
* moved location_force_reg/mem to ncgutil
* moved arrayconstructnode secondpass to ncgld

10
compiler/ncgutil.pas
View File

@ -298,6 +298,7 @@ implementation
LOC_FPUREGISTER,
LOC_CFPUREGISTER :
begin
tg.gettempofsizereference(exprasmlist,TCGSize2Size[l.size],r);
cg.a_loadfpu_reg_ref(exprasmlist,l.size,l.register,r);
location_reset(l,LOC_REFERENCE,l.size);
l.reference:=r;
@ -382,7 +383,14 @@ end.
{
$Log$
Revision 1.9 2002-04-21 15:24:38 carl
Revision 1.10 2002-04-21 19:02:03 peter
* removed newn and disposen nodes, the code is now directly
inlined from pexpr
* -an option that will write the secondpass nodes to the .s file, this
requires EXTDEBUG define to actually write the info
* fixed various internal errors and crashes due recent code changes
Revision 1.9 2002/04/21 15:24:38 carl
+ a_jmp_cond -> a_jmp_always (a_jmp_cond is NOT portable)
+ changeregsize -> rg.makeregsize

17
compiler/ncnv.pas
View File

@ -1485,8 +1485,12 @@ implementation
if convtype=tc_equal then
begin
{ remove typeconv node if left is a const. For other nodes we can't
remove it because the secondpass can still depend on the old type (PFV) }
if is_constnode(left) then
remove it because the secondpass can still depend on the old type (PFV)
Conversions to float should also be left in the tree, because a float
is not possible in LOC_CONSTANT. The second_nothing routine will take
care of the conversion to LOC_REFERENCE }
if is_constnode(left) and
(resulttype.def.deftype<>floatdef) then
begin
left.resulttype:=resulttype;
result:=left;
@ -1701,7 +1705,14 @@ begin
end.
{
$Log$
Revision 1.51 2002-04-06 18:10:42 jonas
Revision 1.52 2002-04-21 19:02:03 peter
* removed newn and disposen nodes, the code is now directly
inlined from pexpr
* -an option that will write the secondpass nodes to the .s file, this
requires EXTDEBUG define to actually write the info
* fixed various internal errors and crashes due recent code changes
Revision 1.51 2002/04/06 18:10:42 jonas
* several powerpc-related additions and fixes
Revision 1.50 2002/04/04 19:05:58 peter

21
compiler/nld.pas
View File

@ -275,14 +275,12 @@ implementation
{ process methodpointer }
if assigned(left) then
begin
{ if only typenode then remove }
resulttypepass(left);
{ turn on the allowed flag, the secondpass
will handle the typen itself }
if left.nodetype=typen then
begin
left.free;
left:=nil;
end
else
resulttypepass(left);
ttypenode(left).allowed:=true;
end;
end;
else
@ -915,7 +913,14 @@ begin
end.
{
$Log$
Revision 1.34 2002-04-02 17:11:29 peter
Revision 1.35 2002-04-21 19:02:04 peter
* removed newn and disposen nodes, the code is now directly
inlined from pexpr
* -an option that will write the secondpass nodes to the .s file, this
requires EXTDEBUG define to actually write the info
* fixed various internal errors and crashes due recent code changes
Revision 1.34 2002/04/02 17:11:29 peter
* tlocation,treference update
* LOC_CONSTANT added for better constant handling
* secondadd splitted in multiple routines

176
compiler/nmem.pas
View File

@ -40,19 +40,13 @@ interface
tloadvmtnodeclass = class of tloadvmtnode;
thnewnode = class(tnode)
constructor create;virtual;
objtype : ttype;
constructor create(t:ttype);virtual;
function pass_1 : tnode;override;
function det_resulttype:tnode;override;
end;
thnewnodeclass = class of thnewnode;
tnewnode = class(tunarynode)
constructor create(l : tnode);virtual;
function pass_1 : tnode;override;
function det_resulttype:tnode;override;
end;
tnewnodeclass = class of tnewnode;
thdisposenode = class(tunarynode)
constructor create(l : tnode);virtual;
function pass_1 : tnode;override;
@ -60,13 +54,6 @@ interface
end;
thdisposenodeclass = class of thdisposenode;
tsimplenewdisposenode = class(tunarynode)
constructor create(n : tnodetype;l : tnode);
function pass_1 : tnode;override;
function det_resulttype:tnode;override;
end;
tsimplenewdisposenodeclass = class of tsimplenewdisposenode;
taddrnode = class(tunarynode)
getprocvardef : tprocvardef;
constructor create(l : tnode);virtual;
@ -130,9 +117,7 @@ interface
var
cloadvmtnode : tloadvmtnodeclass;
chnewnode : thnewnodeclass;
cnewnode : tnewnodeclass;
chdisposenode : thdisposenodeclass;
csimplenewdisposenode : tsimplenewdisposenodeclass;
caddrnode : taddrnodeclass;
cdoubleaddrnode : tdoubleaddrnodeclass;
cderefnode : tderefnodeclass;
@ -147,6 +132,7 @@ implementation
globtype,systems,
cutils,verbose,globals,
symconst,symbase,types,
nbas,
htypechk,pass_1,ncal,nld,ncon,ncnv,cgbase
;
@ -180,16 +166,19 @@ implementation
THNEWNODE
*****************************************************************************}
constructor thnewnode.create;
constructor thnewnode.create(t:ttype);
begin
inherited create(hnewn);
objtype:=t;
end;
function thnewnode.det_resulttype:tnode;
begin
result:=nil;
resulttype:=voidtype;
if objtype.def.deftype<>objectdef then
Message(parser_e_pointer_to_class_expected);
resulttype:=objtype;
end;
@ -199,100 +188,6 @@ implementation
end;
{*****************************************************************************
TNEWNODE
*****************************************************************************}
constructor tnewnode.create(l : tnode);
begin
inherited create(newn,l);
end;
function tnewnode.det_resulttype:tnode;
begin
result:=nil;
if assigned(left) then
resulttypepass(left);
resulttype:=voidtype;
end;
function tnewnode.pass_1 : tnode;
{$ifdef NEW_COMPILERPROC}
var
temp : ttempcreatenode;
newstatement : tstatementnode;
newblock : tblocknode;
{$endif NEW_COMPILERPROC}
begin
result:=nil;
{$ifdef NEW_COMPILERPROC}
{ create the blocknode which will hold the generated statements + }
{ an initial dummy statement }
newstatement := cstatementnode.create(nil,cnothingnode.create);
newblock := cblocknode.create(newstatement);
{ create temp for result }
temp := ctempcreatenode.create(resulttype,
resulttype.size,true);
newstatement.left := cstatementnode.create(nil,temp);
{ create parameter }
sizepara := ccallparanode.create(cordconstnode.create
(tpointerdef(resulttype.def).pointertype.def.size,s32bittype),nil);
{ create the call and assign the result to dest }
{ the assignment will take care of rangechecking }
newstatement.left := cstatementnode.create(nil,cassignmentnode.create(
ctemprefnode.create(tempcode),
ccallnode.createintern('fpc_getmem',sizepara)));
newstatement := tstatementnode(newstatement.left);
if tpointerdef(resulttype.def).pointertype.def.needs_inittable then
begin
para := ccallparanode.create(cloadnode.create
(tpointerdef(resulttype.def).pointertype.def.size,s32bittype),
ccallparanode.create(cordconstnode.create
(tpointerdef(resulttype.def).pointertype.def.size,s32bittype),nil));
newstatement.left := cstatementnode.create(nil,cassignmentnode.create(
ctemprefnode.create(tempcode),
ccallnode.createintern('fpc_initialize',sizepara)));
newstatement := tstatementnode(newstatement.left);
new(r);
reset_reference(r^);
r^.symbol:=tstoreddef(tpointerdef(resulttype.def).pointertype.def).get_rtti_label(initrtti);
emitpushreferenceaddr(r^);
dispose(r);
{ push pointer we just allocated, we need to initialize the
data located at that pointer not the pointer self (PFV) }
emit_push_loc(location);
emitcall('FPC_INITIALIZE');
end;
{ and return it }
result := newblock;
{$endif NEW_COMPILERPROC}
if assigned(left) then
begin
firstpass(left);
if codegenerror then
exit;
registers32:=left.registers32;
registersfpu:=left.registersfpu;
{$ifdef SUPPORT_MMX}
registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
location.loc:=LOC_REGISTER
end
else
location.loc:=LOC_REFERENCE;
procinfo^.flags:=procinfo^.flags or pi_do_call;
end;
{*****************************************************************************
THDISPOSENODE
*****************************************************************************}
@ -309,6 +204,8 @@ implementation
resulttypepass(left);
if codegenerror then
exit;
if (left.resulttype.def.deftype<>pointerdef) then
CGMessage1(type_e_pointer_type_expected,left.resulttype.def.typename);
resulttype:=tpointerdef(left.resulttype.def).pointertype;
end;
@ -337,48 +234,6 @@ implementation
end;
{*****************************************************************************
TSIMPLENEWDISPOSENODE
*****************************************************************************}
constructor tsimplenewdisposenode.create(n : tnodetype;l : tnode);
begin
inherited create(n,l);
end;
function tsimplenewdisposenode.det_resulttype:tnode;
begin
result:=nil;
resulttypepass(left);
if codegenerror then
exit;
if (left.resulttype.def.deftype<>pointerdef) then
CGMessage1(type_e_pointer_type_expected,left.resulttype.def.typename);
resulttype:=voidtype;
end;
function tsimplenewdisposenode.pass_1 : tnode;
begin
result:=nil;
{ this cannot be in a register !! }
make_not_regable(left);
firstpass(left);
if codegenerror then
exit;
registers32:=left.registers32;
registersfpu:=left.registersfpu;
{$ifdef SUPPORT_MMX}
registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
procinfo^.flags:=procinfo^.flags or pi_do_call;
end;
{*****************************************************************************
TADDRNODE
*****************************************************************************}
@ -1027,9 +882,7 @@ implementation
begin
cloadvmtnode := tloadvmtnode;
chnewnode := thnewnode;
cnewnode := tnewnode;
chdisposenode := thdisposenode;
csimplenewdisposenode := tsimplenewdisposenode;
caddrnode := taddrnode;
cdoubleaddrnode := tdoubleaddrnode;
cderefnode := tderefnode;
@ -1040,7 +893,14 @@ begin
end.
{
$Log$
Revision 1.28 2002-04-20 21:32:23 carl
Revision 1.29 2002-04-21 19:02:04 peter
* removed newn and disposen nodes, the code is now directly
inlined from pexpr
* -an option that will write the secondpass nodes to the .s file, this
requires EXTDEBUG define to actually write the info
* fixed various internal errors and crashes due recent code changes
Revision 1.28 2002/04/20 21:32:23 carl
+ generic FPC_CHECKPOINTER
+ first parameter offset in stack now portable
* rename some constants

17
compiler/node.pas
View File

@ -86,8 +86,6 @@ interface
typen, {A type name. Used for i.e. typeof(obj).}
hnewn, {The new operation, constructor call.}
hdisposen, {The dispose operation with destructor call.}
newn, {The new operation, constructor call.}
simpledisposen, {The dispose operation.}
setelementn, {A set element(s) (i.e. [a,b] and also [a..b]).}
setconstn, {A set constant (i.e. [1,2]).}
blockn, {A block of statements.}
@ -104,10 +102,8 @@ interface
casen, {A case statement.}
labeln, {A label.}
goton, {A goto statement.}
simplenewn, {The new operation.}
tryexceptn, {A try except block.}
raisen, {A raise statement.}
switchesn, {??? Currently unused...}
tryfinallyn, {A try finally statement.}
onn, { for an on statement in exception code }
isn, {Represents the is operator.}
@ -175,8 +171,6 @@ interface
'typen',
'hnewn',
'hdisposen',
'newn',
'simpledisposen',
'setelementn',
'setconstn',
'blockn',
@ -193,10 +187,8 @@ interface
'casen',
'labeln',
'goton',
'simplenewn',
'tryexceptn',
'raisen',
'switchesn',
'tryfinallyn',
'onn',
'isn',
@ -814,7 +806,14 @@ implementation
end.
{
$Log$
Revision 1.23 2002-04-06 18:13:01 jonas
Revision 1.24 2002-04-21 19:02:04 peter
* removed newn and disposen nodes, the code is now directly
inlined from pexpr
* -an option that will write the secondpass nodes to the .s file, this
requires EXTDEBUG define to actually write the info
* fixed various internal errors and crashes due recent code changes
Revision 1.23 2002/04/06 18:13:01 jonas
* several powerpc-related additions and fixes
Revision 1.22 2002/03/31 20:26:35 jonas

13
compiler/options.pas
View File

@ -382,6 +382,7 @@ begin
'l' : include(initglobalswitches,cs_asm_source);
'r' : include(initglobalswitches,cs_asm_regalloc);
't' : include(initglobalswitches,cs_asm_tempalloc);
'n' : include(initglobalswitches,cs_asm_nodes);
'-' : initglobalswitches:=initglobalswitches -
[cs_asm_leave, cs_asm_source,cs_asm_regalloc, cs_asm_tempalloc];
else
@ -1345,6 +1346,7 @@ begin
def_symbol('HAS_ADDR_STACK_ON_STACK');
def_symbol('NOBOUNDCHECK');
def_symbol('HASCOMPILERPROC');
def_symbol('VALUEGETMEM');
def_symbol('VALUEFREEMEM');
{ some stuff for TP compatibility }
@ -1379,7 +1381,7 @@ begin
else
internalerror(1295969);
end;
{ get default messagefile }
{$ifdef Delphi}
@ -1656,7 +1658,14 @@ finalization
end.
{
$Log$
Revision 1.68 2002-04-20 21:32:24 carl
Revision 1.69 2002-04-21 19:02:04 peter
* removed newn and disposen nodes, the code is now directly
inlined from pexpr
* -an option that will write the secondpass nodes to the .s file, this
requires EXTDEBUG define to actually write the info
* fixed various internal errors and crashes due recent code changes
Revision 1.68 2002/04/20 21:32:24 carl
+ generic FPC_CHECKPOINTER
+ first parameter offset in stack now portable
* rename some constants

116
compiler/pass_2.pas
View File

@ -47,7 +47,7 @@ procedure secondpass(var p : tnode);
implementation
uses
{$ifdef logsecondpass}
{$ifdef EXTDEBUG}
cutils,
{$endif}
globtype,systems,verbose,
@ -59,7 +59,7 @@ implementation
SecondPass
*****************************************************************************}
{$ifdef logsecondpass}
{$ifdef EXTDEBUG}
procedure logsecond(ht:tnodetype; entry: boolean);
const
secondnames: array[tnodetype] of string[13] =
@ -92,9 +92,8 @@ implementation
'ordconst', {ordconstn}
'typeconv', {typeconvn}
'calln', {calln}
'nothing-callp', {callparan}
'noth-callpar', {callparan}
'realconst', {realconstn}
'fixconst', {fixconstn}
'unaryminus', {unaryminusn}
'asm', {asmn}
'vecn', {vecn}
@ -109,8 +108,6 @@ implementation
'nothing-typen', {typen}
'hnewn', {hnewn}
'hdisposen', {hdisposen}
'newn', {newn}
'simplenewDISP', {simpledisposen}
'setelement', {setelementn}
'setconst', {setconstn}
'blockn', {blockn}
@ -127,22 +124,25 @@ implementation
'case', {casen}
'label', {labeln}
'goto', {goton}
'simpleNEWdisp', {simplenewn}
'tryexcept', {tryexceptn}
'raise', {raisen}
'nothing-swtch', {switchesn}
'tryfinally', {tryfinallyn}
'on', {onn}
'is', {isn}
'as', {asn}
'error-caret', {caretn}
'fail', {failn}
'add-startstar', {starstarn}
'add-starstar', {starstarn}
'procinline', {procinlinen}
'arrayconstruc', {arrayconstructn}
'noth-arrcnstr', {arrayconstructrangen}
'tempn',
'temprefn',
'addoptn',
'nothing-nothg', {nothingn}
'loadvmt' {loadvmtn}
'loadvmt', {loadvmtn}
'guidconstn',
'rttin'
);
var
p: pchar;
@ -153,7 +153,7 @@ implementation
p := strpnew('second'+secondnames[ht]+' (exit)');
exprasmlist.concat(tai_asm_comment.create(p));
end;
{$endif logsecondpass}
{$endif EXTDEBUG}
procedure secondpass(var p : tnode);
var
@ -184,15 +184,13 @@ implementation
{$ifdef EXTDEBUG}
oldloc:=p.location.loc;
p.location.loc:=LOC_INVALID;
if (cs_asm_nodes in aktglobalswitches) then
logsecond(p.nodetype,true);
{$endif EXTDEBUG}
{$ifdef logsecondpass}
logsecond(p.nodetype,true);
{$endif logsecondpass}
p.pass_2;
{$ifdef logsecondpass}
logsecond(p.nodetype,false);
{$endif logsecondpass}
{$ifdef EXTDEBUG}
if (cs_asm_nodes in aktglobalswitches) then
logsecond(p.nodetype,false);
if (not codegenerror) and
(oldloc<>LOC_INVALID) and
(p.location.loc=LOC_INVALID) then
@ -256,48 +254,51 @@ implementation
{ only do secondpass if there are no errors }
if ErrorCount=0 then
begin
{$ifdef OMITSTACKFRAME}
if (cs_regalloc in aktglobalswitches) and
((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
begin
{ can we omit the stack frame ? }
{ conditions:
1. procedure (not main block)
2. no constructor or destructor
3. no call to other procedures
4. no interrupt handler
}
{!!!!!! this doesn work yet, because of problems with
with linux and windows
}
(*
if assigned(aktprocsym) then
begin
if not(assigned(procinfo^._class)) and
not(aktprocdef.proctypeoption in [potype_constructor,potype_destructor]) and
not(po_interrupt in aktprocdef.procoptions) and
((procinfo^.flags and pi_do_call)=0) and
(lexlevel>=normal_function_level) then
begin
{ use ESP as frame pointer }
procinfo^.framepointer:=STACK_POINTER_REG;
use_esp_stackframe:=true;
{ can we omit the stack frame ? }
{ conditions:
1. procedure (not main block)
2. no constructor or destructor
3. no call to other procedures
4. no interrupt handler
}
{!!!!!! this doesn work yet, because of problems with
with linux and windows
}
(*
if assigned(aktprocsym) then
begin
if not(assigned(procinfo^._class)) and
not(aktprocdef.proctypeoption in [potype_constructor,potype_destructor]) and
not(po_interrupt in aktprocdef.procoptions) and
((procinfo^.flags and pi_do_call)=0) and
(lexlevel>=normal_function_level) then
begin
{ use ESP as frame pointer }
procinfo^.framepointer:=STACK_POINTER_REG;
use_esp_stackframe:=true;
{ calc parameter distance new }
dec(procinfo^.framepointer_offset,4);
dec(procinfo^.selfpointer_offset,4);
{ calc parameter distance new }
dec(procinfo^.framepointer_offset,4);
dec(procinfo^.selfpointer_offset,4);
{ is this correct ???}
{ retoffset can be negativ for results in eax !! }
{ the value should be decreased only if positive }
if procinfo^.retoffset>=0 then
dec(procinfo^.retoffset,4);
{ is this correct ???}
{ retoffset can be negativ for results in eax !! }
{ the value should be decreased only if positive }
if procinfo^.retoffset>=0 then
dec(procinfo^.retoffset,4);
dec(procinfo^.para_offset,4);
aktprocdef.parast.address_fixup:=procinfo^.para_offset;
end;
end;
*)
end;
{$endif OMITSTACKFRAME}
dec(procinfo^.para_offset,4);
aktprocdef.parast.address_fixup:=procinfo^.para_offset;
end;
end;
*)
end;
{ process register variable stuff (JM) }
assign_regvars(p);
load_regvars(procinfo^.aktentrycode,p);
@ -320,7 +321,14 @@ implementation
end.
{
$Log$
Revision 1.25 2002-04-20 21:32:24 carl
Revision 1.26 2002-04-21 19:02:04 peter
* removed newn and disposen nodes, the code is now directly
inlined from pexpr
* -an option that will write the secondpass nodes to the .s file, this
requires EXTDEBUG define to actually write the info
* fixed various internal errors and crashes due recent code changes
Revision 1.25 2002/04/20 21:32:24 carl
+ generic FPC_CHECKPOINTER
+ first parameter offset in stack now portable
* rename some constants

10
compiler/pdecobj.pas
View File

@ -794,6 +794,7 @@ implementation
p:=comp_expr(true);
if p.nodetype=stringconstn then
begin
stringdispose(aktclass.iidstr);
aktclass.iidstr:=stringdup(strpas(tstringconstnode(p).value_str)); { or upper? }
p.free;
aktclass.isiidguidvalid:=string2guid(aktclass.iidstr^,aktclass.iidguid);
@ -1110,7 +1111,14 @@ implementation
end.
{
$Log$
Revision 1.40 2002-04-19 15:46:02 peter
Revision 1.41 2002-04-21 19:02:04 peter
* removed newn and disposen nodes, the code is now directly
inlined from pexpr
* -an option that will write the secondpass nodes to the .s file, this
requires EXTDEBUG define to actually write the info
* fixed various internal errors and crashes due recent code changes
Revision 1.40 2002/04/19 15:46:02 peter
* mangledname rewrite, tprocdef.mangledname is now created dynamicly
in most cases and not written to the ppu
* add mangeledname_prefix() routine to generate the prefix of

61
compiler/pdecsub.pas
View File

@ -329,7 +329,6 @@ implementation
orgsp,sp:stringid;
paramoffset:longint;
sym:tsym;
doinsert : boolean;
st : tsymtable;
srsymtable : tsymtable;
pdl : pprocdeflist;
@ -478,7 +477,6 @@ implementation
end;
end;
doinsert:=true;
if assigned(aktprocsym) then
begin
{ Check if overloaded is a procsym }
@ -498,8 +496,9 @@ implementation
Message1(parser_e_overloaded_no_procedure,aktprocsym.realname)
else
DuplicateSym(aktprocsym);
{ don't reinsert as that will generated another error }
doinsert:=false;
{ rename the name to an unique name to avoid an
error when inserting the symbol in the symtable }
orgsp:=orgsp+'$'+tostr(aktfilepos.line);
end;
{ generate a new aktprocsym }
aktprocsym:=nil;
@ -537,8 +536,7 @@ implementation
end
else
aktprocsym:=tprocsym.create(orgsp);
if doinsert then
symtablestack.insert(aktprocsym);
symtablestack.insert(aktprocsym);
end;
st:=symtablestack;
@ -1908,23 +1906,31 @@ const
{ insert otsym only in the right symtable }
if ((procinfo^.flags and pi_operator)<>0) and
assigned(otsym) and
not parse_only then
begin
if ret_in_param(aprocdef.rettype.def) then
begin
aprocdef.parast.insert(otsym);
{ this increases the data size }
{ correct this to get the right ret $value }
dec(aprocdef.parast.datasize,
align(otsym.getpushsize,aktprocdef.parast.dataalignment));
{ this allows to read the funcretoffset }
otsym.address:=-4;
otsym.varspez:=vs_var;
end
else
aprocdef.localst.insert(otsym);
end;
assigned(otsym) then
begin
if not parse_only then
begin
if ret_in_param(aprocdef.rettype.def) then
begin
aprocdef.parast.insert(otsym);
{ this increases the data size }
{ correct this to get the right ret $value }
dec(aprocdef.parast.datasize,
align(otsym.getpushsize,aktprocdef.parast.dataalignment));
{ this allows to read the funcretoffset }
otsym.address:=-4;
otsym.varspez:=vs_var;
end
else
aprocdef.localst.insert(otsym);
end
else
begin
{ this is not required anymore }
otsym.free;
otsym:=nil;
end;
end;
proc_add_definition:=forwardfound;
end;
@ -1932,7 +1938,14 @@ const
end.
{
$Log$
Revision 1.52 2002-04-20 21:32:24 carl
Revision 1.53 2002-04-21 19:02:04 peter
* removed newn and disposen nodes, the code is now directly
inlined from pexpr
* -an option that will write the secondpass nodes to the .s file, this
requires EXTDEBUG define to actually write the info
* fixed various internal errors and crashes due recent code changes
Revision 1.52 2002/04/20 21:32:24 carl
+ generic FPC_CHECKPOINTER
+ first parameter offset in stack now portable
* rename some constants

126
compiler/pexpr.pas
View File

@ -220,6 +220,9 @@ implementation
function new_dispose_statement(is_new:boolean) : tnode;
var
newstatement : tstatementnode;
temp : ttempcreatenode;
para : tcallparanode;
p,p2 : tnode;
again : boolean; { dummy for do_proc_call }
destructorname : stringid;
@ -293,11 +296,10 @@ implementation
else
begin
if is_new then
p2:=chnewnode.create
p2:=chnewnode.create(tpointerdef(p.resulttype.def).pointertype)
else
p2:=chdisposenode.create(p);
do_resulttypepass(p2);
p2.resulttype:=tpointerdef(p.resulttype.def).pointertype;
if is_new then
do_member_read(false,sym,p2,again)
else
@ -329,8 +331,6 @@ implementation
begin
if (tcallnode(p2).procdefinition.proctypeoption<>potype_constructor) then
Message(parser_e_expr_have_to_be_constructor_call);
p2:=cnewnode.create(p2);
do_resulttypepass(p2);
p2.resulttype:=p.resulttype;
p2:=cassignmentnode.create(p,p2);
end
@ -365,10 +365,57 @@ implementation
Message(parser_e_no_new_dispose_on_void_pointers);
end;
{ create statements with call to getmem+initialize or
finalize+freemem }
new_dispose_statement:=internalstatements(newstatement);
if is_new then
new_dispose_statement:=csimplenewdisposenode.create(simplenewn,p)
begin
{ create temp for result }
temp := ctempcreatenode.create(p.resulttype,p.resulttype.def.size,true);
addstatement(newstatement,temp);
{ create call to fpc_getmem }
para := ccallparanode.create(cordconstnode.create
(tpointerdef(p.resulttype.def).pointertype.def.size,s32bittype),nil);
addstatement(newstatement,cassignmentnode.create(
ctemprefnode.create(temp),
ccallnode.createintern('fpc_getmem',para)));
{ create call to fpc_initialize }
if tpointerdef(p.resulttype.def).pointertype.def.needs_inittable then
begin
para := ccallparanode.create(caddrnode.create(crttinode.create(
tstoreddef(tpointerdef(p.resulttype.def).pointertype.def),initrtti)),
ccallparanode.create(ctemprefnode.create
(temp),nil));
addstatement(newstatement,ccallnode.createintern('fpc_initialize',para));
end;
{ copy the temp to the destination }
addstatement(newstatement,cassignmentnode.create(
p,
ctemprefnode.create(temp)));
{ release temp }
addstatement(newstatement,ctempdeletenode.create(temp));
end
else
new_dispose_statement:=csimplenewdisposenode.create(simpledisposen,p);
begin
{ create call to fpc_finalize }
if tpointerdef(p.resulttype.def).pointertype.def.needs_inittable then
begin
{ we need to use a copy of p here }
para := ccallparanode.create(caddrnode.create(crttinode.create
(tstoreddef(tpointerdef(p.resulttype.def).pointertype.def),initrtti)),
ccallparanode.create(p.getcopy,nil));
addstatement(newstatement,ccallnode.createintern('fpc_finalize',para));
end;
{ create call to fpc_freemem }
para := ccallparanode.create(p,nil);
addstatement(newstatement,ccallnode.createintern('fpc_freemem',para));
end;
end;
end;
consume(_RKLAMMER);
@ -377,6 +424,10 @@ implementation
function new_function : tnode;
var
newstatement : tstatementnode;
newblock : tblocknode;
temp : ttempcreatenode;
para : tcallparanode;
p1,p2 : tnode;
classh : tobjectdef;
sym : tsym;
@ -399,26 +450,52 @@ implementation
begin
if (tpointerdef(p1.resulttype.def).pointertype.def.deftype=objectdef) and
(oo_has_vmt in tobjectdef(tpointerdef(p1.resulttype.def).pointertype.def).objectoptions) then
Message(parser_w_use_extended_syntax_for_objects);
p2:=cnewnode.create(nil);
do_resulttypepass(p2);
p2.resulttype:=p1.resulttype;
Message(parser_w_use_extended_syntax_for_objects);
{ create statements with call to getmem+initialize }
newblock:=internalstatements(newstatement);
{ create temp for result }
temp := ctempcreatenode.create(p1.resulttype,p1.resulttype.def.size,true);
addstatement(newstatement,temp);
{ create call to fpc_getmem }
para := ccallparanode.create(cordconstnode.create
(tpointerdef(p1.resulttype.def).pointertype.def.size,s32bittype),nil);
addstatement(newstatement,cassignmentnode.create(
ctemprefnode.create(temp),
ccallnode.createintern('fpc_getmem',para)));
{ create call to fpc_initialize }
if tpointerdef(p1.resulttype.def).pointertype.def.needs_inittable then
begin
para := ccallparanode.create(caddrnode.create(crttinode.create
(tstoreddef(tpointerdef(p1.resulttype.def).pointertype.def),initrtti)),
ccallparanode.create(ctemprefnode.create
(temp),nil));
addstatement(newstatement,ccallnode.createintern('fpc_initialize',para));
end;
{ the last statement should return the value as
location and type, this is done be referencing the
temp and converting it first from a persistent temp to
normal temp }
addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
addstatement(newstatement,ctemprefnode.create(temp));
p1.destroy;
p1:=p2;
p1:=newblock;
consume(_RKLAMMER);
end
else
begin
p2:=chnewnode.create;
p2:=chnewnode.create(tpointerdef(p1.resulttype.def).pointertype);
do_resulttypepass(p2);
p2.resulttype:=tpointerdef(p1.resulttype.def).pointertype;
consume(_COMMA);
afterassignment:=false;
{ determines the current object defintion }
classh:=tobjectdef(p2.resulttype.def);
if classh.deftype<>objectdef then
Message(parser_e_pointer_to_class_expected)
else
if classh.deftype=objectdef then
begin
{ check for an abstract class }
if (oo_has_abstract in classh.objectoptions) then
@ -434,9 +511,11 @@ implementation
(assigned(tcallnode(p2).procdefinition) and
(tcallnode(p2).procdefinition.proctypeoption<>potype_constructor)) then
Message(parser_e_expr_have_to_be_constructor_call);
end;
p2:=cnewnode.create(p2);
do_resulttypepass(p2);
end
else
Message(parser_e_pointer_to_class_expected);
{ constructors return boolean, update resulttype to return
the pointer to the object }
p2.resulttype:=p1.resulttype;
p1.destroy;
p1:=p2;
@ -2458,7 +2537,14 @@ implementation
end.
{
$Log$
Revision 1.62 2002-04-16 16:11:17 peter
Revision 1.63 2002-04-21 19:02:05 peter
* removed newn and disposen nodes, the code is now directly
inlined from pexpr
* -an option that will write the secondpass nodes to the .s file, this
requires EXTDEBUG define to actually write the info
* fixed various internal errors and crashes due recent code changes
Revision 1.62 2002/04/16 16:11:17 peter
* using inherited; without a parent having the same function
will do nothing like delphi

19
compiler/pstatmnt.pas
View File

@ -991,8 +991,8 @@ implementation
{ blockn support because a read/write is changed into a blocknode }
{ with a separate statement for each read/write operation (JM) }
{ the same is true for val() if the third parameter is not 32 bit }
if not(p.nodetype in [nothingn,calln,assignn,breakn,inlinen,continuen,labeln,blockn,
simplenewn,simpledisposen]) then
if not(p.nodetype in [nothingn,calln,assignn,breakn,inlinen,
continuen,labeln,blockn]) then
Message(cg_e_illegal_expression);
{ specify that we don't use the value returned by the call }
@ -1071,7 +1071,7 @@ implementation
{# Optimize the assembler block by removing all references
which are via the frame pointer by replacing them with
references via the stack pointer.
This is only available to certain cpu targets where
the frame pointer saving must be done explicitly.
}
@ -1178,8 +1178,8 @@ implementation
following conditions are met:
- if the are no local variables
- no reference to the result variable (refcount<=1)
- result is not stored as parameter
- target processor has optional frame pointer save
- result is not stored as parameter
- target processor has optional frame pointer save
(vm, i386, vm only currently)
}
if (po_assembler in aktprocdef.procoptions) and
@ -1213,7 +1213,14 @@ implementation
end.
{
$Log$
Revision 1.53 2002-04-20 21:32:24 carl
Revision 1.54 2002-04-21 19:02:05 peter
* removed newn and disposen nodes, the code is now directly
inlined from pexpr
* -an option that will write the secondpass nodes to the .s file, this
requires EXTDEBUG define to actually write the info
* fixed various internal errors and crashes due recent code changes
Revision 1.53 2002/04/20 21:32:24 carl
+ generic FPC_CHECKPOINTER
+ first parameter offset in stack now portable
* rename some constants

11
compiler/symdef.pas
View File

@ -745,6 +745,8 @@ implementation
prefix : string;
begin
prefix:='';
if not assigned(st) then
internalerror(200204212);
{ sub procedures }
while (st.symtabletype=localsymtable) do
begin
@ -5468,7 +5470,14 @@ implementation
end.
{
$Log$
Revision 1.72 2002-04-20 21:32:25 carl
Revision 1.73 2002-04-21 19:02:05 peter
* removed newn and disposen nodes, the code is now directly
inlined from pexpr
* -an option that will write the secondpass nodes to the .s file, this
requires EXTDEBUG define to actually write the info
* fixed various internal errors and crashes due recent code changes
Revision 1.72 2002/04/20 21:32:25 carl
+ generic FPC_CHECKPOINTER
+ first parameter offset in stack now portable
* rename some constants