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

* splitted namedobjectitem.next into indexnext and listnext so it

Browse Source 
can be used in both lists
  * don't allow "word = word" type definitions (merged)
This commit is contained in:
peter 2000-08-16 18:33:53 +00:00
parent 244fc53520
commit 7eaac1706d
10 changed files with 175 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
compiler/aasm.pas
View File

@ -1085,7 +1085,7 @@ uses
reset;
inusedlist:=false;
end;
hp:=pasmsymbol(hp^.next);
hp:=pasmsymbol(hp^.listnext);
end;
end;
@ -1102,7 +1102,7 @@ uses
altsymbol:=nil;
inusedlist:=false;
end;
hp:=pasmsymbol(hp^.next);
hp:=pasmsymbol(hp^.listnext);
end;
end;
@ -1121,7 +1121,7 @@ uses
not(bind in [AB_EXTERNAL,AB_COMMON]) then
Message1(asmw_e_undefined_label,name);
end;
hp:=pasmsymbol(hp^.next);
hp:=pasmsymbol(hp^.listnext);
end;
end;
@ -1180,7 +1180,12 @@ uses
end.
{
$Log$
Revision 1.8 2000-08-12 19:14:58 peter
Revision 1.9 2000-08-16 18:33:53 peter
* splitted namedobjectitem.next into indexnext and listnext so it
can be used in both lists
* don't allow "word = word" type definitions (merged)
Revision 1.8 2000/08/12 19:14:58 peter
* ELF writer works now also with -g
* ELF writer is default again for linux
@ -1203,4 +1208,4 @@ end.
Revision 1.2 2000/07/13 11:32:28 michael
+ removed logs
}
}

13
compiler/browcol.pas
View File

@ -1254,10 +1254,10 @@ end;
end;
if assigned(dc^.paratype.def) then
CurName:=CurName+GetDefinitionStr(dc^.paratype.def);
if dc^.next<>nil then
if dc^.indexnext<>nil then
CurName:=', '+CurName;
Name:=CurName+Name;
dc:=pparaitem(dc^.next);
dc:=pparaitem(dc^.indexnext);
Inc(Count);
end;
GetAbsProcParmDefStr:=Name;
@ -1571,7 +1571,7 @@ end;
end;
if Assigned(Symbol) then
Owner^.Insert(Symbol);
sym:=psym(sym^.next);
sym:=psym(sym^.indexnext);
end;
end;
@ -2094,7 +2094,12 @@ begin
end.
{
$Log$
Revision 1.3 2000-07-13 12:08:24 michael
Revision 1.4 2000-08-16 18:33:53 peter
* splitted namedobjectitem.next into indexnext and listnext so it
can be used in both lists
* don't allow "word = word" type definitions (merged)
Revision 1.3 2000/07/13 12:08:24 michael
+ patched to 1.1.0 with former 1.09patch from peter
Revision 1.2 2000/07/13 11:32:32 michael

39
compiler/cobjects.pas
View File

@ -220,11 +220,15 @@ unit cobjects;
{ namedindexobject for use with dictionary and indexarray }
Pnamedindexobject=^Tnamedindexobject;
Tnamedindexobject=object
{ indexarray }
indexnr : longint;
indexnext : Pnamedindexobject;
{ dictionary }
_name : Pstring;
next,
left,right : Pnamedindexobject;
speedvalue : longint;
{ singlelist }
listnext : Pnamedindexobject;
constructor init;
constructor initname(const n:string);
destructor done;virtual;
@ -1325,24 +1329,28 @@ constructor Tnamedindexobject.init;
begin
{ index }
indexnr:=-1;
next:=nil;
indexnext:=nil;
{ dictionary }
left:=nil;
right:=nil;
_name:=nil;
speedvalue:=-1;
{ list }
listnext:=nil;
end;
constructor Tnamedindexobject.initname(const n:string);
begin
{ index }
indexnr:=-1;
next:=nil;
indexnext:=nil;
{ dictionary }
left:=nil;
right:=nil;
speedvalue:=-1;
_name:=stringdup(n);
{ list }
listnext:=nil;
end;
destructor Tnamedindexobject.done;
@ -1801,7 +1809,7 @@ end;
while assigned(hp) do
begin
hp2:=hp;
hp:=hp^.next;
hp:=hp^.listnext;
dispose(hp2,done);
end;
first:=nil;
@ -1814,9 +1822,9 @@ end;
if not assigned(first) then
first:=p
else
last^.next:=p;
last^.listnext:=p;
last:=p;
p^.next:=nil;
p^.listnext:=nil;
end;
@ -2036,16 +2044,16 @@ end;
dec(i);
if (i>0) and assigned(data^[i]) then
begin
data^[i]^.next:=data^[p^.indexnr]^.next;
data^[i]^.indexnext:=data^[p^.indexnr]^.indexnext;
break;
end;
end;
if i=0 then
first:=p^.next;
first:=p^.indexnext;
data^[p^.indexnr]:=nil;
{ clear entry }
p^.indexnr:=-1;
p^.next:=nil;
p^.indexnext:=nil;
end;
@ -2078,7 +2086,7 @@ end;
dec(i);
if (i>0) and assigned(data^[i]) then
begin
data^[i]^.next:=p;
data^[i]^.indexnext:=p;
break;
end;
end;
@ -2091,12 +2099,12 @@ end;
inc(i);
if (i<=count) and assigned(data^[i]) then
begin
p^.next:=data^[i];
p^.indexnext:=data^[i];
exit;
end;
end;
if i>count then
p^.next:=nil;
p^.indexnext:=nil;
end;
@ -2484,7 +2492,12 @@ end;
end.
{
$Log$
Revision 1.8 2000-08-13 08:41:57 peter
Revision 1.9 2000-08-16 18:33:53 peter
* splitted namedobjectitem.next into indexnext and listnext so it
can be used in both lists
* don't allow "word = word" type definitions (merged)
Revision 1.8 2000/08/13 08:41:57 peter
* fixed typo in tsinglelist.clear (merged)
Revision 1.7 2000/08/12 15:34:22 peter

11
compiler/htypechk.pas
View File

@ -713,7 +713,7 @@ implementation
if tok2node[i].tok=optoken then
begin
ld:=pvarsym(pf^.parast^.symindex^.first)^.vartype.def;
rd:=pvarsym(pf^.parast^.symindex^.first^.next)^.vartype.def;
rd:=pvarsym(pf^.parast^.symindex^.first^.indexnext)^.vartype.def;
dd:=pf^.rettype.def;
isoperatoracceptable:=
tok2node[i].op_overloading_supported and
@ -1132,7 +1132,12 @@ implementation
end.
{
$Log$
Revision 1.3 2000-08-07 11:31:04 jonas
Revision 1.4 2000-08-16 18:33:53 peter
* splitted namedobjectitem.next into indexnext and listnext so it
can be used in both lists
* don't allow "word = word" type definitions (merged)
Revision 1.3 2000/08/07 11:31:04 jonas
* fixed bug in type conversions between enum subranges (it didn't take
the packenum directive into account)
+ define PACKENUMFIXED symbol in options.pas
@ -1141,4 +1146,4 @@ end.
Revision 1.2 2000/07/13 11:32:41 michael
+ removed logs
}
}

26
compiler/pdecl.pas
View File

@ -267,7 +267,7 @@ unit pdecl;
if not sc^.empty then
Comment(V_Error,'default value only allowed for one parameter');
sc^.insert_with_tokeninfo(s,hpos);
{ prefix 'def' to the parameter name }
{ prefix 'def' to the parameter name }
pdefaultvalue:=ReadConstant('def'+s,hpos);
if assigned(pdefaultvalue) then
pprocdef(aktprocdef)^.parast^.insert(pdefaultvalue);
@ -839,8 +839,8 @@ unit pdecl;
begin
consume(_EQUAL);
sym:=readconstant(name,filepos);
if assigned(sym) then
symtablestack^.insert(sym);
if assigned(sym) then
symtablestack^.insert(sym);
consume(_SEMICOLON);
end;
@ -1084,12 +1084,19 @@ unit pdecl;
{ no old type reused ? Then insert this new type }
if not assigned(newtype) then
begin
read_type(tt,typename);
{ insert the new type first with an errordef, so that
referencing the type before it's really set it
will give an error (PFV) }
tt.setdef(generrordef);
storetokenpos:=tokenpos;
tokenpos:=defpos;
newtype:=new(ptypesym,init(typename,tt));
symtablestack^.insert(newtype);
tokenpos:=defpos;
tokenpos:=storetokenpos;
{ read the type definition }
read_type(tt,typename);
{ update the definition of the type }
newtype^.restype:=tt;
end;
if assigned(newtype^.restype.def) and
(newtype^.restype.def^.deftype=procvardef) then
@ -1275,7 +1282,12 @@ unit pdecl;
end.
{
$Log$
Revision 1.8 2000-08-13 13:11:28 peter
Revision 1.9 2000-08-16 18:33:53 peter
* splitted namedobjectitem.next into indexnext and listnext so it
can be used in both lists
* don't allow "word = word" type definitions (merged)
Revision 1.8 2000/08/13 13:11:28 peter
* put defaultpara values in parast and changed the name to
'def<Parameter name>'
@ -1297,4 +1309,4 @@ end.
Revision 1.2 2000/07/13 11:32:44 michael
+ removed logs
}
}

9
compiler/pexpr.pas
View File

@ -579,7 +579,7 @@ unit pexpr;
else
hs1:=hs;
p2:=gencallparanode(genloadnode(hs1,hs1^.owner),p2);
hs:=pvarsym(hs^.next);
hs:=pvarsym(hs^.indexnext);
end;
end
else
@ -2208,7 +2208,12 @@ _LECKKLAMMER : begin
end.
{
$Log$
Revision 1.4 2000-08-16 13:06:06 florian
Revision 1.5 2000-08-16 18:33:53 peter
* splitted namedobjectitem.next into indexnext and listnext so it
can be used in both lists
* don't allow "word = word" type definitions (merged)
Revision 1.4 2000/08/16 13:06:06 florian
+ support of 64 bit integer constants
Revision 1.3 2000/08/04 22:00:52 peter

11
compiler/psub.pas
View File

@ -688,8 +688,8 @@ begin
while assigned(parast^.symindex^.first) and (lastps<>psym(parast^.symindex^.first)) do
begin
ps:=psym(parast^.symindex^.first);
while assigned(ps^.next) and (psym(ps^.next)<>lastps) do
ps:=psym(ps^.next);
while assigned(ps^.indexnext) and (psym(ps^.indexnext)<>lastps) do
ps:=psym(ps^.indexnext);
ps^.owner:=st;
{ recalculate the corrected offset }
{ the really_insert_in_data procedure
@ -2087,7 +2087,12 @@ end.
{
$Log$
Revision 1.8 2000-08-13 12:54:56 peter
Revision 1.9 2000-08-16 18:33:54 peter
* splitted namedobjectitem.next into indexnext and listnext so it
can be used in both lists
* don't allow "word = word" type definitions (merged)
Revision 1.8 2000/08/13 12:54:56 peter
* class member decl wrong then no other error after it
* -vb has now also line numbering
* -vb is also used for interface/implementation different decls and

16
compiler/ptype.pas
View File

@ -172,12 +172,21 @@ uses
tt.setdef(generrordef);
exit;
end;
{ type sym ? }
if (srsym^.typ<>typesym) then
begin
Message(type_e_type_id_expected);
tt.setdef(generrordef);
exit;
end;
{ Types are first defined with an error def before assigning
the real type so check if it's an errordef. if so then
give an error }
if (ptypesym(srsym)^.restype.def=generrordef) then
begin
Message(sym_e_error_in_type_def);
exit;
end;
{ Only use the definitions for system/current unit, becuase
they can be refered from the parameters and symbols are not
loaded at that time. A symbol reference to an other unit
@ -1597,7 +1606,12 @@ uses
end.
{
$Log$
Revision 1.5 2000-08-06 14:17:15 peter
Revision 1.6 2000-08-16 18:33:54 peter
* splitted namedobjectitem.next into indexnext and listnext so it
can be used in both lists
* don't allow "word = word" type definitions (merged)
Revision 1.5 2000/08/06 14:17:15 peter
* overload fixes (merged)
Revision 1.4 2000/07/30 17:04:43 peter

107
compiler/symdef.inc
View File

@ -73,8 +73,8 @@
constructor tdef.load;
begin
inherited init;
deftype:=abstractdef;
next := nil;
owner := nil;
has_rtti:=false;
has_inittable:=false;
@ -2427,17 +2427,17 @@
procedure tabstractprocdef.write;
var
hp : pparaitem;
oldintfcrc : boolean;
oldintfcrc : boolean;
begin
inherited write;
rettype.write;
oldintfcrc:=current_ppu^.do_interface_crc;
oldintfcrc:=current_ppu^.do_interface_crc;
current_ppu^.do_interface_crc:=false;
writebyte(fpu_used);
writelong(ord(proctypeoption));
writesmallset(proccalloptions);
writesmallset(procoptions);
current_ppu^.do_interface_crc:=oldintfcrc;
current_ppu^.do_interface_crc:=oldintfcrc;
writeword(maxparacount);
hp:=pparaitem(para^.first);
while assigned(hp) do
@ -2480,7 +2480,7 @@
var
hs,s : string;
hp : pparaitem;
hpc : pconstsym;
hpc : pconstsym;
begin
s:='(';
hp:=pparaitem(para^.last);
@ -2494,37 +2494,37 @@
s:=s+'const'
else if hp^.paratyp=vs_out then
s:=s+'out';
{ default value }
if assigned(hp^.defaultvalue) then
begin
hpc:=pconstsym(hp^.defaultvalue);
hs:='';
case hpc^.consttyp of
conststring,
constresourcestring :
hs:=+strpas(pchar(tpointerord(hpc^.value)));
constreal :
{ default value }
if assigned(hp^.defaultvalue) then
begin
hpc:=pconstsym(hp^.defaultvalue);
hs:='';
case hpc^.consttyp of
conststring,
constresourcestring :
hs:=+strpas(pchar(tpointerord(hpc^.value)));
constreal :
str(pbestreal(tpointerord(hpc^.value))^,hs);
constord,
constpointer :
hs:=tostr(hpc^.value);
constbool :
begin
if hpc^.value<>0 then
hs:='TRUE'
else
hs:='FALSE';
end;
constnil :
hs:='nil';
constchar :
hs:=chr(hpc^.value);
constset :
hs:='<set>';
constord,
constpointer :
hs:=tostr(hpc^.value);
constbool :
begin
if hpc^.value<>0 then
hs:='TRUE'
else
hs:='FALSE';
end;
constnil :
hs:='nil';
constchar :
hs:=chr(hpc^.value);
constset :
hs:='<set>';
end;
if hs<>'' then
s:=s+'="'+hs+'"';
end;
if hs<>'' then
s:=s+'="'+hs+'"';
end;
hp:=pparaitem(hp^.previous);
if assigned(hp) then
s:=s+',';
@ -2681,8 +2681,8 @@
{new(localst,loadas(localsymtable));
localst^.defowner:=@self;
parast^.next:=localst;
localst^.next:=owner;}
localst^.next:=owner;}
forwarddef:=false;
interfacedef:=false;
hasforward:=false;
@ -2886,7 +2886,7 @@ Const local_symtable_index : longint = $8001;
oldintfcrc : boolean;
begin
inherited write;
oldintfcrc:=current_ppu^.do_interface_crc;
oldintfcrc:=current_ppu^.do_interface_crc;
current_ppu^.do_interface_crc:=false;
{ set all registers to used for simplified compilation PM }
if simplify_ppu then
@ -2913,7 +2913,7 @@ Const local_symtable_index : longint = $8001;
writeword(usedregisters);
{$endif}
{$endif newcg}
current_ppu^.do_interface_crc:=oldintfcrc;
current_ppu^.do_interface_crc:=oldintfcrc;
writestring(mangledname);
writelong(extnumber);
if (proctypeoption<>potype_operator) then
@ -2940,22 +2940,22 @@ Const local_symtable_index : longint = $8001;
}
end;
current_ppu^.writeentry(ibprocdef);
{ Save the para and local symtable, for easier reading
save both always, they don't influence the interface crc }
save both always, they don't influence the interface crc }
oldintfcrc:=current_ppu^.do_interface_crc;
current_ppu^.do_interface_crc:=false;
if not assigned(parast) then
begin
begin
parast:=new(psymtable,init(parasymtable));
parast^.defowner:=@self;
end;
parast^.defowner:=@self;
end;
parast^.writeas;
{if not assigned(localst) then
begin
begin
localst:=new(psymtable,init(localsymtable));
localst^.defowner:=@self;
end;
localst^.defowner:=@self;
end;
localst^.writeas;}
current_ppu^.do_interface_crc:=oldintfcrc;
end;
@ -3023,22 +3023,22 @@ Const local_symtable_index : longint = $8001;
procedure tprocdef.deref;
var
oldsymtablestack,
oldsymtablestack,
oldlocalsymtable : psymtable;
begin
inherited deref;
resolvedef(pdef(nextoverloaded));
resolvedef(pdef(_class));
{ parast }
oldsymtablestack:=symtablestack;
oldsymtablestack:=symtablestack;
oldlocalsymtable:=aktlocalsymtable;
aktlocalsymtable:=parast;
parast^.deref;
{symtablestack:=parast;
{symtablestack:=parast;
aktlocalsymtable:=localst;
localst^.deref;}
aktlocalsymtable:=oldlocalsymtable;
symtablestack:=oldsymtablestack;
symtablestack:=oldsymtablestack;
end;
@ -4252,7 +4252,12 @@ Const local_symtable_index : longint = $8001;
{
$Log$
Revision 1.10 2000-08-16 13:06:06 florian
Revision 1.11 2000-08-16 18:33:54 peter
* splitted namedobjectitem.next into indexnext and listnext so it
can be used in both lists
* don't allow "word = word" type definitions (merged)
Revision 1.10 2000/08/16 13:06:06 florian
+ support of 64 bit integer constants
Revision 1.9 2000/08/13 13:06:37 peter

29
compiler/symtable.pas
View File

@ -1590,7 +1590,7 @@ implementation
while assigned(pd) do
begin
pd^.write;
pd:=pdef(pd^.next);
pd:=pdef(pd^.indexnext);
end;
{ write end of definitions }
current_ppu^.writeentry(ibenddefs);
@ -1612,7 +1612,7 @@ implementation
while assigned(pd) do
begin
pd^.write;
pd:=psym(pd^.next);
pd:=psym(pd^.indexnext);
end;
{ end of symbols }
current_ppu^.writeentry(ibendsyms);
@ -1629,21 +1629,21 @@ implementation
while assigned(hs) do
begin
hs^.prederef;
hs:=psym(hs^.next);
hs:=psym(hs^.indexnext);
end;
{ deref the definitions }
hp:=pdef(defindex^.first);
while assigned(hp) do
begin
hp^.deref;
hp:=pdef(hp^.next);
hp:=pdef(hp^.indexnext);
end;
{ deref the symbols }
hs:=psym(symindex^.first);
while assigned(hs) do
begin
hs^.deref;
hs:=psym(hs^.next);
hs:=psym(hs^.indexnext);
end;
end;
@ -1667,9 +1667,9 @@ implementation
{ this is used to insert case variant into the main
record }
psymt^.datasize:=ps^.address+offset;
nps:=pvarsym(ps^.next);
nps:=pvarsym(ps^.indexnext);
symindex^.deleteindex(ps);
ps^.next:=nil;
ps^.indexnext:=nil;
ps^.left:=nil;
ps^.right:=nil;
psymt^.insert(ps);
@ -1678,9 +1678,9 @@ implementation
pd:=pdef(defindex^.first);
while assigned(pd) do
begin
npd:=pdef(pd^.next);
npd:=pdef(pd^.indexnext);
defindex^.deleteindex(pd);
pd^.next:=nil;
pd^.indexnext:=nil;
pd^.left:=nil;
pd^.right:=nil;
psymt^.registerdef(pd);
@ -2244,7 +2244,7 @@ implementation
l:=sym^.getpushsize;
sym^.address:=datasize;
datasize:=align(datasize+l,dataalignment);
sym:=pvarsym(sym^.next);
sym:=pvarsym(sym^.indexnext);
end;
end;
@ -2265,7 +2265,7 @@ implementation
find_at_offset:=sym;
exit;
end;
sym:=pvarsym(sym^.next);
sym:=pvarsym(sym^.indexnext);
end;
end;
@ -2980,7 +2980,12 @@ implementation
end.
{
$Log$
Revision 1.3 2000-08-08 19:28:57 peter
Revision 1.4 2000-08-16 18:33:54 peter
* splitted namedobjectitem.next into indexnext and listnext so it
can be used in both lists
* don't allow "word = word" type definitions (merged)
Revision 1.3 2000/08/08 19:28:57 peter
* memdebug/memory patches (merged)
* only once illegal directive (merged)