/*
 * base code for various Tcl extensions
 * Copyright 2006-2012 Ian Jackson
 *
 * 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 library; if not, see <http://www.gnu.org/licenses/>.
 */

#include "chiark-tcl-base.h"

/* Arg parsing */

typedef struct {
  const IdDataSpec *idds;
  int n;
  void **a;
} IdDataAssocData;

typedef struct {
  Tcl_Interp *interp;
  IdDataAssocData *assoc;
  int ix;
} IdDataValue;

static void assoc_del(ClientData assoc_cd, Tcl_Interp *ip) {
  IdDataAssocData *assoc;
  int ix;
  void **p, *v;

  assoc= assoc_cd;
  for (ix=0, p=assoc->a; ix<assoc->n; ix++, p++) {
    v= *p;
    if (!v) continue;
    assert(*(int*)v == ix);
    *(int*)v= -1;
    assoc->idds->destroyitem(ip,v);
    *p= 0;
  }
  TFREE(assoc->a);
  TFREE(assoc);
}

static void setobjdataid(Tcl_Interp *interp, Tcl_Obj *o,
			 int ix, const IdDataSpec *idds) {
  IdDataValue *dv;
  IdDataAssocData *assoc;

  assoc= Tcl_GetAssocData(interp, (char*)idds->assockey, 0);
  if (!assoc) {
    assoc= TALLOC(sizeof(*assoc));
    assoc->idds= idds;
    assoc->n= 0;
    assoc->a= 0;
    Tcl_SetAssocData(interp, (char*)idds->assockey, assoc_del, assoc);
  }
  
  dv= TALLOC(sizeof(*dv));
  dv->interp= interp;
  dv->assoc= assoc;
  dv->ix= ix;
  
  o->typePtr= &cht_tabledataid_nearlytype;
  o->internalRep.otherValuePtr= dv;
}

int cht_tabledataid_parse(Tcl_Interp *ip, Tcl_Obj *o, const IdDataSpec *idds) {
  int l;
  unsigned long ul;
  IdDataValue *dv;
  char *ep, *str;

  if (o->typePtr != &cht_tabledataid_nearlytype) goto convert;

  dv= o->internalRep.otherValuePtr;
  if (dv->interp != ip) goto convert;
  if (dv->assoc->idds != idds) goto convert;

  return TCL_OK;

convert:
  l= strlen(idds->valprefix);
  str= Tcl_GetStringFromObj(o,0);
  if (memcmp(str,idds->valprefix,l))
    return cht_staticerr(ip,"bad id (wrong prefix)",0);

  errno=0; ul=strtoul(str+l,&ep,10);
  if (errno || *ep) return cht_staticerr(ip,"bad id number",0);
  if (ul > INT_MAX) return cht_staticerr(ip,"out of range id number",0);

  cht_objfreeir(o);
  setobjdataid(ip,o,ul,idds);
  return TCL_OK;
}

int cht_pat_iddata(Tcl_Interp *ip, Tcl_Obj *o, void **rv, const IdDataSpec *idds) {
  int rc, ix;
  IdDataValue *dv;
  IdDataAssocData *assoc;
  void *r;
  
  rc= cht_tabledataid_parse(ip,o,idds);
  if (rc) return rc;

  dv= o->internalRep.otherValuePtr;
  ix= dv->ix;
  assoc= dv->assoc;

  if (ix >= assoc->n || !(r= assoc->a[ix]))
    return cht_staticerr(ip,"id not in use",0);

  assert(*(int*)r == ix);

  *rv= r;
  return TCL_OK;
}

Tcl_Obj *cht_ret_iddata(Tcl_Interp *ip, void *val, const IdDataSpec *idds) {
  /* Command procedure implementation may set val->ix,
   * ie *(int*)val, to -1, to mean it's a new struct.  Otherwise
   * it had better be an old one !
   */
  Tcl_Obj *o;
  IdDataValue *dv;
  IdDataAssocData *assoc;
  int ix;

  o= Tcl_NewObj();
  setobjdataid(ip,o,0,idds);
  dv= o->internalRep.otherValuePtr;
  assoc= dv->assoc;

  ix= *(int*)val;
  if (ix==-1) {
    for (ix=0; ix<assoc->n && assoc->a[ix]; ix++);
    if (ix>=assoc->n) {
      assert(assoc->n < INT_MAX/4);
      assoc->n += 2;
      assoc->n *= 2;
      assoc->a= TREALLOC(assoc->a, assoc->n*sizeof(*assoc->a));
      while (ix<assoc->n) assoc->a[ix++]=0;
      ix--;
    }
    assoc->a[ix]= val;
    *(int*)val= ix;
  } else {
    assert(val == assoc->a[ix]);
  }
  dv->ix= ix;
  Tcl_InvalidateStringRep(o);
  return o;
}

void cht_tabledataid_disposing(Tcl_Interp *ip, void *val, const IdDataSpec *idds) {
  IdDataAssocData *assoc;
  int ix;

  ix= *(int*)val;
  if (ix==-1) return;

  assoc= Tcl_GetAssocData(ip, (char*)idds->assockey, 0);
  assert(assoc->a[ix] == val);
  assoc->a[ix]= 0;
  *(int*)val= -1;
}

static int tabledataid_nt_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
  abort();
}

static void tabledataid_nt_free(Tcl_Obj *o) {
  TFREE(o->internalRep.otherValuePtr);
  o->internalRep.otherValuePtr= 0;
}

static void tabledataid_nt_dup(Tcl_Obj *src, Tcl_Obj *dup) {
  IdDataValue *sv, *dv;

  sv= src->internalRep.otherValuePtr;
  dv= TALLOC(sizeof(*dv));
  *dv= *sv;
  dup->typePtr= &cht_tabledataid_nearlytype;
  dup->internalRep.otherValuePtr= dv;
}

static void tabledataid_nt_ustr(Tcl_Obj *o) {
  const IdDataValue *dv;
  const IdDataAssocData *assoc;
  const IdDataSpec *idds;
  char buf[75];

  dv= o->internalRep.otherValuePtr;
  assoc= dv->assoc;
  idds= assoc->idds;

  snprintf(buf,sizeof(buf), "%d", dv->ix);
  cht_obj_updatestr_vstringls(o,
			  idds->valprefix, strlen(idds->valprefix),
			  buf, strlen(buf),
			  (char*)0);
}

Tcl_ObjType cht_tabledataid_nearlytype = {
  "tabledataid",
  tabledataid_nt_free, tabledataid_nt_dup,
  tabledataid_nt_ustr, tabledataid_nt_sfa
};
