* 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.

rtl/beos/Makefile

@@ -225,7 +225,7 @@ override FPCOPT+=-Ur
 endif
 OBJPASDIR=$(RTL)/objpas
 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_RSTS+=math varutils typinfo
 override INSTALL_FPCPACKAGE=y

rtl/beos/Makefile.fpc

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

rtl/beos/beos.inc

@@ -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)
+
+
+}

rtl/beos/dos.inc

@@ -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
+
+}

rtl/beos/errno.inc

@@ -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
+
+}

rtl/beos/osposix.inc

@@ -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
+
+}

rtl/beos/osposixh.inc

@@ -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
+
+}

rtl/beos/posix.pp

@@ -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
+
+
+}

rtl/beos/syscall.inc

@@ -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)
+
+}

rtl/beos/system.pp

@@ -50,6 +50,7 @@ var
   argc : longint;
   argv : ppchar;
   envp : ppchar;
+  errno : longint;		// MvdV: yuckie
 
   UnusedHandle:longint;
   StdInputHandle:longint;
@@ -534,7 +535,11 @@ begin
 end.
 {
   $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
 
   Revision 1.6  2003/01/05 20:06:30  florian

rtl/beos/timezone.inc

@@ -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)
+
+}