Commit 2c920646 authored by Mart Lubbers's avatar Mart Lubbers

fix device listing for windows

parent 704600d9
......@@ -8,3 +8,4 @@ test
*.prp
*-sapl
*-www
*.swp
implementation module TTY
import StdFunc
import StdFunc, StdBool
import StdList
import System.OS
import Text
......@@ -43,7 +43,7 @@ getTTYDevices :: !*World -> *(![String], !*World)
getTTYDevices w
# (ds, w) = getDevices w
= (IF_WINDOWS
(filter (startsWith "COM") ds)
(filter (\s->startsWith "COM" s && size s > 3 && isDigit s.[3]) ds)
(map ((+++) "/dev/") (filter isTTY ds))
, w)
where
......
definition module Platform
getDevices :: !*World -> !*([String], !*World)
getDevices :: !*World -> *([String], !*World)
implementation module Platform
getDevices :: !*World -> !*([String], !*World)
import code from library "CleanSerial_library"
import System._Pointer
import System._WinBase
import StdMisc, StdDebug, StdBool, StdString
import Text
getDevices :: !*World -> *([String], !*World)
getDevices w
# (ph, w) = getProcessheap w
# (ptr, w) = heapAlloc ph 0 4096 w
# (ret, w) = realQDD 0 ptr 4096 w
| ret == 0 = abort "error in QueryDosDevice"
# res = derefString ptr
# (ph, w) = getProcessHeap w
# (ptr, w) = heapAlloc ph 0 40960 w
# (ret, w) = realQDD 0 ptr 40960 w
| ret == 0
# (err, w) = getLastError w
= abort ("error in QueryDosDevice: " +++ toString err)
#! res = derefCharArray ptr ret
# (ok, w) = heapFree ph 0 ptr w
= split "\0" res
= (split "\0" res, w)
realQDD :: !Pointer !Pointer !Int !*env -> !*(Int, !*env)
realQDD _ _ _ _ =
= code {
ccall QueryDosDevice "ppI:I:A"
realQDD :: !Pointer !Pointer !Int !*env -> *(!Int, !*env)
realQDD _ _ _ _ = code {
ccall QueryDosDeviceA@12 "PppI:I:A"
}
......@@ -6,6 +6,8 @@ endif
all: listDevices
.SECONDARY: listDevices.prj
%: %.prj %.icl
cpm $<
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment