* first version of rtti support

compiler/cg386add.pas

@@ -142,10 +142,10 @@ implementation
                        pushusedregisters(pushedregs,$ff);
                        secondpass(p^.left);
                        del_reference(p^.left^.location.reference);
-                       emitpushreferenceaddr(p^.left^.location.reference);
+                       emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
                        secondpass(p^.right);
                        del_reference(p^.right^.location.reference);
-                       emitpushreferenceaddr(p^.right^.location.reference);
+                       emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
                        emitcall('ANSISTRCMP',true);
                        maybe_loadesi;
                        popusedregisters(pushedregs);
@@ -224,8 +224,8 @@ implementation
                     pushusedregisters(pushedregs,pstringdef(p^.left^.resulttype)^.len)
                   else
                     pushusedregisters(pushedregs,$ff);
-                  emitpushreferenceaddr(p^.left^.location.reference);
-                  emitpushreferenceaddr(p^.right^.location.reference);
+                  emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                  emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
                   emitcall('STRCONCAT',true);
                   maybe_loadesi;
                   popusedregisters(pushedregs);
@@ -265,10 +265,10 @@ implementation
                     pushusedregisters(pushedregs,$ff);
                     secondpass(p^.left);
                     del_reference(p^.left^.location.reference);
-                    emitpushreferenceaddr(p^.left^.location.reference);
+                    emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
                     secondpass(p^.right);
                     del_reference(p^.right^.location.reference);
-                    emitpushreferenceaddr(p^.right^.location.reference);
+                    emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
                     emitcall('STRCMP',true);
                     maybe_loadesi;
                     popusedregisters(pushedregs);
@@ -420,8 +420,8 @@ implementation
                      del_reference(p^.left^.location.reference);
                      del_reference(p^.right^.location.reference);
                      pushusedregisters(pushedregs,$ff);
-                     emitpushreferenceaddr(p^.right^.location.reference);
-                     emitpushreferenceaddr(p^.left^.location.reference);
+                     emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
+                     emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
                      emitcall('SET_COMP_SETS',true);
                      maybe_loadesi;
                      popusedregisters(pushedregs);
@@ -436,11 +436,11 @@ implementation
                      href.symbol:=nil;
                      pushusedregisters(pushedregs,$ff);
                      gettempofsizereference(32,href);
-                     emitpushreferenceaddr(href);
+                     emitpushreferenceaddr(exprasmlist,href);
                      { wrong place !! was hard to find out
                      pushusedregisters(pushedregs,$ff);}
-                     emitpushreferenceaddr(p^.right^.location.reference);
-                     emitpushreferenceaddr(p^.left^.location.reference);
+                     emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
+                     emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
                      case p^.treetype of
                        subn:
                          emitcall('SET_SUB_SETS',true);
@@ -1198,7 +1198,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.2  1998-06-08 13:13:28  pierre
+  Revision 1.3  1998-06-25 08:48:04  florian
+    * first version of rtti support
+
+  Revision 1.2  1998/06/08 13:13:28  pierre
     + temporary variables now in temp_gen.pas unit
       because it is processor independent
     * mppc68k.bat modified to undefine i386 and support_mmx

compiler/cg386cal.pas

@@ -147,7 +147,7 @@ implementation
                             R_EDI,r)));
                        end
                      else
-                        emitpushreferenceaddr(p^.left^.location.reference);
+                        emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
                         del_reference(p^.left^.location.reference);
                      end;
                 end;
@@ -168,7 +168,7 @@ implementation
                             R_EDI,r)));
                        end
                      else
-              emitpushreferenceaddr(p^.left^.location.reference);
+              emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
               del_reference(p^.left^.location.reference);
            end
          else
@@ -190,7 +190,7 @@ implementation
                             R_EDI,r)));
                        end
                      else
-                     emitpushreferenceaddr(p^.left^.location.reference);
+                     emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
                    del_reference(p^.left^.location.reference);
                 end
               else
@@ -431,7 +431,7 @@ implementation
                             R_EDI,r)));
                        end
                      else
-                                     emitpushreferenceaddr(p^.left^.location.reference);
+                                     emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
                                   end
                                 else
                                   begin
@@ -729,7 +729,7 @@ implementation
                      R_EDI,r)));
                 end
               else
-                emitpushreferenceaddr(funcretref);
+                emitpushreferenceaddr(exprasmlist,funcretref);
            end;
          { procedure variable ? }
          if (p^.right=nil) then
@@ -1996,7 +1996,7 @@ implementation
                   pushusedregisters(pushed,$ff);
                   exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,pfiledef(p^.left^.resulttype)^.typed_as^.size)));
                   secondload(p^.left);
-                  emitpushreferenceaddr(p^.left^.location.reference);
+                  emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
                   if p^.inlinenumber=in_reset_typedfile then
                     emitcall('RESET_TYPED',true)
                   else
@@ -2193,7 +2193,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.3  1998-06-09 16:01:33  pierre
+  Revision 1.4  1998-06-25 08:48:06  florian
+    * first version of rtti support
+
+  Revision 1.3  1998/06/09 16:01:33  pierre
     + added procedure directive parsing for procvars
       (accepted are popstack cdecl and pascal)
     + added C vars with the following syntax

compiler/cg386con.pas

@@ -300,7 +300,7 @@ implementation
                        if codegenerror then
                          exit;
                        pushsetelement(hp^.left);
-                       emitpushreferenceaddr(sref);
+                       emitpushreferenceaddr(exprasmlist,sref);
                        { register is save in subroutine }
                        emitcall('SET_SET_BYTE',true);
                        hp:=hp^.right;
@@ -328,7 +328,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.4  1998-06-08 13:13:31  pierre
+  Revision 1.5  1998-06-25 08:48:07  florian
+    * first version of rtti support
+
+  Revision 1.4  1998/06/08 13:13:31  pierre
     + temporary variables now in temp_gen.pas unit
       because it is processor independent
     * mppc68k.bat modified to undefine i386 and support_mmx

compiler/cg386flw.pas

@@ -530,7 +530,8 @@ do_jmp:
                 exit;
 
               case p^.left^.location.loc of
-                 LOC_MEM,LOC_REFERENCE : emitpushreferenceaddr(p^.left^.location.reference);
+                 LOC_MEM,LOC_REFERENCE:
+                   emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
                  LOC_CREGISTER,LOC_REGISTER : exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,
                        p^.left^.location.register)));
                  else Message(sym_e_type_mismatch);
@@ -589,7 +590,10 @@ do_jmp:
 end.
 {
   $Log$
-  Revision 1.2  1998-06-08 13:13:33  pierre
+  Revision 1.3  1998-06-25 08:48:08  florian
+    * first version of rtti support
+
+  Revision 1.2  1998/06/08 13:13:33  pierre
     + temporary variables now in temp_gen.pas unit
       because it is processor independent
     * mppc68k.bat modified to undefine i386 and support_mmx

compiler/cg386mem.pas

@@ -132,7 +132,8 @@ implementation
          case p^.left^.location.loc of
             LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,
               p^.left^.location.register)));
-            LOC_REFERENCE : emitpushreferenceaddr(p^.left^.location.reference);
+            LOC_REFERENCE:
+              emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
 
          end;
 
@@ -578,7 +579,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.2  1998-06-08 13:13:35  pierre
+  Revision 1.3  1998-06-25 08:48:09  florian
+    * first version of rtti support
+
+  Revision 1.2  1998/06/08 13:13:35  pierre
     + temporary variables now in temp_gen.pas unit
       because it is processor independent
     * mppc68k.bat modified to undefine i386 and support_mmx

compiler/cg386set.pas

@@ -395,7 +395,7 @@ implementation
                             if p^.swaped then
                               swaptree(p);
                             pushsetelement(p^.left);
-                            emitpushreferenceaddr(p^.right^.location.reference);
+                            emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
                             del_reference(p^.right^.location.reference);
                             { registers need not be save. that happens in SET_IN_BYTE }
                             { (EDI is changed) }
@@ -661,10 +661,8 @@ implementation
          cleartempgen;
          secondpass(p^.left);
          { determines the size of the operand }
-         { determines the size of the operand }
          opsize:=bytes2Sxx[p^.left^.resulttype^.size];
          { copy the case expression to a register }
-         { copy the case expression to a register }
          case p^.left^.location.loc of
             LOC_REGISTER,
             LOC_CREGISTER:
@@ -765,7 +763,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.2  1998-06-16 08:56:18  peter
+  Revision 1.3  1998-06-25 08:48:10  florian
+    * first version of rtti support
+
+  Revision 1.2  1998/06/16 08:56:18  peter
     + targetcpu
     * cleaner pmodules for newppu
 

compiler/files.pas

@@ -234,6 +234,7 @@ unit files;
        uf_shared_library = $10;
        uf_big_endian     = $20;
        uf_smartlink      = $40;
+       uf_finalize       = $80;
 {$endif}
 
     var
@@ -967,7 +968,10 @@ unit files;
 end.
 {
   $Log$
-  Revision 1.27  1998-06-24 14:48:34  peter
+  Revision 1.28  1998-06-25 08:48:12  florian
+    * first version of rtti support
+
+  Revision 1.27  1998/06/24 14:48:34  peter
     * ifdef newppu -> ifndef oldppu
 
   Revision 1.26  1998/06/17 14:36:19  peter

compiler/pass_1.pas

@@ -466,6 +466,25 @@ unit pass_1;
                 doconv:=tc_equal;
                 b:=true;
              end
+         else
+           { nil is compatible with ansi- and wide strings }
+           if (fromtreetype=niln) and (def_to^.deftype=stringdef)
+             and (pstringdef(def_to)^.string_typ in [ansistring,widestring]) then
+             begin
+                doconv:=tc_equal;
+                b:=true;
+             end
+         else
+           { ansi- and wide strings can be assigned to void pointers }
+           if (def_from^.deftype=stringdef) and
+             (pstringdef(def_from)^.string_typ in [ansistring,widestring]) and
+             (def_to^.deftype=pointerdef) and
+             (ppointerdef(def_to)^.definition^.deftype=orddef) and
+             (porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
+             begin
+                doconv:=tc_equal;
+                b:=true;
+             end
          { procedure variable can be assigned to an void pointer }
          { Not anymore. Use the @ operator now.}
          else
@@ -2797,9 +2816,19 @@ unit pass_1;
       function is_equal(def1,def2 : pdef) : boolean;
 
         begin
-           { all types can be passed to a  formaldef  }
+           { all types can be passed to a formaldef }
            is_equal:=(def1^.deftype=formaldef) or
-             (assigned(def2) and types.is_equal(def1,def2));
+             (assigned(def2) and types.is_equal(def1,def2))
+{$ifdef USEANSISTRING}
+           { to support ansi/long/wide strings in a proper way }
+           { string and string[10] are assumed as equal        }
+             or
+             (assigned(def1) and assigned(def2) and
+              (def1^.deftype=stringdef) and (def2^.deftype=stringdef) and
+              (pstringdef(def1)^.string_typ=pstringdef(def2)^.string_typ)
+             )
+{$endif USEANSISTRING}
+             ;
         end;
 
       function is_in_limit(def_from,def_to : pdef) : boolean;
@@ -3101,14 +3130,14 @@ unit pass_1;
                                   if not is_equal(hp^.nextpara^.data,pt^.resulttype) then
                                     begin
                                        def_to:=hp^.nextpara^.data;
-                                       if (def_from^.deftype=orddef) and (def_to^.deftype=orddef) then
-                                         if is_in_limit(def_from,def_to) or
-                                           ((hp^.nextpara^.paratyp=vs_var) and
-                                           (def_from^.size=def_to^.size)) then
-                                           begin
-                                              exactmatch:=true;
-                                              conv_to:=def_to;
-                                           end;
+                                       if ((def_from^.deftype=orddef) and (def_to^.deftype=orddef)) and
+                                         (is_in_limit(def_from,def_to) or
+                                         ((hp^.nextpara^.paratyp=vs_var) and
+                                         (def_from^.size=def_to^.size))) then
+                                         begin
+                                            exactmatch:=true;
+                                            conv_to:=def_to;
+                                         end;
                                     end;
                                   hp:=hp^.next;
                                end;
@@ -5018,7 +5047,10 @@ unit pass_1;
 end.
 {
   $Log$
-  Revision 1.33  1998-06-16 08:56:24  peter
+  Revision 1.34  1998-06-25 08:48:14  florian
+    * first version of rtti support
+
+  Revision 1.33  1998/06/16 08:56:24  peter
     + targetcpu
     * cleaner pmodules for newppu
 

compiler/pmodules.pas

@@ -122,6 +122,7 @@ unit pmodules;
 
 
     procedure inserttargetspecific;
+
       begin
 {$ifdef i386}
         case target_info.target of
@@ -943,7 +944,25 @@ unit pmodules;
 
          { Shutdown the codegen for this procedure }
          codegen_doneprocedure;
+{$ifdef dummy}
+         if token=_FINALIZATION then
+           begin
+              current_module^.flags:=current_module^.flags or uf_finalize;
+              { clear flags }
+              procinfo.flags:=0;
+
+              {Reset the codegenerator.}
+              codegen_newprocedure;
 
+              names.init;
+              names.insert(current_module^.modulename^+'_finalize');
+              names.insert('FINALIZE$$'+current_module^.modulename^);
+              compile_proc_body(names,true,false);
+              names.done;
+
+              codegen_doneprocedure;
+           end;
+{$endif dummy}
          consume(POINT);
 
          { size of the static data }
@@ -1131,7 +1150,10 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.31  1998-06-24 14:48:35  peter
+  Revision 1.32  1998-06-25 08:48:16  florian
+    * first version of rtti support
+
+  Revision 1.31  1998/06/24 14:48:35  peter
     * ifdef newppu -> ifndef oldppu
 
   Revision 1.30  1998/06/17 14:10:16  peter

compiler/pstatmnt.pas

@@ -815,7 +815,7 @@ unit pstatmnt;
       end;
 
 
-    function statement_block : ptree;
+    function statement_block(starttoken : ttoken) : ptree;
 
       var
          first,last : ptree;
@@ -824,10 +824,13 @@ unit pstatmnt;
       begin
          first:=nil;
          filepos:=tokenpos;
-         consume(_BEGIN);
+         consume(starttoken);
          inc(statement_level);
 
-         while token<>_END do
+         while not(
+             (token=_END) or
+             ((starttoken=_INITIALIZATION) and (token=_FINALIZATION))
+           ) do
            begin
               if first=nil then
                 begin
@@ -839,7 +842,8 @@ unit pstatmnt;
                    last^.left:=gennode(statementn,nil,statement);
                    last:=last^.left;
                 end;
-              if token=_END then
+              if (token=_END) or
+                ((starttoken=_INITIALIZATION) and (token=_FINALIZATION)) then
                 break
               else
                 begin
@@ -855,7 +859,13 @@ unit pstatmnt;
                 end;
               emptystats;
            end;
-         consume(_END);
+
+         { don't consume the finalization token, it is consumed when
+           reading the finalization block !
+         }
+         if token=_END then
+           consume(_END);
+
          dec(statement_level);
 
          last:=gensinglenode(blockn,first);
@@ -901,7 +911,7 @@ unit pstatmnt;
                                 plabelsym(srsym)^.number);
                          end;
                     end;
-            _BEGIN : code:=statement_block;
+            _BEGIN : code:=statement_block(_BEGIN);
             _IF    : code:=if_statement;
             _CASE  : code:=case_statement;
             _REPEAT : code:=repeat_statement;
@@ -916,11 +926,13 @@ unit pstatmnt;
             SEMICOLON,
             _ELSE,
             _UNTIL,
-            _END : code:=genzeronode(niln);
-            _CONTINUE : begin
-                           consume(_CONTINUE);
-                           code:=genzeronode(continuen);
-                        end;
+            _END:
+              code:=genzeronode(niln);
+            _CONTINUE:
+              begin
+                 consume(_CONTINUE);
+                 code:=genzeronode(continuen);
+              end;
             _FAIL : begin
                        { internalerror(100); }
                        if (aktprocsym^.definition^.options and poconstructor)=0 then
@@ -1065,19 +1077,37 @@ unit pstatmnt;
            end;
 
          {Unit initialization?.}
-         if (lexlevel=1) then
-            if (token=_END) then
-                begin
-                    consume(_END);
-                    block:=nil;
-                end
-            else
-                begin
-                    current_module^.flags:=current_module^.flags or uf_init;
-                    block:=statement_block;
-                end
+         if (lexlevel=1) and (current_module^.is_unit) then
+           if (token=_END) then
+             begin
+                consume(_END);
+                block:=nil;
+             end
+           else
+             begin
+                if token=_INITIALIZATION then
+                  begin
+                     current_module^.flags:=current_module^.flags or uf_init;
+                     block:=statement_block(_INITIALIZATION);
+                  end
+                else if (token=_FINALIZATION) then
+                  begin
+                     if (current_module^.flags and uf_finalize)<>0 then
+                       block:=statement_block(_FINALIZATION)
+                     else
+                       begin
+                          block:=nil;
+                          exit;
+                       end;
+                  end
+                else
+                  begin
+                     current_module^.flags:=current_module^.flags or uf_init;
+                     block:=statement_block(_BEGIN);
+                  end;
+             end
          else
-            block:=statement_block;
+            block:=statement_block(_BEGIN);
       end;
 
     function assembler_block : ptree;
@@ -1136,7 +1166,10 @@ unit pstatmnt;
 end.
 {
   $Log$
-  Revision 1.22  1998-06-24 14:48:36  peter
+  Revision 1.23  1998-06-25 08:48:18  florian
+    * first version of rtti support
+
+  Revision 1.22  1998/06/24 14:48:36  peter
     * ifdef newppu -> ifndef oldppu
 
   Revision 1.21  1998/06/24 14:06:34  peter

compiler/scanner.pas

@@ -44,7 +44,7 @@ unit scanner;
        ident = string[id_len];
 
     const
-      max_keywords = 69;
+      max_keywords = 70;
       anz_keywords : longint = max_keywords;
 
       { the following keywords are no keywords in TP, they
@@ -70,7 +70,7 @@ unit scanner;
 {        'EXTERNAL',}
          'FAIL','FALSE',
 {        'FAR',}
-         'FILE','FINALLY','FOR',
+         'FILE','FINALIZATION','FINALLY','FOR',
 {        'FORWARD',}
          'FUNCTION','GOTO','IF','IMPLEMENTATION','IN',
          'INHERITED','INITIALIZATION',
@@ -106,7 +106,7 @@ unit scanner;
 {        _EXTERNAL,}
          _FAIL,_FALSE,
 {        _FAR,}
-         _FILE,_FINALLY,_FOR,
+         _FILE,_FINALIZATION,_FINALLY,_FOR,
 {        _FORWARD,}
          _FUNCTION,_GOTO,_IF,_IMPLEMENTATION,_IN,
          _INHERITED,_INITIALIZATION,
@@ -1231,10 +1231,10 @@ unit scanner;
    procedure change_to_tp_keywords;
 
      const
-        non_tp : array[0..13] of string[id_len] = (
+        non_tp : array[0..14] of string[id_len] = (
           'AS','CLASS','EXCEPT','FINALLY','INITIALIZATION','IS',
           'ON','OPERATOR','OTHERWISE','PROPERTY','RAISE','TRY',
-          'EXPORTS','LIBRARY');
+          'EXPORTS','LIBRARY','FINALIZATION');
 
      var
         i : longint;
@@ -1267,7 +1267,10 @@ unit scanner;
 end.
 {
   $Log$
-  Revision 1.26  1998-06-16 08:56:30  peter
+  Revision 1.27  1998-06-25 08:48:19  florian
+    * first version of rtti support
+
+  Revision 1.26  1998/06/16 08:56:30  peter
     + targetcpu
     * cleaner pmodules for newppu
 

compiler/systems.pas

@@ -583,21 +583,12 @@ implementation
             short_name  : 'GO32V2';
             unit_env    : 'GO32V2UNITS';
             system_unit : 'SYSTEM';
-{$ifndef UseAnsiString}
             smartext    : '.SL';
             unitext     : '.PPU';
             unitlibext  : '.PPL';
             asmext      : '.S';
             objext      : '.O';
             exeext      : '.EXE';
-{$else UseAnsiString}
-            smartext    : '.SL';
-            unitext     : '.PAU';
-            unitlibext  : '.PPL';
-            asmext      : '.SA';
-            objext      : '.OA';
-            exeext      : '.EXE';
-{$endif UseAnsiString}
             os          : os_GO32V2;
             link        : link_ldgo32v2;
             assem       : as_o;
@@ -875,7 +866,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.22  1998-06-17 14:10:21  peter
+  Revision 1.23  1998-06-25 08:48:20  florian
+    * first version of rtti support
+
+  Revision 1.22  1998/06/17 14:10:21  peter
     * small os2 fixes
     * fixed interdependent units with newppu (remake3 under linux works now)