chiark / gitweb /
hbytes and crypto compile now
[chiark-tcl.git] / 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 }