Browse Source

* allow out file parameters
* assign has out file

git-svn-id: trunk@2717 -

peter 19 years ago
parent
commit
9566255122
6 changed files with 24 additions and 23 deletions
  1. 1 0
      compiler/options.pas
  2. 5 5
      compiler/pdecsub.pas
  3. 3 3
      rtl/inc/file.inc
  4. 9 9
      rtl/inc/systemh.inc
  5. 3 3
      rtl/inc/text.inc
  6. 3 3
      rtl/inc/typefile.inc

+ 1 - 0
compiler/options.pas

@@ -1794,6 +1794,7 @@ begin
   { "main" symbol is generated in the main program, and left out of the system unit }
   def_system_macro('FPC_DARWIN_PASCALMAIN');
   def_system_macro('COMPPROCINLINEFIXED');
+  def_system_macro('PARAOUTFILE');
 
   if pocall_default = pocall_register then
     def_system_macro('REGCALL');

+ 5 - 5
compiler/pdecsub.pas

@@ -584,9 +584,9 @@ implementation
           else
            tt:=cformaltype;
 
-          { File types are only allowed for var parameters }
+          { File types are only allowed for var and out parameters }
           if (tt.def.deftype=filedef) and
-             (varspez<>vs_var) then
+             not(varspez in [vs_out,vs_var]) then
             CGMessage(cg_e_file_must_call_by_reference);
 
           vs:=tparavarsym(sc.first);
@@ -1178,7 +1178,7 @@ begin
   if pd.deftype<>procdef then
     internalerror(200304268);
   consume(_COLON);
-  tprocdef(pd).extnumber:=get_intconst;
+  tprocdef(pd).extnumber:=longint(get_intconst);
 end;
 
 procedure pd_internproc(pd:tabstractprocdef);
@@ -1186,7 +1186,7 @@ begin
   if pd.deftype<>procdef then
     internalerror(200304268);
   consume(_COLON);
-  tprocdef(pd).extnumber:=get_intconst;
+  tprocdef(pd).extnumber:=longint(get_intconst);
   { the proc is defined }
   tprocdef(pd).forwarddef:=false;
 end;
@@ -1481,7 +1481,7 @@ begin
            begin
              {After the word index follows the index number in the DLL.}
              consume(_INDEX);
-             import_nr:=get_intconst;
+             import_nr:=longint(get_intconst);
            end;
           { default is to used the realname of the procedure }
           if (import_nr=0) and not assigned(import_name) then

+ 3 - 3
rtl/inc/file.inc

@@ -18,7 +18,7 @@
 type
   UnTypedFile=File;
 
-Procedure Assign(var f:File;const Name:string);
+Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} f:File;const Name:string);
 {
   Assign Name to file f so it can be used with the file routines
 }
@@ -30,7 +30,7 @@ Begin
 End;
 
 
-Procedure assign(var f:File;p:pchar);
+Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} f:File;p:pchar);
 {
   Assign Name to file f so it can be used with the file routines
 }
@@ -39,7 +39,7 @@ begin
 end;
 
 
-Procedure assign(var f:File;c:char);
+Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} f:File;c:char);
 {
   Assign Name to file f so it can be used with the file routines
 }

+ 9 - 9
rtl/inc/systemh.inc

@@ -504,9 +504,9 @@ function  lowercase(const s : ansistring) : ansistring;
                           Untyped File Management
 ****************************************************************************}
 
-Procedure Assign(var f:File;const Name:string);
-Procedure Assign(var f:File;p:pchar);
-Procedure Assign(var f:File;c:char);
+Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} f:File;const Name:string);
+Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} f:File;p:pchar);
+Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} f:File;c:char);
 Procedure Rewrite(var f:File;l:Longint);
 Procedure Rewrite(var f:File);
 Procedure Reset(var f:File;l:Longint);
@@ -539,9 +539,9 @@ Procedure Truncate (var F:File);
                            Typed File Management
 ****************************************************************************}
 
-Procedure Assign(var f:TypedFile;const Name:string);
-Procedure Assign(var f:TypedFile;p:pchar);
-Procedure Assign(var f:TypedFile;c:char);
+Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} f:TypedFile;const Name:string);
+Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} f:TypedFile;p:pchar);
+Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} f:TypedFile;c:char);
 Procedure Reset(var f : TypedFile);   [INTERNPROC: fpc_in_Reset_TypedFile];
 Procedure Rewrite(var f : TypedFile); [INTERNPROC: fpc_in_Rewrite_TypedFile];
 
@@ -549,9 +549,9 @@ Procedure Rewrite(var f : TypedFile); [INTERNPROC: fpc_in_Rewrite_TypedFile];
                             Text File Management
 ****************************************************************************}
 
-Procedure Assign(var t:Text;const s:string);
-Procedure Assign(var t:Text;p:pchar);
-Procedure Assign(var t:Text;c:char);
+Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} t:Text;const s:string);
+Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} t:Text;p:pchar);
+Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} t:Text;c:char);
 Procedure Close(var t:Text);
 Procedure Rewrite(var t:Text);
 Procedure Reset(var t:Text);

+ 3 - 3
rtl/inc/text.inc

@@ -72,7 +72,7 @@ Begin
 End;
 
 
-Procedure assign(var t:Text;const s:String);
+Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} t:Text;const s:String);
 Begin
   FillChar(t,SizeOf(TextRec),0);
 { only set things that are not zero }
@@ -90,13 +90,13 @@ Begin
 End;
 
 
-Procedure assign(var t:Text;p:pchar);
+Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} t:Text;p:pchar);
 begin
   Assign(t,StrPas(p));
 end;
 
 
-Procedure assign(var t:Text;c:char);
+Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} t:Text;c:char);
 begin
   Assign(t,string(c));
 end;

+ 3 - 3
rtl/inc/typefile.inc

@@ -15,7 +15,7 @@
                     subroutines for typed file handling
 ****************************************************************************}
 
-Procedure assign(var f:TypedFile;const Name:string);
+Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} f:TypedFile;const Name:string);
 {
   Assign Name to file f so it can be used with the file routines
 }
@@ -27,7 +27,7 @@ Begin
 End;
 
 
-Procedure assign(var f:TypedFile;p:pchar);
+Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} f:TypedFile;p:pchar);
 {
   Assign Name to file f so it can be used with the file routines
 }
@@ -36,7 +36,7 @@ begin
 end;
 
 
-Procedure assign(var f:TypedFile;c:char);
+Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} f:TypedFile;c:char);
 {
   Assign Name to file f so it can be used with the file routines
 }