mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-15 14:19:28 +02:00
* merged fixes from 1.0.x
This commit is contained in:
peter
parent
1700a42f14
commit
21a8c2cc8e
@ -215,10 +215,15 @@ END;
|
||||
|
||||
PROCEDURE Mouse_Trap_NT; ASSEMBLER;
|
||||
ASM
|
||||
pushl %eax;
|
||||
PUSH %ES; { Save ES register }
|
||||
PUSH %DS; { Save DS register }
|
||||
PUSH %FS; { Save FS register }
|
||||
PUSHL %EDI; { Save register }
|
||||
PUSHL %ESI; { Save register }
|
||||
pushl %ebx;
|
||||
pushl %ecx;
|
||||
pushl %edx;
|
||||
{ ; caution : ds is not the selector for our data !! }
|
||||
{$ifdef DEBUG}
|
||||
MOVL %EDI,%ES:EntryEDI
|
||||
@ -253,14 +258,19 @@ ASM
|
||||
MOVL 28(%EAX), %EAX; { EAX from actionregs }
|
||||
CALL *MOUSECALLBACK; { Call callback proc }
|
||||
.L_NoCallBack:
|
||||
popl %edx;
|
||||
popl %ecx;
|
||||
popl %ebx;
|
||||
POPL %ESI; { Recover register }
|
||||
POPL %EDI; { Recover register }
|
||||
POP %FS; { Restore FS register }
|
||||
POP %DS; { Restore DS register }
|
||||
POP %ES; { Restore ES register }
|
||||
movzwl %si,%eax
|
||||
MOVL %ds:(%Eax), %EAX;
|
||||
MOVL %EAX, %ES:42(%EDI); { Set as return addr }
|
||||
ADDW $4, %ES:46(%EDI); { adjust stack }
|
||||
popl %eax;
|
||||
IRET; { Interrupt return }
|
||||
END;
|
||||
|
||||
@ -731,13 +741,16 @@ Const
|
||||
PollMouseEvent : Nil;
|
||||
PutMouseEvent : Nil;
|
||||
);
|
||||
|
||||
|
||||
Begin
|
||||
SetMouseDriver(SysMouseDriver);
|
||||
SetMouseDriver(SysMouseDriver);
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2001-09-22 00:01:42 michael
|
||||
Revision 1.3 2001-12-26 21:03:56 peter
|
||||
* merged fixes from 1.0.x
|
||||
|
||||
Revision 1.2 2001/09/22 00:01:42 michael
|
||||
+ Merged driver support for mouse from fixbranch
|
||||
|
||||
Revision 1.1.2.2 2001/09/21 23:53:48 michael
|
||||
|
||||
@ -195,41 +195,12 @@
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Helper routines to support old TP styled reals
|
||||
****************************************************************************}
|
||||
|
||||
function real2double(r : real48) : double;
|
||||
|
||||
var
|
||||
res : array[0..7] of byte;
|
||||
exponent : word;
|
||||
|
||||
begin
|
||||
{ copy mantissa }
|
||||
res[0]:=0;
|
||||
res[1]:=r[1] shl 5;
|
||||
res[2]:=(r[1] shr 3) or (r[2] shl 5);
|
||||
res[3]:=(r[2] shr 3) or (r[3] shl 5);
|
||||
res[4]:=(r[3] shr 3) or (r[4] shl 5);
|
||||
res[5]:=(r[4] shr 3) or (r[5] and $7f) shl 5;
|
||||
res[6]:=(r[5] and $7f) shr 3;
|
||||
|
||||
{ copy exponent }
|
||||
{ correct exponent: }
|
||||
exponent:=(word(r[0])+(1023-129));
|
||||
res[6]:=res[6] or ((exponent and $f) shl 4);
|
||||
res[7]:=exponent shr 4;
|
||||
|
||||
{ set sign }
|
||||
res[7]:=res[7] or (r[5] and $80);
|
||||
real2double:=double(res);
|
||||
end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.6 2001-07-30 21:38:54 peter
|
||||
Revision 1.7 2001-12-26 21:03:56 peter
|
||||
* merged fixes from 1.0.x
|
||||
|
||||
Revision 1.6 2001/07/30 21:38:54 peter
|
||||
* m68k updates merged
|
||||
|
||||
Revision 1.1.2.3 2001/07/29 23:56:28 carl
|
||||
|
||||
@ -17,8 +17,8 @@
|
||||
{ I think we should use the pascal version, this code isn't }
|
||||
{ much faster }
|
||||
|
||||
{ $define FPC_SYSTEM_HAS_FPC_INITIALIZE}
|
||||
{
|
||||
{ define FPC_SYSTEM_HAS_FPC_INITIALIZE}
|
||||
(*
|
||||
Procedure fpc_Initialize (Data,TypeInfo : pointer);[Public,Alias:'FPC_INITIALIZE']; {$ifdef hascompilerproc} compilerproc; {$endif}
|
||||
assembler;
|
||||
asm
|
||||
@ -134,10 +134,10 @@ asm
|
||||
pop %ebx
|
||||
pop %eax
|
||||
end;
|
||||
}
|
||||
*)
|
||||
|
||||
{$ define FPC_SYSTEM_HAS_FPC_FINALIZE}
|
||||
{
|
||||
{ define FPC_SYSTEM_HAS_FPC_FINALIZE}
|
||||
(*
|
||||
Procedure fpc_finalize (Data,TypeInfo: Pointer);[Public,Alias:'FPC_FINALIZE']; {$ifdef hascompilerproc} compilerproc; {$endif}
|
||||
assembler;
|
||||
asm
|
||||
@ -250,7 +250,7 @@ asm
|
||||
pop %ebx
|
||||
pop %eax
|
||||
end;
|
||||
}
|
||||
*)
|
||||
|
||||
{$define FPC_SYSTEM_HAS_FPC_ADDREF}
|
||||
|
||||
@ -482,7 +482,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.12 2001-11-17 16:56:08 florian
|
||||
Revision 1.13 2001-12-26 21:03:56 peter
|
||||
* merged fixes from 1.0.x
|
||||
|
||||
Revision 1.12 2001/11/17 16:56:08 florian
|
||||
* init and final code in genrtti.inc updated
|
||||
|
||||
Revision 1.11 2001/11/14 22:59:11 michael
|
||||
|
||||
@ -983,9 +983,45 @@ Function float32_to_int32_round_to_zero( a: Float32 ): longint;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
{$ifdef SUPPORT_DOUBLE}
|
||||
{****************************************************************************
|
||||
Helper routines to support old TP styled reals
|
||||
****************************************************************************}
|
||||
|
||||
function real2double(r : real48) : double;
|
||||
|
||||
var
|
||||
res : array[0..7] of byte;
|
||||
exponent : word;
|
||||
|
||||
begin
|
||||
{ copy mantissa }
|
||||
res[0]:=0;
|
||||
res[1]:=r[1] shl 5;
|
||||
res[2]:=(r[1] shr 3) or (r[2] shl 5);
|
||||
res[3]:=(r[2] shr 3) or (r[3] shl 5);
|
||||
res[4]:=(r[3] shr 3) or (r[4] shl 5);
|
||||
res[5]:=(r[4] shr 3) or (r[5] and $7f) shl 5;
|
||||
res[6]:=(r[5] and $7f) shr 3;
|
||||
|
||||
{ copy exponent }
|
||||
{ correct exponent: }
|
||||
exponent:=(word(r[0])+(1023-129));
|
||||
res[6]:=res[6] or ((exponent and $f) shl 4);
|
||||
res[7]:=exponent shr 4;
|
||||
|
||||
{ set sign }
|
||||
res[7]:=res[7] or (r[5] and $80);
|
||||
real2double:=double(res);
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2001-07-30 21:38:55 peter
|
||||
Revision 1.3 2001-12-26 21:03:56 peter
|
||||
* merged fixes from 1.0.x
|
||||
|
||||
Revision 1.2 2001/07/30 21:38:55 peter
|
||||
* m68k updates merged
|
||||
|
||||
Revision 1.1.2.1 2001/07/29 23:58:16 carl
|
||||
|
||||
@ -31,16 +31,21 @@
|
||||
function power(bas,expo : extended) : extended;
|
||||
function power(bas,expo : longint) : longint;
|
||||
|
||||
{$ifdef SUPPORT_DOUBLE}
|
||||
type
|
||||
real48 = array[0..5] of byte;
|
||||
|
||||
function Real2Double(r : real48) : double;
|
||||
operator := (b:real48) d:double;
|
||||
operator := (b:real48) e:extended;
|
||||
{$endif}
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 2001-12-13 20:23:19 michael
|
||||
Revision 1.6 2001-12-26 21:03:56 peter
|
||||
* merged fixes from 1.0.x
|
||||
|
||||
Revision 1.5 2001/12/13 20:23:19 michael
|
||||
+ Added double2real function from main branch
|
||||
|
||||
Revision 1.4 2001/07/30 21:38:55 peter
|
||||
|
||||
@ -141,12 +141,11 @@
|
||||
|
||||
procedure InitInterfacePointers(objclass: tclass;instance : pointer);
|
||||
|
||||
{$ifdef HASINTF}
|
||||
var
|
||||
intftable : pinterfacetable;
|
||||
i : longint;
|
||||
|
||||
begin
|
||||
{$ifdef HASINTF}
|
||||
if assigned(objclass.classparent) then
|
||||
InitInterfacePointers(objclass.classparent,instance);
|
||||
intftable:=objclass.getinterfacetable;
|
||||
@ -154,8 +153,11 @@
|
||||
for i:=0 to intftable^.EntryCount-1 do
|
||||
ppointer(@(PChar(instance)[intftable^.Entries[i].IOffset]))^:=
|
||||
pointer(intftable^.Entries[i].VTable);
|
||||
{$endif HASINTF}
|
||||
end;
|
||||
{$else HASINTF}
|
||||
begin
|
||||
end;
|
||||
{$endif HASINTF}
|
||||
|
||||
class function TObject.InitInstance(instance : pointer) : tobject;
|
||||
|
||||
@ -693,7 +695,10 @@
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.17 2001-09-29 21:32:47 jonas
|
||||
Revision 1.18 2001-12-26 21:03:56 peter
|
||||
* merged fixes from 1.0.x
|
||||
|
||||
Revision 1.17 2001/09/29 21:32:47 jonas
|
||||
* almost all second pass typeconvnode helpers are now processor independent
|
||||
* fixed converting boolean to int64/qword
|
||||
* fixed register allocation bugs which could cause internalerror 10
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
#
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2001/12/11]
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2001/12/17]
|
||||
#
|
||||
default: all
|
||||
override PATH:=$(subst \,/,$(PATH))
|
||||
@ -191,7 +191,7 @@ USELIBGGI=NO
|
||||
endif
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings $(LINUXUNIT) unix initc $(CPU_UNITS) dos crt objects printer ggigraph sysutils typinfo math varutils getopts heaptrc lineinfo errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants
|
||||
override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 cprt21 gprt21
|
||||
override TARGET_RSTS+=math varutils typinfo
|
||||
override TARGET_RSTS+=math varutils typinfo variants
|
||||
override CLEAN_UNITS+=syslinux linux
|
||||
override INSTALL_FPCPACKAGE=y
|
||||
override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
|
||||
@ -213,6 +213,9 @@ endif
|
||||
ifeq ($(OS_TARGET),netbsd)
|
||||
UNIXINSTALLDIR=1
|
||||
endif
|
||||
ifeq ($(OS_TARGET),sunos)
|
||||
UNIXINSTALLDIR=1
|
||||
endif
|
||||
else
|
||||
ifeq ($(OS_SOURCE),linux)
|
||||
UNIXINSTALLDIR=1
|
||||
@ -223,6 +226,9 @@ endif
|
||||
ifeq ($(OS_SOURCE),netbsd)
|
||||
UNIXINSTALLDIR=1
|
||||
endif
|
||||
ifeq ($(OS_TARGET),sunos)
|
||||
UNIXINSTALLDIR=1
|
||||
endif
|
||||
endif
|
||||
ifndef INSTALL_PREFIX
|
||||
ifdef UNIXINSTALLDIR
|
||||
|
||||
@ -14,7 +14,7 @@ units=$(SYSTEMUNIT) objpas strings \
|
||||
getopts heaptrc lineinfo \
|
||||
errors sockets gpm ipc serial terminfo dl dynlibs \
|
||||
video mouse keyboard variants
|
||||
rsts=math varutils typinfo
|
||||
rsts=math varutils typinfo variants
|
||||
|
||||
[require]
|
||||
nortl=y
|
||||
|
||||
@ -553,7 +553,7 @@ var
|
||||
end ;
|
||||
'/': StoreStr(@DateSeparator, 1);
|
||||
':': StoreStr(@TimeSeparator, 1);
|
||||
' ', 'C', 'D', 'H', 'M', 'N', 'S', 'T', 'Y': begin
|
||||
' ', 'C', 'D', 'H', 'M', 'N', 'S', 'T', 'Y','Z' : begin
|
||||
while (P < FormatEnd) and (UpCase(P^) = Token) do
|
||||
P := P + 1;
|
||||
Count := P - FormatCurrent;
|
||||
@ -602,6 +602,10 @@ var
|
||||
if Count = 1 then StoreInt(Second, 0)
|
||||
else StoreInt(Second, 2);
|
||||
end ;
|
||||
'Z': begin
|
||||
if Count = 1 then StoreInt(MilliSecond, 0)
|
||||
else StoreInt(MilliSecond, 2);
|
||||
end ;
|
||||
'T': begin
|
||||
if Count = 1 then StoreFormat(timereformat(ShortTimeFormat))
|
||||
else StoreFormat(TimeReformat(LongTimeFormat));
|
||||
@ -673,7 +677,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2001-01-18 22:09:09 michael
|
||||
Revision 1.5 2001-12-26 21:03:57 peter
|
||||
* merged fixes from 1.0.x
|
||||
|
||||
Revision 1.4 2001/01/18 22:09:09 michael
|
||||
+ Merged fixes from fixbranch - file modes
|
||||
|
||||
Revision 1.3 2000/12/16 15:57:16 jonas
|
||||
|
||||
@ -958,6 +958,9 @@ Begin
|
||||
'-','=' : PushExt(FAltKey(ch));
|
||||
#10 : PushKey(#10);
|
||||
'[' : State:=2;
|
||||
{$IFDEF LINUX}
|
||||
'O': State:=7;
|
||||
{$ENDIF}
|
||||
else
|
||||
begin
|
||||
PushKey(ch);
|
||||
@ -1088,6 +1091,16 @@ Begin
|
||||
if (Ch<>'~') then
|
||||
State:=255;
|
||||
end;
|
||||
{$ifdef LINUX}
|
||||
7 : begin {Esc[O}
|
||||
case ch of
|
||||
'A' : PushExt(72);
|
||||
'B' : PushExt(80);
|
||||
'C' : PushExt(77);
|
||||
'D' : PushExt(75);
|
||||
end;
|
||||
end;
|
||||
{$endif}
|
||||
255 : ;
|
||||
end;
|
||||
if State<>0 then
|
||||
@ -1669,7 +1682,10 @@ Finalization
|
||||
End.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.7 2001-07-30 21:53:53 peter
|
||||
Revision 1.8 2001-12-26 21:03:57 peter
|
||||
* merged fixes from 1.0.x
|
||||
|
||||
Revision 1.7 2001/07/30 21:53:53 peter
|
||||
* reset winminx,winminy to 1
|
||||
|
||||
Revision 1.6 2001/06/27 20:21:46 peter
|
||||
|
||||
@ -830,10 +830,29 @@ End;
|
||||
|
||||
|
||||
Procedure setftime(var f; time : longint);
|
||||
Begin
|
||||
{! No Linux equivalent !}
|
||||
End;
|
||||
|
||||
Var
|
||||
utim: utimbuf;
|
||||
DT: DateTime;
|
||||
path: pathstr;
|
||||
index: Integer;
|
||||
|
||||
Begin
|
||||
doserror:=0;
|
||||
with utim do
|
||||
begin
|
||||
actime:=getepochtime;
|
||||
UnPackTime(Time,DT);
|
||||
modtime:=DTToUnixDate(DT);
|
||||
end;
|
||||
for Index:=0 to FilerecNameLength-1 do
|
||||
path[Index+1]:=filerec(f).name[Index];
|
||||
if not utime(path,utim) then
|
||||
begin
|
||||
Time:=0;
|
||||
doserror:=3;
|
||||
end;
|
||||
End;
|
||||
|
||||
|
||||
Procedure setfattr (var f;attr : word);
|
||||
@ -880,7 +899,10 @@ End.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.10 2001-09-22 11:17:13 peter
|
||||
Revision 1.11 2001-12-26 21:03:57 peter
|
||||
* merged fixes from 1.0.x
|
||||
|
||||
Revision 1.10 2001/09/22 11:17:13 peter
|
||||
* Fixed passing of command without parameters to Exec() to not include
|
||||
a space after the executable name
|
||||
|
||||
|
||||
@ -211,13 +211,19 @@ function SetDateTime(Year,Month,Day,hour,minute,second:Word) : Boolean;
|
||||
function CreateShellArgV(const prog:string):ppchar;
|
||||
function CreateShellArgV(const prog:Ansistring):ppchar;
|
||||
procedure FreeShellArgV(p:ppchar);
|
||||
Procedure Execve(Path:pathstr;args:ppchar;ep:ppchar);
|
||||
Procedure Execve(path:pchar;args:ppchar;ep:ppchar);
|
||||
Procedure Execve(Path: pathstr;args:ppchar;ep:ppchar);
|
||||
Procedure Execve(Path: AnsiString;args:ppchar;ep:ppchar);
|
||||
Procedure Execve(path: pchar;args:ppchar;ep:ppchar);
|
||||
Procedure Execv(const path:pathstr;args:ppchar);
|
||||
Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar);
|
||||
Procedure Execl(const Todo:string);
|
||||
Procedure Execle(Todo:string;Ep:ppchar);
|
||||
Procedure Execlp(Todo:string;Ep:ppchar);
|
||||
Procedure Execv(const path: AnsiString;args:ppchar);
|
||||
Procedure Execvp(Path: Pathstr;Args:ppchar;Ep:ppchar);
|
||||
Procedure Execvp(Path: AnsiString; Args:ppchar;Ep:ppchar);
|
||||
Procedure Execl(const Todo: String);
|
||||
Procedure Execl(const Todo: Ansistring);
|
||||
Procedure Execle(Todo: String;Ep:ppchar);
|
||||
Procedure Execle(Todo: AnsiString;Ep:ppchar);
|
||||
Procedure Execlp(Todo: string;Ep:ppchar);
|
||||
Procedure Execlp(Todo: Ansistring;Ep:ppchar);
|
||||
Function Shell(const Command:String):Longint;
|
||||
Function Shell(const Command:AnsiString):Longint;
|
||||
Function Fork:longint;
|
||||
@ -473,7 +479,9 @@ Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
|
||||
Function FNMatch(const Pattern,Name:string):Boolean;
|
||||
Function Glob(Const path:pathstr):pglob;
|
||||
Procedure Globfree(var p:pglob);
|
||||
Function StringToPPChar(Var S:STring):ppchar;
|
||||
Function StringToPPChar(Var S:String):ppchar;
|
||||
Function StringToPPChar(Var S:AnsiString):ppchar;
|
||||
Function StringToPPChar(S : Pchar):ppchar;
|
||||
Function GetFS(var T:Text):longint;
|
||||
Function GetFS(Var F:File):longint;
|
||||
{Filedescriptorsets}
|
||||
@ -587,6 +595,44 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
Procedure Execve(Path: AnsiString;args:ppchar;ep:ppchar);
|
||||
{
|
||||
overloaded ansistring version.
|
||||
}
|
||||
begin
|
||||
ExecVE(PChar(Path),args,ep);
|
||||
end;
|
||||
|
||||
Procedure Execv(const path: AnsiString;args:ppchar);
|
||||
{
|
||||
Overloaded ansistring version.
|
||||
}
|
||||
begin
|
||||
ExecVe(Path,Args,envp)
|
||||
end;
|
||||
|
||||
Procedure Execvp(Path: AnsiString; Args:ppchar;Ep:ppchar);
|
||||
{
|
||||
Overloaded ansistring version
|
||||
}
|
||||
var
|
||||
thepath : Ansistring;
|
||||
begin
|
||||
if path[1]<>'/' then
|
||||
begin
|
||||
Thepath:=strpas(getenv('PATH'));
|
||||
if thepath='' then
|
||||
thepath:='.';
|
||||
Path:=FSearch(path,thepath)
|
||||
end
|
||||
else
|
||||
Path:='';
|
||||
if Path='' then
|
||||
linuxerror:=Sys_enoent
|
||||
else
|
||||
Execve(Path,args,ep);{On error linuxerror will get set there}
|
||||
end;
|
||||
|
||||
Procedure Execv(const path:pathstr;args:ppchar);
|
||||
{
|
||||
Replaces the current program by the program specified in path,
|
||||
@ -642,6 +688,24 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
Procedure Execle(Todo:AnsiString;Ep:ppchar);
|
||||
{
|
||||
This procedure takes the string 'Todo', parses it for command and
|
||||
command options, and Executes the command with the given options.
|
||||
The string 'Todo' shoud be of the form 'command options', options
|
||||
separated by commas.
|
||||
the PATH environment is not searched for 'command'.
|
||||
The specified environment(in 'ep') is passed on to command
|
||||
}
|
||||
var
|
||||
p : ppchar;
|
||||
begin
|
||||
p:=StringToPPChar(ToDo);
|
||||
if (p=nil) or (p^=nil) then
|
||||
exit;
|
||||
ExecVE(p^,p,EP);
|
||||
end;
|
||||
|
||||
Procedure Execl(const Todo:string);
|
||||
{
|
||||
This procedure takes the string 'Todo', parses it for command and
|
||||
@ -675,6 +739,20 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
Procedure Execlp(Todo: Ansistring;Ep:ppchar);
|
||||
{
|
||||
Overloaded ansistring version.
|
||||
}
|
||||
var
|
||||
p : ppchar;
|
||||
begin
|
||||
p:=StringToPPchar(todo);
|
||||
if (p=nil) or (p^=nil) then
|
||||
exit;
|
||||
ExecVP(StrPas(p^),p,EP);
|
||||
end;
|
||||
|
||||
|
||||
Function Shell(const Command:String):Longint;
|
||||
{
|
||||
Executes the shell, and passes it the string Command. (Through /bin/sh -c)
|
||||
@ -920,6 +998,15 @@ begin
|
||||
SetDateTime:=stime ( LocalToEpoch ( Year, Month, Day, Hour, Minute, Second ) );
|
||||
end;
|
||||
|
||||
Procedure Execl(const Todo:Ansistring);
|
||||
|
||||
{
|
||||
Overloaded AnsiString Version of ExecL.
|
||||
}
|
||||
|
||||
begin
|
||||
ExecLE(ToDo,EnvP);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -2115,7 +2202,7 @@ var
|
||||
if ((st.mode and $E000)=$4000) and { if it is a directory }
|
||||
(strpas(@(d^.name))<>'.') and { but not ., .. and fd subdirs }
|
||||
(strpas(@(d^.name))<>'..') and
|
||||
(strpas(@(d^.name))<>'') and
|
||||
(strpas(@(d^.name))<>'') and
|
||||
(strpas(@(d^.name))<>'fd') then
|
||||
begin {we found a directory, search inside it}
|
||||
if mysearch(name) then
|
||||
@ -2184,20 +2271,14 @@ begin
|
||||
Octal:=oct;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Function StringToPPChar(Var S:STring):ppchar;
|
||||
{
|
||||
Create a PPChar to structure of pchars which are the arguments specified
|
||||
in the string S. Especially usefull for creating an ArgV for Exec-calls
|
||||
}
|
||||
Function StringToPPChar(S: PChar):ppchar;
|
||||
var
|
||||
nr : longint;
|
||||
Buf : ^char;
|
||||
p : ppchar;
|
||||
|
||||
begin
|
||||
s:=s+#0;
|
||||
buf:=@s[1];
|
||||
buf:=s;
|
||||
nr:=0;
|
||||
while(buf^<>#0) do
|
||||
begin
|
||||
@ -2214,7 +2295,7 @@ begin
|
||||
LinuxError:=sys_enomem;
|
||||
exit;
|
||||
end;
|
||||
buf:=@s[1];
|
||||
buf:=s;
|
||||
while (buf^<>#0) do
|
||||
begin
|
||||
while (buf^ in [' ',#8,#10]) do
|
||||
@ -2335,6 +2416,27 @@ begin
|
||||
DirName:=Dir;
|
||||
end;
|
||||
|
||||
Function StringToPPChar(Var S:String):ppchar;
|
||||
{
|
||||
Create a PPChar to structure of pchars which are the arguments specified
|
||||
in the string S. Especially usefull for creating an ArgV for Exec-calls
|
||||
Note that the string S is destroyed by this call.
|
||||
}
|
||||
|
||||
begin
|
||||
S:=S+#0;
|
||||
StringToPPChar:=StringToPPChar(@S[1]);
|
||||
end;
|
||||
|
||||
Function StringToPPChar(Var S:AnsiString):ppchar;
|
||||
{
|
||||
Create a PPChar to structure of pchars which are the arguments specified
|
||||
in the string S. Especially usefull for creating an ArgV for Exec-calls
|
||||
}
|
||||
|
||||
begin
|
||||
StringToPPChar:=StringToPPChar(PChar(S));
|
||||
end;
|
||||
|
||||
|
||||
Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
|
||||
@ -2947,7 +3049,10 @@ End.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.18 2001-11-30 07:16:41 marco
|
||||
Revision 1.19 2001-12-26 21:03:57 peter
|
||||
* merged fixes from 1.0.x
|
||||
|
||||
Revision 1.18 2001/11/30 07:16:41 marco
|
||||
* TTYname fix from Maarten Beekers. Apparantly accidentally not commited the first time.
|
||||
|
||||
Revision 1.17 2001/10/14 13:33:20 peter
|
||||
|
||||
159
rtl/unix/unix.pp
159
rtl/unix/unix.pp
@ -210,13 +210,19 @@ function SetDateTime(Year,Month,Day,hour,minute,second:Word) : Boolean;
|
||||
|
||||
function CreateShellArgV(const prog:string):ppchar;
|
||||
function CreateShellArgV(const prog:Ansistring):ppchar;
|
||||
Procedure Execve(Path:pathstr;args:ppchar;ep:ppchar);
|
||||
Procedure Execve(path:pchar;args:ppchar;ep:ppchar);
|
||||
Procedure Execve(Path: pathstr;args:ppchar;ep:ppchar);
|
||||
Procedure Execve(Path: AnsiString;args:ppchar;ep:ppchar);
|
||||
Procedure Execve(path: pchar;args:ppchar;ep:ppchar);
|
||||
Procedure Execv(const path:pathstr;args:ppchar);
|
||||
Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar);
|
||||
Procedure Execl(const Todo:string);
|
||||
Procedure Execle(Todo:string;Ep:ppchar);
|
||||
Procedure Execlp(Todo:string;Ep:ppchar);
|
||||
Procedure Execv(const path: AnsiString;args:ppchar);
|
||||
Procedure Execvp(Path: Pathstr;Args:ppchar;Ep:ppchar);
|
||||
Procedure Execvp(Path: AnsiString; Args:ppchar;Ep:ppchar);
|
||||
Procedure Execl(const Todo: String);
|
||||
Procedure Execl(const Todo: Ansistring);
|
||||
Procedure Execle(Todo: String;Ep:ppchar);
|
||||
Procedure Execle(Todo: AnsiString;Ep:ppchar);
|
||||
Procedure Execlp(Todo: string;Ep:ppchar);
|
||||
Procedure Execlp(Todo: Ansistring;Ep:ppchar);
|
||||
Function Shell(const Command:String):Longint;
|
||||
Function Shell(const Command:AnsiString):Longint;
|
||||
Function Fork:longint;
|
||||
@ -467,7 +473,9 @@ Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
|
||||
Function FNMatch(const Pattern,Name:string):Boolean;
|
||||
Function Glob(Const path:pathstr):pglob;
|
||||
Procedure Globfree(var p:pglob);
|
||||
Function StringToPPChar(Var S:STring):ppchar;
|
||||
Function StringToPPChar(Var S:String):ppchar;
|
||||
Function StringToPPChar(Var S:AnsiString):ppchar;
|
||||
Function StringToPPChar(S : Pchar):ppchar;
|
||||
Function GetFS(var T:Text):longint;
|
||||
Function GetFS(Var F:File):longint;
|
||||
{Filedescriptorsets}
|
||||
@ -581,6 +589,44 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
Procedure Execve(Path: AnsiString;args:ppchar;ep:ppchar);
|
||||
{
|
||||
overloaded ansistring version.
|
||||
}
|
||||
begin
|
||||
ExecVE(PChar(Path),args,ep);
|
||||
end;
|
||||
|
||||
Procedure Execv(const path: AnsiString;args:ppchar);
|
||||
{
|
||||
Overloaded ansistring version.
|
||||
}
|
||||
begin
|
||||
ExecVe(Path,Args,envp)
|
||||
end;
|
||||
|
||||
Procedure Execvp(Path: AnsiString; Args:ppchar;Ep:ppchar);
|
||||
{
|
||||
Overloaded ansistring version
|
||||
}
|
||||
var
|
||||
thepath : Ansistring;
|
||||
begin
|
||||
if path[1]<>'/' then
|
||||
begin
|
||||
Thepath:=strpas(getenv('PATH'));
|
||||
if thepath='' then
|
||||
thepath:='.';
|
||||
Path:=FSearch(path,thepath)
|
||||
end
|
||||
else
|
||||
Path:='';
|
||||
if Path='' then
|
||||
linuxerror:=Sys_enoent
|
||||
else
|
||||
Execve(Path,args,ep);{On error linuxerror will get set there}
|
||||
end;
|
||||
|
||||
Procedure Execv(const path:pathstr;args:ppchar);
|
||||
{
|
||||
Replaces the current program by the program specified in path,
|
||||
@ -636,6 +682,24 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
Procedure Execle(Todo:AnsiString;Ep:ppchar);
|
||||
{
|
||||
This procedure takes the string 'Todo', parses it for command and
|
||||
command options, and Executes the command with the given options.
|
||||
The string 'Todo' shoud be of the form 'command options', options
|
||||
separated by commas.
|
||||
the PATH environment is not searched for 'command'.
|
||||
The specified environment(in 'ep') is passed on to command
|
||||
}
|
||||
var
|
||||
p : ppchar;
|
||||
begin
|
||||
p:=StringToPPChar(ToDo);
|
||||
if (p=nil) or (p^=nil) then
|
||||
exit;
|
||||
ExecVE(p^,p,EP);
|
||||
end;
|
||||
|
||||
Procedure Execl(const Todo:string);
|
||||
{
|
||||
This procedure takes the string 'Todo', parses it for command and
|
||||
@ -669,6 +733,20 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
Procedure Execlp(Todo: Ansistring;Ep:ppchar);
|
||||
{
|
||||
Overloaded ansistring version.
|
||||
}
|
||||
var
|
||||
p : ppchar;
|
||||
begin
|
||||
p:=StringToPPchar(todo);
|
||||
if (p=nil) or (p^=nil) then
|
||||
exit;
|
||||
ExecVP(StrPas(p^),p,EP);
|
||||
end;
|
||||
|
||||
|
||||
Function Shell(const Command:String):Longint;
|
||||
{
|
||||
Executes the shell, and passes it the string Command. (Through /bin/sh -c)
|
||||
@ -729,38 +807,38 @@ function WEXITSTATUS(Status: Integer): Integer;
|
||||
begin
|
||||
WEXITSTATUS:=(Status and $FF00) shr 8;
|
||||
end;
|
||||
|
||||
|
||||
function WTERMSIG(Status: Integer): Integer;
|
||||
begin
|
||||
WTERMSIG:=(Status and $7F);
|
||||
end;
|
||||
|
||||
|
||||
function WSTOPSIG(Status: Integer): Integer;
|
||||
begin
|
||||
WSTOPSIG:=WEXITSTATUS(Status);
|
||||
end;
|
||||
|
||||
|
||||
Function WIFEXITED(Status: Integer): Boolean;
|
||||
begin
|
||||
WIFEXITED:=(WTERMSIG(Status)=0);
|
||||
end;
|
||||
|
||||
|
||||
Function WIFSTOPPED(Status: Integer): Boolean;
|
||||
begin
|
||||
WIFSTOPPED:=((Status and $FF)=$7F);
|
||||
end;
|
||||
|
||||
|
||||
Function WIFSIGNALED(Status: Integer): Boolean;
|
||||
begin
|
||||
WIFSIGNALED:=(not WIFSTOPPED(Status)) and
|
||||
WIFSIGNALED:=(not WIFSTOPPED(Status)) and
|
||||
(not WIFEXITED(Status));
|
||||
end;
|
||||
|
||||
|
||||
Function W_EXITCODE(ReturnCode, Signal: Integer): Integer;
|
||||
begin
|
||||
W_EXITCODE:=(ReturnCode shl 8) or Signal;
|
||||
end;
|
||||
|
||||
|
||||
Function W_STOPCODE(Signal: Integer): Integer;
|
||||
|
||||
begin
|
||||
@ -977,6 +1055,15 @@ begin
|
||||
LinuxError:=Errno;
|
||||
end;
|
||||
|
||||
Procedure Execl(const Todo:Ansistring);
|
||||
|
||||
{
|
||||
Overloaded AnsiString Version of ExecL.
|
||||
}
|
||||
|
||||
begin
|
||||
ExecLE(ToDo,EnvP);
|
||||
end;
|
||||
|
||||
|
||||
Function fdOpen(pathname:pchar;flags:longint):longint;
|
||||
@ -2144,7 +2231,7 @@ var
|
||||
if ((st.mode and $E000)=$4000) and { if it is a directory }
|
||||
(strpas(@(d^.name))<>'.') and { but not ., .. and fd subdirs }
|
||||
(strpas(@(d^.name))<>'..') and
|
||||
(strpas(@(d^.name))<>'') and
|
||||
(strpas(@(d^.name))<>'') and
|
||||
(strpas(@(d^.name))<>'fd') then
|
||||
begin {we found a directory, search inside it}
|
||||
if mysearch(name) then
|
||||
@ -2213,20 +2300,14 @@ begin
|
||||
Octal:=oct;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Function StringToPPChar(Var S:STring):ppchar;
|
||||
{
|
||||
Create a PPChar to structure of pchars which are the arguments specified
|
||||
in the string S. Especially usefull for creating an ArgV for Exec-calls
|
||||
}
|
||||
Function StringToPPChar(S: PChar):ppchar;
|
||||
var
|
||||
nr : longint;
|
||||
Buf : ^char;
|
||||
p : ppchar;
|
||||
|
||||
begin
|
||||
s:=s+#0;
|
||||
buf:=@s[1];
|
||||
buf:=s;
|
||||
nr:=0;
|
||||
while(buf^<>#0) do
|
||||
begin
|
||||
@ -2243,7 +2324,7 @@ begin
|
||||
LinuxError:=sys_enomem;
|
||||
exit;
|
||||
end;
|
||||
buf:=@s[1];
|
||||
buf:=s;
|
||||
while (buf^<>#0) do
|
||||
begin
|
||||
while (buf^ in [' ',#8,#10]) do
|
||||
@ -2360,6 +2441,27 @@ begin
|
||||
DirName:=Dir;
|
||||
end;
|
||||
|
||||
Function StringToPPChar(Var S:String):ppchar;
|
||||
{
|
||||
Create a PPChar to structure of pchars which are the arguments specified
|
||||
in the string S. Especially usefull for creating an ArgV for Exec-calls
|
||||
Note that the string S is destroyed by this call.
|
||||
}
|
||||
|
||||
begin
|
||||
S:=S+#0;
|
||||
StringToPPChar:=StringToPPChar(@S[1]);
|
||||
end;
|
||||
|
||||
Function StringToPPChar(Var S:AnsiString):ppchar;
|
||||
{
|
||||
Create a PPChar to structure of pchars which are the arguments specified
|
||||
in the string S. Especially usefull for creating an ArgV for Exec-calls
|
||||
}
|
||||
|
||||
begin
|
||||
StringToPPChar:=StringToPPChar(PChar(S));
|
||||
end;
|
||||
|
||||
|
||||
Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
|
||||
@ -2972,7 +3074,10 @@ End.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.19 2001-11-30 07:16:42 marco
|
||||
Revision 1.20 2001-12-26 21:03:57 peter
|
||||
* merged fixes from 1.0.x
|
||||
|
||||
Revision 1.19 2001/11/30 07:16:42 marco
|
||||
* TTYname fix from Maarten Beekers. Apparantly accidentally not commited the first time.
|
||||
|
||||
Revision 1.18 2001/11/05 21:46:06 michael
|
||||
|
||||
Loading…
Reference in New Issue
Block a user