--- /dev/null
+/*
+ */
+
+#include <string.h>
+
+#include "tables.h"
+#include "hbytes.h"
+
+typedef struct {
+ Byte *start; /* byl bytes */
+ Tcl_Obj *data; /* may be 0 to mean empty */
+} AddrMap_Entry;
+
+struct AddrMap_Value {
+ int byl, used, space;
+ AddrMap_Entry *entries;
+ /* Entries are sorted by start. Each entry gives value (or lack of
+ * it) for all A st START <= A < NEXT-START. Last entry has value
+ * (or lack of it) for all A >= START. First entry is always
+ * present and always has start all-bits-0. */
+}; /* internalRep.otherValuePtr */
+
+/*---------- operations on AddrMap_Entry ----------*/
+
+static void ame_free(AddrMap_Entry *ame) {
+ TFREE(ame->start); ame->start=0;
+ if (ame->data) { Tcl_DecrRefCount(ame->data); ame->data=0; }
+}
+
+static const Byte *ame_parsecheck_addr(Tcl_Interp *ip, const AddrMap_Value *am,
+ const HBytes_Value *hb) {
+ int hbl= hbytes_len(hb);
+ if (hbl < am->byl) {
+ staticerr(ip,"addr-map address too short","HBYTES ADDRMAP UNDERRUN");
+ return 0;
+ }
+ if (hbl > am->byl) {
+ staticerr(ip,"addr-map address too long","HBYTES ADDRMAP OVERRUN");
+ return 0;
+ }
+ return hbytes_data(hb);
+}
+
+static int ame_parsecheck_range(Tcl_Interp *ip, const AddrMap_Value *am,
+ const HBytes_Value *starthb,
+ const HBytes_Value *endhb,
+ const Byte *p_r[2]) {
+ p_r[0]= ame_parsecheck_addr(ip,am,starthb); if (!p_r[0]) return TCL_ERROR;
+ p_r[1]= ame_parsecheck_addr(ip,am,endhb); if (!p_r[0]) return TCL_ERROR;
+ if (memcmp(p_r[0],p_r[1],am->byl) > 0)
+ return staticerr(ip, "addr-map range start is after end",
+ "HBYTES ADDRMAP BADRANGE");
+ return TCL_OK;
+}
+
+static int ame_ba_addsubtractone(Byte *out, const Byte *in, int byl,
+ unsigned signum, unsigned onoverflow) {
+ /* On entry:
+ * *in is an array of byl bytes
+ * signum is 0xff or 0x01
+ * onoverflow is what counts as overflowed value,
+ * ie (for unsigned arith) 0x00 for add and 0xff for subtract
+ * On exit:
+ * *out is the resulting value (subject to overflow truncation)
+ * return value is TCL_OK, or TCL_ERROR if overflow happened
+ * (but interpreter result is not set on overflow)
+ */
+ int j;
+
+ for (j= byl, in += byl, out += byl;
+ in--, out--, j>0;
+ j--) {
+ *out = (*out) + signum;
+ if (*out != onoverflow)
+ return TCL_OK;
+ }
+ return TCL_ERROR;
+}
+
+/*---------- useful operations on AddrMap_Value etc. ----------*/
+
+static void am_init0(AddrMap_Value *am, int byl) {
+ am->byl= byl;
+ am->used= 0;
+ am->space= 0;
+ am->entries= 0;
+}
+
+static void am_reallocentries(AddrMap_Value *am, int len) {
+ AddrMap_Entry *newentries;
+
+ assert(len >= am->space);
+ if (!len) return;
+
+ newentries= TREALLOC(am->entries, sizeof(*newentries)*len);
+ assert(newentries);
+
+ am->space= len;
+ am->entries= newentries;
+}
+
+static void am_free(AddrMap_Value *am) {
+ AddrMap_Entry *ame;
+ int i;
+
+ if (!am) return;
+
+ for (i=0, ame=am->entries; i<am->used; i++, ame++)
+ ame_free(ame);
+
+ TFREE(am->entries);
+ TFREE(am);
+}
+
+/*---------- Tcl type and arg parsing functions ----------*/
+
+int pat_addrmapv(Tcl_Interp *ip, Tcl_Obj *var, AddrMap_Var *agg) {
+ int rc;
+ rc= pat_somethingv(ip,var,&agg->sth,&addrmap_type); if (rc) return rc;
+ agg->am= agg->sth.obj->internalRep.otherValuePtr;
+ return TCL_OK;
+}
+
+static void addrmap_t_free(Tcl_Obj *o) {
+ AddrMap_Value *am= o->internalRep.otherValuePtr;
+ am_free(am);
+}
+
+static void addrmap_t_dup(Tcl_Obj *sob, Tcl_Obj *dob) {
+ AddrMap_Value *sm= sob->internalRep.otherValuePtr;
+ AddrMap_Value *dm;
+ AddrMap_Entry *sme, *dme;
+ int i;
+
+ assert(sob->typePtr == &addrmap_type);
+ objfreeir(dob);
+ dm= TALLOC(sizeof(*dm));
+
+ am_init0(dm,sm->byl);
+ am_reallocentries(dm,sm->used);
+ dm->used= sm->used;
+ for (i=0, sme=sm->entries, dme=dm->entries;
+ i < dm->used;
+ i++, sme++, dme++) {
+ *dme= *sme;
+ dme->start= TALLOC(sm->byl); assert(dme->start);
+ memcpy(dme->start, sme->start, sm->byl);
+ Tcl_IncrRefCount(dme->data);
+ }
+ dob->internalRep.otherValuePtr= dm;
+ dob->typePtr= &addrmap_type;
+}
+
+static void addrmap_t_ustr(Tcl_Obj *so) {
+ AddrMap_Value *sm= so->internalRep.otherValuePtr;
+ Tcl_Obj **mainlobjsl, *surrogate;
+ AddrMap_Entry *sme;
+ int entnum, listlength;
+
+ assert(so->typePtr == &addrmap_type);
+ mainlobjsl= TALLOC(sizeof(*mainlobjsl) * (sm->used+1)); assert(mainlobjsl);
+ mainlobjsl[0]= Tcl_NewIntObj(sm->byl * 8);
+ listlength= 1;
+
+ for (entnum=0, sme=sm->entries; entnum<sm->used; entnum++, sme++) {
+ HBytes_Value hb;
+ Tcl_Obj *subl[3], *sublo;
+
+ if (!sme->data) continue;
+
+ hbytes_array(&hb, sme->start, sm->byl);
+ subl[0]= ret_hb(0, hb); assert(subl[0]);
+
+ if (entnum+1 < sm->used) {
+ ame_ba_addsubtractone(hbytes_arrayspace(&hb, sm->byl),
+ (sme+1)->start, sm->byl,
+ /*subtract:*/ 0x0ffu, 0x0ffu);
+ } else {
+ memset(hbytes_arrayspace(&hb, sm->byl),
+ 0x0ffu, sm->byl);
+ }
+
+ subl[1]= ret_hb(0, hb); assert(subl[1]);
+ subl[2]= sme->data;
+
+ sublo= Tcl_NewListObj(3,subl); assert(sublo);
+ mainlobjsl[listlength++]= sublo;
+ }
+ assert(listlength <= sm->used+1);
+ surrogate= Tcl_NewListObj(listlength,mainlobjsl); assert(surrogate);
+ assert(surrogate);
+
+ so->bytes= Tcl_GetStringFromObj(surrogate, &so->length); assert(so->bytes);
+ surrogate->bytes= 0; surrogate->length= 0; /* we stole it */
+}
+
+static AddrMap_Entry *ame_sfa_alloc(AddrMap_Value *am) {
+ AddrMap_Entry *ame;
+
+ ame= am->entries + am->used;
+
+ am->used++;
+ assert(am->used <= am->space);
+
+ ame->start= TALLOC(am->byl); assert(ame->start);
+ ame->data= 0;
+ return ame;
+}
+
+static int addrmap_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
+ int rc, inlen, eol, innum, bitlen, cmp;
+ Tcl_Obj *eo, *starto, *endo;
+ HBytes_Value starthb, endhb;
+ const Byte *rangeptrs[2];
+ AddrMap_Value *am;
+ AddrMap_Entry *ame;
+
+ am= TALLOC(sizeof(*am)); assert(am);
+ am_init0(am,0);
+
+ rc= Tcl_ListObjLength(ip,o,&inlen); if (rc) goto x_badvalue_rc;
+
+ if (inlen<0) {
+ rc= staticerr(ip, "addr-map overall length < 1", 0);
+ goto x_badvalue_rc;
+ }
+
+ rc= Tcl_ListObjIndex(ip,o,0,&eo); if (rc) goto x_badvalue_rc;
+ rc= Tcl_GetIntFromObj(ip,eo,&bitlen); if (rc) goto x_badvalue_rc;
+
+ if (bitlen<0 || bitlen % 8) {
+ rc= staticerr(ip, "addr-map overall length < 1", 0);
+ goto x_badvalue_rc;
+ }
+
+ am->byl= bitlen/8;
+ am_reallocentries(am, (inlen-1)*2+1);
+
+ ame= ame_sfa_alloc(am);
+ memset(ame->start,0,am->byl);
+
+ for (innum=1; innum < inlen; innum++) {
+ rc= Tcl_ListObjIndex(ip,o,innum,&eo); if (rc) goto x_badvalue_rc;
+ rc= Tcl_ListObjLength(ip,eo,&eol); if (rc) goto x_badvalue_rc;
+
+ if (eol != 3) {
+ rc= staticerr(ip, "addr-map entry length != 3", 0);
+ goto x_badvalue_rc;
+ }
+ rc= Tcl_ListObjIndex(ip,eo,0,&starto); if (rc) goto x_badvalue_rc;
+ rc= Tcl_ListObjIndex(ip,eo,1,&endo); if (rc) goto x_badvalue_rc;
+
+ rc= pat_hb(ip,starto,&starthb); if (rc) goto x_badvalue_rc;
+ rc= pat_hb(ip,endo,&endhb); if (rc) goto x_badvalue_rc;
+
+ rc= ame_parsecheck_range(ip,am,&starthb,&endhb,rangeptrs);
+ if (rc) goto x_badvalue_rc;
+
+ cmp= memcmp(ame->start, rangeptrs[0], am->byl);
+ if (cmp < 0) {
+ rc= staticerr(ip, "addr-map entries out of order", 0);
+ goto x_badvalue_rc;
+ }
+ if (cmp > 0) {
+ ame= ame_sfa_alloc(am);
+ memcpy(ame->start, rangeptrs[0], am->byl);
+ }
+
+ assert(!ame->data);
+ rc= Tcl_ListObjIndex(ip,eo,2,&ame->data); if (rc) goto x_badvalue_rc;
+ Tcl_IncrRefCount(ame->data);
+
+ ame= ame_sfa_alloc(am);
+ rc= ame_ba_addsubtractone(ame->start, rangeptrs[1], am->byl,
+ /*add:*/ 0x01u, 0x00u);
+ if (rc) {
+ /* we've overflowed. it must have been ffffffff.... */
+ if (innum != inlen-1) {
+ rc= staticerr(ip, "addr-map non-last entry end is all-bits-1", 0);
+ goto x_badvalue_rc;
+ }
+ TFREE(ame->start);
+ am->used--;
+ break;
+ }
+ }
+
+ /* we commit now */
+ objfreeir(o);
+ o->internalRep.otherValuePtr= am;
+ o->typePtr= &addrmap_type;
+ return TCL_OK;
+
+ x_badvalue_rc:
+ if (rc == TCL_ERROR)
+ Tcl_SetObjErrorCode(ip, Tcl_NewStringObj("HBYTES ADDRMAP VALUE", -1));
+
+ am_free(am);
+ return rc;
+}
+
+Tcl_ObjType addrmap_type = {
+ "addr-map",
+ addrmap_t_free, addrmap_t_dup, addrmap_t_ustr, addrmap_t_sfa
+};
~ian / chiark-tcl.git / blobdiff