Mercurial > repos > tabletprog

annotate modules/socket.tp @ 232:25b800094623

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fix string method of funcall nodes
author Michael Pavone <pavone@retrodev.com>
date Thu, 02 Jan 2014 23:42:33 -0800
parents 4c96a393103e
children 57d78a0af132
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
139
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
1 #{
145
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
2 includeSystemHeader: "sys/types.h"
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
3 includeSystemHeader: "sys/socket.h"
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
4 includeSystemHeader: "netdb.h"
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
5
139
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
6 llMessage: AF_INET withVars: {
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
7 intret <- obj_int32 ptr
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
8 } andCode: {
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
9 intret <- make_object: (addr_of: obj_int32_meta) NULL 0
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
10 intret num!: AF_INET
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
11 intret
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
12 }
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
13 llMessage: AF_UNIX withVars: {
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
14 intret <- obj_int32 ptr
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
15 } andCode: {
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
16 intret <- make_object: (addr_of: obj_int32_meta) NULL 0
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
17 intret num!: AF_UNIX
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
18 intret
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
19 }
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
20 llMessage: STREAM withVars: {
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
21 intret <- obj_int32 ptr
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
22 } andCode: {
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
23 intret <- make_object: (addr_of: obj_int32_meta) NULL 0
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
24 intret num!: SOCK_STREAM
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
25 intret
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
26 }
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
27 llMessage: DGRAM withVars: {
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
28 intret <- obj_int32 ptr
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
29 } andCode: {
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
30 intret <- make_object: (addr_of: obj_int32_meta) NULL 0
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
31 intret num!: SOCK_DGRAM
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
32 intret
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
33 }
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
34 llMessage: socket withVars: {
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
35 fd <- obj_int32 ptr
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
36 domain <- obj_int32 ptr
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
37 type <- obj_int32 ptr
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
38 protocol <- obj_int32 ptr
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
39 } andCode: :domain type protocol {
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
40 fd <- make_object: (addr_of: obj_int32_meta) NULL 0
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
41 fd num!: (socket: (domain num) (type num) (protocol num))
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
42 fd
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
43 }
145
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
44
139
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
45 new <- :domain type protocol {
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
46 sfd <- socket: domain type protocol
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
47 #{
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
48 fd <- {sfd}
147
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
49
139
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
50 llMessage: close withVars: {
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
51 sfd <- obj_int32 ptr
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
52 } andCode: {
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
53 sfd <- mcall: fd 1 self
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
54 close: (sfd num)
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
55 self
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
56 }
147
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
57
145
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
58 llMessage: send:withFlags withVars: {
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
59 odata <- object ptr
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
60 flags <- obj_int32 ptr
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
61 sdata <- string ptr
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
62 sfd <- obj_int32 ptr
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
63 res <- obj_int32 ptr
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
64 } andCode: :odata :flags {
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
65 sdata <- mcall: string 1 odata
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
66 sfd <- mcall: fd 1 self
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
67 res <- make_object: (addr_of: obj_int32_meta) NULL 0
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
68 res num!: (send: (sfd num) (sdata data) (sdata bytes) (flags num))
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
69 res
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
70 }
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
71 send <- :data {
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
72 send: data withFlags: 0
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
73 }
147
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
74
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
75 llMessage: recv:withFlags withVars: {
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
76 length <- obj_int32 ptr
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
77 flags <- obj_int32 ptr
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
78 sfd <- obj_int32 ptr
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
79 res <- int
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
80 buf <- char ptr
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
81 out <- string ptr
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
82 } andCode: :length :flags {
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
83 sfd <- mcall: fd 1 self
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
84 buf <- GC_MALLOC_ATOMIC: (length num) + 1
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
85 res <- recv: (sfd num) buf (length num) (flags num)
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
86 if: res < 0 {
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
87 length <- make_object: (addr_of: obj_int32_meta) NULL 0
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
88 length num!: res
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
89 length
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
90 } else: {
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
91 out <- make_object: (addr_of: string_meta) NULL 0
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
92 out bytes!: res
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
93 out len!: res
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
94 out data!: buf
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
95 out
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
96 }
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
97 }
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
98 recv <- :length {
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
99 recv: length withFlags: 0
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
100 }
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
101 recvAll <- :len {
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
102 received <- ""
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
103 error <- false
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
104 while: { (not: error) && (received length) < len} do: {
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
105 res <- recv: (len - (received length))
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
106 if: (res isInteger?) || (res length) = 0 {
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
107 error <- true
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
108 } else: {
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
109 received <- received . res
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
110 }
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
111 }
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
112 received
4c96a393103e Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents: 145
diff changeset
113 }
139
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
114 }
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
115 }
145
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
116
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
117 llMessage: _connectTo:onPort withVars: {
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
118 host <- string ptr
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
119 port <- string ptr
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
120 hints <- struct: addrinfo
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
121 info <- (struct: addrinfo) ptr
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
122 domain <- obj_int32 ptr
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
123 type <- obj_int32 ptr
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
124 protocol <- obj_int32 ptr
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
125 sock <- object ptr
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
126 sfd <- obj_int32 ptr
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
127 } andCode: :host :port {
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
128 memset: (addr_of: hints) 0 (sizeof: hints)
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
129 hints ai_family!: AF_UNSPEC
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
130 hints ai_socktype!: SOCK_STREAM
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
131 getaddrinfo: (host data) (port data) (addr_of: hints) (addr_of: info)
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
132
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
133 domain <- make_object: (addr_of: obj_int32_meta) NULL 0
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
134 domain num!: (info ai_family)
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
135 type <- make_object: (addr_of: obj_int32_meta) NULL 0
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
136 type num!: (info ai_socktype)
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
137 protocol <- make_object: (addr_of: obj_int32_meta) NULL 0
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
138 protocol num!: (info ai_protocol)
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
139
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
140 sock <- mcall: new 4 self domain type protocol
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
141 sfd <- mcall: fd 1 sock
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
142
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
143 connect: (sfd num) (info ai_addr) (info ai_addrlen)
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
144
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
145 freeaddrinfo: info
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
146 sock
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
147 }
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
148
139
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
149 connectTo:onPort <- :host :port {
145
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
150 _connectTo: host onPort: (string: port)
139
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
151 }
145
7db37f040a6f Basic socket support
Mike Pavone <pavone@retrodev.com>
parents: 139
diff changeset
152 listenOn <- :port {
139
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
153 }
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
154 listenAt:onPort <- :host :port {
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
155 }
9bce890a7ff2 Old work on a socket module
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
156 }