Browse Source

* final implemenation of exception support, maybe it needs
some fixes :)

florian 27 years ago
parent
commit
a1f903d4b1
6 changed files with 72 additions and 31 deletions
  1. 6 2
      compiler/cg386cal.pas
  2. 18 4
      compiler/cg386flw.pas
  3. 26 16
      compiler/cg386ld.pas
  4. 8 3
      compiler/cgi386.pas
  5. 7 3
      compiler/pass_1.pas
  6. 7 3
      compiler/pstatmnt.pas

+ 6 - 2
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.
 

+ 18 - 4
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;
+         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))));
 
-         emitpushreferenceaddr(exprasmlist,ref);
-         emitcall('FPC_LOADEXCEPTIONPOINTER',true);
          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
 

+ 26 - 16
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

+ 8 - 3
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
 

+ 7 - 3
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
 

+ 7 - 3
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