From a1f903d4b198d7026c50ef07ff50bf83c57de7b9 Mon Sep 17 00:00:00 2001 From: florian Date: Thu, 30 Jul 1998 13:30:31 +0000 Subject: [PATCH] * final implemenation of exception support, maybe it needs some fixes :) --- compiler/cg386cal.pas | 8 ++++++-- compiler/cg386flw.pas | 24 +++++++++++++++++++----- compiler/cg386ld.pas | 42 ++++++++++++++++++++++++++---------------- compiler/cgi386.pas | 11 ++++++++--- compiler/pass_1.pas | 10 +++++++--- compiler/pstatmnt.pas | 10 +++++++--- 6 files changed, 73 insertions(+), 32 deletions(-) diff --git a/compiler/cg386cal.pas b/compiler/cg386cal.pas index 6be0bd3699..739e01498b 100644 --- a/compiler/cg386cal.pas +++ b/compiler/cg386cal.pas @@ -810,7 +810,7 @@ implementation exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI))); { insert the vmt } exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L, - newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0)))); + newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0)))); maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner, pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname); extended_new:=true; @@ -2290,7 +2290,11 @@ implementation end. { $Log$ - Revision 1.11 1998-07-24 22:16:52 florian + Revision 1.12 1998-07-30 13:30:31 florian + * final implemenation of exception support, maybe it needs + some fixes :) + + Revision 1.11 1998/07/24 22:16:52 florian * internal error 10 together with array access fixed. I hope that's the final fix. diff --git a/compiler/cg386flw.pas b/compiler/cg386flw.pas index 14894e2879..708fccba11 100644 --- a/compiler/cg386flw.pas +++ b/compiler/cg386flw.pas @@ -619,17 +619,27 @@ do_jmp: begin getlabel(nextonlabel); + + { push the vmt } + exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L, + newcsymbol(p^.excepttype^.vmt_mangledname,0)))); + maybe_concat_external(p^.excepttype^.owner, + p^.excepttype^.vmt_mangledname); + 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); + { what a hack ! } + if assigned(p^.exceptsymtable) then + pvarsym(p^.exceptsymtable^.root)^.address:=ref.offset; + + exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L, + R_EAX,newreference(ref)))); + if assigned(p^.right) then secondpass(p^.right); { clear some stuff } @@ -720,7 +730,11 @@ do_jmp: end. { $Log$ - Revision 1.7 1998-07-30 11:18:13 florian + Revision 1.8 1998-07-30 13:30:32 florian + * final implemenation of exception support, maybe it needs + some fixes :) + + 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 diff --git a/compiler/cg386ld.pas b/compiler/cg386ld.pas index 333933805d..4da60c6a12 100644 --- a/compiler/cg386ld.pas +++ b/compiler/cg386ld.pas @@ -142,21 +142,27 @@ implementation if symtabletype=unitsymtable then concat_external(p^.symtableentry^.mangledname,EXT_NEAR); end; - objectsymtable : begin - if (pvarsym(p^.symtableentry)^.properties and sp_static)<>0 then - begin - stringdispose(p^.location.reference.symbol); - p^.location.reference.symbol:= - stringdup(p^.symtableentry^.mangledname); - if p^.symtable^.defowner^.owner^.symtabletype=unitsymtable then - concat_external(p^.symtableentry^.mangledname,EXT_NEAR); - end - else - begin - p^.location.reference.base:=R_ESI; - p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address; - end; - end; + stt_exceptsymtable: + begin + p^.location.reference.base:=procinfo.framepointer; + p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address; + end; + objectsymtable: + begin + if (pvarsym(p^.symtableentry)^.properties and sp_static)<>0 then + begin + stringdispose(p^.location.reference.symbol); + p^.location.reference.symbol:= + stringdup(p^.symtableentry^.mangledname); + if p^.symtable^.defowner^.owner^.symtabletype=unitsymtable then + concat_external(p^.symtableentry^.mangledname,EXT_NEAR); + end + else + begin + p^.location.reference.base:=R_ESI; + p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address; + end; + end; withsymtable: begin hregister:=getregister32; @@ -559,7 +565,11 @@ implementation end. { $Log$ - Revision 1.6 1998-07-26 21:58:57 florian + Revision 1.7 1998-07-30 13:30:33 florian + * final implemenation of exception support, maybe it needs + some fixes :) + + Revision 1.6 1998/07/26 21:58:57 florian + better support for switch $H + index access to ansi strings added + assigment of data (records/arrays) containing ansi strings diff --git a/compiler/cgi386.pas b/compiler/cgi386.pas index 60795eaf92..5defa4cd61 100644 --- a/compiler/cgi386.pas +++ b/compiler/cgi386.pas @@ -224,8 +224,9 @@ implementation secondcontinuen,second_while_repeatn,second_while_repeatn,secondfor, secondexitn,secondwith,secondcase,secondlabel, secondgoto,secondsimplenewdispose,secondtryexcept, - secondon,secondraise, - secondnothing,secondtryfinally,secondis,secondas,seconderror, + secondraise, + secondnothing,secondtryfinally,secondon,secondis, + secondas,seconderror, secondfail,secondadd,secondprocinline, secondnothing,secondloadvmt); var @@ -506,7 +507,11 @@ implementation end. { $Log$ - Revision 1.44 1998-07-30 11:18:15 florian + Revision 1.45 1998-07-30 13:30:34 florian + * final implemenation of exception support, maybe it needs + some fixes :) + + 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 diff --git a/compiler/pass_1.pas b/compiler/pass_1.pas index f705eac30e..1add65c778 100644 --- a/compiler/pass_1.pas +++ b/compiler/pass_1.pas @@ -5084,8 +5084,8 @@ unit pass_1; firstnothing,first_while_repeat,first_while_repeat,firstfor, firstexitn,firstwith,firstcase,firstlabel, firstgoto,firstsimplenewdispose,firsttryexcept, - firstonn,firstraise, - firstnothing,firsttryfinally,firstis,firstas,firstadd, + firstraise,firstnothing,firsttryfinally, + firstonn,firstis,firstas,firstadd, firstnothing,firstadd,firstprocinline,firstnothing,firstloadvmt); var @@ -5173,7 +5173,11 @@ unit pass_1; end. { $Log$ - Revision 1.47 1998-07-30 11:18:17 florian + Revision 1.48 1998-07-30 13:30:35 florian + * final implemenation of exception support, maybe it needs + some fixes :) + + 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 diff --git a/compiler/pstatmnt.pas b/compiler/pstatmnt.pas index 36f0e7bae6..2ee4ba4eb9 100644 --- a/compiler/pstatmnt.pas +++ b/compiler/pstatmnt.pas @@ -547,6 +547,7 @@ unit pstatmnt; sym:=new(pvarsym,init(pattern,nil)); exceptsymtable:=new(psymtable,init(stt_exceptsymtable)); exceptsymtable^.insert(sym); + consume(ID); consume(COLON); getsym(pattern,false); consume(ID); @@ -568,7 +569,7 @@ unit pstatmnt; sym^.definition:=ot; { insert the exception symtable stack } exceptsymtable^.next:=symtablestack; - symtablestack^.next:=exceptsymtable; + symtablestack:=exceptsymtable; end else begin @@ -595,7 +596,6 @@ unit pstatmnt; else consume(ID); consume(_DO); - statement; if p_specific=nil then begin last:=gennode(onn,nil,statement); @@ -1242,7 +1242,11 @@ unit pstatmnt; end. { $Log$ - Revision 1.28 1998-07-30 11:18:18 florian + Revision 1.29 1998-07-30 13:30:37 florian + * final implemenation of exception support, maybe it needs + some fixes :) + + 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