hbytes/chop.c

   1 /*
   2  */
   3
   4 #include "chiark_tcl_hbytes.h"
   5
   6 static int strs1(Tcl_Interp *ip, int strc, Tcl_Obj *const *strv, int *l_r) {
   7   int rc, l, i;
   8
   9   l= 0;
  10   for (i=1; i<strc; i++) {
  11     rc= Tcl_ConvertToType(ip,strv[i],&cht_hbytes_type);
  12     if (rc) return rc;
  13     l += cht_hb_len(OBJ_HBYTES(strv[i]));
  14   }
  15   *l_r= l;
  16   return TCL_OK;
  17 }
  18
  19 static void strs2(Byte *dest, int strc, Tcl_Obj *const *strv) {
  20   int tl, i;
  21
  22   for (i=1; i<strc; i++) {
  23     tl= cht_hb_len(OBJ_HBYTES(strv[i]));
  24     memcpy(dest, cht_hb_data(OBJ_HBYTES(strv[i])), tl);
  25     dest += tl;
  26   }
  27 }
  28
  29 int cht_do_hbytes_prepend(ClientData cd, Tcl_Interp *ip,
  30                       HBytes_Var v, int strc, Tcl_Obj *const *strv) {
  31   int rc, el;
  32   Byte *dest;
  33
  34   rc= strs1(ip,strc,strv,&el);  if (rc) return rc;
  35   dest= cht_hb_prepend(v.hb, el);
  36   strs2(dest, strc,strv);
  37   return TCL_OK;
  38 }
  39
  40 int cht_do_hbytes_append(ClientData cd, Tcl_Interp *ip,
  41                      HBytes_Var v, int strc, Tcl_Obj *const *strv) {
  42   int rc, el;
  43   Byte *dest;
  44
  45   rc= strs1(ip,strc,strv,&el);  if (rc) return rc;
  46   dest= cht_hb_append(v.hb, el);
  47   strs2(dest,  strc,strv);
  48   return TCL_OK;
  49 }
  50
  51 int cht_do_hbytes_concat(ClientData cd, Tcl_Interp *ip,
  52                      int strc, Tcl_Obj *const *strv, HBytes_Value *result) {
  53   int rc, l;
  54   Byte *dest;
  55
  56   rc= strs1(ip,strc,strv,&l);  if (rc) return rc;
  57   dest= cht_hb_arrayspace(result,l);
  58   strs2(dest, strc,strv);
  59   return TCL_OK;
  60 }
  61
  62 static int underrun(Tcl_Interp *ip) {
  63   return cht_staticerr(ip,"data underrun","HBYTES LENGTH UNDERRUN");
  64 }
  65
  66 int cht_do_hbytes_unprepend(ClientData cd, Tcl_Interp *ip,
  67                         HBytes_Var v, int preflength, HBytes_Value *result) {
  68   const Byte *rdata= cht_hb_unprepend(v.hb, preflength);
  69   if (!rdata) return underrun(ip);
  70   cht_hb_array(result, rdata, preflength);
  71   return TCL_OK;
  72 }
  73
  74 int cht_do_hbytes_unappend(ClientData cd, Tcl_Interp *ip,
  75                        HBytes_Var v, int suflength, HBytes_Value *result) {
  76   const Byte *rdata= cht_hb_unappend(v.hb, suflength);
  77   if (!rdata) return underrun(ip);
  78   cht_hb_array(result, rdata, suflength);
  79   return TCL_OK;
  80 }
  81
  82 int cht_do_hbytes_chopto(ClientData cd, Tcl_Interp *ip,
  83                      HBytes_Var v, int newlength, HBytes_Value *result) {
  84   int suflength= cht_hb_len(v.hb) - newlength;
  85   return cht_do_hbytes_unappend(0,ip,v, suflength, result);
  86 }