chiark / gitweb /
wiringpi: drop piFace
[chiark-tcl.git] / 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 }