several units added. Additions to OS.pp

bepascal/source/bepascal/pas/src/be/kernel/beostypes.inc

@@ -0,0 +1,67 @@
+// Description: BeOS.
+
+// #include <time.h>
+{
+int32	status_t;
+int64	bigtime_t;
+uint32	type_code;
+uint32	perform_code;
+}
+
+type
+// from <types.h> ---------------------------------------------------
+  blkcnt_t = Int64;     // long long
+  blksize_t = Smallint; // int
+  fsblkcnt_t = Int64;   // long long
+  fsfilcnt_t = Int64;   // long long
+  ino_t = Int64;        // long long
+  cnt_t = Smallint;     // int
+  mode_t = Word;        // unsigned int
+  nlink_t = Smallint;   // int
+  dev_t = Longint;      // long
+  off_t = Int64;        // long long
+  pid_t = Longint;      // long
+
+  uid_t = Word;       // unsigned int
+  gid_t = Word;       // unsigned int
+  umode_t = Word;     // unsigned int
+  daddr_t = Smallint; // int
+
+// bsd
+  u_char = Byte;     // unsigned char
+  u_short = Word;    // unsigned short
+  u_int = Smallint;  // unsigned int
+  u_long = Longword; // unsigned long
+
+// sysv
+  unchar = Byte; // unsigned char
+
+  caddr_t = PChar;
+
+// from <size_t.h> --------------------------------------------------
+  size_t = Longword; // unsigned long
+  ssize_t = Longint; // long
+
+
+
+// from <dirent.h> --------------------------------------------------
+
+type
+  dirent = record
+    d_dev,
+    d_pdev : dev_t;
+    d_ino,
+    d_pino : ino_t;
+    d_reclen : Word;
+    d_name : string[2]; // this was: char d_name[1]
+  end;
+
+  DIR = record
+    fd : Smallint;
+    ent : dirent;
+  end;
+
+const
+  MAXNAMLEN = 256;
+
+  MAXPATHLEN = 1024; // From posix limits.h

bepascal/source/bepascal/pas/src/be/kernel/compilerdefs.inc

@@ -0,0 +1,9 @@
+// Here we put defines to the supported features of FPC 1.x and 2.x
+
+{$ifdef FPC}
+  {$ifndef VER1_0}
+    {$define SUPPORTS_DEF_PARAMS}
+    {$define SUPPORTS_INLINE}
+
+  {$endif VER1_0}
+{$endif}

bepascal/source/bepascal/pas/src/be/kernel/fs_attr.pp

@@ -0,0 +1,54 @@
+unit fs_attr;
+
+// Description: Interface to extended file attributes.
+
+interface
+
+uses
+  SupportDefs;
+
+{$I beostypes.inc}
+
+type
+  attr_info = record
+    at_type : Longint; // uint32 type 
+    size    : off_t;   // off_t size
+  end;
+
+// Note: in the following methods, I used: integer (32 bits) = int (?? bits)
+// Please confirm/fix this.
+
+// I also renamed the 'type' parameter to attype (attribute type)
+
+function fs_read_attr(fd : Integer; const attribute : PChar; attype : Longword;
+                      pos : off_t; buf : Pointer; count : size_t)
+         : ssize_t; cdecl; external 'root' name 'fs_read_attr';
+
+function fs_write_attr(fd : Integer; const attribute : PChar; attype : Longword;
+                       pos : off_t; const buf : Pointer; count : size_t)
+         : ssize_t; cdecl; external 'root' name 'fs_write_attr';
+
+function fs_remove_attr(fd : Integer; const attr : PChar) : Integer;
+            cdecl; external 'root' name 'fs_remove_attr';
+
+function fs_open_attr_dir(const path : PChar) : DIR;
+            cdecl; external 'root' name 'fs_open_attr_dir';
+
+function fs_fopen_attr_dir(fd : Integer) : DIR;
+            cdecl; external 'root' name 'fs_fopen_attr_dir';
+
+function fs_close_attr_dir(dirp : DIR) : Integer;
+            cdecl; external 'root' name 'fs_close_attr_dir';
+
+function fs_read_attr_dir(dirp : DIR) : dirent;
+            cdecl; external 'root' name 'fs_read_attr_dir';
+
+procedure fs_rewind_attr_dir(dirp : DIR);
+            cdecl; external 'root' name 'fs_rewind_attr_dir';
+
+function fs_stat_attr(fd : Integer; const name : PChar; ai : attr_info) : Integer;
+            cdecl; external 'root' name 'fs_stat_attr';
+
+implementation
+
+end.

bepascal/source/bepascal/pas/src/be/kernel/fs_query.pp

@@ -0,0 +1,31 @@
+unit fs_query;
+
+// Description: C interface to the BeOS file system query mechanism.
+
+interface
+
+uses
+  OS, SupportDefs;
+
+{$I beostypes.inc}
+
+// flags for fs_open_query()
+const
+  B_LIVE_QUERY = $00000001;
+
+
+function fs_open_query(device : dev_t; const query : PChar; flags : Longword)
+         : DIR; cdecl; external 'root' name 'fs_open_query';
+function fs_open_live_query(device : dev_t; const query : PChar; flags : Longword;
+                            port : port_id; token : Longint)
+         : DIR; cdecl; external 'root' name 'fs_open_live_query';
+
+function fs_close_query(d : DIR) : Smallint; cdecl; external 'root' name 'fs_close_query';
+function fs_read_query(d : DIR) : dirent; cdecl; external 'root' name 'fs_read_query';
+
+function get_path_for_dirent(dent : dirent; buf : PChar; len : size_t)
+         : status_t; cdecl; external 'root' name 'get_path_for_dirent';
+
+implementation
+
+end.

bepascal/source/bepascal/pas/src/be/kernel/image.pp

@@ -0,0 +1,104 @@
+// Description: Kernel interface for managing executable images.
+unit image;
+
+interface
+
+uses
+  OS, SupportDefs;
+
+{$I beostypes.inc}
+
+//----- Image types, info, and functions ------------------
+const
+  B_INIT_BEFORE_FUNCTION_NAME = 'initialize_before';
+  B_INIT_AFTER_FUNCTION_NAME  = 'initialize_after';
+  B_TERM_BEFORE_FUNCTION_NAME = 'terminate_before';
+  B_TERM_AFTER_FUNCTION_NAME  = 'terminate_after';
+
+type
+  image_id = Longint;
+
+  image_type = (filler_blabla,
+    B_APP_IMAGE,
+    B_LIBRARY_IMAGE,
+    B_ADD_ON_IMAGE,
+    B_SYSTEM_IMAGE
+  );
+
+  image_info = record
+    id : image_id;
+    iitype : image_type;        // Renamed type <-> iitype
+    sequence : Longint;
+    init_order : Longint;
+    init_routine : procedure; // ( * init_routine)();
+    term_routine : procedure;
+    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 load_image(argc : Longint; const argv : PPChar; const envp : PPChar)
+         : thread_id; cdecl; external 'root' name 'load_image';
+function load_add_on(const path : PChar) : image_id;
+           cdecl; external 'root' name 'load_add_on';
+function unload_add_on(imid : image_id) : status_t;
+           cdecl; external 'root' name 'unload_add_on';
+
+// private; use the macros, below
+function _get_image_info(image : image_id; info : image_info; size : size_t)
+         : status_t; cdecl; external 'root' name '_get_image_info';
+
+function _get_next_image_info(team : team_id; cookie : Longint; info : image_info; size : size_t)
+         : status_t; cdecl; external 'root' name '_get_next_image_info';
+
+// use these
+function get_image_info(image : image_id; info : image_info) : status_t;
+function get_next_image_info(team : team_id; cookie : Longint;
+                             info : image_info) : status_t;
+
+//----- symbol types and functions ------------------------
+const
+  B_SYMBOL_TYPE_DATA = $1;
+  B_SYMBOL_TYPE_TEXT = $2;
+  B_SYMBOL_TYPE_ANY  = $5;
+
+function get_image_symbol(imid : image_id; const name : PChar; sclass : Longint;
+                          var ptr : Pointer)
+         : status_t; cdecl; external 'root' name 'get_image_symbol';
+
+function get_nth_image_symbol(imid : image_id; index : Longint; buf : PChar;
+                              bufsize : Longint; sclass : Longint;
+                              var ptr : Pointer)
+         : status_t; cdecl; external 'root' name 'get_nth_image_symbol';
+
+//----- 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;
+
+procedure clear_caches(addr : Pointer; len : size_t; flags : Longword);
+            cdecl; external 'root' name 'clear_caches';
+
+//---------------------------------------------------------
+
+implementation
+
+// these were macros
+
+function get_image_info(image : image_id; info : image_info) : status_t;
+begin
+  Result := _get_image_info(image, info, SizeOf(info));
+end;
+
+function get_next_image_info(team : team_id; cookie : Longint; info : image_info) : status_t;
+begin
+  Result := _get_next_image_info(team, cookie, info, SizeOf(info));
+end;
+
+end.

bepascal/source/bepascal/pas/src/be/kernel/os.pp

@@ -1,5 +1,6 @@
-{  BePascal - A pascal wrapper around the BeOS API
+{   BePascal - A pascal wrapper around the BeOS API
-    Copyright (C) 2002 Olivier Coursiere
+    Copyright (C) 2002-2003 Olivier Coursiere
+                            Oscar Lesta
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Library General Public
@@ -16,40 +17,30 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 }
 
-unit os;
+unit OS;
 
 interface
 
 uses
-  SupportDefs;
+  SupportDefs, StorageDefs;
-
-const
-  B_LOW_LATENCY = 5;
-  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;
 
 const
   B_OS_NAME_LENGTH = 32;
   B_PAGE_SIZE = 4096;
 //  B_INFINITE_TIMEOUT = 9223372036854775807; // $7FFFFFFFFFFFFFFF
 
-// workaround because fpc 1.0.* don't support int64 const -> will
+// workaround because fpc 1.0.* doesn't support int64 const -> will
-// be changed in fpc 1.1.
+// be changed in fpc 2.x
 // see initialization section
 var
   B_INFINITE_TIMEOUT : int64;
-  
+
 type
-  Area_id = Longint;
+  area_id   = Longint;
-  Port_id = Longint;
+  port_id   = Longint;
-  Sem_id = Longint;
+  sem_id    = Longint;
-  Thread_id = Longint;
+  thread_id = Longint;
-  Team_id = Longint;
+  team_id   = Longint;
 
 const
   B_NO_LOCK       = 0;
@@ -67,15 +58,15 @@ const
   B_READ_AREA  = 1;
   B_WRITE_AREA = 2;
 
-// area  
+// area
 type
-  Area_Info = record
+  area_info = record
-    area : Area_id;
+    area : area_id;
-    name : array [0..B_OS_NAME_LENGTH] of char;
+    name : array[0..B_OS_NAME_LENGTH - 1] of Char; // we could do string[B_OS_NAME_LENGTH]
-    size : Size_t;
+    size : size_t;
     lock : Cardinal;
     protection : Cardinal;
-    team : Team_id;
+    team : team_id;
     ram_size : Cardinal;
     copy_count : Cardinal;
     in_count : Cardinal;
@@ -83,6 +74,108 @@ type
     address : Pointer;    
   end;
 
+                                         // void **start_addr;
+function create_area(const name : PChar; start_addr : Pointer;
+                     addr_spec : Longword; size : size_t; lock : Longword;
+                     protection : Longword)
+         : area_id; cdecl; external 'root' name 'create_area';
+
+                                        // void **dest_addr;
+function clone_area(const name : PChar; dest_addr : Pointer;
+                    addr_spec : Longword; protection : Longword;
+                    source : area_id)
+         : area_id; cdecl; external 'root' name 'clone_area';
+
+function find_area(const name : PChar) : area_id;
+            cdecl; external 'root' name 'find_area';
+function area_for(addr : Pointer) : area_id;
+            cdecl; external 'root' name 'area_for';
+function delete_area(id : area_id): status_t;
+            cdecl; external 'root' name 'delete_area';
+function resize_area(id : area_id; new_size : size_t) : status_t;
+            cdecl; external 'root' name 'resize_area';
+
+function set_area_protection(id : area_id; new_protection : Longword)
+         : status_t; cdecl; external 'root' name 'set_area_protection';
+
+function get_area_info(id : area_id; var ainfo : area_info) : status_t;
+function get_next_area_info(team : team_id; cookie : Pointer;
+                            var ainfo : area_info) : status_t;
+
+//--------------------------------------------------------------------------
+
+// Ports
+
+type
+  port_info =record
+    port : port_id;
+    team : team_id;
+    name : array[0..B_OS_NAME_LENGTH - 1] of Char; // String[B_OS_NAME_LENGTH] ?
+    capacity : Longint;    // queue depth
+    queue_count : Longint; // # msgs waiting to be read
+    total_count : Longint; // total # msgs read so far
+  end;
+
+function create_port(capacity : Longint; const name : PChar) : port_id;
+            cdecl; external 'root' name 'create_port';
+function find_port(const name : PChar) : port_id;
+            cdecl; external 'root' name 'find_port';
+
+function write_port(port : port_id; code : Longint; const buf : Pointer;
+                    buf_size : size_t)
+         : status_t; cdecl; external 'root' name 'write_port';
+
+function read_port(port : port_id; code : Longint; buf : Pointer;
+                   buf_size : size_t)
+         : status_t; cdecl; external 'root' name 'read_port';
+
+function write_port_etc(port : port_id; code : Longint; const buf : Pointer;
+                        buf_size : size_t; flags : Longword;
+                        timeout : bigtime_t)
+         : status_t; cdecl; external 'root' name 'write_port_etc';
+
+function read_port_etc(port : port_id; var code : Longint; var buf : Pointer;
+                       buf_size : size_t; flags : Longword; timeout : bigtime_t)
+         : status_t; cdecl; external 'root' name 'read_port_etc';
+
+function port_buffer_size(port : port_id) : ssize_t;
+            cdecl; external 'root' name 'port_buffer_size';
+
+function port_buffer_size_etc(port : port_id; flags : Longword;
+                              timeout : bigtime_t)
+         : ssize_t; cdecl; external 'root' name 'port_buffer_size_etc';
+
+function port_count(port : port_id) : ssize_t;
+            cdecl; external 'root' name 'port_count';
+
+function set_port_owner(port : port_id; team : team_id)
+         : status_t; cdecl; external 'root' name 'set_port_owner';
+
+function close_port(port : port_id) : status_t;
+             cdecl; external 'root' name 'close_port';
+
+function delete_port(port : port_id) : status_t;
+             cdecl; external 'root' name 'delete_port';
+
+
+// These were macros.
+function get_port_info(port : port_id; info : port_info) : status_t;
+function get_next_port_info(team : team_id; var cookie : Pointer; var info : port_info) : status_t;
+
+//--------------------------------------------------------------------------
+
+
+const
+  B_LOW_LATENCY = 5;
+  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;
+  
+
 // Semaphores
 type
   Sem_Info = record
@@ -97,7 +190,48 @@ implementation
 
 uses
   SysUtils;
-  
+
+
+// --- These were macros ---
+
+function _get_area_info(id : area_id; var ainfo : area_info; size : size_t)
+         : status_t; cdecl; external 'root' name '_get_area_info';
+
+// int32 * == Pointer ?
+function _get_next_area_info(team : team_id; cookie : Pointer;
+                             var ainfo : area_info; size : size_t)
+         : status_t; cdecl; external 'root' name '_get_next_area_info';
+
+function get_area_info(id : area_id; var ainfo : area_info) : status_t;
+begin
+  Result := _get_area_info(id, ainfo, SizeOf(ainfo));
+end;
+
+function get_next_area_info(team : team_id; cookie : Pointer; var ainfo : area_info) : status_t;
+begin
+  Result := _get_next_area_info(team, cookie, ainfo, SizeOf(ainfo));
+end;
+
+// --- ^^ These were macros ^^ ---
+
+function _get_port_info(port : port_id; var info : port_info; size : size_t)
+         : status_t; cdecl; external 'root' name '_get_port_info';
+function _get_next_port_info(team : team_id; var cookie : Pointer;
+                             var info : port_info; size : size_t)
+         : status_t; cdecl; external 'root' name '_get_next_port_info';
+
+function get_port_info(port : port_id; info : port_info) : status_t;
+begin
+  Result := _get_port_info(port, info, SizeOf(info));
+end;
+
+function get_next_port_info(team : team_id; var cookie : Pointer;
+                            var info : port_info) : status_t;
+begin
+  Result := _get_next_port_info(team, cookie, info, SizeOf(info));
+end;
+
+
 initialization
 // workaround because fpc 1.0.* don't support int64 const -> will
 // be changed in fpc 1.1.

bepascal/source/bepascal/pas/src/be/kernel/scheduler.pp

@@ -0,0 +1,59 @@
+unit scheduler;
+
+// Description: Scheduling inquiry functions
+
+interface
+
+{$I compilerdefs.inc}
+
+uses
+  OS, SupportDefs;
+{
+  To get a good thread priority, call suggest_thread_priority() with the
+  following information:
+  'what' is a bit mask describing what you're doing in the thread.
+  'period' is how many times a second your thread needs to run (-1 if you're
+           running continuously.)
+  'jitter' is an estimate (in us) of how much that period can vary, as long as
+           it stays centered on the average.
+  'length' is how long (in us) you expect to run for each invocation.
+  "invocation" means, typically, receiving a message, dispatching it, and then
+               returning to reading a message.
+
+  MANIPULATION means both filtering and compression/decompression.
+  PLAYBACK and RECORDING means threads feeding/reading ACTUAL HARDWARE ONLY.
+  0 means don't care
+}
+
+// enum be_task_flags {};
+const
+  // bitmasks for "what"
+  B_DEFAULT_MEDIA_PRIORITY  = 0;
+  B_OFFLINE_PROCESSING      = $1;
+  B_STATUS_RENDERING        = $2;   // can also use this for "preview" type things
+  B_USER_INPUT_HANDLING     = $4;
+  B_LIVE_VIDEO_MANIPULATION = $8;   // non-live processing is OFFLINE_PROCESSING
+  B_VIDEO_PLAYBACK          = $10;  // feeding hardware
+  B_VIDEO_RECORDING         = $20;  // grabbing from hardware
+  B_LIVE_AUDIO_MANIPULATION = $40;  // non-live processing is OFFLINE_PROCESSING
+  B_AUDIO_PLAYBACK          = $80;  // feeding hardware
+  B_AUDIO_RECORDING         = $100; // grabbing from hardware
+  B_LIVE_3D_RENDERING       = $200; // non-live rendering is OFFLINE_PROCESSING
+  B_NUMBER_CRUNCHING        = $400;
+  B_MIDI_PROCESSING         = $800;
+
+
+function suggest_thread_priority(
+            task_flags : Longword{$ifdef SUPPORTS_DEF_PARMS} = B_DEFAULT_MEDIA_PRIORITY{$endif};
+            period     : Longint{$ifdef SUPPORTS_DEF_PARMS} = 0{$endif};
+            jitter     : bigtime_t{$ifdef SUPPORTS_DEF_PARMS} = 0{$endif};
+            length     : bigtime_t{$ifdef SUPPORTS_DEF_PARMS} = 0{$endif})
+         : Longint; cdecl; external 'root' name 'suggest_thread_priority';
+
+// default is current thread
+function estimate_max_scheduling_latency(th : thread_id{$ifdef SUPPORTS_DEF_PARMS} = -1{$endif})
+         : bigtime_t; cdecl; external 'root' name 'estimate_max_scheduling_latency';
+
+implementation
+
+end.