X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?a=blobdiff_plain;ds=sidebyside;f=base%2Fparse.c;h=5e1f918d99d886a829fb06c8cf8afefa5888cb91;hb=fa11284b9469c1c79af7f8f129da934c1ebcf594;hp=14d8f9906b59334ab8343e59c54d98e3d1e153cf;hpb=b740135c3efcb63e0c7741384e5fa8ff229d2919;p=chiark-tcl.git diff --git a/base/parse.c b/base/parse.c index 14d8f99..5e1f918 100644 --- a/base/parse.c +++ b/base/parse.c @@ -22,23 +22,34 @@ int pat_obj(Tcl_Interp *ip, Tcl_Obj *obj, Tcl_Obj **val) { return TCL_OK; } +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); + Tcl_InvalidateStringRep(val); + if (Tcl_IsShared(val)) { + val= Tcl_DuplicateObj(val); + agg->copied= 1; + } + agg->obj= val; + + agg->hb= OBJ_HBYTES(val); return TCL_OK; } @@ -50,17 +61,39 @@ void fini_hbv(Tcl_Interp *ip, int rc, HBytes_Var *agg) { 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) { + return val; +} + +void setstringresult(Tcl_Interp *ip, const char *m) { + Tcl_ResetResult(ip); + Tcl_AppendResult(ip, m, (char*)0); }