home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / FPC355_2.ZIP / FPCSRC.ZIP / TIMER.SEQ < prev    next >
Encoding:
Text File  |  1989-09-21  |  2.6 KB  |  91 lines
  1. \ TIMER.SEQ      Time measurment words for F-PC.
  2.  
  3. : GETDATE       ( --- Y MD ) 0 0 42 OS2 DROP ;
  4.  
  5. : SETDATE       ( NM Y --- ) SWAP 43 OS2 NIP NIP 255 =
  6.                 IF      CR ." Invalid DATE " THEN ;
  7.  
  8. : <GETTIME>     ( --- HM Sh ) 0 0 44 OS2 DROP ;
  9.  
  10. DEFER GETTIME   ' <GETTIME> IS GETTIME
  11.  
  12. : SETTIME       ( HM Sh --- ) SWAP 45 OS2 NIP NIP 255 =
  13.                 IF      CR ." Invalid TIME " THEN ;
  14.  
  15. CREATE DTBUF 16 ALLOT
  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. DEFER BUILD-DATE   ' <M/D/Y> IS BUILD-DATE
  51.  
  52. : M/D/Y         ['] <M/D/Y> IS BUILD-DATE ;
  53.  
  54. : Y-M-D         ['] <Y-M-D> IS BUILD-DATE ;
  55.  
  56. : D.M.Y         ['] <D.M.Y> IS BUILD-DATE ;
  57.  
  58. : FORM-DATE     ( D1 --- A1 )
  59.                 BASE @ >R DECIMAL
  60.                 DTBUF OFF
  61.                 BUILD-DATE
  62.                 R> BASE ! DTBUF ;
  63.  
  64. : .DATE         GETDATE FORM-DATE COUNT TYPE ;
  65.  
  66. VARIABLE STIME 0 ,
  67. VARIABLE TTIME 0 ,
  68.  
  69. : T>B           SPLIT 100 * + SWAP 0 SWAP
  70.                 SPLIT >R 6000 *D D+ R> 1000 * 360 *D D+ ;
  71.  
  72. : B>T           0 100 UM/MOD >R 100 UM/MOD SWAP TTIME C!
  73.                              R>  60 UM/MOD SWAP TTIME 1+ C!
  74.                                  60   /MOD      TTIME 3 + C!
  75.                                                 TTIME 2+ C! ;
  76.  
  77. : TIME-RESET    GETTIME T>B STIME 2! ;  \ RESET TIMER
  78.  
  79. : TIME-ELAPSED  GETTIME T>B STIME 2@ D- ; ( - D1 ) \ BINARY
  80.  
  81. : B>SEC         ( D1 - N1 )      \ CONVERT DOUBLE BINARY TO
  82.                 0 100 UM/MOD DROP   \ SECONDS, OVERFLOW AT 18 HRS
  83.                   100 UM/MOD NIP ;
  84.  
  85. : <.ELAPSED>    TIME-ELAPSED B>T TTIME 2@ FORM-TIME COUNT TYPE ;
  86.  
  87. : .ELAPSED      CR ." Elapsed time   =  " <.ELAPSED> ;
  88.  
  89. : TIMER         TIME-RESET INTERPRET .ELAPSED ;
  90.  
  91.