Posted to tcl by hypnotoad at Fri Dec 05 19:48:52 GMT 2014view raw

  1.  
  2. static constObj *irm_constant(const char *zName,int create) {
  3. int len,isNew=0;
  4. Tcl_HashEntry *pEntry;
  5. constObj *p;
  6. if(zName==NULL) {
  7. return NULL;
  8. }
  9. if(create) {
  10. pEntry=Tcl_CreateHashEntry(&constant_strings,zName,&isNew);
  11. } else {
  12. pEntry=Tcl_FindHashEntry(&constant_strings,zName);
  13. }
  14. if(isNew) {
  15. len = strlen(zName);
  16. p =(constObj*)IRM_Alloc(sizeof(*p)+len+1);
  17. p->string=p+1;
  18. strncpy(p->string, zName, len+1);
  19. p->tclobj=Tcl_NewStringObj(zName,len);
  20. Tcl_IncrRefCount(p->tclobj);
  21. Tcl_SetHashValue(pEntry,(ClientData)p);
  22. return p;
  23. }
  24. if(pEntry) {
  25. p=(constObj*)Tcl_GetHashValue(pEntry);
  26. return p;
  27. }
  28. return NULL;
  29. }
  30.  
  31. int Irm_SameString(char *aPtr,char *bPtr) {
  32. if(aPtr==bPtr) {
  33. return 1;
  34. }
  35. if(!bPtr || !aPtr) {
  36. return 0;
  37. }
  38. if(strcmp(aPtr,bPtr)==0) {
  39. return 1;
  40. }
  41. return 0;
  42. }
  43. char *irm_constant_string(const char *zName) {
  44. constObj *p;
  45. p=irm_constant(zName,1);
  46. return p->string;
  47. }
  48.  
  49.  
  50. Tcl_Obj *irm_constant_tclobj(const char *zName) {
  51. constObj *p;
  52. p=irm_constant(zName,1);
  53. Tcl_IncrRefCount(p->tclobj);
  54. return p->tclobj;
  55. }
  56.  
  57. Tcl_Obj *Irm_NewStringObj(const char *str) {
  58. /*
  59. if(!str) {
  60. return Tcl_NewObj();
  61. }
  62. return Tcl_NewStringObj(str,-1);
  63. */
  64. return irm_constant_tclobj(str);
  65. }
  66.