Posted to tcl by de at Wed May 16 00:41:03 GMT 2018view raw

  1.  
  2. #include <tcl.h>
  3. #include <time.h>
  4.  
  5. static int
  6. timeObjCmd (
  7. ClientData dummy,
  8. Tcl_Interp *interp,
  9. int objc,
  10. Tcl_Obj *const objv[]
  11. ) {
  12. Tcl_Obj *objPtr;
  13. Tcl_Obj *objs[4];
  14. int i, result;
  15. int count;
  16. struct timespec tp;
  17. time_t startSec;
  18. long startNano;
  19.  
  20. if (objc == 2) {
  21. count = 1;
  22. } else if (objc == 3) {
  23. result = Tcl_GetIntFromObj(interp, objv[2], &count);
  24. if (result != TCL_OK) {
  25. return result;
  26. }
  27. } else {
  28. Tcl_WrongNumArgs(interp, 1, objv, "command ?count?");
  29. return TCL_ERROR;
  30. }
  31.  
  32. objPtr = objv[1];
  33. i = count;
  34. if (clock_gettime (CLOCK_PROCESS_CPUTIME_ID, &tp) != 0) {
  35. return TCL_ERROR;
  36. }
  37. startNano = tp.tv_sec * 1000000000 + tp.tv_nsec;
  38.  
  39. while (i-- > 0) {
  40. result = Tcl_EvalObjEx(interp, objPtr, 0);
  41. if (result != TCL_OK) {
  42. return result;
  43. }
  44. }
  45.  
  46. if (clock_gettime (CLOCK_PROCESS_CPUTIME_ID, &tp) != 0) {
  47. return TCL_ERROR;
  48. }
  49.  
  50. if (count <= 1) {
  51. objs[0] = Tcl_NewLongObj ((tp.tv_sec * 1000000000 + tp.tv_nsec - startNano)
  52. / 1000);
  53. } else {
  54. objs[0] = Tcl_NewDoubleObj ((tp.tv_sec * 1000000000.0 + tp.tv_nsec - startNano)
  55. / (count * 1000));
  56. }
  57.  
  58. /*
  59. * Construct the result as a list because many programs have always parsed
  60. * as such (extracting the first element, typically).
  61. */
  62.  
  63. objs[1] = Tcl_NewStringObj ("microseconds", -1);
  64. objs[2] = Tcl_NewStringObj ("per", -1);
  65. objs[3] = Tcl_NewStringObj ("iteration", -1);
  66. Tcl_SetObjResult(interp, Tcl_NewListObj(4, objs));
  67.  
  68. return TCL_OK;
  69.  
  70. }
  71.  
  72. int
  73. Time_Init (interp)
  74. Tcl_Interp *interp; /* Interpreter to initialize. */
  75. {
  76. Tcl_InitStubs(interp, "8", 0);
  77. Tcl_CreateObjCommand(interp, "time::time", timeObjCmd, NULL, NULL );
  78. Tcl_PkgProvide(interp, "time", "1.0");
  79. return TCL_OK;
  80. }
  81.