Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-compiler-and-rts
stdenv
Commits
3b0659ac
Commit
3b0659ac
authored
Jan 17, 2000
by
Peter Achten
Browse files
(PA) New version of TCP by Martin Wierich
parent
dccad754
Changes
11
Hide whitespace changes
Inline
Side-by-side
ObjectIO/Tcp Examples/chat/chatClient.icl
View file @
3b0659ac
...
...
@@ -23,7 +23,6 @@ CR :== '\xD' // carriage return
::
NoState
=
NoState
// The singleton data type
Start
::
*
World
->
*
World
Start
world
=
startIO
SDI
{
sndChan
=
undef
,
nickname
=
""
}
initialize
[
ProcessWindowSize
zero
]
world
...
...
@@ -35,19 +34,23 @@ initialize ps
(
buttonId
,
ps
)
=
accPIO
openId
ps
// prompt for chat parameters nickname and server address
dDef
=
Dialog
"Enter Chat Parameters"
(
EditControl
""
(
PixelWidth
400
)
1
[
ControlId
nicknameId
,
ControlPos
(
Right
,
zero
)]
:+:
TextControl
"Nickname:"
[
ControlPos
(
LeftOfPrev
,
zero
)]
:+:
EditControl
remote
(
PixelWidth
400
)
1
[
ControlId
rmtsiteId
,
ControlPos
(
Right
,
zero
)]
:+:
TextControl
"Chat Server:"
[
ControlPos
(
LeftOfPrev
,
zero
)]
:+:
ButtonControl
"OK"
[
ControlId
buttonId
,
ControlFunction
(
noLS1
ok
(
dialogId
,
nicknameId
,
rmtsiteId
)),
ControlPos
(
Right
,
zero
)]
)
[
WindowId
dialogId
,
WindowOk
buttonId
]
dDef
=
Dialog
"Enter Chat Parameters"
(
TextControl
"Type in below your nickname and the internet address of the server"
[]
:+:
TextControl
(
"If there is no server running on the specified machine then this "
+++
"program aborts."
)
[
ControlPos
(
BelowPrev
,
zero
)]
:+:
EditControl
""
(
PixelWidth
400
)
1
[
ControlId
nicknameId
,
ControlPos
(
Right
,
zero
)]
:+:
TextControl
"Nickname:"
[
ControlPos
(
LeftOfPrev
,
zero
)]
:+:
EditControl
remote
(
PixelWidth
400
)
1
[
ControlId
rmtsiteId
,
ControlPos
(
Right
,
zero
)]
:+:
TextControl
"Chat Server:"
[
ControlPos
(
LeftOfPrev
,
zero
)]
:+:
ButtonControl
"OK"
[
ControlId
buttonId
,
ControlFunction
(
noLS1
ok
(
dialogId
,
nicknameId
,
rmtsiteId
)),
ControlPos
(
Right
,
zero
)]
)
[
WindowId
dialogId
,
WindowOk
buttonId
]
#
((
errReport
,
_),
ps
)
=
openModalDialog
NoState
dDef
ps
|
errReport
<>
NoError
=
abort
"
abort:
can't open modal dialog"
=
abort
"can't open modal dialog"
#
(_,
ps
)
=
openWindow
NoState
(
Window
"dummy"
NilLS
[
WindowViewSize
{
w
=
100
,
h
=
30
}])
ps
=
ps
where
...
...
@@ -65,7 +68,7 @@ initialize ps
=
closeWindow
dialogId
ps
continuation
::
!
String
!
String
(
Maybe
TCP_DuplexChannel
)
PState
->
PState
continuation
_
remoteSite
Nothing
ps
=
abort
(
"CAN'T CONNECT with "
+++
remoteSite
)
=
abort
(
"
ABORT:
CAN'T CONNECT with "
+++
remoteSite
)
continuation
nickname
_
(
Just
{
sChannel
,
rChannel
})
ps
// connection with server has been established.
#
(
dialogId
,
ps
)
=
accPIO
openId
ps
...
...
@@ -156,7 +159,7 @@ sReceiver Sendable ps=:{ls=ls=:{sndChan}, io}
#
(
sndChan
,
io
)
=
flushBuffer_NB
sndChan
io
=
{
ps
&
ls
={
ls
&
sndChan
=
sndChan
},
io
=
io
}
sReceiver
Disconnected
ps
=
abort
"CONNECTION DISRUPTED "
=
abort
"
ABORT:
CONNECTION DISRUPTED "
rReceiver
::
!(
ReceiveMsg
ByteSeq
)
((
Id
,
Id
),
PState
)
->
((
Id
,
Id
),
PState
)
// the function for the send channel's send notifier
...
...
@@ -174,7 +177,7 @@ rReceiver (Received byteSeq) (ls=:(dialogId, outId), ps)
=
str
rReceiver
EOM
_
=
abort
"CONNECTION DISRUPTED "
=
abort
"
ABORT:
CONNECTION DISRUPTED "
quit
ps
=:{
ls
=
ls
=:{
sndChan
},
io
}
#
io
=
closeChannel
sndChan
io
...
...
ObjectIO/Tcp Examples/chat/chatServer.icl
View file @
3b0659ac
...
...
@@ -84,7 +84,7 @@ loop listener channels console world
broadcastString
::
!
String
![
ChanInfo
]
![
ChanInfo
]
!*
World
->
([
ChanInfo
],!*
World
)
broadcastString
string
[]
akku
world
=
(
u_
reverse
akku
,
world
)
=
(
reverse
akku
,
world
)
broadcastString
string
[
channel
=:{
sndChan
}:
channels
]
akku
world
#
(
sndChan
,
world
)
=
send
(
toByteSeq
string
)
sndChan
world
=
broadcastString
string
channels
[{
channel
&
sndChan
=
sndChan
}:
akku
]
world
...
...
@@ -114,8 +114,3 @@ zip3 :: ![TCP_SChannel] ![!TCP_RChannel] ![String] -> [!ChanInfo]
zip3
[]
[]
[]
=
[]
zip3
[
sndChan
:
a
]
[
rcvChan
:
b
]
[
nickname
:
c
]
=
[{
sndChan
=
sndChan
,
rcvChan
=
rcvChan
,
nickname
=
nickname
}
:
zip3
a
b
c
]
u_reverse
list
=
reverse_
list
[]
where
reverse_
[
hd
:
tl
]
list
=
reverse_
tl
[
hd
:
list
]
reverse_
[]
list
=
list
ObjectIO/Tcp Examples/downloadHTTP/downloadHTTP.icl
View file @
3b0659ac
...
...
@@ -39,7 +39,6 @@ Start world
#!
console
=
fwrites
(
server
+++
" responded on port "
+++
toString
port
+++
"
\n
"
)
console
{
sChannel
=
sc
,
rChannel
=
rc
}=
fromJust
mbDuplexChan
// **************************************************************************************************
// send http command
...
...
ObjectIO/Tcp/StdChannels.dcl
View file @
3b0659ac
...
...
@@ -8,7 +8,7 @@ definition module StdChannels
from
StdMaybe
import
Maybe
from
StdOverloaded
import
==,
toString
from
channelenv
import
ChannelEnv
from
tcp
import
ChannelEnv
instance
ChannelEnv
World
...
...
ObjectIO/Tcp/StdChannels.icl
View file @
3b0659ac
...
...
@@ -6,9 +6,9 @@ implementation module StdChannels
import
StdEnv
import
StdMaybe
import
StdIOCommon
,
StdTime
import
channelenv
import
id
import
commondef
,
iostate
,
receiverid
,
StdPStClass
,
StdReceiver
import
commondef
,
iostate
,
receiverid
,
StdPStClass
,
StdReceiver
import
tcp
instance
ChannelEnv
World
where
...
...
ObjectIO/Tcp/StdEventTCP.icl
View file @
3b0659ac
...
...
@@ -3,7 +3,7 @@ implementation module StdEventTCP
// Clean Standard Object I/O library, version 1.2
import
StdEnv
import
/*StdChannelEnv,*/
StdChannels
,
StdTCPDef
,
StdTCPChannels
import
StdChannels
,
StdTCPDef
,
StdTCPChannels
import
StdReceiver
import
StdPSt
,
StdPStClass
import
tcp
,
ostcp
,
tcp_bytestreams
...
...
@@ -515,9 +515,6 @@ Cast a
}
// MW11..
u_isNothing
x
=:(
Just
_)
=
(
False
,
x
)
u_isNothing
x
=:
Nothing
=
(
True
,
x
)
getConnectedIds
rAtts
#
l
=
[
ids
\\
(
ReceiverConnectedReceivers
ids
)<-
rAtts
]
|
isEmpty
l
...
...
ObjectIO/Tcp/StdTCPChannels.icl
View file @
3b0659ac
...
...
@@ -5,7 +5,7 @@ implementation module StdTCPChannels
import
StdEnv
import
StdTCPDef
,
StdChannels
,
StdTime
import
StdIOCommon
import
id
,
tcp
,
ostcp
,
channelenv
,
ostick
,
tcp_bytestreams
import
id
,
tcp
,
ostcp
,
ostick
,
tcp_bytestreams
//////////////////////// Listeners ////////////////////////////////////
...
...
ObjectIO/Tcp/ostcp.dcl
View file @
3b0659ac
...
...
@@ -3,7 +3,7 @@ definition module ostcp
import
StdMaybe
import
StdTCPDef
from
StdChannels
import
Timeout
,
TimeoutReport
import
tcp
,
channelenv
import
tcp
os_eom
::
!
EndpointRef
!*
env
->
(!
Bool
,
!*
env
)
...
...
ObjectIO/Tcp/ostcp.icl
View file @
3b0659ac
...
...
@@ -3,7 +3,7 @@ implementation module ostcp
import
StdEnv
,
StdMaybe
import
StdTCPDef
import
StdChannels
import
tcp
,
channelenv
,
ostick
import
tcp
,
ostick
import
code
from
"cTCP.obj"
,
library
"wsock_library"
os_eom
::
!
EndpointRef
!*
env
...
...
ObjectIO/Tcp/tcp.dcl
View file @
3b0659ac
definition
module
tcp
from
StdString
import
String
from
id
import
Id
from
StdString
import
String
from
id
import
Id
from
StdFile
import
FileEnv
,
Files
from
StdTime
import
TimeEnv
,
Date
,
Tick
,
Time
from
StdId
import
Ids
,
RId
,
R2Id
from
id
import
Id
class
ChannelEnv
env
|
Ids
env
&
TimeEnv
env
&
FileEnv
env
where
channelEnvKind
::
!*
env
->
(!
Int
,
!*
env
)
mb_close_inet_receiver_without_id
::
!
Bool
!(!
Int
,
!
Int
)
!*
env
->
*
env
/*
:: !Bool !(!EndpointRef, !InetReceiverCategory) !*env -> *env
mb_close_inet_receiver_without_id:
iff the Boolean is True, this function closes the receiver, which is identified through
the (!EndpointRef, !InetReceiverCategory) pair
*/
//channelEnvKind can return the following values:
WORLD
:==
0
IOST
:==
1
PST
:==
2
IE_CONNECTREQUEST
:==
0x0001
IE_RECEIVED
:==
0x0004
...
...
ObjectIO/Tcp/tcp.icl
View file @
3b0659ac
implementation
module
tcp
import
StdEnv
from
id
import
Id
import
StdFile
import
id
import
StdTime
from
StdId
import
Ids
class
ChannelEnv
env
|
Ids
env
&
TimeEnv
env
&
FileEnv
env
where
channelEnvKind
::
!*
env
->
(!
Int
,
!*
env
)
mb_close_inet_receiver_without_id
::
!
Bool
!(!
Int
,
!
Int
)
!*
env
->
*
env
//channelEnvKind can return the following values:
// (some C functions rely on these values)
WORLD
:==
0
IOST
:==
1
PST
:==
2
IE_CONNECTREQUEST
:==
0x0001
IE_RECEIVED
:==
0x0004
...
...
@@ -80,13 +94,13 @@ unpack_ipaddr i = i
close_listener
::
!
EndpointRef
!*
env
->
*
env
close_listener
endpointRef
env
#
!
env
=
setEndpointDataC
endpointRef
0
False
False
True
env
#
env
=
setEndpointDataC
endpointRef
0
False
False
True
env
env
=
garbageCollectEndpointC
endpointRef
env
=
env
close_tcprchan
::
!
EndpointRef
!*
env
->
*
env
close_tcprchan
endpointRef
env
#
!
((
referenceCount
,_,
hs
,
aborted
),
env
)
#
((
referenceCount
,_,
hs
,
aborted
),
env
)
=
getEndpointDataC
endpointRef
env
env
=
setEndpointDataC
endpointRef
(
dec
referenceCount
)
False
hs
aborted
env
env
=
case
(
referenceCount
,
aborted
)
of
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment