* read only typed const support, switch $J-

compiler/globals.pas

@@ -1361,7 +1361,7 @@ implementation
 
       { Init values }
         initmodeswitches:=fpcmodeswitches;
-        initlocalswitches:=[cs_check_io];
+        initlocalswitches:=[cs_check_io,cs_typed_const_writable];
         initmoduleswitches:=[cs_extsyntax,cs_browser];
         initglobalswitches:=[cs_check_unit_name,cs_link_static];
         initoutputformat:=target_asm.id;
@@ -1411,7 +1411,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.45  2001-10-16 15:10:34  jonas
+  Revision 1.46  2001-10-20 20:30:20  peter
+    * read only typed const support, switch $J-
+
+  Revision 1.45  2001/10/16 15:10:34  jonas
     * fixed goto/label/try bugs
 
   Revision 1.44  2001/10/12 16:06:17  peter

compiler/globtype.pas

@@ -75,7 +75,7 @@ interface
          cs_check_overflow,cs_check_range,cs_check_object_ext,
          cs_check_io,cs_check_stack,
          cs_omitstackframe,cs_do_assertion,cs_generate_rtti,
-         cs_full_boolean_eval,
+         cs_full_boolean_eval,cs_typed_const_writable,
          { mmx }
          cs_mmx,cs_mmx_saturation,
          { parser }
@@ -90,7 +90,6 @@ interface
          { support }
          cs_support_inline,cs_support_goto,cs_support_macro,
          cs_support_c_operators,cs_static_keyword,
-         cs_typed_const_not_changeable,
          { generation }
          cs_profile,cs_debuginfo,cs_browser,cs_local_browser,cs_compilesystem,
          cs_lineinfo,
@@ -186,6 +185,7 @@ interface
 {$ifndef Delphi}
   {$ifndef xFPC}
     type
+      pguid = ^tguid;
       tguid = packed record
         D1: LongWord;
         D2: Word;
@@ -208,7 +208,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.15  2001-09-17 21:29:11  peter
+  Revision 1.16  2001-10-20 20:30:21  peter
+    * read only typed const support, switch $J-
+
+  Revision 1.15  2001/09/17 21:29:11  peter
     * merged netbsd, fpu-overflow from fixes branch
 
   Revision 1.14  2001/07/30 20:59:27  peter

compiler/htypechk.pas

@@ -904,12 +904,19 @@ implementation
                           exit;
                         end;
                      end;
-                   funcretsym,
-                   typedconstsym :
+                   funcretsym :
                      begin
                        valid_for_assign:=true;
                        exit;
                      end;
+                   typedconstsym :
+                     begin
+                       if ttypedconstsym(tloadnode(hp).symtableentry).is_writable then
+                        valid_for_assign:=true
+                       else
+                        CGMessagePos(hp.fileinfo,type_e_no_assign_to_const);
+                       exit;
+                     end;
                  end;
                end;
              else
@@ -967,7 +974,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.36  2001-10-12 13:51:51  jonas
+  Revision 1.37  2001-10-20 20:30:21  peter
+    * read only typed const support, switch $J-
+
+  Revision 1.36  2001/10/12 13:51:51  jonas
     * fixed internalerror(10) due to previous fpu overflow fixes ("merged")
     * fixed bug in n386add (introduced after compilerproc changes for string
       operations) where calcregisters wasn't called for shortstring addnodes

compiler/pdecl.pas

@@ -189,19 +189,7 @@ implementation
                    { create symbol }
                    storetokenpos:=akttokenpos;
                    akttokenpos:=filepos;
-{$ifdef DELPHI_CONST_IN_RODATA}
-                   if m_delphi in aktmodeswitches then
-                     begin
-                       if assigned(readtypesym) then
-                        sym:=ttypedconstsym.createsym(orgname,readtypesym,true)
-                       else
-                        sym:=ttypedconstsym.create(orgname,def,true)
-                     end
-                   else
-{$endif DELPHI_CONST_IN_RODATA}
-                     begin
-                       sym:=ttypedconstsym.createtype(orgname,tt,false)
-                     end;
+                   sym:=ttypedconstsym.createtype(orgname,tt,(cs_typed_const_writable in aktlocalswitches));
                    akttokenpos:=storetokenpos;
                    symtablestack.insert(sym);
                    { procvar can have proc directives }
@@ -230,12 +218,7 @@ implementation
                     begin
                       { get init value }
                       consume(_EQUAL);
-{$ifdef DELPHI_CONST_IN_RODATA}
-                      if m_delphi in aktmodeswitches then
-                       readtypedconst(tt,ttypedconstsym(sym),true)
-                      else
-{$endif DELPHI_CONST_IN_RODATA}
-                       readtypedconst(tt,ttypedconstsym(sym),false);
+                      readtypedconst(tt,ttypedconstsym(sym),(cs_typed_const_writable in aktlocalswitches));
                       try_consume_hintdirective(sym.symoptions);
                       consume(_SEMICOLON);
                     end;
@@ -610,7 +593,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.36  2001-10-20 19:28:39  peter
+  Revision 1.37  2001-10-20 20:30:21  peter
+    * read only typed const support, switch $J-
+
+  Revision 1.36  2001/10/20 19:28:39  peter
     * interface 2 guid support
     * guid constants support
 

compiler/ptconst.pas

@@ -31,7 +31,7 @@ interface
     { this procedure reads typed constants }
     { sym is only needed for ansi strings  }
     { the assembler label is in the middle (PM) }
-    procedure readtypedconst(const t:ttype;sym : ttypedconstsym;no_change_allowed : boolean);
+    procedure readtypedconst(const t:ttype;sym : ttypedconstsym;writable : boolean);
 
 implementation
 
@@ -57,7 +57,7 @@ implementation
   {$maxfpuregisters 0}
 {$endif fpc}
     { this procedure reads typed constants }
-    procedure readtypedconst(const t:ttype;sym : ttypedconstsym;no_change_allowed : boolean);
+    procedure readtypedconst(const t:ttype;sym : ttypedconstsym;writable : boolean);
 
       var
          len,base  : longint;
@@ -95,10 +95,10 @@ implementation
 
 {$R-}  {Range check creates problem with init_8bit(-1) !!}
       begin
-         if no_change_allowed then
-           curconstsegment:=consts
+         if writable then
+           curconstsegment:=datasegment
          else
-           curconstsegment:=datasegment;
+           curconstsegment:=consts;
          case t.def.deftype of
             orddef:
               begin
@@ -597,10 +597,10 @@ implementation
                     consume(_LKLAMMER);
                     for l:=tarraydef(t.def).lowrange to tarraydef(t.def).highrange-1 do
                       begin
-                         readtypedconst(tarraydef(t.def).elementtype,nil,no_change_allowed);
+                         readtypedconst(tarraydef(t.def).elementtype,nil,writable);
                          consume(_COMMA);
                       end;
-                    readtypedconst(tarraydef(t.def).elementtype,nil,no_change_allowed);
+                    readtypedconst(tarraydef(t.def).elementtype,nil,writable);
                     consume(_RKLAMMER);
                  end
               else
@@ -805,7 +805,7 @@ implementation
                              aktpos:=tvarsym(srsym).address+tvarsym(srsym).vartype.def.size;
 
                              { read the data }
-                             readtypedconst(tvarsym(srsym).vartype,nil,no_change_allowed);
+                             readtypedconst(tvarsym(srsym).vartype,nil,writable);
 
                              { keep previous field for checking whether whole }
                              { record was initialized (JM)                    }
@@ -910,7 +910,7 @@ implementation
                              aktpos:=tvarsym(srsym).address+tvarsym(srsym).vartype.def.size;
 
                              { read the data }
-                             readtypedconst(tvarsym(srsym).vartype,nil,no_change_allowed);
+                             readtypedconst(tvarsym(srsym).vartype,nil,writable);
 
                              if token=_SEMICOLON then
                                consume(_SEMICOLON)
@@ -950,7 +950,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.35  2001-10-20 17:24:26  peter
+  Revision 1.36  2001-10-20 20:30:21  peter
+    * read only typed const support, switch $J-
+
+  Revision 1.35  2001/10/20 17:24:26  peter
     * make all sets equal when reading an array of sets. Before it could
       mix normal and small sets in the same array!
 

compiler/switches.pas

@@ -56,7 +56,7 @@ const
    {G} (typesw:ignoredsw; setsw:ord(cs_localnone)),
    {H} (typesw:localsw; setsw:ord(cs_ansistrings)),
    {I} (typesw:localsw; setsw:ord(cs_check_io)),
-   {J} (typesw:unsupportedsw; setsw:ord(cs_typed_const_not_changeable)),
+   {J} (typesw:localsw; setsw:ord(cs_typed_const_writable)),
    {K} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
    {L} (typesw:modulesw; setsw:ord(cs_local_browser)),
    {M} (typesw:localsw; setsw:ord(cs_generate_rtti)),
@@ -177,7 +177,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.7  2001-05-18 22:56:05  peter
+  Revision 1.8  2001-10-20 20:30:21  peter
+    * read only typed const support, switch $J-
+
+  Revision 1.7  2001/05/18 22:56:05  peter
     * $E is moduleswitch (merged)
 
   Revision 1.6  2000/12/25 00:07:29  peter

compiler/symconst.pas

@@ -401,7 +401,7 @@ type
   tconsttyp = (constnone,
     constord,conststring,constreal,constbool,
     constint,constchar,constset,constpointer,constnil,
-    constresourcestring,constwstring,constwchar
+    constresourcestring,constwstring,constwchar,constguid
   );
 
   { RTTI information to store }
@@ -453,7 +453,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.23  2001-08-30 20:13:54  peter
+  Revision 1.24  2001-10-20 20:30:21  peter
+    * read only typed const support, switch $J-
+
+  Revision 1.23  2001/08/30 20:13:54  peter
     * rtti/init table updates
     * rttisym for reusable global rtti/init info
     * support published for interfaces

compiler/symsym.pas

@@ -229,9 +229,9 @@ interface
        ttypedconstsym = class(tstoredsym)
           prefix          : pstring;
           typedconsttype  : ttype;
-          is_really_const : boolean;
-          constructor create(const n : string;p : tdef;really_const : boolean);
-          constructor createtype(const n : string;const tt : ttype;really_const : boolean);
+          is_writable     : boolean;
+          constructor create(const n : string;p : tdef;writable : boolean);
+          constructor createtype(const n : string;const tt : ttype;writable : boolean);
           constructor load(ppufile:tcompilerppufile);
           destructor destroy;override;
           function  mangledname : string;override;
@@ -1675,20 +1675,23 @@ implementation
                              TTYPEDCONSTSYM
 *****************************************************************************}
 
-    constructor ttypedconstsym.create(const n : string;p : tdef;really_const : boolean);
+    constructor ttypedconstsym.create(const n : string;p : tdef;writable : boolean);
       begin
          inherited create(n);
          typ:=typedconstsym;
          typedconsttype.setdef(p);
-         is_really_const:=really_const;
+         is_writable:=writable;
          prefix:=stringdup(procprefix);
       end;
 
 
-    constructor ttypedconstsym.createtype(const n : string;const tt : ttype;really_const : boolean);
+    constructor ttypedconstsym.createtype(const n : string;const tt : ttype;writable : boolean);
       begin
-         ttypedconstsym(self).create(n,nil,really_const);
+         inherited create(n);
+         typ:=typedconstsym;
          typedconsttype:=tt;
+         is_writable:=writable;
+         prefix:=stringdup(procprefix);
       end;
 
 
@@ -1698,7 +1701,7 @@ implementation
          typ:=typedconstsym;
          ppufile.gettype(typedconsttype);
          prefix:=stringdup(ppufile.getstring);
-         is_really_const:=boolean(ppufile.getbyte);
+         is_writable:=boolean(ppufile.getbyte);
       end;
 
 
@@ -1735,7 +1738,7 @@ implementation
          inherited writesym(ppufile);
          ppufile.puttype(typedconsttype);
          ppufile.putstring(prefix^);
-         ppufile.putbyte(byte(is_really_const));
+         ppufile.putbyte(byte(is_writable));
          ppufile.writeentry(ibtypedconstsym);
       end;
 
@@ -1748,10 +1751,10 @@ implementation
       begin
         storefilepos:=aktfilepos;
         aktfilepos:=akttokenpos;
-        if is_really_const then
-          curconstsegment:=consts
+        if is_writable then
+          curconstsegment:=datasegment
         else
-          curconstsegment:=datasegment;
+          curconstsegment:=consts;
         l:=getsize;
         varalign:=size_2_align(l);
         varalign:=used_align(varalign,aktalignment.constalignmin,aktalignment.constalignmax);
@@ -2484,7 +2487,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.22  2001-09-19 11:04:42  michael
+  Revision 1.23  2001-10-20 20:30:21  peter
+    * read only typed const support, switch $J-
+
+  Revision 1.22  2001/09/19 11:04:42  michael
   * Smartlinking with interfaces fixed
   * Better smartlinking for rtti and init tables