* freemem change to value parameter

* torddef low/high range changed to int64
This commit is contained in:
peter 2001-12-03 21:48:41 +00:00
parent 346c2a9ed1
commit e45bb82d81
9 changed files with 164 additions and 33 deletions

View File

@ -157,7 +157,7 @@ implementation
emit_push_loc(left.location);
emitcall('FPC_FINALIZE');
end;
emit_push_lea_loc(left.location,true);
emit_push_loc(left.location);
emitcall('FPC_FREEMEM');
end;
simplenewn:
@ -701,7 +701,11 @@ begin
end.
{
$Log$
Revision 1.17 2001-09-30 16:17:17 jonas
Revision 1.18 2001-12-03 21:48:43 peter
* freemem change to value parameter
* torddef low/high range changed to int64
Revision 1.17 2001/09/30 16:17:17 jonas
* made most constant and mem handling processor independent
Revision 1.16 2001/08/30 20:13:57 peter

View File

@ -853,8 +853,9 @@ implementation
end;
var
lv,hv,
max_label: tconstexprint;
lv,hv,labels : longint;
labels : longint;
max_linear_list : longint;
otl, ofl: tasmlabel;
{$ifdef Delphi}
@ -1091,7 +1092,11 @@ begin
end.
{
$Log$
Revision 1.17 2001-09-04 11:38:55 jonas
Revision 1.18 2001-12-03 21:48:43 peter
* freemem change to value parameter
* torddef low/high range changed to int64
Revision 1.17 2001/09/04 11:38:55 jonas
+ searchsystype() and searchsystype() functions in symtable
* changed ninl and nadd to use these functions
* i386 set comparison functions now return their results in al instead

View File

@ -60,7 +60,7 @@ implementation
uses
globtype,globals,systems,verbose,
cutils,
aasm,cpubase,cpuasm,
aasm,cpubase,cpuasm,cpuinfo,
symconst,symbase,symdef,symsym,symtable,
{$ifdef GDB}
gdb,
@ -1115,7 +1115,7 @@ implementation
op : tasmop;
fromdef : tdef;
lto,hto,
lfrom,hfrom : longint;
lfrom,hfrom : TConstExprInt;
is_reg : boolean;
begin
{ range checking on and range checkable value? }
@ -1544,7 +1544,11 @@ implementation
end.
{
$Log$
Revision 1.23 2001-12-02 16:19:17 jonas
Revision 1.24 2001-12-03 21:48:43 peter
* freemem change to value parameter
* torddef low/high range changed to int64
Revision 1.23 2001/12/02 16:19:17 jonas
* less unnecessary regvar loading with if-statements
Revision 1.22 2001/10/12 13:51:52 jonas

View File

@ -229,8 +229,8 @@ implementation
end;
var
l : longint;
lr,hr : longint;
l : Longint;
lr,hr : TConstExprInt;
begin
new(constset);
@ -1618,7 +1618,11 @@ begin
end.
{
$Log$
Revision 1.44 2001-11-02 23:24:11 jonas
Revision 1.45 2001-12-03 21:48:41 peter
* freemem change to value parameter
* torddef low/high range changed to int64
Revision 1.44 2001/11/02 23:24:11 jonas
* fixed web bug 1665 (allow char to chararray type conversion) ("merged")
Revision 1.43 2001/11/02 22:58:02 peter

View File

@ -219,8 +219,61 @@ implementation
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);
@ -317,10 +370,6 @@ implementation
if codegenerror then
exit;
if (left.location.loc<>LOC_REFERENCE) {and
(left.location.loc<>LOC_CREGISTER)} then
CGMessage(cg_e_illegal_expression);
registers32:=left.registers32;
registersfpu:=left.registersfpu;
{$ifdef SUPPORT_MMX}
@ -985,7 +1034,11 @@ begin
end.
{
$Log$
Revision 1.23 2001-11-02 22:58:02 peter
Revision 1.24 2001-12-03 21:48:42 peter
* freemem change to value parameter
* torddef low/high range changed to int64
Revision 1.23 2001/11/02 22:58:02 peter
* procsym definition rewrite
Revision 1.22 2001/10/28 17:22:25 peter

View File

@ -1346,6 +1346,7 @@ begin
def_symbol('HAS_ADDR_STACK_ON_STACK');
def_symbol('NOBOUNDCHECK');
def_symbol('HASCOMPILERPROC');
def_symbol('VALUEFREEMEM');
{ some stuff for TP compatibility }
{$ifdef i386}
@ -1645,7 +1646,11 @@ finalization
end.
{
$Log$
Revision 1.63 2001-11-24 02:09:54 carl
Revision 1.64 2001-12-03 21:48:42 peter
* freemem change to value parameter
* torddef low/high range changed to int64
Revision 1.63 2001/11/24 02:09:54 carl
* Renamed ppc.cfg -> fpc.cfg
Revision 1.62 2001/11/23 02:48:46 carl

View File

@ -37,7 +37,7 @@ interface
{ node }
node,
{ aasm }
aasm,cpubase
aasm,cpubase,cpuinfo
;
@ -370,9 +370,9 @@ interface
torddef = class(tstoreddef)
rangenr : longint;
low,high : longint;
low,high : TConstExprInt;
typ : tbasetype;
constructor create(t : tbasetype;v,b : longint);
constructor create(t : tbasetype;v,b : TConstExprInt);
constructor load(ppufile:tcompilerppufile);
procedure write(ppufile:tcompilerppufile);override;
function is_publishable : boolean;override;
@ -720,7 +720,7 @@ implementation
{ global }
verbose,
{ target }
systems,cpuinfo,
systems,
{ symtable }
symsym,symtable,
types,
@ -1597,7 +1597,7 @@ implementation
TORDDEF
****************************************************************************}
constructor torddef.create(t : tbasetype;v,b : longint);
constructor torddef.create(t : tbasetype;v,b : TConstExprInt);
begin
inherited create;
deftype:=orddef;
@ -1610,12 +1610,44 @@ implementation
constructor torddef.load(ppufile:tcompilerppufile);
var
l1,l2 : longint;
begin
inherited loaddef(ppufile);
deftype:=orddef;
typ:=tbasetype(ppufile.getbyte);
low:=ppufile.getlongint;
high:=ppufile.getlongint;
if sizeof(TConstExprInt)=8 then
begin
l1:=ppufile.getlongint;
l2:=ppufile.getlongint;
{$ifopt R+}
{$define Range_check_on}
{$endif opt R+}
{$R- needed here }
low:=qword(l1)+(int64(l2) shl 32);
{$ifdef Range_check_on}
{$R+}
{$undef Range_check_on}
{$endif Range_check_on}
end
else
low:=ppufile.getlongint;
if sizeof(TConstExprInt)=8 then
begin
l1:=ppufile.getlongint;
l2:=ppufile.getlongint;
{$ifopt R+}
{$define Range_check_on}
{$endif opt R+}
{$R- needed here }
high:=qword(l1)+(int64(l2) shl 32);
{$ifdef Range_check_on}
{$R+}
{$undef Range_check_on}
{$endif Range_check_on}
end
else
high:=ppufile.getlongint;
rangenr:=0;
setsize;
end;
@ -1728,8 +1760,20 @@ implementation
begin
inherited writedef(ppufile);
ppufile.putbyte(byte(typ));
ppufile.putlongint(low);
ppufile.putlongint(high);
if sizeof(TConstExprInt)=8 then
begin
ppufile.putlongint(longint(lo(low)));
ppufile.putlongint(longint(hi(low)));
end
else
ppufile.putlongint(low);
if sizeof(TConstExprInt)=8 then
begin
ppufile.putlongint(longint(lo(high)));
ppufile.putlongint(longint(hi(high)));
end
else
ppufile.putlongint(high);
ppufile.writeentry(iborddef);
end;
@ -5458,7 +5502,11 @@ implementation
end.
{
$Log$
Revision 1.58 2001-11-30 15:01:51 jonas
Revision 1.59 2001-12-03 21:48:42 peter
* freemem change to value parameter
* torddef low/high range changed to int64
Revision 1.58 2001/11/30 15:01:51 jonas
* tarraydef.size returns target_info.size_of_pointer instead of 4 for
dynamic arrays

View File

@ -1918,7 +1918,7 @@ implementation
{$endif Range_check_on}
end
else
valueordptr:=ppufile.getlongint;
valueordptr:=cardinal(ppufile.getlongint);
end;
conststring,
constresourcestring :
@ -2017,7 +2017,7 @@ implementation
ppufile.putlongint(longint(hi(valueordptr)));
end
else
ppufile.putlongint(valueordptr);
ppufile.putlongint(longint(valueordptr));
end;
conststring,
constresourcestring :
@ -2440,7 +2440,11 @@ implementation
end.
{
$Log$
Revision 1.28 2001-11-30 16:25:35 jonas
Revision 1.29 2001-12-03 21:48:42 peter
* freemem change to value parameter
* torddef low/high range changed to int64
Revision 1.28 2001/11/30 16:25:35 jonas
* fixed web bug 1707:
* tvarsym.getvaluesize doesn't return 0 anymore for dynarrays (found
by Florian)

View File

@ -231,7 +231,7 @@ interface
procedure testrange(def : tdef;var l : tconstexprint;explicit:boolean);
{ returns the range of def }
procedure getrange(def : tdef;var l : longint;var h : longint);
procedure getrange(def : tdef;var l : TConstExprInt;var h : TConstExprInt);
{ some type helper routines for MMX support }
function is_mmx_able_array(p : tdef) : boolean;
@ -833,7 +833,7 @@ implementation
the value is placed within the range }
procedure testrange(def : tdef;var l : tconstexprint;explicit:boolean);
var
lv,hv: longint;
lv,hv: TConstExprInt;
error: boolean;
begin
error := false;
@ -914,7 +914,7 @@ implementation
{ return the range from def in l and h }
procedure getrange(def : tdef;var l : longint;var h : longint);
procedure getrange(def : tdef;var l : TConstExprInt;var h : TConstExprInt);
begin
case def.deftype of
orddef :
@ -1869,7 +1869,11 @@ implementation
end.
{
$Log$
Revision 1.57 2001-11-14 01:12:45 florian
Revision 1.58 2001-12-03 21:48:43 peter
* freemem change to value parameter
* torddef low/high range changed to int64
Revision 1.57 2001/11/14 01:12:45 florian
* variant paramter passing and functions results fixed
Revision 1.56 2001/11/02 23:24:12 jonas