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

* removed some erros after other errors (introduced by useexcept)

Browse Source 
* stabs works again correctly (for how long !)
This commit is contained in:
pierre 1998-10-28 18:26:12 +00:00
parent 4b59eb6621
commit 1dab5a8cf0
7 changed files with 109 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
compiler/cg386add.pas
View File

@ -677,6 +677,7 @@ implementation
{ bts requires both elements to be registers } { bts requires both elements to be registers }
if p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE] then if p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE] then
begin begin
ungetiftemp(p^.left^.location.reference);
del_reference(p^.left^.location.reference); del_reference(p^.left^.location.reference);
hregister:=getregister32; hregister:=getregister32;
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize, exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
@ -688,6 +689,7 @@ implementation
end; end;
if p^.right^.location.loc in [LOC_MEM,LOC_REFERENCE] then if p^.right^.location.loc in [LOC_MEM,LOC_REFERENCE] then
begin begin
ungetiftemp(p^.right^.location.reference);
del_reference(p^.right^.location.reference); del_reference(p^.right^.location.reference);
hregister:=getregister32; hregister:=getregister32;
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize, exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
@ -1396,7 +1398,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.21 1998-10-25 23:32:48 peter Revision 1.22 1998-10-28 18:26:12 pierre
* removed some erros after other errors (introduced by useexcept)
* stabs works again correctly (for how long !)
Revision 1.21 1998/10/25 23:32:48 peter
* fixed unsigned mul * fixed unsigned mul
Revision 1.20 1998/10/21 08:39:56 florian Revision 1.20 1998/10/21 08:39:56 florian

18
compiler/parser.pas
View File

@ -290,7 +290,10 @@ unit parser;
recoverpospointer:=oldrecoverpos; recoverpospointer:=oldrecoverpos;
end end
else else
recoverpospointer:=oldrecoverpos; begin
recoverpospointer:=oldrecoverpos;
longjump_used:=true;
end;
{$endif USEEXCEPT} {$endif USEEXCEPT}
{ clear memory } { clear memory }
{$ifdef Splitheap} {$ifdef Splitheap}
@ -327,7 +330,8 @@ unit parser;
if (compile_level>1) then if (compile_level>1) then
begin begin
{ reset ranges/stabs in exported definitions } { reset ranges/stabs in exported definitions }
reset_global_defs; { reset_global_defs;
moved to pmodules (PM) }
{ restore scanner } { restore scanner }
c:=oldc; c:=oldc;
@ -409,12 +413,20 @@ unit parser;
end; end;
dec(compile_level); dec(compile_level);
{$ifdef USEEXCEPT}
if longjump_used then
longjmp(recoverpospointer^,1);
{$endif USEEXCEPT}
end; end;
end. end.
{ {
$Log$ $Log$
Revision 1.59 1998-10-26 17:15:18 pierre Revision 1.60 1998-10-28 18:26:14 pierre
* removed some erros after other errors (introduced by useexcept)
* stabs works again correctly (for how long !)
Revision 1.59 1998/10/26 17:15:18 pierre
+ added two level of longjump to + added two level of longjump to
allow clean freeing of used memory on errors allow clean freeing of used memory on errors

31
compiler/pmodules.pas
View File

@ -749,20 +749,10 @@ unit pmodules;
current_module^.globalsymtable:=current_module^.localsymtable; current_module^.globalsymtable:=current_module^.localsymtable;
current_module^.localsymtable:=nil; current_module^.localsymtable:=nil;
reset_global_defs;
{ ... parse the declarations } { ... parse the declarations }
read_interface_declarations; read_interface_declarations;
{$ifdef GDB}
{ add all used definitions}
if (cs_debuginfo in aktmoduleswitches) then
begin
{ all types }
punitsymtable(refsymtable)^.concattypestabto(debuglist);
{ and all local symbols}
refsymtable^.concatstabto(debuglist);
end;
{$endif GDB}
{ leave when we got an error } { leave when we got an error }
if (status.errorcount>0) and not status.skip_error then if (status.errorcount>0) and not status.skip_error then
begin begin
@ -888,6 +878,13 @@ unit pmodules;
{ add all used definitions even for implementation} { add all used definitions even for implementation}
if (cs_debuginfo in aktmoduleswitches) then if (cs_debuginfo in aktmoduleswitches) then
begin begin
if assigned(current_module^.globalsymtable) then
begin
{ all types }
punitsymtable(current_module^.globalsymtable)^.concattypestabto(debuglist);
{ and all local symbols}
punitsymtable(current_module^.globalsymtable)^.concatstabto(debuglist);
end;
{ all types } { all types }
punitsymtable(st)^.concattypestabto(debuglist); punitsymtable(st)^.concattypestabto(debuglist);
{ and all local symbols} { and all local symbols}
@ -895,6 +892,9 @@ unit pmodules;
end; end;
{$endif GDB} {$endif GDB}
reset_global_defs;
{ tests, if all (interface) forwards are resolved } { tests, if all (interface) forwards are resolved }
if (status.errorcount=0) then if (status.errorcount=0) then
symtablestack^.check_forwards; symtablestack^.check_forwards;
@ -1020,6 +1020,9 @@ unit pmodules;
if token=_USES then if token=_USES then
loadunits; loadunits;
reset_global_defs;
{Insert the name of the main program into the symbol table.} {Insert the name of the main program into the symbol table.}
if current_module^.modulename^<>'' then if current_module^.modulename^<>'' then
st^.insert(new(pprogramsym,init(current_module^.modulename^))); st^.insert(new(pprogramsym,init(current_module^.modulename^)));
@ -1098,7 +1101,11 @@ unit pmodules;
end. end.
{ {
$Log$ $Log$
Revision 1.75 1998-10-27 13:45:35 pierre Revision 1.76 1998-10-28 18:26:15 pierre
* removed some erros after other errors (introduced by useexcept)
* stabs works again correctly (for how long !)
Revision 1.75 1998/10/27 13:45:35 pierre
* classes get a vmt allways * classes get a vmt allways
* better error info (tried to remove * better error info (tried to remove
several error strings introduced by the tpexcept handling) several error strings introduced by the tpexcept handling)

9
compiler/symsym.inc
View File

@ -415,6 +415,9 @@
pd : pprocdef; pd : pprocdef;
oldaktfilepos : tfileposinfo; oldaktfilepos : tfileposinfo;
begin begin
{ don't check if errors !! }
if status.errorcount>0 then
exit;
pd:=definition; pd:=definition;
while assigned(pd) do while assigned(pd) do
begin begin
@ -1715,7 +1718,11 @@
{ {
$Log$ $Log$
Revision 1.55 1998-10-20 08:07:00 pierre Revision 1.56 1998-10-28 18:26:18 pierre
* removed some erros after other errors (introduced by useexcept)
* stabs works again correctly (for how long !)
Revision 1.55 1998/10/20 08:07:00 pierre
* several memory corruptions due to double freemem solved * several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location; => never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default + finally I added now by default

89
compiler/tccal.pas
View File

@ -221,11 +221,15 @@ implementation
hp,procs,hp2 : pprocdefcoll; hp,procs,hp2 : pprocdefcoll;
pd : pprocdef; pd : pprocdef;
actprocsym : pprocsym; actprocsym : pprocsym;
nextprocsym : pprocsym;
def_from,def_to,conv_to : pdef; def_from,def_to,conv_to : pdef;
pt,inlinecode : ptree; pt,inlinecode : ptree;
exactmatch,inlined : boolean; exactmatch,inlined : boolean;
paralength,l : longint; paralength,l : longint;
pdc : pdefcoll; pdc : pdefcoll;
{$ifdef TEST_PROCSYMS}
symt : psymtable;
{$endif TEST_PROCSYMS}
{ only Dummy } { only Dummy }
hcvt : tconverttype; hcvt : tconverttype;
@ -368,6 +372,33 @@ implementation
if not(assigned(p^.procdefinition)) then if not(assigned(p^.procdefinition)) then
begin begin
actprocsym:=pprocsym(p^.symtableprocentry); actprocsym:=pprocsym(p^.symtableprocentry);
{$ifdef TEST_PROCSYMS}
if (p^.unit_specific) or
assigned(p^.methodpointer) then
nextprocsym:=nil
else while not assigned(procs) do
begin
symt:=p^.symtableproc;
srsym:=nil;
while assigned(symt^.next) and not assigned(srsym) do
begin
symt:=symt^.next;
getsymonlyin(symt,actprocsym^.name);
if assigned(srsym) then
if srsym^.typ<>procsym then
begin
{ reject all that is not a procedure }
srsym:=nil;
{ don't search elsewhere }
while assigned(symt^.next) do
symt:=symt^.next;
end;
end;
nextprocsym:=srsym;
end;
{$else TEST_PROCSYMS}
nextprocsym:=nil;
{$endif TEST_PROCSYMS}
{ determine length of parameter list } { determine length of parameter list }
pt:=p^.left; pt:=p^.left;
paralength:=0; paralength:=0;
@ -414,20 +445,13 @@ implementation
end; end;
end; end;
pd:=pd^.nextoverloaded; pd:=pd^.nextoverloaded;
{$ifdef CHAINPROCSYMS}
if (pd=nil) and not (p^.unit_specific) then
begin
actprocsym:=actprocsym^.nextprocsym;
if assigned(actprocsym) then
pd:=actprocsym^.definition;
end;
{$endif CHAINPROCSYMS}
end; end;
{ no procedures found? then there is something wrong { no procedures found? then there is something wrong
with the parameter size } with the parameter size }
if not assigned(procs) and if not assigned(procs) and
((parsing_para_level=0) or assigned(p^.left)) then ((parsing_para_level=0) or assigned(p^.left)) and
(nextprocsym=nil) then
begin begin
CGMessage(parser_e_wrong_parameter_size); CGMessage(parser_e_wrong_parameter_size);
actprocsym^.write_parameter_lists; actprocsym^.write_parameter_lists;
@ -526,7 +550,8 @@ implementation
begin begin
{ there is an error, must be wrong type, because { there is an error, must be wrong type, because
wrong size is already checked (PFV) } wrong size is already checked (PFV) }
if (parsing_para_level=0) or (p^.left<>nil) then if ((parsing_para_level=0) or (p^.left<>nil)) and
(nextprocsym=nil) then
begin begin
CGMessage(parser_e_wrong_parameter_type); CGMessage(parser_e_wrong_parameter_type);
actprocsym^.write_parameter_lists; actprocsym^.write_parameter_lists;
@ -553,7 +578,7 @@ implementation
{ rather than to words } { rather than to words }
{ conversion of byte to integer or longint } { conversion of byte to integer or longint }
{would still not be solved } {would still not be solved }
if assigned(procs^.next) then if assigned(procs) and assigned(procs^.next) then
begin begin
hp:=procs; hp:=procs;
while assigned(hp) do while assigned(hp) do
@ -652,43 +677,19 @@ implementation
end; end;
end; } end; }
{$ifndef CHAINPROCSYMS}
if assigned(procs^.next) then if assigned(procs^.next) then
begin begin
CGMessage(cg_e_cant_choose_overload_function); CGMessage(cg_e_cant_choose_overload_function);
actprocsym^.write_parameter_lists; actprocsym^.write_parameter_lists;
end; end;
{$else CHAINPROCSYMS} {$ifdef TEST_PROCSYMS}
if assigned(procs^.next) then if (procs=nil) and assigned(nextprocsym) then
{ if the last retained is the only one }
{ from a unit it is OK PM }
{ the last is the one coming from the first symtable }
{ as the diff defcoll are inserted in front }
begin begin
hp2:=procs; p^.symtableprocentry:=nextprocsym;
while assigned(hp2^.next) and assigned(hp2^.next^.next) do p^.symtableproc:=symt;
hp2:=hp2^.next;
if (hp2^.data^.owner<>hp2^.next^.data^.owner) then
begin
hp:=procs^.next;
{hp2 is the correct one }
hp2:=hp2^.next;
while hp<>hp2 do
begin
dispose(procs);
procs:=hp;
hp:=procs^.next;
end;
procs:=hp2;
end
else
begin
CGMessage(cg_e_cant_choose_overload_function);
actprocsym^.write_parameter_lists;
error(too_much_matches);
end;
end; end;
{$endif CHAINPROCSYMS} end ; { of while assigned(p^.symtableprocentry) do }
{$endif TEST_PROCSYMS}
{$ifdef UseBrowser} {$ifdef UseBrowser}
if make_ref then if make_ref then
begin begin
@ -923,7 +924,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.8 1998-10-09 16:36:09 pierre Revision 1.9 1998-10-28 18:26:22 pierre
* removed some erros after other errors (introduced by useexcept)
* stabs works again correctly (for how long !)
Revision 1.8 1998/10/09 16:36:09 pierre
* some memory leaks specific to usebrowser define fixed * some memory leaks specific to usebrowser define fixed
* removed tmodule.implsymtable (was like tmodule.localsymtable) * removed tmodule.implsymtable (was like tmodule.localsymtable)

9
compiler/tpexcept.pas
View File

@ -51,7 +51,8 @@ type
const const
recoverpospointer : pjmp_buf = nil; recoverpospointer : pjmp_buf = nil;
longjump_used : boolean = false;
implementation implementation
@ -335,7 +336,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.4 1998-10-26 22:58:24 florian Revision 1.5 1998-10-28 18:26:23 pierre
* removed some erros after other errors (introduced by useexcept)
* stabs works again correctly (for how long !)
Revision 1.4 1998/10/26 22:58:24 florian
* new introduded problem with classes fix, the parent class wasn't set * new introduded problem with classes fix, the parent class wasn't set
correct, if the class was defined forward before correct, if the class was defined forward before

7
compiler/verbose.pas
View File

@ -290,6 +290,7 @@ end;
procedure internalerror(i : longint); procedure internalerror(i : longint);
begin begin
do_internalerror(i); do_internalerror(i);
inc(status.errorcount);
stop; stop;
end; end;
@ -427,7 +428,11 @@ end.
{ {
$Log$ $Log$
Revision 1.26 1998-10-27 13:45:38 pierre Revision 1.27 1998-10-28 18:26:24 pierre
* removed some erros after other errors (introduced by useexcept)
* stabs works again correctly (for how long !)
Revision 1.26 1998/10/27 13:45:38 pierre
* classes get a vmt allways * classes get a vmt allways
* better error info (tried to remove * better error info (tried to remove
several error strings introduced by the tpexcept handling) several error strings introduced by the tpexcept handling)