Initial revision
authorclaus
Thu, 02 Jun 1994 13:20:08 +0200
changeset 84 1eba5946aea2
parent 83 3630ed3bfdca
child 85 1343af456e28
Initial revision
CompCode.st
CompiledCode.st
ExecFunc.st
ExecutableFunction.st
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/CompCode.st	Thu Jun 02 13:20:08 1994 +0200
@@ -0,0 +1,126 @@
+"
+ COPYRIGHT (c) 1994 by Claus Gittinger
+              All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+
+ExecutableFunction subclass:#ExecutableCodeObject
+       instanceVariableNames:'byteCode literals'
+       classVariableNames:''
+       poolDictionaries:''
+       category:'Kernel-Methods'
+!
+
+ExecutableCodeObject comment:'
+
+COPYRIGHT (c) 1994 by Claus Gittinger
+              All Rights Reserved
+
+$Header: /cvs/stx/stx/libbasic/Attic/CompCode.st,v 1.1 1994-06-02 11:20:03 claus Exp $
+
+written summer 94 by claus
+'!
+
+!ExecutableCodeObject class methodsFor:'documentation'!
+
+documentation
+"
+    This is an abstract class, to merge common attributes of Blocks and
+    Methods i.e. describe all objects consisting of compiled or interpreted code.
+
+    Instance variables:
+
+    byteCode    <ByteArray>       bytecode of home method if its an interpreted codeobject
+    literals    <Array>           the blocks literal array
+
+    NOTICE: layout known by runtime system and compiler - do not change
+"
+! !
+
+!ExecutableCodeObject class methodsFor:'queries'!
+
+isBuiltInClass
+    "this class is known by the run-time-system"
+
+    ^ true
+! !
+
+!ExecutableCodeObject methodsFor:'accessing'!
+
+byteCode
+    "return the bytecode (a ByteArray)"
+
+    ^ byteCode
+!
+
+literals
+    "return the literal array"
+
+    ^ literals
+! !
+
+!ExecutableCodeObject methodsFor:'private accessing'!
+
+byteCode:aByteArray
+    "set the bytecode field - DANGER ALERT"
+
+    byteCode := aByteArray
+!
+
+literals:aLiteralArray 
+    "set the literal array for evaluation - DANGER ALERT"
+
+    literals := aLiteralArray
+! !
+
+!ExecutableCodeObject methodsFor:'error handling'!
+
+noByteCode
+    "this error is triggered when the interpreter tries to execute a
+     code object, where the byteCode is nil.
+     Can only happen when Compiler/runtime system is broken or
+     someone played around with a block/method."
+
+    self error:'nil byteCode in code-object - not executable'
+!
+
+invalidByteCode
+    "this error is triggered when the interpreter tries to execute a
+     code object, where the byteCode is nonNil, but not a ByteArray.
+     Can only happen when Compiler/runtime system is broken or
+     someone played around with a block/method."
+
+    self error:'invalid byteCode in code-object - not executable'
+!
+
+invalidInstruction
+    "this error is triggered when the bytecode-interpreter tries to
+     execute an invalid bytecode instruction.
+     Can only happen when Compiler/runtime system is broken or
+     someone played around with the block/methods code."
+
+    self error:'invalid instruction in code-object - not executable'
+!
+
+badLiteralTable
+    "this error is triggered, when a block/method is called with a bad literal
+     array (i.e. non-array) - this can only happen, if the
+     compiler is broken or someone played around with a block/methods
+     literal table or the GC is broken and corrupted it."
+
+    self error:'bad literal table in code-object - should not happen'
+!
+
+receiverNotBoolean:anObject
+    "this error is triggered when the bytecode-interpreter tries to
+     execute ifTrue:/ifFalse or whileTrue: type of expressions where the
+     receiver is neither true nor false."
+
+    self error:'if/while on non-boolean receiver'
+! !
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/CompiledCode.st	Thu Jun 02 13:20:08 1994 +0200
@@ -0,0 +1,126 @@
+"
+ COPYRIGHT (c) 1994 by Claus Gittinger
+              All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+
+ExecutableFunction subclass:#ExecutableCodeObject
+       instanceVariableNames:'byteCode literals'
+       classVariableNames:''
+       poolDictionaries:''
+       category:'Kernel-Methods'
+!
+
+ExecutableCodeObject comment:'
+
+COPYRIGHT (c) 1994 by Claus Gittinger
+              All Rights Reserved
+
+$Header: /cvs/stx/stx/libbasic/CompiledCode.st,v 1.1 1994-06-02 11:20:03 claus Exp $
+
+written summer 94 by claus
+'!
+
+!ExecutableCodeObject class methodsFor:'documentation'!
+
+documentation
+"
+    This is an abstract class, to merge common attributes of Blocks and
+    Methods i.e. describe all objects consisting of compiled or interpreted code.
+
+    Instance variables:
+
+    byteCode    <ByteArray>       bytecode of home method if its an interpreted codeobject
+    literals    <Array>           the blocks literal array
+
+    NOTICE: layout known by runtime system and compiler - do not change
+"
+! !
+
+!ExecutableCodeObject class methodsFor:'queries'!
+
+isBuiltInClass
+    "this class is known by the run-time-system"
+
+    ^ true
+! !
+
+!ExecutableCodeObject methodsFor:'accessing'!
+
+byteCode
+    "return the bytecode (a ByteArray)"
+
+    ^ byteCode
+!
+
+literals
+    "return the literal array"
+
+    ^ literals
+! !
+
+!ExecutableCodeObject methodsFor:'private accessing'!
+
+byteCode:aByteArray
+    "set the bytecode field - DANGER ALERT"
+
+    byteCode := aByteArray
+!
+
+literals:aLiteralArray 
+    "set the literal array for evaluation - DANGER ALERT"
+
+    literals := aLiteralArray
+! !
+
+!ExecutableCodeObject methodsFor:'error handling'!
+
+noByteCode
+    "this error is triggered when the interpreter tries to execute a
+     code object, where the byteCode is nil.
+     Can only happen when Compiler/runtime system is broken or
+     someone played around with a block/method."
+
+    self error:'nil byteCode in code-object - not executable'
+!
+
+invalidByteCode
+    "this error is triggered when the interpreter tries to execute a
+     code object, where the byteCode is nonNil, but not a ByteArray.
+     Can only happen when Compiler/runtime system is broken or
+     someone played around with a block/method."
+
+    self error:'invalid byteCode in code-object - not executable'
+!
+
+invalidInstruction
+    "this error is triggered when the bytecode-interpreter tries to
+     execute an invalid bytecode instruction.
+     Can only happen when Compiler/runtime system is broken or
+     someone played around with the block/methods code."
+
+    self error:'invalid instruction in code-object - not executable'
+!
+
+badLiteralTable
+    "this error is triggered, when a block/method is called with a bad literal
+     array (i.e. non-array) - this can only happen, if the
+     compiler is broken or someone played around with a block/methods
+     literal table or the GC is broken and corrupted it."
+
+    self error:'bad literal table in code-object - should not happen'
+!
+
+receiverNotBoolean:anObject
+    "this error is triggered when the bytecode-interpreter tries to
+     execute ifTrue:/ifFalse or whileTrue: type of expressions where the
+     receiver is neither true nor false."
+
+    self error:'if/while on non-boolean receiver'
+! !
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/ExecFunc.st	Thu Jun 02 13:20:08 1994 +0200
@@ -0,0 +1,139 @@
+"
+ COPYRIGHT (c) 1994 by Claus Gittinger
+              All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+
+Object subclass:#ExecutableFunction
+       instanceVariableNames:'code flags'
+       classVariableNames:''
+       poolDictionaries:''
+       category:'Kernel-Methods'
+!
+
+ExecutableFunction comment:'
+
+COPYRIGHT (c) 1994 by Claus Gittinger
+              All Rights Reserved
+
+$Header: /cvs/stx/stx/libbasic/Attic/ExecFunc.st,v 1.1 1994-06-02 11:20:08 claus Exp $
+
+written summer 94 by claus
+'!
+
+!ExecutableFunction class methodsFor:'documentation'!
+
+documentation
+"
+    This is an abstract class, to merge common attributes of non-ST functions,
+    Blocks and Methods.
+
+    Instance variables:
+
+    code        <not_an_object>   the function pointer if its a compiled block/method
+    flags       <SmallInteger>    special flag bits coded in a number
+
+    NOTICE: layout known by runtime system and compiler - do not change
+"
+! !
+
+!ExecutableFunction class methodsFor:'queries'!
+
+isBuiltInClass
+    "this class is known by the run-time-system"
+
+    ^ true
+! !
+
+!ExecutableFunction methodsFor:'accessing'!
+
+instVarAt:index
+    "have to catch instVar access to code - since its no object"
+
+    (index == 1) ifTrue:[^ self code].
+    ^ super instVarAt:index
+!
+
+instVarAt:index put:value
+    "have to catch instVar access to code - since its no object"
+
+    (index == 1) ifTrue:[^ self code:value].
+    ^ super instVarAt:index put:value
+!
+
+code
+    "return the code field. This is not an object but the address of the machine instructions. 
+     Therefore an integer representing the code-address is returned"
+
+%{  /* NOCONTEXT */
+
+    if (_INST(code) != nil) {
+        RETURN ( _MKSMALLINT((int)(_INST(code))) )
+    }
+%}
+.
+    ^ nil
+! !
+
+!ExecutableFunction methodsFor:'private accessing'!
+
+code:anAddress
+    "set the code field - DANGER ALERT. 
+     This is not an object but the address of the machine instructions.
+     Therefore the argument must be an integer representing this address.
+     You can crash Smalltalk very badly when playing around here ...
+     This method is for compiler support and very special cases (debugging) only
+     - do not use"
+
+%{  /* NOCONTEXT */
+    if (_isSmallInteger(anAddress))
+        _INST(code) = (OBJ)(_intVal(anAddress));
+    else
+        _INST(code) = (OBJ)0;
+%}
+!
+
+dynamic:aBoolean
+    "set the flag bit stating that the machine code was created
+     dynamically and should be flushed on image-restart.
+     Obsolete - now done in VM"
+
+%{  /* NOCONTEXT */
+    int newFlags = _intVal(_INST(flags));
+
+    /* made this a primitive to get define in stc.h */
+    if (aBoolean == true)
+        newFlags |= F_DYNAMIC;
+    else
+        newFlags &= ~F_DYNAMIC;
+
+    _INST(flags) = _MKSMALLINT(newFlags);
+%}
+! !
+
+!ExecutableFunction methodsFor:'error handling'!
+
+invalidCode
+    "this error is triggered by the interpreter when something is wrong
+     with the code object (any error not handled below).
+     In this case, the VM sends this to the bad method/block (the receiver).
+     Can only happen when the Compiler/runtime system is broken or
+     someone played around."
+
+    self error:'invalid code-object - not executable'
+! !
+
+!ExecutableFunction methodsFor:'binary storage'!
+
+readBinaryContentsFrom: stream manager: manager
+    "make certain, that no invalid function addresses are created."
+
+    super readBinaryContentsFrom: stream manager: manager.
+    code := nil.
+! !
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/ExecutableFunction.st	Thu Jun 02 13:20:08 1994 +0200
@@ -0,0 +1,139 @@
+"
+ COPYRIGHT (c) 1994 by Claus Gittinger
+              All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+
+Object subclass:#ExecutableFunction
+       instanceVariableNames:'code flags'
+       classVariableNames:''
+       poolDictionaries:''
+       category:'Kernel-Methods'
+!
+
+ExecutableFunction comment:'
+
+COPYRIGHT (c) 1994 by Claus Gittinger
+              All Rights Reserved
+
+$Header: /cvs/stx/stx/libbasic/ExecutableFunction.st,v 1.1 1994-06-02 11:20:08 claus Exp $
+
+written summer 94 by claus
+'!
+
+!ExecutableFunction class methodsFor:'documentation'!
+
+documentation
+"
+    This is an abstract class, to merge common attributes of non-ST functions,
+    Blocks and Methods.
+
+    Instance variables:
+
+    code        <not_an_object>   the function pointer if its a compiled block/method
+    flags       <SmallInteger>    special flag bits coded in a number
+
+    NOTICE: layout known by runtime system and compiler - do not change
+"
+! !
+
+!ExecutableFunction class methodsFor:'queries'!
+
+isBuiltInClass
+    "this class is known by the run-time-system"
+
+    ^ true
+! !
+
+!ExecutableFunction methodsFor:'accessing'!
+
+instVarAt:index
+    "have to catch instVar access to code - since its no object"
+
+    (index == 1) ifTrue:[^ self code].
+    ^ super instVarAt:index
+!
+
+instVarAt:index put:value
+    "have to catch instVar access to code - since its no object"
+
+    (index == 1) ifTrue:[^ self code:value].
+    ^ super instVarAt:index put:value
+!
+
+code
+    "return the code field. This is not an object but the address of the machine instructions. 
+     Therefore an integer representing the code-address is returned"
+
+%{  /* NOCONTEXT */
+
+    if (_INST(code) != nil) {
+        RETURN ( _MKSMALLINT((int)(_INST(code))) )
+    }
+%}
+.
+    ^ nil
+! !
+
+!ExecutableFunction methodsFor:'private accessing'!
+
+code:anAddress
+    "set the code field - DANGER ALERT. 
+     This is not an object but the address of the machine instructions.
+     Therefore the argument must be an integer representing this address.
+     You can crash Smalltalk very badly when playing around here ...
+     This method is for compiler support and very special cases (debugging) only
+     - do not use"
+
+%{  /* NOCONTEXT */
+    if (_isSmallInteger(anAddress))
+        _INST(code) = (OBJ)(_intVal(anAddress));
+    else
+        _INST(code) = (OBJ)0;
+%}
+!
+
+dynamic:aBoolean
+    "set the flag bit stating that the machine code was created
+     dynamically and should be flushed on image-restart.
+     Obsolete - now done in VM"
+
+%{  /* NOCONTEXT */
+    int newFlags = _intVal(_INST(flags));
+
+    /* made this a primitive to get define in stc.h */
+    if (aBoolean == true)
+        newFlags |= F_DYNAMIC;
+    else
+        newFlags &= ~F_DYNAMIC;
+
+    _INST(flags) = _MKSMALLINT(newFlags);
+%}
+! !
+
+!ExecutableFunction methodsFor:'error handling'!
+
+invalidCode
+    "this error is triggered by the interpreter when something is wrong
+     with the code object (any error not handled below).
+     In this case, the VM sends this to the bad method/block (the receiver).
+     Can only happen when the Compiler/runtime system is broken or
+     someone played around."
+
+    self error:'invalid code-object - not executable'
+! !
+
+!ExecutableFunction methodsFor:'binary storage'!
+
+readBinaryContentsFrom: stream manager: manager
+    "make certain, that no invalid function addresses are created."
+
+    super readBinaryContentsFrom: stream manager: manager.
+    code := nil.
+! !