Mercurial > repos > tabletprog

annotate modules/socket.tp @ 263:98147071baf6

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