Programmer 7500/MAX_PROGRAMMERS.iso/INFO/FORTH/FIG_4TH.ZIP/TIME.SCR

Text File | 1987-01-14 | 4.0 KB | 1 lines

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ( utilities: DATE?, T>, >T, .T, TIME? )                         FORTH DEFINITIONS DECIMAL                                       : ##    0 <# # # #> TYPE ; ( print tos as 2-digit # )           : DATE? DATE@ ## 47 EMIT ## 47 EMIT ## SPACE ; ( --  show date) 0 VARIABLE [T] 2 ALLOT  0 VARIABLE [ET] 2 ALLOT                 ( unpack, pack 'times': sec/csec hr/min )                       : T>     [T] 2! [T] 2+ C@  ( csec ) [T] 3 + C@  ( sec )                         [T]    C@   ( min ) [T] 1+  C@  ( hr ) ;        : >T     [T] 1+  C! (  hr  )  [T]  C!  ( min )                           [T] 3 + C!  ( sec )  [T] 2+  C! ( csec ) [T] 2@ ;      : -MOD60  - DUP 0< IF 60  +   -1 ( borrow ) ELSE 0 THEN ;       : -MOD100 - DUP 0< IF 100 +   -1 ( borrow ) ELSE 0 THEN ;       : -MOD24  - DUP 0< IF 24  +   -1 ( borrow ) ELSE 0 THEN ;       : .T    ## 58 EMIT ## 58 EMIT ## 46 EMIT ## SPACE ;             : TIME? TIME@ T> .T ;  ( --   show current time )               -->                                                             ( utilities: ET0, ET? )                                         0 VARIABLE [T0] 2 ALLOT      0 VARIABLE [T1] 2 ALLOT            ( d1 d2 -- csec sec min hr  subtract two times;                                             result is unpacked )                : T-     [T0] 2!  [T1] 2!                                                [T1] 2+  C@   [T0] 2+  C@  -MOD100  ( delta csec )              [T1] 3 + C@ + [T0] 3 + C@  -MOD60   ( delta sec  )              [T1]     C@ + [T0]     C@  -MOD60   ( delta min  )              [T1] 1+  C@ + [T0] 1+  C@  -MOD24   ( delta hr   ) ;   : ET0    TIME@ [ET] 2! ;  ( reset elapsed time )                : ET     TIME@ [ET] 2@ T- ( measure elapsed time ) ;            : ET?    ET DROP ( ignore carry ) .T ; ( -- show elapsed time)           ( csec sec min hr -- n  n=time in csec )               : >CS    60 * +  60 * +  100 * + ;                              : ET(S)  ET DROP >CS  ( show elapsed time in seconds )                   0 <# # # 46 HOLD #S #> TYPE SPACE ;                    ( utilities: DISCOPY )                                          FORTH DEFINITIONS DECIMAL   1872 CONSTANT MAXREC                : PAUSE ." hit any key to continue..." KEY DROP ;               : FILL  #BUFF OVER + SWAP DO I MAXREC > 0=                          IF I MAXREC + BLOCK 2- ! UPDATE                                ELSE LEAVE THEN LOOP ;                                       : BLOCK0  FIRST LIMIT OVER - BLANKS ;                           : NL  CR 0 OUT !  ." Block" ;  : NL?  OUT @ 70 > IF NL THEN ;   : DISPLAY  NL? 7 .R ;                                           ( absolute sector disk copy: takes about 10 minutes if you )    (    only use 8 buffers !! )                                    : DISKCOPY  CR ." Place the source disk in drive A, "                          ." and the destination disk in drive B.  " CR        PAUSE ." please wait"  CR FLUSH DR0 0 DRIVE ! BLOCK0 NL         MAXREC 0 DO I DISPLAY I FILL  FLUSH #BUFF +LOOP             CR CR ." Disk copy finished.  " ;