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

fix device listing for windows

parent 704600d9
...@@ -8,3 +8,4 @@ test ...@@ -8,3 +8,4 @@ test
*.prp *.prp
*-sapl *-sapl
*-www *-www
*.swp
implementation module TTY implementation module TTY
import StdFunc import StdFunc, StdBool
import StdList import StdList
import System.OS import System.OS
import Text import Text
...@@ -43,7 +43,7 @@ getTTYDevices :: !*World -> *(![String], !*World) ...@@ -43,7 +43,7 @@ getTTYDevices :: !*World -> *(![String], !*World)
getTTYDevices w getTTYDevices w
# (ds, w) = getDevices w # (ds, w) = getDevices w
= (IF_WINDOWS = (IF_WINDOWS
(filter (startsWith "COM") ds) (filter (\s->startsWith "COM" s && size s > 3 && isDigit s.[3]) ds)
(map ((+++) "/dev/") (filter isTTY ds)) (map ((+++) "/dev/") (filter isTTY ds))
, w) , w)
where where
......
definition module Platform definition module Platform
getDevices :: !*World -> !*([String], !*World) getDevices :: !*World -> *([String], !*World)
implementation module Platform 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 getDevices w
# (ph, w) = getProcessheap w # (ph, w) = getProcessHeap w
# (ptr, w) = heapAlloc ph 0 4096 w # (ptr, w) = heapAlloc ph 0 40960 w
# (ret, w) = realQDD 0 ptr 4096 w # (ret, w) = realQDD 0 ptr 40960 w
| ret == 0 = abort "error in QueryDosDevice" | ret == 0
# res = derefString ptr # (err, w) = getLastError w
= abort ("error in QueryDosDevice: " +++ toString err)
#! res = derefCharArray ptr ret
# (ok, w) = heapFree ph 0 ptr w # (ok, w) = heapFree ph 0 ptr w
= split "\0" res = (split "\0" res, w)
realQDD :: !Pointer !Pointer !Int !*env -> !*(Int, !*env) realQDD :: !Pointer !Pointer !Int !*env -> *(!Int, !*env)
realQDD _ _ _ _ = realQDD _ _ _ _ = code {
= code { ccall QueryDosDeviceA@12 "PppI:I:A"
ccall QueryDosDevice "ppI:I:A"
} }
...@@ -6,6 +6,8 @@ endif ...@@ -6,6 +6,8 @@ endif
all: listDevices all: listDevices
.SECONDARY: listDevices.prj
%: %.prj %.icl %: %.prj %.icl
cpm $< 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