* obsolete files

git-svn-id: trunk@7440 -

.gitattributes

@@ -4370,12 +4370,8 @@ rtl/atari/system.pas svneol=native#text/plain
 rtl/beos/Makefile svneol=native#text/plain
 rtl/beos/Makefile.fpc svneol=native#text/plain
 rtl/beos/baseunix.pp svneol=native#text/plain
-rtl/beos/beos.inc svneol=native#text/plain
-rtl/beos/beos.pp svneol=native#text/plain
 rtl/beos/bethreads.pp svneol=native#text/plain
 rtl/beos/classes.pp svneol=native#text/plain
-rtl/beos/dos.pp svneol=native#text/plain
-rtl/beos/dos_beos.inc svneol=native#text/plain
 rtl/beos/errno.inc svneol=native#text/plain
 rtl/beos/errnostr.inc svneol=native#text/plain
 rtl/beos/i386/cprt0.as -text
@@ -4383,13 +4379,10 @@ rtl/beos/i386/dllprt.as -text
 rtl/beos/i386/dllprt.cpp -text
 rtl/beos/i386/func.as -text
 rtl/beos/i386/prt0.as -text
-rtl/beos/objinc.inc svneol=native#text/plain
 rtl/beos/osmacro.inc svneol=native#text/plain
-rtl/beos/osposix.inc svneol=native#text/plain
 rtl/beos/osposixh.inc svneol=native#text/plain
 rtl/beos/ossysc.inc svneol=native#text/plain
 rtl/beos/ostypes.inc svneol=native#text/plain
-rtl/beos/posix.pp svneol=native#text/plain
 rtl/beos/ptypes.inc svneol=native#text/plain
 rtl/beos/settimeo.inc svneol=native#text/plain
 rtl/beos/signal.inc svneol=native#text/plain
@@ -4399,17 +4392,14 @@ rtl/beos/syscallh.inc svneol=native#text/plain
 rtl/beos/sysconst.inc svneol=native#text/plain
 rtl/beos/sysdir.inc svneol=native#text/plain
 rtl/beos/sysfile.inc svneol=native#text/plain
-rtl/beos/sysfiles.inc svneol=native#text/plain
 rtl/beos/sysheap.inc svneol=native#text/plain
 rtl/beos/sysnr.inc svneol=native#text/plain
 rtl/beos/sysos.inc svneol=native#text/plain
 rtl/beos/sysosh.inc svneol=native#text/plain
 rtl/beos/system.pp svneol=native#text/plain
-rtl/beos/sysutils.pp svneol=native#text/plain
 rtl/beos/termio.pp svneol=native#text/plain
 rtl/beos/termios.inc svneol=native#text/plain
 rtl/beos/termiosproc.inc svneol=native#text/plain
-rtl/beos/timezone.inc svneol=native#text/plain
 rtl/beos/tthread.inc svneol=native#text/plain
 rtl/beos/unixsock.inc svneol=native#text/plain
 rtl/beos/unxconst.inc svneol=native#text/plain

rtl/beos/beos.inc

@@ -1,543 +0,0 @@
-{
-    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);
-}
-
-
-{*****************************************************************}
-
-
-
-
-
-
-
-

rtl/beos/beos.pp

@@ -1,384 +0,0 @@
-unit beos;
-
-interface
-
-type
-    Stat = packed record
-      dev:longint;     {"device" that this file resides on}
-      ino:int64;       {this file's inode #, unique per device}
-      mode:dword;      {mode bits (rwx for user, group, etc)}
-      nlink:longint;   {number of hard links to this file}
-      uid:dword;       {user id of the owner of this file}
-      gid:dword;       {group id of the owner of this file}
-      size:int64;      {size of this file (in bytes)}
-      rdev:longint;    {device type (not used)}
-      blksize:longint; {preferref block size for i/o}
-      atime:longint;   {last access time}
-      mtime:longint;   {last modification time}
-      ctime:longint;   {last change time, not creation time}
-      crtime:longint;  {creation time}
-    end;
-    PStat=^Stat;
-    TStat=Stat;
-
-                ComStr  = String[255];
-                  PathStr = String[255];
-                    DirStr  = String[255];
-                      NameStr = String[255];
-        ExtStr  = String[255];
-
-function FStat(Path:String;Var Info:stat):Boolean;
-function FStat(var f:File;Var Info:stat):Boolean;
-function GetEnv(P: string): pchar;
-
-function  FExpand(Const Path: PathStr):PathStr;
-function  FSearch(const path:pathstr;dirlist:string):pathstr;
-procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
-function  Dirname(Const path:pathstr):pathstr;
-function  Basename(Const path:pathstr;Const suf:pathstr):pathstr;
-function  FNMatch(const Pattern,Name:string):Boolean;
-{function  StringToPPChar(Var S:STring):ppchar;}
-
-function PExists(path:string):boolean;
-function FExists(path:string):boolean;
-
-Function Shell(const Command:String):Longint;
-
-implementation
-
-uses strings;
-
-{$i filerec.inc}
-{$i textrec.inc}
-
-function sys_stat (a:cardinal;path:pchar;info:pstat;n:longint):longint; cdecl; external name 'sys_stat';
-
-function FStat(Path:String;Var Info:stat):Boolean;
-{
-  Get all information on a file, and return it in Info.
-}
-var tmp:string;
-var p:pchar;
-begin
-  tmp:=path+#0;
-  p:=@tmp[1];
-  FStat:=(sys_stat($FF000000,p,@Info,0)=0);
-end;
-
-function FStat(var f:File;Var Info:stat):Boolean;
-{
-  Get all information on a file, and return it in Info.
-}
-begin
-  FStat:=(sys_stat($FF000000,PChar(@FileRec(f).Name),@Info,0)=0);
-end;
-
-
-
-Function GetEnv(P:string):Pchar;
-{
-  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;
-Begin
-  p:=p+'=';            {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 strlcomp(@p[1],(ep^),length(p))=0 then
-         found:=true
-        else
-         inc(ep);
-      end;
-   end;
-  if found then
-   getenv:=ep^+length(p)
-  else
-   getenv:=nil;
-{  writeln ('GETENV (',P,') =',getenv);}
-end;
-
-
-
-Function StringToPPChar(Var S:String; Var nr:longint):ppchar;
-{
-  Create a PPChar to structure of pchars which are the arguments specified
-  in the string S. Especially usefull for creating an ArgV for Exec-calls
-}
-var
-  Buf : ^char;
-  p   : ppchar;
-begin
-  s:=s+#0;
-  buf:=@s[1];
-  nr:=0;
-  while(buf^<>#0) do
-   begin
-     while (buf^ in [' ',#8,#10]) do
-      inc(buf);
-     inc(nr);
-     while not (buf^ in [' ',#0,#8,#10]) do
-      inc(buf);
-   end;
-  getmem(p,nr*4);
-  StringToPPChar:=p;
-  if p=nil then
-   begin
-{     LinuxError:=sys_enomem;}
-     exit;
-   end;
-  buf:=@s[1];
-  while (buf^<>#0) do
-   begin
-     while (buf^ in [' ',#8,#10]) do
-      begin
-        buf^:=#0;
-        inc(buf);
-      end;
-     p^:=buf;
-     inc(p);
-     p^:=nil;
-     while not (buf^ in [' ',#0,#8,#10]) do
-      inc(buf);
-   end;
-end;
-
-
-
-{
-function FExpand (const Path: PathStr): PathStr;
-- declared in fexpand.inc
-}
-
-{$DEFINE FPC_FEXPAND_TILDE} { Tilde is expanded to home }
-{$DEFINE FPC_FEXPAND_GETENVPCHAR} { GetEnv result is a PChar }
-
-{$I fexpand.inc}
-
-{$UNDEF FPC_FEXPAND_GETENVPCHAR}
-{$UNDEF FPC_FEXPAND_TILDE}
-
-
-
-Function FSearch(const path:pathstr;dirlist:string):pathstr;
-{
-  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 : PathStr;
-  p1     : Longint;
-  Info   : Stat;
-Begin
-{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
-   FSearch:='' {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);
-       if FStat(NewDir,Info) 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);
-     FSearch:=NewDir;
-   End;
-End;
-
-
-
-Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
-Var
-  DotPos,SlashPos,i : longint;
-Begin
-  SlashPos:=0;
-  DotPos:=256;
-  i:=Length(Path);
-  While (i>0) and (SlashPos=0) Do
-   Begin
-     If (DotPos=256) and (Path[i]='.') Then
-      DotPos:=i;
-     If (Path[i]='/') Then
-      SlashPos:=i;
-     Dec(i);
-   End;
-  Ext:=Copy(Path,DotPos,255);
-  Dir:=Copy(Path,1,SlashPos);
-  Name:=Copy(Path,SlashPos + 1,DotPos - SlashPos - 1);
-End;
-
-
-
-Function Dirname(Const path:pathstr):pathstr;
-{
-  This function returns the directory part of a complete path.
-  Unless the directory is root '/', The last character is not
-  a slash.
-}
-var
-  Dir  : PathStr;
-  Name : NameStr;
-  Ext  : ExtStr;
-begin
-  FSplit(Path,Dir,Name,Ext);
-  if length(Dir)>1 then
-   Delete(Dir,length(Dir),1);
-  DirName:=Dir;
-end;
-
-
-
-Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
-{
-  This function returns the filename part of a complete path. If suf is
-  supplied, it is cut off the filename.
-}
-var
-  Dir  : PathStr;
-  Name : NameStr;
-  Ext  : ExtStr;
-begin
-  FSplit(Path,Dir,Name,Ext);
-  if Suf<>Ext then
-   Name:=Name+Ext;
-  BaseName:=Name;
-end;
-
-
-
-Function FNMatch(const Pattern,Name:string):Boolean;
-Var
-  LenPat,LenName : longint;
-
-  Function DoFNMatch(i,j:longint):Boolean;
-  Var
-    Found : boolean;
-  Begin
-  Found:=true;
-  While Found and (i<=LenPat) Do
-   Begin
-     Case Pattern[i] of
-      '?' : Found:=(j<=LenName);
-      '*' : Begin
-            {find the next character in pattern, different of ? and *}
-              while Found and (i<LenPat) do
-                begin
-                inc(i);
-                case Pattern[i] of
-                  '*' : ;
-                  '?' : begin
-                          inc(j);
-                          Found:=(j<=LenName);
-                        end;
-                else
-                  Found:=false;
-                end;
-               end;
-            {Now, find in name the character which i points to, if the * or ?
-             wasn't the last character in the pattern, else, use up all the
-             chars in name}
-              Found:=true;
-              if (i<=LenPat) then
-                begin
-                repeat
-                {find a letter (not only first !) which maches pattern[i]}
-                while (j<=LenName) and (name[j]<>pattern[i]) do
-                  inc (j);
-                 if (j<LenName) then
-                  begin
-                    if DoFnMatch(i+1,j+1) then
-                     begin
-                       i:=LenPat;
-                       j:=LenName;{we can stop}
-                       Found:=true;
-                     end
-                    else
-                     inc(j);{We didn't find one, need to look further}
-                  end;
-               until (j>=LenName);
-                end
-              else
-                j:=LenName;{we can stop}
-            end;
-     else {not a wildcard character in pattern}
-       Found:=(j<=LenName) and (pattern[i]=name[j]);
-     end;
-     inc(i);
-     inc(j);
-   end;
-  DoFnMatch:=Found and (j>LenName);
-  end;
-
-Begin {start FNMatch}
-  LenPat:=Length(Pattern);
-  LenName:=Length(Name);
-  FNMatch:=DoFNMatch(1,1);
-End;
-
-
-function PExists(path:string):boolean;
-begin
-  PExists:=FExists(path);
-end;
-
-function FExists(path:string):boolean;
-var
-    info:stat;
-begin
-  FExists:=Fstat(path,info);
-end;
-
-function sys_load_image(a:cardinal; argp:ppchar; envp:ppchar):longint; cdecl; external name 'sys_load_image';
-function sys_wait_for_thread (th:longint; var exitcode:longint):longint; cdecl; external name 'sys_wait_for_thread';
-
-Function Shell(const Command:String):Longint;
-var s:string;
-    argv:ppchar;
-    argc:longint;
-    th:longint;
-begin
-  s:=Command;
-  argv:=StringToPPChar(s,argc);
-  th:=0;
-{  writeln ('argc = ',argc);
-  while argv[th]<>Nil do begin
-    writeln ('argv[',th,'] = ',argv[th]);
-    th:=th+1;
-  end;
-}
-  th:=sys_load_image(argc,argv,system.envp);
-  if th<0 then begin
-    shell:=0;
-    exit;
-  end;
-  sys_wait_for_thread(th,Shell);
-end;
-
-
-
-end.

rtl/beos/dos.pp

@@ -1,820 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 2001 by members of the Free Pascal
-    development team
-
-    DOS unit template based on POSIX
-
-    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 Dos;
-
-Interface
-
-{$goto on}
-
-Const
-  FileNameLen = 255;
-
-Type
-  SearchRec = packed Record
-  {Fill : array[1..21] of byte;  Fill replaced with below}
-    DirPtr     : pointer;        {directory pointer for reading directory}
-    SearchAttr : Byte;        {attribute we are searching for}
-    Fill       : Array[1..16] of Byte; {future use}
-  {End of fill}
-    Attr       : Byte;        {attribute of found file}
-    Time       : LongInt;     {last modify date of found file}
-    Size       : LongInt;     {file size of found file}
-    Reserved   : Word;        {future use}
-    Name       : String[FileNameLen]; {name of found file}
-    SearchSpec : String[FileNameLen]; {search pattern}
-    SearchDir  : String[FileNameLen]; { path we are searching in }
-  End;
-
-{$DEFINE HAS_FILENAMELEN}
-{$I dosh.inc}
-
-Procedure AddDisk(const path:string);
-
-Implementation
-
-Uses
-  strings,posix;
-
-(* Potentially needed FPC_FEXPAND_* defines should be defined here. *)
-{$I dos.inc}
-
-  { Used by AddDisk(), DiskFree() and DiskSize() }
-const
-  Drives   : byte = 4;
-  MAX_DRIVES = 26;
-var
-  DriveStr : array[4..MAX_DRIVES] of pchar;
-
-
-Function StringToPPChar(Var S:STring; var count : longint):ppchar;
-{
-  Create a PPChar to structure of pchars which are the arguments specified
-  in the string S. Especially usefull for creating an ArgV for Exec-calls
-}
-var
-  nr  : longint;
-  Buf : ^char;
-  p   : ppchar;
-begin
-  s:=s+#0;
-  buf:=@s[1];
-  nr:=0;
-  while(buf^<>#0) do
-   begin
-     while (buf^ in [' ',#8,#10]) do
-      inc(buf);
-     inc(nr);
-     while not (buf^ in [' ',#0,#8,#10]) do
-      inc(buf);
-   end;
-  getmem(p,nr*4);
-  StringToPPChar:=p;
-  if p=nil then
-   begin
-     Errno:=sys_enomem;
-     count := 0;
-     exit;
-   end;
-  buf:=@s[1];
-  while (buf^<>#0) do
-   begin
-     while (buf^ in [' ',#8,#10]) do
-      begin
-        buf^:=#0;
-        inc(buf);
-      end;
-     p^:=buf;
-     inc(p);
-     p^:=nil;
-     while not (buf^ in [' ',#0,#8,#10]) do
-      inc(buf);
-   end;
-   count := nr;
-end;
-
-
-{$i dos_beos.inc}    { include OS specific stuff }
-
-
-
-
-{******************************************************************************
-                        --- Info / Date / Time ---
-******************************************************************************}
-var
-  TZSeconds : longint;   { offset to add/ subtract from Epoch to get local time }
-  tzdaylight : boolean;
-  tzname     : array[boolean] of pchar;
-
-
-type
-  GTRec = packed Record
-    Year,
-    Month,
-    MDay,
-    WDay,
-    Hour,
-    Minute,
-    Second : Word;
-  End;
-Const
-{Date Calculation}
-  C1970 = 2440588;
-  D0    = 1461;
-  D1    = 146097;
-  D2    = 1721119;
-
-
-function WeekDay (y,m,d:longint):longint;
-{
-  Calculates th day of the week. returns -1 on error
-}
-var
-  u,v : longint;
-begin
-  if (m<1) or (m>12) or (y<1600) or (y>4000) or
-     (d<1) or (d>30+((m+ord(m>7)) and 1)-ord(m=2)) or
-     ((m*d=58) and (((y mod 4>0) or (y mod 100=0)) and (y mod 400>0))) then
-   WeekDay:=-1
-  else
-   begin
-     u:=m;
-     v:=y;
-     if m<3 then
-      begin
-        inc(u,12);
-        dec(v);
-      end;
-     WeekDay:=(d+2*u+((3*(u+1)) div 5)+v+(v div 4)-(v div 100)+(v div 400)+1) mod 7;
-   end;
-end;
-
-
-
-
-Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
-Var
-  YYear,XYear,Temp,TempMonth : LongInt;
-Begin
-  Temp:=((JulianDN-D2) shl 2)-1;
-  JulianDN:=Temp Div D1;
-  XYear:=(Temp Mod D1) or 3;
-  YYear:=(XYear Div D0);
-  Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
-  Day:=((Temp Mod 153)+5) Div 5;
-  TempMonth:=Temp Div 153;
-  If TempMonth>=10 Then
-   Begin
-     inc(YYear);
-     dec(TempMonth,12);
-   End;
-  inc(TempMonth,3);
-  Month := TempMonth;
-  Year:=YYear+(JulianDN*100);
-end;
-
-
-
-Procedure EpochToLocal(epoch:time_t;var year,month,day,hour,minute,second:Word);
-{
-  Transforms Epoch time into local time (hour, minute,seconds)
-}
-Var
-  DateNum: time_t;
-Begin
-  Epoch:=Epoch+TZSeconds;
-  Datenum:=(Epoch Div 86400) + c1970;
-  JulianToGregorian(DateNum,Year,Month,day);
-  Epoch:=Abs(Epoch Mod 86400);
-  Hour:=Epoch Div 3600;
-  Epoch:=Epoch Mod 3600;
-  Minute:=Epoch Div 60;
-  Second:=Epoch Mod 60;
-End;
-
-
-
-Procedure GetDate(Var Year, Month, MDay, WDay: Word);
-var
-  hour,minute,second : word;
-  timeval : time_t;
-Begin
-  timeval := sys_time(timeval);
-  { convert the GMT time to local time }
-  EpochToLocal(timeval,year,month,mday,hour,minute,second);
-  Wday:=weekday(Year,Month,MDay);
-end;
-
-
-
-Procedure SetDate(Year, Month, Day: Word);
-Begin
-  {!!}
-End;
-
-
-
-
-Procedure GetTime(Var Hour, Minute, Second, Sec100: Word);
-var
- timeval : time_t;
- year,month,day: word;
-Begin
-  timeval := sys_time(timeval);
-  EpochToLocal(timeval,year,month,day,hour,minute,second);
-  Sec100 := 0;
-end;
-
-
-
-Procedure SetTime(Hour, Minute, Second, Sec100: Word);
-Begin
-  {!!}
-End;
-
-
-Procedure UnixDateToDt(SecsPast: LongInt; Var Dt: DateTime);
-Begin
-  EpochToLocal(SecsPast,dt.Year,dt.Month,dt.Day,dt.Hour,dt.Min,dt.Sec);
-End;
-
-
-{$ifndef DOS_HAS_EXEC}
-{******************************************************************************
-                               --- Exec ---
-******************************************************************************}
-
-Function  InternalWaitProcess(Pid:pid_t):Longint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
-var     r,s     : cint;
-begin
-  repeat
-    s:=$7F00;
-    r:=sys_WaitPid(Pid,s,0);
-  until (r<>-1) or (Errno<>Sys_EINTR);
-  { When r = -1 or r = 0, no status is available, so there was an error. }
-  if (r=-1) or (r=0) then
-    InternalWaitProcess:=-1 { return -1 to indicate an error }
-  else
-   begin
-     { process terminated normally }
-     if wifexited(s)<>0 then
-       begin
-         { get status code }
-         InternalWaitProcess := wexitstatus(s);
-         exit;
-       end;
-     { process terminated due to a signal }
-     if wifsignaled(s)<>0 then
-       begin
-         { get signal number }
-         InternalWaitProcess := wstopsig(s);
-         exit;
-       end;
-     InternalWaitProcess:=-1;
-   end;
-end;
-
-
-
-
-Procedure Exec (Const Path: PathStr; Const ComLine: ComStr);
-var
-  pid    : pid_t;
-  tmp : string;
-  p : ppchar;
-  count: longint;
-  // The Error-Checking in the previous Version failed, since halt($7F) gives an WaitPid-status of $7F00
-  F: File;
-Begin
-{$IFOPT I+}
-{$DEFINE IOCHECK}
-{$ENDIF}
-{$I-}
-  { verify if the file to execute exists }
-  Assign(F,Path);
-  Reset(F,1);
-  if IOResult <> 0 then
-    { file not found }
-    begin
-      DosError := 2;
-      exit;
-    end
-  else
-    Close(F);
-{$IFDEF IOCHECK}
-{$I+}
-{$UNDEF IOCHECK}
-{$ENDIF}
-  LastDosExitCode:=0;
-  { Fork the process }
-  pid:=sys_Fork;
-  if pid=0 then
-   begin
-   {The child does the actual execution, and then exits}
-    tmp := Path+' '+ComLine;
-    p:=StringToPPChar(tmp,count);
-    if (p<>nil) and (p^<>nil) then
-    begin
-      sys_Execve(p^,p,Envp);
-    end;
-   {If the execve fails, we return an exitvalue of 127, to let it be known}
-     sys_exit(127);
-   end
-  else
-   if pid=-1 then         {Fork failed - parent only}
-    begin
-      DosError:=8;
-      exit
-    end;
-{We're in the parent, let's wait.}
-  LastDosExitCode:=InternalWaitProcess(pid); // WaitPid and result-convert
-  if (LastDosExitCode>=0) and (LastDosExitCode<>127) then DosError:=0 else
-     DosError:=8; // perhaps one time give an better error
-End;
-{$ENDIF}
-
-
-{******************************************************************************
-                               --- Disk ---
-******************************************************************************}
-
-
-Procedure AddDisk(const path:string);
-begin
-  if not (DriveStr[Drives]=nil) then
-   FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1);
-  GetMem(DriveStr[Drives],length(Path)+1);
-  StrPCopy(DriveStr[Drives],path);
-  inc(Drives);
-  if Drives>26 then
-   Drives:=4;
-end;
-
-
-{******************************************************************************
-                       --- Findfirst FindNext ---
-******************************************************************************}
-
-
-Function FNMatch(const Pattern,Name:string):Boolean;
-Var
-  LenPat,LenName : longint;
-
-  Function DoFNMatch(i,j:longint):Boolean;
-  Var
-    Found : boolean;
-  Begin
-  Found:=true;
-  While Found and (i<=LenPat) Do
-   Begin
-     Case Pattern[i] of
-      '?' : Found:=(j<=LenName);
-      '*' : Begin
-            {find the next character in pattern, different of ? and *}
-              while Found and (i<LenPat) do
-                begin
-                inc(i);
-                case Pattern[i] of
-                  '*' : ;
-                  '?' : begin
-                          inc(j);
-                          Found:=(j<=LenName);
-                        end;
-                else
-                  Found:=false;
-                end;
-               end;
-            {Now, find in name the character which i points to, if the * or ?
-             wasn't the last character in the pattern, else, use up all the
-             chars in name}
-              Found:=true;
-              if (i<=LenPat) then
-                begin
-                repeat
-                {find a letter (not only first !) which maches pattern[i]}
-                while (j<=LenName) and (name[j]<>pattern[i]) do
-                  inc (j);
-                 if (j<LenName) then
-                  begin
-                    if DoFnMatch(i+1,j+1) then
-                     begin
-                       i:=LenPat;
-                       j:=LenName;{we can stop}
-                       Found:=true;
-                     end
-                    else
-                     inc(j);{We didn't find one, need to look further}
-                  end;
-               until (j>=LenName);
-                end
-              else
-                j:=LenName;{we can stop}
-            end;
-     else {not a wildcard character in pattern}
-       Found:=(j<=LenName) and (pattern[i]=name[j]);
-     end;
-     inc(i);
-     inc(j);
-   end;
-  DoFnMatch:=Found and (j>LenName);
-  end;
-
-Begin {start FNMatch}
-  LenPat:=Length(Pattern);
-  LenName:=Length(Name);
-  FNMatch:=DoFNMatch(1,1);
-End;
-
-
-Procedure FindClose(Var f: SearchRec);
-{
-  Closes dirptr if it is open
-}
-Begin
-  { could already have been closed }
-  if assigned(f.dirptr) then
-     sys_closedir(pdir(f.dirptr));
-  f.dirptr := nil;
-End;
-
-
-{ Returns a filled in searchRec structure }
-{ and TRUE if the specified file in s is  }
-{ found.                                  }
-Function FindGetFileInfo(s:string;var f:SearchRec):boolean;
-var
-  DT   : DateTime;
-  st   : stat;
-  Fmode : byte;
-  res: string;    { overlaid variable }
-  Dir : DirsTr;
-  Name : NameStr;
-  Ext: ExtStr;
-begin
-  FindGetFileInfo:=false;
-  res := s + #0;
-  if sys_stat(@res[1],st)<>0 then
-   exit;
-  if S_ISDIR(st.st_mode) then
-   fmode:=directory
-  else
-   fmode:=0;
-  if (st.st_mode and S_IWUSR)=0 then
-   fmode:=fmode or readonly;
-  FSplit(s,Dir,Name,Ext);
-  if Name[1]='.' then
-   fmode:=fmode or hidden;
-  If ((FMode and Not(f.searchattr))=0) Then
-   Begin
-     if Ext <> '' then
-       res := Name + Ext
-     else
-       res := Name;
-     f.Name:=res;
-     f.Attr:=FMode;
-     f.Size:=longint(st.st_size);
-     UnixDateToDT(st.st_mtime, DT);
-     PackTime(DT,f.Time);
-     FindGetFileInfo:=true;
-   End;
-end;
-
-
-Procedure FindNext(Var f: SearchRec);
-{
-  re-opens dir if not already in array and calls FindWorkProc
-}
-Var
-  FName,
-  SName    : string;
-  Found,
-  Finished : boolean;
-  p        : PDirEnt;
-Begin
-{Main loop}
-  SName:=f.SearchSpec;
-  Found:=False;
-  Finished:=(f.dirptr=nil);
-  While Not Finished Do
-   Begin
-     p:=sys_readdir(pdir(f.dirptr));
-     if p=nil then
-     begin
-      FName:=''
-     end
-     else
-      FName:=Strpas(@p^.d_name);
-     If FName='' Then
-      Finished:=True
-     Else
-      Begin
-        If FNMatch(SName,FName) Then
-         Begin
-           Found:=FindGetFileInfo(f.SearchDir+FName,f);
-           if Found then
-           begin
-            Finished:=true;
-           end;
-         End;
-      End;
-   End;
-{Shutdown}
-  If Found Then
-   Begin
-     DosError:=0;
-   End
-  Else
-   Begin
-     FindClose(f);
-     { FindClose() might be called thereafter also... }
-     f.dirptr := nil;
-     DosError:=18;
-   End;
-End;
-
-
-Procedure FindFirst(Const Path: PathStr; Attr: Word; Var f: SearchRec);
-{
-  opens dir
-}
-var
- res: string;
-  Dir : DirsTr;
-  Name : NameStr;
-  Ext: ExtStr;
-Begin
-  { initialize f.dirptr because it is used    }
-  { to see if we need to close the dir stream }
-  f.dirptr := nil;
-  if Path='' then
-   begin
-     DosError:=3;
-     exit;
-   end;
-  {We always also search for readonly and archive, regardless of Attr:}
-  f.SearchAttr := Attr or archive or readonly;
-{Wildcards?}
-  if (Pos('?',Path)=0)  and (Pos('*',Path)=0) then
-   begin
-     if FindGetFileInfo(Path,f) then
-      DosError:=0
-     else
-      begin
-        if ErrNo=Sys_ENOENT then
-         DosError:=3
-        else
-         DosError:=18;
-      end;
-     f.DirPtr:=nil;
-   end
-  else
-{Find Entry}
-   begin
-     FSplit(Path,Dir,Name,Ext);
-     if Ext <> '' then
-       res := Name + Ext
-     else
-       res := Name;
-     f.SearchSpec := res;
-     { if dir is an empty string }
-     { then this indicates that  }
-     { use the current working   }
-     { directory.                }
-     if dir = '' then
-        dir := './';
-     f.SearchDir := Dir;
-     { add terminating null character }
-     Dir := Dir + #0;
-     f.dirptr := sys_opendir(@Dir[1]);
-     if not assigned(f.dirptr) then
-     begin
-        DosError := 8;
-        exit;
-     end;
-     FindNext(f);
-   end;
-End;
-
-
-{******************************************************************************
-                               --- File ---
-******************************************************************************}
-
-
-Function FSearch(const path:pathstr;dirlist:string):pathstr;
-{
-  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 : PathStr;
-  p1     : Longint;
-  Info   : Stat;
-  buffer : array[0..FileNameLen+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
-    FSearch:=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
-   FSearch:='' {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);
-     FSearch:=NewDir;
-   End;
-End;
-
-
-
-Procedure GetFAttr(var f; var attr : word);
-Var
-  info : stat;
-  LinAttr : mode_t;
-Begin
-  DosError:=0;
-  if sys_stat(@textrec(f).name,info)<>0 then
-   begin
-     Attr:=0;
-     DosError:=3;
-     exit;
-   end
-  else
-   LinAttr:=Info.st_Mode;
-  if S_ISDIR(LinAttr) then
-   Attr:=directory
-  else
-   Attr:=0;
-  if sys_Access(@textrec(f).name,W_OK)<>0 then
-   Attr:=Attr or readonly;
-  if (filerec(f).name[0]='.')  then
-   Attr:=Attr or hidden;
-end;
-
-
-
-Procedure getftime (var f; var time : longint);
-Var
-  Info: stat;
-  DT: DateTime;
-Begin
-  doserror:=0;
-  if sys_fstat(filerec(f).handle,info)<>0 then
-   begin
-     Time:=0;
-     doserror:=3;
-     exit
-   end
-  else
-   UnixDateToDT(Info.st_mtime,DT);
-  PackTime(DT,Time);
-End;
-
-
-
-{******************************************************************************
-                             --- Environment ---
-******************************************************************************}
-
-Function EnvCount: Longint;
-var
-  envcnt : longint;
-  p      : ppchar;
-Begin
-  envcnt:=0;
-  p:=envp;      {defined in syslinux}
-  while (p^<>nil) do
-   begin
-     inc(envcnt);
-     inc(p);
-   end;
-  EnvCount := envcnt
-End;
-
-
-
-Function EnvStr (Index: longint): String;
-Var
-  i : longint;
-  p : ppchar;
-Begin
-  p:=envp;      {defined in syslinux}
-  i:=1;
-  envstr:='';
-  if (index < 1) or (index > EnvCount) then
-    exit;
-  while (i<Index) and (p^<>nil) do
-   begin
-     inc(i);
-     inc(p);
-   end;
-  if p<>nil then
-   envstr:=strpas(p^)
-End;
-
-
-Function GetEnv(EnvVar:string):string;
-{
-  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 strlcomp(@EnvVar[1],(ep^),length(EnvVar))=0 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;
-
-
-
-Procedure setftime(var f; time : longint);
-Begin
-  {! No POSIX equivalent !}
-End;
-
-
-
-Procedure setfattr (var f;attr : word);
-Begin
-  {! No POSIX equivalent !}
-End;
-
-
-
-{ Include timezone routines }
-{$i timezone.inc}
-
-{******************************************************************************
-                            --- Initialization ---
-******************************************************************************}
-
-Initialization
-  InitLocalTime;
-
-finalization
-  DoneLocalTime;
-end.

rtl/beos/dos_beos.inc

@@ -1,143 +0,0 @@
-{
-    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 ---
-******************************************************************************}
-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 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;
-
-

rtl/beos/objinc.inc

@@ -1,96 +0,0 @@
-{ For linux we 'steal' the following from system unit, this way
-  we don't need to change the system unit interface. }
-
-Var errno : Longint;
-
-{$i sysnr.inc}
-{$i errno.inc}
-{$i sysconst.inc}
-{$i systypes.inc}
-{$i syscalls.inc}
-
-FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle;
-
-Var LinuxMode : longint;
-
-BEGIN
-  LinuxMode:=0;
-  if Mode=stCreate then
-  Begin
-     LinuxMode:=Open_Creat;
-     LinuxMode:=LinuxMode or Open_RdWr;
-  end
-  else
-   Begin
-     Case (Mode and 3) of
-      0 : LinuxMode:=LinuxMode or Open_RdOnly;
-      1 : LinuxMode:=LinuxMode or Open_WrOnly;
-      2 : LinuxMode:=LinuxMode or Open_RdWr;
-     end;
-   end;
-  FileOpen:=SYS_Open (pchar(@FileName[0]),LinuxMode,438 {666 octal});
-  If FileOpen=-1 then FileOpen:=0;
-  DosStreamError:=Errno;
-END;
-
-FUNCTION FileRead (Handle: THandle; Var BufferArea; BufferLength: Sw_Word;
-Var BytesMoved: Sw_Word): Word;
-BEGIN
-  BytesMoved:=Sys_read (Handle,Pchar(@BufferArea),BufferLength);
-  DosStreamError:=Errno;
-  FileRead:=Errno;
-END;
-
-FUNCTION FileWrite (Handle:  THandle; Var BufferArea; BufferLength: Sw_Word;
-Var BytesMoved: Sw_Word): Word;
-BEGIN
-  BytesMoved:=Sys_Write (Handle,Pchar(@BufferArea),BufferLength);
-  FileWrite:=Errno;
-  DosStreamError:=Errno;
-END;
-
-FUNCTION SetFilePos (Handle: THandle; Pos: LongInt; MoveType: Word;
-VAR NewPos: LongInt): Word;
-
-BEGIN
-  NewPos:=Sys_LSeek (Handle,Pos,MoveType);
-  SetFilePos:=Errno;
-END;
-
-FUNCTION FileClose (Handle: THandle): Word;
-BEGIN
-  Sys_Close (Handle);
-  DosStreamError:=Errno;
-  FileClose := Errno;
-END;
-
-FUNCTION SetFileSize (Handle: THandle; FileSize: LongInt): Word;
-
-{$IFNDEF BSD}
-Var sr : syscallregs;
-{$ENDIF}
-{$IFDEF DOSSETFILE1}
-    Actual, Buf: LongInt;
-{$ENDIF}
-
-BEGIN
- {$IFDEF BSD}
-  Do_Syscall(Syscall_Nr_ftruncate,handle,filesize,0); {0 -> offset =64 bit}
- {$ELSE}
-  sr.reg2:=Handle;
-  sr.reg3:=FileSize;
-  Syscall(syscall_nr_fTruncate,sr);
- {$ENDIF}
-  If Errno=0 then
-    SetFileSize:=0
-  else
-    SetFileSize:=103;
-{$IFDEF DOSSETFILE1}
-   If (Actual = FileSize) Then Begin                  { No position error }
-     Actual := FileWrite(Handle, Pointer(@Buf), 0,Actual);   { Truncate the file }
-     If (Actual <> -1) Then SetFileSize := 0 Else     { No truncate error }
-       SetFileSize := 103;                            { File truncate error }
-   End Else SetFileSize := 103;                       { File truncate error }
-{$ENDIF}
-END;
-

rtl/beos/osposix.inc

@@ -1,463 +0,0 @@
-{
-    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;
-
-{
-
-
-  Revision 1.3  2005/02/14 17:13:21  peter
-    * truncate log
-
-}

rtl/beos/posix.pp

@@ -1,78 +0,0 @@
-{
-    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.

rtl/beos/sysfiles.inc

@@ -1,18 +0,0 @@
-
-const O_RDONLY=0;
-const O_WRONLY=1;
-const O_RDWR=2;
-const O_CREAT = $200;
-const O_TRUNC = $400;
-const O_APPEND = $800;
-{const O_TEXT = $4000;
-const O_BINARY = $8000;}
-
-
-function sys_open (a:cardinal;name:pchar;access:longint;b:longint;c:longint):longint; cdecl; external name 'sys_open';
-function sys_close (handle:longint):longint; cdecl; external name 'sys_close';
-function sys_read (handle:longint;buffer:pointer;len:longint;var a:longint):longint; cdecl; external name 'sys_read';
-function sys_write (handle:longint;buffer:pointer;len:longint;var a:longint):longint; cdecl; external name 'sys_write';
-function sys_lseek (handle:longint;pos:int64;whence:longint): int64; cdecl; external name 'sys_lseek';
-
-

rtl/beos/sysutils.pp

@@ -1,325 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by Florian Klaempfl
-    member of the Free Pascal development team
-
-    Sysutils unit 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.
-
- **********************************************************************}
-unit sysutils;
-interface
-
-{$MODE objfpc}
-{ force ansistrings }
-{$H+}
-
-uses
-  beos,
-  dos;
-
-{ Include platform independent interface part }
-{$i sysutilh.inc}
-
-
-implementation
-
-  uses
-    sysconst;
-
-(* Potentially needed FPC_FEXPAND_* defines should be defined here. *)
-
-{ Include platform independent implementation part }
-{$i sysutils.inc}
-
-
-{****************************************************************************
-                              File Functions
-****************************************************************************}
-
-Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
-BEGIN
-end;
-
-
-Function FileCreate (Const FileName : String) : longint;
-begin
-end;
-
-Function FileCreate (Const FileName : String;Mode:longint) : longint;
-begin
-end;
-
-
-Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
-begin
-end;
-
-
-Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
-begin
-end;
-
-
-Function FileSeek (Handle,FOffset,Origin : longint) : longint;
-begin
-end;
-
-Function FileSeek (Handle:longint;FOffset: Int64; Origin: Longint) : int64;
-begin
-end;
-
-
-Procedure FileClose (Handle : Longint);
-begin
-end;
-
-
-Function FileTruncate (Handle: longint;Size: Int64) : boolean;
-begin
-end;
-
-
-Function FileAge (Const FileName : String): Longint;
-begin
-end;
-
-
-Function FileExists (Const FileName : String) : Boolean;
-begin
-end;
-
-
-Function FindFirst (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
-begin
-end;
-
-
-Function FindNext (Var Rslt : TSearchRec) : Longint;
-begin
-end;
-
-
-Procedure FindClose (Var F : TSearchrec);
-begin
-end;
-
-
-Function FileGetDate (Handle : Longint) : Longint;
-begin
-end;
-
-
-Function FileSetDate (Handle,Age : Longint) : Longint;
-begin
-end;
-
-
-Function FileGetAttr (Const FileName : String) : Longint;
-begin
-end;
-
-
-Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
-begin
-end;
-
-
-Function DeleteFile (Const FileName : String) : Boolean;
-begin
-end;
-
-
-Function RenameFile (Const OldName, NewName : String) : Boolean;
-begin
-end;
-
-{****************************************************************************
-                              Disk Functions
-****************************************************************************}
-
-Function DiskFree(Drive: Byte): int64;
-Begin
-End;
-
-
-
-Function DiskSize(Drive: Byte): int64;
-Begin
-End;
-
-
-Function GetCurrentDir : String;
-begin
-  GetDir(0,Result);
-end;
-
-
-Function SetCurrentDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-   ChDir(NewDir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
-Function CreateDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-   MkDir(NewDir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
-Function RemoveDir (Const Dir : String) : Boolean;
-begin
-  {$I-}
-   RmDir(Dir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
-function DirectoryExists (const Directory: string): boolean;
-begin
-end;
-
-
-{****************************************************************************
-                              Misc Functions
-****************************************************************************}
-
-procedure Beep;
-begin
-end;
-
-
-{****************************************************************************
-                              Locale Functions
-****************************************************************************}
-
-Procedure GetLocalTime(var SystemTime: TSystemTime);
-begin
-end ;
-
-
-Procedure InitAnsi;
-Var
-  i : longint;
-begin
-  {  Fill table entries 0 to 127  }
-  for i := 0 to 96 do
-    UpperCaseTable[i] := chr(i);
-  for i := 97 to 122 do
-    UpperCaseTable[i] := chr(i - 32);
-  for i := 123 to 191 do
-    UpperCaseTable[i] := chr(i);
-  Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
-
-  for i := 0 to 64 do
-    LowerCaseTable[i] := chr(i);
-  for i := 65 to 90 do
-    LowerCaseTable[i] := chr(i + 32);
-  for i := 91 to 191 do
-    LowerCaseTable[i] := chr(i);
-  Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
-end;
-
-
-Procedure InitInternational;
-begin
-  InitInternationalGeneric;
-  InitAnsi;
-end;
-
-function SysErrorMessage(ErrorCode: Integer): String;
-
-begin
-  Str(Errorcode,Result);
-  Result:='Error '+Result;
-end;
-
-{****************************************************************************
-                              OS utility functions
-****************************************************************************}
-
-Function GetEnvironmentVariable(Const EnvVar : String) : String;
-
-begin
-  Result:=StrPas(beos.Getenv(PChar(EnvVar)));
-end;
-
-Function GetEnvironmentVariableCount : Integer;
-
-begin
-  // Result:=FPCCountEnvVar(EnvP);
-  Result:=0;
-end;
-
-Function GetEnvironmentString(Index : Integer) : String;
-
-begin
-  // Result:=FPCGetEnvStrFromP(Envp,Index);
-  Result:='';
-end;
-
-
-function ExecuteProcess (const Path: AnsiString; const ComLine: AnsiString):
-                                                                       integer;
-
-var
-  CommandLine: AnsiString;
-
-begin
-  { always surround the name of the application by quotes
-    so that long filenames will always be accepted. But don't
-    do it if there are already double quotes!
-  }
-  if pos('"',path)=0 then
-    CommandLine:='"'+path+'"'
-  else
-    CommandLine:=path;
-  if ComLine <> '' then
-   CommandLine := Commandline + ' ' + ComLine;
-  ExecuteProcess := beos.shell (CommandLine);
-end;
-
-
-function ExecuteProcess (const Path: AnsiString;
-                                  const ComLine: array of AnsiString): integer;
-
-{$WARNING Should be probably changed according to the Unix version}
-var
-  CommandLine: AnsiString;
-  I: integer;
-
-begin
-  Commandline := '';
-  for I := 0 to High (ComLine) do
-   if Pos (' ', ComLine [I]) <> 0 then
-    CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
-   else
-    CommandLine := CommandLine + ' ' + Comline [I];
-  ExecuteProcess := ExecuteProcess (Path, CommandLine);
-end;
-
-
-
-{****************************************************************************
-                              Initialization code
-****************************************************************************}
-
-Initialization
-  InitExceptions;       { Initialize exceptions. OS independent }
-  InitInternational;    { Initialize internationalization settings }
-Finalization
-  DoneExceptions;
-end.

rtl/beos/timezone.inc

@@ -1,428 +0,0 @@
-{
-    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;
-
-
-