equal
deleted
inserted
replaced
9 other person. No title to or ownership of the software is |
9 other person. No title to or ownership of the software is |
10 hereby transferred. |
10 hereby transferred. |
11 " |
11 " |
12 |
12 |
13 Object subclass:#ExecutableFunction |
13 Object subclass:#ExecutableFunction |
14 instanceVariableNames:'code*' |
14 instanceVariableNames:'code*' |
15 classVariableNames:'ExecutionErrorSignal InvalidCodeSignal' |
15 classVariableNames:'ExecutionErrorSignal InvalidCodeSignal' |
16 poolDictionaries:'' |
16 poolDictionaries:'' |
17 category:'Kernel-Methods' |
17 category:'Kernel-Methods' |
18 ! |
18 ! |
19 |
19 |
20 !ExecutableFunction class methodsFor:'documentation'! |
20 !ExecutableFunction class methodsFor:'documentation'! |
21 |
21 |
22 copyright |
22 copyright |
29 inclusion of the above copyright notice. This software may not |
29 inclusion of the above copyright notice. This software may not |
30 be provided or otherwise made available to, or used by, any |
30 be provided or otherwise made available to, or used by, any |
31 other person. No title to or ownership of the software is |
31 other person. No title to or ownership of the software is |
32 hereby transferred. |
32 hereby transferred. |
33 " |
33 " |
34 ! |
|
35 |
|
36 version |
|
37 ^ '$Header: /cvs/stx/stx/libbasic/ExecutableFunction.st,v 1.17 1995-11-11 15:22:25 cg Exp $' |
|
38 ! |
34 ! |
39 |
35 |
40 documentation |
36 documentation |
41 " |
37 " |
42 This is an abstract class, to merge common attributes of all kinds of |
38 This is an abstract class, to merge common attributes of all kinds of |
58 |
54 |
59 InvalidCodeSignal codeObject is not executable |
55 InvalidCodeSignal codeObject is not executable |
60 |
56 |
61 NOTICE: layout known by runtime system and compiler - do not change |
57 NOTICE: layout known by runtime system and compiler - do not change |
62 " |
58 " |
63 ! ! |
59 ! |
64 |
60 |
65 !ExecutableFunction class methodsFor:'queries'! |
61 version |
66 |
62 ^ '$Header: /cvs/stx/stx/libbasic/ExecutableFunction.st,v 1.18 1995-11-23 11:17:00 cg Exp $' |
67 isBuiltInClass |
|
68 "this class is known by the run-time-system" |
|
69 |
|
70 ^ true |
|
71 ! ! |
63 ! ! |
72 |
64 |
73 !ExecutableFunction class methodsFor:'initialization'! |
65 !ExecutableFunction class methodsFor:'initialization'! |
74 |
66 |
75 initialize |
67 initialize |
90 "return the parent-signal of all execution errors" |
82 "return the parent-signal of all execution errors" |
91 |
83 |
92 ^ ExecutionErrorSignal |
84 ^ ExecutionErrorSignal |
93 ! ! |
85 ! ! |
94 |
86 |
|
87 !ExecutableFunction class methodsFor:'queries'! |
|
88 |
|
89 isBuiltInClass |
|
90 "this class is known by the run-time-system" |
|
91 |
|
92 ^ true |
|
93 ! ! |
|
94 |
95 !ExecutableFunction methodsFor:'accessing'! |
95 !ExecutableFunction methodsFor:'accessing'! |
96 |
|
97 instVarAt:index |
|
98 "have to catch instVar access to code - since its no object" |
|
99 |
|
100 (index == 1) ifTrue:[^ self code]. |
|
101 ^ super instVarAt:index |
|
102 ! |
|
103 |
|
104 instVarAt:index put:value |
|
105 "have to catch instVar access to code - since its no object" |
|
106 |
|
107 (index == 1) ifTrue:[^ self code:value]. |
|
108 ^ super instVarAt:index put:value |
|
109 ! |
|
110 |
96 |
111 code |
97 code |
112 "return the code field. This is not an object but the address of the machine instructions. |
98 "return the code field. This is not an object but the address of the machine instructions. |
113 Therefore an integer representing the code-address is returned" |
99 Therefore an integer representing the code-address is returned" |
114 |
100 |
123 } |
109 } |
124 RETURN ( __MKUINT(addr)); |
110 RETURN ( __MKUINT(addr)); |
125 } |
111 } |
126 %}. |
112 %}. |
127 ^ nil |
113 ^ nil |
|
114 ! |
|
115 |
|
116 instVarAt:index |
|
117 "have to catch instVar access to code - since its no object" |
|
118 |
|
119 (index == 1) ifTrue:[^ self code]. |
|
120 ^ super instVarAt:index |
|
121 ! |
|
122 |
|
123 instVarAt:index put:value |
|
124 "have to catch instVar access to code - since its no object" |
|
125 |
|
126 (index == 1) ifTrue:[^ self code:value]. |
|
127 ^ super instVarAt:index put:value |
128 ! ! |
128 ! ! |
129 |
129 |
130 !ExecutableFunction methodsFor:'private accessing'! |
130 !ExecutableFunction methodsFor:'binary storage'! |
131 |
131 |
132 code:anAddress |
132 readBinaryContentsFrom: stream manager: manager |
133 "set the code field - DANGER ALERT. |
133 "make certain, that no invalid function addresses are created." |
134 This is not an object but the address of the machine instructions. |
|
135 Therefore the argument must be an integer representing this address. |
|
136 You can crash Smalltalk very badly when playing around here ... |
|
137 This method is for compiler support and very special cases (debugging) only |
|
138 - do not use" |
|
139 |
134 |
140 %{ /* NOCONTEXT */ |
135 super readBinaryContentsFrom: stream manager: manager. |
141 |
136 self code:nil. |
142 if (__isSmallInteger(anAddress)) |
|
143 _INST(code_) = (OBJ)(_intVal(anAddress)); |
|
144 else { |
|
145 _INST(code_) = (OBJ)(__longIntVal(anAddress)); |
|
146 } |
|
147 %} |
|
148 ! ! |
137 ! ! |
149 |
138 |
150 !ExecutableFunction methodsFor:'error handling'! |
139 !ExecutableFunction methodsFor:'error handling'! |
151 |
140 |
152 invalidCode |
141 invalidCode |
169 |
158 |
170 aStream nextPutAll:self class name; nextPutAll:'(address: 0x'; |
159 aStream nextPutAll:self class name; nextPutAll:'(address: 0x'; |
171 nextPutAll:(addr printStringRadix:16); nextPutAll:')' |
160 nextPutAll:(addr printStringRadix:16); nextPutAll:')' |
172 ! ! |
161 ! ! |
173 |
162 |
174 !ExecutableFunction methodsFor:'binary storage'! |
163 !ExecutableFunction methodsFor:'private accessing'! |
175 |
164 |
176 readBinaryContentsFrom: stream manager: manager |
165 code:anAddress |
177 "make certain, that no invalid function addresses are created." |
166 "set the code field - DANGER ALERT. |
|
167 This is not an object but the address of the machine instructions. |
|
168 Therefore the argument must be an integer representing this address. |
|
169 You can crash Smalltalk very badly when playing around here ... |
|
170 This method is for compiler support and very special cases (debugging) only |
|
171 - do not use" |
178 |
172 |
179 super readBinaryContentsFrom: stream manager: manager. |
173 %{ /* NOCONTEXT */ |
180 self code:nil. |
174 |
|
175 if (__isSmallInteger(anAddress)) |
|
176 _INST(code_) = (OBJ)(_intVal(anAddress)); |
|
177 else { |
|
178 _INST(code_) = (OBJ)(__longIntVal(anAddress)); |
|
179 } |
|
180 %} |
181 ! ! |
181 ! ! |
|
182 |
|
183 ExecutableFunction initialize! |