paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 09:07:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ rescued old QNX RTL code

Browse Source 
git-svn-id: trunk@11397 -
This commit is contained in:
florian 2008-07-18 13:24:50 +00:00
parent 050627ea1d
commit 70e7932fe4
14 changed files with 3342 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
.gitattributes vendored
View File

@ -5876,6 +5876,19 @@ rtl/powerpc64/strings.inc svneol=native#text/plain
rtl/powerpc64/stringss.inc svneol=native#text/plain
rtl/powerpc64/strlen.inc svneol=native#text/plain
rtl/powerpc64/strpas.inc svneol=native#text/plain
rtl/qnx/Makefile svneol=native#text/plain
rtl/qnx/Makefile.fpc svneol=native#text/plain
rtl/qnx/dos.inc svneol=native#text/plain
rtl/qnx/errno.inc svneol=native#text/plain
rtl/qnx/i386/cprt0.as svneol=native#text/plain
rtl/qnx/i386/crti.s svneol=native#text/plain
rtl/qnx/i386/crtn.s svneol=native#text/plain
rtl/qnx/osposix.inc svneol=native#text/plain
rtl/qnx/osposixh.inc svneol=native#text/plain
rtl/qnx/posix.pp svneol=native#text/plain
rtl/qnx/qnx.inc svneol=native#text/plain
rtl/qnx/signal.inc svneol=native#text/plain
rtl/qnx/system.pp svneol=native#text/plain
rtl/solaris/Makefile svneol=native#text/plain
rtl/solaris/Makefile.fpc svneol=native#text/plain
rtl/solaris/errno.inc svneol=native#text/plain

1335
rtl/qnx/Makefile Normal file
View File

File diff suppressed because it is too large Load Diff

159
rtl/qnx/Makefile.fpc Normal file
View File

@ -0,0 +1,159 @@
#
# Makefile.fpc for Free Pascal QNX RTL
#
[package]
main=rtl
[target]
loaders=cprt0 crti crtn
units=system dos objpas objects strings \
sysutils typinfo math \
cpu mmx getopts heaptrc lineinfo posix
rsts=math typinfo
[require]
nortl=y
[install]
fpcpackage=y
[default]
fpcdir=../..
target=qnx
cpu=i386
[compiler]
includedir=$(INC) $(PROCINC) $(POSIXINC) $(SYSCALLINC)
sourcedir=$(INC) $(PROCINC) $(POSIXINC) $(SYSCALLINC)
targetdir=.
[prerules]
RTL=..
INC=$(RTL)/inc
PROCINC=$(RTL)/$(CPU_TARGET)
POSIXINC=$(RTL)/posix
SYSCALLINC=$(RTL)/qnx/$(CPU_TARGET)
UNITPREFIX=rtl
# Use new feature from 1.0.5 version
# that generates release PPU files
# which will not be recompiled
ifdef RELEASE
ifeq ($(findstring 1.0.2,$(FPC_VERSION)),)
ifeq ($(findstring 1.0.4,$(FPC_VERSION)),)
override FPCOPT+=-Ur
endif
endif
endif
# Paths
OBJPASDIR=$(RTL)/objpas
GRAPHDIR=$(INC)/graph
[rules]
# Get the system independent include file names.
# This will set the following variables :
# SYSINCNAMES
include $(INC)/makefile.inc
SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
# Get the processor dependent include file names.
# This will set the following variables :
# CPUINCNAMES
include $(PROCINC)/makefile.cpu
SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
# Put system unit dependencies together.
SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
#
# Loaders
#
cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
$(AS) -o cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
crti$(OEXT) : $(CPU_TARGET)/crti.s
$(AS) -o crti$(OEXT) $(CPU_TARGET)/crti.s
crtn$(OEXT) : $(CPU_TARGET)/crtn.s
$(AS) -o crtn$(OEXT) $(CPU_TARGET)/crtn.s
func$(OEXT) : $(CPU_TARGET)/func.as
$(AS) -o func$(OEXT) $(CPU_TARGET)/func.as
dllprt$(OEXT) : $(CPU_TARGET)/dllprt.as
$(AS) -o dllprt$(OEXT) $(CPU_TARGET)/dllprt.as
#
# system Units (system, Objpas, Strings)
#
system$(PPUEXT) : system.pp $(SYSDEPS)
$(COMPILER) -Us -Sg system.pp
objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc system$(PPUEXT)
$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
$(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
system$(PPUEXT)
#
# TP7 Compatible RTL Units
#
dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
posix$(PPUEXT) system$(PPUEXT)
$(COMPILER) $(POSIXINC)/dos.pp
objects$(PPUEXT) : $(INC)/objects.pp $(POSIXINC)/objinc.inc system$(PPUEXT)
$(COMPILER) $(INC)/objects.pp
#
# Delphi Compatible Units
#
sysutils$(PPUEXT) : $(POSIXINC)/sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \
objpas$(PPUEXT) dos$(PPUEXT)
$(COMPILER) -I$(OBJPASDIR) $(POSIXINC)/sysutils.pp
typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
$(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/math.pp
gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/gettext.pp
#varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
# $(OBJPASDIR)/varutilh.inc varutils.pp
# $(COMPILER) -I$(OBJPASDIR) $(UNIXINC)/varutils.pp
#
# Other system-independent RTL Units
#
cpu$(PPUEXT) : $(PROCINC)/cpu.pp system$(PPUEXT)
mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) system$(PPUEXT)
getopts$(PPUEXT) : $(INC)/getopts.pp system$(PPUEXT)
heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT)
$(COMPILER) -Sg $(INC)/heaptrc.pp
lineinfo$(PPUEXT) : $(INC)/lineinfo.pp system$(PPUEXT)
#
# Other system-dependent RTL Units
#
posix$(PPUEXT) : posix.pp \
errno.inc osposix.inc osposixh.inc signal.inc system$(PPUEXT)

167
rtl/qnx/dos.inc Normal file
View File

@ -0,0 +1,167 @@
{
$Id: dos.inc,v 1.1.2.2 2002/05/01 14:09:49 carl Exp $
This file is part of the Free Pascal run time library.
Copyright (c) 2002 by Carl Eric Codere
Operating system specific calls for DOS unit (part of POSIX interface)
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{$i qnx.inc}
{
The Diskfree and Disksize functions need a file on the specified drive, since this
is required for the statfs system call.
These filenames are set in drivestr[0..26], and have been preset to :
0 - '.' (default drive - hence current dir is ok.)
1 - '/floppy/.' (either direct or contains dir with volume label of mounted device)
2 - '/cdrom/.' (either direct or contains dir with volume label of mounted device)
3 - '/' (C: equivalent of dos is the root partition)
4..26 (can be set by you're own applications)
! Use AddDisk() to Add new drives !
They both return -1 when a failure occurs.
The drive names are OS specific
}
Const
FixDriveStr : array[0..3] of pchar=(
'.', { the current directory }
'/floppy/.', { manually mounted floppy }
'/cdrom/.', { manually mounted cdrom }
'/' { root partition }
);
Function DosVersion:Word;
Var
Buffer : Array[0..255] of Char;
Tmp2,
TmpStr : String[40];
TmpPos,
SubRel,
Rel : LongInt;
info : ^utsname;
Begin
new(info);
sys_uname(info^);
Move(info^.release,buffer[0],40);
TmpStr:=StrPas(Buffer);
SubRel:=0;
TmpPos:=Pos('.',TmpStr);
if TmpPos>0 then
begin
Tmp2:=Copy(TmpStr,TmpPos+1,40);
Delete(TmpStr,TmpPos,40);
end;
TmpPos:=Pos('.',Tmp2);
if TmpPos>0 then
Delete(Tmp2,TmpPos,40);
Val(TmpStr,Rel);
Val(Tmp2,SubRel);
DosVersion:=Rel+(SubRel shl 8);
dispose(info);
End;
Function DiskFree(Drive: Byte): int64;
var
info : statvfs_t;
Begin
DiskFree := -1;
if (Drive < 4) and (FixDriveStr[Drive]<>nil) then
begin
if sys_statvfs(FixDriveStr[Drive],info)=0 then
DiskFree := int64(info.f_frsize)*int64(info.f_bavail);
end
else
if (Drive>4) and (Drive<=MAX_DRIVES) and (drivestr[Drive]<>nil) then
begin
if sys_statvfs(DriveStr[Drive],info)=0 then
DiskFree := int64(info.f_frsize)*int64(info.f_bavail);
end
else
begin
exit;
end;
End;
Function DiskSize(Drive: Byte): int64;
var
info : statvfs_t;
Begin
DiskSize:= -1;
if (Drive < 4) and (FixDriveStr[Drive]<>nil) then
begin
if sys_statvfs(FixDriveStr[Drive],info)=0 then
DiskSize := int64(info.f_frsize)*int64(info.f_blocks);
end
else
if (Drive>4) and (Drive<=MAX_DRIVES) and (drivestr[Drive]<>nil) then
begin
if sys_statvfs(DriveStr[Drive],info)=0 then
DiskSize := int64(info.f_frsize)*int64(info.f_blocks);
end
else
begin
exit;
end;
End;
{ QNX stores its timezone information, in POSIX format }
{ in the /etc/TIMEZONE file. }
function GetTimezoneString: string;
var
s: string;
T: text;
begin
GetTimeZoneString:='';
{ first try 'TZ' }
s := GetEnv('TZ');
if s<>'' then
begin
GetTimeZoneString:=s;
exit;
end;
{ otherwise try to open the TIMEZONE file }
{$IFOPT I+}
{$DEFINE IOCHECK_ON}
{$ENDIF}
{$I-}
Assign(T, '/etc/TIMEZONE');
Reset(T);
If IOResult <> 0 then
exit;
{$IFDEF IOCHECK_ON}
{$I+}
{$ENDIF}
{$UNDEF IOCHECK_ON}
ReadLn(T,s);
Close(T);
GetTimeZoneString:=s;
end;
{ QNX does not use timezone files }
function GetTimezoneFile:string;
begin
GetTimezoneFile:='';
end;
{
$Log: dos.inc,v $
Revision 1.1.2.2 2002/05/01 14:09:49 carl
+ TZ is now taken from GetTimezoneSitrng instead of getenv
Revision 1.1.2.1 2001/12/20 02:55:00 carl
+ QNX versions (still untested)
}

164
rtl/qnx/errno.inc Normal file
View File

@ -0,0 +1,164 @@
{
$Id: errno.inc,v 1.1.2.2 2001/12/20 02:55:00 carl Exp $
This file is part of the Free Pascal run time library.
Taken from QNX RTP Include files
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
const
Sys_EOK = 0;
Sys_EPERM = 1;
Sys_ENOENT = 2;
Sys_ESRCH = 3;
Sys_EINTR = 4;
Sys_EIO = 5;
Sys_ENXIO = 6;
Sys_E2BIG = 7;
Sys_ENOEXEC = 8;
Sys_EBADF = 9;
Sys_ECHILD = 10;
Sys_EAGAIN = 11;
Sys_ENOMEM = 12;
Sys_EACCES = 13;
Sys_EFAULT = 14;
Sys_ENOTBLK = 15;
Sys_EBUSY = 16;
Sys_EEXIST = 17;
Sys_EXDEV = 18;
Sys_ENODEV = 19;
Sys_ENOTDIR = 20;
Sys_EISDIR = 21;
Sys_EINVAL = 22;
Sys_ENFILE = 23;
Sys_EMFILE = 24;
Sys_ENOTTY = 25;
Sys_ETXTBSY = 26;
Sys_EFBIG = 27;
Sys_ENOSPC = 28;
Sys_ESPIPE = 29;
Sys_EROFS = 30;
Sys_EMLINK = 31;
Sys_EPIPE = 32;
Sys_EDOM = 33;
Sys_ERANGE = 34;
Sys_ENOMSG = 35;
Sys_EIDRM = 36;
Sys_ECHRNG = 37;
Sys_EL2NSYNC = 38;
Sys_EL3HLT = 39;
Sys_EL3RST = 40;
Sys_ELNRNG = 41;
Sys_EUNATCH = 42;
Sys_ENOCSI = 43;
Sys_EL2HLT = 44;
Sys_EDEADLK = 45;
Sys_ENOLCK = 46;
Sys_ECANCELED = 47;
{ Not supported (1003.1b-1993) }
Sys_ENOTSUP = 48;
Sys_EDQUOT = 49;
Sys_EBADE = 50;
Sys_EBADR = 51;
Sys_EXFULL = 52;
Sys_ENOANO = 53;
Sys_EBADRQC = 54;
Sys_EBADSLT = 55;
Sys_EDEADLOCK = 56;
Sys_EBFONT = 57;
Sys_ENOSTR = 60;
Sys_ENODATA = 61;
Sys_ETIME = 62;
Sys_ENOSR = 63;
Sys_ENONET = 64;
Sys_ENOPKG = 65;
Sys_EREMOTE = 66;
Sys_ENOLINK = 67;
Sys_EADV = 68;
Sys_ESRMNT = 69;
Sys_ECOMM = 70;
Sys_EPROTO = 71;
Sys_EMULTIHOP = 74;
Sys_EBADMSG = 77;
Sys_ENAMETOOLONG = 78;
Sys_EOVERFLOW = 79;
Sys_ENOTUNIQ = 80;
Sys_EBADFD = 81;
Sys_EREMCHG = 82;
Sys_ELIBACC = 83;
Sys_ELIBBAD = 84;
Sys_ELIBSCN = 85;
Sys_ELIBMAX = 86;
Sys_ELIBEXEC = 87;
Sys_EILSEQ = 88;
Sys_ENOSYS = 89;
Sys_ELOOP = 90;
Sys_ERESTART = 91;
Sys_ESTRPIPE = 92;
Sys_ENOTEMPTY = 93;
Sys_EUSERS = 94;
Sys_EOPNOTSUPP = 103;
Sys_EFPOS = 110;
Sys_ESTALE = 122;
Sys_EWOULDBLOCK = Sys_EAGAIN;
Sys_EINPROGRESS = 236;
Sys_EALREADY = Sys_EBUSY;
Sys_ENOTSOCK = 238;
Sys_EDESTADDRREQ = 239;
Sys_EMSGSIZE = 240;
Sys_EPROTOTYPE = 241;
Sys_ENOPROTOOPT = 242;
Sys_EPROTONOSUPPORT = 243;
Sys_ESOCKTNOSUPPORT = 244;
Sys_EPFNOSUPPORT = 246;
Sys_EAFNOSUPPORT = 247;
Sys_EADDRINUSE = 248;
Sys_EADDRNOTAVAIL = 249;
Sys_ENETDOWN = 250;
Sys_ENETUNREACH = 251;
Sys_ENETRESET = 252;
Sys_ECONNABORTED = 253;
Sys_ECONNRESET = 254;
Sys_ENOBUFS = 255;
Sys_EISCONN = 256;
Sys_ENOTCONN = 257;
Sys_ESHUTDOWN = 258;
Sys_ETOOMANYREFS = 259;
Sys_ETIMEDOUT = 260;
Sys_ECONNREFUSED = 261;
Sys_EHOSTDOWN = 264;
Sys_EHOSTUNREACH = 265;
Sys_EBADRPC = 272;
Sys_ERPCMISMATCH = 273;
Sys_EPROGUNAVAIL = 274;
Sys_EPROGMISMATCH = 275;
Sys_EPROCUNAVAIL = 276;
{ --- QNX specific --- }
Sys_ENOREMOTE = 300;{ Must be done on local machine }
Sys_ENONDP = 301; { Need an NDP (8087...) to run }
Sys_EBADFSYS = 302; { Corrupted file system detected }
Sys_EMORE = 309; { More to do, send message again }
Sys_ECTRLTERM = 310; { Remap to the controlling terminal }
Sys_ENOLIC = 311; { No license }
Sys_ESRVRFAULT = 312; { Server fault on msg pass }
Sys_EENDIAN = 313; { Endian not supported }
{
$Log: errno.inc,v $
Revision 1.1.2.2 2001/12/20 02:55:00 carl
+ QNX versions (still untested)
Revision 1.1.2.1 2001/11/26 03:00:10 carl
+ started qnx port
}

84
rtl/qnx/i386/cprt0.as Normal file
View File

@ -0,0 +1,84 @@
//
//Copyright 2001, QNX Software Systems Ltd. All Rights Reserved
//
// QNX has kindly released this source code under the QNX open
// Community license, expressly to be used with the
// Free Pascal runtime library
//
.extern main
.extern exit
.extern _fini
.extern _init
.extern atexit
.extern errno
.text
.byte 'N', 'I', 'A', 'M' /* Used by debugger for setting a break point */
.long main
#if defined(VARIANT_wcc)
.globl _cstart_
_cstart_:
jmp _CMain
.type _cstart_,@function
.size _cstart_,.-_cstart_
#else
.globl _start
_start:
#if defined(__PIC__)
// call 1f
//1: popl %ebx
// addl $_GLOBAL_OFFSET_TABLE_+[.-1b],%ebx
// call _CMain@PLT
//#else
/* Stash EDX to EBX */
movl %edx,%ebx
/* Call _init_libc -- need to extract argc, argv, env and auxv first */
// argc
movl 0(%esp),%esi
movl 0(%esp), %eax
movl %eax, U_SYSTEM_ARGC
// argv
leal 4(%esp),%ecx
movl %ecx, U_SYSTEM_ARGV
// envp
leal (%ecx,%esi,4),%eax
// auxv vector pointer
leal 4(%eax),%edi
// pointer to environment
leal 8(%eax),%edx
movl %edx, U_SYSTEM_ENVP
cmpl $0,4(%eax)
je .Ldoneargv
.align 4
// Scan for auxv
.Lloop:
movl (%edx),%eax
addl $4,%edx
testl %eax,%eax
jne .Lloop
.Ldoneargv:
pushl %ebx
pushl %edx
pushl %edi
pushl %ecx
pushl %esi
call _init_libc
// Leave the args on the stack, we'll just pass them to main()
pushl $_fini
call atexit
addl $4,%esp
call _init
.Lmain:
movl $0,errno
call PASCALMAIN
pushl %eax
call exit
//#endif
int $3 /* Should never get here.... */
.type _start,@function
.size _start,.-_start
#endif

17
rtl/qnx/i386/crti.s Normal file
View File

@ -0,0 +1,17 @@
//
//Copyright 2001, QNX Software Systems Ltd. All Rights Reserved
//
// QNX has kindly released this source code under the QNX open
// Community license, expressly to be used with the
// Free Pascal runtime library
//
.section .init
.globl _init
.type _init,@function
_init:
.section .fini
.globl _fini
.type _fini,@function
_fini:

23
rtl/qnx/i386/crtn.s Normal file
View File

@ -0,0 +1,23 @@
//
// Copyright 2001, QNX Software Systems Ltd. All Rights Reserved
//
// QNX has kindly released this source code under the QNX open
// Community license, expressly to be used with the
// Free Pascal runtime library
//
/* Make a placeholder .note segment */
.section .note,"a"
#if 0
.long 4 /* Elf32_Nhdr.n_namesz = sizeof QNX_NOTE_NAME */
.long 4 /* Elf32_Nhdr.n_descsz = sizeof Elf32_Word */
.long 3 /* Elf32_Nhdr.n_type = QNT_STACK */
.byte 'Q', 'N', 'X', 0 /* QNX_NOTE_NAME */
.long 32768 /* stack size of 32k */
#endif
.section .init
ret $0x0
.section .fini
ret $0x0

356
rtl/qnx/osposix.inc Normal file
View File

@ -0,0 +1,356 @@
{
$Id: osposix.inc,v 1.1.2.2 2002/04/17 17:16:14 carl Exp $
Copyright (c) 2001 by Carl Eric Codere
Implements POSIX 1003.1 conforming interface
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
{$Linklib c}
function int_fork : pid_t; cdecl; external name 'fork';
function int_execve(const path : pchar; const argv : ppchar; const envp: ppchar): cint; cdecl; external name 'execve';
function int_waitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t; cdecl; external name 'waitpid';
function int_uname(var name: utsname): cint; cdecl; external name 'uname';
procedure sys_exit(status : cint); cdecl; external name '_exit';
function int_opendir(const dirname : pchar): pdir; cdecl; external name 'opendir';
function int_readdir(dirp : pdir) : pdirent;cdecl; external name 'readdir';
function int_closedir(dirp : pdir): cint; cdecl; external name 'closedir';
function int_chdir(const path : pchar): cint; cdecl; external name 'chdir';
function int_open(const path: pchar; flags : cint; mode: mode_t):cint; cdecl; external name 'open';
function int_mkdir(const path : pchar; mode: mode_t):cint; cdecl; external name 'mkdir';
function int_unlink(const path: pchar): cint; cdecl; external name 'unlink';
function int_rmdir(const path : pchar): cint; cdecl; external name 'rmdir';
function int_rename(const old : pchar; const newpath: pchar): cint; cdecl;external name 'rename';
function int_access(const pathname : pchar; amode : cint): cint; cdecl; external name 'access';
function int_close(fd : cint): cint; cdecl; external name 'close';
function int_read(fd: cint; buf: pchar; nbytes : size_t): ssize_t; cdecl; external name 'read';
function int_write(fd: cint;const buf:pchar; nbytes : size_t): ssize_t; cdecl; external name 'write';
function int_lseek(fd : cint; offset : off_t; whence : cint): off_t; cdecl; external name 'lseek';
function int_time(var tloc:time_t): time_t; cdecl; external name 'time';
function int_ftruncate(fd : cint; flength : off_t): cint; cdecl; external name 'ftruncate';
function int_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint; cdecl; external name 'sigaction';
function int_fstat(fd : cint; var sb : stat): cint; cdecl; external name 'fstat';
function int_stat(const path: pchar; var buf : stat): cint; cdecl; external name 'stat';
function sys_fork : pid_t;
begin
sys_fork := int_fork;
if sys_fork <> - 1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_execve(const path : pchar; const argv : ppchar; const envp: ppchar): cint;
begin
sys_execve := int_execve(path, argv, envp);
if sys_execve <> - 1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_waitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t;
begin
sys_waitpid := int_waitpid(pid, stat_loc, options);
if sys_waitpid <> - 1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_uname(var name: utsname): cint;
begin
sys_uname := int_uname(name);
if sys_uname <> - 1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_opendir(const dirname : pchar): pdir;
begin
sys_opendir := int_opendir(dirname);
if sys_opendir <> nil then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_readdir(dirp : pdir) : pdirent;
begin
sys_readdir := int_readdir(dirp);
if sys_readdir <> nil then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_closedir(dirp : pdir): cint;
begin
sys_closedir := int_closedir(dirp);
if sys_closedir <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_chdir(const path : pchar): cint;
begin
sys_chdir := int_chdir(path);
if sys_chdir <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_open(const path: pchar; flags : cint; mode: mode_t):cint;
begin
sys_open:= int_open(path, flags, mode);
if sys_open <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_mkdir(const path : pchar; mode: mode_t):cint;
begin
sys_mkdir:= int_mkdir(path, mode);
if sys_mkdir <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_unlink(const path: pchar): cint;
begin
sys_unlink := int_unlink(path);
if sys_unlink <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_rmdir(const path : pchar): cint;
begin
sys_rmdir := int_rmdir(path);
if sys_rmdir <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_rename(const old : pchar; const newpath: pchar): cint;
begin
sys_rename := int_rename(old, newpath);
if sys_rename <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_access(const pathname : pchar; amode : cint): cint;
begin
sys_access := int_access(pathname, amode);
if sys_access <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_close(fd : cint): cint;
begin
sys_close := int_close(fd);
if sys_close <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_read(fd: cint; buf: pchar; nbytes : size_t): ssize_t;
begin
sys_read := int_read(fd, buf, nbytes);
if sys_read <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_write(fd: cint;const buf:pchar; nbytes : size_t): ssize_t;
begin
sys_write := int_write(fd, buf, nbytes);
if sys_write <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_lseek(fd : cint; offset : off_t; whence : cint): off_t;
begin
sys_lseek := int_lseek(fd, offset, whence);
if sys_lseek <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_time(var tloc:time_t): time_t;
begin
sys_time := int_time(tloc);
if sys_time <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_ftruncate(fd : cint; flength : off_t): cint;
begin
sys_ftruncate := int_ftruncate(fd, flength);
if sys_ftruncate <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint;
begin
sys_sigaction := int_sigaction(sig, act, oact);
if sys_sigaction <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_fstat(fd : cint; var sb : stat): cint;
begin
sys_fstat := int_fstat(fd, sb);
if sys_fstat <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_stat(const path: pchar; var buf : stat): cint;
begin
sys_stat := int_stat(path, buf);
if sys_stat <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
const
_S_IFMT = $F000; (* Type of file *)
_S_IFIFO = $1000; (* FIFO *)
_S_IFCHR = $2000; (* Character special *)
_S_IFDIR = $4000; (* Directory *)
_S_IFNAM = $5000; (* Special named file *)
_S_IFBLK = $6000; (* Block special *)
_S_IFREG = $8000; (* Regular *)
_S_IFLNK = $A000; (* Symbolic link *)
_S_IFSOCK = $C000; (* Socket *)
function S_ISDIR(m : mode_t): boolean;
begin
if (m and _S_IFMT) = _S_IFDIR then
S_ISDIR := true
else
S_ISDIR := false;
end;
function S_ISCHR(m : mode_t): boolean;
begin
if (m and _S_IFMT) = _S_IFCHR then
S_ISCHR := true
else
S_ISCHR := false;
end;
function S_ISBLK(m : mode_t): boolean;
begin
if (m and _S_IFMT) = _S_IFBLK then
S_ISBLK := true
else
S_ISBLK := false;
end;
function S_ISREG(m : mode_t): boolean;
begin
if (m and _S_IFMT) = _S_IFREG then
S_ISREG := true
else
S_ISREG := false;
end;
function S_ISFIFO(m : mode_t): boolean;
begin
if (m and _S_IFMT) = _S_IFIFO then
S_ISFIFO := true
else
S_ISFIFO := false;
end;
function wifexited(status : cint): cint;
begin
wifexited := longint((status and $FF) = 0);
end;
function wexitstatus(status : cint): cint;
begin
wexitstatus := (((status) shr 8) and $FF);
end;
function wstopsig(status : cint): cint;
begin
wstopsig := (((status) shr 8) and $FF);
end;
function wifsignaled(status : cint): cint;
begin
if ((status and $FF) <> 0) and ((status and $FF00)=0) then
wifsignaled := 1
else
wifsignaled := 0;
end;
{
$Log: osposix.inc,v $
Revision 1.1.2.2 2002/04/17 17:16:14 carl
* more fixes for QNX target
Revision 1.1.2.1 2001/12/20 02:55:01 carl
+ QNX versions (still untested)
}

196
rtl/qnx/osposixh.inc Normal file
View File

@ -0,0 +1,196 @@
{
$Id: osposixh.inc,v 1.1.2.5 2002/05/01 14:10:36 carl Exp $
This file is part of the Free Pascal run time library.
Copyright (c) 2002 by Carl Eric Codere
This file implements all the types/constants which are
for the QNX RTP platform.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{***********************************************************************}
{ POSIX TYPE DEFINITIONS }
{***********************************************************************}
type
{ the following type definitions are compiler dependant }
{ and system dependant }
cint = longint; { minimum range is : 32-bit }
cuint = cardinal; { minimum range is : 32-bit }
dev_t = cardinal; { used for device numbers }
gid_t = longint; { used for group IDs }
ino_t = cardinal; { used for file serial numbers }
mode_t = cardinal; { used for file attributes }
nlink_t = cardinal; { used for link counts }
off_t = cardinal; { used for file sizes }
pid_t = longint; { used as process identifier }
size_t = cardinal; { as definied in the C standard }
ssize_t = longint; { used by function for returning number of bytes }
uid_t = longint; { used for user ID type }
time_t = cardinal; { used for returning the time }
blksize_t = cardinal;
blkcnt_t = cardinal;
{***********************************************************************}
{ POSIX STRUCTURES }
{***********************************************************************}
CONST
_UTSNAME_LENGTH = 256; { 256 + 1 in pchar format }
_UTSNAME_NODENAME_LENGTH = 256;
TYPE
{ system information services }
utsname = packed record { don't forget to verify the alignment }
sysname : array[0.._UTSNAME_LENGTH] of char;
nodename : array[0.._UTSNAME_LENGTH] of char;
release : array[0.._UTSNAME_LENGTH] of char;
version : array[0.._UTSNAME_LENGTH] of char;
machine : array[0.._UTSNAME_LENGTH] of char;
end;
{ file characteristics services }
stat = packed record { verify the alignment of the members }
{$IFDEF ENDIAN_LITTLE}
st_ino : ino_t; { File serial number }
st_ino_hi : ino_t;
st_size : off_t;
st_size_hi : off_t;
{$ELSE}
st_ino_hi : ino_t;
st_ino : ino_t;
st_size_hi : off_t;
st_size : off_t;
{$ENDIF}
st_dev : dev_t; (* ID of device containing file. *)
st_rdev : dev_t; (* Device ID, for inode that is device *)
st_uid : uid_t;
st_gid : gid_t;
st_mtime : time_t; (* Time of last data modification *)
st_atime : time_t; (* Time last accessed *)
st_ctime : time_t; (* Time of last status change *)
st_mode : mode_t; (* see below *)
st_nlink : nlink_t;
st_blocksize : blksize_t; (* Size of a block used by st_nblocks *)
st_nblocks : longint; (* Number of blocks st_blocksize blocks *)
st_blksize : blksize_t; (* Prefered I/O block size for object *)
{$IFDEF ENDIAN_LITTLE}
st_blocks : blkcnt_t; (* Number of 512 byte blocks *)
st_blocks_hi : blkcnt_t;
{$ELSE}
st_blocks_hi : blkcnt_t;
st_blocks : blkcnt_t;
{$ENDIF}
end;
{ directory services }
pdirent = ^dirent;
dirent = packed record { directory entry record - verify alignment }
{$ifdef ENDIAN_LITTLE}
d_ino : ino_t; (* File serial number *)
d_ino_hi : ino_t;
d_offset : off_t;
d_offset_hi : off_t;
{$else}
d_ino_hi : ino_t;
d_ino : ino_t;
d_offset_hi : off_t;
d_offset : off_t;
{$endif}
d_reclen : smallint;
d_namelen : smallint;
d_name : array[0..255] of char;
end;
pdir = ^dir;
dir = packed record
end;
{***********************************************************************}
{ POSIX CONSTANT ROUTINE DEFINITIONS }
{***********************************************************************}
CONST
{ access routine - these maybe OR'ed together }
F_OK = 0; { test for existence of file }
R_OK = 4; { test for read permission on file }
W_OK = 2; { test for write permission on file }
X_OK = 1; { test for execute or search permission }
{ seek routine }
SEEK_SET = 0; { seek from beginning of file }
SEEK_CUR = 1; { seek from current position }
SEEK_END = 2; { seek from end of file }
{ open routine }
{ File access modes for `open' and `fcntl'. }
O_RDONLY = 0; { Open read-only. }
O_WRONLY = 1; { Open write-only. }
O_RDWR = 2; { Open read/write. }
{ Bits OR'd into the second argument to open. }
O_CREAT = $100; { Create file if it doesn't exist. }
O_EXCL = $400; { Fail if file already exists. }
O_TRUNC = $200; { Truncate file to zero length. }
O_NOCTTY = $800; { Don't assign a controlling terminal. }
{ File status flags for `open' and `fcntl'. }
O_APPEND = $08; { Writes append to the file. }
O_NONBLOCK = $80; { Non-blocking I/O. }
{ mode_t possible values }
S_IRUSR = $100; { Read permission for owner }
S_IWUSR = $80; { Write permission for owner }
S_IXUSR = $40; { Exec permission for owner }
S_IRGRP = $20; { Read permission for group }
S_IWGRP = $10; { Write permission for group }
S_IXGRP = $8; { Exec permission for group }
S_IROTH = $4; { Read permission for world }
S_IWOTH = $2; { Write permission for world }
S_IXOTH = $1; { Exec permission for world }
{ Used for waitpid }
WNOHANG = $40; { don't block waiting }
WUNTRACED = $04; { report status of stopped children }
{ POSIX limits, used for buffer and stack allocation }
ARG_MAX = 61440; { Maximum number of argument size }
NAME_MAX = 255; { Maximum number of bytes in filename }
PATH_MAX = 1024; { Maximum number of bytes in pathname }
{***********************************************************************}
{ signal handling }
{***********************************************************************}
{$i signal.inc}
{
$Log: osposixh.inc,v $
Revision 1.1.2.5 2002/05/01 14:10:36 carl
* Correct structures for stat and dirent
* correct some compilation problems
* change types according to 80x86 version
Revision 1.1.2.4 2002/04/17 17:16:14 carl
* more fixes for QNX target
Revision 1.1.2.3 2001/12/20 02:55:01 carl
+ QNX versions (still untested)
Revision 1.1.2.2 2001/11/28 03:11:08 carl
+ ustname structure max length
Revision 1.1.2.1 2001/11/26 03:00:10 carl
+ started qnx port
}

403
rtl/qnx/posix.pp Normal file
View File

@ -0,0 +1,403 @@
{
$Id: posix.pp,v 1.1.2.2 2002/05/01 14:10:36 carl Exp $
This file is part of the Free Pascal run time library.
Copyright (c) 2001 by Carl Eric Codere
development team
POSIX Compliant interface unit
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
unit posix;
interface
{***********************************************************************}
{ POSIX PUBLIC INTERFACE }
{***********************************************************************}
{$i errno.inc}
{$i osposixh.inc}
function sys_fork : pid_t;
function sys_execve(const path : pchar; const argv : ppchar; const envp: ppchar): cint;
function sys_waitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t;
procedure sys_exit(status : cint); cdecl; external name '_exit';
function sys_uname(var name: utsname): cint;
function sys_opendir(const dirname : pchar): pdir;
function sys_readdir(dirp : pdir) : pdirent;
function sys_closedir(dirp : pdir): cint;
function sys_chdir(const path : pchar): cint;
function sys_open(const path: pchar; flags : cint; mode: mode_t):cint;
function sys_mkdir(const path : pchar; mode: mode_t):cint;
function sys_unlink(const path: pchar): cint;
function sys_rmdir(const path : pchar): cint;
function sys_rename(const old : pchar; const newpath: pchar): cint;
function sys_access(const pathname : pchar; amode : cint): cint;
function sys_close(fd : cint): cint;
function sys_read(fd: cint; buf: pchar; nbytes : size_t): ssize_t;
function sys_write(fd: cint;const buf:pchar; nbytes : size_t): ssize_t;
function sys_lseek(fd : cint; offset : off_t; whence : cint): off_t;
function sys_time(var tloc:time_t): time_t;
function sys_ftruncate(fd : cint; flength : off_t): cint;
function sys_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint;
function sys_fstat(fd : cint; var sb : stat): cint;
function sys_stat(const path: pchar; var buf : stat): cint;
function S_ISDIR(m : mode_t): boolean;
function S_ISCHR(m : mode_t): boolean;
function S_ISBLK(m : mode_t): boolean;
function S_ISREG(m : mode_t): boolean;
function S_ISFIFO(m : mode_t): boolean;
function wifexited(status : cint): cint;
function wexitstatus(status : cint): cint;
function wstopsig(status : cint): cint;
function wifsignaled(status : cint): cint;
implementation
function int_fork : pid_t; cdecl; external name 'fork';
function int_execve(const path : pchar; const argv : ppchar; const envp: ppchar): cint; cdecl; external name 'execve';
function int_waitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t; cdecl; external name 'waitpid';
function int_uname(var name: utsname): cint; cdecl; external name 'uname';
function int_opendir(const dirname : pchar): pdir; cdecl; external name 'opendir';
function int_readdir(dirp : pdir) : pdirent;cdecl; external name 'readdir';
function int_closedir(dirp : pdir): cint; cdecl; external name 'closedir';
function int_chdir(const path : pchar): cint; cdecl; external name 'chdir';
function int_open(const path: pchar; flags : cint; mode: mode_t):cint; cdecl; external name 'open';
function int_mkdir(const path : pchar; mode: mode_t):cint; cdecl; external name 'mkdir';
function int_unlink(const path: pchar): cint; cdecl; external name 'unlink';
function int_rmdir(const path : pchar): cint; cdecl; external name 'rmdir';
function int_rename(const old : pchar; const newpath: pchar): cint; cdecl;external name 'rename';
function int_access(const pathname : pchar; amode : cint): cint; cdecl; external name 'access';
function int_close(fd : cint): cint; cdecl; external name 'close';
function int_read(fd: cint; buf: pchar; nbytes : size_t): ssize_t; cdecl; external name 'read';
function int_write(fd: cint;const buf:pchar; nbytes : size_t): ssize_t; cdecl; external name 'write';
function int_lseek(fd : cint; offset : off_t; whence : cint): off_t; cdecl; external name 'lseek';
function int_time(var tloc:time_t): time_t; cdecl; external name 'time';
function int_ftruncate(fd : cint; flength : off_t): cint; cdecl; external name 'ftruncate';
function int_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint; cdecl; external name 'sigaction';
function int_fstat(fd : cint; var sb : stat): cint; cdecl; external name 'fstat';
function int_stat(const path: pchar; var buf : stat): cint; cdecl; external name 'stat';
function sys_fork : pid_t;
begin
sys_fork := int_fork;
if sys_fork <> - 1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_execve(const path : pchar; const argv : ppchar; const envp: ppchar): cint;
begin
sys_execve := int_execve(path, argv, envp);
if sys_execve <> - 1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_waitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t;
begin
sys_waitpid := int_waitpid(pid, stat_loc, options);
if sys_waitpid <> - 1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_uname(var name: utsname): cint;
begin
sys_uname := int_uname(name);
if sys_uname <> - 1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_opendir(const dirname : pchar): pdir;
begin
sys_opendir := int_opendir(dirname);
if sys_opendir <> nil then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_readdir(dirp : pdir) : pdirent;
begin
sys_readdir := int_readdir(dirp);
if sys_readdir <> nil then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_closedir(dirp : pdir): cint;
begin
sys_closedir := int_closedir(dirp);
if sys_closedir <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_chdir(const path : pchar): cint;
begin
sys_chdir := int_chdir(path);
if sys_chdir <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_open(const path: pchar; flags : cint; mode: mode_t):cint;
begin
sys_open:= int_open(path, flags, mode);
if sys_open <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_mkdir(const path : pchar; mode: mode_t):cint;
begin
sys_mkdir:= int_mkdir(path, mode);
if sys_mkdir <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_unlink(const path: pchar): cint;
begin
sys_unlink := int_unlink(path);
if sys_unlink <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_rmdir(const path : pchar): cint;
begin
sys_rmdir := int_rmdir(path);
if sys_rmdir <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_rename(const old : pchar; const newpath: pchar): cint;
begin
sys_rename := int_rename(old, newpath);
if sys_rename <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_access(const pathname : pchar; amode : cint): cint;
begin
sys_access := int_access(pathname, amode);
if sys_access <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_close(fd : cint): cint;
begin
sys_close := int_close(fd);
if sys_close <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_read(fd: cint; buf: pchar; nbytes : size_t): ssize_t;
begin
sys_read := int_read(fd, buf, nbytes);
if sys_read <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_write(fd: cint;const buf:pchar; nbytes : size_t): ssize_t;
begin
sys_write := int_write(fd, buf, nbytes);
if sys_write <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_lseek(fd : cint; offset : off_t; whence : cint): off_t;
begin
sys_lseek := int_lseek(fd, offset, whence);
if sys_lseek <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_time(var tloc:time_t): time_t;
begin
sys_time := int_time(tloc);
if sys_time <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_ftruncate(fd : cint; flength : off_t): cint;
begin
sys_ftruncate := int_ftruncate(fd, flength);
if sys_ftruncate <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint;
begin
sys_sigaction := int_sigaction(sig, act, oact);
if sys_sigaction <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_fstat(fd : cint; var sb : stat): cint;
begin
sys_fstat := int_fstat(fd, sb);
if sys_fstat <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
function sys_stat(const path: pchar; var buf : stat): cint;
begin
sys_stat := int_stat(path, buf);
if sys_stat <> -1 then
begin
errno := 0; { reset errno when the call succeeds, contrary to libc }
end;
end;
const
_S_IFMT = $F000; (* Type of file *)
_S_IFIFO = $1000; (* FIFO *)
_S_IFCHR = $2000; (* Character special *)
_S_IFDIR = $4000; (* Directory *)
_S_IFNAM = $5000; (* Special named file *)
_S_IFBLK = $6000; (* Block special *)
_S_IFREG = $8000; (* Regular *)
_S_IFLNK = $A000; (* Symbolic link *)
_S_IFSOCK = $C000; (* Socket *)
function S_ISDIR(m : mode_t): boolean;
begin
if (m and _S_IFMT) = _S_IFDIR then
S_ISDIR := true
else
S_ISDIR := false;
end;
function S_ISCHR(m : mode_t): boolean;
begin
if (m and _S_IFMT) = _S_IFCHR then
S_ISCHR := true
else
S_ISCHR := false;
end;
function S_ISBLK(m : mode_t): boolean;
begin
if (m and _S_IFMT) = _S_IFBLK then
S_ISBLK := true
else
S_ISBLK := false;
end;
function S_ISREG(m : mode_t): boolean;
begin
if (m and _S_IFMT) = _S_IFREG then
S_ISREG := true
else
S_ISREG := false;
end;
function S_ISFIFO(m : mode_t): boolean;
begin
if (m and _S_IFMT) = _S_IFIFO then
S_ISFIFO := true
else
S_ISFIFO := false;
end;
function wifexited(status : cint): cint;
begin
wifexited := longint((status and $FF) = 0);
end;
function wexitstatus(status : cint): cint;
begin
wexitstatus := (((status) shr 8) and $FF);
end;
function wstopsig(status : cint): cint;
begin
wstopsig := (((status) shr 8) and $FF);
end;
function wifsignaled(status : cint): cint;
begin
if ((status and $FF) <> 0) and ((status and $FF00)=0) then
wifsignaled := 1
else
wifsignaled := 0;
end;
end.
{
$Log: posix.pp,v $
Revision 1.1.2.2 2002/05/01 14:10:36 carl
* Correct structures for stat and dirent
* correct some compilation problems
* change types according to 80x86 version
Revision 1.1.2.1 2001/12/20 02:55:01 carl
+ QNX versions (still untested)
Revision 1.1.2.1 2001/12/09 03:25:17 carl
+ reinstated
}

66
rtl/qnx/qnx.inc Normal file
View File

@ -0,0 +1,66 @@
{
$Id: qnx.inc,v 1.1.2.2 2002/05/01 14:10:36 carl Exp $
Copyright (c) 2002 by Carl Eric Codere
Implements QNX system calls and types
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
const
_FSTYPSZ = 16;
type
fsblkcnt_t = int64;
fsfilcnt_t = int64;
statvfs_t = packed record
f_bsize : cardinal; {* fundamental file system block size *}
f_frsize : cardinal; {* fragment size *}
f_blocks : fsblkcnt_t; {* total blocks of f_frsize on fs *}
f_bfree : fsblkcnt_t; {* total free blocks of f_frsize *}
f_bavail : fsblkcnt_t; {* free blocks avail to non-superuser *}
f_files : fsfilcnt_t; {* total file nodes (inodes) *}
f_free : fsfilcnt_t; {* total free file nodes *}
f_favail : fsfilcnt_t; {* free nodes avail to non-superuser *}
f_fsid : cardinal; {* file system id (dev for now) *}
f_basetype : array[0.._FSTYPSZ-1] of char; {* target fs type name null terminated *}
f_flag : cardinal; {* bit-mask of flags *}
f_namemax : cardinal; {* maximum file name length *}
f_filler : array[1..21] of cardinal; {* reserved for future expansion *}
end;
function sys_statvfs(const path: pchar; var buf : statvfs_t): cint; cdecl; external name 'statvfs';
{
$Log: qnx.inc,v $
Revision 1.1.2.2 2002/05/01 14:10:36 carl
* Correct structures for stat and dirent
* correct some compilation problems
* change types according to 80x86 version
Revision 1.1.2.1 2001/12/20 02:55:01 carl
+ QNX versions (still untested)
}

81
rtl/qnx/signal.inc Normal file
View File

@ -0,0 +1,81 @@
{
$Id: signal.inc,v 1.1.2.1 2001/12/20 02:55:01 carl Exp $
This file is part of the Free Pascal run time library.
Copyright (c) 2001 by Free Pascal development team
This file implements all the types/constants related
to signal for QNX RTP
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{ requires osposixh types first }
type
sigset_t = int64; { used for additional signal }
sighandler_t = procedure (signo: cint); cdecl;
{ signal services }
sigactionrec = packed record
sa_handler : sighandler_t; { this is overlapped with sa_sigaction field on solaris }
sa_flags : cint;
sa_mask : sigset_t;
end;
const
{************************ signals *****************************}
{ more can be provided. Herein are only included the required }
{ values. }
{**************************************************************}
SIGABRT = 6; { abnormal termination }
SIGALRM =14; { alarm clock (used with alarm() }
SIGFPE = 8; { illegal arithmetic operation }
SIGHUP = 1; { Hangup }
SIGILL = 4; { Illegal instruction }
SIGINT = 2; { Interactive attention signal }
SIGKILL = 9; { Kill, cannot be caught }
SIGPIPE =13; { Broken pipe signal }
SIGQUIT = 3; { Interactive termination signal }
SIGSEGV =11; { Detection of invalid memory reference }
SIGTERM =15; { Termination request }
SIGUSR1 =16; { Application defined signal 1 }
SIGUSR2 =17; { Application defined signal 2 }
SIGCHLD =18; { Child process terminated / stopped }
SIGCONT =25; { Continue if stopped }
SIGSTOP =23; { Stop signal. cannot be cuaght }
SIGSTP =24; { Interactive stop signal }
SIGTTIN =26; { Background read from TTY }
SIGTTOU =27; { Background write to TTY }
SIGBUS =10; { Access to undefined memory }
{ --------------- QNX specific signals --------------- }
SIGTRAP = 5; { trace trap (not reset when caught) }
SIGIOT = 6; { IOT instruction }
SIGEMT = 7; { EMT instruction }
SIGDEADLK = 7; { Mutex deadlock }
SIGSYS =12; { bad argument to system call }
SIGCLD =SIGCHLD;
SIGPWR =19; { power-fail restart }
SIGWINCH =20; { window change }
SIGURG =21; { urgent condition on I/O channel }
SIGPOLL =22; { System V name for SIGIO }
SIGIO =SIGPOLL;
SIGVTALRM =28; { virtual timer expired }
SIGPROF =29; { profileing timer expired }
SIGXCPU =30; { exceded cpu limit }
SIGXFSZ =31; { exceded file size limit }
{
$Log: signal.inc,v $
Revision 1.1.2.1 2001/12/20 02:55:01 carl
+ QNX versions (still untested)
}

278
rtl/qnx/system.pp Normal file
View File

@ -0,0 +1,278 @@
{
$Id: system.pp,v 1.1.2.2 2002/05/01 14:10:36 carl Exp $
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by the Free Pascal development team.
QNX system unit
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{ no stack check in system }
{$S-}
unit System;
interface
{ include system-independent routine headers }
{$I systemh.inc}
{ include heap support headers }
{$I heaph.inc}
var
argc : longint;
argv : ppchar;
envp : ppchar;
var
Errno : longint; external name 'errno'; { declared in libc }
var
UnusedHandle:longint;
StdInputHandle:longint;
StdOutputHandle:longint;
StdErrorHandle:longint;
{Platform specific information}
const
LineEnding = #10;
LFNSupport = true;
DirectorySeparator = '/';
DriveSeparator = '';
PathSeparator = ':';
FileNameCaseSensitive = True;
implementation
{$I system.inc}
{$i errno.inc} { Error numbers }
{$I osposixh.inc} { include POSIX types / constants }
{$I osposix.inc} { include POSIX system calls }
{$i sysposix.inc}
{*****************************************************************************
Executable filename
*****************************************************************************}
Function FileSearch(const path:shortstring;dirlist:shortstring):shortstring;
{
Searches for a file 'path' in the list of direcories in 'dirlist'.
returns an empty string if not found. Wildcards are NOT allowed.
If dirlist is empty, it is set to '.'
}
Var
NewDir : shortstring;
p1 : Longint;
Info : Stat;
buffer : array[0..PATH_MAX+1] of char;
Begin
Move(path[1], Buffer, Length(path));
Buffer[Length(path)]:=#0;
if (length(Path)>0) and (path[1]='/') and (sys_stat(pchar(@Buffer),info)=0) then
begin
FileSearch:=path;
exit;
end;
{Replace ':' with ';'}
for p1:=1to length(dirlist) do
if dirlist[p1]=':' then
dirlist[p1]:=';';
{Check for WildCards}
If (Pos('?',Path) <> 0) or (Pos('*',Path) <> 0) Then
FileSearch:='' {No wildcards allowed in these things.}
Else
Begin
Dirlist:='.;'+dirlist;{Make sure current dir is first to be searched.}
Repeat
p1:=Pos(';',DirList);
If p1=0 Then
p1:=255;
NewDir:=Copy(DirList,1,P1 - 1);
if NewDir[Length(NewDir)]<>'/' then
NewDir:=NewDir+'/';
NewDir:=NewDir+Path;
Delete(DirList,1,p1);
Move(NewDir[1], Buffer, Length(NewDir));
Buffer[Length(NewDir)]:=#0;
if sys_stat(pchar(@Buffer),Info)=0 then
Begin
If Pos('./',NewDir)=1 Then
Delete(NewDir,1,2);
{DOS strips off an initial .\}
End
Else
NewDir:='';
Until (DirList='') or (Length(NewDir) > 0);
FileSearch:=NewDir;
End;
End;
Function GetEnv(EnvVar:shortstring):shortstring;
{
Searches the environment for a string with name p and
returns a pchar to it's value.
A pchar is used to accomodate for strings of length > 255
}
var
ep : ppchar;
found : boolean;
p1 : pchar;
Begin
EnvVar:=EnvVar+'='; {Else HOST will also find HOSTNAME, etc}
ep:=envp;
found:=false;
if ep<>nil then
begin
while (not found) and (ep^<>nil) do
begin
if (pos(EnvVar,strpas(ep^))=1) then
found:=true
else
inc(ep);
end;
end;
if found then
p1:=ep^+length(EnvVar)
else
p1:=nil;
if p1 = nil then
GetEnv := ''
else
GetEnv := StrPas(p1);
end;
{ this routine sets up the paramstr(0) string at startup }
procedure setupexecname;
var
fstr: shortstring;
begin
execpathstr := strpas(argv[0]);
fstr:=filesearch(strpas(argv[0]), getenv('PATH'));
if fstr<>'' then
execpathstr:=fstr;
end;
{*****************************************************************************
Heap Management
*****************************************************************************}
function malloc(size: size_t): pointer; cdecl; external name 'malloc';
{ IMPORTANT SOLARIS PORT NOTE: mmap() cannot be used, since ANONYMOUS }
{ requests are only available starting from Solaris 8. sbrk() cannot }
{ be used either since C libraries linked in with the runtime library may }
{ use malloc(), and the man pages of Solaris indicate that mixing both }
{ sbrk() and malloc() is a no-no. }
function Sbrk(size : longint):longint;
var ptr : pointer;
begin
ptr := malloc(size_t(size));
if ptr = nil then
sbrk := -1
else
begin
sbrk := longint(ptr);
errno := 0;
end;
end;
{ include standard heap management }
{$I heap.inc}
{****************************************************************************
Low level File Routines
All these functions can set InOutRes on errors
****************************************************************************}
function do_isdevice(handle:longint):boolean;
begin
do_isdevice:= (handle=StdInputHandle) or
(handle=StdOutputHandle) or
(handle=StdErrorHandle);
end;
{*****************************************************************************
UnTyped File Handling
*****************************************************************************}
{$i file.inc}
{*****************************************************************************
Typed File Handling
*****************************************************************************}
{$i typefile.inc}
{*****************************************************************************
Text File Handling
*****************************************************************************}
{$DEFINE SHORT_LINEBREAK}
{ DEFINE EXTENDED_EOF}
{$i text.inc}
{*****************************************************************************
SystemUnit Initialization
*****************************************************************************}
var
stacklength : longint;external name '__stklen';
begin
{ setup lowest value of stack pointer }
StackBottom := SPtr - StackLength;
InitHeap;
{ Set up signals handlers }
InstallSignals;
{ Setup heap }
InitExceptions;
{ Arguments }
SetupCmdLine;
{ Setup IO }
StdInputHandle:=0;
StdOutputHandle:=1;
StdErrorHandle:=2;
OpenStdIO(Input,fmInput,StdInputHandle);
OpenStdIO(Output,fmOutput,StdOutputHandle);
OpenStdIO(StdOut,fmOutput,StdOutputHandle);
OpenStdIO(StdErr,fmOutput,StdErrorHandle);
{ Reset IO Error }
InOutRes:=0;
setupexecname;
end.
{
$Log: system.pp,v $
Revision 1.1.2.2 2002/05/01 14:10:36 carl
* Correct structures for stat and dirent
* correct some compilation problems
* change types according to 80x86 version
Revision 1.1.2.1 2001/12/20 02:55:01 carl
+ QNX versions (still untested)
}