* support of iso pascal like i/o in iso mode

git-svn-id: trunk@15685 -

compiler/ninl.pas

@@ -390,7 +390,7 @@ implementation
         fracpara:Tcallparanode;
         temp:Ttempcreatenode;
         readfunctype:Tdef;
-        name:string[31];
+        name:string[63];
 
     begin
       para:=Tcallparanode(params);
@@ -446,11 +446,6 @@ implementation
                 else
                   begin
                     name := procprefixes[do_read]+'float';
-
-                    { iso pascal needs a different handler due to upper/lower E differences }
-                    if (m_iso in current_settings.modeswitches) and not(do_read) then
-                       name:=name+'_iso';
-
                     readfunctype:=pbestrealtype^;
                   end;
               end;
@@ -485,6 +480,9 @@ implementation
                   uchar :
                     begin
                       name := procprefixes[do_read]+'char';
+                      { iso pascal needs a different handler }
+                      if (m_iso in current_settings.modeswitches) and do_read then
+                        name:=name+'_iso';
                       readfunctype:=cchartype;
                     end;
                   uwidechar :
@@ -523,11 +521,6 @@ implementation
                     else
                       begin
                         name := procprefixes[do_read]+'boolean';
-
-                        { iso pascal needs a different handler }
-                        if (m_iso in current_settings.modeswitches) and not(do_read) then
-                           name:=name+'_iso';
-
                         readfunctype:=booltype;
                       end
                   else
@@ -560,6 +553,10 @@ implementation
               end;
           end;
 
+          { iso pascal needs a different handler }
+          if (m_iso in current_settings.modeswitches) and not(do_read) then
+            name:=name+'_iso';
+
           { check for length/fractional colon para's }
           fracpara:=nil;
           lenpara:=nil;
@@ -607,8 +604,14 @@ implementation
                   if not is_real then
                     begin
                       if not assigned(lenpara) then
-                        lenpara := ccallparanode.create(
-                          cordconstnode.create(0,s32inttype,false),nil)
+                        begin
+                          if m_iso in current_settings.modeswitches then
+                            lenpara := ccallparanode.create(
+                              cordconstnode.create(-1,s32inttype,false),nil)
+                          else
+                            lenpara := ccallparanode.create(
+                              cordconstnode.create(0,s32inttype,false),nil);
+                        end
                       else
                         { make sure we don't pass the successive }
                         { parameters too. We also already have a }
@@ -779,7 +782,11 @@ implementation
             in_writestr_x:
               name:='fpc_write_end';
             in_readln_x:
-              name:='fpc_readln_end';
+              begin
+                name:='fpc_readln_end';
+                if m_iso in current_settings.modeswitches then
+                  name:=name+'_iso';
+              end;
             in_writeln_x:
               name:='fpc_writeln_end';
           end;

rtl/inc/compproc.inc

@@ -462,7 +462,9 @@ Function fpc_get_output:PText;compilerproc;
 Procedure fpc_Write_End(var f:Text); compilerproc;
 Procedure fpc_Writeln_End(var f:Text); compilerproc;
 Procedure fpc_Write_Text_ShortStr(Len : Longint;var f : Text;const s : String); compilerproc;
+Procedure fpc_Write_Text_ShortStr_Iso(Len : Longint;var f : Text;const s : String); compilerproc;
 Procedure fpc_Write_Text_Pchar_as_Array(Len : Longint;var f : Text;const s : array of char; zerobased: boolean = true); compilerproc;
+Procedure fpc_Write_Text_Pchar_as_Array_Iso(Len : Longint;var f : Text;const s : array of char; zerobased: boolean = true); compilerproc;
 Procedure fpc_Write_Text_PChar_As_Pointer(Len : Longint;var f : Text;p : PChar); compilerproc;
 Procedure fpc_Write_Text_AnsiStr (Len : Longint; Var f : Text; const S : AnsiString); compilerproc;
 {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
@@ -473,9 +475,13 @@ Procedure fpc_Write_Text_UnicodeStr (Len : Longint; Var f : Text; const S : Wide
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
 Procedure fpc_Write_Text_SInt(Len : Longint;var t : Text;l : ValSInt); compilerproc;
 Procedure fpc_Write_Text_UInt(Len : Longint;var t : Text;l : ValUInt); compilerproc;
+Procedure fpc_Write_Text_SInt_Iso(Len : Longint;var t : Text;l : ValSInt); compilerproc;
+Procedure fpc_Write_Text_UInt_Iso(Len : Longint;var t : Text;l : ValUInt); compilerproc;
 {$ifndef CPU64}
 procedure fpc_write_text_qword(len : longint;var t : text;q : qword); compilerproc;
 procedure fpc_write_text_int64(len : longint;var t : text;i : int64); compilerproc;
+procedure fpc_write_text_qword_iso(len : longint;var t : text;q : qword); compilerproc;
+procedure fpc_write_text_int64_iso(len : longint;var t : text;i : int64); compilerproc;
 {$endif CPU64}
 {$ifndef FPUNONE}
 Procedure fpc_Write_Text_Float(rt,fixkomma,Len : Longint;var t : Text;r : ValReal); compilerproc;
@@ -488,6 +494,7 @@ Procedure fpc_Write_Text_Currency(fixkomma,Len : Longint;var t : Text;c : Curren
 Procedure fpc_Write_Text_Boolean(Len : Longint;var t : Text;b : Boolean); compilerproc;
 Procedure fpc_Write_Text_Boolean_Iso(Len : Longint;var t : Text;b : Boolean); compilerproc;
 Procedure fpc_Write_Text_Char(Len : Longint;var t : Text;c : Char); compilerproc;
+Procedure fpc_Write_Text_Char_Iso(Len : Longint;var t : Text;c : Char); compilerproc;
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
 Procedure fpc_Write_Text_WideChar(Len : Longint;var t : Text;c : WideChar); compilerproc;
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
@@ -527,6 +534,7 @@ procedure fpc_dispinvoke_variant(dest : pvardata;const source : tvardata;  calld
 {$ifdef FPC_HAS_FEATURE_TEXTIO}
 Procedure fpc_Read_End(var f:Text); compilerproc;
 Procedure fpc_ReadLn_End(var f : Text); compilerproc;
+Procedure fpc_ReadLn_End_Iso(var f : Text); compilerproc;
 Procedure fpc_Read_Text_ShortStr(var f : Text;out s : String); compilerproc;
 Procedure fpc_Read_Text_PChar_As_Pointer(var f : Text; const s : PChar); compilerproc;
 Procedure fpc_Read_Text_PChar_As_Array(var f : Text;out s : array of char; zerobased: boolean = false); compilerproc;
@@ -534,6 +542,7 @@ Procedure fpc_Read_Text_PChar_As_Array(var f : Text;out s : array of char; zerob
 Procedure fpc_Read_Text_AnsiStr(var f : Text;out s : AnsiString); compilerproc;
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 Procedure fpc_Read_Text_Char(var f : Text; out c : char); compilerproc;
+Procedure fpc_Read_Text_Char_Iso(var f : Text; out c : char); compilerproc;
 Procedure fpc_Read_Text_SInt(var f : Text; out l :ValSInt); compilerproc;
 Procedure fpc_Read_Text_UInt(var f : Text; out u :ValUInt); compilerproc;
 {$ifndef FPUNONE}

rtl/inc/iso7185.pp

@@ -29,6 +29,9 @@ unit iso7185;
     Procedure Reset(var f : TypedFile);   [INTERNPROC: fpc_in_Reset_TypedFile];
     Procedure Rewrite(var f : TypedFile); [INTERNPROC: fpc_in_Rewrite_TypedFile];
 
+    Function Eof(Var t: Text): Boolean;
+    Function Eof:Boolean;
+
   implementation
 
   {$i textrec.inc}
@@ -52,13 +55,34 @@ unit iso7185;
 
     Procedure Reset(var t : Text);[IOCheck];
       Begin
-        { create file name? }
-        if Textrec(t).mode=0 then
-          DoAssign(t);
+        case Textrec(t).mode of
+          { create file name? }
+          0:
+            DoAssign(t);
+          fmOutput:
+            Write(t,#26);
+        end;
 
         System.Reset(t);
       End;
 
+
+    Function Eof(Var t: Text): Boolean;[IOCheck];
+      var
+        OldCtrlZMarksEof : Boolean;
+      Begin
+        OldCtrlZMarksEof:=CtrlZMarksEOF;
+        CtrlZMarksEof:=false;
+        Eof:=System.Eof(t);
+        CtrlZMarksEof:=OldCtrlZMarksEOF;
+      end;
+
+
+    Function Eof:Boolean;
+      Begin
+        Eof:=Eof(Input);
+      End;
+
 begin
   { we shouldn't do this because it might confuse user programs, but for now it
     is good enough to get pretty unique tmp file names }

rtl/inc/text.inc

@@ -538,9 +538,38 @@ Begin
   end;
 End;
 
+
+Procedure fpc_Write_Text_ShortStr_Iso(Len : Longint;var f : Text;const s : String); iocheck; [Public,Alias:'FPC_WRITE_TEXT_SHORTSTR_ISO']; compilerproc;
+Begin
+  If (InOutRes<>0) then
+   exit;
+  case TextRec(f).mode of
+    fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
+      begin
+        { default value? }
+        If Len=-1 then
+          Len:=length(s);
+
+        If Len>Length(s) Then
+          begin
+            fpc_WriteBlanks(f,Len-Length(s));
+            fpc_WriteBuffer(f,s[1],Length(s));
+          end
+        else
+          fpc_WriteBuffer(f,s[1],Len);
+      end;
+    fmInput: InOutRes:=105
+    else InOutRes:=103;
+  end;
+End;
+
+
 { provide local access to write_str }
 procedure Write_Str(Len : Longint;var f : Text;const s : String); iocheck; [external name 'FPC_WRITE_TEXT_SHORTSTR'];
 
+{ provide local access to write_str_iso }
+procedure Write_Str_Iso(Len : Longint;var f : Text;const s : String); iocheck; [external name 'FPC_WRITE_TEXT_SHORTSTR_ISO'];
+
 Procedure fpc_Write_Text_Pchar_as_Array(Len : Longint;var f : Text;const s : array of char; zerobased: boolean = true); iocheck; compilerproc;
 var
   ArrayLen : longint;
@@ -552,7 +581,7 @@ Begin
     fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
       begin
         p:=pchar(@s);
-        if (zerobased) then
+        if zerobased then
           begin
             { can't use StrLen, since that one could try to read past the end }
             { of the heap (JM)                                                }
@@ -573,6 +602,47 @@ Begin
 End;
 
 
+Procedure fpc_Write_Text_Pchar_as_Array_Iso(Len : Longint;var f : Text;const s : array of char; zerobased: boolean = true); iocheck; compilerproc;
+var
+  ArrayLen : longint;
+  p : pchar;
+Begin
+  If (InOutRes<>0) then
+   exit;
+  case TextRec(f).mode of
+    fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
+      begin
+        p:=pchar(@s);
+        if zerobased then
+          begin
+            { can't use StrLen, since that one could try to read past the end }
+            { of the heap (JM)                                                }
+            ArrayLen:=IndexByte(p^,high(s)+1,0);
+            { IndexByte returns -1 if not found (JM) }
+            if ArrayLen = -1 then
+              ArrayLen := high(s)+1;
+          end
+        else
+          ArrayLen := high(s)+1;
+
+        { default value? }
+        If Len=-1 then
+          Len:=ArrayLen;
+
+        If Len>ArrayLen Then
+          begin
+            fpc_WriteBlanks(f,Len-ArrayLen);
+            fpc_WriteBuffer(f,p^,ArrayLen);
+          end
+        else
+          fpc_WriteBuffer(f,p^,Len);
+      end;
+    fmInput: InOutRes:=105
+    else InOutRes:=103;
+  end;
+End;
+
+
 Procedure fpc_Write_Text_PChar_As_Pointer(Len : Longint;var f : Text;p : PChar); iocheck; compilerproc;
 var
   PCharLen : longint;
@@ -694,8 +764,38 @@ Begin
 End;
 
 
-{$ifndef CPU64}
+Procedure fpc_Write_Text_SInt_Iso(Len : Longint;var t : Text;l : ValSInt); iocheck; compilerproc;
+var
+  s : String;
+Begin
+  If (InOutRes<>0) then
+   exit;
+  Str(l,s);
+  { default value? }
+  if len=-1 then
+    len:=11
+  else if len<length(s) then
+    len:=length(s);
+  Write_Str_Iso(Len,t,s);
+End;
+
 
+Procedure fpc_Write_Text_UInt_Iso(Len : Longint;var t : Text;l : ValUInt); iocheck; compilerproc;
+var
+  s : String;
+Begin
+  If (InOutRes<>0) then
+   exit;
+  Str(L,s);
+  { default value? }
+  if len=-1 then
+    len:=11
+  else if len<length(s) then
+    len:=length(s);
+  Write_Str_Iso(Len,t,s);
+End;
+
+{$ifndef CPU64}
 procedure fpc_write_text_qword(len : longint;var t : text;q : qword); iocheck; compilerproc;
 var
   s : string;
@@ -706,6 +806,7 @@ begin
   write_str(len,t,s);
 end;
 
+
 procedure fpc_write_text_int64(len : longint;var t : text;i : int64); iocheck; compilerproc;
 var
   s : string;
@@ -716,6 +817,38 @@ begin
   write_str(len,t,s);
 end;
 
+
+procedure fpc_write_text_qword_iso(len : longint;var t : text;q : qword); iocheck; compilerproc;
+var
+  s : string;
+begin
+  if (InOutRes<>0) then
+    exit;
+  str(q,s);
+  { default value? }
+  if len=-1 then
+    len:=20
+  else if len<length(s) then
+    len:=length(s);
+  write_str_iso(len,t,s);
+end;
+
+
+procedure fpc_write_text_int64_iso(len : longint;var t : text;i : int64); iocheck; compilerproc;
+var
+  s : string;
+begin
+  if (InOutRes<>0) then
+   exit;
+  str(i,s);
+  { default value? }
+  if len=-1 then
+    len:=20
+  else if len<length(s) then
+    len:=length(s);
+  write_str_iso(len,t,s);
+end;
+
 {$endif CPU64}
 
 {$ifndef FPUNONE}
@@ -863,11 +996,14 @@ Procedure fpc_Write_Text_Boolean_Iso(Len : Longint;var t : Text;b : Boolean); io
 Begin
   If (InOutRes<>0) then
    exit;
-{ Can't use array[boolean] because b can be >0 ! }
+  { Can't use array[boolean] because b can be >0 ! }
+  { default value? }
+  If Len=-1 then
+    Len:=5;
   if b then
-    Write_Str(Len,t,'true')
+    Write_Str_Iso(Len,t,'true')
   else
-    Write_Str(Len,t,'false');
+    Write_Str_Iso(Len,t,'false');
 End;
 
 
@@ -892,6 +1028,32 @@ Begin
 End;
 
 
+Procedure fpc_Write_Text_Char_Iso(Len : Longint;var t : Text;c : Char); iocheck; compilerproc;
+Begin
+  If (InOutRes<>0) then
+    exit;
+  if (TextRec(t).mode<>fmOutput) Then
+   begin
+     if TextRec(t).mode=fmClosed then
+      InOutRes:=103
+     else
+      InOutRes:=105;
+     exit;
+   end;
+  { default value? }
+  If Len=-1 then
+    Len:=1;
+  If Len>1 Then
+    fpc_WriteBlanks(t,Len-1)
+  else If Len<1 Then
+    exit;
+  If TextRec(t).BufPos>=TextRec(t).BufSize Then
+    FileFunc(TextRec(t).InOutFunc)(TextRec(t));
+  TextRec(t).Bufptr^[TextRec(t).BufPos]:=c;
+  Inc(TextRec(t).BufPos);
+End;
+
+
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
 Procedure fpc_Write_Text_WideChar(Len : Longint;var t : Text;c : WideChar); iocheck; compilerproc;
 var
@@ -1064,6 +1226,64 @@ Begin
 End;
 
 
+Procedure fpc_ReadLn_End_Iso(var f : Text);[Public,Alias:'FPC_READLN_END_ISO']; iocheck; compilerproc;
+var prev: char;
+Begin
+  If not CheckRead(f) then
+    exit;
+  if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
+    { Flush if set }
+    begin
+      if (TextRec(f).FlushFunc<>nil) then
+        FileFunc(TextRec(f).FlushFunc)(TextRec(f));
+      exit;
+    end;
+  if TextRec (F).BufPtr^ [TextRec (F).BufPos] = #26 then
+    begin
+      inc(TextRec(f).BufPos);
+      Exit;
+    end;
+  repeat
+    prev := TextRec(f).BufPtr^[TextRec(f).BufPos];
+    inc(TextRec(f).BufPos);
+{ no system uses #10#13 as line seperator (#10 = *nix, #13 = Mac, }
+{ #13#10 = Dos), so if we've got #10, we can safely exit          }
+    if prev = #10 then
+      exit;
+    {$ifdef MACOS}
+    if prev = #13 then
+      {StdInput on macos never have dos line ending, so this is safe.}
+      if TextRec(f).Handle = StdInputHandle then
+        exit;
+    {$endif MACOS}
+    if TextRec(f).BufPos>=TextRec(f).BufEnd Then
+      begin
+        FileFunc(TextRec(f).InOutFunc)(TextRec(f));
+        if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
+          { Flush if set }
+          begin
+           if (TextRec(f).FlushFunc<>nil) then
+             FileFunc(TextRec(f).FlushFunc)(TextRec(f));
+           exit;
+         end;
+      end;
+   if TextRec (F).BufPtr^ [TextRec (F).BufPos] = #26 then
+     begin
+       inc(TextRec(f).BufPos);
+       Exit;
+     end;
+   if (prev=#13) then
+     { is there also a #10 after it? }
+     begin
+       if (TextRec(f).BufPtr^[TextRec(f).BufPos]=#10) then
+         { yes, skip that one as well }
+         inc(TextRec(f).BufPos);
+       exit;
+     end;
+  until false;
+End;
+
+
 Function ReadPCharLen(var f:Text;s:pchar;maxlen:longint):longint;
 var
   sPos,len : Longint;
@@ -1172,6 +1392,39 @@ Begin
 end;
 
 
+procedure fpc_Read_Text_Char_Iso(var f : Text; out c: char); iocheck;compilerproc;
+Begin
+  c:=' ';
+  If not CheckRead(f) then
+    exit;
+  If TextRec(f).BufPos>=TextRec(f).BufEnd Then
+    begin
+      c:=' ';
+      exit;
+    end;
+  c:=TextRec(f).Bufptr^[TextRec(f).BufPos];
+  inc(TextRec(f).BufPos);
+  if c=#13 then
+    begin
+      c:=' ';
+      If not CheckRead(f) or
+        (TextRec(f).BufPos>=TextRec(f).BufEnd) then
+        exit;
+      If TextRec(f).Bufptr^[TextRec(f).BufPos]=#10 then
+        inc(TextRec(f).BufPos);
+
+      { ignore #26 following a new line }
+      If not CheckRead(f) or
+        (TextRec(f).BufPos>=TextRec(f).BufEnd) then
+        exit;
+      If TextRec(f).Bufptr^[TextRec(f).BufPos]=#26 then
+        inc(TextRec(f).BufPos);
+    end
+  else if c in [#10,#26] then
+    c:=' ';
+end;
+
+
 Procedure fpc_Read_Text_SInt(var f : Text; out l : ValSInt); iocheck; compilerproc;
 var
   hs   : String;