* fixes handling of typed files in iso mode

git-svn-id: trunk@26436 -

compiler/ninl.pas

@@ -1044,7 +1044,8 @@ implementation
 
     {Read/write for typed files.}
 
-    const  procprefixes:array[boolean] of string[15]=('fpc_typed_write','fpc_typed_read');
+    const  procprefixes:array[boolean,boolean] of string[19]=(('fpc_typed_write','fpc_typed_read'),
+                                                              ('fpc_typed_write','fpc_typed_read_iso'));
            procnamesdisplay:array[boolean,boolean] of string[8] = (('Write','Read'),('WriteStr','ReadStr'));
 
     var found_error,do_read,is_rwstr:boolean;
@@ -1134,7 +1135,7 @@ implementation
           { since the parameters are in the correct order, we have to insert }
           { the statements always at the end of the current block            }
           addstatement(Tstatementnode(newstatement),
-            Ccallnode.createintern(procprefixes[do_read],para
+            Ccallnode.createintern(procprefixes[m_iso in current_settings.modeswitches,do_read],para
           ));
 
           { if we used a temp, free it }

compiler/pexpr.pas

@@ -1781,11 +1781,21 @@ implementation
 
                { iso file buf access? }
                if (m_iso in current_settings.modeswitches) and
-                 (p1.resultdef.typ=filedef) and
-                 (tfiledef(p1.resultdef).filetyp=ft_text) then
+                 (p1.resultdef.typ=filedef) then
                  begin
-                   p1:=cderefnode.create(ccallnode.createintern('fpc_getbuf',ccallparanode.create(p1,nil)));
-                   typecheckpass(p1);
+                   case tfiledef(p1.resultdef).filetyp of
+                     ft_text:
+                       begin
+                         p1:=cderefnode.create(ccallnode.createintern('fpc_getbuf_text',ccallparanode.create(p1,nil)));
+                         typecheckpass(p1);
+                       end;
+                     ft_typed:
+                       begin
+                         p1:=cderefnode.create(ctypeconvnode.create_internal(ccallnode.createintern('fpc_getbuf_typedfile',ccallparanode.create(p1,nil)),
+                           getpointerdef(tfiledef(p1.resultdef).typedfiledef)));
+                         typecheckpass(p1);
+                       end;
+                   end;
                  end
                else if (p1.resultdef.typ<>pointerdef) then
                  begin

compiler/symdef.pas

@@ -2824,13 +2824,19 @@ implementation
     procedure tfiledef.setsize;
       begin
        case filetyp of
-         ft_text    :
+         ft_text:
            savesize:=search_system_type('TEXTREC').typedef.size;
-         ft_typed,
-         ft_untyped :
+         ft_typed:
+           begin
+             savesize:=search_system_type('FILEREC').typedef.size;
+             { allocate put/get buffer in iso mode }
+             if m_iso in current_settings.modeswitches then
+               inc(savesize,typedfiledef.size);
+           end;
+         ft_untyped:
            savesize:=search_system_type('FILEREC').typedef.size;
-           else
-             internalerror(2013113001);
+         else
+           internalerror(2013113001);
          end;
       end;
 

rtl/inc/compproc.inc

@@ -511,7 +511,8 @@ procedure fpc_Read_Text_Int64_Iso(var f : text; out i : int64); compilerproc;
 Procedure fpc_Read_Text_LongWord(var f : text; out q : longword); compilerproc;
 Procedure fpc_Read_Text_LongInt(var f : text; out i : longint); compilerproc;
 {$endif CPU16 or CPU8}
-function fpc_GetBuf(var f : Text) : pchar; compilerproc;
+function fpc_GetBuf_Text(var f : Text) : pchar; compilerproc;
+function fpc_GetBuf_TypedFile(var f : TypedFile) : pointer; compilerproc;
 {$endif FPC_HAS_FEATURE_TEXTIO}
 
 {$ifdef FPC_INCLUDE_SOFTWARE_MOD_DIV}
@@ -690,6 +691,7 @@ Procedure fpc_reset_typed_iso(var f : TypedFile;Size : Longint); compilerproc;
 Procedure fpc_rewrite_typed_iso(var f : TypedFile;Size : Longint); compilerproc;
 Procedure fpc_typed_write(TypeSize : Longint;var f : TypedFile;const Buf); compilerproc;
 Procedure fpc_typed_read(TypeSize : Longint;var f : TypedFile;out Buf); compilerproc;
+Procedure fpc_typed_read_iso(TypeSize : Longint;var f : TypedFile;out Buf); compilerproc;
 {$endif FPC_HAS_FEATURE_FILEIO}
 
 {$ifdef FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}

rtl/inc/iso7185.pp

@@ -40,6 +40,9 @@ unit iso7185;
     Procedure Get(Var t: Text);
     Procedure Put(Var t: Text);
 
+    Procedure Get(Var f: TypedFile);
+    Procedure Put(Var f: TypedFile);
+
     Function Eof(var f:TypedFile): Boolean;
 
   implementation
@@ -79,10 +82,17 @@ unit iso7185;
       var
         OldCtrlZMarksEof : Boolean;
       Begin
-        OldCtrlZMarksEof:=CtrlZMarksEOF;
-        CtrlZMarksEof:=false;
-        Eof:=System.Eof(t);
-        CtrlZMarksEof:=OldCtrlZMarksEOF;
+        { not sure if this is correct, but we are always at eof when
+          writing to a file }
+        if TextRec(t).mode=fmOutput then
+          Eof:=true
+        else
+          begin
+            OldCtrlZMarksEof:=CtrlZMarksEOF;
+            CtrlZMarksEof:=false;
+            Eof:=System.Eof(t);
+            CtrlZMarksEof:=OldCtrlZMarksEOF;
+          end;
       end;
 
 
@@ -109,19 +119,19 @@ unit iso7185;
       End;
 
 
-    Procedure Page;
+    Procedure Page;[IOCheck];
       begin
         Page(Output);
       end;
 
 
-    Procedure Page(var t : Text);
+    Procedure Page(var t : Text);[IOCheck];
       Begin
         write(#12);
       End;
 
 
-    procedure Get(var t : Text);
+    procedure Get(var t : Text);[IOCheck];
       var
         c : char;
       Begin
@@ -129,7 +139,7 @@ unit iso7185;
       End;
 
 
-    Procedure Put(var t : Text);
+    Procedure Put(var t : Text);[IOCheck];
       type
         FileFunc = Procedure(var t : TextRec);
       begin
@@ -139,7 +149,20 @@ unit iso7185;
       end;
 
 
-    Function Eof(var f:TypedFile): Boolean;
+    procedure Get(var f:TypedFile);[IOCheck];
+      Begin
+        if not(eof(f)) then
+          BlockRead(f,(pbyte(@f)+sizeof(FileRec))^,1)
+      End;
+
+
+    Procedure Put(var f:TypedFile);[IOCheck];
+      begin
+        BlockWrite(f,(pbyte(@f)+sizeof(FileRec))^,1)
+      end;
+
+
+    Function Eof(var f:TypedFile): Boolean;[IOCheck];
       Type
         UnTypedFile = File;
       Begin
@@ -150,8 +173,7 @@ 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 }
   Randomize;
+  { reset opens with read-only }
+  Filemode:=0;
 end.
 
-
-
-

rtl/inc/text.inc

@@ -1724,7 +1724,7 @@ end;
 procedure fpc_Read_Text_Char_intern(var f : Text; out c: char); iocheck; [external name 'FPC_READ_TEXT_CHAR'];
 
 
-function fpc_GetBuf(var f : Text) : pchar; iocheck; compilerproc;
+function fpc_GetBuf_Text(var f : Text) : pchar; iocheck; compilerproc;
 Begin
   Result:=@TextRec(f).Bufptr^[TextRec(f).BufEnd];
   If not CheckRead(f) then

rtl/inc/typefile.inc

@@ -97,6 +97,7 @@ Begin
     DoAssign(f);
 
   Reset(UnTypedFile(f),Size);
+  BlockRead(UntypedFile(f),(pbyte(@f)+sizeof(FileRec))^,1);
 End;
 
 
@@ -143,3 +144,19 @@ Begin
   end;
 End;
 
+
+Procedure fpc_typed_read_iso(TypeSize : Longint;var f : TypedFile;out Buf);[IOCheck, Public, Alias :'FPC_TYPED_READ_ISO']; compilerproc;
+var
+  Result : Longint;
+Begin
+  move((pbyte(@f)+sizeof(TypedFile))^,Buf,TypeSize);
+  if not(eof(f)) then
+    BlockRead(f,(pbyte(@f)+sizeof(FileRec))^,1)
+End;
+
+
+function fpc_GetBuf_TypedFile(var f : TypedFile) : pointer; [IOCheck]; compilerproc;
+Begin
+  Result:=pbyte(@f)+sizeof(TypedFile);
+end;
+