* handling of private and protected fixed

  + change_keywords_to_tp implemented to remove
    keywords which aren't supported by tp
  * break and continue are now symbols of the system unit
  + widestring, longstring and ansistring type released

compiler/cgi386.pas

@@ -1624,16 +1624,18 @@ implementation
               { call shortstring to ansistring conversion }
               { result is in register }
               del_reference(p^.left^.location.reference);
+              {!!!!
               copyshortstringtoansistring(p^.location,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
+              }
               ungetiftemp(p^.left^.location.reference);
            end
-         else if not is_ansistring(p^.resulttype) and is_ansistring(p^.left.resulttype) then
+         else if not is_ansistring(p^.resulttype) and is_ansistring(p^.left^.resulttype) then
            begin
               { call ansistring to shortstring conversion }
               { result is in mem }
               stringdispose(p^.location.reference.symbol);
               gettempofsizereference(p^.resulttype^.size,p^.location.reference);
-              if p^.left^.location.locin [LOC_MEM,LOC_REFERENCE] then
+              if p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE] then
                 del_reference(p^.left^.location.reference);
               copyansistringtoshortstring(p^.location.reference,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
               ungetiftemp(p^.left^.location.reference);
@@ -2296,11 +2298,10 @@ implementation
 {$ifdef UseAnsiString}
               if is_ansistring(p^.left^.resulttype) then
                 begin
-
-                  { we do not need destination anymore }
-                  del_reference(p^.left^.location.reference);
-                  { only source if withresult is set }
-                  del_reference(p^.right^.location.reference);
+                  { the source and destinations are released
+                    in loadansistring, because an ansi string can
+                    also be in a register
+                  }
                   loadansistring(p);
                 end
               else
@@ -2309,7 +2310,6 @@ implementation
                 begin
                   { we do not need destination anymore }
                   del_reference(p^.left^.location.reference);
-                  { only source if withresult is set }
                   del_reference(p^.right^.location.reference);
                   loadstring(p);
                   ungetiftemp(p^.right^.location.reference);
@@ -3971,7 +3971,7 @@ implementation
                  set_location(p^.location,p^.left^.location);
                  { length in ansi strings is at offset -8 }
 {$ifdef UseAnsiString}
-                 if is_ansistring(p^.left^.resultype)) then
+                 if is_ansistring(p^.left^.resulttype) then
                    dec(p^.location.reference.offset,8);
 {$endif UseAnsiString}
               end;
@@ -6033,7 +6033,14 @@ do_jmp:
 end.
 {
   $Log$
-  Revision 1.19  1998-04-30 15:59:39  pierre
+  Revision 1.20  1998-05-01 16:38:44  florian
+    * handling of private and protected fixed
+    + change_keywords_to_tp implemented to remove
+      keywords which aren't supported by tp
+    * break and continue are now symbols of the system unit
+    + widestring, longstring and ansistring type released
+
+  Revision 1.19  1998/04/30 15:59:39  pierre
     * GDB works again better :
       correct type info in one pass
     + UseTokenInfo for better source position

compiler/cgi386ad.inc

@@ -223,7 +223,7 @@
                        { we do not need destination anymore }
                        del_reference(p^.left^.location.reference);
                        del_reference(p^.right^.location.reference);
-                       concatansistring(p);
+                       { concatansistring(p); }
                     end;
                   ltn,lten,gtn,gten,
                   equaln,unequaln :
@@ -1271,7 +1271,14 @@
 
 {
      $Log$
-     Revision 1.6  1998-04-30 15:59:40  pierre
+     Revision 1.7  1998-05-01 16:38:44  florian
+       * handling of private and protected fixed
+       + change_keywords_to_tp implemented to remove
+         keywords which aren't supported by tp
+       * break and continue are now symbols of the system unit
+       + widestring, longstring and ansistring type released
+
+     Revision 1.6  1998/04/30 15:59:40  pierre
        * GDB works again better :
          correct type info in one pass
        + UseTokenInfo for better source position

compiler/files.pas

@@ -188,6 +188,7 @@ unit files;
        iblongstringdef = 32;
        ibansistringdef = 33;
        ibunitname      = 34;
+       ibwidestringdef = 35;
        ibend           = 255;
 
        { unit flags }
@@ -630,7 +631,14 @@ unit files;
 end.
 {
   $Log$
-  Revision 1.6  1998-05-01 07:43:53  florian
+  Revision 1.7  1998-05-01 16:38:44  florian
+    * handling of private and protected fixed
+    + change_keywords_to_tp implemented to remove
+      keywords which aren't supported by tp
+    * break and continue are now symbols of the system unit
+    + widestring, longstring and ansistring type released
+
+  Revision 1.6  1998/05/01 07:43:53  florian
     + basics for rtti implemented
     + switch $m (generate rtti for published sections)
 

compiler/innr.inc

@@ -53,10 +53,19 @@ const
    in_dec_x = 36;
    in_include_x_y = 37;
    in_exclude_x_y = 38;
+   in_break = 39;
+   in_continue = 40;
 
 {
   $Log$
-  Revision 1.3  1998-04-14 23:27:03  florian
+  Revision 1.4  1998-05-01 16:38:44  florian
+    * handling of private and protected fixed
+    + change_keywords_to_tp implemented to remove
+      keywords which aren't supported by tp
+    * break and continue are now symbols of the system unit
+    + widestring, longstring and ansistring type released
+
+  Revision 1.3  1998/04/14 23:27:03  florian
     + exclude/include with constant second parameter added
 
   Revision 1.2  1998/04/08 16:58:02  pierre

compiler/parser.pas

@@ -64,12 +64,9 @@ unit parser;
          s32bitdef:=porddef(globaldef('longint'));
          u32bitdef:=porddef(globaldef('ulong'));
          cstringdef:=pstringdef(globaldef('string'));
-{$ifdef UseLongString}
          clongstringdef:=pstringdef(globaldef('longstring'));
-{$endif UseLongString}
-{$ifdef UseAnsiString}
          cansistringdef:=pstringdef(globaldef('ansistring'));
-{$endif UseAnsiString}
+         cwidestringdef:=pstringdef(globaldef('widestring'));
          cchardef:=porddef(globaldef('char'));
 {$ifdef i386}
          c64floatdef:=pfloatdef(globaldef('s64real'));
@@ -351,12 +348,9 @@ unit parser;
               u32bitdef:=new(porddef,init(u32bit,0,$ffffffff));
               cstringdef:=new(pstringdef,init(255));
               { should we give a length to the default long and ansi string definition ?? }
-{$ifdef UseLongString}
               clongstringdef:=new(pstringdef,longinit(-1));
-{$endif UseLongString}
-{$ifdef UseAnsiString}
               cansistringdef:=new(pstringdef,ansiinit(-1));
-{$endif UseAnsiString}
+              cwidestringdef:=new(pstringdef,wideinit(-1));
               cchardef:=new(porddef,init(uchar,0,255));
 {$ifdef i386}
               c64floatdef:=new(pfloatdef,init(s64real));
@@ -542,7 +536,14 @@ done:
 end.
 {
   $Log$
-  Revision 1.10  1998-05-01 07:43:56  florian
+  Revision 1.11  1998-05-01 16:38:45  florian
+    * handling of private and protected fixed
+    + change_keywords_to_tp implemented to remove
+      keywords which aren't supported by tp
+    * break and continue are now symbols of the system unit
+    + widestring, longstring and ansistring type released
+
+  Revision 1.10  1998/05/01 07:43:56  florian
     + basics for rtti implemented
     + switch $m (generate rtti for published sections)
 

compiler/pass_1.pas

@@ -525,13 +525,6 @@ unit pass_1;
                      p^.registers32:=1;
                    if p^.symtable^.symtabletype=withsymtable then
                      p^.registers32:=1;
-                   { check semantics of private }
-                   if p^.symtable^.symtabletype=objectsymtable then
-                     begin
-                        if (pobjectdef(pvarsym(p^.symtableentry)^.owner^.defowner)^.owner^.symtabletype=unitsymtable) and
-                          ((p^.vs^.properties and sp_private)<>0) then
-                          Message(parser_e_cant_access_private_member);
-                     end;
 
                    { a class variable is a pointer !!!
                      yes, but we have to resolve the reference in an
@@ -1995,24 +1988,24 @@ unit pass_1;
 
     procedure first_string_chararray(var p : ptree);
 
-           begin
-                   p^.registers32:=1;
-                   p^.location.loc:=LOC_REGISTER;
-           end;
+      begin
+         p^.registers32:=1;
+         p^.location.loc:=LOC_REGISTER;
+      end;
 
     procedure first_string_string(var p : ptree);
 
+      begin
+         if pstringdef(p^.resulttype)^.string_typ<>
+            pstringdef(p^.left^.resulttype)^.string_typ then
            begin
-              if pstringdef(p^.resulttype)^.string_typ<>
-                 pstringdef(p^.left^.resulttype)^.string_typ then
-                begin
-                   { call shortstring_to_ansistring or ansistring_to_shortstring }
-                   procinfo.flags:=procinfo.flags or pi_do_call;
-                end;
-              { for simplicity lets first keep all ansistrings
-                as LOC_MEM, could also become LOC_REGISTER }
-              p^.location.loc:=LOC_MEM;
+              { call shortstring_to_ansistring or ansistring_to_shortstring }
+              procinfo.flags:=procinfo.flags or pi_do_call;
            end;
+         { for simplicity lets first keep all ansistrings
+           as LOC_MEM, could also become LOC_REGISTER }
+         p^.location.loc:=LOC_MEM;
+      end;
 
     procedure first_char_to_string(var p : ptree);
 
@@ -3856,16 +3849,6 @@ unit pass_1;
 {$ifdef SUPPORT_MMX}
          p^.registersmmx:=p^.left^.registersmmx;
 {$endif SUPPORT_MMX}
-        { check protected and private members }
-        if (p^.left^.resulttype^.deftype=objectdef) then
-          begin
-             if (pobjectdef(p^.vs^.owner^.defowner)^.owner^.symtabletype=unitsymtable) and
-               ((p^.vs^.properties and sp_private)<>0) then
-               Message(parser_e_cant_access_private_member);
-             if (pobjectdef(p^.left^.resulttype)^.owner^.symtabletype=unitsymtable) and
-               ((p^.vs^.properties and sp_protected)<>0) then
-               Message(parser_e_cant_access_protected_member);
-          end;
          { classes must be dereferenced implicit }
          if (p^.left^.resulttype^.deftype=objectdef) and
            pobjectdef(p^.left^.resulttype)^.isclass then
@@ -4846,7 +4829,14 @@ unit pass_1;
 end.
 {
   $Log$
-  Revision 1.15  1998-05-01 09:01:23  florian
+  Revision 1.16  1998-05-01 16:38:45  florian
+    * handling of private and protected fixed
+    + change_keywords_to_tp implemented to remove
+      keywords which aren't supported by tp
+    * break and continue are now symbols of the system unit
+    + widestring, longstring and ansistring type released
+
+  Revision 1.15  1998/05/01 09:01:23  florian
     + correct semantics of private and protected
     * small fix in variable scope:
        a id can be used in a parameter list of a method, even it is used in

compiler/pexpr.pas

@@ -120,7 +120,7 @@ unit pexpr;
          prev_in_args:=in_args;
          Store_valid:=Must_be_valid;
          case l of
-            in_ord_x :
+            in_ord_x:
               begin
                  consume(LKLAMMER);
                  in_args:=true;
@@ -133,6 +133,16 @@ unit pexpr;
                  statement_syssym := p1;
                  pd:=p1^.resulttype;
               end;
+            in_break:
+              begin
+                 statement_syssym:=genzeronode(breakn);
+                 pd:=voiddef;
+              end;
+            in_continue:
+              begin
+                 statement_syssym:=genzeronode(continuen);
+                 pd:=voiddef;
+              end;
             in_typeof_x : begin
                              consume(LKLAMMER);
                              in_args:=true;
@@ -580,6 +590,13 @@ unit pexpr;
          else
            begin
               isclassref:=pd^.deftype=classrefdef;
+              { check protected and private members }
+              if ((sym^.properties and sp_private)<>0) and
+                 (pobjectdef(sym^.owner^.defowner)^.owner^.symtabletype=unitsymtable) then
+                Message(parser_e_cant_access_private_member);
+              if ((sym^.properties and sp_protected)<>0) and
+                (pobjectdef(pd)^.owner^.symtabletype=unitsymtable) then
+               Message(parser_e_cant_access_protected_member);
               { we assume, that only procsyms and varsyms are in an object }
               { symbol table, for classes, properties are allowed          }
               case sym^.typ of
@@ -938,6 +955,14 @@ unit pexpr;
                              end
                            else
                              unit_specific:=false;
+                           { check semantics of private }
+                           if srsymtable^.symtabletype=objectsymtable then
+                             begin
+                                if ((srsym^.properties and sp_private)<>0) and
+                                  (pobjectdef(srsym^.owner^.defowner)^.
+                                  owner^.symtabletype=unitsymtable) then
+                                  Message(parser_e_cant_access_private_member);
+                             end;
                            case srsym^.typ of
                               absolutesym:
                                 begin
@@ -1640,7 +1665,14 @@ unit pexpr;
 end.
 {
   $Log$
-  Revision 1.9  1998-04-29 10:33:58  pierre
+  Revision 1.10  1998-05-01 16:38:45  florian
+    * handling of private and protected fixed
+    + change_keywords_to_tp implemented to remove
+      keywords which aren't supported by tp
+    * break and continue are now symbols of the system unit
+    + widestring, longstring and ansistring type released
+
+  Revision 1.9  1998/04/29 10:33:58  pierre
     + added some code for ansistring (not complete nor working yet)
     * corrected operator overloading
     * corrected nasm output

compiler/pmodules.pas

@@ -82,6 +82,8 @@ unit pmodules;
          p^.insert(new(psyssym,init('SUCC',in_succ_x)));
          p^.insert(new(psyssym,init('EXCLUDE',in_exclude_x_y)));
          p^.insert(new(psyssym,init('INCLUDE',in_include_x_y)));
+         p^.insert(new(psyssym,init('BREAK',in_break)));
+         p^.insert(new(psyssym,init('CONTINUE',in_continue)));
 
          { for testing purpose }
          p^.insert(new(psyssym,init('DECI',in_dec_x)));
@@ -112,12 +114,9 @@ unit pmodules;
          p^.insert(new(ptypesym,init('cs32fixed',s32fixeddef)));
          p^.insert(new(ptypesym,init('byte',u8bitdef)));
          p^.insert(new(ptypesym,init('string',cstringdef)));
-{$ifdef UseLongString}
          p^.insert(new(ptypesym,init('longstring',clongstringdef)));
-{$endif UseLongString}
-{$ifdef UseAnsiString}
          p^.insert(new(ptypesym,init('ansistring',cansistringdef)));
-{$endif UseAnsiString}
+         p^.insert(new(ptypesym,init('widestring',cansistringdef)));
          p^.insert(new(ptypesym,init('word',u16bitdef)));
          p^.insert(new(ptypesym,init('boolean',booldef)));
          p^.insert(new(ptypesym,init('void_pointer',voidpointerdef)));
@@ -145,12 +144,9 @@ unit pmodules;
          p^.insert(new(ptypesym,init('SINGLE',new(pfloatdef,init(s32real)))));
          p^.insert(new(ptypesym,init('POINTER',new(ppointerdef,init(voiddef)))));
          p^.insert(new(ptypesym,init('STRING',cstringdef)));
-{$ifdef UseLongString}
          p^.insert(new(ptypesym,init('LONGSTRING',clongstringdef)));
-{$endif UseLongString}
-{$ifdef UseAnsiString}
          p^.insert(new(ptypesym,init('ANSISTRING',cansistringdef)));
-{$endif UseAnsiString}
+         p^.insert(new(ptypesym,init('WIDESTRING',cwidestringdef)));
          p^.insert(new(ptypesym,init('BOOLEAN',new(porddef,init(bool8bit,0,1)))));
          p^.insert(new(ptypesym,init('CHAR',new(porddef,init(uchar,0,255)))));
          p^.insert(new(ptypesym,init('TEXT',new(pfiledef,init(ft_text,nil)))));
@@ -955,7 +951,14 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.8  1998-04-30 15:59:41  pierre
+  Revision 1.9  1998-05-01 16:38:45  florian
+    * handling of private and protected fixed
+    + change_keywords_to_tp implemented to remove
+      keywords which aren't supported by tp
+    * break and continue are now symbols of the system unit
+    + widestring, longstring and ansistring type released
+
+  Revision 1.8  1998/04/30 15:59:41  pierre
     * GDB works again better :
       correct type info in one pass
     + UseTokenInfo for better source position

compiler/pstatmnt.pas

@@ -889,11 +889,13 @@ unit pstatmnt;
                        consume(_FAIL);
                        code:=genzeronode(failn);
                     end;
+            {
             _BREAK:
               begin
                  consume(_BREAK);
                  code:=genzeronode(breakn);
               end;
+             }
             _EXIT : code:=exit_statement;
             _ASM : code:=_asm_statement;
          else
@@ -928,9 +930,8 @@ unit pstatmnt;
                      end;
                 end;
               p:=expr;
-              if (p^.treetype<>calln) and
-                (p^.treetype<>assignn) and
-                (p^.treetype<>inlinen) then
+              if not(p^.treetype in [calln,assignn,breakn,inlinen,
+                continuen]) then
                 Message(cg_e_illegal_expression);
               code:=p;
            end;
@@ -1076,7 +1077,14 @@ unit pstatmnt;
 end.
 {
   $Log$
-  Revision 1.6  1998-04-30 15:59:42  pierre
+  Revision 1.7  1998-05-01 16:38:46  florian
+    * handling of private and protected fixed
+    + change_keywords_to_tp implemented to remove
+      keywords which aren't supported by tp
+    * break and continue are now symbols of the system unit
+    + widestring, longstring and ansistring type released
+
+  Revision 1.6  1998/04/30 15:59:42  pierre
     * GDB works again better :
       correct type info in one pass
     + UseTokenInfo for better source position

compiler/scanner.pas

@@ -44,17 +44,24 @@ unit scanner;
        ident = string[id_len];
 
     const
-      max_keywords = 71;
+      max_keywords = 69;
       anz_keywords : longint = max_keywords;
 
+      { the following keywords are no keywords in TP, they
+        are internal procedures
+
+      CONTINUE, DISPOSE, EXIT, FAIL, FALSE, NEW, SELF
+      TRUE
+      }
+      { INLINE is a keyword in TP, but only an modifier in FPC }
       keyword : array[1..max_keywords] of ident = (
 {        'ABSOLUTE',}
          'AND',
          'ARRAY','AS','ASM',
 {        'ASSEMBLER',}
          'BEGIN',
-         'BREAK','CASE','CLASS',
-         'CONST','CONSTRUCTOR','CONTINUE',
+         'CASE','CLASS',
+         'CONST','CONSTRUCTOR',
          'DESTRUCTOR','DISPOSE','DIV','DO','DOWNTO','ELSE','END',
          'EXCEPT',
          'EXIT',
@@ -89,8 +96,8 @@ unit scanner;
          _ARRAY,_AS,_ASM,
 {        _ASSEMBLER,}
          _BEGIN,
-         _BREAK,_CASE,_CLASS,
-         _CONST,_CONSTRUCTOR,_CONTINUE,
+         _CASE,_CLASS,
+         _CONST,_CONSTRUCTOR,
          _DESTRUCTOR,_DISPOSE,_DIV,_DO,_DOWNTO,
          _ELSE,_END,_EXCEPT,
          _EXIT,
@@ -177,6 +184,8 @@ unit scanner;
         procedure InitScanner(const fn: string);
         procedure DoneScanner(testendif:boolean);
 
+        { changes to keywords to be tp compatible }
+        procedure change_to_tp_keywords;
 
   implementation
 
@@ -1413,10 +1422,53 @@ unit scanner;
         end;
      end;
 
+   procedure change_to_tp_keywords;
+
+     const
+        non_tp : array[0..13] of string[id_len] = (
+          'AS','CLASS','EXCEPT','FINALLY','INITIALIZATION','IS',
+          'ON','OPERATOR','OTHERWISE','PROPERTY','RAISE','TRY',
+          'EXPORTS','LIBRARY');
+
+     var
+        i : longint;
+
+     begin
+        for i:=0 to 13 do
+          remove_keyword(non_tp[i]);
+     end;
+
+   procedure change_to_delphi_keywords;
+
+     {
+     const
+        non_tp : array[0..13] of string[id_len] = (
+          'AS','CLASS','EXCEPT','FINALLY','INITIALIZATION','IS',
+          'ON','OPERATOR','OTHERWISE','PROPERTY','RAISE','TRY',
+          'EXPORTS','LIBRARY');
+
+     var
+        i : longint;
+     }
+
+     begin
+     {
+        for i:=0 to 13 do
+          remove_keyword(non_tp[i]);
+     }
+     end;
+
 end.
 {
   $Log$
-  Revision 1.14  1998-04-30 15:59:42  pierre
+  Revision 1.15  1998-05-01 16:38:46  florian
+    * handling of private and protected fixed
+    + change_keywords_to_tp implemented to remove
+      keywords which aren't supported by tp
+    * break and continue are now symbols of the system unit
+    + widestring, longstring and ansistring type released
+
+  Revision 1.14  1998/04/30 15:59:42  pierre
     * GDB works again better :
       correct type info in one pass
     + UseTokenInfo for better source position

compiler/todo.txt

@@ -18,8 +18,14 @@ compiler version and your short cut.
   - message qualifier
         - correct handling of constructor result type ............ 0.99.6 (FK)
   - rtti
+  - published
   - dynamic methods
-  - correct handling of access specifiers
+  - correct handling of access specifiers ........................ 0.99.7 (FK)
+  - interface
+* rtti
+  - generation
+  - use when copying etc.
+* AnsiString, LongString and WideString
 * MMX support by the compiler
           - unary minus .......................................... 0.99.1 (FK)
           - proper handling of fixed type ........................ 0.99.1 (FK)

compiler/types.pas

@@ -40,6 +40,15 @@ unit types;
     { true if o is an ansi string def }
     function is_ansistring(p : pdef) : boolean;
 
+    { true if o is a long string def }
+    function is_longstring(p : pdef) : boolean;
+
+    { true if o is a wide string def }
+    function is_widestring(p : pdef) : boolean;
+
+    { true if o is a short string def }
+    function is_shortstring(p : pdef) : boolean;
+
     { returns true, if def defines a signed data type (only for ordinal types) }
     function is_signed(def : pdef) : boolean;
 
@@ -228,6 +237,27 @@ unit types;
                  (pstringdef(p)^.string_typ=ansistring);
       end;
 
+    { true if o is an long string def }
+    function is_longstring(p : pdef) : boolean;
+      begin
+         is_longstring:=(p^.deftype=stringdef) and
+                 (pstringdef(p)^.string_typ=longstring);
+      end;
+
+    { true if o is an long string def }
+    function is_widestring(p : pdef) : boolean;
+      begin
+         is_widestring:=(p^.deftype=stringdef) and
+                 (pstringdef(p)^.string_typ=widestring);
+      end;
+
+    { true if o is an short string def }
+    function is_shortstring(p : pdef) : boolean;
+      begin
+         is_shortstring:=(p^.deftype=stringdef) and
+                 (pstringdef(p)^.string_typ=shortstring);
+      end;
+
     { true if the return value is in accumulator (EAX for i386), D0 for 68k }
     function ret_in_acc(def : pdef) : boolean;
 
@@ -935,7 +965,14 @@ unit types;
 end.
 {
   $Log$
-  Revision 1.10  1998-04-29 10:34:08  pierre
+  Revision 1.11  1998-05-01 16:38:46  florian
+    * handling of private and protected fixed
+    + change_keywords_to_tp implemented to remove
+      keywords which aren't supported by tp
+    * break and continue are now symbols of the system unit
+    + widestring, longstring and ansistring type released
+
+  Revision 1.10  1998/04/29 10:34:08  pierre
     + added some code for ansistring (not complete nor working yet)
     * corrected operator overloading
     * corrected nasm output