├── .smackspec ├── LICENSE ├── Makefile ├── README ├── ev-epoll-mlton.sml ├── ev-epoll-poly.sml ├── ev-kqueue-mlton-old.sml ├── ev-kqueue-mlton.sml ├── ev-kqueue-poly-old.sml ├── ev-kqueue-polyml.sml ├── ev-poll.sml ├── ev-timer.use ├── ev-with-timer.sml ├── ev.use ├── hash-array.sml ├── main.sml ├── t-timer.mlb ├── t-timer.mlp ├── t-timer.sml ├── t.mlb ├── t.mlp └── t.sml /.smackspec: -------------------------------------------------------------------------------- 1 | description: kqueue (*BSD) and epoll (Linux) library for Standard ML (MLton and Poly/ML) 2 | maintainer: Nick Kostyria 3 | keywords: SML,I/O,async 4 | license: BSD3 5 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016-2022, Nick Kostyria 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | 7 | * Redistributions of source code must retain the above copyright 8 | notice, this list of conditions and the following disclaimer. 9 | * Redistributions in binary form must reproduce the above copyright 10 | notice, this list of conditions and the following disclaimer in the 11 | documentation and/or other materials provided with the distribution. 12 | * Neither the name of the author nor the 13 | names of its contributors may be used to endorse or promote products 14 | derived from this software without specific prior written permission. 15 | 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 17 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 18 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 19 | DISCLAIMED. IN NO EVENT SHALL BE LIABLE FOR ANY 20 | DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 21 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 22 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 23 | ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 24 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 25 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 26 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | help: 2 | @echo "target: poly mlton timer-poly timer-mlton poll-poly poll-mlton clean" 3 | 4 | all: poly timer-poly mlton timer-mlton 5 | 6 | poly: 7 | polyc -o t-poly t.mlp 8 | 9 | timer-poly: 10 | polyc -o t-timer-poly t-timer.mlp 11 | 12 | poll-poly: 13 | polyc -o t-poll-poly t-poll.mlp 14 | 15 | mlton: 16 | mlton -default-ann 'allowFFI true' -output t-mlton t.mlb 17 | 18 | timer-mlton: 19 | mlton -default-ann 'allowFFI true' -output t-timer-mlton t-timer.mlb 20 | 21 | poll-mlton: 22 | mlton -output t-poll-mlton t-poll.mlb 23 | 24 | clean: 25 | rm -rf t-poly t-mlton t-timer-poly t-timer-mlton poll-poly poll-mlton 26 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | sml-ev - kqueue (*BSD), epoll (Linux), poll library for Standard ML (MLton and Poly/ML). 2 | 3 | ev-{kqueue,epoll}-{poly,mlton}.sml - base library 4 | ev-poll.sml - OS.IO.poll from The Standard ML Basis Library 5 | ev-with-timer.sml - added evTimer* functions 6 | 7 | Execute "make poly" or "make mlton" command to build "t.sml" test. 8 | Firstly, you need to edit "t.mlp" (Poly/ML) or "t.mlb" (MLton) for Linux: replace kqueue on epoll. 9 | 10 | Before running a test you should launch simple tcp servers on 8081 and 8082 ports, for example: 11 | echo pong | nc -l 8081 (*BSD) or echo pong | nc -l -p 8081 (Linux) 12 | 13 | To build timer's test (t-timer.sml) execute "make timer-poly" or "make timer-mlton". 14 | 15 | 16 | N.B. 17 | About *BSD. 18 | It works on FreeBSD 12 as it is. 19 | Use ev-kqueue-mlton-old.sml and ev-kqueue-poly-old.sml for FreeBSD 11, NetBSD and OpenBSD. 20 | 21 | 22 | About ARM and ARM64 of MLton version. 23 | It tested on ARM FreeBSD 12 (Nanopi NEO board) and ARM64 FreeBSD 12 (qemu). 24 | Linux MLton version do not tested but should work on ARM and ARM64. 25 | -------------------------------------------------------------------------------- /ev-epoll-mlton.sml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2016 Nick Kostyria. BSD3 license. *) 2 | 3 | signature OS_IO_EV = sig 4 | 5 | type evFd = int 6 | datatype evFilter = evRead | evWrite 7 | type evCb = (evFd * evFilter) -> unit 8 | datatype evDesc = evAdd of evFd * evFilter * evCb | evDelete of evFd * evFilter 9 | type ev 10 | 11 | exception Ev of string 12 | 13 | val evInit: unit -> ev 14 | val evModify: ev -> evDesc list -> int 15 | val evWait: ev -> Time.time option -> int 16 | end 17 | 18 | 19 | structure Ev :> OS_IO_EV = 20 | struct 21 | 22 | structure H = HashArrayInt 23 | 24 | type evFd = int 25 | datatype evFilter = evRead | evWrite 26 | type evCb = (evFd * evFilter) -> unit 27 | datatype evDesc = evAdd of evFd * evFilter * evCb | evDelete of evFd * evFilter 28 | type ev = {ev: int, rH: evCb H.hash, wH: evCb H.hash} 29 | 30 | exception Ev of string 31 | val () = MLton.Exn.addExnMessager (fn Ev m => SOME ("Ev \"" ^ m ^ "\"") | _ => NONE) 32 | 33 | local 34 | open MLton.Pointer 35 | open MLton.Platform 36 | 37 | val max_events = 64 38 | val hash_size = 1000 39 | 40 | 41 | val (epoll_event_size, epoll_data_fd_offsetof) = 42 | if Arch.host = Arch.X86 orelse Arch.host = Arch.AMD64 then (12, 0w4) else 43 | if Arch.host = Arch.ARM orelse Arch.host = Arch.ARM64 then (16, 0w8) else 44 | raise Ev "Unsupported platform" 45 | 46 | 47 | val malloc = (_import "malloc" : Word.word -> t;) o Word.fromInt 48 | val epoll_event_pointer = malloc (epoll_event_size * max_events) 49 | 50 | 51 | val epoll_create = _import "epoll_create" : int -> int; 52 | val epoll_ctl_ffi = _import "epoll_ctl" : int * int * int * t -> int; 53 | val epoll_wait_ffi = _import "epoll_wait" : int * t * int * int -> int; 54 | 55 | 56 | val EPOLL_CTL_ADD = 1 and EPOLL_CTL_DEL = 2 and EPOLL_CTL_MOD = 3 57 | 58 | 59 | fun epoll_ctl ev ctl fd event = ( 60 | setInt32 (epoll_event_pointer, 0, Int32.fromInt event); 61 | setWord32 (add (epoll_event_pointer, epoll_data_fd_offsetof), 0, Word32.fromInt fd); 62 | if epoll_ctl_ffi (ev, ctl, fd, epoll_event_pointer) = 0 63 | then 1 64 | else if ctl = EPOLL_CTL_DEL then 0 else raise Ev "evModify" 65 | ) 66 | 67 | 68 | val epoll_event_array = Array.array (max_events, (0, 0)) 69 | 70 | 71 | fun epoll_wait ev epoll_event_array t = 72 | let 73 | val cnt = epoll_wait_ffi (ev, epoll_event_pointer, max_events, t) 74 | 75 | fun doit p i n = 76 | if i = n 77 | then n 78 | else 79 | let 80 | val events = Word32.toInt (getWord32 (p, 0)) 81 | val fd = Int32.toInt (getInt32 (add (p, epoll_data_fd_offsetof), 0)) 82 | in 83 | Array.update (epoll_event_array, i, (events, fd)); 84 | doit (add (p, Word.fromInt epoll_event_size)) (i+1) n 85 | end 86 | in 87 | if cnt >= 0 88 | then doit epoll_event_pointer 0 cnt 89 | else cnt 90 | end 91 | 92 | in 93 | 94 | fun evInit () = 95 | let 96 | val ev = epoll_create 1 97 | in 98 | if ev = ~1 then raise Ev "evInit" else 99 | { ev = ev, rH = H.hash hash_size, wH = H.hash hash_size } 100 | end 101 | 102 | 103 | fun evModify {ev=ev, rH=rH, wH=wH } ev_desc_list = 104 | let 105 | 106 | fun isNotSome v = if isSome v then false else true 107 | 108 | infix xorb 109 | fun op xorb (a:int, b:int) : int = Word.toInt (Word.xorb (Word.fromInt a, Word.fromInt b)) 110 | 111 | val EPOLLIN = 1 and EPOLLOUT = 4 112 | 113 | fun evModifyOne (evAdd (fd, evRead, cb)) = if isSome (H.sub (rH, fd)) then 0 else ( ( 114 | if isSome (H.sub (wH, fd)) 115 | then epoll_ctl ev EPOLL_CTL_MOD fd (EPOLLIN xorb EPOLLOUT) 116 | else epoll_ctl ev EPOLL_CTL_ADD fd EPOLLIN 117 | ); H.update (rH, fd, cb); 1 ) 118 | 119 | | evModifyOne (evAdd (fd, evWrite, cb)) = if isSome (H.sub (wH, fd)) then 0 else ( ( 120 | if isSome (H.sub (rH, fd)) 121 | then epoll_ctl ev EPOLL_CTL_MOD fd (EPOLLIN xorb EPOLLOUT) 122 | else epoll_ctl ev EPOLL_CTL_ADD fd EPOLLOUT 123 | ); H.update (wH, fd, cb); 1 ) 124 | 125 | | evModifyOne (evDelete (fd, evRead)) = if isNotSome (H.sub (rH, fd)) then 0 else ( ( 126 | if isSome (H.sub (wH, fd)) 127 | then epoll_ctl ev EPOLL_CTL_MOD fd EPOLLOUT 128 | else epoll_ctl ev EPOLL_CTL_DEL fd 0 129 | ); H.delete (rH, fd); 1 ) 130 | 131 | | evModifyOne (evDelete (fd, evWrite)) = if isNotSome (H.sub (wH, fd)) then 0 else ( ( 132 | if isSome (H.sub (rH, fd)) 133 | then epoll_ctl ev EPOLL_CTL_MOD fd EPOLLIN 134 | else epoll_ctl ev EPOLL_CTL_DEL fd 0 135 | ); H.delete (wH, fd); 1 ) 136 | 137 | in 138 | foldl ( fn (ev_desc, cnt) => cnt + evModifyOne ev_desc ) 0 ev_desc_list 139 | end 140 | 141 | 142 | fun evWait (ev:ev) t = 143 | let 144 | 145 | val timeout = case t of SOME t => LargeInt.toInt (Time.toMilliseconds t) | NONE => ~1 146 | 147 | val cnt = epoll_wait (#ev ev) epoll_event_array timeout 148 | 149 | infix xorb 150 | infix andb 151 | 152 | val op xorb = Word.xorb 153 | val op andb = Word.andb 154 | 155 | val EPOLLIN = 0wx001 and EPOLLOUT = 0wx004 and EPOLLERR = 0wx008 and EPOLLHUP = 0wx010 156 | 157 | fun isRead events = case (Word.fromInt events) andb (EPOLLIN xorb EPOLLERR xorb EPOLLHUP) of 0w0 => false | _ => true 158 | fun isWrite events = case (Word.fromInt events) andb (EPOLLOUT xorb EPOLLERR xorb EPOLLHUP) of 0w0 => false | _ => true 159 | 160 | fun getCb fd evRead = H.sub ((#rH ev), fd) 161 | | getCb fd evWrite = H.sub ((#wH ev), fd) 162 | 163 | fun doCb fd filter = 164 | case getCb fd filter of 165 | SOME cb => cb (fd, filter) 166 | | NONE => () 167 | 168 | val cnt_all = ref 0 169 | fun cnt_all_up () = cnt_all := (!cnt_all) + 1 170 | 171 | fun new_loop 0 = (!cnt_all) 172 | | new_loop i = 173 | let 174 | val (events, fd) = Array.sub (epoll_event_array, (i-1)) 175 | in 176 | if isRead events then (doCb fd evRead ; cnt_all_up () ) else (); 177 | if isWrite events then (doCb fd evWrite; cnt_all_up () ) else (); 178 | new_loop (i - 1) 179 | end 180 | 181 | in 182 | if cnt >= 0 183 | then new_loop cnt 184 | else cnt 185 | end 186 | end 187 | 188 | end 189 | -------------------------------------------------------------------------------- /ev-epoll-poly.sml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2016 Nick Kostyria. BSD3 license. *) 2 | 3 | signature OS_IO_EV = sig 4 | 5 | type evFd = int 6 | datatype evFilter = evRead | evWrite 7 | type evCb = (evFd * evFilter) -> unit 8 | datatype evDesc = evAdd of evFd * evFilter * evCb | evDelete of evFd * evFilter 9 | type ev 10 | 11 | exception Ev of string 12 | 13 | val evInit: unit -> ev 14 | val evModify: ev -> evDesc list -> int 15 | val evWait: ev -> Time.time option -> int 16 | end 17 | 18 | 19 | structure Ev :> OS_IO_EV = 20 | struct 21 | 22 | structure H = HashArrayInt 23 | 24 | type evFd = int 25 | datatype evFilter = evRead | evWrite 26 | type evCb = (evFd * evFilter) -> unit 27 | datatype evDesc = evAdd of evFd * evFilter * evCb | evDelete of evFd * evFilter 28 | type ev = {ev: int, rH: evCb H.hash, wH: evCb H.hash} 29 | 30 | exception Ev of string 31 | 32 | local 33 | open Foreign 34 | 35 | val max_events = 8 36 | val hash_size = 1000 37 | 38 | val libc = loadExecutable () 39 | 40 | local 41 | val { load=load, store=store, ctype={ align=align, typeForm=ffiType, ...} } = breakConversion cInt32 42 | val ctype = { size= #size LowLevel.cTypeInt64, align=align, typeForm=ffiType } 43 | in 44 | val cInt32forUnion64: int conversion = makeConversion{ load=load, store=store, ctype = ctype } 45 | end 46 | 47 | val epoll_event_conversion = cStruct2 (cUint32, cInt32forUnion64) 48 | 49 | val epoll_create = buildCall1 ((getSymbol libc "epoll_create"), cInt, cInt) 50 | val epoll_ctl_ffi = buildCall4 ((getSymbol libc "epoll_ctl"), (cInt, cInt, cInt, cConstStar epoll_event_conversion), cInt) 51 | val epoll_wait_ffi = buildCall4 ((getSymbol libc "epoll_wait"), (cInt, cArrayPointer epoll_event_conversion, cInt, cInt), cInt) 52 | 53 | val EPOLL_CTL_ADD = 1 and EPOLL_CTL_DEL = 2 and EPOLL_CTL_MOD = 3 54 | 55 | fun epoll_ctl ev ctl fd event = 56 | if epoll_ctl_ffi(ev, ctl, fd, (event, fd)) = 0 57 | then 1 58 | else if ctl = EPOLL_CTL_DEL then 0 else raise Ev "evModify" 59 | 60 | val epoll_event_array = Array.array (max_events, (0,0)) 61 | 62 | in 63 | 64 | fun evInit () = 65 | let 66 | val ev = epoll_create 1 67 | in 68 | if ev = ~1 then raise Ev "evInit" else 69 | { ev = ev, rH = H.hash hash_size, wH = H.hash hash_size } 70 | end 71 | 72 | 73 | fun evModify {ev=ev, rH=rH, wH=wH } ev_desc_list = 74 | let 75 | 76 | fun isNotSome v = if isSome v then false else true 77 | 78 | infix xorb 79 | fun op xorb(a:int,b:int):int = Word.toInt(Word.xorb(Word.fromInt a, Word.fromInt b)) 80 | 81 | val EPOLLIN = 1 and EPOLLOUT = 4 82 | 83 | fun evModifyOne (evAdd (fd, evRead, cb)) = if isSome (H.sub (rH, fd)) then 0 else ( ( 84 | if isSome (H.sub (wH, fd)) 85 | then epoll_ctl ev EPOLL_CTL_MOD fd (EPOLLIN xorb EPOLLOUT) 86 | else epoll_ctl ev EPOLL_CTL_ADD fd EPOLLIN 87 | ); H.update (rH, fd, cb); 1 ) 88 | 89 | | evModifyOne (evAdd (fd, evWrite, cb)) = if isSome (H.sub (wH, fd)) then 0 else ( ( 90 | if isSome (H.sub (rH, fd)) 91 | then epoll_ctl ev EPOLL_CTL_MOD fd (EPOLLIN xorb EPOLLOUT) 92 | else epoll_ctl ev EPOLL_CTL_ADD fd EPOLLOUT 93 | ); H.update (wH, fd, cb); 1 ) 94 | 95 | | evModifyOne (evDelete (fd, evRead)) = if isNotSome (H.sub (rH, fd)) then 0 else ( ( 96 | if isSome (H.sub (wH, fd)) 97 | then epoll_ctl ev EPOLL_CTL_MOD fd EPOLLOUT 98 | else epoll_ctl ev EPOLL_CTL_DEL fd 0 99 | ); H.delete (rH, fd); 1 ) 100 | 101 | | evModifyOne (evDelete (fd, evWrite)) = if isNotSome (H.sub (wH, fd)) then 0 else ( ( 102 | if isSome (H.sub (rH, fd)) 103 | then epoll_ctl ev EPOLL_CTL_MOD fd EPOLLIN 104 | else epoll_ctl ev EPOLL_CTL_DEL fd 0 105 | ); H.delete (wH, fd); 1 ) 106 | 107 | in 108 | foldl ( fn(ev_desc,cnt) => cnt + evModifyOne ev_desc ) 0 ev_desc_list 109 | end 110 | 111 | 112 | fun evWait (ev:ev) t = 113 | let 114 | 115 | val timeout = case t of SOME t => Int.fromLarge (Time.toMilliseconds t) | NONE => ~1 116 | 117 | val cnt = epoll_wait_ffi((#ev ev), epoll_event_array, (Array.length epoll_event_array), timeout) 118 | 119 | infix xorb 120 | infix andb 121 | 122 | val op xorb = Word.xorb 123 | val op andb = Word.andb 124 | 125 | val EPOLLIN = 0wx001 and EPOLLOUT = 0wx004 and EPOLLERR = 0wx008 and EPOLLHUP = 0wx010 126 | 127 | fun isRead events = case (Word.fromInt events) andb (EPOLLIN xorb EPOLLERR xorb EPOLLHUP) of 0w0 => false | _ => true 128 | fun isWrite events = case (Word.fromInt events) andb (EPOLLOUT xorb EPOLLERR xorb EPOLLHUP) of 0w0 => false | _ => true 129 | 130 | fun getCb fd evRead = H.sub ((#rH ev), fd) 131 | | getCb fd evWrite = H.sub ((#wH ev), fd) 132 | 133 | fun doCb fd filter = 134 | case getCb fd filter of 135 | SOME cb => cb (fd, filter) 136 | | NONE => () 137 | 138 | val cnt_all = ref 0 139 | fun cnt_all_up () = cnt_all := (!cnt_all) + 1 140 | 141 | fun new_loop 0 = (!cnt_all) 142 | | new_loop i = 143 | let 144 | val (events,fd) = Array.sub(epoll_event_array, (i-1)) 145 | in 146 | if isRead events then (doCb fd evRead ; cnt_all_up () ) else (); 147 | if isWrite events then (doCb fd evWrite; cnt_all_up () ) else (); 148 | new_loop (i - 1) 149 | end 150 | 151 | 152 | in 153 | if cnt >= 0 154 | then new_loop cnt 155 | else cnt 156 | end 157 | end 158 | 159 | end 160 | -------------------------------------------------------------------------------- /ev-kqueue-mlton-old.sml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2016 Nick Kostyria. BSD3 license. *) 2 | 3 | signature OS_IO_EV = sig 4 | 5 | type evFd = int 6 | datatype evFilter = evRead | evWrite 7 | type evCb = (evFd * evFilter) -> unit 8 | datatype evDesc = evAdd of evFd * evFilter * evCb | evDelete of evFd * evFilter 9 | type ev 10 | 11 | exception Ev of string 12 | 13 | val evInit: unit -> ev 14 | val evModify: ev -> evDesc list -> int 15 | val evWait: ev -> Time.time option -> int 16 | end 17 | 18 | 19 | structure Ev :> OS_IO_EV = 20 | struct 21 | 22 | structure H = HashArrayInt 23 | 24 | type evFd = int 25 | datatype evFilter = evRead | evWrite 26 | type evCb = (evFd * evFilter) -> unit 27 | datatype evDesc = evAdd of evFd * evFilter * evCb | evDelete of evFd * evFilter 28 | type ev = {ev: int, rH: evCb H.hash, wH: evCb H.hash} 29 | 30 | exception Ev of string 31 | val () = MLton.Exn.addExnMessager (fn Ev m => SOME ("Ev \"" ^ m ^ "\"") | _ => NONE) 32 | 33 | local 34 | open MLton.Pointer 35 | 36 | val max_events = 64 37 | val hash_size = 1000 38 | 39 | val is_64bit = sizeofPointer = 0w8 40 | 41 | val malloc = (_import "malloc" : Word.word -> t;) o Word.fromInt 42 | 43 | val kevent_size = if is_64bit then 32 else 20 44 | val kevent_list_pointer = malloc (kevent_size * max_events) 45 | val timeout_pointer = malloc (if is_64bit then 16 else 8) 46 | 47 | val kqueue = _import "kqueue" : unit -> int; 48 | 49 | val kevent = _import "kevent" : int * t * int * t * int * t -> int; 50 | 51 | fun setC_Ulong(p:t, v:int):t = ( 52 | if is_64bit 53 | then setWord64(p, 0, Word64.fromInt(v)) 54 | else setWord32(p, 0, Word32.fromInt(v)); 55 | add (p, sizeofPointer) 56 | ) 57 | 58 | fun setC_Long(p:t, v:int):t = ( 59 | if is_64bit 60 | then setInt64(p, 0, Int64.fromInt(v)) 61 | else setInt32(p, 0, Int32.fromInt(v)); 62 | add (p, sizeofPointer) 63 | ) 64 | 65 | fun setC_Pointer(p, v) = ( setPointer(p, 0, v); add (p, sizeofPointer) ) 66 | 67 | fun setC_Int16(p, v:int) = ( setInt16(p, 0, Int16.fromInt(v)); add (p, 0wx2) ) 68 | fun setC_Word16(p, v:int) = ( setWord16(p, 0, Word16.fromInt v); add (p, 0wx2) ) 69 | fun setC_Word32(p, v:int) = ( setWord32(p, 0, Word32.fromInt v); add (p, 0wx4) ) 70 | 71 | 72 | fun getC_Ulong(p:t):(t*int) = 73 | let 74 | val v = if is_64bit then Word64.toInt(getWord64(p, 0)) else Word32.toInt(getWord32(p, 0)) 75 | val p = add (p, sizeofPointer) 76 | in (p,v) end 77 | 78 | fun getC_Long(p:t):(t*int) = 79 | let 80 | val v = if is_64bit then Int64.toInt(getInt64(p, 0)) else Int32.toInt(getInt32(p, 0)) 81 | val p = add (p, sizeofPointer) 82 | in (p,v) end 83 | 84 | fun getC_Int16(p):(t*int) = let val v = Int16.toInt(getInt16(p, 0)) val p = add (p, 0wx2) in (p,v) end 85 | fun getC_Word16(p):(t*int) = let val v = Word16.toInt(getWord16(p, 0)) val p = add (p, 0wx2) in (p,v) end 86 | fun getC_Word32(p):(t*int) = let val v = Word32.toInt(getWord32(p, 0)) val p = add (p, 0wx4) in (p,v) end 87 | 88 | fun getC_Pointer(p) = let val v = getPointer(p, 0) val p = add (p, sizeofPointer) in (p,v) end 89 | 90 | 91 | fun kevent_change kq changelist = 92 | let 93 | fun pack_kevent_struct_list p l = 94 | let 95 | fun pack_kevent_struct((ident, filter, flags, fflags, data, udata), p) = 96 | let 97 | val p = setC_Ulong(p,ident) 98 | val p = setC_Int16(p, filter) 99 | val p = setC_Word16(p, flags) 100 | val p = setC_Word32(p, fflags) 101 | val p = setC_Long(p, data) 102 | val p = setC_Pointer(p, null) 103 | in p end 104 | in 105 | Vector.foldl pack_kevent_struct p l 106 | end 107 | in 108 | pack_kevent_struct_list kevent_list_pointer changelist; 109 | kevent(kq, kevent_list_pointer, Vector.length changelist, MLton.Pointer.null, 0, MLton.Pointer.null) 110 | end 111 | 112 | fun kevent_wait kq eventlist t = 113 | let 114 | 115 | fun pack_timeout t = 116 | case t of 117 | NONE => MLton.Pointer.null 118 | | SOME (s, n) => 119 | let 120 | val p = setC_Long (timeout_pointer, s) 121 | val _ = setC_Long (p, n) 122 | in timeout_pointer end 123 | 124 | val cnt = kevent(kq, MLton.Pointer.null, 0, kevent_list_pointer, max_events, (pack_timeout t)) 125 | 126 | fun unpack_kevent_struct_list p n = 127 | let 128 | fun unpack_kevent_struct p = 129 | let 130 | 131 | val (p, ident) = getC_Ulong(p) 132 | val (p, filter) = getC_Int16(p) 133 | val (p, flags) = getC_Word16(p) 134 | val (p, fflags) = getC_Word32(p) 135 | val (p, data) = getC_Long(p) 136 | val (p, _) = getC_Pointer(p) 137 | in ((ident, filter, flags, fflags, data, {}), p) end 138 | 139 | fun doit p i n = 140 | if i = n 141 | then n 142 | else 143 | let 144 | val (v,p) = unpack_kevent_struct p 145 | in 146 | Array.update(eventlist, i, v); 147 | doit p (i+1) n 148 | end 149 | in 150 | doit p 0 n 151 | end 152 | 153 | in 154 | if cnt > 0 155 | then unpack_kevent_struct_list kevent_list_pointer cnt 156 | else cnt 157 | end 158 | 159 | 160 | val kevent_struct_empty = (0,0,0,0,0,{}) 161 | val eventlist = Array.array (max_events, kevent_struct_empty) 162 | 163 | in 164 | fun evInit () = 165 | let 166 | val ev = kqueue () 167 | in 168 | if ev = ~1 then raise Ev "evInit" else 169 | { ev = ev, rH = H.hash hash_size, wH = H.hash hash_size } 170 | end 171 | 172 | 173 | fun evModify (ev:ev) ev_desc_list = 174 | let 175 | fun evFilterToInt evRead = ~1 176 | | evFilterToInt evWrite = ~2 177 | 178 | fun evFilterToH evRead = #rH ev 179 | | evFilterToH evWrite = #wH ev 180 | 181 | fun toChange fd filter action = (fd, (evFilterToInt filter), action, 0, 0, {}) 182 | 183 | fun evDescToChange (evAdd (fd, filter, cb)) = toChange fd filter 1 184 | | evDescToChange (evDelete (fd, filter)) = toChange fd filter 2 185 | 186 | 187 | fun evDescFilter (evAdd (fd, filter, cb)) = (H.update ((evFilterToH filter), fd, cb); true) 188 | | evDescFilter (evDelete (fd, filter)) = 189 | let 190 | val H = evFilterToH filter 191 | in 192 | if isSome (H.sub (H, fd)) 193 | then ( H.delete (H, fd) ; true ) 194 | else false 195 | end 196 | 197 | 198 | val changelist = Vector.fromList ( map evDescToChange ( List.filter evDescFilter ev_desc_list ) ) 199 | 200 | val _ = if Vector.length changelist > max_events then raise Ev "too big changelist" else () 201 | 202 | val cnt = kevent_change (#ev ev) changelist 203 | in 204 | if cnt >= 0 205 | then cnt 206 | else raise Ev "evModify" 207 | end 208 | 209 | 210 | fun evWait (ev:ev) t = 211 | let 212 | val timeout = case t of 213 | SOME t => 214 | let 215 | val s = Time.toSeconds t 216 | val n = Time.toNanoseconds(t) - s * 1000000000 217 | in 218 | SOME (Int.fromLarge s, Int.fromLarge n) 219 | end 220 | | NONE => NONE 221 | 222 | val cnt = kevent_wait (#ev ev) eventlist timeout 223 | 224 | fun intToevFilter (~1) = evRead 225 | | intToevFilter (~2) = evWrite 226 | | intToevFilter _ = raise Ev "intToevFilter" 227 | 228 | fun getCb fd evRead = H.sub ((#rH ev), fd) 229 | | getCb fd evWrite = H.sub ((#wH ev), fd) 230 | 231 | fun new_loop 0 = cnt 232 | | new_loop i = 233 | let 234 | val (fd,f,_,_,_,_) = Array.sub(eventlist, (i-1)) 235 | val filter = intToevFilter f 236 | in 237 | case getCb fd filter of 238 | SOME cb => cb (fd, filter) 239 | | NONE => () 240 | ; 241 | new_loop (i - 1) 242 | end 243 | 244 | in 245 | if cnt >= 0 246 | then new_loop cnt 247 | else cnt 248 | end 249 | end 250 | 251 | end 252 | -------------------------------------------------------------------------------- /ev-kqueue-mlton.sml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2016 Nick Kostyria. BSD3 license. *) 2 | 3 | signature OS_IO_EV = sig 4 | 5 | type evFd = int 6 | datatype evFilter = evRead | evWrite 7 | type evCb = (evFd * evFilter) -> unit 8 | datatype evDesc = evAdd of evFd * evFilter * evCb | evDelete of evFd * evFilter 9 | type ev 10 | 11 | exception Ev of string 12 | 13 | val evInit: unit -> ev 14 | val evModify: ev -> evDesc list -> int 15 | val evWait: ev -> Time.time option -> int 16 | end 17 | 18 | 19 | structure Ev :> OS_IO_EV = 20 | struct 21 | 22 | structure H = HashArrayInt 23 | 24 | type evFd = int 25 | datatype evFilter = evRead | evWrite 26 | type evCb = (evFd * evFilter) -> unit 27 | datatype evDesc = evAdd of evFd * evFilter * evCb | evDelete of evFd * evFilter 28 | type ev = {ev: int, rH: evCb H.hash, wH: evCb H.hash} 29 | 30 | exception Ev of string 31 | val () = MLton.Exn.addExnMessager (fn Ev m => SOME ("Ev \"" ^ m ^ "\"") | _ => NONE) 32 | 33 | local 34 | open MLton.Pointer 35 | open MLton.Platform 36 | 37 | val max_events = 64 38 | val hash_size = 1000 39 | 40 | 41 | val (kevent_size, timeout_size) = 42 | case Arch.host of 43 | Arch.X86 => (56, 8) 44 | | Arch.AMD64 => (64, 16) 45 | | Arch.ARM => (64, 16) 46 | | Arch.ARM64 => (64, 16) 47 | | _ => raise Ev "Unsupported platform" 48 | 49 | 50 | val malloc = (_import "malloc" : Word.word -> t;) o Word.fromInt 51 | val kevent_list_pointer = malloc (kevent_size * max_events) 52 | val timeout_pointer = malloc timeout_size 53 | 54 | 55 | val kqueue = _import "kqueue" : unit -> int; 56 | 57 | val kevent = _import "kevent" : int * t * int * t * int * t -> int; 58 | 59 | 60 | fun kevent_change kq changelist = 61 | let 62 | fun pack_kevent_struct_list p l = 63 | let 64 | fun pack_kevent_struct ((ident, filter, flags, fflags, data, udata), p) = ( 65 | case Arch.host of 66 | Arch.X86 => ( 67 | setWord32 (add (p, 0w0), 0, Word32.fromInt ident); 68 | setInt16 (add (p, 0w4), 0, Int16.fromInt filter); 69 | setWord16 (add (p, 0w6), 0, Word16.fromInt flags); 70 | setWord32 (add (p, 0w8), 0, Word32.fromInt fflags); 71 | setInt64 (add (p, 0w12), 0, Int64.fromInt data); 72 | setPointer (add (p, 0w20), 0, null); 73 | setInt64 (add (p, 0w24), 0, 0); 74 | setInt64 (add (p, 0w32), 0, 0); 75 | setInt64 (add (p, 0w40), 0, 0); 76 | setInt64 (add (p, 0w48), 0, 0) 77 | ) 78 | | Arch.AMD64 => ( 79 | setWord64 (add (p, 0w0), 0, Word64.fromInt ident); 80 | setInt16 (add (p, 0w8), 0, Int16.fromInt filter); 81 | setWord16 (add (p, 0w10), 0, Word16.fromInt flags); 82 | setWord32 (add (p, 0w12), 0, Word32.fromInt fflags); 83 | setInt64 (add (p, 0w16), 0, Int64.fromInt data); 84 | setPointer (add (p, 0w24), 0, null); 85 | setInt64 (add (p, 0w32), 0, 0); 86 | setInt64 (add (p, 0w40), 0, 0); 87 | setInt64 (add (p, 0w48), 0, 0); 88 | setInt64 (add (p, 0w56), 0, 0) 89 | ) 90 | | Arch.ARM => ( 91 | setWord32 (add (p, 0w0), 0, Word32.fromInt ident); 92 | setInt16 (add (p, 0w4), 0, Int16.fromInt filter); 93 | setWord16 (add (p, 0w6), 0, Word16.fromInt flags); 94 | setWord32 (add (p, 0w8), 0, Word32.fromInt fflags); 95 | setInt64 (add (p, 0w16), 0, Int64.fromInt data); 96 | setPointer (add (p, 0w24), 0, null); 97 | setInt64 (add (p, 0w32), 0, 0); 98 | setInt64 (add (p, 0w40), 0, 0); 99 | setInt64 (add (p, 0w48), 0, 0); 100 | setInt64 (add (p, 0w56), 0, 0) 101 | ) 102 | | Arch.ARM64 => ( 103 | setWord64 (add (p, 0w0), 0, Word64.fromInt ident); 104 | setInt16 (add (p, 0w8), 0, Int16.fromInt filter); 105 | setWord16 (add (p, 0w10), 0, Word16.fromInt flags); 106 | setWord32 (add (p, 0w12), 0, Word32.fromInt fflags); 107 | setInt64 (add (p, 0w16), 0, Int64.fromInt data); 108 | setPointer (add (p, 0w24), 0, null); 109 | setInt64 (add (p, 0w32), 0, 0); 110 | setInt64 (add (p, 0w40), 0, 0); 111 | setInt64 (add (p, 0w48), 0, 0); 112 | setInt64 (add (p, 0w56), 0, 0) 113 | ) 114 | | _ => raise Ev "Unsupported platform" 115 | ; 116 | add (p, Word.fromInt kevent_size) 117 | ) 118 | in 119 | Vector.foldl pack_kevent_struct p l 120 | end 121 | in 122 | pack_kevent_struct_list kevent_list_pointer changelist; 123 | kevent (kq, kevent_list_pointer, Vector.length changelist, MLton.Pointer.null, 0, MLton.Pointer.null) 124 | end 125 | 126 | fun kevent_wait kq eventlist t = 127 | let 128 | 129 | fun pack_timeout t = 130 | case t of 131 | NONE => MLton.Pointer.null 132 | | SOME (s, n) => ( 133 | case Arch.host of 134 | Arch.X86 => ( 135 | setInt32 (add (timeout_pointer, 0w0), 0, Int32.fromInt s); 136 | setInt32 (add (timeout_pointer, 0w4), 0, Int32.fromInt n) 137 | ) 138 | | Arch.AMD64 => ( 139 | setInt64 (add (timeout_pointer, 0w0), 0, Int64.fromInt s); 140 | setInt64 (add (timeout_pointer, 0w8), 0, Int64.fromInt n) 141 | ) 142 | | Arch.ARM => ( 143 | setInt64 (add (timeout_pointer, 0w0), 0, Int64.fromInt s); 144 | setInt32 (add (timeout_pointer, 0w8), 0, Int32.fromInt n) 145 | ) 146 | | Arch.ARM64 => ( 147 | setInt64 (add (timeout_pointer, 0w0), 0, Int64.fromInt s); 148 | setInt64 (add (timeout_pointer, 0w8), 0, Int64.fromInt n) 149 | ) 150 | | _ => raise Ev "Unsupported platform" 151 | ; 152 | timeout_pointer 153 | ) 154 | 155 | val cnt = kevent (kq, MLton.Pointer.null, 0, kevent_list_pointer, max_events, (pack_timeout t)) 156 | 157 | fun unpack_kevent_struct_list p n = 158 | let 159 | fun unpack_kevent_struct p = 160 | let 161 | val (ident, filter, flags, fflags, data) = 162 | case Arch.host of 163 | Arch.X86 => ( 164 | let 165 | val ident = Word32.toInt (getWord32 (add (p, 0w0), 0)) 166 | val filter = Int16.toInt (getInt16 (add (p, 0w4), 0)) 167 | val flags = Int16.toInt (getInt16 (add (p, 0w6), 0)) 168 | val fflags = Word32.toInt (getWord32 (add (p, 0w8), 0)) 169 | val data = Int64.toInt (getInt64 (add (p, 0w12), 0)) 170 | in (ident, filter, flags, fflags, data) end 171 | ) 172 | | Arch.AMD64 => ( 173 | let 174 | val ident = Word64.toInt (getWord64 (add (p, 0w0), 0)) 175 | val filter = Int16.toInt (getInt16 (add (p, 0w8), 0)) 176 | val flags = Int16.toInt (getInt16 (add (p, 0w10), 0)) 177 | val fflags = Word32.toInt (getWord32 (add (p, 0w12), 0)) 178 | val data = Int64.toInt (getInt64 (add (p, 0w16), 0)) 179 | in (ident, filter, flags, fflags, data) end 180 | ) 181 | | Arch.ARM => ( 182 | let 183 | val ident = Word32.toInt (getWord32 (add (p, 0w0), 0)) 184 | val filter = Int16.toInt (getInt16 (add (p, 0w4), 0)) 185 | val flags = Int16.toInt (getInt16 (add (p, 0w6), 0)) 186 | val fflags = Word32.toInt (getWord32 (add (p, 0w8), 0)) 187 | val data = Int64.toInt (getInt64 (add (p, 0w16), 0)) 188 | in (ident, filter, flags, fflags, data) end 189 | ) 190 | | Arch.ARM64 => ( 191 | let 192 | val ident = Word64.toInt (getWord64 (add (p, 0w0), 0)) 193 | val filter = Int16.toInt (getInt16 (add (p, 0w8), 0)) 194 | val flags = Int16.toInt (getInt16 (add (p, 0w10), 0)) 195 | val fflags = Word32.toInt (getWord32 (add (p, 0w12), 0)) 196 | val data = Int64.toInt (getInt64 (add (p, 0w16), 0)) 197 | in (ident, filter, flags, fflags, data) end 198 | ) 199 | | _ => raise Ev "Unsupported platform" 200 | in 201 | ((ident, filter, flags, fflags, data, {}), add (p, Word.fromInt kevent_size)) 202 | end 203 | 204 | fun doit p i n = 205 | if i = n 206 | then n 207 | else 208 | let 209 | val (v,p) = unpack_kevent_struct p 210 | in 211 | Array.update (eventlist, i, v); 212 | doit p (i+1) n 213 | end 214 | in 215 | doit p 0 n 216 | end 217 | 218 | in 219 | if cnt > 0 220 | then unpack_kevent_struct_list kevent_list_pointer cnt 221 | else cnt 222 | end 223 | 224 | 225 | val kevent_struct_empty = (0,0,0,0,0,{}) 226 | val eventlist = Array.array (max_events, kevent_struct_empty) 227 | 228 | in 229 | fun evInit () = 230 | let 231 | val ev = kqueue () 232 | in 233 | if ev = ~1 then raise Ev "evInit" else 234 | { ev = ev, rH = H.hash hash_size, wH = H.hash hash_size } 235 | end 236 | 237 | 238 | fun evModify (ev:ev) ev_desc_list = 239 | let 240 | fun evFilterToInt evRead = ~1 241 | | evFilterToInt evWrite = ~2 242 | 243 | fun evFilterToH evRead = #rH ev 244 | | evFilterToH evWrite = #wH ev 245 | 246 | fun toChange fd filter action = (fd, (evFilterToInt filter), action, 0, 0, {}) 247 | 248 | fun evDescToChange (evAdd (fd, filter, cb)) = toChange fd filter 1 249 | | evDescToChange (evDelete (fd, filter)) = toChange fd filter 2 250 | 251 | 252 | fun evDescFilter (evAdd (fd, filter, cb)) = (H.update ((evFilterToH filter), fd, cb); true) 253 | | evDescFilter (evDelete (fd, filter)) = 254 | let 255 | val H = evFilterToH filter 256 | in 257 | if isSome (H.sub (H, fd)) 258 | then ( H.delete (H, fd) ; true ) 259 | else false 260 | end 261 | 262 | 263 | val changelist = Vector.fromList ( map evDescToChange ( List.filter evDescFilter ev_desc_list ) ) 264 | 265 | val _ = if Vector.length changelist > max_events then raise Ev "too big changelist" else () 266 | 267 | val cnt = kevent_change (#ev ev) changelist 268 | in 269 | if cnt >= 0 270 | then cnt 271 | else raise Ev "evModify" 272 | end 273 | 274 | 275 | fun evWait (ev:ev) t = 276 | let 277 | val timeout = case t of 278 | SOME t => 279 | let 280 | val s = Time.toSeconds t 281 | val n = Time.toNanoseconds t - s * 1000000000 282 | in 283 | SOME (Int.fromLarge s, Int.fromLarge n) 284 | end 285 | | NONE => NONE 286 | 287 | val cnt = kevent_wait (#ev ev) eventlist timeout 288 | 289 | fun intToevFilter (~1) = evRead 290 | | intToevFilter (~2) = evWrite 291 | | intToevFilter _ = raise Ev "intToevFilter" 292 | 293 | fun getCb fd evRead = H.sub ((#rH ev), fd) 294 | | getCb fd evWrite = H.sub ((#wH ev), fd) 295 | 296 | fun new_loop 0 = cnt 297 | | new_loop i = 298 | let 299 | val (fd,f,_,_,_,_) = Array.sub (eventlist, (i-1)) 300 | val filter = intToevFilter f 301 | in 302 | case getCb fd filter of 303 | SOME cb => cb (fd, filter) 304 | | NONE => () 305 | ; 306 | new_loop (i - 1) 307 | end 308 | 309 | in 310 | if cnt >= 0 311 | then new_loop cnt 312 | else cnt 313 | end 314 | end 315 | 316 | end 317 | -------------------------------------------------------------------------------- /ev-kqueue-poly-old.sml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2016 Nick Kostyria. BSD3 license. *) 2 | 3 | signature OS_IO_EV = sig 4 | 5 | type evFd = int 6 | datatype evFilter = evRead | evWrite 7 | type evCb = (evFd * evFilter) -> unit 8 | datatype evDesc = evAdd of evFd * evFilter * evCb | evDelete of evFd * evFilter 9 | type ev 10 | 11 | exception Ev of string 12 | 13 | val evInit: unit -> ev 14 | val evModify: ev -> evDesc list -> int 15 | val evWait: ev -> Time.time option -> int 16 | end 17 | 18 | 19 | structure Ev :> OS_IO_EV = 20 | struct 21 | 22 | structure H = HashArrayInt 23 | 24 | type evFd = int 25 | datatype evFilter = evRead | evWrite 26 | type evCb = (evFd * evFilter) -> unit 27 | datatype evDesc = evAdd of evFd * evFilter * evCb | evDelete of evFd * evFilter 28 | type ev = {ev: int, rH: evCb H.hash, wH: evCb H.hash} 29 | 30 | exception Ev of string 31 | 32 | local 33 | open Foreign 34 | 35 | val max_events = 8 36 | val hash_size = 1000 37 | 38 | val libc = loadExecutable () 39 | 40 | val kqueue = buildCall0 ((getSymbol libc "kqueue"), (), cInt) 41 | 42 | local 43 | val kevent_struct_conversion = cStruct6 (cUlong, cShort, cUshort, cUint, cLong, cConstStar cVoid) 44 | val timespec_conversion = cStruct2 (cLong, cLong) 45 | val kevent_ffi = 46 | buildCall6 ( (getSymbol libc "kevent"), 47 | ( 48 | cInt, 49 | (cVectorPointer kevent_struct_conversion), cInt, 50 | (cArrayPointer kevent_struct_conversion), cInt, 51 | (cOptionPtr (cConstStar timespec_conversion)) 52 | ), 53 | cInt 54 | ) 55 | in 56 | fun kevent kq changelist eventlist timeout = kevent_ffi 57 | (kq, changelist, (Vector.length changelist), eventlist, (Array.length eventlist), timeout) 58 | end 59 | 60 | 61 | val kevent_struct_empty = (0,0,0,0,0,{}) 62 | 63 | val changelist_zero = Vector.tabulate (0, (fn i => kevent_struct_empty )) 64 | val eventlist = Array.array (max_events, kevent_struct_empty) 65 | val eventlist_zero = Array.array (0, kevent_struct_empty) 66 | 67 | in 68 | fun evInit () = 69 | let 70 | val ev = kqueue () 71 | in 72 | if ev = ~1 then raise Ev "evInit" else 73 | { ev = ev, rH = H.hash hash_size, wH = H.hash hash_size } 74 | end 75 | 76 | 77 | fun evModify (ev:ev) ev_desc_list = 78 | let 79 | fun evFilterToInt evRead = ~1 80 | | evFilterToInt evWrite = ~2 81 | 82 | fun evFilterToH evRead = #rH ev 83 | | evFilterToH evWrite = #wH ev 84 | 85 | fun toChange fd filter action = (fd, (evFilterToInt filter), action, 0, 0, {}) 86 | 87 | fun evDescToChange (evAdd (fd, filter, cb)) = toChange fd filter 1 88 | | evDescToChange (evDelete (fd, filter)) = toChange fd filter 2 89 | 90 | 91 | fun evDescFilter (evAdd (fd, filter, cb)) = (H.update ((evFilterToH filter), fd, cb); true) 92 | | evDescFilter (evDelete (fd, filter)) = 93 | let 94 | val H = evFilterToH filter 95 | in 96 | if isSome (H.sub (H, fd)) 97 | then ( H.delete (H, fd) ; true ) 98 | else false 99 | end 100 | 101 | 102 | val changelist = Vector.fromList ( map evDescToChange ( List.filter evDescFilter ev_desc_list ) ) 103 | 104 | val cnt = kevent (#ev ev) changelist eventlist_zero NONE 105 | in 106 | if cnt >= 0 107 | then cnt 108 | else raise Ev "evModify" 109 | end 110 | 111 | 112 | fun evWait (ev:ev) t = 113 | let 114 | val timeout = case t of 115 | SOME t => 116 | let 117 | val s = Time.toSeconds t 118 | val n = Time.toNanoseconds(t) - s * 1000000000 119 | in 120 | SOME (Int.fromLarge s, Int.fromLarge n) 121 | end 122 | | NONE => NONE 123 | 124 | val cnt = kevent (#ev ev) changelist_zero eventlist timeout 125 | 126 | fun intToevFilter (~1) = evRead 127 | | intToevFilter (~2) = evWrite 128 | | intToevFilter _ = raise Ev "intToevFilter" 129 | 130 | fun getCb fd evRead = H.sub ((#rH ev), fd) 131 | | getCb fd evWrite = H.sub ((#wH ev), fd) 132 | 133 | fun new_loop 0 = cnt 134 | | new_loop i = 135 | let 136 | val (fd,f,_,_,_,_) = Array.sub(eventlist, (i-1)) 137 | val filter = intToevFilter f 138 | in 139 | case getCb fd filter of 140 | SOME cb => cb (fd, filter) 141 | | NONE => () 142 | ; 143 | new_loop (i - 1) 144 | end 145 | 146 | in 147 | if cnt >= 0 148 | then new_loop cnt 149 | else cnt 150 | end 151 | end 152 | 153 | end 154 | -------------------------------------------------------------------------------- /ev-kqueue-polyml.sml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2016 Nick Kostyria. BSD3 license. *) 2 | 3 | signature OS_IO_EV = sig 4 | 5 | type evFd = int 6 | datatype evFilter = evRead | evWrite 7 | type evCb = (evFd * evFilter) -> unit 8 | datatype evDesc = evAdd of evFd * evFilter * evCb | evDelete of evFd * evFilter 9 | type ev 10 | 11 | exception Ev of string 12 | 13 | val evInit: unit -> ev 14 | val evModify: ev -> evDesc list -> int 15 | val evWait: ev -> Time.time option -> int 16 | end 17 | 18 | 19 | structure Ev :> OS_IO_EV = 20 | struct 21 | 22 | structure H = HashArrayInt 23 | 24 | type evFd = int 25 | datatype evFilter = evRead | evWrite 26 | type evCb = (evFd * evFilter) -> unit 27 | datatype evDesc = evAdd of evFd * evFilter * evCb | evDelete of evFd * evFilter 28 | type ev = {ev: int, rH: evCb H.hash, wH: evCb H.hash} 29 | 30 | exception Ev of string 31 | 32 | local 33 | open Foreign 34 | 35 | val max_events = 8 36 | val hash_size = 1000 37 | 38 | val libc = loadExecutable () 39 | 40 | val kqueue = buildCall0 ((getSymbol libc "kqueue"), (), cInt) 41 | 42 | local 43 | val kevent_struct_conversion = cStruct10 (cUlong, cShort, cUshort, cUint, cInt64, cConstStar cVoid, cUint64,cUint64,cUint64,cUint64) 44 | val timespec_conversion = cStruct2 (cLong, cLong) 45 | val kevent_ffi = 46 | buildCall6 ( (getSymbol libc "kevent"), 47 | ( 48 | cInt, 49 | (cVectorPointer kevent_struct_conversion), cInt, 50 | (cArrayPointer kevent_struct_conversion), cInt, 51 | (cOptionPtr (cConstStar timespec_conversion)) 52 | ), 53 | cInt 54 | ) 55 | in 56 | fun kevent kq changelist eventlist timeout = kevent_ffi 57 | (kq, changelist, (Vector.length changelist), eventlist, (Array.length eventlist), timeout) 58 | end 59 | 60 | 61 | val kevent_struct_empty = (0,0,0,0,0,{},0,0,0,0) 62 | 63 | val changelist_zero = Vector.tabulate (0, (fn i => kevent_struct_empty )) 64 | val eventlist = Array.array (max_events, kevent_struct_empty) 65 | val eventlist_zero = Array.array (0, kevent_struct_empty) 66 | 67 | in 68 | fun evInit () = 69 | let 70 | val ev = kqueue () 71 | in 72 | if ev = ~1 then raise Ev "evInit" else 73 | { ev = ev, rH = H.hash hash_size, wH = H.hash hash_size } 74 | end 75 | 76 | 77 | fun evModify (ev:ev) ev_desc_list = 78 | let 79 | fun evFilterToInt evRead = ~1 80 | | evFilterToInt evWrite = ~2 81 | 82 | fun evFilterToH evRead = #rH ev 83 | | evFilterToH evWrite = #wH ev 84 | 85 | fun toChange fd filter action = (fd, (evFilterToInt filter), action, 0, 0, {}, 0,0,0,0) 86 | 87 | fun evDescToChange (evAdd (fd, filter, cb)) = toChange fd filter 1 88 | | evDescToChange (evDelete (fd, filter)) = toChange fd filter 2 89 | 90 | 91 | fun evDescFilter (evAdd (fd, filter, cb)) = (H.update ((evFilterToH filter), fd, cb); true) 92 | | evDescFilter (evDelete (fd, filter)) = 93 | let 94 | val H = evFilterToH filter 95 | in 96 | if isSome (H.sub (H, fd)) 97 | then ( H.delete (H, fd) ; true ) 98 | else false 99 | end 100 | 101 | 102 | val changelist = Vector.fromList ( map evDescToChange ( List.filter evDescFilter ev_desc_list ) ) 103 | 104 | val cnt = kevent (#ev ev) changelist eventlist_zero NONE 105 | in 106 | if cnt >= 0 107 | then cnt 108 | else raise Ev "evModify" 109 | end 110 | 111 | 112 | fun evWait (ev:ev) t = 113 | let 114 | val timeout = case t of 115 | SOME t => 116 | let 117 | val s = Time.toSeconds t 118 | val n = Time.toNanoseconds(t) - s * 1000000000 119 | in 120 | SOME (Int.fromLarge s, Int.fromLarge n) 121 | end 122 | | NONE => NONE 123 | 124 | val cnt = kevent (#ev ev) changelist_zero eventlist timeout 125 | 126 | fun intToevFilter (~1) = evRead 127 | | intToevFilter (~2) = evWrite 128 | | intToevFilter _ = raise Ev "intToevFilter" 129 | 130 | fun getCb fd evRead = H.sub ((#rH ev), fd) 131 | | getCb fd evWrite = H.sub ((#wH ev), fd) 132 | 133 | fun new_loop 0 = cnt 134 | | new_loop i = 135 | let 136 | val (fd,f,_,_,_,_,_,_,_,_) = Array.sub(eventlist, (i-1)) 137 | val filter = intToevFilter f 138 | in 139 | case getCb fd filter of 140 | SOME cb => cb (fd, filter) 141 | | NONE => () 142 | ; 143 | new_loop (i - 1) 144 | end 145 | 146 | in 147 | if cnt >= 0 148 | then new_loop cnt 149 | else cnt 150 | end 151 | end 152 | 153 | end 154 | -------------------------------------------------------------------------------- /ev-poll.sml: -------------------------------------------------------------------------------- 1 | signature OS_IO_EV = sig 2 | 3 | type evFd = int 4 | datatype evFilter = evRead | evWrite 5 | type evCb = (evFd * evFilter) -> unit 6 | datatype evDesc = evAdd of evFd * evFilter * evCb | evDelete of evFd * evFilter 7 | 8 | type ev 9 | 10 | val evInit: unit -> ev 11 | val evModify: ev -> evDesc list -> int 12 | val evWait: ev -> Time.time option -> int 13 | end 14 | 15 | 16 | structure Ev :> OS_IO_EV = 17 | struct 18 | 19 | structure H = HashArrayInt 20 | 21 | type evFd = int 22 | datatype evFilter = evRead | evWrite 23 | type evCb = (evFd * evFilter) -> unit 24 | datatype evDesc = evAdd of evFd * evFilter * evCb | evDelete of evFd * evFilter 25 | 26 | type ev = { rH: (OS.IO.poll_desc * evCb) H.hash, wH: (OS.IO.poll_desc * evCb) H.hash } 27 | 28 | val hash_size = 100 29 | 30 | fun evInit () = { rH = H.hash hash_size, wH = H.hash hash_size } 31 | 32 | val intToPollDesc = Option.valOf o OS.IO.pollDesc o Posix.FileSys.fdToIOD o Posix.FileSys.wordToFD o SysWord.fromInt 33 | val pollDescToInt = SysWord.toInt o Posix.FileSys.fdToWord o Option.valOf o Posix.FileSys.iodToFD o OS.IO.pollToIODesc o OS.IO.infoToPollDesc 34 | 35 | fun evModify (ev:ev) ev_desc_list = 36 | let 37 | fun evFilterToH evRead = #rH ev 38 | | evFilterToH evWrite = #wH ev 39 | in 40 | List.app (fn d => case d of 41 | evAdd (fd, filter, cb) => H.update ((evFilterToH filter), fd, (intToPollDesc fd, cb)) 42 | | evDelete (fd, filter) => H.delete ((evFilterToH filter), fd) 43 | ) ev_desc_list; 44 | List.length ev_desc_list 45 | end 46 | 47 | fun evWait (ev:ev) t = 48 | let 49 | open OS.IO 50 | 51 | val ds:poll_desc list = H.fold (fn (k, (d, cb), r) => (pollIn d)::r) [] (#rH ev) 52 | val ds:poll_desc list = H.fold (fn (k, (d, cb), r) => (pollIn d)::r) ds (#wH ev) 53 | 54 | val pInfo = poll (ds, t) 55 | 56 | fun doit (h, fd, f) = case H.sub (h, fd) of NONE => () | SOME (d, cb) => cb (fd, f) 57 | in 58 | List.app (fn i => 59 | let 60 | val fd = pollDescToInt i 61 | in 62 | if isIn i then doit (#rH ev, fd, evRead) else 63 | if isOut i then doit (#wH ev, fd, evWrite) else 64 | () 65 | end 66 | ) pInfo; 67 | List.length pInfo 68 | end 69 | end 70 | -------------------------------------------------------------------------------- /ev-timer.use: -------------------------------------------------------------------------------- 1 | lib ["hash-array.sml", 2 | "ev-kqueue-${SML_COMPILER}.sml", 3 | "ev-with-timer.sml"] ; 4 | -------------------------------------------------------------------------------- /ev-with-timer.sml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2016-2023 Nick Kostyria. BSD3 license. *) 2 | 3 | signature OS_IO_EV = sig 4 | include OS_IO_EV 5 | val evTimerNew: ev -> int 6 | val evTimerAdd: ev -> int * Time.time * (unit -> unit) -> unit 7 | val evTimerDelete: ev -> int -> unit 8 | val evNowUpdate: ev -> unit 9 | end 10 | 11 | 12 | structure Ev :> OS_IO_EV = 13 | struct 14 | open Ev 15 | 16 | structure H = HashArrayInt 17 | 18 | type ev = { ev:Ev.ev, now: Time.time ref, timers: (Time.time * (unit -> unit)) H.hash, last_id: int ref, free_id: int list ref } 19 | 20 | val hash_size = 100 21 | 22 | fun evInit () = { ev = Ev.evInit (), now = ref (Time.now ()), timers = H.hash hash_size, last_id = ref 0, free_id = ref [] } 23 | 24 | fun evNowUpdate ({now=now, ...}:ev) = now := Time.now () 25 | 26 | 27 | fun evTimerNew ({ last_id=last_id, free_id=free_id, ... }:ev) = 28 | if List.null(!free_id) 29 | then 30 | let 31 | val id = 1 + (!last_id) 32 | in 33 | last_id := id; 34 | id 35 | end 36 | else 37 | let 38 | val id = List.hd (!free_id) 39 | in 40 | free_id := List.tl (!free_id); 41 | id 42 | end 43 | 44 | 45 | fun evTimerAdd ({now=now, timers=timers, ...}:ev) (id, t, cb) = 46 | let 47 | val time = Time.+((!(now)), t) 48 | in 49 | H.update (timers, id, (time, cb)) 50 | end 51 | 52 | 53 | fun evTimerDelete ({ timers=timers, free_id=free_id, ... }:ev) id = 54 | let 55 | in 56 | H.delete (timers, id); 57 | free_id := id::(!free_id) 58 | end 59 | 60 | 61 | fun doTimer ({now=now, timers=timers, free_id=free_id, ...}:ev) = 62 | let 63 | val cbs = H.fold (fn (id, (time, cb), r) => 64 | if Time.>(time, !now) 65 | then r 66 | else (H.delete (timers, id); cb::r) 67 | ) [] timers 68 | in 69 | app (fn cb => cb ()) cbs 70 | end 71 | 72 | 73 | fun newTimeout ({now=now, timers=timers, ...}:ev) timeout = 74 | let 75 | val t = case timeout of SOME t => t | NONE => Time.fromSeconds 25 76 | val min = H.fold (fn (id, (time, cb), min) => 77 | if Time.<(time, min) then time else min 78 | ) (Time.+(!now, t)) timers 79 | val d = Time.-(min, !now) 80 | val d_min = Time.fromMilliseconds 1 81 | in 82 | SOME (if Time.<(d, d_min) then d_min else d) 83 | end 84 | 85 | 86 | fun evModify (ev:ev) ev_desc_list = Ev.evModify (#ev ev) ev_desc_list 87 | 88 | 89 | fun evWait (ev:ev) timeout = 90 | let 91 | val _ = doTimer ev 92 | val timeout = newTimeout ev timeout 93 | val cnt = Ev.evWait (#ev ev) timeout 94 | val _ = (#now ev) := Time.now () 95 | in 96 | cnt 97 | end 98 | end 99 | -------------------------------------------------------------------------------- /ev.use: -------------------------------------------------------------------------------- 1 | lib ["hash-array.sml", 2 | "ev-kqueue-${SML_COMPILER}.sml"] ; 3 | -------------------------------------------------------------------------------- /hash-array.sml: -------------------------------------------------------------------------------- 1 | signature HASHED = 2 | sig 3 | eqtype t 4 | val hashValue : int -> t -> int 5 | end 6 | 7 | 8 | functor HashArray (Hashed:HASHED) :> 9 | sig 10 | type 'a hash 11 | 12 | val hash : int -> 'a hash 13 | 14 | val update : 'a hash * Hashed.t * 'a -> unit 15 | val sub : 'a hash * Hashed.t -> 'a option 16 | val delete : 'a hash * Hashed.t -> unit 17 | 18 | val fold : (Hashed.t * 'a * 'b -> 'b) -> 'b -> 'a hash -> 'b 19 | end 20 | = 21 | struct 22 | 23 | val hashValue = Hashed.hashValue 24 | 25 | datatype 'a status = Empty | Deleted | Used of Hashed.t * 'a 26 | datatype 'a hash = Hash of { used: int ref, entries: 'a status array ref } 27 | 28 | fun hash size = Hash { used = ref 0, entries = ref (Array.array (size, Empty)) } 29 | 30 | fun prevId i length = if i = 0 then length - 1 else i - 1 31 | 32 | 33 | fun update (Hash {entries as ref arr, used}, key, value) = 34 | let 35 | fun remove arr i = 36 | case Array.sub (arr, i) of 37 | Empty => () 38 | | Deleted => remove arr (prevId i (Array.length arr)) 39 | | Used (k, _) => if k = key 40 | then Array.update (arr, i, Deleted) 41 | else remove arr (prevId i (Array.length arr)) 42 | 43 | 44 | fun enter arr i (entry as (key, _)) = 45 | case Array.sub (arr, i) of 46 | Empty => ( Array.update (arr, i, Used entry); true ) 47 | | Deleted => ( remove arr i; Array.update (arr, i, Used entry); false ) 48 | (* check and remove old enter from other place, then enter new in freed place *) 49 | | Used (k, _) => if k = key 50 | then ( Array.update (arr, i, Used entry); false ) 51 | else enter arr (prevId i (Array.length arr)) entry 52 | 53 | 54 | fun rehash newLength = 55 | let 56 | val newArr = Array.array (newLength, Empty) 57 | val hashFromNewLength = hashValue newLength 58 | 59 | fun doit ((Used (entry as (key, _))), r) = if enter newArr (hashFromNewLength key) entry then r + 1 else r 60 | | doit (_, r) = r 61 | in 62 | used := Array.foldl doit 0 arr; 63 | entries := newArr 64 | end 65 | 66 | 67 | fun maybyRehash () = 68 | let 69 | val length = Array.length arr 70 | in 71 | if !used * 5 > length * 4 (* if 80% then rehash *) 72 | then rehash (length * 2) 73 | else () 74 | end 75 | in 76 | if enter arr (hashValue (Array.length arr) key) (key, value) 77 | then ( used := !used + 1 ; maybyRehash () ) 78 | else () 79 | end 80 | 81 | 82 | fun fold f init (Hash { entries = ref e, ...}) = 83 | let 84 | fun doit (Used (k, v), r) = f (k, v, r) 85 | | doit (_, r) = r 86 | in 87 | Array.foldl doit init e 88 | end 89 | 90 | 91 | fun sub (Hash {entries = ref arr, ...}, key) = 92 | let 93 | val length = Array.length arr 94 | 95 | fun doit i = case Array.sub (arr, i) of 96 | Empty => NONE 97 | | Deleted => doit (prevId i length) 98 | | Used (k, v) => if key = k 99 | then SOME v 100 | else doit (prevId i length) 101 | in 102 | doit (hashValue length key) 103 | end 104 | 105 | 106 | fun delete (Hash {entries = ref arr, ...}, key) = 107 | let 108 | val length = Array.length arr 109 | 110 | fun doit i = case Array.sub (arr, i) of 111 | Empty => () 112 | | Deleted => doit (prevId i length) 113 | | Used (k, _) => if key = k 114 | then Array.update (arr, i, Deleted) 115 | else doit (prevId i length) 116 | in 117 | doit (hashValue length key) 118 | end 119 | 120 | end 121 | 122 | 123 | 124 | structure HashArrayInt = HashArray ( 125 | struct 126 | type t = int 127 | fun hashValue length i = Int.mod (i, length) 128 | end 129 | ) 130 | 131 | 132 | structure HashArrayLargeInt = HashArray ( 133 | struct 134 | type t = LargeInt.int 135 | fun hashValue length i = Int.fromLarge (LargeInt.mod (i, (Int.toLarge length))) 136 | end 137 | ) 138 | 139 | 140 | structure HashArrayString = HashArray ( 141 | struct 142 | type t = string 143 | fun hashValue length str = 144 | Word.toInt ( 145 | Word.mod ( 146 | CharVector.foldr 147 | (fn (c, r) => Word.fromInt (Char.ord c) + 0w7 * r) 0w0 str, 148 | (Word.fromInt length) 149 | ) 150 | ) 151 | end 152 | ) 153 | -------------------------------------------------------------------------------- /main.sml: -------------------------------------------------------------------------------- 1 | val _ = main () 2 | -------------------------------------------------------------------------------- /t-timer.mlb: -------------------------------------------------------------------------------- 1 | local 2 | $(SML_LIB)/basis/mlton.mlb 3 | $(SML_LIB)/basis/basis.mlb 4 | in 5 | hash-array.sml 6 | ev-kqueue-mlton.sml 7 | ev-with-timer.sml 8 | t-timer.sml 9 | main.sml 10 | end 11 | -------------------------------------------------------------------------------- /t-timer.mlp: -------------------------------------------------------------------------------- 1 | use "hash-array.sml"; 2 | use "ev-kqueue-polyml.sml"; 3 | use "ev-with-timer.sml"; 4 | use "t-timer.sml"; 5 | -------------------------------------------------------------------------------- /t-timer.sml: -------------------------------------------------------------------------------- 1 | fun socket_connect host port = 2 | let 3 | val h = valOf(NetHostDB.fromString host) 4 | val addr = INetSock.toAddr(h, port) 5 | val sock:(Socket.active INetSock.stream_sock) = INetSock.TCP.socket() (* active, passive - listening *) 6 | val _ = Socket.connect(sock, addr) 7 | in 8 | sock 9 | end 10 | 11 | 12 | 13 | fun main_handle () = 14 | let 15 | 16 | val sock1 = socket_connect "127.0.0.1" 8081 17 | val sock2 = socket_connect "127.0.0.1" 8082 18 | 19 | val sockToEvFD : ('a, 'b) Socket.sock -> int = fn sock => (SysWord.toInt o Posix.FileSys.fdToWord o Option.valOf o Posix.FileSys.iodToFD o Socket.ioDesc) sock 20 | 21 | val fd1 = sockToEvFD sock1 22 | val fd2 = sockToEvFD sock2 23 | 24 | 25 | local 26 | fun say_sock_no text sock = print (text ^ ": " ^ (Int.toString (sockToEvFD sock)) ^ "\n") 27 | in 28 | val _ = (say_sock_no "sock1" sock1; say_sock_no "sock2" sock2) 29 | end 30 | 31 | 32 | val _ = print "-----\n" 33 | 34 | local open Ev in 35 | val ev = evInit () 36 | 37 | (* ... val _ = evNowUpdate ev *) 38 | (* This function establishes the current time by querying the kernel, it is done automatically within evInit and evWait. 39 | * Call this function before any evTimerAdd when evWait is not called for a very long time. *) 40 | 41 | fun showEvFilter evRead = "Read" 42 | | showEvFilter evWrite = "Write" 43 | 44 | fun cb (fd, f) = print ( "cb " ^ (Int.toString fd) ^ ": " ^ (showEvFilter f) ^ "\n") 45 | 46 | val ev_desc_list = [evAdd (fd1, evRead, cb), evAdd (fd1, evWrite, cb), evAdd (fd2, evWrite, cb)] 47 | val _ = evModify ev ev_desc_list 48 | 49 | val t1 = evTimerNew ev 50 | val _ = evTimerAdd ev (t1, Time.zeroTime, (fn () => print "Timer 1\n")) 51 | 52 | val wait_cnt = evWait ev (SOME (Time.fromSeconds 3)) (* Time.zeroTime *) 53 | val _ = print ("evWait: " ^ (Int.toString wait_cnt) ^ "\n") 54 | 55 | val _ = print "...\n" 56 | 57 | val _ = evModify ev [evDelete (fd2, evWrite)] 58 | 59 | val t2 = evTimerNew ev 60 | val _ = evTimerAdd ev (t2, Time.zeroTime, (fn () => print "Timer 2\n")) 61 | 62 | val wait_cnt = evWait ev (SOME (Time.fromSeconds 3)) (* Time.zeroTime *) 63 | val _ = print ("evWait: " ^ (Int.toString wait_cnt) ^ "\n") 64 | 65 | end 66 | 67 | val _ = print "=================\n" 68 | 69 | local open Ev in 70 | val ev = evInit () 71 | 72 | val t1 = evTimerNew ev 73 | val _ = evTimerAdd ev (t1, Time.zeroTime, (fn () => print "Timer zeroTime\n")) 74 | 75 | val t4 = evTimerNew ev 76 | val _ = evTimerAdd ev (t4, Time.fromSeconds 1, (fn () => print "Timer 1 second\n")) 77 | 78 | val t2 = evTimerNew ev 79 | val _ = evTimerAdd ev (t2, Time.fromSeconds 2, (fn () => print "Timer 2 second\n")) 80 | 81 | val t3 = evTimerNew ev 82 | val _ = evTimerAdd ev (t3, Time.fromSeconds 1, (fn () => print "Timer 1 second\n")) 83 | 84 | val wait_cnt = evWait ev (SOME (Time.fromSeconds 3)) 85 | val _ = print "...\n" 86 | 87 | val wait_cnt = evWait ev (SOME (Time.fromSeconds 3)) 88 | val _ = print "...\n" 89 | 90 | val wait_cnt = evWait ev (SOME (Time.fromSeconds 3)) 91 | val _ = print "...\n" 92 | 93 | 94 | val _ = evTimerAdd ev (t1, Time.zeroTime, (fn () => print "Timer zeroTime again\n")) 95 | val _ = evTimerAdd ev (t2, Time.fromSeconds 2, (fn () => print "Timer 2 second again\n")) 96 | 97 | val wait_cnt = evWait ev (SOME (Time.fromSeconds 3)) 98 | val _ = print "...\n" 99 | 100 | val wait_cnt = evWait ev (SOME (Time.fromSeconds 3)) 101 | val _ = print "...\n" 102 | 103 | end 104 | 105 | 106 | in () end 107 | 108 | 109 | fun main () = main_handle () handle exc => print ("function main raised an exception: " ^ exnMessage exc ^ "\n") 110 | -------------------------------------------------------------------------------- /t.mlb: -------------------------------------------------------------------------------- 1 | local 2 | $(SML_LIB)/basis/mlton.mlb 3 | $(SML_LIB)/basis/basis.mlb 4 | in 5 | hash-array.sml 6 | ev-kqueue-mlton.sml 7 | t.sml 8 | main.sml 9 | end 10 | -------------------------------------------------------------------------------- /t.mlp: -------------------------------------------------------------------------------- 1 | use "hash-array.sml"; 2 | use "ev-kqueue-polyml.sml"; 3 | use "t.sml"; 4 | -------------------------------------------------------------------------------- /t.sml: -------------------------------------------------------------------------------- 1 | fun socket_connect host port = 2 | let 3 | val h = valOf(NetHostDB.fromString host) 4 | val addr = INetSock.toAddr(h, port) 5 | val sock:(Socket.active INetSock.stream_sock) = INetSock.TCP.socket() (* active, passive - listening *) 6 | val _ = Socket.connect(sock, addr) 7 | in 8 | sock 9 | end 10 | 11 | 12 | 13 | fun main_handle () = 14 | let 15 | 16 | val sock1 = socket_connect "127.0.0.1" 8081 17 | val sock2 = socket_connect "127.0.0.1" 8082 18 | 19 | val sockToEvFD : ('a, 'b) Socket.sock -> int = fn sock => (SysWord.toInt o Posix.FileSys.fdToWord o Option.valOf o Posix.FileSys.iodToFD o Socket.ioDesc) sock 20 | 21 | val fd1 = sockToEvFD sock1 22 | val fd2 = sockToEvFD sock2 23 | 24 | 25 | local 26 | fun say_sock_no text sock = print (text ^ ": " ^ (Int.toString (sockToEvFD sock)) ^ "\n") 27 | in 28 | val _ = (say_sock_no "sock1" sock1; say_sock_no "sock2" sock2) 29 | end 30 | 31 | 32 | val _ = print "-----\n" 33 | 34 | local open Ev in 35 | val ev = evInit () 36 | 37 | fun showEvFilter evRead = "Read" 38 | | showEvFilter evWrite = "Write" 39 | 40 | fun cb (fd, f) = print ( "cb " ^ (Int.toString fd) ^ ": " ^ (showEvFilter f) ^ "\n") 41 | 42 | val ev_desc_list = [evAdd (fd1, evRead, cb), evAdd (fd1, evWrite, cb), evAdd (fd2, evWrite, cb)] 43 | val _ = evModify ev ev_desc_list 44 | 45 | 46 | val wait_cnt = evWait ev (SOME (Time.fromSeconds 3)) (* Time.zeroTime *) 47 | val _ = if wait_cnt = ~1 then print "evWait return ~1: errno equal 4 with high probability (Interrupted system call)" else () 48 | val _ = print ("evWait: " ^ (Int.toString wait_cnt) ^ "\n") 49 | 50 | val _ = print "...\n" 51 | 52 | val _ = evModify ev [evDelete (fd2, evWrite)] 53 | 54 | val wait_cnt = evWait ev (SOME (Time.fromSeconds 3)) (* Time.zeroTime *) 55 | val _ = print ("evWait: " ^ (Int.toString wait_cnt) ^ "\n") 56 | 57 | end 58 | 59 | in () end 60 | 61 | 62 | fun main () = main_handle () handle exc => print ("function main raised an exception: " ^ exnMessage exc ^ "\n") 63 | --------------------------------------------------------------------------------