|
1 " |
|
2 COPYRIGHT (c) 1994 by Claus Gittinger |
|
3 All Rights Reserved |
|
4 |
|
5 This software is furnished under a license and may be used |
|
6 only in accordance with the terms of that license and with the |
|
7 inclusion of the above copyright notice. This software may not |
|
8 be provided or otherwise made available to, or used by, any |
|
9 other person. No title to or ownership of the software is |
|
10 hereby transferred. |
|
11 " |
|
12 |
|
13 Object subclass:#ExecutableFunction |
|
14 instanceVariableNames:'code flags' |
|
15 classVariableNames:'' |
|
16 poolDictionaries:'' |
|
17 category:'Kernel-Methods' |
|
18 ! |
|
19 |
|
20 ExecutableFunction comment:' |
|
21 |
|
22 COPYRIGHT (c) 1994 by Claus Gittinger |
|
23 All Rights Reserved |
|
24 |
|
25 $Header: /cvs/stx/stx/libbasic/ExecutableFunction.st,v 1.1 1994-06-02 11:20:08 claus Exp $ |
|
26 |
|
27 written summer 94 by claus |
|
28 '! |
|
29 |
|
30 !ExecutableFunction class methodsFor:'documentation'! |
|
31 |
|
32 documentation |
|
33 " |
|
34 This is an abstract class, to merge common attributes of non-ST functions, |
|
35 Blocks and Methods. |
|
36 |
|
37 Instance variables: |
|
38 |
|
39 code <not_an_object> the function pointer if its a compiled block/method |
|
40 flags <SmallInteger> special flag bits coded in a number |
|
41 |
|
42 NOTICE: layout known by runtime system and compiler - do not change |
|
43 " |
|
44 ! ! |
|
45 |
|
46 !ExecutableFunction class methodsFor:'queries'! |
|
47 |
|
48 isBuiltInClass |
|
49 "this class is known by the run-time-system" |
|
50 |
|
51 ^ true |
|
52 ! ! |
|
53 |
|
54 !ExecutableFunction methodsFor:'accessing'! |
|
55 |
|
56 instVarAt:index |
|
57 "have to catch instVar access to code - since its no object" |
|
58 |
|
59 (index == 1) ifTrue:[^ self code]. |
|
60 ^ super instVarAt:index |
|
61 ! |
|
62 |
|
63 instVarAt:index put:value |
|
64 "have to catch instVar access to code - since its no object" |
|
65 |
|
66 (index == 1) ifTrue:[^ self code:value]. |
|
67 ^ super instVarAt:index put:value |
|
68 ! |
|
69 |
|
70 code |
|
71 "return the code field. This is not an object but the address of the machine instructions. |
|
72 Therefore an integer representing the code-address is returned" |
|
73 |
|
74 %{ /* NOCONTEXT */ |
|
75 |
|
76 if (_INST(code) != nil) { |
|
77 RETURN ( _MKSMALLINT((int)(_INST(code))) ) |
|
78 } |
|
79 %} |
|
80 . |
|
81 ^ nil |
|
82 ! ! |
|
83 |
|
84 !ExecutableFunction methodsFor:'private accessing'! |
|
85 |
|
86 code:anAddress |
|
87 "set the code field - DANGER ALERT. |
|
88 This is not an object but the address of the machine instructions. |
|
89 Therefore the argument must be an integer representing this address. |
|
90 You can crash Smalltalk very badly when playing around here ... |
|
91 This method is for compiler support and very special cases (debugging) only |
|
92 - do not use" |
|
93 |
|
94 %{ /* NOCONTEXT */ |
|
95 if (_isSmallInteger(anAddress)) |
|
96 _INST(code) = (OBJ)(_intVal(anAddress)); |
|
97 else |
|
98 _INST(code) = (OBJ)0; |
|
99 %} |
|
100 ! |
|
101 |
|
102 dynamic:aBoolean |
|
103 "set the flag bit stating that the machine code was created |
|
104 dynamically and should be flushed on image-restart. |
|
105 Obsolete - now done in VM" |
|
106 |
|
107 %{ /* NOCONTEXT */ |
|
108 int newFlags = _intVal(_INST(flags)); |
|
109 |
|
110 /* made this a primitive to get define in stc.h */ |
|
111 if (aBoolean == true) |
|
112 newFlags |= F_DYNAMIC; |
|
113 else |
|
114 newFlags &= ~F_DYNAMIC; |
|
115 |
|
116 _INST(flags) = _MKSMALLINT(newFlags); |
|
117 %} |
|
118 ! ! |
|
119 |
|
120 !ExecutableFunction methodsFor:'error handling'! |
|
121 |
|
122 invalidCode |
|
123 "this error is triggered by the interpreter when something is wrong |
|
124 with the code object (any error not handled below). |
|
125 In this case, the VM sends this to the bad method/block (the receiver). |
|
126 Can only happen when the Compiler/runtime system is broken or |
|
127 someone played around." |
|
128 |
|
129 self error:'invalid code-object - not executable' |
|
130 ! ! |
|
131 |
|
132 !ExecutableFunction methodsFor:'binary storage'! |
|
133 |
|
134 readBinaryContentsFrom: stream manager: manager |
|
135 "make certain, that no invalid function addresses are created." |
|
136 |
|
137 super readBinaryContentsFrom: stream manager: manager. |
|
138 code := nil. |
|
139 ! ! |