hbytes/chop.c

   1 /*
   2  * hbytes - hex-stringrep efficient byteblocks for Tcl
   3  * Copyright 2006-2012 Ian Jackson
   4  *
   5  * This program is free software; you can redistribute it and/or
   6  * modify it under the terms of the GNU General Public License as
   7  * published by the Free Software Foundation; either version 2 of the
   8  * License, or (at your option) any later version.
   9  *
  10  * This program is distributed in the hope that it will be useful, but
  11  * WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13  * General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License
  16  * along with this library; if not, see <http://www.gnu.org/licenses/>.
  17  */
  18
  19
  20 #include "chiark_tcl_hbytes.h"
  21
  22 static int strs1(Tcl_Interp *ip, int strc, Tcl_Obj *const *strv, int *l_r) {
  23   int rc, l, i, pl;
  24
  25   l= 0;
  26   for (i=1; i<strc; i++) {
  27     rc= Tcl_ConvertToType(ip,strv[i],&cht_hbytes_type);
  28     if (rc) return rc;
  29     pl= cht_hb_len(OBJ_HBYTES(strv[i]));
  30     assert(l < INT_MAX/2 && pl < INT_MAX/2);
  31     l += pl;
  32   }
  33   *l_r= l;
  34   return TCL_OK;
  35 }
  36
  37 static void strs2(Byte *dest, int strc, Tcl_Obj *const *strv) {
  38   int tl, i;
  39
  40   for (i=1; i<strc; i++) {
  41     tl= cht_hb_len(OBJ_HBYTES(strv[i]));
  42     memcpy(dest, cht_hb_data(OBJ_HBYTES(strv[i])), tl);
  43     dest += tl;
  44   }
  45 }
  46
  47 int cht_do_hbytes_prepend(ClientData cd, Tcl_Interp *ip,
  48                       HBytes_Var v, int strc, Tcl_Obj *const *strv) {
  49   int rc, el;
  50   Byte *dest;
  51
  52   rc= strs1(ip,strc,strv,&el);  if (rc) return rc;
  53   dest= cht_hb_prepend(v.hb, el);
  54   strs2(dest, strc,strv);
  55   return TCL_OK;
  56 }
  57
  58 int cht_do_hbytes_append(ClientData cd, Tcl_Interp *ip,
  59                      HBytes_Var v, int strc, Tcl_Obj *const *strv) {
  60   int rc, el;
  61   Byte *dest;
  62
  63   rc= strs1(ip,strc,strv,&el);  if (rc) return rc;
  64   dest= cht_hb_append(v.hb, el);
  65   strs2(dest,  strc,strv);
  66   return TCL_OK;
  67 }
  68
  69 int cht_do_hbytes_concat(ClientData cd, Tcl_Interp *ip,
  70                      int strc, Tcl_Obj *const *strv, HBytes_Value *result) {
  71   int rc, l;
  72   Byte *dest;
  73
  74   rc= strs1(ip,strc,strv,&l);  if (rc) return rc;
  75   dest= cht_hb_arrayspace(result,l);
  76   strs2(dest, strc,strv);
  77   return TCL_OK;
  78 }
  79
  80 static int underrun(Tcl_Interp *ip) {
  81   return cht_staticerr(ip,"data underrun","HBYTES LENGTH UNDERRUN");
  82 }
  83
  84 int cht_do_hbytes_unprepend(ClientData cd, Tcl_Interp *ip,
  85                         HBytes_Var v, int preflength, HBytes_Value *result) {
  86   const Byte *rdata= cht_hb_unprepend(v.hb, preflength);
  87   if (!rdata) return underrun(ip);
  88   cht_hb_array(result, rdata, preflength);
  89   return TCL_OK;
  90 }
  91
  92 int cht_do_hbytes_unappend(ClientData cd, Tcl_Interp *ip,
  93                        HBytes_Var v, int suflength, HBytes_Value *result) {
  94   const Byte *rdata= cht_hb_unappend(v.hb, suflength);
  95   if (!rdata) return underrun(ip);
  96   cht_hb_array(result, rdata, suflength);
  97   return TCL_OK;
  98 }
  99
 100 int cht_do_hbytes_chopto(ClientData cd, Tcl_Interp *ip,
 101                      HBytes_Var v, int newlength, HBytes_Value *result) {
 102   int suflength= cht_hb_len(v.hb) - newlength;
 103   return cht_do_hbytes_unappend(0,ip,v, suflength, result);
 104 }