X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=chiark-tcl.git;a=blobdiff_plain;f=hbytes%2Fparse.c;h=44f00e2a25727c2333b07ccb4f67a2700931e08c;hp=1e1e5bb2ba616b13d3a27e08e8a9c74d1458c8c6;hb=7419270cc04e1d026b31838c527cf051550a2add;hpb=4ab162065d72217bcad27748442cbb27860c0cbd diff --git a/hbytes/parse.c b/hbytes/parse.c index 1e1e5bb..44f00e2 100644 --- a/hbytes/parse.c +++ b/hbytes/parse.c @@ -26,48 +26,67 @@ int pat_int(Tcl_Interp *ip, Tcl_Obj *obj, int *val) { return Tcl_GetIntFromObj(ip, obj, val); } +int pat_long(Tcl_Interp *ip, Tcl_Obj *obj, long *val) { + return Tcl_GetLongFromObj(ip, obj, val); +} + int pat_hbv(Tcl_Interp *ip, Tcl_Obj *var, HBytes_Var *agg) { int rc; Tcl_Obj *val; - Tcl_IncrRefCount(var); agg->var= var; val= Tcl_ObjGetVar2(ip,var,0,TCL_LEAVE_ERR_MSG); if (!val) return TCL_ERROR; - if (Tcl_IsShared(val)) val= Tcl_DuplicateObj(val); - Tcl_IncrRefCount(val); - agg->obj= val; - + rc= Tcl_ConvertToType(ip,val,&hbytes_type); if (rc) return rc; - agg->hb= &HBYTES(val); + if (Tcl_IsShared(val)) { + val= Tcl_DuplicateObj(val); + agg->copied= 1; + } + Tcl_InvalidateStringRep(val); + agg->obj= val; + + agg->hb= OBJ_HBYTES(val); return TCL_OK; } void fini_hbv(Tcl_Interp *ip, int rc, HBytes_Var *agg) { Tcl_Obj *ro; - Tcl_InvalidateStringRep(agg->obj); if (!rc) { assert(agg->obj); ro= Tcl_ObjSetVar2(ip,agg->var,0,agg->obj,TCL_LEAVE_ERR_MSG); if (!ro) rc= TCL_ERROR; } - if (agg->obj) Tcl_DecrRefCount(agg->obj); - if (agg->var) Tcl_DecrRefCount(agg->var); + if (rc && agg->copied) + Tcl_DecrRefCount(agg->obj); } int pat_hb(Tcl_Interp *ip, Tcl_Obj *obj, HBytes_Value *val) { int rc; rc= Tcl_ConvertToType(ip,obj,&hbytes_type); if (rc) return rc; - *val= HBYTES(obj); + *val= *OBJ_HBYTES(obj); return TCL_OK; } Tcl_Obj *ret_hb(Tcl_Interp *ip, HBytes_Value val) { - return hbytes_set_obj(0, val.start, HBYTES_LEN(val)); + Tcl_Obj *obj; + obj= Tcl_NewObj(); + Tcl_InvalidateStringRep(obj); + *OBJ_HBYTES(obj)= val; + obj->typePtr= &hbytes_type; + return obj; +} + +Tcl_Obj *ret_int(Tcl_Interp *ip, int val) { + return Tcl_NewIntObj(val); +} + +Tcl_Obj *ret_long(Tcl_Interp *ip, long val) { + return Tcl_NewLongObj(val); } Tcl_Obj *ret_obj(Tcl_Interp *ip, Tcl_Obj *val) {