Mercurial > repos > tabletprog
diff modules/object.tp @ 266:75dc7161c1ca
Added object module which provides some basic reflection capabilities
author | Michael Pavone <pavone@retrodev.com> |
---|---|
date | Thu, 17 Jul 2014 23:57:41 -0700 |
parents | |
children | 123e9468d55e |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/modules/object.tp Thu Jul 17 23:57:41 2014 -0700 @@ -0,0 +1,94 @@ +{ + rt <- #{ + llMessage: numMessages withVars: { + intret <- obj_int32 ptr + } andCode: { + intret <- make_object: (addr_of: obj_int32_meta) NULL 0 + intret num!: (sizeof: methodNames) / (sizeof: (char ptr)) + intret + } + + llMessage: methodName withVars: { + methodId <- obj_int32 ptr + name <- string ptr + namelen <- int + } andCode: :methodId { + name <- make_object: (addr_of: string_meta) NULL 0 + namelen <- strlen: (methodNames get: (methodId num)) + name bytes!: namelen + name len!: namelen + name data!: (GC_MALLOC_ATOMIC: namelen + 1) + memcpy: (name data) (methodNames get: (methodId num)) namelen + name + } + + llMessage: understands? withVars: { + obj <- object ptr + methodId <- obj_int32 ptr + ret <- object ptr + } andCode: :obj methodId { + if: (object_understands: obj (methodId num)) { + ret <- module_true + } else: { + ret <- module_false + } + ret + } + + llMessage: addUnderstood withVars: { + obj <- object ptr + arr <- object ptr + methHash <- (uint32_t ptr) ptr + methodId <- obj_int32 ptr + slot <- int + i <- int + } andCode: :obj arr { + methHash <- (obj meta) methods + slot <- 0 + while: {slot < 16} do: { + if: (methHash get: slot) { + i <- 0 + while: { ((methHash get: slot) get: i) != 0xFFFFFFFF } do: { + methodId <- make_object: (addr_of: obj_int32_meta) NULL 0 + methodId num!: ((methHash get: slot) get: i) + mcall: append 2 arr methodId + + i <- i + 1 + } + } + + slot <- slot + 1 + } + arr + } + } + getMethodDict <- { + methodDict <- dict hash + i <- 0 + n <- rt numMessages + while: { i < n } do: { + name <- rt methodName: i + methodDict set: name i + i <- i + 1 + } + getMethodDict <- { + methodDict + } + methodDict + } + #{ + does:understand? <- :obj :message { + d <- getMethodDict: + d ifget: message :messageId{ + rt understands?: obj messageId + } else: { false } + } + + understoodBy <- :obj { + ids <- rt addUnderstood: obj #[] + ids map: :id { + rt methodName: id + } + } + } +}