1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218
|
int
NombreObjCmd(ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[])
{
char *text = NULL;
Tcl_DString *dynstr = NULL;
int *val = NULL;
Tcl_Obj *intobj = NULL;
int *intval = (int*) clientData;
#if 0
/* inutile... l'idée était d'incrémenter
* le compteur de référence ce qui doit
* empêcher la libération des objets passer
* lors de l'appel vu qu'on semble taper une
* erreur de ségmentation en appelant objv[2] */
int i;
for(i=0;i<objc;i++) Tcl_IncrRefCount(objv[i]);
#endif // 0
/* nombre d'arguments transmis */
if (objc < 2) {
Tcl_WrongNumArgs(interp,0,objv,
"Usage : attribut ?valeur?");
return TCL_ERROR;
}
/* parsage des arguments : récupérer le mode d'appel */
if ((text = Tcl_GetStringFromObj(objv[1], NULL)) == NULL)
return TCL_ERROR;
/* mode écriture */
if (strncmp(text,"ecrire",6) == 0) {
/* en mode écriture, il faut forcément
* indiquer la valeur que l'on veut écrire */
if (objc != 3) {
Tcl_WrongNumArgs(interp,0,objv,
"Usage : ecrire valeur");
return TCL_ERROR;
}
#if 1
/* lorsqu'un argument est transmis pour la valeur,
* il faut ensuite le décoder */
if ((Tcl_GetIntFromObj(interp, objv[2], val) != TCL_OK) ||
((text = Tcl_GetStringFromObj(objv[2],NULL)) == NULL))
return TCL_ERROR;
#else
/* une ségmentation erronée semble arriver avec objv[2] */
*intval += 1;
/* acquérir la valeur en mémoire et
* l'exprimer en chaine de caractères */
if ((intobj = Tcl_NewIntObj(*intval)) == NULL)
return TCL_ERROR;
if ((text = Tcl_GetStringFromObj(intobj,NULL)) == NULL)
return TCL_ERROR;
#endif // 0
#if 1
if ((dynstr = attemptckalloc(sizeof(Tcl_DString))) == NULL)
return TCL_ERROR;
Tcl_DStringInit(dynstr);
/* affecter la nouvelle valeur en
* mémoire et la retourner en sortie */
*intval = *val;
Tcl_DStringAppend(dynstr, text, -1);
Tcl_DStringResult(interp,dynstr);
ckfree(dynstr);
#endif // 0
return TCL_OK;
}
/* mode lecture */
else if (strncmp(text,"lire",4) == 0) {
/* acquérir la valeur en mémoire et
* l'exprimer en chaine de caractères */
if ((intobj = Tcl_NewIntObj(*intval)) == NULL)
return TCL_ERROR;
if ((text = Tcl_GetStringFromObj(intobj,NULL)) == NULL)
return TCL_ERROR;
if ((dynstr = attemptckalloc(sizeof(Tcl_DString))) == NULL)
return TCL_ERROR;
Tcl_DStringInit(dynstr);
/* communication de la valeur */
Tcl_DStringAppend(dynstr, text, -1);
Tcl_DStringResult(interp,dynstr);
ckfree(dynstr);
// ckfree(intobj);
return TCL_OK;
}
/* mode incrémentation */
else if (strncmp(text,"incr",4) == 0) {
/* affecter la nouvelle valeur en mémoire */
*intval += 1;
*intval += 1;
/* acquérir la valeur en mémoire et
* l'exprimer en chaine de caractères */
if ((intobj = Tcl_NewIntObj(*intval)) == NULL)
return TCL_ERROR;
if ((text = Tcl_GetStringFromObj(intobj,NULL)) == NULL)
return TCL_ERROR;
/* affecter la nouvelle valeur en
* mémoire et la retourner en sortie */
if ((dynstr = attemptckalloc(sizeof(Tcl_DString))) == NULL)
return TCL_ERROR;
Tcl_DStringInit(dynstr);
Tcl_DStringAppend(dynstr, text, -1);
Tcl_DStringResult(interp,dynstr);
ckfree(dynstr);
return TCL_OK;
}
/* mode inconnu */
else {
return TCL_ERROR;
}
}
int
InstanceurNombreObjCmd(ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[])
{
/* variables locales */
char *text = NULL;
Tcl_DString *dynstr = NULL;
int *intval = NULL;
Tcl_Command cmd = NULL;
/* nombre d'arguments transmis */
if (objc != 2) {
Tcl_WrongNumArgs(interp,0,objv,
"Usage : nombre nouveau");
return TCL_ERROR;
}
/* parsage des arguments : récupérer le mode d'appel */
if ((text = Tcl_GetStringFromObj(objv[1], NULL)) == NULL)
return TCL_ERROR;
/* unique mode d'appel supporté : nouveau */
if (strncmp(text,"nouveau",7) != 0)
return TCL_ERROR;
/* allouer en mémoire l'objet en question */
/* -> approprié par Tcl_Alloc = aucun risque
* de libération prématurée ??? */
if ((intval = attemptckalloc(sizeof(int))) == NULL)
return TCL_ERROR;
*intval = 0; /* RàZ */
/* mettre en forme le contenu de la chaine de caractères
* retournée lors de l'appel de cette commande :
* - 3 caractères pout le mot "int",
* - 16 chiffres héxadécimaux pour l'adresse de la
* variable de type int en architecture 64 bits et
* - 1 pour le marqueur de fin de chaine de caractères */
if ((text = attemptckalloc(sizeof(char)*(3+16+1))) == NULL) {
ckfree(intval);
return TCL_ERROR;
}
sprintf(text, "int%p", intval);
/* passer la chaine crée à une dstring qui en FAIT une COPIE
* du contenu et par conséquent libérer la mémoire superflue */
if ((dynstr = attemptckalloc(sizeof(Tcl_DString))) == NULL) {
ckfree(intval);
ckfree(text);
return TCL_ERROR;
}
Tcl_DStringInit(dynstr);
Tcl_DStringAppend(dynstr, text, -1);
ckfree(text);
/* créer une nouvelle commande dont le nom correspond
* au contenu de la dstring */
if ((text = Tcl_DStringValue(dynstr)) == NULL)
goto ErrorFree;
cmd = Tcl_CreateObjCommand(interp, text, NombreObjCmd,
(ClientData) intval, (Tcl_CmdDeleteProc *) NULL);
if (cmd == NULL) goto ErrorFree;
/* renvoyer en sortie le contenu de la dstring puis
* en libérer la mémoire pour conclure */
Tcl_DStringResult(interp,dynstr);
ckfree(dynstr);
return TCL_OK;
ErrorFree:
ckfree(intval);
ckfree(dynstr);
return TCL_ERROR;
int
Tcl_wrap_obj_Init(Tcl_Interp *interp) {
Tcl_Command cmd;
cmd = Tcl_CreateObjCommand(interp, "nombre", InstanceurNombreObjCmd,
(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
if (cmd == NULL) return TCL_ERROR;
return TCL_OK;
} |
Partager