home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / ttimer.seq < prev    next >
Encoding:
Text File  |  1989-12-15  |  2.6 KB  |  94 lines
  1. \ TIMER.SEQ      Time measurment words for F-PC.
  2.  
  3. FORTH DECIMAL TARGET >LIBRARY       \ A Library file
  4.  
  5. : GETDATE       ( --- Y MD ) 0 0 42 OS2 DROP ;
  6.  
  7. : SETDATE       ( NM Y --- ) SWAP 43 OS2 NIP NIP 255 =
  8.                 IF      CR ." Invalid DATE " THEN ;
  9.  
  10. : GETTIME       ( --- HM Sh ) 0 0 44 OS2 DROP ;
  11.  
  12. : SETTIME       ( HM Sh --- ) SWAP 45 OS2 NIP NIP 255 =
  13.                 IF      CR ." Invalid TIME " THEN ;
  14.  
  15. 16 ARRAY DTBUF
  16.  
  17. : ##+           ( N1 --- )              \ two low digits of n1 to DATEBUF.
  18.                 0 <# # # #> TUCK DTBUF COUNT + SWAP CMOVE
  19.                 DTBUF C+! ;
  20.  
  21. : "+            ( A1 N1 --- )
  22.                 TUCK DTBUF COUNT + SWAP CMOVE DTBUF C+! ;
  23.  
  24. : BUILD-HM      ( N1 --- )
  25.                 SPLIT ##+ " :" "+ ##+ ;
  26.  
  27. : BUILD-SH      ( N1 --- )
  28.                 " :" "+ SPLIT ##+ " ." "+ ##+ ;
  29.  
  30. : BUILD-TIME    ( D1 --- )
  31.                 SWAP BUILD-HM BUILD-SH ;
  32.  
  33. : FORM-TIME     ( D1 --- a1 )
  34.                 BASE @ >R DECIMAL
  35.                 DTBUF OFF
  36.                 BUILD-TIME
  37.                 R> BASE ! DTBUF ;
  38.  
  39. : .TIME         GETTIME FORM-TIME COUNT TYPE ;
  40.  
  41. : <M/D/Y>       ( D1 --- )
  42.                 SPLIT      ##+ " /" "+ ##+ " /" "+ ##+ ;
  43.  
  44. : <Y-M-D>       ( D1 --- )
  45.                 SPLIT ROT  ##+ " -" "+ ##+ " -" "+ ##+ ;
  46.  
  47. : <D.M.Y>       ( D1 --- )
  48.                 SPLIT SWAP ##+ " ." "+ ##+ " ." "+ ##+ ;
  49.  
  50. 0 VALUE DATE-TYPE
  51.  
  52. : BUILD-DATE    ( -- )
  53.                 DATE-TYPE 3 AND EXEC: <M/D/Y> <Y-M-D> <D.M.Y> ;
  54.  
  55. : M/D/Y         0 =: DATE-TYPE ;
  56.  
  57. : Y-M-D         1 =: DATE-TYPE ;
  58.  
  59. : D.M.Y         2 =: DATE-TYPE ;
  60.  
  61. : FORM-DATE     ( D1 --- A1 )
  62.                 BASE @ >R DECIMAL
  63.                 DTBUF OFF
  64.                 BUILD-DATE
  65.                 R> BASE ! DTBUF ;
  66.  
  67. : .DATE         GETDATE FORM-DATE COUNT TYPE ;
  68.  
  69. 2VARIABLE STIME
  70. 2VARIABLE TTIME
  71.  
  72. : T>B           SPLIT 100 * + SWAP 0 SWAP
  73.                 SPLIT >R 6000 *D D+ R> 1000 * 360 *D D+ ;
  74.  
  75. : B>T           0 100 UM/MOD >R 100 UM/MOD SWAP TTIME C!
  76.                              R>  60 UM/MOD SWAP TTIME 1+ C!
  77.                                  60   /MOD      TTIME 3 + C!
  78.                                                 TTIME 2+ C! ;
  79.  
  80. : TIME-RESET    GETTIME T>B STIME 2! ;  \ RESET TIMER
  81.  
  82. : TIME-ELAPSED  GETTIME T>B STIME 2@ D- ; ( - D1 ) \ BINARY
  83.  
  84. : B>SEC         ( D1 - N1 )      \ CONVERT DOUBLE BINARY TO
  85.                 0 100 UM/MOD DROP   \ SECONDS, OVERFLOW AT 18 HRS
  86.                   100 UM/MOD NIP ;
  87.  
  88. : <.ELAPSED>    TIME-ELAPSED B>T TTIME 2@ FORM-TIME COUNT TYPE ;
  89.  
  90. : .ELAPSED      CR ." Elapsed time   =  " <.ELAPSED> ;
  91.  
  92. FORTH TARGET >TARGET
  93.  
  94.