Patch title: Release 85 bulk changes
Abstract:
File: /pliant/language/data/entry.c
Key:
    Removed line
    Added line
// Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
//
// This program is free software; you can redistribute it and/or
// modify it under the terms of the GNU General Public License version 2
// as published by the Free Software Foundation.
// 
// 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
// version 2 along with this program; if not, write to the Free Software
// Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

/*
abstract
  text "Here we are dealing with Pliant objects"
doc
  text "An object is a data of any type, with a header that points to it's type and a reference count.[lf]"
  text "The reference count is used in order to automatically free the object when it' not used any more.[lf]"
  text "The type is used in order to call the right destroy function, and also in order to support generic functions: when you call a generic function, it will get the address of the exact function to be called through a table in the type, and the type is pointed by a field in the object header. "
  text "It means that you cannot call a generic function on a variable which is not an object. A local variable is not an object: it has no header. Anything allocated with 'new' is an object: is has a header."
*/

INLINE Void entry_record(struct EntryHeader *h,struct Type *t) {
  h->type=t;
  h->counter=0;
  #ifdef _CHECK_
    h->signature=entry_signature;
    G.entry_lock_hook();
    h->previous=G.entry_last;
    h->next=null;
    if(G.entry_last!=null) G.entry_last->next=h; else G.entry_first=h;
    G.entry_last=h;
    if(t!=null) t->objects_counter++;
    G.entry_unlock_hook();
  #endif
  }


INLINE Void entry_unrecord(struct EntryHeader *h) {
  #ifdef _CHECK_
    check(h->signature==entry_signature); h->signature=~entry_signature;
    G.entry_lock_hook();
    check(h->next==null || h->next->previous==h);
    check(h->previous==null || h->previous->next==h);
    if(h->next!=null) h->next->previous=h->previous; else G.entry_last=h->previous;
    if(h->previous!=null) h->previous->next=h->next; else G.entry_first=h->next;
    h->type->objects_counter--;
    G.entry_unlock_hook();
  #endif
  }


/*****************************************************************************/


INLINE struct EntryHeader *entry_header(Arrow object) {
  return (struct EntryHeader *)object-1; }


/*
doc
  text "Extract informations from the object header."
*/

FUNCTION struct Type *entry_type(Arrow object) {
  #ifdef _CHECK_
    entry_check(object,"get type");
  #endif
  return entry_header(object)->type; }


FUNCTION Int entry_counter(Arrow object) {
  #ifdef _CHECK_
    entry_check(object,"get reference count");
  #endif
  return entry_header(object)->counter; }


/*****************************************************************************/

/*
doc
  text "Creating a new object.[lf]"
  text "'entry_new1' is only for the very early startup stage where the type of the object may not exist yet.[lf]"
  text "'entry_new' is the standard one used by Pliant 'new' function.[lf]"
  text "'entry_new2' is for creating an object with an extended header (named object used to implement database features in the PDEE).[lf]"
*/

FUNCTION Arrow entry_new1(struct Type *type,Int size,Void (*build)(Address object)) {
  struct EntryHeader *h;
  h=(struct EntryHeader *)memory_allocate(sizeof(struct EntryHeader)+size,null);
  #ifdef _MARK_OBJECTS_
    ((Int *)h)[-1]|=chunk_is_object;
  #endif
  entry_record(h,type);
  if(build!=null) build((Address)(h+1));
  return (Arrow)(h+1); }

FUNCTION Arrow entry_new(struct Type *type) {
  Address c; struct EntryHeader *h;
  #ifdef _CHECK_
    if(Type_is_corrupted(type)) {
      error_notify_fatalz(error_id_corrupted,"Attempted to build on object with an invalid type");
      return null; }
  #endif
  h=(struct EntryHeader *)memory_allocate(sizeof(struct EntryHeader)+type->size,null);
  #ifdef _MARK_OBJECTS_
    ((Int *)h)[-1]|=chunk_is_object;
  #endif
  entry_record(h,type);
  Type_build_instance(type,(Address)(h+1));
  return (Arrow)(h+1); }


#ifdef _CHECK_
  FUNCTION Void entry_check(Arrow object,Char *operation) {
    struct EntryHeader *h; Char *trouble;
    trouble=null;
    if(object==null) 
      trouble=" at null address";
    eif((uInt)object<4096) 
      trouble=" at a very low address";
    h=(struct EntryHeader *)object-1;
    if(trouble!=null) ;
    eif(h->signature==entry_signature) ;
    eif(h->signature==~entry_signature)
      trouble=" an already freed object";
    eif(h->signature!=entry_signature)
      trouble=" an invalid object"; 
    if(trouble!=null) ;
    eif(Type_is_corrupted(h->type) && G.execution_phase==phase_run)
      trouble=" an object with corrupted type"; 
  if(trouble!=null) {
    consolen(Z,"Attempted to ",Z,operation,Z,trouble,EOL);
    error_notify_fatalz(error_id_corrupted,"Reference count violation"); } }
#endif


/*****************************************************************************/

/*
doc
  text "Incrementing and decrementing the references count of an object.[lf]"
*/

FUNCTION Void entry_lockz(Arrow object) {
  if(object!=null) entry_lock(object); }

FUNCTION Void entry_lock(Arrow object) {
  #ifdef _CHECK_
    entry_check(object,"lock");
  #endif
  atomic_increment(&entry_header(object)->counter); }


FUNCTION Void entry_unlockz(Arrow object) {
  if(object!=null) entry_unlock(object); }

FUNCTION Void entry_unlock(Arrow object) {
  struct EntryHeader *h;
  #ifdef _CHECK_
    entry_check(object,"unlock");
  #endif
  if(atomic_decrement_and_test_zero(&entry_header(object)->counter)) {
    h=entry_header(object);
    Type_destroy_instance(h->type,object);
    entry_unrecord(h);
    memory_free(h); } }


/*****************************************************************************/

/*
doc
  text "Specify that the object is a root one: a root object will never be freed."
*/

FUNCTION Void entry_root(Arrow object) {
  #ifdef _CHECK_
    List_append(&G.entry_roots,object);
  #else
    entry_lock(object);
  #endif
  }


/*****************************************************************************/

/*
doc
  text "These functions are used to build objects using C code (mainly in " ; link "startup.c" "../startup/startup.c#init" ; text ")."
*/


FUNCTION Arrow entry(struct Type *type, ...) {
  Arrow r;
  va_list arguments; Int i; struct TypeField *f;
  struct Str temp;
  r=entry_new(type);
  va_start(arguments,type);
  if(type==G.type_Int || type==G.type_CBool) {
    *(Int *)r=va_arg(arguments,Int);
  orif(type==G.type_Str || type==G.type_Ident)
    string_Str(va_arg(arguments,Char *),(struct Str *)r);
  orif(type==G.type_Address || type_is_pointer(type))
    *(Address *)r=va_arg(arguments,Address);
  orif(type==G.type_Void)
  other
    for(i=0; i<type->nb_field; i++) {
      f=type->fields+i;
      if(f->type==G.type_Int || f->type==G.type_CBool) {
        *(Int *)address_translate(r,f->offset)=va_arg(arguments,Int);
      orif(f->type==G.type_Str)
        string_Str(va_arg(arguments,Char *),(struct Str *)address_translate(r,f->offset));
      orif(f->type==G.type_Address || type_is_pointer(f->type))
        *(Address *)address_translate(r,f->offset)=va_arg(arguments,Address);
      orif(f->type==G.type_Arrow || type_is_link(f->type))
        Arrow_set((Arrow *)address_translate(r,f->offset),va_arg(arguments,Arrow));
      other
        error_notify_fatalz(error_id_unexpected,"Unsupported type passed to entry function"); } } }
  if(va_arg(arguments,Address)!=END)
    error_notify_fatalz(error_id_unexpected,"Bad arguments list passed to entry function");
  va_end(arguments);
  return r; }


FUNCTION Address C_map(Char *name,struct Module *module,Arrow object,Int access) {
  struct GlobalVariable *gv; struct Str temp;
  gv=(struct GlobalVariable *)entry_new(G.type_GlobalVariable);
  Arrow_set(&gv->variable,object);
  gv->access=access;
  Dictionary_insert2(G.general_dictionary,Str_map_string(&temp,name),true,gv,module);
  return object; }


FUNCTION Address C_constant(Char *name,struct Module *module,Arrow object) {
  struct Str temp;
  Dictionary_insert2(G.general_dictionary,Str_map_string(&temp,name),true,object,module);
  return object; }