home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / timestuf.seq < prev    next >
Text File  |  1990-05-25  |  2KB  |  60 lines
  1. \ TIMESTUF.SEQ          More words associated with timing       Tom Zimmer
  2.  
  3. : SEC-ELAPSED   ( --- N1 )    \ RETURN ELAPSED SECONDS < 18 HRS
  4.                 TIME-ELAPSED B>SEC ; ( -- N1 )
  5.  
  6. : 10TH-ELAPSED  ( --- N1 )
  7.                 TIME-ELAPSED 0 100 UM/MOD DROP 10 UM/MOD NIP ;
  8.  
  9. DEFER PAUSE-FUNC        ' NOOP IS PAUSE-FUNC
  10.  
  11. : SECONDS       ( N1 --- )   \ PAUSE FOR N1 SECONDS
  12.                 STIME 2@ 2>R >R TIME-RESET
  13.                 BEGIN   PAUSE  PAUSE-FUNC
  14.                         R@ SEC-ELAPSED > 0=
  15.                 UNTIL   R>DROP 2R> STIME 2! ;
  16.  
  17. : TENTHS        ( N1 --- )       \ PAUSE FOR N1 SECONDS
  18.                 STIME 2@ 2>R >R TIME-RESET
  19.                 BEGIN   PAUSE  PAUSE-FUNC
  20.                         R@ 10TH-ELAPSED > 0=
  21.                 UNTIL   R>DROP 2R> STIME 2! ;
  22.  
  23. : MINUTES       ( N1 --- )   \ PAUSE FOR N1 MINUTES
  24.                 0MAX   0 ?DO   60 SECONDS      LOOP ;
  25.  
  26. : HOURS         ( N1 --- )       \ PAUSE FOR N1 HOURS
  27.                 0MAX   0 ?DO   60 MINUTES      LOOP ;
  28.  
  29. : 0COMPILER     ( --- )
  30.                 TOTALLINES OFF
  31.                 TIME-RESET ;
  32.  
  33. : .COMPSTAT     ( --- )
  34.                 cr .elapsed
  35.                 cr ." Total lines compiled  = " totallines @ 5 u.r
  36.                 cr ." Compiled lines/minute = "
  37.                 totallines @ time-elapsed over 32000 u> or
  38.                 if      ." Too much time has elapsed to calculate LPM"
  39.                         2drop
  40.                 else    >R 60 10000 R@ */MOD
  41.                         10 * SWAP DUP 10 >
  42.                         IF      >R 100 100 100 r> r> SWAP */ */
  43.                                 10 /MOD  SWAP 4 > IF 1+ THEN +
  44.                         ELSE    r>drop DROP
  45.                         THEN    2DUP 100 / SWAP 100 / * 3200 >  \ 05/25/90 tjz
  46.                         IF      10 / 1000 */ 10 *D 5 D.R
  47.                         ELSE    1000 */ 5 u.R
  48.                         THEN
  49.                 then    ;
  50.  
  51. : TILLKEY       ( N1 --- )      \ WAIT UP TO N1 SECONDS FOR A KEY THEN GO ON.
  52.                 KEY?    IF  DROP EXIT  THEN     \ LEAVE IF KEY PRESSED
  53.                 CR ."  Waiting, press SPACEBAR to continue.."
  54.                 0MAX 0
  55.                 ?DO     KEY?    ?LEAVE
  56.                         1 SECONDS
  57.                 LOOP    KEY?
  58.                 IF      KEY 3 = ABORT" Quitting " THEN ;
  59.  
  60.