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

* several memory corruptions due to double freemem solved

Browse Source 
=> never use p^.loc.location:=p^.left^.loc.location;
  + finally I added now by default
    that ra386dir translates global and unit symbols
  + added a first field in tsymtable and
    a nextsym field in tsym
    (this allows to obtain ordered type info for
    records and objects in gdb !)
This commit is contained in:
pierre 1998-10-20 08:06:37 +00:00
parent ed24c76b30
commit 1a77339355
19 changed files with 362 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
compiler/ag68kmpw.pas
View File

@ -547,7 +547,7 @@ ait_labeled_instruction :
begin
{$ifdef EXTDEBUG}
if assigned(current_module^.mainsource) then
comment(v_info,'Start writing motorola-styled assembler output for '+current_module^.mainsource^);
comment(v_info,'Start writing MPW-styled assembler output for '+current_module^.mainsource^);
{$endif}
WriteTree(externals);
AsmLn;
@ -579,7 +579,17 @@ ait_labeled_instruction :
end.
{
$Log$
Revision 1.4 1998-10-14 15:56:42 pierre
Revision 1.5 1998-10-20 08:06:37 pierre
* several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default
that ra386dir translates global and unit symbols
+ added a first field in tsymtable and
a nextsym field in tsym
(this allows to obtain ordered type info for
records and objects in gdb !)
Revision 1.4 1998/10/14 15:56:42 pierre
* all references to comp suppressed for m68k
Revision 1.3 1998/10/12 12:20:47 pierre

17
compiler/cg386add.pas
View File

@ -507,7 +507,10 @@ implementation
if p^.left^.treetype=ordconstn then
swaptree(p);
secondpass(p^.left);
p^.location:=p^.left^.location;
set_location(p^.location,p^.left^.location);
{p^.location:=p^.left^.location;
created a bug !!! PM
because symbol was used twice }
{ are enough registers free ? }
pushed:=maybe_push(p^.right^.registers32,p);
secondpass(p^.right);
@ -1290,7 +1293,17 @@ implementation
end.
{
$Log$
Revision 1.17 1998-10-09 11:47:45 pierre
Revision 1.18 1998-10-20 08:06:38 pierre
* several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default
that ra386dir translates global and unit symbols
+ added a first field in tsymtable and
a nextsym field in tsym
(this allows to obtain ordered type info for
records and objects in gdb !)
Revision 1.17 1998/10/09 11:47:45 pierre
* still more memory leaks fixes !!
Revision 1.16 1998/10/09 08:56:21 pierre

14
compiler/cg386cal.pas
View File

@ -1163,6 +1163,8 @@ implementation
emitcall(p^.procdefinition^.mangledname,
(p^.symtableproc^.symtabletype=unitsymtable) or
((p^.symtableproc^.symtabletype=objectsymtable) and
(pobjectdef(p^.symtableproc^.defowner)^.owner^.symtabletype=unitsymtable))or
((p^.symtableproc^.symtabletype=withsymtable) and
(pobjectdef(p^.symtableproc^.defowner)^.owner^.symtabletype=unitsymtable)))
else { inlined proc }
{ inlined code is in inlinecode }
@ -1512,7 +1514,17 @@ implementation
end.
{
$Log$
Revision 1.35 1998-10-16 08:51:45 peter
Revision 1.36 1998-10-20 08:06:39 pierre
* several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default
that ra386dir translates global and unit symbols
+ added a first field in tsymtable and
a nextsym field in tsym
(this allows to obtain ordered type info for
records and objects in gdb !)
Revision 1.35 1998/10/16 08:51:45 peter
+ target_os.stackalignment
+ stack can be aligned at 2 or 4 byte boundaries

26
compiler/cg386inl.pas
View File

@ -814,12 +814,25 @@ implementation
end
else
begin
{ BUG HERE : detected with nasm :
hregister is allways 32 bit
it should be converted to 16 or 8 bit depending on op_size PM }
{ still not perfect :
if hregister is already a 16 bit reg ?? PM }
case opsize of
S_B : hregister:=reg32toreg8(hregister);
S_W : hregister:=reg32toreg16(hregister);
end;
if p^.left^.left^.location.loc=LOC_CREGISTER then
exprasmlist^.concat(new(pai386,op_reg_reg(addsubop[p^.inlinenumber],opsize,
hregister,p^.left^.left^.location.register)))
else
exprasmlist^.concat(new(pai386,op_reg_ref(addsubop[p^.inlinenumber],opsize,
hregister,newreference(p^.left^.left^.location.reference))));
case opsize of
S_B : hregister:=reg8toreg32(hregister);
S_W : hregister:=reg16toreg32(hregister);
end;
ungetregister32(hregister);
end;
emitoverflowcheck(p^.left^.left);
@ -929,6 +942,7 @@ implementation
end
else
begin
internalerror(10083);
end;
end;
end;
@ -941,7 +955,17 @@ implementation
end.
{
$Log$
Revision 1.13 1998-10-13 16:50:02 pierre
Revision 1.14 1998-10-20 08:06:40 pierre
* several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default
that ra386dir translates global and unit symbols
+ added a first field in tsymtable and
a nextsym field in tsym
(this allows to obtain ordered type info for
records and objects in gdb !)
Revision 1.13 1998/10/13 16:50:02 pierre
* undid some changes of Peter that made the compiler wrong
for m68k (I had to reinsert some ifdefs)
* removed several memory leaks under m68k

16
compiler/cg386mat.pas
View File

@ -348,7 +348,7 @@ implementation
{$ifdef SUPPORT_MMX}
LOC_MMXREGISTER:
begin
p^.location:=p^.left^.location;
set_location(p^.location,p^.left^.location);
emit_reg_reg(A_PXOR,S_NO,R_MM7,R_MM7);
do_mmx_neg;
end;
@ -488,7 +488,7 @@ implementation
{ load operand }
case p^.left^.location.loc of
LOC_MMXREGISTER:
p^.location:=p^.left^.location;
set_location(p^.location,p^.left^.location);
LOC_CMMXREGISTER:
begin
p^.location.register:=getregistermmx;
@ -561,7 +561,17 @@ implementation
end.
{
$Log$
Revision 1.8 1998-10-09 08:56:24 pierre
Revision 1.9 1998-10-20 08:06:42 pierre
* several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default
that ra386dir translates global and unit symbols
+ added a first field in tsymtable and
a nextsym field in tsym
(this allows to obtain ordered type info for
records and objects in gdb !)
Revision 1.8 1998/10/09 08:56:24 pierre
* several memory leaks fixed
Revision 1.7 1998/09/17 09:42:17 peter

14
compiler/cg68kadd.pas
View File

@ -580,7 +580,7 @@ implementation
if p^.left^.treetype=ordconstn then
swaptree(p);
secondpass(p^.left);
p^.location:=p^.left^.location;
set_location(p^.location,p^.left^.location);
{ are enough registers free ? }
pushed:=maybe_push(p^.right^.registers32,p);
secondpass(p^.right);
@ -1279,7 +1279,17 @@ implementation
end.
{
$Log$
Revision 1.12 1998-10-17 02:53:48 carl
Revision 1.13 1998-10-20 08:06:43 pierre
* several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default
that ra386dir translates global and unit symbols
+ added a first field in tsymtable and
a nextsym field in tsym
(this allows to obtain ordered type info for
records and objects in gdb !)
Revision 1.12 1998/10/17 02:53:48 carl
* bugfix of FPU deallocation in $E- mode
Revision 1.11 1998/10/14 11:28:15 florian

18
compiler/cg68kcal.pas
View File

@ -841,7 +841,11 @@ implementation
end
else
emitcall(p^.procdefinition^.mangledname,
p^.symtableproc^.symtabletype=unitsymtable);
(p^.symtableproc^.symtabletype=unitsymtable) or
((p^.symtableproc^.symtabletype=objectsymtable) and
(pobjectdef(p^.symtableproc^.defowner)^.owner^.symtabletype=unitsymtable))or
((p^.symtableproc^.symtabletype=withsymtable) and
(pobjectdef(p^.symtableproc^.defowner)^.owner^.symtabletype=unitsymtable)));
if ((p^.procdefinition^.options and poclearstack)<>0) then
begin
if (pushedparasize > 0) and (pushedparasize < 9) then
@ -1052,7 +1056,17 @@ implementation
end.
{
$Log$
Revision 1.12 1998-10-19 08:54:53 pierre
Revision 1.13 1998-10-20 08:06:45 pierre
* several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default
that ra386dir translates global and unit symbols
+ added a first field in tsymtable and
a nextsym field in tsym
(this allows to obtain ordered type info for
records and objects in gdb !)
Revision 1.12 1998/10/19 08:54:53 pierre
* wrong stabs info corrected once again !!
+ variable vmt offset with vmt field only if required
implemented now !!!

16
compiler/cga68k.pas
View File

@ -1327,14 +1327,14 @@ end;
if (dest_loc.loc=LOC_CREGISTER) or (dest_loc.loc=LOC_REGISTER) then
begin
emit_reg_reg(A_MOVE,s,reg,dest_loc.register);
p^.location:=dest_loc;
set_location(p^.location,dest_loc);
in_dest_loc:=true;
end
else
if (dest_loc.loc=LOC_REFERENCE) or (dest_loc.loc=LOC_MEM) then
begin
exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,s,reg,newreference(dest_loc.reference))));
p^.location:=dest_loc;
set_location(p^.location,dest_loc);
in_dest_loc:=true;
end
else
@ -1346,7 +1346,17 @@ end;
end.
{
$Log$
Revision 1.25 1998-10-16 13:12:48 pierre
Revision 1.26 1998-10-20 08:06:46 pierre
* several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default
that ra386dir translates global and unit symbols
+ added a first field in tsymtable and
a nextsym field in tsym
(this allows to obtain ordered type info for
records and objects in gdb !)
Revision 1.25 1998/10/16 13:12:48 pierre
* added vmt_offsets in destructors code also !!!
* vmt_offset code for m68k

2
compiler/msgtxt.inc
View File

@ -385,7 +385,7 @@ const msgtxt : array[0..00091,1..240] of char=(+
'W_NEAR ignored'#000+
'W_FAR ignored'#000+
'D_Creating inline asm lookup tables'#000+
'W_Using a defined name as a local ','label'#000+
'E_Using a defined name as a local ','label'#000+
'F_internal error in HandleExtend()'#000+
'E_Invalid character: <'#000+
'E_Invalid character: >'#000+

17
compiler/pstatmnt.pas
View File

@ -377,6 +377,7 @@ unit pstatmnt;
symtab^.next:=new(psymtable,init(symtable.withsymtable));
symtab:=symtab^.next;
symtab^.root:=obj^.publicsyms^.root;
symtab^.defowner:=obj;
obj:=obj^.childof;
inc(levelcount);
end;
@ -1203,8 +1204,8 @@ unit pstatmnt;
procinfo.framepointer:=R_SP;
{$endif}
{ set the right value for parameters }
dec(aktprocsym^.definition^.parast^.call_offset,sizeof(pointer));
dec(procinfo.call_offset,sizeof(pointer));
dec(aktprocsym^.definition^.parast^.call_offset,target_os.size_of_pointer);
dec(procinfo.call_offset,target_os.size_of_pointer);
end;
assembler_block:=_asm_statement;
{ becuase the END is already read we need to get the
@ -1215,7 +1216,17 @@ unit pstatmnt;
end.
{
$Log$
Revision 1.45 1998-10-19 08:55:01 pierre
Revision 1.46 1998-10-20 08:06:53 pierre
* several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default
that ra386dir translates global and unit symbols
+ added a first field in tsymtable and
a nextsym field in tsym
(this allows to obtain ordered type info for
records and objects in gdb !)
Revision 1.45 1998/10/19 08:55:01 pierre
* wrong stabs info corrected once again !!
+ variable vmt offset with vmt field only if required
implemented now !!!

22
compiler/ptconst.pas
View File

@ -54,7 +54,7 @@ unit ptconst;
{$ifdef m68k}
j : longint;
{$endif m68k}
p : ptree;
p,hp : ptree;
i,l,offset,
strlength : longint;
lsym : pvarsym;
@ -166,6 +166,14 @@ unit ptconst;
begin
p:=comp_expr(true);
do_firstpass(p);
{ allows horrible ofs(typeof(TButton)^) code !! }
if (p^.treetype=addrn) and (p^.left^.treetype=derefn) then
begin
hp:=p^.left^.left;
p^.left^.left:=nil;
disposetree(p);
p:=hp;
end;
{ nil pointer ? }
if p^.treetype=niln then
datasegment^.concat(new(pai_const,init_32bit(0)))
@ -612,7 +620,17 @@ unit ptconst;
end.
{
$Log$
Revision 1.21 1998-10-19 08:55:03 pierre
Revision 1.22 1998-10-20 08:06:56 pierre
* several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default
that ra386dir translates global and unit symbols
+ added a first field in tsymtable and
a nextsym field in tsym
(this allows to obtain ordered type info for
records and objects in gdb !)
Revision 1.21 1998/10/19 08:55:03 pierre
* wrong stabs info corrected once again !!
+ variable vmt offset with vmt field only if required
implemented now !!!

14
compiler/ra386dir.pas
View File

@ -180,7 +180,7 @@ unit Ra386dir;
else
begin
{$ifdef TESTGLOBALVAR}
{$ifndef IGNOREGLOBALVAR}
getsym(upper(hs),false);
sym:=srsym;
if assigned(sym) and (sym^.owner^.symtabletype in [unitsymtable,
@ -262,7 +262,17 @@ unit Ra386dir;
end.
{
$Log$
Revision 1.8 1998-09-04 08:42:08 peter
Revision 1.9 1998-10-20 08:06:57 pierre
* several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default
that ra386dir translates global and unit symbols
+ added a first field in tsymtable and
a nextsym field in tsym
(this allows to obtain ordered type info for
records and objects in gdb !)
Revision 1.8 1998/09/04 08:42:08 peter
* updated some error messages
Revision 1.7 1998/09/03 17:39:05 florian

108
compiler/symdef.inc
View File

@ -423,7 +423,7 @@
string_typ:=st_longstring;
deftype:=stringdef;
len:=l;
savesize:=Sizeof(pointer);
savesize:=target_os.size_of_pointer;
end;
@ -433,7 +433,7 @@
deftype:=stringdef;
string_typ:=st_longstring;
len:=readlong;
savesize:=Sizeof(pointer);
savesize:=target_os.size_of_pointer;
end;
@ -443,7 +443,7 @@
string_typ:=st_ansistring;
deftype:=stringdef;
len:=l;
savesize:=sizeof(pointer);
savesize:=target_os.size_of_pointer;
end;
@ -453,7 +453,7 @@
deftype:=stringdef;
string_typ:=st_ansistring;
len:=readlong;
savesize:=sizeof(pointer);
savesize:=target_os.size_of_pointer;
end;
@ -463,7 +463,7 @@
string_typ:=st_widestring;
deftype:=stringdef;
len:=l;
savesize:=sizeof(pointer);
savesize:=target_os.size_of_pointer;
end;
@ -473,7 +473,7 @@
deftype:=stringdef;
string_typ:=st_widestring;
len:=readlong;
savesize:=sizeof(pointer);
savesize:=target_os.size_of_pointer;
end;
@ -1166,7 +1166,7 @@
inherited init;
deftype:=pointerdef;
definition:=def;
savesize:=Sizeof(pointer);
savesize:=target_os.size_of_pointer;
end;
@ -1176,7 +1176,7 @@
deftype:=pointerdef;
{ the real address in memory is calculated later (deref) }
definition:=readdefref;
savesize:=Sizeof(pointer);
savesize:=target_os.size_of_pointer;
end;
@ -1254,7 +1254,7 @@
inherited init(def);
deftype:=classrefdef;
definition:=def;
savesize:=Sizeof(pointer);
savesize:=target_os.size_of_pointer;
end;
@ -1409,7 +1409,7 @@
begin
inherited init;
deftype:=formaldef;
savesize:=Sizeof(pointer);
savesize:=target_os.size_of_pointer;
end;
@ -1417,7 +1417,7 @@
begin
inherited load;
deftype:=formaldef;
savesize:=Sizeof(pointer);
savesize:=target_os.size_of_pointer;
end;
@ -1690,13 +1690,21 @@
procedure addname(p : psym);
var
news, newrec : pchar;
spec : string[2];
begin
{ static variables from objects are like global objects }
if ((p^.properties and sp_static)<>0) then
exit;
if ((p^.properties and sp_protected)<>0) then
spec:='/1'
else if ((p^.properties and sp_private)<>0) then
spec:='/0'
else
spec:='';
If p^.typ = varsym then
begin
newrec := strpnew(p^.name+':'+pvarsym(p)^.definition^.numberstring
newrec := strpnew(p^.name+':'+spec+pvarsym(p)^.definition^.numberstring
+','+tostr(pvarsym(p)^.address*8)+','
+tostr(pvarsym(p)^.definition^.size*8)+';');
if strlen(StabRecString) + strlen(newrec) >= StabRecSize-256 then
@ -1718,6 +1726,7 @@
function trecdef.stabstring : pchar;
Var oldrec : pchar;
oldsize : longint;
cur : psym;
begin
oldrec := stabrecstring;
oldsize:=stabrecsize;
@ -1725,11 +1734,20 @@
stabrecsize:=memsizeinc;
strpcopy(stabRecString,'s'+tostr(savesize));
RecOffset := 0;
{$ifdef nonextfield}
{$ifdef tp}
symtable^.foreach(addname);
{$else}
symtable^.foreach(@addname);
{$endif}
{$else nonextfield}
cur:=symtable^.root;
while assigned(cur) do
begin
addname(cur);
cur:=cur^.nextsym;
end;
{$endif nonextfield}
{ FPC doesn't want to convert a char to a pchar}
{ is this a bug ? }
strpcopy(strend(StabRecString),';');
@ -1843,7 +1861,7 @@
fpu_used:=0;
options:=0;
retdef:=voiddef;
savesize:=Sizeof(pointer);
savesize:=target_os.size_of_pointer;
end;
@ -1915,7 +1933,7 @@
options:=readlong;
count:=readword;
para1:=nil;
savesize:=Sizeof(pointer);
savesize:=target_os.size_of_pointer;
for i:=1 to count do
begin
new(hp);
@ -1942,9 +1960,9 @@
begin
case pdc^.paratyp of
vs_value : inc(l,align(pdc^.data^.size,target_os.stackalignment));
vs_var : inc(l,sizeof(pointer));
vs_var : inc(l,target_os.size_of_pointer);
vs_const : if dont_copy_const_param(pdc^.data) then
inc(l,sizeof(pointer))
inc(l,target_os.size_of_pointer)
else
inc(l,align(pdc^.data^.size,target_os.stackalignment));
end;
@ -2298,6 +2316,7 @@
if i>0 then
begin
strpcopy(strend(StabRecString),','+tostr(i)+';');
(* confuse gdb !! PM
if assigned(parast) then
{$IfDef TP}
parast^.foreach(addparaname)
@ -2318,7 +2337,7 @@
+':'+param^.data^.numberstring+','+vartyp+';');
param := param^.next;
end;
end;
end; *)
{strpcopy(strend(StabRecString),';');}
end;
stabstring := strnew(stabrecstring);
@ -2444,9 +2463,9 @@
function tprocvardef.size : longint;
begin
if (options and pomethodpointer)=0 then
size:=sizeof(pointer)
size:=target_os.size_of_pointer
else
size:=2*sizeof(pointer);
size:=2*target_os.size_of_pointer;
end;
@ -2540,7 +2559,7 @@
publicsyms^.name := stringdup(n);
{ create space for vmt !! }
{$ifdef OLDVMTSTYLE}
publicsyms^.datasize:=Sizeof(pointer);
publicsyms^.datasize:=target_os.size_of_pointer;
options:=oo_hasvmt;
vmt_offset:=0;
{$else }
@ -2573,7 +2592,7 @@
+childof^.publicsyms^.datasize;
if ((options and oo_hasvmt)<>0) and
((c^.options and oo_hasvmt)<>0) then
publicsyms^.datasize:=publicsyms^.datasize-Sizeof(pointer);
publicsyms^.datasize:=publicsyms^.datasize-target_os.size_of_pointer;
{ if parent has a vmt field then
the offset is the same for the child PM }
if ((c^.options and oo_hasvmt)<>0) then
@ -2633,7 +2652,7 @@
publicsyms^.datasize:=publicsyms^.datasize+4-(publicsyms^.datasize mod 4);
end;
vmt_offset:=publicsyms^.datasize;
publicsyms^.datasize:=publicsyms^.datasize+sizeof(pointer);
publicsyms^.datasize:=publicsyms^.datasize+target_os.size_of_pointer;
options:=options or oo_hasvmt;
end;
end;
@ -2688,7 +2707,7 @@
function tobjectdef.size : longint;
begin
if (options and oo_is_class)<>0 then
size:=sizeof(pointer)
size:=target_os.size_of_pointer
else
size:=publicsyms^.datasize;
@ -2873,6 +2892,9 @@
oldrec : pchar;
oldrecsize : longint;
str_end : string;
{$ifndef nonextfield}
cur : psym;
{$endif nonextfield}
begin
oldrec := stabrecstring;
oldrecsize:=stabrecsize;
@ -2885,22 +2907,40 @@
strpcopy(strend(stabrecstring),'!1,020,'+childof^.numberstring+';');
{virtual table to implement yet}
RecOffset := 0;
{$ifdef tp}
publicsyms^.foreach(addname);
{$else}
publicsyms^.foreach(@addname);
{$endif tp}
{$ifdef nonextfield}
{$ifdef tp}
publicsyms^.foreach(addname);
{$else}
publicsyms^.foreach(@addname);
{$endif}
{$else nonextfield}
cur:=publicsyms^.root;
while assigned(cur) do
begin
addname(cur);
cur:=cur^.nextsym;
end;
{$endif nonextfield}
if (options and oo_hasvmt) <> 0 then
if not assigned(childof) or ((childof^.options and oo_hasvmt) = 0) then
begin
strpcopy(strend(stabrecstring),'$vf'+numberstring+':'+typeglobalnumber('vtblarray')
+','+tostr(vmt_offset*8)+';');
end;
{$ifdef nonextfield}
{$ifdef tp}
publicsyms^.foreach(addprocname);
{$else}
publicsyms^.foreach(@addprocname);
{$endif tp }
{$else nonextfield}
cur:=publicsyms^.root;
while assigned(cur) do
begin
addprocname(cur);
cur:=cur^.nextsym;
end;
{$endif nonextfield}
if (options and oo_hasvmt) <> 0 then
begin
anc := @self;
@ -3141,7 +3181,17 @@
{
$Log$
Revision 1.61 1998-10-19 08:55:05 pierre
Revision 1.62 1998-10-20 08:06:58 pierre
* several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default
that ra386dir translates global and unit symbols
+ added a first field in tsymtable and
a nextsym field in tsym
(this allows to obtain ordered type info for
records and objects in gdb !)
Revision 1.61 1998/10/19 08:55:05 pierre
* wrong stabs info corrected once again !!
+ variable vmt offset with vmt field only if required
implemented now !!!

14
compiler/symppu.inc
View File

@ -307,7 +307,6 @@
end;
{$ifdef UseBrowser}
function readsymref : psym;
var
hd : psym;
@ -316,7 +315,6 @@
longint(hd):=longint(hd) or (longint(current_ppu^.getword) shl 16);
readsymref:=hd;
end;
{$endif}
procedure readsourcefiles;
@ -445,7 +443,17 @@
{
$Log$
Revision 1.23 1998-10-16 13:37:24 florian
Revision 1.24 1998-10-20 08:06:59 pierre
* several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default
that ra386dir translates global and unit symbols
+ added a first field in tsymtable and
a nextsym field in tsym
(this allows to obtain ordered type info for
records and objects in gdb !)
Revision 1.23 1998/10/16 13:37:24 florian
+ switch -FD added to specify the path for utilities
Revision 1.22 1998/10/14 13:38:24 peter

29
compiler/symsym.inc
View File

@ -28,6 +28,9 @@
begin
left:=nil;
right:=nil;
{$ifdef nextfield}
nextsym:=nil;
{$endif nextfield}
setname(n);
typ:=abstractsym;
properties:=current_object_option;
@ -214,7 +217,7 @@
setstring(_name,s);
end;
{ for most symbol types ther is nothing to do at all }
{ for most symbol types there is nothing to do at all }
procedure tsym.insert_in_data;
begin
end;
@ -944,30 +947,30 @@
case varspez of
vs_value : begin
if is_open_array(definition) then
getsize:=sizeof(pointer)+4
getsize:=target_os.size_of_pointer+target_os.size_of_longint
else
getsize:=definition^.size;
end;
vs_var : begin
{ open arrays push also the high valye }
if is_open_array(definition) then
getsize:=sizeof(pointer)+4
getsize:=target_os.size_of_pointer+target_os.size_of_pointer
else
getsize:=sizeof(pointer);
getsize:=target_os.size_of_pointer;
end;
vs_const : begin
case definition^.deftype of
stringdef,
recorddef,
objectdef,
setdef : getsize:=sizeof(pointer);
setdef : getsize:=target_os.size_of_pointer;
arraydef : begin
{ open arrays push also the high valye }
if (parraydef(definition)^.lowrange=0) and
(parraydef(definition)^.highrange=-1) then
getsize:=sizeof(pointer)+4
getsize:=target_os.size_of_pointer+target_os.size_of_pointer
else
getsize:=sizeof(pointer);
getsize:=target_os.size_of_pointer;
end;
else
getsize:=definition^.size;
@ -1712,7 +1715,17 @@
{
$Log$
Revision 1.54 1998-10-19 08:55:07 pierre
Revision 1.55 1998-10-20 08:07:00 pierre
* several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default
that ra386dir translates global and unit symbols
+ added a first field in tsymtable and
a nextsym field in tsym
(this allows to obtain ordered type info for
records and objects in gdb !)
Revision 1.54 1998/10/19 08:55:07 pierre
* wrong stabs info corrected once again !!
+ variable vmt offset with vmt field only if required
implemented now !!!

15
compiler/symsymh.inc
View File

@ -39,6 +39,9 @@
typ : tsymtyp;
_name : pchar;
left,right : psym;
{$ifndef nonextfield}
nextsym : psym;
{$endif nextfield}
speedvalue : longint;
properties : symprop;
owner : psymtable;
@ -315,7 +318,17 @@
{
$Log$
Revision 1.3 1998-10-08 17:17:34 pierre
Revision 1.4 1998-10-20 08:07:02 pierre
* several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default
that ra386dir translates global and unit symbols
+ added a first field in tsymtable and
a nextsym field in tsym
(this allows to obtain ordered type info for
records and objects in gdb !)
Revision 1.3 1998/10/08 17:17:34 pierre
* current_module old scanner tagged as invalid if unit is recompiled
+ added ppheap for better info on tracegetmem of heaptrc
(adds line column and file index)

36
compiler/systems.pas
View File

@ -120,7 +120,9 @@ unit systems;
Cprefix : string[2];
newline : string[2];
endian : tendian;
stackalignment : longint;
stackalignment : {longint this is a little overkill no ?? }byte;
size_of_pointer : byte;
size_of_longint : byte;
use_function_relative_addresses : boolean;
end;
@ -222,6 +224,8 @@ implementation
newline : #13#10;
endian : endian_little;
stackalignment : 2;
size_of_pointer : 4;
size_of_longint : 4;
use_function_relative_addresses : true
),
(
@ -238,6 +242,8 @@ implementation
newline : #13#10;
endian : endian_little;
stackalignment : 2;
size_of_pointer : 4;
size_of_longint : 4;
use_function_relative_addresses : true
),
(
@ -254,6 +260,8 @@ implementation
newline : #10;
endian : endian_little;
stackalignment : 4;
size_of_pointer : 4;
size_of_longint : 4;
use_function_relative_addresses : true
),
(
@ -270,6 +278,8 @@ implementation
newline : #13#10;
endian : endian_little;
stackalignment : 2;
size_of_pointer : 4;
size_of_longint : 4;
use_function_relative_addresses : false
),
(
@ -286,6 +296,8 @@ implementation
newline : #13#10;
endian : endian_little;
stackalignment : 4;
size_of_pointer : 4;
size_of_longint : 4;
use_function_relative_addresses : true
),
(
@ -302,6 +314,8 @@ implementation
newline : #10;
endian : endian_big;
stackalignment : 2;
size_of_pointer : 4;
size_of_longint : 4;
use_function_relative_addresses : false
),
(
@ -318,6 +332,8 @@ implementation
newline : #10;
endian : endian_big;
stackalignment : 2;
size_of_pointer : 4;
size_of_longint : 4;
use_function_relative_addresses : false
),
(
@ -334,6 +350,8 @@ implementation
newline : #13;
endian : endian_big;
stackalignment : 2;
size_of_pointer : 4;
size_of_longint : 4;
use_function_relative_addresses : false
),
(
@ -350,6 +368,8 @@ implementation
newline : #10;
endian : endian_big;
stackalignment : 2;
size_of_pointer : 4;
size_of_longint : 4;
use_function_relative_addresses : true
),
(
@ -366,6 +386,8 @@ implementation
newline : #10;
endian : endian_big;
stackalignment : 2;
size_of_pointer : 4;
size_of_longint : 4;
use_function_relative_addresses : false
)
);
@ -1152,7 +1174,17 @@ begin
end.
{
$Log$
Revision 1.46 1998-10-16 08:51:54 peter
Revision 1.47 1998-10-20 08:07:04 pierre
* several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default
that ra386dir translates global and unit symbols
+ added a first field in tsymtable and
a nextsym field in tsym
(this allows to obtain ordered type info for
records and objects in gdb !)
Revision 1.46 1998/10/16 08:51:54 peter
+ target_os.stackalignment
+ stack can be aligned at 2 or 4 byte boundaries

28
compiler/tcadd.pas
View File

@ -509,13 +509,23 @@ implementation
if (psetdef(ld)^.settype<>smallset) and
(psetdef(rd)^.settype=smallset) then
begin
p^.right:=gentypeconvnode(p^.right,psetdef(p^.left^.resulttype));
if (p^.right^.treetype=setconstn) then
begin
t:=gensetconstnode(p^.right^.value_set,psetdef(p^.left^.resulttype));
t^.left:=p^.right^.left;
putnode(p^.right);
p^.right:=t;
end
else
p^.right:=gentypeconvnode(p^.right,psetdef(p^.left^.resulttype));
firstpass(p^.right);
end;
{ do constant evalution }
{ do constant evaluation }
if (p^.right^.treetype=setconstn) and
(p^.left^.treetype=setconstn) then
not assigned(p^.right^.left) and
(p^.left^.treetype=setconstn) and
not assigned(p^.left^.left) then
begin
new(resultset);
case p^.treetype of
@ -905,7 +915,17 @@ implementation
end.
{
$Log$
Revision 1.4 1998-10-14 12:53:39 peter
Revision 1.5 1998-10-20 08:07:05 pierre
* several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default
that ra386dir translates global and unit symbols
+ added a first field in tsymtable and
a nextsym field in tsym
(this allows to obtain ordered type info for
records and objects in gdb !)
Revision 1.4 1998/10/14 12:53:39 peter
* fixed small tp7 things
* boolean:=longbool and longbool fixed

16
compiler/tree.pas
View File

@ -308,7 +308,7 @@ unit tree;
implementation
uses
verbose,files,types;
systems,verbose,files,types;
function getnode : ptree;
@ -1151,7 +1151,7 @@ unit tree;
p^.para_offset:=0;
p^.para_size:=p^.inlineprocdef^.para_size;
if ret_in_param(p^.inlineprocdef^.retdef) then
p^.para_size:=p^.para_size+sizeof(pointer);
p^.para_size:=p^.para_size+target_os.size_of_pointer;
{ copy args }
p^.left:=getcopy(code);
p^.registers32:=code^.registers32;
@ -1620,7 +1620,17 @@ unit tree;
end.
{
$Log$
Revision 1.46 1998-10-08 17:17:37 pierre
Revision 1.47 1998-10-20 08:07:07 pierre
* several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default
that ra386dir translates global and unit symbols
+ added a first field in tsymtable and
a nextsym field in tsym
(this allows to obtain ordered type info for
records and objects in gdb !)
Revision 1.46 1998/10/08 17:17:37 pierre
* current_module old scanner tagged as invalid if unit is recompiled
+ added ppheap for better info on tracegetmem of heaptrc
(adds line column and file index)