0 | module System.Posix.Timer.Prim
  1 |
  2 | import Data.C.Ptr
  3 |
  4 | import public Data.C.Integer
  5 | import public System.Posix.Errno
  6 | import public System.Posix.Timer.Types
  7 | import public System.Posix.Time
  8 |
  9 | %default total
 10 |
 11 | --------------------------------------------------------------------------------
 12 | -- FFI
 13 | --------------------------------------------------------------------------------
 14 |
 15 | %foreign "C:li_setitimer, posix-idris"
 16 | prim__setitimer : Bits8 -> AnyPtr -> AnyPtr -> PrimIO CInt
 17 |
 18 | %foreign "C:li_setitimer1, posix-idris"
 19 | prim__setitimer1 : Bits8 -> TimeT -> SusecondsT -> TimeT -> SusecondsT -> PrimIO CInt
 20 |
 21 | %foreign "C:getitimer, posix-idris"
 22 | prim__getitimer : Bits8 -> AnyPtr -> PrimIO ()
 23 |
 24 | %foreign "C:li_clock_gettime, posix-idris"
 25 | prim__clock_gettime : Bits8 -> AnyPtr -> PrimIO CInt
 26 |
 27 | %foreign "C:li_clock_getres, posix-idris"
 28 | prim__clock_getres : Bits8 -> AnyPtr -> PrimIO CInt
 29 |
 30 | %foreign "C:li_nanosleep, posix-idris"
 31 | prim__nanosleep : AnyPtr -> AnyPtr -> PrimIO CInt
 32 |
 33 | %foreign "C:li_nanosleep1, posix-idris"
 34 | prim__nanosleep1 : TimeT -> NsecT -> PrimIO CInt
 35 |
 36 | %foreign "C:li_clock_nanosleep, posix-idris"
 37 | prim__clock_nanosleep : Bits8 -> AnyPtr -> AnyPtr -> PrimIO Bits32
 38 |
 39 | %foreign "C:li_clock_nanosleep_abs, posix-idris"
 40 | prim__clock_nanosleep_abs : Bits8 -> AnyPtr -> PrimIO Bits32
 41 |
 42 | --------------------------------------------------------------------------------
 43 | -- API
 44 | --------------------------------------------------------------------------------
 45 |
 46 | ||| Returns an approximation of processor time used by the program.
 47 | |||
 48 | ||| Type `ClockT` measures time with a granularity of
 49 | ||| `CLOCKS_PER_SEC`.
 50 | export %foreign "C:clock, posix-idris"
 51 | clock : PrimIO ClockT
 52 |
 53 | ||| This sets `new` as the new timer and places the current timer for
 54 | ||| `Which` in `old`.
 55 | |||
 56 | ||| Depending on `Which`, the timer will use a different clock and
 57 | ||| will (possibly repeatedly) raise a different kind signal:
 58 | |||
 59 | ||| * ITIMER_REAL: Counts down in real (i.e. wall clock) time
 60 | |||   and raises SIGALRM
 61 | ||| * ITIMER_VIRTUAL: Counts down in process virtual time
 62 | |||   (i.e. user-mode CPU time) and raises SIGVTALRM
 63 | ||| * ITIMER_PROF: Counts down in process time
 64 | |||   (i.e. the sum of kernel-mode and user-mode CPU time) and raises SIGPROF
 65 | export %inline
 66 | setitimer : Which -> (new,old : IOTimerval) -> EPrim ()
 67 | setitimer w n o = toUnit $ prim__setitimer (whichCode w) (unwrap n) (unwrap o)
 68 |
 69 | ||| Writes the currently set timer for `Which` into `old.
 70 | export %inline
 71 | getitimer : Which -> (old : IOTimerval) -> PrimIO ()
 72 | getitimer w o = prim__getitimer (whichCode w) (unwrap o)
 73 |
 74 | ||| A very basic version of `setitimer` that raises `SIGALRM`
 75 | ||| after the given number of seconds.
 76 | |||
 77 | ||| The returned value is the remaining number of seconds on any
 78 | ||| previously set timer. The timer can be disabled by setting
 79 | ||| this to zero.
 80 | export %foreign "C:alarm, posix-idris"
 81 | alarm : UInt -> PrimIO UInt
 82 |
 83 | ||| Writes the current time for the given clock into the
 84 | ||| `IOTimespec` pointer.
 85 | export %inline
 86 | clockGetTime : ClockId -> IOTimespec -> EPrim ()
 87 | clockGetTime c t = toUnit $ prim__clock_gettime (clockCode c) (unwrap t)
 88 |
 89 | ||| Writes the resolution for the given clock into the
 90 | ||| `IOTimespec` pointer.
 91 | export %inline
 92 | clockGetRes : ClockId -> IOTimespec -> EPrim ()
 93 | clockGetRes c t = toUnit $ prim__clock_getres (clockCode c) (unwrap t)
 94 |
 95 | ||| High resolution sleeping for the duration given in `dur`.
 96 | |||
 97 | ||| In case this is interrupted by a signal, it returns `Left EINTR`
 98 | ||| and writes the remaining duration into `rem`.
 99 | export %inline
100 | nanosleep_ : (dur,rem : IOTimespec) -> EPrim ()
101 | nanosleep_ d r = toUnit $ prim__nanosleep (unwrap d) (unwrap r)
102 |
103 | ||| Like `nanosleep` but allows us to specify the system clock to use.
104 | export %inline
105 | clockNanosleep : ClockId -> (dur,rem : IOTimespec) -> EPrim ()
106 | clockNanosleep c d r =
107 |   posToUnit $ prim__clock_nanosleep (clockCode c) (unwrap d) (unwrap r)
108 |
109 | ||| Like `clockNanosleep` but uses an absolute time value instead of a duration.
110 | |||
111 | ||| This is useful to get exact wakeup times even in case of lots of signal
112 | ||| interrupts.
113 | export %inline
114 | clockNanosleepAbs : ClockId -> (time : IOTimespec) -> EPrim ()
115 | clockNanosleepAbs c d =
116 |   posToUnit $ prim__clock_nanosleep_abs (clockCode c) (unwrap d)
117 |
118 | --------------------------------------------------------------------------------
119 | -- Convenience API
120 | --------------------------------------------------------------------------------
121 |
122 | public export
123 | ClockTpe : ClockId -> ClockType
124 | ClockTpe CLOCK_REALTIME           = UTC
125 | ClockTpe CLOCK_MONOTONIC          = Monotonic
126 | ClockTpe CLOCK_PROCESS_CPUTIME_ID = Process
127 | ClockTpe CLOCK_THREAD_CPUTIME_ID  = Thread
128 |
129 | public export
130 | IClock : ClockId -> Type
131 | IClock = Clock . ClockTpe
132 |
133 | ||| Like `setitimer` but does not store the old timer in a pointer.
134 | export %inline
135 | setTimer : Which -> Timerval -> EPrim ()
136 | setTimer w (TRV (TV si ui) (TV sv uv)) =
137 |   toUnit $ prim__setitimer1 (whichCode w) si ui sv uv
138 |
139 | ||| Returns the currently set timer for `Which`.
140 | export
141 | getTimer : Which -> EPrim Timerval
142 | getTimer wh =
143 |   withStruct Itimerval $ \str,t =>
144 |     let _ # t := toF1 (getitimer wh str) t
145 |         r # t := timerval str t
146 |      in R r t
147 |
148 | ||| Returns the current time for the given clock.
149 | export
150 | getTime : (c : ClockId) -> EPrim (IClock c)
151 | getTime c =
152 |   withStruct STimespec $ \str,t =>
153 |     let R _ t := clockGetTime c str t | E x t => E x t
154 |         c # t := toClock str t
155 |      in R c t
156 |
157 | ||| Returns the resolution for the given clock.
158 | export
159 | getResolution : (c : ClockId) -> EPrim (IClock c)
160 | getResolution c =
161 |   withStruct STimespec $ \str,t =>
162 |     let R _ t := clockGetRes c str t | E x t => E x t
163 |         c # t := toClock str t
164 |      in R c t
165 |
166 | ||| Like `nanosleep` but without the capability of keeping track of the
167 | ||| remaining duration in case of a signal interrupt.
168 | export %inline
169 | nanosleep : (dur : Clock Monotonic) -> EPrim ()
170 | nanosleep cl = toUnit $ prim__nanosleep1 cl.secs cl.nsecs
171 |