We planned to upgrade GitLab and Mattermost to the latest version this Friday morning (early). You may experience some downtime!

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