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