Mercurial > repos > tabletprog
comparison 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 |
comparison
equal
deleted
inserted
replaced
265:d6a4c9e7716e | 266:75dc7161c1ca |
---|---|
1 { | |
2 rt <- #{ | |
3 llMessage: numMessages withVars: { | |
4 intret <- obj_int32 ptr | |
5 } andCode: { | |
6 intret <- make_object: (addr_of: obj_int32_meta) NULL 0 | |
7 intret num!: (sizeof: methodNames) / (sizeof: (char ptr)) | |
8 intret | |
9 } | |
10 | |
11 llMessage: methodName withVars: { | |
12 methodId <- obj_int32 ptr | |
13 name <- string ptr | |
14 namelen <- int | |
15 } andCode: :methodId { | |
16 name <- make_object: (addr_of: string_meta) NULL 0 | |
17 namelen <- strlen: (methodNames get: (methodId num)) | |
18 name bytes!: namelen | |
19 name len!: namelen | |
20 name data!: (GC_MALLOC_ATOMIC: namelen + 1) | |
21 memcpy: (name data) (methodNames get: (methodId num)) namelen | |
22 name | |
23 } | |
24 | |
25 llMessage: understands? withVars: { | |
26 obj <- object ptr | |
27 methodId <- obj_int32 ptr | |
28 ret <- object ptr | |
29 } andCode: :obj methodId { | |
30 if: (object_understands: obj (methodId num)) { | |
31 ret <- module_true | |
32 } else: { | |
33 ret <- module_false | |
34 } | |
35 ret | |
36 } | |
37 | |
38 llMessage: addUnderstood withVars: { | |
39 obj <- object ptr | |
40 arr <- object ptr | |
41 methHash <- (uint32_t ptr) ptr | |
42 methodId <- obj_int32 ptr | |
43 slot <- int | |
44 i <- int | |
45 } andCode: :obj arr { | |
46 methHash <- (obj meta) methods | |
47 slot <- 0 | |
48 while: {slot < 16} do: { | |
49 if: (methHash get: slot) { | |
50 i <- 0 | |
51 while: { ((methHash get: slot) get: i) != 0xFFFFFFFF } do: { | |
52 methodId <- make_object: (addr_of: obj_int32_meta) NULL 0 | |
53 methodId num!: ((methHash get: slot) get: i) | |
54 mcall: append 2 arr methodId | |
55 | |
56 i <- i + 1 | |
57 } | |
58 } | |
59 | |
60 slot <- slot + 1 | |
61 } | |
62 arr | |
63 } | |
64 } | |
65 getMethodDict <- { | |
66 methodDict <- dict hash | |
67 i <- 0 | |
68 n <- rt numMessages | |
69 while: { i < n } do: { | |
70 name <- rt methodName: i | |
71 methodDict set: name i | |
72 i <- i + 1 | |
73 } | |
74 getMethodDict <- { | |
75 methodDict | |
76 } | |
77 methodDict | |
78 } | |
79 #{ | |
80 does:understand? <- :obj :message { | |
81 d <- getMethodDict: | |
82 d ifget: message :messageId{ | |
83 rt understands?: obj messageId | |
84 } else: { false } | |
85 } | |
86 | |
87 understoodBy <- :obj { | |
88 ids <- rt addUnderstood: obj #[] | |
89 ids map: :id { | |
90 rt methodName: id | |
91 } | |
92 } | |
93 } | |
94 } |