annotate modules/object.tp @ 347:ff7ea11b4b60

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