paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 08:29:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Small fixes and quick merge with 1.0.x. At least the compiler builds now,

Browse Source 
but it could crash hard, since there are lots of unimplemented funcs.
This commit is contained in:
marco 2003-01-08 22:32:28 +00:00
parent 4a0ec9ad00
commit 97533b60f8
12 changed files with 3299 additions and 471 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
rtl/beos/Makefile
View File

@ -225,7 +225,7 @@ override FPCOPT+=-Ur
endif endif
OBJPASDIR=$(RTL)/objpas OBJPASDIR=$(RTL)/objpas
GRAPHDIR=$(INC)/graph GRAPHDIR=$(INC)/graph
override TARGET_UNITS+=system objpas strings beos dos sysutils typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types override TARGET_UNITS+=system objpas posix strings beos dos sysutils typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types
override TARGET_LOADERS+=prt0 cprt0 func dllprt override TARGET_LOADERS+=prt0 cprt0 func dllprt
override TARGET_RSTS+=math varutils typinfo override TARGET_RSTS+=math varutils typinfo
override INSTALL_FPCPACKAGE=y override INSTALL_FPCPACKAGE=y

2
rtl/beos/Makefile.fpc
View File

@ -7,7 +7,7 @@ main=rtl
[target] [target]
loaders=prt0 cprt0 func dllprt loaders=prt0 cprt0 func dllprt
units=system objpas strings \ units=system posix objpas strings \
beos \ beos \
dos \ dos \
sysutils typinfo math varutils \ sysutils typinfo math varutils \

571
rtl/beos/beos.inc Normal file
View File

@ -0,0 +1,571 @@
{
$Id$
Copyright (c) 2001 by Carl Eric Codere
Implements BeOS 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
{ BeOS specific calls }
syscall_nr_create_area = $14;
syscall_nr_resize_area = $08;
syscall_nr_delete_area = $15;
syscall_nr_load_image = $34;
syscall_nr_wait_thread = $22;
syscall_nr_rstat = $30;
syscall_nr_statfs = $5F;
syscall_nr_get_team_info = $3b;
syscall_nr_kill_team = $3a;
syscall_nr_get_system_info = $56;
syscall_nr_kget_tzfilename = $AF;
syscall_nr_get_next_image_info = $3C;
const
{ -----
system-wide constants;
----- *}
MAXPATHLEN = PATH_MAX;
B_FILE_NAME_LENGTH = NAME_MAX;
B_OS_NAME_LENGTH = 32;
B_PAGE_SIZE = 4096;
(* -----
types
----- *)
type area_id = longint;
type port_id = longint;
type sem_id = longint;
type thread_id = longint;
type team_id = longint;
type bigtime_t = int64;
type status_t = longint;
{*************************************************************}
{*********************** KERNEL KIT **************************}
{*************************************************************}
{ ------------------------- Areas --------------------------- }
const
{ create_area constant definitions }
{ lock type }
B_NO_LOCK = 0;
B_LAZY_LOCK = 1;
B_FULL_LOCK = 2;
B_CONTIGUOUS = 3;
B_LOMEM = 4;
{ address type }
B_ANY_ADDRESS = 0;
B_EXACT_ADDRESS = 1;
B_BASE_ADDRESS = 2;
B_CLONE_ADDRESS = 3;
B_ANY_KERNEL_ADDRESS = 4;
{ protection bits }
B_READ_AREA = 1;
B_WRITE_AREA = 2;
type
area_info = packed record
area: area_id;
name: array[0..B_OS_NAME_LENGTH-1] of char;
size: size_t;
lock: cardinal;
protection: cardinal;
team: team_id;
ram_size: cardinal;
copy_count: cardinal;
in_count: cardinal;
out_count: cardinal;
address: pointer;
end;
function create_area(name : pchar; var addr : longint;
addr_typ : longint; size : longint; lock_type: longint; protection : longint): area_id;
var
args : SysCallArgs;
begin
args.param[1] := cint(name);
args.param[2] := cint(@addr);
args.param[3] := cint(addr_typ);
args.param[4] := cint(size);
args.param[5] := cint(lock_type);
args.param[6] := cint(protection);
create_area := SysCall(syscall_nr_create_area, args);
end;
function delete_area(area : area_id): status_t;
var
args: SysCallargs;
begin
args.param[1] := cint(area);
delete_area:= SysCall(syscall_nr_delete_area, args);
end;
function resize_area(area: area_id; new_size: size_t): status_t;
var
args: SysCallArgs;
begin
args.param[1] := cint(area);
args.param[2] := cint(new_size);
resize_area := SysCall(syscall_nr_resize_area, args);
end;
{ the buffer should at least have MAXPATHLEN+1 bytes in size }
function kget_tzfilename(buffer:pchar): cint;
var
args: SysCallArgs;
begin
args.param[1] := cint(buffer);
kget_tzfilename := SysCall(syscall_nr_kget_tzfilename,args);
end;
(*
extern _IMPEXP_ROOT area_id clone_area(const char *name, void **dest_addr,
uint32 addr_spec, uint32 protection,
area_id source);
extern _IMPEXP_ROOT area_id find_area(const char *name);
extern _IMPEXP_ROOT area_id area_for(void *addr);
extern _IMPEXP_ROOT status_t set_area_protection(area_id id,
uint32 new_protection);
extern _IMPEXP_ROOT status_t _get_area_info(area_id id, area_info *ainfo,
size_t size);
extern _IMPEXP_ROOT status_t _get_next_area_info(team_id team, int32 *cookie,
area_info *ainfo, size_t size);
*)
{ ------------------------- Threads --------------------------- }
const
{ thread state }
B_THREAD_RUNNING = 1;
B_THREAD_READY = 2;
B_THREAD_RECEIVING = 3;
B_THREAD_ASLEEP = 4;
B_THREAD_SUSPENDED = 5;
B_THREAD_WAITING = 6;
{ thread priorities }
B_LOW_PRIORITY = 5;
B_NORMAL_PRIORITY = 10;
B_DISPLAY_PRIORITY = 15;
B_URGENT_DISPLAY_PRIORITY = 20;
B_REAL_TIME_DISPLAY_PRIORITY= 100;
B_URGENT_PRIORITY = 110;
B_REAL_TIME_PRIORITY = 120;
type
thread_info = packed record
thread: thread_id;
team: team_id;
name: array[0..B_OS_NAME_LENGTH-1] of char;
state: longint; { thread_state enum }
priority:longint;
sem:sem_id;
user_time:bigtime_t;
kernel_time:bigtime_t;
stack_base:pointer;
stack_end:pointer;
end;
{
extern _IMPEXP_ROOT thread_id spawn_thread (
thread_func function_name,
const char *thread_name,
int32 priority,
void *arg
);
extern _IMPEXP_ROOT thread_id find_thread(const char *name);
extern _IMPEXP_ROOT status_t kill_thread(thread_id thread);
extern _IMPEXP_ROOT status_t resume_thread(thread_id thread);
extern _IMPEXP_ROOT status_t suspend_thread(thread_id thread);
extern _IMPEXP_ROOT status_t rename_thread(thread_id thread, const char *new_name);
extern _IMPEXP_ROOT status_t set_thread_priority (thread_id thread, int32 new_priority);
extern _IMPEXP_ROOT void exit_thread(status_t status);
extern _IMPEXP_ROOT status_t _get_thread_info(thread_id thread, thread_info *info, size_t size);
extern _IMPEXP_ROOT status_t _get_next_thread_info(team_id tmid, int32 *cookie, thread_info *info, size_t size);
extern _IMPEXP_ROOT status_t send_data(thread_id thread,
int32 code,
const void *buf,
size_t buffer_size);
extern _IMPEXP_ROOT status_t receive_data(thread_id *sender,
void *buf,
size_t buffer_size);
extern _IMPEXP_ROOT bool has_data(thread_id thread);
extern _IMPEXP_ROOT status_t snooze(bigtime_t microseconds);
/*
Right now you can only snooze_until() on a single time base, the
system time base given by system_time(). The "time" argument is
the time (in the future) relative to the current system_time() that
you want to snooze until. Eventually there will be multiple time
bases (and a way to find out which ones exist) but for now just pass
the value B_SYSTEM_TIMEBASE.
*/
extern _IMPEXP_ROOT status_t snooze_until(bigtime_t time, int timebase);
#define B_SYSTEM_TIMEBASE (0)
}
function wait_for_thread(thread: thread_id; var status : status_t): status_t;
var
args: SysCallArgs;
i: longint;
begin
args.param[1] := cint(thread);
args.param[2] := cint(@status);
wait_for_thread := SysCall(syscall_nr_wait_thread, args);
end;
{ ------------------------- Teams --------------------------- }
const
B_SYSTEM_TEAM = 2;
type
team_info = packed record
team: team_id;
image_count: longint;
thread_count: longint;
area_count: longint;
debugger_nub_thread: thread_id;
debugger_nub_port: port_id;
argc:longint; (* number of args on the command line *)
args: array[0..63] of char; {* abbreviated command line args *}
uid: uid_t;
gid: gid_t;
end;
{
extern _IMPEXP_ROOT status_t _get_next_team_info(int32 *cookie, team_info *info, size_t size);
}
function get_team_info(team: team_id; var info : team_info): status_t;
var
args: SysCallArgs;
begin
args.param[1] := cint(team);
args.param[2] := cint(@info);
get_team_info := SysCall(syscall_nr_get_team_info, args);
end;
function kill_team(team: team_id): status_t;
var
args: SysCallArgs;
begin
args.param[1] := cint(team);
kill_team := SysCall(syscall_nr_kill_team, args);
end;
{ ------------------------- Images --------------------------- }
type image_id = longint;
{ image types }
const
B_APP_IMAGE = 1;
B_LIBRARY_IMAGE = 2;
B_ADD_ON_IMAGE = 3;
B_SYSTEM_IMAGE = 4;
type
image_info = packed record
id : image_id;
_type : longint;
sequence: longint;
init_order: longint;
init_routine: pointer;
term_routine: pointer;
device: dev_t;
node: ino_t;
name: array[0..MAXPATHLEN-1] of char;
text: pointer;
data: pointer;
text_size: longint;
data_size: longint;
end;
function get_next_image_info(team : team_id; var cookie: longint;var info : image_info): status_t;
var
args: SysCallArgs;
begin
args.param[1] := cint(team);
args.param[2] := cint(@cookie);
args.param[3] := cint(@info);
args.param[4] := cint(sizeof(image_info));
get_next_image_info := SysCall(syscall_nr_get_next_image_info, args);
end;
{
extern _IMPEXP_ROOT image_id load_add_on(const char *path);
extern _IMPEXP_ROOT status_t unload_add_on(image_id imid);
/* private; use the macros, below */
extern _IMPEXP_ROOT status_t _get_image_info (image_id image,
image_info *info, size_t size);
extern _IMPEXP_ROOT status_t _get_next_image_info (team_id team, int32 *cookie,
image_info *info, size_t size);
}
(*----- symbol types and functions ------------------------*)
const B_SYMBOL_TYPE_DATA = $1;
const B_SYMBOL_TYPE_TEXT = $2;
const B_SYMBOL_TYPE_ANY = $5;
{
extern _IMPEXP_ROOT status_t get_image_symbol(image_id imid,
const char *name, int32 sclass, void **ptr);
extern _IMPEXP_ROOT status_t get_nth_image_symbol(image_id imid, int32 index,
char *buf, int32 *bufsize, int32 *sclass,
void **ptr);
}
{*----- cache manipulation --------------------------------*}
const
B_FLUSH_DCACHE =$0001; {* dcache = data cache *}
B_FLUSH_ICACHE =$0004; {* icache = instruction cache *}
B_INVALIDATE_DCACHE =$0002;
B_INVALIDATE_ICACHE =$0008;
{
extern _IMPEXP_ROOT void clear_caches(void *addr, size_t len, uint32 flags);
}
function load_image(argc : longint; argv : ppchar; envp : ppchar): thread_id;
var
args: SysCallArgs;
i: longint;
begin
args.param[1] := cint(argc);
args.param[2] := cint(argv);
args.param[3] := cint(envp);
load_image := SysCall(syscall_nr_load_image, args);
end;
{ ------------------------ System information --------------------------- }
{ for both intel and ppc platforms }
const B_MAX_CPU_COUNT = 8;
type
system_info = packed record
id: array[0..1] of longint; {* unique machine ID *}
boot_time: bigtime_t; {* time of boot (# usec since 1/1/70) *}
cpu_count: longint; {* # of cpus *}
cpu_type: longint; {* type of cpu *}
cpu_revision:longint ; {* revision # of cpu *}
cpu_infos: array [0..B_MAX_CPU_COUNT-1] of bigtime_t; {* info about individual cpus *}
cpu_clock_speed:int64; {* processor clock speed (Hz) *}
bus_clock_speed:int64; {* bus clock speed (Hz) * }
platform_type:longint; {* type of machine we're on *}
max_pages:longint; {* total # physical pages *}
used_pages:longint; {* # physical pages in use *}
page_faults:longint; {* # of page faults *}
max_sems:longint; {* maximum # semaphores *}
used_sems:longint; {* # semaphores in use *}
max_ports:longint; {* maximum # ports *}
used_ports:longint; {* # ports in use *}
max_threads:longint; {* maximum # threads *}
used_threads:longint; {* # threads in use *}
max_teams:longint; {* maximum # teams *}
used_teams:longint; {* # teams in use *}
kernel_name: array[0..B_FILE_NAME_LENGTH-1] of char; {* name of kernel *}
kernel_build_date: array[0..B_OS_NAME_LENGTH-1] of char; {* date kernel built *}
kernel_build_time: array[0..B_OS_NAME_LENGTH-1] of char; {* time kernel built *}
kernel_version:int64; {* version of this kernel *}
_busy_wait_time:bigtime_t; {* reserved for Be *}
pad:array[1..4] of longint; {* just in case... *}
end;
function get_system_info(var info: system_info): status_t;
var
args: SysCallArgs;
i: longint;
begin
args.param[1] := cint(@info);
i := SysCall(syscall_nr_get_system_info, args);
get_system_info := i;
end;
{*************************************************************}
{*********************** STORAGE KIT *************************}
{*************************************************************}
const
{ file system flags }
B_FS_IS_READONLY = $00000001;
B_FS_IS_REMOVABLE = $00000002;
B_FS_IS_PERSISTENT = $00000004;
B_FS_IS_SHARED = $00000008;
B_FS_HAS_MIME = $00010000;
B_FS_HAS_ATTR = $00020000;
B_FS_HAS_QUERY = $00040000;
type
fs_info = packed record
dev : dev_t; { fs dev_t }
root : ino_t; { root ino_t }
flags : cardinal; { file system flags }
block_size:off_t; { fundamental block size }
io_size:off_t; { optimal io size }
total_blocks:off_t; { total number of blocks }
free_blocks:off_t; { number of free blocks }
total_nodes:off_t; { total number of nodes }
free_nodes:off_t; { number of free nodes }
device_name: array[0..127] of char; { device holding fs }
volume_name: array[0..B_FILE_NAME_LENGTH-1] of char;{ volume name }
fsh_name : array[0..B_OS_NAME_LENGTH-1] of char;{ name of fs handler }
end;
function dev_for_path(const pathname : pchar): dev_t;
var
args: SysCallArgs;
buffer: array[1..15] of longint;
i: cint;
begin
args.param[1] := $FFFFFFFF;
args.param[2] := cint(pathname);
args.param[3] := cint(@buffer);
args.param[4] := $01000000;
if SysCall(syscall_nr_rstat, args)=0 then
i:=buffer[1]
else
i:=-1;
dev_for_path := i;
end;
function fs_stat_dev(device: dev_t; var info: fs_info): dev_t;
var
args: SysCallArgs;
begin
args.param[1] := cint(device);
args.param[2] := 0;
args.param[3] := $FFFFFFFF;
args.param[4] := 0;
args.param[5] := cint(@info);
fs_stat_dev := SysCall(syscall_nr_statfs, args);
end;
{
_IMPEXP_ROOT dev_t next_dev(int32 *pos);
}
{*****************************************************************}
{
$Log$
Revision 1.2 2003-01-08 22:32:28 marco
* Small fixes and quick merge with 1.0.x. At least the compiler builds now,
but it could crash hard, since there are lots of unimplemented funcs.
Revision 1.1.2.6 2002/02/15 18:15:00 carl
+ added get_next_image_info
Revision 1.1.2.5 2001/08/13 05:56:35 carl
* renamed routine names (names are same as documented in the Be Book)
Revision 1.1.2.4 2001/08/12 15:14:24 carl
+ added kget_tzfilename() kernel call to get timezone info.
Revision 1.1.2.3 2001/08/04 06:14:15 carl
- remove crappy tab characters
Revision 1.1.2.2 2001/08/04 05:25:03 carl
+ added much more system headers and system calls
Revision 1.1.2.1 2001/08/03 01:57:36 carl
* beos types and system inteface (minimalistic for the moment)
}

178
rtl/beos/dos.inc Normal file
View File

@ -0,0 +1,178 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 2001 by members of the Free Pascal
development team
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 syscall.inc}
{$i beos.inc}
{$define DOS_HAS_EXEC}
{
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 - '/fd0/.' (floppy drive 1 - should be adapted to local system )
2 - '/fd1/.' (floppy drive 2 - should be adapted to local system )
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 }
'/disk 0/.', { mounted floppy 1 }
'/disk 1/.', { mounted floppy 2 }
'/boot/.' { the boot up disk }
);
Function DosVersion:Word;
Begin
DosVersion := 0;
End;
Function DiskFree(Drive: Byte): int64;
var
info: fs_info;
device : dev_t;
Begin
device := 0;
DiskFree := -1;
if (Drive < 4) and (FixDriveStr[Drive]<>nil) then
begin
device:= dev_for_path(FixDriveStr[Drive]);
end
else
if (Drive>4) and (Drive<=MAX_DRIVES) and (drivestr[Drive]<>nil) then
device := dev_for_path(driveStr[drive])
else
begin
exit;
end;
if fs_Stat_dev(device,info)=0 then
DiskFree := int64(info.block_size)*int64(info.free_blocks);
End;
Function DiskSize(Drive: Byte): int64;
var
info: fs_info;
device : dev_t;
Begin
device := 0;
DiskSize:= -1;
if (Drive < 4) and (FixDriveStr[Drive]<>nil) then
begin
device:= dev_for_path(FixDriveStr[Drive]);
end
else
if (Drive>4) and (Drive<=MAX_DRIVES) and (drivestr[Drive]<>nil) then
device := dev_for_path(driveStr[drive])
else
begin
exit;
end;
if fs_Stat_dev(device,info)=0 then
DiskSize := int64(info.block_size)*int64(info.total_blocks);
End;
{******************************************************************************
--- Exec ---
******************************************************************************}
var
LastDosExitCode: word;
Procedure Exec(const path: pathstr; const comline: comstr);
var p:string;
argv:ppchar;
argc:longint;
th:thread_id;
status : status_t;
begin
LastDosExitCode:=0;
DosError:= 0;
p:=path+' '+comline;
argv:=StringToPPChar(p,argc);
th:=load_image(argc,argv,system.envp);
if th<0 then begin
DosError:=5; { lets emulate an error }
exit;
end;
wait_for_thread(th,status);
LastDosExitCode:=status and $FF; { only keep the lower 8-bits }
end;
Function DosExitCode: Word;
Begin
DosExitCode:=LastDosExitCode;
End;
function GetTimeZoneString : string;
begin
GetTimeZoneString:=getenv('TZ');
end;
function GetTimezoneFile:string;
var
f,len : longint;
s : string;
info : stat;
buffer : array[0..MAXPATHLEN+1] of char;
begin
GetTimezoneFile:='';
if kget_tzfilename(pchar(@buffer))=0 then
begin
GetTimeZoneFile := strpas(pchar(@buffer));
end;
end;
{
$Log$
Revision 1.2 2003-01-08 22:32:28 marco
* Small fixes and quick merge with 1.0.x. At least the compiler builds now,
but it could crash hard, since there are lots of unimplemented funcs.
Revision 1.1.2.6 2002/05/01 14:08:53 carl
+ TZ is now taken from GetTimezoneSitrng instead of getenv
Revision 1.1.2.5 2001/12/17 02:14:50 carl
* bugfix for more than default drives
Revision 1.1.2.4 2001/08/15 01:01:29 carl
+ added missing file include
Revision 1.1.2.3 2001/08/13 05:57:01 carl
* renamed routine names (names are same as documented in the Be Book)
Revision 1.1.2.2 2001/08/12 15:14:54 carl
+ GetTimeZoneFileName()
Revision 1.1.2.1 2001/08/04 05:26:08 carl
+ Exec() works
+ DiskFree() / DiskSize() works
}

1439
rtl/beos/dos.pp
View File

File diff suppressed because it is too large Load Diff

219
rtl/beos/errno.inc Normal file
View File

@ -0,0 +1,219 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by the Free Pascal development team.
BeOS POSIX compliant error codes
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
{----- Error baselines ---------------------------------------}
B_GENERAL_ERROR_BASE = -2147483647-1;
B_OS_ERROR_BASE = B_GENERAL_ERROR_BASE + $1000;
B_APP_ERROR_BASE = B_GENERAL_ERROR_BASE + $2000;
B_INTERFACE_ERROR_BASE = B_GENERAL_ERROR_BASE + $3000;
B_MEDIA_ERROR_BASE = B_GENERAL_ERROR_BASE + $4000; {* - $41ff *}
B_TRANSLATION_ERROR_BASE = B_GENERAL_ERROR_BASE + $4800; {* - $48ff *}
B_MIDI_ERROR_BASE = B_GENERAL_ERROR_BASE + $5000;
B_STORAGE_ERROR_BASE = B_GENERAL_ERROR_BASE + $6000;
B_POSIX_ERROR_BASE = B_GENERAL_ERROR_BASE + $7000;
B_MAIL_ERROR_BASE = B_GENERAL_ERROR_BASE + $8000;
B_PRINT_ERROR_BASE = B_GENERAL_ERROR_BASE + $9000;
B_DEVICE_ERROR_BASE = B_GENERAL_ERROR_BASE + $a000;
{--- Developer-defined errors start at (B_ERRORS_END+1)----}
B_ERRORS_END = (B_GENERAL_ERROR_BASE + $ffff);
type
{----- General Errors ----------------------------------------}
tgeneralerrors= (
B_NO_MEMORY := B_GENERAL_ERROR_BASE,
B_IO_ERROR,
B_PERMISSION_DENIED,
B_BAD_INDEX,
B_BAD_TYPE,
B_BAD_VALUE,
B_MISMATCHED_VALUES,
B_NAME_NOT_FOUND,
B_NAME_IN_USE,
B_TIMED_OUT,
B_INTERRUPTED,
B_WOULD_BLOCK,
B_CANCELED,
B_NO_INIT,
B_BUSY,
B_NOT_ALLOWED,
B_ERROR := -1,
B_OK := 0,
B_NO_ERROR := 0
);
{----- Kernel Kit Errors -------------------------------------}
tkernelerror = (
B_BAD_SEM_ID := B_OS_ERROR_BASE,
B_NO_MORE_SEMS,
B_BAD_THREAD_ID := B_OS_ERROR_BASE + $100,
B_NO_MORE_THREADS,
B_BAD_THREAD_STATE,
B_BAD_TEAM_ID,
B_NO_MORE_TEAMS,
B_BAD_PORT_ID := B_OS_ERROR_BASE + $200,
B_NO_MORE_PORTS,
B_BAD_IMAGE_ID := B_OS_ERROR_BASE + $300,
B_BAD_ADDRESS,
B_NOT_AN_EXECUTABLE,
B_MISSING_LIBRARY,
B_MISSING_SYMBOL,
B_DEBUGGER_ALREADY_INSTALLED := B_OS_ERROR_BASE + $400
);
{----- Application Kit Errors --------------------------------}
tapperrors =
(
B_BAD_REPLY := B_APP_ERROR_BASE,
B_DUPLICATE_REPLY,
B_MESSAGE_TO_SELF,
B_BAD_HANDLER,
B_ALREADY_RUNNING,
B_LAUNCH_FAILED,
B_AMBIGUOUS_APP_LAUNCH,
B_UNKNOWN_MIME_TYPE,
B_BAD_SCRIPT_SYNTAX,
B_LAUNCH_FAILED_NO_RESOLVE_LINK,
B_LAUNCH_FAILED_EXECUTABLE,
B_LAUNCH_FAILED_APP_NOT_FOUND,
B_LAUNCH_FAILED_APP_IN_TRASH,
B_LAUNCH_FAILED_NO_PREFERRED_APP,
B_LAUNCH_FAILED_FILES_APP_NOT_FOUND
);
{----- Storage Kit/File System Errors ------------------------}
tfserrors= (
B_FILE_ERROR :=B_STORAGE_ERROR_BASE,
B_FILE_NOT_FOUND, { discouraged; use B_ENTRY_NOT_FOUND in new code }
B_FILE_EXISTS,
B_ENTRY_NOT_FOUND,
B_NAME_TOO_LONG,
B_NOT_A_DIRECTORY,
B_DIRECTORY_NOT_EMPTY,
B_DEVICE_FULL,
B_READ_ONLY_DEVICE,
B_IS_A_DIRECTORY,
B_NO_MORE_FDS,
B_CROSS_DEVICE_LINK,
B_LINK_LIMIT,
B_BUSTED_PIPE,
B_UNSUPPORTED,
B_PARTITION_TOO_SMALL
);
const
{***********************************************************************}
{ POSIX ERROR DEFINITIONS }
{***********************************************************************}
{ The following constants are system dependent but must all exist }
Sys_E2BIG = (B_POSIX_ERROR_BASE + 1);
Sys_EACCES = ord(B_PERMISSION_DENIED);
Sys_EAGAIN = ord(B_WOULD_BLOCK);
Sys_EBADF = ord(B_FILE_ERROR);
Sys_EBUSY = ord(B_BUSY);
Sys_ECHILD = (B_POSIX_ERROR_BASE + 2);
Sys_EDEADLK = (B_POSIX_ERROR_BASE + 3);
Sys_EDOM = (B_POSIX_ERROR_BASE + 16);
Sys_EEXIST = ord(B_FILE_EXISTS);
Sys_EFAULT = ord(B_BAD_ADDRESS);
Sys_EFBIG = (B_POSIX_ERROR_BASE + 4);
Sys_EINTR = ord(B_INTERRUPTED);
Sys_EINVAL = ord(B_BAD_VALUE);
Sys_EIO = ord(B_IO_ERROR);
Sys_EISDIR = ord(B_IS_A_DIRECTORY);
Sys_EMFILE = ord(B_NO_MORE_FDS);
Sys_EMLINK = (B_POSIX_ERROR_BASE + 5);
Sys_ENAMETOOLONG= ord(B_NAME_TOO_LONG);
Sys_ENFILE = (B_POSIX_ERROR_BASE + 6);
Sys_ENODEV = (B_POSIX_ERROR_BASE + 7);
Sys_ENOENT = ord(B_ENTRY_NOT_FOUND);
Sys_ENOEXEC = ord(B_NOT_AN_EXECUTABLE);
Sys_ENOLCK = (B_POSIX_ERROR_BASE + 8);
Sys_ENOMEM = ord(B_NO_MEMORY);
Sys_ENOSPC = ord(B_DEVICE_FULL);
Sys_ENOSYS = (B_POSIX_ERROR_BASE + 9);
Sys_ENOTDIR = ord(B_NOT_A_DIRECTORY);
Sys_ENOTEMPTY = ord(B_DIRECTORY_NOT_EMPTY);
Sys_ENOTTY = (B_POSIX_ERROR_BASE + 10);
Sys_ENXIO = (B_POSIX_ERROR_BASE + 11);
Sys_EPERM = ord(B_NOT_ALLOWED);
Sys_EPIPE = ord(B_BUSTED_PIPE);
Sys_ERANGE = (B_POSIX_ERROR_BASE + 17);
Sys_EROFS = ord(B_READ_ONLY_DEVICE);
Sys_ESPIPE = (B_POSIX_ERROR_BASE + 12);
Sys_ESRCH = (B_POSIX_ERROR_BASE + 13);
Sys_ETIMEDOUT = ord(B_TIMED_OUT);
Sys_EXDEV = ord(B_CROSS_DEVICE_LINK);
{Sys_EBADMSG = realtime extension POSIX only }
{Sys_ECANCELED = async. I/O extension POSIX only }
{Sys_EMSGSIZE = realtime extension POSIX only }
{Sys_EINPROGRESS = async. I/O extension POSIX only }
{***********************************************************************}
{ NON POSIX ERROR DEFINITIONS }
{***********************************************************************}
sys_EFPOS = (B_POSIX_ERROR_BASE + 14);
sys_ESIGPARM = (B_POSIX_ERROR_BASE + 15);
sys_EPROTOTYPE = (B_POSIX_ERROR_BASE + 18);
sys_EPROTONOSUPPORT = (B_POSIX_ERROR_BASE + 19);
sys_EPFNOSUPPORT = (B_POSIX_ERROR_BASE + 20);
sys_EAFNOSUPPORT = (B_POSIX_ERROR_BASE + 21);
sys_EADDRINUSE = (B_POSIX_ERROR_BASE + 22);
sys_EADDRNOTAVAIL = (B_POSIX_ERROR_BASE + 23);
sys_ENETDOWN = (B_POSIX_ERROR_BASE + 24);
sys_ENETUNREACH = (B_POSIX_ERROR_BASE + 25);
sys_ENETRESET = (B_POSIX_ERROR_BASE + 26);
sys_ECONNABORTED = (B_POSIX_ERROR_BASE + 27);
sys_ECONNRESET = (B_POSIX_ERROR_BASE + 28);
sys_EISCONN = (B_POSIX_ERROR_BASE + 29);
sys_ENOTCONN = (B_POSIX_ERROR_BASE + 30);
sys_ESHUTDOWN = (B_POSIX_ERROR_BASE + 31);
sys_ECONNREFUSED = (B_POSIX_ERROR_BASE + 32);
sys_EHOSTUNREACH = (B_POSIX_ERROR_BASE + 33);
sys_ENOPROTOOPT = (B_POSIX_ERROR_BASE + 34);
sys_ENOBUFS = (B_POSIX_ERROR_BASE + 35);
sys_EINPROGRESS = (B_POSIX_ERROR_BASE + 36);
sys_EALREADY = (B_POSIX_ERROR_BASE + 37);
sys_EWOULDBLOCK = ord(B_WOULD_BLOCK); {* BSD compatibility *}
sys_ELOOP = ord(B_LINK_LIMIT);
{
$Log$
Revision 1.2 2003-01-08 22:32:28 marco
* Small fixes and quick merge with 1.0.x. At least the compiler builds now,
but it could crash hard, since there are lots of unimplemented funcs.
Revision 1.1.2.4 2001/07/13 03:15:12 carl
* updated log and header of file
}

505
rtl/beos/osposix.inc Normal file
View File

@ -0,0 +1,505 @@
{
$Id$
Copyright (c) 2001 by Carl Eric Codere
Implements POSIX 1003.1 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.
****************************************************************************
}
const
syscall_nr_exit = $3F;
syscall_nr_chdir = $57;
syscall_nr_mkdir = $1E;
syscall_nr_unlink = $27;
syscall_nr_rmdir = $60;
syscall_nr_close = $01;
syscall_nr_read = $02;
syscall_nr_write = $03;
syscall_nr_stat = $30;
syscall_nr_fstat = $30;
syscall_nr_rename = $26;
syscall_nr_access = $58;
syscall_nr_opendir= $0C;
syscall_nr_closedir= $0F;
syscall_nr_sigaction= $70;
syscall_nr_time = $07;
syscall_nr_open = $00;
syscall_nr_readdir = $1C;
syscall_nr_lseek = $05;
syscall_nr_ftruncate = $4b;
S_IFDIR =$004000; { Directory. }
S_IFCHR =$002000; { Character device. }
S_IFBLK =$006000; { Block device. }
S_IFREG =$008000; { Regular file. }
S_IFIFO =$001000; { FIFO. }
S_IFLNK =$00A000; { Symbolic link. }
type
{ _kwstat_ kernel call structure }
pwstat = ^twstat;
twstat = packed record
{00} filler : array[1..3] of longint;
{12} newmode : mode_t; { chmod mode_t parameter }
{16} unknown1 : longint;
{20} newuser : uid_t; { chown uid_t parameter }
{24} newgroup : gid_t; { chown gid_t parameter }
{28} trunc_offset : off_t; { ftrucnate parameter }
{36} unknown2 : array[1..2] of longint;
{44} utime_param: int64;
{52} unknown3 : array[1..2] of longint;
end;
{ These routines are currently not required for BeOS }
function sys_fork : pid_t;
begin
end;
function sys_execve(const path : pchar; const argv : ppchar; const envp: ppchar): cint;
begin
end;
function sys_waitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t;
begin
end;
function sys_uname(var name: utsname): cint;
begin
FillChar(name, sizeof(utsname), #0);
name.machine := 'BePC'#0;
end;
function S_ISDIR(m : mode_t): boolean;
begin
if (m and S_IFDIR)= S_IFDIR then
S_ISDIR := true
else
S_ISDIR := false;
end;
function S_ISCHR(m : mode_t): boolean;
begin
if (m and S_IFCHR) = S_IFCHR then
S_ISCHR := true
else
S_ISCHR := false;
end;
function S_ISBLK(m : mode_t): boolean;
begin
if (m and S_IFBLK) = S_IFBLK then
S_ISBLK := true
else
S_ISBLK := false;
end;
function S_ISREG(m : mode_t): boolean;
begin
if (m and S_IFREG) = S_IFREG then
S_ISREG := true
else
S_ISREG := false;
end;
function S_ISFIFO(m : mode_t): boolean;
begin
if (m and S_IFIFO) = S_IFIFO then
S_ISFIFO := true
else
S_ISFIFO := false;
end;
function wifexited(status : cint): cint;
begin
wifexited := byte(boolean((status and not $FF) = 0));
end;
function wexitstatus(status : cint): cint;
begin
wexitstatus := status and $FF;
end;
function wstopsig(status : cint): cint;
begin
wstopsig:=(status shr 16) and $FF;
end;
function wifsignaled(status : cint): cint;
begin
if (((status) shr 8) and $ff) <> 0 then
wifsignaled := 1
else
wifsignaled := 0;
end;
{$i syscall.inc}
procedure sys_exit(status : cint); external name 'sys_exit';
(*
procedure sys_exit(status : cint);
var
args: SysCallArgs;
begin
args.param[1] := status;
SysCall(syscall_nr_exit,args);
end;
*)
function sys_close(fd : cint): cint;
var
args : SysCallArgs;
begin
args.param[1] := fd;
sys_close:=SysCall(syscall_nr_close,args);
end;
function sys_time(var tloc:time_t): time_t;
var
args : SysCallArgs;
begin
{ don't treat errno, since there is never any }
tloc := Do_Syscall(syscall_nr_time,args);
sys_time := tloc;
end;
function sys_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint;
var
args : SysCallArgs;
begin
args.param[1] := sig;
args.param[2] := cint(@act);
args.param[3] := cint(@oact);
sys_sigaction := SysCall(syscall_nr_sigaction, args);
end;
function sys_closedir(dirp : pdir): cint;
var
args : SysCallArgs;
begin
if assigned(dirp) then
begin
args.param[1] := dirp^.fd;
sys_closedir := SysCall(syscall_nr_closedir,args);
Dispose(dirp);
dirp := nil;
exit;
end;
Errno := Sys_EBADF;
sys_closedir := -1;
end;
function sys_opendir(const dirname : pchar): pdir;
var
args : SysCallArgs;
dirp: pdir;
fd : cint;
begin
New(dirp);
{ just in case }
FillChar(dirp^,sizeof(dir),#0);
if assigned(dirp) then
begin
args.param[1] := $FFFFFFFF;
args.param[2] := cint(dirname);
args.param[3] := 0;
fd:=SysCall(syscall_nr_opendir,args);
if fd = -1 then
begin
Dispose(dirp);
sys_opendir := nil;
exit;
end;
dirp^.fd := fd;
sys_opendir := dirp;
exit;
end;
Errno := Sys_EMFILE;
sys_opendir := nil;
end;
function sys_access(const pathname : pchar; amode : cint): cint;
var
args : SysCallArgs;
begin
args.param[1] := $FFFFFFFF;
args.param[2] := cint(pathname);
args.param[3] := amode;
sys_access := SysCall(syscall_nr_access,args);
end;
function sys_rename(const old : pchar; const newpath: pchar): cint;
var
args: SysCallArgs;
begin
args.param[1] := $FFFFFFFF;
args.param[2] := cint(old);
args.param[3] := $FFFFFFFF;
args.param[4] := cint(newpath);
sys_rename := SysCall(syscall_nr_rename,args);
end;
function sys_rmdir(const path : pchar): cint;
var
args: SysCallArgs;
begin
args.param[1] := $FFFFFFFF;
args.param[2] := cint(path);
sys_rmdir := SysCall(syscall_nr_rmdir,args);
end;
function sys_unlink(const path: pchar): cint;
var
args :SysCallArgs;
begin
args.param[1] := $FFFFFFFF;
args.param[2] := cint(path);
sys_unlink := SysCall(syscall_nr_unlink,args);
end;
function sys_mkdir(const path : pchar; mode: mode_t):cint;
var
args :SysCallArgs;
begin
args.param[1] := $FFFFFFFF;
args.param[2] := cint(path);
args.param[3] := cint(mode);
sys_mkdir := SysCall(syscall_nr_mkdir,args);
end;
function sys_fstat(fd : cint; var sb : stat): cint;
var
args : SysCallArgs;
begin
args.param[1] := fd;
args.param[2] := $00;
args.param[3] := cint(@sb);
args.param[4] := $00000001;
sys_fstat := SysCall(syscall_nr_fstat, args);
end;
function sys_stat(const path: pchar; var buf : stat): cint;
var
args : SysCallArgs;
begin
args.param[1] := $FFFFFFFF;
args.param[2] := cint(path);
args.param[3] := cint(@buf);
args.param[4] := $01000000;
sys_stat := SysCall(syscall_nr_stat, args);
end;
function sys_read(fd: cint; buf:pchar; nbytes : size_t): ssize_t;
var
args : SysCallArgs;
funcresult: ssize_t;
errorcode : cint;
begin
args.param[1] := fd;
args.param[2] := cint(buf);
args.param[3] := cint(nbytes);
args.param[4] := cint(@errorcode);
funcresult := ssize_t(Do_SysCall(syscall_nr_read,args));
if funcresult >= 0 then
begin
sys_read := funcresult;
errno := 0;
end
else
begin
sys_read := -1;
errno := errorcode;
end;
end;
function sys_write(fd: cint;const buf:pchar; nbytes : size_t): ssize_t;
var
args : SysCallArgs;
funcresult : ssize_t;
errorcode : cint;
begin
args.param[1] := fd;
args.param[2] := cint(buf);
args.param[3] := cint(nbytes);
args.param[4] := cint(@errorcode);
funcresult := Do_SysCall(syscall_nr_write,args);
if funcresult >= 0 then
begin
sys_write := funcresult;
errno := 0;
end
else
begin
sys_write := -1;
errno := errorcode;
end;
end;
function sys_chdir(const path : pchar): cint;
var
args: SysCallArgs;
begin
args.param[1] := $FFFFFFFF;
args.param[2] := cint(path);
sys_chdir := SysCall(syscall_nr_chdir, args);
end;
function sys_open(const path: pchar; flags : cint; mode: mode_t):cint;
var
args: SysCallArgs;
begin
args.param[1] := $FFFFFFFF;
args.param[2] := cint(path);
args.param[3] := flags;
args.param[4] := cint(mode);
args.param[5] := 0; { close on execute flag }
sys_open:= SysCall(syscall_nr_open, args);
end;
function sys_readdir(dirp : pdir) : pdirent;
var
args : SysCallArgs;
funcresult : cint;
begin
args.param[1] := dirp^.fd;
args.param[2] := cint(@(dirp^.ent));
args.param[3] := $0000011C;
args.param[4] := $00000001;
{ the error will be processed here }
funcresult := Do_SysCall(syscall_nr_readdir, args);
if funcresult <> 1 then
begin
if funcresult <> 0 then
errno := funcresult;
sys_readdir := nil;
exit;
end;
errno := 0;
sys_readdir := @dirp^.ent
end;
function sys_lseek(fd : cint; offset : off_t; whence : cint): off_t;
var
args: SysCallArgs;
begin
args.param[1] := fd;
args.param[2] := cint(offset and $FFFFFFFF);
args.param[3] := cint((offset shr 32) and $FFFFFFFF);
args.param[4] := whence;
{ we currently only support seeks upto 32-bit in length }
sys_lseek := off_t(SysCall(syscall_nr_lseek,args));
end;
function sys_ftruncate(fd : cint; flength : off_t): cint;
var
args: SysCallArgs;
wstat : pwstat;
begin
New(wstat);
FillChar(wstat^,sizeof(wstat),0);
wstat^.trunc_offset := flength;
args.param[1] := fd;
args.param[2] := $00000000;
args.param[3] := cint(wstat);
args.param[4] := $00000008;
args.param[5] := $00000001;
sys_ftruncate:=SysCall(syscall_nr_ftruncate, args);
Dispose(wstat);
end;
{
$Log$
Revision 1.2 2003-01-08 22:32:28 marco
* Small fixes and quick merge with 1.0.x. At least the compiler builds now,
but it could crash hard, since there are lots of unimplemented funcs.
Revision 1.1.2.13 2001/12/17 02:14:28 carl
+ wifsignaled() added
Revision 1.1.2.12 2001/12/03 03:11:05 carl
* update for new posix prototype (caused problem with other OS)
Revision 1.1.2.11 2001/08/22 02:38:12 carl
- sys_exit now written in assembler
Revision 1.1.2.10 2001/08/15 01:01:51 carl
- moved SysCall to syscall.inc
Revision 1.1.2.9 2001/08/13 09:40:43 carl
* bugfix of problems of changing signs with errno!
* changed prototype of sys_readdir() to conform to POSIX
Revision 1.1.2.8 2001/08/13 05:57:53 carl
* corrected written/read value returned for sys_read() and sys_write(). errno now correctly set.
Revision 1.1.2.7 2001/08/12 15:15:21 carl
* bugfix of call to sys_time (would always return weird results)
Revision 1.1.2.6 2001/08/09 01:12:46 carl
* fstat() call now correct
+ ftruncate() support
Revision 1.1.2.5 2001/08/08 01:55:43 carl
* bugfix of sys_opendir()
* bugfix of sys_readdir() should be var parameter not const :(
Revision 1.1.2.4 2001/07/14 04:20:33 carl
+ sys_lseek()
+ sys_open()
* bugfix of sys_write()
* bugfix of sys_readdir()
+ started testing
Revision 1.1.2.3 2001/07/13 03:14:55 carl
+ more syscalls (not all verified) working
}

211
rtl/beos/osposixh.inc Normal file
View File

@ -0,0 +1,211 @@
{
$Id$
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 used in POSIX for BeOS
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 = cint; { used for device numbers }
gid_t = cuint; { used for group IDs }
ino_t = int64; { used for file serial numbers }
mode_t = cuint; { used for file attributes }
nlink_t = cint; { used for link counts }
off_t = int64; { used for file sizes }
pid_t = cint; { used as process identifier }
size_t = cint; { as definied in the C standard }
ssize_t = cint; { used by function for returning number of bytes }
uid_t = cuint; { used for user ID type }
time_t = cint; { used for returning the time }
sigset_t = cuint; { used for additional signal }
{***********************************************************************}
{ POSIX STRUCTURES }
{***********************************************************************}
CONST
_UTSNAME_LENGTH = 32;
_UTSNAME_NODENAME_LENGTH = _UTSNAME_LENGTH;
TYPE
{ system information services }
utsname = packed record { don't forget to verify the alignment }
{ Name of this implementation of the operating systems (POSIX) }
sysname : array[0.._UTSNAME_LENGTH+1] of char;
{ Name of this node (POSIX) }
nodename : array[0.._UTSNAME_NODENAME_LENGTH+1] of char;
{ Current release level of this implementation (POSIX) }
release : array[0.._UTSNAME_LENGTH+1] of char;
{ Current version level of this release (POSX) }
version : array[0.._UTSNAME_LENGTH+1] of char;
{ Name of the hardware type on which the system is running (POSIX) }
machine : array[0.._UTSNAME_LENGTH+1] of char;
end;
{ file characteristics services }
stat = packed record { verify the alignment of the members }
st_dev : dev_t; { Device containing the file (POSIX) }
st_ino : ino_t; { File serial number (POSIX) }
st_mode: mode_t; { File mode (POSIX) }
st_nlink: nlink_t; { Link count (POSIX) }
st_uid: uid_t; { User ID of the file's owner. (POSIX)}
st_gid: gid_t; { Group ID of the file's group.(POSIX)}
st_size : off_t; { Size of file, in bytes. (POSIX)}
st_rdev : dev_t; { Device type (not used). }
st_blksize: cardinal;{ Preferred block size for I/O. }
st_atime: time_t; { Time of last access (POSIX) }
st_mtime: time_t; { Time of last modification (POSIX) }
st_ctime: time_t; { Time of last status change (POSIX) }
st_crtime: time_t; { Time of creation }
end;
{ directory services }
pdirent = ^dirent;
dirent = packed record { directory entry record - verify alignment }
d_dev: dev_t;
d_pdev: dev_t;
d_fileno: ino_t;
d_pino: ino_t;
d_reclen:word;
d_name:array[0..255] of char; { Filename in DIRENT (POSIX) }
end;
pdir = ^dir;
dir = packed record
fd : cint; { file descriptor }
ent : dirent; { directory entry }
end;
sighandler_t = procedure (signo: cint); cdecl;
{ signal services }
sigactionrec = packed record
sa_handler : sighandler_t; { pointer to a function (POSIX.1) }
sa_mask : sigset_t; { additional signal masks (POSIX.1) }
sa_flags : cint; { special flags for signals (POSIX.1) }
sa_userdata : pointer;
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 =$0200; { Create file if it doesn't exist. }
O_EXCL =$0100; { Fail if file already exists. }
O_TRUNC =$0400; { Truncate file to zero length. }
O_NOCTTY =$1000; { Don't assign a controlling terminal. }
{ File status flags for `open' and `fcntl'. }
O_APPEND =$0800; { Writes append to the file. }
O_NONBLOCK =$0080; { Non-blocking I/O. }
{ mode_t possible values }
S_IRUSR = $0100; { Read permission for owner }
S_IWUSR = $0080; { Write permission for owner }
S_IXUSR = $0040; { Exec permission for owner }
S_IRGRP = S_IRUSR shr 3; { Read permission for group }
S_IWGRP = S_IWUSR shr 3; { Write permission for group }
S_IXGRP = S_IWUSR shr 3; { Exec permission for group }
S_IROTH = S_IRGRP shr 3; { Read permission for world }
S_IWOTH = S_IWGRP shr 3; { Write permission for world }
S_IXOTH = S_IXGRP shr 3; { Exec permission for world }
{ Used for waitpid }
WNOHANG = 1; { don't block waiting }
WUNTRACED = 2; { report status of stopped children }
{************************ 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 = 7; { Broken pipe signal }
SIGQUIT = 3; { Interactive termination signal }
SIGSEGV = 11; { Detection of invalid memory reference }
SIGTERM = 15; { Termination request }
SIGUSR1 = 18; { Application defined signal 1 }
SIGUSR2 = 19; { Application defined signal 2 }
SIGCHLD = 5; { Child process terminated / stopped }
SIGCONT = 12; { Continue if stopped }
SIGSTOP = 10; { Stop signal. cannot be cuaght }
SIGSTP = 13; { Interactive stop signal }
SIGTTIN = 16; { Background read from TTY }
SIGTTOU = 17; { Background write to TTY }
SIGBUS = SIGSEGV; { Access to undefined memory }
{ POSIX limits }
ARG_MAX = 128*1024; { Maximum number of arguments }
NAME_MAX = 256; { Maximum number of bytes in a filename }
PATH_MAX = 1024; { Maximum number of bytes in a pathname }
{
$Log$
Revision 1.2 2003-01-08 22:32:28 marco
* Small fixes and quick merge with 1.0.x. At least the compiler builds now,
but it could crash hard, since there are lots of unimplemented funcs.
Revision 1.1.2.7 2001/07/21 19:17:11 carl
+ added MAX_ARGS define
Revision 1.1.2.6 2001/07/08 04:45:28 carl
+ updated type definitions
Revision 1.1.2.5 2001/07/07 15:41:42 carl
+ added missing definitions
Revision 1.1.2.4 2001/07/07 04:38:54 carl
+ added missing S_X constants
Revision 1.1.2.3 2001/07/06 12:07:05 carl
* correct definitions
Revision 1.1.2.2 2001/07/06 11:59:35 carl
+ added missing constants
(still missing mode_t bit definitions)
Revision 1.1.2.1 2001/07/06 02:59:56 carl
+ first revision for BeOS
}

94
rtl/beos/posix.pp Normal file
View File

@ -0,0 +1,94 @@
{
$Id$
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);
{ get system specific information }
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_fstat(fd : cint; var sb : stat): cint;
function sys_stat(const path: pchar; var buf : stat): 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_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint;
function sys_ftruncate(fd : cint; flength : off_t): 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
{$i osposix.inc}
end.
{
$Log$
Revision 1.2 2003-01-08 22:32:28 marco
* Small fixes and quick merge with 1.0.x. At least the compiler builds now,
but it could crash hard, since there are lots of unimplemented funcs.
Revision 1.1.2.2 2001/12/17 02:13:52 carl
+ wifsignaled() added
Revision 1.1.2.1 2001/12/05 02:49:14 carl
+ posix unit is now OS specific but with same interface
}

99
rtl/beos/syscall.inc Normal file
View File

@ -0,0 +1,99 @@
{
$Id$
Copyright (c) 1998-2000 by Florian Klaempfl
This include implements the actual system call for the
intel BeOS 80x86 platform.
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.
****************************************************************************
}
type
SysCallArgs = packed record
param: array[1..8] of cint;
End;
procedure sys_call; external name 'sys_call';
function Do_SysCall( callnr:longint;var regs : SysCallArgs ): longint;assembler;
{
This routine sets up the parameters on the stack, all the parameters
are in reverse order on the stack (like C parameter passing).
}
asm
{ load the parameters... }
movl regs,%eax
movl 24(%eax),%ebx
pushl %ebx
movl 20(%eax),%ebx
pushl %ebx
movl 16(%eax),%ebx
pushl %ebx
movl 12(%eax),%ebx
pushl %ebx
movl 8(%eax),%ebx
pushl %ebx
movl 4(%eax),%ebx
pushl %ebx
movl 0(%eax),%ebx
pushl %ebx
{ set the call number }
movl callnr,%eax
call sys_call
addl $28,%esp
end;
Function SysCall( callnr:longint;var args : SysCallArgs ):longint;
{
This function serves as an interface to do_SysCall.
If the SysCall returned a negative number, it returns -1, and puts the
SysCall result in errno. Otherwise, it returns the SysCall return value
}
var
funcresult : longint;
begin
funcresult:=do_SysCall(callnr,args);
if funcresult<0 then
begin
ErrNo:=funcresult;
SysCall:=-1;
end
else
begin
SysCall:=funcresult;
errno:=0
end;
end;
{
$Log$
Revision 1.1 2003-01-08 22:32:28 marco
* Small fixes and quick merge with 1.0.x. At least the compiler builds now,
but it could crash hard, since there are lots of unimplemented funcs.
Revision 1.1.2.2 2001/08/15 01:08:25 carl
* added SysCall(0 routine here as well as argument declarations
Revision 1.1.2.1 2001/07/13 03:16:03 carl
+ static kernel call interface (CPU specific)
}

7
rtl/beos/system.pp
View File

@ -50,6 +50,7 @@ var
argc : longint; argc : longint;
argv : ppchar; argv : ppchar;
envp : ppchar; envp : ppchar;
errno : longint; // MvdV: yuckie
UnusedHandle:longint; UnusedHandle:longint;
StdInputHandle:longint; StdInputHandle:longint;
@ -534,7 +535,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.7 2003-01-05 20:22:24 florian Revision 1.8 2003-01-08 22:32:28 marco
* Small fixes and quick merge with 1.0.x. At least the compiler builds now,
but it could crash hard, since there are lots of unimplemented funcs.
Revision 1.7 2003/01/05 20:22:24 florian
- removed stack check, it's system independend in 1.1 - removed stack check, it's system independend in 1.1
Revision 1.6 2003/01/05 20:06:30 florian Revision 1.6 2003/01/05 20:06:30 florian

443
rtl/beos/timezone.inc Normal file
View File

@ -0,0 +1,443 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 2002 by the Free Pascal development team.
Timezone extraction routines
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
TZ_MAGIC = 'TZif';
type
plongint=^longint;
pbyte=^byte;
ttzhead=packed record
tzh_magic : array[0..3] of char;
tzh_reserved : array[1..16] of byte;
tzh_ttisgmtcnt,
tzh_ttisstdcnt,
tzh_leapcnt,
tzh_timecnt,
tzh_typecnt,
tzh_charcnt : longint;
end;
pttinfo=^tttinfo;
tttinfo=packed record
offset : longint;
isdst : boolean;
idx : byte;
isstd : byte;
isgmt : byte;
end;
pleap=^tleap;
tleap=record
transition : longint;
change : longint;
end;
var
num_transitions,
num_leaps,
num_types : longint;
transitions : plongint;
type_idxs : pbyte;
types : pttinfo;
zone_names : pchar;
leaps : pleap;
function find_transition(timer:time_t):pttinfo;
var
i : longint;
begin
if (num_transitions=0) or (timer<time_t(transitions[0])) then
begin
i:=0;
while (i<num_types) and (types[i].isdst) do
inc(i);
if (i=num_types) then
i:=0;
end
else
begin
for i:=1 to num_transitions do
if (timer<transitions[i]) then
break;
i:=type_idxs[i-1];
end;
find_transition:=@types[i];
end;
procedure GetLocalTimezone(timer:time_t;var leap_correct,leap_hit:longint);
var
info : pttinfo;
i : longint;
begin
{ reset }
TZDaylight:=false;
TZSeconds:=0;
TZName[false]:=nil;
TZName[true]:=nil;
leap_correct:=0;
leap_hit:=0;
{ get info }
info:=find_transition(timer);
if not assigned(info) then
exit;
TZDaylight:=info^.isdst;
TZSeconds:=info^.offset;
i:=0;
while (i<num_types) do
begin
tzname[types[i].isdst]:=@zone_names[types[i].idx];
inc(i);
end;
tzname[info^.isdst]:=@zone_names[info^.idx];
i:=num_leaps;
repeat
if i=0 then
exit;
dec(i);
until (timer>leaps[i].transition);
leap_correct:=leaps[i].change;
if (timer=leaps[i].transition) and
(((i=0) and (leaps[i].change>0)) or
(leaps[i].change>leaps[i-1].change)) then
begin
leap_hit:=1;
while (i>0) and
(leaps[i].transition=leaps[i-1].transition+1) and
(leaps[i].change=leaps[i-1].change+1) do
begin
inc(leap_hit);
dec(i);
end;
end;
end;
procedure GetLocalTimezone(timer:longint);
var
lc,lh : longint;
begin
GetLocalTimezone(timer,lc,lh);
end;
procedure ReadTimezoneFile(fn:string);
procedure decode(var l:longint);
var
k : longint;
p : pbyte;
begin
p:=pbyte(@l);
if (p[0] and (1 shl 7))<>0 then
k:=not 0
else
k:=0;
k:=(k shl 8) or p[0];
k:=(k shl 8) or p[1];
k:=(k shl 8) or p[2];
k:=(k shl 8) or p[3];
l:=k;
end;
var
f : File;
tzdir : string;
tzhead : ttzhead;
i : longint;
chars : longint;
buf : pbyte;
_result : longint;
label lose;
begin
if fn = '' then
exit;
{$IFOPT I+}
{$DEFINE IOCHECK_ON}
{$ENDIF}
{$I-}
Assign(F, fn);
Reset(F,1);
If IOResult <> 0 then
exit;
{$IFDEF IOCHECK_ON}
{$I+}
{$ENDIF}
{$UNDEF IOCHECK_ON}
BlockRead(f,tzhead,sizeof(tzhead),i);
if i<>sizeof(tzhead) then
goto lose;
if tzhead.tzh_magic<>TZ_MAGIC then
begin
goto lose;
end;
decode(tzhead.tzh_timecnt);
decode(tzhead.tzh_typecnt);
decode(tzhead.tzh_charcnt);
decode(tzhead.tzh_leapcnt);
decode(tzhead.tzh_ttisstdcnt);
decode(tzhead.tzh_ttisgmtcnt);
num_transitions:=tzhead.tzh_timecnt;
num_types:=tzhead.tzh_typecnt;
chars:=tzhead.tzh_charcnt;
reallocmem(transitions,num_transitions*sizeof(longint));
reallocmem(type_idxs,num_transitions);
reallocmem(types,num_types*sizeof(tttinfo));
reallocmem(zone_names,chars);
reallocmem(leaps,num_leaps*sizeof(tleap));
BlockRead(f,transitions^,num_transitions*4,_result);
if _result <> num_transitions*4 then
begin
goto lose;
end;
BlockRead(f,type_idxs^,num_transitions,_result);
if _result <> num_transitions then
begin
goto lose;
end;
{* Check for bogus indices in the data file, so we can hereafter
safely use type_idxs[T] as indices into `types' and never crash. *}
for i := 0 to num_transitions-1 do
if (type_idxs[i] >= num_types) then
begin
goto lose;
end;
for i:=0 to num_transitions-1 do
decode(transitions[i]);
for i:=0 to num_types-1 do
begin
blockread(f,types[i].offset,4,_result);
if _result <> 4 then
begin
goto lose;
end;
blockread(f,types[i].isdst,1,_result);
if _result <> 1 then
begin
goto lose;
end;
blockread(f,types[i].idx,1,_result);
if _result <> 1 then
begin
goto lose;
end;
decode(types[i].offset);
types[i].isstd:=0;
types[i].isgmt:=0;
end;
blockread(f,zone_names^,chars,_result);
if _result<>chars then
begin
goto lose;
end;
for i:=0 to num_leaps-1 do
begin
blockread(f,leaps[i].transition,4);
if _result <> 4 then
begin
goto lose;
end;
blockread(f,leaps[i].change,4);
begin
goto lose;
end;
decode(leaps[i].transition);
decode(leaps[i].change);
end;
getmem(buf,tzhead.tzh_ttisstdcnt);
blockread(f,buf^,tzhead.tzh_ttisstdcnt,_result);
if _result<>tzhead.tzh_ttisstdcnt then
begin
goto lose;
end;
for i:=0 to tzhead.tzh_ttisstdcnt-1 do
types[i].isstd:=byte(buf[i]<>0);
freemem(buf);
getmem(buf,tzhead.tzh_ttisgmtcnt);
blockread(f,buf^,tzhead.tzh_ttisgmtcnt);
if _result<>tzhead.tzh_ttisgmtcnt then
begin
goto lose;
end;
for i:=0 to tzhead.tzh_ttisgmtcnt-1 do
types[i].isgmt:=byte(buf[i]<>0);
freemem(buf);
close(f);
exit;
lose:
close(f);
end;
{ help function to extract TZ variable data }
function extractnumberend(tzstr: string; offset : integer): integer;
var
j: integer;
begin
j:=0;
extractnumberend := 0;
repeat
if (offset+j) > length(tzstr) then
begin
exit;
end;
inc(j);
until not (tzstr[offset+j] in ['0'..'9']);
extractnumberend := offset+j;
end;
function getoffsetseconds(tzstr: string): longint;
{ extract GMT timezone information }
{ Returns the number of minutes to }
{ add or subtract to the GMT time }
{ to get the local time. }
{ Format of TZ variable (POSIX) }
{ std offset dst }
{ std = characters of timezone }
{ offset = hh[:mm] to add to GMT }
{ dst = daylight savings time }
{ CURRENTLY DOES NOT TAKE CARE }
{ OF SUMMER TIME DIFFERENCIAL }
var
s: string;
i, j: integer;
code : integer;
hours : longint;
minutes : longint;
negative : boolean;
begin
hours:=0;
minutes:=0;
getoffsetseconds := 0;
negative := FALSE;
i:=-1;
{ get to offset field }
repeat
if i > length(tzstr) then
begin
exit;
end;
inc(i);
until (tzstr[i] = '-') or (tzstr[i] in ['0'..'9']);
if tzstr[i] = '-' then
begin
Inc(i);
negative := TRUE;
end;
j:=extractnumberend(tzstr,i);
s:=copy(tzstr,i,j-i);
val(s,hours,code);
if code <> 0 then
begin
exit;
end;
if tzstr[j] = ':' then
begin
i:=j;
Inc(i);
j:=extractnumberend(tzstr,i);
s:=copy(tzstr,i,j-i);
val(s,minutes,code);
if code <> 0 then
begin
exit;
end;
end;
if negative then
begin
minutes := -minutes;
hours := -hours;
end;
getoffsetseconds := minutes*60 + hours*3600;
end;
procedure InitLocalTime;
var
tloc: time_t;
s : string;
begin
TZSeconds:=0;
{ try to get the POSIX version }
{ of the local time offset }
{ if '', then it does not exist }
{ if ': ..', then non-POSIX }
s:=GetTimezoneString;
if (s<>'') and (s[1]<>':') then
begin
TZSeconds := getoffsetseconds(s);
end
else
begin
s:=GetTimeZoneFile;
{ only read if there is something to read }
if s<>'' then
begin
ReadTimezoneFile(s);
tloc:=sys_time(tloc);
GetLocalTimezone(tloc);
end;
end;
end;
procedure DoneLocalTime;
begin
if assigned(transitions) then
freemem(transitions);
if assigned(type_idxs) then
freemem(type_idxs);
if assigned(types) then
freemem(types);
if assigned(zone_names) then
freemem(zone_names);
if assigned(leaps) then
freemem(leaps);
num_transitions:=0;
num_leaps:=0;
num_types:=0;
end;
{
$Log$
Revision 1.1 2003-01-08 22:32:28 marco
* Small fixes and quick merge with 1.0.x. At least the compiler builds now,
but it could crash hard, since there are lots of unimplemented funcs.
Revision 1.1.2.2 2002/05/01 14:06:13 carl
* bugfix for stricter POSIX checking
+ TZ is now taken from GetTimezoneSitrng instead of getenv
Revision 1.1.2.1 2001/08/12 15:13:50 carl
+ first version of timezone stuff (more checking than the unix version)
}