4 #include "chiark-tcl-base.h"
6 int cht_staticerr(Tcl_Interp *ip, const char *m, const char *ec) {
7 Tcl_SetResult(ip, (char*)m, TCL_STATIC);
8 if (ec) Tcl_SetObjErrorCode(ip, Tcl_NewStringObj(ec,-1));
12 int cht_posixerr(Tcl_Interp *ip, int errnoval, const char *m) {
17 em= Tcl_PosixError(ip);
18 Tcl_AppendResult(ip, m, ": ", em, (char*)0);
22 int cht_newfdposixerr(Tcl_Interp *ip, int fd, const char *m) {
26 return cht_posixerr(ip,e,m);
29 void cht_objfreeir(Tcl_Obj *o) {
30 if (o->typePtr && o->typePtr->freeIntRepProc)
31 o->typePtr->freeIntRepProc(o);
35 void cht_obj_updatestr_vstringls(Tcl_Obj *o, ...) {
42 for (l=0; (part= va_arg(al, const char*)); )
47 o->bytes= TALLOC(l+1);
50 for (p= o->bytes; (part= va_arg(al, const char*)); p += pl) {
59 void cht_obj_updatestr_string(Tcl_Obj *o, const char *str) {
60 cht_obj_updatestr_vstringls(o, str, strlen(str), (char*)0);
63 #define URANDOM "/dev/urandom"
65 int cht_get_urandom(Tcl_Interp *ip, Byte *buffer, int l) {
71 urandom= fopen(URANDOM,"rb");
72 if (!urandom) return cht_posixerr(ip,errno,"open " URANDOM);
74 r= fread(buffer,1,l,urandom);
78 fclose(urandom); urandom=0;
80 if (ferror(urandom)) {
81 return cht_posixerr(ip,errno,"read " URANDOM);
83 assert(feof(urandom));
84 return cht_staticerr(ip, URANDOM " gave eof!", 0);
88 int cht_initextension(Tcl_Interp *ip, const TopLevel_Command *cmds,
89 int *donep /* or 0, meaning no types follow */,
90 ... /* types, terminated by 0 */) {
93 const TopLevel_Command *cmd;
100 Tcl_RegisterObjType(&cht_tabledataid_nearlytype);
101 Tcl_RegisterObjType(&cht_enum_nearlytype);
102 Tcl_RegisterObjType(&cht_enum1_nearlytype);
105 if (donep && !*donep) {
108 while ((ot= va_arg(al, Tcl_ObjType*)))
109 Tcl_RegisterObjType(ot);
115 Tcl_CreateObjCommand(ip, (char*)cmd->name, cmd->func, 0,0);