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

* var:=new(pointer_type) support added

Browse Source
This commit is contained in:
pierre 1998-11-25 19:12:51 +00:00
parent b661b37184
commit 4201ea4903
4 changed files with 113 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
compiler/cg386mem.pas
View File

@ -75,11 +75,45 @@ implementation
*****************************************************************************}
procedure secondnewn(var p : ptree);
var
pushed : tpushed;
r : preference;
begin
secondpass(p^.left);
if assigned(p^.left) then
begin
secondpass(p^.left);
p^.location.register:=p^.left^.location.register;
end
else
begin
pushusedregisters(pushed,$ff);
{ code copied from simplenewdispose PM }
{ determines the size of the mem block }
push_int(ppointerdef(p^.resulttype)^.definition^.size);
gettempofsizereference(target_os.size_of_pointer,p^.location.reference);
emitpushreferenceaddr(exprasmlist,p^.location.reference);
emitcall('FPC_GETMEM',true);
if ppointerdef(p^.resulttype)^.definition^.needs_inittable then
begin
new(r);
reset_reference(r^);
r^.symbol:=stringdup(lab2str(ppointerdef(p^.left^.resulttype)^.definition^.get_inittable_label));
emitpushreferenceaddr(exprasmlist,r^);
{ push pointer adress }
emitpushreferenceaddr(exprasmlist,p^.location.reference);
stringdispose(r^.symbol);
dispose(r);
emitcall('FPC_INITIALIZE',true);
end;
popusedregisters(pushed);
{ may be load ESI }
maybe_loadesi;
end;
if codegenerror then
exit;
p^.location.register:=p^.left^.location.register;
end;
@ -157,6 +191,8 @@ implementation
LOC_REFERENCE:
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
end;
stringdispose(r^.symbol);
dispose(r);
emitcall('FPC_FINALIZE',true);
end;
emitcall('FPC_FREEMEM',true);
@ -177,6 +213,8 @@ implementation
LOC_REFERENCE:
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
end;
stringdispose(r^.symbol);
dispose(r);
emitcall('FPC_INITIALIZE',true);
end;
end;
@ -702,7 +740,10 @@ implementation
end.
{
$Log$
Revision 1.19 1998-11-20 15:35:55 florian
Revision 1.20 1998-11-25 19:12:54 pierre
* var:=new(pointer_type) support added
Revision 1.19 1998/11/20 15:35:55 florian
* problems with rtti fixed, hope it works
Revision 1.18 1998/11/17 00:36:40 peter

44
compiler/cg68kmem.pas
View File

@ -77,11 +77,46 @@ implementation
*****************************************************************************}
procedure secondnewn(var p : ptree);
var
pushed : tpushed;
r : preference;
begin
secondpass(p^.left);
if assigned(p^.left) then
begin
secondpass(p^.left);
p^.location.register:=p^.left^.location.register;
end
else
begin
pushusedregisters(pushed,$ff);
{ code copied from simplenewdispose PM }
{ determines the size of the mem block }
push_int(ppointerdef(p^.resulttype)^.definition^.size);
gettempofsizereference(target_os.size_of_pointer,p^.location.reference);
emitpushreferenceaddr(exprasmlist,p^.location.reference);
emitcall('FPC_GETMEM',true);
{!!!!!!!}
(* if ppointerdef(p^.resulttype)^.definition^.needs_inittable then
begin
new(r);
reset_reference(r^);
r^.symbol:=stringdup(lab2str(ppointerdef(p^.left^.resulttype)^.definition^.get_inittable_label));
emitpushreferenceaddr(exprasmlist,r^);
{ push pointer adress }
emitpushreferenceaddr(exprasmlist,p^.location.reference);
stringdispose(r^.symbol);
dispose(r);
emitcall('FPC_INITIALIZE',true);
end; *)
popusedregisters(pushed);
{ may be load ESI }
maybe_loada5;
end;
if codegenerror then
exit;
p^.location.register:=p^.left^.location.register;
end;
@ -689,7 +724,10 @@ implementation
end.
{
$Log$
Revision 1.8 1998-10-14 11:28:21 florian
Revision 1.9 1998-11-25 19:12:55 pierre
* var:=new(pointer_type) support added
Revision 1.8 1998/10/14 11:28:21 florian
* emitpushreferenceaddress gets now the asmlist as parameter
* m68k version compiles with -duseansistrings

17
compiler/pexpr.pas
View File

@ -1420,10 +1420,14 @@ unit pexpr;
pd:=p1^.typenodetype;
pd2:=pd;
if (pd^.deftype<>pointerdef) or
(ppointerdef(pd)^.definition^.deftype<>objectdef) then
if (pd^.deftype<>pointerdef) then
Message(type_e_pointer_type_expected)
else if (ppointerdef(pd)^.definition^.deftype<>objectdef) then
begin
Message(parser_e_pointer_to_class_expected);
p1:=gensinglenode(newn,nil);
p1^.resulttype:=pd2;
consume(RKLAMMER);
(*Message(parser_e_pointer_to_class_expected);
{ if an error occurs, read til the end of
the new statement }
p1:=genzeronode(errorn);
@ -1437,7 +1441,7 @@ unit pexpr;
consume(token);
if l=0 then
break;
end;
end;*)
end
else
begin
@ -1904,7 +1908,10 @@ unit pexpr;
end.
{
$Log$
Revision 1.74 1998-11-13 10:18:11 peter
Revision 1.75 1998-11-25 19:12:51 pierre
* var:=new(pointer_type) support added
Revision 1.74 1998/11/13 10:18:11 peter
+ nil constants
Revision 1.73 1998/11/05 12:02:52 peter

22
compiler/tcmem.pas
View File

@ -81,18 +81,25 @@ implementation
procedure firstnew(var p : ptree);
begin
{ Standardeinleitung }
firstpass(p^.left);
if assigned(p^.left) then
firstpass(p^.left);
if codegenerror then
exit;
p^.registers32:=p^.left^.registers32;
p^.registersfpu:=p^.left^.registersfpu;
if assigned(p^.left) then
begin
p^.registers32:=p^.left^.registers32;
p^.registersfpu:=p^.left^.registersfpu;
{$ifdef SUPPORT_MMX}
p^.registersmmx:=p^.left^.registersmmx;
p^.registersmmx:=p^.left^.registersmmx;
{$endif SUPPORT_MMX}
end;
{ result type is already set }
procinfo.flags:=procinfo.flags or pi_do_call;
p^.location.loc:=LOC_REGISTER;
if assigned(p^.left) then
p^.location.loc:=LOC_REGISTER
else
p^.location.loc:=LOC_REFERENCE;
end;
@ -500,7 +507,10 @@ implementation
end.
{
$Log$
Revision 1.3 1998-09-26 15:03:05 florian
Revision 1.4 1998-11-25 19:12:53 pierre
* var:=new(pointer_type) support added
Revision 1.3 1998/09/26 15:03:05 florian
* small problems with DOM and excpetions fixed (code generation
of raise was wrong and self was sometimes destroyed :()