* System.TypeInfo fixed

  + System.Finalize implemented
  + some new keywords for interface support added

compiler/compinnr.inc

@@ -54,6 +54,7 @@ const
    in_addr_x            = 42;
    in_typeinfo_x        = 43;
    in_setlength_x       = 44;
+   in_finalize_x        = 45;
 
 { Internal constant functions }
    in_const_trunc      = 100;
@@ -101,7 +102,12 @@ const
 
 {
   $Log$
-  Revision 1.1  2000-11-04 16:48:32  florian
+  Revision 1.2  2000-11-09 17:46:54  florian
+    * System.TypeInfo fixed
+    + System.Finalize implemented
+    + some new keywords for interface support added
+
+  Revision 1.1  2000/11/04 16:48:32  florian
     * innr.inc renamed to make compiler compilation easier because the rtl contains
       a file of the same name
 
@@ -118,4 +124,4 @@ const
   Revision 1.2  2000/07/13 11:32:43  michael
   + removed logs
 
-}
+}

compiler/i386/n386inl.pas

@@ -1305,6 +1305,7 @@ implementation
                 emitoverflowcheck(tcallparanode(left).left);
                 emitrangecheck(tcallparanode(left).left,tcallparanode(left).left.resulttype);
               end;
+
             in_typeinfo_x:
                begin
                   pstoreddef(ttypenode(tcallparanode(left).left).typenodetype)^.generate_rtti;
@@ -1312,8 +1313,41 @@ implementation
                   new(r);
                   reset_reference(r^);
                   r^.symbol:=pstoreddef(ttypenode(tcallparanode(left).left).typenodetype)^.rtti_label;
-                  emit_ref_reg(A_MOV,S_L,r,location.register);
+                  emit_ref_reg(A_LEA,S_L,r,location.register);
                end;
+
+             in_finalize_x:
+               begin
+                  pushusedregisters(pushed,$ff);
+                  { force rtti generation }
+                  pstoreddef(ttypenode(tcallparanode(left).left).resulttype)^.generate_rtti;
+                  { if a count is passed, push size, typeinfo and count }
+                  if assigned(tcallparanode(left).right) then
+                    begin
+                       secondpass(tcallparanode(tcallparanode(left).right).left);
+                       push_int(tcallparanode(left).left.resulttype^.size);
+                       if codegenerror then
+                        exit;
+                       emit_push_loc(tcallparanode(tcallparanode(left).right).left.location);
+                    end;
+
+                  { generate a reference }
+                  reset_reference(hr);
+                  hr.symbol:=pstoreddef(ttypenode(tcallparanode(left).left).resulttype)^.rtti_label;
+                  emitpushreferenceaddr(hr);
+
+                  { data to finalize }
+                  secondpass(tcallparanode(left).left);
+                  if codegenerror then
+                    exit;
+                  emitpushreferenceaddr(tcallparanode(left).left.location.reference);
+                  if assigned(tcallparanode(left).right) then
+                    emitcall('FPC_FINALIZEARRAY')
+                  else
+                    emitcall('FPC_FINALIZE');
+                  popusedregisters(pushed);
+               end;
+
             in_assigned_x :
               begin
                  secondpass(tcallparanode(left).left);
@@ -1629,7 +1663,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.4  2000-10-31 22:02:56  peter
+  Revision 1.5  2000-11-09 17:46:56  florian
+    * System.TypeInfo fixed
+    + System.Finalize implemented
+    + some new keywords for interface support added
+
+  Revision 1.4  2000/10/31 22:02:56  peter
     * symtable splitted, no real code changes
 
   Revision 1.3  2000/10/26 14:15:07  jonas

compiler/ninl.pas

@@ -711,6 +711,33 @@ implementation
                     CGMessage(type_e_mismatch);
                end;
 
+             in_finalize_x:
+               begin
+                  resulttype:=voiddef;
+                  if assigned(left) and assigned(tcallparanode(left).left) then
+                    begin
+                       firstpass(tcallparanode(left).left);
+                       if codegenerror then
+                        exit;
+                       { first param must be var }
+                       valid_for_assign(tcallparanode(left).left,false);
+                       set_varstate(tcallparanode(left).left,true);
+
+                       { two parameters? }
+                       if assigned(tcallparanode(left).right) then
+                         begin
+                            { the last parameter must be a longint }
+                            tcallparanode(tcallparanode(left).right).left:=
+                              gentypeconvnode(tcallparanode(tcallparanode(left).right).left,s32bitdef);
+                            firstpass(tcallparanode(tcallparanode(left).right).left);
+                            if codegenerror then
+                             exit;
+                         end;
+                    end
+                  else
+                    CGMessage(type_e_mismatch);
+               end;
+
              in_inc_x,
              in_dec_x:
                begin
@@ -1464,7 +1491,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.13  2000-11-04 16:48:32  florian
+  Revision 1.14  2000-11-09 17:46:54  florian
+    * System.TypeInfo fixed
+    + System.Finalize implemented
+    + some new keywords for interface support added
+
+  Revision 1.13  2000/11/04 16:48:32  florian
     * innr.inc renamed to make compiler compilation easier because the rtl contains
       a file of the same name
 

compiler/pexpr.pas

@@ -468,6 +468,24 @@ implementation
               pd:=voiddef;
             end;
 
+          in_finalize_x:
+            begin
+              consume(_LKLAMMER);
+              in_args:=true;
+              p1:=comp_expr(true);
+              if token=_COMMA then
+               begin
+                 consume(_COMMA);
+                 p2:=gencallparanode(comp_expr(true),nil);
+               end
+              else
+               p2:=nil;
+              p2:=gencallparanode(p1,p2);
+              statement_syssym:=geninlinenode(in_finalize_x,false,p2);
+              consume(_RKLAMMER);
+              pd:=voiddef;
+            end;
+
           in_concat_x :
             begin
               consume(_LKLAMMER);
@@ -2372,7 +2390,12 @@ _LECKKLAMMER : begin
 end.
 {
   $Log$
-  Revision 1.16  2000-11-06 20:30:55  peter
+  Revision 1.17  2000-11-09 17:46:55  florian
+    * System.TypeInfo fixed
+    + System.Finalize implemented
+    + some new keywords for interface support added
+
+  Revision 1.16  2000/11/06 20:30:55  peter
     * more fixes to get make cycle working
 
   Revision 1.15  2000/11/04 14:25:20  florian

compiler/psystem.pas

@@ -74,6 +74,7 @@ begin
   p^.insert(new(psyssym,init('Addr',in_addr_x)));
   p^.insert(new(psyssym,init('TypeInfo',in_typeinfo_x)));
   p^.insert(new(psyssym,init('SetLength',in_setlength_x)));
+  p^.insert(new(psyssym,init('Finalize',in_finalize_x)));
 end;
 
 
@@ -258,7 +259,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.8  2000-10-31 22:02:51  peter
+  Revision 1.9  2000-11-09 17:46:56  florian
+    * System.TypeInfo fixed
+    + System.Finalize implemented
+    + some new keywords for interface support added
+
+  Revision 1.8  2000/10/31 22:02:51  peter
     * symtable splitted, no real code changes
 
   Revision 1.7  2000/10/21 18:16:12  florian

compiler/tokens.pas

@@ -148,6 +148,7 @@ type
     _UNTIL,
     _WHILE,
     _WRITE,
+    _DISPID,
     _DOWNTO,
     _EXCEPT,
     _EXPORT,
@@ -204,6 +205,7 @@ type
     _PUBLISHED,
     _THREADVAR,
     _DESTRUCTOR,
+    _IMPLEMENTS,
     _INTERNPROC,
     _OPENSTRING,
     _CONSTRUCTOR,
@@ -211,6 +213,7 @@ type
     _REINTRODUCE,
     _SHORTSTRING,
     _FINALIZATION,
+    _DISPINTERFACE,
     _SAVEREGISTERS,
     _IMPLEMENTATION,
     _INITIALIZATION,
@@ -353,6 +356,7 @@ const
       (str:'UNTIL'         ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'WHILE'         ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'WRITE'         ;special:false;keyword:m_none;op:NOTOKEN),
+      (str:'DISPID'        ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'DOWNTO'        ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'EXCEPT'        ;special:false;keyword:m_class;op:NOTOKEN),
       (str:'EXPORT'        ;special:false;keyword:m_none;op:NOTOKEN),
@@ -409,6 +413,7 @@ const
       (str:'PUBLISHED'     ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'THREADVAR'     ;special:false;keyword:m_class;op:NOTOKEN),
       (str:'DESTRUCTOR'    ;special:false;keyword:m_all;op:NOTOKEN),
+      (str:'IMPLEMENTS'    ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'INTERNPROC'    ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'OPENSTRING'    ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'CONSTRUCTOR'   ;special:false;keyword:m_all;op:NOTOKEN),
@@ -416,6 +421,7 @@ const
       (str:'REINTRODUCE'   ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'SHORTSTRING'   ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'FINALIZATION'  ;special:false;keyword:m_initfinal;op:NOTOKEN),
+      (str:'DISPINTERFACE' ;special:false;keyword:m_class;op:NOTOKEN),
       (str:'SAVEREGISTERS' ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'IMPLEMENTATION';special:false;keyword:m_all;op:NOTOKEN),
       (str:'INITIALIZATION';special:false;keyword:m_initfinal;op:NOTOKEN),
@@ -468,7 +474,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.5  2000-10-14 10:14:56  peter
+  Revision 1.6  2000-11-09 17:46:56  florian
+    * System.TypeInfo fixed
+    + System.Finalize implemented
+    + some new keywords for interface support added
+
+  Revision 1.5  2000/10/14 10:14:56  peter
     * moehrendorf oct 2000 rewrite
 
   Revision 1.4  2000/09/24 15:06:32  peter