home *** CD-ROM | disk | FTP | other *** search
/ The CDPD Public Domain Collection for CDTV 4 / CDPD_IV.bin / e / mailinglists / binaries / readstr-study.lha / rwt1.e < prev    next >
Text File  |  1993-07-24  |  5KB  |  178 lines
  1. /* Timing of E's builtin ReadStr() function. */
  2.  
  3. MODULE 'dos/dos'
  4.  
  5. OBJECT st_stackType
  6.   top, count
  7. ENDOBJECT
  8.  
  9. OBJECT et_procInfoType
  10.   visits : LONG
  11.   started : datestamp
  12.   elapsed : datestamp
  13.   name : LONG
  14. ENDOBJECT
  15.  
  16. DEF et_procInfoArray : PTR TO et_procInfoType,
  17.     et_stack : st_stackType,
  18.     et_numberOfProcs = 0,
  19.     et_idRunning = -1 /* Used to turn timer off/on  */
  20.                       /* in case of recursive call. */
  21.                       /* Used by et_StartTime AND   */
  22.                       /* et_StopTime.               */
  23.  
  24. ENUM ER_NONE,
  25.      ER_MEM
  26.  
  27. RAISE ER_MEM IF String () = NIL
  28.  
  29. PROC st_init (theStack : PTR TO st_stackType)
  30. /* Simply declare the stack variable as st_stackType.   The status of the */
  31. /* stack can be checked by testing stackname.count.                       */
  32.   theStack.top := NIL
  33.   theStack.count := 0
  34. ENDPROC
  35.   /* st_init */
  36.  
  37. PROC st_push (theStack : PTR TO st_stackType, addr)
  38.   DEF newList, tempList
  39.   newList := List (1)
  40.   ListCopy (newList, [addr], ALL)
  41.   tempList := Link (newList, theStack.top)
  42.   theStack.top := tempList
  43.   theStack.count := theStack.count + 1
  44. ENDPROC
  45.   /* st_push */
  46.  
  47. PROC st_pop (theStack : PTR TO st_stackType)
  48.   DEF list, addr = NIL
  49.   IF theStack.count
  50.     list := theStack.top
  51.     addr := ^list
  52.     theStack.top := Next (list)
  53.     theStack.count := theStack.count - 1
  54.   ENDIF
  55. ENDPROC  addr
  56.   /* st_pop */
  57.  
  58. PROC et_init (numberOfProcs)
  59.   DEF i, elapsed : PTR TO datestamp
  60.   et_numberOfProcs := numberOfProcs + 1
  61.   et_procInfoArray := New ((SIZEOF et_procInfoType) * et_numberOfProcs)
  62.   FOR i := 0 TO numberOfProcs
  63.     et_procInfoArray [i].visits := 0
  64.     elapsed := et_procInfoArray [i].elapsed
  65.     elapsed.minute := 0
  66.     elapsed.tick := 0
  67.   ENDFOR
  68.   st_init (et_stack)
  69. ENDPROC
  70.  
  71. PROC et_startTimer (id, name)
  72.   DEF current : datestamp,
  73.       started : PTR TO datestamp,
  74.       elapsed : PTR TO datestamp
  75.   VOID DateStamp (current)
  76.  
  77.   /* Update the elapsed time of the proc that relinquished control to     */
  78.   /* child.  Init if et_idRunning = -1 (PROC main () is the *only* case.) */
  79.   IF et_idRunning = -1
  80.     et_init (id)
  81.   ELSE
  82.     started := et_procInfoArray [et_idRunning].started
  83.     elapsed := et_procInfoArray [et_idRunning].elapsed
  84.     IF current.tick < started.tick
  85.       current.tick := current.tick + 3000
  86.       current.minute := current.minute - 1
  87.     ENDIF
  88.     elapsed.tick := elapsed.tick + (current.tick - started.tick)
  89.     elapsed.minute := elapsed.minute + (current.minute - started.minute)
  90.   ENDIF
  91.   st_push (et_stack, et_idRunning)
  92.  
  93.   /* Update the start time of the child proc. */
  94.   started := et_procInfoArray [id].started
  95.   started.minute := current.minute
  96.   started.tick := current.tick
  97.   et_procInfoArray [id].name := IF name = NIL THEN '' ELSE name
  98.   et_idRunning := id
  99.   et_procInfoArray [id].visits := et_procInfoArray [id].visits + 1
  100. ENDPROC
  101.  
  102. PROC et_toMinutes (ticks) RETURN ticks / 3000
  103.  
  104. PROC et_report ()
  105.   DEF i,
  106.       totalMinute = 0,
  107.       totalTick = 0,
  108.       ds : PTR TO datestamp
  109.   FOR i := 0 TO (et_numberOfProcs - 1)
  110.     ds := et_procInfoArray [i].elapsed
  111.     ds.minute := ds.minute + et_toMinutes (ds.tick)
  112.     ds.tick := ds.tick - (et_toMinutes (ds.tick) * 3000)
  113.     WriteF ('\nid=\d, visits=\d, minute=\d, tick=\d, name=\s',
  114.             i,
  115.             et_procInfoArray [i].visits,
  116.             ds.minute,
  117.             ds.tick,
  118.             et_procInfoArray [i].name)
  119.     totalMinute := totalMinute + ds.minute
  120.     totalTick := totalTick + ds.tick
  121.   ENDFOR
  122.   totalMinute := totalMinute + et_toMinutes (totalTick)
  123.   totalTick := totalTick - (et_toMinutes (totalTick) * 3000)
  124.   WriteF ('\ntotalMinute=\d totalTick=\d\n', totalMinute, totalTick)
  125. ENDPROC
  126.  
  127. PROC et_stopTimer ()
  128.   DEF current : datestamp,
  129.       started : PTR TO datestamp,
  130.       elapsed : PTR TO datestamp
  131.   VOID DateStamp (current)
  132.  
  133.   /* Update the elapsed time of the child proc that id returning control */
  134.   /* to the parent.  None if et_idRunning = -1 (PROC main () is the      */
  135.   /* *only* case.)                                                       */
  136.   started := et_procInfoArray [et_idRunning].started
  137.   elapsed := et_procInfoArray [et_idRunning].elapsed
  138.     IF current.tick < started.tick
  139.       current.tick := current.tick + (50 * 60)
  140.       current.minute := current.minute - 1
  141.     ENDIF
  142.   elapsed.tick := elapsed.tick + (current.tick - started.tick)
  143.   elapsed.minute := elapsed.minute + (current.minute - started.minute)
  144.  
  145.   /* Update the start time of the parent proc.  None if et_idRunning = -1 */
  146.   /* (PROC main () is the *only* case.)                                   */
  147.   et_idRunning := st_pop (et_stack)
  148.   IF et_idRunning > -1
  149.     started := et_procInfoArray [et_idRunning].started
  150.     started.minute := current.minute
  151.     started.tick := current.tick
  152.   ELSE
  153.     et_report ()
  154.   ENDIF
  155. ENDPROC
  156.  
  157. PROC main () HANDLE
  158.   DEF fh, fho, s
  159.   s := String (80)
  160.   fho := Open ('rwt1.out', NEWFILE)
  161.   IF (fh := Open ('testfile.txt', OLDFILE))
  162.     et_startTimer (0, 'readStr(2)')
  163.     WHILE ReadStr (fh, s) > -1
  164.       Write (fho, s, StrLen (s))
  165.       Out (fho, '\n')
  166.     ENDWHILE
  167.     et_stopTimer ()
  168.     Close (fh)
  169.   ENDIF
  170.   Close (fho)
  171.   CleanUp (0)
  172. EXCEPT
  173.   IF fh THEN Close (fh)
  174.   IF fho THEN Close (fho)
  175.   IF exception = ER_MEM THEN WriteF ('Not enough memory.\n')
  176.   CleanUp (0)
  177. ENDPROC
  178.