+ open strings, $P switch support

compiler/cg386cal.pas

@@ -68,7 +68,7 @@ implementation
         end;
 
 
-      procedure maybe_push_open_array_high;
+      procedure maybe_push_high;
         var
            r    : preference;
            hreg : tregister;
@@ -78,7 +78,8 @@ implementation
            { open array ? }
            { defcoll^.data can be nil for read/write }
            if assigned(defcoll^.data) and
-              is_open_array(defcoll^.data) then
+              (is_open_array(defcoll^.data) or
+               is_open_string(defcoll^.data)) then
              begin
               { push high }
                case p^.left^.resulttype^.deftype of
@@ -93,17 +94,31 @@ implementation
                                    parraydef(p^.left^.resulttype)^.lowrange
                            end;
                stringdef : begin
-                             if p^.left^.treetype=stringconstn then
-                              len:=str_length(p^.left)
+                             if is_open_string(defcoll^.data) then
+			       begin
+			         if is_open_string(p^.left^.resulttype) then
+				  begin
+                                    r:=new_reference(highframepointer,highoffset+4);
+                                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
+                                    hreg:=R_EDI;
+                                    len:=-2;
+				  end
+				 else 
+                                  len:=pstringdef(p^.left^.resulttype)^.len
+			       end
                              else
-                              begin
-                                href:=p^.left^.location.reference;
-                                dec(href.offset);
-                                hreg:=reg32toreg8(getregister32);
-                                exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_B,newreference(href),hreg)));
-                                emit_to_reg32(hreg);
-                                len:=-2;
-                              end;
+                             { passing a string to an array of char }
+                               begin
+                                 if (p^.left^.treetype=stringconstn) then
+                                   len:=str_length(p^.left)
+                                 else
+                                   begin
+                                     href:=p^.left^.location.reference;
+                                     exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,newreference(href),R_EDI)));
+                                     hreg:=R_EDI;
+                                     len:=-2;
+                                   end;
+                               end;
                            end;
                else
                 len:=0;
@@ -218,7 +233,7 @@ implementation
            begin
               if (p^.left^.location.loc<>LOC_REFERENCE) then
                 CGMessage(cg_e_var_must_be_reference);
-              maybe_push_open_array_high;
+              maybe_push_high;
               inc(pushedparasize,4);
               if inlined then
                 begin
@@ -242,7 +257,7 @@ implementation
 {$endif}
                  push_addr(p^.left) then
                 begin
-                   maybe_push_open_array_high;
+                   maybe_push_high;
                    inc(pushedparasize,4);
                    if inlined then
                      begin
@@ -530,7 +545,7 @@ implementation
                                  is_open_array(defcoll^.data) then
                                begin
                                   { first, push high }
-                                  maybe_push_open_array_high;
+                                  maybe_push_high;
                                   inc(pushedparasize,4);
                                   if inlined then
                                     begin
@@ -1575,7 +1590,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.47  1998-11-26 21:30:03  peter
+  Revision 1.48  1998-11-27 14:50:30  peter
+    + open strings, $P switch support
+
+  Revision 1.47  1998/11/26 21:30:03  peter
     * fix for valuepara
 
   Revision 1.46  1998/11/26 14:39:10  peter

compiler/cg386inl.pas

@@ -203,6 +203,11 @@ implementation
                        CGMessage(parser_e_illegal_colon_qualifier);
                      if ft=ft_typed then
                        never_copy_const_param:=true;
+                     { reset data type }
+                     dummycoll.data:=nil;
+                     { support openstring calling for readln(shortstring) }
+                     if doread and (is_shortstring(hp^.resulttype)) then
+                       dummycoll.data:=openshortstringdef;
                      secondcallparan(hp,@dummycoll,false,false,0);
                      if ft=ft_typed then
                        never_copy_const_param:=false;
@@ -279,7 +284,6 @@ implementation
                                      if doread then
                                        begin
                                          { push maximum string length }
-                                         push_int(pstringdef(pararesult)^.len);
                                          case pstringdef(pararesult)^.string_typ of
                                           st_shortstring:
                                             emitcall ('FPC_READ_TEXT_STRING',true);
@@ -432,17 +436,16 @@ implementation
            { we have at least two args }
            { with at max 2 colon_para in between }
 
-           { first arg longint or float }
+           { string arg }
            hp:=node;
            node:=node^.right;
            hp^.right:=nil;
-           dummycoll.data:=hp^.resulttype;
-           { string arg }
-
            dummycoll.paratyp:=vs_var;
-           secondcallparan(hp,@dummycoll,false
-             ,false,0
-             );
+           if is_shortstring(hp^.resulttype) then
+             dummycoll.data:=openshortstringdef
+           else
+             dummycoll.data:=hp^.resulttype;
+           secondcallparan(hp,@dummycoll,false,false,0);
            if codegenerror then
              exit;
 
@@ -586,15 +589,13 @@ implementation
               end;
             in_high_x :
               begin
-                 if is_open_array(p^.left^.resulttype) then
+                 if is_open_array(p^.left^.resulttype) or
+                    is_open_string(p^.left^.resulttype) then
                    begin
                       secondpass(p^.left);
                       del_reference(p^.left^.location.reference);
                       p^.location.register:=getregister32;
-                      new(r);
-                      reset_reference(r^);
-                      r^.base:=highframepointer;
-                      r^.offset:=highoffset+4;
+                      r:=new_reference(highframepointer,highoffset+4);
                       exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
                         r,p^.location.register)));
                    end
@@ -604,21 +605,20 @@ implementation
               begin
                { sizeof(openarray) handling }
                  if (p^.inlinenumber=in_sizeof_x) and
-                    is_open_array(p^.left^.resulttype) then
+                    (is_open_array(p^.left^.resulttype) or
+                     is_open_string(p^.left^.resulttype)) then
                   begin
                   { sizeof(openarray)=high(openarray)+1 }
                     secondpass(p^.left);
                     del_reference(p^.left^.location.reference);
                     p^.location.register:=getregister32;
-                    new(r);
-                    reset_reference(r^);
-                    r^.base:=highframepointer;
-                    r^.offset:=highoffset+4;
+                    r:=new_reference(highframepointer,highoffset+4);
                     exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
                       r,p^.location.register)));
                     exprasmlist^.concat(new(pai386,op_reg(A_INC,S_L,
                       p^.location.register)));
-                    if parraydef(p^.left^.resulttype)^.elesize<>1 then
+                    if (p^.left^.resulttype^.deftype=arraydef) and
+                       (parraydef(p^.left^.resulttype)^.elesize<>1) then
                       exprasmlist^.concat(new(pai386,op_const_reg(A_IMUL,S_L,
                         parraydef(p^.left^.resulttype)^.elesize,p^.location.register)));
                   end
@@ -970,7 +970,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.19  1998-11-26 13:10:40  peter
+  Revision 1.20  1998-11-27 14:50:32  peter
+    + open strings, $P switch support
+
+  Revision 1.19  1998/11/26 13:10:40  peter
     * new int - int conversion -dNEWCNV
     * some function renamings
 

compiler/cg386ld.pas

@@ -26,17 +26,6 @@ interface
     uses
       tree,i386;
 
-    var
-       { this is for open arrays and strings        }
-       { but be careful, this data is in the        }
-       { generated code destroyed quick, and also   }
-       { the next call of secondload destroys this  }
-       { data                                       }
-       { So be careful using the informations       }
-       { provided by this variables                 }
-       highframepointer : tregister;
-       highoffset : longint;
-
     procedure secondload(var p : ptree);
     procedure secondassignment(var p : ptree);
     procedure secondfuncret(var p : ptree);
@@ -187,16 +176,17 @@ implementation
                             ((pvarsym(p^.symtableentry)^.varspez=vs_const) and
 {$ifndef VALUEPARA}
                              dont_copy_const_param(pvarsym(p^.symtableentry)^.definition)) or
-{$else}
-                             push_addr_param(pvarsym(p^.symtableentry)^.definition)) or
-{$endif}
                              { call by value open arrays are also indirect addressed }
                              is_open_array(pvarsym(p^.symtableentry)^.definition) then
+{$else}
+                             push_addr_param(pvarsym(p^.symtableentry)^.definition)) then
+{$endif}
                            begin
                               simple_loadn:=false;
                               if hregister=R_NO then
                                 hregister:=getregister32;
-                              if is_open_array(pvarsym(p^.symtableentry)^.definition) then
+                              if is_open_array(pvarsym(p^.symtableentry)^.definition) or
+                                 is_open_string(pvarsym(p^.symtableentry)^.definition) then
                                 begin
                                    if (p^.location.reference.base=procinfo.framepointer) then
                                      begin
@@ -689,7 +679,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.32  1998-11-26 09:53:36  florian
+  Revision 1.33  1998-11-27 14:50:33  peter
+    + open strings, $P switch support
+
+  Revision 1.32  1998/11/26 09:53:36  florian
     * for classes no init/final. code is necessary, fixed
 
   Revision 1.31  1998/11/20 15:35:54  florian

compiler/hcodegen.pas

@@ -131,6 +131,16 @@ unit hcodegen;
        { true, if an error while code generation occurs }
        codegenerror : boolean;
 
+       { this is for open arrays and strings        }
+       { but be careful, this data is in the        }
+       { generated code destroyed quick, and also   }
+       { the next call of secondload destroys this  }
+       { data                                       }
+       { So be careful using the informations       }
+       { provided by this variables                 }
+       highframepointer : tregister;
+       highoffset : longint;
+
     { message calls with codegenerror support }
     procedure cgmessage(const t : tmsgconst);
     procedure cgmessage1(const t : tmsgconst;const s : string);
@@ -344,7 +354,10 @@ end.
 
 {
   $Log$
-  Revision 1.22  1998-11-16 12:12:21  peter
+  Revision 1.23  1998-11-27 14:50:38  peter
+    + open strings, $P switch support
+
+  Revision 1.22  1998/11/16 12:12:21  peter
     - generate_pascii which is obsolete
 
   Revision 1.21  1998/11/04 10:11:38  peter

compiler/pexpr.pas

@@ -216,8 +216,9 @@ unit pexpr;
                  Must_be_valid:=false;
                  do_firstpass(p1);
                  if ((p1^.resulttype^.deftype=objectdef) and
-                    ((pobjectdef(p1^.resulttype)^.options and oo_hasconstructor)<>0))
-                   or is_open_array(p1^.resulttype) then
+                     ((pobjectdef(p1^.resulttype)^.options and oo_hasconstructor)<>0)) or
+                    is_open_array(p1^.resulttype) or
+                    is_open_string(p1^.resulttype) then
                   statement_syssym:=geninlinenode(in_sizeof_x,false,p1)
                  else
                   begin
@@ -1583,16 +1584,21 @@ unit pexpr;
                  p1:=genrealconstnode(d);
                end;
      _STRING : begin
-               { STRING can be also a type cast }
                  pd:=stringtype;
-                 consume(LKLAMMER);
-                 p1:=comp_expr(true);
-                 consume(RKLAMMER);
-                 p1:=gentypeconvnode(p1,pd);
-                 p1^.explizit:=true;
-                 { handle postfix operators here e.g. string(a)[10] }
-                 again:=true;
-                 postfixoperators;
+                 { STRING can be also a type cast }
+                 if token=LKLAMMER then
+                  begin
+                    consume(LKLAMMER);
+                    p1:=comp_expr(true);
+                    consume(RKLAMMER);
+                    p1:=gentypeconvnode(p1,pd);
+                    p1^.explizit:=true;
+                    { handle postfix operators here e.g. string(a)[10] }
+                    again:=true;
+                    postfixoperators;
+                  end
+                 else
+                  p1:=gentypenode(pd);
                end;
        _FILE : begin
                  pd:=cfiledef;
@@ -1908,7 +1914,10 @@ unit pexpr;
 end.
 {
   $Log$
-  Revision 1.75  1998-11-25 19:12:51  pierre
+  Revision 1.76  1998-11-27 14:50:40  peter
+    + open strings, $P switch support
+
+  Revision 1.75  1998/11/25 19:12:51  pierre
     * var:=new(pointer_type) support added
 
   Revision 1.74  1998/11/13 10:18:11  peter

compiler/psystem.pas

@@ -93,6 +93,7 @@ begin
   p^.insert(new(ptypesym,init('longstring',clongstringdef)));
   p^.insert(new(ptypesym,init('ansistring',cansistringdef)));
   p^.insert(new(ptypesym,init('widestring',cwidestringdef)));
+  p^.insert(new(ptypesym,init('openshortstring',openshortstringdef)));
   p^.insert(new(ptypesym,init('word',u16bitdef)));
   p^.insert(new(ptypesym,init('boolean',booldef)));
   p^.insert(new(ptypesym,init('void_pointer',voidpointerdef)));
@@ -168,6 +169,7 @@ begin
   clongstringdef:=pstringdef(globaldef('longstring'));
   cansistringdef:=pstringdef(globaldef('ansistring'));
   cwidestringdef:=pstringdef(globaldef('widestring'));
+  openshortstringdef:=pstringdef(globaldef('openshortstring'));
   cchardef:=porddef(globaldef('char'));
 {$ifdef i386}
   c64floatdef:=pfloatdef(globaldef('s64real'));
@@ -209,6 +211,8 @@ begin
   clongstringdef:=new(pstringdef,longinit(-1));
   cansistringdef:=new(pstringdef,ansiinit(-1));
   cwidestringdef:=new(pstringdef,wideinit(-1));
+  { length=0 for shortstring is open string (needed for readln(string) }
+  openshortstringdef:=new(pstringdef,shortinit(0));
 {$ifdef i386}
   c64floatdef:=new(pfloatdef,init(s64real));
   s80floatdef:=new(pfloatdef,init(s80real));
@@ -232,7 +236,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.11  1998-11-16 10:18:09  peter
+  Revision 1.12  1998-11-27 14:50:45  peter
+    + open strings, $P switch support
+
+  Revision 1.11  1998/11/16 10:18:09  peter
     * fixes for ansistrings
 
   Revision 1.10  1998/11/09 11:44:36  peter

compiler/switches.pas

@@ -57,7 +57,7 @@ const
    {M} (typesw:localsw; setsw:ord(cs_generate_rtti)),
    {N} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
    {O} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
-   {P} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
+   {P} (typesw:modulesw; setsw:ord(cs_openstring)),
    {Q} (typesw:localsw; setsw:ord(cs_check_overflow)),
    {R} (typesw:localsw; setsw:ord(cs_check_range)),
    {S} (typesw:localsw; setsw:ord(cs_check_stack)),
@@ -164,7 +164,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.16  1998-10-13 16:50:22  pierre
+  Revision 1.17  1998-11-27 14:50:46  peter
+    + open strings, $P switch support
+
+  Revision 1.16  1998/10/13 16:50:22  pierre
     * undid some changes of Peter that made the compiler wrong
       for m68k (I had to reinsert some ifdefs)
     * removed several memory leaks under m68k

compiler/symdef.inc

@@ -921,11 +921,6 @@
                 begin
                    datasegment^.concat(new(pai_const,init_32bit(low)));
                    datasegment^.concat(new(pai_const,init_32bit($7fffffff)));
-                   inc(nextlabelnr);
-                   if (cs_smartlink in aktmoduleswitches) then
-                     datasegment^.concat(new(pai_symbol,init_global('R_'+current_module^.modulename^+tostr(rangenr+1))))
-                   else
-                     datasegment^.concat(new(pai_symbol,init('R_'+tostr(rangenr+1))));
                    datasegment^.concat(new(pai_const,init_32bit($80000000)));
                    datasegment^.concat(new(pai_const,init_32bit(high)));
                 end;
@@ -3224,7 +3219,10 @@
 
 {
   $Log$
-  Revision 1.73  1998-11-26 14:47:00  michael
+  Revision 1.74  1998-11-27 14:50:47  peter
+    + open strings, $P switch support
+
+  Revision 1.73  1998/11/26 14:47:00  michael
   + Fixed RTTI constants
 
   Revision 1.72  1998/11/25 14:35:28  florian

compiler/symsym.inc

@@ -970,8 +970,9 @@
                             end;
                    vs_var : begin
                             { open arrays push also the high valye }
-                              if is_open_array(definition) then
-                                getsize:=target_os.size_of_pointer+target_os.size_of_pointer
+                              if is_open_array(definition) or
+                                 is_open_string(definition) then
+                                getsize:=target_os.size_of_pointer+target_os.size_of_longint
                               else
                                 getsize:=target_os.size_of_pointer;
                             end;
@@ -983,9 +984,8 @@
                                 setdef : getsize:=target_os.size_of_pointer;
                               arraydef : begin
                                          { open arrays push also the high valye }
-                                           if (parraydef(definition)^.lowrange=0) and
-                                              (parraydef(definition)^.highrange=-1) then
-                                             getsize:=target_os.size_of_pointer+target_os.size_of_pointer
+                                           if is_open_array(definition) then
+                                             getsize:=target_os.size_of_pointer+target_os.size_of_longint
                                            else
                                              getsize:=target_os.size_of_pointer;
                                          end;
@@ -1016,8 +1016,9 @@
                 vs_var :
                   begin
                     { open arrays push also the high valye }
-                    if is_open_array(definition) then
-                      getpushsize:=target_os.size_of_pointer+target_os.size_of_pointer
+                    if is_open_array(definition) or
+                       is_open_string(definition) then
+                      getpushsize:=target_os.size_of_pointer+target_os.size_of_longint
                     else
                       getpushsize:=target_os.size_of_pointer;
                   end;
@@ -1032,7 +1033,7 @@
                         getpushsize:=target_os.size_of_pointer;
                       arraydef :
                         if is_open_array(definition) then
-                          getpushsize:=target_os.size_of_pointer+target_os.size_of_pointer
+                          getpushsize:=target_os.size_of_pointer+target_os.size_of_longint
                         else
                           getpushsize:=target_os.size_of_pointer;
                       else
@@ -1803,7 +1804,10 @@
 
 {
   $Log$
-  Revision 1.61  1998-11-18 15:44:18  peter
+  Revision 1.62  1998-11-27 14:50:48  peter
+    + open strings, $P switch support
+
+  Revision 1.61  1998/11/18 15:44:18  peter
     * VALUEPARA for tp7 compatible value parameters
 
   Revision 1.60  1998/11/16 10:13:51  peter

compiler/tccal.pas

@@ -164,9 +164,10 @@ implementation
                       firstpass(p^.left);
                       allow_array_constructor:=old_array_constructor;
                     end;
-                   { don't generate an type conversion for open arrays   }
-                   { else we loss the ranges                             }
-                   if is_open_array(defcoll^.data) then
+                   { don't generate an type conversion for open arrays and
+                     openstring, else we loss the ranges }
+                   if is_open_array(defcoll^.data) or
+                      is_open_string(defcoll^.data) then
                     begin
                       { insert type conv but hold the ranges of the array }
                       oldtype:=p^.left^.resulttype;
@@ -190,6 +191,7 @@ implementation
                  is_shortstring(p^.left^.resulttype) and
                  is_shortstring(defcoll^.data) and
                  (defcoll^.paratyp=vs_var) and
+                 not(is_open_string(defcoll^.data)) and
                  not(is_equal(p^.left^.resulttype,defcoll^.data)) then
                  CGMessage(type_e_strict_var_string_violation);
               { Variablen for call by reference may not be copied }
@@ -978,7 +980,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.13  1998-11-24 17:03:51  peter
+  Revision 1.14  1998-11-27 14:50:52  peter
+    + open strings, $P switch support
+
+  Revision 1.13  1998/11/24 17:03:51  peter
     * fixed exactmatch removings
 
   Revision 1.12  1998/11/16 10:18:10  peter

compiler/tcinl.pas

@@ -780,43 +780,55 @@ implementation
                             end;
                          arraydef:
                             begin
-                              if is_open_array(p^.left^.resulttype) then
-                                begin
-                                   if p^.inlinenumber=in_low_x then
-                                     begin
-                                        hp:=genordinalconstnode(Parraydef(p^.left^.resulttype)^.lowrange,s32bitdef);
-                                        disposetree(p);
-                                        p:=hp;
-                                        firstpass(p);
-                                     end
-                                   else
-                                     begin
-                                        p^.resulttype:=s32bitdef;
-                                        p^.registers32:=max(1,
-                                          p^.registers32);
-                                        p^.location.loc:=LOC_REGISTER;
-                                     end;
-                                end
+                              if p^.inlinenumber=in_low_x then
+                               begin
+                                 hp:=genordinalconstnode(Parraydef(p^.left^.resulttype)^.lowrange,s32bitdef);
+                                 disposetree(p);
+                                 p:=hp;
+                                 firstpass(p);
+                               end
                               else
-                                begin
-                                   if p^.inlinenumber=in_low_x then
-                                     hp:=genordinalconstnode(Parraydef(p^.left^.resulttype)^.lowrange,s32bitdef)
-                                   else
-                                     hp:=genordinalconstnode(Parraydef(p^.left^.resulttype)^.highrange,s32bitdef);
-                                   disposetree(p);
-                                   p:=hp;
-                                   firstpass(p);
-                                end;
+                               begin
+                                 if is_open_array(p^.left^.resulttype) then
+                                  begin
+                                    p^.resulttype:=s32bitdef;
+                                    p^.registers32:=max(1,p^.registers32);
+                                    p^.location.loc:=LOC_REGISTER;
+                                  end
+                                 else
+                                  begin
+                                    hp:=genordinalconstnode(Parraydef(p^.left^.resulttype)^.highrange,s32bitdef);
+                                    disposetree(p);
+                                    p:=hp;
+                                    firstpass(p);
+                                  end;
+                               end;
                            end;
                          stringdef:
                            begin
                               if p^.inlinenumber=in_low_x then
-                                hp:=genordinalconstnode(0,u8bitdef)
+                               begin
+                                 hp:=genordinalconstnode(0,u8bitdef);
+                                 disposetree(p);
+                                 p:=hp;
+                                 firstpass(p);
+                               end
                               else
-                                hp:=genordinalconstnode(Pstringdef(p^.left^.resulttype)^.len,u8bitdef);
-                              disposetree(p);
-                              p:=hp;
-                              firstpass(p);
+                               begin
+                                 if is_open_string(p^.left^.resulttype) then
+                                  begin
+                                    p^.resulttype:=s32bitdef;
+                                    p^.registers32:=max(1,p^.registers32);
+                                    p^.location.loc:=LOC_REGISTER;
+                                  end
+                                 else
+                                  begin
+                                    hp:=genordinalconstnode(Pstringdef(p^.left^.resulttype)^.len,u8bitdef);
+                                    disposetree(p);
+                                    p:=hp;
+                                    firstpass(p);
+                                  end;
+                               end;
                            end;
                          else
                            CGMessage(type_e_mismatch);
@@ -863,7 +875,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.9  1998-11-24 17:04:28  peter
+  Revision 1.10  1998-11-27 14:50:53  peter
+    + open strings, $P switch support
+
+  Revision 1.9  1998/11/24 17:04:28  peter
     * fixed length(char) when char is a variable
 
   Revision 1.8  1998/11/14 10:51:33  peter

compiler/token.inc

@@ -169,6 +169,7 @@ type
     _PUBLISHED,
     _DESTRUCTOR,
     _CONSTRUCTOR,
+    _SHORTSTRING,
     _FINALIZATION,
     _IMPLEMENTATION,
     _INITIALIZATION
@@ -327,6 +328,7 @@ const
       (str:'PUBLISHED'     ;special:false;keyword:m_none),
       (str:'DESTRUCTOR'    ;special:false;keyword:m_all),
       (str:'CONSTRUCTOR'   ;special:false;keyword:m_all),
+      (str:'SHORTSTRING'   ;special:false;keyword:m_none),
       (str:'FINALIZATION'  ;special:false;keyword:m_class),
       (str:'IMPLEMENTATION';special:false;keyword:m_all),
       (str:'INITIALIZATION';special:false;keyword:m_class)
@@ -334,7 +336,10 @@ const
 
 {
   $Log$
-  Revision 1.6  1998-11-13 15:40:33  pierre
+  Revision 1.7  1998-11-27 14:50:54  peter
+    + open strings, $P switch support
+
+  Revision 1.6  1998/11/13 15:40:33  pierre
     + added -Se in Makefile cvstest target
     + lexlevel cleanup
       normal_function_level main_program_level and unit_init_level defined

compiler/types.pas

@@ -46,6 +46,9 @@ unit types;
     { true if p is a char }
     function is_char(def : pdef) : boolean;
 
+    { true if p points to an open string def }
+    function is_open_string(p : pdef) : boolean;
+
     { true if p points to an open array def }
     function is_open_array(p : pdef) : boolean;
 
@@ -261,6 +264,15 @@ unit types;
       end;
 
 
+    { true, if p points to an open array def }
+    function is_open_string(p : pdef) : boolean;
+      begin
+         is_open_string:=(p^.deftype=stringdef) and
+                        (pstringdef(p)^.string_typ=st_shortstring) and
+                        (pstringdef(p)^.len=0);
+      end;
+
+
     { true, if p points to an open array def }
     function is_open_array(p : pdef) : boolean;
       begin
@@ -1020,7 +1032,10 @@ unit types;
 end.
 {
   $Log$
-  Revision 1.38  1998-11-18 15:44:24  peter
+  Revision 1.39  1998-11-27 14:50:55  peter
+    + open strings, $P switch support
+
+  Revision 1.38  1998/11/18 15:44:24  peter
     * VALUEPARA for tp7 compatible value parameters
 
   Revision 1.37  1998/11/13 10:15:50  peter

rtl/inc/systemh.inc

@@ -24,7 +24,12 @@
                              Needed switches
 ****************************************************************************}
 
-{$I-,Q-,H-,R-}
+{$I-,Q-,H-,R-,V-}
+
+{ needed for insert,delete,readln }
+{$ifdef OPENSTRINGS}
+  {$P+}
+{$endif}
 
 { Stack check gives a note under linux }
 {$ifndef linux}
@@ -432,7 +437,10 @@ const
 
 {
   $Log$
-  Revision 1.43  1998-11-26 23:16:13  jonas
+  Revision 1.44  1998-11-27 14:50:57  peter
+    + open strings, $P switch support
+
+  Revision 1.43  1998/11/26 23:16:13  jonas
     * changed RandSeed and OldRandSeed to Cardinal to avoid negative random numbers
 
   Revision 1.42  1998/11/24 17:12:43  peter

rtl/inc/text.inc

@@ -726,8 +726,15 @@ Begin
 End;
 
 
+{$ifdef OPENSTRINGS}
+Procedure Read_String(var f : TextRec;var s : String);[Public,Alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_STRING'];
+{$else}
 Procedure Read_String(Maxlen : Longint;var f : TextRec;var s : String);[Public,Alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_STRING'];
+{$endif}
 var
+{$ifdef OPENSTRINGS}
+  maxlen,
+{$endif}
   sPos,len : Longint;
   p,startp,maxp : pchar;
 Begin
@@ -743,6 +750,9 @@ Begin
    end;
 { Read maximal until Maxlen is reached }
   sPos:=0;
+{$ifdef OPENSTRINGS}
+  MaxLen:=high(s);
+{$endif}
   repeat
     If f.BufPos>=f.BufEnd Then
      begin
@@ -902,15 +912,23 @@ Begin
 End;
 
 
-Procedure Read_String(Maxlen : Longint;var f : TextRec;var s : AnsiString);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_ANSISTRING'];
+{$ifdef OPENSTRINGS}
+Procedure Read_AnsiString(var f : TextRec;var s : AnsiString);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_ANSISTRING'];
+{$else}
+Procedure Read_AnsiString(Maxlen : Longint;var f : TextRec;var s : AnsiString);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_ANSISTRING'];
+{$endif}
 var
   p,maxp,startp,sidx : PChar;
+{$ifdef OPENSTRINGS}
+  maxlen,
+{$endif}
   spos,len : longint;
 Begin
 { Delete the string }
   Decr_ansi_ref (Pointer(S));
   { We assign room for 1024 characters totally at random.... }
   Pointer(s):=Pointer(NewAnsiString(1024));
+  MaxLen:=1024;
 { Check error and if file is open }
   If (InOutRes<>0) then
    exit;
@@ -1194,7 +1212,10 @@ end;
 
 {
   $Log$
-  Revision 1.34  1998-11-16 12:21:48  peter
+  Revision 1.35  1998-11-27 14:50:58  peter
+    + open strings, $P switch support
+
+  Revision 1.34  1998/11/16 12:21:48  peter
     * fixes for 0.99.8
 
   Revision 1.33  1998/10/23 00:03:29  peter