Mercurial > repos > tabletprog
annotate modules/socket.tp @ 251:2557ce4e671f
Fix a couple of compiler bugs. topenv was getting initialized in multiple places. This resulted in multiple copies of modules getting created which caused problems for macro expansion. Additionally, arguments were not being marked as declared during code generation so assigning to an argument that was not closed over generated invalid C code.
| author | Michael Pavone <pavone@retrodev.com> |
|---|---|
| date | Fri, 11 Apr 2014 22:29:32 -0700 |
| parents | 4c96a393103e |
| children | 57d78a0af132 |
| rev | line source |
|---|---|
| 139 | 1 #{ |
| 145 | 2 includeSystemHeader: "sys/types.h" |
| 3 includeSystemHeader: "sys/socket.h" | |
| 4 includeSystemHeader: "netdb.h" | |
| 5 | |
| 139 | 6 llMessage: AF_INET withVars: { |
| 7 intret <- obj_int32 ptr | |
| 8 } andCode: { | |
| 9 intret <- make_object: (addr_of: obj_int32_meta) NULL 0 | |
| 10 intret num!: AF_INET | |
| 11 intret | |
| 12 } | |
| 13 llMessage: AF_UNIX withVars: { | |
| 14 intret <- obj_int32 ptr | |
| 15 } andCode: { | |
| 16 intret <- make_object: (addr_of: obj_int32_meta) NULL 0 | |
| 17 intret num!: AF_UNIX | |
| 18 intret | |
| 19 } | |
| 20 llMessage: STREAM withVars: { | |
| 21 intret <- obj_int32 ptr | |
| 22 } andCode: { | |
| 23 intret <- make_object: (addr_of: obj_int32_meta) NULL 0 | |
| 24 intret num!: SOCK_STREAM | |
| 25 intret | |
| 26 } | |
| 27 llMessage: DGRAM withVars: { | |
| 28 intret <- obj_int32 ptr | |
| 29 } andCode: { | |
| 30 intret <- make_object: (addr_of: obj_int32_meta) NULL 0 | |
| 31 intret num!: SOCK_DGRAM | |
| 32 intret | |
| 33 } | |
| 34 llMessage: socket withVars: { | |
| 35 fd <- obj_int32 ptr | |
| 36 domain <- obj_int32 ptr | |
| 37 type <- obj_int32 ptr | |
| 38 protocol <- obj_int32 ptr | |
| 39 } andCode: :domain type protocol { | |
| 40 fd <- make_object: (addr_of: obj_int32_meta) NULL 0 | |
| 41 fd num!: (socket: (domain num) (type num) (protocol num)) | |
| 42 fd | |
| 43 } | |
| 145 | 44 |
| 139 | 45 new <- :domain type protocol { |
| 46 sfd <- socket: domain type protocol | |
| 47 #{ | |
| 48 fd <- {sfd} | |
|
147
4c96a393103e
Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents:
145
diff
changeset
|
49 |
| 139 | 50 llMessage: close withVars: { |
| 51 sfd <- obj_int32 ptr | |
| 52 } andCode: { | |
| 53 sfd <- mcall: fd 1 self | |
| 54 close: (sfd num) | |
| 55 self | |
| 56 } | |
|
147
4c96a393103e
Add support for receiving data from a socket
Mike Pavone <pavone@retrodev.com>
parents:
145
diff
changeset
|
57 |
| 145 | 58 llMessage: send:withFlags withVars: { |
| 59 odata <- object ptr | |
| 60 flags <- obj_int32 ptr | |
| 61 sdata <- string ptr | |
| 62 sfd <- obj_int32 ptr | |
| 63 res <- obj_int32 ptr | |
| 64 } andCode: :odata :flags { | |
| 65 sdata <- mcall: string 1 odata | |
| 66 sfd <- mcall: fd 1 self | |
| 67 res <- make_object: (addr_of: obj_int32_meta) NULL 0 | |
| 68 res num!: (send: (sfd num) (sdata data) (sdata bytes) (flags num)) | |
| 69 res | |
| 70 } | |
| 71 send <- :data { | |
| 72 send: data withFlags: 0 | |
| 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 | 114 } |
| 115 } | |
| 145 | 116 |
| 117 llMessage: _connectTo:onPort withVars: { | |
| 118 host <- string ptr | |
| 119 port <- string ptr | |
| 120 hints <- struct: addrinfo | |
| 121 info <- (struct: addrinfo) ptr | |
| 122 domain <- obj_int32 ptr | |
| 123 type <- obj_int32 ptr | |
| 124 protocol <- obj_int32 ptr | |
| 125 sock <- object ptr | |
| 126 sfd <- obj_int32 ptr | |
| 127 } andCode: :host :port { | |
| 128 memset: (addr_of: hints) 0 (sizeof: hints) | |
| 129 hints ai_family!: AF_UNSPEC | |
| 130 hints ai_socktype!: SOCK_STREAM | |
| 131 getaddrinfo: (host data) (port data) (addr_of: hints) (addr_of: info) | |
| 132 | |
| 133 domain <- make_object: (addr_of: obj_int32_meta) NULL 0 | |
| 134 domain num!: (info ai_family) | |
| 135 type <- make_object: (addr_of: obj_int32_meta) NULL 0 | |
| 136 type num!: (info ai_socktype) | |
| 137 protocol <- make_object: (addr_of: obj_int32_meta) NULL 0 | |
| 138 protocol num!: (info ai_protocol) | |
| 139 | |
| 140 sock <- mcall: new 4 self domain type protocol | |
| 141 sfd <- mcall: fd 1 sock | |
| 142 | |
| 143 connect: (sfd num) (info ai_addr) (info ai_addrlen) | |
| 144 | |
| 145 freeaddrinfo: info | |
| 146 sock | |
| 147 } | |
| 148 | |
| 139 | 149 connectTo:onPort <- :host :port { |
| 145 | 150 _connectTo: host onPort: (string: port) |
| 139 | 151 } |
| 145 | 152 listenOn <- :port { |
| 139 | 153 } |
| 154 listenAt:onPort <- :host :port { | |
| 155 } | |
| 156 } |