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