unit kern_namedobj;

{$mode ObjFPC}{$H+}
{$CALLING SysV_ABI_CDecl}

interface

uses
 mqueue,
 kern_named_id;

type
 p_namedobj=^t_namedobj;
 t_namedobj=packed object(t_id_named_desc)
  link:TAILQ_ENTRY;
  objp:Pointer;
 end;

var
 named_table:t_id_desc_table;

procedure named_table_init; //SYSINIT

function  get_obj_name(objp:Pointer;objt:Integer;name:PChar):Boolean;

function  sys_namedobj_create(name:PChar;objp:Pointer;objt:Integer):Integer;
function  sys_namedobj_delete(id,objt:Integer):Integer;

const
 NAMED_OBJT=$1000;
 NAMED_DYNL=$2000;

implementation

uses
 errno,
 systm,
 kern_thr,
 kern_rwlock;

var
 namedobj_list:TAILQ_HEAD=(tqh_first:nil;tqh_last:@namedobj_list.tqh_first);
 namedobj_lock:Pointer;

procedure named_table_init;
begin
 id_table_init(@named_table,1);
end;

procedure namedobj_add(data:p_namedobj);
begin
 rw_wlock(namedobj_lock);
 TAILQ_INSERT_TAIL(@namedobj_list,data,@data^.link);
 rw_wunlock(namedobj_lock);
end;

procedure namedobj_rem(data:p_namedobj);
begin
 rw_wlock(namedobj_lock);
 TAILQ_REMOVE(@namedobj_list,data,@data^.link);
 rw_wunlock(namedobj_lock);
end;

procedure namedobj_free(data:pointer);
begin
 namedobj_rem(data);
 FreeMem(data);
end;

function get_obj_name(objp:Pointer;objt:Integer;name:PChar):Boolean;
var
 entry:p_namedobj;
begin
 Result:=False;
 objt:=Word(objt) or NAMED_OBJT;

 rw_rlock(namedobj_lock);

 entry:=TAILQ_FIRST(@namedobj_list);
 while (entry<>nil) do
 begin
  if (entry^.objp=objp) and
     (entry^.objt=objt) then
  begin
   Result:=True;

   copystr(entry^.name,name,SizeOf(entry^.name),nil);

   Break;
  end;

  entry:=TAILQ_NEXT(entry,@entry^.link);
 end;

 rw_runlock(namedobj_lock);
end;

function sys_namedobj_create(name:PChar;objp:Pointer;objt:Integer):Integer;
var
 td:p_kthread;
 _name:t_id_name;
 obj:p_namedobj;
 key:Integer;
begin
 if (name=nil) then Exit(EINVAL);

 td:=curkthread;
 if (td=nil) then Exit(-1);

 _name:=Default(t_id_name);

 Result:=copyinstr(name,@_name,SizeOf(t_id_name),nil);
 if (Result<>0) then Exit;

 obj:=AllocMem(SizeOf(t_namedobj));
 if (obj=nil) then Exit(ENOMEM);

 obj^.desc.free:=@namedobj_free;
 obj^.objt:=Word(objt) or NAMED_OBJT;
 obj^.name:=_name;
 obj^.objp:=objp;

 namedobj_add(obj);

 key:=0;
 if not id_name_new(@named_table,obj,@key) then
 begin
  namedobj_free(obj);
  Exit(EAGAIN);
 end;

 id_release(obj);

 td^.td_retval[0]:=key;

 Writeln('namedobj_create("',_name,'",0x',HexStr(QWORD(objp),11),',0x',HexStr(objt,4),'):',key);

 Result:=0;
end;

function sys_namedobj_delete(id,objt:Integer):Integer;
var
 obj:p_namedobj;
begin
 Result:=ESRCH;

 if not id_name_del(@named_table,id,Word(objt) or NAMED_OBJT,@obj) then Exit;

 id_release(obj);

 Result:=0;
end;



end.

