chiark / gitweb /
new socket id arrangements, working on tun
[chiark-tcl.git] / hbytes / chop.c
1 /*
2  */
3
4 #include <string.h>
5
6 #include "hbytes.h"
7 #include "tables.h"
8
9 static int strs1(Tcl_Interp *ip, int strc, Tcl_Obj *const *strv, int *l_r) {
10   int rc, l, i;
11
12   l= 0;
13   for (i=1; i<strc; i++) {
14     rc= Tcl_ConvertToType(ip,strv[i],&hbytes_type);
15     if (rc) return rc;
16     l += hbytes_len(OBJ_HBYTES(strv[i]));
17   }
18   *l_r= l;
19   return TCL_OK;
20 }
21
22 static void strs2(Byte *dest, int strc, Tcl_Obj *const *strv) {
23   int tl, i;
24   
25   for (i=1; i<strc; i++) {
26     tl= hbytes_len(OBJ_HBYTES(strv[i]));
27     memcpy(dest, hbytes_data(OBJ_HBYTES(strv[i])), tl);
28     dest += tl;
29   }
30 }
31
32 int do_hbytes_prepend(ClientData cd, Tcl_Interp *ip,
33                       HBytes_Var v, int strc, Tcl_Obj *const *strv) {
34   int rc, el;
35   Byte *dest;
36   
37   rc= strs1(ip,strc,strv,&el);  if (rc) return rc;
38   dest= hbytes_prepend(v.hb, el);
39   strs2(dest, strc,strv);
40   return TCL_OK;
41 }
42   
43 int do_hbytes_append(ClientData cd, Tcl_Interp *ip,
44                      HBytes_Var v, int strc, Tcl_Obj *const *strv) {
45   int rc, el;
46   Byte *dest;
47
48   rc= strs1(ip,strc,strv,&el);  if (rc) return rc;
49   dest= hbytes_append(v.hb, el);
50   strs2(dest,  strc,strv);
51   return TCL_OK;
52 }
53
54 int do_hbytes_concat(ClientData cd, Tcl_Interp *ip,
55                      int strc, Tcl_Obj *const *strv, HBytes_Value *result) {
56   int rc, l;
57   Byte *dest;
58   
59   rc= strs1(ip,strc,strv,&l);  if (rc) return rc;
60   dest= hbytes_arrayspace(result,l);
61   strs2(dest, strc,strv);
62   return TCL_OK;
63 }
64
65 static int underrun(Tcl_Interp *ip) {
66   return staticerr(ip,"data underrun","HBYTES LENGTH UNDERRUN");
67 }
68
69 int do_hbytes_unprepend(ClientData cd, Tcl_Interp *ip,
70                         HBytes_Var v, int preflength, HBytes_Value *result) {
71   const Byte *rdata= hbytes_unprepend(v.hb, preflength);
72   if (!rdata) return underrun(ip);
73   hbytes_array(result, rdata, preflength);
74   return TCL_OK;
75 }
76
77 int do_hbytes_unappend(ClientData cd, Tcl_Interp *ip,
78                        HBytes_Var v, int suflength, HBytes_Value *result) {
79   const Byte *rdata= hbytes_unappend(v.hb, suflength);
80   if (!rdata) return underrun(ip);
81   hbytes_array(result, rdata, suflength);
82   return TCL_OK;
83 }
84
85 int do_hbytes_chopto(ClientData cd, Tcl_Interp *ip,
86                      HBytes_Var v, int newlength, HBytes_Value *result) {
87   int suflength= hbytes_len(v.hb) - newlength;
88   return do_hbytes_unappend(0,ip,v, suflength, result);
89 }