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

+ first implementation of try ... except on .. do end;

Browse Source 
* limitiation of 65535 bytes parameters for cdecl removed
This commit is contained in:
florian 1998-07-30 11:18:13 +00:00
parent ae929aed5a
commit 38ec73449d
7 changed files with 229 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
compiler/cg386flw.pas
View File

@ -37,6 +37,7 @@ interface
procedure secondraise(var p : ptree);
procedure secondtryexcept(var p : ptree);
procedure secondtryfinally(var p : ptree);
procedure secondon(var p : ptree);
procedure secondfail(var p : ptree);
@ -552,13 +553,18 @@ do_jmp:
SecondTryExcept
*****************************************************************************}
var
endexceptlabel : plabel;
procedure secondtryexcept(var p : ptree);
var
exceptlabel,doexceptlabel,endexceptlabel,
exceptlabel,doexceptlabel,oldendexceptlabel,
nextonlabel,lastonlabel : plabel;
begin
{ this can be called recursivly }
oldendexceptlabel:=endexceptlabel;
{ we modify EAX }
usedinproc:=usedinproc or ($80 shr byte(R_EAX));
@ -592,23 +598,9 @@ do_jmp:
emitl(A_JMP,endexceptlabel);
emitl(A_LABEL,doexceptlabel);
{ for each object: }
while false do
begin
getlabel(nextonlabel);
end;
{
for each 'on object' do :
----------------
if assigned(p^.right) then
secondpass(p^.right);
pushl objectclass; // pass object class, or -1 if no class specified.
call FPC_CATCHES // Does this object tacth the exception ?
testl %eax,%eax
je .nexton // No, jump to next on...
... code for on handler...
.nexton
...
}
emitl(A_LABEL,lastonlabel);
{ default handling }
if assigned(p^.t1) then
@ -616,7 +608,37 @@ je .nexton // No, jump to next on...
else
emitcall('FPC_RERAISE',true);
emitl(A_LABEL,endexceptlabel);
endexceptlabel:=oldendexceptlabel;
end;
procedure secondon(var p : ptree);
var
nextonlabel,myendexceptlabel : plabel;
ref : treference;
begin
getlabel(nextonlabel);
emitcall('FPC_CATCHES',true);
exprasmlist^.concat(new(pai386,
op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
emitl(A_JE,nextonlabel);
ref.symbol:=nil;
gettempofsizereference(4,ref);
{ what a hack ! }
pvarsym(p^.exceptsymtable^.root)^.address:=ref.offset;
emitpushreferenceaddr(exprasmlist,ref);
emitcall('FPC_LOADEXCEPTIONPOINTER',true);
if assigned(p^.right) then
secondpass(p^.right);
{ clear some stuff }
ungetiftemp(ref);
emitl(A_JMP,endexceptlabel);
emitl(A_LABEL,nextonlabel);
{ next on node }
if assigned(p^.left) then
secondpass(p^.left);
end;
{*****************************************************************************
@ -663,7 +685,6 @@ je .nexton // No, jump to next on...
op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
emitl(A_JE,noreraiselabel);
emitcall('FPC_RERAISE',true);
emitl(A_JMP,endfinallylabel);
emitl(A_LABEL,noreraiselabel);
emitcall('FPC_POPADDRSTACK',true);
emitl(A_LABEL,endfinallylabel);
@ -699,7 +720,11 @@ je .nexton // No, jump to next on...
end.
{
$Log$
Revision 1.6 1998-07-29 13:29:11 michael
Revision 1.7 1998-07-30 11:18:13 florian
+ first implementation of try ... except on .. do end;
* limitiation of 65535 bytes parameters for cdecl removed
Revision 1.6 1998/07/29 13:29:11 michael
+ Corrected try.. code. Type of exception fram is pushed
Revision 1.5 1998/07/28 21:52:49 florian

9
compiler/cgi386.pas
View File

@ -223,7 +223,8 @@ implementation
secondstatement,secondnothing,secondifn,secondbreakn,
secondcontinuen,second_while_repeatn,second_while_repeatn,secondfor,
secondexitn,secondwith,secondcase,secondlabel,
secondgoto,secondsimplenewdispose,secondtryexcept,secondraise,
secondgoto,secondsimplenewdispose,secondtryexcept,
secondon,secondraise,
secondnothing,secondtryfinally,secondis,secondas,seconderror,
secondfail,secondadd,secondprocinline,
secondnothing,secondloadvmt);
@ -505,7 +506,11 @@ implementation
end.
{
$Log$
Revision 1.43 1998-07-28 21:52:50 florian
Revision 1.44 1998-07-30 11:18:15 florian
+ first implementation of try ... except on .. do end;
* limitiation of 65535 bytes parameters for cdecl removed
Revision 1.43 1998/07/28 21:52:50 florian
+ implementation of raise and try..finally
+ some misc. exception stuff

67
compiler/pass_1.pas
View File

@ -4764,11 +4764,36 @@ unit pass_1;
procedure firsttryexcept(var p : ptree);
begin
cleartempgen;
firstpass(p^.left);
{ on statements }
if assigned(p^.right) then
begin
cleartempgen;
firstpass(p^.right);
p^.registers32:=max(p^.registers32,p^.right^.registers32);
p^.registersfpu:=max(p^.registersfpu,p^.right^.registersfpu);
{$ifdef SUPPORT_MMX}
p^.registersmmx:=max(p^.registersmmx,p^.right^.registersmmx);
{$endif SUPPORT_MMX}
end;
{ else block }
if assigned(p^.t1) then
begin
firstpass(p^.right);
p^.registers32:=max(p^.registers32,p^.t1^.registers32);
p^.registersfpu:=max(p^.registersfpu,p^.t1^.registersfpu);
{$ifdef SUPPORT_MMX}
p^.registersmmx:=max(p^.registersmmx,p^.t1^.registersmmx);
{$endif SUPPORT_MMX}
end;
end;
procedure firsttryfinally(var p : ptree);
begin
p^.resulttype:=voiddef;
cleartempgen;
must_be_valid:=true;
firstpass(p^.left);
@ -4916,6 +4941,39 @@ unit pass_1;
end;
end;
procedure firstonn(var p : ptree);
begin
{ that's really an example procedure for a firstpass :) }
cleartempgen;
p^.resulttype:=voiddef;
p^.registers32:=0;
p^.registersfpu:=0;
{$ifdef SUPPORT_MMX}
p^.registersmmx:=0;
{$endif SUPPORT_MMX}
if assigned(p^.left) then
begin
firstpass(p^.left);
p^.registers32:=p^.left^.registers32;
p^.registersfpu:=p^.left^.registersfpu;
{$ifdef SUPPORT_MMX}
p^.registersmmx:=p^.left^.registersmmx;
{$endif SUPPORT_MMX}
end;
cleartempgen;
if assigned(p^.right) then
begin
firstpass(p^.right);
p^.registers32:=max(p^.registers32,p^.right^.registers32);
p^.registersfpu:=max(p^.registersfpu,p^.right^.registersfpu);
{$ifdef SUPPORT_MMX}
p^.registersmmx:=max(p^.registersmmx,p^.right^.registersmmx);
{$endif SUPPORT_MMX}
end;
end;
procedure firstprocinline(var p : ptree);
begin
@ -5025,7 +5083,8 @@ unit pass_1;
firststatement,firstnothing,firstif,firstnothing,
firstnothing,first_while_repeat,first_while_repeat,firstfor,
firstexitn,firstwith,firstcase,firstlabel,
firstgoto,firstsimplenewdispose,firsttryexcept,firstraise,
firstgoto,firstsimplenewdispose,firsttryexcept,
firstonn,firstraise,
firstnothing,firsttryfinally,firstis,firstas,firstadd,
firstnothing,firstadd,firstprocinline,firstnothing,firstloadvmt);
@ -5114,7 +5173,11 @@ unit pass_1;
end.
{
$Log$
Revision 1.46 1998-07-28 21:52:52 florian
Revision 1.47 1998-07-30 11:18:17 florian
+ first implementation of try ... except on .. do end;
* limitiation of 65535 bytes parameters for cdecl removed
Revision 1.46 1998/07/28 21:52:52 florian
+ implementation of raise and try..finally
+ some misc. exception stuff

99
compiler/pstatmnt.pas
View File

@ -478,10 +478,14 @@ unit pstatmnt;
var
p_try_block,p_finally_block,first,last,
p_default,e1,e2,p_specific : ptree;
p_default,p_specific : ptree;
ot : pobjectdef;
sym : pvarsym;
old_in_except_block : boolean;
exceptsymtable : psymtable;
begin
procinfo.flags:=procinfo.flags or
pi_uses_exceptions;
@ -530,31 +534,98 @@ unit pstatmnt;
if token=_ON then
{ catch specific exceptions }
begin
p_specific:=nil;
repeat
consume(_ON);
e1:=comp_expr(true);
if token=COLON then
if token=ID then
begin
consume(COLON);
e2:=comp_expr(true);
{ !!!!! }
getsym(pattern,false);
{ is a explicit name for the exception given ? }
if not(assigned(srsym)) then
begin
sym:=new(pvarsym,init(pattern,nil));
exceptsymtable:=new(psymtable,init(stt_exceptsymtable));
exceptsymtable^.insert(sym);
consume(COLON);
getsym(pattern,false);
consume(ID);
if srsym^.typ=unitsym then
begin
consume(POINT);
getsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
consume(ID);
end;
if (srsym^.typ=typesym) and
(ptypesym(srsym)^.definition^.deftype=objectdef) and
pobjectdef(ptypesym(srsym)^.definition)^.isclass then
ot:=pobjectdef(ptypesym(srsym)^.definition)
else
begin
message(parser_e_class_type_expected);
ot:=pobjectdef(generrordef);
end;
sym^.definition:=ot;
{ insert the exception symtable stack }
exceptsymtable^.next:=symtablestack;
symtablestack^.next:=exceptsymtable;
end
else
begin
{ only exception type }
if srsym^.typ=unitsym then
begin
consume(POINT);
getsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
consume(ID);
end;
consume(ID);
if (srsym^.typ=typesym) and
(ptypesym(srsym)^.definition^.deftype=objectdef) and
pobjectdef(ptypesym(srsym)^.definition)^.isclass then
ot:=pobjectdef(ptypesym(srsym)^.definition)
else
begin
message(parser_e_class_type_expected);
ot:=pobjectdef(generrordef);
end;
exceptsymtable:=nil;
end;
end
else
consume(ID);
consume(_DO);
statement;
if p_specific=nil then
begin
last:=gennode(onn,nil,statement);
p_specific:=last;
end
else
begin
{ !!!!! }
last^.left:=gennode(onn,nil,statement);
last:=last^.left;
end;
consume(_DO);
statement;
{ set the informations }
last^.excepttype:=ot;
last^.exceptsymtable:=exceptsymtable;
{ remove exception symtable }
if assigned(exceptsymtable) then
dellexlevel;
if token<>SEMICOLON then
break;
consume(SEMICOLON);
emptystats;
until false;
until (token=_END) or(token=_ELSE);
if token=_ELSE then
{ catch the other exceptions }
begin
consume(_ELSE);
p_default:=statements_til_end;
end;
end
else
consume(_END);
end
else
{ catch all exceptions }
@ -1171,7 +1242,11 @@ unit pstatmnt;
end.
{
$Log$
Revision 1.27 1998-07-28 21:52:55 florian
Revision 1.28 1998-07-30 11:18:18 florian
+ first implementation of try ... except on .. do end;
* limitiation of 65535 bytes parameters for cdecl removed
Revision 1.27 1998/07/28 21:52:55 florian
+ implementation of raise and try..finally
+ some misc. exception stuff

10
compiler/symsym.inc
View File

@ -981,6 +981,10 @@
l:=getsize;
case owner^.symtabletype of
stt_exceptsymtable:
{ can contain only one symbol, address calculated later }
;
localsymtable : begin
is_valid := 0;
modulo:=owner^.datasize and 3;
@ -1646,7 +1650,11 @@
{
$Log$
Revision 1.24 1998-07-20 18:40:16 florian
Revision 1.25 1998-07-30 11:18:19 florian
+ first implementation of try ... except on .. do end;
* limitiation of 65535 bytes parameters for cdecl removed
Revision 1.24 1998/07/20 18:40:16 florian
* handling of ansi string constants should now work
Revision 1.23 1998/07/14 21:37:24 peter

13
compiler/todo.txt
View File

@ -23,9 +23,14 @@ compiler version and your short cut.
- correct handling of access specifiers ........................ 0.99.7 (FK)
- interface
* rtti
- generation
- use when copying etc.
* AnsiString, LongString and WideString
- generation ........................................... 0.99.7 (FK)
- use when copying etc. ................................ 0.99.7 (FK)
- new/dispose should look for rtti'ed data
* AnsiString
- operators
- indexed access
- type conversations
* LongString and WideString
* MMX support by the compiler
- unary minus .......................................... 0.99.1 (FK)
- proper handling of fixed type ........................ 0.99.1 (FK)
@ -49,6 +54,8 @@ compiler version and your short cut.
- subrange types of enumerations
- method pointers (procedure of object)
- code generation for exceptions
- assertation
- sysutils unit for go32v2 (excpetions!)
- initialisation/finalization for units
- fixed data type
- add abstract virtual method runtime

8
compiler/tree.pas
View File

@ -114,6 +114,7 @@ unit tree;
raisen, {A raise statement.}
switchesn, {??? Currently unused...}
tryfinallyn, {A try finally statement.}
onn, { for an on statement in exception code }
isn, {Represents the is operator.}
asn, {Represents the as typecast.}
caretn, {Represents the ^ operator.}
@ -232,6 +233,7 @@ unit tree;
casen : (nodes : pcaserecord;elseblock : ptree);
labeln,goton : (labelnr : plabel);
withn : (withsymtable : psymtable;tablecount : longint);
onn : (exceptsymtable : psymtable;excepttype : pobjectdef);
end;
procedure init_tree;
@ -1596,7 +1598,11 @@ unit tree;
end.
{
$Log$
Revision 1.23 1998-07-24 22:17:01 florian
Revision 1.24 1998-07-30 11:18:23 florian
+ first implementation of try ... except on .. do end;
* limitiation of 65535 bytes parameters for cdecl removed
Revision 1.23 1998/07/24 22:17:01 florian
* internal error 10 together with array access fixed. I hope
that's the final fix.