annotate modules/object.tp @ 270:b74956a2196f

Add a propertiesOf method to the object module that returns the names of things that look like getter messages
author Michael Pavone <pavone@retrodev.com>
date Fri, 18 Jul 2014 20:45:50 -0700
parents 123e9468d55e
children ead24192ed45
rev   line source
pavone@266 1 {
pavone@266 2 rt <- #{
pavone@266 3 llMessage: numMessages withVars: {
pavone@266 4 intret <- obj_int32 ptr
pavone@266 5 } andCode: {
pavone@266 6 intret <- make_object: (addr_of: obj_int32_meta) NULL 0
pavone@266 7 intret num!: (sizeof: methodNames) / (sizeof: (char ptr))
pavone@266 8 intret
pavone@266 9 }
pavone@266 10
pavone@266 11 llMessage: methodName withVars: {
pavone@266 12 methodId <- obj_int32 ptr
pavone@266 13 name <- string ptr
pavone@266 14 namelen <- int
pavone@266 15 } andCode: :methodId {
pavone@266 16 name <- make_object: (addr_of: string_meta) NULL 0
pavone@266 17 namelen <- strlen: (methodNames get: (methodId num))
pavone@266 18 name bytes!: namelen
pavone@266 19 name len!: namelen
pavone@266 20 name data!: (GC_MALLOC_ATOMIC: namelen + 1)
pavone@266 21 memcpy: (name data) (methodNames get: (methodId num)) namelen
pavone@266 22 name
pavone@266 23 }
pavone@266 24
pavone@266 25 llMessage: understands? withVars: {
pavone@266 26 obj <- object ptr
pavone@266 27 methodId <- obj_int32 ptr
pavone@266 28 ret <- object ptr
pavone@266 29 } andCode: :obj methodId {
pavone@266 30 if: (object_understands: obj (methodId num)) {
pavone@266 31 ret <- module_true
pavone@266 32 } else: {
pavone@266 33 ret <- module_false
pavone@266 34 }
pavone@266 35 ret
pavone@266 36 }
pavone@266 37
pavone@266 38 llMessage: addUnderstood withVars: {
pavone@266 39 obj <- object ptr
pavone@266 40 arr <- object ptr
pavone@266 41 methHash <- (uint32_t ptr) ptr
pavone@266 42 methodId <- obj_int32 ptr
pavone@266 43 slot <- int
pavone@266 44 i <- int
pavone@266 45 } andCode: :obj arr {
pavone@266 46 methHash <- (obj meta) methods
pavone@266 47 slot <- 0
pavone@266 48 while: {slot < 16} do: {
pavone@266 49 if: (methHash get: slot) {
pavone@266 50 i <- 0
pavone@270 51 while: { ((methHash get: slot) get: i)!= 0xFFFFFFFF } do: {
pavone@266 52 methodId <- make_object: (addr_of: obj_int32_meta) NULL 0
pavone@266 53 methodId num!: ((methHash get: slot) get: i)
pavone@266 54 mcall: append 2 arr methodId
pavone@266 55
pavone@266 56 i <- i + 1
pavone@266 57 }
pavone@266 58 }
pavone@266 59
pavone@266 60 slot <- slot + 1
pavone@266 61 }
pavone@266 62 arr
pavone@266 63 }
pavone@268 64
pavone@268 65 llMessage: sendMessage:to withVars: {
pavone@268 66 obj <- object ptr
pavone@268 67 methodId <- obj_int32 ptr
pavone@268 68 } andCode: :methodId :obj {
pavone@268 69 mcall: (methodId num) 1 obj
pavone@268 70 }
pavone@266 71 }
pavone@266 72 getMethodDict <- {
pavone@266 73 methodDict <- dict hash
pavone@266 74 i <- 0
pavone@266 75 n <- rt numMessages
pavone@266 76 while: { i < n } do: {
pavone@266 77 name <- rt methodName: i
pavone@266 78 methodDict set: name i
pavone@266 79 i <- i + 1
pavone@266 80 }
pavone@266 81 getMethodDict <- {
pavone@266 82 methodDict
pavone@266 83 }
pavone@266 84 methodDict
pavone@266 85 }
pavone@266 86 #{
pavone@266 87 does:understand? <- :obj :message {
pavone@266 88 d <- getMethodDict:
pavone@266 89 d ifget: message :messageId{
pavone@266 90 rt understands?: obj messageId
pavone@266 91 } else: { false }
pavone@266 92 }
pavone@266 93
pavone@266 94 understoodBy <- :obj {
pavone@266 95 ids <- rt addUnderstood: obj #[]
pavone@266 96 ids map: :id {
pavone@266 97 rt methodName: id
pavone@266 98 }
pavone@266 99 }
pavone@268 100
pavone@270 101 propertiesOf <- :obj {
pavone@270 102 messages <- understoodBy: obj
pavone@270 103 setters <- dict hash
pavone@270 104 potentials <- #[]
pavone@270 105 foreach: messages :idx message {
pavone@270 106 if: (message endsWith?: "!") {
pavone@270 107 setters set: (message from: 0 withLength: (message length) - 1) true
pavone@270 108 } else: {
pavone@270 109 potentials append: message
pavone@270 110 }
pavone@270 111 }
pavone@270 112 potentials filter: :el { setters contains?: el }
pavone@270 113 }
pavone@270 114
pavone@268 115 sendMessage:to <- :message :obj {
pavone@268 116 d <- getMethodDict:
pavone@268 117 d ifget: message :messageId{
pavone@268 118 rt sendMessage: messageId to: obj
pavone@268 119 } else: { false }
pavone@268 120 }
pavone@266 121 }
pavone@266 122 }