paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-28 23:42:27 +01:00
Code Issues Packages Projects Releases Wiki Activity

* dup and dup2 work for go32v2

Browse Source 
+ also should work for linux (after linux.pp patch)
This commit is contained in:
pierre 1999-02-22 11:12:33 +00:00
parent ebb2c9f47d
commit 1ededfde9a
1 changed files with 77 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

177
ide/text/fpredir.pas
View File

@ -24,13 +24,20 @@ Interface
{$endif} {$endif}
{$ifdef TP} {$ifdef TP}
{$define in_dos} {$define implemented}
{$define usedup}
{$endif TP} {$endif TP}
{$ifdef Go32v2} {$ifdef Go32v2}
{$define in_dos} {$define implemented}
{ $define usedup}
{$endif} {$endif}
{$ifdef linux}
{$define implemented}
{$endif}
{ be sure msdos is not set for FPC compiler }
{$ifdef FPC}
{$UnDef MsDos}
{$endif FPC}
Var Var
IOStatus : Integer; IOStatus : Integer;
@ -53,19 +60,29 @@ Uses
{$ifdef go32v2} {$ifdef go32v2}
go32, go32,
{$endif go32v2} {$endif go32v2}
{$ifdef linux}
linux,
{$endif linux}
dos; dos;
{***************************************************************************** {*****************************************************************************
Dos Dos
*****************************************************************************} *****************************************************************************}
{$ifdef in_dos} {$ifdef implemented}
{$ifdef TP}
const
UnusedHandle = -1;
StdInputHandle = 0;
StdOutputHandle = 1;
StdErrorHandle = 2;
Type Type
PtrRec = packed record PtrRec = packed record
Ofs, Seg : Word; Ofs, Seg : Word;
end; end;
PHandles = ^THandles; PHandles = ^THandles;
THandles = Array [Byte] of Byte; THandles = Array [Byte] of Byte;
@ -74,24 +91,24 @@ Type
Var Var
PrefSeg : Word; PrefSeg : Word;
{$IfDef MsDos}
MinBlockSize : Word; MinBlockSize : Word;
MyBlockSize : Word; MyBlockSize : Word;
{$endif}
F,FE : File;
RedirChanged : Boolean;
RedirErrorChanged : Boolean;
OldHandle,OldErrorHandle : Byte;
{$ifdef UseDUP}
TempH, TempErrorH : longint;
{$endif}
{$ifdef FPC}
HandlesOffset : word;
{$else}
Handles : PHandles; Handles : PHandles;
{$endif FPC} OldHandle,OldErrorHandle : Byte;
{$endif TP}
function dup(fh : longint) : longint; Var
F,FE : File;
RedirChanged : Boolean;
RedirErrorChanged : Boolean;
TempH, TempErrorH : longint;
{ For linux the following functions exist
Function Dup(oldfile:longint;var newfile:longint):Boolean;
Function Dup2(oldfile,newfile:longint):Boolean; }
{$ifdef go32v2}
function dup(fh : longint;var nh : longint) : boolean;
var var
Regs : Registers; Regs : Registers;
@ -99,32 +116,31 @@ begin
Regs.ah:=$45; Regs.ah:=$45;
Regs.bx:=fh; Regs.bx:=fh;
MsDos (Regs); MsDos (Regs);
Dup:=true;
If (Regs.Flags and fCarry)=0 then If (Regs.Flags and fCarry)=0 then
Dup:=Regs.Ax nh:=Regs.Ax
else else
Dup:=-1; Dup:=false;
end; end;
function dup2(fh,nh : longint) : longint; function dup2(fh,nh : longint) : boolean;
var var
Regs : Registers; Regs : Registers;
begin begin
Dup2:=true;
If fh=nh then If fh=nh then
begin exit;
dup2:=nh;
exit;
end;
Regs.ah:=$46; Regs.ah:=$46;
Regs.bx:=fh; Regs.bx:=fh;
Regs.cx:=nh; Regs.cx:=nh;
MsDos (Regs); MsDos (Regs);
If (Regs.Flags and fCarry)=0 then If (Regs.Flags and fCarry)<>0 then
Dup2:=nh Dup2:=false;
else
Dup2:=-1;
end; end;
{$endif def go32v2}
{$I-} {$I-}
function FileExist(const FileName : PathStr) : Boolean; function FileExist(const FileName : PathStr) : Boolean;
var var
@ -140,7 +156,6 @@ end;
{............................................................................} {............................................................................}
function ChangeRedir(Const Redir : String; AppendToFile : Boolean) : Boolean; function ChangeRedir(Const Redir : String; AppendToFile : Boolean) : Boolean;
var temp : byte;
begin begin
ChangeRedir:=False; ChangeRedir:=False;
If Redir = '' then Exit; If Redir = '' then Exit;
@ -154,29 +169,20 @@ function ChangeRedir(Const Redir : String; AppendToFile : Boolean) : Boolean;
RedirError:=IOResult; RedirError:=IOResult;
IOStatus:=RedirError; IOStatus:=RedirError;
If IOStatus <> 0 then Exit; If IOStatus <> 0 then Exit;
{$ifdef UseDUP} {$ifndef FPC}
TempH:=dup(1);
if dup2(1,FileRec(F).Handle)=FileRec(F).Handle then
{$else UseDUP}
{$ifndef FPC}
Handles:=Ptr (prefseg, PWord (Ptr (prefseg, $34))^); Handles:=Ptr (prefseg, PWord (Ptr (prefseg, $34))^);
OldHandle:=Handles^[1]; OldHandle:=Handles^[1];
Handles^[1]:=Handles^[FileRec (F).Handle]; Handles^[1]:=Handles^[FileRec (F).Handle];
{$else} ChangeRedir:=True;
DosMemGet(prefseg,HandlesOffset+1,OldHandle,1); {$else}
DosMemGet(prefseg,HandlesOffset+FileRec(F).handle,temp,1); if dup(StdOutputHandle,TempH) and
dosmemput(prefseg,HandlesOffset+1,temp,1); dup2(FileRec(F).Handle,StdOutputHandle) then
{ NO MEM use as %fs is distroyed somewhere !!
OldHandle:=Mem[prefseg:HandlesOffset+1];
Mem[prefseg:HandlesOffset+1]:=Mem[prefseg:HandlesOffset+FileRec(F).handle];}
{$endif}
{$endif UseDUP}
ChangeRedir:=True; ChangeRedir:=True;
{$endif def FPC}
RedirChanged:=True; RedirChanged:=True;
end; end;
function ChangeErrorRedir(Const Redir : String; AppendToFile : Boolean) : Boolean; function ChangeErrorRedir(Const Redir : String; AppendToFile : Boolean) : Boolean;
var temp : byte;
begin begin
ChangeErrorRedir:=False; ChangeErrorRedir:=False;
If Redir = '' then Exit; If Redir = '' then Exit;
@ -192,29 +198,21 @@ function ChangeErrorRedir(Const Redir : String; AppendToFile : Boolean) : Boolea
RedirError:=IOResult; RedirError:=IOResult;
IOStatus:=RedirError; IOStatus:=RedirError;
If IOStatus <> 0 then Exit; If IOStatus <> 0 then Exit;
{$ifdef UseDUP} {$ifndef FPC}
TempErrorH:=dup(2);
if dup2(2,FileRec(F).Handle)=FileRec(F).Handle then
{$else UseDUP}
{$ifndef FPC}
Handles:=Ptr (prefseg, PWord (Ptr (prefseg, $34))^); Handles:=Ptr (prefseg, PWord (Ptr (prefseg, $34))^);
OldErrorHandle:=Handles^[2]; OldErrorHandle:=Handles^[2];
Handles^[2]:=Handles^[FileRec (FE).Handle]; Handles^[2]:=Handles^[FileRec (FE).Handle];
{$else} ChangeErrorRedir:=True;
DosMemGet(prefseg,HandlesOffset+2,OldErrorHandle,1); {$else}
DosMemGet(prefseg,HandlesOffset+FileRec(F).handle,temp,1); if dup(StdErrorHandle,TempErrorH) and
dosmemput(prefseg,HandlesOffset+1,temp,1); dup2(FileRec(FE).Handle,StdErrorHandle) then
{OldErrorHandle:=Mem[prefseg:HandlesOffset+2];
Mem[prefseg:HandlesOffset+2]:=Mem[prefseg:HandlesOffset+FileRec(FE).handle];}
{$endif}
{$endif UseDUP}
ChangeErrorRedir:=True; ChangeErrorRedir:=True;
RedirErrorChanged:=True; {$endif}
RedirErrorChanged:=True;
end; end;
{$IfDef MsDos} {$IfDef MsDos}
{Set HeapEnd Pointer to Current Used Heapsize} {Set HeapEnd Pointer to Current Used Heapsize}
Procedure SmallHeap;assembler; Procedure SmallHeap;assembler;
asm asm
@ -252,16 +250,12 @@ end;
begin begin
If not RedirChanged then Exit; If not RedirChanged then Exit;
{$ifdef UseDUP}
dup2(1,TempH);
{$else UseDUP}
{$ifndef FPC} {$ifndef FPC}
Handles^[1]:=OldHandle; Handles^[1]:=OldHandle;
OldHandle:=StdOutputHandle;
{$else} {$else}
dosmemput(prefseg,HandlesOffset+1,OldHandle,1); dup2(TempH,StdOutputHandle);
{Mem[prefseg:HandlesOffset+1]:=OldHandle;}
{$endif} {$endif}
{$endif UseDUP}
Close (F); Close (F);
RedirChanged:=false; RedirChanged:=false;
end; end;
@ -274,13 +268,9 @@ end;
If not RedirErrorChanged then Exit; If not RedirErrorChanged then Exit;
{$ifndef FPC} {$ifndef FPC}
Handles^[2]:=OldErrorHandle; Handles^[2]:=OldErrorHandle;
OldErrorHandle:=StdErrorHandle;
{$else} {$else}
{$ifdef UseDUP} dup2(TempErrorH,StdErrorHandle);
dup2(1,TempErrorH);
{$else UseDUP}
dosmemput(prefseg,HandlesOffset+2,OldErrorHandle,1);
{Mem[prefseg:HandlesOffset+2]:=OldErrorHandle;}
{$endif UseDUP}
{$endif} {$endif}
Close (FE); Close (FE);
RedirErrorChanged:=false; RedirErrorChanged:=false;
@ -322,28 +312,13 @@ Begin
End; End;
procedure InitRedir; {$else not implemented}
begin
{$ifndef FPC}
PrefSeg:=PrefixSeg;
{$else FPC}
{$ifdef go32v2}
PrefSeg:=go32_info_block.linear_address_of_original_psp div 16;
HandlesOffset:=Memw[prefseg:$34];
{$else }
PrefSeg:=0;
{$endif }
{$endif FPC}
end;
{$endif indos}
{***************************************************************************** {*****************************************************************************
Linux Linux
*****************************************************************************} *****************************************************************************}
{$ifdef linux}
function ExecuteRedir (Const ProgName, ComLine, RedirStdOut, RedirStdErr : String) : boolean; function ExecuteRedir (Const ProgName, ComLine, RedirStdOut, RedirStdErr : String) : boolean;
begin begin
@ -372,19 +347,21 @@ procedure InitRedir;
begin begin
end; end;
{$endif linux} {$endif not implemented}
{***************************************************************************** {*****************************************************************************
Initialize Initialize
*****************************************************************************} *****************************************************************************}
Begin
InitRedir;
End. End.
{ {
$Log$ $Log$
Revision 1.8 1999-02-22 02:15:18 peter Revision 1.9 1999-02-22 11:12:33 pierre
* dup and dup2 work for go32v2
+ also should work for linux (after linux.pp patch)
Revision 1.8 1999/02/22 02:15:18 peter
+ default extension for save in the editor + default extension for save in the editor
+ Separate Text to Find for the grep dialog + Separate Text to Find for the grep dialog
* fixed redir crash with tp7 * fixed redir crash with tp7