paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 11:45:32 +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

11
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 }
@ -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

13
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 }
@ -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